Fix make-array transforms.

[sbcl.git] / src / code / macroexpand.lisp

diff --git a/src/code/macroexpand.lisp b/src/code/macroexpand.lisp
index f351784..cb60c38 100644 (file)
--- a/src/code/macroexpand.lisp
+++ b/src/code/macroexpand.lisp
@@ -28,7 +28,6 @@
   whenever a runtime expansion is needed. Initially this is set to
   FUNCALL.")
 
   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), expand it once. Return two values,
 (defun sb!xc:macroexpand-1 (form &optional env)
   #!+sb-doc
   "If form is a macro (or symbol macro), expand it once. Return two values,

@@ -36,37 +35,46 @@
    fact, a macro. ENV is the lexical environment to expand in, which defaults
    to the null environment."
   (cond ((and (consp form) (symbolp (car form)))
    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
-                               (coerce-to-lexenv env))
-                      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))
-                ((eq (info :variable :kind form) :macro)
-                 (values (info :variable :macro-expansion form) t))
-                (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.
 (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)
    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)))
     (frob form nil)))