From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 13 Aug 2007 13:41:49 +0000 (+0000)
Subject: 1.0.8.24: factor (THE TYPE FORM) => FORM transformations into a function
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=25016a777703dc022ef527cbe6a5f3ca6903bc61;p=sbcl.git

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
--- 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
--- 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
--- 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"