bugfix: integrate finally clause with accept.

The test case for this issue is:

  @(next :list '#"the quick brown fox jumped")
  @(block b)
  @(try)
  @the
  @(accept b)
  @(finally)
  @quick
  @(end)
  @(end)

Inside the try-protected clause, we bind the variable the to
the string "the". Then we initiate an accept whose exit point
is the block b. There are two problems: the finally clause
executes against the input stream beginning with "the", even
though "the" was consumed in the protected block.  Secondly,
the binding captures by finally is thrown away; the accept
control transfer continues and only one variable emerges from
the block: the variable the.

In this patch we obtain a different behavior. The processing
of the finally clause detects that an accept transfer is
passing through.

The clause is executed against the input stream that is being
communicated by the accept, in this case the stream which
beings with the second line "quick", so the quick variable
gets bound to this string.

Secondly, the bindings being communicated by the accept are
hijacked and replaced with the new environment captured by the
finally clause. Thus, in this case, the quick variable emerges
out of the block.

Lastly, if the finally block fails to match, the accept
transfer is converted to a @(fail) transfer and continues to
the block.

* match.c (v_take_accept): New static function.
(v_block); Use v_take_accept function to update the
match_files_ctx state from a caught accept. That is
to say, the code to do this moves into that function,
and is just called. This way we can share that logic with
the finally processing in v_try.
(v_try): Detect an accept transfer by checking the
exit point. If one is going on, then accept the input and
bindings into the current context and process the clause
in that context. Afterward, update the accept result
object with the new position and bindings or convert to
a failure.

1 files changed, 40 insertions, 20 deletions

diff --git a/match.c b/match.c
index 1dafcbbe..6414b0ef 100644
--- a/match.c
+++ b/match.c
@@ -2483,6 +2483,30 @@ static val maybe_next(match_files_ctx *c, val match_result)
   return next_spec_k;
 }
 
+static void v_take_accept(match_files_ctx *c, val specline, val result)
+{
+  val bindings = vecref(result, zero);
+  val vpos = vecref(result, one);
+  val hpos = vecref(result, two);
+  c->bindings = bindings;
+
+  if (hpos && car(vpos) == c->data) {
+    debuglf(specline, lit("accept from horiz. context in same line: advancing"),
+            nao);
+    c->data = cdr(c->data);
+  } else if (hpos) {
+    debuglf(specline, lit("accept from horiz. context in diff line"), nao);
+  } else {
+    debuglf(specline, lit("accept from vertical context"), nao);
+    if (vpos == t) {
+      c->data = nil;
+    } else {
+      c->data = car(vpos);
+      c->data_lineno = cdr(vpos);
+    }
+  }
+}
+
 static val v_block(match_files_ctx *c)
 {
   spec_bind (specline, first_spec, c->spec);
@@ -2501,26 +2525,7 @@ static val v_block(match_files_ctx *c)
 
     if (vectorp(result))
     {
-      val bindings = vecref(result, zero);
-      val vpos = vecref(result, one);
-      val hpos = vecref(result, two);
-      c->bindings = bindings;
-
-      if (hpos && car(vpos) == c->data) {
-        debuglf(specline, lit("accept from horiz. context in same line: advancing"),
-                nao);
-        c->data = cdr(c->data);
-      } else if (hpos) {
-        debuglf(specline, lit("accept from horiz. context in diff line"), nao);
-      } else {
-        debuglf(specline, lit("accept from vertical context"), nao);
-        if (vpos == t) {
-          c->data = nil;
-        } else {
-          c->data = car(vpos);
-          c->data_lineno = cdr(vpos);
-        }
-      }
+      v_take_accept(c, specline, result);
       return next_spec_k;
     }
 
@@ -3775,6 +3780,9 @@ static val v_try(match_files_ctx *c)
 
     uw_unwind {
       val iter;
+      uw_frame_t *ex = uw_current_exit_point();
+      int acc_intercept = (ex && ex->uw.type == UW_BLOCK &&
+                           ex->bl.protocol == accept_s);
 
       /* result may be t, from catch above. */
       if (consp(result)) {
@@ -3801,6 +3809,9 @@ static val v_try(match_files_ctx *c)
         }
       }
 
+      if (finally_clause && acc_intercept)
+        v_take_accept(c, specline, ex->bl.result);
+
       if (finally_clause) {
         cons_bind (new_bindings, success,
                    match_files(mf_spec(*c, finally_clause)));
@@ -3814,6 +3825,15 @@ static val v_try(match_files_ctx *c)
           } else {
             c->data = nil;
           }
+
+          if (acc_intercept && finally_clause) {
+            ex->bl.result = if2(success,
+                                vec(c->bindings,
+                                    if3(c->data, cons(c->data, c->data_lineno), t),
+                                    nil,
+                                    nao));
+            ex->bl.protocol = if3(success, accept_s, fail_s);
+          }
         }
       }
     }