expander: noexpand mechanism.

* eval.c (noexpand_s): New symbol variable, holding
sys:noexpand symbol.
(do_expand): When a (sys:noexpand X) form is seen, then
produce the expansion X without recursing into it; in other
words, sys:noexpand is like quote, but against expansion.
(noexpand): Static function.
(eval_init): Initialize noexpand_s. Register noexpand
as intrinsic function.

* txr.1: Document noexpand function.

2 files changed, 70 insertions, 1 deletions

diff --git a/eval.c b/eval.c
index c5da8b74..43f36fdf 100644
--- a/eval.c
+++ b/eval.c
@@ -106,7 +106,7 @@ val promise_s, promise_forced_s, promise_inprogress_s, force_s;
 val op_s, identity_s;
 val hash_lit_s, hash_construct_s, struct_lit_s, qref_s, uref_s;
 val vector_lit_s, vec_list_s, tree_lit_s, tree_construct_s;
-val macro_time_s, macrolet_s, expander_let_s;
+val macro_time_s, macrolet_s, expander_let_s, noexpand_s;
 val defsymacro_s, symacrolet_s, prof_s, switch_s, struct_s;
 val fbind_s, lbind_s, flet_s, labels_s;
 val load_path_s, load_hooks_s, load_recursive_s, load_search_dirs_s;
@@ -5481,6 +5481,8 @@ again:
       if (body == body_ex)
         return form;
       return rlcp(cons(sym, cons(vars_ex, body_ex)), form);
+    } else if (sym == noexpand_s) {
+      return cadr(form);
     } else {
       /* funtion call expansion also handles: prog1, call, if, and, or,
          unwind-protect, return and other special forms whose arguments
@@ -5593,6 +5595,11 @@ val expand(val form, val menv)
   return ret;
 }
 
+static val noexpand(val form)
+{
+  return cons(noexpand_s, cons(form, nil));
+}
+
 static val expand_hook_combine_fun(val env, val form, val menv, val type)
 {
   cons_bind (first, next, env);
@@ -7357,6 +7364,7 @@ void eval_init(void)
   macrolet_s = intern(lit("macrolet"), user_package);
   symacrolet_s = intern(lit("symacrolet"), user_package);
   expander_let_s = intern(lit("expander-let"), user_package);
+  noexpand_s = intern(lit("noexpand"), system_package);
   whole_k = intern(lit("whole"), keyword_package);
   form_k = intern(lit("form"), keyword_package);
   special_s = intern(lit("special"), system_package);
@@ -7736,6 +7744,7 @@ void eval_init(void)
   reg_var(load_hooks_s, nil);
   reg_fun(intern(lit("expand"), user_package), func_n2o(no_ub_warn_expand, 1));
   reg_fun(intern(lit("expand*"), user_package), func_n2o(expand, 1));
+  reg_fun(intern(lit("noexpand"), user_package), func_n1(noexpand));
   reg_fun(intern(lit("expand-hook-combine"), user_package), func_n2(expand_hook_combine));
   reg_fun(intern(lit("expand-with-free-refs"), user_package),
           func_n3o(expand_with_free_refs, 1));
diff --git a/txr.1 b/txr.1
index 7461f7ec..e0819658 100644
--- a/txr.1
+++ b/txr.1
@@ -42728,6 +42728,22 @@ being expanded by expand, the warning is effectively squelched. Rationale:
 is may be used by macros for expanding fragments which contain references to
 variables or functions which are not defined in those fragments.
 
+Note: the
+.code expand
+function is sometimes used by macros in order to obtain a complete
+expansion of some argument material. That argument material is
+then incorporated into the output of the macro. The macro expander
+will then visit the material and perform another expansion pass on it.
+Multiple expansion passes are a wasteful computation which can
+produce duplicate diagnostics, and which can be incorrect in the
+presence of expansion hooks (see the
+.code *expand-hook*
+variable). It is recommended to apply the
+.code noexpand
+function to an expansion which will be visited by the expander
+gain, to prevent expanded code from being subject to another
+expansion pass.
+
 .coNP Function @ expand-with-free-refs
 .synb
 .mets (expand-with-free-refs < form >> [ inner-env <> [ outer-env ]])
@@ -43017,6 +43033,50 @@ to discover the identities of the variables and functions which are used inside
 that form, whose definitions come from a specific, bounded scope surrounding
 that form.
 
+.coNP Function @ noexpand
+.synb
+.mets (noexpand << form )
+.syne
+.desc
+The
+.code noexpand
+function provides a mechanism for protecting a
+.meta form
+against undergoing expansion.
+
+It returns a new form, of an unspecified structure, in which the original
+.meta form
+is embedded in an unspecified manner.
+
+When the resulting form is processed by the expander, it expands into
+.meta form
+in such a way that
+.meta form
+is only reproduced literally, without undergoing expansion. Effectively, the
+form is quoted against expansion, similarly to how a form embedded in a
+.code quote
+is protected against evaluation.
+
+.TP* Example:
+
+Without the use of
+.codn noexpand ,
+the
+.code "(set x 42)"
+form undergoes expansion to
+.codn sys:setq .
+In contrast,
+.code noexpand
+converts
+.code "(set x 42)"
+into a form which expands to
+.codn "(set x 42)" :
+
+.verb
+(expand '(set x 42))  -->  (sys:setq x 42)
+(expand (noexpand '(set x 42)))  -->  (set x 42)
+.brev
+
 .coNP Functions @, lexical-var-p @, lexical-fun-p @ lexical-symacro-p and @ lexical-macro-p
 .synb
 .mets (lexical-var-p < env << form )