X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=mop.lisp;h=f85912b88e7c97410544a356c054dbc03d5a0beb;hp=a274f48991fbdab1c65d777f8e7efbefd171b904;hb=a283ba48cb48da22968784700aeb607b12160cdd;hpb=b50ea2bfdae861ee682a6493ee20e4b1ef4db110 diff --git a/mop.lisp b/mop.lisp index a274f48..f85912b 100644 --- a/mop.lisp +++ b/mop.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: mop.lisp,v 1.16 2003/06/25 20:11:54 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -42,9 +42,11 @@ #+kmr-cmucl-mop #:mop #+allegro #:mop #+lispworks #:clos + #+clisp #:clos #+scl #:clos #+openmcl #:openmcl-mop - )) + ) + ) (in-package #:kmr-mop) @@ -52,29 +54,29 @@ (defun intern-eql-specializer (slot) `(eql ,slot)) - (defmacro process-class-option (metaclass slot-name &optional required) - #+lispworks - `(defmethod clos:process-a-class-option ((class ,metaclass) - (name (eql ,slot-name)) - value) - (when (and ,required (null value)) - (error "metaclass ~A class slot ~A must have a value" (quote ,metaclass) name)) - (list name `',value)) - #-lispworks - (declare (ignore metaclass slot-name required)) - ) +(defmacro process-class-option (metaclass slot-name &optional required) + #+lispworks + `(defmethod clos:process-a-class-option ((class ,metaclass) + (name (eql ,slot-name)) + value) + (when (and ,required (null value)) + (error "metaclass ~A class slot ~A must have a value" (quote ,metaclass) name)) + (list name `',value)) + #-lispworks + (declare (ignore metaclass slot-name required)) + ) - (defmacro process-slot-option (metaclass slot-name) - #+lispworks - `(defmethod clos:process-a-slot-option ((class ,metaclass) - (option (eql ,slot-name)) - value - already-processed-options - slot) - (list* option `',value already-processed-options)) - #-lispworks - (declare (ignore metaclass slot-name)) - ) +(defmacro process-slot-option (metaclass slot-name) + #+lispworks + `(defmethod clos:process-a-slot-option ((class ,metaclass) + (option (eql ,slot-name)) + value + already-processed-options + slot) + (list* option `',value already-processed-options)) + #-lispworks + (declare (ignore metaclass slot-name)) + ) (eval-when (:compile-toplevel :load-toplevel :execute) @@ -83,6 +85,8 @@ '(excl::compute-effective-slot-definition-initargs) #+lispworks '(clos::compute-effective-slot-definition-initargs) + #+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