From 63bb57defa65f96e6467cecc1a705c5e75a9b5df Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sat, 5 Jul 2014 11:44:15 -0400 Subject: Reduce allocation in transform*. * sly/transform.scm (transform*): Use a single array to accumulate result. --- sly/transform.scm | 31 ++++++++++++++++++++----------- 1 file changed, 20 insertions(+), 11 deletions(-) (limited to 'sly') diff --git a/sly/transform.scm b/sly/transform.scm index afb8d97..05ce32d 100644 --- a/sly/transform.scm +++ b/sly/transform.scm @@ -114,17 +114,26 @@ null-transform if called without any arguments." (define (transform* . transforms) "Return the product of all given transformation matrices. Return identity-transform if called without any arguments." - (define (mul a b) - (let ((m1 (transform-matrix a)) - (m2 (transform-matrix b)) - (m3 (make-4x4-matrix))) - (do-ec (: r 4) (: c 4) - (let ((x (sum-ec (: k 4) - (* (array-ref m1 r k) - (array-ref m2 k c))))) - (array-set! m3 x r c))) - (%make-transform m3))) - (reduce mul identity-transform transforms)) + (cond + ((null? transforms) + identity-transform) + ((null? (cdr transforms)) + (car transforms)) + (else + (let ((result (make-4x4-matrix))) + (array-copy! (transform-matrix (car transforms)) result) + (for-each + (lambda (t) + (let ((m (transform-matrix t))) + (do-ec + (: r 4) (: c 4) + (let ((x (sum-ec + (: k 4) + (* (array-ref m r k) + (array-ref result k c))))) + (array-set! result x r c))))) + (cdr transforms)) + (%make-transform result))))) (define (translate v) "Return a new transform that translates by the 2D or 3D vector V." -- cgit v1.2.3