Version 1.102 (other changes not in last commit)

[kmrcl.git] / mop.lisp

diff --git a/mop.lisp b/mop.lisp
index f6bd037d1fb8cba81ba694c2ed969fd2ebd45723..f8aba54c1f26ae47ed39b74987ed1c056938e15f 100644 (file)
--- a/mop.lisp
+++ b/mop.lisp
@@ -7,9 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2003
 ;;;;
 ;;;; 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
 ;;;;
 ;;;; 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)
 #+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))
 
 #+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
 
 (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
    #+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
    #+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
      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
      )
      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
    '(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)
 
   #+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)
 
   #+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)
                      (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
 
   )  ;; eval-when