CVS: sbcl/src/pcl vector.lisp,1.28,1.29

Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sc8-pr-cvs1:/tmp/cvs-serv30933/src/pcl

Modified Files:
        vector.lisp 
Log Message:
0.8.6.17:
        Fix for bogus type warning (Rudi sbcl-devel 2003-09-21)
        ... I don't really know what I'm doing here.  Presumably
                SLOTS could never be NIL at this point?  Bah.


Index: vector.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/vector.lisp,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -d -r1.28 -r1.29
--- vector.lisp 26 Aug 2003 13:21:19 -0000      1.28
+++ vector.lisp 30 Nov 2003 15:19:35 -0000      1.29
@@ -665,8 +665,21 @@
        `(locally (declare #.*optimize-speed*)
          (let ((,index (pvref ,pv ,pv-offset)))
            (setq ,value (typecase ,index
+                          ;; FIXME: the line marked by KLUDGE below
+                          ;; (and the analogous spot in
+                          ;; INSTANCE-WRITE-INTERNAL) is there purely
+                          ;; to suppress a type mismatch warning that
+                          ;; propagates through to user code.
+                          ;; Presumably SLOTS at this point can never
+                          ;; actually be NIL, but the compiler seems
+                          ;; to think it could, so we put this here
+                          ;; to shut it up.  (see also mail Rudi
+                          ;; Schlatte sbcl-devel 2003-09-21) -- CSR,
+                          ;; 2003-11-30
                           ,@(when (or (null type) (eq type :instance))
-                              `((fixnum (clos-slots-ref ,slots ,index))))
+                              `((fixnum
+                                 (and ,slots ; KLUDGE
+                                  (clos-slots-ref ,slots ,index)))))
                           ,@(when (or (null type) (eq type :class))
                               `((cons (cdr ,index))))
                           (t +slot-unbound+)))
@@ -700,8 +713,9 @@
          (let ((,index (pvref ,pv ,pv-offset)))
            (typecase ,index
              ,@(when (or (null type) (eq type :instance))
-                      `((fixnum (setf (clos-slots-ref ,slots ,index)
-                                     ,new-value))))
+                  `((fixnum (and ,slots
+                            (setf (clos-slots-ref ,slots ,index)
+                                  ,new-value)))))
              ,@(when (or (null type) (eq type :class))
                  `((cons (setf (cdr ,index) ,new-value))))
              (t ,default)))))))



-------------------------------------------------------
This SF.net email is sponsored by: SF.net Giveback Program.
Does SourceForge.net help you be more productive?  Does it
help you create better code?  SHARE THE LOVE, and help us help
YOU!  Click Here: http://sourceforge.net/donate/