From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Thu, 7 Apr 2005 12:32:54 +0000 (+0000)
Subject: 0.8.21.22:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8987be18e94b9ef8ba393f05d1157587528810b3;p=sbcl.git

0.8.21.22:
	Maybe make two-dimensional array type testing faster.
---

diff --git a/NEWS b/NEWS
index 2637cb8..1f29261 100644
--- a/NEWS
+++ b/NEWS
@@ -27,6 +27,7 @@ changes in sbcl-0.8.22 relative to sbcl-0.8.21:
   * increased the maximimum compact environment size to allow
     purify on images with large amounts of functions. (thanks to Cyrus Harmon)
   * improvements to the x86-64 disassembler. (thanks to Lutz Euler)
+  * optimization: type testing for non-vector arrays should be faster.
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** MISC.549 and similar: late transformation of unsafe type
        assertions into derived types caused unexpected code
diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index a48474c..5d0fa9d 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -327,12 +327,13 @@
 
 ;;; Return forms to test that OBJ has the rank and dimensions
 ;;; specified by TYPE, where STYPE is the type we have checked against
-;;; (which is the same but for dimensions.)
+;;; (which is the same but for dimensions and element type).
 (defun test-array-dimensions (obj type stype)
   (declare (type array-type type stype))
   (let ((obj `(truly-the ,(type-specifier stype) ,obj))
 	(dims (array-type-dimensions type)))
-    (unless (eq dims '*)
+    (unless (or (eq dims '*)
+		(equal dims (array-type-dimensions stype)))
       (collect ((res))
 	(when (eq (array-type-dimensions stype) '*)
 	  (res `(= (array-rank ,obj) ,(length dims))))
@@ -344,6 +345,24 @@
 	      (res `(= (array-dimension ,obj ,i) ,dim)))))
 	(res)))))
 
+;;; Return forms to test that OBJ has the element-type specified by
+;;; type specified by TYPE, where STYPE is the type we have checked
+;;; against (which is the same but for dimensions and element type).
+(defun test-array-element-type (obj type stype)
+  (declare (type array-type type stype))
+  (let ((obj `(truly-the ,(type-specifier stype) ,obj))
+	(eltype (array-type-specialized-element-type type)))
+    (unless (type= eltype (array-type-specialized-element-type stype))
+      (with-unique-names (data)
+	`((do ((,data ,obj (%array-data-vector ,data)))
+	      ((not (array-header-p ,data))
+	       ;; KLUDGE: this isn't in fact maximally efficient,
+	       ;; because though we know that DATA is a (SIMPLE-ARRAY *
+	       ;; (*)), we will still check to see if the lowtag is
+	       ;; appropriate.
+	       (typep ,data
+		      '(simple-array ,(type-specifier eltype) (*))))))))))
+
 ;;; If we can find a type predicate that tests for the type without
 ;;; dimensions, then use that predicate and test for dimensions.
 ;;; Otherwise, just do %TYPEP.
@@ -354,12 +373,11 @@
 	     ;; not safe to assume here that it will eventually
 	     ;; have (UPGRADED-ARRAY-ELEMENT-TYPE type)=T, so punt.)
 	     (not (unknown-type-p (array-type-element-type type)))
-	     (type= (array-type-specialized-element-type stype)
-		    (array-type-specialized-element-type type))
 	     (eq (array-type-complexp stype) (array-type-complexp type)))
 	(once-only ((n-obj obj))
 	  `(and (,pred ,n-obj)
-		,@(test-array-dimensions n-obj type stype)))
+	        ,@(test-array-dimensions n-obj type stype)
+	        ,@(test-array-element-type n-obj type stype)))
 	`(%typep ,obj ',(type-specifier type)))))
 
 ;;; Transform a type test against some instance type. The type test is
diff --git a/version.lisp-expr b/version.lisp-expr
index 76b87c0..ddb271b 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,5 +17,5 @@
 ;;; 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".)
-"0.8.21.21"
+"0.8.21.22"