--- Begin Message ---
|
Subject: |
26.0.50; SRFI-2 and-let* |
|
Date: |
Sun, 27 Aug 2017 16:11:29 -0400 |
Hi,
A while ago I aliased and-let* to when-let* in subr-x in be10c00d.
Some time later I implemented it and promptly forgot about it. While
this could be cleaned up and dropped into subr-x, it could just as
well be in its own file--its behavior overlaps with when-let* but each
has things the other lacks.
https://www.gnu.org/software/guile/manual/html_node/SRFI_002d2.html
https://srfi.schemers.org/srfi-2/srfi-2.html
(defmacro and-let* (varlist &rest body)
"Bind variables according to VARLIST and conditionally eval BODY.
Like `when-let*' except if BODY is empty and all the bindings are
non-nil, then the result is t. Elements of VARLIST can
additionally be of the form (EXPR), which is evaluated and
checked for nil."
(declare (indent 1)
(debug ([&or (&rest &or symbolp atom (symbolp &optional form) (form))
(symbolp form)]
body)))
(let (res (prev-var t) (i 0))
(dolist (binding varlist)
(push
(cond
((symbolp binding)
(prog1
`(,binding (and ,prev-var ,binding))
(setq prev-var binding)))
((atom binding) binding)
((and (listp binding) (null (cdr binding))
(let ((form (car binding)))
(or (listp form) (atom form))))
(let ((new (cl-gensym)))
(prog1 `(,new (and ,prev-var ,(car binding)))
(setq prev-var new))))
(t
(prog1 `(,(car binding) (and ,prev-var ,(cadr binding)))
(setq prev-var (car binding)))))
res))
`(let* ,(nreverse res)
,(if (null body) prev-var
`(when ,prev-var ,@body)))))
(ert-deftest srfi-2-test-empty-varlist ()
(should (equal 1 (and-let* () 1)))
(should (equal 2 (and-let* () 1 2)))
(should (equal t (and-let* ()))))
(ert-deftest srfi-2-test-group-1 ()
(should (equal nil (let ((x nil)) (and-let* (x)))))
(should (equal 1 (let ((x 1)) (and-let* (x)))))
(should (equal nil (and-let* ((x nil)))))
(should (equal 1 (and-let* ((x 1)))))
(should-error (and-let* (nil (x 1))) :type 'setting-constant)
(should (equal nil (and-let* ((nil) (x 1)))))
(should-error (and-let* (2 (x 1))) :type 'wrong-type-argument)
(should (equal 1 (and-let* ((2) (x 1)))))
(should (equal 2 (and-let* ((x 1) (2)))))
(should (equal nil (let ((x nil)) (and-let* (x) x))))
(should (equal "" (let ((x "")) (and-let* (x) x))))
(should (equal "" (let ((x "")) (and-let* (x)))))
(should (equal 2 (let ((x 1)) (and-let* (x) (+ x 1)))))
(should (equal nil (let ((x nil)) (and-let* (x) (+ x 1)))))
(should (equal 2 (let ((x 1)) (and-let* (((> x 0))) (+ x 1)))))
(should (equal t (let ((x 1)) (and-let* (((> x 0)))))))
(should (equal nil (let ((x 0)) (and-let* (((> x 0))) (+ x 1)))))
(should (equal 3
(let ((x 1)) (and-let* (((> x 0)) (x (+ x 1))) (+ x 1))))))
(ert-deftest srfi-2-test-rebind ()
(should
(equal 4
(let ((x 1))
(and-let* (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1))))))
(ert-deftest srfi-2-test-group-2 ()
(should
(equal 2 (let ((x 1)) (and-let* (x ((> x 0))) (+ x 1)))))
(should
(equal 2 (let ((x 1)) (and-let* (((progn x)) ((> x 0))) (+ x 1)))))
(should (equal nil (let ((x 0)) (and-let* (x ((> x 0))) (+ x 1)))))
(should (equal nil (let ((x nil)) (and-let* (x ((> x 0))) (+ x 1)))))
(should
(equal nil (let ((x nil)) (and-let* (((progn x)) ((> x 0))) (+ x 1))))))
(ert-deftest srfi-2-test-group-3 ()
(should
(equal nil (let ((x 1)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
(should
(equal nil (let ((x 0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
(should
(equal nil
(let ((x nil)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
(should
(equal (/ 3.0 2)
(let ((x 3.0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))))
--- End Message ---
--- Begin Message ---
|
Subject: |
Re: bug#28254: 26.0.50; SRFI-2 and-let* |
|
Date: |
Wed, 13 Sep 2017 12:49:17 -0400 |
|
User-agent: |
Mutt/1.9.0 (2017-09-02) |
On 13/09/17 at 06:46pm, Michael Heerdegen wrote:
> Mark Oteiza <address@hidden> writes:
>
> > I guess the following is fine then--thanks for finding these.
>
> Yes, that's what I meant.
>
> If you are sure it's ok, please install, and thanks.
Ok, great. All tests passed, so I installed it. Closing!
--- End Message ---