From: Taylor R Campbell <campbell@mumble.net>
Date: Fri, 9 Oct 2009 20:29:10 +0000 (-0400)
Subject: Make AUTOMAGIC-INTEGRATIONS search recursively, so that it transform
X-Git-Tag: 20100708-Gtk~273^2~6
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2ae287b4d0cd8b222f06dba47f3bd6c080047676;p=mit-scheme.git

Make AUTOMAGIC-INTEGRATIONS search recursively, so that it transform

(let ((foo cdr))
  (cdr x))

into

(cdr x),

which will then be open-coded.  I believe AUTOMAGIC-INTEGRATIONS
formerly made no changes that improved the code LIAR generates; now
this change does improve the code that LIAR generates.  This idiom
arises mainly in macros and in integrated procedures.

Fix bugs in previous changes that this change uncovered: when
integrating compound operators and conditional predicates, bail if
any open blocks are involved; handling them is too complicated.
---

diff --git a/src/sf/subst.scm b/src/sf/subst.scm
index 6a7089bb0..588baee96 100644
--- a/src/sf/subst.scm
+++ b/src/sf/subst.scm
@@ -122,6 +122,7 @@ USA.
 		(lambda ()
 		  (integrate/name-if-safe expression expression
 					  environment operations
+					  '(INTEGRATE INTEGRATE-SAFELY)
 					  integration-success
 					  integration-failure))))
 	(operations/lookup operations variable
@@ -143,14 +144,15 @@ USA.
 	       (integration-failure))))))))
 
 (define (integrate/name-if-safe expr reference environment
-				operations if-win if-fail)
+				operations safe-operations if-win if-fail)
   (let ((variable (reference/variable reference)))
     (if (or (variable/side-effected variable)
 	    (not (block/safe? (variable/block variable))))
 	(if-fail)
 	(let ((finish
 	       (lambda (value)
-		 (if (constant-value? value environment operations)
+		 (if (safely-integrable-value? value environment operations
+					       safe-operations)
 		     (if-win
 		      (reassign
 		       expr
@@ -173,29 +175,34 @@ USA.
       (with-new-scode (object/scode expr) object)
       object))
 
-(define (constant-value? value environment operations)
+(define (safely-integrable-value? value environment operations safe-operations)
   (let check ((value value) (top? #t))
     (or (constant? value)
 	(and (reference? value)
 	     (or (not top?)
-		 (let ((var (reference/variable value)))
-		   (and (not (variable/side-effected var))
-			(block/safe? (variable/block var))
-			(environment/lookup environment var
-			  (lambda (value*)
-			    (check value* #f))
-			  (lambda ()
-			    ;; unknown value
-			    (operations/lookup operations var
-			      (lambda (operation info)
-				operation info
-				#f)
+		 (let ((variable (reference/variable value)))
+		   (or (operations/lookup operations variable
+			 (lambda (operation info)
+			   info		;ignore
+			   (memq operation safe-operations))
+			 (lambda () #f))
+		       (and (not (variable/side-effected variable))
+			    (block/safe? (variable/block variable))
+			    (environment/lookup environment variable
+			      (lambda (value*)
+				(check value* #f))
 			      (lambda ()
-				;; No operations
-				#t)))
-			  (lambda ()
-			    ;; not found variable
-			    #t)))))))))
+				;; unknown value
+				(operations/lookup operations variable
+				  (lambda (operation info)
+				    operation info
+				    #f)
+				  (lambda ()
+				    ;; No operations
+				    #t)))
+			      (lambda ()
+				;; not found variable
+				#t))))))))))
 
 (define (integrate/reference-operator expression operations environment
 				      block operator operands)
@@ -217,6 +224,8 @@ USA.
 	      (lambda ()
 		(integrate/name-if-safe expression operator
 					environment operations
+					'(EXPAND INTEGRATE INTEGRATE-OPERATOR
+						 INTEGRATE-SAFELY)
 					integration-success
 					integration-failure))))
       (operations/lookup operations variable
@@ -544,7 +553,8 @@ you ask for.
 (define (integrate/compound-operator operator operands)
   (define (scan-body body encloser)
     (if (procedure? body)
-	(procedure-with-body body (encloser (procedure/body body)))
+	(and (not (open-block? (procedure/body body)))
+	     (procedure-with-body body (encloser (procedure/body body))))
 	(scan-operator body encloser)))
   (define (scan-operator operator encloser)
     (cond ((sequence? operator)
@@ -559,12 +569,14 @@ you ask for.
 	  ((combination? operator)
 	   (let ((descend
 		  (lambda (operator*)
-		    (scan-body (procedure/body operator*)
-			       (lambda (body*)
-				 (encloser
-				  (combination-with-operator
-				   operator
-				   (procedure-with-body operator* body*)))))))
+		    (and (not (open-block? (procedure/body operator*)))
+			 (scan-body
+			  (procedure/body operator*)
+			  (lambda (body*)
+			    (encloser
+			     (combination-with-operator
+			      operator
+			      (procedure-with-body operator* body*))))))))
 		 (operator* (combination/operator operator)))
 	     (cond ((procedure? operator*) (descend operator*))
 		   ((integrate/compound-operator
@@ -667,7 +679,10 @@ you ask for.
 		   (cons (loop (car actions))
 			 (cdr actions))))))
 	      ((and (combination? predicate)
-		    (procedure? (combination/operator predicate)))
+		    (procedure? (combination/operator predicate))
+		    (not
+		     (open-block?
+		      (procedure/body (combination/operator predicate)))))
 	       (combination-with-operator
 		predicate
 		(procedure-with-body