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 588, Fri Mar 31 09:00:02 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, GG.GROUP { kind = GG.STABLELIB _, ... }) =                      fun goodSublib (p, gth, _) =
67                            case gth () of
68                                GG.GROUP { kind = GG.LIB { kind = GG.STABLE _,
69                                                           ... }, ... } =>
70                        SrcPath.compare (p, igp) = EQUAL orelse                        SrcPath.compare (p, igp) = EQUAL orelse
71                        SrcPathMap.inDomain (!sgc, p)                        SrcPathMap.inDomain (!sgc, p)
72                      | goodSublib _ = true                            | _ => true
73                    val cs = List.all goodSublib sublibs                    val cs = List.all goodSublib sublibs
74                  in                  in
75                      if cs then () else changed := true;                      if cs then () else changed := true;
# Line 83  Line 86 
86      fun listLibs () = map #1 (SrcPathMap.listItemsi (!sgc))      fun listLibs () = map #1 (SrcPathMap.listItemsi (!sgc))
87    
88      fun dropPickles () = let      fun dropPickles () = let
89          fun drop (GG.GROUP { kind = GG.STABLELIB dropper, ... }) = dropper ()          fun drop (GG.GROUP { kind = GG.LIB { kind = GG.STABLE dropper,
90                                                 ... }, ... }) = dropper ()
91            | drop _ = ()            | drop _ = ()
92      in      in
93          SrcPathMap.app drop (!sgc)          SrcPathMap.app drop (!sgc)
# Line 109  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 123  Line 127 
127    
128          fun update_em (GG.GROUP ns_g, GG.GROUP s_g) =          fun update_em (GG.GROUP ns_g, GG.GROUP s_g) =
129              let val s_e = #exports s_g              let val s_e = #exports s_g
130                  fun add (sy, ((_ , DG.SB_SNODE (DG.SNODE sn)), _)) =                  fun add (sy, (snth, _, _)) =
131                        case snth () of
132                            (_ , DG.SB_SNODE (DG.SNODE sn)) =>
133                      (case SymbolMap.find (s_e, sy) of                      (case SymbolMap.find (s_e, sy) of
134                           SOME ((_, DG.SB_BNODE (DG.BNODE bn, _)), _) =>                               NONE => ()
135                           em := StableMap.insert (!em, #bininfo bn, #smlinfo sn)                             | SOME (bnth, _, _) =>
136                         | _ => ())                               (case bnth () of
137                    | add _ = ()                                    (_, DG.SB_BNODE (DG.BNODE bn, _)) =>
138                                      em := StableMap.insert (!em, #bininfo bn,
139                                                              #smlinfo sn)
140                                    | _ => ()))
141                          | _ => ()
142              in              in
143                  SymbolMap.appi add (#exports ns_g)                  SymbolMap.appi add (#exports ns_g)
144              end              end
# Line 158  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 167  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 176  Line 186 
186                | [] => false                | [] => false
187          end          end
188    
189          fun mparse (group, groupstack, pErrFlag, stabthis, curlib) = let          fun mparse args = let
190              fun getStable stablestack gpath = 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 204  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                          (ginfo, gpath, vers, rb)
223                  in                  in
224                      case go of                      case go of
225                          NONE => NONE                          NONE => NONE
# Line 243  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                      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 275  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 306  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 = 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 315  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, 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 324  Line 340 
340                           GG.ERRORGROUP)                           GG.ERRORGROUP)
341    
342                      fun doMember ({ name, mkpath }, p1, p2, c, oto) =                      fun doMember ({ name, mkpath }, p1, p2, c, oto) =
343                          CMSemant.member (ginfo, recParse (p1, p2), load_plugin)                          CMSemant.member { gp = ginfo,
344                                              rparse = recParse (p1, p2),
345                                              load_plugin = load_plugin }
346                            { name = name, mkpath = mkpath,                            { name = name, mkpath = mkpath,
347                              class = c, tooloptions = oto,                              class = c, tooloptions = oto,
348                              group = (group, (p1, p2)),                              group = (group, (p1, p2)),
# Line 417  Line 435 
435    
436                      fun inputc k = TextIO.input stream                      fun inputc k = TextIO.input stream
437    
438                      val lexer = CMLex.makeLexer inputc lexarg                      val tokenStream = CMParse.makeLexer inputc lexarg
                     val tokenStream = LrParser.Stream.streamify lexer  
439                      val (parseResult, _) =                      val (parseResult, _) =
440                          CMParse.parse (lookAhead, tokenStream,                          CMParse.parse (lookAhead, tokenStream,
441                                         fn (s,p1,p2) => error (p1, p2) s,                                         fn (s,p1,p2) => error (p1, p2) s,
# Line 442  Line 459 
459          end          end
460      in      in
461          SmlInfo.newGeneration ();          SmlInfo.newGeneration ();
462          case mparse (group, [], 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.588  
changed lines
  Added in v.666

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