0.8.15.15: Removing non-ANSI FTYPE proclaims and TYPE declarares from PCL

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

diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index 4ef3dc0..0843787 100644 (file)
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -54,14 +54,6 @@
 ;;; and some things (e.g., READ-CHAR) can't afford this excessive
 ;;; consing, we bend backwards a little.
 ;;;
-;;; FIXME: In reality, this restart cruft is needed hardly anywhere in
-;;; the system. Write NEED and NEED-TYPE to replace ASSERT and
-;;; CHECK-TYPE inside the system. (CL:CHECK-TYPE must still be
-;;; defined, since it's specified by ANSI and it is sometimes nice for
-;;; whipping up little things. But as far as I can tell it's not
-;;; usually very helpful deep inside the guts of a complex system like
-;;; SBCL.)
-;;;
 ;;; CHECK-TYPE-ERROR isn't defined until a later file because it uses
 ;;; the macro RESTART-CASE, which isn't defined until a later file.
 (defmacro-mundanely check-type (place type &optional type-string)
@@ -87,6 +79,8 @@
     (error 'simple-type-error :datum name :expected-type 'symbol
           :format-control "Symbol macro name is not a symbol: ~S."
           :format-arguments (list name)))
+  (with-single-package-locked-error 
+      (:symbol name "defining ~A as a symbol-macro"))
   (ecase (info :variable :kind name)
     ((:macro :global nil)
      (setf (info :variable :kind name) :macro)
@@ -134,7 +128,7 @@
       (let ((def `(lambda (,whole ,environment)
                    ,@local-decs
                    ,body))
-           (debug-name (debug-namify "DEFINE-COMPILER-MACRO ~S" name)))
+           (debug-name (sb!c::debug-namify "DEFINE-COMPILER-MACRO " name)))
        `(eval-when (:compile-toplevel :load-toplevel :execute)
          (sb!c::%define-compiler-macro ',name
                                        #',def
@@ -168,8 +162,7 @@
                              lambda-list
                             (%simple-fun-name (%closure-fun definition))
                             debug-name))
-                      ((#.sb!vm:simple-fun-header-widetag
-                        #.sb!vm:closure-fun-header-widetag)
+                      (#.sb!vm:simple-fun-header-widetag
                        (setf (%simple-fun-arglist definition) lambda-list
                             (%simple-fun-name definition) debug-name))))
             name))))