Support horizontal @(block), phase 1.

Unresolved issue: horizontal @(accept) terminating in a
vertical @(block) or horizontal @(block) in a different line,
or vertical @(accept) caught in horizontal context.

* match.c (h_block, h_accept_fail): New functions.
(dir_tables_init): Register horizontal @(block),
@(accept) and @(fail).

* parser.y (elem): Support BLOCK syntax.

2 files changed, 50 insertions, 0 deletions

diff --git a/match.c b/match.c
index 46ca1559..25133444 100644
--- a/match.c
+++ b/match.c
@@ -810,6 +810,48 @@ static val h_skip(match_line_ctx *c)
   return nil;
 }
 
+static val h_block(match_line_ctx *c)
+{
+  val elem = first(c->specline);
+  val name = second(elem);
+  val specs = car(third(elem));
+
+  {
+    uw_block_begin(name, result);
+    result = match_line(ml_specline(*c, specs));
+    uw_block_end;
+    if (result) {
+      cons_bind (bindings, new_pos, result);
+      c->bindings = bindings;
+      c->pos = minus(new_pos, c->base);
+      return next_spec_k;
+    }
+    return nil;
+  }
+}
+
+static val h_accept_fail(match_line_ctx *c)
+{
+  val elem = first(c->specline);
+  val sym = first(elem);
+  val target = second(elem);
+
+  uw_block_return_proto(target,
+                        if2(sym == accept_s,
+                            cons(c->bindings, c->pos)),
+                        sym);
+
+  /* TODO: uw_block_return could just throw this */
+  if (target)
+    sem_error(elem, lit("~a: no block named ~a in scope"),
+              sym, target, nao);
+  else
+    sem_error(elem, lit("~a: no anonymous block in scope"),
+              sym, nao);
+  return nil;
+}
+
+
 static val h_coll(match_line_ctx *c)
 {
   val elem = first(c->specline);
@@ -4561,6 +4603,9 @@ static void dir_tables_init(void)
   sethash(h_directive_table, text_s, cptr(coerce(mem_t *, h_text)));
   sethash(h_directive_table, var_s, cptr(coerce(mem_t *, h_var)));
   sethash(h_directive_table, skip_s, cptr(coerce(mem_t *, h_skip)));
+  sethash(h_directive_table, block_s, cptr(coerce(mem_t *, h_block)));
+  sethash(h_directive_table, accept_s, cptr(coerce(mem_t *, h_accept_fail)));
+  sethash(h_directive_table, fail_s, cptr(coerce(mem_t *, h_accept_fail)));
   sethash(h_directive_table, coll_s, cptr(coerce(mem_t *, h_coll)));
   sethash(h_directive_table, rep_s, cptr(coerce(mem_t *, h_coll)));
   sethash(h_directive_table, flatten_s, cptr(coerce(mem_t *, hv_trampoline)));
diff --git a/parser.y b/parser.y
index 5a2ef76f..14bad936 100644
--- a/parser.y
+++ b/parser.y
@@ -486,10 +486,15 @@ elem : texts                    { $$ = rlcp(cons(text_s, $1), $1);
                                             args, nao);
                                   rl($$, num($1));
                                   rl($6, car($5)); }
+     | BLOCK exprs_opt ')' elems END { $$ = list(block_s, car($2),
+                                                 cons($4, nil), nao);
+                                       rl($$, num($1)); }
      | COLL error               { $$ = nil;
                                   yybadtok(yychar, lit("coll clause")); }
      | REP error               { $$ = nil;
                                  yybadtok(yychar, lit("rep clause")); }
+     | BLOCK error             { $$ = nil;
+                                 yybadtok(yychar, lit("rep clause")); }
      | ALL clause_parts_h       { $$ = rl(list(all_s, t, $2, nao), num($1)); }
      | SOME exprs_opt ')'
        clause_parts_h           { $$ = rl(list(some_s, t, $4, $2, nao), num($1)); }