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 537 - (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 :     * 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 : blume 448 val snodeMap : GroupGraph.group -> DependencyGraph.snode SrcPathMap.map
18 : blume 537
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 : blume 492 val groupsOf : GroupGraph.group -> SrcPathSet.set
23 : blume 537
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 : blume 301 end
37 :    
38 :     structure Reachable :> REACHABLE = struct
39 :     structure DG = DependencyGraph
40 : blume 492 structure GG = GroupGraph
41 : blume 301
42 : blume 448 local
43 :     fun reach ops (exports: DG.impexp SymbolMap.map) = let
44 :     val { add, member, empty } = ops
45 :     fun snode (x as DG.SNODE n, known) = let
46 : blume 537 val { smlinfo = i, localimports = l, globalimports = g } = n
47 : blume 448 in
48 : blume 537 if member (known, i) then known
49 :     else foldl farsbnode (foldl snode (add (known, i, x)) l) g
50 : blume 448 end
51 :    
52 :     and farsbnode ((_, n), known) = sbnode (n, known)
53 :    
54 :     and sbnode (DG.SB_BNODE _, known) = known
55 :     | sbnode (DG.SB_SNODE n, known) = snode (n, known)
56 :    
57 :     fun impexp ((n, _), known) = farsbnode (n, known)
58 : blume 301 in
59 : blume 448 SymbolMap.foldl impexp empty exports
60 : blume 301 end
61 :    
62 : blume 537 fun snodeMap' (exports, acc) = let
63 :     fun add (m, i, x) = SrcPathMap.insert (m, SmlInfo.sourcepath i, x)
64 :     fun member (m, i) = SrcPathMap.inDomain (m, SmlInfo.sourcepath i)
65 :     in
66 :     reach { add = add, member = member, empty = acc } exports
67 :     end
68 : blume 448 in
69 :     val reachable' =
70 : blume 537 reach { add = fn (s, i, _) => SmlInfoSet.add (s, i),
71 :     member = SmlInfoSet.member,
72 :     empty = SmlInfoSet.empty }
73 : blume 301
74 : blume 492 fun reachable (GG.GROUP { exports, ... }) = reachable' exports
75 : blume 301
76 : blume 451 fun snodeMap g = let
77 :     fun snm (g, (a, seen)) = let
78 : blume 492 val GG.GROUP { exports, sublibs, grouppath, ... } = g
79 : blume 451 in
80 :     if SrcPathSet.member (seen, grouppath) then (a, seen)
81 :     else foldl (fn ((_, g), x) => snm (g, x))
82 :     (snodeMap' (exports, a),
83 :     SrcPathSet.add (seen, grouppath))
84 :     sublibs
85 :     end
86 :     in
87 :     #1 (snm (g, (SrcPathMap.empty, SrcPathSet.empty)))
88 :     end
89 : blume 492
90 :     fun groupsOf g = let
91 : blume 537 fun subgroups (GG.GROUP { kind = GG.NOLIB sg, ... }) = sg
92 :     | 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 : blume 492 if SrcPathSet.member (a, p) then a else go (g, a)
98 :     | sl (_, a) = a
99 :     in
100 : blume 537 SrcPathSet.add (foldl sl a sgl, grouppath)
101 : blume 492 end
102 :     in
103 :     go (g, SrcPathSet.empty)
104 :     end
105 : blume 537
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 : blume 301 end
144 :     end

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