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 569 - (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 301
81 : blume 451 fun snodeMap g = let
82 :     fun snm (g, (a, seen)) = let
83 : blume 492 val GG.GROUP { exports, sublibs, grouppath, ... } = g
84 : blume 451 in
85 :     if SrcPathSet.member (seen, grouppath) then (a, seen)
86 :     else foldl (fn ((_, g), x) => snm (g, x))
87 :     (snodeMap' (exports, a),
88 :     SrcPathSet.add (seen, grouppath))
89 :     sublibs
90 :     end
91 :     in
92 :     #1 (snm (g, (SrcPathMap.empty, SrcPathSet.empty)))
93 :     end
94 : blume 492
95 :     fun groupsOf g = let
96 : blume 537 fun subgroups (GG.GROUP { kind = GG.NOLIB sg, ... }) = sg
97 :     | subgroups (GG.GROUP { kind = GG.LIB (_, sg), ... }) = sg
98 :     | subgroups _ = []
99 :     fun go (g as GG.GROUP { grouppath, ... }, a) = let
100 :     val sgl = subgroups g
101 :     fun sl ((p, g as GG.GROUP { kind = GG.NOLIB _, ... }), a) =
102 : blume 492 if SrcPathSet.member (a, p) then a else go (g, a)
103 :     | sl (_, a) = a
104 :     in
105 : blume 537 SrcPathSet.add (foldl sl a sgl, grouppath)
106 : blume 492 end
107 :     in
108 :     go (g, SrcPathSet.empty)
109 :     end
110 : blume 537
111 :     fun stableLibsOf (g as GG.GROUP { grouppath, ... }) = let
112 :     fun slo ((p, g), (seen, res)) = let
113 :     val GG.GROUP { kind, sublibs, ... } = g
114 :     in
115 :     if SrcPathSet.member (seen, p) then (seen, res)
116 :     else let
117 :     val (seen, res) = foldl slo (seen, res) sublibs
118 :     val seen = SrcPathSet.add (seen, p)
119 :     in
120 :     case kind of
121 :     GG.STABLELIB _ => (seen, SrcPathMap.insert (res, p, g))
122 :     | _ => (seen, res)
123 :     end
124 :     end
125 :     in
126 :     #2 (slo ((grouppath, g), (SrcPathSet.empty, SrcPathMap.empty)))
127 :     end
128 :    
129 :     fun frontier inSet (GG.GROUP { exports, ... }) = let
130 :     fun bnode (DG.BNODE n, (seen, f)) = let
131 :     val i = #bininfo n
132 :     val li = #localimports n
133 :     in
134 :     if StableSet.member (seen, i) then (seen, f)
135 :     else let
136 :     val seen = StableSet.add (seen, i)
137 :     in
138 :     if inSet i then (seen, StableSet.add (f, i))
139 :     else foldl bnode (seen, f) li
140 :     end
141 :     end
142 :     fun get_bn (((_, DG.SB_BNODE (n, _)), _), bnl) = n :: bnl
143 :     | get_bn (_, bnl) = bnl
144 :     val bnl = SymbolMap.foldl get_bn [] exports
145 :     in
146 :     #2 (foldl bnode (StableSet.empty, StableSet.empty) bnl)
147 :     end
148 : blume 301 end
149 :     end

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