Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/depend/reachable.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/depend/reachable.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 536, Fri Feb 18 16:51:54 2000 UTC revision 537, Fri Feb 18 17:20:16 2000 UTC
# Line 6  Line 6 
6   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7   *)   *)
8  signature REACHABLE = sig  signature REACHABLE = sig
9      val reachable' : DependencyGraph.impexp SymbolMap.map -> SrcPathSet.set      (* These two functions simply give you the set of (non-stable)
10      val reachable : GroupGraph.group -> SrcPathSet.set       * modules reachable from some root. *)
11        val reachable' : DependencyGraph.impexp SymbolMap.map -> SmlInfoSet.set
12        val reachable : GroupGraph.group -> SmlInfoSet.set
13    
14        (* "snodeMap" gives us handles at arbitrary points within the (non-stable)
15         * portion of a dependency graph.
16         * This is used by "slave" mode compiler. *)
17      val snodeMap : GroupGraph.group -> DependencyGraph.snode SrcPathMap.map      val snodeMap : GroupGraph.group -> DependencyGraph.snode SrcPathMap.map
18    
19        (* Given a library (or group) g, "groupsOf g" gets the set of
20         * subgroups (but not sub-libraries) of that group.  The result
21         * will include the argument itself. *)
22      val groupsOf : GroupGraph.group -> SrcPathSet.set      val groupsOf : GroupGraph.group -> SrcPathSet.set
23    
24        (* Given an arbitrary group graph rooted at group g, "stableLibsOf g"
25         * gets the set of stable libraries reachable from g. *)
26        val stableLibsOf : GroupGraph.group -> GroupGraph.group SrcPathMap.map
27    
28        (* Given a "closed" subset of (non-stable) nodes in a dependency graph,
29         * "frontier" gives you the set of frontier nodes of that set.  The
30         * closed set is given by its indicator function (first argument).
31         * ("closed" means that any node that if a node's ancestors are all in
32         * the set, then so is the node itself.  A frontier node is a node that
33         * is in the set but either not all of its ancestors are or the node
34         * is an export node.) *)
35        val frontier : (BinInfo.info -> bool) -> GroupGraph.group -> StableSet.set
36  end  end
37    
38  structure Reachable :> REACHABLE = struct  structure Reachable :> REACHABLE = struct
# Line 20  Line 43 
43          fun reach ops (exports: DG.impexp SymbolMap.map) = let          fun reach ops (exports: DG.impexp SymbolMap.map) = let
44              val { add, member, empty } = ops              val { add, member, empty } = ops
45              fun snode (x as DG.SNODE n, known) = let              fun snode (x as DG.SNODE n, known) = let
46                  val { smlinfo, localimports = l, globalimports = g } = n                  val { smlinfo = i, localimports = l, globalimports = g } = n
                 val p = SmlInfo.sourcepath smlinfo  
47              in              in
48                  if member (known, p) then known                  if member (known, i) then known
49                  else foldl farsbnode (foldl snode (add (known, p, x)) l) g                  else foldl farsbnode (foldl snode (add (known, i, x)) l) g
50              end              end
51    
52              and farsbnode ((_, n), known) = sbnode (n, known)              and farsbnode ((_, n), known) = sbnode (n, known)
# Line 37  Line 59 
59              SymbolMap.foldl impexp empty exports              SymbolMap.foldl impexp empty exports
60          end          end
61    
62          fun snodeMap' (exports, acc) =          fun snodeMap' (exports, acc) = let
63              reach { add = SrcPathMap.insert,              fun add (m, i, x) = SrcPathMap.insert (m, SmlInfo.sourcepath i, x)
64                      member = SrcPathMap.inDomain,              fun member (m, i) = SrcPathMap.inDomain (m, SmlInfo.sourcepath i)
65                      empty = acc } exports          in
66                reach { add = add, member = member, empty = acc } exports
67            end
68      in      in
69          val reachable' =          val reachable' =
70              reach { add = fn (s, x, _) => SrcPathSet.add (s, x),              reach { add = fn (s, i, _) => SmlInfoSet.add (s, i),
71                      member = SrcPathSet.member,                      member = SmlInfoSet.member,
72                      empty = SrcPathSet.empty }                      empty = SmlInfoSet.empty }
73    
74          fun reachable (GG.GROUP { exports, ... }) = reachable' exports          fun reachable (GG.GROUP { exports, ... }) = reachable' exports
75    
# Line 64  Line 88 
88          end          end
89    
90          fun groupsOf g = let          fun groupsOf g = let
91              fun go (GG.GROUP { grouppath, sublibs, ... }, a) = let              fun subgroups (GG.GROUP { kind = GG.NOLIB sg, ... }) = sg
92                  fun sl ((p, g as GG.GROUP { kind = GG.NOLIB, ... }), a) =                | subgroups (GG.GROUP { kind = GG.LIB (_, sg), ... }) = sg
93                  | subgroups _ = []
94                fun go (g as GG.GROUP { grouppath, ... }, a) = let
95                    val sgl = subgroups g
96                    fun sl ((p, g as GG.GROUP { kind = GG.NOLIB _, ... }), a) =
97                      if SrcPathSet.member (a, p) then a else go (g, a)                      if SrcPathSet.member (a, p) then a else go (g, a)
98                    | sl (_, a) = a                    | sl (_, a) = a
99              in              in
100                  SrcPathSet.add (foldl sl a sublibs, grouppath)                  SrcPathSet.add (foldl sl a sgl, grouppath)
101              end              end
102          in          in
103              go (g, SrcPathSet.empty)              go (g, SrcPathSet.empty)
104          end          end
105    
106            fun stableLibsOf (g as GG.GROUP { grouppath, ... }) = let
107                fun slo ((p, g), (seen, res)) = let
108                    val GG.GROUP { kind, sublibs, ... } = g
109                in
110                    if SrcPathSet.member (seen, p) then (seen, res)
111                    else let
112                        val (seen, res) = foldl slo (seen, res) sublibs
113                        val seen = SrcPathSet.add (seen, p)
114                    in
115                        case kind of
116                            GG.STABLELIB _ => (seen, SrcPathMap.insert (res, p, g))
117                          | _ => (seen, res)
118                    end
119                end
120            in
121                #2 (slo ((grouppath, g), (SrcPathSet.empty, SrcPathMap.empty)))
122            end
123    
124            fun frontier inSet (GG.GROUP { exports, ... }) = let
125                fun bnode (DG.BNODE n, (seen, f)) = let
126                    val i = #bininfo n
127                    val li = #localimports n
128                in
129                    if StableSet.member (seen, i) then (seen, f)
130                    else let
131                        val seen = StableSet.add (seen, i)
132                    in
133                        if inSet i then (seen, StableSet.add (f, i))
134                        else foldl bnode (seen, f) li
135                    end
136                end
137                fun get_bn (((_, DG.SB_BNODE (n, _)), _), bnl) = n :: bnl
138                  | get_bn (_, bnl) = bnl
139                val bnl = SymbolMap.foldl get_bn [] exports
140            in
141                #2 (foldl bnode (StableSet.empty, StableSet.empty) bnl)
142            end
143      end      end
144  end  end

Legend:
Removed from v.536  
changed lines
  Added in v.537

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0