New: %fun% mechanism for current function name.

* eval.c (pct_fun_s): New symbol variable, holding
the usr:%fun% symbol.
(fun_macro_env): New static function.
(do_expand): For defun and defmacro, use fun_macro_env
to establish an environment binding the %fun% symbol
macro, and expand everything in that environment.
(eval_init): Intern the %fun% symbol, initializing
pct_fun_s, and also register a global symbol macro in
that name so that we can freely use %fun% everywhere
without worrying that the code will blow up.
E.g. a logging macro can use it to get the function name,
but still be useful in a top-level form outside of
a named function.

* stdlib/struct.tl (sys:meth-lambda): New macro.
(defstruct, defmeth): Use sys:meth-lambda as a replacement
for lambda to set up the %fun% symbol macro. In the :init
case which doesn't use a lambda, an open-coded symacrolet
does the job.

* tests/019/pct-fun.tl: New file.

* tests/019/pct-fun.expected: Likewise.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.

1 files changed, 14 insertions, 3 deletions

diff --git a/eval.c b/eval.c
index 0bcbd469..acf3b2e2 100644
--- a/eval.c
+++ b/eval.c
@@ -106,6 +106,7 @@ val load_path_s, load_hooks_s, load_recursive_s, load_search_dirs_s;
 val load_time_s, load_time_lit_s;
 val eval_only_s, compile_only_s;
 val const_foldable_s;
+val pct_fun_s;
 
 val special_s, unbound_s;
 val whole_k, form_k, symacro_k;
@@ -4776,6 +4777,12 @@ static val rt_load_for(struct args *args)
   return nil;
 }
 
+static val fun_macro_env(val menv, val name)
+{
+  val qname = list(quote_s, name, nao);
+  return make_env(cons(cons(pct_fun_s, qname), nil), nil, menv);
+}
+
 static val expand_catch_clause(val form, val menv)
 {
   val sym = first(form);
@@ -5005,11 +5012,12 @@ again:
 
       {
         val body = rest(rest(rest(form)));
+        val menv0 = fun_macro_env(menv, name);
         cons_bind (params_ex, body_ex0,
-                   expand_params(params, body, menv,
+                   expand_params(params, body, menv0,
                                  eq(sym, defmacro_s), form));
-        val new_menv = make_var_shadowing_env(menv, get_param_syms(params_ex));
-        val body_ex = expand_progn(body_ex0, new_menv);
+        val menv1 = make_var_shadowing_env(menv0, get_param_syms(params_ex));
+        val body_ex = expand_progn(body_ex0, menv1);
         val form_ex = form;
 
         if (body != body_ex || params != params_ex)
@@ -6756,6 +6764,7 @@ void eval_init(void)
   eval_only_s  = intern(lit("eval-only"), user_package);
   compile_only_s = intern(lit("compile-only"), user_package);
   const_foldable_s = intern(lit("%const-foldable%"), system_package);
+  pct_fun_s = intern(lit("%fun%"), user_package);
 
   qquote_init();
 
@@ -7488,6 +7497,8 @@ void eval_init(void)
 
   reg_var(lazy_streams_s, nil);
 
+  reg_symacro(pct_fun_s, nil);
+
   eval_error_s = intern(lit("eval-error"), user_package);
   case_error_s = intern(lit("case-error"), user_package);
   uw_register_subtype(eval_error_s, error_s);