X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Finfo-functions.lisp;h=b9dfd7137a4d1932bd1bc4ff7f4a2cc623255fea;hb=94ac5b7c3ff37850210b6fc9a7593cf1c5752993;hp=cd5327f62e9b21abbb2f9c52a55a9e61478914d8;hpb=012fbee7176df4472ef4add1a7df558d762bc4f6;p=sbcl.git diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp index cd5327f..b9dfd71 100644 --- a/src/compiler/info-functions.lisp +++ b/src/compiler/info-functions.lisp @@ -49,22 +49,23 @@ (:function) ; happy case ((nil)) ; another happy case (:macro ; maybe-not-so-good case - (compiler-style-warning "~S was previously defined as a macro." name) + (compiler-style-warn "~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 does PROCLAIM FTYPE in macroexpansion, - ;; 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, it's no longer a free function.) - (when (boundp '*free-functions*) ; when compiling - (remhash name *free-functions*)) + ;; (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-funs*) ; when compiling + (remhash name *free-funs*)) ;; recording the ordinary case (setf (info :function :kind name) :function) - (note-if-setf-function-and-macro name) + (note-if-setf-fun-and-macro name) (values)) @@ -74,11 +75,11 @@ ;;; 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) +(defun note-if-setf-fun-and-macro (name) (when (consp name) (when (or (info :setf :inverse name) (info :setf :expander name)) - (compiler-style-warning + (compiler-style-warn "defining as a SETF function a name that already has a SETF macro:~ ~% ~S" name))) @@ -150,7 +151,7 @@ else returns NIL. If ENV is unspecified or NIL, use the global environment only." (declare (symbol symbol)) - (let* ((fenv (when env (sb!c::lexenv-functions env))) + (let* ((fenv (when env (sb!c::lexenv-funs env))) (local-def (cdr (assoc symbol fenv)))) (cond (local-def (if (and (consp local-def) (eq (car local-def) 'MACRO)) @@ -193,7 +194,7 @@ definition, or declared NOTINLINE, NIL is returned. Can be set with SETF." (let ((found (and env - (cdr (assoc name (sb!c::lexenv-functions env) + (cdr (assoc name (sb!c::lexenv-funs env) :test #'equal))))) (unless (eq (cond ((sb!c::defined-fun-p found) (sb!c::defined-fun-inlinep found)) @@ -239,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 @@ -258,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))))