(in-package "SB!C")
\f
-;;; Check the legality of a function name that is being introduced.
-;;; -- If it names a macro, then give a warning and blast the macro
-;;; information.
-;;; -- If it is a structure slot accessor, give a warning and blast
-;;; the structure.
-;;; -- Check for conflicting setf macros.
-(declaim (ftype (function ((or symbol cons)) t) proclaim-as-function-name))
-(defun proclaim-as-function-name (name)
- (check-function-name name)
- (ecase (info :function :kind name)
- (:function
- (let ((accessor-for (info :function :accessor-for name)))
- (when accessor-for
- (compiler-warning
- "Undefining structure type:~% ~S~@
- so that this slot accessor can be redefined:~% ~S"
- (sb!xc:class-name accessor-for) name)
- ;; FIXME: This is such weird, unfriendly behavior.. (What if
- ;; the user didn't want his structure blasted?) It probably
- ;; violates ANSI, too. (Check this.) Perhaps instead of
- ;; undefining the structure, we should attach the lost
- ;; accessor function to SB-EXT:LOST-STRUCTURE-ACCESSORS on
- ;; the property list of the symbol which names the structure?
- (undefine-structure accessor-for)
- (setf (info :function :kind name) :function))))
- (:macro
- (compiler-style-warning "~S previously defined as a macro." name)
- (setf (info :function :kind name) :function)
- (setf (info :function :where-from name) :assumed)
- (clear-info :function :macro-function name))
- ((nil)
- (setf (info :function :kind name) :function)))
+;;;; 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-fun-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)))
+ (symbol
+ (when (eq (info :function :kind name) :special-form)
+ (compiler-error "Special form is an illegal function name: ~S" name)))
+ (t
+ (compiler-error "illegal function name: ~S" name)))
+ (values))
+
+;;; Record a new function definition, and check its legality.
+(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
+ ((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))))
+
+ ;; 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)
-;;; Make NAME no longer be a function name: clear everything back to the
-;;; default.
-(defun undefine-function-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
+;;; 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))
+
+;;; Make NAME no longer be a function name: clear everything back to
+;;; the default.
+(defun undefine-fun-name (name)
(when name
(macrolet ((frob (type &optional val)
`(unless (eq (info :function ,type name) ,val)
(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-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
;; FIXME: Should STRUCTURE-OBJECT and/or STANDARD-OBJECT be here?
;; They eval to themselves..
;;
- ;; KLUDGE: Someday it might be nice to make the code recognize foldable
+ ;; FIXME: Someday it would be nice to make the code recognize foldable
;; functions and call itself recursively on their arguments, so that
;; more of the examples in the ANSI CL definition are recognized.
;; (e.g. (+ 3 2), (SQRT PI), and (LENGTH '(A B C)))
(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)))
(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)