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

Diff of /sml/trunk/src/cm/bootstrap/btcompile.sml

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

revision 587, Thu Mar 30 09:01:52 2000 UTC revision 588, Fri Mar 31 09:00:02 2000 UTC
# Line 38  Line 38 
38                        root = SrcPath.descr grouppath }                        root = SrcPath.descr grouppath }
39        | init_servers GG.ERRORGROUP = ()        | init_servers GG.ERRORGROUP = ()
40    
41        structure StabModmap = StabModmapFn ()
42    
43      structure Compile = CompileFn (structure MachDepVC = MachDepVC      structure Compile = CompileFn (structure MachDepVC = MachDepVC
44                                       structure StabModmap = StabModmap
45                                     val compile_there =                                     val compile_there =
46                                         Servers.compile o SrcPath.descr)                                         Servers.compile o SrcPath.descr)
47    
# Line 47  Line 50 
50      (* instantiate Stabilize... *)      (* instantiate Stabilize... *)
51      structure Stabilize =      structure Stabilize =
52          StabilizeFn (structure MachDepVC = MachDepVC          StabilizeFn (structure MachDepVC = MachDepVC
53                         structure StabModmap = StabModmap
54                       fun recomp gp g = let                       fun recomp gp g = let
55                           val { store, get } = BFC.new ()                           val { store, get } = BFC.new ()
56                           val _ = init_servers g                           val _ = init_servers g
# Line 64  Line 68 
68    
69      (* ... and Parse *)      (* ... and Parse *)
70      structure Parse = ParseFn (structure Stabilize = Stabilize      structure Parse = ParseFn (structure Stabilize = Stabilize
71                                   structure StabModmap = StabModmap
72                                 val evictStale = Compile.evictStale                                 val evictStale = Compile.evictStale
73                                 fun pending () = SymbolMap.empty)                                 fun pending () = SymbolMap.empty)
74    
# Line 85  Line 90 
90          MkBootList.group listName g          MkBootList.group listName g
91      end      end
92    
93        local
94            fun internal_reset () =
95                (Compile.reset ();
96                 Parse.reset ();
97                 StabModmap.reset ())
98        in
99            fun reset () =
100                (Say.vsay ["[CMB reset]\n"];
101                 internal_reset ())
102            val checkDirbase = let
103                val prev = ref NONE
104                fun ck db =
105                    (case !prev of
106                         NONE => prev := SOME db
107                       | SOME db' =>
108                         if db = db' then ()
109                         else (Say.vsay ["[new dirbase is `", db,
110                                         "'; CMB reset]\n"];
111                               internal_reset ();
112                               prev := SOME db))
113            in
114                ck
115            end
116        end
117    
118      fun mk_compile { deliver, root, dirbase = dbopt, paranoid } = let      fun mk_compile { deliver, root, dirbase = dbopt, paranoid } = let
119    
120            val _ = StabModmap.reset ()
121    
122          val dirbase = getOpt (dbopt, BtNames.dirbaseDefault)          val dirbase = getOpt (dbopt, BtNames.dirbaseDefault)
123            val _ = checkDirbase dirbase
124          val pcmodespec = BtNames.pcmodespec          val pcmodespec = BtNames.pcmodespec
125          val initgspec = BtNames.initgspec          val initgspec = BtNames.initgspec
126          val maingspec = BtNames.maingspec          val maingspec = BtNames.maingspec
# Line 387  Line 420 
420          val _ = CMBSlaveHook.init archos slave          val _ = CMBSlaveHook.init archos slave
421      end      end
422    
     fun reset () =  
         (Compile.reset ();  
          Parse.reset ())  
   
423      val make' = compile      val make' = compile
424      fun make () = make' NONE      fun make () = make' NONE
425      val symval = SSV.symval      val symval = SSV.symval

Legend:
Removed from v.587  
changed lines
  Added in v.588

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