[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master e85ebb3d824: (macroexp--unfold-lambda): Obey the lexbind semantic
|
From: |
Stefan Monnier |
|
Subject: |
master e85ebb3d824: (macroexp--unfold-lambda): Obey the lexbind semantics |
|
Date: |
Sat, 24 Jun 2023 17:53:53 -0400 (EDT) |
branch: master
commit e85ebb3d82466c5838e9c6836e6d8b5c8d0a7c33
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
(macroexp--unfold-lambda): Obey the lexbind semantics
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.
---
lisp/emacs-lisp/byte-opt.el | 30 ++++------
lisp/emacs-lisp/bytecomp.el | 6 --
lisp/emacs-lisp/cl-macs.el | 6 +-
lisp/emacs-lisp/disass.el | 23 +++----
lisp/emacs-lisp/macroexp.el | 143 +++++++++++++++++++++-----------------------
5 files changed, 95 insertions(+), 113 deletions(-)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 307e3841e9b..26a1dc4a103 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -167,8 +167,8 @@ Earlier variables shadow later ones with the same name.")
((or `(lambda . ,_) `(closure . ,_))
;; While byte-compile-unfold-bcf can inline dynbind byte-code into
;; letbind byte-code (or any other combination for that matter), we
- ;; can only inline dynbind source into dynbind source or letbind
- ;; source into letbind source.
+ ;; can only inline dynbind source into dynbind source or lexbind
+ ;; source into lexbind source.
;; When the function comes from another file, we byte-compile
;; the inlined function first, and then inline its byte-code.
;; This also has the advantage that the final code does not
@@ -176,7 +176,10 @@ Earlier variables shadow later ones with the same name.")
;; the build more reproducible.
(if (eq fn localfn)
;; From the same file => same mode.
- (macroexp--unfold-lambda `(,fn ,@(cdr form)))
+ (let* ((newform `(,fn ,@(cdr form)))
+ (unfolded (macroexp--unfold-lambda newform)))
+ ;; Use the newform only if it could be optimized.
+ (if (eq unfolded newform) form unfolded))
;; Since we are called from inside the optimizer, we need to make
;; sure not to propagate lexvar values.
(let ((byte-optimize--lexvars nil)
@@ -452,13 +455,6 @@ for speeding up processing.")
`(progn ,@(byte-optimize-body env t))
`(,fn ,vars ,(mapcar #'byte-optimize-form env) . ,rest)))
- (`((lambda . ,_) . ,_)
- (let ((newform (macroexp--unfold-lambda form)))
- (if (eq newform form)
- ;; Some error occurred, avoid infinite recursion.
- form
- (byte-optimize-form newform for-effect))))
-
(`(setq ,var ,expr)
(let ((lexvar (assq var byte-optimize--lexvars))
(value (byte-optimize-form expr nil)))
@@ -1412,15 +1408,15 @@ See Info node `(elisp) Integer Basics'."
(defun byte-optimize-funcall (form)
- ;; (funcall #'(lambda ...) ...) -> ((lambda ...) ...)
+ ;; (funcall #'(lambda ...) ...) -> (let ...)
;; (funcall #'SYM ...) -> (SYM ...)
;; (funcall 'SYM ...) -> (SYM ...)
- (let* ((fn (nth 1 form))
- (head (car-safe fn)))
- (if (or (eq head 'function)
- (and (eq head 'quote) (symbolp (nth 1 fn))))
- (cons (nth 1 fn) (cdr (cdr form)))
- form)))
+ (pcase form
+ (`(,_ #'(lambda . ,_) . ,_)
+ (macroexp--unfold-lambda form))
+ (`(,_ ,(or `#',f `',(and f (pred symbolp))) . ,actuals)
+ `(,f ,@actuals))
+ (_ form)))
(defun byte-optimize-apply (form)
(let ((len (length form)))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 0d878846304..64a57948017 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3556,12 +3556,6 @@ lambda-expression."
((and (byte-code-function-p (car form))
(memq byte-optimize '(t lap)))
(byte-compile-unfold-bcf form))
- ((and (eq (car-safe (car form)) 'lambda)
- ;; if the form comes out the same way it went in, that's
- ;; because it was malformed, and we couldn't unfold it.
- (not (eq form (setq form (macroexp--unfold-lambda form)))))
- (byte-compile-form form byte-compile--for-effect)
- (setq byte-compile--for-effect nil))
((byte-compile-normal-call form)))
(if byte-compile--for-effect
(byte-compile-discard))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 540bcc7f3b3..1de5409f7ee 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -251,10 +251,8 @@ The name is made by appending a number to PREFIX, default
\"T\"."
(if (macroexp--dynamic-variable-p (car binding)) (setq dyn t)))
(cond
(dyn
- ;; FIXME: We use `identity' to obfuscate the code enough to
- ;; circumvent the known bug in `macroexp--unfold-lambda' :-(
- `(funcall (identity (lambda (,@(mapcar #'car bindings))
- ,@(macroexp-unprogn body)))
+ `(funcall (lambda (,@(mapcar #'car bindings))
+ ,@(macroexp-unprogn body))
,@(mapcar #'cadr bindings)))
((null (cdr bindings))
(macroexp-let* bindings body))
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 9dd08d00920..dd59a2e02e1 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -63,16 +63,19 @@ redefine OBJECT if it is a symbol."
(list (intern (completing-read (format-prompt "Disassemble function" fn)
obarray 'fboundp t nil nil def))
nil 0 t)))
- (if (and (consp object) (not (functionp object)))
- (setq object `(lambda () ,object)))
- (or indent (setq indent 0)) ;Default indent to zero
- (save-excursion
- (if (or interactive-p (null buffer))
- (with-output-to-temp-buffer "*Disassemble*"
- (set-buffer "*Disassemble*")
- (disassemble-internal object indent (not interactive-p)))
- (set-buffer buffer)
- (disassemble-internal object indent nil)))
+ (let ((lb lexical-binding))
+ (if (and (consp object) (not (functionp object)))
+ (setq object `(lambda () ,object)))
+ (or indent (setq indent 0)) ;Default indent to zero
+ (save-excursion
+ (if (or interactive-p (null buffer))
+ (with-output-to-temp-buffer "*Disassemble*"
+ (set-buffer "*Disassemble*")
+ (let ((lexical-binding lb))
+ (disassemble-internal object indent (not interactive-p))))
+ (set-buffer buffer)
+ (let ((lexical-binding lb))
+ (disassemble-internal object indent nil)))))
nil)
(declare-function native-comp-unit-file "data.c")
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index f3d0804323e..290bf1c933a 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -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 . ,_)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master e85ebb3d824: (macroexp--unfold-lambda): Obey the lexbind semantics,
Stefan Monnier <=