New macro: letrec.

* eval.c (me_letrec): New function.
(eval_init): Register letrec intrinsic macro.

* tests/012/let.tl: New file.

* txr.1: Documented, and also referenced from mlet.

3 files changed, 211 insertions, 1 deletions

diff --git a/eval.c b/eval.c
index cc4a21eb..8dd3b047 100644
--- a/eval.c
+++ b/eval.c
@@ -4701,6 +4701,49 @@ static val me_mlet(val form, val menv)
                                    nao)), nao);
 }
 
+static val me_letrec(val form, val menv)
+{
+  val op = car(form);
+  val body = (syn_check(form, op, cdr, 0), cdr(form));
+  val bindings = pop(&body);
+  val iter;
+  list_collect_decl (vars, ptail_vars);
+  list_collect_decl (inits, ptail_inits);
+
+  (void) menv;
+
+  for (iter = bindings; iter; iter = cdr(iter)) {
+    val item = car(iter);
+    if (atom(item)) {
+      val var = item;
+      if (!bindable(var))
+        not_bindable_error(form, var);
+      ptail_vars = list_collect(ptail_vars, var);
+    } else if (consp(item)) {
+      val binding = item;
+      val var = pop(&item);
+      if (item && atom(item)) {
+        uw_throwf(error_s, lit("~s: invalid dotted binding syntax ~s"),
+                  op, binding, nao);
+      } else if (consp(item)) {
+        val init = car(item);
+        if (cdr(item))
+          uw_throwf(error_s, lit("~s: extra material in binding syntax ~s"),
+                    op, binding, nao);
+        ptail_vars = list_collect(ptail_vars, var);
+        ptail_inits = list_collect(ptail_inits,
+                                   list(set_s, var, init, nao));
+      } else {
+        ptail_vars = list_collect(ptail_vars, var);
+      }
+    }
+  }
+
+  list_collect_nconc(ptail_inits, body);
+
+  return cons(let_s, cons(vars, inits));
+}
+
 static val me_load_time(val form, val menv)
 {
   val expr = (syn_check(form, car(form), cdr, cddr), cadr(form));
@@ -7296,6 +7339,7 @@ void eval_init(void)
   reg_mac(intern(lit("dotimes"), user_package), func_n2(me_dotimes));
   reg_mac(intern(lit("lcons"), user_package), func_n2(me_lcons));
   reg_mac(intern(lit("mlet"), user_package), func_n2(me_mlet));
+  reg_mac(intern(lit("letrec"), user_package), func_n2(me_letrec));
   reg_mac(load_time_s, func_n2(me_load_time));
   reg_mac(intern(lit("load-for"), user_package), func_n2(me_load_for));
   reg_mac(intern(lit("push-after-load"), user_package),
diff --git a/tests/012/let.tl b/tests/012/let.tl
new file mode 100644
index 00000000..36a506ca
--- /dev/null
+++ b/tests/012/let.tl
@@ -0,0 +1,21 @@
+(load "../common")
+
+(test
+  (letrec ((a (progn (set b 2 c 3) 1))
+           (b)
+           (c nil)
+           (d (+ 3 a)))
+   (list a b c d))
+  (1 2 nil 4))
+
+(test
+  (letrec ((a (lcons 0 b))
+           (b (lcons 1 a)))
+    (take 10 a))
+  (0 1 0 1 0 1 0 1 0 1))
+
+(test
+  (letrec ((even (do if (zerop @1) t [odd (pred @1)]))
+           (odd (do if (zerop @1) nil [even (pred @1)])))
+    (list [even 16] [even 11] [odd 1]))
+  (t nil t))
diff --git a/txr.1 b/txr.1
index f21ea8ac..599638bc 100644
--- a/txr.1
+++ b/txr.1
@@ -15365,6 +15365,133 @@ name for the construct which has sequential semantics.
 Nevertheless, in this matter, \*(TL remains compatible with dialects like
 ANSI CL and Emacs Lisp.
 
+.coNP Macro @ letrec
+.synb
+.mets (letrec* >> ({ sym | >> ( sym <> [ init-form ])}*) << body-form *)
+.syne
+.desc
+The
+.code letrec
+macro provides a variation of
+.code let
+with altered scoping semantics.
+
+Under
+.codn letrec ,
+the
+.metn init-form s
+are evaluated in a scope in which all of the variables are visible.
+The scope is created with all the variables initially taking on
+.code nil
+values. The
+.metn init-form s
+are evaluated left to right and their values are assigned to their
+corresponding variables. Then the
+.metn body-form s
+are evaluated.
+
+An initializing assignment is not generated for any
+.meta sym
+which is specified without an
+.metn init-form .
+
+Note:
+.meta letrec
+is useful for binding variables to lazily constructed objects
+which use the variables to refer to each other in circular
+relationships. It is also useful for binding
+.meta lambda
+functions, which can use the variables to mutually recurse.
+While it is more common to use
+.code labels
+for such a situation,
+.code letrec
+can be used when the functions are written by macros which generate
+.codn lambda .
+
+.TP* Examples:
+
+.verb
+  (letrec ((a (progn (set b 2 c 3) 1))
+           (b) ;; equivalent to just b
+           (c nil)
+           (d (+ 3 a)))
+   (list a b c d))
+  --> (1 2 nil 4)
+.brev
+
+In this example,
+.code c
+is nil because it has an
+.metn init-form ,
+.codn nil .
+Although the form
+.code "(set b 2 c 3)"
+assigns it a value during the initialization of
+.codn a ,
+that value is later clobbered by the value of
+.codn c 's
+.metn init-form .
+Since
+.code b
+has not
+.metn init-form ,
+it retains the assigned value
+.codn 2 .
+
+.verb
+  (letrec ((a (lcons 0 b))
+           (b (lcons 1 a)))
+    (take 10 a))
+  --> (0 1 0 1 0 1 0 1 0 1)
+
+  ;; Above code is equivalent to
+  ;; (let (a b)
+  ;;   (set a (lcons 0 b))
+  ;;   (set b (lcons 0 a))
+  ;;   (take 10 a))
+.brev
+
+This example shows how
+.code letrec
+helps orchestrate the construction of a circular list, consisting of a pair
+of lazy
+.code cons
+cells. The
+.code letrec
+syntax conceals the mechanism, which relies on variable assignments.
+
+.verb
+  (letrec ((even (do if (zerop @1) t [odd (pred @1)]))
+           (odd (do if (zerop @1) nil [even (pred @1)])))
+    (list [even 16] [even 11] [odd 1]))
+  --> (t nil t)
+.brev
+
+This example shows mutual recursion between
+.code lambda
+functions generated by the
+.code do
+syntax from the
+.code op
+family. Note that not all instances of these operators can be relied
+upon to always generate lambdas. For instance, the expression
+.code "(opip a b c)"
+reduces to
+.code "[chain a b c]"
+which does not defer the evaluation of the
+.codn a ,
+.code b
+and
+.code c
+terms. If any of those terms are variables introduced later in the same
+.codn letrec ,
+they will turn into
+.code nil
+argument values passed to
+.codn chain ,
+which is incorrect.
+
 .coNP Operator @ progv
 .synb
 .mets (progv < symbols-expr < values-expr << body-form *)
@@ -24921,11 +25048,12 @@ expansion of
     z)
 
   ;; Okay: lazy circular reference because lcons is used
+  ;; This can use letrec instead for better efficiency
   (mlet ((list (lcons 1 list)))
     list)  -->  (1 1 1 1 1 ...) ;; circular list
 .brev
 
-In the last example, the
+In this example
 .code list
 variable is accessed for the first time in the body of the 
 .code mlet
@@ -24949,6 +25077,23 @@ argument is accessed. By that time, the variable is initialized
 and holds the lazy cons itself, which creates the circular reference,
 and a circular list.
 
+Note that the above last example can use
+.codn letrec ,
+which will make it more efficient, because the
+.code lcons
+macro provides all the necessary lazy semantics, such that
+.codn mlet 's
+lazy treatment of variable initialization is not required.
+All that is necessary for creating the circular list is that by the time the
+lazy evaluation of the
+.code list
+expression in the
+.code "(lcons 1 list)"
+form takes place, the lazy cons which was returned by that expression
+has already been constructed and stored in the
+.code list
+variable.
+
 .coNP Functions @, generate @ giterate and @ ginterate
 .synb
 .mets (generate < while-fun << gen-fun )