[MLton-commit] r5076

[Vesa Karvonen]

Added new expert option: -prefer-abs-paths {false|true}

Setting the option to true is supposed to have the effect that source
files are referred to by their absolute paths.  This can simplify
(working with and implementation of) external tools that would
otherwise have to know the directory from which the compiler was
executed (in order to locate source files).

----------------------------------------------------------------------

U   mlton/trunk/mlton/control/control-flags.sig
U   mlton/trunk/mlton/control/control-flags.sml
U   mlton/trunk/mlton/control/source-pos.sml
U   mlton/trunk/mlton/front-end/mlb-front-end.fun
U   mlton/trunk/mlton/main/main.fun

----------------------------------------------------------------------

Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig	2007-01-29 12:35:47 UTC (rev 5075)
+++ mlton/trunk/mlton/control/control-flags.sig	2007-01-29 14:27:04 UTC (rev 5076)
@@ -251,6 +251,8 @@
           product: int
          } option ref
 
+      val preferAbsPaths: bool ref
+
       (* List of pass names to keep profiling info on. *)
       val profPasses: Regexp.Compiled.t list ref
 

Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml	2007-01-29 12:35:47 UTC (rev 5075)
+++ mlton/trunk/mlton/control/control-flags.sml	2007-01-29 14:27:04 UTC (rev 5076)
@@ -836,6 +836,10 @@
                              ("product", Int.layout product)])
              p)}
 
+val preferAbsPaths = control {name = "prefer abs paths",
+                              default = false,
+                              toString = Bool.toString}
+
 val profPasses = 
    control {name = "prof passes",
             default = [],

Modified: mlton/trunk/mlton/control/source-pos.sml
===================================================================
--- mlton/trunk/mlton/control/source-pos.sml	2007-01-29 12:35:47 UTC (rev 5075)
+++ mlton/trunk/mlton/control/source-pos.sml	2007-01-29 14:27:04 UTC (rev 5076)
@@ -46,14 +46,17 @@
    end
 
 fun file (p as T {file, ...}) =
-   case getLib p of
-      NONE => file
-    | SOME i =>
-         String.substituteFirst
-         (String.substituteFirst
-          (String.dropPrefix (file, i), 
-           {substring = "/", replacement = "<"}),
-          {substring = "/", replacement = ">/"})
+   if !ControlFlags.preferAbsPaths
+      then file
+      else
+         case getLib p of
+            NONE => file
+          | SOME i =>
+               String.substituteFirst
+               (String.substituteFirst
+                (String.dropPrefix (file, i),
+                 {substring = "/", replacement = "<"}),
+                {substring = "/", replacement = ">/"})
 
 val bogus = T {column = ~1,
                file = "<bogus>",

Modified: mlton/trunk/mlton/front-end/mlb-front-end.fun
===================================================================
--- mlton/trunk/mlton/front-end/mlb-front-end.fun	2007-01-29 12:35:47 UTC (rev 5075)
+++ mlton/trunk/mlton/front-end/mlb-front-end.fun	2007-01-29 14:27:04 UTC (rev 5076)
@@ -153,7 +153,7 @@
             val fileAbs = OS.Path.mkAbsolute {path = fileExp, relativeTo = cwd}
             val fileAbs = OS.Path.mkCanonical fileAbs
             val relativize =
-               if OS.Path.isAbsolute fileExp
+               if !Control.preferAbsPaths orelse OS.Path.isAbsolute fileExp
                   then NONE
                   else relativize
             val fileUse =

Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun	2007-01-29 12:35:47 UTC (rev 5075)
+++ mlton/trunk/mlton/main/main.fun	2007-01-29 14:27:04 UTC (rev 5076)
@@ -373,6 +373,9 @@
         SpaceString (fn s => output := SOME s)),
        (Expert, "polyvariance", " {true|false}", "use polyvariance",
         Bool (fn b => if b then () else polyvariance := NONE)),
+       (Expert, "prefer-abs-paths", " {false|true}",
+        "prefer absolute paths when referring to files",
+        boolRef preferAbsPaths),
        (Expert, "prof-pass", " <pass>", "keep profile info for pass",
         SpaceString (fn s =>
                      (case Regexp.fromString s of