X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=mop.lisp;h=48b0f053467972061f868c16da9e31955d5be962;hb=962a9b69315aaa22c831c9e29230d315b5d0b9b7;hp=0002d566f2f016374a6c3175232660bb9570e7b5;hpb=224c382d0d7fa09a5c86bfb1a8479ac380a094c6;p=hyperobject.git diff --git a/mop.lisp b/mop.lisp index 0002d56..48b0f05 100644 --- a/mop.lisp +++ b/mop.lisp @@ -11,7 +11,7 @@ ;;;; in Text, HTML, and XML formats. This includes hyperlinking ;;;; capability and sub-objects. ;;;; -;;;; $Id: mop.lisp,v 1.27 2003/03/29 20:11:09 kevin Exp $ +;;;; $Id: mop.lisp,v 1.29 2003/03/29 20:29:10 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg ;;;; @@ -282,7 +282,7 @@ (,reader ,@keys))))) #+(or sbcl scl cmu) -(defun ensure-lazy-reader (class slot-name reader &rest reader-keys) +(defun ensure-lazy-reader (class-name slot-name reader &rest reader-keys) (let ((keys nil) (gf (ensure-generic-function 'slot-unbound))) (dolist (key reader-keys) @@ -294,15 +294,17 @@ (class-prototype (generic-function-method-class gf)) `(lambda (the-class the-instance the-slot-name) (declare (ignore the-class)) - (setf (slot-value the-instance the-slot-name) (,reader ,@keys)))) - (print init-args-values) + (setf (slot-value the-instance the-slot-name) (,reader ,@keys))) + nil) (add-method gf - (make-instance (generic-function-method-class gf) - ':specializers (list t class (intern-eql-specializer slot-name)) - ':lambda-list '(the-class the-instance the-slot-name) - ':function `(function ,method-lambda) - ;;init-args-values - ))))) + (apply + #'make-instance (generic-function-method-class gf) + ':specializers (list (intern-eql-specializer class-name) + (find-class class-name) + (intern-eql-specializer slot-name)) + ':lambda-list '(the-class the-instance the-slot-name) + ':function `(function ,method-lambda) + init-args-values))))) (defun finalize-subobjects (cl) "Process class subobjects slot"