[MLton] Option to show path map

[Vesa Karvonen]

I think it would be nice if mlton had a command line option to show
the (MLB) path map.  I was thinking about using such an option in
build files to choose directories for generated files (through
TARGET_OS and TARGET_ARCH).  Such an option could also be handy in
case you need to debug problems with path maps.  You might
(accidentally) have multiple definitions of a variable, for example.
I made an implementation of the option.  See the patch below.

-Vesa Karvonen

Index: mlton/control/control-flags.sig
===================================================================
--- mlton/control/control-flags.sig	(revision 4999)
+++ mlton/control/control-flags.sig	(working copy)
@@ -192,6 +192,8 @@
       val maxFunctionSize: int ref
 
       val mlbPathMaps: string list ref
+      val mlbPathMap: unit -> {var: string,
+                               path: string} list
 
       structure Native:
          sig
Index: mlton/control/control-flags.sml
===================================================================
--- mlton/control/control-flags.sml	(revision 4999)
+++ mlton/control/control-flags.sml	(working copy)
@@ -987,6 +987,49 @@
                         default = Linux,
                         toString = MLton.Platform.OS.toString}
 
+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
+                                       (!targetArch))},
+               {var = "TARGET_OS",
+                path = String.toLower (MLton.Platform.OS.toString
+                                       (!targetOS))},
+               {var = "OBJPTR_REP",
+                path = "objptr-rep32.sml"},
+               {var = "HEADER_WORD",
+                path = "header-word32.sml"},
+               {var = "SEQINDEX_INT",
+                path = "seqindex-int32.sml"},
+               {var = "DEFAULT_CHAR",
+                path = concat ["default-", !defaultChar, ".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
+
 val typeCheck = control {name = "type check",
                          default = false,
                          toString = Bool.toString}
Index: mlton/main/main.fun
===================================================================
--- mlton/main/main.fun	(revision 4999)
+++ mlton/main/main.fun	(working copy)
@@ -66,6 +66,7 @@
 val profileTimeSet: bool ref = ref false
 val runtimeArgs: string list ref = ref ["@MLton"]
 val showAnns: bool ref = ref false
+val showPathMap: bool ref = ref false
 val stop = ref Place.OUT
 
 val targetMap: unit -> {arch: MLton.Platform.Arch.t,
@@ -457,6 +458,8 @@
         SpaceString (fn s => showBasis := SOME s)),
        (Normal, "show-def-use", " <file>", "write def-use information",
         SpaceString (fn s => showDefUse := SOME s)),
+       (Expert, "show-path-map", " {false|true}", "show path map",
+        boolRef showPathMap),
        (Expert, "show-types", " {false|true}", "show types in ILs",
         boolRef showTypes),
        (Expert, "ssa-passes", " <passes>", "ssa optimization passes",
@@ -588,6 +591,21 @@
                              Out.standard)
              ; let open OS.Process in exit success end)
          else ()
+      val () =
+         if !showPathMap then
+            let
+               open Layout
+               val () =
+                   outputl (align
+                            (List.map (Control.mlbPathMap (),
+                                       fn {var, path, ...} =>
+                                       str (concat [var, " ", path]))),
+                            Out.standard)
+               open OS.Process
+            in
+               exit success
+            end
+         else ()
       val () = if !profileTimeSet
                   then (case !codegen of
                            Native => profile := ProfileTimeLabel
Index: mlton/front-end/mlb-front-end.fun
===================================================================
--- mlton/front-end/mlb-front-end.fun	(revision 4999)
+++ mlton/front-end/mlb-front-end.fun	(working copy)
@@ -84,46 +84,8 @@
       val psi : (File.t * Ast.Basdec.t Promise.t) HashSet.t =
          HashSet.new {hash = String.hash o #1}
       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]))
          val pathMap =
-            List.rev
-            (List.concat
-             [[{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))},
-               {var = "OBJPTR_REP",
-                path = "objptr-rep32.sml"},
-               {var = "HEADER_WORD",
-                path = "header-word32.sml"},
-               {var = "SEQINDEX_INT",
-                path = "seqindex-int32.sml"},
-               {var = "DEFAULT_CHAR",
-                path = concat ["default-", !Control.defaultChar, ".sml"]},
-               {var = "DEFAULT_INT",
-                path = concat ["default-", !Control.defaultInt, ".sml"]},
-               {var = "DEFAULT_REAL",
-                path = concat ["default-", !Control.defaultReal, ".sml"]},
-               {var = "DEFAULT_WORD",
-                path = concat ["default-", !Control.defaultWord, ".sml"]}],
-              List.concat (List.map (!Control.mlbPathMaps, make))])
-
+             Control.mlbPathMap ()
          fun peekPathMap var' =
             case List.peek (pathMap, fn {var,...} =>
                             var = var') of