0.pre7.92:

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

diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp
index 64bba8d..2319a83 100644 (file)
--- a/src/compiler/info-functions.lisp
+++ b/src/compiler/info-functions.lisp
@@ -17,6 +17,8 @@
 
 (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
@@ -33,12 +35,15 @@
        (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-fun-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) ; happy case
@@ -47,9 +52,22 @@
        (compiler-style-warning "~S was previously defined as a macro." name)
        (setf (info :function :where-from name) :assumed)
        (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
@@ -92,6 +110,15 @@
     (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
@@ -213,7 +240,7 @@
         (symbol (values (info :variable :documentation x)))))
       (function
        (cond ((functionp x)
-             (function-doc x))
+             (%fun-doc x))
             ((legal-fun-name-p x)
              ;; FIXME: Is it really right to make
              ;; (DOCUMENTATION '(SETF FOO) 'FUNCTION) equivalent to
@@ -232,7 +259,7 @@
       (setf (info :setf :documentation x))
       ((t)
        (typecase x
-        (function (function-doc x))
+        (function (%fun-doc x))
         (package (package-doc-string x))
         (structure-class (values (info :type :documentation (class-name x))))
         (symbol (try-cmucl-random-doc x doc-type))))