From c4b30c86e3dd1d1cc70c572a6cfffe8b84e9c34a Mon Sep 17 00:00:00 2001
From: Paul Khuong <pvk@pvk.ca>
Date: Sat, 18 Jul 2009 17:44:42 +0000
Subject: [PATCH] 1.0.30.2: more aggressive constant-folding

* Allow constant-folding on values of an EQL type.

* Fix a buggy :load-if in x86-64 float EQLs VOPs.
---
 src/compiler/ir1opt.lisp       |   21 +++++++++++++++++----
 src/compiler/x86-64/float.lisp |    2 +-
 tests/float.pure.lisp          |   11 +++++++++++
 version.lisp-expr              |    2 +-
 4 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 62f019a..d091f38 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -23,15 +23,28 @@
 (defun constant-lvar-p (thing)
   (declare (type (or lvar null) thing))
   (and (lvar-p thing)
-       (let ((use (principal-lvar-use thing)))
-         (and (ref-p use) (constant-p (ref-leaf use))))))
+       (or (let ((use (principal-lvar-use thing)))
+             (and (ref-p use) (constant-p (ref-leaf use))))
+           ;; check for EQL types (but not singleton numeric types)
+           (let ((type (lvar-type thing)))
+             (and (member-type-p type)
+                  (eql 1 (member-type-size type)))))))
 
 ;;; Return the constant value for an LVAR whose only use is a constant
 ;;; node.
 (declaim (ftype (function (lvar) t) lvar-value))
 (defun lvar-value (lvar)
-  (let ((use (principal-lvar-use lvar)))
-    (constant-value (ref-leaf use))))
+  (let ((use  (principal-lvar-use lvar))
+        (type (lvar-type lvar))
+        leaf)
+    (cond ((and (ref-p use)
+                (constant-p (setf leaf (ref-leaf use))))
+           (constant-value leaf))
+          ((and (member-type-p type)
+                (eql 1 (member-type-size type)))
+           (first (member-type-members type)))
+          (t
+           (error "~S used on non-constant LVAR ~S" 'lvar-value lvar)))))
 
 ;;;; interface for obtaining results of type inference
 
diff --git a/src/compiler/x86-64/float.lisp b/src/compiler/x86-64/float.lisp
index 999771b..b0d1b77 100644
--- a/src/compiler/x86-64/float.lisp
+++ b/src/compiler/x86-64/float.lisp
@@ -830,7 +830,7 @@
                             :load-if (not (sc-is x ,constant-sc)))
                          (y :scs (,sc ,constant-sc)
                             :target mask
-                            :load-if (not (sc-is x ,constant-sc))))
+                            :load-if (not (sc-is y ,constant-sc))))
                   (:arg-types ,type ,type)
                   (:temporary (:sc ,sc :from :eval) mask)
                   (:temporary (:sc any-reg) bits)
diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp
index bea74a8..f0d9a5d 100644
--- a/tests/float.pure.lisp
+++ b/tests/float.pure.lisp
@@ -233,3 +233,14 @@
     (assert (eql 0.0d0 (funcall f 123.0d0 0.0)))
     (assert (eql 0.0d0 (funcall f 123.0d0 0.0d0)))
     (assert (eql 0.0d0 (funcall f 123.0 0.0d0)))))
+
+;; Bug reported by Eric Marsden on July 15 2009. The compiler
+;; used not to constant fold calls with arguments of type
+;; (EQL foo).
+(with-test (:name :eql-type-constant-fold)
+  (assert (equal '(FUNCTION (T) (VALUES (MEMBER T) &OPTIONAL))
+                 (sb-kernel:%simple-fun-type
+                  (compile nil `(lambda (x)
+                                  (eql #c(1.0 2.0)
+                                       (the (eql #c(1.0 2.0))
+                                         x))))))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 66b8672..c5fcc61 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.30.1"
+"1.0.30.2"
-- 
1.7.10.4