Fix compiler-expansion of CL's cXXr functions.
* emacs-lisp/cl-lib.el (cl--defalias): New function. (cl-values, cl-values-list, cl-copy-seq, cl-svref, cl-first) (cl-second, cl-rest, cl-endp, cl-third, cl-fourth): Use it. (cl-plusp, cl-minusp, cl-fifth, cl-sixth, cl-seventh, cl-eighth) (cl-ninth, cl-tenth): Mark them as inlinable. (cl-caaar, cl-caadr, cl-cadar, cl-caddr, cl-cdaar, cl-cdadr) (cl-cddar, cl-cdddr, cl-caaaar, cl-caaadr, cl-caadar, cl-caaddr) (cl-cadaar, cl-cadadr, cl-caddar, cl-cadddr, cl-cdaaar, cl-cdaadr) (cl-cdadar, cl-cdaddr, cl-cddaar, cl-cddadr, cl-cdddar, cl-cddddr): Add a compiler-macro declaration to use cl--compiler-macro-cXXr. (cl-list*, cl-adjoin): Don't put an autoload manually. * emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin) (cl--compiler-macro-list*): Add autoload cookie. (cl--compiler-macro-cXXr): New function. * help-fns.el (help-fns--compiler-macro): New function extracted from describe-function-1; follow aliases and use `compiler-macro' property. (describe-function-1): Use it. Fixes: debbugs:11673
This commit is contained in:
Stefan Monnier
parent
a66744021f
commit
71adb94b71
5 changed files with 153 additions and 79 deletions
|
|
@ -1,3 +1,24 @@
|
|||
2012-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
Fix compiler-expansion of CL's cXXr functions (bug#11673).
|
||||
* emacs-lisp/cl-lib.el (cl--defalias): New function.
|
||||
(cl-values, cl-values-list, cl-copy-seq, cl-svref, cl-first)
|
||||
(cl-second, cl-rest, cl-endp, cl-third, cl-fourth): Use it.
|
||||
(cl-plusp, cl-minusp, cl-fifth, cl-sixth, cl-seventh, cl-eighth)
|
||||
(cl-ninth, cl-tenth): Mark them as inlinable.
|
||||
(cl-caaar, cl-caadr, cl-cadar, cl-caddr, cl-cdaar, cl-cdadr)
|
||||
(cl-cddar, cl-cdddr, cl-caaaar, cl-caaadr, cl-caadar, cl-caaddr)
|
||||
(cl-cadaar, cl-cadadr, cl-caddar, cl-cadddr, cl-cdaaar, cl-cdaadr)
|
||||
(cl-cdadar, cl-cdaddr, cl-cddaar, cl-cddadr, cl-cdddar, cl-cddddr):
|
||||
Add a compiler-macro declaration to use cl--compiler-macro-cXXr.
|
||||
(cl-list*, cl-adjoin): Don't put an autoload manually.
|
||||
* emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin)
|
||||
(cl--compiler-macro-list*): Add autoload cookie.
|
||||
(cl--compiler-macro-cXXr): New function.
|
||||
* help-fns.el (help-fns--compiler-macro): New function extracted from
|
||||
describe-function-1; follow aliases and use `compiler-macro' property.
|
||||
(describe-function-1): Use it.
|
||||
|
||||
2012-06-11 Chong Yidong <cyd@gnu.org>
|
||||
|
||||
* startup.el (fancy-splash-head): Use splash.svg even if librsvg
|
||||
|
|
|
|||
|
|
@ -217,21 +217,23 @@ an element already on the list.
|
|||
;; simulated. Instead, cl-multiple-value-bind and friends simply expect
|
||||
;; the target form to return the values as a list.
|
||||
|
||||
(defalias 'cl-values #'list
|
||||
(defun cl--defalias (cl-f el-f &optional doc)
|
||||
(defalias cl-f el-f doc)
|
||||
(put cl-f 'byte-optimizer 'byte-compile-inline-expand))
|
||||
|
||||
(cl--defalias 'cl-values #'list
|
||||
"Return multiple values, Common Lisp style.
|
||||
The arguments of `cl-values' are the values
|
||||
that the containing function should return.
|
||||
|
||||
\(fn &rest VALUES)")
|
||||
(put 'cl-values 'byte-optimizer 'byte-compile-inline-expand)
|
||||
|
||||
(defalias 'cl-values-list #'identity
|
||||
(cl--defalias 'cl-values-list #'identity
|
||||
"Return multiple values, Common Lisp style, taken from a list.
|
||||
LIST specifies the list of values
|
||||
that the containing function should return.
|
||||
|
||||
\(fn LIST)")
|
||||
(put 'cl-values-list 'byte-optimizer 'byte-compile-inline-expand)
|
||||
|
||||
(defsubst cl-multiple-value-list (expression)
|
||||
"Return a list of the multiple values produced by EXPRESSION.
|
||||
|
|
@ -300,11 +302,11 @@ On Emacs versions that lack floating-point support, this function
|
|||
always returns nil."
|
||||
(and (numberp object) (not (integerp object))))
|
||||
|
||||
(defun cl-plusp (number)
|
||||
(defsubst cl-plusp (number)
|
||||
"Return t if NUMBER is positive."
|
||||
(> number 0))
|
||||
|
||||
(defun cl-minusp (number)
|
||||
(defsubst cl-minusp (number)
|
||||
"Return t if NUMBER is negative."
|
||||
(< number 0))
|
||||
|
||||
|
|
@ -367,7 +369,7 @@ Call `cl-float-limits' to set this.")
|
|||
|
||||
;;; Sequence functions.
|
||||
|
||||
(defalias 'cl-copy-seq 'copy-sequence)
|
||||
(cl--defalias 'cl-copy-seq 'copy-sequence)
|
||||
|
||||
(declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs))
|
||||
|
||||
|
|
@ -387,141 +389,160 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp
|
|||
(nreverse cl-res)))
|
||||
(mapcar cl-func cl-x)))
|
||||
|
||||
(defalias 'cl-svref 'aref)
|
||||
(cl--defalias 'cl-svref 'aref)
|
||||
|
||||
;;; List functions.
|
||||
|
||||
(defalias 'cl-first 'car)
|
||||
(defalias 'cl-second 'cadr)
|
||||
(defalias 'cl-rest 'cdr)
|
||||
(defalias 'cl-endp 'null)
|
||||
(cl--defalias 'cl-first 'car)
|
||||
(cl--defalias 'cl-second 'cadr)
|
||||
(cl--defalias 'cl-rest 'cdr)
|
||||
(cl--defalias 'cl-endp 'null)
|
||||
|
||||
(defun cl-third (x)
|
||||
"Return the cl-third element of the list X."
|
||||
(car (cdr (cdr x))))
|
||||
(cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.")
|
||||
(cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.")
|
||||
|
||||
(defun cl-fourth (x)
|
||||
"Return the cl-fourth element of the list X."
|
||||
(nth 3 x))
|
||||
|
||||
(defun cl-fifth (x)
|
||||
"Return the cl-fifth element of the list X."
|
||||
(defsubst cl-fifth (x)
|
||||
"Return the fifth element of the list X."
|
||||
(nth 4 x))
|
||||
|
||||
(defun cl-sixth (x)
|
||||
"Return the cl-sixth element of the list X."
|
||||
(defsubst cl-sixth (x)
|
||||
"Return the sixth element of the list X."
|
||||
(nth 5 x))
|
||||
|
||||
(defun cl-seventh (x)
|
||||
"Return the cl-seventh element of the list X."
|
||||
(defsubst cl-seventh (x)
|
||||
"Return the seventh element of the list X."
|
||||
(nth 6 x))
|
||||
|
||||
(defun cl-eighth (x)
|
||||
"Return the cl-eighth element of the list X."
|
||||
(defsubst cl-eighth (x)
|
||||
"Return the eighth element of the list X."
|
||||
(nth 7 x))
|
||||
|
||||
(defun cl-ninth (x)
|
||||
"Return the cl-ninth element of the list X."
|
||||
(defsubst cl-ninth (x)
|
||||
"Return the ninth element of the list X."
|
||||
(nth 8 x))
|
||||
|
||||
(defun cl-tenth (x)
|
||||
"Return the cl-tenth element of the list X."
|
||||
(defsubst cl-tenth (x)
|
||||
"Return the tenth element of the list X."
|
||||
(nth 9 x))
|
||||
|
||||
(defun cl-caaar (x)
|
||||
"Return the `car' of the `car' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(car (car (car x))))
|
||||
|
||||
(defun cl-caadr (x)
|
||||
"Return the `car' of the `car' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(car (car (cdr x))))
|
||||
|
||||
(defun cl-cadar (x)
|
||||
"Return the `car' of the `cdr' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(car (cdr (car x))))
|
||||
|
||||
(defun cl-caddr (x)
|
||||
"Return the `car' of the `cdr' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(car (cdr (cdr x))))
|
||||
|
||||
(defun cl-cdaar (x)
|
||||
"Return the `cdr' of the `car' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(cdr (car (car x))))
|
||||
|
||||
(defun cl-cdadr (x)
|
||||
"Return the `cdr' of the `car' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(cdr (car (cdr x))))
|
||||
|
||||
(defun cl-cddar (x)
|
||||
"Return the `cdr' of the `cdr' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(cdr (cdr (car x))))
|
||||
|
||||
(defun cl-cdddr (x)
|
||||
"Return the `cdr' of the `cdr' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(cdr (cdr (cdr x))))
|
||||
|
||||
(defun cl-caaaar (x)
|
||||
"Return the `car' of the `car' of the `car' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(car (car (car (car x)))))
|
||||
|
||||
(defun cl-caaadr (x)
|
||||
"Return the `car' of the `car' of the `car' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(car (car (car (cdr x)))))
|
||||
|
||||
(defun cl-caadar (x)
|
||||
"Return the `car' of the `car' of the `cdr' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(car (car (cdr (car x)))))
|
||||
|
||||
(defun cl-caaddr (x)
|
||||
"Return the `car' of the `car' of the `cdr' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(car (car (cdr (cdr x)))))
|
||||
|
||||
(defun cl-cadaar (x)
|
||||
"Return the `car' of the `cdr' of the `car' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(car (cdr (car (car x)))))
|
||||
|
||||
(defun cl-cadadr (x)
|
||||
"Return the `car' of the `cdr' of the `car' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(car (cdr (car (cdr x)))))
|
||||
|
||||
(defun cl-caddar (x)
|
||||
"Return the `car' of the `cdr' of the `cdr' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(car (cdr (cdr (car x)))))
|
||||
|
||||
(defun cl-cadddr (x)
|
||||
"Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(car (cdr (cdr (cdr x)))))
|
||||
|
||||
(defun cl-cdaaar (x)
|
||||
"Return the `cdr' of the `car' of the `car' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(cdr (car (car (car x)))))
|
||||
|
||||
(defun cl-cdaadr (x)
|
||||
"Return the `cdr' of the `car' of the `car' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(cdr (car (car (cdr x)))))
|
||||
|
||||
(defun cl-cdadar (x)
|
||||
"Return the `cdr' of the `car' of the `cdr' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(cdr (car (cdr (car x)))))
|
||||
|
||||
(defun cl-cdaddr (x)
|
||||
"Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(cdr (car (cdr (cdr x)))))
|
||||
|
||||
(defun cl-cddaar (x)
|
||||
"Return the `cdr' of the `cdr' of the `car' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(cdr (cdr (car (car x)))))
|
||||
|
||||
(defun cl-cddadr (x)
|
||||
"Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(cdr (cdr (car (cdr x)))))
|
||||
|
||||
(defun cl-cdddar (x)
|
||||
"Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(cdr (cdr (cdr (car x)))))
|
||||
|
||||
(defun cl-cddddr (x)
|
||||
"Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
|
||||
(declare (compiler-macro cl--compiler-macro-cXXr))
|
||||
(cdr (cdr (cdr (cdr x)))))
|
||||
|
||||
;;(defun last* (x &optional n)
|
||||
|
|
@ -548,7 +569,6 @@ Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
|
|||
(last (nthcdr (- n 2) copy)))
|
||||
(setcdr last (car (cdr last)))
|
||||
(cons arg copy)))))
|
||||
(autoload 'cl--compiler-macro-list* "cl-macs")
|
||||
|
||||
(defun cl-ldiff (list sublist)
|
||||
"Return a copy of LIST with the tail SUBLIST removed."
|
||||
|
|
@ -585,7 +605,6 @@ Otherwise, return LIST unmodified.
|
|||
((or (equal cl-keys '(:test equal)) (null cl-keys))
|
||||
(if (member cl-item cl-list) cl-list (cons cl-item cl-list)))
|
||||
(t (apply 'cl--adjoin cl-item cl-list cl-keys))))
|
||||
(autoload 'cl--compiler-macro-adjoin "cl-macs")
|
||||
|
||||
(defun cl-subst (cl-new cl-old cl-tree &rest cl-keys)
|
||||
"Substitute NEW for OLD everywhere in TREE (non-destructively).
|
||||
|
|
|
|||
|
|
@ -254,18 +254,20 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
|
|||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (cl-defsubst cl-compiler-macroexpand cl-define-compiler-macro
|
||||
;;;;;; cl-assert cl-check-type cl-typep cl-deftype cl-struct-setf-expander
|
||||
;;;;;; cl-defstruct cl-define-modify-macro cl-callf2 cl-callf cl-letf*
|
||||
;;;;;; cl-letf cl-rotatef cl-shiftf cl-remf cl-do-pop cl-psetf cl-setf
|
||||
;;;;;; cl-get-setf-method cl-defsetf cl-define-setf-expander cl-declare
|
||||
;;;;;; cl-the cl-locally cl-multiple-value-setq cl-multiple-value-bind
|
||||
;;;;;; cl-symbol-macrolet cl-macrolet cl-labels cl-flet cl-progv
|
||||
;;;;;; cl-psetq cl-do-all-symbols cl-do-symbols cl-dotimes cl-dolist
|
||||
;;;;;; cl-do* cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase
|
||||
;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
|
||||
;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
|
||||
;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "a8ede90b4a2ce9015d4b63254b4678a2")
|
||||
;;;### (autoloads (cl--compiler-macro-cXXr cl--compiler-macro-list*
|
||||
;;;;;; cl--compiler-macro-adjoin cl-defsubst cl-compiler-macroexpand
|
||||
;;;;;; cl-define-compiler-macro cl-assert cl-check-type cl-typep
|
||||
;;;;;; cl-deftype cl-struct-setf-expander cl-defstruct cl-define-modify-macro
|
||||
;;;;;; cl-callf2 cl-callf cl-letf* cl-letf cl-rotatef cl-shiftf
|
||||
;;;;;; cl-remf cl-do-pop cl-psetf cl-setf cl-get-setf-method cl-defsetf
|
||||
;;;;;; cl-define-setf-expander cl-declare cl-the cl-locally cl-multiple-value-setq
|
||||
;;;;;; cl-multiple-value-bind cl-symbol-macrolet cl-macrolet cl-labels
|
||||
;;;;;; cl-flet cl-progv cl-psetq cl-do-all-symbols cl-do-symbols
|
||||
;;;;;; cl-dotimes cl-dolist cl-do* cl-do cl-loop cl-return-from
|
||||
;;;;;; cl-return cl-block cl-etypecase cl-typecase cl-ecase cl-case
|
||||
;;;;;; cl-load-time-value cl-eval-when cl-destructuring-bind cl-function
|
||||
;;;;;; cl-defmacro cl-defun cl-gentemp cl-gensym) "cl-macs" "cl-macs.el"
|
||||
;;;;;; "5eba72da8ff76ec1346aa355feb936cb")
|
||||
;;; Generated autoloads from cl-macs.el
|
||||
|
||||
(autoload 'cl-gensym "cl-macs" "\
|
||||
|
|
@ -777,6 +779,21 @@ surrounded by (cl-block NAME ...).
|
|||
|
||||
\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t)
|
||||
|
||||
(autoload 'cl--compiler-macro-adjoin "cl-macs" "\
|
||||
|
||||
|
||||
\(fn FORM A LIST &rest KEYS)" nil nil)
|
||||
|
||||
(autoload 'cl--compiler-macro-list* "cl-macs" "\
|
||||
|
||||
|
||||
\(fn FORM ARG &rest OTHERS)" nil nil)
|
||||
|
||||
(autoload 'cl--compiler-macro-cXXr "cl-macs" "\
|
||||
|
||||
|
||||
\(fn FORM X)" nil nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads (cl-tree-equal cl-nsublis cl-sublis cl-nsubst-if-not
|
||||
|
|
|
|||
|
|
@ -3011,12 +3011,14 @@ surrounded by (cl-block NAME ...).
|
|||
`(assoc ,a ,list) `(assq ,a ,list)))
|
||||
(t form))))
|
||||
|
||||
;;;###autoload
|
||||
(defun cl--compiler-macro-adjoin (form a list &rest keys)
|
||||
(if (and (cl--simple-expr-p a) (cl--simple-expr-p list)
|
||||
(not (memq :key keys)))
|
||||
`(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list))
|
||||
form))
|
||||
|
||||
;;;###autoload
|
||||
(defun cl--compiler-macro-list* (_form arg &rest others)
|
||||
(let* ((args (reverse (cons arg others)))
|
||||
(form (car args)))
|
||||
|
|
@ -3035,27 +3037,34 @@ surrounded by (cl-block NAME ...).
|
|||
(cl--make-type-test temp (cl--const-expr-val type)))
|
||||
form))
|
||||
|
||||
;;;###autoload
|
||||
(defun cl--compiler-macro-cXXr (form x)
|
||||
(let* ((head (car form))
|
||||
(n (symbol-name (car form)))
|
||||
(i (- (length n) 2)))
|
||||
(if (not (string-match "c[ad]+r\\'" n))
|
||||
(if (and (fboundp head) (symbolp (symbol-function head)))
|
||||
(cl--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
|
||||
x)
|
||||
(error "Compiler macro for cXXr applied to non-cXXr form"))
|
||||
(while (> i (match-beginning 0))
|
||||
(setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
|
||||
(setq i (1- i)))
|
||||
x)))
|
||||
|
||||
(mapc (lambda (y)
|
||||
(put (car y) 'side-effect-free t)
|
||||
(put (car y) 'compiler-macro
|
||||
`(lambda (_w x)
|
||||
,(if (symbolp (cadr y))
|
||||
`(list ',(cadr y)
|
||||
(list ',(cl-caddr y) x))
|
||||
(cons 'list (cdr y))))))
|
||||
'((cl-first 'car x) (cl-second 'cadr x) (cl-third 'cl-caddr x) (cl-fourth 'cl-cadddr x)
|
||||
(cl-fifth 'nth 4 x) (cl-sixth 'nth 5 x) (cl-seventh 'nth 6 x)
|
||||
(cl-eighth 'nth 7 x) (cl-ninth 'nth 8 x) (cl-tenth 'nth 9 x)
|
||||
(cl-rest 'cdr x) (cl-endp 'null x) (cl-plusp '> x 0) (cl-minusp '< x 0)
|
||||
(cl-caaar car caar) (cl-caadr car cadr) (cl-cadar car cdar)
|
||||
(cl-caddr car cddr) (cl-cdaar cdr caar) (cl-cdadr cdr cadr)
|
||||
(cl-cddar cdr cdar) (cl-cdddr cdr cddr) (cl-caaaar car cl-caaar)
|
||||
(cl-caaadr car cl-caadr) (cl-caadar car cl-cadar) (cl-caaddr car cl-caddr)
|
||||
(cl-cadaar car cl-cdaar) (cl-cadadr car cl-cdadr) (cl-caddar car cl-cddar)
|
||||
(cl-cadddr car cl-cdddr) (cl-cdaaar cdr cl-caaar) (cl-cdaadr cdr cl-caadr)
|
||||
(cl-cdadar cdr cl-cadar) (cl-cdaddr cdr cl-caddr) (cl-cddaar cdr cl-cdaar)
|
||||
(cl-cddadr cdr cl-cdadr) (cl-cdddar cdr cl-cddar) (cl-cddddr cdr cl-cdddr) ))
|
||||
(dolist (y '(cl-first cl-second cl-third cl-fourth
|
||||
cl-fifth cl-sixth cl-seventh
|
||||
cl-eighth cl-ninth cl-tenth
|
||||
cl-rest cl-endp cl-plusp cl-minusp
|
||||
cl-caaar cl-caadr cl-cadar
|
||||
cl-caddr cl-cdaar cl-cdadr
|
||||
cl-cddar cl-cdddr cl-caaaar
|
||||
cl-caaadr cl-caadar cl-caaddr
|
||||
cl-cadaar cl-cadadr cl-caddar
|
||||
cl-cadddr cl-cdaaar cl-cdaadr
|
||||
cl-cdadar cl-cdaddr cl-cddaar
|
||||
cl-cddadr cl-cdddar cl-cddddr))
|
||||
(put y 'side-effect-free t))
|
||||
|
||||
;;; Things that are inline.
|
||||
(cl-proclaim '(inline cl-floatp-safe cl-acons cl-map cl-concatenate cl-notany cl-notevery
|
||||
|
|
|
|||
|
|
@ -380,6 +380,27 @@ suitable file is found, return nil."
|
|||
|
||||
(declare-function ad-get-advice-info "advice" (function))
|
||||
|
||||
(defun help-fns--compiler-macro (function)
|
||||
(let ((handler nil))
|
||||
;; FIXME: Copied from macroexp.el.
|
||||
(while (and (symbolp function)
|
||||
(not (setq handler (get function 'compiler-macro)))
|
||||
(fboundp function))
|
||||
;; Follow the sequence of aliases.
|
||||
(setq function (symbol-function function)))
|
||||
(when handler
|
||||
(princ "This function has a compiler macro")
|
||||
(let ((lib (get function 'compiler-macro-file)))
|
||||
;; FIXME: rather than look at the compiler-macro-file property,
|
||||
;; just look at `handler' itself.
|
||||
(when (stringp lib)
|
||||
(princ (format " in `%s'" lib))
|
||||
(with-current-buffer standard-output
|
||||
(save-excursion
|
||||
(re-search-backward "`\\([^`']+\\)'" nil t)
|
||||
(help-xref-button 1 'help-function-cmacro function lib)))))
|
||||
(princ ".\n\n"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun describe-function-1 (function)
|
||||
(let* ((advised (and (symbolp function) (featurep 'advice)
|
||||
|
|
@ -509,20 +530,7 @@ suitable file is found, return nil."
|
|||
(fill-region-as-paragraph pt2 (point))
|
||||
(unless (looking-back "\n\n")
|
||||
(terpri)))))
|
||||
;; Note that list* etc do not get this property until
|
||||
;; cl--hack-byte-compiler runs, after bytecomp is loaded.
|
||||
(when (and (symbolp function)
|
||||
(eq (get function 'byte-compile)
|
||||
'cl-byte-compile-compiler-macro))
|
||||
(princ "This function has a compiler macro")
|
||||
(let ((lib (get function 'compiler-macro-file)))
|
||||
(when (stringp lib)
|
||||
(princ (format " in `%s'" lib))
|
||||
(with-current-buffer standard-output
|
||||
(save-excursion
|
||||
(re-search-backward "`\\([^`']+\\)'" nil t)
|
||||
(help-xref-button 1 'help-function-cmacro function lib)))))
|
||||
(princ ".\n\n"))
|
||||
(help-fns--compiler-macro function)
|
||||
(let* ((advertised (gethash def advertised-signature-table t))
|
||||
(arglist (if (listp advertised)
|
||||
advertised (help-function-arglist def)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue