X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=mop.lisp;h=73f949903cd7d61da67f637d551ace80cba9c922;hb=ab663bd390b95de44dd144fbeea504e0ed2e5d2d;hp=9a571b5d6823c4699e5f4e6f1acb253bce52bdbd;hpb=152fd9dc7d5a0fb8079f3b18ecafff6aeb836a75;p=kmrcl.git diff --git a/mop.lisp b/mop.lisp index 9a571b5..73f9499 100644 --- a/mop.lisp +++ b/mop.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: mop.lisp,v 1.3 2003/04/29 04:56:58 kevin Exp $ +;;;; $Id: mop.lisp,v 1.8 2003/04/29 05:54:24 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -41,85 +41,106 @@ #+kmr-cmucl-mop #:mop #+allegro #:mop #+lispworks #:clos - #+scl #:clos) - (:export - #: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 #:compute-effective-slot-definition - #: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) - ) + #+scl #:clos)) (in-package #:kmr-mop) -(shadowing-import - #+allegro - '(excl::compute-effective-slot-definition-initargs) - #+lispworks - '(clos::compute-effective-slot-definition-initargs) - #+kmr-sbcl-mop - '(sb-pcl::compute-effective-slot-definition-initargs) - #+kmr-sbcl-pcl - '(sb-pcl:class-of sb-pcl:class-name sb-pcl:class-slots 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::compute-effective-slot-definition - 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) - #+kmr-cmucl-mop - '(pcl::compute-effective-slot-definition-initargs) - #+kmr-cmucl-pcl - '(pcl:class-of pcl:class-name pcl:class-slots pcl:find-class pcl::standard-class - pcl::slot-definition-name pcl:finalize-inheritance - pcl::standard-direct-slot-definition pcl::standard-effective-slot-definition - pcl::validate-superclass pcl:direct-slot-definition-class - pcl:compute-effective-slot-definition - pcl::compute-effective-slot-definition-initargs - pcl::slot-value-using-class - pcl:class-prototype pcl:generic-function-method-class pcl:intern-eql-specializer - pcl:make-method-lambda pcl:generic-function-lambda-list - pcl::compute-slots) - #+scl - '(clos::compute-effective-slot-definition-initargs - clos::class-prototype - ;; note: make-method-lambda is not fbound - ) - '#:kmr-mop) - -#+sbcl (eval-when (:compile-toplevel :load-toplevel :execute) + (shadowing-import + #+allegro + '(class-of class-name class-slots find-class mop::standard-class + mop::slot-definition-name mop:finalize-inheritance + mop::standard-direct-slot-definition mop::standard-effective-slot-definition + mop::validate-superclass mop:direct-slot-definition-class + mop:compute-effective-slot-definition + excl::compute-effective-slot-definition-initargs + mop::slot-value-using-class + mop:class-prototype mop:generic-function-method-class mop:intern-eql-specializer + mop:make-method-lambda mop:generic-function-lambda-list + mop::compute-slots + ;; note: make-method-lambda is not fbound + ) + #+lispworks + '(class-of class-name class-slots find-class + clos::standard-class + clos:slot-definition-name clos::finalize-inheritance + clos::standard-direct-slot-definition + clos::standard-effective-slot-definition clos::validate-superclass + clos::direct-slot-definition-class clos::compute-effective-slot-definition + clos::compute-effective-slot-definition-initargs + clos::slot-value-using-class + clos:class-prototype clos:generic-function-method-class clos:intern-eql-specializer + clos:make-method-lambda clos:generic-function-lambda-list + clos::compute-slots) + #+sbcl + '(sb-pcl:class-of sb-pcl:class-name sb-pcl:class-slots 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::compute-effective-slot-definition + 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 + pcl::standard-direct-slot-definition pcl::standard-effective-slot-definition + pcl::validate-superclass pcl:direct-slot-definition-class + pcl:compute-effective-slot-definition + pcl::compute-effective-slot-definition-initargs + pcl::slot-value-using-class + pcl:class-prototype pcl:generic-function-method-class pcl:intern-eql-specializer + pcl:make-method-lambda pcl:generic-function-lambda-list + pcl::compute-slots) + #+scl + '(class-of class-name class-slots find-class clos::standard-class + clos::slot-definition-name clos:finalize-inheritance + clos::standard-direct-slot-definition clos::standard-effective-slot-definition + clos::validate-superclass clos:direct-slot-definition-class + clos:compute-effective-slot-definition + clos::compute-effective-slot-definition-initargs + clos::slot-value-using-class + clos:class-prototype clos:generic-function-method-class clos:intern-eql-specializer + clos:make-method-lambda clos:generic-function-lambda-list + clos::compute-slots + ;; note: make-method-lambda is not fbound + )) + + (export '(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 compute-effective-slot-definition + 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)) + + #+sbcl (if (find-package 'sb-mop) (setq cl:*features* (delete :kmr-sbcl-mop cl:*features*)) - (setq cl:*features* (delete :kmr-sbcl-pcl cl:*features*)))) - -#+cmu -(eval-when (:compile-toplevel :load-toplevel :execute) + (setq cl:*features* (delete :kmr-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*)))) - -(eval-when (:compile-toplevel :load-toplevel :execute) + (setq cl:*features* (delete :kmr-cmucl-pcl cl:*features*))) + (when (>= (length (generic-function-lambda-list (ensure-generic-function 'compute-effective-slot-definition))) 3) - (pushnew :kmr-normal-cesd cl:*features*))) - -(eval-when (:compile-toplevel :load-toplevel :execute) + (pushnew :kmr-normal-cesd cl:*features*)) + (when (>= (length (generic-function-lambda-list - (ensure-generic-function - 'direct-slot-definition-class))) + (ensure-generic-function + 'direct-slot-definition-class))) 3) - (pushnew :kmr-normal-dsdc cl:*features*))) + (pushnew :kmr-normal-dsdc cl:*features*)) + ) ;; eval-when