1.0.45.17: give CONSTANTLY some love

 Replace the source-transform with a DERIVE-TYPE optimizer: there are
 essentially no cases where the source transform improves performance.

 Make sure the out-of-line version has the right lambda-list.

 Fixes lp#713626.

diff --git a/NEWS b/NEWS
index 36f68c8..22a9839 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -9,6 +9,7 @@ changes relative to sbcl-1.0.45:
     safe (lp#673630).
   * bug fix: Solaris/x86-64 wasn't getting built with lutex support by
     mistake. (lp#667297).
+  * bug fix: CONSTANTLY generated functions had bogus lambda-lists. (lp#713626)
 
 changes in sbcl-1.0.45 relative to sbcl-1.0.44:
   * enhancement: ~/ and ~user/ are treated specially in pathnames.

diff --git a/src/code/funutils.lisp b/src/code/funutils.lisp
index 456128f..00ecb67 100644 (file)
--- a/src/code/funutils.lisp
+++ b/src/code/funutils.lisp
@@ -32,10 +32,7 @@
 (defun constantly (value)
   #!+sb-doc
   "Return a function that always returns VALUE."
-  (lambda ()
-    ;; KLUDGE: This declaration is a hack to make the closure ignore
-    ;; all its arguments without consing a &REST list or anything.
-    ;; Perhaps once DYNAMIC-EXTENT is implemented we won't need to
-    ;; screw around with this kind of thing. -- WHN 2001-04-06
-    (declare (optimize (speed 3) (safety 0)))
+  (lambda (&rest arguments)
+    (declare (ignore arguments))
+    (declare (optimize (speed 3) (safety 0) (debug 0)))
     value))

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 50d4d3c..ed2f97b 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -29,13 +29,11 @@
 (define-source-transform identity (x) `(prog1 ,x))
 (define-source-transform values (x) `(prog1 ,x))
 
-;;; Bind the value and make a closure that returns it.
-(define-source-transform constantly (value)
-  (with-unique-names (rest n-value)
-    `(let ((,n-value ,value))
-      (lambda (&rest ,rest)
-        (declare (ignore ,rest))
-        ,n-value))))
+
+;;; CONSTANTLY is pretty much never worth transforming, but it's good to get the type.
+(defoptimizer (constantly derive-type) ((value))
+  (specifier-type
+   `(function (&rest t) (values ,(type-specifier (lvar-type value)) &optional))))
 
 ;;; If the function has a known number of arguments, then return a
 ;;; lambda with the appropriate fixed number of args. If the

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 37bf669..0cd2fac 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3760,3 +3760,8 @@
                             (foo z args)))
                      (declare (sb-int:truly-dynamic-extent #'foo))
                      (call #'foo nil))))))
+
+(with-test (:name :bug-713626)
+  (let ((f (eval '(constantly 42))))
+    (handler-bind ((warning #'error))
+      (assert (= 42 (funcall (compile nil `(lambda () (funcall ,f 1 2 3)))))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index eeaa20f..348c803 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,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.45.16"
+"1.0.45.17"