X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=mop.lisp;h=f8aba54c1f26ae47ed39b74987ed1c056938e15f;hp=f6bd037d1fb8cba81ba694c2ed969fd2ebd45723;hb=251043d4c96c996a35cd48c4452b03fbef2ea21a;hpb=34155b65860404099c8e178dc7c7db0a919c607a

diff --git a/mop.lisp b/mop.lisp
index f6bd037..f8aba54 100644
--- a/mop.lisp
+++ b/mop.lisp
@@ -7,9 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2003
 ;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of KMRCL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
 ;;;;
 ;;;; KMRCL users are granted the rights to distribute and use this software
 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
@@ -24,27 +22,27 @@
 #+sbcl
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (if (find-package 'sb-mop)
-      (pushnew :kmr-sbcl-mop cl:*features*)
-      (pushnew :kmr-sbcl-pcl cl:*features*)))
+      (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)
           (find-package 'common-lisp))
-      (pushnew :kmr-cmucl-mop cl:*features*)
-      (pushnew :kmr-cmucl-pcl cl:*features*)))
+      (pushnew 'kmrcl::cmucl-mop cl:*features*)
+      (pushnew 'kmrcl::cmucl-pcl cl:*features*)))
 
 (defpackage #:kmr-mop
   (:use
    #:cl
    #:kmrcl
-   #+kmr-sbcl-mop #:sb-mop
-   #+kmr-cmucl-mop #:mop
+   #+kmrcl::sbcl-mop #:sb-mop
+   #+kmrcl::cmucl-mop #:mop
    #+allegro #:mop
    #+lispworks #:clos
    #+clisp #:clos
    #+scl #:clos
-   #+openmcl #:openmcl-mop
+   #+ccl #:openmcl-mop
    )
   )
 
@@ -88,10 +86,10 @@
    #+clisp
    '(clos::compute-effective-slot-definition-initargs)
    #+sbcl
-   '(#+kmr-sbcl-mop class-of #-kmr-sbcl-mop sb-pcl:class-of
-     #+kmr-sbcl-mop class-name #-kmr-sbcl-mop sb-pcl:class-name
-     #+kmr-sbcl-mop class-slots #-kmr-sbcl-mop sb-pcl:class-slots
-     #+kmr-sbcl-mop find-class #-kmr-sbcl-mop sb-pcl:find-class
+   '(#+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
@@ -132,7 +130,7 @@
      clos::compute-slots
      ;; note: make-method-lambda is not fbound
      )
-   #+openmcl
+   #+ccl
    '(openmcl-mop::slot-definition-name openmcl-mop:finalize-inheritance
      openmcl-mop::standard-direct-slot-definition openmcl-mop::standard-effective-slot-definition
      openmcl-mop::validate-superclass openmcl-mop:direct-slot-definition-class openmcl-mop::effective-slot-definition-class
@@ -164,24 +162,24 @@
 
   #+sbcl
   (if (find-package 'sb-mop)
-      (setq cl:*features* (delete :kmr-sbcl-mop cl:*features*))
-      (setq cl:*features* (delete :kmr-sbcl-pcl cl:*features*)))
+      (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 :kmr-cmucl-mop cl:*features*))
-      (setq cl:*features* (delete :kmr-cmucl-pcl cl:*features*)))
+      (setq cl:*features* (delete 'kmrcl::cmucl-mop cl:*features*))
+      (setq cl:*features* (delete 'kmrcl::cmucl-pcl cl:*features*)))
 
-  (when (>= (length (generic-function-lambda-list
+  (when (< (length (generic-function-lambda-list
                      (ensure-generic-function
                       'compute-effective-slot-definition)))
             3)
-    (pushnew :kmr-normal-cesd cl:*features*))
+    (pushnew 'short-arg-cesd cl:*features*))
 
-  (when (>= (length (generic-function-lambda-list
-                     (ensure-generic-function
-                      'direct-slot-definition-class)))
-            3)
-    (pushnew :kmr-normal-dsdc cl:*features*))
+  (when (< (length (generic-function-lambda-list
+                    (ensure-generic-function
+                     'direct-slot-definition-class)))
+           3)
+    (pushnew 'short-arg-dsdc cl:*features*))
 
   )  ;; eval-when