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/compile/compile.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/compile/compile.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 536, Fri Feb 18 16:51:54 2000 UTC revision 537, Fri Feb 18 17:20:16 2000 UTC
# Line 10  Line 10 
10      structure DG = DependencyGraph      structure DG = DependencyGraph
11      structure GG = GroupGraph      structure GG = GroupGraph
12      structure E = GenericVC.Environment      structure E = GenericVC.Environment
13        structure BE = GenericVC.BareEnvironment
14      structure Pid = GenericVC.PersStamps      structure Pid = GenericVC.PersStamps
15      structure DE = GenericVC.DynamicEnv      structure DE = GenericVC.DynamicEnv
16      structure PP = PrettyPrint      structure PP = PrettyPrint
# Line 36  Line 37 
37    
38          val getII : SmlInfo.info -> IInfo.info          val getII : SmlInfo.info -> IInfo.info
39    
40          val evict : SmlInfo.info -> unit          val evictStale : unit -> unit
41          val evictAll : unit -> unit          val evictAll : unit -> unit
42    
43          val newSbnodeTraversal : unit -> GP.info -> DG.sbnode -> ed option          val newSbnodeTraversal : unit -> GP.info -> DG.sbnode -> ed option
# Line 192  Line 193 
193          fun mkTraversal (notify, storeBFC, getUrgency) = let          fun mkTraversal (notify, storeBFC, getUrgency) = let
194              val localstate = ref SmlInfoMap.empty              val localstate = ref SmlInfoMap.empty
195    
196              fun pervenv (gp: GP.info) = let              fun sbnode gp (DG.SB_SNODE n) = snode gp n
                 val e = #pervasive (#param gp)  
                 val ste = E.staticPart e  
                 val sye = E.symbolicPart e  
             in  
                 { envs = fn () => { stat = ste, sym = sye },  
                   pids = PidSet.empty }  
             end  
   
             fun sbnode gp n =  
                 case n of  
                     DG.SB_BNODE (_, ii) =>  
197                          (* The beauty of this scheme is that we don't have                          (* The beauty of this scheme is that we don't have
198                           * to do anything at all for SB_BNODEs:  Everything                           * to do anything at all for SB_BNODEs:  Everything
199                           * is prepared ready to be used when the library                           * is prepared ready to be used when the library
200                           * is unpickled. *)                 * is unpickled: *)
201                          SOME ii                | sbnode gp (DG.SB_BNODE (_, ii)) = SOME ii
                   | DG.SB_SNODE n =>  
                         (case snode gp n of  
                              NONE => NONE  
                            | SOME ii => SOME ii)  
202    
203              and fsbnode gp (f, n) =              and fsbnode gp (f, n) =
204                  case (sbnode gp n, f) of                  case (sbnode gp n, f) of
# Line 227  Line 213 
213                  fun fail () =                  fun fail () =
214                      if #keep_going (#param gp) then NONE else raise Abort                      if #keep_going (#param gp) then NONE else raise Abort
215    
216                  fun compile_here (stat, sym, pids) = let                  fun compile_here (stat, sym, pids, split) = let
217                      fun save bfc = let                      fun save bfc = let
218                          fun writer s =                          fun writer s =
219                              (BF.write { stream = s, content = bfc,                              (BF.write { stream = s, content = bfc,
# Line 261  Line 247 
247                              (* clear error flag (could still be set from                              (* clear error flag (could still be set from
248                               * earlier run) *)                               * earlier run) *)
249                              val _ = #anyErrors source := false                              val _ = #anyErrors source := false
250                              val bfc = BF.create { runtimePid = NONE,                              val bfc = BF.create
251                                                    splitting = SmlInfo.split i,                                  { runtimePid = NONE,
252                                      splitting = split,
253                                                    cmData = cmData,                                                    cmData = cmData,
254                                                    ast = ast,                                                    ast = ast,
255                                                    source = source,                                                    source = source,
256                                                    senv = stat,                                                    senv = stat,
257                                                    symenv = sym,                                    symenv = BE.layerSymbolic
258                                                    corenv = corenv }                                                 (sym, BE.symbolicPart corenv),
259                                      corenv = BE.staticPart corenv }
260                              val memo = bfc2memo (bfc, SmlInfo.lastseen i)                              val memo = bfc2memo (bfc, SmlInfo.lastseen i)
261                          in                          in
262                              save bfc;                              save bfc;
# Line 289  Line 277 
277                      val e =                      val e =
278                          foldl (layer'wait urgency)                          foldl (layer'wait urgency)
279                                (foldl (layer'wait urgency)                                (foldl (layer'wait urgency)
280                                       (SOME (pervenv gp))                                       (SOME emptyEnv)
281                                       gi_cl)                                       gi_cl)
282                                li_cl                                li_cl
283                  in                  in
# Line 301  Line 289 
289                               * global map... *)                               * global map... *)
290                              fun fromfile () = let                              fun fromfile () = let
291                                  val { stat, sym } = envs ()                                  val { stat, sym } = envs ()
292                                    val { split, extra_compenv, ... } =
293                                        SmlInfo.attribs i
294                                    val stat =
295                                        case extra_compenv of
296                                            NONE => stat
297                                          | SOME s => E.layerStatic (stat, s)
298                                  fun load () = let                                  fun load () = let
299                                      val ts = TStamp.fmodTime binname                                      val ts = TStamp.fmodTime binname
300                                      fun openIt () = BinIO.openIn binname                                      fun openIt () = BinIO.openIn binname
# Line 334  Line 328 
328                                  fun compile_again () =                                  fun compile_again () =
329                                      (Say.vsay ["[compiling ",                                      (Say.vsay ["[compiling ",
330                                                 SmlInfo.descr i, "]\n"];                                                 SmlInfo.descr i, "]\n"];
331                                       compile_here (stat, sym, pids))                                       compile_here (stat, sym, pids, split))
332                                  fun compile () = let                                  fun compile () = let
333                                      val sp = SmlInfo.sourcepath i                                      val sp = SmlInfo.sourcepath i
334                                  in                                  in
# Line 419  Line 413 
413          end          end
414    
415          fun newSbnodeTraversal () = let          fun newSbnodeTraversal () = let
416              val { sbnode, ... } = mkTraversal (fn _ => fn _ => (),              val { sbnode, ... } =
417                                                 fn _ => (),                  mkTraversal (fn _ => fn _ => (), fn _ => (), fn _ => 0)
                                                fn _ => 0)  
418              fun sbn_trav gp g = let              fun sbn_trav gp g = let
419                  val r = sbnode gp g handle Abort => NONE                  val r = sbnode gp g handle Abort => NONE
420              in              in
# Line 432  Line 425 
425              sbn_trav              sbn_trav
426          end          end
427    
428          fun evict i =          fun evictStale () =
429              (globalstate := #1 (SmlInfoMap.remove (!globalstate, i)))              globalstate :=
430              handle LibBase.NotFound => ()                SmlInfoMap.filteri (SmlInfo.isKnown o #1) (!globalstate)
431    
432          fun evictAll () = globalstate := SmlInfoMap.empty          fun evictAll () = globalstate := SmlInfoMap.empty
433    

Legend:
Removed from v.536  
changed lines
  Added in v.537

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