PCL walker doesn't know that SYMBOL-MACROLET can be shadowed by rebindings

[Douglas Katzman]

Suppose we have macro GET-A-PROP which wants explicitly to expand something in its proper lexenv before deciding how to continue expanding. And suppose that there are two nested lexical environment contours in which the same symbol is used as a macro and not a macro. Here's a minimal example, on which the compiler (and interpreter) are totally correct:

* (defun hairball-get-thing (x) (format t "Got you thing ~S~%" x) 'yay)

* (defmacro get-a-prop (arg &environment e)
    (let ((newform (macroexpand arg e)))
      (if (keywordp newform) `(get ,newform 'foo) `(hairball-get-thing ,arg))))

* (symbol-macrolet ((a :mykeyword)) (let ((a (list 'foo (- 5)))) (get-a-prop a)))
Got you thing (FOO -5)
YAY

But the PCL code walker is sorely mistaken:

* (let ((SB-WALKER:*WALK-FORM-EXPAND-MACROS-P* t))
     (sb-walker:walk-form '(symbol-macrolet ((a :mykeyword)) (let ((a (list 'foo (- 5)))) (get-a-prop a)))))
=> (SYMBOL-MACROLET ((A :MYKEYWORD))
       (LET ((A (LIST 'FOO (- 5)))) (GET :MYKEYWORD 'FOO)))

Or an even more contrived example:
* (let ((a 'frob)) (declare(special a)) (symbol-macrolet ((a :mykeyword)) (locally (declare (special a)) (get-a-prop a))))
Got you thing FROB
YAY
* (let ((SB-WALKER:*WALK-FORM-EXPAND-MACROS-P* t)) (sb-walker:walk-form '(let ((a 'frob)) (declare(special a)) (symbol-macrolet ((a :mykeyword)) (locally (declare (special a)) (get-a-prop a))))))
=> (LET ((A 'FROB))
  (DECLARE (SPECIAL A))
  (SYMBOL-MACROLET ((A :MYKEYWORD))
    (LOCALLY (DECLARE (SPECIAL A)) (GET :MYKEYWORD 'FOO))))

This could have implications for the correctness of the CLOS implementation, in addition to being a pita.
The problem seems to date back to the original change in CMUCL:
commit 8d3b58a2b30d490ab3e5925989bd8a91017ae6ef
Author: pw <pw>
Date: Wed Nov 15 19:07:31 2000 +0000
    Fix environment hacking code to feed symbol-macrolet variable
    names to macroexpand-1. Added some commentary on how this code works.

So Paul fixed the opposite problem, that symbol-macrolets were never propagated from the walker bogo-environment into the actual lexical environment that EVAL (or equivalent) needs to execute macroexpander functions.
I'm working on a patch, maybe even one that does away with bogo-funs so that the walker env can never be out-of-sync with the true macro lexenv.

(For what it's worth, I also tested CMUCL's WALKER:MACROEXPAND-ALL and found it wrong on the second of my tests but right on the first. That should provide some clues toward a fix)

bash-3.2$ sbcl --version
SBCL 1.0.54.0-185b926

[Douglas Katzman (dougk)]

a simpler example I found while fixing this. Initially I thought that only the native lexenv fails to see the more deeply nested binding, but this also affects the walker's internal code for SETQ which does not call macroexpand. It just looks at its own replica of the lexenv and decides that A is a symbol-macro.

Good: (symbol-macrolet ((a (nosuchfun x))) (let () (declare (special a)) (setq a 9))) => 9

Bad: (let ((SB-WALKER:*WALK-FORM-EXPAND-MACROS-P* t))
           (sb-walker:walk-form '(symbol-macrolet ((a (nosuchfun x))) (let () (declare (special a)) (setq a 9)))))
=> (SYMBOL-MACROLET ((A (FOO X)))
  (LET ()
    (DECLARE (SPECIAL A))
    (LET* ((#:X600 X))
      (MULTIPLE-VALUE-BIND (#:NEW599) 9 (FUNCALL #'(SETF NOSUCHFUN) #:NEW599 #:X600)))))

[Douglas Katzman (dougk)]

Another bug in which the code runs fine, but the walker is confused by a symbol-macro.

;; have some fun with conflicting namespaces of symbol-macros and tagbody tags
(defun foo () (print 'foo-called!))
(defun more-p () nil)
(symbol-macrolet ((collect (setq some stuff)))
   (tagbody collect (foo) (when (more-p) (go collect))) 'all-done)
=>
FOO-CALLED!
ALL-DONE

But:
(sb-cltl2:macroexpand-all
  '(symbol-macrolet ((collect (setq some stuff))) (tagbody collect (foo) (when (more-p) (go collect))) 'all-done))
=>
(SYMBOL-MACROLET ((COLLECT (SETQ SOME STUFF)))
  (TAGBODY
    (SETQ SOME STUFF)
    (FOO)
    (IF (MORE-P)
        (PROGN (GO COLLECT))
        NIL))
  'ALL-DONE)

It macroexpanded the COLLECT which is not in a for-evaluation position. Needless to say, consumers of the walker would probably think that to be in fact a SETQ at that point.

[Christophe Rhodes (csr21-cantab)]

I think the tagbody problem can be fairly straightforwardly fixed: the problem was the tagbody walker trying to handle symbols specially by passing a particular CONTEXT, but no other walker function inspecting the context in any way.

(defun walk-tagbody-1 (form context env)
  (and form
       (recons form
               (if (or (symbolp (car form)) (integerp (car form)))
                   (car form)
                   (walk-form-internal (car form) context env))
               (walk-tagbody-1 (cdr form) context env))))

Putting that in gives

(let ((sb-walker::*walk-form-expand-macros-p* t))
  (sb-walker:walk-form
   '(symbol-macrolet ((x (progn 1)))
      (macrolet ((y () 'x))
        (dotimes (i 10) x (y) (go x))))))
=>
(SYMBOL-MACROLET ((X (PROGN 1)))
  (MACROLET ((Y ()
               'X))
    (BLOCK NIL
      (LET ((I 0))
        (DECLARE (TYPE UNSIGNED-BYTE I))
        (TAGBODY
          (GO #:G619)
         #:G618
          (TAGBODY X (PROGN 1) (GO X))
          (LET* ()
            (MULTIPLE-VALUE-BIND (#:NEW620)
                (1+ I)
              (PROGN (SETQ I #:NEW620) NIL)))
         #:G619
          (IF (>= I 10)
              NIL
              (PROGN (GO #:G618)))
          (RETURN-FROM NIL (PROGN NIL)))))))

and that's correct: the (Y) => X must be further macroexpanded, as CLHS TAGBODY says "The determination of which elements of the body are tags and which are statements is made prior to any macro expansion of that element."

Thoughts?

[Christophe Rhodes (csr21-cantab)]

Christophe Rhodes <email address hidden> writes:

> I think the tagbody problem can be fairly straightforwardly fixed: the
> problem was the tagbody walker trying to handle symbols specially by
> passing a particular CONTEXT, but no other walker function inspecting
> the context in any way.

I think this is still correct: I suspect that what the original writer
was aiming for was (walk-template form 'quote context env) rather than
(walk-form-internal form 'quote env).

However. That thinkg about "no walker function inspecting CONTEXT"... I
have realised to my horror that this should not be true. Firstly, the
PCL walker and (since b3ccf16b40858c0147229cbe61e0d89e9bea9ff0)
macroexpand-all both check that they are walking something in :eval
context, so hooray. However, even after the tagbody change, either my
original one or one to go to walk-template, the basic walker is
vulnerable to confusion because as well as :eval context there is :set
context. We correctly expand symbol macros in :set context; however, we
incorrectly expand normal macros too:

  (let ((sb-walker:*walk-form-expand-macros-p* t))
    (sb-walker:walk-form '(macrolet ((x () 'y)) (setq (x) 3))))

(This is invisible to anything that uses our exported interfaces, which
only do anything if the context argument is :eval).

The problems with scoping of symbol-macrolets remain; here's another
one:

  (symbol-macrolet ((tag (slot-value x 'y)))
    (defmethod foo ((x z))
      (tagbody tag
        (print "here")
        (if (= tag 0) 'done (go tag)))))

The PCL walker correctly doesn't expand the tagbody/go tags, but also
doesn't expand the tag that *is* evaluated, so slot-value optimization
doesn't get performed -- variable-symbol-macro-p of TAG returns NIL.