[MLton-commit] r6883
Wesley Terpstra
wesley at mlton.org
Tue Sep 23 08:00:29 PDT 2008
Added an explicit control (-libname) to set the library name instead of
guessing it from -export-header. libname controls the libname_{open,close}
function names as well as the PART_OF_LIBRARY_libname macro in the header.
If libname is not set, it is inferred from the output by stripping the
extension and any prefixing "lib".
If there is no export-header set, it will be automatically set to libname.h
When building a library, assume -default-ann "allowFFI true".
When outputting to a DLL the -output switch controls the import library,
while the libname controls the dll/def file names. eg:
foo.dll, foo.def, foo_{open,close} <= controlled by libname
libfoo.a <= controlled by output
With these settings,
mlton -format library libfoo.sml
will do the "right thing (TM)" on every platform MLton supports.
=> foo.h, foo_{open,close}, (libfoo.so | foo.dll, foo.def, libfoo.a)
----------------------------------------------------------------------
U mlton/trunk/mlton/control/control-flags.sig
U mlton/trunk/mlton/control/control-flags.sml
U mlton/trunk/mlton/main/compile.fun
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig 2008-09-23 13:43:32 UTC (rev 6882)
+++ mlton/trunk/mlton/control/control-flags.sig 2008-09-23 15:00:28 UTC (rev 6883)
@@ -215,6 +215,9 @@
(* lib/mlton/target directory *)
val libTargetDir: Dir.t ref
+
+ (* name of the output library *)
+ val libname : string ref
(* Number of times to loop through optimization passes. *)
val loopPasses: int ref
Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml 2008-09-23 13:43:32 UTC (rev 6882)
+++ mlton/trunk/mlton/control/control-flags.sml 2008-09-23 15:00:28 UTC (rev 6883)
@@ -765,6 +765,8 @@
default = "<libTargetDir unset>",
toString = fn s => s}
+val libname = ref ""
+
val loopPasses = control {name = "loop passes",
default = 1,
toString = Int.toString}
Modified: mlton/trunk/mlton/main/compile.fun
===================================================================
--- mlton/trunk/mlton/main/compile.fun 2008-09-23 13:43:32 UTC (rev 6882)
+++ mlton/trunk/mlton/main/compile.fun 2008-09-23 15:00:28 UTC (rev 6883)
@@ -417,15 +417,19 @@
File.withOut
(f, fn out =>
let
+ fun print s = Out.output (out, s)
+ val libname = !Control.libname
+ val libcap = CharVector.map Char.toUpper libname
+ val _ = print ("#ifndef __" ^ libcap ^ "_ML_H__\n")
+ val _ = print ("#define __" ^ libcap ^ "_ML_H__\n")
+ val _ = print "\n"
val _ =
File.outputContents
(concat [!Control.libDir, "/include/ml-types.h"], out)
+ val _ = print "\n"
val _ =
File.outputContents
(concat [!Control.libDir, "/include/export.h"], out)
- fun print s = Out.output (out, s)
- val lib = File.base f
- val libcap = CharVector.map Char.toUpper lib
val _ = print "\n"
val _ =
if !Control.format = Control.Executable
@@ -440,12 +444,14 @@
val _ = print "\n"
val _ =
if !Control.format = Control.Executable then () else
- (print ("MLLIB_PUBLIC(void " ^ lib ^ "_open(int argc, const char** argv);)\n")
- ;print ("MLLIB_PUBLIC(void " ^ lib ^ "_close();)\n"))
+ (print ("MLLIB_PUBLIC(void " ^ libname ^ "_open(int argc, const char** argv);)\n")
+ ;print ("MLLIB_PUBLIC(void " ^ libname ^ "_close();)\n"))
val _ = Ffi.declareHeaders {print = print}
val _ = print "\n"
val _ = print "#undef MLLIB_PRIVATE\n"
val _ = print "#undef MLLIB_PUBLIC\n"
+ val _ = print "\n"
+ val _ = print ("#endif /* __" ^ libcap ^ "_ML_H__ */\n")
in
()
end)
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2008-09-23 13:43:32 UTC (rev 6882)
+++ mlton/trunk/mlton/main/main.fun 2008-09-23 15:00:28 UTC (rev 6883)
@@ -472,6 +472,8 @@
in List.push (keepPasses, re)
end
| NONE => usage (concat ["invalid -keep-pass flag: ", s])))),
+ (Expert, "libname", " <basename>", "the name of the generated library",
+ SpaceString (fn s => libname := s)),
(Normal, "link-opt", " <opt>", "pass option to linker",
(SpaceString o tokenizeOpt)
(fn s => List.push (linkOpts, {opt = s, pred = OptPred.Yes}))),
@@ -824,6 +826,12 @@
val targetOS = !Target.os
val OSStr = String.toLower (MLton.Platform.OS.toString targetOS)
+ (* It doesn't make sense to have a library without FFI *)
+ val () =
+ case !format of
+ Executable => ()
+ | _ => ignore (Control.Elaborate.processDefault "allowFFI true")
+
(* Determine whether code should be PIC (position independent) or not.
* This decision depends on the platform and output format.
*)
@@ -1150,10 +1158,23 @@
case !output of
NONE => suffix suf
| SOME f => f
- fun libname () =
- case !exportHeader of
- NONE => "lib"
- | SOME f => File.base f
+ val { base = outputBase, ext=_ } =
+ OS.Path.splitBaseExt (maybeOut ".ext")
+ val { file = defLibname, dir=_ } =
+ OS.Path.splitDirFile outputBase
+ val defLibname =
+ if String.hasPrefix (defLibname, {prefix = "lib"})
+ then String.extract (defLibname, 3, NONE)
+ else defLibname
+ val () =
+ if !libname <> "" then () else
+ libname := defLibname
+ (* Library output includes a header by default *)
+ val () =
+ case (!format, !exportHeader) of
+ (Executable, _) => ()
+ | (_, NONE) => exportHeader := SOME (!libname ^ ".h")
+ | _ => ()
val _ =
atMLtons :=
Vector.fromList
@@ -1174,27 +1195,22 @@
| StabsPlus => (["-gstabs+", "-g2"], "-Wa,--gstabs")
fun compileO (inputs: File.t list): unit =
let
- val libExt =
- case targetOS of
- Darwin => ".dylib"
- | MinGW => ".dll"
- | _ => ".so"
val output =
- case !format of
- Archive => maybeOut ".a"
- | Executable => maybeOut ""
- | LibArchive => maybeOut ".a"
- | Library => maybeOut libExt
- val { base = outputBase, ext=_ } =
- OS.Path.splitBaseExt output
+ case (!format, targetOS) of
+ (Archive, _) => maybeOut ".a"
+ | (Executable, _) => maybeOut ""
+ | (LibArchive, _) => maybeOut ".a"
+ | (Library, Darwin) => maybeOut ".dylib"
+ | (Library, MinGW) => !libname ^ ".dll"
+ | (Library, _) => maybeOut ".so"
val libOpts =
case targetOS of
Darwin => [ "-dynamiclib" ]
| MinGW => [ "-shared",
"-Wl,--out-implib," ^
- output ^ ".a",
+ maybeOut ".a",
"-Wl,--output-def," ^
- outputBase ^ ".def"]
+ !libname ^ ".def"]
| _ => [ "-shared" ]
val _ =
trace (Top, "Link")
@@ -1262,7 +1278,7 @@
List.concat
[[ "-std=gnu99", "-c" ],
if !format = Executable
- then [] else [ "-DLIBNAME=" ^ libname () ],
+ then [] else [ "-DLIBNAME=" ^ !libname ],
if positionIndependent
then [ "-fPIC", "-DPIC" ] else [],
if !debug then debugSwitches else [],
More information about the MLton-commit
mailing list