[MLton-commit] r6129
Vesa Karvonen
vesak at mlton.org
Wed Nov 7 06:05:36 PST 2007
Added a new command-line switch:
-mlb-path-var '<name> <value>'
It allows one to specify MLB path variables directly on the command-line.
The main design point is that variables given through the -mlb-path-map
and -mlb-path-var switches are processed in the order in which they are
specified on the command-line. Neither switch has higher precedence than
the other.
----------------------------------------------------------------------
U mlton/trunk/mlton/control/control-flags.sig
U mlton/trunk/mlton/control/control-flags.sml
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig 2007-11-06 20:20:12 UTC (rev 6128)
+++ mlton/trunk/mlton/control/control-flags.sig 2007-11-07 14:05:35 UTC (rev 6129)
@@ -202,7 +202,8 @@
val maxFunctionSize: int ref
- val mlbPathMaps: string list ref
+ val mlbPathVars: {var: string,
+ path: string} list ref
val mlbPathMap: unit -> {var: string,
path: string} list
Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml 2007-11-06 20:20:12 UTC (rev 6128)
+++ mlton/trunk/mlton/control/control-flags.sml 2007-11-07 14:05:35 UTC (rev 6129)
@@ -736,9 +736,13 @@
default = 10000,
toString = Int.toString}
-val mlbPathMaps = control {name = "mlb path maps",
- default = [],
- toString = List.toString (fn s => s)}
+val mlbPathVars =
+ control
+ {name = "mlb path vars",
+ default = [],
+ toString = List.toString
+ (fn {var, path} =>
+ concat ["{var = ", var, ", path = ", path, "}"])}
structure Native =
struct
@@ -1019,59 +1023,43 @@
; Size.set_seqIndex seqIndex)
end
-local
- fun make (file: File.t) =
- if not (File.canRead file) then
- Error.bug (concat ["can't read MLB path map file: ", file])
- else
- List.keepAllMap
- (File.lines file, fn line =>
- if String.forall (line, Char.isSpace)
- then NONE
- else
- case String.tokens (line, Char.isSpace) of
- [var, path] => SOME {var = var, path = path}
- | _ => Error.bug (concat ["strange mlb path mapping: ",
- file, ":: ", line]))
-in
- fun mlbPathMap () =
- List.rev
- (List.concat
- [[{var = "LIB_MLTON_DIR",
- path = !libDir},
- {var = "TARGET_ARCH",
- path = String.toLower (MLton.Platform.Arch.toString
- (!Target.arch))},
- {var = "TARGET_OS",
- path = String.toLower (MLton.Platform.OS.toString
- (!Target.os))},
- {var = "OBJPTR_REP",
- path = (case Bits.toInt (Target.Size.objptr ()) of
- 32 => "objptr-rep32.sml"
- | 64 => "objptr-rep64.sml"
- | _ => Error.bug "Control.mlbPathMap")},
- {var = "HEADER_WORD",
- path = (case Bits.toInt (Target.Size.header ()) of
- 32 => "header-word32.sml"
- | 64 => "header-word64.sml"
- | _ => Error.bug "Control.mlbPathMap")},
- {var = "SEQINDEX_INT",
- path = (case Bits.toInt (Target.Size.seqIndex ()) of
- 32 => "seqindex-int32.sml"
- | 64 => "seqindex-int64.sml"
- | _ => Error.bug "Control.mlbPathMap")},
- {var = "DEFAULT_CHAR",
- path = concat ["default-", !defaultChar, ".sml"]},
- {var = "DEFAULT_WIDECHAR",
- path = concat ["default-", !defaultWideChar, ".sml"]},
- {var = "DEFAULT_INT",
- path = concat ["default-", !defaultInt, ".sml"]},
- {var = "DEFAULT_REAL",
- path = concat ["default-", !defaultReal, ".sml"]},
- {var = "DEFAULT_WORD",
- path = concat ["default-", !defaultWord, ".sml"]}],
- List.concat (List.map (!mlbPathMaps, make))])
-end
+fun mlbPathMap () =
+ List.rev
+ (List.concat
+ [[{var = "LIB_MLTON_DIR",
+ path = !libDir},
+ {var = "TARGET_ARCH",
+ path = String.toLower (MLton.Platform.Arch.toString
+ (!Target.arch))},
+ {var = "TARGET_OS",
+ path = String.toLower (MLton.Platform.OS.toString
+ (!Target.os))},
+ {var = "OBJPTR_REP",
+ path = (case Bits.toInt (Target.Size.objptr ()) of
+ 32 => "objptr-rep32.sml"
+ | 64 => "objptr-rep64.sml"
+ | _ => Error.bug "Control.mlbPathMap")},
+ {var = "HEADER_WORD",
+ path = (case Bits.toInt (Target.Size.header ()) of
+ 32 => "header-word32.sml"
+ | 64 => "header-word64.sml"
+ | _ => Error.bug "Control.mlbPathMap")},
+ {var = "SEQINDEX_INT",
+ path = (case Bits.toInt (Target.Size.seqIndex ()) of
+ 32 => "seqindex-int32.sml"
+ | 64 => "seqindex-int64.sml"
+ | _ => Error.bug "Control.mlbPathMap")},
+ {var = "DEFAULT_CHAR",
+ path = concat ["default-", !defaultChar, ".sml"]},
+ {var = "DEFAULT_WIDECHAR",
+ path = concat ["default-", !defaultWideChar, ".sml"]},
+ {var = "DEFAULT_INT",
+ path = concat ["default-", !defaultInt, ".sml"]},
+ {var = "DEFAULT_REAL",
+ path = concat ["default-", !defaultReal, ".sml"]},
+ {var = "DEFAULT_WORD",
+ path = concat ["default-", !defaultWord, ".sml"]}],
+ !mlbPathVars])
val typeCheck = control {name = "type check",
default = false,
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2007-11-06 20:20:12 UTC (rev 6128)
+++ mlton/trunk/mlton/main/main.fun 2007-11-07 14:05:35 UTC (rev 6129)
@@ -74,6 +74,25 @@
val show: Show.t option ref = ref NONE
val stop = ref Place.OUT
+fun parseMlbPathVar (line: String.t) =
+ case String.tokens (line, Char.isSpace) of
+ [var, path] => SOME {var = var, path = path}
+ | _ => NONE
+
+fun readMlbPathMap (file: File.t) =
+ if not (File.canRead file) then
+ Error.bug (concat ["can't read MLB path map file: ", file])
+ else
+ List.keepAllMap
+ (File.lines file, fn line =>
+ if String.forall (line, Char.isSpace)
+ then NONE
+ else
+ case parseMlbPathVar line of
+ NONE => Error.bug (concat ["strange mlb path mapping: ",
+ file, ":: ", line])
+ | SOME v => SOME v)
+
val targetMap: unit -> {arch: MLton.Platform.Arch.t,
os: MLton.Platform.OS.t,
target: string} list =
@@ -443,7 +462,13 @@
(Expert, "max-function-size", " <n>", "max function size (blocks)",
intRef maxFunctionSize),
(Normal, "mlb-path-map", " <file>", "additional MLB path map",
- SpaceString (fn s => mlbPathMaps := !mlbPathMaps @ [s])),
+ SpaceString (fn s => mlbPathVars := !mlbPathVars @ readMlbPathMap s)),
+ (Normal, "mlb-path-var", " '<name> <value>'", "additional MLB path var",
+ SpaceString
+ (fn s => mlbPathVars := !mlbPathVars @
+ [case parseMlbPathVar s of
+ NONE => Error.bug ("strange mlb path var: " ^ s)
+ | SOME v => v])),
(Expert, "native-commented", " <n>", "level of comments (0)",
intRef Native.commented),
(Expert, "native-copy-prop", " {true|false}",
More information about the MLton-commit
mailing list