(* Main.sml *) open List BasicIO Nonstdio;open Miscsys Memory Fnlib Config Mixture Location Units Smlperv Rtvals Smltop;open Types (* cvr *);val initialFiles = ref ([] : string list); (* Initial loop *) fun initial_loop () = while true do let in msgFlush(); (case !initialFiles of [] => raise Toplevel | filename :: rest => (initialFiles := rest; evalUse filename)) handle Toplevel => (msgFlush(); raise EndOfFile) | Interrupt => (msgIBlock 0; msgPrompt "Interrupted."; msgEOL(); msgEBlock(); msgFlush(); raise EndOfFile) | x => (msgFlush(); raise x) end; (* Main loop *) fun main_loop () = while true do let in msgFlush(); if !Exec_phr.quietdec then () else outputc std_out toplevel_input_prompt; flush_out std_out; let val isLast = loadToplevelPhrase (!input_lexbuf) in if isLast then raise EndOfFile else () end handle EndOfFile => (msgIBlock 0; msgEOL(); msgEBlock (); msgFlush(); BasicIO.exit 0) | Toplevel => msgFlush() | Interrupt => (msgIBlock 0; msgPrompt "Interrupted."; msgEOL(); msgEBlock(); msgFlush()) | x => (msgFlush(); raise x) end; fun anonymous s = initialFiles := !initialFiles @ [s]; fun set_stdlib p = path_library := p; fun set_value_polymorphism b _ = value_polymorphism := b; fun set_quietdec b _ = Exec_phr.quietdec := b; fun add_include d = load_path := !load_path @ [d]; fun perv_set set' = let val set = Fnlib.stringToLower set' in if set = "none" then (preloadedUnits := []; preopenedPreloadedUnits := []) else (preloadedUnits := lookup set preloadedUnitSets @ ["Help"]; preopenedPreloadedUnits := lookup set preopenedPreloadedUnitSets @ ["Help"]) handle Subscript => raise Arg.Bad ("Unknown preloaded unit set " ^ set) end fun set_msgstyle p = if exists (fn x => x = p) ["default", "msdev"] then msgStyle := p else raise Arg.Bad ("Unknown message style " ^ p); fun orthodox () = currentCompliance := Orthodox;fun conservative () = currentCompliance := Conservative;fun liberal () = currentCompliance := Liberal; fun main () =( let in perv_set "default"; load_path := []; toplevel := true; (* Choose the default (value polymorphism or imperative types) here: *) value_polymorphism := true; (* Choose the default SML compliance checks here *) currentCompliance := Liberal; Arg.parse [("-stdlib", Arg.String set_stdlib), ("-I", Arg.String add_include), ("-include", Arg.String add_include), ("-P", Arg.String perv_set), ("-perv", Arg.String perv_set), ("-imptypes", Arg.Unit (set_value_polymorphism false)), ("-valuepoly", Arg.Unit (set_value_polymorphism true)), ("-quietdec", Arg.Unit (set_quietdec true)), ("-msgstyle", Arg.String set_msgstyle), ("-m", Arg.String set_msgstyle), ("-orthodox", Arg.Unit orthodox), ("-conservative", Arg.Unit conservative), ("-liberal", Arg.Unit liberal) ] anonymous; if !Exec_phr.quietdec then () else (msgIBlock 0; msgString ("Moscow ML version "^Config.version); msgEOL(); msgString "Enter `quit();' to quit."; msgEOL(); msgEBlock(); msgFlush()); if !path_library <> "" then load_path := !load_path @ [!path_library] else (); resetGlobalDynEnv(); resetSMLTopDynEnv(); initPervasiveEnvironments(); setGlobalVal 16 (Obj.repr true); (* 16: cf ../runtime/globals.h *) startCompilingUnit "Top" "" TOPDECmode; app evalLoad (!preloadedUnits); initInitialEnvironments []; execToplevelOpen nilLocation "Meta"; resetTypePrinter(); (* cvr *) Miscsys.catch_interrupt true; input_lexbuf := Compiler.createLexerStream std_in; (initial_loop() handle EndOfFile => ()); main_loop() end handle Toplevel => (msgFlush(); BasicIO.exit 2) | Impossible msg => (msgIBlock 0; errPrompt "Internal error: "; msgString msg; msgEOL(); msgEBlock(); msgFlush(); BasicIO.exit 4)); val () = Printexc.f main ();
(* Main.sml *)
open List BasicIO Nonstdio;
open Miscsys Memory Fnlib Config Mixture Location Units Smlperv Rtvals Smltop;
open Types (* cvr *);
val initialFiles = ref ([] : string list);
(* Initial loop *)
fun initial_loop () =
while true do
let in
msgFlush();
(case !initialFiles of
[] =>
raise Toplevel
| filename :: rest =>
(initialFiles := rest;
evalUse filename))
handle
Toplevel =>
(msgFlush();
raise EndOfFile)
| Interrupt =>
(msgIBlock 0;
msgPrompt "Interrupted."; msgEOL();
msgEBlock();
msgFlush();
raise EndOfFile)
| x =>
(msgFlush();
raise x)
end
;
(* Main loop *)
fun main_loop () =
while true do
let in
msgFlush();
if !Exec_phr.quietdec then () else outputc std_out toplevel_input_prompt;
flush_out std_out;
let val isLast = loadToplevelPhrase (!input_lexbuf) in
if isLast then raise EndOfFile else ()
end
handle
EndOfFile =>
(msgIBlock 0; msgEOL(); msgEBlock ();
msgFlush(); BasicIO.exit 0)
| Toplevel =>
msgFlush()
| Interrupt =>
(msgIBlock 0;
msgPrompt "Interrupted.";
msgEOL(); msgEBlock(); msgFlush())
| x =>
(msgFlush();
raise x)
end
;
fun anonymous s =
initialFiles := !initialFiles @ [s];
fun set_stdlib p =
path_library := p;
fun set_value_polymorphism b _ =
value_polymorphism := b;
fun set_quietdec b _ =
Exec_phr.quietdec := b;
fun add_include d =
load_path := !load_path @ [d];
fun perv_set set' =
let val set = Fnlib.stringToLower set'
in
if set = "none" then
(preloadedUnits := []; preopenedPreloadedUnits := [])
else
(preloadedUnits :=
lookup set preloadedUnitSets @ ["Help"];
preopenedPreloadedUnits :=
lookup set preopenedPreloadedUnitSets @ ["Help"])
handle Subscript =>
raise Arg.Bad ("Unknown preloaded unit set " ^ set)
end
fun set_msgstyle p =
if exists (fn x => x = p) ["default", "msdev"] then
msgStyle := p
else
raise Arg.Bad ("Unknown message style " ^ p)
;
fun orthodox () = currentCompliance := Orthodox;
fun conservative () = currentCompliance := Conservative;
fun liberal () = currentCompliance := Liberal;
fun main () =
(
let in
perv_set "default";
load_path := [];
toplevel := true;
(* Choose the default (value polymorphism or imperative types) here: *)
value_polymorphism := true;
(* Choose the default SML compliance checks here *)
currentCompliance := Liberal;
Arg.parse [("-stdlib", Arg.String set_stdlib),
("-I", Arg.String add_include),
("-include", Arg.String add_include),
("-P", Arg.String perv_set),
("-perv", Arg.String perv_set),
("-imptypes", Arg.Unit (set_value_polymorphism false)),
("-valuepoly", Arg.Unit (set_value_polymorphism true)),
("-quietdec", Arg.Unit (set_quietdec true)),
("-msgstyle", Arg.String set_msgstyle),
("-m", Arg.String set_msgstyle),
("-orthodox", Arg.Unit orthodox),
("-conservative", Arg.Unit conservative),
("-liberal", Arg.Unit liberal)
]
anonymous;
if !Exec_phr.quietdec then ()
else
(msgIBlock 0;
msgString ("Moscow ML version "^Config.version);
msgEOL();
msgString "Enter `quit();' to quit.";
msgEOL();
msgEBlock();
msgFlush());
if !path_library <> "" then
load_path := !load_path @ [!path_library]
else ();
resetGlobalDynEnv();
resetSMLTopDynEnv();
initPervasiveEnvironments();
setGlobalVal 16 (Obj.repr true); (* 16: cf ../runtime/globals.h *)
startCompilingUnit "Top" "" TOPDECmode;
app evalLoad (!preloadedUnits);
initInitialEnvironments [];
execToplevelOpen nilLocation "Meta";
resetTypePrinter(); (* cvr *)
Miscsys.catch_interrupt true;
input_lexbuf := Compiler.createLexerStream std_in;
(initial_loop() handle EndOfFile => ());
main_loop()
end
handle
Toplevel =>
(msgFlush(); BasicIO.exit 2)
| Impossible msg =>
(msgIBlock 0;
errPrompt "Internal error: "; msgString msg;
msgEOL(); msgEBlock(); msgFlush();
BasicIO.exit 4)
);
val () = Printexc.f main ();