[MLton] cvs commit: mlb-path-map support

Matthew Fluet fluet@mlton.org
Mon, 2 Aug 2004 18:01:01 -0700


fluet       04/08/02 18:00:59

  Modified:    .        Makefile
               bin      mlton regression
               lib/cml/cml-lib cml-lib.mlb
               lib/cml/core-cml core-cml.mlb
               lib/cml/tests exit.mlb ping-pong.mlb primes-multicast.mlb
                        primes.mlb timeout.mlb
               lib/cml/util util.mlb
               mlton/front-end mlb-front-end.fun
               mlton/main compile.fun
  Log:
  MAIL mlb-path-map support
  
  When building the $(VAR) environment mapping for MLBs paths,
  MLton will look for $lib/mlb-path-map and $HOME/.mlton/mlb-path-map;
  $HOME/.mlton/mlb-path-map takes precedence over $lib/mlb-path-map.
  
  Renamed  SML_LIB ==> MLTON_ROOT.

Revision  Changes    Path
1.116     +20 -11    mlton/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/Makefile,v
retrieving revision 1.115
retrieving revision 1.116
diff -u -r1.115 -r1.116
--- Makefile	28 Jul 2004 21:05:07 -0000	1.115
+++ Makefile	3 Aug 2004 01:00:58 -0000	1.116
@@ -10,6 +10,7 @@
 RUN = $(SRC)/runtime
 MLTON = $(BIN)/mlton
 AOUT = mlton-compile
+MLBPATHMAP = $(LIB)/mlb-path-map
 TARGETMAP = $(LIB)/target-map
 SPEC = $(SRC)/doc/mlton.spec
 LEX = mllex
@@ -36,7 +37,7 @@
 ifeq (other, $(shell if [ ! -x $(BIN)/mlton ]; then echo other; fi))
 	rm -f $(COMP)/$(AOUT)
 endif
-	$(MAKE) script targetmap constants compiler world tools
+	$(MAKE) script mlbpathmap targetmap constants compiler world tools
 	@echo 'Build of MLton succeeded.'
 
 .PHONY: basis
@@ -138,28 +139,27 @@
 
 #	rm -rf $(BSDSRC)
 
-.PHONY: targetmap
-targetmap:
-	touch $(TARGETMAP)
-	( sed '/$(TARGET)/d' <$(TARGETMAP); 			\
-		echo '$(TARGET) $(TARGET_ARCH) $(TARGET_OS)' ) 	\
-		>>$(TARGETMAP).tmp
-	mv $(TARGETMAP).tmp $(TARGETMAP)
-
 .PHONY: nj-mlton
 nj-mlton:
 	$(MAKE) dirs runtime 
 	$(MAKE) -C $(COMP) nj-mlton
-	$(MAKE) script basis targetmap constants
+	$(MAKE) script basis mlbpathmap targetmap constants
 	@echo 'Build of MLton succeeded.'
 
 .PHONY: nj-mlton-dual
 nj-mlton-dual:
 	$(MAKE) dirs runtime
 	$(MAKE) -C $(COMP) nj-mlton-dual
-	$(MAKE) script basis targetmap constants
+	$(MAKE) script basis mlbpathmap targetmap constants
 	@echo 'Build of MLton succeeded.'
 
+.PHONY: mlbpathmap
+mlbpathmap:
+	touch $(MLBPATHMAP)
+	( echo 'MLTON_ROOT $(LIB)/sml' ) 	\
+		>>$(MLBPATHMAP).tmp
+	mv $(MLBPATHMAP).tmp $(MLBPATHMAP)
+
 .PHONY: profiled
 profiled:
 	$(MAKE) -C $(COMP) AOUT=$(AOUT).alloc COMPILE_ARGS='-profile alloc'
@@ -211,6 +211,14 @@
 	chmod a+x $(MLTON)
 	$(CP) $(SRC)/bin/platform $(LIB)
 
+.PHONY: targetmap
+targetmap:
+	touch $(TARGETMAP)
+	( sed '/$(TARGET)/d' <$(TARGETMAP); 			\
+		echo '$(TARGET) $(TARGET_ARCH) $(TARGET_OS)' ) 	\
+		>>$(TARGETMAP).tmp
+	mv $(TARGETMAP).tmp $(TARGETMAP)
+
 .PHONY: tools
 tools:
 	$(MAKE) -C $(LEX)
@@ -281,6 +289,7 @@
 install-no-docs:
 	mkdir -p $(TLIB) $(TBIN) $(TMAN)
 	$(CP) $(LIB)/. $(TLIB)/
+	( echo 'MLTON_ROOT $(TLIB)/sml' ) >$(TLIB)/mlb-path-map
 	sed "/^lib=/s;'.*';'$(prefix)/$(ULIB)';" 			\
 			<$(SRC)/bin/mlton >$(TBIN)/mlton
 	chmod +x $(TBIN)/mlton



1.33      +0 -2      mlton/bin/mlton

Index: mlton
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/mlton,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- mlton	28 Jul 2004 21:05:09 -0000	1.32
+++ mlton	3 Aug 2004 01:00:58 -0000	1.33
@@ -8,8 +8,6 @@
 gcc='gcc'
 mlton="$lib/mlton-compile"
 world="$lib/world.mlton"
-SML_LIB="$lib/sml"
-export SML_LIB
 nj='sml'
 eval `$lib/platform`
 njHeap="$lib/mlton.$HOST_ARCH-$HOST_OS"



1.83      +1 -1      mlton/bin/regression

Index: regression
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/regression,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -r1.82 -r1.83
--- regression	29 Jul 2004 21:56:55 -0000	1.82
+++ regression	3 Aug 2004 01:00:58 -0000	1.83
@@ -105,7 +105,7 @@
 		case "$runOnly" in
 		no)
 			mlb="/tmp/$$.mlb"
-			echo "\$(SML_LIB)/basis/basis.mlb
+			echo "\$(MLTON_ROOT)/basis/basis.mlb
                               ann allowExport true, allowImport true, allowOverload true
                               in $src/regression/$f.sml end" >$mlb
 			$mlton $flags $extraFlags -output $f $mlb



1.2       +1 -1      mlton/lib/cml/cml-lib/cml-lib.mlb

Index: cml-lib.mlb
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/cml/cml-lib/cml-lib.mlb,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- cml-lib.mlb	1 Aug 2004 22:49:22 -0000	1.1
+++ cml-lib.mlb	3 Aug 2004 01:00:58 -0000	1.2
@@ -4,7 +4,7 @@
   warnUnused true
 in
 local
-  $(SML_LIB)/basis/basis.mlb
+  $(MLTON_ROOT)/basis/basis.mlb
   ../core-cml/core-cml.mlb
   multicast.sig
   multicast.sml



1.2       +1 -1      mlton/lib/cml/core-cml/core-cml.mlb

Index: core-cml.mlb
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/cml/core-cml/core-cml.mlb,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- core-cml.mlb	1 Aug 2004 22:49:22 -0000	1.1
+++ core-cml.mlb	3 Aug 2004 01:00:59 -0000	1.2
@@ -4,7 +4,7 @@
   warnUnused true
 in
 local
-  $(SML_LIB)/basis/basis.mlb
+  $(MLTON_ROOT)/basis/basis.mlb
   ../util/util.mlb
   rep-types.sml
   running.sml



1.2       +1 -1      mlton/lib/cml/tests/exit.mlb

Index: exit.mlb
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/cml/tests/exit.mlb,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- exit.mlb	1 Aug 2004 22:49:23 -0000	1.1
+++ exit.mlb	3 Aug 2004 01:00:59 -0000	1.2
@@ -1,5 +1,5 @@
 local
-  $(SML_LIB)/basis/basis.mlb
+  $(MLTON_ROOT)/basis/basis.mlb
   ../cml.mlb
   print.sml
 in



1.2       +1 -1      mlton/lib/cml/tests/ping-pong.mlb

Index: ping-pong.mlb
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/cml/tests/ping-pong.mlb,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- ping-pong.mlb	1 Aug 2004 22:49:23 -0000	1.1
+++ ping-pong.mlb	3 Aug 2004 01:00:59 -0000	1.2
@@ -1,5 +1,5 @@
 local
-  $(SML_LIB)/basis/basis.mlb
+  $(MLTON_ROOT)/basis/basis.mlb
   ../cml.mlb
   print.sml
 in



1.2       +1 -1      mlton/lib/cml/tests/primes-multicast.mlb

Index: primes-multicast.mlb
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/cml/tests/primes-multicast.mlb,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- primes-multicast.mlb	1 Aug 2004 22:49:23 -0000	1.1
+++ primes-multicast.mlb	3 Aug 2004 01:00:59 -0000	1.2
@@ -1,5 +1,5 @@
 local
-  $(SML_LIB)/basis/basis.mlb
+  $(MLTON_ROOT)/basis/basis.mlb
   ../cml.mlb
   print.sml
 in



1.2       +1 -1      mlton/lib/cml/tests/primes.mlb

Index: primes.mlb
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/cml/tests/primes.mlb,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- primes.mlb	1 Aug 2004 22:49:23 -0000	1.1
+++ primes.mlb	3 Aug 2004 01:00:59 -0000	1.2
@@ -1,5 +1,5 @@
 local
-  $(SML_LIB)/basis/basis.mlb
+  $(MLTON_ROOT)/basis/basis.mlb
   ../cml.mlb
   print.sml
 in



1.2       +1 -1      mlton/lib/cml/tests/timeout.mlb

Index: timeout.mlb
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/cml/tests/timeout.mlb,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- timeout.mlb	1 Aug 2004 22:49:23 -0000	1.1
+++ timeout.mlb	3 Aug 2004 01:00:59 -0000	1.2
@@ -1,5 +1,5 @@
 local
-  $(SML_LIB)/basis/basis.mlb
+  $(MLTON_ROOT)/basis/basis.mlb
   ../cml.mlb
   print.sml
 in



1.2       +1 -1      mlton/lib/cml/util/util.mlb

Index: util.mlb
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/cml/util/util.mlb,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- util.mlb	1 Aug 2004 22:49:24 -0000	1.1
+++ util.mlb	3 Aug 2004 01:00:59 -0000	1.2
@@ -5,7 +5,7 @@
   forceUsed
 in
 local
-  $(SML_LIB)/basis/basis.mlb
+  $(MLTON_ROOT)/basis/basis.mlb
   critical.sig
   critical.sml
   assert.sig



1.5       +23 -2     mlton/mlton/front-end/mlb-front-end.fun

Index: mlb-front-end.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/front-end/mlb-front-end.fun,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- mlb-front-end.fun	2 Aug 2004 00:25:49 -0000	1.4
+++ mlb-front-end.fun	3 Aug 2004 01:00:59 -0000	1.5
@@ -82,6 +82,25 @@
       val psi : (OS.FileSys.file_id * Ast.Basdec.t) HashSet.t =
 	 HashSet.new {hash = OS.FileSys.hash o #1}
 
+      local
+	 fun make (file : File.t) =
+	    if File.canRead file
+	       then List.map
+		    (File.lines file, fn line =>
+		     case String.tokens (line, Char.isSpace) of
+			[var, path] => {var = var, path = path}
+		      | _ => Error.bug (concat ["strange mlb path mapping: ", 
+						file, ":: ", line]))
+	       else []
+      in
+	 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"])]
+      end
+
       fun regularize {fileOrig, cwd, relativize} =
 	 let
 	    val fileExp = 
@@ -99,9 +118,11 @@
 				  | c::s => loopVar (s, c::acc)
 			      val (s, var) = loopVar (s, [])
 			   in
-			      case OS.Process.getEnv var of
+			      case List.peek (pathMap, fn {var = var', ...} => 
+					      var = var') of
 				 NONE => loop (s, [], accs)
-			       | SOME p => loop ((String.explode p) @ s, [], accs)
+			       | SOME {path, ...} => 
+				    loop ((String.explode path) @ s, [], accs)
 			   end
 		      | c::s => loop (s, c::acc, accs)
 	       in



1.38      +2 -2      mlton/mlton/main/compile.fun

Index: compile.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/compile.fun,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- compile.fun	30 Jul 2004 16:42:39 -0000	1.37
+++ compile.fun	3 Aug 2004 01:00:59 -0000	1.38
@@ -343,7 +343,7 @@
    let
       val _ = amBuildingConstants := true
       val (_, decs) =
-	 parseAndElaborateMLB (File "$(SML_LIB)/basis/libs/primitive.mlb")
+	 parseAndElaborateMLB (File "$(MLTON_ROOT)/basis/libs/primitive.mlb")
       val decs = Vector.map (decs, fn (decs, _) => Decs.toList decs)
       val decs = Vector.concatV (Vector.map (decs, Vector.fromList))
       (* Need to defunctorize so the constants are forced. *)
@@ -578,7 +578,7 @@
       let
 	 val basis =
 	    String.concat
-	    ["$(SML_LIB)/basis/",!Control.basisLibrary,".mlb\n"]
+	    ["$(MLTON_ROOT)/basis/",!Control.basisLibrary,".mlb\n"]
 	 val s =
 	    if List.length input = 0
 	       then basis