From d9857e534be786674818645a1c51410b4ca68cf8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Jun 2012 22:26:47 -0400 Subject: [PATCH] =?utf8?q?Don't=20autoload=20functions=20too=20eagerly=20d?= =?utf8?q?uring=20macroexpansion.=20*=20lisp/emacs-lisp/macroexp.el=20(mac?= =?utf8?q?roexp--expand-all):=20Only=20autoload=20a=20function=20if=20ther?= =?utf8?q?e's=20a=20clear=20indication=20that=20it=20has=20a=20compiler-ma?= =?utf8?q?cro.=20*=20lisp/emacs-lisp/byte-run.el=20(defun-declarations-ali?= =?utf8?q?st,=20defmacro,=20defun)=20(macro-declarations-alist):=20Add=20a?= =?utf8?q?rglist=20to=20declaration=20functions.=20(defun-declarations-ali?= =?utf8?q?st):=20Add=20`obsolete'=20and=20`compiler-macro'.=20*=20lisp/ema?= =?utf8?q?cs-lisp/cl-seq.el=20(cl-member,=20cl-assoc):=20*=20lisp/emacs-li?= =?utf8?q?sp/cl-lib.el=20(cl-list*,=20cl-adjoin):=20*=20lisp/emacs-lisp/cl?= =?utf8?q?-extra.el=20(cl-get):=20Use=20the=20new=20`declare'=20statement.?= =?utf8?q?=20Also=20add=20autoload=20to=20find=20the=20compiler=20macro.?= =?utf8?q?=20*=20lisp/emacs-lisp/cl-macs.el=20(eql)=20[compiler-macro]:=20?= =?utf8?q?Remove.=20(cl--compiler-macro-member,=20cl--compiler-macro-assoc?= =?utf8?q?)=20(cl--compiler-macro-adjoin,=20cl--compiler-macro-list*)=20(c?= =?utf8?q?l--compiler-macro-get):=20New=20functions,=20replacing=20calls?= =?utf8?q?=20to=20cl-define-compiler-macro.=20(cl-typep)=20[compiler-macro?= =?utf8?q?]:=20Use=20macroexp-let=C2=B2.?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- lisp/ChangeLog | 18 ++++++++++++++++++ lisp/emacs-lisp/byte-run.el | 27 +++++++++++++++++---------- lisp/emacs-lisp/cl-extra.el | 4 +++- lisp/emacs-lisp/cl-lib.el | 8 ++++++-- lisp/emacs-lisp/cl-loaddefs.el | 12 +++++++++--- lisp/emacs-lisp/cl-macs.el | 42 ++++++++---------------------------------- lisp/emacs-lisp/cl-seq.el | 4 ++++ lisp/emacs-lisp/macroexp.el | 15 +++++++++------ 8 files changed, 74 insertions(+), 56 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bcedfd88917..72a9cb352a5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,21 @@ +2012-06-09 Stefan Monnier + + * emacs-lisp/macroexp.el (macroexp--expand-all): Only autoload + a function if there's a clear indication that it has a compiler-macro. + * 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'. + * emacs-lisp/cl-seq.el (cl-member, cl-assoc): + * emacs-lisp/cl-lib.el (cl-list*, cl-adjoin): + * emacs-lisp/cl-extra.el (cl-get): Use the new `declare' statement. + Also add autoload to find the compiler macro. + * 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². + 2012-06-08 Nick Dokos (tiny change) * calendar/icalendar.el (icalendar--parse-vtimezone): Import TZID diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index df8f588ce01..635eef93d96 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -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. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 6c774e7e8cd..5c5802f0e02 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -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) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 5cfb99bd829..6ec1060e39f 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -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). diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 337a82e2e47..87ae4223737 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -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. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 22ef55e3a52..60f1189718b 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -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)) diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index 1db2f19349b..cb167ad2881 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -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) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 5ca028c4ba4..8effb3c8e31 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -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) -- 2.11.4.GIT