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 380, Fri Jul 9 05:22:18 1999 UTC revision 459, Fri Oct 29 06:22:25 1999 UTC
# Line 11  Line 11 
11          GeneralParams.param -> bool option ->          GeneralParams.param -> bool option ->
12          SrcPath.t -> (CMSemant.group * GeneralParams.info) option          SrcPath.t -> (CMSemant.group * GeneralParams.info) option
13      val reset : unit -> unit      val reset : unit -> unit
14        val listLibs : unit -> unit
15        val dismissLib : SrcPath.t -> unit
16  end  end
17    
18  functor ParseFn (val pending : unit -> DependencyGraph.impexp SymbolMap.map  functor ParseFn (val pending : unit -> DependencyGraph.impexp SymbolMap.map
# Line 34  Line 36 
36      val sgc = ref (SrcPathMap.empty: CMSemant.group SrcPathMap.map)      val sgc = ref (SrcPathMap.empty: CMSemant.group SrcPathMap.map)
37      fun reset () = sgc := SrcPathMap.empty      fun reset () = sgc := SrcPathMap.empty
38    
39        fun listLibs () = let
40            fun show (sp, _) =
41                Say.say [SrcPath.descr sp, "\n"]
42        in
43            SrcPathMap.appi show (!sgc)
44        end
45    
46        fun dismissLib l =
47            (sgc := #1 (SrcPathMap.remove (!sgc, l)))
48            handle LibBase.NotFound => ()
49    
50      fun parse gropt param stabflag group = let      fun parse gropt param stabflag group = let
51    
52          val stabthis = isSome stabflag          val stabthis = isSome stabflag
# Line 51  Line 64 
64           * to parse it had failed. *)           * to parse it had failed. *)
65          val gc = ref (SrcPathMap.empty: CMSemant.group option SrcPathMap.map)          val gc = ref (SrcPathMap.empty: CMSemant.group option SrcPathMap.map)
66    
67          fun mparse (group, groupstack, pErrFlag, stabthis, curlib) =          fun hasCycle (group, groupstack) = let
             case SrcPathMap.find (!sgc, group) of  
                 SOME g => SOME g  
               | NONE =>  
                     (case SrcPathMap.find (!gc, group) of  
                          SOME gopt => gopt  
                        | NONE => let  
                              fun cache_nonstable gopt =  
                                  (gc := SrcPathMap.insert (!gc, group, gopt);  
                                   gopt)  
                              fun cache_stable g =  
                                  (sgc := SrcPathMap.insert (!sgc, group, g);  
                                   SOME g)  
                              fun isStable (GG.GROUP { kind, ... }) =  
                                  case kind of  
                                      GG.STABLELIB _ => true  
                                    | _ => false  
                              val pres =  
                                  parse' (group, groupstack, pErrFlag,  
                                          stabthis, curlib)  
                          in  
                              case pres of  
                                  NONE => cache_nonstable NONE  
                                | SOME g =>  
                                      if isStable g then cache_stable g  
                                      else cache_nonstable (SOME g)  
                          end)  
   
         and parse' (group, groupstack, pErrFlag, stabthis, curlib) = let  
68              (* checking for cycles among groups and printing them nicely *)              (* checking for cycles among groups and printing them nicely *)
69              fun findCycle ([], _) = []              fun findCycle ([], _) = []
70                | findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =                | findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =
# Line 91  Line 76 
76                        | loop (g0, (g, (s, p1, p2)) :: t) = let                        | loop (g0, (g, (s, p1, p2)) :: t) = let
77                              val s = EM.matchErrorString s (p1, p2)                              val s = EM.matchErrorString s (p1, p2)
78                          in                          in
79                                PrettyPrint.add_newline pps;
80                              PrettyPrint.add_string pps s;                              PrettyPrint.add_string pps s;
81                              PrettyPrint.add_string pps ": importing ";                              PrettyPrint.add_string pps ": importing ";
82                              PrettyPrint.add_string pps (SrcPath.specOf g0);                              PrettyPrint.add_string pps (SrcPath.specOf g0);
                             PrettyPrint.add_newline pps;  
83                              loop (g, t)                              loop (g, t)
84                          end                          end
85                  in                  in
                     PrettyPrint.add_newline pps;  
86                      loop (g, hist)                      loop (g, hist)
87                  end                  end
88              in              in
# Line 107  Line 91 
91                              SrcPath.specOf group)                              SrcPath.specOf group)
92                             pphist                             pphist
93              end              end
94            in
95                case findCycle (groupstack, []) of
96                    h :: t => (report (h, t); true)
97                  | [] => false
98            end
99    
100              fun getStable gpath = let          fun mparse (group, groupstack, pErrFlag, stabthis, curlib) = let
101                  (* To make a cycle involving existing stable groups,              fun getStable stablestack gpath = let
102                   * one must use aliases.  The cycle will be detected                  (* This is a separate "findCycle" routine that detects
103                   * amoung those aliases... (?? - hopefully) *)                   * cycles among stable libraries.  These cycles should
104                  fun getStableSG p =                   * never occur unless someone purposefully renames
105                      mparse (p, groupstack, pErrFlag, staball, SOME gpath)                   * stable library files in a bad way. *)
106                    fun findCycle ([], _) = NONE
107                      | findCycle (h :: t, cyc) =
108                        if SrcPath.compare (h, gpath) = EQUAL then SOME (h :: cyc)
109                        else findCycle (t, h :: cyc)
110                    fun report cyc = let
111                        fun pphist pps = let
112                            fun loop [] = ()
113                              | loop (h :: t) =
114                                (PrettyPrint.add_newline pps;
115                                 PrettyPrint.add_string pps (SrcPath.descr h);
116                                 loop t)
117                        in
118                            loop (rev cyc)
119                        end
120                    in
121                        EM.errorNoFile (errcons, pErrFlag) SM.nullRegion
122                          EM.COMPLAIN
123                          ("stable libraries form a cycle with " ^
124                           SrcPath.descr gpath)
125                          pphist
126                    end
127                    fun load () = let
128                        val go = Stabilize.loadStable ginfo
129                            { getGroup = getStable (gpath :: stablestack),
130                              anyerrors = pErrFlag }
131                            gpath
132                    in
133                        case go of
134                            NONE => NONE
135                          | SOME g =>
136                                (sgc := SrcPathMap.insert (!sgc, gpath, g);
137                                 Say.vsay ["[library ", SrcPath.descr gpath,
138                                           " is stable]\n"];
139                                 SOME g)
140                    end
141                in
142                    case findCycle (stablestack, []) of
143                        NONE => (case SrcPathMap.find (!sgc, gpath) of
144                                     SOME g => SOME g
145                                   | NONE => load ())
146                      | SOME cyc => (report cyc; NONE)
147                end
148            in
149                case getStable [] group of
150                    SOME g => SOME g
151                  | NONE =>
152                        (case SrcPathMap.find (!gc, group) of
153                             SOME gopt => gopt
154                           | NONE => let
155                                 val pres =
156                                     parse' (group, groupstack, pErrFlag,
157                                             stabthis, curlib)
158              in              in
159                  Stabilize.loadStable (ginfo, getStableSG, pErrFlag) gpath                               gc := SrcPathMap.insert (!gc, group, pres);
160                                 pres
161                             end)
162              end              end
163    
164            and parse' (group, groupstack, pErrFlag, stabthis, curlib) = let
165    
166              (* We stabilize libraries only because a stable library will              (* We stabilize libraries only because a stable library will
167               * encompass the contents of its sub-groups               * encompass the contents of its sub-groups
168               * (but not sub-libraries!). *)               * (but not sub-libraries!). *)
# Line 127  Line 172 
172    
173              (* normal processing -- used when there is no cycle to report *)              (* normal processing -- used when there is no cycle to report *)
174              fun normal_processing () = let              fun normal_processing () = let
175                    val _ = Say.vsay ["[scanning ", SrcPath.descr group, "]\n"]
176    
177                  val context = SrcPath.sameDirContext group                  val context = SrcPath.sameDirContext group
178    
179                  fun work stream = let                  fun work stream = let
# Line 142  Line 189 
189                       * data structures. *)                       * data structures. *)
190                      fun error r m =                      fun error r m =
191                          EM.error source r EM.COMPLAIN m EM.nullErrorBody                          EM.error source r EM.COMPLAIN m EM.nullErrorBody
192                        fun obsolete r =
193                            if #get StdConfig.warn_obsolete () then
194                                EM.error source r EM.WARN
195                                  "old-style operator (obsolete)" EM.nullErrorBody
196                            else ()
197    
198                      (* recParse returns a group (not an option).                      (* recParse returns a group (not an option).
199                       * This function is used to parse sub-groups.                       * This function is used to parse sub-groups.
# Line 245  Line 297 
297                            getS = getS,                            getS = getS,
298                            handleEof = handleEof,                            handleEof = handleEof,
299                            newline = newline,                            newline = newline,
300                              obsolete = obsolete,
301                            error = error,                            error = error,
302                            sync = sync}                            sync = sync}
303                      end                      end
# Line 256  Line 309 
309                      val (parseResult, _) =                      val (parseResult, _) =
310                          CMParse.parse (lookAhead, tokenStream,                          CMParse.parse (lookAhead, tokenStream,
311                                         fn (s,p1,p2) => error (p1, p2) s,                                         fn (s,p1,p2) => error (p1, p2) s,
312                                         (group, context, error,                                         (group, context, obsolete, error,
313                                          doMember, curlib, ginfo))                                          doMember, curlib, ginfo))
314                  in                  in
315                      if !(#anyErrors source) then NONE                      if !(#anyErrors source) then NONE
# Line 267  Line 320 
320                      SafeIO.perform { openIt = openIt,                      SafeIO.perform { openIt = openIt,
321                                       closeIt = TextIO.closeIn,                                       closeIt = TextIO.closeIn,
322                                       work = work,                                       work = work,
323                                       cleanup = fn () => () }                                       cleanup = fn _ => () }
324              in              in
325                  case pro of                  case pro of
326                      NONE => NONE                      NONE => NONE
# Line 277  Line 330 
330              end              end
331              handle LrParser.ParseError => NONE              handle LrParser.ParseError => NONE
332          in          in
333              case findCycle (groupstack, []) of              if hasCycle (group, groupstack) then NONE
334                  h :: t => (report (h, t); NONE)              else normal_processing ()
               | [] =>  
                     (case getStable group of  
                          NONE =>  
                              (Say.vsay ["[scanning ", SrcPath.descr group,  
                                         "]\n"];  
                               normal_processing ())  
                        | SOME g =>  
                              (Say.vsay ["[library ", SrcPath.descr group,  
                                         " is stable]\n"];  
                               SOME g))  
335          end          end
336      in      in
337          case mparse (group, [], ref false, stabthis, NONE) of          case mparse (group, [], ref false, stabthis, NONE) of
338              NONE => NONE              NONE => NONE
339            | SOME g =>            | SOME g => let
                 if CheckSharing.check (g, ginfo) then  
                     let  
340                          val reach1 = Reachable.reachable g                          val reach1 = Reachable.reachable g
341                          val reach2 = Reachable.reachable' (pending ())                          val reach2 = Reachable.reachable' (pending ())
342                          val reach = SrcPathSet.union (reach1, reach2)                          val reach = SrcPathSet.union (reach1, reach2)
# Line 303  Line 344 
344                          SmlInfo.forgetAllBut reach;                          SmlInfo.forgetAllBut reach;
345                          SOME (g, ginfo)                          SOME (g, ginfo)
346                      end                      end
                 else NONE  
347      end      end
348  end  end

Legend:
Removed from v.380  
changed lines
  Added in v.459

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