Changeset 7924

Timestamp:

Dec 20, 2007, 6:31:51 AM (17 years ago)

Author:

Bill St. Clair

Message:

TYPEP was consing on a user-defined array type, due to the call to
ARRAY-DIMENSIONS in %%TYPEP. I changed it to use ARRAY-RANK and
ARRAY-DIMENSION, which slightly slows it down, not counting GC
time, but stops it from consing.

Example:

(deftype my-string () 'string)
(time (typep "foo" 'my-string)) ; Conses type structures
(time (typep "foo" 'my-string))

The final form conses 16 bytes before this change, 0 after.

File:

• branches/working-0711/ccl/level-1/l1-typesys.lisp (modified) (1 diff)

branches/working-0711/ccl/level-1/l1-typesys.lisp

@@ -3641 +3641 @@
               ((* :maybe) t))
             (or (eq (array-ctype-dimensions type) '*)
-                (do ((want (array-ctype-dimensions type) (cdr want))
-                     (got (array-dimensions object) (cdr got)))
-                    ((and (null want) (null got)) t)
-                  (unless (and want got
-                               (or (eq (car want) '*)
-                                   (= (car want) (car got))))
-                    (return nil))))
+                (let ((rank (array-rank object)))
+                  (declare (fixnum rank))
+                  (do* ((n 0 (1+ n))
+                        (want (array-ctype-dimensions type) (cdr want))
+                        (got (and (< n rank) (array-dimension object n))
+                             (and (< n rank) (array-dimension object n))))
+                       ((and (null want) (null got)) t)
+                    (declare (fixnum n))
+                    (unless (and want got
+                                 (or (eq (car want) '*)
+                                     (= (car want) got)))
+                      (return nil)))))
             (or (eq (array-ctype-element-type type) *wild-type*)
                 (type= (array-ctype-specialized-element-type type)