Task #11598.

* match.c (resolve_k): New keyword symbol variable.
(h_parallel, v_parallel): Implement :resolve keyword in @(some)
directive.
(syms_init): New symbol variable initialized.

* parser.l: Allow (some) to have argument material.

* parser.y (some_clause, elem): SOME syntax adjusted.

* txr.1: Documented new :resolve keyword in @(some).

5 files changed, 124 insertions, 10 deletions

diff --git a/ChangeLog b/ChangeLog
index 6035c971..3594ba75 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,20 @@
 2011-11-17  Kaz Kylheku  <kaz@kylheku.com>
 
+	Task #11598.
+
+	* match.c (resolve_k): New keyword symbol variable.
+	(h_parallel, v_parallel): Implement :resolve keyword in @(some)
+	directive.
+	(syms_init): New symbol variable initialized.
+
+	* parser.l: Allow (some) to have argument material.
+
+	* parser.y (some_clause, elem): SOME syntax adjusted.
+
+	* txr.1: Documented new :resolve keyword in @(some).
+
+2011-11-17  Kaz Kylheku  <kaz@kylheku.com>
+
 	Adding quote and unquote read syntax to list forms, resembling
 	Lisp. The difference is that splice is spelled ,* because @
 	already means something, and that there is only one quote operator.
diff --git a/match.c b/match.c
index a4efdf4b..f5d23760 100644
--- a/match.c
+++ b/match.c
@@ -56,7 +56,7 @@ val mingap_k, maxgap_k, gap_k, mintimes_k, maxtimes_k, times_k;
 val lines_k, chars_k;
 val choose_s, gather_s;
 val longest_k, shortest_k, greedy_k;
-val vars_k;
+val vars_k, resolve_k;
 val append_k, into_k, var_k, list_k, string_k, env_k;
 
 val filter_s;
@@ -843,6 +843,9 @@ static val h_parallel(match_line_ctx c, match_line_ctx *cout)
   val choose_sym = or2(choose_longest, choose_shortest);
   val choose_bindings = c.bindings, choose_pos = c.pos;
   val choose_minmax = choose_longest ? num(-1) : num(NUM_MAX);
+  val resolve = getplist(plist, resolve_k);
+  val resolve_ub_vars = nil;
+  val resolve_bindings = nil;
   val iter;
 
   if (choose_longest && choose_shortest)
@@ -850,6 +853,16 @@ static val h_parallel(match_line_ctx c, match_line_ctx *cout)
 
   if (directive == choose_s && !choose_sym)
     sem_error(elem, lit("choose: criterion not specified"), nao);
+
+
+  if (resolve) {
+    for (iter = resolve; iter; iter = cdr(iter)) {
+      val var = car(iter);
+      if (!assoc(c.bindings, var))
+        push(var, &resolve_ub_vars);
+    }
+  }
+
   for (iter = specs; iter != nil; iter = cdr(iter)) {
     val nested_spec = first(iter);
     cons_bind (new_bindings, new_pos,
@@ -857,8 +870,23 @@ static val h_parallel(match_line_ctx c, match_line_ctx *cout)
 
     if (new_pos) {
       some_match = t;
+
+      if (resolve_ub_vars) {
+        val uiter;
+        for (uiter = resolve_ub_vars; uiter; uiter = cdr(uiter)) {
+          val ubvar = car(uiter);
+          val exists = assoc(new_bindings, ubvar);
+
+          if (exists)
+            resolve_bindings = acons_new(resolve_bindings, ubvar, cdr(exists));
+        }
+
+        new_bindings = alist_remove(new_bindings, resolve_ub_vars);
+      }
+
       if (gt(new_pos, max_pos))
         max_pos = new_pos;
+
       if (directive == choose_s) {
         val binding = choose_sym ? assoc(new_bindings, choose_sym) : nil;
         val value = cdr(binding);
@@ -903,6 +931,10 @@ static val h_parallel(match_line_ctx c, match_line_ctx *cout)
 
   /* No check for maybe, since it always succeeds. */
 
+ 
+  if (resolve_bindings)
+    c.bindings = nappend2(resolve_bindings, c.bindings);
+
   if (directive == choose_s) {
     c.bindings = choose_bindings;
     c.pos = choose_pos;
@@ -1987,6 +2019,9 @@ static val v_parallel(match_files_ctx *c)
     val choose_sym = or2(choose_longest, choose_shortest);
     val choose_bindings = c->bindings, choose_line = zero, choose_data = nil;
     val choose_minmax = choose_longest ? num(-1) : num(NUM_MAX);
+    val resolve = getplist(plist, resolve_k);
+    val resolve_ub_vars = nil;
+    val resolve_bindings = nil;
     val iter;
 
     if (choose_longest && choose_shortest)
@@ -1995,6 +2030,14 @@ static val v_parallel(match_files_ctx *c)
     if (sym == choose_s && !choose_sym)
       sem_error(specline, lit("choose: criterion not specified"), nao);
 
+    if (resolve) {
+      for (iter = resolve; iter; iter = cdr(iter)) {
+        val var = car(iter);
+        if (!assoc(c->bindings, var))
+          push(var, &resolve_ub_vars);
+      }
+    }
+
     for (iter = specs; iter != nil; iter = rest(iter))
     {
       val nested_spec = first(iter);
@@ -2004,6 +2047,19 @@ static val v_parallel(match_files_ctx *c)
       if (success) {
         some_match = t;
 
+        if (resolve_ub_vars) {
+          val uiter;
+          for (uiter = resolve_ub_vars; uiter; uiter = cdr(uiter)) {
+            val ubvar = car(uiter);
+            val exists = assoc(new_bindings, ubvar);
+
+            if (exists)
+              resolve_bindings = acons_new(resolve_bindings, ubvar, cdr(exists));
+          }
+
+          new_bindings = alist_remove(new_bindings, resolve_ub_vars);
+        }
+
         if (sym == choose_s) {
           val binding = choose_sym ? assoc(new_bindings, choose_sym) : nil;
           val value = cdr(binding);
@@ -2067,6 +2123,9 @@ static val v_parallel(match_files_ctx *c)
 
     /* No check for maybe, since it always succeeds. */
 
+    if (resolve_bindings)
+      c->bindings = nappend2(resolve_bindings, c->bindings);
+
     if (choose_sym) {
       if (consp(choose_data)) {
         c->data_lineno = choose_line;
@@ -3178,6 +3237,7 @@ static void syms_init(void)
   shortest_k = intern(lit("shortest"), keyword_package);
   greedy_k = intern(lit("greedy"), keyword_package);
   vars_k = intern(lit("vars"), keyword_package);
+  resolve_k = intern(lit("resolve"), keyword_package);
   append_k = intern(lit("append"), keyword_package);
   into_k = intern(lit("into"), keyword_package);
   var_k = intern(lit("var"), keyword_package);
diff --git a/parser.l b/parser.l
index ccc8cf05..d6be1239 100644
--- a/parser.l
+++ b/parser.l
@@ -218,8 +218,8 @@ UONLY   {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
                                   return ALL;
                                 }
 
-<SPECIAL>\({WS}some{WS}\)       {
-                                  yy_pop_state();
+<SPECIAL>\({WS}some/{ID_END}    {
+                                  yy_push_state(NESTED);
                                   yylval.lineno = lineno;
                                   return SOME;
                                 }
diff --git a/parser.y b/parser.y
index e80c7756..43e03ed8 100644
--- a/parser.y
+++ b/parser.y
@@ -150,12 +150,16 @@ all_clause : ALL newl clause_parts      { $$ = list(all_s, $3, nao);
 
            ;
 
-some_clause : SOME newl clause_parts    { $$ = list(some_s, $3, nao);
+some_clause : SOME exprs_opt ')'
+              newl clause_parts         { $$ = list(some_s, $5, $2, nao);
                                           rl($$, num($1)); }
-            | SOME newl error           { $$ = nil;
+            | SOME exprs_opt ')'
+              newl error           
+                                        { $$ = nil;
                                           yybadtoken(yychar,
                                                      lit("some clause")); }
-            | SOME newl END newl       { $$ = nil;
+            | SOME exprs_opt ')'
+              newl END newl             { $$ = nil;
                                           yyerror("empty some clause"); }
             ;
 
@@ -289,8 +293,9 @@ elem : TEXT                     { $$ = rl(string_own($1), num(lineno)); }
                                   yybadtoken(yychar, lit("coll clause")); }
      | ALL clause_parts_h       { $$ = rl(list(all_s, t, $2, nao), num($1)); }
      | ALL END                  { yyerror("empty all clause"); }
-     | SOME clause_parts_h      { $$ = rl(list(some_s, t, $2, nao), num($1)); }
-     | SOME END                 { yyerror("empty some clause"); }
+     | SOME exprs_opt ')'
+       clause_parts_h           { $$ = rl(list(some_s, t, $4, $2, nao), num($1)); }
+     | SOME exprs_opt ')' END   { yyerror("empty some clause"); }
      | NONE clause_parts_h      { $$ = rl(list(none_s, t, $2, nao), num($1)); }
      | NONE END                 { yyerror("empty none clause"); }
      | MAYBE clause_parts_h     { $$ = rl(list(maybe_s, t, $2, nao), num($1)); }
diff --git a/txr.1 b/txr.1
index f8197650..33f21df7 100644
--- a/txr.1
+++ b/txr.1
@@ -1657,13 +1657,47 @@ evaluated. Bindings extracted by a successful clause are visible the clauses
 which follow, and if the directive succeeds, all of the combined bindings
 emerge.
 
-.IP @(some)
+.IP @(some [ :resolve (vars ...) ])
 Each of the clauses is matched at the current position. If any of the clauses
 succeed, the directive succeeds, retaining the bindings accumulated by the
 successully matching clauses.  Evaluation does not stop on the first successful
 clause. Bindings extracted by a successful clause are visible to the clauses
 which follow.
 
+The :resolve parameter is for situations when the @(some) directive has
+multiple clauses that need to bind some common variables to different
+values: for instance, output parameters in functions. Resolve takes
+a list of variable name symbols as an argument.  This is called the
+resolve set. If the clauses of @(some) bind variables in the resolve
+set, those bindings are not visible to later clauses.  However, those
+bindings do emerge out of the @(some) directive as a whole.
+This creates a conflict: what if two or more clauses introduce
+non-matching bindings for a variable in the resolve set?
+This is why it is called the resolve set: conflicts for variables in the
+resolve set are automatically resolved in favor of later directives.
+
+Example:
+
+  @(some :resolve (x))
+  @  (bind a "a")
+  @  (bind x "x1")
+  @(or)
+  @  (bind b "b")
+  @  (bind x "x2")
+  @(end)
+
+Here, the two clauses both introduce a binding for x.  Without the :resolve
+parameter, this would mean that the second clause fails, because x comes in
+with the value "x1", which does not bind with "x2".  But because x is placed
+into the resolve set, the second clause does not see the "x1" binding. Both
+clauses establish their bindings independently creating a conflict over x.
+The conflict is resolved in favor of the second clause, and so the bindings
+which emerge from the directive are:
+
+  a="a"
+  b="b"
+  x="x2"
+
 .IP @(none)
 Each of the clauses is matched at the current position. The
 directive succeeds only if all of the clauses fail. If
@@ -1685,7 +1719,7 @@ collected from that clause are retained. Any remaining clauses
 after that one are not processed. If no clause matches, the
 directive fails, and produces no bindings.
 
-.IP @(choose { :longest <var> | :shortest <var> })
+.IP @(choose [ :longest <var> | :shortest <var> ])
 Each of the clauses is matched at the current position in order. In this
 construct, bindings established an earlier clause are not visible to later
 clauses.  Although any or all of the clauses can potentially match, the clause