branch: elpa/loopy
commit b7b2399f403532de07f7a50bf18a8462c9780a0e
Author: okamsn <[email protected]>
Commit: GitHub <[email protected]>
Fix detecting destructured `with`-bound variables. (#260)
Closes issues #259 and #252. See also for `loopy-dash` related PR
https://github.com/okamsn/loopy-dash/pull/4.
- In `loopy--pcase-destructure-for-iteration`:
- Return list of single variable when given. Previously, we were
mistakenly
returning the symbol instead of a list containing the symbol.
- Prepend the `rest` variable in the `lambda` function with an underscore
to silence a compiler warning.
- In `loopy--pcase-destructure-for-with-vars`:
- Change the return value from a list containing the symbol `pcase-let*`
and
the list of variable bindings to a list containing a list of found
variables
as symbols and a function that receives an expression and produces
wrapped
code correctly binding the variables.
- Add the argument `error`, like `loopy--pcase-destructure-for-with-vars`,
so that we signal `loopy-bad-run-time-destructuring` when desired.
- In `loopy--process-special-arg-with` and
`loopy-iter--process-special-arg-with`, set `loopy--with-vars`
to the new output of `loopy--pcase-destructure-for-with-vars`
instead of just the pairs given to the special macro argument.
- Update the documentation of `loopy--with-vars` to match the new output
of `loopy--pcase-destructure-for-with-vars`.
- Update `loopy-seq--destructure-for-with-vars` and
`loopy-pcase--destructure-for-with-vars` to match the new output
of `loopy--pcase-destructure-for-with-vars`.
- Update `loopy--with-bound-p` to use the new output
of `loopy--pcase-destructure-for-with-vars`.
- Update `loopy--expand-to-loop` to use the new output
of `loopy--pcase-destructure-for-with-vars`.
- Add tests `with-var-destructured-still-detected`,
`seq-with-var-destructured-still-detected`, and
`pcase-with-var-destructured-still-detected`
to make sure accumulation commands properly detect destructured
`with` variables.
---
lisp/loopy-destructure.el | 55 +++++++++++++++++++++++++-----
lisp/loopy-iter.el | 3 +-
lisp/loopy-seq.el | 15 +++++++--
lisp/loopy-vars.el | 26 ++++++++-------
lisp/loopy.el | 85 +++++++++++++----------------------------------
tests/pcase-tests.el | 12 +++++++
tests/seq-tests.el | 12 +++++++
tests/tests.el | 24 +++++++++++--
8 files changed, 144 insertions(+), 88 deletions(-)
diff --git a/lisp/loopy-destructure.el b/lisp/loopy-destructure.el
index 3624277dea9..6d211fecb06 100644
--- a/lisp/loopy-destructure.el
+++ b/lisp/loopy-destructure.el
@@ -900,12 +900,12 @@ Returns a list. The elements are:
If ERROR is non-nil, then signal an error in the produced code if
the pattern doesn't match."
(if (symbolp var)
- `((setq ,var ,val)
- ,var)
+ (list `(setq ,var ,val)
+ (list var))
(let* ((var-list nil)
(always-used-cases
(cons var (lambda (varvals &rest _)
- (cons 'setq (mapcan (pcase-lambda (`(,var ,val .
,rest))
+ (cons 'setq (mapcan (pcase-lambda (`(,var ,val .
,_rest))
(push var var-list)
(list var val))
varvals))))))
@@ -917,13 +917,52 @@ the pattern doesn't match."
(list always-used-cases)))
(seq-uniq var-list #'eq)))))
-(defun loopy--pcase-destructure-for-with-vars (bindings)
- "Return a way to destructure BINDINGS by `pcase-let*'.
+(cl-defun loopy--pcase-destructure-for-with-vars (bindings &key error)
+ "Get function to wrap code and destructure values in BINDINGS.
+
+Each binding in BINDINGS is a (VARIABLE VALUE) pair, where VARIABLE is a
+symbol or a `pcase' pattern. If VARIABLE is a symbol, then it is used
+directly. If ERROR is non-nil, then `loopy-bad-run-time-destructuring'
+is signaled if a binding does not match.
Returns a list of two elements:
-1. The symbol `pcase-let*'.
-2. A new list of bindings."
- (list 'pcase-let* bindings))
+1. A list of symbols being all the variables to be bound in BINDINGS.
+2. A function to be called with the code to be wrapped, which
+ should produce wrapped code appropriate for BINDINGS,
+ such as a `let*' form."
+ (let ((new-bindings nil)
+ (all-vars nil))
+ (pcase-dolist (`(,var ,val) bindings)
+ (if (symbolp var)
+ (progn
+ (cl-callf2 cl-adjoin var all-vars :test #'eq)
+ (push `(nil (,var ,val))
+ new-bindings))
+ ;; `loopy--pcase-destructure-for-iteration' does not return any capture
+ ;; variables that `pcase' might use, so we need to `let' bind our own
+ ;; capture variable before we `let' bind the found variables, to avoid
+ ;; hiding any needed variable values when binding the found variables
to
+ ;; `nil'.
+ (let ((capture-var (gensym "loopy--with-capture")))
+ (pcase-let ((`(,setter ,found-vars)
+ (loopy--pcase-destructure-for-iteration
+ var capture-var
+ :error error)))
+ (cl-callf cl-union all-vars found-vars :test #'eq)
+ (push `(,setter
+ (,capture-var ,val)
+ ,@(cl-loop for v in found-vars
+ collect `(,v nil)))
+ new-bindings)))))
+ (list all-vars
+ (lambda (body)
+ (let ((result (macroexp-progn body)))
+ (dolist (b new-bindings)
+ (setq result
+ `(let ,(cdr b)
+ ,(car b)
+ ,result)))
+ result)))))
(cl-defun loopy--pcase-parse-for-destructuring-accumulation-command
((name var val &rest args) &key error)
diff --git a/lisp/loopy-iter.el b/lisp/loopy-iter.el
index 237bd4484b0..f62ce79b413 100644
--- a/lisp/loopy-iter.el
+++ b/lisp/loopy-iter.el
@@ -389,7 +389,8 @@ Returns BODY without the `%s' argument."
((= 1 (length binding)) (list (cl-first binding) nil))
(t binding)))
(finally-do
- (setq loopy--with-vars loopy-result))))
+ (setq loopy--with-vars (loopy--destructure-for-with-vars
+ loopy-result)))))
(loopy-iter--def-special-processor finally-return
diff --git a/lisp/loopy-seq.el b/lisp/loopy-seq.el
index 28bc99cf56a..5e664f4f40e 100644
--- a/lisp/loopy-seq.el
+++ b/lisp/loopy-seq.el
@@ -85,9 +85,18 @@
"Return a way to destructure BINDINGS as if by a `seq-let*'.
Returns a list of two elements:
-1. The symbol `loopy-seq--seq-let*'.
-2. A new list of bindings."
- (list 'loopy-seq--seq-let* bindings))
+1. A list of symbols being all the variables to be bound in BINDINGS.
+2. A function to be called with the code to be wrapped, which
+ should produce wrapped code appropriate for BINDINGS,
+ such as a `let*' form."
+ (loopy--pcase-destructure-for-with-vars
+ (cl-loop for b in bindings
+ for (var val) = b
+ collect (if (seqp var)
+ `(,(loopy-seq--make-pcase-pattern var)
+ ,val)
+ b))
+ :error nil))
(defmacro loopy-seq--seq-let* (bindings &rest body)
"Bind variables in BINDINGS according via `seq-let' and `let'.
diff --git a/lisp/loopy-vars.el b/lisp/loopy-vars.el
index ed0f262532c..d68d645cb3e 100644
--- a/lisp/loopy-vars.el
+++ b/lisp/loopy-vars.el
@@ -425,14 +425,20 @@ This is used to check for errors with the `at' command.")
(defvar loopy--with-vars nil
"With Forms are variables explicitly created using the `with' keyword.
-This is a list of ((VAR1 VAL1) (VAR2 VAL2) ...). If VAR is a
-sequence, then it will be destructured. How VAR and VAL are
-used, as well as how the bindings are expanded into the loop's
-surrounding code, is determined by the destructuring system being
-used.
+This is a list of the form (VARIABLES BINDING-FUNCTION). VARIABLES
+is a list of symbols naming which variables are found in the bindings,
+including destructured bindings. BINDING-FUNCTION is a function
+that will receive code to be wrapped in a `let'-like form
+and should return an expression binding the VARIABLES and setting
+their values.
They are created by passing (with (VAR1 VAL1) (VAR2 VAL2) ...) to
-`loopy'.")
+`loopy'.
+
+Because it can affect expansion of the loop commands,
+`loopy--with-vars' is by `loopy--process-special-arg-with',
+which uses `loopy--destructure-for-with-vars' and the destructuring
+flags found by `loopy--process-special-arg-flag'.")
(defvar loopy--without-vars nil
"A list of variables that `loopy' won't try to initialize.
@@ -739,12 +745,8 @@ This list is mainly fed to the macro
`loopy--wrap-variables-around-body'."))
Some iteration commands (e.g., `reduce') will change their behavior
depending on whether the accumulation variable is given an initial
value."
- (or (cl-loop for (var val) in loopy--with-vars
- when (eq var var-name)
- return (cons 'with val))
- (cl-loop for x in loopy--without-vars
- when (eq x var-name)
- return (cons 'without nil))))
+ (or (memq var-name (car-safe loopy--with-vars))
+ (memq var-name loopy--without-vars)))
(defun loopy--command-bound-p (var-name)
"Whether VAR-NAME was bound by a command (and not a special macro argument).
diff --git a/lisp/loopy.el b/lisp/loopy.el
index 4d1172a990d..f5c2eea7845 100644
--- a/lisp/loopy.el
+++ b/lisp/loopy.el
@@ -156,69 +156,34 @@ this means that an explicit \"nil\" is always required."
(error "Invalid binding in `loopy' expansion: %s" binding)))
(defun loopy--destructure-for-with-vars (bindings)
- "Destructure BINDINGS into bindings suitable for something like `let*'.
+ "Get function to wrap code and destructure values in BINDINGS.
This function named by this variables receives the bindings given
to the `with' macro argument and should usually return a list of
two elements:
-1. A function/macro that works like `let*' and can be used to wrap
- the expanded macro code.
-2. The bindings that will be given to this macro.
-
-For example, an acceptable return value might be something like
-
- (list \\='pcase-let* BINDINGS)
-
-which will be used to wrap the loop and other code."
+1. A list of symbols being all the variables to be bound in BINDINGS.
+2. A function to be called with the code to be wrapped, which
+ should produce wrapped code appropriate for BINDINGS,
+ such as a `let*' form."
(funcall (or loopy--destructuring-for-with-vars-function
#'loopy--destructure-for-with-vars-default)
bindings))
(defun loopy--destructure-for-with-vars-default (bindings)
- "Destructure BINDINGS into bindings suitable for something like `let*'.
+ "Get function to wrap code and destructure values in BINDINGS.
Returns a list of two elements:
-1. The symbol `pcase-let*'.
-2. A new list of bindings."
- ;; We do this instead of passing to `pcase-let*' so that:
- ;; 1) We sure that variables are bound even when unmatched.
- ;; 2) We can signal an error if the pattern doesn't match a value.
- ;; This keeps the behavior of the old implementation.
- ;;
- ;; Note: Binding the found variables to `nil' would overwrite any values that
- ;; we might try to access while binding, so we can't do that like we do
- ;; for iteration commands in which we already know the scope.
- ;; (let ((new-binds)
- ;; (all-set-exprs))
- ;; (dolist (bind bindings)
- ;; (cl-destructuring-bind (var val)
- ;; bind
- ;; (if (symbolp var)
- ;; (push `(,var ,val) new-binds)
- ;; (let ((sym (gensym)))
- ;; (push `(,sym ,val) new-binds)
- ;; (cl-destructuring-bind (set-expr found-vars)
- ;; (loopy--pcase-destructure-for-iteration `(loopy ,var) sym
:error t)
- ;; (dolist (v found-vars)
- ;; (push `(,v nil) new-binds))
- ;; (push set-expr all-set-exprs))))))
- ;; (list 'let* (nreverse new-binds) (macroexp-progn (nreverse
- ;; all-set-exprs))))
- (let ((new-binds))
- (dolist (bind bindings)
- (cl-destructuring-bind (var val)
- bind
- (if (symbolp var)
- (push `(,var ,val) new-binds)
- (let ((sym (gensym)))
- (push `(,sym ,val) new-binds)
- (cl-destructuring-bind (set-expr found-vars)
- (loopy--pcase-destructure-for-iteration `(loopy ,var) sym
:error t)
- (dolist (v found-vars)
- (push `(,v nil) new-binds))
- (push `(_ ,set-expr) new-binds))))))
- (list 'let* (nreverse new-binds))))
+1. A list of symbols being all the variables to be bound in BINDINGS.
+2. A function to be called with the code to be wrapped, which
+ should produce wrapped code appropriate for BINDINGS,
+ such as a `let*' form."
+ (loopy--pcase-destructure-for-with-vars (cl-loop for b in bindings
+ for (var val) = b
+ collect (if (symbolp var)
+ b
+ `((loopy ,var)
,val)))
+ :error t))
;;;; The Macro Itself
(defun loopy--expand-to-loop ()
@@ -426,8 +391,7 @@ The function creates quoted code that should be used by a
macro."
;; Declare the With variables.
(when loopy--with-vars
- (setq result `(,@(loopy--destructure-for-with-vars loopy--with-vars)
- ,@(get-result))
+ (setq result (funcall (cl-second loopy--with-vars) (get-result))
result-is-one-expression t))
;; Declare the symbol macros.
@@ -527,14 +491,13 @@ Returns BODY without the `%s' argument."
(loopy--def-special-processor with
(setq loopy--with-vars
- ;; Note: These values don't have to be used literally, due to
- ;; destructuring.
- (mapcar (lambda (binding)
- (cond ((symbolp binding) (list binding nil))
- ((= 1 (length binding)) (list (cl-first binding)
- nil))
- (t binding)))
- arg-value))
+ (loopy--destructure-for-with-vars
+ (mapcar (lambda (binding)
+ (cond ((symbolp binding) (list binding nil))
+ ((= 1 (length binding)) (list (cl-first binding)
+ nil))
+ (t binding)))
+ arg-value)))
(seq-remove (lambda (x) (eq (car x) arg-name)) body))
(loopy--def-special-processor without
diff --git a/tests/pcase-tests.el b/tests/pcase-tests.el
index 60f2ee0e5a7..b6257f77324 100644
--- a/tests/pcase-tests.el
+++ b/tests/pcase-tests.el
@@ -112,3 +112,15 @@
(should-not loopy--destructuring-for-with-vars-function)
(should-not loopy--destructuring-for-iteration-function)
(should-not loopy--destructuring-accumulation-parser))
+
+(ert-deftest pcase-with-var-destructured-still-detected ()
+ "Make sure destructured `with' variables are still detected by other
commands.
+For example, make sure we don't see an error for incompatible accumulations
+since we are binding `acc' in `with'."
+ (should (= 45 (eval '(loopy (flag pcase)
+ (with (`(,acc ,b) '(3 4)))
+ (list i '(1 2 3))
+ (sum acc i)
+ (multiply acc i)
+ (finally-return acc))
+ t))))
diff --git a/tests/seq-tests.el b/tests/seq-tests.el
index abf0e54273c..b47aee395fc 100644
--- a/tests/seq-tests.el
+++ b/tests/seq-tests.el
@@ -114,3 +114,15 @@
(should-not loopy--destructuring-for-with-vars-function)
(should-not loopy--destructuring-for-iteration-function)
(should-not loopy--destructuring-accumulation-parser))
+
+(ert-deftest seq-with-var-destructured-still-detected ()
+ "Make sure destructured `with' variables are still detected by other
commands.
+For example, make sure we don't see an error for incompatible accumulations
+since we are binding `acc' in `with'."
+ (should (= 45 (eval '(loopy (flag seq)
+ (with ([acc b] '(3 4)))
+ (list i '(1 2 3))
+ (sum acc i)
+ (multiply acc i)
+ (finally-return acc))
+ t))))
diff --git a/tests/tests.el b/tests/tests.el
index fa67acf2369..5686a7529c4 100644
--- a/tests/tests.el
+++ b/tests/tests.el
@@ -41,7 +41,7 @@
args doc repeat body multi-body
repeat-loopy repeat-iter-bare repeat-iter-keyword
wrap
- macroexpand
+ (macroexpand nil macroexpand-provided)
(loopy nil loopy-provided)
(iter-bare nil iter-bare-provided)
(iter-keyword nil iter-keyword-provided)
@@ -98,7 +98,7 @@ prefix the items in LOOPY or ITER-BARE."
(declare (indent 1))
(unless (or result-provided error-provided should-provided)
- (error "Must include `result' or `error'"))
+ (error "Must include `result', `error', or `should' (even for
`macroexpand')"))
(unless (or loopy iter-bare iter-keyword)
(error "Must include `loopy' or `iter-bare'"))
(unless body
@@ -138,7 +138,9 @@ prefix the items in LOOPY or ITER-BARE."
(output-wrap (x) (cond (should-provided `(should ,x))
(result-provided `(should (equal ,result ,x)))
(error-provided `(should-error ,x :type
- (quote
,error)))))
+ (quote ,error)))
+ (t
+ (error "Didn't specify how to wrap output
(`result', `should', etc.)"))))
;; Replace given placeholder command names with actual names,
;; maybe including the `for' keyword for `loopy-iter'.
(translate (group-alist this-body &optional keyword)
@@ -396,6 +398,22 @@ writing a `seq-do' method for the custom seq."
:loopy t
:iter-bare ((return . returning)))
+(loopy-deftest with-var-destructured-still-detected
+ :doc "Make sure destructured `with' variables are still detected by other
commands.
+For example, make sure we don't see an error for incompatible accumulations
+since we are binding `acc' in `with'."
+ :result 45
+ :body ((with ((acc b) '(3 4)))
+ (list i '(1 2 3))
+ (sum acc i)
+ (multiply acc i)
+ (finally-return acc))
+ :loopy t
+ :iter-keyword (list sum multiply)
+ :iter-bare ((list . listing)
+ (sum . summing)
+ (multiply . multiplying)))
+
;;;; Without
(loopy-deftest without
:result '(4 5)
