X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fproclaim.lisp;h=0a6e7e385232a8d8701cc5b94022b5e7a884a4c4;hb=0a82f2db352cc348d2107a882e50af222ff97ed3;hp=4c86f5f19cf5d661447b6e8743e503365697ed29;hpb=1513b29bfbe948e7b431b5f67f1ff10769c192cf;p=sbcl.git

diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp
index 4c86f5f..0a6e7e3 100644
--- a/src/compiler/proclaim.lisp
+++ b/src/compiler/proclaim.lisp
@@ -125,53 +125,42 @@
 	   (unless (csubtypep type (specifier-type 'function))
 	     (error "not a function type: ~S" (first args)))
 	   (dolist (name (rest args))
-	     (cond ((info :function :accessor-for name)
-		    ;; FIXME: This used to be a WARNING, which was
-		    ;; clearly wrong, since it would cause warnings to
-		    ;; be issued for conforming code, which is really
-		    ;; annoying for people who use Lisp code to build
-		    ;; Lisp systems (and check the return values from
-		    ;; COMPILE and COMPILE-FILE). Changing it to a
-		    ;; compiler note is somewhat better, since it's
-		    ;; after all news about a limitation of the
-		    ;; compiler, not a problem in the code. But even
-		    ;; better would be to handle FTYPE proclamations
-		    ;; for slot accessors, and since in the long run
-		    ;; slot accessors should become more like other
-		    ;; functions, this should eventually become
-		    ;; straightforward.
-		    (maybe-compiler-note
-		     "~@<ignoring FTYPE proclamation for ~
-                      slot accessor (currently unsupported): ~2I~_~S~:>"
-		     name))
-		   (t
 
-		    ;; KLUDGE: Something like the commented-out TYPE/=
-		    ;; check here would be nice, but it has been
-		    ;; commented out because TYPE/= doesn't support
-		    ;; function types. It could probably be made to do
-		    ;; so, but it might take some time, since function
-		    ;; types involve values types, which aren't
-		    ;; supported, and since the SUBTYPEP operator for
-		    ;; FUNCTION types is rather broken, e.g.
-		    ;;   (SUBTYPEP '(FUNCTION (T BOOLEAN) NIL)
-		    ;;             '(FUNCTION (FIXNUM FIXNUM) NIL)) => T, T
-		    ;; -- WHN 20000229
-		    #+nil
-		    (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)))))
+	     ;; KLUDGE: Something like the commented-out TYPE/=
+	     ;; check here would be nice, but it has been
+	     ;; commented out because TYPE/= doesn't support
+	     ;; function types. It could probably be made to do
+	     ;; so, but it might take some time, since function
+	     ;; types involve values types, which aren't
+	     ;; supported, and since the SUBTYPEP operator for
+	     ;; FUNCTION types is rather broken, e.g.
+	     ;;   (SUBTYPEP '(FUNCTION (T BOOLEAN) NIL)
+	     ;;             '(FUNCTION (FIXNUM FIXNUM) NIL)) => T, T
+	     ;; -- WHN 20000229
+	     #|
+	     (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)))))
+             |#
+
+	     ;; Now references to this function shouldn't be warned
+	     ;; about as undefined, since even if we haven't seen a
+	     ;; definition yet, we know one is planned. (But if this
+	     ;; function name was already declared as a structure
+	     ;; accessor, then that was already been taken care of.)
+	     (unless (info :function :accessor-for name)
+	       (proclaim-as-fun-name name)
+	       (note-name-defined name :function))
 
-		    (proclaim-as-function-name name)
-		    (note-name-defined name :function)
-		    (setf (info :function :type name) type
-			  (info :function :where-from name) :declared)))))))
+	     ;; the actual type declaration
+	     (setf (info :function :type name) type
+		   (info :function :where-from name) :declared)))))
       (freeze-type
        (dolist (type args)
 	 (let ((class (specifier-type type)))
@@ -186,7 +175,7 @@
        (setq *policy* (process-optimize-decl form *policy*)))
       ((inline notinline maybe-inline)
        (dolist (name args)
-	 ;; (CMU CL did (PROCLAIM-AS-FUNCTION-NAME NAME) here, but that
+	 ;; (CMU CL did (PROCLAIM-AS-FUN-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)