From 60d79d3d94445b9b27c1b394499995847e889d64 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 17 Jun 2019 23:01:49 -0700
Subject: expander: relax sys:setq and lisp-1 stringency.

The motivation here is that there are behaviors in the
expander which hinder symbol-macro-based renaming techniques.
For instance (expand '(symacrolet ((x y)) (sys:setq x x)))
throws. The right hand side of the setq is fine, but the left
hand one is a forbidden symbol macro. Yet, we would just like
this to expand to (sys:setq y y). The original idea was that
sys:setq occurs as a result of macro-expansion. Therefore,
if its argument is a symbol macro, something must be wrong; it
didn't get expanded. That reasoning is wrong in the face of
explicit expansion techniques that make multiple expansion
passes. For instance (set a b) can become something like
(sys:setq #:g0005 #:g0007) when the intent that in another round
of renaming these gensyms will be defined as symbol macros
which perform one more renaming.

* eval.c (expand_lisp1_value, expand_lisp1_setq): Macro-expand
the symbol and work with the expanded one. We still keep the
check for a symbol macro; these situations can arise if a
symbol macro cannot expand due to circularity.
(do_expand): When checking sys:setq for a bad symbol or symbol
macro, work with the expanded argument.
---
 eval.c | 44 +++++++++++++++++++++-----------------------
 1 file changed, 21 insertions(+), 23 deletions(-)

diff --git a/eval.c b/eval.c
index 1ef2ef47..5dd9c830 100644
--- a/eval.c
+++ b/eval.c
@@ -2346,23 +2346,24 @@ static val expand_lisp1_value(val form, val menv)
 
   {
     val sym = second(form);
-    val binding_type = lexical_lisp1_binding(menv, sym);
+    val sym_ex = expand(sym, menv);
+    val binding_type = lexical_lisp1_binding(menv, sym_ex);
 
     if (nilp(binding_type)) {
-      if (!bindable(sym))
+      if (!bindable(sym_ex))
         eval_error(form, lit("~s: misapplied to form ~s"),
-                   first(form), sym, nao);
+                   first(form), sym_ex, nao);
       return form;
     }
 
     if (binding_type == var_k)
-      return sym;
+      return sym_ex;
 
     if (binding_type == fun_k)
-      return rlcp(cons(fun_s, cons(sym, nil)), form);
+      return rlcp(cons(fun_s, cons(sym_ex, nil)), form);
 
-    eval_error(form, lit("~s: misapplied to symbol macro ~s"),
-               first(form), sym, nao);
+    eval_error(form, lit("~s: applied to unexpanded symbol macro ~s"),
+               first(form), sym_ex, nao);
   }
 }
 
@@ -2374,29 +2375,30 @@ static val expand_lisp1_setq(val form, val menv)
   {
     val op = car(form);
     val sym = cadr(form);
+    val sym_ex = expand(sym, menv);
     val newval = caddr(form);
-    val binding_type = lexical_lisp1_binding(menv, sym);
+    val binding_type = lexical_lisp1_binding(menv, sym_ex);
 
     if (nilp(binding_type)) {
-      if (!bindable(sym))
+      if (!bindable(sym_ex))
         eval_error(form, lit("~s: misapplied to form ~s"),
-                   op, sym, nao);
-      if (!lookup_var(nil, sym) && !lookup_fun(nil, sym))
+                   op, sym_ex, nao);
+      if (!lookup_var(nil, sym_ex) && !lookup_fun(nil, sym_ex))
         eval_defr_warn(uw_last_form_expanded(),
-                       cons(var_s, sym),
+                       cons(var_s, sym_ex),
                        lit("~s: unbound variable/function ~s"),
-                       op, sym, nao);
-      return rlcp(cons(op, cons(sym, cons(expand(newval, menv), nil))),
+                       op, sym_ex, nao);
+      return rlcp(cons(op, cons(sym_ex, cons(expand(newval, menv), nil))),
                   form);
     }
 
     if (binding_type == var_k)
-      return expand(rlcp(cons(setq_s, cons(sym, cddr(form))), form), menv);
+      return expand(rlcp(cons(setq_s, cons(sym_ex, cddr(form))), form), menv);
 
     if (binding_type == fun_k)
-      eval_error(form, lit("~s: cannot assign lexical function ~s"), op, sym, nao);
+      eval_error(form, lit("~s: cannot assign lexical function ~s"), op, sym_ex, nao);
 
-    eval_error(form, lit("~s: misapplied to symbol macro ~s"), op, sym, nao);
+    eval_error(form, lit("~s: applied to unexpanded symbol macro ~s"), op, sym_ex, nao);
   }
 }
 
@@ -4854,15 +4856,11 @@ again:
           eval_error(form, lit("~s: excess arguments"), sym, nao);
 
         {
-          val target = car(args);
+          val target = car(args_ex);
 
           if (!consp(target) || car(target) != var_s) {
             if (!bindable(target))
-              not_bindable_warning(form, car(args));
-
-            if (car(args_ex) != target)
-              eval_error(form, lit("~s: misapplied to symbol macro ~a"), sym,
-                         car(args), nao);
+              not_bindable_warning(form, car(args_ex));
           }
         }
       }
-- 
cgit v1.2.3