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 433, Mon Sep 13 06:57:29 1999 UTC revision 435, Tue Sep 14 08:51:11 1999 UTC
# Line 64  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 102  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 118  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                  fun getStableSG p =              fun getStable stablestack gpath = let
102                      mparse (p, groupstack, pErrFlag, staball, SOME gpath)                  (* This is a separate "findCycle" routine that detects
103                     * cycles among stable libraries.  These cycles should
104                     * never occur unless someone purposefully renames
105                     * 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 { getGroup = getStableSG,                      EM.errorNoFile (errcons, pErrFlag) SM.nullRegion
122                                               anyerrors = pErrFlag } gpath                        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 136  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 292  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

Legend:
Removed from v.433  
changed lines
  Added in v.435

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