[MLton] cvs commit: Really fixed bug in refFlatten pass.

[Matthew Fluet]

fluet       05/07/24 18:15:38

  Modified:    mlton/ssa ref-flatten.fun
               regression ref-flatten.6.ok
  Log:
  MAIL Really fixed bug in refFlatten pass.
  
  The bug fix should go the other way -- don't allow flattening of the
  value in an Update (rather than adjusting the transformation).  Doing
  so could break sharing.

Revision  Changes    Path
1.37      +12 -17    mlton/mlton/ssa/ref-flatten.fun

Index: ref-flatten.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/ref-flatten.fun,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- ref-flatten.fun	24 Jul 2005 02:11:35 -0000	1.36
+++ ref-flatten.fun	25 Jul 2005 01:15:37 -0000	1.37
@@ -480,8 +480,12 @@
 	     | _ => Error.bug "RefFlatten.select"
 	 end
       fun update {base, offset, value} =
-	 coerce {from = value,
-		 to = select {base = base, offset = offset}}
+	 (coerce {from = value,
+		  to = select {base = base, offset = offset}}
+	  (* Don't flatten the component of the update, 
+	   * else sharing will be broken.
+	   *)
+	  ; Value.dontFlatten value)
       fun const c = typeValue (Type.ofConst c)
       val {func, value = varValue, ...} =
 	 analyze {coerce = coerce,
@@ -972,10 +976,11 @@
 	    Bind b => transformBind b
 	  | Profile _ => Vector.new1 s
 	  | Update {base, offset, value} =>
+	       Vector.new1
 	       (case base of
 		   Base.Object object =>
 		      (case varObject object of
-			  NONE => Vector.new1 s
+			  NONE => s
 			| SOME obj =>
 			     let
 				val base =
@@ -986,22 +991,12 @@
 						Base.Object objectVar
 					   | _ => base)
 				    | Unflattenable => base
-				val value =
-				   case flattenArgs (Vector.new1 value, obj, []) of
-				      [value] => value
-				    | _ => Error.bug 
-                                           "RefFlatten.transformStatement.Update"
-				val extra = !extraSelects
-				val () = extraSelects := []
 			     in
-				Vector.concat
-				[Vector.fromList extra,
-				 (Vector.new1 o Update) 
-				 {base = base,
-				  offset = objectOffset (obj, offset),
-				  value = value}]
+				Update {base = base,
+					offset = objectOffset (obj, offset),
+					value = value}
 			     end)
-		 | Base.VectorSub _ => Vector.new1 s)
+		 | Base.VectorSub _ => s)
       val transformStatement =
 	 Trace.trace ("RefFlatten.transformStatement",
 		      Statement.layout,



1.2       +0 -1      mlton/regression/ref-flatten.6.ok

Index: ref-flatten.6.ok
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/ref-flatten.6.ok,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- ref-flatten.6.ok	24 Jul 2005 02:11:35 -0000	1.1
+++ ref-flatten.6.ok	25 Jul 2005 01:15:38 -0000	1.2
@@ -1,2 +1 @@
 hi
-hi