[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 37a09a4c00e: cl-defun/cl-struct: Use static scoping for function
From: |
Stefan Monnier |
Subject: |
master 37a09a4c00e: cl-defun/cl-struct: Use static scoping for function args |
Date: |
Fri, 23 Jun 2023 10:45:58 -0400 (EDT) |
branch: master
commit 37a09a4c00e5f78c27f64ea09ec076838a1a3d47
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
cl-defun/cl-struct: Use static scoping for function args
* lisp/emacs-lisp/cl-macs.el (cl--slet*): New function.
(cl--transform-lambda): Use it to fix bug#47552.
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-&key-arguments): Add test.
---
lisp/emacs-lisp/cl-macs.el | 22 ++++++++++++++++++----
test/lisp/emacs-lisp/cl-macs-tests.el | 10 +++++++++-
2 files changed, 27 insertions(+), 5 deletions(-)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 0b09cd7d225..007be1c9b08 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -243,6 +243,18 @@ The name is made by appending a number to PREFIX, default
\"T\"."
(defvar cl--bind-enquote) ;Non-nil if &cl-quote was in the formal arglist!
(defvar cl--bind-lets) (defvar cl--bind-forms)
+(defun cl--slet* (bindings body)
+ "Like `macroexp-let*' but uses static scoping for all the BINDINGS."
+ (pcase-exhaustive bindings
+ ('() body)
+ (`((,var ,exp) . ,bindings)
+ (let ((rest (cl--slet* bindings body)))
+ (if (macroexp--dynamic-variable-p var)
+ ;; FIXME: We use `identity' to obfuscate the code enough to
+ ;; circumvent the known bug in `macroexp--unfold-lambda' :-(
+ `(funcall (identity (lambda (,var) ,@(macroexp-unprogn rest))) ,exp)
+ (macroexp-let* `((,var ,exp)) rest))))))
+
(defun cl--transform-lambda (form bind-block)
"Transform a function form FORM of name BIND-BLOCK.
BIND-BLOCK is the name of the symbol to which the function will be bound,
@@ -337,10 +349,12 @@ FORM is of the form (ARGS . BODY)."
(list '&rest (car (pop cl--bind-lets))))))))
`((,@(nreverse simple-args) ,@rest-args)
,@header
- ,(macroexp-let* cl--bind-lets
- (macroexp-progn
- `(,@(nreverse cl--bind-forms)
- ,@body)))))))
+ ;; Make sure that function arguments are unconditionally statically
+ ;; scoped (bug#47552).
+ ,(cl--slet* cl--bind-lets
+ (macroexp-progn
+ `(,@(nreverse cl--bind-forms)
+ ,@body)))))))
;;;###autoload
(defmacro cl-defun (name args &rest body)
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el
b/test/lisp/emacs-lisp/cl-macs-tests.el
index a4bc8d542d4..44fc7264a0a 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -806,7 +806,15 @@ See Bug#57915."
(ert-deftest cl-&key-arguments ()
(cl-flet ((fn (&key x) x))
(should-error (fn :x))
- (should (eq (fn :x :a) :a))))
+ (should (eq (fn :x :a) :a)))
+ ;; In ELisp function arguments are always statically scoped (bug#47552).
+ (defvar cl--test-a)
+ (let ((cl--test-a 'dyn)
+ ;; FIXME: How do we silence the "Lexical argument shadows" warning?
+ (f (cl-function (lambda (&key cl--test-a b)
+ (list cl--test-a (symbol-value 'cl--test-a) b)))))
+ (should (equal (funcall f :cl--test-a 'lex :b 2) '(lex dyn 2)))))
+
;;; cl-macs-tests.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 37a09a4c00e: cl-defun/cl-struct: Use static scoping for function args,
Stefan Monnier <=