From b70592cd55646c24592cfc0e4a3d788a97934076 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Tue, 6 Oct 2009 23:42:08 -0400 Subject: [PATCH] Close some procedures whose closing blocks are expression blocks. --- src/compiler/fgopt/closan.scm | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) 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) -- 2.25.1