From f33ae9d7b1b764deb327c7534392216d17de8f1e Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Fri, 16 Mar 1990 13:59:37 +0000
Subject: [PATCH] Fixed TRANSFORM-CALL to return T or NIL to indicate whether
 to attempt other transforms, and changed IR1-OPTIMIZE-COMBINATION to respect
 this.

---
 compiler/ir1opt.lisp | 21 ++++++++++++++-------
 1 file changed, 14 insertions(+), 7 deletions(-)

diff --git a/compiler/ir1opt.lisp b/compiler/ir1opt.lisp
index 88b8572f8..a431cdf4f 100644
--- a/compiler/ir1opt.lisp
+++ b/compiler/ir1opt.lisp
@@ -708,7 +708,8 @@
        (let ((fun (function-info-optimizer kind)))
 	 (unless (and fun (funcall fun node))
 	   (dolist (x (function-info-transforms kind))
-	     (ir1-transform node (car x) (cdr x))))))))
+	     (unless (ir1-transform node (car x) (cdr x))
+	       (return))))))))
 
   (undefined-value))
 
@@ -789,10 +790,13 @@
 ;;;    Attempt to transform Node using Function, subject to the call type
 ;;; constraint Type.  If we are inhibited from doing the transform for some
 ;;; reason and Flame is true, then we make a note of the message in 
-;;; *failed-optimizations* for IR1 finalize to pick up.
+;;; *failed-optimizations* for IR1 finalize to pick up.  We return true if
+;;; the transform failed, and thus further transformation should be
+;;; attempted.  We return false if either the transform suceeded or was
+;;; aborted.
 ;;;
-(proclaim '(function ir1-transform (node type function) void))
 (defun ir1-transform (node type fun)
+  (declare (type combination node) (type ctype type) (type function fun))
   (let ((constrained (function-type-p type))
 	(flame (policy node (> speed brevity)))
 	(*compiler-error-context* node))
@@ -805,21 +809,24 @@
 		 (remhash node *failed-optimizations*)
 		 (values :none nil))
 	     (ecase severity
-	       (:none)
+	       (:none nil)
 	       (:aborted
 		(setf (combination-kind node) :full)
 		(setf (ref-inlinep (continuation-use (combination-fun node)))
 		      :notinline)
 		(when args
-		  (apply #'compiler-warning args)))
+		  (apply #'compiler-warning args))
+		nil)
 	       (:failure 
 		(when (and flame args)
-		  (setf (gethash node *failed-optimizations*) args))))))
+		  (setf (gethash node *failed-optimizations*) args))
+		t))))
 	  ((and flame
 		(valid-function-use node type
 				    :argument-test #'types-intersect
 				    :result-test #'values-types-intersect))
-	   (setf (gethash node *failed-optimizations*) type)))))
+	   (setf (gethash node *failed-optimizations*) type)
+	   t))))
 
 
 ;;; GIVE-UP, ABORT-TRANSFORM  --  Interface
-- 
GitLab