Reduce allocation in transform*.

* sly/transform.scm (transform*): Use a single array to accumulate
  result.

1 files changed, 20 insertions, 11 deletions

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."