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 399, Thu Aug 26 09:55:09 1999 UTC revision 404, Wed Sep 1 07:03:22 1999 UTC
# Line 38  Line 38 
38        val emptydyn = E.dynamicPart E.emptyEnv        val emptydyn = E.dynamicPart E.emptyEnv
39        val system_values = ref emptydyn        val system_values = ref emptydyn
40    
41          structure Compile =
42              CompileFn (structure MachDepVC = HostMachDepVC)
43    
44        structure Link =        structure Link =
45            LinkFn (structure MachDepVC = HostMachDepVC            LinkFn (structure MachDepVC = HostMachDepVC
46                    val system_values = system_values)                    val system_values = system_values)
47    
48        structure Compile =        structure BFC =
49            CompileFn (structure MachDepVC = HostMachDepVC)            BfcFn (structure MachDepVC = HostMachDepVC)
50    
51        structure AutoLoad = AutoLoadFn        structure AutoLoad = AutoLoadFn
52            (structure C = Compile            (structure C = Compile
53             structure L = Link)             structure L = Link
54               structure BFC = BFC)
55    
56        fun recomp_runner gp g = let        fun recomp_runner gp g = let
57            val { group, ... } = Compile.newTraversal (Link.evict, g)            fun store _ = ()
58              val { group, ... } = Compile.newTraversal (Link.evict, store, g)
59        in        in
60            isSome (group gp) before Link.cleanup ()            isSome (group gp) before Link.cleanup gp
61        end        end
62    
63        (* This function combines the actions of "recompile" and "exec".        (* This function combines the actions of "recompile" and "exec".
64         * When successful, it combines the results (thus forming a full         * When successful, it combines the results (thus forming a full
65         * environment) and adds it to the toplevel environment. *)         * environment) and adds it to the toplevel environment. *)
66        fun make_runner gp g = let        fun make_runner gp g = let
67            val { group = c_group, ... } = Compile.newTraversal (Link.evict, g)            val { store, get } = BFC.new ()
68            val { group = l_group, ... } = Link.newTraversal g            val { group = c_group, ... } =
69                  Compile.newTraversal (Link.evict, store, g)
70              val { group = l_group, ... } = Link.newTraversal (g, get)
71            val GroupGraph.GROUP { required = rq, ... } = g            val GroupGraph.GROUP { required = rq, ... } = g
72        in        in
73            case c_group gp of            case c_group gp of
# Line 71  Line 78 
78                     * that everybody has every conceivable privilege, but at                     * that everybody has every conceivable privilege, but at
79                     * the very least we announce which ones are being made                     * the very least we announce which ones are being made
80                     * use of.) *)                     * use of.) *)
81                    (Link.cleanup ();                    (Link.cleanup gp;
82                     if StringSet.isEmpty rq then ()                     if StringSet.isEmpty rq then ()
83                     else Say.say ("$Execute: required privileges are:\n" ::                     else Say.say ("$Execute: required privileges are:\n" ::
84                       map (fn s => ("  " ^ s ^ "\n")) (StringSet.listItems rq));                       map (fn s => ("  " ^ s ^ "\n")) (StringSet.listItems rq));
# Line 93  Line 100 
100    
101        (* Instantiate the stabilization mechanism. *)        (* Instantiate the stabilization mechanism. *)
102        structure Stabilize =        structure Stabilize =
103            StabilizeFn (val recomp = recomp_runner            StabilizeFn (structure MachDepVC = HostMachDepVC
104                         val writeBFC = Compile.writeBFC                         fun recomp gp g = let
105                         val sizeBFC = Compile.sizeBFC                             val { store, get } = BFC.new ()
106                         val getII = Compile.getII                             val { group, ... } =
107                         val destroy_state = Link.evict)                                 Compile.newTraversal (Link.evict, store, g)
108                           in
109                               case group gp of
110                                   NONE => NONE
111                                 | SOME _ => SOME get
112                           end
113                           fun destroy_state gp i =
114                               (Compile.evict i; Link.evict gp i)
115                           val getII = Compile.getII)
116    
117        (* Access to the stabilization mechanism is integrated into the        (* Access to the stabilization mechanism is integrated into the
118         * parser. I'm not sure if this is the cleanest way, but it works         * parser. I'm not sure if this is the cleanest way, but it works
# Line 195  Line 210 
210                  | SOME (g, gp) => f gp g                  | SOME (g, gp) => f gp g
211            end            end
212    
213              val listLibs = Parse.listLibs
214              fun dismissLib l = let
215                  val c = SrcPath.cwdContext ()
216                  val p = SrcPath.standard pcmode { context = c, spec = l }
217              in
218                  Parse.dismissLib p
219              end
220    
221            fun stabilize_runner gp g = true            fun stabilize_runner gp g = true
222    
223            fun stabilize recursively = run (SOME recursively) stabilize_runner            fun stabilize recursively = run (SOME recursively) stabilize_runner
# Line 256  Line 279 
279                         * been cheating, and if we ever have to try and                         * been cheating, and if we ever have to try and
280                         * fetch assembly.sig or core.sml in a separate                         * fetch assembly.sig or core.sml in a separate
281                         * traversal, it will fail. *)                         * traversal, it will fail. *)
282                        val sbnode = Compile.newSbnodeTraversal (fn _ => ())                        val sbnode = Compile.newSbnodeTraversal ()
283                        fun get n = let                        fun get n = let
284                            val { ii, ctxt } = valOf (sbnode ginfo n)                            val { ii, ctxt } = valOf (sbnode ginfo n)
285                            val { statpid, statenv, symenv, sympid } = ii                            val { statpid, statenv, symenv, sympid } = ii
# Line 344  Line 367 
367                                     cancelAnchor = cancelAnchor,                                     cancelAnchor = cancelAnchor,
368                                     resetPathConfig = resetPathConfig,                                     resetPathConfig = resetPathConfig,
369                                     synchronize = SrcPath.sync,                                     synchronize = SrcPath.sync,
370                                     showPending = showPending })                                     showPending = showPending,
371                                       listLibs = listLibs,
372                                       dismissLib = dismissLib })
373    
374                    end                    end
375            end            end

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

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