From 5c5adb1297021e440fa4943ef996c59ed9681178 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Fri, 17 Jul 2020 17:33:12 -0600
Subject: [PATCH] For SBCL, first check sb-mop for symbols to import, if not
 found check sb-pcl

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

diff --git a/mop.lisp b/mop.lisp
index f8aba54..98fb9e9 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)
@@ -36,7 +30,6 @@
   (:use
    #:cl
    #:kmrcl
-   #+kmrcl::sbcl-mop #:sb-mop
    #+kmrcl::cmucl-mop #:mop
    #+allegro #:mop
    #+lispworks #:clos
@@ -78,6 +71,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 +108,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 +165,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