New semantics for @(if) directive.

* eval.h (if_s): Declared.

* match.c (v_if): New static function.
(dir_tables_init): Register v_if in v_directive_table under if symbol.

* parser.y (IF): Token assigned to <lineno> type.
(if_clause, elif_clauses_opt, else_clause_opt): New syntactic
representation, understood by v_if.

* txr.1: Documented if semantics more precisely, dropped
the text about it being syntactic sugar for a cases with require,
added compatibility note.

4 files changed, 107 insertions, 46 deletions

diff --git a/eval.h b/eval.h
index d3e814ad..ae5008f1 100644
--- a/eval.h
+++ b/eval.h
@@ -26,7 +26,7 @@
 
 extern val dwim_s, lambda_s, vector_lit_s, vec_list_s, list_s;
 extern val hash_lit_s, hash_construct_s, struct_lit_s, qref_s;
-extern val eval_error_s;
+extern val eval_error_s, if_s;
 extern val eq_s, eql_s, equal_s;
 extern val last_form_evaled, last_form_expanded;
 
diff --git a/match.c b/match.c
index 4e5ed362..0747b011 100644
--- a/match.c
+++ b/match.c
@@ -3656,6 +3656,33 @@ static val v_require(match_files_ctx *c)
   return next_spec_k;
 }
 
+static val v_if(match_files_ctx *c)
+{
+  spec_bind (specline, first_spec, c->spec);
+  val args = rest(first_spec);
+
+  for (; args; args = cdr(args)) {
+    cons_bind (expr, spec, car(args));
+    if (eval_with_bindings(expr, c->spec, c->bindings, specline)) {
+      cons_bind (new_bindings, success, match_files(mf_spec(*c, spec)));
+      if (!success) {
+        return nil;
+      } else if (success == t) {
+        c->data = nil;
+      } else {
+        cons_bind (new_data, new_line, success);
+        c->data = new_data;
+        c->data_lineno = new_line;
+      }
+
+      c->bindings = new_bindings;
+      return next_spec_k;
+    }
+  }
+
+  return next_spec_k;
+}
+
 static val v_assert(match_files_ctx *c)
 {
   spec_bind (specline, first_spec, c->spec);
@@ -4182,6 +4209,7 @@ static void dir_tables_init(void)
   sethash(v_directive_table, eof_s, cptr(coerce(mem_t *, v_eof)));
   sethash(v_directive_table, do_s, cptr(coerce(mem_t *, v_do)));
   sethash(v_directive_table, require_s, cptr(coerce(mem_t *, v_require)));
+  sethash(v_directive_table, if_s, cptr(coerce(mem_t *, v_if)));
   sethash(v_directive_table, assert_s, cptr(coerce(mem_t *, v_assert)));
   sethash(v_directive_table, load_s, cptr(coerce(mem_t *, v_load)));
   sethash(v_directive_table, close_s, cptr(coerce(mem_t *, v_close)));
diff --git a/parser.y b/parser.y
index 3849e86b..e4a1552e 100644
--- a/parser.y
+++ b/parser.y
@@ -100,7 +100,7 @@ int yyparse(scanner_t *, parser_t *);
 %token <lineno> ALL SOME NONE MAYBE CASES BLOCK CHOOSE GATHER
 %token <lineno> AND OR END COLLECT
 %token <lineno> UNTIL COLL OUTPUT REPEAT REP SINGLE FIRST LAST EMPTY
-%token <lineno> MOD MODLAST DEFINE TRY CATCH FINALLY
+%token <lineno> MOD MODLAST DEFINE TRY CATCH FINALLY IF
 %token <lineno> ERRTOK /* deliberately not used in grammar */
 %token <lineno> HASH_BACKSLASH HASH_SLASH DOTDOT HASH_H HASH_S HASH_R
 %token <lineno> WORDS WSPLICE QWORDS QWSPLICE
@@ -358,25 +358,48 @@ if_clause : IF exprs_opt ')'
             newl clauses_opt
             elif_clauses_opt
             else_clause_opt
-            END newl            { val req = rlcp(cons(require_s, $2), $2);
-                                  val iff = rlcp(cons(cons(cons(req, nil), $5), nil), $2);
-                                  val elifs = $6;
-                                  val els = cons($7, nil);
-                                  val cases = nappend2(nappend2(iff, elifs), els);
-                                  $$ = list(cases_s, cases, nao); }
+            END newl            { if (opt_compat && opt_compat <= 136)
+                                  { val req = rlcp(cons(require_s, $2), $2);
+                                    val iff = rlcp(cons(cons(cons(req, nil), $5), nil), $2);
+                                    val elifs = $6;
+                                    val els = cons($7, nil);
+                                    val cases = nappend2(nappend2(iff, elifs), els);
+                                    $$ = list(cases_s, cases, nao); }
+                                  else
+                                  { val expr = car($2);
+                                    val ifs = $5;
+                                    val branch = cons(cons(expr, ifs), nil);
+                                    val elifs = $6;
+                                    val els = $7;
+                                    if (cdr($2))
+                                      yyerr("extra expression in if");
+                                    $$ = cons(if_s,
+                                              nappend2(branch, nappend2(elifs, els)));
+                                    rl($$, num($1)); } }
           | IF exprs_opt ')'
             newl error          { $$ = nil; yybadtok(yychar, lit("if clause")); }
           ;
 
 elif_clauses_opt : ELIF exprs_opt ')' newl
                    clauses_opt
-                   elif_clauses_opt  { val req = rlcp(cons(require_s, $2), $2);
-                                       $$ = cons(cons(cons(req, nil), $5), $6); }
+                   elif_clauses_opt  { if (opt_compat && opt_compat <= 136)
+                                       { val req = rlcp(cons(require_s, $2), $2);
+                                         $$ = cons(cons(cons(req, nil), $5), $6); }
+                                       else
+                                       { val expr = car($2);
+                                         val elifs = $5;
+                                         val branch = cons(cons(expr, elifs), nil);
+                                         if (cdr($2))
+                                           yyerr("extra expression in elif");
+                                         $$ = nappend2(branch, $6); } }
                  |                   { $$ = nil; }
                  ;
 
 else_clause_opt : ELSE newl
-                  clauses_opt        { $$ = $3; }
+                  clauses_opt        { if (opt_compat && opt_compat <= 136)
+                                       { $$ = $3; }
+                                       else
+                                       { $$ = cons(cons(t, $3), nil); } }
                   |                  { $$ = nil; }
                   ;
 
diff --git a/txr.1 b/txr.1
index b54b6398..b6824575 100644
--- a/txr.1
+++ b/txr.1
@@ -2955,11 +2955,8 @@ directive with optional
 .code elif
 and
 .code else
-clauses is a syntactic sugar
-which translates to a combination of
-.code @(cases)
-and
-.codn @(require) .
+clauses allows one of multiple bodies of pattern matching directives to be
+conditionally selected by testing the values of Lisp expressions.
 
 .coIP @(choose)
 Multiple clauses are applied to the same input. The one whose effect persists
@@ -4348,6 +4345,11 @@ Example:
 
 .dir if
 
+The
+.code if
+directive allows for conditional selection of pattern matching clauses,
+based on the Boolean results Lisp expressions.
+
 The syntax of the
 .code if
 directive can be exemplified as follows:
@@ -4411,37 +4413,33 @@ then matching continues with
 otherwise it proceeds with
 .codn {@c} .
 
-The
+More precisely, how the
 .code if
-directive is actually a syntactic sugar which is translated to
-.code @(cases)
-and
-.codn @(require) .
-That is to say, the following pattern:
-
-.cblk
-  @(cases)
-.mets @(require << lisp-expr-1 )
-  A
-  @(or)
-.mets @(require << lisp-expr-2 )
-  B
-  @(or)
-  C
-  @(end)
-.cble
-
-corresponds to the somewhat shorter and clearer:
-
-.cblk
-.mets @(if << lisp-expr-1 )
-  A
-.mets @(elif << lisp-expr-2 )
-  B
-  @(else)
-  C
-  @(end)
-.cble
+directive works is as follows. The Lisp expressions are evaluated in order,
+starting with the
+.code if
+expression, then the
+.code elif
+expressions if any are present. If any Lisp expression yields a true result
+(any value other than
+.codn nil)
+then evaluation of Lisp expressions stops. The corresponding clause of that
+Lisp expression is selected and pattern matching continues
+with that clauses. The result of that clause (its success or failure,
+and any newly bound variables) is then taken as the result of the
+.code if
+directive. If none of the Lisp expressions yield true, and an
+.code else
+clause is present, then that clause is processed and its result determines
+the result of the
+.code if
+directive. If none of the Lisp expressions
+yield true, and there is no
+.code else
+clause, then the
+.code if
+directive is deemed to have trivially succeeded, allowing matching to continue
+with whatever directive follows it.
 
 .dir gather
 
@@ -40636,6 +40634,18 @@ of these version values, the described behaviors are provided if
 is given an argument which is equal or lower. For instance
 .code -C 103
 selects the behaviors described below for version 105, but not those for 102.
+.IP 136
+A request for compatibility with \*(TX 136 or earlier restores the old behavior
+of the
+.code if
+directive, which in used to be a syntactic sugar for a
+.code cases
+directive with
+.code require
+at the top of each block. Though semantically well-defined and working as
+documented, the behavior was confusing, since failed matching caused potential
+evaluation of multiple clauses, whereas programmers expect an if/elif/else
+ladder to select exactly one clause.
 .IP 128
 Compatibility with \*(TX 128 or earlier brings back the behavior that
 expressions in quasiliterals are evaluated according to \*(TX evaluation