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 578, Tue Mar 14 05:16:29 2000 UTC revision 587, Thu Mar 30 09:01:52 2000 UTC
# Line 50  Line 50 
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)
53          | cachedStable (_, GG.ERRORGROUP) = NONE
54    
55      (* When an entry A vanishes from the stable cache (this only happens in      (* When an entry A vanishes from the stable cache (this only happens in
56       * paranoid mode), then all the other ones that refer to A must       * paranoid mode), then all the other ones that refer to A must
# Line 57  Line 58 
58       * had been unpickled before A became invalid they will point to       * had been unpickled before A became invalid they will point to
59       * invalid data.  By removing them from the cache we force them to       * invalid data.  By removing them from the cache we force them to
60       * be re-read and re-unpickled.  This restores sanity. *)       * be re-read and re-unpickled.  This restores sanity. *)
61      fun delCachedStable (p, GG.GROUP { grouppath = igp, ... }) = let      fun delCachedStable (p, GG.GROUP { grouppath = igp, ... }) =
62          val changed = ref true          let val changed = ref true
63          fun canStay (GG.GROUP { sublibs, ... }) = let              fun canStay GG.ERRORGROUP = true (* doesn't matter *)
64                  | canStay (GG.GROUP { sublibs, ... }) = let
65              fun goodSublib (p, GG.GROUP { kind = GG.STABLELIB _, ... }) =              fun goodSublib (p, GG.GROUP { kind = GG.STABLELIB _, ... }) =
66                  SrcPath.compare (p, igp) = EQUAL orelse                  SrcPath.compare (p, igp) = EQUAL orelse
67                  SrcPathMap.inDomain (!sgc, p)                  SrcPathMap.inDomain (!sgc, p)
# Line 69  Line 71 
71              if cs then () else changed := true;              if cs then () else changed := true;
72              cs              cs
73          end          end
   
74      in      in
75          (sgc := #1 (SrcPathMap.remove (!sgc, p)))          (sgc := #1 (SrcPathMap.remove (!sgc, p)))
76               handle LibBase.NotFound => ();               handle LibBase.NotFound => ();
77          while !changed do          while !changed do
78               (changed := false; sgc := SrcPathMap.filter canStay (!sgc))               (changed := false; sgc := SrcPathMap.filter canStay (!sgc))
79      end      end
80          | delCachedStable (_, GG.ERRORGROUP) = ()
81    
82      fun listLibs () = map #1 (SrcPathMap.listItemsi (!sgc))      fun listLibs () = map #1 (SrcPathMap.listItemsi (!sgc))
83    
# Line 94  Line 96 
96          val { load_plugin, gr, param, stabflag, group,          val { load_plugin, gr, param, stabflag, group,
97                init_group, paranoid } = args                init_group, paranoid } = args
98    
99          val GroupGraph.GROUP { grouppath = init_gname, ... } = init_group          val { grouppath = init_gname, ... } =
100                case init_group of
101                    GG.GROUP x => x
102                  | GG.ERRORGROUP =>
103                    EM.impossible "parse.sml: parse: bad init group"
104    
105          val stabthis = isSome stabflag          val stabthis = isSome stabflag
106          val staball = stabflag = SOME true          val staball = stabflag = SOME true
# Line 102  Line 108 
108          val groupreg = gr          val groupreg = gr
109          val errcons = EM.defaultConsumer ()          val errcons = EM.defaultConsumer ()
110          val ginfo = { param = param, groupreg = groupreg, errcons = errcons }          val ginfo = { param = param, groupreg = groupreg, errcons = errcons }
111            val keep_going = #keep_going param
112    
113          (* The "group cache" -- we store "group options";  having          (* The "group cache" -- we store "group options";  having
114           * NONE registered for a group means that a previous attempt           * NONE registered for a group means that a previous attempt
# Line 112  Line 119 
119    
120          val em = ref StableMap.empty          val em = ref StableMap.empty
121    
122          fun update_em (GG.GROUP ns_g, GG.GROUP s_g) = let          fun update_em (GG.GROUP ns_g, GG.GROUP s_g) =
123              val s_e = #exports s_g              let val s_e = #exports s_g
124              fun add (sy, ((_ , DG.SB_SNODE (DG.SNODE sn)), _)) =              fun add (sy, ((_ , DG.SB_SNODE (DG.SNODE sn)), _)) =
125                  (case SymbolMap.find (s_e, sy) of                  (case SymbolMap.find (s_e, sy) of
126                       SOME ((_, DG.SB_BNODE (DG.BNODE bn, _)), _) =>                       SOME ((_, DG.SB_BNODE (DG.BNODE bn, _)), _) =>
127                           em := StableMap.insert (!em, #bininfo bn, #smlinfo sn)                           em := StableMap.insert (!em, #bininfo bn, #smlinfo sn)
128                     | _ => ())                     | _ => ())
129                | add _ = ()                | add _ = ()
130          in SymbolMap.appi add (#exports ns_g)              in
131                    SymbolMap.appi add (#exports ns_g)
132          end          end
133              | update_em _ = ()
134    
135          fun registerNewStable (p, g) =          fun registerNewStable (p, g) =
136              (sgc := SrcPathMap.insert (!sgc, p, g);              (sgc := SrcPathMap.insert (!sgc, p, g);
# Line 217  Line 226 
226              fun stabilize NONE = NONE              fun stabilize NONE = NONE
227                | stabilize (SOME g) =                | stabilize (SOME g) =
228                  (case g of                  (case g of
229                       GG.GROUP { kind = GG.LIB _, ... } => let                       GG.ERRORGROUP => NONE
230                       | GG.GROUP { kind = GG.LIB _, ... } => let
231                           val go = Stabilize.stabilize ginfo                           val go = Stabilize.stabilize ginfo
232                               { group = g, anyerrors = pErrFlag }                               { group = g, anyerrors = pErrFlag }
233                       in                       in
# Line 296  Line 306 
306                       * "anyErrors" flag of the parent group. *)                       * "anyErrors" flag of the parent group. *)
307                      fun recParse (p1, p2) curlib p = let                      fun recParse (p1, p2) curlib p = let
308                          val gs' = (group, (source, p1, p2)) :: groupstack                          val gs' = (group, (source, p1, p2)) :: groupstack
309                          val myErrorFlag = #anyErrors source                          (* my error flag *)
310                            val mef = #anyErrors source
311                      in                      in
312                          case mparse (p, gs', myErrorFlag, staball, curlib) of                          (* unless we are in keep-going mode we do no further
313                              NONE => (myErrorFlag := true;                           * recursive traversals once there was an error on
314                                       CMSemant.emptyGroup group)                           * this group. *)
315                            if !mef andalso not keep_going then GG.ERRORGROUP
316                            else case mparse (p, gs', mef, staball, curlib) of
317                                     NONE => (mef := true; GG.ERRORGROUP)
318                            | SOME res => res                            | SOME res => res
319                      end                      end
320                      handle exn as IO.Io _ =>                      handle exn as IO.Io _ =>
321                          (error (p1, p2) (General.exnMessage exn);                          (error (p1, p2) (General.exnMessage exn);
322                           CMSemant.emptyGroup group)                           GG.ERRORGROUP)
323    
324                      fun doMember ({ name, mkpath }, p1, p2, c) =                      fun doMember ({ name, mkpath }, p1, p2, c, oto) =
325                          CMSemant.member (ginfo, recParse (p1, p2), load_plugin)                          CMSemant.member (ginfo, recParse (p1, p2), load_plugin)
326                            { name = name, mkpath = mkpath,                            { name = name, mkpath = mkpath,
327                              class = c, group = (group, (p1, p2)),                              class = c, tooloptions = oto,
328                                group = (group, (p1, p2)),
329                              context = context }                              context = context }
330    
331                      (* Build the argument for the lexer; the lexer's local                      (* Build the argument for the lexer; the lexer's local

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

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