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².

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  <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
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)