Implementing @(if)/@(elif)/@(else) in the pattern language.

Input side for now; output later.

* parser.y (if_clause, elif_clauses_opt, else_clause_opt): New nonterminals.
(IF, ELIF, ELSE): New tokens.
(yybadtoken): Handle IF, ELIF, ELSE.

* parser.l: Recognize and return new tokens IF, ELIF and ELSE.

* txr.1: Documented.

* genvim.txr: Updated with if, elsif and else directive keywords.

* txr.vim: Regenerated

6 files changed, 173 insertions, 16 deletions

diff --git a/ChangeLog b/ChangeLog
index 3854494b..4593c47d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,22 @@
 2014-03-13  Kaz Kylheku  <kaz@kylheku.com>
 
+	Implementing @(if)/@(elif)/@(else) in the pattern language.
+	Input side for now; output later.
+
+	* parser.y (if_clause, elif_clauses_opt, else_clause_opt): New nonterminals.
+	(IF, ELIF, ELSE): New tokens.
+	(yybadtoken): Handle IF, ELIF, ELSE.
+
+	* parser.l: Recognize and return new tokens IF, ELIF and ELSE.
+
+	* txr.1: Documented.
+
+	* genvim.txr: Updated with if, elsif and else directive keywords.
+
+	* txr.vim: Regenerated
+
+2014-03-13  Kaz Kylheku  <kaz@kylheku.com>
+
 	On platforms with sigaltstack, TXR programs can now catch the
 	segmentation fault that occurs when running out of stack space,
 	and escape by throwing an exception.
diff --git a/genvim.txr b/genvim.txr
index c134884e..1fabcb91 100644
--- a/genvim.txr
+++ b/genvim.txr
@@ -41,7 +41,8 @@ static void dir_tables_init(void)
        [sort (hash-values hash) string-lt])))
 @(do (set [txr-sym 0..0] '("rep" "end" "and" "or"
                            "catch" "finally"
-                           "until" "last")))
+                           "until" "last"
+                           "if" "else" "elif")))
 @(do (set [txl-sym 0..0] '("macro-time" "macrolet" "symacrolet")))
 @(set (txr-sym txl-sym) (@(sortuniq txr-sym) @(sortuniq txl-sym)))
 @(output)
diff --git a/parser.l b/parser.l
index 0e569980..3c4b7159 100644
--- a/parser.l
+++ b/parser.l
@@ -489,6 +489,24 @@ UONLY   {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
   return FINALLY;
 }
 
+<SPECIAL>\({WS}if/{ID_END} {
+  yy_push_state(NESTED);
+  yylval.lineno = lineno;
+  return IF;
+}
+
+<SPECIAL>\({WS}elif/{ID_END} {
+  yy_push_state(NESTED);
+  yylval.lineno = lineno;
+  return ELIF;
+}
+
+<SPECIAL>\({WS}else{WS}\) {
+  yy_pop_state();
+  yylval.lineno = lineno;
+  return ELSE;
+}
+
 <SPECIAL>[{] {
   yy_push_state(BRACED);
   yylval.lineno = lineno;
diff --git a/parser.y b/parser.y
index 5b2775ad..9062ca4a 100644
--- a/parser.y
+++ b/parser.y
@@ -31,6 +31,7 @@
 #include <limits.h>
 #include <dirent.h>
 #include <stdlib.h>
+#include <stdarg.h>
 #include <setjmp.h>
 #include <wchar.h>
 #include <signal.h>
@@ -43,6 +44,7 @@
 #include "match.h"
 #include "hash.h"
 #include "eval.h"
+#include "stream.h"
 #include "parser.h"
 
 int yylex(void);
@@ -88,6 +90,7 @@ static val parsed_spec;
 %type <val> collect_repeat
 %type <val> clause_parts additional_parts gather_parts additional_gather_parts
 %type <val> output_clause define_clause try_clause catch_clauses_opt
+%type <val> if_clause elif_clauses_opt else_clause_opt
 %type <val> line elems_opt elems clause_parts_h additional_parts_h
 %type <val> text texts elem var var_op modifiers vector hash
 %type <val> list exprs exprs_opt expr n_exprs n_expr
@@ -103,7 +106,7 @@ static val parsed_spec;
 %nonassoc LOW /* used for precedence assertion */
 %right SYMTOK '{' '}'
 %right ALL SOME NONE MAYBE CASES CHOOSE AND OR END COLLECT UNTIL COLL
-%right OUTPUT REPEAT REP FIRST LAST EMPTY DEFINE
+%right OUTPUT REPEAT REP FIRST LAST EMPTY DEFINE IF ELIF ELSE
 %right SPACE TEXT NUMBER
 %nonassoc '[' ']' '(' ')'
 %left '-' ',' '\'' '^' SPLICE '@'
@@ -148,6 +151,7 @@ clause : all_clause             { $$ = cons($1, nil); rlcp($$, $1); }
                                   rlcp(car($$), $1);
                                   rlcp($$, $1); }
        | try_clause             { $$ = cons($1, nil); rlcp($$, $1); }
+       | if_clause              { $$ = cons($1, nil); rlcp($$, $1); }
        | output_clause          { $$ = cons($1, nil); rlcp($$, $1); }
        | line                   { $$ = $1; }
        ;
@@ -304,6 +308,33 @@ additional_parts : END newl                             { $$ = nil; }
                  | OR newl clauses additional_parts     { $$ = cons($3, $4); }
                  ;
 
+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); }
+          | IF exprs_opt ')'
+            newl error          { $$ = nil; yybadtoken(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); }
+                 |                   { $$ = nil; }
+                 ;
+
+else_clause_opt : ELSE newl
+                  clauses_opt        { $$ = $3; }
+                  |                  { $$ = nil; }
+                  ;
+
+
 line : elems_opt '\n'           { $$ = $1; }
      ;
 
@@ -1251,6 +1282,9 @@ void yybadtoken(int tok, val context)
   case TRY:     problem = lit("\"try\""); break;
   case CATCH:   problem = lit("\"catch\""); break;
   case FINALLY: problem = lit("\"finally\""); break;
+  case IF:      problem = lit("\"if\""); break;
+  case ELIF:    problem = lit("\"elif\""); break;
+  case ELSE:    problem = lit("\"else\""); break;
   case NUMBER:  problem = lit("number"); break;
   case REGCHAR: problem = lit("regular expression character"); break;
   case REGTOKEN: problem = lit("regular expression token"); break;
diff --git a/txr.1 b/txr.1
index 0d278fef..1f39a45c 100644
--- a/txr.1
+++ b/txr.1
@@ -1302,6 +1302,15 @@ to the later clauses.
 Multiple clauses are applied to the same input. Evaluation stops on the
 first successful clause.
 
+.IP @(require)
+The require directive is similar to the do directive: it evaluates one or more
+TXR Lisp expressions.  If the result of the rightmost expression is nil,
+then require triggers a match failure.  See the TXR LISP section far below.
+
+.IP "@(if), @(elif), @(else)"
+The if directive with optional elif and else clauses is a syntactic sugar
+which translates to a combination of @(cases) and @(require)
+
 .IP @(choose)
 Multiple clauses are applied to the same input. The one whose effect persists
 is the one which maximizes or minimizes the length of a particular variable.
@@ -1424,11 +1433,6 @@ The load directive loads another TXR file and interprets its contents.
 The do directive is used to evaluate TXR Lisp expressions, discarding their
 result values. See the TXR LISP section far below.
 
-.IP @(require)
-The require directive is similar to the do directive: it evaluates one or more
-TXR Lisp expressions.  If the result of the rightmost expression is nil,
-then require triggers a match failure.  See the TXR LISP section far below.
-
 .PP
 
 .SH INPUT SCANNING AND DATA MANIPULATION
@@ -2046,6 +2050,88 @@ but the other one matches five lines, then the overall clause is considered to
 have made a five line match at its position. If more directives follow, they
 begin matching five lines down from that position.
 
+.SS The Require Directive
+
+The syntax of @(require) is:
+
+  @(require <lisp-expression>)
+
+The require directive evaluates a TXR Lisp expression. (See TXR LISP far
+below.) If the expression yields a true value, then it succeeds, and matching
+continues with the directives which follow. Otherwise the directive fails.
+
+In the context of the @(require) directive, should not be delimited by an @.
+
+Example:
+
+  @# require that 4 is greater than 3
+  @# This succeeds; therefore, @a is processed
+  @(require (> (+ 2 2) 3))
+  @a
+
+
+.SS The If Directive
+
+The syntax of the directive can be exemplified as follows
+
+  @(if <lisp-expr>)
+  .
+  .
+  .
+  @(elif <lisp-expr>)
+  .
+  .
+  .
+  @(elif <lisp-expr>)
+  .
+  .
+  .
+  @(else)
+  .
+  .
+  .
+  @(end)
+
+The @(elif) and @(else) clauses are all optional. If @(else) is present, it must be
+last, before @(end), after any @(elif) clauses. Any of the clauses may be empty.
+
+See the TXR Lisp section about TXR Lisp expressions. In this directive, TXR Lisp
+expressions are not introduced by the @ symbol.
+
+For example:
+
+  @(if (> (length str) 42))
+  foo: @a @b
+  @(else)
+  {@c}
+  @(end)
+
+In this example, if the length of the variable str is greater than 42, then
+matching continues with "foo: @a b", otherwise it proceeds with {@c}.
+
+The if directive is actually a syntactic sugar which is translated to @(cases)
+and @(require).  That is to say, the following pattern:
+
+  @(cases)
+  @(require <lisp-expr-1>)
+  A
+  @(or)
+  @(require <lisp-expr-2>)
+  B
+  @(or)
+  C
+  @(end)
+
+corresponds to the somewhat shorter and clearer:
+
+  @(if <lisp-expr-1>)
+  A
+  @(elsif <lisp-expr-2>)
+  B
+  @(else
+  C
+  @(end)
+
 .SS The Gather Directive
 
 Sometimes text is structured as items that can appear in an arbitrary order.
diff --git a/txr.vim b/txr.vim
index ef1ab970..1f3bbb26 100644
--- a/txr.vim
+++ b/txr.vim
@@ -23,15 +23,16 @@ syn keyword txr_keyword contained accept all and assert
 syn keyword txr_keyword contained bind block cases cat
 syn keyword txr_keyword contained catch choose close coll
 syn keyword txr_keyword contained collect defex deffilter define
-syn keyword txr_keyword contained do end eof eol
-syn keyword txr_keyword contained fail filter finally flatten
-syn keyword txr_keyword contained forget freeform fuzz gather
-syn keyword txr_keyword contained last load local maybe
-syn keyword txr_keyword contained merge next none or
-syn keyword txr_keyword contained output rebind rep repeat
-syn keyword txr_keyword contained require set skip some
-syn keyword txr_keyword contained text throw trailer try
-syn keyword txr_keyword contained until var
+syn keyword txr_keyword contained do elif else end
+syn keyword txr_keyword contained eof eol fail filter
+syn keyword txr_keyword contained finally flatten forget freeform
+syn keyword txr_keyword contained fuzz gather if last
+syn keyword txr_keyword contained load local maybe merge
+syn keyword txr_keyword contained next none or output
+syn keyword txr_keyword contained rebind rep repeat require
+syn keyword txr_keyword contained set skip some text
+syn keyword txr_keyword contained throw trailer try until
+syn keyword txr_keyword contained var
 
 syn keyword txl_keyword contained * *args* *full-args* *gensym-counter*
 syn keyword txl_keyword contained *keyword-package* *random-state* *self-path* *stddebug*