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 507, Fri Dec 10 09:18:23 1999 UTC revision 518, Wed Jan 12 06:26:25 2000 UTC
# Line 13  Line 13 
13    datatype envrequest = AUTOLOAD | BARE    datatype envrequest = AUTOLOAD | BARE
14    
15    local    local
       structure YaccTool = YaccTool  
       structure LexTool = LexTool  
       structure BurgTool = BurgTool  
   
16        structure E = GenericVC.Environment        structure E = GenericVC.Environment
17        structure SE = GenericVC.StaticEnv        structure SE = GenericVC.StaticEnv
18        structure ER = GenericVC.EnvRef        structure ER = GenericVC.EnvRef
# Line 72  Line 68 
68        (* This function combines the actions of "recompile" and "exec".        (* This function combines the actions of "recompile" and "exec".
69         * When successful, it combines the results (thus forming a full         * When successful, it combines the results (thus forming a full
70         * environment) and adds it to the toplevel environment. *)         * environment) and adds it to the toplevel environment. *)
71        fun make_runner gp g = let        fun make_runner add_bindings gp g = let
72            val { store, get } = BFC.new ()            val { store, get } = BFC.new ()
73            val _ = init_servers g            val _ = init_servers g
74            val { group = c_group, ... } =            val { group = c_group, ... } =
# Line 94  Line 90 
90                       map (fn s => ("  " ^ s ^ "\n")) (StringSet.listItems rq));                       map (fn s => ("  " ^ s ^ "\n")) (StringSet.listItems rq));
91                     case l_group gp of                     case l_group gp of
92                         NONE => false                         NONE => false
93                       | SOME dyn => let                       | SOME dyn =>
94                             val delta = E.mkenv { static = stat, symbolic = sym,                             (if add_bindings then
95                                    let val delta = E.mkenv { static = stat,
96                                                              symbolic = sym,
97                                                   dynamic = dyn }                                                   dynamic = dyn }
98                             val base = #get ER.topLevel ()                             val base = #get ER.topLevel ()
99                             val new = BE.concatEnv (CoerceEnv.e2b delta, base)                                      val new =
100                                            BE.concatEnv (CoerceEnv.e2b delta,
101                                                          base)
102                         in                         in
103                             #set ER.topLevel new;                             #set ER.topLevel new;
104                             Say.vsay ["[New bindings added.]\n"];                                      Say.vsay ["[New bindings added.]\n"]
105                             true                                  end
106                         end)                              else ();
107                                true))
108        end        end
109    
110        val al_greg = GroupReg.new ()        val al_greg = GroupReg.new ()
# Line 203  Line 204 
204                val c = SrcPath.cwdContext ()                val c = SrcPath.cwdContext ()
205                val p = SrcPath.standard pcmode { context = c, spec = s }                val p = SrcPath.standard pcmode { context = c, spec = s }
206            in            in
207                (case Parse.parse (SOME al_greg) (param ()) NONE p of                (case Parse.parse load_plugin (SOME al_greg) (param ()) NONE p of
208                     NONE => false                     NONE => false
209                   | SOME (g, _) =>                   | SOME (g, _) =>
210                         (AutoLoad.register (GenericVC.EnvRef.topLevel, g);                         (AutoLoad.register (GenericVC.EnvRef.topLevel, g);
# Line 211  Line 212 
212                before dropPickles ()                before dropPickles ()
213            end            end
214    
215            fun al_ginfo () = { param = param (),            and run sflag f s = let
                               groupreg = al_greg,  
                               errcons = EM.defaultConsumer () }  
   
           val al_manager =  
               AutoLoad.mkManager { get_ginfo = al_ginfo,  
                                    dropPickles = dropPickles }  
   
           fun al_manager' (ast, _, ter) = al_manager (ast, ter)  
   
           fun run sflag f s = let  
216                val c = SrcPath.cwdContext ()                val c = SrcPath.cwdContext ()
217                val p = SrcPath.standard pcmode { context = c, spec = s }                val p = SrcPath.standard pcmode { context = c, spec = s }
218            in            in
219                (case Parse.parse NONE (param ()) sflag p of                (case Parse.parse load_plugin NONE (param ()) sflag p of
220                     NONE => false                     NONE => false
221                   | SOME (g, gp) => f gp g)                   | SOME (g, gp) => f gp g)
222                before dropPickles ()                before dropPickles ()
223            end            end
224    
225              and load_plugin x = let
226                  val _ = Say.vsay ["[attempting to load plugin ", x, "]\n"]
227                  val success =
228                      run NONE (make_runner false) x handle _ => false
229              in
230                  if success then
231                      Say.vsay ["[plugin ", x, " loaded successfully]\n"]
232                  else
233                      Say.vsay ["[unable to load plugin ", x, "]\n"];
234                  success
235              end
236    
237            fun stabilize_runner gp g = true            fun stabilize_runner gp g = true
238    
239            fun stabilize recursively = run (SOME recursively) stabilize_runner            fun stabilize recursively = run (SOME recursively) stabilize_runner
240            val recomp = run NONE recomp_runner            val recomp = run NONE recomp_runner
241            val make = run NONE make_runner            val make = run NONE (make_runner true)
242    
243            fun slave () =            fun slave () = let
244                  fun parse p =
245                      Parse.parse load_plugin NONE (param ()) NONE p
246              in
247                Slave.slave { pcmode = pcmode,                Slave.slave { pcmode = pcmode,
248                              parse = fn p => Parse.parse NONE (param ()) NONE p,                              parse = parse,
249                              my_archos = my_archos,                              my_archos = my_archos,
250                              sbtrav = Compile.newSbnodeTraversal,                              sbtrav = Compile.newSbnodeTraversal,
251                              make = make }                              make = make }
252              end
253    
254              fun al_ginfo () = { param = param (),
255                                  groupreg = al_greg,
256                                  errcons = EM.defaultConsumer () }
257    
258              val al_manager =
259                  AutoLoad.mkManager { get_ginfo = al_ginfo,
260                                       dropPickles = dropPickles }
261    
262              fun al_manager' (ast, _, ter) = al_manager (ast, ter)
263    
264            fun reset () =            fun reset () =
265                (Compile.reset ();                (Compile.reset ();
# Line 461  Line 478 
478          val stabilize = stabilize          val stabilize = stabilize
479    
480          val symval = SSV.symval          val symval = SSV.symval
481            val load_plugin = load_plugin
482      end      end
483    end    end
484  end  end

Legend:
Removed from v.507  
changed lines
  Added in v.518

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