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 364, Fri Jul 2 07:33:12 1999 UTC revision 435, Tue Sep 14 08:51:11 1999 UTC
# Line 10  Line 10 
10          GroupReg.groupreg option ->          GroupReg.groupreg option ->
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
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 29  Line 32 
32                       structure Lex = CMLex                       structure Lex = CMLex
33                       structure LrParser = LrParser)                       structure LrParser = LrParser)
34    
35      fun parse gropt param stabflag group = let      (* the "stable group cache" *)
36        val sgc = ref (SrcPathMap.empty: CMSemant.group SrcPathMap.map)
37        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          val _ = SrcPath.revalidateCwd ()      fun parse gropt param stabflag group = let
51    
52          val stabthis = isSome stabflag          val stabthis = isSome stabflag
53          val staball = stabflag = SOME true          val staball = stabflag = SOME true
# Line 48  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) =          fun hasCycle (group, groupstack) = let
             case SrcPathMap.find (!gc, group) of  
                 SOME g => g  
               | NONE => let  
                     val g = parse' (group, groupstack, pErrFlag, stabthis)  
                 in  
                     gc := SrcPathMap.insert (!gc, group, g);  
                     g  
                 end  
   
         and parse' (group, groupstack, pErrFlag, stabthis) = 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 70  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 86  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)                   * 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              in
121                  Stabilize.loadStable (ginfo, getStableSG, pErrFlag) gpath                      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
159                                 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 106  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 121  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 aliases and sub-groups.                       * This function is used to parse sub-groups.
200                       * Errors are propagated by explicitly setting the                       * Errors are propagated by explicitly setting the
201                       * "anyErrors" flag of the parent group. *)                       * "anyErrors" flag of the parent group. *)
202                      fun recParse (p1, p2) p = let                      fun recParse (p1, p2) curlib p = let
203                          val groupstack' =                          val gs' = (group, (source, p1, p2)) :: groupstack
                             (group, (source, p1, p2)) :: groupstack  
204                          val myErrorFlag = #anyErrors source                          val myErrorFlag = #anyErrors source
205                      in                      in
206                          case mparse (p, groupstack', myErrorFlag, staball) of                          case mparse (p, gs', myErrorFlag, staball, curlib) of
207                              NONE => (myErrorFlag := true;                              NONE => (myErrorFlag := true;
208                                       CMSemant.emptyGroup group)                                       CMSemant.emptyGroup group)
209                            | SOME res => res                            | SOME res => res
# Line 225  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 236  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, recParse,                                         (group, context, obsolete, error,
313                                          doMember, ginfo))                                          doMember, curlib, ginfo))
314                  in                  in
315                      if !(#anyErrors source) then NONE                      if !(#anyErrors source) then NONE
316                      else SOME parseResult                      else SOME parseResult
# Line 257  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) 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 283  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.364  
changed lines
  Added in v.435

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