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/system/smlnj/internal/boot-env-fn.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/smlnj/internal/boot-env-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 905 - (view) (download)

1 : blume 573 (*
2 :     * Copyright 1996 by Bell Laboratories
3 :     * boot.sml -- bootstrap environments
4 :     *
5 :     * completely redone by M.Blume (5/1998)
6 :     * ... and again in the course of switching over to the new CM
7 :     * (M. Blume, 7/1999)
8 :     *)
9 :     signature BOOTENV = sig
10 :     val init:
11 :     string -> { heapfile: string, procCmdLine: (unit -> unit) option }
12 :     end
13 :    
14 :     functor BootEnvF (datatype envrequest = AUTOLOAD | BARE
15 :     val architecture: string
16 : blume 905 val cminit : string * DynamicEnv.env * envrequest
17 :     * (TextIO.instream -> unit)(* useStream *)
18 :     * (string -> unit) (* useFile *)
19 :     * ((Ast.dec * EnvRef.envref -> unit) -> unit)
20 :     -> (unit -> unit) option
21 : blume 645 val cmbmake: string * bool -> unit) :> BOOTENV = struct
22 : blume 573
23 :     exception BootFailure
24 :    
25 :     (* To be able to use ml-yacc and ml-lex at -rebuild time it is necessary
26 :     * to force their plugins to be _always_ plugged in. We achieve this
27 :     * by simply mentioning the structure names here. *)
28 :     structure YaccTool = YaccTool and LexTool = LexTool
29 : blume 756 (* The classifier for dir-tool.cm must also be registered permanently... *)
30 :     structure DirToolClassify = DirToolClassify
31 : blume 573
32 :     structure DynE = DynamicEnv
33 : blume 879 structure Print = Control.Print
34 : blume 573
35 :     fun say s = (Print.say s; Print.flush ())
36 :     fun die s = (say s; raise BootFailure)
37 :    
38 :     (* just run CMB.make to make a new set of binfiles... *)
39 : blume 645 fun recompile (bindir, light) =
40 : blume 573 (say (concat ["[building new binfiles in ", bindir, "]\n"]);
41 : blume 645 cmbmake (bindir, light);
42 : blume 573 OS.Process.exit OS.Process.success)
43 :    
44 :     local
45 :     structure U = Unsafe
46 :     in
47 :     fun initialize (bootdir, er) = let
48 :     fun mkDE (U.NILrde, de) = de
49 :     | mkDE (U.CONSrde (rawdynpid, obj, rest), de) = let
50 : blume 879 val dynpid = PersStamps.fromBytes rawdynpid
51 : blume 573 in
52 :     mkDE (rest, DynE.bind (dynpid, obj, de))
53 :     end
54 :     val de = mkDE (!U.pStruct, DynE.empty)
55 :     in
56 :     U.pStruct := U.NILrde;
57 : blume 905 cminit (bootdir, de, er,
58 :     Backend.Interact.useStream,
59 :     Backend.Interact.useFile,
60 :     Backend.Interact.installCompManager)
61 : blume 573 end
62 :     end
63 :    
64 :     fun init bootdir = let
65 :     (* grab relevant command line arguments... *)
66 : blume 645 fun caseArg arg cases dfl = let
67 :     fun loop [] = dfl ()
68 :     | loop ({ prefix, action } :: l) =
69 :     if String.isPrefix prefix arg then
70 :     action (String.extract (arg, size prefix, NONE))
71 :     else loop l
72 :     in
73 :     loop cases
74 :     end
75 :    
76 : blume 573 fun bootArgs ([], newbindir, heapfile, er) = (newbindir, heapfile, er)
77 :     | bootArgs ("@SMLbare" :: rest, newbindir, heapfile, _) =
78 :     bootArgs (rest, newbindir, heapfile, BARE)
79 :     | bootArgs (head :: rest, newbindir, heapfile, er) =
80 : blume 645 caseArg head
81 :     [{ prefix = "@SMLheap=",
82 :     action = fn hf => bootArgs (rest, newbindir, hf, er) },
83 :     { prefix = "@SMLrebuild=",
84 :     action = fn nbd =>
85 :     bootArgs (rest, SOME (nbd, false),
86 :     heapfile, er) },
87 :     { prefix = "@SMLlightrebuild=",
88 :     action = fn nbd =>
89 :     bootArgs (rest, SOME (nbd, true),
90 :     heapfile, er) }]
91 :     (fn () => bootArgs (rest, newbindir, heapfile, er))
92 : blume 573
93 :     val (newbindir, heapfile, er) =
94 :     bootArgs (SMLofNJ.getAllArgs (),
95 :     NONE,
96 :     "sml." ^ architecture,
97 :     AUTOLOAD)
98 :     in
99 :     case newbindir of
100 :     NONE => let
101 :     val procCmdLine = initialize (bootdir, er)
102 :     in
103 :     { heapfile = heapfile, procCmdLine = procCmdLine }
104 :     end
105 : blume 645 | SOME (nbd, light) => let
106 :     val nbd = OS.Path.mkCanonical nbd
107 :     in
108 : blume 573 if nbd = bootdir then
109 :     die "@SMLboot= and @SMLrebuild= name the same directory\n"
110 : blume 645 else recompile (nbd, light)
111 :     end
112 : blume 573 end
113 :     end

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