[MLton-commit] r4068

[Stephen Weeks]

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}",