143 lines · 3.3 KB · Standard ML
RawDownload
(* The Caml Light linker. Command-line parsing. *) local  open List Fnlib Config Mixture Symtable Link;in val object_files = ref ([] : string list);val exec_file = ref default_exec_name; fun anonymous s =  let val name =    if Filename.check_suffix s ".sml" then      Filename.chop_suffix s ".sml" ^ ".uo"    else if Filename.check_suffix s ".uo" then      s    else      raise Arg.Bad ("Don't know what to do with file "^s)  in    object_files := name :: !object_files  end; fun set_stdlib p =  path_library := p;; 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 := []	else	    (preloadedUnits          := lookup set preloadedUnitSets)	    handle Subscript =>		raise Arg.Bad ("Unknown preloaded unit set " ^ set)    end; fun set_debug () =  write_symbols := true; fun set_noheader () =  no_header := true; fun set_standalone () =  stand_alone := true; fun unset_autolink () =  Link.autolink := false; fun set_verbose () =  Link.verbose := true; fun set_exec_file e =  exec_file := e; fun show_version() =(  msgIBlock 0;  msgString ("Moscow ML linker version "^Config.version);  msgEOL();  msgString "Based in part on Caml Light";  msgEOL();  msgEBlock();  msgFlush();  BasicIO.exit 0); fun process_include filename =  List.app anonymous (Readword.from_file filename); fun main() =(  Miscsys.catch_interrupt true;  perv_set "default";  load_path := [];  reset_linker_tables();  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),             ("-noautolink", Arg.Unit unset_autolink),             ("-i",          Arg.Unit set_verbose),             ("-g",          Arg.Unit set_debug),             ("-debug",      Arg.Unit set_debug),             ("-noheader",   Arg.Unit set_noheader),             ("-standalone", Arg.Unit set_standalone),             ("-o",          Arg.String set_exec_file),             ("-exec",       Arg.String set_exec_file),             ("-v",          Arg.Unit show_version),             ("-version",    Arg.Unit show_version),             ("-files",      Arg.String process_include),             ("-",           Arg.String anonymous)            ] anonymous;  if !path_library <> "" then    load_path := !load_path @ [!path_library]  else ();  if null (!object_files) then    show_version()  else ();  object_files :=    (map (fn uname => uname ^".uo") (!preloadedUnits))    @ (rev (!object_files));  link (!object_files) (!exec_file);  msgFlush();  BasicIO.exit 0 ) handle    Toplevel =>      (msgFlush(); BasicIO.exit 2)  | Interrupt =>      (msgIBlock 0;       errPrompt "Interrupted."; msgEOL();       msgEBlock();       msgFlush();       BasicIO.exit 3)  | Impossible msg =>      (msgIBlock 0;       errPrompt "Internal error: "; msgString msg; msgEOL();       msgEBlock();       msgFlush();       BasicIO.exit 4)  | Fail msg =>      (msgIBlock 0;       errPrompt msg; msgEOL();       msgEBlock();       msgFlush();       BasicIO.exit 2); val () = Printexc.f main (); end;