0.7.7.12:

[sbcl.git] / src / compiler / ir1tran.lisp

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 269345d..b5ad3de 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -586,22 +586,31 @@
   (values))
 
 ;;; Convert anything that looks like a special form, global function
-;;; or macro call.
+;;; or compiler-macro call.
 (defun ir1-convert-global-functoid (start cont form)
   (declare (type continuation start cont) (list form))
-  (let* ((fun (first form))
-        (translator (info :function :ir1-convert fun))
-        (cmacro (info :function :compiler-macro-function fun)))
-    (cond (translator (funcall translator start cont form))
-         ((and cmacro
-               (not (eq (info :function :inlinep fun)
-                        :notinline)))
-          (let ((res (careful-expand-macro cmacro form)))
+  (let* ((fun-name (first form))
+        (translator (info :function :ir1-convert fun-name))
+        (cmacro-fun (sb!xc:compiler-macro-function fun-name *lexenv*)))
+    (cond (translator
+          (when cmacro-fun
+            (compiler-warn "ignoring compiler macro for special form"))
+          (funcall translator start cont form))
+         ((and cmacro-fun
+               ;; gotcha: If you look up the DEFINE-COMPILER-MACRO
+               ;; macro in the ANSI spec, you might think that
+               ;; suppressing compiler-macro expansion when NOTINLINE
+               ;; is some pre-ANSI hack. However, if you look up the
+               ;; NOTINLINE declaration, you'll find that ANSI
+               ;; requires this behavior after all.
+               (not (eq (info :function :inlinep fun-name) :notinline)))
+          (let ((res (careful-expand-macro cmacro-fun form)))
             (if (eq res form)
-                (ir1-convert-global-functoid-no-cmacro start cont form fun)
+                (ir1-convert-global-functoid-no-cmacro
+                 start cont form fun-name)
                 (ir1-convert start cont res))))
          (t
-          (ir1-convert-global-functoid-no-cmacro start cont form fun)))))
+          (ir1-convert-global-functoid-no-cmacro start cont form fun-name)))))
 
 ;;; Handle the case of where the call was not a compiler macro, or was
 ;;; a compiler macro and passed.
@@ -1224,9 +1233,10 @@
 (declaim (ftype (function (list) (values list boolean boolean list list))
                make-lambda-vars))
 (defun make-lambda-vars (list)
-  (multiple-value-bind (required optional restp rest keyp keys allowp aux
+  (multiple-value-bind (required optional restp rest keyp keys allowp auxp aux
                        morep more-context more-count)
       (parse-lambda-list list)
+    (declare (ignore auxp)) ; since we just iterate over AUX regardless
     (collect ((vars)
              (names-so-far)
              (aux-vars)
@@ -1940,7 +1950,7 @@
 
   (multiple-value-bind (vars keyp allow-other-keys aux-vars aux-vals)
       (make-lambda-vars (cadr form))
-    (multiple-value-bind (forms decls) (sb!sys:parse-body (cddr form))
+    (multiple-value-bind (forms decls) (parse-body (cddr form))
       (let* ((result-cont (make-continuation))
             (*lexenv* (process-decls decls
                                      (append aux-vars vars)
@@ -1988,9 +1998,9 @@
                          :source-name source-name
                          :debug-name debug-name))))
 
-;;; Get a DEFINED-FUN object for a function we are about to
-;;; define. If the function has been forward referenced, then
-;;; substitute for the previous references.
+;;; Get a DEFINED-FUN object for a function we are about to define. If
+;;; the function has been forward referenced, then substitute for the
+;;; previous references.
 (defun get-defined-fun (name)
   (proclaim-as-fun-name name)
   (let ((found (find-free-fun name "shouldn't happen! (defined-fun)")))