txr: allow variable to span vertical function.

* match.c (v_var_compat, v_var): New static functions.
(match_files): No longer recognize v_var specially; it is now
handled via vertical table.
(dir_tables_init): Register a vertical sys:var directive also
via v_var function.
(match_compat_fixup): New function.

* txr.c (compat): Call match_compat_fixup.

* tests/010/span-var.txr: New file.

* txr.1: Documented.

5 files changed, 95 insertions, 7 deletions

diff --git a/match.c b/match.c
index de7e6186..1f10ab78 100644
--- a/match.c
+++ b/match.c
@@ -2316,6 +2316,39 @@ typedef val (*v_match_func)(match_files_ctx *cout);
   val specline = first(spec);                           \
   val first_spec = first(specline)
 
+static val v_var_compat(match_files_ctx *c)
+{
+  (void) c;
+  return decline_k;
+}
+
+static val v_var(match_files_ctx *c)
+{
+  spec_bind (specline, var_elem, c->spec);
+
+  if (!rest(specline)) {
+    val varsym  = second(var_elem);
+    val modifiers = third(var_elem);
+    val modifier = first(modifiers);
+
+    if (consp(modifier)) {
+      match_files_ctx fc = mf_spec(*c, cons(modifiers, nil));
+      val data = c->data;
+
+      val ret = v_fun(&fc);
+
+      if (ret == next_spec_k) {
+        c->data = fc.data;
+        c->bindings = acons(varsym, ldiff(data, fc.data), fc.bindings);
+      }
+
+      return ret;
+    }
+  }
+
+  return decline_k;
+}
+
 static val v_skip(match_files_ctx *c)
 {
   val self = lit("skip");
@@ -4662,11 +4695,11 @@ repeat_spec_same_data:
     if (consp(first_spec) && !rest(specline)) {
       val lfe_save = set_last_form_evaled(first_spec);
       val sym = first(first_spec);
-      val entry = gethash(v_directive_table, sym);
+      val entry;
 
-      if (sym == var_s || sym == text_s) {
-        /* It's actually a var or text; go to horizontal processing below */
-      } else if (entry) {
+      if (sym == text_s) {
+        /* It's literal text; go to horizontal processing below */
+      } else if ((entry = gethash(v_directive_table, sym))) {
         v_match_func vmf = coerce(v_match_func, cptr_get(entry));
         val result = vmf(&c);
 
@@ -4985,7 +5018,7 @@ static void dir_tables_init(void)
   sethash(v_directive_table, data_s, cptr(coerce(mem_t *, v_data)));
   sethash(v_directive_table, name_s, cptr(coerce(mem_t *, v_name)));
   sethash(v_directive_table, call_s, cptr(coerce(mem_t *, v_call)));
-
+  sethash(v_directive_table, var_s, cptr(coerce(mem_t *, v_var)));
   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)));
@@ -5062,3 +5095,9 @@ void match_init(void)
   syms_init();
   dir_tables_init();
 }
+
+void match_compat_fixup(int compat_ver)
+{
+  if (compat_ver <= 272)
+    sethash(v_directive_table, var_s, cptr(coerce(mem_t *, v_var_compat)));
+}
diff --git a/match.h b/match.h
index 95667158..3314345b 100644
--- a/match.h
+++ b/match.h
@@ -40,3 +40,4 @@ void match_reg_var(val sym);
 void match_reg_params(val params);
 void match_reg_elem(val elem);
 void match_init(void);
+void match_compat_fixup(int compat_ver);
diff --git a/tests/010/span-var.txr b/tests/010/span-var.txr
new file mode 100644
index 00000000..5f5faa6c
--- /dev/null
+++ b/tests/010/span-var.txr
@@ -0,0 +1,15 @@
+@(define fun (x y))
+@(bind x "x")
+@y
+@y
+@y
+@(end)
+@(next :list '("a" "a" "a" "b" "c"))
+@{z (fun x "a")}
+@(require (equal x "x"))
+@(require (equal z '("a" "a" "a")))
+@(define fun2 (x y))@(bind x "x")@y@(end)
+@(next :string "ab")
+@{w (fun2 x "a")}@y
+@(require (equal w "a"))
+@(require (equal y "b"))
diff --git a/txr.1 b/txr.1
index 363c6977..794bff7f 100644
--- a/txr.1
+++ b/txr.1
@@ -2494,7 +2494,7 @@ In the
 .mono
 .meti >> ( fun >> [ args ...])
 .onom
-form, the match extends over characters which
+form, the match extends over lines or characters which
 are matched by the call to the function, if the call
 succeeds. Thus
 .code "@{x (y z w)}"
@@ -2505,7 +2505,23 @@ text skipped over by
 .code "@(y z w)"
 is also bound to the variable
 .codn x .
-See Functions below.
+Except in one special case, the matching takes place horizontally within the
+current line, and the spanned range of text is treated as a string.
+The exception is that if the
+.mono
+.meti >> @{ bident >> ( fun >> [ args ...])}
+.onom
+appears as the only element of a line, and
+.meta fun
+has a binding as a vertical function, then the function is invoked in
+the same manner as it would be by the
+.mono
+.meti >> @( fun >> [ args ...])
+.onom
+syntax. Then the variable indicated by
+.meta bident
+is bound to the list of lines matched by the function call.
+Pattern functions are described in the Functions section below.
 
 In the
 .meta number
@@ -86652,6 +86668,21 @@ of these version values, the described behaviors are provided if
 is given an argument which is equal or lower. For instance
 .code "-C 103"
 selects the behaviors described below for version 105, but not those for 102.
+.IP 272
+\*(TX 273 introduce a new feature into the pattern language: a pattern variable
+of the form
+.mono
+.meti >> @{ bident >> ( fun >> [ args ...])}
+.onom
+matches multiple lines, if it appears as the only element of a query line,
+and if
+.meta fun
+has a binding as a vertical pattern function.  Prior to 273, this situation was
+not given any special treatment; the vertical function
+.meta fun
+was called such that only one line of input is visible, and if it produced
+a match, the variable was bound to that line. A compatibility value of 272
+or lower restores this behavior.
 .IP 265
 Until \*(TX 265, the
 .code with-resources
diff --git a/txr.c b/txr.c
index 3157b879..f29ce7bd 100644
--- a/txr.c
+++ b/txr.c
@@ -451,6 +451,8 @@ static int compat(val optval)
   }
 
   sysroot_compat_fixup(compat);
+  match_compat_fixup(compat);
+
   opt_compat = compat;
   reg_varl(intern(lit("compat"), system_package), num(compat));
   return 1;