Merge branch 'jneeman' of git+ssh://jneem@git.sv.gnu.org/srv/git/lilypond into jneeman

[lilypond.git] / scm / lily-library.scm

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 7bdf96d05d542a73b97e5a2a9d5f5b1d45e83c87..0d09beae53b5c6f9e994c10cbc5dbe0cd192eb47 100644 (file)
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -6,6 +6,8 @@
 ;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; constants.
 
 (define-public X 0)
 (define-public Y 1)
@@ -28,11 +30,17 @@
 (define-safe-public DOUBLE-SHARP 4)
 (define-safe-public SEMI-TONE 2)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; moments
+
 (define-public ZERO-MOMENT (ly:make-moment 0 1)) 
 
 (define-public (moment-min a b)
   (if (ly:moment<? a b) a b))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; arithmetic
 (define-public (average x . lst)
   (/ (+ x (apply + lst)) (1+ (length lst))))
 
@@ -120,6 +128,7 @@
 
 ;;;;;;;;;;;;;;;;
 ;; alist
+
 (define-public assoc-get ly:assoc-get)
 
 (define-public (uniqued-alist alist acc)
@@ -192,6 +201,7 @@ found."
 
 ;;;;;;;;;;;;;;;;
 ;; vector
+
 (define-public (vector-for-each proc vec)
   (do
       ((i 0 (1+ i)))
@@ -230,7 +240,54 @@ found."
 ;;;;;;;;;;;;;;;;
 ;; list
 
+(define (functional-or . rest)
+  (if (pair? rest)
+      (or (car rest)
+          (apply functional-and (cdr rest)))
+      #f))
 
+(define (functional-and . rest)
+  (if (pair? rest)
+      (and (car rest)
+          (apply functional-and (cdr rest)))
+      #t))
+
+(define (split-list lst n)
+  "Split LST in N equal sized parts"
+  
+  (define (helper todo acc-vector k)
+    (if (null? todo)
+       acc-vector
+       (begin
+         (if (< k 0)
+             (set! k (+ n k)))
+           
+         (vector-set! acc-vector k (cons (car todo) (vector-ref acc-vector k)))
+         (helper (cdr todo) acc-vector (1- k)))))
+
+  (helper lst (make-vector n '()) (1- n)))
+
+(define (list-element-index lst x)
+  (define (helper todo k)
+    (cond
+     ((null? todo) #f)
+     ((equal? (car todo) x) k)
+     (else
+      (helper (cdr todo) (1+ k)))))
+
+  (helper lst 0))
+
+(define-public (count-list lst)
+  "Given lst (E1 E2 .. ) return ((E1 . 1) (E2 . 2) ... )  "
+
+  (define (helper l acc count)
+    (if (pair? l)
+       (helper (cdr l) (cons (cons (car l) count) acc) (1+ count))
+       acc))
+
+
+  (reverse (helper lst '() 1)))
+  
 (define-public (list-join lst intermediate)
   "put INTERMEDIATE  between all elts of LST."
 
@@ -259,19 +316,17 @@ found."
   "Return list of elements in A that are not in B."
   (lset-difference eq? a b))
 
-;; TODO: use the srfi-1 partition function.
 (define-public (uniq-list lst)
-  
   "Uniq LST, assuming that it is sorted"
-  (define (helper acc lst) 
-    (if (null? lst)
-       acc
-       (if (null? (cdr lst))
-           (cons (car lst) acc)
-           (if (equal? (car lst) (cadr lst))
-               (helper acc (cdr lst))
-               (helper (cons (car lst) acc)  (cdr lst))))))
-  (reverse! (helper '() lst) '()))
+
+  (reverse! 
+   (fold (lambda (x acc)
+          (if (null? acc)
+              (list x)
+              (if (eq? x (car acc))
+                  acc
+                  (cons x acc))))
+        '() lst) '()))
 
 (define (split-at-predicate predicate lst)
  "Split LST = (a_1 a_2 ... a_k b_1 ... b_k)
@@ -280,6 +335,7 @@ found."
   L1 is copied, L2 not.
 
   (split-at-predicate (lambda (x y) (= (- y x) 2)) '(1 3 5 9 11) (cons '() '()))"
+ 
  ;; " Emacs is broken
 
  (define (inner-split predicate lst acc)
@@ -301,8 +357,8 @@ found."
    (set-car! c (reverse! (car c)))
    c))
 
-(define-public (split-list lst sep?)
-   "(display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))))
+(define-public (split-list-by-separator lst sep?)
+   "(display (split-list-by-separator '(a b c / d e f / g) (lambda (x) (equal? x '/))))
    =>
    ((a b c) (d e f) (g))
   "
@@ -318,7 +374,7 @@ found."
    (if (null? lst)
        '()
        (let* ((c (split-one sep? lst '())))
-        (cons (reverse! (car c) '()) (split-list (cdr c) sep?)))))
+        (cons (reverse! (car c) '()) (split-list-by-separator (cdr c) sep?)))))
 
 (define-public (offset-add a b)
   (cons (+ (car a) (car b))