X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=mop.lisp;h=ae294581e60db4fdd9130e152308bff335931a4f;hb=091384f1aef529b0b5c9f065f672805199515ced;hp=10f329ef02e6d6c040c36fdefd34eecfb9562da5;hpb=700877fb1a5501199b25eb65770f9db565377d91;p=hyperobject.git diff --git a/mop.lisp b/mop.lisp index 10f329e..ae29458 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.54 2003/04/16 19:56:33 kevin Exp $ +;;;; $Id: mop.lisp,v 1.61 2003/04/22 14:19:08 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg ;;;; @@ -233,19 +233,19 @@ value-type (car value-type)) ((:string :cdata :varchar :char) - 'string) + '(or null string)) (:character - 'character) + '(or null character)) (:fixnum - 'fixnum) + '(or null fixnum)) (:boolean - 'boolean) + '(or null boolean)) (:integer - 'integer) + '(or null integer)) ((:float :single-float) - 'single-float) + '(or null single-float)) (:double-float - 'double-float) + '(or null double-float)) (otherwise t))) @@ -288,14 +288,14 @@ `(defmethod slot-unbound (,the-class (,the-instance ,class) (,the-slot-name (eql ',slot-name))) (declare (ignore ,the-class)) - (setf (slot-value ,the-instance ,the-slot-name) - (,reader ,@keys))))) + (setf (slot-value ,the-instance ,the-slot-name) (,reader ,@keys))))) + #+lispworks (defun intern-eql-specializer (slot) `(eql ,slot)) -#+(or sbcl lispworks) +#+(or sbcl cmu lispworks) (defun ensure-lazy-reader (class-name slot-name reader &rest reader-keys) (let ((keys nil) (gf (ensure-generic-function 'slot-unbound))) @@ -343,12 +343,12 @@ nil (cdr subobj-def))))) (unless (eq (lookup subobject) t) - #-(or sbcl lispworks) + #-(or sbcl cmu lispworks) (eval `(hyperobject::def-lazy-reader ,(name-class subobject) ,(name-slot subobject) ,(lookup subobject) ,@(lookup-keys subobject))) - #+(or sbcl lispworks) + #+(or sbcl cmu lispworks) (apply #'ensure-lazy-reader (name-class subobject) (name-slot subobject) (lookup subobject) (lookup-keys subobject)) )