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 586, Thu Mar 30 05:08:07 2000 UTC revision 587, Thu Mar 30 09:01:52 2000 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 full-cm.cm.  A "minimal" structure   * structure CM that people find in smlnj/cm/full.cm.  A "minimal" structure
4   * CM is defined in CmHook, but it needs to be initialized at bootstrap   * CM is defined in CmHook, but it needs to be initialized at bootstrap
5   * time.   * time.
6   *   *
# Line 17  Line 17 
17        structure DE = DynamicEnv        structure DE = DynamicEnv
18        structure SE = GenericVC.StaticEnv        structure SE = GenericVC.StaticEnv
19        structure ER = GenericVC.EnvRef        structure ER = GenericVC.EnvRef
       structure BE = GenericVC.BareEnvironment  
       structure CMSE = GenericVC.CMStaticEnv  
20        structure S = GenericVC.Symbol        structure S = GenericVC.Symbol
       structure CoerceEnv = GenericVC.CoerceEnv  
21        structure EM = GenericVC.ErrorMsg        structure EM = GenericVC.ErrorMsg
22        structure BF = HostMachDepVC.Binfile        structure BF = HostMachDepVC.Binfile
23        structure P = OS.Path        structure P = OS.Path
24        structure F = OS.FileSys        structure F = OS.FileSys
25        structure DG = DependencyGraph        structure DG = DependencyGraph
26          structure GG = GroupGraph
27    
28        val os = SMLofNJ.SysInfo.getOSKind ()        val os = SMLofNJ.SysInfo.getOSKind ()
29        val my_archos =        val my_archos =
# Line 57  Line 55 
55    
56        val mkBootList = #l o MkBootList.group (fn p => p)        val mkBootList = #l o MkBootList.group (fn p => p)
57    
58        fun init_servers (GroupGraph.GROUP { grouppath, ... }) =        fun init_servers (GG.GROUP { grouppath, ... }) =
59            Servers.cm { archos = my_archos, project = SrcPath.descr grouppath }            Servers.cm { archos = my_archos, project = SrcPath.descr grouppath }
60            | init_servers GG.ERRORGROUP = ()
61    
62        fun recomp_runner gp g = let        fun recomp_runner gp g = let
63            val _ = init_servers g            val _ = init_servers g
# Line 72  Line 71 
71        (* This function combines the actions of "recompile" and "exec".        (* This function combines the actions of "recompile" and "exec".
72         * When successful, it combines the results (thus forming a full         * When successful, it combines the results (thus forming a full
73         * environment) and adds it to the toplevel environment. *)         * environment) and adds it to the toplevel environment. *)
74        fun make_runner add_bindings gp g = let        fun make_runner _ _ GG.ERRORGROUP = false
75            | make_runner add_bindings gp (g as GG.GROUP grec) = let
76                  val { required = rq, ... } = grec
77            val { store, get } = BFC.new ()            val { store, get } = BFC.new ()
78            val _ = init_servers g            val _ = init_servers g
79            val { group = c_group, ... } =            val { group = c_group, ... } =
80                Compile.newTraversal (Link.evict, store, g)                Compile.newTraversal (Link.evict, store, g)
81            val { group = l_group, ... } = Link.newTraversal (g, get)            val { group = l_group, ... } = Link.newTraversal (g, get)
           val GroupGraph.GROUP { required = rq, ... } = g  
82        in        in
83            case Servers.withServers (fn () => c_group gp) of            case Servers.withServers (fn () => c_group gp) of
84                NONE => false                NONE => false
# Line 100  Line 100 
100                                                            symbolic = sym,                                                            symbolic = sym,
101                                                            dynamic = dyn }                                                            dynamic = dyn }
102                                      val base = #get ER.topLevel ()                                      val base = #get ER.topLevel ()
103                                      val new =                                      val new = E.concatEnv (delta, base)
                                         BE.concatEnv (CoerceEnv.e2b delta,  
                                                       base)  
104                                  in                                  in
105                                      #set ER.topLevel new;                                      #set ER.topLevel new;
106                                      Say.vsay ["[New bindings added.]\n"]                                      Say.vsay ["[New bindings added.]\n"]
# Line 139  Line 137 
137    
138        local        local
139            type kernelValues =            type kernelValues =
140                { corenv : BE.environment,                 { corenv : E.environment, init_group : GG.group }
                 init_group : GroupGraph.group }  
141    
142            val fnpolicy = FilenamePolicy.colocate            val fnpolicy = FilenamePolicy.colocate
143                { os = os, arch = HostMachDepVC.architecture }                { os = os, arch = HostMachDepVC.architecture }
# Line 362  Line 359 
359                                        pcmode = pcmode,                                        pcmode = pcmode,
360                                        symval = SSV.symval,                                        symval = SSV.symval,
361                                        keep_going = false,                                        keep_going = false,
362                                        corenv = BE.emptyEnv },                                        corenv = E.emptyEnv },
363                              groupreg = GroupReg.new (),                              groupreg = GroupReg.new (),
364                              errcons = EM.defaultConsumer () }                              errcons = EM.defaultConsumer () }
365                fun loadInitGroup () =                fun loadInitGroup () =
# Line 405  Line 402 
402                        val pervdyn = doTrav perv_lt                        val pervdyn = doTrav perv_lt
403    
404                        val corenv =                        val corenv =
405                            BE.mkenv { static = CoerceEnv.es2bs corestat,                            E.mkenv { static = corestat,
406                                       symbolic = coresym,                                       symbolic = coresym,
407                                       dynamic = coredyn }                                       dynamic = coredyn }
408                        val core_symdyn =                        val core_symdyn =
# Line 427  Line 424 
424                        val standard_preload =                        val standard_preload =
425                            Preload.preload { make = make, autoload = autoload }                            Preload.preload { make = make, autoload = autoload }
426                    in                    in
427                        #set ER.core (BE.staticPart corenv);                        #set ER.core (E.staticPart corenv);
428                        #set ER.pervasive (E.layerEnv (pervasive, core_symdyn));                        #set ER.pervasive (E.layerEnv (pervasive, core_symdyn));
429                        #set ER.topLevel BE.emptyEnv;                        #set ER.topLevel E.emptyEnv;
430                        theValues := SOME { corenv = corenv,                        theValues := SOME { corenv = corenv,
431                                            init_group = init_group };                                            init_group = init_group };
432                        case er of                        case er of

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

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