X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Finfo-functions.lisp;h=8384932716f440e69503e800f231de11a2153b3f;hb=0a82f2db352cc348d2107a882e50af222ff97ed3;hp=df45fa3bdaa7594607490642bfdcc3893fc8bf15;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp index df45fa3..8384932 100644 --- a/src/compiler/info-functions.lisp +++ b/src/compiler/info-functions.lisp @@ -16,48 +16,70 @@ ;;;; files for more information. (in-package "SB!C") - -(file-comment - "$Header$") -;;; 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))) +;;; 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))) + name) + +;;; 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) + (check-fun-name name) + (when (fboundp name) + (ecase (info :function :kind name) + (:function + (let ((accessor-for (info :function :accessor-for name))) + (when accessor-for + (compiler-style-warning + "~@" + name + accessor-for) + (clear-info :function :accessor-for name)))) + (:macro + (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)))) + (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) +;;; 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) @@ -68,10 +90,19 @@ (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)))) ;;;; ANSI Common Lisp functions which are defined in terms of the info ;;;; database @@ -83,7 +114,7 @@ ;; 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))) @@ -194,13 +225,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)