master ff09851: * lisp/emacs-lisp/macroexp.el: Rewrite the code warning about '(lambda ...)

[Stefan Monnier]

branch: master
commit ff09851a1fff745584de11cb67091a432eeff312
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * lisp/emacs-lisp/macroexp.el: Rewrite the code warning about '(lambda ...)
    
    (macroexp--expand-all): Use `pcase--dontcare` so pcase generates
    slightly better code.  Don't hardcode which functions takes function
    arguments; rely on a new `funarg-positions` symbol property instead.
---
 lisp/emacs-lisp/macroexp.el | 61 +++++++++++++++++++++++++--------------------
 1 file changed, 34 insertions(+), 27 deletions(-)

diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 4d04bfa..59ada5e 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -294,10 +294,12 @@ Assumes the caller has bound 
`macroexpand-all-environment'."
                   macroexpand-all-environment)
     ;; Normal form; get its expansion, and then expand arguments.
     (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) dontcare))
+      (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare))
        (macroexp--cons
         'condition-case
         (macroexp--cons err
@@ -314,7 +316,8 @@ Assumes the caller has bound `macroexpand-all-environment'."
                                        (cdr form))
                        form))
       (`(,(or 'function 'quote) . ,_) form)
-      (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) dontcare))
+      (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
+                                           pcase--dontcare))
        (macroexp--cons fun
                        (macroexp--cons (macroexp--all-clauses bindings 1)
                                        (if (null body)
@@ -339,27 +342,7 @@ Assumes the caller has bound 
`macroexpand-all-environment'."
                              form)
           (macroexp--expand-all newform))))
 
-      ;; The following few cases are for normal function calls that
-      ;; are known to funcall one of their arguments.  The byte
-      ;; compiler has traditionally handled these functions specially
-      ;; by treating a lambda expression quoted by `quote' as if it
-      ;; were quoted by `function'.  We make the same transformation
-      ;; here, so that any code that cares about the difference will
-      ;; see the same transformation.
-      ;; First arg is a function:
-      (`(,(and fun (or 'funcall 'apply 'mapcar 'mapatoms 'mapconcat 'mapc))
-         ',(and f `(lambda . ,_)) . ,args)
-       (macroexp-warn-and-return
-        (format "%s quoted with ' rather than with #'"
-                (list 'lambda (nth 1 f) '...))
-        (macroexp--expand-all `(,fun #',f . ,args))))
-      ;; Second arg is a function:
-      (`(,(and fun (or 'sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
-       (macroexp-warn-and-return
-        (format "%s quoted with ' rather than with #'"
-                (list 'lambda (nth 1 f) '...))
-        (macroexp--expand-all `(,fun ,arg1 #',f . ,args))))
-      (`(funcall ,exp . ,args)
+      (`(funcall . ,(or `(,exp . ,args) pcase--dontcare))
        (let ((eexp (macroexp--expand-all exp))
              (eargs (macroexp--all-forms args)))
          ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
@@ -368,10 +351,22 @@ Assumes the caller has bound 
`macroexpand-all-environment'."
            (`#',f (macroexp--expand-all `(,f . ,eargs)))
            (_ `(funcall ,eexp . ,eargs)))))
       (`(,func . ,_)
-       ;; Macro expand compiler macros.  This cannot be delayed to
-       ;; byte-optimize-form because the output of the compiler-macro can
-       ;; use macros.
-       (let ((handler (function-get func 'compiler-macro)))
+       (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)))))
+         ;; 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
@@ -397,6 +392,18 @@ Assumes the caller has bound 
`macroexpand-all-environment'."
 
       (_ form))))
 
+;; Record which arguments expect functions, so we can warn when those
+;; are accidentally quoted with ' rather than with #'
+(dolist (f '(funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash))
+  (put f 'funarg-positions '(1)))
+(dolist (f '( add-hook remove-hook advice-remove advice--remove-function
+              defalias fset global-set-key run-after-idle-timeout
+              set-process-filter set-process-sentinel sort))
+  (put f 'funarg-positions '(2)))
+(dolist (f '( advice-add define-key
+              run-at-time run-with-idle-timer run-with-timer ))
+  (put f 'funarg-positions '(3)))
+
 ;;;###autoload
 (defun macroexpand-all (form &optional environment)
   "Return result of expanding macros at all levels in FORM.