Simple indirection on pattern functions: @(call).

* eval.h (call_s): Declared.

* match.c (h_call, v_call): New static function.
(dir_tables_init): Register v_call in v_directive_table
under call symbol. Likewise h_call in h_directive_table.

* txr.1: Documented.

3 files changed, 150 insertions, 1 deletions

diff --git a/eval.h b/eval.h
index ae5008f1..c0cce698 100644
--- a/eval.h
+++ b/eval.h
@@ -26,7 +26,7 @@
 
 extern val dwim_s, lambda_s, vector_lit_s, vec_list_s, list_s;
 extern val hash_lit_s, hash_construct_s, struct_lit_s, qref_s;
-extern val eval_error_s, if_s;
+extern val eval_error_s, if_s, call_s;
 extern val eq_s, eql_s, equal_s;
 extern val last_form_evaled, last_form_expanded;
 
diff --git a/match.c b/match.c
index a1474926..bffde874 100644
--- a/match.c
+++ b/match.c
@@ -1239,6 +1239,42 @@ static match_files_ctx mf_all(val spec, val files, val bindings,
 
 static val v_fun(match_files_ctx *c);
 
+static val h_call(match_line_ctx *c)
+{
+  val saved_specline = c->specline;
+  val elem = first(saved_specline);
+  val args = rest(elem);
+  val funexpr = first(args);
+  val funval = txeval(c->specline, funexpr, c->bindings);
+  val argexprs = rest(args);
+  val call = cons(funval, argexprs);
+  val new_specline = cons(call, nil);
+  val ret;
+
+  c->specline = new_specline;
+
+  ret = h_fun(c);
+
+  c->specline = saved_specline;
+
+  if (ret == decline_k) {
+    val spec = cons(new_specline, nil);
+    match_files_ctx vc = mf_all(spec, nil, c->bindings, nil, c->file);
+    val vresult = v_fun(&vc);
+
+    if (vresult == next_spec_k) {
+      c->bindings = vc.bindings;
+      return vresult;
+    } else if (vresult == decline_k) {
+      sem_error(elem, lit("call: function ~s not found"), funval, nao);
+    }
+
+    return vresult;
+  }
+
+  return ret;
+}
+
 static val do_match_line(match_line_ctx *c)
 {
   val lfe_save = set_last_form_evaled(nil);
@@ -3863,6 +3899,27 @@ static val v_name(match_files_ctx *c)
   return next_spec_k;
 }
 
+static val v_call(match_files_ctx *c)
+{
+  spec_bind (specline, first_spec, c->spec);
+  val exprs = rest(first_spec);
+  val funexpr = car(exprs);
+  val funval = txeval(specline, funexpr, c->bindings);
+  val argexprs = cdr(exprs);
+  val call = cons(funval, argexprs);
+  val spec = cons(cons(call, nil), nil);
+  match_files_ctx ctx = mf_spec_bindings(*c, spec, c->bindings);
+  val ret = v_fun(&ctx);
+
+  if (ret == nil)
+    return nil;
+
+  if (ret == decline_k)
+    sem_error(nil, lit("call: function ~s not found"), funval, nao);
+
+  return cons(ctx.bindings, if3(ctx.data, cons(ctx.data, ctx.data_lineno), t));
+}
+
 static val h_do(match_line_ctx *c)
 {
   val elem = first(c->specline);
@@ -4216,6 +4273,7 @@ static void dir_tables_init(void)
   sethash(v_directive_table, line_s, cptr(coerce(mem_t *, v_line)));
   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(h_directive_table, text_s, cptr(coerce(mem_t *, h_text)));
   sethash(h_directive_table, var_s, cptr(coerce(mem_t *, h_var)));
@@ -4247,6 +4305,7 @@ static void dir_tables_init(void)
   sethash(h_directive_table, line_s, cptr(coerce(mem_t *, hv_trampoline)));
   sethash(h_directive_table, data_s, cptr(coerce(mem_t *, hv_trampoline)));
   sethash(h_directive_table, name_s, cptr(coerce(mem_t *, hv_trampoline)));
+  sethash(h_directive_table, call_s, cptr(coerce(mem_t *, h_call)));
 
   sethash(non_matching_directive_table, block_s, t);
   sethash(non_matching_directive_table, accept_s, t);
diff --git a/txr.1 b/txr.1
index 26ed0eec..e018123d 100644
--- a/txr.1
+++ b/txr.1
@@ -2972,6 +2972,12 @@ clauses, in conjunction with
 .meIP @(define < name >> ( args ...))
 Introduces a function. Functions are described in the Functions section below.
 
+.meIP @(call < expr << args *)
+Performs function indirection.  Evaluates
+.metn expr ,
+which must produce a symbol that names a pattern function. Then that
+pattern function is invoked.
+
 .coIP @(gather)
 Searches text for matches for multiple clauses which may occur in arbitrary
 order. For convenience, lines of the first clause are treated as separate
@@ -7131,6 +7137,90 @@ is called directly from the top level, its
 .code fun
 call goes to the toplevel definition.
 
+.NP* Indirect Calls
+
+Function indirection may be performed using the
+.code call
+directive. If
+.meta fun-expr
+is an expression which evaluates to a symbol, and
+that symbol names a function which takes no arguments, then
+.cblk
+  @(call fun-expr)
+.cble
+may be used to invoke the function. Of course, additional
+expressions may be supplied which specify arguments.
+
+Example 1:
+
+.cblk
+\ @(define foo (arg))
+  @(bind arg "abc")
+  @(end)
+  @(call @'foo b)
+.cble
+
+In this example, the effect is that
+.code foo
+is invoked, and
+.code b
+ends up bound to
+.strn abc .
+
+The
+.code call
+directive here uses the
+.code @'foo
+expression to calculate the name of the function to be invoked.
+The
+.code @
+symbol indicates that the expression which follows is \*(TL ,
+and
+.code 'foo
+is the \*(TL syntax for quoting a symbol. (See the
+.code quote
+operator).
+
+Of course, this particular
+.code call
+expression can just be replaced by the direct invocation
+syntax
+.codn "@(foo b)" .
+
+The power of
+.code call
+lies in being able to specify the function as a value which
+comes from elsewhere in the program, as in the following example.
+
+.cblk
+\ @(define foo (arg))
+  @(bind arg "abc")
+  @(end)
+  @(bind f @'foo)
+  @(call f b)
+.cble
+
+Here the
+.code call
+directive obtains the name of the function from the
+.code f
+variable.
+
+Note that function names are resolved to functions in the environment
+that is apparent at the point in execution where the
+.code call
+takes place. Very simply, the directive
+.code "@(call f args ...)"
+is precisely equivalent to
+.code "@(s args ...)"
+if, at the point of the call,
+.code f
+is a variable which holds the symbol
+.code s
+and symbol
+.code s
+is defined as a function. Otherwise it is erroneous.
+
 .SS* Modularization
 
 .dirs load include