[MLton-commit] r4243

Matthew Fluet MLton@mlton.org
Sat, 19 Nov 2005 10:48:44 -0800


Reworked the cm2mlb-map treatment.  You can now specify the mapping of
both anchored CM paths to MLB paths and anchored CM files to MLB
files.  This lets us map

$ml-yacc-lib.cm/ml-yacc-lib.cm  $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb
$c/c.cm  $(SML_LIB)/mlnlffi-lib/mlnlffi-lib.mlb

which compensates for the difference in the names of the .cm and .mlb
files.


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

U   mlton/trunk/util/cm2mlb/cm2mlb-map
U   mlton/trunk/util/cm2mlb/cm2mlb.sml

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

Modified: mlton/trunk/util/cm2mlb/cm2mlb-map
===================================================================
--- mlton/trunk/util/cm2mlb/cm2mlb-map	2005-11-18 03:28:42 UTC (rev 4242)
+++ mlton/trunk/util/cm2mlb/cm2mlb-map	2005-11-19 18:48:43 UTC (rev 4243)
@@ -1,17 +1,24 @@
-basis           $(SML_LIB)/basis
+$basis.cm              $(SML_LIB)/basis
+$basis.cm/basis.cm     $(SML_LIB)/basis/basis.mlb
 
-ml-yacc-lib     $(SML_LIB)/mlyacc-lib
+$ml-yacc-lib.cm                    $(SML_LIB)/mlyacc-lib
+$ml-yacc-lib.cm/ml-yacc-lib.cm     $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb
 
-smlnj-lib       $(SML_LIB)/smlnj-lib/Util
-controls-lib    $(SML_LIB)/smlnj-lib/Controls
-hash-cons-lib   $(SML_LIB)/smlnj-lib/HashCons
-inet-lib        $(SML_LIB)/smlnj-lib/INet
-unix-lib        $(SML_LIB)/smlnj-lib/Unix
-pp-lib          $(SML_LIB)/smlnj-lib/PP
-html-lib        $(SML_LIB)/smlnj-lib/HTML
-regexp-lib      $(SML_LIB)/smlnj-lib/RegExp
-reactive-lib    $(SML_LIB)/smlnj-lib/Reactive
+$cml            $(SML_LIB)/cml
+$cml/cml.mlb    $(SML_LIB)/cml/cml.mlb
 
-ckit-lib        $(SML_LIB)/ckit-lib/src
+$c          $(SML_LIB)/mlnlffi-lib
+$c/c.cm     $(SML_LIB)/mlnlffi-lib/mlnlffi-lib.mlb
 
-c               $(SML_LIB)/mlnlffi-lib
+$smlnj-lib.cm         $(SML_LIB)/smlnj-lib/Util
+$controls-lib.cm      $(SML_LIB)/smlnj-lib/Controls
+$hash-cons-lib.cm     $(SML_LIB)/smlnj-lib/HashCons
+$inet-lib.cm          $(SML_LIB)/smlnj-lib/INet
+$unix-lib.cm          $(SML_LIB)/smlnj-lib/Unix
+$pp-lib.cm            $(SML_LIB)/smlnj-lib/PP
+$html-lib.cm          $(SML_LIB)/smlnj-lib/HTML
+$regexp-lib.cm        $(SML_LIB)/smlnj-lib/RegExp
+$reactive-lib.cm      $(SML_LIB)/smlnj-lib/Reactive
+
+$ckit-lib.cm                 $(SML_LIB)/ckit-lib
+$ckit-lib.cm/ckit-lib.cm     $(SML_LIB)/ckit-lib/ckit-lib.mlb

Modified: mlton/trunk/util/cm2mlb/cm2mlb.sml
===================================================================
--- mlton/trunk/util/cm2mlb/cm2mlb.sml	2005-11-18 03:28:42 UTC (rev 4242)
+++ mlton/trunk/util/cm2mlb/cm2mlb.sml	2005-11-19 18:48:43 UTC (rev 4243)
@@ -138,7 +138,7 @@
                       let
                          val cmLibDescr = CM.Library.descr cmLib
                          val cmLibOSString = CM.Library.osstring cmLib
-
+                            
                          fun mlbLibDef () =
                             let
                                val {base, ext} = OS.Path.splitBaseExt cmLibOSString
@@ -146,40 +146,36 @@
                             in
                                mlbLib
                             end
-                                  
-                         fun doitAnchoredPath (anchor, path) =
-                            case peekAnchorMap anchor of
-                               SOME mlbPath => 
-                                  let
-                                     val {dir, file} = OS.Path.splitDirFile path
-                                     val {base, ext} = OS.Path.splitBaseExt file
-                                     val file = OS.Path.joinBaseExt {base = base, ext = SOME "mlb"}
-                                     val path = OS.Path.joinDirFile {dir = dir, file = file}
-                                     val mlbLib = OS.Path.joinDirFile {dir = mlbPath, file = path}
-                                  in 
-                                     concat ["(* ", cmLibDescr, " ====> *) ", mlbLib]
-                                  end
-                             | NONE => 
-                                  concat ["(* ", cmLibDescr, " =??=> *) ", mlbLibDef ()]
 
+                         fun doitAnchoredPath arcs =
+                            let
+                               fun loop (prefix, suffix) =
+                                  if List.null prefix 
+                                     then concat ["(* ", cmLibDescr, " =??=> *) ", mlbLibDef ()]
+                                     else case peekAnchorMap (String.concatWith "/" (List.rev prefix)) of
+                                             SOME mlbPath =>
+                                                concat ["(* ", cmLibDescr, " ====> *) ", mlbPath ^ suffix]
+                                           | NONE =>
+                                                let
+                                                   val suffix =
+                                                      if suffix = ""
+                                                         then OS.Path.joinBaseExt
+                                                              {base = #base (OS.Path.splitBaseExt (List.hd prefix)),
+                                                               ext = SOME "mlb"}
+                                                         else (List.hd prefix) ^ suffix
+                                                in
+                                                   loop (List.tl prefix, "/" ^ suffix)
+                                                end
+                            in
+                               loop (List.rev arcs, "")
+                            end
+
                          val mlbLib =
                             if String.sub (cmLibDescr, 0) = #"$"
                                then case String.fields (fn #"/" => true | _ => false) cmLibDescr of
-                                       ["$", abbrev] =>
-                                          let
-                                             val anchor = OS.Path.base abbrev
-                                             val path = abbrev
-                                          in
-                                             doitAnchoredPath (anchor, path)
-                                          end
-                                     | anchor::path =>
-                                          let
-                                             val anchor = String.extract (anchor, 1, NONE)
-                                             val path = String.concatWith "/" path
-                                          in
-                                             doitAnchoredPath (anchor, path)
-                                          end
-                                     | _ => die "strange anchored path"
+                                       "$" :: (arcs as (arc0 :: _)) => 
+                                          doitAnchoredPath (("$" ^ arc0) :: arcs)
+                                     | arcs => doitAnchoredPath arcs
                                else concat ["(* ", cmLibOSString, " ===> *) ", mlbLibDef ()]
                       in
                          concat