home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / compiler / Maint.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  3.1 KB  |  128 lines  |  [TEXT/R*ch]
  1. (* Main.sml *)
  2.  
  3. open List BasicIO Nonstdio;
  4. open Miscsys Memory Fnlib Config Mixture Location Units Smlperv Rtvals Smltop;
  5.  
  6. val initialFiles = ref ([] : string list);
  7.  
  8. (* Initial loop *)
  9.  
  10. fun initial_loop () =
  11.   while true do
  12.     let in
  13.       msgFlush();
  14.       (case !initialFiles of
  15.            [] =>
  16.              raise Toplevel
  17.          | filename :: rest =>
  18.              (initialFiles := rest;
  19.               evalUse filename))
  20.       handle
  21.           Toplevel =>
  22.             (msgFlush();
  23.              raise EndOfFile)
  24.         | Interrupt =>
  25.             (msgIBlock 0;
  26.              msgPrompt "Interrupted."; msgEOL();
  27.              msgEBlock();
  28.              msgFlush();
  29.              raise EndOfFile)
  30.         | x =>
  31.            (msgFlush();
  32.             raise x)
  33.     end
  34. ;
  35.  
  36. (* Main loop *)
  37.  
  38. fun main_loop () =
  39.   while true do
  40.     let in
  41.       msgFlush();
  42.       outputc std_out toplevel_input_prompt;
  43.       flush_out std_out;
  44.       let val isLast = loadToplevelPhrase (!input_lexbuf) in
  45.         if isLast then raise EndOfFile else ()
  46.       end
  47.       handle
  48.           EndOfFile =>
  49.               (msgFlush(); BasicIO.exit 0)
  50.         | Toplevel =>
  51.             msgFlush()
  52.         | Interrupt =>
  53.             (msgIBlock 0;
  54.              msgPrompt "Interrupted.";
  55.              msgEOL(); msgEBlock(); msgFlush())
  56.         | x =>
  57.             (msgFlush();
  58.              raise x)
  59.     end
  60. ;
  61.  
  62. fun anonymous s =
  63.   initialFiles := !initialFiles @ [s]
  64. ;
  65.  
  66. fun set_stdlib p =
  67.   path_library := p;
  68. ;
  69.  
  70. fun add_include d =
  71.   load_path := !load_path @ [d]
  72. ;
  73.  
  74. fun perv_set set =
  75.   (preloadedUnits := lookup set preloadedUnitSets;
  76.    preopenedPreloadedUnits := lookup set preopenedPreloadedUnitSets)
  77.   handle Subscript =>
  78.     raise (Arg.Bad ("unknown preloaded unit set " ^ set))
  79. ;
  80.  
  81. fun main () =
  82. (
  83.   msgIBlock 0;
  84.   msgString "Moscow ML version 1.31 (15 October 1995)";
  85.   msgEOL();
  86.   msgString "Enter `quit();' to quit.";
  87.   msgEOL();
  88.   msgEBlock();
  89.   msgFlush();
  90.   let in
  91.     preloadedUnits := lookup "default" preloadedUnitSets;
  92.     preopenedPreloadedUnits := lookup "default" preopenedPreloadedUnitSets;
  93.     load_path := [];
  94.     toplevel := true;
  95.     Arg.parse [("-stdlib", Arg.String set_stdlib),
  96.                ("-I", Arg.String add_include),
  97.                ("-include", Arg.String add_include),
  98.                ("-P", Arg.String perv_set),
  99.                ("-perv", Arg.String perv_set)]
  100.       anonymous;
  101.     if !path_library <> "" then
  102.       load_path := !load_path @ [!path_library]
  103.     else ();
  104.     resetGlobalDynEnv();
  105.     resetSMLTopDynEnv();
  106.     initPervasiveEnvironments();
  107.     setGlobalVal 16 (Obj.repr true); (* 16: cf ../runtime/globals.h *)
  108.     startCompilingUnit "Top";
  109.     app evalLoad (!preloadedUnits);
  110.     initInitialEnvironments();
  111.     execToplevelOpen nilLocation "Meta";
  112.     Miscsys.catch_interrupt true;
  113.     input_lexbuf := Compiler.createLexerStream std_in;
  114.     (initial_loop() handle EndOfFile => ());
  115.     main_loop()
  116.   end
  117.   handle
  118.       Toplevel =>
  119.         (msgFlush(); BasicIO.exit 2)
  120.     | Impossible msg =>
  121.         (msgIBlock 0;
  122.          errPrompt "Internal error: "; msgString msg;
  123.          msgEOL(); msgEBlock(); msgFlush();
  124.          BasicIO.exit 4)
  125. );
  126.  
  127. val () = Printexc.f main ();
  128.