mop: In print-object-with-slots, use write for the slot values.

[lisp] / mdw-mop.lisp

diff --git a/mdw-mop.lisp b/mdw-mop.lisp
index 0766e384cd7968e134a57efc06ffdf23b7d015a7..e88ff1227a007e10fd375b154f3288b11d6960f9 100644 (file)
--- a/mdw-mop.lisp
+++ b/mdw-mop.lisp
@@ -27,7 +27,7 @@
 ;;; Packages.
 
 (defpackage #:mdw.mop
 ;;; Packages.
 
 (defpackage #:mdw.mop

-  (:use #:common-lisp #+cmu #:pcl)
+  (:use #:common-lisp #:mdw.base #+cmu #:pcl)

   (:export #:compatible-class
           #:initargs-for-effective-slot #:make-effective-slot
           #:filtered-slot-class-mixin
   (:export #:compatible-class
           #:initargs-for-effective-slot #:make-effective-slot
           #:filtered-slot-class-mixin


@@ -152,7 +152,7 @@ (defmethod effective-slot-definition-class
       (call-next-method)))
 
 (defmethod initialize-instance :after
       (call-next-method)))
 
 (defmethod initialize-instance :after

-    ((slot filtered-direct-slot-definition) &key &allow-other-keys)
+    ((slot filtered-direct-slot-definition) &key)

   (with-slots (filter) slot
     (when (and (consp filter)
               (or (eq (car filter) 'function)
   (with-slots (filter) slot
     (when (and (consp filter)
               (or (eq (car filter) 'function)


@@ -191,7 +191,7 @@ (defclass predicate-class-mixin (compatible-class)
     returning a non-nil value."))
 
 (defmethod shared-initialize :after
     returning a non-nil value."))
 
 (defmethod shared-initialize :after

-    ((class predicate-class-mixin) slot-names &key &allow-other-keys)
+    ((class predicate-class-mixin) slot-names &key)

   (declare (ignore slot-names))
   (with-slots (predicates) class
     (dolist (predicate predicates)
   (declare (ignore slot-names))
   (with-slots (predicates) class
     (dolist (predicate predicates)


@@ -274,7 +274,7 @@ (defun print-object-with-slots (obj stream)
                 (progn (format stream " ~@_~:I") (setf sep t)))
             (let ((name (pprint-pop))
                   (value (pprint-pop)))
                 (progn (format stream " ~@_~:I") (setf sep t)))
             (let ((name (pprint-pop))
                   (value (pprint-pop)))

-              (format stream "~S ~@_~:[~S~;<unbound>~*~]"
+              (format stream "~S ~@_~:[~W~;#<unbound>~*~]"

                       name (eq value magic) value))))))))
 
 ;;;----- That's all, folks --------------------------------------------------
                       name (eq value magic) value))))))))
 
 ;;;----- That's all, folks --------------------------------------------------