1.0.10.9: symbol-macro expansion uses *MACROEXPAND-HOOK*

Thanks to Tobias Rittweiler.

diff --git a/NEWS b/NEWS
index 835caeb..5175035 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,8 @@ changes in sbcl-1.0.11 relative to sbcl-1.0.10:
   * enhancement: dynamic-extent support has been extended to support
     cases where there are multiple possible sources for the stack
     allocated value.
+  * bug fix: symbol-macro expansion now uses the *MACROEXPAND-HOOK*
+    as specified by the CLHS. (thanks to Tobias Rittweiler)
 
 changes in sbcl-1.0.10 relative to sbcl-1.0.9:
   * minor incompatible change: the MSI installer on Windows no longer

diff --git a/src/code/macroexpand.lisp b/src/code/macroexpand.lisp
index ca38c6c..4b7a1a2 100644 (file)
--- a/src/code/macroexpand.lisp
+++ b/src/code/macroexpand.lisp
@@ -53,17 +53,25 @@
                        t)
                (values form nil))))
         ((symbolp form)
-         (let* ((venv (when env (sb!c::lexenv-vars env)))
-                (local-def (cdr (assoc form venv))))
-           (cond ((and (consp local-def)
-                       (eq (car local-def) 'macro))
-                  (values (cdr local-def) t))
-                 (local-def
-                  (values form nil))
-                 ((eq (info :variable :kind form) :macro)
-                  (values (info :variable :macro-expansion form) t))
-                 (t
-                  (values form nil)))))
+         (flet ((perform-symbol-expansion (symbol expansion)
+                  ;; CLHS 3.1.2.1.1 specifies that symbol-macros are expanded
+                  ;; via the macroexpand hook, too.
+                  (funcall sb!xc:*macroexpand-hook*
+                           (constantly expansion)
+                           symbol
+                           env)))
+           (let* ((venv (when env (sb!c::lexenv-vars env)))
+                  (local-def (cdr (assoc form venv))))
+             (cond ((and (consp local-def)
+                         (eq (car local-def) 'macro))
+                    (values (perform-symbol-expansion form (cdr local-def)) t))
+                   (local-def
+                    (values form nil))
+                   ((eq (info :variable :kind form) :macro)
+                    (let ((expansion (info :variable :macro-expansion form)))
+                      (values (perform-symbol-expansion form expansion) t)))
+                   (t
+                    (values form nil))))))
         (t
          (values form nil))))
 

diff --git a/tests/macroexpand.impure.lisp b/tests/macroexpand.impure.lisp
index 6f5863d..8a13935 100644 (file)
--- a/tests/macroexpand.impure.lisp
+++ b/tests/macroexpand.impure.lisp
@@ -27,3 +27,41 @@
 (assert (null glob))
 (assert (equal (let ((glob nil)) (push 'foo glob) glob) '(foo)))
 (assert (null glob))
+
+
+
+;;; CLHS 3.1.2.1.1 specifies that symbol macro expansion must also
+;;; go through *MACROEXPAND-HOOK*. (2007-09-22, -TCR.)
+
+(define-symbol-macro .foo. 'foobar)
+
+(let* ((expanded-p nil)
+      (*macroexpand-hook* #'(lambda (fn form env)
+                              (when (eq form '.foo.)
+                                (setq expanded-p t))
+                              (funcall fn form env))))
+  (multiple-value-bind (expansion flag) (macroexpand '.foo.)
+    (assert (equal expansion '(quote foobar)))
+    (assert flag)
+    (assert expanded-p)))
+
+(let ((sb-ext::*evaluator-mode* :interpret))
+  (let* ((expanded-p nil)
+         (*macroexpand-hook* #'(lambda (fn form env)
+                                 (when (eq form '.foo.)
+                                   (setq expanded-p t))
+                                 (funcall fn form env))))
+    (eval '.foo.)
+    (assert expanded-p)))
+
+(let* ((expanded-p nil)
+       (*macroexpand-hook* #'(lambda (fn form env)
+                               (when (eq form '/foo/)
+                                 (setq expanded-p t))
+                               (funcall fn form env))))
+  (compile nil '(lambda ()
+                 (symbol-macrolet ((/foo/ 'foobar))
+                   (macrolet ((expand (symbol &environment env)
+                                (macroexpand symbol env)))
+                     (expand /foo/)))))
+  (assert expanded-p))

diff --git a/version.lisp-expr b/version.lisp-expr
index 4cea42f..112b106 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.10.8"
+"1.0.10.9"