From: Nikodemus S. <de...@us...> - 2006-08-22 15:49:05
|
Update of /cvsroot/sbcl/sbcl/src/pcl In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv31818/src/pcl Modified Files: boot.lisp methods.lisp slots.lisp Log Message: 0.9.15.46: cosmetic cleanups * SLOT-VALUE-OR-DEFAULT now uses an UNREADABLE-OBJECT as the default marker for unbound slots, giving us #<unbound slot> instead of "unbound". * Edit special operator docstrings for consistency. * Whitespace. Index: boot.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/boot.lisp,v retrieving revision 1.122 retrieving revision 1.123 diff -u -d -r1.122 -r1.123 --- boot.lisp 22 Aug 2006 13:23:42 -0000 1.122 +++ boot.lisp 22 Aug 2006 15:48:56 -0000 1.123 @@ -2202,9 +2202,9 @@ arglist &rest initargs) (let* (;; we don't need to deal with the :generic-function-class - ;; argument here because the default, - ;; STANDARD-GENERIC-FUNCTION, is right for all early generic - ;; functions. (See REAL-ADD-NAMED-METHOD) + ;; argument here because the default, + ;; STANDARD-GENERIC-FUNCTION, is right for all early generic + ;; functions. (See REAL-ADD-NAMED-METHOD) (gf (ensure-generic-function generic-function-name)) (existing (dolist (m (early-gf-methods gf)) Index: methods.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/methods.lisp,v retrieving revision 1.63 retrieving revision 1.64 diff -u -d -r1.63 -r1.64 --- methods.lisp 22 Aug 2006 13:23:42 -0000 1.63 +++ methods.lisp 22 Aug 2006 15:48:56 -0000 1.64 @@ -229,7 +229,7 @@ (let* ((existing-gf (find-generic-function generic-function-name nil)) (generic-function (if existing-gf - (ensure-generic-function + (ensure-generic-function generic-function-name :generic-function-class (class-of existing-gf)) (ensure-generic-function generic-function-name))) Index: slots.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/slots.lisp,v retrieving revision 1.24 retrieving revision 1.25 diff -u -d -r1.24 -r1.25 --- slots.lisp 7 Jun 2006 09:58:37 -0000 1.24 +++ slots.lisp 22 Aug 2006 15:48:56 -0000 1.25 @@ -136,9 +136,12 @@ (let ((class (class-of object))) (not (null (find-slot-definition class slot-name))))) +(defvar *unbound-slot-value-marker* (make-unprintable-object "unbound slot")) + ;;; This isn't documented, but is used within PCL in a number of print ;;; object methods. (See NAMED-OBJECT-PRINT-FUNCTION.) -(defun slot-value-or-default (object slot-name &optional (default "unbound")) +(defun slot-value-or-default (object slot-name &optional + (default *unbound-slot-value-marker*)) (if (slot-boundp object slot-name) (slot-value object slot-name) default)) |