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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 737 - (view) (download)

1 : blume 301 (*
2 :     * Get the set of reachable SNODEs in a given dependency graph.
3 :     *
4 :     * (C) 1999 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 :     signature REACHABLE = sig
9 : blume 537 (* These two functions simply give you the set of (non-stable)
10 : blume 569 * modules reachable from some root and the fringe of stable
11 :     * modules that surrounds the non-stable portion. *)
12 :     val reachable' :
13 :     DependencyGraph.sbnode list -> SmlInfoSet.set * StableSet.set
14 :     val reachable : GroupGraph.group -> SmlInfoSet.set * StableSet.set
15 : blume 537
16 :     (* "snodeMap" gives us handles at arbitrary points within the (non-stable)
17 :     * portion of a dependency graph.
18 :     * This is used by "slave" mode compiler. *)
19 : blume 448 val snodeMap : GroupGraph.group -> DependencyGraph.snode SrcPathMap.map
20 : blume 537
21 :     (* Given a library (or group) g, "groupsOf g" gets the set of
22 :     * subgroups (but not sub-libraries) of that group. The result
23 :     * will include the argument itself. *)
24 : blume 492 val groupsOf : GroupGraph.group -> SrcPathSet.set
25 : blume 537
26 :     (* Given an arbitrary group graph rooted at group g, "stableLibsOf g"
27 :     * gets the set of stable libraries reachable from g. *)
28 :     val stableLibsOf : GroupGraph.group -> GroupGraph.group SrcPathMap.map
29 :    
30 :     (* Given a "closed" subset of (non-stable) nodes in a dependency graph,
31 :     * "frontier" gives you the set of frontier nodes of that set. The
32 :     * closed set is given by its indicator function (first argument).
33 : blume 569 * ("closed" means that if a node's ancestors are all in
34 : blume 537 * the set, then so is the node itself. A frontier node is a node that
35 :     * is in the set but either not all of its ancestors are or the node
36 :     * is an export node.) *)
37 :     val frontier : (BinInfo.info -> bool) -> GroupGraph.group -> StableSet.set
38 : blume 301 end
39 :    
40 :     structure Reachable :> REACHABLE = struct
41 :     structure DG = DependencyGraph
42 : blume 492 structure GG = GroupGraph
43 : blume 301
44 : blume 448 local
45 : blume 569 fun reach ops (export_nodes: DG.sbnode list) = let
46 : blume 448 val { add, member, empty } = ops
47 : blume 569 fun snode (x as DG.SNODE n, (known, stabfringe)) = let
48 : blume 537 val { smlinfo = i, localimports = l, globalimports = g } = n
49 : blume 448 in
50 : blume 569 if member (known, i) then (known, stabfringe)
51 :     else foldl farsbnode
52 :     (foldl snode (add (known, i, x), stabfringe) l)
53 :     g
54 : blume 448 end
55 :    
56 : blume 569 and farsbnode ((_, n), ksf) = sbnode (n, ksf)
57 : blume 448
58 : blume 737 and sbnode (DG.SB_BNODE (DG.BNODE n, _, _), (known, stabfringe)) =
59 : blume 569 (known, StableSet.add (stabfringe, #bininfo n))
60 :     | sbnode (DG.SB_SNODE n, ksf) = snode (n, ksf)
61 : blume 301 in
62 : blume 569 foldl sbnode (empty, StableSet.empty) export_nodes
63 : blume 301 end
64 :    
65 : blume 652 fun force f = f ()
66 :    
67 : blume 569 fun snodeMap' (exports: DG.impexp SymbolMap.map, acc) = let
68 : blume 537 fun add (m, i, x) = SrcPathMap.insert (m, SmlInfo.sourcepath i, x)
69 :     fun member (m, i) = SrcPathMap.inDomain (m, SmlInfo.sourcepath i)
70 :     in
71 : blume 569 #1 (reach { add = add, member = member, empty = acc }
72 : blume 652 (map (#2 o force o #1) (SymbolMap.listItems exports)))
73 : blume 537 end
74 : blume 448 in
75 :     val reachable' =
76 : blume 537 reach { add = fn (s, i, _) => SmlInfoSet.add (s, i),
77 :     member = SmlInfoSet.member,
78 :     empty = SmlInfoSet.empty }
79 : blume 301
80 : blume 569 fun reachable (GG.GROUP { exports, ... }) =
81 : blume 652 reachable' (map (#2 o force o #1)
82 :     (SymbolMap.listItems exports))
83 : blume 587 | reachable GG.ERRORGROUP = (SmlInfoSet.empty, StableSet.empty)
84 : blume 301
85 : blume 451 fun snodeMap g = let
86 : blume 587 fun snm (GG.ERRORGROUP, x) = x
87 :     | snm (g as GG.GROUP grec, (a, seen)) = let
88 :     val { exports, sublibs, grouppath, ... } = grec
89 :     in
90 :     if SrcPathSet.member (seen, grouppath) then (a, seen)
91 : blume 666 else foldl (fn ((_, g, _), x) => snm (g (), x))
92 : blume 587 (snodeMap' (exports, a),
93 :     SrcPathSet.add (seen, grouppath))
94 :     sublibs
95 :     end
96 : blume 451 in
97 :     #1 (snm (g, (SrcPathMap.empty, SrcPathSet.empty)))
98 :     end
99 : blume 492
100 :     fun groupsOf g = let
101 : blume 573 fun subgroups (GG.GROUP { kind = GG.NOLIB x, ... }) = #subgroups x
102 : blume 632 | subgroups (GG.GROUP { kind = GG.LIB { kind = GG.DEVELOPED x,
103 :     ... },
104 :     ... }) = #subgroups x
105 : blume 537 | subgroups _ = []
106 : blume 587 fun go (GG.ERRORGROUP, a) = a
107 :     | go (g as GG.GROUP { grouppath, ... }, a) = let
108 :     val sgl = subgroups g
109 : blume 666 fun sl ((p, gth, _), a) =
110 : blume 652 case gth () of
111 :     g as GG.GROUP { kind = GG.NOLIB _, ... } =>
112 :     if SrcPathSet.member (a, p) then a else go (g, a)
113 :     | _ => a
114 : blume 587 in
115 :     SrcPathSet.add (foldl sl a sgl, grouppath)
116 :     end
117 : blume 492 in
118 :     go (g, SrcPathSet.empty)
119 :     end
120 : blume 537
121 : blume 587 fun stableLibsOf GG.ERRORGROUP = SrcPathMap.empty
122 :     | stableLibsOf (g as GG.GROUP { grouppath, ... }) = let
123 : blume 652 fun slo' ((_, GG.ERRORGROUP), x) = x
124 :     | slo' ((p, g as GG.GROUP grec), (seen, res)) = let
125 : blume 587 val { kind, sublibs, ... } = grec
126 :     in
127 :     if SrcPathSet.member (seen, p) then (seen, res)
128 :     else
129 :     let
130 :     val (seen, res) = foldl slo (seen, res) sublibs
131 :     val seen = SrcPathSet.add (seen, p)
132 :     in
133 :     case kind of
134 : blume 632 GG.LIB { kind = GG.STABLE _, ... } =>
135 : blume 587 (seen, SrcPathMap.insert (res, p, g))
136 :     | _ => (seen, res)
137 :     end
138 :     end
139 : blume 666 and slo ((p, gth, _), x) = slo' ((p, gth ()), x)
140 : blume 537 in
141 : blume 652 #2 (slo' ((grouppath, g),
142 :     (SrcPathSet.empty, SrcPathMap.empty)))
143 : blume 537 end
144 :    
145 : blume 587 fun frontier _ GG.ERRORGROUP = StableSet.empty
146 :     | frontier inSet (GG.GROUP { exports, ... }) = let
147 : blume 537 fun bnode (DG.BNODE n, (seen, f)) = let
148 :     val i = #bininfo n
149 :     val li = #localimports n
150 :     in
151 :     if StableSet.member (seen, i) then (seen, f)
152 :     else let
153 :     val seen = StableSet.add (seen, i)
154 :     in
155 :     if inSet i then (seen, StableSet.add (f, i))
156 :     else foldl bnode (seen, f) li
157 :     end
158 :     end
159 : blume 652 fun get_bn ((nth, _, _), bnl) =
160 :     case nth () of
161 : blume 737 (_, DG.SB_BNODE (n, _, _)) => n :: bnl
162 : blume 652 | _ => bnl
163 : blume 537 val bnl = SymbolMap.foldl get_bn [] exports
164 :     in
165 :     #2 (foldl bnode (StableSet.empty, StableSet.empty) bnl)
166 :     end
167 : blume 301 end
168 :     end

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