X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fmacroexpand.lisp;h=cb60c38d9dcdeb7d36cbec6b5674edf3da6f63ee;hb=HEAD;hp=ca38c6c5ae1ebc64b57b0045f43c9e8be9a2cb2c;hpb=65e947c7a90df88e0691e664f3387ccb35d390d9;p=sbcl.git

diff --git a/src/code/macroexpand.lisp b/src/code/macroexpand.lisp
index ca38c6c..cb60c38 100644
--- 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))))
 
@@ -80,3 +88,21 @@
                    (frob new-form t)
                    (values new-form expanded)))))
     (frob form nil)))
+
+;;; Like MACROEXPAND-1, but takes care not to expand special forms.
+(defun %macroexpand-1 (form &optional env)
+  (if (or (atom form)
+          (let ((op (car form)))
+            (not (and (symbolp op) (sb!xc:special-operator-p op)))))
+      (sb!xc:macroexpand-1 form env)
+      (values form nil)))
+
+;;; Like MACROEXPAND, but takes care not to expand special forms.
+(defun %macroexpand (form &optional env)
+  (labels ((frob (form expanded)
+             (multiple-value-bind (new-form newly-expanded-p)
+                 (%macroexpand-1 form env)
+               (if newly-expanded-p
+                   (frob new-form t)
+                   (values new-form expanded)))))
+    (frob form nil)))