1.0.28.58: more MAKE-ARRAY goodness

  Consider (MAKE-ARRAY '(3) :INITIAL-CONTENTS (LIST X Y Z)):

  The transform for LIST dimensions replaces this with an identical
  call, except that the dimensions will be 3.

  The transform for INTEGER dimensions fires, but does not yet
  see the (LIST X Y Z) in INITIAL-CONTENTS, since it is now an
  argument to the lambda introduced by the previous call.

  One option would be to delay the latter transform if we don't see
  how to compile it nicely, because after a couple of IR1-OPTIMIZE
  passes the call to LIST will be there, and the intermediate lambda
  eliminated.

  However, because multiple roundtrips like that suck, instead make
  the source transform for MAKE-ARRAY smart enough to recognize this
  case, and transform to the integer argument case directly.

  ...now, this makes me think we really should try to eliminate /
  simplify lambdas introduced by TRANSFORM-CALL up front somehow.

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 387f53f..340ce53 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -233,13 +233,19 @@
 
 ;;; Prevent open coding DIMENSION and :INITIAL-CONTENTS arguments,
 ;;; so that we can pick them apart.
-(define-source-transform make-array (&whole form &rest args)
-  (declare (ignore args))
+(define-source-transform make-array (&whole form dimensions &rest keyargs
+                                     &environment env)
   (if (and (fun-lexically-notinline-p 'list)
            (fun-lexically-notinline-p 'vector))
       (values nil t)
       `(locally (declare (notinline list vector))
-         ,form)))
+         ;; Transform '(3) style dimensions to integer args directly.
+         ,(if (sb!xc:constantp dimensions env)
+              (let ((dims (constant-form-value dimensions env)))
+                (if (and (listp dims) (= 1 (length dims)))
+                    `(make-array ',(car dims) ,@keyargs)
+                    form))
+              form))))
 
 ;;; This baby is a bit of a monster, but it takes care of any MAKE-ARRAY
 ;;; call which creates a vector with a known element type -- and tries

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 151f400..26b12ce 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -1835,4 +1835,27 @@
 (setf *mystery* :mystery)
 (assert (eq :ok (test-mystery (make-thing :slot :mystery))))
 
+;;; optimizing make-array
+(defun count-code-callees (f)
+  (let ((code (sb-kernel:fun-code-header f))
+        (n 0))
+    (loop for i from sb-vm::code-constants-offset below (sb-kernel:get-header-data code)
+          for c = (sb-kernel:code-header-ref code i)
+          do (when (typep c 'fdefn)
+               (print c)
+               (incf n)))
+    n))
+(assert (zerop (count-code-callees
+                (compile nil
+                         `(lambda (x y z)
+                            (make-array '(3) :initial-contents (list x y z)))))))
+(assert (zerop (count-code-callees
+                (compile nil
+                         `(lambda (x y z)
+                            (make-array '3 :initial-contents (vector x y z)))))))
+(assert (zerop (count-code-callees
+                (compile nil
+                         `(lambda (x y z)
+                            (make-array '3 :initial-contents `(,x ,y ,z)))))))
+
 ;;; success

diff --git a/version.lisp-expr b/version.lisp-expr
index 27774ee..639ca72 100644 (file)
--- 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.28.57"
+"1.0.28.58"