X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=mop.lisp;h=8decec559d7ec7330ac0e79202d4817b53da800c;hp=ff4d2179bd84167bbbb0d9d035759574f5b63b6d;hb=3884e25c65417de34331b45a7b68d479dde15949;hpb=d1918433c6b93fbc85153da62aa6e31fd06461fa diff --git a/mop.lisp b/mop.lisp index ff4d217..8decec5 100644 --- a/mop.lisp +++ b/mop.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: mop.lisp,v 1.17 2003/07/30 17:32:26 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -45,7 +45,6 @@ #+scl #:clos #+openmcl #:openmcl-mop ) - #+openmcl (:shadowing-import-from #:ccl #:ensure-generic-function) ) (in-package #:kmr-mop) @@ -54,29 +53,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)