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

cl-defsubst: Use static scoping for args

Browse source 
* lisp/emacs-lisp/cl-macs.el (cl--slet): New function, partly extracted
from `cl--slet*`.
(cl--slet*): Use it.
(cl--defsubst-expand): Use it to fix bug#47552.

* test/lisp/emacs-lisp/cl-macs-tests.el (cl-defstruct-dynbound-label):
New test.
This commit is contained in:
Stefan Monnier 2023-06-23 11:37:12 -04:00
parent 37a09a4c00
commit e2ee646b16
2 changed files with 31 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

33
lisp/emacs-lisp/cl-macs.el
View file

@ -243,17 +243,24 @@ 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 `cl--slet*' but for \"parallel let\"."
(cond
((seq-some (lambda (binding) (macroexp--dynamic-variable-p (car binding)))
bindings)
;; 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)))
,@(mapcar #'cadr bindings)))
((null (cdr bindings))
(macroexp-let* bindings body))
(t `(let ,bindings ,@(macroexp-unprogn body)))))
(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))))))
(if (null bindings) body
(cl--slet `(,(car bindings)) (cl--slet* (cdr bindings) body))))
(defun cl--transform-lambda (form bind-block)
"Transform a function form FORM of name BIND-BLOCK.
@ -349,8 +356,7 @@ FORM is of the form (ARGS . BODY)."
(list '&rest (car (pop cl--bind-lets))))))))
`((,@(nreverse simple-args) ,@rest-args)
,@header
;; Make sure that function arguments are unconditionally statically
;; scoped (bug#47552).
;; Function arguments are unconditionally statically scoped (bug#47552).
,(cl--slet* cl--bind-lets
(macroexp-progn
`(,@(nreverse cl--bind-forms)
@ -2910,9 +2916,10 @@ The function's arguments should be treated as immutable.
(cl-defun ,name ,args ,@body))))
(defun cl--defsubst-expand (argns body _simple whole _unsafe &rest argvs)
(if (and whole (not (cl--safe-expr-p (cons 'progn argvs))))
(if (and whole (not (cl--safe-expr-p (macroexp-progn argvs))))
whole
`(let ,(cl-mapcar #'list argns argvs) ,body)))
;; Function arguments are unconditionally statically scoped (bug#47552).
(cl--slet (cl-mapcar #'list argns argvs) body)))
;;; Structures.