From e1744ff07d27f7c292df3e935ea1bbd2c8febd90 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Sat, 18 Jul 2020 10:08:28 -0600
Subject: [PATCH] If reloading mop.lisp, delete-package kmr-mop prior to
 redefining

---
 mop.lisp | 63 +++++++++++++++++++++++++++++---------------------------
 1 file changed, 33 insertions(+), 30 deletions(-)

diff --git a/mop.lisp b/mop.lisp
index f8aba54..7926252 100644
--- a/mop.lisp
+++ b/mop.lisp
@@ -19,12 +19,6 @@
 
 (in-package #:cl-user)
 
-#+sbcl
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (if (find-package 'sb-mop)
-      (pushnew 'kmrcl::sbcl-mop cl:*features*)
-      (pushnew 'kmrcl::sbcl-pcl cl:*features*)))
-
 #+cmu
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (if (eq (symbol-package 'pcl:find-class)
@@ -32,11 +26,13 @@
       (pushnew 'kmrcl::cmucl-mop cl:*features*)
       (pushnew 'kmrcl::cmucl-pcl cl:*features*)))
 
+(when (find-package '#:kmr-mop)
+  (delete-package '#:kmr-mop))
+
 (defpackage #:kmr-mop
   (:use
    #:cl
    #:kmrcl
-   #+kmrcl::sbcl-mop #:sb-mop
    #+kmrcl::cmucl-mop #:mop
    #+allegro #:mop
    #+lispworks #:clos
@@ -78,6 +74,36 @@
 
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
+  #+sbcl
+  (dolist (name '("CLASS-OF"
+                  "CLASS-NAME"
+                  "CLASS-SLOTS"
+                  "FIND-CLASS"
+                  "STANDARD-CLASS"
+                  "SLOT-DEFINITION-NAME"
+                  "FINALIZE-INHERITANCE"
+                  "STANDARD-DIRECT-SLOT-DEFINITION"
+                  "STANDARD-EFFECTIVE-SLOT-DEFINITION"
+                  "VALIDATE-SUPERCLASS" "DIRECT-SLOT-DEFINITION-CLASS"
+                  "EFFECTIVE-SLOT-DEFINITION-CLASS"
+                  "COMPUTE-EFFECTIVE-SLOT-DEFINITION"
+                  "CLASS-DIRECT-SLOTS"
+                  "COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS"
+                  "SLOT-VALUE-USING-CLASS"
+                  "CLASS-PROTOTYPE"
+                  "GENERIC-FUNCTION-METHOD-CLASS"
+                  "INTERN-EQL-SPECIALIZER"
+                  "MAKE-METHOD-LAMBDA"
+                  "GENERIC-FUNCTION-LAMBDA-LIST"
+                  "COMPUTE-SLOTS"))
+    (let ((sym (find-symbol name "SB-MOP")))
+      (if sym
+          (shadowing-import sym)
+          (progn
+            (setq sym (find-symbol name "SB-PCL"))
+            (when sym
+              (shadowing-import sym))))))
+  #-sbcl
   (shadowing-import
    #+allegro
    '(excl::compute-effective-slot-definition-initargs)
@@ -85,24 +111,6 @@
    '(clos::compute-effective-slot-definition-initargs)
    #+clisp
    '(clos::compute-effective-slot-definition-initargs)
-   #+sbcl
-   '(#+kmrcl::sbcl-mop class-of #-kmrcl::sbcl-mop sb-pcl:class-of
-     #+kmrcl::sbcl-mop class-name #-kmrcl::sbcl-mop sb-pcl:class-name
-     #+kmrcl::sbcl-mop class-slots #-kmrcl::sbcl-mop sb-pcl:class-slots
-     #+kmrcl::sbcl-mop find-class #-kmrcl::sbcl-mop sb-pcl:find-class
-     sb-pcl::standard-class
-     sb-pcl:slot-definition-name sb-pcl::finalize-inheritance
-     sb-pcl::standard-direct-slot-definition
-     sb-pcl::standard-effective-slot-definition sb-pcl::validate-superclass
-     sb-pcl::direct-slot-definition-class
-     sb-pcl::effective-slot-definition-class
-     sb-pcl::compute-effective-slot-definition
-     sb-pcl:class-direct-slots
-     sb-pcl::compute-effective-slot-definition-initargs
-     sb-pcl::slot-value-using-class
-     sb-pcl:class-prototype sb-pcl:generic-function-method-class sb-pcl:intern-eql-specializer
-     sb-pcl:make-method-lambda sb-pcl:generic-function-lambda-list
-     sb-pcl::compute-slots)
    #+cmu
    '(pcl:class-of  pcl:class-name pcl:class-slots pcl:find-class pcl::standard-class
      pcl::slot-definition-name pcl:finalize-inheritance
@@ -160,11 +168,6 @@
             process-slot-option
             process-class-option))
 
-  #+sbcl
-  (if (find-package 'sb-mop)
-      (setq cl:*features* (delete 'kmrcl::sbcl-mop cl:*features*))
-      (setq cl:*features* (delete 'kmrcl::sbcl-pcl cl:*features*)))
-
   #+cmu
   (if (find-package 'mop)
       (setq cl:*features* (delete 'kmrcl::cmucl-mop cl:*features*))
-- 
2.34.1