From e4c6f7338e2ca63cef6f82fbd8f88bc9264c292e Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 18 May 2009 09:17:49 +0000 Subject: [PATCH] 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. --- src/compiler/array-tran.lisp | 12 +++++++++--- tests/compiler.impure.lisp | 23 +++++++++++++++++++++++ version.lisp-expr | 2 +- 3 files changed, 33 insertions(+), 4 deletions(-) diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 387f53f..340ce53 100644 --- 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 --- 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 --- 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" -- 1.7.10.4