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

diff --git a/src/code/macroexpand.lisp b/src/code/macroexpand.lisp
index b9274bf..cb60c38 100644
--- a/src/code/macroexpand.lisp
+++ b/src/code/macroexpand.lisp
@@ -10,15 +10,12 @@
 ;;;; files for more information.
 
 (in-package "SB!IMPL")
-
-(file-comment
-  "$Header$")
 
 ;;;; syntactic environment access
 
 (defun sb!xc:special-operator-p (symbol)
   #!+sb-doc
-  "If the symbol globally names a special form, returns T, otherwise NIL."
+  "If the symbol globally names a special form, return T, otherwise NIL."
   (declare (symbol symbol))
   (eq (info :function :kind symbol) :special-form))
 
@@ -31,42 +28,53 @@
   whenever a runtime expansion is needed. Initially this is set to
   FUNCALL.")
 
-(declaim (ftype (function (t &optional (or null sb!c::lexenv))) sb!xc:macroexpand-1))
 (defun sb!xc:macroexpand-1 (form &optional env)
   #!+sb-doc
-  "If form is a macro (or symbol macro), expands it once. Returns two values,
+  "If form is a macro (or symbol macro), expand it once. Return two values,
    the expanded form and a T-or-NIL flag indicating whether the form was, in
-   fact, a macro. Env is the lexical environment to expand in, which defaults
+   fact, a macro. ENV is the lexical environment to expand in, which defaults
    to the null environment."
   (cond ((and (consp form) (symbolp (car form)))
-	 (let ((def (sb!xc:macro-function (car form) env)))
-	   (if def
-	       (values (funcall sb!xc:*macroexpand-hook*
-				def
-				form
-				;; As far as I can tell, it's not clear from
-				;; the ANSI spec whether a MACRO-FUNCTION
-				;; function needs to be prepared to handle
-				;; NIL as a lexical environment. CMU CL
-				;; passed NIL through to the MACRO-FUNCTION
-				;; function, but I prefer SBCL "be conservative
-				;; in what it sends and liberal in what it
-				;; accepts" by doing the defaulting itself.
-				;; -- WHN 19991128
-				(or env (make-null-lexenv)))
-		       t)
-	       (values form nil))))
-	((symbolp form)
-	 (let* ((venv (when env (sb!c::lexenv-variables env)))
-		(local-def (cdr (assoc form venv))))
-	   (if (and (consp local-def)
-		    (eq (car local-def) 'macro))
-	       (values (cdr local-def) t)
-	       (values form nil))))
-	(t
-	 (values form nil))))
+         (let ((def (sb!xc:macro-function (car form) env)))
+           (if def
+               (values (funcall sb!xc:*macroexpand-hook*
+                                def
+                                form
+                                ;; As far as I can tell, it's not clear from
+                                ;; the ANSI spec whether a MACRO-FUNCTION
+                                ;; function needs to be prepared to handle
+                                ;; NIL as a lexical environment. CMU CL
+                                ;; passed NIL through to the MACRO-FUNCTION
+                                ;; function, but I prefer SBCL "be conservative
+                                ;; in what it sends and liberal in what it
+                                ;; accepts" by doing the defaulting itself.
+                                ;; -- WHN 19991128
+                                (coerce-to-lexenv env))
+                       t)
+               (values form nil))))
+        ((symbolp form)
+         (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))))
 
-(declaim (ftype (function (t &optional (or null sb!c::lexenv))) sb!xc:macroexpand))
 (defun sb!xc:macroexpand (form &optional env)
   #!+sb-doc
   "Repetitively call MACROEXPAND-1 until the form can no longer be expanded.
@@ -74,9 +82,27 @@
    lexical environment to expand in, or NIL (the default) for the null
    environment."
   (labels ((frob (form expanded)
-	     (multiple-value-bind (new-form newly-expanded-p)
-		 (sb!xc:macroexpand-1 form env)
-	       (if newly-expanded-p
-		   (frob new-form t)
-		   (values new-form expanded)))))
+             (multiple-value-bind (new-form newly-expanded-p)
+                 (sb!xc:macroexpand-1 form env)
+               (if newly-expanded-p
+                   (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)))