New directive: choose.

* match.c (choose_s, longest_k, shortest_k): New variables.
(match_line, match_files): Introduced choose directive.
(match_init): Initialize new variables.

* match.h (choose_s): Declared.

* parser.l (yybadtoken): Handle CHOOSE.
(CHOOSE): Clause added for returning this token.

* parser.y: Added #include "match.h".
(CHOOSE): New token symbol.
(choose_clause): New nonterminal symbol.
(clause): choose_clause added.
(all_clause, some_clause, none_clause,  maybe_clause,
cases_clause): Abstract syntax tree tweaked.
(choose_clause): New syntax.
(elem): Abstract syntax trees tweaked for many clauses.
New CHOOSE clauses.
(out_clause): New error case for choose_clause.

5 files changed, 164 insertions, 25 deletions

diff --git a/ChangeLog b/ChangeLog
index a03acdb7..2cd09002 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+2011-10-01  Kaz Kylheku  <kaz@kylheku.com>
+
+	New directive: choose.
+
+	* match.c (choose_s, longest_k, shortest_k): New variables.
+	(match_line, match_files): Introduced choose directive.
+	(match_init): Initialize new variables.
+
+	* match.h (choose_s): Declared.
+
+	* parser.l (yybadtoken): Handle CHOOSE.
+	(CHOOSE): Clause added for returning this token.
+
+	* parser.y: Added #include "match.h".
+	(CHOOSE): New token symbol.
+	(choose_clause): New nonterminal symbol.
+	(clause): choose_clause added.
+	(all_clause, some_clause, none_clause,  maybe_clause,
+	cases_clause): Abstract syntax tree tweaked.
+	(choose_clause): New syntax.
+	(elem): Abstract syntax trees tweaked for many clauses.
+	New CHOOSE clauses.
+	(out_clause): New error case for choose_clause.
+
 2011-09-30  Kaz Kylheku  <kaz@kylheku.com>
 
 	* HACKING: Updated with debugging hints.
diff --git a/match.c b/match.c
index 0ed7daed..f11c11dc 100644
--- a/match.c
+++ b/match.c
@@ -48,6 +48,7 @@
 int output_produced;
 
 val mingap_k, maxgap_k, gap_k, times_k, lines_k, chars_k;
+val choose_s, longest_k, shortest_k;
 
 static void debugf(val fmt, ...)
 {
@@ -564,25 +565,54 @@ next_coll:
           }
         } else if (directive == all_s || directive == some_s ||
                    directive == none_s || directive == maybe_s ||
-                   directive == cases_s)
+                   directive == cases_s || directive == choose_s)
         {
-          val specs;
+          val specs = third(elem);
+          val plist = fourth(elem);
           val all_match = t;
           val some_match = nil;
           val max_pos = pos;
+          val choose_shortest = getplist(plist, shortest_k);
+          val choose_longest = getplist(plist, longest_k);
+          val choose_sym = or2(choose_longest, choose_shortest);
+          val choose_bindings = bindings, choose_pos = pos;
+          val choose_minmax = choose_longest ? num(-1) : num(NUM_MAX);
+          val iter;
+
+          if (choose_longest && choose_shortest)
+            sem_error(spec_lineno, lit("choose: both :shortest and :longest specified"), nao);
 
-          for (specs = rest(rest(elem)); specs != nil; specs = cdr(specs)) {
-            val nested_spec = first(specs);
+          if (directive == choose_s && !choose_sym)
+            sem_error(spec_lineno, lit("choose: criterion not specified"), nao);
+          for (iter = specs; iter != nil; iter = cdr(iter)) {
+            val nested_spec = first(iter);
             cons_bind (new_bindings, new_pos,
                        match_line(bindings, nested_spec, dataline, pos,
                                   spec_lineno, data_lineno, file));
             if (new_pos) {
-              bindings = new_bindings;
               some_match = t;
               if (gt(new_pos, max_pos))
                 max_pos = new_pos;
               if (directive == cases_s || directive == none_s)
                 break;
+              if (directive == choose_s) {
+                val binding = choose_sym ? assoc(new_bindings, choose_sym) : nil;
+                val value = cdr(binding);
+
+                if (value) {
+                  val len = length_str(value);
+
+                  if ((choose_longest && gt(len, choose_minmax)) ||
+                      (choose_shortest && lt(len, choose_minmax)))
+                  {
+                    choose_minmax = len;
+                    choose_bindings = new_bindings;
+                    choose_pos = new_pos;
+                  }
+                }
+              } else {
+                bindings = new_bindings;
+              }
             } else {
               all_match = nil;
               if (directive == all_s)
@@ -607,7 +637,12 @@ next_coll:
 
           /* No check for maybe, since it always succeeds. */
 
-          pos = max_pos;
+          if (directive == choose_s) {
+            bindings = choose_bindings;
+            pos = choose_pos;
+          } else {
+            pos = max_pos;
+          }
         } else if (consp(directive) || stringp(directive)) {
           cons_bind (find, len, search_str_tree(dataline, elem, pos, nil));
           val newpos;
@@ -1315,17 +1350,31 @@ repeat_spec_same_data:
           return nil;
         }
       } else if ((sym == some_s || sym == all_s || sym == none_s ||
-                 sym == maybe_s || sym == cases_s) && second(first_spec) != t)
+                  sym == maybe_s || sym == cases_s || sym == choose_s) && 
+                 second(first_spec) != t)
       {
-        val specs;
         val all_match = t;
         val some_match = nil;
         val max_line = zero;
         val max_data = nil;
+        val specs = second(first_spec);
+        val plist = third(first_spec);
+        val choose_shortest = getplist(plist, shortest_k);
+        val choose_longest = getplist(plist, longest_k);
+        val choose_sym = or2(choose_longest, choose_shortest);
+        val choose_bindings = bindings, choose_line = zero, choose_data = nil;
+        val choose_minmax = choose_longest ? num(-1) : num(NUM_MAX);
+        val iter;
+
+        if (choose_longest && choose_shortest)
+          sem_error(spec_linenum, lit("choose: both :shortest and :longest specified"), nao);
 
-        for (specs = rest(first_spec); specs != nil; specs = rest(specs))
+        if (sym == choose_s && !choose_sym)
+          sem_error(spec_linenum, lit("choose: criterion not specified"), nao);
+
+        for (iter = specs; iter != nil; iter = rest(iter))
         {
-          val nested_spec = first(specs);
+          val nested_spec = first(iter);
           val data_linenum = num(data_lineno);
 
           cons_bind (new_bindings, success,
@@ -1333,9 +1382,36 @@ repeat_spec_same_data:
                                  data, data_linenum));
 
           if (success) {
-            bindings = new_bindings;
             some_match = t;
 
+            if (sym == choose_s) {
+              val binding = choose_sym ? assoc(new_bindings, choose_sym) : nil;
+              val value = cdr(binding);
+
+              if (value) {
+                val len = length_str(value);
+
+                if ((choose_longest && gt(len, choose_minmax)) ||
+                    (choose_shortest && lt(len, choose_minmax)))
+                {
+                  choose_minmax = len;
+                  choose_bindings = new_bindings;
+
+                  if (success == t) {
+                    choose_data = t;
+                  } else {
+                    cons_bind (new_data, new_line, success);
+                    choose_data = new_data;
+                    choose_line = new_line;
+                  }
+                }
+              }
+            } else {
+              /* choose does not propagate bindings between clauses! */
+              bindings = new_bindings;
+            }
+
+
             if (success == t) {
               max_data = t;
             } else if (consp(success) && max_data != t) {
@@ -1371,7 +1447,15 @@ repeat_spec_same_data:
 
         /* No check for maybe, since it always succeeds. */
 
-        if (consp(max_data)) {
+        if (choose_sym) {
+          if (consp(choose_data)) {
+            data_lineno = c_num(choose_line);
+            data = choose_data;
+          } else if (choose_data == t) {
+            data = nil;
+          }
+          bindings = choose_bindings;
+        } else if (consp(max_data)) {
           data_lineno = c_num(max_line);
           data = max_data;
         } else if (max_data == t) {
@@ -2038,4 +2122,7 @@ void match_init(void)
   times_k = intern(lit("times"), keyword_package);
   lines_k = intern(lit("lines"), keyword_package);
   chars_k = intern(lit("chars"), keyword_package);
+  choose_s = intern(lit("choose"), user_package);
+  longest_k = intern(lit("longest"), keyword_package);
+  shortest_k = intern(lit("shortest"), keyword_package);
 }
diff --git a/match.h b/match.h
index f343e654..a6d30510 100644
--- a/match.h
+++ b/match.h
@@ -26,3 +26,4 @@
 
 void match_init(void);
 int extract(val spec, val filenames, val bindings);
+extern val choose_s;
diff --git a/parser.l b/parser.l
index a57c954b..b2b1e6b4 100644
--- a/parser.l
+++ b/parser.l
@@ -99,6 +99,7 @@ void yybadtoken(int tok, val context)
   case NONE:    problem = lit("\"none\""); break;
   case MAYBE:   problem = lit("\"maybe\""); break;
   case CASES:   problem = lit("\"cases\""); break;
+  case CHOOSE:  problem = lit("\"choose\""); break;
   case AND:     problem = lit("\"and\""); break;
   case OR:      problem = lit("\"or\""); break;
   case END:     problem = lit("\"end\""); break;
@@ -256,6 +257,12 @@ UONLY   {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
                                   return CASES;
                                 }
 
+<SPECIAL>\({WS}choose/{ID_END}  {
+                                  yy_push_state(NESTED);
+                                  return CHOOSE;
+                                }
+
+
 <SPECIAL>\({WS}and{WS}\)        {
                                   yy_pop_state();
                                   return AND;
diff --git a/parser.y b/parser.y
index cc66a96f..51f45042 100644
--- a/parser.y
+++ b/parser.y
@@ -36,6 +36,7 @@
 #include "lib.h"
 #include "regex.h"
 #include "utf8.h"
+#include "match.h"
 #include "parser.h"
 
 int yylex(void);
@@ -57,7 +58,8 @@ static val parsed_spec;
   cnum num;
 }
 
-%token <lexeme> TEXT IDENT KEYWORD ALL SOME NONE MAYBE CASES AND OR END COLLECT
+%token <lexeme> TEXT IDENT KEYWORD ALL SOME NONE MAYBE CASES CHOOSE
+%token <lexeme> AND OR END COLLECT
 %token <lexeme> UNTIL COLL OUTPUT REPEAT REP SINGLE FIRST LAST EMPTY DEFINE
 %token <lexeme> TRY CATCH FINALLY
 %token <num> NUMBER
@@ -65,7 +67,8 @@ static val parsed_spec;
 
 %type <val> spec clauses clauses_opt clause
 %type <val> all_clause some_clause none_clause maybe_clause
-%type <val> cases_clause collect_clause clause_parts additional_parts
+%type <val> cases_clause choose_clause collect_clause
+%type <val> clause_parts additional_parts
 %type <val> output_clause define_clause try_clause catch_clauses_opt
 %type <val> line elems_opt elems clause_parts_h additional_parts_h
 %type <val> elem var var_op
@@ -77,7 +80,7 @@ static val parsed_spec;
 %type <val> strlit chrlit quasilit quasi_items quasi_item litchars
 %type <chr> regchar
 %nonassoc LOW /* used for precedence assertion */
-%nonassoc ALL SOME NONE MAYBE CASES AND OR END COLLECT UNTIL COLL
+%nonassoc ALL SOME NONE MAYBE CASES CHOOSE AND OR END COLLECT UNTIL COLL
 %nonassoc OUTPUT REPEAT REP FIRST LAST EMPTY DEFINE
 %nonassoc '[' ']' '(' ')'
 %right IDENT TEXT NUMBER '{' '}'
@@ -108,6 +111,7 @@ clause : all_clause             { $$ = list(num(lineno - 1), $1, nao); }
        | none_clause            { $$ = list(num(lineno - 1), $1, nao); }
        | maybe_clause           { $$ = list(num(lineno - 1), $1, nao); }
        | cases_clause           { $$ = list(num(lineno - 1), $1, nao); }
+       | choose_clause          { $$ = list(num(lineno - 1), $1, nao); }
        | collect_clause         { $$ = list(num(lineno - 1), $1, nao); }
        | define_clause          { $$ = list(num(lineno - 1),
                                             define_transform($1), nao); }
@@ -118,7 +122,7 @@ clause : all_clause             { $$ = list(num(lineno - 1), $1, nao); }
                                   yyerror("repeat outside of output"); }
        ;
 
-all_clause : ALL newl clause_parts      { $$ = cons(all_s, $3); }
+all_clause : ALL newl clause_parts      { $$ = list(all_s, $3); }
            | ALL newl error             { $$ = nil;
                                           yybadtoken(yychar,
                                                      lit("all clause")); }
@@ -127,7 +131,7 @@ all_clause : ALL newl clause_parts      { $$ = cons(all_s, $3); }
 
            ;
 
-some_clause : SOME newl clause_parts    { $$ = cons(some_s, $3); }
+some_clause : SOME newl clause_parts    { $$ = list(some_s, $3); }
             | SOME newl error           { $$ = nil;
                                           yybadtoken(yychar,
                                                      lit("some clause")); }
@@ -135,7 +139,7 @@ some_clause : SOME newl clause_parts    { $$ = cons(some_s, $3); }
                                           yyerror("empty some clause"); }
             ;
 
-none_clause : NONE newl clause_parts    { $$ = cons(none_s, $3); }
+none_clause : NONE newl clause_parts    { $$ = list(none_s, $3); }
             | NONE newl error           { $$ = nil;
                                           yybadtoken(yychar,
                                                      lit("none clause")); }
@@ -143,7 +147,7 @@ none_clause : NONE newl clause_parts    { $$ = cons(none_s, $3); }
                                           yyerror("empty none clause"); }
             ;
 
-maybe_clause : MAYBE newl clause_parts  { $$ = cons(maybe_s, $3); }
+maybe_clause : MAYBE newl clause_parts  { $$ = list(maybe_s, $3); }
              | MAYBE newl error         { $$ = nil;
                                           yybadtoken(yychar,
                                                      lit("maybe clause")); }
@@ -151,7 +155,7 @@ maybe_clause : MAYBE newl clause_parts  { $$ = cons(maybe_s, $3); }
                                           yyerror("empty maybe clause"); }
              ;
 
-cases_clause : CASES newl clause_parts  { $$ = cons(cases_s, $3); }
+cases_clause : CASES newl clause_parts  { $$ = list(cases_s, $3); }
              | CASES newl error         { $$ = nil;
                                           yybadtoken(yychar,
                                                      lit("cases clause")); }
@@ -159,6 +163,17 @@ cases_clause : CASES newl clause_parts  { $$ = cons(cases_s, $3); }
                                           yyerror("empty cases clause"); }
              ;
 
+choose_clause : CHOOSE exprs_opt ')'
+                newl clause_parts       { $$ = list(choose_s, $5, $2); }
+              | CHOOSE exprs_opt ')'
+                newl error              { $$ = nil;
+                                          yybadtoken(yychar,
+                                                     lit("choose clause")); }
+              | CHOOSE exprs_opt ')'
+                newl END newl           { $$ = nil;
+                                          yyerror("empty choose clause"); }
+              ;
+
 collect_clause : COLLECT exprs_opt ')' newl
                  clauses END newl                { $$ = list(collect_s,
                                                              $5, nil, $2,
@@ -207,16 +222,19 @@ elem : TEXT                     { $$ = string_own($1); }
        UNTIL elems END          { $$ = list(coll_s, $4, $6, $2, nao); }
      | COLL error               { $$ = nil;
                                   yybadtoken(yychar, lit("coll clause")); }
-     | ALL clause_parts_h       { $$ = cons(all_s, cons(t, $2)); }
+     | ALL clause_parts_h       { $$ = list(all_s, t, $2); }
      | ALL END                  { yyerror("empty all clause"); }
-     | SOME clause_parts_h      { $$ = cons(some_s, cons(t, $2)); }
+     | SOME clause_parts_h      { $$ = list(some_s, t, $2); }
      | SOME END                 { yyerror("empty some clause"); }
-     | NONE clause_parts_h      { $$ = cons(none_s, cons(t, $2)); }
+     | NONE clause_parts_h      { $$ = list(none_s, t, $2); }
      | NONE END                 { yyerror("empty none clause"); }
-     | MAYBE clause_parts_h     { $$ = cons(maybe_s, cons(t, $2)); }
+     | MAYBE clause_parts_h     { $$ = list(maybe_s, t, $2); }
      | MAYBE END                { yyerror("empty maybe clause"); }
-     | CASES clause_parts_h     { $$ = cons(cases_s, cons(t, $2)); }
+     | CASES clause_parts_h     { $$ = list(cases_s, t, $2); }
      | CASES END                { yyerror("empty cases clause"); }
+     | CHOOSE exprs_opt ')'
+       clause_parts_h           { $$ = list(choose_s, t, $4, $2); }
+     | CHOOSE exprs_opt ')' END { yyerror("empty cases clause"); }
      ;
 
 clause_parts_h : elems additional_parts_h { $$ = cons($1, $2); }
@@ -339,6 +357,8 @@ out_clause : repeat_clause              { $$ = list(num(lineno - 1), $1, nao); }
                                           yyerror("match clause in output"); }
            | cases_clause               { $$ = nil;
                                           yyerror("match clause in output"); }
+           | choose_clause              { $$ = nil;
+                                          yyerror("choose clause in output"); }
            | collect_clause             { $$ = nil;
                                           yyerror("match clause in output"); }
            | define_clause              { $$ = nil;