Commit d9857e53 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

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².
parent 7cb70fd7
2012-06-09 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <nicholas.dokos@hp.com> (tiny change)
 
* calendar/icalendar.el (icalendar--parse-vtimezone): Import TZID
......
......@@ -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.
......
;;; 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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment