From 24d9fc8fe248b40d13d08592f0fadc1826f8dfe2 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Sat, 31 Jul 1993 20:21:51 +0000 Subject: [PATCH] Added stuff to blow away the old class definitions of any loaded PCL. --- tools/pclcom.lisp | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/tools/pclcom.lisp b/tools/pclcom.lisp index a01046cde..b89eef1c9 100644 --- a/tools/pclcom.lisp +++ b/tools/pclcom.lisp @@ -2,8 +2,38 @@ (in-package "USER") (when (find-package "PCL") + ;; + ;; Undefine all generic functions exported from Lisp so that bootstrapping + ;; doesn't get confused. + (let ((class (find-class 'generic-function nil))) + (when class + (do-external-symbols (sym "LISP") + (when (and (fboundp sym) + (typep (fdefinition sym) class)) + (fmakunbound sym)) + (let ((ssym `(setf ,sym))) + (when (and (fboundp ssym) + (typep (fdefinition ssym) class)) + (fmakunbound ssym)))))) + + ;; Undefine all PCL classes, and clear CLASS-PCL-CLASS slots. + (let ((wot (find-symbol "*FIND-CLASS*" "PCL"))) + (when (and wot (boundp wot)) + (do-hash (name ignore (symbol-value wot)) + (declare (ignore ignore)) + (let ((class (find-class name nil))) + (cond ((not class)) + ((typep class 'kernel::std-class) + (setf (kernel:class-cell-class + (kernel:find-class-cell name)) + nil) + (setf (info type kind name) nil)) + (t + (setf (kernel:class-pcl-class class) nil))))))) + (rename-package "PCL" "OLD-PCL") (make-package "PCL")) + (when (find-package "SLOT-ACCESSOR-NAME") (rename-package "SLOT-ACCESSOR-NAME" "OLD-SLOT-ACCESSOR-NAME")) -- GitLab