1.0.9.47: VALID-WRAPPER-OF

* Renamed CHECK-OBSOLETE-INSTANCE/WRAPPER-OF, and fixed the semantics
  so that it always returns the fresh wrapper.

* Add FIXME re CHECK-WRAPPER-VALIDITY name.

diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp
index ed6c25a..f406c6f 100644 (file)
--- a/src/pcl/slots.lisp
+++ b/src/pcl/slots.lisp
@@ -97,7 +97,7 @@
 
 (declaim (ftype (sfunction (t symbol) t) slot-value))
 (defun slot-value (object slot-name)
-  (let* ((wrapper (check-obsolete-instance/wrapper-of object))
+  (let* ((wrapper (valid-wrapper-of object))
          (cell (find-slot-cell wrapper slot-name))
          (location (car cell))
          (value
@@ -128,7 +128,7 @@
       form))
 
 (defun set-slot-value (object slot-name new-value)
-  (let* ((wrapper (check-obsolete-instance/wrapper-of object))
+  (let* ((wrapper (valid-wrapper-of object))
          (cell (find-slot-cell wrapper slot-name))
          (location (car cell))
          (type-check-function (cadr cell)))
@@ -171,7 +171,7 @@
       form))
 
 (defun slot-boundp (object slot-name)
-  (let* ((wrapper (check-obsolete-instance/wrapper-of object))
+  (let* ((wrapper (valid-wrapper-of object))
          (cell (find-slot-cell wrapper slot-name))
          (location (car cell))
          (value
@@ -201,7 +201,7 @@
       form))
 
 (defun slot-makunbound (object slot-name)
-  (let* ((wrapper (check-obsolete-instance/wrapper-of object))
+  (let* ((wrapper (valid-wrapper-of object))
          (cell (find-slot-cell wrapper slot-name))
          (location (car cell)))
     (cond ((fixnump location)

diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp
index 27e6bfe..4a20240 100644 (file)
--- a/src/pcl/vector.lisp
+++ b/src/pcl/vector.lisp
@@ -923,25 +923,17 @@
   (pv-table-lookup pv-table (pv-wrappers-from-pv-args pv-parameters)))
 
 (defun pv-wrappers-from-pv-args (&rest args)
-  (let (wrappers)
-    (dolist (arg args (if (cdr wrappers) (nreverse wrappers) (car wrappers)))
-      (let ((wrapper (wrapper-of arg)))
-        (push (if (invalid-wrapper-p wrapper)
-                  (check-wrapper-validity wrapper)
-                  wrapper)
-              wrappers)))))
+  (loop for arg in args
+        collect (valid-wrapper-of arg)))
 
 (defun pv-wrappers-from-all-args (pv-table args)
   (loop for snl in (pv-table-slot-name-lists pv-table) and arg in args
         when snl
-          collect (wrapper-of arg) into wrappers
-        finally (return (if (cdr wrappers) wrappers (car wrappers)))))
+        collect (valid-wrapper-of arg)))
 
 ;;; Return the subset of WRAPPERS which is used in the cache
 ;;; of PV-TABLE.
 (defun pv-wrappers-from-all-wrappers (pv-table wrappers)
   (loop for snl in (pv-table-slot-name-lists pv-table) and w in wrappers
         when snl
-          collect w into result
-        finally (return (if (cdr result) result (car result)))))
-
+        collect w))

diff --git a/src/pcl/wrapper.lisp b/src/pcl/wrapper.lisp
index 49738e5..c204e4f 100644 (file)
--- a/src/pcl/wrapper.lisp
+++ b/src/pcl/wrapper.lisp
@@ -152,6 +152,9 @@
     (remhash owrapper *previous-nwrappers*)
     (setf (gethash nwrapper *previous-nwrappers*) new-previous)))
 
+;;; FIXME: This is not a good name: part of the constract here is that
+;;; we return the valid wrapper, which is not obvious from the name
+;;; (or the names of our callees.)
 (defun check-wrapper-validity (instance)
   (let* ((owrapper (wrapper-of instance))
          (state (layout-invalid owrapper)))
@@ -188,11 +191,11 @@
   (when (invalid-wrapper-p (layout-of instance))
     (check-wrapper-validity instance)))
 
-(defun check-obsolete-instance/wrapper-of (instance)
+(defun valid-wrapper-of (instance)
   (let ((wrapper (wrapper-of instance)))
-    (when (invalid-wrapper-p wrapper)
-      (check-wrapper-validity instance))
-    wrapper))
+    (if (invalid-wrapper-p wrapper)
+       (check-wrapper-validity instance)
+       wrapper)))
 \f
 ;;;  NIL: means nothing so far, no actual arg info has NILs in the
 ;;;  metatype.

diff --git a/version.lisp-expr b/version.lisp-expr
index b1458fb..1c07746 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,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.9.46"
+"1.0.9.47"