[MLton-commit] r4068
Stephen Weeks
MLton@mlton.org
Mon, 5 Sep 2005 14:33:13 -0700
Added -mlb-path-map switch.
----------------------------------------------------------------------
U mlton/trunk/doc/changelog
U mlton/trunk/man/mlton.1
U mlton/trunk/mlton/control/control-flags.sig
U mlton/trunk/mlton/control/control-flags.sml
U mlton/trunk/mlton/front-end/mlb-front-end.fun
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2005-09-05 20:35:42 UTC (rev 4067)
+++ mlton/trunk/doc/changelog 2005-09-05 21:33:10 UTC (rev 4068)
@@ -1,5 +1,8 @@
Here are the changes since version 20041109.
+* 2005-09-05
+ - Added -mlb-path-map switch.
+
* 2005-08-25
- Fixed bug in MLton.Finalizable.touch, which was not keeping alive
finalizable values in all cases.
Modified: mlton/trunk/man/mlton.1
===================================================================
--- mlton/trunk/man/mlton.1 2005-09-05 20:35:42 UTC (rev 4067)
+++ mlton/trunk/man/mlton.1 2005-09-05 21:33:10 UTC (rev 4068)
@@ -129,6 +129,12 @@
syntax, e.g., \fB-link-opt '-Wl,--export-dynamic'\fP.
.TP
+\fB-mlb-path-map \fIfile\fR
+Use file as an MLB path map to define additional MLB path variables.
+Multiple uses of \fB-mlb-path-map\fP are allowed, with variable
+definitions in later path maps taking precendence over earlier ones.
+
+.TP
\fB-output \fIfile\fR
Specify the name of the final output file.
The default name is the input file name with its suffix removed and an
Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig 2005-09-05 20:35:42 UTC (rev 4067)
+++ mlton/trunk/mlton/control/control-flags.sig 2005-09-05 21:33:10 UTC (rev 4068)
@@ -186,6 +186,8 @@
val maxFunctionSize: int ref
+ val mlbPathMaps: string list ref
+
structure Native:
sig
(* whether or not to use comments in native codegen *)
Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml 2005-09-05 20:35:42 UTC (rev 4067)
+++ mlton/trunk/mlton/control/control-flags.sml 2005-09-05 21:33:10 UTC (rev 4068)
@@ -705,6 +705,10 @@
val maxFunctionSize = control {name = "max function size",
default = 10000,
toString = Int.toString}
+
+val mlbPathMaps = control {name = "mlb path maps",
+ default = [],
+ toString = List.toString (fn s => s)}
structure Native =
struct
Modified: mlton/trunk/mlton/front-end/mlb-front-end.fun
===================================================================
--- mlton/trunk/mlton/front-end/mlb-front-end.fun 2005-09-05 20:35:42 UTC (rev 4067)
+++ mlton/trunk/mlton/front-end/mlb-front-end.fun 2005-09-05 21:33:10 UTC (rev 4068)
@@ -85,32 +85,33 @@
HashSet.new {hash = String.hash o #1}
local
fun make (file: File.t) =
- if File.canRead file
- then
- 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]))
- else []
+ 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]))
val pathMap =
- (List.rev o List.concat)
- [make (concat [!Control.libDir, "/mlb-path-map"]),
- case OS.Process.getEnv "HOME" of
- NONE => []
- | SOME path => make (concat [path, "/.mlton/mlb-path-map"]),
- [{var = "LIB_MLTON_DIR",
- path = !Control.libDir},
- {var = "TARGET_ARCH",
- path = (String.toLower o MLton.Platform.Arch.toString)
- (!Control.targetArch)},
- {var = "TARGET_OS",
- path = (String.toLower o MLton.Platform.OS.toString)
- (!Control.targetOS)}]]
+ List.rev
+ (List.concat
+ [List.concat
+ (List.map (concat [!Control.libDir, "/mlb-path-map"]
+ :: (!Control.mlbPathMaps),
+ make)),
+ [{var = "LIB_MLTON_DIR",
+ path = !Control.libDir},
+ {var = "TARGET_ARCH",
+ path = String.toLower (MLton.Platform.Arch.toString
+ (!Control.targetArch))},
+ {var = "TARGET_OS",
+ path = String.toLower (MLton.Platform.OS.toString
+ (!Control.targetOS))}]])
fun peekPathMap var' =
case List.peek (pathMap, fn {var,...} =>
var = var') of
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2005-09-05 20:35:42 UTC (rev 4067)
+++ mlton/trunk/mlton/main/main.fun 2005-09-05 21:33:10 UTC (rev 4068)
@@ -282,6 +282,8 @@
boolRef markCards),
(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])),
(Expert, "native-commented", " <n>", "level of comments (0)",
intRef Native.commented),
(Expert, "native-copy-prop", " {true|false}",