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 536, Fri Feb 18 16:51:54 2000 UTC revision 537, Fri Feb 18 17:20:16 2000 UTC
# Line 6  Line 6 
6   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7   *)   *)
8  signature PARSE = sig  signature PARSE = sig
9      val parse :      val parse : { load_plugin: string -> bool,
10          (string -> bool) ->                    gr: GroupReg.groupreg,
11          GroupReg.groupreg option ->                    param: GeneralParams.param,
12          GeneralParams.param -> bool option ->                    stabflag: bool option,
13          SrcPath.t -> (CMSemant.group * GeneralParams.info) option                    group: SrcPath.t,
14                      init_group: CMSemant.group,
15                      paranoid: bool }
16            -> (CMSemant.group * GeneralParams.info) option
17      val reset : unit -> unit      val reset : unit -> unit
18      val listLibs : unit -> SrcPath.t list      val listLibs : unit -> SrcPath.t list
19      val dropPickles : unit -> unit      val dropPickles : unit -> unit
# Line 18  Line 21 
21  end  end
22    
23  functor ParseFn (val pending : unit -> DependencyGraph.impexp SymbolMap.map  functor ParseFn (val pending : unit -> DependencyGraph.impexp SymbolMap.map
24                     val evictStale : unit -> unit
25                   structure Stabilize: STABILIZE) :> PARSE = struct                   structure Stabilize: STABILIZE) :> PARSE = struct
26    
27      val lookAhead = 30      val lookAhead = 30
# Line 40  Line 44 
44    
45      fun registerNewStable (p, g) =      fun registerNewStable (p, g) =
46          (sgc := SrcPathMap.insert (!sgc, p, g);          (sgc := SrcPathMap.insert (!sgc, p, g);
47           SrcPathSet.app (SmlInfo.cleanGroup true) (Reachable.groupsOf g))           SrcPathSet.app (SmlInfo.cleanGroup true) (Reachable.groupsOf g);
48      fun cachedStable p = SrcPathMap.find (!sgc, p)           evictStale ())
49        fun cachedStable (p, ig as GG.GROUP { grouppath, ... }) =
50            if SrcPath.compare (p, grouppath) = EQUAL then SOME ig
51            else SrcPathMap.find (!sgc, p)
52    
53      fun listLibs () = map #1 (SrcPathMap.listItemsi (!sgc))      fun listLibs () = map #1 (SrcPathMap.listItemsi (!sgc))
54    
# Line 56  Line 63 
63          (sgc := #1 (SrcPathMap.remove (!sgc, l)))          (sgc := #1 (SrcPathMap.remove (!sgc, l)))
64          handle LibBase.NotFound => ()          handle LibBase.NotFound => ()
65    
66      fun parse load_plugin gropt param stabflag group = let      fun parse args = let
67            val { load_plugin, gr, param, stabflag, group, init_group, paranoid } =
68                args
69    
70            val GroupGraph.GROUP { grouppath = init_gname, ... } = init_group
71    
72          val stabthis = isSome stabflag          val stabthis = isSome stabflag
73          val staball = stabflag = SOME true          val staball = stabflag = SOME true
74    
75          val groupreg =          val groupreg = gr
             case gropt of  
                 SOME r => r  
               | NONE => GroupReg.new ()  
76          val errcons = EM.defaultConsumer ()          val errcons = EM.defaultConsumer ()
77          val ginfo = { param = param, groupreg = groupreg, errcons = errcons }          val ginfo = { param = param, groupreg = groupreg, errcons = errcons }
78    
79          (* The "group cache" -- we store "group options";  having          (* The "group cache" -- we store "group options";  having
80           * NONE registered for a group means that a previous attempt           * NONE registered for a group means that a previous attempt
81           * to parse it had failed. *)           * to parse it had failed.
82          val gc = ref (SrcPathMap.empty: CMSemant.group option SrcPathMap.map)           * This registry is primed with the "init" group because it is
83             * "special" and cannot be parsed directly. *)
84            val gc = ref (SrcPathMap.singleton (init_gname, SOME init_group))
85    
86          fun hasCycle (group, groupstack) = let          fun hasCycle (group, groupstack) = let
87              (* checking for cycles among groups and printing them nicely *)              (* checking for cycles among groups and printing them nicely *)
# Line 149  Line 159 
159                  end                  end
160              in              in
161                  case findCycle (stablestack, []) of                  case findCycle (stablestack, []) of
162                      NONE => (case cachedStable gpath of                      NONE => (case cachedStable (gpath, init_group) of
163                                   SOME g => SOME g                                   SOME g => SOME g
164                                 | NONE => load ())                                 | NONE => load ())
165                    | SOME cyc => (report cyc; NONE)                    | SOME cyc => (report cyc; NONE)
166              end              end
167          in  
168              case getStable [] group of              fun stabilize NONE = NONE
169                  SOME g => SOME g                | stabilize (SOME g) =
170                | NONE =>                  (case g of
171                      (case SrcPathMap.find (!gc, group) of                       GG.GROUP { kind = GG.LIB _, ... } => let
172                           SOME gopt => gopt                           val go = Stabilize.stabilize ginfo
173                         | NONE => let                               { group = g, anyerrors = pErrFlag }
                              val pres =  
                                  parse' (group, groupstack, pErrFlag,  
                                          stabthis, curlib)  
                          in  
                              case cachedStable group of  
                                  NONE =>  
                                      gc := SrcPathMap.insert (!gc, group, pres)  
                                | SOME _ => ();  
                              pres  
                          end)  
         end  
   
         and parse' (group, groupstack, pErrFlag, stabthis, curlib) = let  
   
             (* We stabilize libraries only because a stable library will  
              * encompass the contents of its sub-groups  
              * (but not sub-libraries!). *)  
             fun stabilize (g as GG.GROUP { kind = GG.NOLIB, ... }) = SOME g  
               | stabilize g = let  
                     val go = Stabilize.stabilize ginfo { group = g,  
                                                          anyerrors = pErrFlag }  
174                  in                  in
175                      case go of                      case go of
176                          NONE => NONE                          NONE => NONE
177                        | SOME g => (registerNewStable (group, g);                             | SOME g => (registerNewStable (group, g); SOME g)
178                                     (gc := #1 (SrcPathMap.remove (!gc, group))                       end
179                                      handle LibBase.NotFound => ());                     | _ => SOME g)
180                                     SOME g)          in
181                case SrcPathMap.find (!gc, group) of
182                    SOME gopt => gopt
183                  | NONE => let
184                        fun try_s () = getStable [] group
185                        fun try_n () = parse' (group, groupstack, pErrFlag, curlib)
186                        fun reg gopt =
187                            (gc := SrcPathMap.insert (!gc, group, gopt); gopt)
188                        fun proc_n gopt =
189                            reg (if stabthis then stabilize gopt
190                                 else (SmlInfo.cleanGroup false group; gopt))
191                    in
192                        if paranoid then
193                            case try_n () of
194                                NONE => reg NONE
195                              | SOME g =>
196                                    if VerifyStable.verify ginfo g then
197                                        reg (case try_s () of
198                                                 NONE => SOME g
199                                               | SOME g' => SOME g')
200                                    else proc_n (SOME g)
201                        else case try_s () of
202                            SOME g => reg (SOME g)
203                          | NONE => proc_n (try_n ())
204                    end
205                  end                  end
206    
207            (* Parse' is used when we are sure that we don't want to load
208             * a stable library. *)
209            and parse' (group, groupstack, pErrFlag, curlib) = let
210    
211              (* normal processing -- used when there is no cycle to report *)              (* normal processing -- used when there is no cycle to report *)
212              fun normal_processing () = let              fun normal_processing () = let
213                  val _ = Say.vsay ["[scanning ", SrcPath.descr group, "]\n"]                  val _ = Say.vsay ["[scanning ", SrcPath.descr group, "]\n"]
# Line 332  Line 349 
349                          CMParse.parse (lookAhead, tokenStream,                          CMParse.parse (lookAhead, tokenStream,
350                                         fn (s,p1,p2) => error (p1, p2) s,                                         fn (s,p1,p2) => error (p1, p2) s,
351                                         (group, context, obsolete, error,                                         (group, context, obsolete, error,
352                                          doMember, curlib, ginfo))                                          doMember, curlib, ginfo, init_group))
353                  in                  in
354                      if !(#anyErrors source) then NONE                      if !(#anyErrors source) then NONE
355                      else SOME parseResult                      else SOME parseResult
356                  end                  end
357                  fun openIt () = TextIO.openIn (SrcPath.osstring group)                  fun openIt () = TextIO.openIn (SrcPath.osstring group)
358                  val pro =              in
359                      SafeIO.perform { openIt = openIt,                      SafeIO.perform { openIt = openIt,
360                                       closeIt = TextIO.closeIn,                                       closeIt = TextIO.closeIn,
361                                       work = work,                                       work = work,
362                                       cleanup = fn _ => () }                                       cleanup = fn _ => () }
             in  
                 case pro of  
                     NONE => NONE  
                   | SOME pr =>  
                         if stabthis then stabilize pr  
                         else (SmlInfo.cleanGroup false group; SOME pr)  
363              end              end
364              handle LrParser.ParseError => NONE              handle LrParser.ParseError => NONE
365          in          in

Legend:
Removed from v.536  
changed lines
  Added in v.537

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