prettier backtraces

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

diff --git a/src/code/macroexpand.lisp b/src/code/macroexpand.lisp
index 4806e01..cb60c38 100644 (file)
--- a/src/code/macroexpand.lisp
+++ b/src/code/macroexpand.lisp
@@ -15,7 +15,7 @@
 
 (defun sb!xc:special-operator-p (symbol)
   #!+sb-doc
 
 (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))
 
   (declare (symbol symbol))
   (eq (info :function :kind symbol) :special-form))
 

@@ -28,42 +28,53 @@
   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
 (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
    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)))
    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.
 (defun sb!xc:macroexpand (form &optional env)
   #!+sb-doc
   "Repetitively call MACROEXPAND-1 until the form can no longer be expanded.

@@ -71,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)))