[Emacs-diffs] /srv/bzr/emacs/trunk r108533: Don't autoload functions too eagerly during macroexpansion.

[Stefan Monnier]

------------------------------------------------------------
revno: 108533
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Fri 2012-06-08 22:26:47 -0400
message:
  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².
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/byte-run.el
  lisp/emacs-lisp/cl-extra.el
  lisp/emacs-lisp/cl-lib.el
  lisp/emacs-lisp/cl-loaddefs.el
  lisp/emacs-lisp/cl-macs.el
  lisp/emacs-lisp/cl-seq.el
  lisp/emacs-lisp/macroexp.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-06-08 18:35:28 +0000
+++ b/lisp/ChangeLog    2012-06-09 02:26:47 +0000
@@ -1,3 +1,21 @@
+2012-06-09  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>  (tiny change)
 
        * calendar/icalendar.el (icalendar--parse-vtimezone): Import TZID

=== modified file 'lisp/emacs-lisp/byte-run.el'
--- a/lisp/emacs-lisp/byte-run.el       2012-05-31 01:41:17 +0000
+++ b/lisp/emacs-lisp/byte-run.el       2012-06-09 02:26:47 +0000
@@ -70,30 +70,37 @@
 ;; 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 @@
                (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 @@
             #'(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.

=== modified file 'lisp/emacs-lisp/cl-extra.el'
--- a/lisp/emacs-lisp/cl-extra.el       2012-06-07 19:48:22 +0000
+++ b/lisp/emacs-lisp/cl-extra.el       2012-06-09 02:26:47 +0000
@@ -584,15 +584,17 @@
 ;;; 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)

=== modified file 'lisp/emacs-lisp/cl-lib.el'
--- a/lisp/emacs-lisp/cl-lib.el 2012-06-07 19:48:22 +0000
+++ b/lisp/emacs-lisp/cl-lib.el 2012-06-09 02:26:47 +0000
@@ -544,11 +544,12 @@
 ;;    (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 @@
                  (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 @@
 (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).

=== modified file 'lisp/emacs-lisp/cl-loaddefs.el'
--- a/lisp/emacs-lisp/cl-loaddefs.el    2012-06-08 13:18:26 +0000
+++ b/lisp/emacs-lisp/cl-loaddefs.el    2012-06-09 02:26:47 +0000
@@ -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 @@
 
 \(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 @@
 ;;;;;;  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 @@
 ;;;;;;  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 @@
 
 \(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 @@
 
 \(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.
 

=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el        2012-06-08 13:18:26 +0000
+++ b/lisp/emacs-lisp/cl-macs.el        2012-06-09 02:26:47 +0000
@@ -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 @@
 ;; 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 @@
          ((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 @@
               `(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))
 
 

=== modified file 'lisp/emacs-lisp/cl-seq.el'
--- a/lisp/emacs-lisp/cl-seq.el 2012-06-04 01:05:17 +0000
+++ b/lisp/emacs-lisp/cl-seq.el 2012-06-09 02:26:47 +0000
@@ -676,6 +676,7 @@
 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 @@
     (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 @@
   "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 @@
     (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)

=== modified file 'lisp/emacs-lisp/macroexp.el'
--- a/lisp/emacs-lisp/macroexp.el       2012-06-08 13:18:26 +0000
+++ b/lisp/emacs-lisp/macroexp.el       2012-06-09 02:26:47 +0000
@@ -182,12 +182,7 @@
        (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 @@
              ;; 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)