If one of the blocks which are subordinate to a @(trailer)

happen to request a successful termination by invoking @(accept)
the position must not advance into the trailer material.

* match.c (v_trailer): Added an unwind protect which
detects that an accept is taking place and adjusts the return value to
restrict the input position at the point given to trailer.
(accept_fail): Use uw_block_return_proto instead of uw_block_return
and pass the symbol as the protocol identifier.

* unwind.c (uw_current_exit_point): New function.
(uw_block_return): Function renamed to uw_block_return_proto;
takes new parameter which is stored in the block structure.

* unwind.h (struct uw_block): New member, protocol.
(uw_block_return): Becomes an inline wrapper for uw_block_return_proto.
(uw_block_return_proto, uw_current_exit_point): Declared.

* txr.1: Interaction between @(trailer) and @(accept) documented.

5 files changed, 100 insertions, 11 deletions

diff --git a/ChangeLog b/ChangeLog
index 917475c7..dd83bed4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,25 @@
+2012-03-31  Kaz Kylheku  <kaz@kylheku.com>
+
+	If one of the blocks which are subordinate to a @(trailer)
+	happen to request a successful termination by invoking @(accept)
+	the position must not advance into the trailer material.
+
+	* match.c (v_trailer): Added an unwind protect which
+	detects that an accept is taking place and adjusts the return value to
+	restrict the input position at the point given to trailer.
+	(accept_fail): Use uw_block_return_proto instead of uw_block_return
+	and pass the symbol as the protocol identifier.
+
+	* unwind.c (uw_current_exit_point): New function.
+	(uw_block_return): Function renamed to uw_block_return_proto;
+	takes new parameter which is stored in the block structure.
+
+	* unwind.h (struct uw_block): New member, protocol.
+	(uw_block_return): Becomes an inline wrapper for uw_block_return_proto.
+	(uw_block_return_proto, uw_current_exit_point): Declared.
+
+	* txr.1: Interaction between @(trailer) and @(accept) documented.
+
 2012-03-30  Kaz Kylheku  <kaz@kylheku.com>
 
 	* match.c (h_var): Disallow the variable named by the symbol t
diff --git a/match.c b/match.c
index 36b5c9a2..39a6980d 100644
--- a/match.c
+++ b/match.c
@@ -2060,11 +2060,33 @@ static val v_trailer(match_files_ctx *c)
 
   c->spec = rest(c->spec);
 
-  if (!c->spec)  {
-    return cons(c->bindings, cons(c->data, c->data_lineno));
-  } else {
-    cons_bind (new_bindings, success, match_files(*c));
-    return success ? cons(new_bindings, cons(c->data, c->data_lineno)) : nil;
+  {
+    val result = nil;
+
+    uw_simple_catch_begin;
+
+    if (!c->spec)  {
+      result = cons(c->bindings, cons(c->data, c->data_lineno));
+    } else {
+      cons_bind (new_bindings, success, match_files(*c));
+      result = if2(success, cons(new_bindings, cons(c->data, c->data_lineno)));
+    }
+
+    /*
+     * Intercept an block return initiated by accept, and rewrite
+     * the data extent part of the result. If we don't do this;
+     * then an accept can emanate out of the trailer block and cause
+     * the data position to advance into the matched material.
+     */
+    uw_unwind {
+      uw_frame_t *ex = uw_current_exit_point();
+      if (ex->uw.type == UW_BLOCK && ex->bl.protocol == accept_s)
+        rplacd(ex->bl.result, cons(c->data, c->data_lineno));
+    }
+
+    uw_catch_end;
+
+    return result;
   }
 }
 
@@ -2170,10 +2192,13 @@ static val v_accept_fail(match_files_ctx *c)
   if (rest(specline))
     sem_error(specline, lit("unexpected material after ~a"), sym, nao);
 
-  uw_block_return(target,
-                  if2(sym == accept_s,
-                      cons(c->bindings,
-                           if3(c->data, cons(c->data, c->data_lineno), t))));
+  uw_block_return_proto(target,
+                        if2(sym == accept_s,
+                            cons(c->bindings,
+                                 if3(c->data, cons(c->data, c->data_lineno),
+                                     t))),
+                        sym);
+
   /* TODO: uw_block_return could just throw this */
   if (target)
     sem_error(specline, lit("~a: no block named ~a in scope"),
diff --git a/txr.1 b/txr.1
index 533bc464..89792af8 100644
--- a/txr.1
+++ b/txr.1
@@ -3040,6 +3040,36 @@ The second clause grabs four lines, which is the longest match.
 And so, the next line of input available for matching is 5, which goes
 to the @second variable.
 
+.SS Interaction between Trailer and Accept Directives
+
+If one of the clauses which follow a @(trailer) request a successful
+termination to an outer block via @(accept), then @(trailer) intercepts
+the transfer and adjusts the data extent to the position that it was given.
+
+Example:
+
+  Query:        @(block)
+                @(trailer)
+                @line1
+                @line2
+                @(accept)
+                @(end)
+                @line3
+
+  Data:         1
+                2
+                3
+
+  Output:       line1="1"
+                line2="2"
+                line3="1"
+
+The variable line3 is bound to 1 because although the @(accept) yields a data
+position which is advanced to the third line, this is intercepted by @(trailer)
+and adjusted back to the first line.
+
+Directives other than @(trailer) have no such special interaction with accept.
+
 .SH FUNCTIONS
 
 .SS Introduction
diff --git a/unwind.c b/unwind.c
index 34ef821a..a51ef98f 100644
--- a/unwind.c
+++ b/unwind.c
@@ -192,7 +192,12 @@ uw_frame_t *uw_current_frame(void)
   return uw_stack;
 }
 
-val uw_block_return(val tag, val result)
+uw_frame_t *uw_current_exit_point(void)
+{
+  return uw_exit_point;
+}
+
+val uw_block_return_proto(val tag, val result, val protocol)
 {
   uw_frame_t *ex;
 
@@ -205,6 +210,7 @@ val uw_block_return(val tag, val result)
     return nil;
 
   ex->bl.result = result;
+  ex->bl.protocol = protocol;
   uw_exit_point = ex;
   uw_unwind_to_exit_point();
   abort();
diff --git a/unwind.h b/unwind.h
index c963b1ff..db8a53fa 100644
--- a/unwind.h
+++ b/unwind.h
@@ -43,6 +43,7 @@ struct uw_block {
   uw_frtype_t type;
   val tag;
   val result;
+  val protocol;
   jmp_buf jb;
 };
 
@@ -91,7 +92,11 @@ val uw_get_func(val sym);
 val uw_set_func(val sym, val value);
 val uw_get_match_context(void);
 val uw_set_match_context(val context);
-val uw_block_return(val tag, val result);
+val uw_block_return_proto(val tag, val result, val protocol);
+INLINE val uw_block_return(val tag, val result)
+{
+   return uw_block_return_proto(tag, result, nil);
+}
 void uw_push_catch(uw_frame_t *, val matches);
 noreturn val uw_throw(val sym, val exception);
 noreturn val uw_throwf(val sym, val fmt, ...);
@@ -106,6 +111,7 @@ void uw_push_debug(uw_frame_t *, val func, val args,
                    val line, val chr);
 void uw_pop_frame(uw_frame_t *);
 uw_frame_t *uw_current_frame(void);
+uw_frame_t *uw_current_exit_point(void);
 void uw_init(void);
 
 noreturn val type_mismatch(val, ...);