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 / Mainc.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  3.0 KB  |  122 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 add_include d =
  35.   load_path := (!load_path) @ [d]
  36. ;
  37.  
  38. fun perv_set set =
  39.   (preloadedUnits := lookup set preloadedUnitSets;
  40.    preopenedPreloadedUnits := lookup set preopenedPreloadedUnitSets)
  41.   handle Subscript =>
  42.     raise (Arg.Bad ("Unknown preloaded unit set " ^ set))
  43. ;
  44.  
  45. fun show_version() =
  46. (
  47.   msgIBlock 0;
  48.   msgString "Moscow ML compiler, version 1.31 (15 October 1995)";
  49.   msgEOL();
  50.   msgString "Based in part on Caml Light and the ML Kit";
  51.   msgEOL();
  52.   msgEBlock();
  53.   msgFlush();
  54.   BasicIO.exit 0
  55. );
  56.  
  57. fun show_inferred_types() =
  58.   verbose := true
  59. ;
  60.  
  61. fun enable_quotation() =
  62.   Lexer.quotation := true
  63. ;
  64.  
  65. fun main () =
  66. (
  67.   preloadedUnits := lookup "default" preloadedUnitSets;
  68.   preopenedPreloadedUnits := lookup "default" preopenedPreloadedUnitSets;
  69.   load_path := [];
  70.   toplevel := true;
  71.   Arg.parse [("-stdlib",    Arg.String set_stdlib),
  72.              ("-I",         Arg.String add_include),
  73.              ("-include",   Arg.String add_include),
  74.              ("-P",         Arg.String perv_set),
  75.              ("-perv",      Arg.String perv_set),
  76.              ("-v",         Arg.Unit show_version),
  77.              ("-version",   Arg.Unit show_version),
  78.              ("-i",         Arg.Unit show_inferred_types),
  79.              ("-quotation", Arg.Unit enable_quotation),
  80.              ("-q",         Arg.Unit enable_quotation)
  81.              ]
  82.     anonymous;
  83.   if !path_library <> "" then
  84.     load_path := !load_path @ [!path_library]
  85.   else ();
  86.   initPervasiveEnvironments();
  87.   Miscsys.catch_interrupt true;
  88.   if null (!initialFiles) then show_version() else ();
  89.   app compileFile (!initialFiles)
  90. )
  91. handle
  92.     Toplevel =>
  93.       (msgFlush();
  94.        BasicIO.exit 2)
  95.   | Interrupt =>
  96.       (msgIBlock 0;
  97.        errPrompt "Interrupted."; msgEOL();
  98.        msgEBlock();
  99.        msgFlush();
  100.        BasicIO.exit 3)
  101.   | Impossible msg =>
  102.       (msgIBlock 0;
  103.        errPrompt "Internal error: "; msgString msg; msgEOL();
  104.        msgEBlock();
  105.        msgFlush();
  106.        BasicIO.exit 4)
  107.   | Io msg =>
  108.       (msgIBlock 0;
  109.        errPrompt msg; msgEOL();
  110.        msgEBlock();
  111.        msgFlush();
  112.        BasicIO.exit 2)
  113.   | Fail msg =>
  114.       (msgIBlock 0;
  115.        errPrompt msg; msgEOL();
  116.        msgEBlock();
  117.        msgFlush();
  118.        BasicIO.exit 2)
  119. ;
  120.  
  121. val () = Printexc.f main ();
  122.