0.pre7.86.flaky7.5:

[sbcl.git] / src / compiler / info-functions.lisp

diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp
index f6f51dd..9e41aeb 100644 (file)
--- a/src/compiler/info-functions.lisp
+++ b/src/compiler/info-functions.lisp
@@ -17,11 +17,13 @@
 
 (in-package "SB!C")
 \f
+;;;; internal utilities defined in terms of INFO
+
 ;;; Check that NAME is a valid function name, returning the name if
 ;;; OK, and signalling 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)
+(defun check-fun-name (name)
   (typecase name
     (list
      (unless (and (consp name) (consp (cdr name))
@@ -33,33 +35,39 @@
        (compiler-error "Special form is an illegal function name: ~S" name)))
     (t
      (compiler-error "illegal function name: ~S" name)))
-  name)
+  (values))
 
 ;;; Record a new function definition, and check its legality.
-(declaim (ftype (function ((or symbol cons)) t) proclaim-as-function-name))
-(defun proclaim-as-function-name (name)
-  (check-function-name name)
+(defun proclaim-as-fun-name (name)
+
+  ;; legal name?
+  (check-fun-name name)
+
+  ;; scrubbing old data I: possible collision with old definition
   (when (fboundp name)
     (ecase (info :function :kind name)
-      (:function
-       (let ((accessor-for (info :function :accessor-for name)))
-        (when accessor-for
-          (compiler-style-warning
-           "~@<The function ~
-           ~2I~_~S ~
-           ~I~_was previously defined as a slot accessor for ~
-           ~2I~_~S.~:>"
-           name
-           accessor-for)
-          (clear-info :function :accessor-for name))))
-      (:macro
+      (:function) ; happy case
+      ((nil)) ; another happy case
+      (:macro ; maybe-not-so-good case
        (compiler-style-warning "~S was previously defined as a macro." name)
        (setf (info :function :where-from name) :assumed)
-       (clear-info :function :macro-function name))
-      ((nil))))
+       (clear-info :function :macro-function name))))
+
+  ;; scrubbing old data II: dangling forward references
+  ;;
+  ;; (This could happen if someone executes PROCLAIM FTYPE at
+  ;; macroexpansion time, which is bad style, or at compile time, e.g.
+  ;; in EVAL-WHEN (:COMPILE) inside something like DEFSTRUCT, in which
+  ;; case it's reasonable style. Either way, NAME is no longer a free
+  ;; function.)
+  (when (boundp '*free-functions*) ; when compiling
+    (remhash name *free-functions*))
+
+  ;; recording the ordinary case
   (setf (info :function :kind name) :function)
   (note-if-setf-function-and-macro name)
-  name)
+
+  (values))
 
 ;;; This is called to do something about SETF functions that overlap
 ;;; with SETF macros. Perhaps we should interact with the user to see
@@ -79,7 +87,7 @@
 
 ;;; Make NAME no longer be a function name: clear everything back to
 ;;; the default.
-(defun undefine-function-name (name)
+(defun undefine-fun-name (name)
   (when name
     (macrolet ((frob (type &optional val)
                 `(unless (eq (info :function ,type name) ,val)
@@ -89,20 +97,28 @@
       (frob :where-from :assumed)
       (frob :inlinep)
       (frob :kind)
-      (frob :accessor-for)
-      (frob :inline-expansion)
+      (frob :inline-expansion-designator)
       (frob :source-transform)
       (frob :assumed-type)))
   (values))
 
 ;;; part of what happens with DEFUN, also with some PCL stuff: Make
 ;;; NAME known to be a function definition.
-(defun become-defined-function-name (name)
-  (proclaim-as-function-name name)
+(defun become-defined-fun-name (name)
+  (proclaim-as-fun-name name)
   (when (eq (info :function :where-from name) :assumed)
     (setf (info :function :where-from name) :defined)
     (if (info :function :assumed-type name)
        (setf (info :function :assumed-type name) nil))))
+
+;;; Decode any raw (INFO :FUNCTION :INLINE-EXPANSION-DESIGNATOR FUN-NAME)
+;;; value into a lambda expression, or return NIL if there is none.
+(declaim (ftype (function ((or symbol cons)) list) fun-name-inline-expansion))
+(defun fun-name-inline-expansion (fun-name)
+  (let ((info (info :function :inline-expansion-designator fun-name)))
+    (if (functionp info)
+       (funcall info)
+       info)))
 \f
 ;;;; ANSI Common Lisp functions which are defined in terms of the info
 ;;;; database
@@ -180,8 +196,8 @@
   (let ((found (and env
                    (cdr (assoc name (sb!c::lexenv-functions env)
                                :test #'equal)))))
-    (unless (eq (cond ((sb!c::defined-function-p found)
-                      (sb!c::defined-function-inlinep found))
+    (unless (eq (cond ((sb!c::defined-fun-p found)
+                      (sb!c::defined-fun-inlinep found))
                      (found :notinline)
                      (t
                       (info :function :inlinep name)))
@@ -225,13 +241,13 @@
       (function
        (cond ((functionp x)
              (function-doc x))
-            ((legal-function-name-p x)
+            ((legal-fun-name-p x)
              ;; FIXME: Is it really right to make
              ;; (DOCUMENTATION '(SETF FOO) 'FUNCTION) equivalent to
              ;; (DOCUMENTATION 'FOO 'FUNCTION)? That's what CMU CL
              ;; did, so we do it, but I'm not sure it's what ANSI wants.
              (values (info :function :documentation
-                           (function-name-block-name x))))))
+                           (fun-name-block-name x))))))
       (structure
        (typecase x
         (symbol (when (eq (info :type :kind x) :instance)