(* 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;
(* 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;