carbon2-commit: Normally return a compiled function if one argument, #'constantly.

[Aidan Kehoe]

changeset:   5125:868a9ffcc37b
user:        Aidan Kehoe <kehoea at parhasard.net>
date:        Wed Feb 24 17:17:13 2010 +0000
files:       lisp/ChangeLog lisp/cl-extra.el
description:
Normally return a compiled function if one argument, #'constantly.

2010-02-24  Aidan Kehoe  <kehoea at parhasard.net>

	* cl-extra.el (constantly):
	Normally return a compiled function from #'constantly if we are
	handed a single argument. Shouldn't actually matter, the overhead
	for returning a single constant in a lambda form vs. in a compiled
	function is minuscule, but using compiled functions as much as
	possible is good style in XEmacs, our interpreter is not stellar
	(nor indeed should it need to be).


diff -r 8af6a32b170d -r 868a9ffcc37b lisp/ChangeLog
--- a/lisp/ChangeLog	Wed Feb 24 15:45:20 2010 +0100
+++ b/lisp/ChangeLog	Wed Feb 24 17:17:13 2010 +0000
@@ -1,3 +1,13 @@
+2010-02-24  Aidan Kehoe  <kehoea at parhasard.net>
+
+	* cl-extra.el (constantly):
+	Normally return a compiled function from #'constantly if we are
+	handed a single argument. Shouldn't actually matter, the overhead
+	for returning a single constant in a lambda form vs. in a compiled
+	function is minuscule, but using compiled functions as much as
+	possible is good style in XEmacs, our interpreter is not stellar
+	(nor indeed should it need to be).
+
 2010-02-23  Ben Wing  <ben at xemacs.org>
 
 	* help.el: fux typo in comment. (oops)
diff -r 8af6a32b170d -r 868a9ffcc37b lisp/cl-extra.el
--- a/lisp/cl-extra.el	Wed Feb 24 15:45:20 2010 +0100
+++ b/lisp/cl-extra.el	Wed Feb 24 17:17:13 2010 +0000
@@ -612,9 +612,7 @@
 	  ((memq (car plst) indicator-list)
 	   (return (values (car plst) (cadr plst) plst))))))
 
-;; See our compiler macro in cl-macs.el, we will only pass back the
-;; actual lambda list in interpreted code or if we've been funcalled
-;; (from #'apply or #'mapcar or whatever).
+;; See also the compiler macro in cl-macs.el.
 (defun constantly (value &rest more-values)
   "Construct a function always returning VALUE, and possibly MORE-VALUES.
 
@@ -622,7 +620,24 @@
 
 Members of MORE-VALUES, if provided, will be passed as multiple values; see
 `multiple-value-bind' and `multiple-value-setq'."
-  `(lambda (&rest ignore) (values-list ',(cons value more-values))))
+  (symbol-macrolet
+      ((arglist '(&rest ignore)))
+    (if (or more-values (eval-when-compile (not (cl-compiling-file))))
+        `(lambda ,arglist (values-list ',(cons value more-values)))
+      (make-byte-code
+       arglist
+       (eval-when-compile
+         (let ((compiled (byte-compile-sexp #'(lambda (&rest ignore)
+                                                (declare (ignore ignore))
+                                                'placeholder))))
+           (assert (and
+                    (equal [placeholder]
+                           (compiled-function-constants compiled))
+                    (= 1 (compiled-function-stack-depth compiled)))
+		   t
+		   "Our assumptions about compiled code appear not to hold.")
+           (compiled-function-instructions compiled)))
+       (vector value) 1))))
 
 ;;; Hash tables.