X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/93c540af1697a73fe04cba69ef91c3e4ace3003c..fee2e08f5f30a1b3a0665c63d1c85c8576da449f:/mdw-mop.lisp diff --git a/mdw-mop.lisp b/mdw-mop.lisp index 85e7885..7af8ad9 100644 --- a/mdw-mop.lisp +++ b/mdw-mop.lisp @@ -13,12 +13,12 @@ ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2 of the License, or ;;; (at your option) any later version. -;;; +;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. -;;; +;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software Foundation, ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. @@ -27,7 +27,10 @@ ;;; Packages. (defpackage #:mdw.mop - (:use #:common-lisp #:mdw.base #+(or cmu clisp) #:mop #+ecl #:clos) + (:use #:common-lisp #:mdw.base + #+(or cmu clisp) #:mop + #+sbcl #:sb-mop + #+ecl #:clos) (:export #:copy-instance #:copy-instance-using-class #:with-slot-variables #:compatible-class @@ -106,10 +109,7 @@ (listify slots) (mapcar #'slot-definition-name (class-slots class)))))) - (multiple-value-bind - (docs decls body) - (parse-body body :allow-docstring-p nil) - (declare (ignore docs)) + (with-parsed-body (body decls) body (with-gensyms (instvar) `(let ((,instvar ,instance)) ,@(and class `((declare (type ,(class-name class) ,instvar)))) @@ -221,13 +221,13 @@ (Yes, I know that using functions would be nicer, but the MOP makes that surprisingly difficult.)")) +(defgeneric slot-definition-filter (slot) + (:method ((slot slot-definition)) nil)) + (defclass filtered-direct-slot-definition (standard-direct-slot-definition) ((filter :initarg :filter :reader slot-definition-filter))) -(defgeneric slot-definition-filter (slot) - (:method ((slot slot-definition)) nil)) - (defclass filtered-effective-slot-definition (standard-effective-slot-definition) ((filter :initarg :filter :accessor slot-definition-filter)))