[MLton-devel] cvs commit: eliminatedDeadBlocks bug fix

[Stephen Weeks]

sweeks      02/08/22 09:09:46

  Modified:    mlton/ssa shrink.fun
  Log:
  Fixed bug in eliminateDeadBlocks -- it had deleted dead blocks but left around
  references in HandlerPush/Pop.  Now, it deletes the "dead" HandlerPush/Pops as
  well.

Revision  Changes    Path
1.19      +22 -3     mlton/mlton/ssa/shrink.fun

Index: shrink.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/shrink.fun,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- shrink.fun	21 Aug 2002 04:48:31 -0000	1.18
+++ shrink.fun	22 Aug 2002 16:09:45 -0000	1.19
@@ -1293,12 +1293,31 @@
 	 (functions, fn f =>
 	  let
 	     val {args, blocks, name, raises, returns, start} = Function.dest f
-	     val {get, set, rem} =
+	     val {get = isLive, set = setLive, rem} =
 		Property.getSetOnce (Label.plist, Property.initConst false)
 	     val _ = Function.dfs (f, fn Block.T {label, ...} =>
-				   (set (label, true)
+				   (setLive (label, true)
 				    ; fn () => ()))
-	     val blocks = Vector.keepAll (blocks, get o Block.label)
+	     val blocks =
+		Vector.keepAllMap
+		(blocks, fn Block.T {args, label, statements, transfer} =>
+		 if isLive label
+		    then
+		       let
+			  val statements =
+			     Vector.keepAll
+			     (statements, fn Statement.T {exp, ...} =>
+			      case exp of
+				 HandlerPop l => isLive l
+			       | HandlerPush l => isLive l
+			       | _ => true)
+		       in
+			  SOME (Block.T {args = args,
+					 label = label,
+					 statements = statements,
+					 transfer = transfer})
+		       end
+		 else NONE)
 	     val _ = Vector.foreach (blocks, rem o Block.label)
 	  in
 	     Function.new {args = args,





-------------------------------------------------------
This sf.net email is sponsored by: OSDN - Tired of that same old
cell phone?  Get a new here for FREE!
https://www.inphonic.com/r.asp?r=sourceforge1&refcode1=vs3390
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel