New feature: *expand-hook*.

* eval.c (expand_hook_s): New symbol variable.
(do_expand): Check for expand hook in several places and
call it: symbol macros, macros, functions, and
forms that not confirmed function calls.
(eval_init): Initialize new symbol, and
register the *expand-hook* special variable.

* eval.h (expand_hook_s): Declared.
(expand_hook): New macro.

* txr.1: Documented.

3 files changed, 150 insertions, 1 deletions

diff --git a/eval.c b/eval.c
index 93576d00..4489025f 100644
--- a/eval.c
+++ b/eval.c
@@ -116,6 +116,8 @@ val const_foldable_s;
 val pct_fun_s;
 
 val special_s, unbound_s;
+val expand_hook_s;
+
 val whole_k, form_k, symacro_k, macro_k;
 
 val last_form_evaled;
@@ -5065,11 +5067,22 @@ again:
     val symac_bind = lookup_symac(menv, form);
 
     if (symac_bind) {
+      val eh = expand_hook;
       val symac = cdr(symac_bind);
+
+      if (eh) {
+        val eform = funcall3(eh, form, menv, macro_k);
+        if (eform != form) {
+          form = rlcp_tree(eform, form);
+          goto again;
+        }
+      }
+
       if (symac == form)
         return form;
       return expand(rlcp_tree(symac, form), menv);
     }
+
     if (!lookup_var(menv, form))
       eval_defr_warn(uw_last_form_expanded(),
                      cons(var_s, form),
@@ -5368,7 +5381,16 @@ again:
     } else if (sym == switch_s) {
       return expand_switch(form, menv);
     } else if (!macro && (macro = lookup_mac(menv, sym))) {
-      val mac_expand = expand_macro(form, macro, menv);
+      val eh = expand_hook;
+      val mac_expand;
+      if (eh) {
+        val eform = funcall3(eh, form, menv, macro_k);
+        if (eform != form) {
+          form = rlcp_tree(eform, form);
+          goto again;
+        }
+      }
+      mac_expand = expand_macro(form, macro, menv);
       if (mac_expand == form)
         goto again;
       return expand(rlcp_tree(rlcp_tree(mac_expand, form), macro), menv);
@@ -5457,6 +5479,15 @@ again:
       if (consp(insym) && car(insym) == lambda_s) {
         insym_ex = expand(insym, menv);
       } else if (!lookup_fun(menv, insym) && !special_operator_p(insym)) {
+        val eh = expand_hook;
+        if (eh) {
+          val eform = funcall3(eh, form, menv, nil);
+          if (eform != form) {
+            form = rlcp_tree(eform, form);
+            macro = nil;
+            goto again;
+          }
+        }
         if (!bindable(insym))
           eval_warn(uw_last_form_expanded(),
                     lit("~s appears in operator position"), insym, nao);
@@ -5465,6 +5496,16 @@ again:
                          cons(fun_s, insym),
                          lit("unbound function ~s"),
                          insym, nao);
+      } else {
+        val eh = expand_hook;
+        if (eh && !special_operator_p(insym)) {
+          val eform = funcall3(eh, form, menv, fun_k);
+          if (eform != form) {
+            form = rlcp_tree(eform, form);
+            macro = nil;
+            goto again;
+          }
+        }
       }
 
       if (insym_ex == rcons_s &&
@@ -7213,6 +7254,7 @@ void eval_init(void)
   prof_s = intern(lit("prof"), user_package);
   switch_s = intern(lit("switch"), system_package);
   struct_s = intern(lit("struct"), user_package);
+  expand_hook_s = intern(lit("*expand-hook*"), user_package);
   load_path_s = intern(lit("*load-path*"), user_package);
   load_hooks_s = intern(lit("*load-hooks*"), user_package);
   load_recursive_s = intern(lit("*load-recursive*"), system_package);
@@ -7563,6 +7605,7 @@ void eval_init(void)
   reg_fun(intern(lit("rot"), user_package), func_n2o(rot, 1));
 
   reg_var(intern(lit("*param-macro*"), user_package), pm_table);
+  reg_var(expand_hook_s, nil);
 
   reg_fun(intern(lit("eval"), user_package), func_n3o(eval_intrinsic, 1));
   reg_fun(intern(lit("lisp-parse"), user_package), func_n5o(nread, 0));
diff --git a/eval.h b/eval.h
index 6ac92cdf..535788b3 100644
--- a/eval.h
+++ b/eval.h
@@ -36,11 +36,13 @@ extern val car_s, cdr_s;
 extern val last_form_evaled;
 extern val load_path_s, load_hooks_s, load_recursive_s, load_search_dirs_s;
 extern val special_s, struct_s;
+extern val expand_hook_s;
 
 extern val dyn_env;
 
 #define load_path (deref(lookup_var_l(nil, load_path_s)))
 #define load_search_dirs (deref(lookup_var_l(nil, load_search_dirs_s)))
+#define expand_hook (deref(lookup_var_l(nil, expand_hook_s)))
 
 NORETURN val eval_error(val ctx, val fmt, ...);
 val ctx_form(val obj);
diff --git a/txr.1 b/txr.1
index b7e031d9..17186810 100644
--- a/txr.1
+++ b/txr.1
@@ -41922,6 +41922,14 @@ when a \*(TX file is loaded, expansion of the Lisp forms are its arguments
 takes place during the parsing of the entire source file, and is complete
 for the entire file before any of the code is executed.
 
+Language customizations that cannot be easily achieved with macros
+alone, due to needing to perform a code walk, may be achieved by
+dynamically hooking into the expansion process using the
+.code *expand-hook*
+variable, which specifies a function that is invoked whenever
+\*(TL's macro expanding code walker encounters a function call,
+macro or symbol macro. The function may transform that expression.
+
 .NP* Macro parameter lists
 
 \*(TX macros support destructuring, similarly to Common Lisp macros.
@@ -43939,6 +43947,102 @@ shorthand:
     ^(,x ,y ,z))
 .brev
 
+.coNP Special Variable @ *expand-hook*
+.desc
+The
+.code *expand-hook*
+variable is
+.code nil
+by default. If it is given any other value, that value must specify
+a function which takes three arguments:
+.mono
+.meti (lambda >> ( form < env << type-keyword ) ...)
+.onom
+Whenever the macro expander encounters the invocation of a symbol macro,
+macro, function, or invalid form, it calls the function stored in
+.code *expand-hook*
+if that variable isn't
+.codn nil .
+
+If the function returns an expression other than
+.metn form ,
+the expander takes that expression as a replacement for
+.meta form
+and continues by expanding the new form.
+
+If the hook function returns
+.metn form ,
+then it is considered to have declined to perform a transformation.
+The expander continues processing
+.meta form
+as if no function had been called.
+
+The
+.meta env
+argument is the macro-expansion-time lexical environment.
+If the hook needs to perform explicit expansion of a macro occurring inside
+.metn form ,
+it should pass this environment to the expansion function. The environment
+is also useful for inquiring about variable and function bindings and
+calculating free variables: see the functions
+.metn expand-with-free-refs ,
+.meta lexical-binding-kind
+and others in that category.
+
+The
+.meta type-keyword
+argument takes on one of three values:
+.codn :fun ,
+.code :macro
+or
+.codn nil .
+If the value is
+.codn :fun ,
+this indicates that
+.meta form
+is a confirmed function call: it is a compound form whose
+.code car
+position contains a symbol naming a global or lexical function.
+If the value is
+.codn :macro ,
+then
+.meta form
+is a macro invocation: if it is a symbol, then it is a symbol macro form,
+otherwise an ordinary macro form.
+If
+.meta type-keyword
+is
+.codn nil ,
+then
+.meta form
+is a compound form that is either invalid, or that invokes a function that is
+not defined (note: which should be carefully interpreted as not
+.B yet
+defined).
+
+Note: this hook mechanism provides a great deal of power for customizing the
+language, in ways that are difficult to achieve with macros, and that, in the
+absence of this mechanism, require a code walker. However, not everything that
+can be achieved with a code walker is possible with this hook mechanism; in
+particular, the hook mechanism is not invoked for special forms, or for
+self-evaluating terms, and its output must be valid Lisp.
+
+Note: it is recommended to dynamically bind
+.code *expand-hook*
+with a binding construct like
+.code let
+rather than assign a value to it. Assigning an incorrect value to
+to it in a Listener session may be difficult to recover from, since
+it may render the Listener incapable of evaluating forms.
+
+Note: it is recommended to capture the previous value of
+.code *expand-hook*
+and call that function before performing any transformation of
+.metn form .
+If that function performs a transformation, indicated by
+returning a different form, then return that form, only
+performing local processing when that function has declined.
+
 .SS* Parameter List Macros
 
 Parameter list macros, also more briefly called