0.pre7.37:

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

diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp
index e2be4a2..4c86f5f 100644 (file)
--- a/src/compiler/proclaim.lisp
+++ b/src/compiler/proclaim.lisp
@@ -19,41 +19,6 @@
 (defvar *undefined-warnings*)
 (declaim (list *undefined-warnings*))
 
-;;; Check that NAME is a valid function name, returning the name if
-;;; OK, and doing an error if not. In addition to checking for basic
-;;; well-formedness, we also check that symbol names are not NIL or
-;;; the name of a special form.
-(defun check-function-name (name)
-  (typecase name
-    (list
-     (unless (and (consp name) (consp (cdr name))
-                 (null (cddr name)) (eq (car name) 'setf)
-                 (symbolp (cadr name)))
-       (compiler-error "illegal function name: ~S" name))
-     name)
-    (symbol
-     (when (eq (info :function :kind name) :special-form)
-       (compiler-error "Special form is an illegal function name: ~S" name))
-     name)
-    (t
-     (compiler-error "illegal function name: ~S" name))))
-
-;;; This is called to do something about SETF functions that overlap
-;;; with SETF macros. Perhaps we should interact with the user to see
-;;; whether the macro should be blown away, but for now just give a
-;;; warning. Due to the weak semantics of the (SETF FUNCTION) name, we
-;;; can't assume that they aren't just naming a function (SETF FOO)
-;;; for the heck of it. NAME is already known to be well-formed.
-(defun note-if-setf-function-and-macro (name)
-  (when (consp name)
-    (when (or (info :setf :inverse name)
-             (info :setf :expander name))
-      (compiler-style-warning
-       "defining as a SETF function a name that already has a SETF macro:~
-       ~%  ~S"
-       name)))
-  (values))
-
 ;;; Look up some symbols in *FREE-VARIABLES*, returning the var
 ;;; structures for any which exist. If any of the names aren't
 ;;; symbols, we complain.
@@ -102,7 +67,7 @@
 (defun canonized-decl-spec (decl-spec)
   (let ((id (first decl-spec)))
     (unless (symbolp id)
-      (error "The declaration identifier is not a symbol: ~S" what))
+      (error "The declaration identifier is not a symbol: ~S" id))
     (let ((id-is-type (info :type :kind id))
          (id-is-declared-decl (info :declaration :recognized id)))
       (cond ((and id-is-type id-is-declared-decl)
@@ -196,11 +161,12 @@
                    (when (eq (info :function :where-from name) :declared)
                      (let ((old-type (info :function :type name)))
                        (when (type/= type old-type)
-                         (style-warn "new FTYPE proclamation~@
-                                       ~S~@
-                                       for ~S does not match old FTYPE proclamation~@
-                                       ~S"
-                                     (list type name old-type)))))
+                         (style-warn
+                          "new FTYPE proclamation~@
+                            ~S~@
+                            for ~S does not match old FTYPE proclamation~@
+                            ~S"
+                          (list type name old-type)))))
 
                    (proclaim-as-function-name name)
                    (note-name-defined name :function)
@@ -209,7 +175,7 @@
       (freeze-type
        (dolist (type args)
         (let ((class (specifier-type type)))
-          (when (typep class 'class)
+          (when (typep class 'sb!xc:class)
             (setf (class-state class) :sealed)
             (let ((subclasses (class-subclasses class)))
               (when subclasses
@@ -218,14 +184,13 @@
                   (setf (class-state subclass) :sealed))))))))
       (optimize
        (setq *policy* (process-optimize-decl form *policy*)))
-      (optimize-interface
-       (setq *interface-policy*
-            (process-optimize-decl form *interface-policy*)))
       ((inline notinline maybe-inline)
        (dolist (name args)
-        (proclaim-as-function-name name)
+        ;; (CMU CL did (PROCLAIM-AS-FUNCTION-NAME NAME) here, but that
+        ;; seems more likely to surprise the user than to help him, so
+        ;; we don't do it.)
         (setf (info :function :inlinep name)
-              (case kind
+              (ecase kind
                 (inline :inline)
                 (notinline :notinline)
                 (maybe-inline :maybe-inline)))))