Mercurial > hg > xemacs-beta

comparison lisp/cl-extra.el @ 5075:868a9ffcc37b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Normally return a compiled function if one argument, #'constantly. 2010-02-24 Aidan Kehoe <kehoea@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).
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 24 Feb 2010 17:17:13 +0000
parents 6aba0daedb7c
children 41262f87eb39
comparison
equal deleted inserted replaced
5074:8af6a32b170d 5075:868a9ffcc37b
610 (cond ((atom (cdr plst)) 610 (cond ((atom (cdr plst))
611 (error "Malformed property list: %S." plist)) 611 (error "Malformed property list: %S." plist))
612 ((memq (car plst) indicator-list) 612 ((memq (car plst) indicator-list)
613 (return (values (car plst) (cadr plst) plst)))))) 613 (return (values (car plst) (cadr plst) plst))))))
614 614
615 ;; See our compiler macro in cl-macs.el, we will only pass back the 615 ;; See also the compiler macro in cl-macs.el.
616 ;; actual lambda list in interpreted code or if we've been funcalled
617 ;; (from #'apply or #'mapcar or whatever).
618 (defun constantly (value &rest more-values) 616 (defun constantly (value &rest more-values)
619 "Construct a function always returning VALUE, and possibly MORE-VALUES. 617 "Construct a function always returning VALUE, and possibly MORE-VALUES.
620 618
621 The constructed function accepts any number of arguments, and ignores them. 619 The constructed function accepts any number of arguments, and ignores them.
622 620
623 Members of MORE-VALUES, if provided, will be passed as multiple values; see 621 Members of MORE-VALUES, if provided, will be passed as multiple values; see
624 `multiple-value-bind' and `multiple-value-setq'." 622 `multiple-value-bind' and `multiple-value-setq'."
625 `(lambda (&rest ignore) (values-list ',(cons value more-values)))) 623 (symbol-macrolet
624 ((arglist '(&rest ignore)))
625 (if (or more-values (eval-when-compile (not (cl-compiling-file))))
626 `(lambda ,arglist (values-list ',(cons value more-values)))
627 (make-byte-code
628 arglist
629 (eval-when-compile
630 (let ((compiled (byte-compile-sexp #'(lambda (&rest ignore)
631 (declare (ignore ignore))
632 'placeholder))))
633 (assert (and
634 (equal [placeholder]
635 (compiled-function-constants compiled))
636 (= 1 (compiled-function-stack-depth compiled)))
637 t
638 "Our assumptions about compiled code appear not to hold.")
639 (compiled-function-instructions compiled)))
640 (vector value) 1))))
626 641
627 ;;; Hash tables. 642 ;;; Hash tables.
628 643
629 ;; The `regular' Common Lisp hash-table stuff has been moved into C. 644 ;; The `regular' Common Lisp hash-table stuff has been moved into C.
630 ;; Only backward compatibility stuff remains here. 645 ;; Only backward compatibility stuff remains here.