diff --git a/code/macros.lisp b/code/macros.lisp index 2a7f74c252f4925c95832c00bcaf50505e368bc1..475f6ee8be6d26692291871a7f14c9be37c42a5b 100644 --- a/code/macros.lisp +++ b/code/macros.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.113 2009/06/18 17:34:58 rtoy Rel $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.114 2010/03/18 16:43:11 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -351,12 +351,12 @@ ;;; Similar to %Defmacro, ... ;;; (defun c::%%defun (name def doc &optional inline-expansion) + (c::define-function-name name) (setf (fdefinition name) def) (when doc (if (and (consp name) (eq (first name) 'setf)) (setf (documentation (second name) 'setf) doc) (setf (documentation name 'function) doc))) - (c::define-function-name name) (when (eq (info function where-from name) :assumed) (setf (info function where-from name) :defined) (when (info function assumed-type name) diff --git a/compiler/main.lisp b/compiler/main.lisp index 7afaff77c70e6498be28ab963baf2cd9fb7af146..7e2ef3a8a79fd8b1b696ff93d184e246cb0e01a7 100644 --- a/compiler/main.lisp +++ b/compiler/main.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.151 2010/03/16 14:13:24 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.152 2010/03/18 16:43:12 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1919,6 +1919,7 @@ in the user USER-INFO slot of STREAM-SOURCE-LOCATIONs.") (defun compile-fix-function-name (lambda name) (declare (type clambda lambda) (type (or symbol cons) name)) (when name + (note-if-accessor name) (let ((fun (ref-leaf (continuation-next (node-cont (lambda-bind lambda)))))) diff --git a/compiler/proclaim.lisp b/compiler/proclaim.lisp index b32ae70d08a914c4b7dd4a9dfd25665aa8bb618d..8217e21e6ad2093c2cb6f18d90d98b7a0cae4079 100644 --- a/compiler/proclaim.lisp +++ b/compiler/proclaim.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/proclaim.lisp,v 1.44 2007/11/14 10:04:35 cshapiro Rel $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/proclaim.lisp,v 1.45 2010/03/18 16:43:12 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -224,28 +224,35 @@ name))) (undefined-value)) +;;; Note-If-Accessor -- Interface +;;; +;;; Check if Name is also the name of a slot accessor for some +;;; structure. If it is, we signal an continuable error. If we +;;; continue, assume the user knows what he's doing and redefine the +;;; function. +(defun note-if-accessor (name) + (let ((for (info function accessor-for name))) + (when for + (cerror "Assume redefinition is compatible and allow it" + "Redefining slot accessor ~S for structure type ~S" + name (%class-name for)) + ;;(undefine-structure for) + (setf (info function kind name) :function)))) ;;; Define-Function-Name -- Interface ;;; ;;; 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. +;;; -- If it is a structure slot accessor, give a continuable error +;;; and allow redefinition if continued. ;;; -- Check for conflicting setf macros. ;;; (defun define-function-name (name) (check-function-name name) (ecase (info function kind name) (:function - (let ((for (info function accessor-for name))) - (when for - (compiler-warning - "Undefining structure type:~% ~S~@ - so that this slot accessor can be redefined:~% ~S" - (%class-name for) name) - (undefine-structure for) - (setf (info function kind name) :function)))) + (note-if-accessor name)) (:macro (compiler-warning "~S previously defined as a macro." name) (setf (info function kind name) :function)