mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-07 15:00:34 -08:00
Don't autoload functions too eagerly during macroexpansion.
* lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Only autoload a function if there's a clear indication that it has a compiler-macro. * lisp/emacs-lisp/byte-run.el (defun-declarations-alist, defmacro, defun) (macro-declarations-alist): Add arglist to declaration functions. (defun-declarations-alist): Add `obsolete' and `compiler-macro'. * lisp/emacs-lisp/cl-seq.el (cl-member, cl-assoc): * lisp/emacs-lisp/cl-lib.el (cl-list*, cl-adjoin): * lisp/emacs-lisp/cl-extra.el (cl-get): Use the new `declare' statement. Also add autoload to find the compiler macro. * lisp/emacs-lisp/cl-macs.el (eql) [compiler-macro]: Remove. (cl--compiler-macro-member, cl--compiler-macro-assoc) (cl--compiler-macro-adjoin, cl--compiler-macro-list*) (cl--compiler-macro-get): New functions, replacing calls to cl-define-compiler-macro. (cl-typep) [compiler-macro]: Use macroexp-let².
This commit is contained in:
Stefan Monnier
parent
7cb70fd73e
commit
d9857e534b
8 changed files with 74 additions and 56 deletions
|
|
@ -70,30 +70,37 @@ The return value of this function is not used."
|
|||
;; loaded by loadup.el that uses declarations in macros.
|
||||
|
||||
(defvar defun-declarations-alist
|
||||
;; FIXME: Should we also add an `obsolete' property?
|
||||
(list
|
||||
;; Too bad we can't use backquote yet at this stage of the bootstrap.
|
||||
;; We can only use backquotes inside the lambdas and not for those
|
||||
;; properties that are used by functions loaded before backquote.el.
|
||||
(list 'advertised-calling-convention
|
||||
#'(lambda (f arglist when)
|
||||
#'(lambda (f _args arglist when)
|
||||
(list 'set-advertised-calling-convention
|
||||
(list 'quote f) (list 'quote arglist) (list 'quote when))))
|
||||
(list 'obsolete
|
||||
#'(lambda (f _args new-name when)
|
||||
`(make-obsolete ',f ',new-name ,when)))
|
||||
(list 'compiler-macro
|
||||
#'(lambda (f _args compiler-function)
|
||||
`(put ',f 'compiler-macro #',compiler-function)))
|
||||
(list 'doc-string
|
||||
#'(lambda (f pos)
|
||||
#'(lambda (f _args pos)
|
||||
(list 'put (list 'quote f) ''doc-string-elt (list 'quote pos))))
|
||||
(list 'indent
|
||||
#'(lambda (f val)
|
||||
#'(lambda (f _args val)
|
||||
(list 'put (list 'quote f)
|
||||
''lisp-indent-function (list 'quote val)))))
|
||||
"List associating function properties to their macro expansion.
|
||||
Each element of the list takes the form (PROP FUN) where FUN is
|
||||
a function. For each (PROP . VALUES) in a function's declaration,
|
||||
the FUN corresponding to PROP is called with the function name
|
||||
and the VALUES and should return the code to use to set this property.")
|
||||
the FUN corresponding to PROP is called with the function name,
|
||||
the function's arglist, and the VALUES and should return the code to use
|
||||
to set this property.")
|
||||
|
||||
(defvar macro-declarations-alist
|
||||
(cons
|
||||
(list 'debug
|
||||
#'(lambda (name spec)
|
||||
#'(lambda (name _args spec)
|
||||
(list 'progn :autoload-end
|
||||
(list 'put (list 'quote name)
|
||||
''edebug-form-spec (list 'quote spec)))))
|
||||
|
|
@ -135,7 +142,7 @@ interpreted according to `macro-declarations-alist'."
|
|||
(mapcar
|
||||
#'(lambda (x)
|
||||
(let ((f (cdr (assq (car x) macro-declarations-alist))))
|
||||
(if f (apply (car f) name (cdr x))
|
||||
(if f (apply (car f) name arglist (cdr x))
|
||||
(message "Warning: Unknown macro property %S in %S"
|
||||
(car x) name))))
|
||||
(cdr decl))))
|
||||
|
|
@ -171,7 +178,7 @@ interpreted according to `defun-declarations-alist'.
|
|||
#'(lambda (x)
|
||||
(let ((f (cdr (assq (car x) defun-declarations-alist))))
|
||||
(cond
|
||||
(f (apply (car f) name (cdr x)))
|
||||
(f (apply (car f) name arglist (cdr x)))
|
||||
;; Yuck!!
|
||||
((and (featurep 'cl)
|
||||
(memq (car x) ;C.f. cl-do-proclaim.
|
||||
|
|
|
|||
|
|
@ -584,15 +584,17 @@ If START or END is negative, it counts from the end."
|
|||
;;; Property lists.
|
||||
|
||||
;;;###autoload
|
||||
(defun cl-get (sym tag &optional def) ; See compiler macro in cl-macs.el
|
||||
(defun cl-get (sym tag &optional def)
|
||||
"Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
|
||||
\n(fn SYMBOL PROPNAME &optional DEFAULT)"
|
||||
(declare (compiler-macro cl--compiler-macro-get))
|
||||
(or (get sym tag)
|
||||
(and def
|
||||
(let ((plist (symbol-plist sym)))
|
||||
(while (and plist (not (eq (car plist) tag)))
|
||||
(setq plist (cdr (cdr plist))))
|
||||
(if plist (car (cdr plist)) def)))))
|
||||
(autoload 'cl--compiler-macro-get "cl-macs")
|
||||
|
||||
;;;###autoload
|
||||
(defun cl-getf (plist tag &optional def)
|
||||
|
|
|
|||
|
|
@ -544,11 +544,12 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp
|
|||
;; (while (consp (cdr x)) (pop x))
|
||||
;; x))
|
||||
|
||||
(defun cl-list* (arg &rest rest) ; See compiler macro in cl-macs.el
|
||||
(defun cl-list* (arg &rest rest)
|
||||
"Return a new list with specified ARGs as elements, consed to last ARG.
|
||||
Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
|
||||
`(cons A (cons B (cons C D)))'.
|
||||
\n(fn ARG...)"
|
||||
(declare (compiler-macro cl--compiler-macro-list*))
|
||||
(cond ((not rest) arg)
|
||||
((not (cdr rest)) (cons arg (car rest)))
|
||||
(t (let* ((n (length rest))
|
||||
|
|
@ -556,6 +557,7 @@ 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."
|
||||
|
|
@ -584,17 +586,19 @@ The elements of LIST are not copied, just the list structure itself."
|
|||
(declare-function cl-round "cl-extra" (x &optional y))
|
||||
(declare-function cl-mod "cl-extra" (x y))
|
||||
|
||||
(defun cl-adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs
|
||||
(defun cl-adjoin (cl-item cl-list &rest cl-keys)
|
||||
"Return ITEM consed onto the front of LIST only if it's not already there.
|
||||
Otherwise, return LIST unmodified.
|
||||
\nKeywords supported: :test :test-not :key
|
||||
\n(fn ITEM LIST [KEYWORD VALUE]...)"
|
||||
(declare (compiler-macro cl--compiler-macro-adjoin))
|
||||
(cond ((or (equal cl-keys '(:test eq))
|
||||
(and (null cl-keys) (not (numberp cl-item))))
|
||||
(if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
|
||||
((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).
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@
|
|||
;;;;;; cl-set-frame-visible-p cl-map-overlays cl-map-intervals cl-map-keymap-recursively
|
||||
;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan
|
||||
;;;;;; cl-mapl cl-maplist cl-map cl-mapcar-many cl-equalp cl-coerce)
|
||||
;;;;;; "cl-extra" "cl-extra.el" "fecce2e361fd06364d2ffd8c0d482cd0")
|
||||
;;;;;; "cl-extra" "cl-extra.el" "6661c504c379dfde0c37a0f8e2ba6568")
|
||||
;;; Generated autoloads from cl-extra.el
|
||||
|
||||
(autoload 'cl-coerce "cl-extra" "\
|
||||
|
|
@ -224,6 +224,8 @@ Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
|
|||
|
||||
\(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil)
|
||||
|
||||
(put 'cl-get 'compiler-macro #'cl--compiler-macro-get)
|
||||
|
||||
(autoload 'cl-getf "cl-extra" "\
|
||||
Search PROPLIST for property PROPNAME; return its value or DEFAULT.
|
||||
PROPLIST is a list of the sort returned by `symbol-plist'.
|
||||
|
|
@ -263,7 +265,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
|
|||
;;;;;; 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" "07b3d08f956d6740ea1979825c84bc01")
|
||||
;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "9eb287dd2a8d20f1c6459a9d095fa335")
|
||||
;;; Generated autoloads from cl-macs.el
|
||||
|
||||
(autoload 'cl-gensym "cl-macs" "\
|
||||
|
|
@ -789,7 +791,7 @@ surrounded by (cl-block NAME ...).
|
|||
;;;;;; cl-nsubstitute-if cl-nsubstitute cl-substitute-if-not cl-substitute-if
|
||||
;;;;;; cl-substitute cl-delete-duplicates cl-remove-duplicates cl-delete-if-not
|
||||
;;;;;; cl-delete-if cl-delete cl-remove-if-not cl-remove-if cl-remove
|
||||
;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "d3eaca7a24bdb10b381bb94729c5d7e9")
|
||||
;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "8877479cb008b43a94098f3e6ec85d91")
|
||||
;;; Generated autoloads from cl-seq.el
|
||||
|
||||
(autoload 'cl-reduce "cl-seq" "\
|
||||
|
|
@ -1050,6 +1052,8 @@ Keywords supported: :test :test-not :key
|
|||
|
||||
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
|
||||
|
||||
(put 'cl-member 'compiler-macro #'cl--compiler-macro-member)
|
||||
|
||||
(autoload 'cl-member-if "cl-seq" "\
|
||||
Find the first item satisfying PREDICATE in LIST.
|
||||
Return the sublist of LIST whose car matches.
|
||||
|
|
@ -1078,6 +1082,8 @@ Keywords supported: :test :test-not :key
|
|||
|
||||
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
|
||||
|
||||
(put 'cl-assoc 'compiler-macro #'cl--compiler-macro-assoc)
|
||||
|
||||
(autoload 'cl-assoc-if "cl-seq" "\
|
||||
Find the first item whose car satisfies PREDICATE in LIST.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; cl-macs.el --- Common Lisp macros --*- lexical-binding: t -*-
|
||||
;;; cl-macs.el --- Common Lisp macros -*- lexical-binding: t; coding: utf-8 -*-
|
||||
|
||||
;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -2993,30 +2993,7 @@ surrounded by (cl-block NAME ...).
|
|||
;; Note that cl.el arranges to force cl-macs to be loaded at compile-time,
|
||||
;; mainly to make sure these macros will be present.
|
||||
|
||||
(put 'eql 'byte-compile nil)
|
||||
(cl-define-compiler-macro eql (&whole form a b)
|
||||
(cond ((macroexp-const-p a)
|
||||
(let ((val (cl--const-expr-val a)))
|
||||
(if (and (numberp val) (not (integerp val)))
|
||||
`(equal ,a ,b)
|
||||
`(eq ,a ,b))))
|
||||
((macroexp-const-p b)
|
||||
(let ((val (cl--const-expr-val b)))
|
||||
(if (and (numberp val) (not (integerp val)))
|
||||
`(equal ,a ,b)
|
||||
`(eq ,a ,b))))
|
||||
((cl--simple-expr-p a 5)
|
||||
`(if (numberp ,a)
|
||||
(equal ,a ,b)
|
||||
(eq ,a ,b)))
|
||||
((and (cl--safe-expr-p a)
|
||||
(cl--simple-expr-p b 5))
|
||||
`(if (numberp ,b)
|
||||
(equal ,a ,b)
|
||||
(eq ,a ,b)))
|
||||
(t form)))
|
||||
|
||||
(cl-define-compiler-macro cl-member (&whole form a list &rest keys)
|
||||
(defun cl--compiler-macro-member (form a list &rest keys)
|
||||
(let ((test (and (= (length keys) 2) (eq (car keys) :test)
|
||||
(cl--const-expr-val (nth 1 keys)))))
|
||||
(cond ((eq test 'eq) `(memq ,a ,list))
|
||||
|
|
@ -3024,7 +3001,7 @@ surrounded by (cl-block NAME ...).
|
|||
((or (null keys) (eq test 'eql)) `(memql ,a ,list))
|
||||
(t form))))
|
||||
|
||||
(cl-define-compiler-macro cl-assoc (&whole form a list &rest keys)
|
||||
(defun cl--compiler-macro-assoc (form a list &rest keys)
|
||||
(let ((test (and (= (length keys) 2) (eq (car keys) :test)
|
||||
(cl--const-expr-val (nth 1 keys)))))
|
||||
(cond ((eq test 'eq) `(assq ,a ,list))
|
||||
|
|
@ -3034,31 +3011,28 @@ surrounded by (cl-block NAME ...).
|
|||
`(assoc ,a ,list) `(assq ,a ,list)))
|
||||
(t form))))
|
||||
|
||||
(cl-define-compiler-macro cl-adjoin (&whole form a list &rest keys)
|
||||
(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))
|
||||
|
||||
(cl-define-compiler-macro cl-list* (arg &rest others)
|
||||
(defun cl--compiler-macro-list* (_form arg &rest others)
|
||||
(let* ((args (reverse (cons arg others)))
|
||||
(form (car args)))
|
||||
(while (setq args (cdr args))
|
||||
(setq form `(cons ,(car args) ,form)))
|
||||
form))
|
||||
|
||||
(cl-define-compiler-macro cl-get (sym prop &optional def)
|
||||
(defun cl--compiler-macro-get (_form sym prop &optional def)
|
||||
(if def
|
||||
`(cl-getf (symbol-plist ,sym) ,prop ,def)
|
||||
`(get ,sym ,prop)))
|
||||
|
||||
(cl-define-compiler-macro cl-typep (&whole form val type)
|
||||
(if (macroexp-const-p type)
|
||||
(let ((res (cl--make-type-test val (cl--const-expr-val type))))
|
||||
(if (or (memq (cl--expr-contains res val) '(nil 1))
|
||||
(cl--simple-expr-p val)) res
|
||||
(let ((temp (make-symbol "--cl-var--")))
|
||||
`(let ((,temp ,val)) ,(cl-subst temp val res)))))
|
||||
(macroexp-let² macroexp-copyable-p temp val
|
||||
(cl--make-type-test temp (cl--const-expr-val type)))
|
||||
form))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -676,6 +676,7 @@ sequences, and PREDICATE is a `less-than' predicate on the elements.
|
|||
Return the sublist of LIST whose car is ITEM.
|
||||
\nKeywords supported: :test :test-not :key
|
||||
\n(fn ITEM LIST [KEYWORD VALUE]...)"
|
||||
(declare (compiler-macro cl--compiler-macro-member))
|
||||
(if cl-keys
|
||||
(cl-parsing-keywords (:test :test-not :key :if :if-not) ()
|
||||
(while (and cl-list (not (cl-check-test cl-item (car cl-list))))
|
||||
|
|
@ -684,6 +685,7 @@ Return the sublist of LIST whose car is ITEM.
|
|||
(if (and (numberp cl-item) (not (integerp cl-item)))
|
||||
(member cl-item cl-list)
|
||||
(memq cl-item cl-list))))
|
||||
(autoload 'cl--compiler-macro-member "cl-macs")
|
||||
|
||||
;;;###autoload
|
||||
(defun cl-member-if (cl-pred cl-list &rest cl-keys)
|
||||
|
|
@ -714,6 +716,7 @@ Return the sublist of LIST whose car matches.
|
|||
"Find the first item whose car matches ITEM in LIST.
|
||||
\nKeywords supported: :test :test-not :key
|
||||
\n(fn ITEM LIST [KEYWORD VALUE]...)"
|
||||
(declare (compiler-macro cl--compiler-macro-assoc))
|
||||
(if cl-keys
|
||||
(cl-parsing-keywords (:test :test-not :key :if :if-not) ()
|
||||
(while (and cl-alist
|
||||
|
|
@ -724,6 +727,7 @@ Return the sublist of LIST whose car matches.
|
|||
(if (and (numberp cl-item) (not (integerp cl-item)))
|
||||
(assoc cl-item cl-alist)
|
||||
(assq cl-item cl-alist))))
|
||||
(autoload 'cl--compiler-macro-assoc "cl-macs")
|
||||
|
||||
;;;###autoload
|
||||
(defun cl-assoc-if (cl-pred cl-list &rest cl-keys)
|
||||
|
|
|
|||
|
|
@ -182,12 +182,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
|
|||
(let ((handler nil))
|
||||
(while (and (symbolp func)
|
||||
(not (setq handler (get func 'compiler-macro)))
|
||||
(fboundp func)
|
||||
(or (not (eq (car-safe (symbol-function func))
|
||||
'autoload))
|
||||
(ignore-errors
|
||||
(load (nth 1 (symbol-function func))
|
||||
'noerror 'nomsg))))
|
||||
(fboundp func))
|
||||
;; Follow the sequence of aliases.
|
||||
(setq func (symbol-function func)))
|
||||
(if (null handler)
|
||||
|
|
@ -195,6 +190,14 @@ Assumes the caller has bound `macroexpand-all-environment'."
|
|||
;; setq/setq-default this works alright because the variable names
|
||||
;; are symbols).
|
||||
(macroexp--all-forms form 1)
|
||||
;; If the handler is not loaded yet, try (auto)loading the
|
||||
;; function itself, which may in turn load the handler.
|
||||
(when (and (not (functionp handler))
|
||||
(fboundp func) (eq (car-safe (symbol-function func))
|
||||
'autoload))
|
||||
(ignore-errors
|
||||
(load (nth 1 (symbol-function func))
|
||||
'noerror 'nomsg)))
|
||||
(let ((newform (condition-case err
|
||||
(apply handler form (cdr form))
|
||||
(error (message "Compiler-macro error: %S" err)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue