New directive: mdo.

* eval.h (progn_s): Declarationa added.

* match.c (mdo_s): New symbol variable.
(syms_init): Initialize mdo_s.

* match.h (mdo_s): Declared.

* parser.y (check_for_include): Renamed to check_parse_time_action
and implements mdo, not only include.
(clauses_rev): Follow rename of function.

* txr.1: Documented.

5 files changed, 66 insertions, 11 deletions

diff --git a/eval.h b/eval.h
index aea33907..bf97af3c 100644
--- a/eval.h
+++ b/eval.h
@@ -25,7 +25,7 @@
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
-extern val dwim_s, lambda_s, vector_lit_s, vec_list_s, list_s;
+extern val dwim_s, lambda_s, progn_s, vector_lit_s, vec_list_s, list_s;
 extern val hash_lit_s, hash_construct_s, struct_lit_s, qref_s, uref_s;
 extern val eval_error_s, if_s, call_s;
 extern val eq_s, eql_s, equal_s;
diff --git a/match.c b/match.c
index 01ee5c2a..60b5a6df 100644
--- a/match.c
+++ b/match.c
@@ -58,7 +58,7 @@ int opt_arraydims = 1;
 val decline_k, next_spec_k, repeat_spec_k;
 val mingap_k, maxgap_k, gap_k, mintimes_k, maxtimes_k, times_k;
 val lines_k, chars_k;
-val text_s, choose_s, gather_s, do_s, mod_s, modlast_s;
+val text_s, choose_s, gather_s, do_s, mdo_s, mod_s, modlast_s;
 val line_s, data_s, fuzz_s, load_s;
 val include_s, close_s, require_s;
 val longest_k, shortest_k, greedy_k;
@@ -4684,6 +4684,7 @@ static void syms_init(void)
   choose_s = intern(lit("choose"), user_package);
   gather_s = intern(lit("gather"), user_package);
   do_s = intern(lit("do"), user_package);
+  mdo_s = intern(lit("mdo"), user_package);
   load_s = intern(lit("load"), user_package);
   include_s = intern(lit("include"), user_package);
   close_s = intern(lit("close"), user_package);
diff --git a/match.h b/match.h
index 77ddfcb5..9894ecff 100644
--- a/match.h
+++ b/match.h
@@ -25,7 +25,7 @@
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
-extern val text_s, choose_s, gather_s, do_s, require_s;
+extern val text_s, choose_s, gather_s, do_s, mdo_s, require_s;
 extern val close_s, load_s, include_s, mod_s, modlast_s, line_s;
 extern val counter_k, vars_k, env_k, var_k, into_k, named_k;
 val match_expand_keyword_args(val elem);
diff --git a/parser.y b/parser.y
index 20c540e3..6615a3e7 100644
--- a/parser.y
+++ b/parser.y
@@ -67,7 +67,7 @@ static val unquotes_occur(val quoted_form, int level);
 static val rlrec(parser_t *, val form, val line);
 static wchar_t char_from_name(const wchar_t *name);
 static val make_expr(parser_t *, val sym, val rest, val lineno);
-static val check_for_include(val spec_rev);
+static val check_parse_time_action(val spec_rev);
 static void misplaced_consing_dot_check(scanner_t *scanner, val term_atom_cons);
 
 #if YYBISON
@@ -212,8 +212,8 @@ byacc_fool : n_expr { internal_error("notreached"); }
            | { internal_error("notreached"); }
            ;
 
-clauses_rev : clause                    { $$ = check_for_include(cons($1, nil)); }
-            | clauses_rev clause        { $$ = check_for_include(cons($2, $1));  }
+clauses_rev : clause                    { $$ = check_parse_time_action(cons($1, nil)); }
+            | clauses_rev clause        { $$ = check_parse_time_action(cons($2, $1));  }
             ;
 
 clauses_opt : clauses_rev       { $$ = nreverse($1); }
@@ -1661,15 +1661,21 @@ static val make_expr(parser_t *parser, val sym, val rest, val lineno)
   return ret;
 }
 
-static val check_for_include(val spec_rev)
+static val check_parse_time_action(val spec_rev)
 {
   val line = first(spec_rev);
 
   if (consp(line)) {
     val elem = first(line);
     if (consp(elem)) {
-      if (car(elem) == include_s)
+      val sym = car(elem);
+      if (sym == include_s) {
         return nappend2(nreverse(include(line)), rest(spec_rev));
+      }
+      if (sym == mdo_s) {
+        eval_intrinsic(cons(progn_s, cdr(elem)), nil);
+        return nil;
+      }
     }
   }
   return spec_rev;
diff --git a/txr.1 b/txr.1
index d9ef1e36..50bb99c2 100644
--- a/txr.1
+++ b/txr.1
@@ -3263,9 +3263,19 @@ These directives allow \*(TX programs to be modularized. They bring in
 code from a file, in two different ways.
 
 .coIP @(do)
-The do directive is used to evaluate \*(TL expressions, discarding their
+The
+.code do
+directive is used to evaluate \*(TL expressions, discarding their
 result values. See the TXR LISP section far below.
 
+.coIP @(mdo)
+The
+.code mdo
+(macro
+.codn do )
+directive evaluates \*(TL expressions immediately, during the parsing
+of the \*(TX syntax in which it occurs.
+
 .PP
 
 .SS* Subexpression Evaluation
@@ -6508,10 +6518,12 @@ The syntax of
 is:
 
 .cblk
-.mets @(do << lisp-expression )
+.mets @(do << lisp-expression *)
 .cble
 
-The do directive evaluates a \*(TL expression. (See TXR LISP far
+The
+.code do
+directive evaluates zero or more \*(TL expressions. (See TXR LISP far
 below.) The value of the expression is ignored, and matching continues
 continues with the directives which follow the
 .code do
@@ -6532,6 +6544,42 @@ Example:
   @(do (set [h a] b))
 .cble
 
+.dir mdo
+
+The syntax of
+.code @(mdo)
+is:
+
+.cblk
+.mets @(mdo << lisp-expression *)
+.cble
+
+Like the
+.code do
+directive,
+.code mdo
+(macro-time
+.codn do )
+evaluates zero or more \*(TL expressions. Unlike
+.codn do ,
+.code mdo
+performs this evaluation immediately upon being parsed.
+Then it disappears from the syntax.
+
+The effect of
+.code "@(mdo e0 e1 e2 ...)"
+is exactly like
+.code "@(do (macro-time e0 e1 e2 ...))"
+except that
+.code do
+doesn't disappear from the syntax.
+
+Another difference is that
+.code do
+can be used as a horizontal or vertical directive, whereas
+.code mdo
+is only vertical.
+
 .SS* Blocks
 
 .NP* Overview