0.6.11.34:

[sbcl.git] / src / code / list.lisp

diff --git a/src/code/list.lisp b/src/code/list.lisp
index cc13b1a..4dea431 100644 (file)
--- a/src/code/list.lisp
+++ b/src/code/list.lisp
@@ -490,42 +490,31 @@
 (defun complement (function)
   #!+sb-doc
   "Builds a new function that returns T whenever FUNCTION returns NIL and
-   NIL whenever FUNCTION returns T."
-  #'(lambda (&optional (arg0 nil arg0-p) (arg1 nil arg1-p) (arg2 nil arg2-p)
-                      &rest more-args)
-      (not (cond (more-args (apply function arg0 arg1 arg2 more-args))
-                (arg2-p (funcall function arg0 arg1 arg2))
-                (arg1-p (funcall function arg0 arg1))
-                (arg0-p (funcall function arg0))
-                (t (funcall function))))))
-
-(defun constantly (value &optional (val1 nil val1-p) (val2 nil val2-p)
-                        &rest more-values)
-  #!+sb-doc
-  "Builds a function that always returns VALUE, and posisbly MORE-VALUES."
-  (cond (more-values
-        (let ((list (list* value val1 val2 more-values)))
-          #'(lambda ()
-              (declare (optimize-interface (speed 3) (safety 0)))
-              (values-list list))))
-       (val2-p
-        #'(lambda ()
-            (declare (optimize-interface (speed 3) (safety 0)))
-            (values value val1 val2)))
-       (val1-p
-        #'(lambda ()
-            (declare (optimize-interface (speed 3) (safety 0)))
-            (values value val1)))
-       (t
-        #'(lambda ()
-            (declare (optimize-interface (speed 3) (safety 0)))
-            value))))
+   NIL whenever FUNCTION returns non-NIL."
+  (lambda (&optional (arg0 nil arg0-p) (arg1 nil arg1-p) (arg2 nil arg2-p)
+                    &rest more-args)
+    (not (cond (more-args (apply function arg0 arg1 arg2 more-args))
+              (arg2-p (funcall function arg0 arg1 arg2))
+              (arg1-p (funcall function arg0 arg1))
+              (arg0-p (funcall function arg0))
+              (t (funcall function))))))
+
+(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)))
+    value))
 \f
 ;;;; macros for (&KEY (KEY #'IDENTITY) (TEST #'EQL TESTP) (TEST-NOT NIL NOTP))
 
-;;; Use these with the following keyword args:
+;;; Use these with the following &KEY args:
 (defmacro with-set-keys (funcall)
-  `(cond ((and testp notp) (error "Test and test-not both supplied."))
+  `(cond ((and testp notp) (error ":TEST and :TEST-NOT were both supplied."))
         (notp ,(append funcall '(:key key :test-not test-not)))
         (t ,(append funcall '(:key key :test test)))))