Skip to content
Snippets Groups Projects
Commit e1744ff0 authored by Kevin M. Rosenberg's avatar Kevin M. Rosenberg
Browse files

If reloading mop.lisp, delete-package kmr-mop prior to redefining

parent 5260068b
No related branches found
No related tags found
No related merge requests found
...@@ -19,12 +19,6 @@ ...@@ -19,12 +19,6 @@
(in-package #:cl-user) (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 #+cmu
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(if (eq (symbol-package 'pcl:find-class) (if (eq (symbol-package 'pcl:find-class)
...@@ -32,11 +26,13 @@ ...@@ -32,11 +26,13 @@
(pushnew 'kmrcl::cmucl-mop cl:*features*) (pushnew 'kmrcl::cmucl-mop cl:*features*)
(pushnew 'kmrcl::cmucl-pcl cl:*features*))) (pushnew 'kmrcl::cmucl-pcl cl:*features*)))
(when (find-package '#:kmr-mop)
(delete-package '#:kmr-mop))
(defpackage #:kmr-mop (defpackage #:kmr-mop
(:use (:use
#:cl #:cl
#:kmrcl #:kmrcl
#+kmrcl::sbcl-mop #:sb-mop
#+kmrcl::cmucl-mop #:mop #+kmrcl::cmucl-mop #:mop
#+allegro #:mop #+allegro #:mop
#+lispworks #:clos #+lispworks #:clos
...@@ -78,6 +74,36 @@ ...@@ -78,6 +74,36 @@
(eval-when (:compile-toplevel :load-toplevel :execute) (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 (shadowing-import
#+allegro #+allegro
'(excl::compute-effective-slot-definition-initargs) '(excl::compute-effective-slot-definition-initargs)
...@@ -85,24 +111,6 @@ ...@@ -85,24 +111,6 @@
'(clos::compute-effective-slot-definition-initargs) '(clos::compute-effective-slot-definition-initargs)
#+clisp #+clisp
'(clos::compute-effective-slot-definition-initargs) '(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 #+cmu
'(pcl:class-of pcl:class-name pcl:class-slots pcl:find-class pcl::standard-class '(pcl:class-of pcl:class-name pcl:class-slots pcl:find-class pcl::standard-class
pcl::slot-definition-name pcl:finalize-inheritance pcl::slot-definition-name pcl:finalize-inheritance
...@@ -160,11 +168,6 @@ ...@@ -160,11 +168,6 @@
process-slot-option process-slot-option
process-class-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 #+cmu
(if (find-package 'mop) (if (find-package 'mop)
(setq cl:*features* (delete 'kmrcl::cmucl-mop cl:*features*)) (setq cl:*features* (delete 'kmrcl::cmucl-mop cl:*features*))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment