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 1712 - (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 : mblume 1712 * ((string -> unit) -> (string -> unit))
20 :     (* errorwrap *)
21 : mblume 1393 * ({ manageImport:
22 :     Ast.dec * EnvRef.envref -> unit,
23 :     managePrint:
24 :     Symbol.symbol * EnvRef.envref -> unit,
25 :     getPending : unit -> Symbol.symbol list }
26 :     -> unit)
27 : blume 905 -> (unit -> unit) option
28 : blume 645 val cmbmake: string * bool -> unit) :> BOOTENV = struct
29 : blume 573
30 :     exception BootFailure
31 :    
32 :     (* To be able to use ml-yacc and ml-lex at -rebuild time it is necessary
33 :     * to force their plugins to be _always_ plugged in. We achieve this
34 :     * by simply mentioning the structure names here. *)
35 :     structure YaccTool = YaccTool and LexTool = LexTool
36 : blume 756 (* The classifier for dir-tool.cm must also be registered permanently... *)
37 :     structure DirToolClassify = DirToolClassify
38 : blume 573
39 :     structure DynE = DynamicEnv
40 : blume 879 structure Print = Control.Print
41 : blume 573
42 :     fun say s = (Print.say s; Print.flush ())
43 :     fun die s = (say s; raise BootFailure)
44 :    
45 :     (* just run CMB.make to make a new set of binfiles... *)
46 : blume 645 fun recompile (bindir, light) =
47 : blume 573 (say (concat ["[building new binfiles in ", bindir, "]\n"]);
48 : blume 645 cmbmake (bindir, light);
49 : blume 573 OS.Process.exit OS.Process.success)
50 :    
51 :     local
52 :     structure U = Unsafe
53 :     in
54 :     fun initialize (bootdir, er) = let
55 :     fun mkDE (U.NILrde, de) = de
56 :     | mkDE (U.CONSrde (rawdynpid, obj, rest), de) = let
57 : blume 879 val dynpid = PersStamps.fromBytes rawdynpid
58 : blume 573 in
59 :     mkDE (rest, DynE.bind (dynpid, obj, de))
60 :     end
61 :     val de = mkDE (!U.pStruct, DynE.empty)
62 : mblume 1712 fun errorwrap u f x =
63 :     Backend.Interact.withErrorHandling u
64 :     { thunk = fn () => f x,
65 :     flush = fn () => (),
66 :     cont = fn e => raise e }
67 : blume 573 in
68 :     U.pStruct := U.NILrde;
69 : blume 905 cminit (bootdir, de, er,
70 :     Backend.Interact.useStream,
71 : mblume 1712 errorwrap false Backend.Interact.useFile,
72 :     errorwrap true,
73 : mblume 1393 Backend.Interact.installCompManagers)
74 : blume 573 end
75 :     end
76 :    
77 :     fun init bootdir = let
78 :     (* grab relevant command line arguments... *)
79 : blume 645 fun caseArg arg cases dfl = let
80 :     fun loop [] = dfl ()
81 :     | loop ({ prefix, action } :: l) =
82 :     if String.isPrefix prefix arg then
83 :     action (String.extract (arg, size prefix, NONE))
84 :     else loop l
85 :     in
86 :     loop cases
87 :     end
88 :    
89 : blume 573 fun bootArgs ([], newbindir, heapfile, er) = (newbindir, heapfile, er)
90 :     | bootArgs ("@SMLbare" :: rest, newbindir, heapfile, _) =
91 :     bootArgs (rest, newbindir, heapfile, BARE)
92 :     | bootArgs (head :: rest, newbindir, heapfile, er) =
93 : blume 645 caseArg head
94 :     [{ prefix = "@SMLheap=",
95 :     action = fn hf => bootArgs (rest, newbindir, hf, er) },
96 :     { prefix = "@SMLrebuild=",
97 :     action = fn nbd =>
98 :     bootArgs (rest, SOME (nbd, false),
99 :     heapfile, er) },
100 :     { prefix = "@SMLlightrebuild=",
101 :     action = fn nbd =>
102 :     bootArgs (rest, SOME (nbd, true),
103 :     heapfile, er) }]
104 :     (fn () => bootArgs (rest, newbindir, heapfile, er))
105 : blume 573
106 :     val (newbindir, heapfile, er) =
107 :     bootArgs (SMLofNJ.getAllArgs (),
108 :     NONE,
109 :     "sml." ^ architecture,
110 :     AUTOLOAD)
111 :     in
112 :     case newbindir of
113 :     NONE => let
114 :     val procCmdLine = initialize (bootdir, er)
115 :     in
116 :     { heapfile = heapfile, procCmdLine = procCmdLine }
117 :     end
118 : blume 645 | SOME (nbd, light) => let
119 :     val nbd = OS.Path.mkCanonical nbd
120 :     in
121 : blume 573 if nbd = bootdir then
122 :     die "@SMLboot= and @SMLrebuild= name the same directory\n"
123 : blume 645 else recompile (nbd, light)
124 :     end
125 : blume 573 end
126 :     end

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