X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Finfo-functions.lisp;h=81d35254e91995977ad559a0f15dab0d62dd54a8;hb=4dbc52ee4f9a4f566701f1d33e7916e8491b918b;hp=2319a8304e2064224c3a743fc531a998f2bd34b2;hpb=cd176690400f8b6fa23faa4dc6fa8494bcbce480;p=sbcl.git

diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp
index 2319a83..81d3525 100644
--- a/src/compiler/info-functions.lisp
+++ b/src/compiler/info-functions.lisp
@@ -49,7 +49,7 @@
       (: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))))
 
@@ -60,12 +60,12 @@
   ;; 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*))
+  (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))
 
@@ -75,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)))
@@ -151,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))
@@ -189,23 +189,23 @@
 
 (defun sb!xc:compiler-macro-function (name &optional env)
   #!+sb-doc
-  "If NAME names a compiler-macro, returns the expansion function,
-   else returns NIL. Note: if the name is shadowed in ENV by a local
-   definition, or declared NOTINLINE, NIL is returned. Can be
-   set with SETF."
-  (let ((found (and env
-		    (cdr (assoc name (sb!c::lexenv-functions env)
-				:test #'equal)))))
-    (unless (eq (cond ((sb!c::defined-fun-p found)
-		       (sb!c::defined-fun-inlinep found))
-		      (found :notinline)
-		      (t
-		       (info :function :inlinep name)))
-		:notinline)
-      (values (info :function :compiler-macro-function name)))))
-(defun (setf sb!xc:compiler-macro-function) (function name)
+  "If NAME names a compiler-macro in ENV, return the expansion function, else
+   return NIL. Can be set with SETF when ENV is NIL."
+  (legal-fun-name-or-type-error name)
+  ;; Note: CMU CL used to return NIL here when a NOTINLINE declaration
+  ;; was in force. That's fairly logical, given the specified effect
+  ;; of NOTINLINE declarations on compiler-macro expansion. However,
+  ;; (1) it doesn't seem to be consistent with the ANSI spec for
+  ;; COMPILER-MACRO-FUNCTION, and (2) it would give surprising
+  ;; behavior for (SETF (COMPILER-MACRO-FUNCTION FOO) ...) in the
+  ;; presence of a (PROCLAIM '(NOTINLINE FOO)). So we don't do it.
+  (values (info :function :compiler-macro-function name)))
+(defun (setf sb!xc:compiler-macro-function) (function name &optional env)
   (declare (type (or symbol list) name)
 	   (type (or function null) function))
+  (when env
+    ;; ANSI says this operation is undefined.
+    (error "can't SETF COMPILER-MACRO-FUNCTION when ENV is non-NIL"))
   (when (eq (info :function :kind name) :special-form)
     (error "~S names a special form." name))
   (setf (info :function :compiler-macro-function name) function)