New condlet macro; small change to iflet/whenlet.

* eval.c (me_iflet_whenlet): Allow the test form
to be an atomic expression instead of bindings.
This allows iflet to be used as the sole target
construct of condlet, while allowing condlet to
have a fallback clause with t. It also means that
an empty list of bindings is allowed (since it
is the atom nil).

* lisplib.c (ifa_set_entries): Add "condlet" to
the autoload names for the ifa module. That's
where we are adding condlet.

* share/txr/stdlib/ifa.tl (sys:if-to-cond): New
macro expander helper function, generalizing the writing
cond-like macros based on if-like operators.
(conda): Rewritten using sys:if-to-cond.
(condlet): New macro.

* txr.1: Documented change in iflet/whenlet.
Documented condlet.

4 files changed, 137 insertions, 18 deletions

diff --git a/eval.c b/eval.c
index c00f6a80..9edc6ae6 100644
--- a/eval.c
+++ b/eval.c
@@ -2961,14 +2961,22 @@ static val me_iflet_whenlet(val form, val env)
   val args = form;
   val sym = pop(&args);
   val lets = pop(&args);
-  val lastlet = last(lets);
 
-  if (nilp(lastlet))
-    eval_error(form, lit("~s: empty binding list"), sym, nao);
+  if (atom(lets)) {
+    return apply_frob_args(list(if3(sym == iflet_s, if_s, when_s),
+                                lets, args, nao));
+  } else {
+    val lastlet = last(lets);
 
-  return list(let_star_s, lets,
-              cons(if3(sym == iflet_s, if_s, when_s),
-                   cons(car(car(lastlet)), args)), nao);
+    if (nilp(lastlet))
+      eval_error(form, lit("~s: empty binding list"), sym, nao);
+
+
+
+    return list(let_star_s, lets,
+                cons(if3(sym == iflet_s, if_s, when_s),
+                     cons(car(car(lastlet)), args)), nao);
+  }
 }
 
 static val me_dotimes(val form, val env)
diff --git a/lisplib.c b/lisplib.c
index e06b62e6..fcaf05f1 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -102,7 +102,7 @@ static val ver_instantiate(val set_fun)
 
 static val ifa_set_entries(val dlt, val fun)
 {
-  val name[] = { lit("ifa"), lit("conda"), nil };
+  val name[] = { lit("ifa"), lit("conda"), lit("condlet"), nil };
   set_dlt_entries(dlt, name, fun);
   return nil;
 }
diff --git a/share/txr/stdlib/ifa.tl b/share/txr/stdlib/ifa.tl
index cefb38eb..42b4d99c 100644
--- a/share/txr/stdlib/ifa.tl
+++ b/share/txr/stdlib/ifa.tl
@@ -65,9 +65,16 @@
                   (if (,sym ,*(if (eq 'dwim sym) ^(,(second test)))
                             ,*temps) ,then ,else)))))))))
 
+(macro-time
+  (defun sys:if-to-cond (if-oper cond-oper pairs)
+    (tree-case pairs
+      (((test . forms) . rest) ^(,if-oper ,test (progn ,*forms)
+                                          (,cond-oper ,*rest)))
+      (() ())
+      (else (throwf 'eval-error "~s: bad syntax: ~s" cond-oper pairs)))))
+
 (defmacro conda (. pairs)
-  (tree-case pairs
-    (((test . forms) . rest) ^(ifa ,test (progn ,*forms)
-                                   (conda ,*rest)))
-    (() ())
-    (else (throwf 'eval-error "conda: bad syntax: ~s" pairs))))
+  (sys:if-to-cond 'ifa 'conda pairs))
+
+(defmacro condlet (. pairs)
+  (sys:if-to-cond 'iflet 'condlet pairs))
diff --git a/txr.1 b/txr.1
index bbea1fdb..b8c70fb1 100644
--- a/txr.1
+++ b/txr.1
@@ -12184,10 +12184,10 @@ a return value can be specified. Under normal termination, the return value is
 
 .coNP Macros @ iflet and @ whenlet
 .synb
-.mets (iflet >> ({ sym | >> ( sym << init-form )}+)
+.mets (iflet >> {({ sym | >> ( sym << init-form )}+) | << atom-form }
 .mets \ \  < then-form <> [ else-form ])
-.mets (whenlet >> ({ sym | >> ( sym << init-form )}+)
-.mets \ \  << body-form *])
+.mets (whenlet >> {({ sym | >> ( sym << init-form )}+) | << atom-form }
+.mets \ \  << body-form *)
 .syne
 .desc
 The
@@ -12202,13 +12202,30 @@ and
 .codn when ,
 respectively.
 
-The evaluation of these forms takes place as follows. First, fresh bindings are
-established for
+In either construct's syntax, a non-compound form
+.meta atom-form
+may appear in place of the variable binding list. In this case,
+.meta atom-form
+is evaluated as a form, and the construct is equivalent to
+its respective ordinary
+.code if
+or
+.code when
+counterpart.
+
+If the list of variable bindings is empty, it is interpreted as the atom
+.code nil
+and treated as an
+.codn atom-form .
+
+If one or more bindings are specified rather than
+.metn atom-form ,
+then the evaluation of these forms takes
+place as follows. First, fresh bindings are established for
 .metn sym -s
 as if by the
 .code let*
 operator.
-It is an error for the list of variable bindings to be empty.
 
 Then, the last variable's value is tested. If it is not
 .code nil
@@ -12257,6 +12274,93 @@ is returned.
   (whenlet ((fv (get-frobosity-value))
             (exceeds-p (> fv 150)))
     (format t "frobosity value ~a exceeds 150\en" fv))
+
+  ;; yield 4: 3 interpreted as atom-form
+  (whenlet 3 4)
+
+  ;; yield 4: nil interpreted as atom-form
+  (iflet () 3 4)
+.cble
+
+.coNP Macro @ condlet
+.synb
+.mets (condlet
+.mets \ \  ([({ sym | >> ( sym << init-form )}+) | << atom-form ]
+.mets \ \ \  << body-form *)*)
+.syne
+.desc
+The
+.code condlet
+macro generalizes
+.codn iflet
+
+Arguments to
+.code condlet
+are are pairs.
+
+Each arguments is a compound consisting of at least one item: a list of
+bindings or
+.metn atom-form .
+This item is followed by zero or more
+.metn body-form -s.
+
+If the are are no
+.metn body-form -s
+then the situation is treated as if there were a single
+.meta body-form
+specified as
+.codn nil .
+
+The pairs of arguments are considered in sequence, starting with the
+leftmost.
+
+If the argument's left item is an
+.meta atom-form
+then the form is evaluated. If it yields true, then the
+.metn body-form -s
+next to it are evaluated in order, and the
+.code condlet
+form terminates, yielding the value obtained from the last
+.metn body-form .
+If
+.meta atom-form
+yields false, then the next argument is considered, if there is one.
+
+If the argument's left item is a list of bindings, then it is processed
+with exactly the same logic as under the
+.code iflet
+macro. If the last binding contains a true value, then the
+adjoining
+.metn body-form -s
+are evaluated in a scope in which all of the bindings are visible, and
+.code condlet
+terminates, yielding the value of the last
+.metn body-form .
+Otherwise, the next argument of
+.code condlet
+is considered (processed in a scope in which the bindings produced
+by the current item are no longer visible).
+
+If
+.code condlet
+runs out of arguments, it terminates and returns
+.codn nil .
+
+.TP* Example:
+.cblk
+  (let ((l '(1 2 3)))
+    (condlet
+       ;; first arg
+       (((a (first l)   ;; a binding gets 1
+         (b (second l)) ;; b binding gets 2
+         (g (> a b))))  ;; last variable g is nil
+        'foo)           ;; not evaluated
+       ;; second arg
+       (((b (second l)  ;; b gets 2
+         (c (third l))  ;; c gets 3
+         (g (> b c))))  ;; last variable g is true
+        'bar)))         ;; condlet terminates
+   --> bar              ;; result is bar
 .cble
 
 .coNP Macro @ ifa