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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 644, Fri May 12 09:18:31 2000 UTC revision 645, Mon May 15 07:17:30 2000 UTC
# Line 15  Line 15 
15                    val architecture: string                    val architecture: string
16                    val cminit : string * DynamicEnv.dynenv * envrequest ->                    val cminit : string * DynamicEnv.dynenv * envrequest ->
17                                 (unit -> unit) option                                 (unit -> unit) option
18                    val cmbmake: string -> unit) :> BOOTENV = struct                    val cmbmake: string * bool -> unit) :> BOOTENV = struct
19    
20      exception BootFailure      exception BootFailure
21    
# Line 31  Line 31 
31      fun die s = (say s; raise BootFailure)      fun die s = (say s; raise BootFailure)
32    
33      (* just run CMB.make to make a new set of binfiles... *)      (* just run CMB.make to make a new set of binfiles... *)
34      fun recompile bindir =      fun recompile (bindir, light) =
35          (say (concat ["[building new binfiles in ", bindir, "]\n"]);          (say (concat ["[building new binfiles in ", bindir, "]\n"]);
36           cmbmake bindir;           cmbmake (bindir, light);
37           OS.Process.exit OS.Process.success)           OS.Process.exit OS.Process.success)
38    
39      local      local
# Line 55  Line 55 
55    
56      fun init bootdir = let      fun init bootdir = let
57          (* grab relevant command line arguments... *)          (* grab relevant command line arguments... *)
58          fun vArg (prefix, arg) =          fun caseArg arg cases dfl = let
59                fun loop [] = dfl ()
60                  | loop ({ prefix, action } :: l) =
61              if String.isPrefix prefix arg then              if String.isPrefix prefix arg then
62                  SOME (String.extract (arg, size prefix, NONE))                      action (String.extract (arg, size prefix, NONE))
63              else NONE                  else loop l
64            in
65                loop cases
66            end
67    
68          fun bootArgs ([], newbindir, heapfile, er) = (newbindir, heapfile, er)          fun bootArgs ([], newbindir, heapfile, er) = (newbindir, heapfile, er)
69            | bootArgs ("@SMLbare" :: rest, newbindir, heapfile, _) =            | bootArgs ("@SMLbare" :: rest, newbindir, heapfile, _) =
70              bootArgs (rest, newbindir, heapfile, BARE)              bootArgs (rest, newbindir, heapfile, BARE)
71            | bootArgs (head :: rest, newbindir, heapfile, er) =            | bootArgs (head :: rest, newbindir, heapfile, er) =
72              (case vArg ("@SMLrebuild=", head) of              caseArg head
73                   nbd as SOME _ => bootArgs (rest, nbd, heapfile, er)                      [{ prefix = "@SMLheap=",
74                 | NONE =>                         action = fn hf => bootArgs (rest, newbindir, hf, er) },
75                       (case vArg ("@SMLheap=", head) of                       { prefix = "@SMLrebuild=",
76                            SOME hf => bootArgs (rest, newbindir, hf, er)                         action = fn nbd =>
77                          | NONE => bootArgs (rest, newbindir, heapfile, er)))                                     bootArgs (rest, SOME (nbd, false),
78                                                 heapfile, er) },
79                         { prefix = "@SMLlightrebuild=",
80                           action = fn nbd =>
81                                       bootArgs (rest, SOME (nbd, true),
82                                                 heapfile, er) }]
83                        (fn () => bootArgs (rest, newbindir, heapfile, er))
84    
85          val (newbindir, heapfile, er) =          val (newbindir, heapfile, er) =
86              bootArgs (SMLofNJ.getAllArgs (),              bootArgs (SMLofNJ.getAllArgs (),
87                        NONE,                        NONE,
88                        "sml." ^ architecture,                        "sml." ^ architecture,
89                        AUTOLOAD)                        AUTOLOAD)
         val newbindir = Option.map OS.Path.mkCanonical newbindir  
90      in      in
91          case newbindir of          case newbindir of
92              NONE => let              NONE => let
# Line 83  Line 94 
94              in              in
95                  { heapfile = heapfile, procCmdLine = procCmdLine }                  { heapfile = heapfile, procCmdLine = procCmdLine }
96              end              end
97            | SOME nbd =>            | SOME (nbd, light) => let
98                    val nbd = OS.Path.mkCanonical nbd
99                in
100                  if nbd = bootdir then                  if nbd = bootdir then
101                      die "@SMLboot= and @SMLrebuild= name the same directory\n"                      die "@SMLboot= and @SMLrebuild= name the same directory\n"
102                  else recompile nbd                  else recompile (nbd, light)
103                end
104      end      end
105  end  end

Legend:
Removed from v.644  
changed lines
  Added in v.645

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