From 9df4b285c97087d4333b052d42a9039c2fd18d03 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 2 Dec 1989 21:19:29 +0000
Subject: [PATCH] Don't undrift a procedure if the only reason for doing so is
 contagion from trivial closures.

---
 v7/src/compiler/fgopt/closan.scm | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/v7/src/compiler/fgopt/closan.scm b/v7/src/compiler/fgopt/closan.scm
index a7172d39e..a315bfe13 100644
--- a/v7/src/compiler/fgopt/closan.scm
+++ b/v7/src/compiler/fgopt/closan.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/closan.scm,v 4.10 1989/10/26 07:36:40 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/closan.scm,v 4.11 1989/12/02 21:19:29 cph Exp $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -309,7 +309,11 @@ MIT in each case. |#
      (let ((entries
 	    (list-transform-negative! (cdr entry)
 	      (lambda (entry*)
-		(null? (cdr entry*))))))
+		(for-all? (cdr entry*)
+		  (lambda (condition)
+		    (and condition
+			 (eq? 'CONTAGION (cadr condition))
+			 (procedure/trivial-closure? (caddr condition)))))))))
        (if (not (null? entries))
 	   (undrift-block! (car entry)
 			   (reduce original-block-nearest-ancestor
-- 
2.25.1