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 632 - (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 569 and sbnode (DG.SB_BNODE (DG.BNODE n, _), (known, stabfringe)) =
59 :     (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 569 fun snodeMap' (exports: DG.impexp SymbolMap.map, acc) = let
66 : blume 537 fun add (m, i, x) = SrcPathMap.insert (m, SmlInfo.sourcepath i, x)
67 :     fun member (m, i) = SrcPathMap.inDomain (m, SmlInfo.sourcepath i)
68 :     in
69 : blume 569 #1 (reach { add = add, member = member, empty = acc }
70 :     (map (#2 o #1) (SymbolMap.listItems exports)))
71 : blume 537 end
72 : blume 448 in
73 :     val reachable' =
74 : blume 537 reach { add = fn (s, i, _) => SmlInfoSet.add (s, i),
75 :     member = SmlInfoSet.member,
76 :     empty = SmlInfoSet.empty }
77 : blume 301
78 : blume 569 fun reachable (GG.GROUP { exports, ... }) =
79 :     reachable' (map (#2 o #1) (SymbolMap.listItems exports))
80 : blume 587 | reachable GG.ERRORGROUP = (SmlInfoSet.empty, StableSet.empty)
81 : blume 301
82 : blume 451 fun snodeMap g = let
83 : blume 587 fun snm (GG.ERRORGROUP, x) = x
84 :     | snm (g as GG.GROUP grec, (a, seen)) = let
85 :     val { exports, sublibs, grouppath, ... } = grec
86 :     in
87 :     if SrcPathSet.member (seen, grouppath) then (a, seen)
88 :     else foldl (fn ((_, g), x) => snm (g, x))
89 :     (snodeMap' (exports, a),
90 :     SrcPathSet.add (seen, grouppath))
91 :     sublibs
92 :     end
93 : blume 451 in
94 :     #1 (snm (g, (SrcPathMap.empty, SrcPathSet.empty)))
95 :     end
96 : blume 492
97 :     fun groupsOf g = let
98 : blume 573 fun subgroups (GG.GROUP { kind = GG.NOLIB x, ... }) = #subgroups x
99 : blume 632 | subgroups (GG.GROUP { kind = GG.LIB { kind = GG.DEVELOPED x,
100 :     ... },
101 :     ... }) = #subgroups x
102 : blume 537 | subgroups _ = []
103 : blume 587 fun go (GG.ERRORGROUP, a) = a
104 :     | go (g as GG.GROUP { grouppath, ... }, a) = let
105 :     val sgl = subgroups g
106 :     fun sl ((p, g as GG.GROUP { kind = GG.NOLIB _, ... }), a) =
107 :     if SrcPathSet.member (a, p) then a else go (g, a)
108 :     | sl (_, a) = a
109 :     in
110 :     SrcPathSet.add (foldl sl a sgl, grouppath)
111 :     end
112 : blume 492 in
113 :     go (g, SrcPathSet.empty)
114 :     end
115 : blume 537
116 : blume 587 fun stableLibsOf GG.ERRORGROUP = SrcPathMap.empty
117 :     | stableLibsOf (g as GG.GROUP { grouppath, ... }) = let
118 :     fun slo ((_, GG.ERRORGROUP), x) = x
119 :     | slo ((p, g as GG.GROUP grec), (seen, res)) = let
120 :     val { kind, sublibs, ... } = grec
121 :     in
122 :     if SrcPathSet.member (seen, p) then (seen, res)
123 :     else
124 :     let
125 :     val (seen, res) = foldl slo (seen, res) sublibs
126 :     val seen = SrcPathSet.add (seen, p)
127 :     in
128 :     case kind of
129 : blume 632 GG.LIB { kind = GG.STABLE _, ... } =>
130 : blume 587 (seen, SrcPathMap.insert (res, p, g))
131 :     | _ => (seen, res)
132 :     end
133 :     end
134 : blume 537 in
135 : blume 587 #2 (slo ((grouppath, g), (SrcPathSet.empty, SrcPathMap.empty)))
136 : blume 537 end
137 :    
138 : blume 587 fun frontier _ GG.ERRORGROUP = StableSet.empty
139 :     | frontier inSet (GG.GROUP { exports, ... }) = let
140 : blume 537 fun bnode (DG.BNODE n, (seen, f)) = let
141 :     val i = #bininfo n
142 :     val li = #localimports n
143 :     in
144 :     if StableSet.member (seen, i) then (seen, f)
145 :     else let
146 :     val seen = StableSet.add (seen, i)
147 :     in
148 :     if inSet i then (seen, StableSet.add (f, i))
149 :     else foldl bnode (seen, f) li
150 :     end
151 :     end
152 :     fun get_bn (((_, DG.SB_BNODE (n, _)), _), bnl) = n :: bnl
153 :     | get_bn (_, bnl) = bnl
154 :     val bnl = SymbolMap.foldl get_bn [] exports
155 :     in
156 :     #2 (foldl bnode (StableSet.empty, StableSet.empty) bnl)
157 :     end
158 : blume 301 end
159 :     end

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