1.0.8.24: factor (THE TYPE FORM) => FORM transformations into a function

* EXTRACT-THE, for now only used in PCL.

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index 8e15dc8..e8a0d5c 100644 (file)
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -2668,13 +2668,18 @@ bootstrapping.
 ;;; walker stuff was only used for implementing stuff like that; maybe
 ;;; it's not needed any more? Hunt down what it was used for and see.
 
+(defun extract-the (form)
+  (cond ((and (consp form) (eq (car form) 'the))
+         (aver (proper-list-of-length-p 3))
+         (third form))
+        (t
+         form)))
+
 (defmacro with-slots (slots instance &body body)
   (let ((in (gensym)))
     `(let ((,in ,instance))
        (declare (ignorable ,in))
-       ,@(let ((instance (if (and (consp instance) (eq (car instance) 'the))
-                             (third instance)
-                             instance)))
+       ,@(let ((instance (extract-the instance)))
            (and (symbolp instance)
                 `((declare (%variable-rebinding ,in ,instance)))))
        ,in
@@ -2696,9 +2701,7 @@ bootstrapping.
   (let ((in (gensym)))
     `(let ((,in ,instance))
        (declare (ignorable ,in))
-       ,@(let ((instance (if (and (consp instance) (eq (car instance) 'the))
-                             (third instance)
-                             instance)))
+       ,@(let ((instance (extract-the instance)))
            (and (symbolp instance)
                 `((declare (%variable-rebinding ,in ,instance)))))
        ,in

diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp
index 1a6f79f..9e4dcd3 100644 (file)
--- a/src/pcl/vector.lisp
+++ b/src/pcl/vector.lisp
@@ -308,15 +308,8 @@
                 (slot-value 'reader)
                 (set-slot-value 'writer)
                 (slot-boundp 'boundp)))
-        (var (cadr form))
+        (var (extract-the (cadr form)))
         (slot-name (eval (caddr form)))) ; known to be constant
-    (when (and (consp var) (eq 'the (car var)))
-      ;; FIXME: We should assert list of length 3 here. Or maybe we
-      ;; should just define EXTRACT-THE, replace the whole (WHEN ..)
-      ;; form with (AWHEN (EXTRACT-THE VAR) (SETF VAR IT)) and then
-      ;; use EXTRACT-THE similarly to clean up the other tests against
-      ;; 'THE scattered through the PCL code.
-      (setq var (caddr var)))
     (when (symbolp var)
       (let* ((rebound? (caddr (var-declaration '%variable-rebinding var env)))
              (parameter-or-nil (car (memq (or rebound? var)

diff --git a/version.lisp-expr b/version.lisp-expr
index bfe2318..b03f964 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.8.23"
+"1.0.8.24"