home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Mainc.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  3.4 KB  |  132 lines  |  [TEXT/R*ch]
  1. open List Fnlib Config Mixture Location Units Smlperv Compiler;
  2.  
  3. (* Compile a file *)
  4.  
  5. fun compileFile s =
  6.   let val s = normalizedFileName s in
  7.     if Filename.check_suffix s ".sig" then
  8.       let val filename = Filename.chop_suffix s ".sig" in
  9.         compileSignature
  10.           (normalizedUnitName (Filename.basename filename))
  11.           filename
  12.       end
  13.     else if Filename.check_suffix s ".sml" then
  14.       let val filename = Filename.chop_suffix s ".sml" in
  15.         compileUnitBody
  16.           (normalizedUnitName (Filename.basename filename))
  17.           filename
  18.       end
  19.     else
  20.       raise (Fail "unknown file name extension")
  21.   end
  22. ;
  23.  
  24. val initialFiles = ref ([] : string list);
  25.  
  26. fun anonymous s =
  27.   initialFiles := (!initialFiles) @ [s]
  28. ;
  29.  
  30. fun set_stdlib p =
  31.   path_library := p;
  32. ;
  33.  
  34. fun set_value_polymorphism b _ =
  35.   value_polymorphism := b;
  36. ;
  37.  
  38. fun add_include d =
  39.   load_path := (!load_path) @ [d]
  40. ;
  41.  
  42. fun perv_set set =
  43.   (preloadedUnits := lookup (Fnlib.stringToLower set) preloadedUnitSets;
  44.    preopenedPreloadedUnits := lookup (Fnlib.stringToLower set) preopenedPreloadedUnitSets)
  45.   handle Subscript =>
  46.     raise (Arg.Bad ("Unknown preloaded unit set " ^ set))
  47. ;
  48.  
  49. fun show_version() =
  50. (
  51.   msgIBlock 0;
  52.   msgString "Moscow ML compiler, version 1.42 (July 1997)";
  53.   msgEOL();
  54.   msgString "Based in part on Caml Light and the ML Kit";
  55.   msgEOL();
  56.   msgEBlock();
  57.   msgFlush();
  58.   BasicIO.exit 0
  59. );
  60.  
  61. fun show_inferred_types() =
  62.   verbose := true
  63. ;
  64.  
  65. fun enable_quotation() =
  66.   Lexer.quotation := true
  67. ;
  68.  
  69. fun main () =
  70. (
  71.   preloadedUnits := lookup "default" preloadedUnitSets;
  72.   preopenedPreloadedUnits := lookup "default" preopenedPreloadedUnitSets;
  73.   load_path := [];
  74.   toplevel := true;
  75.   (* Choose the default (value polymorphism or imperative types) here: *)
  76.   value_polymorphism := true;
  77.   Arg.parse [("-stdlib",    Arg.String set_stdlib),
  78.              ("-I",         Arg.String add_include),
  79.              ("-include",   Arg.String add_include),
  80.              ("-P",         Arg.String perv_set),
  81.              ("-perv",      Arg.String perv_set),
  82.              ("-v",         Arg.Unit show_version),
  83.              ("-version",   Arg.Unit show_version),
  84.              ("-i",         Arg.Unit show_inferred_types),
  85.              ("-quotation", Arg.Unit enable_quotation),
  86.              ("-q",         Arg.Unit enable_quotation),
  87.              ("-imptypes",  Arg.Unit (set_value_polymorphism false)),
  88.              ("-valuepoly", Arg.Unit (set_value_polymorphism true))
  89.              ]
  90.     anonymous;
  91.   if !path_library <> "" then
  92.     load_path := !load_path @ [!path_library]
  93.   else ();
  94.   initPervasiveEnvironments();
  95.   Miscsys.catch_interrupt true;
  96.   if null (!initialFiles) then show_version() else ();
  97.   app compileFile (!initialFiles);
  98.   msgFlush()
  99. )
  100. handle
  101.     Toplevel =>
  102.       (msgFlush();
  103.        BasicIO.exit 2)
  104.   | Interrupt =>
  105.       (msgIBlock 0;
  106.        errPrompt "Interrupted."; msgEOL();
  107.        msgEBlock();
  108.        msgFlush();
  109.        BasicIO.exit 3)
  110.   | Impossible msg =>
  111.       (msgIBlock 0;
  112.        errPrompt "Internal error: "; msgString msg; msgEOL();
  113.        msgEBlock();
  114.        msgFlush();
  115.        BasicIO.exit 4)
  116.   | SysErr(msg, _) =>
  117.       (msgIBlock 0;
  118.        errPrompt "I/O operation failed: ";
  119.        msgString msg; msgEOL();
  120.        msgEBlock();
  121.        msgFlush();
  122.        BasicIO.exit 2)
  123.   | Fail msg =>
  124.       (msgIBlock 0;
  125.        errPrompt msg; msgEOL();
  126.        msgEBlock();
  127.        msgFlush();
  128.        BasicIO.exit 2)
  129. ;
  130.  
  131. val () = Printexc.f main ();
  132.