1.0.45.32: export SB-PCL:+SLOT-UNBOUND+

Using STANDARD-INSTANCE-ACCESS with this provided is much nicer --
  no need to muck around with SLOT-BOUNDP-USING-CLASS and such.

  Also add quick SIA tests and some dependant update abuse
  to tests.

  lp#718039

NEWS

@@ -5,6 +5,9 @@ changes relative to sbcl-1.0.45:
     arguments (lp#710017)
   * enhancement: forward referenced functions no longer cause STYLE-WARNINGS
     when running under --script. (lp#677779)
+  * enhancement: SB-PCL:+SLOT-UNBOUND+ is exported, making it possible to
+    distinguish unbound instance slots when using STANDARD-INSTANCE-ACCESS
+    &co. (lp#718039)
   * optimization: ERROR and CERROR are approximately 5 times faster.
   * optimization: optimized constructors are used for MAKE-INSTANCE of classes
     with applicable non-standard (SETF SLOT-VALUE-USING-CLASS),

doc/manual/beyond-ansi.texinfo

@@ -69,6 +69,8 @@ Extensions}.
 @comment  node-name,  next,  previous,  up
 @section Metaobject Protocol
 
+@subsection AMOP Compatibility of Metaobject Protocol
+
 SBCL supports a metaobject protocol which is intended to be compatible
 with AMOP; present exceptions to this (as distinct from current bugs)
 are:
@@ -217,6 +219,8 @@ states that any class found by @code{find-class}, no matter what its
 
 @end itemize
 
+@subsection Metaobject Protocol Extensions
+
 In addition, SBCL supports extensions to the Metaobject protocol from
 AMOP; at present, they are:
 
@@ -256,6 +260,15 @@ specializer.  The system-provided methods on those methods convert
 between classes and proper names and between lists of the form
 @code{(eql @var{x})} and interned eql specializer objects.
 
+@item
+@vindex @sbpcl{+slot-unbound+}
+@findex @sbmop{standard-instance-access}
+@findex @sbmop{funcallable-standard-instance-access}
+distinguising unbound instance allocated slots from bound ones when
+using @code{standard-instance-access} and
+@code{funcallable-standard-instance-access} is possible by comparison
+to the constant @code{+slot-unbound+}.
+
 @end itemize
 
 @node  Support For Unix

package-data-list.lisp-expr

@@ -2100,7 +2100,8 @@ package is deprecated in favour of SB-MOP."
       ;; experimental SBCL-only (for now) symbols
       :export ("MAKE-METHOD-SPECIALIZERS-FORM"
                "PARSE-SPECIALIZER-USING-CLASS"
-               "UNPARSE-SPECIALIZER-USING-CLASS")
+               "UNPARSE-SPECIALIZER-USING-CLASS"
+               "+SLOT-UNBOUND+")
       ;; FIXME: After a little while, these reexports can probably go
       ;; away, as they're superseded by the use of SB-MOP as the
       ;; publically-accessible package.

src/pcl/low.lisp

@@ -173,17 +173,20 @@
 ;;; this an interned symbol. That means that the fast check to see
 ;;; whether a slot is unbound is to say (EQ <val> '..SLOT-UNBOUND..).
 ;;; That is considerably faster than looking at the value of a special
-;;; variable. Be careful, there are places in the code which actually
-;;; use ..SLOT-UNBOUND.. rather than this variable. So much for
-;;; modularity..
+;;; variable.
 ;;;
-;;; FIXME: Now that we're tightly integrated into SBCL, we could use
-;;; the SBCL built-in unbound value token instead. Perhaps if we did
-;;; so it would be a good idea to define collections of CLOS slots as
-;;; a new type of heap object, instead of using bare SIMPLE-VECTOR, in
-;;; order to avoid problems (in the debugger if nowhere else) with
-;;; SIMPLE-VECTORs some of whose elements are unbound tokens.
-(defconstant +slot-unbound+ '..slot-unbound..)
+;;; It seems only reasonable to also export this for users, since
+;;; otherwise dealing with STANDARD-INSTANCE-ACCESS becomes harder
+;;; -- and slower -- than it needs to be.
+(defconstant +slot-unbound+ '..slot-unbound..
+  "SBCL specific extentions to MOP: if this value is read from an
+instance using STANDARD-INSTANCE-ACCESS, the slot is unbound.
+Similarly, an :INSTANCE allocated slot can be made unbound by
+assigning this to it using (SETF STANDARD-INSTANCE-ACCESS).
+
+Value of +SLOT-UNBOUND+ is unspecified, and should not be relied to be
+of any particular type, but it is guaranteed to be suitable for EQ
+comparison.")
 
 (defmacro %allocate-static-slot-storage--class (no-of-slots)
   `(make-array ,no-of-slots :initial-element +slot-unbound+))

tests/mop-30.impure.lisp

@@ -0,0 +1,96 @@
+;;;; Standard-instance-access tests and update-protocol abuse
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(in-package :cl-user)
+
+(load "test-util.lisp")
+
+(defpackage :mop-test-30
+  (:use :sb-pcl :sb-ext :cl :test-util))
+
+(in-package :mop-test-30)
+
+(defclass foo ()
+  ((bar :initarg :bar)
+   (quux :initarg :quux)))
+
+(defclass foomagic ()
+  ())
+
+(defun find-slot (name class)
+  (let ((class (find-class class)))
+    (unless (class-finalized-p class)
+      (finalize-inheritance class))
+    (find name (class-slots class) :key #'slot-definition-name)))
+
+(add-dependent (find-class 'foo) (find-class 'foomagic))
+
+(defglobal **bar-loc** (slot-definition-location (find-slot 'bar 'foo)))
+(defglobal **quux-loc** (slot-definition-location (find-slot 'quux 'foo)))
+
+(defmethod update-dependent ((meta (eql (find-class 'foo)))
+                             (dep (eql (find-class 'foomagic)))
+                             &key)
+  (setf **bar-loc** (slot-definition-location (find-slot 'bar 'foo))
+        **quux-loc** (slot-definition-location (find-slot 'quux 'foo))))
+
+(defun foo-bar/quux (foo)
+  (declare (type foo foo))
+  (values (standard-instance-access foo **bar-loc**)
+          (standard-instance-access foo **quux-loc**)))
+
+(defun swap-bar/quux (foo)
+  (declare (type foo foo))
+  (rotatef (standard-instance-access foo **bar-loc**)
+           (standard-instance-access foo **quux-loc**)))
+
+(with-test (:name :standard-instance-access)
+  (let ((bar (cons t t))
+        (quux (cons nil nil)))
+    (multiple-value-bind (bar? quux?)
+        (foo-bar/quux (make-instance 'foo :bar bar :quux quux))
+      (assert (eq bar bar?))
+      (assert (eq quux quux?)))))
+
+(with-test (:name :standard-instance-access/setf)
+  (let* ((bar (cons t t))
+         (quux (cons nil nil))
+         (foo
+          (make-instance 'foo :bar bar :quux quux)))
+    (multiple-value-bind (bar? quux?) (foo-bar/quux foo)
+      (assert (eq bar bar?))
+      (assert (eq quux quux?)))
+    (swap-bar/quux foo)
+    (multiple-value-bind (bar? quux?) (foo-bar/quux foo)
+      (assert (eq quux bar?))
+      (assert (eq bar quux?)))))
+
+;;; Sneaky redefinition reorders slots!
+(defclass foo ()
+  ((quux :initarg :quux)
+   (bar :initarg :bar)))
+
+(with-test (:name :standard-instance-access/updated)
+  (let ((bar (cons t t))
+        (quux (cons nil nil)))
+    (multiple-value-bind (bar? quux?)
+        (foo-bar/quux (make-instance 'foo :bar bar :quux quux))
+      (assert (eq bar bar?))
+      (assert (eq quux quux?)))))
+
+(with-test (:name :standard-instance-access/slot-unbound)
+  (let ((bar (cons t t)))
+    (multiple-value-bind (bar? quux?)
+        (foo-bar/quux (make-instance 'foo :bar bar))
+      (assert (eq bar bar?))
+      (assert (eq +slot-unbound+ quux?)))))

version.lisp-expr

@@ -20,4 +20,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.45.31"
+"1.0.45.32"