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 665, Fri Jun 16 04:43:57 2000 UTC revision 666, Fri Jun 16 08:27:00 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 : { load_plugin: SrcPath.context -> string -> bool,      val parse : { load_plugin: SrcPath.dir -> string -> bool,
10                    gr: GroupReg.groupreg,                    gr: GroupReg.groupreg,
11                    param: GeneralParams.param,                    param: GeneralParams.param,
12                    stabflag: bool option,                    stabflag: bool option,
13                    group: SrcPath.t,                    group: SrcPath.file,
14                    init_group: CMSemant.group,                    init_group: CMSemant.group,
15                    paranoid: bool }                    paranoid: bool }
16          -> (CMSemant.group * GeneralParams.info) option          -> (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.file list
19      val dropPickles : unit -> unit      val dropPickles : unit -> unit
20      val dismissLib : SrcPath.t -> unit      val dismissLib : SrcPath.file -> unit
21  end  end
22    
23  functor ParseFn (val pending : unit -> DependencyGraph.impexp SymbolMap.map  functor ParseFn (val pending : unit -> DependencyGraph.impexp SymbolMap.map
# Line 63  Line 63 
63          let val changed = ref true          let val changed = ref true
64              fun canStay GG.ERRORGROUP = true (* doesn't matter *)              fun canStay GG.ERRORGROUP = true (* doesn't matter *)
65                | canStay (GG.GROUP { sublibs, ... }) = let                | canStay (GG.GROUP { sublibs, ... }) = let
66                      fun goodSublib (p, gth) =                      fun goodSublib (p, gth, _) =
67                          case gth () of                          case gth () of
68                              GG.GROUP { kind = GG.LIB { kind = GG.STABLE _,                              GG.GROUP { kind = GG.LIB { kind = GG.STABLE _,
69                                                         ... }, ... } =>                                                         ... }, ... } =>
# Line 113  Line 113 
113    
114          val groupreg = gr          val groupreg = gr
115          val errcons = EM.defaultConsumer ()          val errcons = EM.defaultConsumer ()
116          val ginfo = { param = param, groupreg = groupreg, errcons = errcons }          val ginfo0 = { param = param, groupreg = groupreg, errcons = errcons }
117          val keep_going = #keep_going param          val keep_going = #keep_going param
118    
119          (* The "group cache" -- we store "group options";  having          (* The "group cache" -- we store "group options";  having
# Line 168  Line 168 
168                              PrettyPrint.add_newline pps;                              PrettyPrint.add_newline pps;
169                              PrettyPrint.add_string pps s;                              PrettyPrint.add_string pps s;
170                              PrettyPrint.add_string pps ": importing ";                              PrettyPrint.add_string pps ": importing ";
171                              PrettyPrint.add_string pps (SrcPath.specOf g0);                              PrettyPrint.add_string pps (SrcPath.descr g0);
172                              loop (g, t)                              loop (g, t)
173                          end                          end
174                  in                  in
# Line 177  Line 177 
177              in              in
178                  EM.error s (p1, p2) EM.COMPLAIN                  EM.error s (p1, p2) EM.COMPLAIN
179                             ("group hierarchy forms a cycle with " ^                             ("group hierarchy forms a cycle with " ^
180                              SrcPath.specOf group)                              SrcPath.descr group)
181                             pphist                             pphist
182              end              end
183          in          in
# Line 186  Line 186 
186                | [] => false                | [] => false
187          end          end
188    
189          fun mparse (group, vers, groupstack, pErrFlag, stabthis, curlib) = let          fun mparse args = let
190              fun getStable stablestack (gpath, vers) = let              val (group, vers, groupstack, pErrFlag, stabthis, curlib,
191                     ginfo, rb) = args
192                fun getStable stablestack (ginfo, gpath, vers, rb) = let
193                  (* This is a separate "findCycle" routine that detects                  (* This is a separate "findCycle" routine that detects
194                   * cycles among stable libraries.  These cycles should                   * cycles among stable libraries.  These cycles should
195                   * never occur unless someone purposefully renames                   * never occur unless someone purposefully renames
# Line 214  Line 216 
216                        pphist                        pphist
217                  end                  end
218                  fun load () = let                  fun load () = let
219                      val go = Stabilize.loadStable ginfo                      val go = Stabilize.loadStable
220                          { getGroup = getStable (gpath :: stablestack),                          { getGroup = getStable (gpath :: stablestack),
221                            anyerrors = pErrFlag }                            anyerrors = pErrFlag }
222                          (gpath, vers)                          (ginfo, gpath, vers, rb)
223                  in                  in
224                      case go of                      case go of
225                          NONE => NONE                          NONE => NONE
# Line 253  Line 255 
255              case SrcPathMap.find (!gc, group) of              case SrcPathMap.find (!gc, group) of
256                  SOME gopt => gopt                  SOME gopt => gopt
257                | NONE => let                | NONE => let
258                      fun try_s () = getStable [] (group, vers)                      fun try_s () = getStable [] (ginfo, group, vers, rb)
259                      fun try_n () = parse' (group, groupstack, pErrFlag, curlib)                      fun try_n () =
260                            parse' (group, groupstack, pErrFlag, curlib, ginfo, rb)
261                      fun reg gopt =                      fun reg gopt =
262                          (gc := SrcPathMap.insert (!gc, group, gopt); gopt)                          (gc := SrcPathMap.insert (!gc, group, gopt); gopt)
263                      fun proc_n gopt =                      fun proc_n gopt =
# Line 285  Line 288 
288    
289          (* Parse' is used when we are sure that we don't want to load          (* Parse' is used when we are sure that we don't want to load
290           * a stable library. *)           * a stable library. *)
291          and parse' (group, groupstack, pErrFlag, curlib) = let          and parse' (group, groupstack, pErrFlag, curlib, ginfo, rb) = let
292    
293                val ginfo = GeneralParams.bind ginfo rb
294    
295              (* normal processing -- used when there is no cycle to report *)              (* normal processing -- used when there is no cycle to report *)
296              fun normal_processing () = let              fun normal_processing () = let
297                  val _ = Say.vsay ["[scanning ", SrcPath.descr group, "]\n"]                  val _ = Say.vsay ["[scanning ", SrcPath.descr group, "]\n"]
298    
299                  val context = SrcPath.sameDirContext group                  val context = SrcPath.dir group
300    
301                  fun work stream = let                  fun work stream = let
302                      val source =                      val source =
# Line 316  Line 321 
321                       * This function is used to parse sub-groups.                       * This function is used to parse sub-groups.
322                       * Errors are propagated by explicitly setting the                       * Errors are propagated by explicitly setting the
323                       * "anyErrors" flag of the parent group. *)                       * "anyErrors" flag of the parent group. *)
324                      fun recParse (p1, p2) curlib (p, v) = let                      fun recParse (p1, p2) curlib (p, v, rb) = let
325                          val gs' = (group, (source, p1, p2)) :: groupstack                          val gs' = (group, (source, p1, p2)) :: groupstack
326                          (* my error flag *)                          (* my error flag *)
327                          val mef = #anyErrors source                          val mef = #anyErrors source
# Line 325  Line 330 
330                           * recursive traversals once there was an error on                           * recursive traversals once there was an error on
331                           * this group. *)                           * this group. *)
332                          if !mef andalso not keep_going then GG.ERRORGROUP                          if !mef andalso not keep_going then GG.ERRORGROUP
333                          else case mparse (p, v, gs', mef, staball, curlib) of                          else case mparse (p, v, gs', mef, staball,
334                                              curlib, ginfo, rb) of
335                                   NONE => (mef := true; GG.ERRORGROUP)                                   NONE => (mef := true; GG.ERRORGROUP)
336                                 | SOME res => res                                 | SOME res => res
337                      end                      end
# Line 453  Line 459 
459          end          end
460      in      in
461          SmlInfo.newGeneration ();          SmlInfo.newGeneration ();
462          case mparse (group, NONE, [], ref false, stabthis, NONE) of          case mparse (group, NONE, [], ref false, stabthis, NONE, ginfo0, []) of
463              NONE => NONE              NONE => NONE
464            | SOME g => SOME (g, ginfo)            | SOME g => SOME (g, ginfo0)
465      end      end
466  end  end

Legend:
Removed from v.665  
changed lines
  Added in v.666

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