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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 573, Thu Mar 9 15:23:52 2000 UTC revision 587, Thu Mar 30 09:01:52 2000 UTC
# Line 77  Line 77 
77    
78          fun reachable (GG.GROUP { exports, ... }) =          fun reachable (GG.GROUP { exports, ... }) =
79                        reachable' (map (#2 o #1) (SymbolMap.listItems exports))                        reachable' (map (#2 o #1) (SymbolMap.listItems exports))
80              | reachable GG.ERRORGROUP = (SmlInfoSet.empty, StableSet.empty)
81    
82          fun snodeMap g = let          fun snodeMap g = let
83              fun snm (g, (a, seen)) = let              fun snm (GG.ERRORGROUP, x) = x
84                  val GG.GROUP { exports, sublibs, grouppath, ... } = g                | snm (g as GG.GROUP grec, (a, seen)) = let
85                        val { exports, sublibs, grouppath, ... } = grec
86              in              in
87                  if SrcPathSet.member (seen, grouppath) then (a, seen)                  if SrcPathSet.member (seen, grouppath) then (a, seen)
88                  else foldl (fn ((_, g), x) => snm (g, x))                  else foldl (fn ((_, g), x) => snm (g, x))
# Line 96  Line 98 
98              fun subgroups (GG.GROUP { kind = GG.NOLIB x, ... }) = #subgroups x              fun subgroups (GG.GROUP { kind = GG.NOLIB x, ... }) = #subgroups x
99                | subgroups (GG.GROUP { kind = GG.LIB x, ... }) = #subgroups x                | subgroups (GG.GROUP { kind = GG.LIB x, ... }) = #subgroups x
100                | subgroups _ = []                | subgroups _ = []
101              fun go (g as GG.GROUP { grouppath, ... }, a) = let              fun go (GG.ERRORGROUP, a) = a
102                  | go (g as GG.GROUP { grouppath, ... }, a) = let
103                  val sgl = subgroups g                  val sgl = subgroups g
104                  fun sl ((p, g as GG.GROUP { kind = GG.NOLIB _, ... }), a) =                  fun sl ((p, g as GG.GROUP { kind = GG.NOLIB _, ... }), a) =
105                      if SrcPathSet.member (a, p) then a else go (g, a)                      if SrcPathSet.member (a, p) then a else go (g, a)
# Line 108  Line 111 
111              go (g, SrcPathSet.empty)              go (g, SrcPathSet.empty)
112          end          end
113    
114          fun stableLibsOf (g as GG.GROUP { grouppath, ... }) = let          fun stableLibsOf GG.ERRORGROUP = SrcPathMap.empty
115              fun slo ((p, g), (seen, res)) = let            | stableLibsOf (g as GG.GROUP { grouppath, ... }) = let
116                  val GG.GROUP { kind, sublibs, ... } = g                  fun slo ((_, GG.ERRORGROUP), x) = x
117                      | slo ((p, g as GG.GROUP grec), (seen, res)) = let
118                            val { kind, sublibs, ... } = grec
119              in              in
120                  if SrcPathSet.member (seen, p) then (seen, res)                  if SrcPathSet.member (seen, p) then (seen, res)
121                  else let                          else
122                                let
123                      val (seen, res) = foldl slo (seen, res) sublibs                      val (seen, res) = foldl slo (seen, res) sublibs
124                      val seen = SrcPathSet.add (seen, p)                      val seen = SrcPathSet.add (seen, p)
125                  in                  in
126                      case kind of                      case kind of
127                          GG.STABLELIB _ => (seen, SrcPathMap.insert (res, p, g))                                      GG.STABLELIB _ =>
128                                        (seen, SrcPathMap.insert (res, p, g))
129                        | _ => (seen, res)                        | _ => (seen, res)
130                  end                  end
131              end              end
# Line 126  Line 133 
133              #2 (slo ((grouppath, g), (SrcPathSet.empty, SrcPathMap.empty)))              #2 (slo ((grouppath, g), (SrcPathSet.empty, SrcPathMap.empty)))
134          end          end
135    
136          fun frontier inSet (GG.GROUP { exports, ... }) = let          fun frontier _ GG.ERRORGROUP = StableSet.empty
137              | frontier inSet (GG.GROUP { exports, ... }) = let
138              fun bnode (DG.BNODE n, (seen, f)) = let              fun bnode (DG.BNODE n, (seen, f)) = let
139                  val i = #bininfo n                  val i = #bininfo n
140                  val li = #localimports n                  val li = #localimports n

Legend:
Removed from v.573  
changed lines
  Added in v.587

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