procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
(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.
This commit is contained in:
Stefan Monnier 2021-02-27 20:22:58 -05:00
parent 9eff23573d
commit ff09851a1f
1 changed files with 34 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
lisp/emacs-lisp/macroexp.el
View file

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