]> git.donarmstrong.com Git - lilypond.git/commitdiff
auto-beam engraver: memory efficiency
authorKeith OHara <k-ohara5a5a@oco.net>
Sun, 28 Dec 2014 01:13:57 +0000 (17:13 -0800)
committerKeith OHara <k-ohara5a5a@oco.net>
Sat, 10 Jan 2015 05:30:51 +0000 (21:30 -0800)
The old code was tail-recursive modulo cons, but Guile did not seem
to recognise that and did not optimize the recursion away.

scm/auto-beam.scm

index 6191017dfe84b9ef40b1c7bd89a4b0e9e2589b79..9ba08705ef0102cab09683c8e2747411f7a23704 100644 (file)
     (let ((value (ly:context-property context name)))
       (if (not (null? value)) value default)))
 
-  (define (ending-moments group-list start-beat base-length)
-    (if (null? group-list)
-        '()
-        (let ((new-start (+ start-beat (car group-list))))
-          (cons (* new-start base-length)
-                (ending-moments (cdr group-list) new-start base-length)))))
+  (define (ending-moments group-list base-length)
+    (let ((beat 0))
+      (map-in-order (lambda (x)
+                      (set! beat (+ beat x))
+                      (* base-length beat))
+                    group-list)))
 
   (define (larger-setting type sorted-alist)
     (assoc type sorted-alist <=))
@@ -64,7 +64,7 @@
              (time-signature-fraction
               (get 'timeSignatureFraction '(4 . 4)))
              (beat-structure (get 'beatStructure '(1 1 1 1)))
-             (beat-endings (ending-moments beat-structure base-length))
+             (beat-endings (ending-moments beat-structure base-length))
              (exceptions (sort (map
                                 (lambda (a)
                                   (if (pair? (car a))
@@ -95,7 +95,7 @@
                                   type))
              (exception-moments (and exception-grouping
                                      (ending-moments
-                                      exception-grouping grouping-moment))))
+                                      exception-grouping grouping-moment))))
 
         (if (= dir START)
             ;; Start rules -- #t if beam is allowed to start