bug#28254: 26.0.50; SRFI-2 and-let*

[Mark Oteiza]

On 03/09/17 at 09:13pm, Mark Oteiza wrote:
> On 02/09/17 at 02:41pm, Noam Postavsky wrote:
> > On Sat, Sep 2, 2017 at 9:36 AM, Mark Oteiza <mvoteiza@udel.edu> wrote:
> > > This single tuple special case is troublesome IMO:
> > >
> > > (if-let* (x) "dogs" "cats") => "cats"
> > > (if-let* (x (y 2)) "dogs" "cats") => (void-function y)
> > > (if-let* (x (y 1) (z 2)) "dogs" "cats") => "cats"
> > >
> > > I'm curious if this was brought up in the old discussion when this was
> > > implemented.
>
> FWIW, this was brought up in the original thread.
> https://lists.gnu.org/archive/html/emacs-devel/2014-08/msg00228.html
>
> IMO the original suggestion of having if-let and when-let be exclusively
> single binding, while the starred versions excluding the single binding
> special case would be more sane.
>
> P.S. I just realized I didn't copy the tuple part of if-let* into
> and-let* in the patch I just sent, and therefore missed the problem this
> special case causes in tests.

This is a patch implementing the above: if-let and when-let only take
single tuple, while {if,when,and}-let* lose the single tuple special
case.

diff --git a/etc/NEWS b/etc/NEWS
index 2b0c86d7af..24568d637b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1120,6 +1120,14 @@ be disabled by setting 
'byte-compile-cond-use-jump-table' to nil.
---
** The alist 'ucs-names' is now a hash table.

+---
+** Semantics of 'if-let', 'when-let', 'if-let*', and 'when-let*' have
+changed. 'if-let' and 'when-let' now only accept a single tuple to
+bind a single symbol. 'if-let*' and 'when-let*' no longer accept the
+single tuple special case.  New macro 'and-let*' is an implementation
+of the Scheme SRFI-2 syntax of the same name.  'if-let*' and
+'when-let*' now accept the same binding syntax as 'and-let*'.
+
---
** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term
mode to send the same escape sequences that xterm does.  This makes
@@ -1479,10 +1487,6 @@ It avoids unnecessary consing (and garbage collection).
+++
** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp.

----
-** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el.
-The incumbent 'if-let' and 'when-let' are now aliases.
-
---
** Low-level list functions like 'length' and 'member' now do a better
job of signaling list cycles instead of looping indefinitely.
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 849ac19d6a..e59211a1dc 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -83,10 +83,15 @@ thread-last
  `(internal--thread-argument nil ,@forms))

(defsubst internal--listify (elt)
-  "Wrap ELT in a list if it is not one."
-  (if (not (listp elt))
-      (list elt)
-    elt))
+  "Wrap ELT in a list if it is not one.
+If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol."
+  (cond
+   ((symbolp elt) (list elt elt))
+   ((and (null (cdr elt))
+         (let ((form (car elt)))
+           (or (listp form) (atom form))))
+    (list (cl-gensym) (car elt)))
+   (t elt)))

(defsubst internal--check-binding (binding)
  "Check BINDING is properly formed."
@@ -98,7 +103,10 @@ internal--check-binding

(defsubst internal--build-binding-value-form (binding prev-var)
  "Build the conditional value form for BINDING using PREV-VAR."
-  `(,(car binding) (and ,prev-var ,(cadr binding))))
+  (let ((var (car binding)))
+    (if (and (null (cdr binding)) (atom (car binding)) (not (symbolp (car 
binding))))
+        `(,var (and ,prev-var ,var))
+      `(,var (and ,prev-var ,(cadr binding))))))

(defun internal--build-binding (binding prev-var)
  "Check and build a single BINDING with PREV-VAR."
@@ -117,44 +125,62 @@ internal--build-bindings
                binding))
            bindings)))

-(defmacro if-let* (bindings then &rest else)
+(defmacro if-let* (varlist then &rest else)
  "Bind variables according to VARLIST and eval THEN or ELSE.
Each binding is evaluated in turn with `let*', and evaluation
stops if a binding value is nil.  If all are non-nil, the value
of THEN is returned, or the last form in ELSE is returned.
+
Each element of VARLIST is a symbol (which is bound to nil)
-or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
-In the special case you only want to bind a single value,
-VARLIST can just be a plain tuple.
-\n(fn VARLIST THEN ELSE...)"
+or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value
+of VALUEFORM).
+An element can additionally be of the form (EXPR), which is
+evaluated and checked for nil."
  (declare (indent 2)
-           (debug ([&or (&rest [&or symbolp (symbolp form)]) (symbolp form)]
+           (debug ((&rest [&or symbolp (symbolp form) (sexp)])
                   form body)))
-  (when (and (<= (length bindings) 2)
-             (not (listp (car bindings))))
-    ;; Adjust the single binding case
-    (setq bindings (list bindings)))
-  `(let* ,(internal--build-bindings bindings)
-     (if ,(car (internal--listify (car (last bindings))))
-         ,then
-       ,@else)))
+  (if varlist
+      `(let* ,(setq varlist (internal--build-bindings varlist))
+         (if ,(caar (last varlist))
+             ,then
+           ,@else))
+    `(let* () ,@else)))

-(defmacro when-let* (bindings &rest body)
+(defmacro when-let* (varlist &rest body)
  "Bind variables according to VARLIST and conditionally eval BODY.
Each binding is evaluated in turn with `let*', and evaluation
stops if a binding value is nil.  If all are non-nil, the value
of the last form in BODY is returned.
-Each element of VARLIST is a symbol (which is bound to nil)
-or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
-In the special case you only want to bind a single value,
-VARLIST can just be a plain tuple.
-\n(fn VARLIST BODY...)"
+
+VARLIST is the same as in `if-let*'."
+  (declare (indent 1) (debug if-let*))
+  (list 'if-let* varlist (macroexp-progn body)))
+
+(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 non-nil."
+  (declare (indent 1) (debug when-let*))
+  (let (res)
+    (if varlist
+        `(let* ,(setq varlist (internal--build-bindings varlist))
+           (if ,(setq res (caar (last varlist)))
+               ,@(or body `(,res))))
+      `(let* () ,@(or body '(t))))))
+
+(defmacro if-let (spec then &rest else)
+  "Bind variables according to SPEC and eval THEN or ELSE.
+Like `if-let*' except SPEC is of the form (SYMBOL VALUEFORM)"
+  (declare (indent 2) (debug ((symbolp form) form body)))
+  (if spec
+      `(let (,spec) (if ,(car spec) ,then ,@else))
+    `(let () ,@else)))
+
+(defmacro when-let (spec &rest body)
+  "Bind variables according to SPEC and conditionally eval BODY.
+Like `when-let*' except SPEC is of the form (SYMBOL VALUEFORM)"
  (declare (indent 1) (debug if-let))
-  (list 'if-let bindings (macroexp-progn body)))
-
-(defalias 'if-let 'if-let*)
-(defalias 'when-let 'when-let*)
-(defalias 'and-let* 'when-let*)
+  (list 'if-let spec (macroexp-progn body)))

(defsubst hash-table-empty-p (hash-table)
  "Check whether HASH-TABLE is empty (has 0 elements)."