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 451 - (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 362 val reachable' : DependencyGraph.impexp SymbolMap.map -> SrcPathSet.set
10 : blume 354 val reachable : GroupGraph.group -> SrcPathSet.set
11 : blume 448 val snodeMap : GroupGraph.group -> DependencyGraph.snode SrcPathMap.map
12 : blume 301 end
13 :    
14 :     structure Reachable :> REACHABLE = struct
15 :     structure DG = DependencyGraph
16 :    
17 : blume 448 local
18 :     fun reach ops (exports: DG.impexp SymbolMap.map) = let
19 :     val { add, member, empty } = ops
20 :     fun snode (x as DG.SNODE n, known) = let
21 :     val { smlinfo, localimports = l, globalimports = g } = n
22 :     val p = SmlInfo.sourcepath smlinfo
23 :     in
24 :     if member (known, p) then known
25 :     else foldl farsbnode (foldl snode (add (known, p, x)) l) g
26 :     end
27 :    
28 :     and farsbnode ((_, n), known) = sbnode (n, known)
29 :    
30 :     and sbnode (DG.SB_BNODE _, known) = known
31 :     | sbnode (DG.SB_SNODE n, known) = snode (n, known)
32 :    
33 :     fun impexp ((n, _), known) = farsbnode (n, known)
34 : blume 301 in
35 : blume 448 SymbolMap.foldl impexp empty exports
36 : blume 301 end
37 :    
38 : blume 451 fun snodeMap' (exports, acc) =
39 : blume 448 reach { add = SrcPathMap.insert,
40 :     member = SrcPathMap.inDomain,
41 : blume 451 empty = acc } exports
42 : blume 448 in
43 :     val reachable' =
44 :     reach { add = fn (s, x, _) => SrcPathSet.add (s, x),
45 :     member = SrcPathSet.member,
46 :     empty = SrcPathSet.empty }
47 : blume 301
48 : blume 448 fun reachable (GroupGraph.GROUP { exports, ... }) = reachable' exports
49 : blume 301
50 : blume 451 fun snodeMap g = let
51 :     fun snm (g, (a, seen)) = let
52 :     val GroupGraph.GROUP { exports, sublibs, grouppath, ... } = g
53 :     in
54 :     if SrcPathSet.member (seen, grouppath) then (a, seen)
55 :     else foldl (fn ((_, g), x) => snm (g, x))
56 :     (snodeMap' (exports, a),
57 :     SrcPathSet.add (seen, grouppath))
58 :     sublibs
59 :     end
60 :     in
61 :     #1 (snm (g, (SrcPathMap.empty, SrcPathSet.empty)))
62 :     end
63 : blume 301 end
64 :     end

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