From 13a861377a55a77d2ad2072fd700b720aa71d4d0 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 31 Mar 2012 16:00:52 -0700 Subject: 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. --- ChangeLog | 22 ++++++++++++++++++++++ match.c | 43 ++++++++++++++++++++++++++++++++++--------- txr.1 | 30 ++++++++++++++++++++++++++++++ unwind.c | 8 +++++++- unwind.h | 8 +++++++- 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 + + 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 * 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, ...); -- cgit v1.2.3