Close some procedures whose closing blocks are expression blocks.

diff --git a/src/compiler/fgopt/closan.scm b/src/compiler/fgopt/closan.scm
index 640b6c4f60cd82f91c8728adc0acdd9e845cf6c1..974d4b7d62efa140ce1e182f471cd2fcbebb1d43 100644 (file)
--- 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)