From ca8135a6852cde2206ce9bdaa9b9d57f3b047f4e Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Fri, 11 Feb 2011 17:25:55 +0000 Subject: [PATCH] 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. --- NEWS | 1 + src/code/funutils.lisp | 9 +++------ src/compiler/srctran.lisp | 12 +++++------- tests/compiler.pure.lisp | 5 +++++ version.lisp-expr | 2 +- 5 files changed, 15 insertions(+), 14 deletions(-) diff --git a/NEWS b/NEWS index 36f68c8..22a9839 100644 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4