[MLton] cvs commit: rewrote x86.Block.compress to run in linear time

[Stephen Weeks]

sweeks      04/07/01 12:54:26

  Modified:    mlton/codegen/x86-codegen x86.fun
  Log:
  MAIL rewrote x86.Block.compress to run in linear time

Revision  Changes    Path
1.53      +51 -45    mlton/mlton/codegen/x86-codegen/x86.fun

Index: x86.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86.fun,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- x86.fun	12 Apr 2004 17:53:02 -0000	1.52
+++ x86.fun	1 Jul 2004 19:54:25 -0000	1.53
@@ -4205,52 +4205,58 @@
 		    then Transfer.toString (valOf transfer)
 		    else "NONE");
 	   print "\n")
+ 
+      val compress': t' list -> t' list =
+	 fn l =>
+	 List.fold
+	 (rev l, [],
+	  fn (b' as T' {entry, profileLabel, statements, transfer}, ac) =>
+	  case transfer of
+	     SOME transfer => b' :: ac
+	   | NONE =>
+		case ac of
+		   [] => Error.bug "compress' with dangling transfer"
+		 | b2' :: ac =>
+		      let
+			 val T' {entry = entry2,
+				 profileLabel = profileLabel2,
+				 statements = statements2,
+				 transfer = transfer2} = b2'
+		      in
+			 case entry2 of
+			    SOME _ =>
+			       Error.bug "compress' with mismatched transfer"
+			  | NONE =>
+			       let
+				  val (pl, ss) =
+				     case (profileLabel, statements) of
+					(NONE, []) =>
+					   (profileLabel2, statements2)
+				      | _ => 
+					   (profileLabel,
+					    statements
+					    @ (ProfileLabel.toAssemblyOpt
+					       profileLabel2)
+					    @ statements2)
+			       in
+				  T' {entry = entry,
+				      profileLabel = pl,
+				      statements = ss,
+				      transfer = transfer2} :: ac
+			       end
+		      end)
 
-      val rec compress
-	= fn [] => []
-           | [T' {entry = SOME entry1,
-		  profileLabel = profileLabel1,
-		  statements = statements1,
-		  transfer = SOME transfer1}]
-	   => [T {entry = entry1,
-		  profileLabel = profileLabel1,
-		  statements = statements1,
-		  transfer = transfer1}]
-	   | (T' {entry = SOME entry1,
-		  profileLabel = profileLabel1,
-		  statements = statements1,
-		  transfer = SOME transfer1})::blocks
-	   => (T {entry = entry1,
-		  profileLabel = profileLabel1,
-		  statements = statements1,
-		  transfer = transfer1})::(compress blocks)
-	   | (T' {entry = SOME entry1, 
-		  profileLabel = NONE,
-		  statements = [], 
-		  transfer = NONE})::
-	     (T' {entry = NONE, 
-		  profileLabel = profileLabel2,
-		  statements = statements2, 
-		  transfer = transfer2})::blocks
-           => compress ((T' {entry = SOME entry1,
-			     profileLabel = profileLabel2,
-			     statements = statements2,
-			     transfer = transfer2})::blocks)
-	   | (T' {entry = SOME entry1, 
-		  profileLabel = profileLabel1,
-		  statements = statements1, 
-		  transfer = NONE})::
-	     (T' {entry = NONE, 
-		  profileLabel = profileLabel2,
-		  statements = statements2, 
-		  transfer = transfer2})::blocks
-           => compress ((T' {entry = SOME entry1,
-			     profileLabel = profileLabel1,
-			     statements = statements1 @
-			                  (ProfileLabel.toAssemblyOpt profileLabel2) @
-			                  statements2,
-			     transfer = transfer2})::blocks)
-	   | _ => Error.bug "Blocks.compress"
+      val compress: t' list -> t list =
+	 fn l =>
+	 List.map
+	 (compress' l, fn T' {entry, profileLabel, statements, transfer} =>
+	  case (entry, transfer) of
+	     (SOME e, SOME t) =>
+		T {entry = e,
+		   profileLabel = profileLabel,
+		   statements = statements,
+		   transfer = t}
+	   | _ => Error.bug "compress")
     end
 
   structure Chunk =