From e313ceee48d860d3ee9591298c9ac1630096610b Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 31 Oct 2014 07:17:20 -0700
Subject: New macros tb and tc.

* eval.c (me_tb, me_tc): New static functions.
(eval_init): Registered tb and tc macros.

* txr.1: Documented tb and tc.
---
 ChangeLog |  9 ++++++++
 eval.c    | 30 ++++++++++++++++++++++++++
 txr.1     | 72 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 111 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index 86c746c3..f78f1cf8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2014-10-31  Kaz Kylheku  <kaz@kylheku.com>
+
+	New macros tb and tc.
+
+	* eval.c (me_tb, me_tc): New static functions.
+	(eval_init): Registered tb and tc macros.
+
+	* txr.1: Documented tb and tc.
+
 2014-10-30  Kaz Kylheku  <kaz@kylheku.com>
 
 	* lib.c (chk_grow_vec): New function.
diff --git a/eval.c b/eval.c
index 7d92d22a..aab5a683 100644
--- a/eval.c
+++ b/eval.c
@@ -2595,6 +2595,34 @@ static val me_case(val form, val menv)
               cons(cond_s, condpairs), nao);
 }
 
+static val me_tb(val form, val menv)
+{
+  val opsym = pop(&form);
+  val pat = pop(&form);
+  val body = form;
+  val args = gensym(lit("args-"));
+
+  (void) opsym;
+  (void) menv;
+
+  return list(lambda_s, args,
+              cons(tree_bind_s, cons(pat, cons(args, body))), nao);
+}
+
+static val me_tc(val form, val menv)
+{
+  val opsym = pop(&form);
+  val cases = form;
+  val args = gensym(lit("args-"));
+
+  (void) opsym;
+  (void) menv;
+
+  return list(lambda_s, args,
+              cons(tree_case_s, cons(args, cases)), nao);
+}
+
+
 static val expand_catch_clause(val form, val menv)
 {
   val sym = first(form);
@@ -3506,6 +3534,8 @@ void eval_init(void)
   reg_mac(caseq_s, me_case);
   reg_mac(caseql_s, me_case);
   reg_mac(casequal_s, me_case);
+  reg_mac(intern(lit("tb"), user_package), me_tb);
+  reg_mac(intern(lit("tc"), user_package), me_tc);
 
   reg_fun(cons_s, func_n2(cons));
   reg_fun(intern(lit("make-lazy-cons"), user_package), func_n1(make_lazy_cons));
diff --git a/txr.1 b/txr.1
index 5b19b877..59241881 100644
--- a/txr.1
+++ b/txr.1
@@ -25306,6 +25306,78 @@ is important: even more so than the order of cases in a
 or
 .codn caseql .
 
+.coNP Macro @ tb
+.synb
+.mets (tb < macro-style-params << form *)
+.syne
+.desc
+The
+.code tb
+macro is similar to the
+.code lambda
+operator but its argument binding is based on a macro-style parameter list.
+The name is an abbreviation of
+.codn tree-bind .
+
+A
+.code tb
+form evaluates to a function which takes a variable number of
+arguments.
+
+When that function is called, those arguments are taken as a list object which
+is matched against
+.meta macro-style-params
+as if by
+.metn tree-bind .
+If the match is successful, then the parameters are bound to the
+corresponding elements from the argument structure and each successive
+.meta form
+is evaluated an environment in which those bindings are visible.
+The value of the last
+.meta form
+is the return value of the function. If there are no forms,
+the function's return value is
+.codn nil .
+
+The following equivalence holds, where
+.code args
+should be understood to be a globally unique symbol:
+
+.cblk
+  (tb pattern body ...) <--> (lambda (. args)
+                               (tree-bind pattern args body ...))
+.cble
+
+.coNP Macro @ tc
+.synb
+.mets (tc >> {( macro-style-params  << form *)}*)
+.syne
+.desc
+The
+.code tc
+macro produces an anonymous function whose behavior is closely
+based on the
+.code tree-case
+operator. Its name is an abbreviation of
+.codn tree-case .
+
+The anonymous function takes a variable number of arguments.
+Its argument list is taken to be the value macro is tested
+against the multiple pattern clauses of an implicit
+.codn tree-bind .
+The return value of the function is that of the implied
+.codn tree-bind .
+
+The following equivalence holds, where
+.code args
+should be understood to be a globally unique symbol:
+
+.cblk
+  (tc clause1 clause2 ...) <--> (lambda (. args)
+                                   (tree-bind args
+                                      clause1 clause2 ...))
+.cble
+
 .SS* Debugging Functions
 .coNP Functions source-loc and source-loc-str
 .synb
-- 
cgit v1.2.3