X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Farray-tran.lisp;h=d70cdb536e065660d887a0f35a5e6558e083ef65;hb=7f579b076a1fc54587538ead07e506e7f06f3fe8;hp=02c5c3784ac46af0811e650aa2410034df1e05d0;hpb=403f36a8d3521add954f6bd8795ecfc39e69f465;p=sbcl.git

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 02c5c37..d70cdb5 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -609,7 +609,12 @@
     (unless (constant-lvar-p dims)
       (give-up-ir1-transform
        "The dimension list is not constant; cannot open code array creation."))
-    (let ((dims (lvar-value dims)))
+    (let ((dims (lvar-value dims))
+          (element-type-ctype (and (constant-lvar-p element-type)
+                                   (ir1-transform-specifier-type
+                                    (lvar-value element-type)))))
+      (when (unknown-type-p element-type-ctype)
+        (give-up-ir1-transform))
       (unless (every #'integerp dims)
         (give-up-ir1-transform
          "The dimension list contains something other than an integer: ~S"
@@ -626,9 +631,7 @@
                  (rank (length dims))
                  (spec `(simple-array
                          ,(cond ((null element-type) t)
-                                ((and (constant-lvar-p element-type)
-                                      (ir1-transform-specifier-type
-                                       (lvar-value element-type)))
+                                (element-type-ctype
                                  (sb!xc:upgraded-array-element-type
                                   (lvar-value element-type)))
                                 (t '*))
@@ -1006,10 +1009,44 @@
                   `(aref (the ,',type ,a) ,i))
                 (define-source-transform ,setter (a i v)
                   `(%aset (the ,',type ,a) ,i ,v)))))
-  (define-frob svref %svset simple-vector)
   (define-frob schar %scharset simple-string)
   (define-frob char %charset string))
 
+;;; We transform SVREF and %SVSET directly into DATA-VECTOR-REF/SET: this is
+;;; around 100 times faster than going through the general-purpose AREF
+;;; transform which ends up doing a lot of work -- and introducing many
+;;; intermediate lambdas, each meaning a new trip through the compiler -- to
+;;; get the same result.
+;;;
+;;; FIXME: [S]CHAR, and [S]BIT above would almost certainly benefit from a similar
+;;; treatment.
+(define-source-transform svref (vector index)
+  (let ((elt-type (or (when (symbolp vector)
+                        (let ((var (lexenv-find vector vars)))
+                          (when (lambda-var-p var)
+                            (type-specifier
+                             (array-type-declared-element-type (lambda-var-type var))))))
+                      t)))
+    (with-unique-names (n-vector)
+      `(let ((,n-vector ,vector))
+         (the ,elt-type (data-vector-ref
+                         (the simple-vector ,n-vector)
+                         (%check-bound ,n-vector (length ,n-vector) ,index)))))))
+
+(define-source-transform %svset (vector index value)
+  (let ((elt-type (or (when (symbolp vector)
+                        (let ((var (lexenv-find vector vars)))
+                          (when (lambda-var-p var)
+                            (type-specifier
+                             (array-type-declared-element-type (lambda-var-type var))))))
+                      t)))
+    (with-unique-names (n-vector)
+      `(let ((,n-vector ,vector))
+         (truly-the ,elt-type (data-vector-set
+                               (the simple-vector ,n-vector)
+                               (%check-bound ,n-vector (length ,n-vector) ,index)
+                               (the ,elt-type ,value)))))))
+
 (macrolet (;; This is a handy macro for computing the row-major index
            ;; given a set of indices. We wrap each index with a call
            ;; to %CHECK-BOUND to ensure that everything works out