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 399, Thu Aug 26 09:55:09 1999 UTC revision 448, Thu Oct 21 09:20:16 1999 UTC
# Line 13  Line 13 
13      val deliver' : string option -> bool      val deliver' : string option -> bool
14      val deliver : unit -> bool      val deliver : unit -> bool
15      val reset : unit -> unit      val reset : unit -> unit
16        val symval : string -> { get: unit -> int option, set: int option -> unit }
17  end = struct  end = struct
18    
19      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
# Line 25  Line 26 
26                                        val os = os)                                        val os = os)
27      structure P = OS.Path      structure P = OS.Path
28      structure F = OS.FileSys      structure F = OS.FileSys
29        structure BF = MachDepVC.Binfile
30    
31      structure Compile = CompileFn (structure MachDepVC = MachDepVC)      structure Compile = CompileFn (structure MachDepVC = MachDepVC
32                                       fun compile_there _ = false)
33    
34        structure BFC = BfcFn (structure MachDepVC = MachDepVC)
35    
36      (* instantiate Stabilize... *)      (* instantiate Stabilize... *)
37      structure Stabilize =      structure Stabilize =
38          StabilizeFn (val writeBFC = Compile.writeBFC          StabilizeFn (fun destroy_state _ i = Compile.evict i
39                       val sizeBFC = Compile.sizeBFC                       structure MachDepVC = MachDepVC
                      val getII = Compile.getII  
                      fun destroy_state _ = ()  
40                       fun recomp gp g = let                       fun recomp gp g = let
41                             val { store, get } = BFC.new ()
42                           val { group, ... } =                           val { group, ... } =
43                               Compile.newTraversal (fn _ => (), g)                               Compile.newTraversal (fn _ => fn _ => (),
44                                                       store, g)
45                       in                       in
46                           isSome (group gp)                           case group gp of
47                       end)                               NONE => NONE
48                               | SOME _ => SOME get
49                         end
50                         val getII = Compile.getII)
51    
52      (* ... and Parse *)      (* ... and Parse *)
53      structure Parse = ParseFn (structure Stabilize = Stabilize      structure Parse = ParseFn (structure Stabilize = Stabilize
# Line 113  Line 121 
121                  end                  end
122                | _ => raise Fail "BootstrapCompile:listName: bad name"                | _ => raise Fail "BootstrapCompile:listName: bad name"
123    
124          val keep_going = EnvConfig.getSet StdConfig.keep_going NONE          val keep_going = #get StdConfig.keep_going ()
125    
126          val ctxt = SrcPath.cwdContext ()          val ctxt = SrcPath.cwdContext ()
127    
# Line 140  Line 148 
148              { primconf = primconf,              { primconf = primconf,
149                fnpolicy = fnpolicy,                fnpolicy = fnpolicy,
150                pcmode = pcmode,                pcmode = pcmode,
151                symenv = SSV.env,                symval = SSV.symval,
152                keep_going = keep_going,                keep_going = keep_going,
153                pervasive = pervasive,                pervasive = pervasive,
154                corenv = corenv,                corenv = corenv,
# Line 169  Line 177 
177              val ovldR = GenericVC.Control.overloadKW              val ovldR = GenericVC.Control.overloadKW
178              val savedOvld = !ovldR              val savedOvld = !ovldR
179              val _ = ovldR := true              val _ = ovldR := true
180              val sbnode = Compile.newSbnodeTraversal (fn _ => ())              val sbnode = Compile.newSbnodeTraversal ()
181    
182              (* here we build a new gp -- the one that uses the freshly              (* here we build a new gp -- the one that uses the freshly
183               * brewed pervasive env, core env, and primitives *)               * brewed pervasive env, core env, and primitives *)
# Line 229  Line 237 
237              case Parse.parse NONE param stab maingspec of              case Parse.parse NONE param stab maingspec of
238                  NONE => false                  NONE => false
239                | SOME (g, gp) => let                | SOME (g, gp) => let
240                        fun store _ = ()
241                      val { group = recomp, ... } =                      val { group = recomp, ... } =
242                          Compile.newTraversal (fn _ => (), g)                          Compile.newTraversal (fn _ => fn _ => (), store, g)
243                  in                  in
244                      if isSome (recomp gp) then let                      if isSome (recomp gp) then let
245                          val rtspid = PS.toHex (#statpid (#ii rts))                          val rtspid = PS.toHex (#statpid (#ii rts))
# Line 297  Line 306 
306                           work = fn () => compile true arg,                           work = fn () => compile true arg,
307                           cleanup = fn () => () }                           cleanup = fn () => () }
308      fun deliver () = deliver' NONE      fun deliver () = deliver' NONE
309        val symval = SSV.symval
310  end  end

Legend:
Removed from v.399  
changed lines
  Added in v.448

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