From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 7 Oct 2009 03:42:08 +0000 (-0400)
Subject: Close some procedures whose closing blocks are expression blocks.
X-Git-Tag: 20100708-Gtk~294
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b70592cd55646c24592cfc0e4a3d788a97934076;p=mit-scheme.git

Close some procedures whose closing blocks are expression blocks.
---

diff --git a/src/compiler/fgopt/closan.scm b/src/compiler/fgopt/closan.scm
index 640b6c4f6..974d4b7d6 100644
--- a/src/compiler/fgopt/closan.scm
+++ b/src/compiler/fgopt/closan.scm
@@ -303,15 +303,18 @@ USA.
   ;; if it was an ancestor before procedure-drifting took place, don't
   ;; close, just undrift.
   (let ((procedure (condition-procedure condition)))
-    (cond ((block-ancestor-or-self? block block*)
-	   unspecific)
-	  ((and (original-block-ancestor? block block*)
-		(not (procedure-closure-context procedure)))
-	   (undrifting-constraint! block block* condition))
-	  (else
-	   (close-procedure! procedure
-			     (condition-keyword condition)
-			     (condition-argument condition))))))
+    (define (close)
+      (close-procedure! procedure
+			(condition-keyword condition)
+			(condition-argument condition)))
+    (cond ((and (ic-block? block*)
+		(not (eq? block block*)))
+	   (close))
+	  ((not (block-ancestor-or-self? block block*))
+	   (if (and (original-block-ancestor? block block*)
+		    (not (procedure-closure-context procedure)))
+	       (undrifting-constraint! block block* condition)
+	       (close))))))
 
 (define (close-procedure! procedure keyword argument)
   (add-closure-reason! procedure keyword argument)