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 568, Tue Mar 7 03:59:09 2000 UTC revision 569, Tue Mar 7 04:01:07 2000 UTC
# Line 14  Line 14 
14    
15    local    local
16        structure E = GenericVC.Environment        structure E = GenericVC.Environment
17          structure DE = DynamicEnv
18        structure SE = GenericVC.StaticEnv        structure SE = GenericVC.StaticEnv
19        structure ER = GenericVC.EnvRef        structure ER = GenericVC.EnvRef
20        structure BE = GenericVC.BareEnvironment        structure BE = GenericVC.BareEnvironment
# Line 35  Line 36 
36                              val os = os)                              val os = os)
37    
38        val emptydyn = E.dynamicPart E.emptyEnv        val emptydyn = E.dynamicPart E.emptyEnv
39        val system_values = ref emptydyn        val system_values = ref (SrcPathMap.empty: E.dynenv SrcPathMap.map)
40    
41        structure Compile =        structure Compile =
42            CompileFn (structure MachDepVC = HostMachDepVC            CompileFn (structure MachDepVC = HostMachDepVC
# Line 149  Line 150 
150            val theValues = ref (NONE: kernelValues option)            val theValues = ref (NONE: kernelValues option)
151    
152        in        in
           fun setAnchor { anchor = a, path = s } =  
               (PathConfig.set (pcmode, a, s); SrcPath.sync ())  
153            (* cancelling anchors cannot affect the order of existing paths            (* cancelling anchors cannot affect the order of existing paths
154             * (it may invalidate some paths; but all other ones stay as             * (it may invalidate some paths; but all other ones stay as
155             * they are) *)             * they are) *)
156            fun cancelAnchor a = PathConfig.cancel (pcmode, a)            fun setAnchor a NONE = PathConfig.cancel (pcmode, a)
157                | setAnchor a (SOME s) = (PathConfig.set (pcmode, a, s);
158                                          SrcPath.sync ())
159            (* same goes for reset because it just cancels all anchors... *)            (* same goes for reset because it just cancels all anchors... *)
160            fun resetPathConfig () = PathConfig.reset pcmode            fun resetPathConfig () = PathConfig.reset pcmode
161              (* get the current binding for an anchor *)
162              fun getAnchor a () =
163                  Option.map (fn f => f ()) (PathConfig.configAnchor pcmode a)
164    
165            fun mkStdSrcPath s =            fun mkStdSrcPath s =
166                SrcPath.standard pcmode { context = SrcPath.cwdContext (),                SrcPath.standard pcmode { context = SrcPath.cwdContext (),
# Line 207  Line 211 
211    
212            fun parse_arg (gr, sflag, p) =            fun parse_arg (gr, sflag, p) =
213                { load_plugin = load_plugin, gr = gr, param = param (),                { load_plugin = load_plugin, gr = gr, param = param (),
214                  stabflag = sflag, group = p, init_group = init_group (),                  stabflag = sflag, group = p,
215                  paranoid = false }                  init_group = init_group (), paranoid = false }
216    
217            and autoload s = let            and autoload s = let
218                val p = mkStdSrcPath s                val p = mkStdSrcPath s
# Line 292  Line 296 
296                 Parse.reset ();                 Parse.reset ();
297                 SmlInfo.reset ())                 SmlInfo.reset ())
298    
299            fun initTheValues (bootdir, er, autoload_postprocess) = let            fun initTheValues (bootdir, de, er, autoload_postprocess) = let
300                val _ = let                val _ = let
301                    fun listDir ds = let                    fun listDir ds = let
302                        fun loop l =                        fun loop l =
# Line 317  Line 321 
321                in                in
322                    app (fn (x, d) => PathConfig.set (pcmode, x, d)) pairList                    app (fn (x, d) => PathConfig.set (pcmode, x, d)) pairList
323                end                end
324    
325                  val pidmapfile = P.concat (bootdir, BtNames.pidmap)
326                  fun readpidmap s = let
327                      fun loop m = let
328                          fun enter (d, pids) = let
329                              fun enter1 (hexp, e) =
330                                  case GenericVC.PersStamps.fromHex hexp of
331                                      SOME p => (DE.bind (p, DE.look de p, e)
332                                                 handle DE.Unbound => e)
333                                    | NONE => e
334                          in
335                              SrcPathMap.insert (m, SrcPath.fromDescr pcmode d,
336                                                 foldl enter1 emptydyn pids)
337                          end
338                      in
339                          case TextIO.inputLine s of
340                              "" => m
341                            | line => (case String.tokens Char.isSpace line of
342                                           d :: pids => loop (enter (d, pids))
343                                         | _ => loop m)
344                      end
345                  in
346                      system_values := loop SrcPathMap.empty
347                  end
348    
349                  val _ =
350                      SafeIO.perform { openIt = fn () => TextIO.openIn pidmapfile,
351                                       closeIt = TextIO.closeIn,
352                                       work = readpidmap,
353                                       cleanup = fn _ => () }
354    
355                val initgspec = mkStdSrcPath BtNames.initgspec                val initgspec = mkStdSrcPath BtNames.initgspec
356                val ginfo = { param = { fnpolicy = fnpolicy,                val ginfo = { param = { fnpolicy = fnpolicy,
357                                        pcmode = pcmode,                                        pcmode = pcmode,
# Line 395  Line 430 
430                        case er of                        case er of
431                            BARE =>                            BARE =>
432                                (bare_preload BtNames.bare_preloads;                                (bare_preload BtNames.bare_preloads;
433                                 system_values := emptydyn;                                 system_values := SrcPathMap.empty;
434                                 NONE)                                 NONE)
435                          | AUTOLOAD =>                          | AUTOLOAD =>
436                                (HostMachDepVC.Interact.installCompManager                                (HostMachDepVC.Interact.installCompManager
# Line 434  Line 469 
469                | l => ignore (foldl arg autoload l)                | l => ignore (foldl arg autoload l)
470          end          end
471      in      in
472          system_values := de;          initTheValues (bootdir, de, er,
473          initTheValues (bootdir, er, fn () => (Cleanup.install initPaths;                         fn () => (Cleanup.install initPaths;
474                                                procCmdLine))                                                procCmdLine))
475      end      end
476    
# Line 443  Line 478 
478          type 'a controller = { get : unit -> 'a, set : 'a -> unit }          type 'a controller = { get : unit -> 'a, set : 'a -> unit }
479    
480          structure Anchor = struct          structure Anchor = struct
481              val set = setAnchor              fun anchor a = { get = getAnchor a, set = setAnchor a }
             val cancel = cancelAnchor  
482              val reset = resetPathConfig              val reset = resetPathConfig
483          end          end
484    

Legend:
Removed from v.568  
changed lines
  Added in v.569

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