From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Mon, 24 Aug 1987 19:45:33 +0000 (+0000)
Subject: Fix integration of the result of applying early transformers.
X-Git-Tag: 20090517-FFI~13113
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a4ba0b1c40817cc37f814d33ec11645eade47e3a;p=mit-scheme.git

Fix integration of the result of applying early transformers.
---

diff --git a/v7/src/compiler/base/pmerly.scm b/v7/src/compiler/base/pmerly.scm
index 1bc7418a2..162d5894e 100644
--- a/v7/src/compiler/base/pmerly.scm
+++ b/v7/src/compiler/base/pmerly.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/pmerly.scm,v 1.3 1987/07/30 07:03:43 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/pmerly.scm,v 1.4 1987/08/24 19:45:33 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -509,11 +509,28 @@ MIT in each case. |#
 	       ((eq? result 'MAYBE)
 		(possible (make-simple-transformer-test name null-form)
 			  make-outer-binding))
-	       ((scode/let? code)
-		;; kludge!
-		(possible true make-late-binding))
-	       (else
-		(possible true make-early-binding))))))))
+	       ((can-integrate? code)
+		(possible true make-early-binding))
+	       (else		
+		(possible true make-late-binding))))))))
+
+;; Mega kludge!
+
+(define (can-integrate? code)
+  (if (not (scode/let? code))
+      true
+      (scode/let-components
+       code
+       (lambda (names values decls body)
+	  (and (not (null? names))
+	       (let ((place (assq 'INTEGRATE decls)))
+		 (and (not (null? place))
+		      (let ((integrated (cdr place)))
+			(let loop ((left names))
+			  (cond ((null? left) true)
+				((memq (car left) integrated)
+				 (loop (cdr left)))
+				(else false)))))))))))			     
 
 (define-integrable (make-simple-transformer-test name tag)
   (scode/make-absolute-combination 'NOT
@@ -637,7 +654,7 @@ MIT in each case. |#
 		      declarations
 		      body)
    values))
-#|
+
 (define (scode/let-components lcomb receiver)
   (scode/combination-components
    (lambda (operator values)
@@ -645,7 +662,6 @@ MIT in each case. |#
       operator
       (lambda (tag names opt rest aux decls body)
 	(receiver names values decls body))))))				     
-|#
 
 ;;;; Scode utilities (continued)