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/parse/parse.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/parse/parse.sml

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

revision 568, Tue Mar 7 03:59:09 2000 UTC revision 569, Tue Mar 7 04:01:07 2000 UTC
# Line 24  Line 24 
24                   val evictStale : unit -> unit                   val evictStale : unit -> unit
25                   structure Stabilize: STABILIZE) :> PARSE = struct                   structure Stabilize: STABILIZE) :> PARSE = struct
26    
27        structure VerifyStable = VerStabFn (structure Stabilize = Stabilize)
28    
29      val lookAhead = 30      val lookAhead = 30
30    
31      structure S = GenericVC.Source      structure S = GenericVC.Source
32      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
33      structure SM = GenericVC.SourceMap      structure SM = GenericVC.SourceMap
34      structure GG = GroupGraph      structure GG = GroupGraph
35        structure DG = DependencyGraph
36    
37      structure CMLrVals = CMLrValsFun (structure Token = LrParser.Token)      structure CMLrVals = CMLrValsFun (structure Token = LrParser.Token)
38      structure CMLex = CMLexFun (structure Tokens = CMLrVals.Tokens)      structure CMLex = CMLexFun (structure Tokens = CMLrVals.Tokens)
# Line 42  Line 45 
45      val sgc = ref (SrcPathMap.empty: CMSemant.group SrcPathMap.map)      val sgc = ref (SrcPathMap.empty: CMSemant.group SrcPathMap.map)
46      fun reset () = sgc := SrcPathMap.empty      fun reset () = sgc := SrcPathMap.empty
47    
48      fun registerNewStable (p, g) =      fun majorGC () = SMLofNJ.Internals.GC.doGC 7
49          (sgc := SrcPathMap.insert (!sgc, p, g);  
          SrcPathSet.app (SmlInfo.cleanGroup true) (Reachable.groupsOf g);  
          evictStale ())  
50      fun cachedStable (p, ig as GG.GROUP { grouppath, ... }) =      fun cachedStable (p, ig as GG.GROUP { grouppath, ... }) =
51          if SrcPath.compare (p, grouppath) = EQUAL then SOME ig          if SrcPath.compare (p, grouppath) = EQUAL then SOME ig
52          else SrcPathMap.find (!sgc, p)          else SrcPathMap.find (!sgc, p)
# Line 64  Line 65 
65          handle LibBase.NotFound => ()          handle LibBase.NotFound => ()
66    
67      fun parse args = let      fun parse args = let
68          val { load_plugin, gr, param, stabflag, group, init_group, paranoid } =          val { load_plugin, gr, param, stabflag, group,
69              args                init_group, paranoid } = args
70    
71          val GroupGraph.GROUP { grouppath = init_gname, ... } = init_group          val GroupGraph.GROUP { grouppath = init_gname, ... } = init_group
72    
# Line 83  Line 84 
84           * "special" and cannot be parsed directly. *)           * "special" and cannot be parsed directly. *)
85          val gc = ref (SrcPathMap.singleton (init_gname, SOME init_group))          val gc = ref (SrcPathMap.singleton (init_gname, SOME init_group))
86    
87            val em = ref StableMap.empty
88    
89            fun update_em (GG.GROUP ns_g, GG.GROUP s_g) = let
90                val s_e = #exports s_g
91                fun add (sy, ((_ , DG.SB_SNODE (DG.SNODE sn)), _)) =
92                    (case SymbolMap.find (s_e, sy) of
93                         SOME ((_, DG.SB_BNODE (DG.BNODE bn, _)), _) =>
94                             em := StableMap.insert (!em, #bininfo bn, #smlinfo sn)
95                       | _ => ())
96                  | add _ = ()
97            in SymbolMap.appi add (#exports ns_g)
98            end
99    
100            fun registerNewStable (p, g) =
101                (sgc := SrcPathMap.insert (!sgc, p, g);
102                 SrcPathSet.app (SmlInfo.cleanGroup true) (Reachable.groupsOf g);
103                 evictStale ();
104                 (gc := #1 (SrcPathMap.remove (!gc, p));
105                  (* ... and for good measure, do a major GC... *)
106                  majorGC ())
107                 handle LibBase.NotFound => ())
108    
109          fun hasCycle (group, groupstack) = let          fun hasCycle (group, groupstack) = let
110              (* checking for cycles among groups and printing them nicely *)              (* checking for cycles among groups and printing them nicely *)
111              fun findCycle ([], _) = []              fun findCycle ([], _) = []
# Line 174  Line 197 
197                       in                       in
198                           case go of                           case go of
199                               NONE => NONE                               NONE => NONE
200                             | SOME g => (registerNewStable (group, g); SOME g)                             | SOME g' =>
201                                     (registerNewStable (group, g'); SOME g')
202                       end                       end
203                     | _ => SOME g)                     | _ => SOME g)
204          in          in
# Line 192  Line 216 
216                      if paranoid then                      if paranoid then
217                          case try_n () of                          case try_n () of
218                              NONE => reg NONE                              NONE => reg NONE
219                            | SOME g =>                            | SOME g => let
220                                  if VerifyStable.verify ginfo g then                                  val gopt' =
221                                        if VerifyStable.verify ginfo (!em) g then
222                                      reg (case try_s () of                                      reg (case try_s () of
223                                               NONE => SOME g                                               NONE => SOME g
224                                             | SOME g' => SOME g')                                             | SOME g' => SOME g')
225                                  else proc_n (SOME g)                                  else proc_n (SOME g)
226                                in
227                                    case gopt' of
228                                        NONE => NONE
229                                      | SOME g' => (update_em (g, g'); SOME g')
230                                end
231                      else case try_s () of                      else case try_s () of
232                          SOME g => reg (SOME g)                          SOME g => reg (SOME g)
233                        | NONE => proc_n (try_n ())                        | NONE => proc_n (try_n ())

Legend:
Removed from v.568  
changed lines
  Added in v.569

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