[MLton] cvs commit: another improvement for list constants

[Stephen Weeks]

sweeks      04/07/07 13:26:46

  Modified:    mlton/defunctorize defunctorize.fun
  Log:
  MAIL another improvement for list constants
  
  If a list constant has zero or one expansive expressions, then build
  the list right-to-left.
  
  I thought of the following generalization that combines this hack with
  the one I put in early to evaluate left-to-right, build the list in
  reverse, and then reverse it in the end.
  
  The idea is to evaluate all the expansive expressions left-to-right,
  putting them in a list, and then to build the complete list
  right-to-left, picking elements off the expansives list as we need
  them.
  
  So, for the following list, where ai is non-expansive and ei is
  expansive
  
  	[a0, e0, e1, a1, a2, e2, e3, e4, a3]
  
  we would do
  
  	r = []
  	r = e0 :: r
  	r = e1 :: r
  	r = e2 :: r
  	r = e3 :: r
  	r = e4 :: r
  	l = []
  	l = a3 :: l
  	l = hd r :: l
  	r = tl r
  	l = hd r :: l
  	r = tl r
  	l = hd r :: l
  	r = tl r
  	l = a2 :: l
  	l = a1 :: l
  	l = hd r :: l
  	r = tl r
  	l = hd r :: l
  	r = tl r
  	l = a0 :: l
  
  Hopefully this makes the idea clear, as well as making it clear that
  only a small constant number of variables are live.
  
  Anyways, I haven't put this in, but if someone feels like it, the
  right place is defunctorize.fun.

Revision  Changes    Path
1.20      +27 -5     mlton/mlton/defunctorize/defunctorize.fun

Index: defunctorize.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/defunctorize/defunctorize.fun,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- defunctorize.fun	30 Jun 2004 19:08:09 -0000	1.19
+++ defunctorize.fun	7 Jul 2004 20:26:46 -0000	1.20
@@ -325,9 +325,9 @@
 structure Xexp =
    struct
       open Xexp
-	 
-      val list: Xexp.t vector * Xtype.t -> Xexp.t =
-	 fn (es, ty) =>
+
+      fun list (es: Xexp.t vector, ty: Xtype.t, {forceLeftToRight: bool})
+	 : Xexp.t =
 	 let
 	    val targs = #2 (valOf (Xtype.deConOpt ty))
 	    val eltTy = Vector.sub (targs, 0)
@@ -346,7 +346,18 @@
 		targs = targs,
 		ty = ty}
 	 in
-	    if Vector.length es < 20
+	    if not forceLeftToRight
+	       then
+		  (* Build the list right to left. *)
+		  Vector.foldr (es, nill, fn (e, rest) =>
+				let
+				   val var = Var.newNoname ()
+				in
+				   Xexp.let1 {body = cons (e, monoVar (var, ty)),
+					      exp = rest,
+					      var = var}
+				end)
+	    else if Vector.length es < 20
 	       then Vector.foldr (es, nill, cons)
 	    else
 	       let
@@ -894,7 +905,18 @@
 				   ty = ty}
 		| Lambda l => Xexp.lambda (loopLambda l)
 		| Let (ds, e) => loopDecs (ds, loopExp e)
-		| List es => Xexp.list (Vector.map (es, #1 o loopExp), ty)
+		| List es =>
+		     let
+			(* Must evaluate list components left-to-right if there
+			 * is more than one expansive expression.
+			 *)
+			val numExpansive =
+			   Vector.fold (es, 0, fn (e, n) =>
+					if Cexp.isExpansive e then n + 1 else n)
+		     in
+			Xexp.list (Vector.map (es, #1 o loopExp), ty,
+				   {forceLeftToRight = 2 <= numExpansive})
+		     end
 		| PrimApp {args, prim, targs} =>
 		     let
 			val args = Vector.map (args, #1 o loopExp)