* lily/ly-module.cc (LY_DEFINE): bugfix.

[lilypond.git] / scm / lily.scm

diff --git a/scm/lily.scm b/scm/lily.scm
index 707a403c34b8f70e17b3c7e9385c31e2c15a9c88..264f4be59ada840a0117b25344636938126f3032 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -1,37 +1,62 @@
-;;; lily.scm -- implement Scheme output routines for TeX and PostScript
+;;;; lily.scm -- implement Scheme output routines for TeX and PostScript

 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 

-;;;; (c)  1998--2003 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c)  1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>

 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 ;;; Library functions
 
 
 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 ;;; Library functions
 
 

-(use-modules (ice-9 regex))
+(if (defined? 'set-debug-cell-accesses!)
+    (set-debug-cell-accesses! #f))

 
 

+;; ugh, need this for encoding.scm test
+;; srfi-13 overrides string->list
+(define-public plain-string->list string->list)
+
+(use-modules (ice-9 regex)
+            (ice-9 safe)
+            (oop goops)
+            (srfi srfi-1)  ; lists
+            (srfi srfi-13)) ; strings

 
 

-;;; General settings
-;; debugging evaluator is slower.

 
 

-(debug-enable 'debug)
-;(debug-enable 'backtrace)
-(read-enable 'positions)
+(define-public (myd k v) (display k) (display ": ") (display v) (display ", "))

 
 

+;;; General settings
+;;; debugging evaluator is slower.  This should
+;;; have a more sensible default.
+
+(if (ly:get-option 'verbose)
+    (begin
+      (debug-enable 'debug)
+      (debug-enable 'backtrace)
+      (read-enable 'positions)))

 
 (define-public (line-column-location line col file)
   "Print an input location, including column number ."
   (string-append (number->string line) ":"
 
 (define-public (line-column-location line col file)
   "Print an input location, including column number ."
   (string-append (number->string line) ":"

-                (number->string col) " " file)
-  )
+                (number->string col) " " file))

 
 (define-public (line-location line col file)
   "Print an input location, without column number ."
 
 (define-public (line-location line col file)
   "Print an input location, without column number ."

-  (string-append (number->string line) " " file)
-  )
+  (string-append (number->string line) " " file))

 
 (define-public point-and-click #f)
 
 
 (define-public point-and-click #f)
 

+(define-public parser #f)
+
+(define-public (lilypond-version)
+  (string-join
+   (map (lambda (x) (if (symbol? x)
+                       (symbol->string x)
+                       (number->string x)))
+               (ly:version))
+   "."))
+
+
+

 ;; cpp hack to get useful error message
 (define ifdef "First run this through cpp.")
 (define ifndef "First run this through cpp.")
 ;; cpp hack to get useful error message
 (define ifdef "First run this through cpp.")
 (define ifndef "First run this through cpp.")


@@ -50,37 +75,63 @@
 (define-public DOWN -1)
 (define-public CENTER 0)
 
 (define-public DOWN -1)
 (define-public CENTER 0)
 

+(define-public DOUBLE-FLAT -4)
+(define-public THREE-Q-FLAT -3)
+(define-public FLAT -2)
+(define-public SEMI-FLAT -1)
+(define-public NATURAL 0)
+(define-public SEMI-SHARP 1)
+(define-public SHARP 2)
+(define-public THREE-Q-SHARP 3)
+(define-public DOUBLE-SHARP 4)
+(define-public SEMI-TONE 2)
+
+(define-public ZERO-MOMENT (ly:make-moment 0 1)) 
+
+(define-public (moment-min a b)
+  (if (ly:moment<? a b) a b))
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; lily specific variables.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; lily specific variables.

+

 (define-public default-script-alist '())
 
 (define-public default-script-alist '())
 

-(define-public security-paranoia #f)

 
 

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Unassorted utility functions.
+;; parser stuff.
+(define-public (print-music-as-book parser music)
+  (let* ((score (ly:music-scorify music))
+        (head  (ly:parser-lookup parser '$globalheader))
+        (book (ly:score-bookify score head)))
+    (ly:parser-print-book parser book)))

 
 

+(define-public (print-score-as-book parser score)
+  (let*
+      ((head  (ly:parser-lookup parser '$globalheader))
+       (book (ly:score-bookify score head)))
+    
+    (ly:parser-print-book parser book)))

 
 

-;;;;;;;;;;;;;;;;
-; alist
-(define (uniqued-alist  alist acc)
-  (if (null? alist) acc
-      (if (assoc (caar alist) acc)
-         (uniqued-alist (cdr alist) acc)
-         (uniqued-alist (cdr alist) (cons (car alist) acc)))))
+(define-public (print-score parser score)
+  (let* ((head  (ly:parser-lookup parser '$globalheader))
+       (book (ly:score-bookify score head)))
+    (ly:parser-print-score parser book)))
+               
+(define-public default-toplevel-music-handler print-music-as-book)
+(define-public default-toplevel-book-handler ly:parser-print-book)
+(define-public default-toplevel-score-handler print-score-as-book)

 
 
 
 

-(define (assoc-get key alist)
-  "Return value if KEY in ALIST, else #f."
-  (let ((entry (assoc key alist)))
-    (if entry (cdr entry) #f)))
-  
-(define (assoc-get-default key alist default)
-  "Return value if KEY in ALIST, else DEFAULT."
-  (let ((entry (assoc key alist)))
-    (if entry (cdr entry) default)))

 
 

+;;;;;;;;;;;;;;;;
+; alist
+(define-public (assoc-get key alist . default)
+  "Return value if KEY in ALIST, else DEFAULT (or #f if not specified)."
+  (let ((entry (assoc key alist)))
+    (if (pair? entry)
+       (cdr entry)
+       (if (pair? default) (car default) #f))))

 
 

-(define-public (uniqued-alist  alist acc)
+(define-public (uniqued-alist alist acc)

   (if (null? alist) acc
       (if (assoc (caar alist) acc)
          (uniqued-alist (cdr alist) acc)
   (if (null? alist) acc
       (if (assoc (caar alist) acc)
          (uniqued-alist (cdr alist) acc)


@@ -90,12 +141,85 @@
   (string<? (symbol->string (car x))
            (symbol->string (car y))))
 
   (string<? (symbol->string (car x))
            (symbol->string (car y))))
 

+(define-public (chain-assoc x alist-list)
+  (if (null? alist-list)
+      #f
+      (let* ((handle (assoc x (car alist-list))))
+       (if (pair? handle)
+           handle
+           (chain-assoc x (cdr alist-list))))))
+
+(define-public (chain-assoc-get x alist-list . default)
+  "Return ALIST entry for X. Return DEFAULT (optional, else #f) if not
+found."
+
+  (define (helper x alist-list default)
+    (if (null? alist-list)
+       default
+       (let* ((handle (assoc x (car alist-list))))
+         (if (pair? handle)
+             (cdr handle)
+             (helper x (cdr alist-list) default)))))
+
+  (helper x alist-list
+         (if (pair? default) (car default) #f)))
+
+(define (map-alist-vals func list)
+  "map FUNC over the vals of  LIST, leaving the keys."
+  (if (null?  list)
+      '()
+      (cons (cons  (caar list) (func (cdar list)))
+           (map-alist-vals func (cdr list)))
+      ))
+
+(define (map-alist-keys func list)
+  "map FUNC over the keys of an alist LIST, leaving the vals. "
+  (if (null?  list)
+      '()
+      (cons (cons (func (caar list)) (cdar list))
+           (map-alist-keys func (cdr list)))
+      ))
+ 

 ;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;

-; list
-(define (tail lst)
-  "Return tail element of LST."
-  (car (last-pair lst)))
+;; hash
+
+
+
+(if (not (defined? 'hash-table?))      ; guile 1.6 compat
+    (begin
+      (define hash-table? vector?)

 
 

+      (define-public (hash-table->alist t)
+       "Convert table t to list"
+       (apply append
+              (vector->list t)
+              )))
+
+    ;; native hashtabs.
+    (begin
+      (define-public (hash-table->alist t)
+
+       (hash-fold (lambda (k v acc) (acons  k v  acc))
+                  '() t)
+       )
+      ))
+
+;; todo: code dup with C++. 
+(define-public (alist->hash-table l)
+  "Convert alist to table"
+  (let
+      ((m (make-hash-table (length l))))
+
+    (map (lambda (k-v)
+          (hashq-set! m (car k-v) (cdr k-v)))
+        l)
+
+    m))
+       
+
+
+;;;;;;;;;;;;;;;;
+; list

 
 (define (flatten-list lst)
   "Unnest LST" 
 
 (define (flatten-list lst)
   "Unnest LST" 


@@ -108,65 +232,32 @@
 
 (define (list-minus a b)
   "Return list of elements in A that are not in B."
 
 (define (list-minus a b)
   "Return list of elements in A that are not in B."

-  (if (pair? a)
-      (if (pair? b)
-         (if (member (car a) b)
-             (list-minus (cdr a) b)
-             (cons (car a) (list-minus (cdr a) b)))
-         a)
-      '()))
-
-;; why -list suffix (see reduce-list)
-(define-public (filter-list pred? list)
-  "return that part of LIST for which PRED is true.
-
- TODO: rewrite using accumulator. Now it takes O(n) stack. "
-  
-  (if (null? list) '()
-      (let* ((rest (filter-list pred? (cdr list))))
-       (if (pred? (car list))
-           (cons (car list)  rest)
-           rest))))
-
-(define-public (filter-out-list pred? list)
-  "return that part of LIST for which PRED is false."
-  (if (null? list) '()
-      (let* ((rest (filter-out-list pred? (cdr list))))
-       (if (not (pred? (car list)))
-           (cons (car list)  rest)
-           rest))))
-
-
-(define (first-n n lst)
-  "Return first N elements of LST"
-  (if (and (pair? lst)
-          (> n 0))
-      (cons (car lst) (first-n (- n 1) (cdr lst)))
-      '()))
-
-(define-public (uniq-list list)
-  (if (null? list) '()
-      (if (null? (cdr list))
-         list
-         (if (equal? (car list) (cadr list))
-             (uniq-list (cdr list))
-             (cons (car list) (uniq-list (cdr list)))))))
-
-(define (butfirst-n n lst)
-  "Return all but first N entries of LST"
-  (if (pair? lst)
-      (if (> n 0)
-         (butfirst-n (- n 1) (cdr lst))
-         lst)
-      '()))
+  (lset-difference eq? a b))
+
+
+;; TODO: use the srfi-1 partition function.
+(define-public (uniq-list l)

   
   

-(define (split-at predicate l)
+  "Uniq LIST, assuming that it is sorted"
+  (define (helper acc l) 
+    (if (null? l)
+       acc
+       (if (null? (cdr l))
+           (cons (car l) acc)
+           (if (equal? (car l) (cadr l))
+               (helper acc (cdr l))
+               (helper (cons (car l) acc)  (cdr l)))
+           )))
+  (reverse! (helper '() l) '()))
+
+
+(define (split-at-predicate predicate l)

  "Split L = (a_1 a_2 ... a_k b_1 ... b_k)
 into L1 = (a_1 ... a_k ) and L2 =(b_1 .. b_k) 
 Such that (PREDICATE a_i a_{i+1}) and not (PREDICATE a_k b_1).
 L1 is copied, L2 not.
 
  "Split L = (a_1 a_2 ... a_k b_1 ... b_k)
 into L1 = (a_1 ... a_k ) and L2 =(b_1 .. b_k) 
 Such that (PREDICATE a_i a_{i+1}) and not (PREDICATE a_k b_1).
 L1 is copied, L2 not.
 

-(split-at (lambda (x y) (= (- y x) 2))  '(1 3 5 9 11) (cons '() '()))"
+(split-at-predicate (lambda (x y) (= (- y x) 2))  '(1 3 5 9 11) (cons '() '()))"

 ;; "
 
 ;; KUT EMACS MODE.
 ;; "
 
 ;; KUT EMACS MODE.


@@ -196,19 +287,16 @@ L1 is copied, L2 not.
 
 
 (define-public (split-list l sep?)
 
 
 (define-public (split-list l sep?)

-  "
-
+"

 (display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))) )
 =>
 ((a b c) (d e f) (g))
 
 "
 (display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))) )
 =>
 ((a b c) (d e f) (g))
 
 "

+;; " KUT EMACS.

 
 (define (split-one sep?  l acc)
 
 (define (split-one sep?  l acc)

-  "Split off the first parts before separator and return both parts.
-
-"
-  ;; " KUT EMACS
+  "Split off the first parts before separator and return both parts."

   (if (null? l)
       (cons acc '())
       (if (sep? (car l))
   (if (null? l)
       (cons acc '())
       (if (sep? (car l))


@@ -221,20 +309,9 @@ L1 is copied, L2 not.
     '()
     (let* ((c (split-one sep? l '())))
       (cons (reverse! (car c) '()) (split-list (cdr c) sep?))
     '()
     (let* ((c (split-one sep? l '())))
       (cons (reverse! (car c) '()) (split-list (cdr c) sep?))

-      )
-    )
-)
+      )))

 
 
 
 

-(define-public (range x y)
-  "Produce a list of integers starting at Y with X elements."
-  (if (<= x 0)
-      '()
-      (cons y (range (- x 1)  (+ y 1)))
-
-      )
-  )
-

 (define-public (interval-length x)
   "Length of the number-pair X, when an interval"
   (max 0 (- (cdr x) (car x)))
 (define-public (interval-length x)
   "Length of the number-pair X, when an interval"
   (max 0 (- (cdr x) (car x)))


@@ -245,10 +322,14 @@ L1 is copied, L2 not.
   (remainder (+ a 1) 2))
   
 
   (remainder (+ a 1) 2))
   
 

-(define-public (widen-interval iv amount)
+(define-public (interval-widen iv amount)

    (cons (- (car iv) amount)
    (cons (- (car iv) amount)

-         (+ (cdr iv) amount))
-)
+         (+ (cdr iv) amount)))
+
+(define-public (interval-union i1 i2)
+   (cons (min (car i1) (car i2))
+        (max (cdr i1) (cdr i2))))
+

 
 (define-public (write-me message x)
   "Return X.  Display MESSAGE and write X.  Handy for debugging, possibly turned off."
 
 (define-public (write-me message x)
   "Return X.  Display MESSAGE and write X.  Handy for debugging, possibly turned off."


@@ -264,56 +345,15 @@ L1 is copied, L2 not.
   "map F to contents of X"
   (cons (f (car x)) (f (cdr x))))
 
   "map F to contents of X"
   (cons (f (car x)) (f (cdr x))))
 

-;; used where?
-(define-public (reduce operator list)
-  "reduce OP [A, B, C, D, ... ] =
-   A op (B op (C ... ))
-"
-      (if (null? (cdr list)) (car list)
-         (operator (car list) (reduce operator (cdr list)))))
-
-(define (take-from-list-until todo gathered crit?)
-  "return (G, T), where (reverse G) + T = GATHERED + TODO, and the last of G
-is the  first to satisfy CRIT

 
 

- (take-from-list-until '(1 2 3  4 5) '() (lambda (x) (eq? x 3)))
-=>
- ((3 2 1) 4 5)
-
-"
-  (if (null? todo)
-      (cons gathered todo)
-      (if (crit? (car todo))
-         (cons (cons (car todo) gathered) (cdr todo))
-         (take-from-list-until (cdr todo) (cons (car todo) gathered) crit?)
-      )
-  ))
-
-(define-public (list-insert-separator list between)
+(define-public (list-insert-separator lst between)

   "Create new list, inserting BETWEEN between elements of LIST"
   "Create new list, inserting BETWEEN between elements of LIST"

-  (if (null? list)
-      '()
-      (if (null? (cdr list))
-         list
-         (cons (car list)
-               (cons between (list-insert-separator (cdr list) between)))
-  
-  )))
-
-;;;;;;;;;;;;;;;;
-; strings.
-
-
-;; TODO : make sep optional.
-(define-public (string-join str-list sep)
-  "append the list of strings in STR-LIST, joining them with SEP"
-  
-  (apply string-append (list-insert-separator str-list sep))
-  )
-
-(define-public (pad-string-to str wid)
-  (string-append str (make-string (max (- wid (string-length str)) 0) #\ ))
-  )
+  (define (conc x y )
+    (if (eq? y #f)
+       (list x)
+       (cons x  (cons between y))
+       ))
+  (fold-right conc #f lst))

 
 ;;;;;;;;;;;;;;;;
 ; other
 
 ;;;;;;;;;;;;;;;;
 ; other


@@ -322,6 +362,9 @@ is the  first to satisfy CRIT
       0
       (if (< x 0) -1 1)))
 
       0
       (if (< x 0) -1 1)))
 

+(define-public (symbol<? l r)
+  (string<? (symbol->string l) (symbol->string r)))
+

 (define-public (!= l r)
   (not (= l r)))
 
 (define-public (!= l r)
   (not (= l r)))
 


@@ -330,30 +373,36 @@ is the  first to satisfy CRIT
         (fn (%search-load-path x))
 
         )
         (fn (%search-load-path x))
 
         )

-    (if (ly:verbose)
+    (if (ly:get-option 'verbose)

        (format (current-error-port) "[~A]" fn))
     (primitive-load fn)))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;  output
        (format (current-error-port) "[~A]" fn))
     (primitive-load fn)))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;  output

-(use-modules (scm output-tex)
-            (scm output-ps)
-            (scm output-ascii-script)
-            (scm output-sketch)
-            (scm output-sodipodi)
-            (scm output-pdftex)
+(use-modules (scm framework-tex)
+            (scm framework-ps)

             )
 
             )
 

+
+
+(define output-tex-module
+  (make-module 1021 (list (resolve-interface '(scm output-tex)))))
+(define output-ps-module
+  (make-module 1021 (list (resolve-interface '(scm output-ps)))))
+(define-public (tex-output-expression expr port)
+  (display (eval expr output-tex-module) port))
+(define-public (ps-output-expression expr port)
+  (display (eval expr output-ps-module) port))
+
+

 (define output-alist
   `(
     ("tex" . ("TeX output. The default output form." ,tex-output-expression))
 (define output-alist
   `(
     ("tex" . ("TeX output. The default output form." ,tex-output-expression))

-    ("ps" . ("Direct postscript. Requires setting GS_LIB and GS_FONTPATH" ,ps-output-expression))
-    ("scm" . ("Scheme dump: debug scheme molecule expressions" ,write))
-    ("as" . ("Asci-script. Postprocess with as2txt to get ascii art"  ,as-output-expression))
-    ("sketch" . ("Bare bones Sketch output." ,sketch-output-expression))
-    ("sodipodi" . ("Bare bones Sodipodi output." ,sodipodi-output-expression))
-    ("pdftex" . ("PDFTeX output. Was last seen nonfunctioning." ,pdftex-output-expression))
+    ("scm" . ("Scheme dump: debug scheme stencil expressions" ,write))
+;    ("sketch" . ("Bare bones Sketch output." ,sketch-output-expression))
+;    ("sodipodi" . ("Bare bones Sodipodi output." ,sodipodi-output-expression))
+;    ("pdftex" . ("PDFTeX output. Was last seen nonfunctioning." ,pdftex-output-expression))

     ))
 
 
     ))
 
 


@@ -364,84 +413,158 @@ is the  first to satisfy CRIT
      output-alist)
    ))
 
      output-alist)
    ))
 

-(define-public (find-dumper format )
-  (let*
-      ((d (assoc format output-alist)))
-    
+(define-public (find-dumper format)
+  (let ((d (assoc format output-alist)))

     (if (pair? d)
        (caddr d)
     (if (pair? d)
        (caddr d)

-       (scm-error "Could not find dumper for format ~s" format))
-    ))
+       (scm-error "Could not find dumper for format ~s" format))))
+
+

 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; other files.
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; other files.
 

-(map ly:load
-                                       ; load-from-path
+(for-each ly:load
+     ;; load-from-path

      '("define-music-types.scm"
        "output-lib.scm"
        "c++.scm"
        "chord-ignatzek-names.scm"
        "chord-entry.scm"
        "chord-generic-names.scm"
      '("define-music-types.scm"
        "output-lib.scm"
        "c++.scm"
        "chord-ignatzek-names.scm"
        "chord-entry.scm"
        "chord-generic-names.scm"

-       "molecule.scm"
+       "stencil.scm"

        "new-markup.scm"
        "bass-figure.scm"
        "music-functions.scm"
        "new-markup.scm"
        "bass-figure.scm"
        "music-functions.scm"

+       "part-combiner.scm"

        "define-music-properties.scm"
        "auto-beam.scm"
        "chord-name.scm"
        "define-music-properties.scm"
        "auto-beam.scm"
        "chord-name.scm"

+
+       "ly-from-scheme.scm"

        
        

-       "define-translator-properties.scm"
+       "define-context-properties.scm"

        "translation-functions.scm"
        "script.scm"
        "translation-functions.scm"
        "script.scm"

-       "drums.scm"

        "midi.scm"
        "midi.scm"

-

        "beam.scm"
        "clef.scm"
        "slur.scm"
        "font.scm"
        "beam.scm"
        "clef.scm"
        "slur.scm"
        "font.scm"

+       "encoding.scm"

        
        

+       "fret-diagrams.scm"
+       "define-markup-commands.scm"

        "define-grob-properties.scm"
        "define-grobs.scm"
        "define-grob-interfaces.scm"
        "define-grob-properties.scm"
        "define-grobs.scm"
        "define-grob-interfaces.scm"

-       ))
-
-
+       "page-layout.scm"

        
        

+       "paper.scm"
+
+       ; last:
+       "safe-lily.scm"
+       ))

 
 
 (set! type-p-name-alist
   `(
 
 
 (set! type-p-name-alist
   `(

-   (,ly:dir? . "direction")
-   (,scheme? . "any type")
-   (,number-pair? . "pair of numbers")
-   (,ly:input-location? . "input location")   
-   (,ly:grob? . "grob (GRaphical OBject)")
+   (,boolean-or-symbol? . "boolean or symbol")
+   (,boolean? . "boolean")
+   (,char? . "char")

    (,grob-list? . "list of grobs")
    (,grob-list? . "list of grobs")

-   (,ly:duration? . "duration")
-   (,pair? . "pair")
+   (,hash-table? . "hash table")
+   (,input-port? . "input port")

    (,integer? . "integer")
    (,list? . "list")
    (,integer? . "integer")
    (,list? . "list")

-   (,symbol? . "symbol")
-   (,string? . "string")
-   (,boolean? . "boolean")
-   (,ly:pitch? . "pitch")
-   (,ly:moment? . "moment")
+   (,ly:context? . "context")

    (,ly:dimension? . "dimension, in staff space")
    (,ly:dimension? . "dimension, in staff space")

+   (,ly:dir? . "direction")
+   (,ly:duration? . "duration")
+   (,ly:grob? . "layout object")

    (,ly:input-location? . "input location")
    (,ly:input-location? . "input location")

-   (,music-list? . "list of music")
+   (,ly:moment? . "moment")

    (,ly:music? . "music")
    (,ly:music? . "music")

+   (,ly:pitch? . "pitch")
+   (,ly:translator? . "translator")
+   (,ly:font-metric? . "font metric")
+   (,markup-list? . "list of markups")
+   (,markup? . "markup")
+   (,ly:music-list? . "list of music")
+   (,number-or-grob? . "number or grob")
+   (,number-or-string? . "number or string")
+   (,number-pair? . "pair of numbers")

    (,number? . "number")
    (,number? . "number")

-   (,char? . "char")
-   (,input-port? . "input port")

    (,output-port? . "output port")   
    (,output-port? . "output port")   

-   (,vector? . "vector")
+   (,pair? . "pair")

    (,procedure? . "procedure") 
    (,procedure? . "procedure") 

-   (,boolean-or-symbol? . "boolean or symbol")
-   (,number-or-string? . "number or string")
-   (,markup? . "markup")
-   (,markup-list? . "list of markups")
-   (,number-or-grob? . "number or grob")
+   (,scheme? . "any type")
+   (,string? . "string")
+   (,symbol? . "symbol")
+   (,vector? . "vector")

    ))
    ))

+
+
+;; debug mem leaks
+
+(define gc-protect-stat-count 0)
+(define-public (dump-gc-protects)
+  (set! gc-protect-stat-count (1+ gc-protect-stat-count) )
+  (let*
+      ((protects (sort
+          (hash-table->alist (ly:protects))
+          (lambda (a b)
+            (< (object-address (car a))
+               (object-address (car b))))))
+       (outfile    (open-file (string-append
+              "gcstat-" (number->string gc-protect-stat-count)
+              ".scm"
+              ) "w"))
+       )
+
+    (display "DUMPING...\n")
+    (display
+     (filter
+      (lambda (x) (not (symbol? x))) 
+      (map (lambda (y)
+            (let
+                ((x (car y))
+                 (c (cdr y)))
+
+              (string-append
+               (string-join
+                (map object->string (list (object-address x) c x))
+                " ")
+               "\n")))
+          protects))
+     outfile)
+
+    ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
+
+(define-public (lilypond-main files)
+  "Entry point for Lilypond"
+  (let*
+      ((failed '())
+       (handler (lambda (key arg)
+                 (set! failed (cons arg failed))))
+       )
+
+    (for-each
+     (lambda (fn)
+       (catch 'ly-file-failed
+             (lambda () (ly:parse-file fn))
+             handler))
+       
+       files)
+
+    (if (pair? failed)
+       (begin
+         (display (string-append "\n *** Failed files: " (string-join failed) "\n" ))
+         (exit 1))
+       (exit 0))
+
+    ))
+
+