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 / Mainl.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  2.9 KB  |  124 lines  |  [TEXT/R*ch]
  1. (* The Caml Light linker. Command-line parsing. *)
  2.  
  3. local
  4.   open List Fnlib Config Mixture Symtable Link;
  5. in
  6.  
  7. val object_files = ref ([] : string list);
  8. val exec_file = ref default_exec_name;
  9.  
  10. fun anonymous s =
  11.   let val name =
  12.     if Filename.check_suffix s ".sml" then
  13.       Filename.chop_suffix s ".sml" ^ ".uo"
  14.     else if Filename.check_suffix s ".uo" then
  15.       s
  16.     else
  17.       raise Arg.Bad ("Don't know what to do with file "^s)
  18.   in
  19.     object_files := name :: !object_files
  20.   end;
  21.  
  22. fun set_stdlib p =
  23.   path_library := p;
  24. ;
  25.  
  26. fun add_include d =
  27.   load_path := !load_path @ [d]
  28. ;
  29.  
  30. fun perv_set set =
  31.   preloadedUnits := lookup set preloadedUnitSets
  32.     handle Subscript =>
  33.       raise Arg.Bad ("Unknown preloaded unit set " ^ set)
  34. ;
  35.  
  36. fun set_debug () =
  37.   write_symbols := true
  38. ;
  39.  
  40. fun set_noheader () =
  41.   no_header := true
  42. ;
  43.  
  44. fun set_exec_file e =
  45.   exec_file := e
  46. ;
  47.  
  48. fun show_version() =
  49. (
  50.   msgIBlock 0;
  51.   msgString "Moscow ML linker version 1.31 (15 October 1995)";
  52.   msgEOL();
  53.   msgString "Based in part on Caml Light";
  54.   msgEOL();
  55.   msgEBlock();
  56.   msgFlush();
  57.   BasicIO.exit 0
  58. );
  59.  
  60. fun process_include filename =
  61.   List.app anonymous (Readword.from_file filename)
  62. ;
  63.  
  64. fun main() =
  65. (
  66.   Miscsys.catch_interrupt true;
  67.   preloadedUnits := lookup "default" preloadedUnitSets;
  68.   load_path := [];
  69.   reset_linker_tables();
  70.   Arg.parse [("-stdlib",   Arg.String set_stdlib),
  71.              ("-I",        Arg.String add_include),
  72.              ("-include",  Arg.String add_include),
  73.              ("-P",        Arg.String perv_set),
  74.              ("-perv",     Arg.String perv_set),
  75.              ("-g",        Arg.Unit set_debug),
  76.              ("-debug",    Arg.Unit set_debug),
  77.              ("-noheader", Arg.Unit set_noheader),
  78.              ("-o",        Arg.String set_exec_file),
  79.              ("-exec",     Arg.String set_exec_file),
  80.              ("-v",        Arg.Unit show_version),
  81.              ("-version",  Arg.Unit show_version),
  82.              ("-files",    Arg.String process_include),
  83.              ("-",         Arg.String anonymous)
  84.             ] anonymous;
  85.   if !path_library <> "" then
  86.     load_path := !load_path @ [!path_library]
  87.   else ();
  88.   if null (!object_files) then
  89.     show_version()
  90.   else ();
  91.   object_files :=
  92.     (map (fn uname => uname ^".uo") (!preloadedUnits))
  93.     @ (rev (!object_files));
  94.   link (!object_files) (!exec_file);
  95.   msgFlush();
  96.   BasicIO.exit 0
  97.  
  98. ) handle
  99.     Toplevel =>
  100.       (msgFlush(); BasicIO.exit 2)
  101.   | Interrupt =>
  102.       (msgIBlock 0;
  103.        errPrompt "Interrupted."; msgEOL();
  104.        msgEBlock();
  105.        msgFlush();
  106.        BasicIO.exit 3)
  107.   | Impossible msg =>
  108.       (msgIBlock 0;
  109.        errPrompt "Internal error: "; msgString msg; msgEOL();
  110.        msgEBlock();
  111.        msgFlush();
  112.        BasicIO.exit 4)
  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.  
  123. end;
  124.