emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 0b9b363dab: Byte compiler: Prevent special forms' symbols being r


From: Alan Mackenzie
Subject: master 0b9b363dab: Byte compiler: Prevent special forms' symbols being replaced by bare symbols
Date: Fri, 22 Apr 2022 15:12:45 -0400 (EDT)

branch: master
commit 0b9b363dabd70032a288e14333896022caa2d252
Author: Alan Mackenzie <acm@muc.de>
Commit: Alan Mackenzie <acm@muc.de>

    Byte compiler: Prevent special forms' symbols being replaced by bare symbols
    
    These are symbols with position from source code, which should not be 
replaced
    by bare symbols in, e.g., optimization functions.
    
    * lisp/Makefile.in: (BYTE_COMPILE_FLAGS, compile-first case): Set
    max-specpdl-size to 5000 for the benefit of lisp/emacs-lisp/comp.el.
    
    * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker)
    (byte-optimize--rename-var, byte-optimize-if, byte-optimize-letX)
    * lisp/emacs-lisp/bytecomp.el (byte-compile-recurse-toplevel)
    (byte-compile-lambda)
    * lisp/emacs-lisp/cconv.el (cconv-convert)
    * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Preserve, e.g., (car
    form) in the byte compiler, when this form's car is a symbol with position 
of
    a special form, rather than replacing the symbol with a bare symbol, e.g.
    'cond.
---
 lisp/Makefile.in            |   4 +-
 lisp/emacs-lisp/byte-opt.el | 115 ++++++++++++-------------
 lisp/emacs-lisp/bytecomp.el |   4 +-
 lisp/emacs-lisp/cconv.el    |  22 ++---
 lisp/emacs-lisp/macroexp.el | 203 ++++++++++++++++++++++----------------------
 5 files changed, 176 insertions(+), 172 deletions(-)

diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 308407a8bf..fabf6ed55e 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -78,7 +78,9 @@ AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el 
${srcdir}/finder-inf.el \
 BYTE_COMPILE_FLAGS = \
   --eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS)
 # ... but we must prefer .elc files for those in the early bootstrap.
-compile-first: BYTE_COMPILE_FLAGS = $(BYTE_COMPILE_EXTRA_FLAGS)
+# A larger `max-specpdl-size' is needed for emacs-lisp/comp.el.
+compile-first: BYTE_COMPILE_FLAGS = \
+  --eval '(setq max-specpdl-size 5000)' $(BYTE_COMPILE_EXTRA_FLAGS)
 
 # Files to compile before others during a bootstrap.  This is done to
 # speed up the bootstrap process.  They're ordered by size, so we use
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 39bb622459..d3d8405d06 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -338,7 +338,7 @@ for speeding up processing.")
              (let ((exps-opt (byte-optimize-body exps t)))
                (if (macroexp-const-p exp-opt)
                    `(progn ,@exps-opt ,exp-opt)
-                `(prog1 ,exp-opt ,@exps-opt)))
+                `(,fn ,exp-opt ,@exps-opt)))
           exp-opt)))
 
       (`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps)
@@ -358,7 +358,7 @@ for speeding up processing.")
               (then-opt (and test-opt (byte-optimize-form then for-effect)))
               (else-opt (and (not (and test-opt const))
                              (byte-optimize-body else for-effect))))
-         `(if ,test-opt ,then-opt . ,else-opt)))
+         `(,fn ,test-opt ,then-opt . ,else-opt)))
 
       (`(,(or 'and 'or) . ,exps)
        ;; FIXME: We have to traverse the expressions in left-to-right
@@ -397,7 +397,7 @@ for speeding up processing.")
               ;; as mutated variables have been marked as non-substitutable.
               (condition (byte-optimize-form (car condition-body) nil))
               (body (byte-optimize-body (cdr condition-body) t)))
-         `(while ,condition . ,body)))
+         `(,fn ,condition . ,body)))
 
       (`(interactive . ,_)
        (byte-compile-warn-x form "misplaced interactive spec: `%s'" form)
@@ -409,7 +409,7 @@ for speeding up processing.")
        form)
 
       (`(condition-case ,var ,exp . ,clauses)
-       `(condition-case ,var          ;Not evaluated.
+       `(,fn ,var          ;Not evaluated.
             ,(byte-optimize-form exp for-effect)
           ,@(mapcar (lambda (clause)
                       (let ((byte-optimize--lexvars
@@ -432,14 +432,14 @@ for speeding up processing.")
        (let ((bodyform (byte-optimize-form exp for-effect)))
          (pcase exps
            (`(:fun-body ,f)
-            `(unwind-protect ,bodyform
+            `(,fn ,bodyform
                :fun-body ,(byte-optimize-form f nil)))
            (_
-            `(unwind-protect ,bodyform
+            `(,fn ,bodyform
                . ,(byte-optimize-body exps t))))))
 
       (`(catch ,tag . ,exps)
-       `(catch ,(byte-optimize-form tag nil)
+       `(,fn ,(byte-optimize-form tag nil)
           . ,(byte-optimize-body exps for-effect)))
 
       ;; Needed as long as we run byte-optimize-form after cconv.
@@ -495,7 +495,7 @@ for speeding up processing.")
                                   (cons (byte-optimize-form (car rest) nil)
                                         (cdr rest)))))
          (push name byte-optimize--dynamic-vars)
-         `(defvar ,name . ,optimized-rest)))
+         `(,fn ,name . ,optimized-rest)))
 
       (`(,(pred byte-code-function-p) . ,exps)
        (cons fn (mapcar #'byte-optimize-form exps)))
@@ -561,49 +561,50 @@ for speeding up processing.")
 
 (defun byte-optimize--rename-var (var new-var form)
   "Replace VAR with NEW-VAR in FORM."
-  (pcase form
-    ((pred symbolp) (if (eq form var) new-var form))
-    (`(setq . ,args)
-     (let ((new-args nil))
-       (while args
-         (push (byte-optimize--rename-var var new-var (car args)) new-args)
-         (push (byte-optimize--rename-var var new-var (cadr args)) new-args)
-         (setq args (cddr args)))
-       `(setq . ,(nreverse new-args))))
-    ;; In binding constructs like `let', `let*' and `condition-case' we
-    ;; rename everything for simplicity, even new bindings named VAR.
-    (`(,(and head (or 'let 'let*)) ,bindings . ,body)
-     `(,head
-       ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b))
-                bindings)
-       ,@(byte-optimize--rename-var-body var new-var body)))
-    (`(condition-case ,res-var ,protected-form . ,handlers)
-     `(condition-case ,(byte-optimize--rename-var var new-var res-var)
-          ,(byte-optimize--rename-var var new-var protected-form)
-        ,@(mapcar (lambda (h)
-                    (cons (car h)
-                          (byte-optimize--rename-var-body var new-var (cdr 
h))))
-                  handlers)))
-    (`(internal-make-closure ,vars ,env . ,rest)
-     `(internal-make-closure
-       ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest))
-    (`(defvar ,name . ,rest)
-     ;; NAME is not renamed here; we only care about lexical variables.
-     `(defvar ,name . ,(byte-optimize--rename-var-body var new-var rest)))
-
-    (`(cond . ,clauses)
-     `(cond ,@(mapcar (lambda (c)
-                        (byte-optimize--rename-var-body var new-var c))
-                      clauses)))
-
-    (`(function . ,_) form)
-    (`(quote . ,_) form)
-    (`(lambda . ,_) form)
-
-    ;; Function calls and special forms not handled above.
-    (`(,head . ,args)
-     `(,head . ,(byte-optimize--rename-var-body var new-var args)))
-    (_ form)))
+  (let ((fn (car-safe form)))
+    (pcase form
+      ((pred symbolp) (if (eq form var) new-var form))
+      (`(setq . ,args)
+       (let ((new-args nil))
+         (while args
+           (push (byte-optimize--rename-var var new-var (car args)) new-args)
+           (push (byte-optimize--rename-var var new-var (cadr args)) new-args)
+           (setq args (cddr args)))
+         `(,fn . ,(nreverse new-args))))
+      ;; In binding constructs like `let', `let*' and `condition-case' we
+      ;; rename everything for simplicity, even new bindings named VAR.
+      (`(,(and head (or 'let 'let*)) ,bindings . ,body)
+       `(,head
+         ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b))
+                  bindings)
+         ,@(byte-optimize--rename-var-body var new-var body)))
+      (`(condition-case ,res-var ,protected-form . ,handlers)
+       `(,fn ,(byte-optimize--rename-var var new-var res-var)
+             ,(byte-optimize--rename-var var new-var protected-form)
+             ,@(mapcar (lambda (h)
+                         (cons (car h)
+                               (byte-optimize--rename-var-body var new-var 
(cdr h))))
+                       handlers)))
+      (`(internal-make-closure ,vars ,env . ,rest)
+       `(,fn
+         ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest))
+      (`(defvar ,name . ,rest)
+       ;; NAME is not renamed here; we only care about lexical variables.
+       `(,fn ,name . ,(byte-optimize--rename-var-body var new-var rest)))
+
+      (`(cond . ,clauses)
+       `(,fn ,@(mapcar (lambda (c)
+                         (byte-optimize--rename-var-body var new-var c))
+                       clauses)))
+
+      (`(function . ,_) form)
+      (`(quote . ,_) form)
+      (`(lambda . ,_) form)
+
+      ;; Function calls and special forms not handled above.
+      (`(,head . ,args)
+       `(,head . ,(byte-optimize--rename-var-body var new-var args)))
+      (_ form))))
 
 (defun byte-optimize-let-form (head form for-effect)
   ;; Recursively enter the optimizer for the bindings and body
@@ -1174,21 +1175,21 @@ See Info node `(elisp) Integer Basics'."
                 (proper-list-p clause))
            (if (null (cddr clause))
                ;; A trivial `progn'.
-               (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form)))
+               (byte-optimize-if `(,(car form) ,(cadr clause) ,@(nthcdr 2 
form)))
              (nconc (butlast clause)
                     (list
                      (byte-optimize-if
-                      `(if ,(car (last clause)) ,@(nthcdr 2 form)))))))
+                      `(,(car form) ,(car (last clause)) ,@(nthcdr 2 
form)))))))
           ((byte-compile-trueconstp clause)
           `(progn ,clause ,(nth 2 form)))
          ((byte-compile-nilconstp clause)
            `(progn ,clause ,@(nthcdr 3 form)))
          ((nth 2 form)
           (if (equal '(nil) (nthcdr 3 form))
-              (list 'if clause (nth 2 form))
+              (list (car form) clause (nth 2 form))
             form))
          ((or (nth 3 form) (nthcdr 4 form))
-          (list 'if
+          (list (car form)
                 ;; Don't make a double negative;
                 ;; instead, take away the one that is there.
                 (if (and (consp clause) (memq (car clause) '(not null))
@@ -1267,7 +1268,7 @@ See Info node `(elisp) Integer Basics'."
                              (and (consp binding) (cadr binding)))
                            bindings)
                  ,const)
-       `(let* ,(butlast bindings)
+       `(,head ,(butlast bindings)
           ,@(and (consp (car (last bindings)))
                  (cdar (last bindings)))
           ,const)))
@@ -1282,7 +1283,7 @@ See Info node `(elisp) Integer Basics'."
          `(progn ,@(mapcar (lambda (binding)
                              (and (consp binding) (cadr binding)))
                            bindings))
-       `(let* ,(butlast bindings)
+       `(,head ,(butlast bindings)
           ,@(and (consp (car (last bindings)))
                  (cdar (last bindings))))))
 
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index f97324f3a8..28237d67d2 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -471,7 +471,7 @@ Return the compile-time value of FORM."
   (let ((print-symbols-bare t))         ; Possibly redundant binding.
     (setf form (macroexp-macroexpand form byte-compile-macro-environment)))
   (if (eq (car-safe form) 'progn)
-      (cons 'progn
+      (cons (car form)
             (mapcar (lambda (subform)
                       (byte-compile-recurse-toplevel
                        subform non-toplevel-case))
@@ -3084,7 +3084,7 @@ lambda-expression."
                        ;; which may include "calls" to
                        ;; internal-make-closure (Bug#29988).
                        lexical-binding)
-                   (setq int `(interactive ,newform)))))
+                   (setq int `(,(car int) ,newform)))))
             ((cdr int)                  ; Invalid (interactive . something).
             (byte-compile-warn-x int "malformed interactive spec: %s"
                                  int))))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index be4fea7be1..4535f1aa6e 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -500,11 +500,11 @@ places where they originally did not directly appear."
                  args)))
 
     (`(cond . ,cond-forms)              ; cond special form
-     `(cond . ,(mapcar (lambda (branch)
-                         (mapcar (lambda (form)
-                                   (cconv-convert form env extend))
-                                 branch))
-                       cond-forms)))
+     `(,(car form) . ,(mapcar (lambda (branch)
+                                (mapcar (lambda (form)
+                                          (cconv-convert form env extend))
+                                        branch))
+                              cond-forms)))
 
     (`(function (lambda ,args . ,body) . ,_)
      (let ((docstring (if (eq :documentation (car-safe (car body)))
@@ -538,7 +538,7 @@ places where they originally did not directly appear."
             (msg (when (eq class :unused)
                    (cconv--warn-unused-msg var "variable")))
             (newprotform (cconv-convert protected-form env extend)))
-       `(condition-case ,var
+       `(,(car form) ,var
             ,(if msg
                  (macroexp--warn-wrap var msg newprotform 'lexical)
                newprotform)
@@ -554,9 +554,9 @@ places where they originally did not directly appear."
                        `((let ((,var (list ,var))) ,@body))))))
              handlers))))
 
-    (`(unwind-protect ,form . ,body)
-     `(unwind-protect ,(cconv-convert form env extend)
-        :fun-body ,(cconv--convert-function () body env form)))
+    (`(unwind-protect ,form1 . ,body)
+     `(,(car form) ,(cconv-convert form1 env extend)
+        :fun-body ,(cconv--convert-function () body env form1)))
 
     (`(setq . ,forms)                   ; setq special form
      (if (= (logand (length forms) 1) 1)
@@ -568,7 +568,7 @@ places where they originally did not directly appear."
                   (sym-new (or (cdr (assq sym env)) sym))
                   (value (cconv-convert (pop forms) env extend)))
              (push (pcase sym-new
-                     ((pred symbolp) `(setq ,sym-new ,value))
+                     ((pred symbolp) `(,(car form) ,sym-new ,value))
                      (`(car-safe ,iexp) `(setcar ,iexp ,value))
                      ;; This "should never happen", but for variables which are
                      ;; mutated+captured+unused, we may end up trying to `setq'
@@ -604,7 +604,7 @@ places where they originally did not directly appear."
                                  (cons fun args)))))))
 
     (`(interactive . ,forms)
-     `(interactive . ,(mapcar (lambda (form)
+     `(,(car form) . ,(mapcar (lambda (form)
                                 (cconv-convert form nil nil))
                               forms)))
 
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index e4bc2df280..51c6e8e0ca 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -330,108 +330,109 @@ Assumes the caller has bound 
`macroexpand-all-environment'."
         (setq form (macroexp-macroexpand form macroexpand-all-environment))
         ;; FIXME: It'd be nice to use `byte-optimize--pcase' here, but when
         ;; I tried it, it broke the bootstrap :-(
-        (pcase form
-          (`(cond . ,clauses)
-           (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
-          (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare))
-           (macroexp--cons
-            'condition-case
-            (macroexp--cons err
-                            (macroexp--cons (macroexp--expand-all body)
-                                            (macroexp--all-clauses handlers 1)
-                                            (cddr form))
-                            (cdr form))
-            form))
-          (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_)
-           (push name macroexp--dynvars)
-           (macroexp--all-forms form 2))
-          (`(function ,(and f `(lambda . ,_)))
-           (let ((macroexp--dynvars macroexp--dynvars))
-             (macroexp--cons 'function
-                             (macroexp--cons (macroexp--all-forms f 2)
-                                             nil
-                                             (cdr form))
-                             form)))
-          (`(,(or 'function 'quote) . ,_) form)
-          (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
-                                               pcase--dontcare))
-           (let ((macroexp--dynvars macroexp--dynvars))
+        (let ((fn (car-safe form)))
+          (pcase form
+            (`(cond . ,clauses)
+             (macroexp--cons fn (macroexp--all-clauses clauses) form))
+            (`(condition-case . ,(or `(,err ,body . ,handlers) 
pcase--dontcare))
              (macroexp--cons
-              fun
-              (macroexp--cons
-               (macroexp--all-clauses bindings 1)
-               (if (null body)
-                   (macroexp-unprogn
-                    (macroexp-warn-and-return
-                     (format "Empty %s body" fun)
-                     nil nil 'compile-only fun))
-                 (macroexp--all-forms body))
-               (cdr form))
-              form)))
-          (`(,(and fun `(lambda . ,_)) . ,args)
-           ;; Embedded lambda in function position.
-           ;; If the byte-optimizer is loaded, try to unfold this,
-           ;; i.e. rewrite it to (let (<args>) <body>).  We'd do it in the 
optimizer
-           ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
-           ;; creation of a closure, thus resulting in much better code.
-           (let ((newform (macroexp--unfold-lambda form)))
-            (if (eq newform form)
-                ;; Unfolding failed for some reason, avoid infinite recursion.
-                (macroexp--cons (macroexp--all-forms fun 2)
-                                 (macroexp--all-forms args)
-                                 form)
-              (macroexp--expand-all newform))))
-          (`(funcall ,exp . ,args)
-           (let ((eexp (macroexp--expand-all exp))
-                 (eargs (macroexp--all-forms args)))
-             ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
-             ;; has a compiler-macro, or to unfold it.
-             (pcase eexp
-               ((and `#',f
-                     (guard (not (or (special-form-p f) (macrop f))))) ;; 
bug#46636
-                (macroexp--expand-all `(,f . ,eargs)))
-               (_ `(funcall ,eexp . ,eargs)))))
-          (`(funcall . ,_) form)            ;bug#53227
-          (`(,func . ,_)
-           (let ((handler (function-get func 'compiler-macro))
-                 (funargs (function-get func 'funarg-positions)))
-             ;; Check functions quoted with ' rather than with #'
-             (dolist (funarg funargs)
-               (let ((arg (nth funarg form)))
-                 (when (and (eq 'quote (car-safe arg))
-                            (eq 'lambda (car-safe (cadr arg))))
-                   (setcar (nthcdr funarg form)
-                           (macroexp-warn-and-return
-                            (format "%S quoted with ' rather than with #'"
-                                    (let ((f (cadr arg)))
-                                      (if (symbolp f) f `(lambda ,(nth 1 f) 
...))))
-                            arg nil nil (cadr arg))))))
-             ;; Macro expand compiler macros.  This cannot be delayed to
-             ;; byte-optimize-form because the output of the compiler-macro can
-             ;; use macros.
-             (if (null handler)
-                 ;; No compiler macro.  We just expand each argument (for
-                 ;; 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.
-               (unless (functionp handler)
-                 (with-demoted-errors "macroexp--expand-all: %S"
-                   (autoload-do-load (indirect-function func) func)))
-               (let ((newform (macroexp--compiler-macro handler form)))
-                 (if (eq form newform)
-                     ;; The compiler macro did not find anything to do.
-                     (if (equal form (setq newform (macroexp--all-forms form 
1)))
-                         form
-                       ;; Maybe after processing the args, some new 
opportunities
-                       ;; appeared, so let's try the compiler macro again.
-                       (setq form (macroexp--compiler-macro handler newform))
-                       (if (eq newform form)
-                           newform
-                         (macroexp--expand-all newform)))
-                   (macroexp--expand-all newform))))))
-          (_ form)))
+              fn
+              (macroexp--cons err
+                              (macroexp--cons (macroexp--expand-all body)
+                                              (macroexp--all-clauses handlers 
1)
+                                              (cddr form))
+                              (cdr form))
+              form))
+            (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_)
+             (push name macroexp--dynvars)
+             (macroexp--all-forms form 2))
+            (`(function ,(and f `(lambda . ,_)))
+             (let ((macroexp--dynvars macroexp--dynvars))
+               (macroexp--cons fn
+                               (macroexp--cons (macroexp--all-forms f 2)
+                                               nil
+                                               (cdr form))
+                               form)))
+            (`(,(or 'function 'quote) . ,_) form)
+            (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
+                                                 pcase--dontcare))
+             (let ((macroexp--dynvars macroexp--dynvars))
+               (macroexp--cons
+                fun
+                (macroexp--cons
+                 (macroexp--all-clauses bindings 1)
+                 (if (null body)
+                     (macroexp-unprogn
+                      (macroexp-warn-and-return
+                       (format "Empty %s body" fun)
+                       nil nil 'compile-only fun))
+                   (macroexp--all-forms body))
+                 (cdr form))
+                form)))
+            (`(,(and fun `(lambda . ,_)) . ,args)
+             ;; Embedded lambda in function position.
+             ;; If the byte-optimizer is loaded, try to unfold this,
+             ;; i.e. rewrite it to (let (<args>) <body>).  We'd do it in the 
optimizer
+             ;; anyway, but doing it here (i.e. earlier) can sometimes avoid 
the
+             ;; creation of a closure, thus resulting in much better code.
+             (let ((newform (macroexp--unfold-lambda form)))
+              (if (eq newform form)
+                  ;; Unfolding failed for some reason, avoid infinite 
recursion.
+                  (macroexp--cons (macroexp--all-forms fun 2)
+                                   (macroexp--all-forms args)
+                                   form)
+                (macroexp--expand-all newform))))
+            (`(funcall ,exp . ,args)
+             (let ((eexp (macroexp--expand-all exp))
+                   (eargs (macroexp--all-forms args)))
+               ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
+               ;; has a compiler-macro, or to unfold it.
+               (pcase eexp
+                 ((and `#',f
+                       (guard (not (or (special-form-p f) (macrop f))))) ;; 
bug#46636
+                  (macroexp--expand-all `(,f . ,eargs)))
+                 (_ `(funcall ,eexp . ,eargs)))))
+            (`(funcall . ,_) form)      ;bug#53227
+            (`(,func . ,_)
+             (let ((handler (function-get func 'compiler-macro))
+                   (funargs (function-get func 'funarg-positions)))
+               ;; Check functions quoted with ' rather than with #'
+               (dolist (funarg funargs)
+                 (let ((arg (nth funarg form)))
+                   (when (and (eq 'quote (car-safe arg))
+                              (eq 'lambda (car-safe (cadr arg))))
+                     (setcar (nthcdr funarg form)
+                             (macroexp-warn-and-return
+                              (format "%S quoted with ' rather than with #'"
+                                      (let ((f (cadr arg)))
+                                        (if (symbolp f) f `(lambda ,(nth 1 f) 
...))))
+                              arg nil nil (cadr arg))))))
+               ;; Macro expand compiler macros.  This cannot be delayed to
+               ;; byte-optimize-form because the output of the compiler-macro 
can
+               ;; use macros.
+               (if (null handler)
+                   ;; No compiler macro.  We just expand each argument (for
+                   ;; 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.
+                 (unless (functionp handler)
+                   (with-demoted-errors "macroexp--expand-all: %S"
+                     (autoload-do-load (indirect-function func) func)))
+                 (let ((newform (macroexp--compiler-macro handler form)))
+                   (if (eq form newform)
+                       ;; The compiler macro did not find anything to do.
+                       (if (equal form (setq newform (macroexp--all-forms form 
1)))
+                           form
+                         ;; Maybe after processing the args, some new 
opportunities
+                         ;; appeared, so let's try the compiler macro again.
+                         (setq form (macroexp--compiler-macro handler newform))
+                         (if (eq newform form)
+                             newform
+                           (macroexp--expand-all newform)))
+                     (macroexp--expand-all newform))))))
+            (_ form))))
     (pop byte-compile-form-stack)))
 
 ;; Record which arguments expect functions, so we can warn when those



reply via email to

[Prev in Thread] Current Thread [Next in Thread]