[MLton-commit] r4362
Matthew Fluet
MLton@mlton.org
Sat, 25 Feb 2006 05:52:34 -0800
Merge trunk revisions 4345:4361 into x86_64 branch
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-mlbs.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
U mlton/branches/on-20050822-x86_64-branch/package/debian/control
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig 2006-02-16 19:34:54 UTC (rev 4361)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig 2006-02-25 13:52:33 UTC (rev 4362)
@@ -94,7 +94,7 @@
val name: ('args, 'st) t -> string
datatype ('a, 'b) parseResult =
- Bad | Deprecated of 'a | Good of 'b
+ Bad | Deprecated of 'a | Good of 'b | Other
structure Id :
sig
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml 2006-02-16 19:34:54 UTC (rev 4361)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml 2006-02-25 13:52:33 UTC (rev 4362)
@@ -174,7 +174,7 @@
fun equalsId (ctrl, id') = Id.equals (id ctrl, id')
datatype ('a, 'b) parseResult =
- Bad | Deprecated of 'a | Good of 'b
+ Bad | Deprecated of 'a | Good of 'b | Other
val deGood =
fn Good z => z
| _ => Error.bug "Control.Elaborate.deGood"
@@ -532,6 +532,25 @@
val {parseId, parseIdAndArgs} = ac
end
+ local
+ fun checkPrefix (s, f) =
+ case String.peeki (s, fn (_, c) => c = #":") of
+ NONE => f s
+ | SOME (i, _) =>
+ let
+ val comp = String.prefix (s, i)
+ val comp = String.deleteSurroundingWhitespace comp
+ val s = String.dropPrefix (s, i + 1)
+ in
+ if String.equals (comp, "mlton")
+ then f s
+ else Other
+ end
+ in
+ val parseId = fn s => checkPrefix (s, parseId)
+ val parseIdAndArgs = fn s => checkPrefix (s, parseIdAndArgs)
+ end
+
val processDefault = fn s =>
case parseIdAndArgs s of
Bad => Bad
@@ -540,6 +559,7 @@
(alts, Deprecated (List.map (alts, #1)), fn ((_,args),res) =>
if Args.processDef args then res else Bad)
| Good (_, args) => if Args.processDef args then Good () else Bad
+ | Other => Bad
val processEnabled = fn (s, b) =>
case parseId s of
@@ -549,6 +569,7 @@
(alts, Deprecated alts, fn (id,res) =>
if Id.setEnabled (id, b) then res else Bad)
| Good id => if Id.setEnabled (id, b) then Good () else Bad
+ | Other => Bad
val withDef : (unit -> 'a) -> 'a = fn f =>
let
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-mlbs.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-mlbs.fun 2006-02-16 19:34:54 UTC (rev 4361)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-mlbs.fun 2006-02-25 13:52:33 UTC (rev 4362)
@@ -261,6 +261,7 @@
else elabBasdec basdec,
restore)
end
+ | Other => elabBasdec basdec
end) basdec
val _ = withDef (fn () => elabBasdec mlb)
in
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun 2006-02-16 19:34:54 UTC (rev 4361)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun 2006-02-25 13:52:33 UTC (rev 4362)
@@ -126,6 +126,8 @@
concat ["Warning: ", "deprecated annotation: ", s, ". Use ",
List.toString Control.Elaborate.Id.name ids, ".\n"])
| Control.Elaborate.Good () => ()
+ | Control.Elaborate.Other =>
+ usage (concat ["invalid -", flag, " flag: ", s])
open Control Popt
fun push r = SpaceString (fn s => List.push (r, s))
datatype z = datatype MLton.Platform.Arch.t
@@ -616,7 +618,7 @@
| SOME n => n)}
| Native =>
if isSome (!coalesce)
- then usage "can't use -coalesce and -native true"
+ then usage "can't use -coalesce and -codegen native"
else ChunkPerFunc)
val _ = if not (!Control.codegen = Native) andalso !Native.IEEEFP
then usage "must use native codegen with -ieee-fp true"
@@ -772,7 +774,6 @@
(gcc,
List.concat
[targetOpts,
- ["-std=gnu99"],
["-o", output],
if !debug then gccDebug else [],
inputs,
@@ -798,6 +799,59 @@
in
()
end
+ fun mkOutputO (c: Counter.t, input: File.t): File.t =
+ if stop = Place.O orelse !keepO
+ then
+ if !keepGenerated
+ orelse start = Place.Generated
+ then
+ concat [File.base input,
+ ".o"]
+ else
+ suffix
+ (concat [".",
+ Int.toString
+ (Counter.next c),
+ ".o"])
+ else temp ".o"
+ fun compileC (c: Counter.t, input: File.t): File.t =
+ let
+ val (debugSwitches, switches) =
+ (gccDebug @ ["-DASSERT=1"], ccOpts)
+ val switches =
+ if !debug
+ then debugSwitches @ switches
+ else switches
+ val switches =
+ targetOpts @ ("-std=gnu99" :: "-c" :: switches)
+ val output = mkOutputO (c, input)
+ val _ =
+ System.system
+ (gcc,
+ List.concat [switches,
+ ["-o", output, input]])
+ in
+ output
+ end
+ fun compileS (c: Counter.t, input: File.t): File.t =
+ let
+ val (debugSwitches, switches) =
+ ([asDebug], asOpts)
+ val switches =
+ if !debug
+ then debugSwitches @ switches
+ else switches
+ val switches =
+ targetOpts @ ("-c" :: switches)
+ val output = mkOutputO (c, input)
+ val _ =
+ System.system
+ (gcc,
+ List.concat [switches,
+ ["-o", output, input]])
+ in
+ output
+ end
fun compileCSO (inputs: File.t list): unit =
if List.forall (inputs, fn f =>
SOME "o" = File.extension f)
@@ -806,7 +860,7 @@
let
val c = Counter.new 0
val oFiles =
- trace (Top, "Compile C and Assemble")
+ trace (Top, "Compile and Assemble")
(fn () =>
List.fold
(inputs, [], fn (input, ac) =>
@@ -815,45 +869,15 @@
in
if SOME "o" = extension
then input :: ac
- else
- let
- val (debugSwitches, switches) =
- if SOME "c" = extension
- then
- (gccDebug @ ["-DASSERT=1"],
- ccOpts)
- else ([asDebug], asOpts)
- val switches =
- if !debug
- then debugSwitches @ switches
- else switches
- val switches =
- targetOpts @ ("-std=gnu99" :: "-c" :: switches)
- val output =
- if stop = Place.O orelse !keepO
- then
- if !keepGenerated
- orelse start = Place.Generated
- then
- concat [String.dropSuffix
- (input, 1),
- "o"]
- else
- suffix
- (concat [".",
- Int.toString
- (Counter.next c),
- ".o"])
- else temp ".o"
- val _ =
- System.system
- (gcc,
- List.concat [switches,
- ["-o", output, input]])
-
- in
- output :: ac
- end
+ else if SOME "c" = extension
+ then (compileC (c, input)) :: ac
+ else if SOME "s" = extension
+ orelse SOME "S" = extension
+ then (compileS (c, input)) :: ac
+ else Error.bug
+ (concat
+ ["invalid extension: ",
+ Option.toString (fn s => s) extension])
end))
()
in
Modified: mlton/branches/on-20050822-x86_64-branch/package/debian/control
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/package/debian/control 2006-02-16 19:34:54 UTC (rev 4361)
+++ mlton/branches/on-20050822-x86_64-branch/package/debian/control 2006-02-25 13:52:33 UTC (rev 4362)
@@ -7,7 +7,7 @@
Package: mlton
Architecture: hppa i386 powerpc sparc
-Depends: ${shlibs:Depends}, gcc, libgmp3-dev (>= 4.0.1)
+Depends: ${shlibs:Depends}, gcc, libc6-dev, libgmp3-dev (>= 4.0.1)
Description: Optimizing compiler for Standard ML
MLton (mlton.org) is a whole-program optimizing
compiler for Standard ML. MLton generates