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 651, Thu Jun 1 18:34:03 2000 UTC revision 652, Tue Jun 6 02:14:56 2000 UTC
# Line 62  Line 62 
62              foldl sbnode (empty, StableSet.empty) export_nodes              foldl sbnode (empty, StableSet.empty) export_nodes
63          end          end
64    
65            fun force f = f ()
66    
67          fun snodeMap' (exports: DG.impexp SymbolMap.map, acc) = let          fun snodeMap' (exports: DG.impexp SymbolMap.map, acc) = let
68              fun add (m, i, x) = SrcPathMap.insert (m, SmlInfo.sourcepath i, x)              fun add (m, i, x) = SrcPathMap.insert (m, SmlInfo.sourcepath i, x)
69              fun member (m, i) = SrcPathMap.inDomain (m, SmlInfo.sourcepath i)              fun member (m, i) = SrcPathMap.inDomain (m, SmlInfo.sourcepath i)
70          in          in
71              #1 (reach { add = add, member = member, empty = acc }              #1 (reach { add = add, member = member, empty = acc }
72                        (map (#2 o #1) (SymbolMap.listItems exports)))                        (map (#2 o force o #1) (SymbolMap.listItems exports)))
73          end          end
74      in      in
75          val reachable' =          val reachable' =
# Line 76  Line 78 
78                      empty = SmlInfoSet.empty }                      empty = SmlInfoSet.empty }
79    
80          fun reachable (GG.GROUP { exports, ... }) =          fun reachable (GG.GROUP { exports, ... }) =
81                        reachable' (map (#2 o #1) (SymbolMap.listItems exports))                        reachable' (map (#2 o force o #1)
82                                          (SymbolMap.listItems exports))
83            | reachable GG.ERRORGROUP = (SmlInfoSet.empty, StableSet.empty)            | reachable GG.ERRORGROUP = (SmlInfoSet.empty, StableSet.empty)
84    
85          fun snodeMap g = let          fun snodeMap g = let
# Line 85  Line 88 
88                      val { exports, sublibs, grouppath, ... } = grec                      val { exports, sublibs, grouppath, ... } = grec
89                  in                  in
90                      if SrcPathSet.member (seen, grouppath) then (a, seen)                      if SrcPathSet.member (seen, grouppath) then (a, seen)
91                      else foldl (fn ((_, g), x) => snm (g, x))                      else foldl (fn ((_, g), x) => snm (g (), x))
92                                 (snodeMap' (exports, a),                                 (snodeMap' (exports, a),
93                                  SrcPathSet.add (seen, grouppath))                                  SrcPathSet.add (seen, grouppath))
94                                 sublibs                                 sublibs
# Line 103  Line 106 
106              fun go (GG.ERRORGROUP, a) = a              fun go (GG.ERRORGROUP, a) = a
107                | go (g as GG.GROUP { grouppath, ... }, a) = let                | go (g as GG.GROUP { grouppath, ... }, a) = let
108                      val sgl = subgroups g                      val sgl = subgroups g
109                      fun sl ((p, g as GG.GROUP { kind = GG.NOLIB _, ... }), a) =                      fun sl ((p, gth), a) =
110                            case gth () of
111                                g as GG.GROUP { kind = GG.NOLIB _, ... } =>
112                          if SrcPathSet.member (a, p) then a else go (g, a)                          if SrcPathSet.member (a, p) then a else go (g, a)
113                        | sl (_, a) = a                            | _ => a
114                  in                  in
115                      SrcPathSet.add (foldl sl a sgl, grouppath)                      SrcPathSet.add (foldl sl a sgl, grouppath)
116                  end                  end
# Line 115  Line 120 
120    
121          fun stableLibsOf GG.ERRORGROUP = SrcPathMap.empty          fun stableLibsOf GG.ERRORGROUP = SrcPathMap.empty
122            | stableLibsOf (g as GG.GROUP { grouppath, ... }) = let            | stableLibsOf (g as GG.GROUP { grouppath, ... }) = let
123                  fun slo ((_, GG.ERRORGROUP), x) = x                  fun slo' ((_, GG.ERRORGROUP), x) = x
124                    | slo ((p, g as GG.GROUP grec), (seen, res)) = let                    | slo' ((p, g as GG.GROUP grec), (seen, res)) = let
125                          val { kind, sublibs, ... } = grec                          val { kind, sublibs, ... } = grec
126                      in                      in
127                          if SrcPathSet.member (seen, p) then (seen, res)                          if SrcPathSet.member (seen, p) then (seen, res)
# Line 131  Line 136 
136                                    | _ => (seen, res)                                    | _ => (seen, res)
137                              end                              end
138                      end                      end
139                    and slo ((p, gth), x) = slo' ((p, gth ()), x)
140              in              in
141                  #2 (slo ((grouppath, g), (SrcPathSet.empty, SrcPathMap.empty)))                  #2 (slo' ((grouppath, g),
142                              (SrcPathSet.empty, SrcPathMap.empty)))
143              end              end
144    
145          fun frontier _ GG.ERRORGROUP = StableSet.empty          fun frontier _ GG.ERRORGROUP = StableSet.empty
# Line 149  Line 156 
156                      else foldl bnode (seen, f) li                      else foldl bnode (seen, f) li
157                  end                  end
158              end              end
159              fun get_bn (((_, DG.SB_BNODE (n, _)), _), bnl) = n :: bnl              fun get_bn ((nth, _, _), bnl) =
160                | get_bn (_, bnl) = bnl                  case nth () of
161                        (_, DG.SB_BNODE (n, _)) => n :: bnl
162                      | _ => bnl
163              val bnl = SymbolMap.foldl get_bn [] exports              val bnl = SymbolMap.foldl get_bn [] exports
164          in          in
165              #2 (foldl bnode (StableSet.empty, StableSet.empty) bnl)              #2 (foldl bnode (StableSet.empty, StableSet.empty) bnl)

Legend:
Removed from v.651  
changed lines
  Added in v.652

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