diff --git a/pcl/boot.lisp b/pcl/boot.lisp index 30f861ac4fcb013d12b4430e0e75dd868c123cd4..e388f857f976258e399809c337cf302f55af46d5 100644 --- a/pcl/boot.lisp +++ b/pcl/boot.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.26 2001/05/10 21:28:41 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.27 2002/03/12 16:22:23 pmai Exp $") (in-package :pcl) @@ -1250,24 +1250,30 @@ work during bootstrapping. &allow-other-keys) (declare (ignore environment)) #+copy-&rest-arg (setq all-keys (copy-list all-keys)) - (let ((existing (and (fboundp function-specifier) + (let ((existing (and (fboundp function-specifier) (gdefinition function-specifier)))) - (if (and existing - (eq *boot-state* 'complete) - (null (generic-function-p existing))) - (generic-clobbers-function function-specifier) - (apply #'ensure-generic-function-using-class - existing function-specifier all-keys)))) + (when (and existing + (eq *boot-state* 'complete) + (null (generic-function-p existing))) + (generic-clobbers-function function-specifier) + (setq existing nil)) + (apply #'ensure-generic-function-using-class + existing function-specifier all-keys))) (defun generic-clobbers-function (function-specifier) - (error 'kernel:simple-program-error - :format-control - "~S already names an ordinary function or a macro,~%~ - you may want to replace it with a generic function, but doing so~%~ - will require that you decide what to do with the existing function~%~ - definition.~%~ - The PCL-specific function MAKE-SPECIALIZABLE may be useful to you." - :format-arguments (list function-specifier))) + (restart-case + (error + 'kernel:simple-program-error + :format-control + "~S already names an ordinary function or a macro.~%~ + If you want to replace it with a generic function, you should remove~%~ + the existing definition beforehand.~%" + :format-arguments (list function-specifier)) + (continue () + :report (lambda (stream) + (format stream "Discard the existing definition of ~S." + function-specifier)) + (fmakunbound function-specifier)))) (defvar *sgf-wrapper* (boot-make-wrapper (early-class-size 'standard-generic-function)