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 353, Thu Jun 24 09:43:28 1999 UTC revision 354, Fri Jun 25 08:36:12 1999 UTC
# Line 8  Line 8 
8  signature PARSE = sig  signature PARSE = sig
9      val parse :      val parse :
10          GeneralParams.param -> bool option ->          GeneralParams.param -> bool option ->
11          AbsPath.t -> (CMSemant.group * GeneralParams.info) option          SrcPath.t -> (CMSemant.group * GeneralParams.info) option
12  end  end
13    
14  functor ParseFn (structure Stabilize: STABILIZE) :> PARSE = struct  functor ParseFn (structure Stabilize: STABILIZE) :> PARSE = struct
# Line 39  Line 39 
39          (* The "group cache" -- we store "group options";  having          (* The "group cache" -- we store "group options";  having
40           * NONE registered for a group means that a previous attempt           * NONE registered for a group means that a previous attempt
41           * to parse it had failed. *)           * to parse it had failed. *)
42          val gc = ref (AbsPathMap.empty: CMSemant.group option AbsPathMap.map)          val gc = ref (SrcPathMap.empty: CMSemant.group option SrcPathMap.map)
43    
44          fun mparse (group, groupstack, pErrFlag, stabthis) =          fun mparse (group, groupstack, pErrFlag, stabthis) =
45              case AbsPathMap.find (!gc, group) of              case SrcPathMap.find (!gc, group) of
46                  SOME g => g                  SOME g => g
47                | NONE => let                | NONE => let
48                      val g = parse' (group, groupstack, pErrFlag, stabthis)                      val g = parse' (group, groupstack, pErrFlag, stabthis)
49                  in                  in
50                      gc := AbsPathMap.insert (!gc, group, g);                      gc := SrcPathMap.insert (!gc, group, g);
51                      g                      g
52                  end                  end
53    
# Line 55  Line 55 
55              (* checking for cycles among groups and printing them nicely *)              (* checking for cycles among groups and printing them nicely *)
56              fun findCycle ([], _) = []              fun findCycle ([], _) = []
57                | findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =                | findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =
58                  if AbsPath.compare (g, group) = EQUAL then rev (h :: cyc)                  if SrcPath.compare (g, group) = EQUAL then rev (h :: cyc)
59                  else findCycle (t, h :: cyc)                  else findCycle (t, h :: cyc)
60              fun report ((g, (s, p1, p2)), hist) = let              fun report ((g, (s, p1, p2)), hist) = let
61                  fun pphist pps = let                  fun pphist pps = let
# Line 65  Line 65 
65                          in                          in
66                              PrettyPrint.add_string pps s;                              PrettyPrint.add_string pps s;
67                              PrettyPrint.add_string pps ": importing ";                              PrettyPrint.add_string pps ": importing ";
68                              PrettyPrint.add_string pps (AbsPath.specOf g0);                              PrettyPrint.add_string pps (SrcPath.specOf g0);
69                              PrettyPrint.add_newline pps;                              PrettyPrint.add_newline pps;
70                              loop (g, t)                              loop (g, t)
71                          end                          end
# Line 76  Line 76 
76              in              in
77                  EM.error s (p1, p2) EM.COMPLAIN                  EM.error s (p1, p2) EM.COMPLAIN
78                             ("group hierarchy forms a cycle with " ^                             ("group hierarchy forms a cycle with " ^
79                              AbsPath.specOf group)                              SrcPath.specOf group)
80                             pphist                             pphist
81              end              end
82    
# Line 99  Line 99 
99    
100              (* normal processing -- used when there is no cycle to report *)              (* normal processing -- used when there is no cycle to report *)
101              fun normal_processing () = let              fun normal_processing () = let
102                  val context = AbsPath.sameDirContext group                  val context = SrcPath.sameDirContext group
103                  val filename = AbsPath.name group                  val _ = Say.vsay ["[scanning ", SrcPath.descr group, "]\n"]
                 val _ = Say.vsay ["[scanning ", filename, "]\n"]  
104    
105                  fun work stream = let                  fun work stream = let
106                      val source =                      val source =
107                          S.newSource (filename, 1, stream, false, errcons)                          S.newSource (SrcPath.osstring group,
108                                         1, stream, false, errcons)
109                      val sourceMap = #sourceMap source                      val sourceMap = #sourceMap source
110                      val _ = GroupReg.register groupreg (group, source)                      val _ = GroupReg.register groupreg (group, source)
111    
# Line 238  Line 238 
238                  end                  end
239                  val pro =                  val pro =
240                      SafeIO.perform { openIt =                      SafeIO.perform { openIt =
241                                          fn () => AbsPath.openTextIn group,                                          fn () => SrcPath.openTextIn group,
242                                       closeIt = TextIO.closeIn,                                       closeIt = TextIO.closeIn,
243                                       work = work,                                       work = work,
244                                       cleanup = fn () => () }                                       cleanup = fn () => () }

Legend:
Removed from v.353  
changed lines
  Added in v.354

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