170 lines · 4.5 KB · Standard ML
RawDownload
(* 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 ();