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

(macroexp--unfold-lambda): Obey the lexbind semantics

Browse source 
While at it, rework the code so as not to rely on an
intermediate rewriting of (funcall (lambda ..) ...)
to ((lambda ..) ...) since that forms is deprecated.

* lisp/emacs-lisp/byte-opt.el (byte-optimize-funcall): Unfold lambdas
instead of turning them into the deprecated ((lambda ..) ..).
(byte-optimize-form-code-walker): Don't unfold ((lambda ..) ..) any more.
(byte-compile-inline-expand): Revert to non-optimized call if the unfolding
can't be optimized.

* lisp/emacs-lisp/bytecomp.el (byte-compile-form): Don't unfold
((lambda ..) ..) any more.

* lisp/emacs-lisp/cl-macs.el (cl--slet): Remove workaround.

* lisp/emacs-lisp/disass.el (disassemble): Make sure the code is
compiled with its own `lexical-binding` value.

* lisp/emacs-lisp/macroexp.el (macroexp--unfold-lambda): Make it work
both for ((lambda ..) ..) and for (funcall #'(lambda ..) ..).
Be careful not to move dynbound vars from `lambda` to `let`.
(macroexp--expand-all): Unfold (funcall #'(lambda ..) ..) instead of
turning it into ((lambda ..) ..).  Don't unfold ((lambda ..) ..) any more.
This commit is contained in:
Stefan Monnier 2023-06-24 17:53:41 -04:00
parent f559bd1248
commit e85ebb3d82
5 changed files with 95 additions and 113 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -244,68 +244,64 @@ It should normally be a symbol with position and it defaults to FORM."
new-form)))
(defun macroexp--unfold-lambda (form &optional name)
;; In lexical-binding mode, let and functions don't bind vars in the same way
;; (let obey special-variable-p, but functions don't). But luckily, this
;; doesn't matter here, because function's behavior is underspecified so it
;; can safely be turned into a `let', even though the reverse is not true.
(or name (setq name "anonymous lambda"))
(let* ((lambda (car form))
(values (cdr form))
(arglist (nth 1 lambda))
(body (cdr (cdr lambda)))
optionalp restp
bindings)
(if (and (stringp (car body)) (cdr body))
(setq body (cdr body)))
(if (and (consp (car body)) (eq 'interactive (car (car body))))
(setq body (cdr body)))
;; FIXME: The checks below do not belong in an optimization phase.
(while arglist
(cond ((eq (car arglist) '&optional)
;; ok, I'll let this slide because funcall_lambda() does...
;; (if optionalp (error "Multiple &optional keywords in %s" name))
(if restp (error "&optional found after &rest in %s" name))
(if (null (cdr arglist))
(error "Nothing after &optional in %s" name))
(setq optionalp t))
((eq (car arglist) '&rest)
;; ...but it is by no stretch of the imagination a reasonable
;; thing that funcall_lambda() allows (&rest x y) and
;; (&rest x &optional y) in arglists.
(if (null (cdr arglist))
(error "Nothing after &rest in %s" name))
(if (cdr (cdr arglist))
(error "Multiple vars after &rest in %s" name))
(setq restp t))
(restp
(setq bindings (cons (list (car arglist)
(and values (cons 'list values)))
bindings)
values nil))
((and (not optionalp) (null values))
(setq arglist nil values 'too-few))
(t
(setq bindings (cons (list (car arglist) (car values))
bindings)
values (cdr values))))
(setq arglist (cdr arglist)))
(if values
(macroexp-warn-and-return
(format-message
(if (eq values 'too-few)
"attempt to open-code `%s' with too few arguments"
"attempt to open-code `%s' with too many arguments")
name)
form nil nil arglist)
;; The following leads to infinite recursion when loading a
;; file containing `(defsubst f () (f))', and then trying to
;; byte-compile that file.
;;(setq body (mapcar 'byte-optimize-form body)))
(if bindings
`(let ,(nreverse bindings) . ,body)
(macroexp-progn body)))))
(pcase form
((or `(funcall (function ,lambda) . ,actuals) `(,lambda . ,actuals))
(let* ((formals (nth 1 lambda))
(body (cdr (macroexp-parse-body (cddr lambda))))
optionalp restp
(dynboundarg nil)
bindings)
;; FIXME: The checks below do not belong in an optimization phase.
(while formals
(if (macroexp--dynamic-variable-p (car formals))
(setq dynboundarg t))
(cond ((eq (car formals) '&optional)
;; ok, I'll let this slide because funcall_lambda() does...
;; (if optionalp (error "Multiple &optional keywords in %s" name))
(if restp (error "&optional found after &rest in %s" name))
(if (null (cdr formals))
(error "Nothing after &optional in %s" name))
(setq optionalp t))
((eq (car formals) '&rest)
;; ...but it is by no stretch of the imagination a reasonable
;; thing that funcall_lambda() allows (&rest x y) and
;; (&rest x &optional y) in formalss.
(if (null (cdr formals))
(error "Nothing after &rest in %s" name))
(if (cdr (cdr formals))
(error "Multiple vars after &rest in %s" name))
(setq restp t))
(restp
(setq bindings (cons (list (car formals)
(and actuals (cons 'list actuals)))
bindings)
actuals nil))
((and (not optionalp) (null actuals))
(setq formals nil actuals 'too-few))
(t
(setq bindings (cons (list (car formals) (car actuals))
bindings)
actuals (cdr actuals))))
(setq formals (cdr formals)))
(cond
(actuals
(macroexp-warn-and-return
(format-message
(if (eq actuals 'too-few)
"attempt to open-code `%s' with too few arguments"
"attempt to open-code `%s' with too many arguments")
name)
form nil nil formals))
;; In lexical-binding mode, let and functions don't bind vars in
;; the same way (let obey special-variable-p, but functions
;; don't). So if one of the vars is declared as dynamically scoped, we
;; can't just convert the call to `let'.
;; FIXME: We should α-rename the affected args and then use `let'.
(dynboundarg form)
(bindings `(let ,(nreverse bindings) . ,body))
(t (macroexp-progn body)))))
(_ (error "Not an unfoldable form: %S" form))))
(defun macroexp--dynamic-variable-p (var)
"Whether the variable VAR is dynamically scoped.
@ -437,27 +433,22 @@ Assumes the caller has bound `macroexpand-all-environment'."
(setq args (cddr args)))
(cons 'progn (nreverse assignments))))))
(`(,(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))))
(macroexp--cons (macroexp--all-forms fun 2)
(macroexp--all-forms args)
form))
(`(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
;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
;; has a compiler-macro, or to unfold it.
((and `#',f
(guard (not (or (special-form-p f) (macrop f))))) ;; bug#46636
(guard (and (symbolp f)
;; bug#46636
(not (or (special-form-p f) (macrop f))))))
(macroexp--expand-all `(,f . ,eargs)))
(`#'(lambda . ,_)
(macroexp--unfold-lambda `(,fn ,eexp . ,eargs)))
(_ `(,fn ,eexp . ,eargs)))))
(`(funcall . ,_) form) ;bug#53227
(`(,func . ,_)