X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=mop.lisp;h=cd7c47736dd6e9d38ccc7ce977a21628bf0ffcb4;hp=3252d618bea98f4a1473e10eb0ee81874ad6f0f8;hb=e83a72f1e88062d7e17ac77c17cc9c32d51f3c13;hpb=d4cc19d53788d5180eeef28b1c63edad0f201d5f diff --git a/mop.lisp b/mop.lisp index 3252d61..cd7c477 100644 --- a/mop.lisp +++ b/mop.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: mop.lisp,v 1.11 2003/04/29 09:23:56 kevin Exp $ +;;;; $Id: mop.lisp,v 1.18 2003/07/30 19:04:41 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -29,7 +29,8 @@ #+cmu (eval-when (:compile-toplevel :load-toplevel :execute) - (if (find-package 'mop) + (if (eq (symbol-package 'pcl:find-class) + (find-package 'common-lisp)) (pushnew :kmr-cmucl-mop cl:*features*) (pushnew :kmr-cmucl-pcl cl:*features*))) @@ -41,7 +42,10 @@ #+kmr-cmucl-mop #:mop #+allegro #:mop #+lispworks #:clos - #+scl #:clos)) + #+scl #:clos + #+openmcl #:openmcl-mop + ) + ) (in-package #:kmr-mop) @@ -57,8 +61,8 @@ (when (and ,required (null value)) (error "metaclass ~A class slot ~A must have a value" (quote ,metaclass) name)) (list name `',value)) - #+(or allegro sbcl cmu scl) - (declare (ignore slot-name required)) + #-lispworks + (declare (ignore metaclass slot-name required)) ) (defmacro process-slot-option (metaclass slot-name) @@ -70,7 +74,7 @@ slot) (list* option `',value already-processed-options)) #-lispworks - (declare (ignore slot-name)) + (declare (ignore metaclass slot-name)) ) @@ -120,11 +124,22 @@ 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::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 - ))) + ) + #+openmcl + '(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:compute-effective-slot-definition + openmcl-mop:class-direct-slots + openmcl-mop::compute-effective-slot-definition-initargs + openmcl-mop::slot-value-using-class + openmcl-mop:class-prototype openmcl-mop:generic-function-method-class openmcl-mop:intern-eql-specializer + openmcl-mop:make-method-lambda openmcl-mop:generic-function-lambda-list + openmcl-mop::compute-slots) )) (eval-when (:compile-toplevel :load-toplevel :execute) (export '(class-of class-name class-slots find-class