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/main/cm-boot.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/main/cm-boot.sml

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

revision 800, Fri Mar 16 17:22:47 2001 UTC revision 801, Mon Mar 19 22:53:00 2001 UTC
# Line 1  Line 1 
1  (*  (*
2   * This is the module that actually puts together the contents of the   * This is the module that actually puts together the contents of the
3   * structure CM that people find in $smlnj/cm/full.cm.   * structure CM people find in $smlnj/cm/full.cm.
4   *   *
5   *   Copyright (c) 1999, 2000 by Lucent Bell Laboratories   *   Copyright (c) 1999, 2000 by Lucent Bell Laboratories
6   *   *
# Line 42  Line 42 
42            CompileFn (structure MachDepVC = HostMachDepVC            CompileFn (structure MachDepVC = HostMachDepVC
43                       structure StabModmap = StabModmap                       structure StabModmap = StabModmap
44                       val useStream = HostMachDepVC.Interact.useStream                       val useStream = HostMachDepVC.Interact.useStream
45                       val compile_there = Servers.compile o SrcPath.descr)                       val compile_there = Servers.compile o SrcPath.encode)
46    
47        structure BFC =        structure BFC =
48            BfcFn (structure MachDepVC = HostMachDepVC)            BfcFn (structure MachDepVC = HostMachDepVC)
# Line 60  Line 60 
60        val mkBootList = #l o MkBootList.group (fn p => p)        val mkBootList = #l o MkBootList.group (fn p => p)
61    
62        fun init_servers (GG.GROUP { grouppath, ... }) =        fun init_servers (GG.GROUP { grouppath, ... }) =
63            Servers.cm { archos = my_archos, project = SrcPath.descr grouppath }            Servers.cm { archos = my_archos, project = SrcPath.encode grouppath }
64          | init_servers GG.ERRORGROUP = ()          | init_servers GG.ERRORGROUP = ()
65    
66        fun recomp_runner gp g = let        fun recomp_runner gp g = let
# Line 122  Line 122 
122                         structure StabModmap = StabModmap                         structure StabModmap = StabModmap
123                         fun recomp gp g = let                         fun recomp gp g = let
124                             val { store, get } = BFC.new ()                             val { store, get } = BFC.new ()
                            val _ = init_servers g  
125                             val { group, ... } =                             val { group, ... } =
126                                 Compile.newTraversal (Link.evict, store, g)                                 Compile.newTraversal (Link.evict, store, g)
127                         in                         in
128                             case Servers.withServers (fn () => group gp) of                             case group gp of
129                                 NONE => NONE                                 NONE => NONE
130                               | SOME _ => SOME get                               | SOME _ => SOME get
131                         end                         end
# Line 271  Line 270 
270    
271            fun cwd_load_plugin x = load_plugin (SrcPath.cwd ()) x            fun cwd_load_plugin x = load_plugin (SrcPath.cwd ()) x
272    
273            fun stabilize_runner gp g = true            fun stabilize recursively root = let
274                  fun stabilize_recomp_runner gp g = let
275                      val _ = init_servers g
276                      val { allgroups, ... } =
277                          Compile.newTraversal (Link.evict, fn _ => (), g)
278                  in
279                      Servers.withServers (fn () => allgroups gp)
280                  end
281                  fun stabilize_dummy_runner gp g = true
282                  fun phase1 () = run mkStdSrcPath NONE
283                                      stabilize_recomp_runner root
284                  fun phase2 () = (Compile.reset ();(* a bit too draconian? *)
285                                   run mkStdSrcPath (SOME recursively)
286                                       stabilize_dummy_runner root)
287              in
288                  (* Don't bother with the 2-phase thing if there are
289                   * no compile servers attached... *)
290                  if Servers.noServers () then phase2 ()
291                  else
292                      (* We do this in two phases:
293                       *    1. recompile everything without stabilization but
294                       *       potentially using compile servers
295                       *    2. do a local stabilization run (which should have
296                       *       no need to compile anything); don't use servers
297                       *)
298                      phase1 () andalso phase2 ()
299              end
300    
           fun stabilize recursively =  
               run mkStdSrcPath (SOME recursively) stabilize_runner  
301            val recomp = run mkStdSrcPath NONE recomp_runner            val recomp = run mkStdSrcPath NONE recomp_runner
302            val make = run mkStdSrcPath NONE (make_runner true)            val make = run mkStdSrcPath NONE (make_runner true)
303    
   
304            fun sources archos group = let            fun sources archos group = let
305                val policy =                val policy =
306                    case archos of                    case archos of

Legend:
Removed from v.800  
changed lines
  Added in v.801

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