Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/main/cm-boot.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 692 - (view) (download)

1 : blume 375 (*
2 :     * This is the module that actually puts together the contents of the
3 : blume 587 * structure CM that people find in smlnj/cm/full.cm. A "minimal" structure
4 : blume 375 * CM is defined in CmHook, but it needs to be initialized at bootstrap
5 : blume 495 * time.
6 : blume 375 *
7 :     * Copyright (c) 1999 by Lucent Bell Laboratories
8 :     *
9 :     * author: Matthias Blume (blume@cs.princeton.edu)
10 :     *)
11 :     functor LinkCM (structure HostMachDepVC : MACHDEP_VC) = struct
12 :    
13 :     datatype envrequest = AUTOLOAD | BARE
14 :    
15 :     local
16 :     structure E = GenericVC.Environment
17 : blume 569 structure DE = DynamicEnv
18 : blume 375 structure SE = GenericVC.StaticEnv
19 :     structure ER = GenericVC.EnvRef
20 :     structure S = GenericVC.Symbol
21 :     structure EM = GenericVC.ErrorMsg
22 :     structure BF = HostMachDepVC.Binfile
23 : blume 380 structure P = OS.Path
24 :     structure F = OS.FileSys
25 : blume 451 structure DG = DependencyGraph
26 : blume 587 structure GG = GroupGraph
27 : blume 375
28 :     val os = SMLofNJ.SysInfo.getOSKind ()
29 : blume 464 val my_archos =
30 :     concat [HostMachDepVC.architecture, "-", FilenamePolicy.kind2name os]
31 : blume 375
32 :     structure SSV =
33 :     SpecificSymValFn (structure MachDepVC = HostMachDepVC
34 :     val os = os)
35 :    
36 :     val emptydyn = E.dynamicPart E.emptyEnv
37 : blume 569 val system_values = ref (SrcPathMap.empty: E.dynenv SrcPathMap.map)
38 : blume 375
39 : blume 588 structure StabModmap = StabModmapFn ()
40 :    
41 : blume 400 structure Compile =
42 : blume 448 CompileFn (structure MachDepVC = HostMachDepVC
43 : blume 588 structure StabModmap = StabModmap
44 : blume 677 val useStream = HostMachDepVC.Interact.useStream
45 : blume 464 val compile_there = Servers.compile o SrcPath.descr)
46 : blume 400
47 : blume 537 structure BFC =
48 :     BfcFn (structure MachDepVC = HostMachDepVC)
49 :    
50 : blume 399 structure Link =
51 :     LinkFn (structure MachDepVC = HostMachDepVC
52 : blume 537 structure BFC = BFC
53 : blume 399 val system_values = system_values)
54 : blume 375
55 :     structure AutoLoad = AutoLoadFn
56 : blume 399 (structure C = Compile
57 : blume 403 structure L = Link
58 :     structure BFC = BFC)
59 : blume 375
60 : blume 537 val mkBootList = #l o MkBootList.group (fn p => p)
61 :    
62 : blume 587 fun init_servers (GG.GROUP { grouppath, ... }) =
63 : blume 464 Servers.cm { archos = my_archos, project = SrcPath.descr grouppath }
64 : blume 587 | init_servers GG.ERRORGROUP = ()
65 : blume 456
66 : blume 399 fun recomp_runner gp g = let
67 : blume 456 val _ = init_servers g
68 : blume 403 fun store _ = ()
69 :     val { group, ... } = Compile.newTraversal (Link.evict, store, g)
70 : blume 399 in
71 : blume 450 isSome (Servers.withServers (fn () => group gp))
72 :     before Link.cleanup gp
73 : blume 399 end
74 : blume 375
75 :     (* This function combines the actions of "recompile" and "exec".
76 :     * When successful, it combines the results (thus forming a full
77 :     * environment) and adds it to the toplevel environment. *)
78 : blume 587 fun make_runner _ _ GG.ERRORGROUP = false
79 :     | make_runner add_bindings gp (g as GG.GROUP grec) = let
80 :     val { required = rq, ... } = grec
81 :     val { store, get } = BFC.new ()
82 :     val _ = init_servers g
83 :     val { group = c_group, ... } =
84 :     Compile.newTraversal (Link.evict, store, g)
85 :     val { group = l_group, ... } = Link.newTraversal (g, get)
86 :     in
87 :     case Servers.withServers (fn () => c_group gp) of
88 :     NONE => false
89 :     | SOME { stat, sym} =>
90 : blume 537 (* Before executing the code, we announce the privileges
91 : blume 399 * that are being invoked. (For the time being, we assume
92 :     * that everybody has every conceivable privilege, but at
93 :     * the very least we announce which ones are being made
94 :     * use of.) *)
95 : blume 400 (Link.cleanup gp;
96 : blume 399 if StringSet.isEmpty rq then ()
97 :     else Say.say ("$Execute: required privileges are:\n" ::
98 :     map (fn s => (" " ^ s ^ "\n")) (StringSet.listItems rq));
99 :     case l_group gp of
100 : blume 375 NONE => false
101 : blume 518 | SOME dyn =>
102 :     (if add_bindings then
103 :     let val delta = E.mkenv { static = stat,
104 :     symbolic = sym,
105 :     dynamic = dyn }
106 :     val base = #get ER.topLevel ()
107 : blume 587 val new = E.concatEnv (delta, base)
108 : blume 518 in
109 :     #set ER.topLevel new;
110 :     Say.vsay ["[New bindings added.]\n"]
111 :     end
112 :     else ();
113 :     true))
114 : blume 587 end
115 : blume 375
116 :     val al_greg = GroupReg.new ()
117 :    
118 :     (* Instantiate the stabilization mechanism. *)
119 :     structure Stabilize =
120 : blume 403 StabilizeFn (structure MachDepVC = HostMachDepVC
121 : blume 588 structure StabModmap = StabModmap
122 : blume 403 fun recomp gp g = let
123 :     val { store, get } = BFC.new ()
124 : blume 456 val _ = init_servers g
125 : blume 403 val { group, ... } =
126 :     Compile.newTraversal (Link.evict, store, g)
127 :     in
128 : blume 450 case Servers.withServers (fn () => group gp) of
129 : blume 403 NONE => NONE
130 :     | SOME _ => SOME get
131 :     end
132 :     val getII = Compile.getII)
133 : blume 375
134 :     (* Access to the stabilization mechanism is integrated into the
135 :     * parser. I'm not sure if this is the cleanest way, but it works
136 :     * well enough. *)
137 :     structure Parse = ParseFn (structure Stabilize = Stabilize
138 : blume 588 structure StabModmap = StabModmap
139 : blume 537 fun evictStale () =
140 :     (Compile.evictStale ();
141 :     Link.evictStale ())
142 : blume 375 val pending = AutoLoad.getPending)
143 :    
144 :     local
145 : blume 592 type kernelValues = { init_group : GG.group }
146 : blume 375
147 :     val fnpolicy = FilenamePolicy.colocate
148 :     { os = os, arch = HostMachDepVC.architecture }
149 :    
150 :     val theValues = ref (NONE: kernelValues option)
151 :    
152 :     in
153 : blume 666 val penv = SrcPath.newEnv ()
154 : blume 645
155 : blume 377 (* cancelling anchors cannot affect the order of existing paths
156 :     * (it may invalidate some paths; but all other ones stay as
157 :     * they are) *)
158 : blume 666 fun setAnchor a v = SrcPath.set_anchor (penv, a, v)
159 : blume 377 (* same goes for reset because it just cancels all anchors... *)
160 : blume 666 fun resetPathConfig () = SrcPath.reset_anchors penv
161 : blume 569 (* get the current binding for an anchor *)
162 : blume 666 fun getAnchor a () = SrcPath.get_anchor (penv, a)
163 : blume 375
164 : blume 525 fun mkStdSrcPath s =
165 : blume 666 SrcPath.file
166 :     (SrcPath.standard { err = fn s => raise Fail s, env = penv }
167 :     { context = SrcPath.cwd (), spec = s })
168 : blume 525
169 : blume 479 fun getPending () = let
170 : blume 375 fun one (s, _) = let
171 :     val nss = Symbol.nameSpaceToString (Symbol.nameSpace s)
172 :     val n = Symbol.name s
173 :     in
174 : blume 479 concat [" ", nss, " ", n, "\n"]
175 : blume 375 end
176 :     in
177 : blume 479 map one (SymbolMap.listItemsi (AutoLoad.getPending ()))
178 : blume 375 end
179 :    
180 :     fun initPaths () = let
181 : blume 433 val lpcth = #get StdConfig.local_pathconfig ()
182 : blume 375 val p = case lpcth () of
183 :     NONE => []
184 :     | SOME f => [f]
185 : blume 433 val p = #get StdConfig.pathcfgspec () :: p
186 : blume 666 fun processOne f = SrcPath.processSpecFile (penv, f)
187 : blume 375 handle _ => ()
188 :     in
189 : blume 676 app processOne p;
190 :     SrcPath.sync ()
191 : blume 375 end
192 :    
193 : blume 537 fun getTheValues () = valOf (!theValues)
194 :     handle Option => raise Fail "CMBoot: theParam not initialized"
195 :    
196 : blume 375 fun param () = let
197 : blume 537 val v = getTheValues ()
198 : blume 375 in
199 : blume 537 { fnpolicy = fnpolicy,
200 : blume 666 penv = penv,
201 : blume 433 symval = SSV.symval,
202 : blume 592 keep_going = #get StdConfig.keep_going () }
203 : blume 375 end
204 :    
205 : blume 537 val init_group = #init_group o getTheValues
206 :    
207 : blume 507 fun dropPickles () =
208 :     if #get StdConfig.conserve_memory () then
209 :     Parse.dropPickles ()
210 :     else ()
211 :    
212 : blume 537 fun parse_arg (gr, sflag, p) =
213 :     { load_plugin = load_plugin, gr = gr, param = param (),
214 : blume 569 stabflag = sflag, group = p,
215 :     init_group = init_group (), paranoid = false }
216 : blume 537
217 :     and autoload s = let
218 : blume 525 val p = mkStdSrcPath s
219 : blume 375 in
220 : blume 537 (case Parse.parse (parse_arg (al_greg, NONE, p)) of
221 : blume 505 NONE => false
222 :     | SOME (g, _) =>
223 : blume 537 (AutoLoad.register (GenericVC.EnvRef.topLevel, g);
224 :     true))
225 : blume 507 before dropPickles ()
226 : blume 375 end
227 :    
228 : blume 578 and run mkSrcPath sflag f s = let
229 :     val p = mkSrcPath s
230 : blume 537 val gr = GroupReg.new ()
231 : blume 375 in
232 : blume 537 (case Parse.parse (parse_arg (gr, sflag, p)) of
233 : blume 505 NONE => false
234 :     | SOME (g, gp) => f gp g)
235 : blume 507 before dropPickles ()
236 : blume 375 end
237 :    
238 : blume 578 and load_plugin context x = let
239 : blume 518 val _ = Say.vsay ["[attempting to load plugin ", x, "]\n"]
240 : blume 643 fun badname s = Say.say ["[bad plugin name: ", s, "]\n"]
241 : blume 578 fun mkSrcPath s =
242 : blume 666 SrcPath.file
243 :     (SrcPath.standard { env = penv, err = badname }
244 :     { context = context, spec = s })
245 : blume 518 val success =
246 : blume 578 run mkSrcPath NONE (make_runner false) x handle _ => false
247 : blume 518 in
248 :     if success then
249 :     Say.vsay ["[plugin ", x, " loaded successfully]\n"]
250 :     else
251 :     Say.vsay ["[unable to load plugin ", x, "]\n"];
252 :     success
253 :     end
254 :    
255 : blume 666 fun cwd_load_plugin x = load_plugin (SrcPath.cwd ()) x
256 : blume 578
257 : blume 449 fun stabilize_runner gp g = true
258 :    
259 : blume 578 fun stabilize recursively =
260 :     run mkStdSrcPath (SOME recursively) stabilize_runner
261 :     val recomp = run mkStdSrcPath NONE recomp_runner
262 :     val make = run mkStdSrcPath NONE (make_runner true)
263 : blume 449
264 : blume 642
265 :     fun sources archos group = let
266 :     val policy =
267 :     case archos of
268 :     NONE => fnpolicy
269 :     | SOME ao => FilenamePolicy.colocate_generic ao
270 : blume 666 fun sourcesOf ((p, gth, _), (v, a)) =
271 : blume 642 if SrcPathSet.member (v, p) then (v, a)
272 :     else
273 :     let val v = SrcPathSet.add (v, p)
274 : blume 652 in case gth () of
275 : blume 642 GG.ERRORGROUP => (v, a)
276 :     | GG.GROUP { kind, sources, ... } => let
277 :     fun add (p, x, a) =
278 :     StringMap.insert
279 :     (a, SrcPath.osstring p, x)
280 :     val a = SrcPathMap.foldli add a sources
281 :     fun sg subgroups =
282 :     foldl sourcesOf (v, a) subgroups
283 :     in
284 :     case kind of
285 :     GG.LIB { kind, version } =>
286 :     (case kind of
287 :     GG.STABLE _ => let
288 :     val file = SrcPath.osstring p
289 :     val (a, x) =
290 :     StringMap.remove (a, file)
291 :     val sfile =
292 :     FilenamePolicy.mkStableName
293 :     policy (p, version)
294 :     in
295 :     (v,
296 :     StringMap.insert (a, sfile, x))
297 :     end
298 :     | GG.DEVELOPED d => sg (#subgroups d))
299 :     | GG.NOLIB n => sg (#subgroups n)
300 :     end
301 :     end
302 : blume 632 val p = mkStdSrcPath group
303 :     val gr = GroupReg.new ()
304 :     in
305 :     (case Parse.parse (parse_arg (gr, NONE, p)) of
306 : blume 642 SOME (g, _) => let
307 :     val (_, sm) =
308 : blume 666 sourcesOf ((p, fn () => g, []),
309 : blume 642 (SrcPathSet.empty,
310 :     StringMap.singleton
311 :     (SrcPath.osstring p,
312 :     { class = "cm",
313 :     derived = false })))
314 :     fun add (s, { class, derived }, l) =
315 :     { file = s, class = class, derived = derived } :: l
316 : blume 632 in
317 : blume 642 SOME (StringMap.foldli add [] sm)
318 :     end
319 :     | _ => NONE)
320 : blume 632 before dropPickles ()
321 :     end
322 :    
323 : blume 692 fun mk_standalone sflag { project, wrapper, target } = let
324 :     val hsfx = SMLofNJ.SysInfo.getHeapSuffix ()
325 :     fun extendTarget () =
326 :     OS.Path.joinBaseExt { base = target, ext = SOME hsfx }
327 :     val target =
328 :     case OS.Path.splitBaseExt target of
329 :     { base, ext = NONE } => extendTarget ()
330 :     | { base, ext = SOME e } =>
331 :     if e = hsfx then target else extendTarget ()
332 :     val pp = mkStdSrcPath project
333 :     val wp = mkStdSrcPath wrapper
334 :     val ts = TStamp.fmodTime target
335 : blume 537 val gr = GroupReg.new ()
336 : blume 692 fun do_wrapper () =
337 :     case Parse.parse (parse_arg (gr, NONE, wp)) of
338 :     NONE => NONE
339 :     | SOME (g, gp) =>
340 :     if recomp_runner gp g then SOME (mkBootList g)
341 :     else NONE
342 : blume 537 in
343 : blume 692 (case Parse.parse (parse_arg (gr, sflag, pp)) of
344 : blume 537 NONE => NONE
345 :     | SOME (g, gp) =>
346 :     if isSome sflag orelse recomp_runner gp g then
347 : blume 692 case (ts, !(#youngest gp)) of
348 :     (TStamp.TSTAMP tgt_t, TStamp.TSTAMP src_t) =>
349 :     if Time.< (tgt_t, src_t) then do_wrapper ()
350 :     else SOME []
351 :     | _ => do_wrapper ()
352 : blume 537 else NONE)
353 :     before dropPickles ()
354 :     end
355 :    
356 : blume 518 fun slave () = let
357 : blume 537 val gr = GroupReg.new ()
358 :     fun parse p = Parse.parse (parse_arg (gr, NONE, p))
359 : blume 518 in
360 : blume 666 Slave.slave { penv = penv,
361 : blume 518 parse = parse,
362 : blume 480 my_archos = my_archos,
363 :     sbtrav = Compile.newSbnodeTraversal,
364 :     make = make }
365 : blume 518 end
366 : blume 456
367 : blume 518 fun al_ginfo () = { param = param (),
368 :     groupreg = al_greg,
369 : blume 692 errcons = EM.defaultConsumer (),
370 :     youngest = ref TStamp.ancient }
371 : blume 518
372 :     val al_manager =
373 :     AutoLoad.mkManager { get_ginfo = al_ginfo,
374 :     dropPickles = dropPickles }
375 :    
376 :     fun al_manager' (ast, _, ter) = al_manager (ast, ter)
377 :    
378 : blume 375 fun reset () =
379 : blume 399 (Compile.reset ();
380 :     Link.reset ();
381 : blume 375 AutoLoad.reset ();
382 :     Parse.reset ();
383 : blume 588 SmlInfo.reset ();
384 :     StabModmap.reset ())
385 : blume 375
386 : blume 569 fun initTheValues (bootdir, de, er, autoload_postprocess) = let
387 : blume 375 val _ = let
388 :     fun listDir ds = let
389 :     fun loop l =
390 : blume 380 case F.readDir ds of
391 : blume 375 "" => l
392 :     | x => loop (x :: l)
393 :     in
394 :     loop []
395 :     end
396 :     val fileList = SafeIO.perform
397 : blume 380 { openIt = fn () => F.openDir bootdir,
398 :     closeIt = F.closeDir,
399 : blume 375 work = listDir,
400 : blume 459 cleanup = fn _ => () }
401 : blume 380 fun isDir x = F.isDir x handle _ => false
402 : blume 375 fun subDir x = let
403 : blume 380 val d = P.concat (bootdir, x)
404 : blume 375 in
405 :     if isDir d then SOME (x, d) else NONE
406 :     end
407 :     val pairList = List.mapPartial subDir fileList
408 : blume 666 fun sa (x, d) = SrcPath.set_anchor (penv, x, SOME d)
409 : blume 375 in
410 : blume 666 app sa pairList
411 : blume 375 end
412 : blume 569
413 :     val pidmapfile = P.concat (bootdir, BtNames.pidmap)
414 :     fun readpidmap s = let
415 :     fun loop m = let
416 :     fun enter (d, pids) = let
417 :     fun enter1 (hexp, e) =
418 :     case GenericVC.PersStamps.fromHex hexp of
419 :     SOME p => (DE.bind (p, DE.look de p, e)
420 :     handle DE.Unbound => e)
421 :     | NONE => e
422 :     in
423 : blume 666 SrcPathMap.insert (m, SrcPath.decode penv d,
424 : blume 569 foldl enter1 emptydyn pids)
425 :     end
426 :     in
427 :     case TextIO.inputLine s of
428 :     "" => m
429 :     | line => (case String.tokens Char.isSpace line of
430 :     d :: pids => loop (enter (d, pids))
431 :     | _ => loop m)
432 :     end
433 :     in
434 :     system_values := loop SrcPathMap.empty
435 :     end
436 :    
437 :     val _ =
438 :     SafeIO.perform { openIt = fn () => TextIO.openIn pidmapfile,
439 :     closeIt = TextIO.closeIn,
440 :     work = readpidmap,
441 :     cleanup = fn _ => () }
442 :    
443 : blume 525 val initgspec = mkStdSrcPath BtNames.initgspec
444 : blume 537 val ginfo = { param = { fnpolicy = fnpolicy,
445 : blume 666 penv = penv,
446 : blume 433 symval = SSV.symval,
447 : blume 592 keep_going = false },
448 : blume 375 groupreg = GroupReg.new (),
449 : blume 692 errcons = EM.defaultConsumer (),
450 :     youngest = ref TStamp.ancient }
451 : blume 537 fun loadInitGroup () =
452 : blume 666 Stabilize.loadStable
453 :     { getGroup = fn _ =>
454 :     raise Fail "CMBoot: initial getGroup",
455 :     anyerrors = ref false }
456 :     (ginfo, initgspec, NONE, [])
457 : blume 375 in
458 : blume 537 case loadInitGroup () of
459 :     NONE => raise Fail "CMBoot: unable to load init group"
460 :     | SOME init_group => let
461 :     val _ = Compile.reset ()
462 :     val _ = Link.reset ()
463 : blume 375
464 : blume 537 val { exports = ctm, ... } =
465 :     Compile.newTraversal (fn _ => fn _ => (),
466 :     fn _ => (),
467 :     init_group)
468 :     val { exports = ltm, ... } = Link.newTraversal
469 :     (init_group, fn _ => raise Fail "init: get bfc?")
470 :    
471 :     fun getSymTrav (tr_m, sy) =
472 :     case SymbolMap.find (tr_m, sy) of
473 :     NONE => raise Fail "init: bogus init group (1)"
474 :     | SOME tr => tr
475 :    
476 : blume 592 val perv_ct = getSymTrav (ctm, PervAccess.pervStrSym)
477 :     val perv_lt = getSymTrav (ltm, PervAccess.pervStrSym)
478 : blume 537
479 :     fun doTrav t =
480 :     case t ginfo of
481 :     SOME r => r
482 :     | NONE => raise Fail "init: bogus init group (2)"
483 :    
484 :     val { stat = pervstat, sym = pervsym } = doTrav perv_ct
485 :     val pervdyn = doTrav perv_lt
486 :    
487 :     val pervasive = E.mkenv { static = pervstat,
488 :     symbolic = pervsym,
489 :     dynamic = pervdyn }
490 :    
491 : blume 495 fun bare_autoload x =
492 :     (Say.say
493 :     ["!* ", x,
494 :     ": \"autoload\" not available, using \"make\"\n"];
495 :     make x)
496 :     val bare_preload =
497 :     Preload.preload { make = make,
498 :     autoload = bare_autoload }
499 :     val standard_preload =
500 :     Preload.preload { make = make, autoload = autoload }
501 : blume 375 in
502 : blume 592 #set ER.pervasive pervasive;
503 : blume 587 #set ER.topLevel E.emptyEnv;
504 : blume 592 theValues := SOME { init_group = init_group };
505 : blume 375 case er of
506 :     BARE =>
507 : blume 495 (bare_preload BtNames.bare_preloads;
508 : blume 569 system_values := SrcPathMap.empty;
509 : blume 495 NONE)
510 : blume 375 | AUTOLOAD =>
511 :     (HostMachDepVC.Interact.installCompManager
512 :     (SOME al_manager');
513 : blume 495 standard_preload BtNames.standard_preloads;
514 : blume 507 (* unconditionally drop all library pickles *)
515 :     Parse.dropPickles ();
516 : blume 495 SOME (autoload_postprocess ()))
517 : blume 375 end
518 :     end
519 :     end
520 :     in
521 : blume 495 fun init (bootdir, de, er) = let
522 :     fun procCmdLine () = let
523 :     val autoload = ignore o autoload
524 :     val make = ignore o make
525 : blume 692 fun p (f, mk, ("sml" | "sig" | "fun")) =
526 :     HostMachDepVC.Interact.useFile f
527 :     | p (f, mk, "cm") = mk f
528 :     | p (f, mk, e) = Say.say ["!* unable to process `", f,
529 : blume 495 "' (unknown extension `", e, "')\n"]
530 : blume 692 fun badopt opt f () =
531 :     Say.say ["!* bad ", opt, " option: `", f, "'\n"]
532 :     fun carg ("-D", f, _) =
533 :     let val bad = badopt "-D" f
534 :     in
535 :     case String.fields (fn c => c = #"=")
536 :     (String.extract (f, 2, NONE)) of
537 :     "" :: _ => bad ()
538 :     | [var, num] =>
539 :     (case Int.fromString num of
540 :     SOME i => #set (SSV.symval var) (SOME i)
541 :     | NONE => bad ())
542 :     | [var] => #set (SSV.symval var) (SOME 1)
543 :     | _ => bad ()
544 :     end
545 :     | carg ("-U", f, _) =
546 :     (case String.extract (f, 2, NONE) of
547 :     "" => badopt "-U" f ()
548 :     | var => #set (SSV.symval var) NONE)
549 :     | carg (_, f, mk) = p (f, mk,
550 :     String.map Char.toLower
551 :     (getOpt (OS.Path.ext f, "<none>")))
552 : blume 495 fun arg ("-a", _) = autoload
553 :     | arg ("-m", _) = make
554 : blume 692 | arg (f, mk) = (carg (String.substring (f, 0, 2), f, mk)
555 :     handle General.Subscript => ();
556 :     mk)
557 : blume 495 in
558 :     case SMLofNJ.getArgs () of
559 :     ["@CMslave"] => (#set StdConfig.verbose false; slave ())
560 :     | l => ignore (foldl arg autoload l)
561 :     end
562 : blume 448 in
563 : blume 569 initTheValues (bootdir, de, er,
564 :     fn () => (Cleanup.install initPaths;
565 :     procCmdLine))
566 : blume 448 end
567 : blume 479
568 :     structure CM :> CM = struct
569 :     type 'a controller = { get : unit -> 'a, set : 'a -> unit }
570 :    
571 :     structure Anchor = struct
572 : blume 569 fun anchor a = { get = getAnchor a, set = setAnchor a }
573 : blume 479 val reset = resetPathConfig
574 :     end
575 :    
576 :     structure Control = struct
577 :     val keep_going = StdConfig.keep_going
578 :     val verbose = StdConfig.verbose
579 :     val parse_caching = StdConfig.parse_caching
580 :     val warn_obsolete = StdConfig.warn_obsolete
581 :     val debug = StdConfig.debug
582 : blume 505 val conserve_memory = StdConfig.conserve_memory
583 : blume 479 end
584 :    
585 :     structure Library = struct
586 : blume 666 type lib = SrcPath.file
587 : blume 479 val known = Parse.listLibs
588 :     val descr = SrcPath.descr
589 :     val osstring = SrcPath.osstring
590 :     val dismiss = Parse.dismissLib
591 : blume 632 fun unshare lib = (Link.unshare lib; dismiss lib)
592 : blume 479 end
593 :    
594 :     structure State = struct
595 :     val synchronize = SrcPath.sync
596 :     val reset = reset
597 :     val pending = getPending
598 :     end
599 :    
600 :     structure Server = struct
601 :     type server = Servers.server
602 : blume 666 fun start x = Servers.start x
603 :     before SrcPath.scheduleNotification ()
604 : blume 479 val stop = Servers.stop
605 :     val kill = Servers.kill
606 :     val name = Servers.name
607 :     end
608 :    
609 :     val autoload = autoload
610 :     val make = make
611 :     val recomp = recomp
612 :     val stabilize = stabilize
613 :    
614 : blume 642 val sources = sources
615 : blume 632
616 : blume 479 val symval = SSV.symval
617 : blume 578 val load_plugin = cwd_load_plugin
618 : blume 537 val mk_standalone = mk_standalone
619 : blume 479 end
620 : blume 525
621 : blume 578 structure Tools = ToolsFn (val load_plugin = cwd_load_plugin
622 : blume 666 val penv = penv)
623 : blume 578
624 :     val load_plugin = load_plugin
625 : blume 375 end
626 :     end

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