GUILE debug: Revert part of 52bea08ef73a55ee, so the file of an error is shown

[lilypond.git] / scm / lily.scm

diff --git a/scm/lily.scm b/scm/lily.scm
index 360e694053fafaf1b6a59b0110d6e6182f305b21..e8fb65d4f408dbbd6a2628b9062c1d4a9ecf387e 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -1,9 +1,20 @@
-;;;; lily.scm -- top-level Scheme stuff
+;;;; This file is part of LilyPond, the GNU music typesetter.

 ;;;;
 ;;;;

-;;;;  source file of the GNU LilyPond music typesetter
-;;;;
-;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>

 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>

+;;;;
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.

 
 ;; Internationalisation: (_i "to be translated") gets an entry in the
 ;; POT file; (gettext ...) must be invoked explicitly to do the actual
 
 ;; Internationalisation: (_i "to be translated") gets an entry in the
 ;; POT file; (gettext ...) must be invoked explicitly to do the actual


@@ -16,8 +27,16 @@
 
 (defmacro-public _i (x) x)
 
 
 (defmacro-public _i (x) x)
 

+;;; Boolean thunk - are we integrating Guile V2.0 or higher with LilyPond?
+(define-public (guile-v2)
+  (string>? (version) "1.9.10"))
+

 (read-enable 'positions)
 (read-enable 'positions)

-(debug-enable 'debug)
+(if (not (guile-v2))
+    (debug-enable 'debug)
+    (begin
+      (debug-enable 'backtrace)
+      (debug-enable 'show-file-name)))

 
 (define-public PLATFORM
   (string->symbol
 
 (define-public PLATFORM
   (string->symbol


@@ -38,9 +57,12 @@
 "Render at higher resolution (using given factor)
 and scale down result to prevent jaggies in
 PNG images.")
 "Render at higher resolution (using given factor)
 and scale down result to prevent jaggies in
 PNG images.")

+    (aux-files #t
+"Create .tex, .texi, .count files in the
+EPS backend.")

     (backend ps
 "Select backend.  Possible values: 'eps, 'null,
     (backend ps
 "Select backend.  Possible values: 'eps, 'null,

-'ps, 'scm, 'svg.")
+'ps, 'scm, 'socket, 'svg.")

     (check-internal-types #f
 "Check every property assignment for types.")
     (clip-systems #f
     (check-internal-types #f
 "Check every property assignment for types.")
     (clip-systems #f


@@ -65,7 +87,7 @@ configurations.")
 "Debug cyclic callback chains.")
     (debug-skylines #f
 "Debug skylines.")
 "Debug cyclic callback chains.")
     (debug-skylines #f
 "Debug skylines.")

-    (delete-intermediate-files #f
+    (delete-intermediate-files #t

 "Delete unusable, intermediate PostScript files.")
     (dump-profile #f
 "Dump memory and time information for each file.")
 "Delete unusable, intermediate PostScript files.")
     (dump-profile #f
 "Dump memory and time information for each file.")


@@ -90,6 +112,8 @@ a log file.")
 "Include book titles in preview images.")
     (include-eps-fonts #t
 "Include fonts in separate-system EPS files.")
 "Include book titles in preview images.")
     (include-eps-fonts #t
 "Include fonts in separate-system EPS files.")

+    (include-settings #f
+"Include file for global settings, included before the score is processed.")

     (job-count #f
 "Process in parallel, using the given number of
 jobs.")
     (job-count #f
 "Process in parallel, using the given number of
 jobs.")


@@ -101,6 +125,9 @@ output to log file `FOO.log'.")
                         "midi")
 "Set the default file extension for MIDI output
 file to given string.")
                         "midi")
 "Set the default file extension for MIDI output
 file to given string.")

+    (music-strings-to-paths #f
+"Convert text strings to paths when glyphs belong
+to a music font.")

     (old-relative #f
 "Make \\relative mode for simultaneous music work
 similar to chord syntax.")
     (old-relative #f
 "Make \\relative mode for simultaneous music work
 similar to chord syntax.")


@@ -111,7 +138,7 @@ similar to chord syntax.")
     (pixmap-format "png16m"
 "Set GhostScript's output format for pixel images.")
     (preview #f
     (pixmap-format "png16m"
 "Set GhostScript's output format for pixel images.")
     (preview #f

-"Create PNG and EPS preview images also.")
+"Create preview images also.")

     (print-pages #t
 "Print pages in the normal way.")
     (protected-scheme-parsing #t
     (print-pages #t
 "Print pages in the normal way.")
     (protected-scheme-parsing #t


@@ -132,26 +159,31 @@ the included file relative to the current file
 (instead of the root file)")
     (safe #f
 "Run in safer mode.")
 (instead of the root file)")
     (safe #f
 "Run in safer mode.")

+    (separate-log-files #f
+"For input files `FILE1.ly', `FILE2.ly', ...
+output log data to files `FILE1.log',
+`FILE2.log', ...")
+    (show-available-fonts #f
+"List available font names.")

     (strict-infinity-checking #f
 "Force a crash on encountering Inf and NaN
 floating point exceptions.")
     (strip-output-dir #t
 "Don't use directories from input files while
 constructing output file names.")
     (strict-infinity-checking #f
 "Force a crash on encountering Inf and NaN
 floating point exceptions.")
     (strip-output-dir #t
 "Don't use directories from input files while
 constructing output file names.")

-    (separate-log-files #f
-"For input files `FILE1.ly', `FILE2.ly', ...
-output log data to files `FILE1.log',
-`FILE2.log', ...")
+    (svg-woff #f
+"Use woff font files in SVG backend.")

     (trace-memory-frequency #f
 "Record Scheme cell usage this many times per
 second.  Dump results to `FILE.stacks' and
 `FILE.graph'.")
     (trace-scheme-coverage #f
 "Record coverage of Scheme files in `FILE.cov'.")
     (trace-memory-frequency #f
 "Record Scheme cell usage this many times per
 second.  Dump results to `FILE.stacks' and
 `FILE.graph'.")
     (trace-scheme-coverage #f
 "Record coverage of Scheme files in `FILE.cov'.")

-    (show-available-fonts #f
-"List available font names.")

     (verbose ,(ly:command-line-verbose?)
 "Value of the --verbose flag (read-only).")
     (verbose ,(ly:command-line-verbose?)
 "Value of the --verbose flag (read-only).")

+    (warning-as-error #f
+"Change all warning and programming_error
+messages into errors.")

     ))
 
 ;; Need to do this in the beginning.  Other parts of the Scheme
     ))
 
 ;; Need to do this in the beginning.  Other parts of the Scheme


@@ -170,13 +202,13 @@ second.  Dump results to `FILE.stacks' and
 (if (defined? 'set-debug-cell-accesses!)
     (set-debug-cell-accesses! #f))
 
 (if (defined? 'set-debug-cell-accesses!)
     (set-debug-cell-accesses! #f))
 

-                                       ;(set-debug-cell-accesses! 1000)
+;;(set-debug-cell-accesses! 1000)

 
 (use-modules (ice-9 regex)
             (ice-9 safe)
             (ice-9 format)
             (ice-9 rdelim)
 
 (use-modules (ice-9 regex)
             (ice-9 safe)
             (ice-9 format)
             (ice-9 rdelim)

-             (ice-9 optargs)
+            (ice-9 optargs)

             (oop goops)
             (srfi srfi-1)
             (srfi srfi-13)
             (oop goops)
             (srfi srfi-1)
             (srfi srfi-13)


@@ -185,11 +217,31 @@ second.  Dump results to `FILE.stacks' and
             (scm memory-trace)
             (scm coverage))
 
             (scm memory-trace)
             (scm coverage))
 

+(define-public _ gettext)
+;;; There are new modules defined in Guile V2.0 which we need to use.
+;;
+;;  Modules and scheme files loaded by lily.scm use currying
+;;  in Guile V2 this needs a module which is not present in Guile V1.8
+;;
+
+(cond
+  ((guile-v2)
+   (if (ly:get-option 'verbose)
+       (ly:message  (_ "Using (ice-9 curried-definitions) module\n")))
+   (use-modules (ice-9 curried-definitions)))
+  (else
+    (if (ly:get-option 'verbose)
+        (ly:message (_ "Guile 1.8\n")))))
+
+;; TODO add in modules for V1.8.7 deprecated in V2.0 and integrated
+;; into Guile base code, like (ice-9 syncase).
+;;
+

 (define-public fancy-format
   format)
 
 (define-public (ergonomic-simple-format dest . rest)
 (define-public fancy-format
   format)
 
 (define-public (ergonomic-simple-format dest . rest)

-  "Like ice-9 format, but without the memory consumption."
+  "Like ice-9's @code{format}, but without the memory consumption."

   (if (string? dest)
       (apply simple-format (cons #f (cons dest rest)))
       (apply simple-format (cons dest rest))))
   (if (string? dest)
       (apply simple-format (cons #f (cons dest rest)))
       (apply simple-format (cons dest rest))))


@@ -219,7 +271,6 @@ second.  Dump results to `FILE.stacks' and
        (ly:get-option 'trace-scheme-coverage))
     (begin
       (ly:set-option 'protected-scheme-parsing #f)
        (ly:get-option 'trace-scheme-coverage))
     (begin
       (ly:set-option 'protected-scheme-parsing #f)

-      (debug-enable 'debug)

       (debug-enable 'backtrace)
       (read-enable 'positions)))
 
       (debug-enable 'backtrace)
       (read-enable 'positions)))
 


@@ -228,11 +279,12 @@ second.  Dump results to `FILE.stacks' and
 
 (define-public parser #f)
 
 
 (define-public parser #f)
 

+(define music-string-to-path-backends
+  '(svg))
+
+(if (memq (ly:get-option 'backend) music-string-to-path-backends)
+    (ly:set-option 'music-strings-to-paths #t))

 
 

-;; gettext wrapper for guile < 1.7.2
-(if (defined? 'gettext)
-    (define-public _ gettext)
-    (define-public _ ly:gettext))

 
 (define-public (ly:load x)
   (let* ((file-name (%search-load-path x)))
 
 (define-public (ly:load x)
   (let* ((file-name (%search-load-path x)))


@@ -240,7 +292,7 @@ second.  Dump results to `FILE.stacks' and
        (ly:progress "[~A" file-name))
     (if (not file-name)
        (ly:error (_ "cannot find: ~A") x))
        (ly:progress "[~A" file-name))
     (if (not file-name)
        (ly:error (_ "cannot find: ~A") x))

-    (primitive-load file-name)
+    (primitive-load-path file-name)  ;; to support Guile V2 autocompile

     (if (ly:get-option 'verbose)
        (ly:progress "]\n"))))
 
     (if (ly:get-option 'verbose)
        (ly:progress "]\n"))))
 


@@ -250,25 +302,17 @@ second.  Dump results to `FILE.stacks' and
     (if (null? (cdr platform)) #f
        (member (string-downcase (cadr platform)) '("95" "98" "me")))))
 
     (if (null? (cdr platform)) #f
        (member (string-downcase (cadr platform)) '("95" "98" "me")))))
 

-(case PLATFORM
-  ((windows)
-   (define native-getcwd
-     getcwd)
+(define (slashify x)
+  (if (string-index x #\\)
+      x
+      (string-regexp-substitute
+       "//*" "/"
+       (string-regexp-substitute "\\\\" "/" x))))

 
 

-   (define (slashify x)
-     (if (string-index x #\\)
-        x
-        (string-regexp-substitute
-         "//*" "/"
-         (string-regexp-substitute "\\\\" "/" x))))
-
-   ;; FIXME: this prints a warning.
-   (define-public (ly-getcwd)
-     (slashify (native-getcwd))))
-
-  (else
-   (define-public ly-getcwd
-     getcwd)))
+(define-public (ly-getcwd)
+  (if (eq? PLATFORM 'windows)
+      (slashify (getcwd))
+      (getcwd)))

 
 (define-public (is-absolute? file-name)
   (let ((file-name-length (string-length file-name)))
 
 (define-public (is-absolute? file-name)
   (let ((file-name-length (string-length file-name)))


@@ -281,7 +325,22 @@ second.  Dump results to `FILE.stacks' and
                 (eq? (string-ref file-name 2) #\/))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                 (eq? (string-ref file-name 2) #\/))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+;;; If necessary, emulate Guile V2 module_export_all! for Guile V1.8.n
+(cond-expand
+ ((not guile-v2)
+  (define (module-export-all! mod)
+    (define (fresh-interface!)
+      (let ((iface (make-module)))
+       (set-module-name! iface (module-name mod))
+       ;; for guile 2: (set-module-version! iface (module-version mod))
+       (set-module-kind! iface 'interface)
+       (set-module-public-interface! mod iface)
+       iface))
+    (let ((iface (or (module-public-interface mod)
+                    (fresh-interface!))))
+      (set-module-obarray! iface (module-obarray mod))))))

 
 

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (define (type-check-list location signature arguments)
   "Typecheck a list of arguments against a list of type predicates.
 Print a message at LOCATION if any predicate failed."
 (define (type-check-list location signature arguments)
   "Typecheck a list of arguments against a list of type predicates.
 Print a message at LOCATION if any predicate failed."


@@ -303,16 +362,6 @@ Print a message at LOCATION if any predicate failed."
             (recursion-helper (cdr signature) (cdr arguments) (1+ count)))))
   (recursion-helper signature arguments 1))
 
             (recursion-helper (cdr signature) (cdr arguments) (1+ count)))))
   (recursion-helper signature arguments 1))
 

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;  output
-
-;; (define-public (output-framework) (write "hello\n"))
-
-(define output-ps-module
-  (make-module 1021 (list (resolve-interface '(scm output-ps)))))
-
-(define-public (ps-output-expression expr port)
-  (display (eval expr output-ps-module) port))

 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Safe definitions utility
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Safe definitions utility


@@ -356,7 +405,9 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
   '("lily-library.scm"
     "file-cache.scm"
     "define-event-classes.scm"
   '("lily-library.scm"
     "file-cache.scm"
     "define-event-classes.scm"

+    "define-music-callbacks.scm"

     "define-music-types.scm"
     "define-music-types.scm"

+    "define-note-names.scm"

     "output-lib.scm"
     "c++.scm"
     "chord-ignatzek-names.scm"
     "output-lib.scm"
     "c++.scm"
     "chord-ignatzek-names.scm"


@@ -364,17 +415,22 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
     "chord-generic-names.scm"
     "stencil.scm"
     "markup.scm"
     "chord-generic-names.scm"
     "stencil.scm"
     "markup.scm"

+    "modal-transforms.scm"

     "music-functions.scm"
     "part-combiner.scm"
     "autochange.scm"
     "define-music-properties.scm"
     "music-functions.scm"
     "part-combiner.scm"
     "autochange.scm"
     "define-music-properties.scm"

+    "time-signature-settings.scm"

     "auto-beam.scm"
     "auto-beam.scm"

-    "chord-name.scm"
-
+    "bezier-tools.scm"

     "parser-ly-from-scheme.scm"
     "ly-syntax-constructors.scm"
 
     "define-context-properties.scm"
     "parser-ly-from-scheme.scm"
     "ly-syntax-constructors.scm"
 
     "define-context-properties.scm"

+    ;; guile 1.9 wants markups defined before referenced
+    "define-markup-commands.scm"
+
+    "chord-name.scm"

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


@@ -386,9 +442,11 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
 
     "flag-styles.scm"
     "fret-diagrams.scm"
 
     "flag-styles.scm"
     "fret-diagrams.scm"

+    "tablature.scm"

     "harp-pedals.scm"
     "harp-pedals.scm"

+    "define-woodwind-diagrams.scm"
+    "display-woodwind-diagrams.scm"

     "predefined-fretboards.scm"
     "predefined-fretboards.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"


@@ -404,42 +462,120 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
 
 (for-each ly:load init-scheme-files)
 
 
 (for-each ly:load init-scheme-files)
 

+(define-public r5rs-primary-predicates
+  `((,boolean? . "boolean")
+    (,char? . "character")
+    (,number? . "number")
+    (,pair? . "pair")
+    (,port? . "port")
+    (,procedure? . "procedure")
+    (,string? . "string")
+    (,symbol? . "symbol")
+    (,vector? . "vector")))
+
+(define-public r5rs-secondary-predicates
+  `((,char-alphabetic? . "alphabetic character")
+    (,char-lower-case? . "lower-case character")
+    (,char-numeric? . "numeric character")
+    (,char-upper-case? . "upper-case character")
+    (,char-whitespace? . "whitespace character")
+
+    (,complex? . "complex number")
+    (,even? . "even number")
+    (,exact? . "exact number")
+    (,inexact? . "inexact number")
+    (,integer? . "integer")
+    (,negative? . "negative number")
+    (,odd? . "odd number")
+    (,positive? . "positive number")
+    (,rational? . "rational number")
+    (,real? . "real number")
+    (,zero? . "zero")
+
+    (,list? . "list")
+    (,null? . "null")
+
+    (,input-port? . "input port")
+    (,output-port? . "output port")
+
+    ;; would this ever be used?
+    (,eof-object? . "end-of-file object")
+    ))
+
+(define-public guile-predicates
+  `((,hash-table? . "hash table")
+  ))
+
+(define-public lilypond-scheme-predicates
+  `((,boolean-or-symbol? . "boolean or symbol")
+    (,color? . "color")
+    (,cheap-list? . "list")
+    (,grob-list? . "list of grobs")
+    ;; this is built on cheap-list
+    (,list-or-symbol? . "list or symbol")
+    (,markup? . "markup")
+    (,markup-command-list? . "markup command list")
+    (,markup-list? . "markup list")
+    (,moment-pair? . "pair of moment objects")
+    (,number-or-grob? . "number or grob")
+    (,number-or-pair? . "number or pair")
+    (,number-or-string? . "number or string")
+    (,number-pair? . "pair of numbers")
+    (,rhythmic-location? . "rhythmic location")
+    (,scheme? . "any type")
+    (,string-or-pair? . "string or pair")
+    (,string-or-symbol? . "string or symbol")
+    ))
+
+(define-public lilypond-exported-predicates
+  `((,ly:box? . "box")
+    (,ly:context? . "context")
+    (,ly:dimension? . "dimension, in staff space")
+    (,ly:dir? . "direction")
+    (,ly:dispatcher? . "dispatcher")
+    (,ly:duration? . "duration")
+    (,ly:font-metric? . "font metric")
+    (,ly:grob? . "graphical (layout) object")
+    (,ly:grob-array? . "array of grobs")
+    (,ly:input-location? . "input location")
+    (,ly:item? . "item")
+    (,ly:iterator? . "iterator")
+    (,ly:lily-lexer? . "lily-lexer")
+    (,ly:lily-parser? . "lily-parser")
+    (,ly:listener? . "listener")
+    (,ly:moment? . "moment")
+    (,ly:music? . "music")
+    (,ly:music-function? . "music function")
+    (,ly:music-list? . "list of music objects")
+    (,ly:music-output? . "music output")
+    (,ly:otf-font? . "OpenType font")
+    (,ly:output-def? . "output definition")
+    (,ly:page-marker? . "page marker")
+    (,ly:pango-font? . "pango font")
+    (,ly:paper-book? . "paper book")
+    (,ly:paper-system? . "paper-system Prob")
+    (,ly:pitch? . "pitch")
+    (,ly:prob? . "property object")
+    (,ly:score? . "score")
+    (,ly:simple-closure? . "simple closure")
+    (,ly:skyline? . "skyline")
+    (,ly:skyline-pair? . "pair of skylines")
+    (,ly:source-file? . "source file")
+    (,ly:spanner? . "spanner")
+    (,ly:stencil? . "stencil")
+    (,ly:stream-event? . "stream event")
+    (,ly:translator? . "translator")
+    (,ly:translator-group? . "translator group")
+    ))
+
+

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

-      `((,boolean-or-symbol? . "boolean or symbol")
-       (,boolean? . "boolean")
-       (,char? . "char")
-       (,grob-list? . "list of grobs")
-       (,hash-table? . "hash table")
-       (,input-port? . "input port")
-       (,integer? . "integer")
-       (,list? . "list")
-       (,ly:context? . "context")
-       (,ly:dimension? . "dimension, in staff space")
-       (,ly:dir? . "direction")
-       (,ly:duration? . "duration")
-       (,ly:grob? . "layout object")
-       (,ly:input-location? . "input location")
-       (,ly:moment? . "moment")
-       (,ly:music? . "music")
-       (,ly:pitch? . "pitch")
-       (,ly:translator? . "translator")
-       (,ly:font-metric? . "font metric")
-       (,ly:simple-closure? . "simple closure")
-       (,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")
-       (,output-port? . "output port")
-       (,pair? . "pair")
-       (,procedure? . "procedure")
-       (,rhythmic-location? . "rhythmic location")
-       (,scheme? . "any type")
-       (,string? . "string")
-       (,symbol? . "symbol")
-       (,vector? . "vector")))
+      (append r5rs-primary-predicates
+              r5rs-secondary-predicates
+              guile-predicates
+              lilypond-scheme-predicates
+              lilypond-exported-predicates))
+

 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; timing
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; timing


@@ -449,11 +585,11 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
         (stats (gc-stats)))
     (list (- (+ (tms:cutime t)
                (tms:utime t))
         (stats (gc-stats)))
     (list (- (+ (tms:cutime t)
                (tms:utime t))

-            (ly:assoc-get 'gc-time-taken stats))
-         (ly:assoc-get 'total-cells-allocated  stats 0))))
+            (assoc-get 'gc-time-taken stats))
+         (assoc-get 'total-cells-allocated  stats 0))))

 
 (define (dump-profile base last this)
 
 (define (dump-profile base last this)

-  (let* ((outname (format "~a.profile" (dir-basename base ".ly")))
+  (let* ((outname (format #f "~a.profile" (dir-basename base ".ly")))

         (diff (map (lambda (y) (apply - y)) (zip this last))))
     (ly:progress "\nWriting timing to ~a..." outname)
     (format (open-file outname "w")
         (diff (map (lambda (y) (apply - y)) (zip this last))))
     (ly:progress "\nWriting timing to ~a..." outname)
     (format (open-file outname "w")


@@ -490,18 +626,15 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
                         ".scm"))
         (outfile (open-file out-file-name "w")))
     (set! gc-dumping #t)
                         ".scm"))
         (outfile (open-file out-file-name "w")))
     (set! gc-dumping #t)

-    (display (format "Dumping GC statistics ~a...\n" out-file-name))
-    (display (map (lambda (y)
-                   (let ((x (car y))
-                         (c (cdr y)))
-                     (display
-                      (format "~a (~a) = ~a\n" (object-address x) c x)
-                      outfile)))
-                 (filter
-                  (lambda (x)
-                    (not (symbol? (car x))))
-                  protects))
-            outfile)
+    (format #t "Dumping GC statistics ~a...\n" out-file-name)
+    (for-each (lambda (y)
+               (let ((x (car y))
+                     (c (cdr y)))
+                 (format outfile "~a (~a) = ~a\n" (object-address x) c x)))
+             (filter
+              (lambda (x)
+                (not (symbol? (car x))))
+              protects))

     (format outfile "\nprotected symbols: ~a\n"
            (apply + (map (lambda (obj-count)
                            (if (symbol? (car obj-count))
     (format outfile "\nprotected symbols: ~a\n"
            (apply + (map (lambda (obj-count)
                            (if (symbol? (car obj-count))


@@ -527,15 +660,10 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
     (newline outfile)
     (let* ((stats (gc-stats)))
       (for-each (lambda (sym)
     (newline outfile)
     (let* ((stats (gc-stats)))
       (for-each (lambda (sym)

-                 (display
-                  (format "~a ~a ~a\n"
-                          gc-protect-stat-count
-                          sym
-                          (let ((sym-stat (assoc sym stats)))
-                            (if sym-stat
-                                (cdr sym-stat)
-                                "?")))
-                  outfile))
+                 (format outfile "~a ~a ~a\n"
+                         gc-protect-stat-count
+                         sym
+                         (assoc-get sym stats "?")))

                '(protected-objects bytes-malloced cell-heap-size)))
     (set! gc-dumping #f)
     (close-port outfile)))
                '(protected-objects bytes-malloced cell-heap-size)))
     (set! gc-dumping #f)
     (close-port outfile)))


@@ -556,7 +684,7 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
                                 (string-match "^VmData:[ \t]*([0-9]*) kB" l))
                               lines)))
         (mem (string->number (match:substring (car interesting) 1))))
                                 (string-match "^VmData:[ \t]*([0-9]*) kB" l))
                               lines)))
         (mem (string->number (match:substring (car interesting) 1))))

-    (display (format  "VMDATA: ~a\n" mem))
+    (format #t "VMDATA: ~a\n" mem)

     (display (gc-stats))
     (if (> mem 100000)
        (begin (dump-gc-protects)
     (display (gc-stats))
     (if (> mem 100000)
        (begin (dump-gc-protects)


@@ -579,20 +707,31 @@ PIDs or the number of the process."
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

+(define* (ly:exit status #:optional (silently #f))
+  "Exit function for lilypond"
+  (if (not silently)
+      (case status
+       ((0) (ly:success (_ "Compilation successfully completed")))
+       ((1) (ly:warning (_ "Compilation completed with warnings or errors")))
+       (else (ly:message ""))))
+  (exit status))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+

 (define-public (lilypond-main files)
   "Entry point for LilyPond."
   (eval-string (ly:command-line-code))
   (if (ly:get-option 'help)
       (begin (ly:option-usage)
 (define-public (lilypond-main files)
   "Entry point for LilyPond."
   (eval-string (ly:command-line-code))
   (if (ly:get-option 'help)
       (begin (ly:option-usage)

-            (exit 0)))
+            (ly:exit 0 #t)))

   (if (ly:get-option 'show-available-fonts)
       (begin (ly:font-config-display-fonts)
   (if (ly:get-option 'show-available-fonts)
       (begin (ly:font-config-display-fonts)

-            (exit 0)))
+            (ly:exit 0 #t)))

   (if (ly:get-option 'gui)
       (gui-main files))
   (if (null? files)
       (begin (ly:usage)
   (if (ly:get-option 'gui)
       (gui-main files))
   (if (null? files)
       (begin (ly:usage)

-            (exit 2)))
+            (ly:exit 2 #t)))

   (if (ly:get-option 'read-file-list)
       (set! files
            (filter (lambda (s)
   (if (ly:get-option 'read-file-list)
       (set! files
            (filter (lambda (s)


@@ -611,7 +750,7 @@ PIDs or the number of the process."
            (ly:set-option 'log-file "lilypond-multi-run"))
        (if (number? joblist)
            (begin (ly:set-option
            (ly:set-option 'log-file "lilypond-multi-run"))
        (if (number? joblist)
            (begin (ly:set-option

-                   'log-file (format "~a-~a"
+                   'log-file (format #f "~a-~a"

                                      (ly:get-option 'log-file) joblist))
                   (set! files (vector-ref split-todo joblist)))
            (begin (ly:progress "\nForking into jobs:  ~a\n" joblist)
                                      (ly:get-option 'log-file) joblist))
                   (set! files (vector-ref split-todo joblist)))
            (begin (ly:progress "\nForking into jobs:  ~a\n" joblist)


@@ -627,7 +766,7 @@ PIDs or the number of the process."
                    (lambda (x)
                      (let* ((job (car x))
                             (state (cdr x))
                    (lambda (x)
                      (let* ((job (car x))
                             (state (cdr x))

-                            (logfile (format "~a-~a.log"
+                            (logfile (format #f "~a-~a.log"

                                              (ly:get-option 'log-file) job))
                             (log (ly:gulp-file logfile))
                             (len (string-length log))
                                              (ly:get-option 'log-file) job))
                             (log (ly:gulp-file logfile))
                             (len (string-length log))


@@ -635,7 +774,7 @@ PIDs or the number of the process."
                        (if (status:term-sig state)
                            (ly:message
                             "\n\n~a\n"
                        (if (status:term-sig state)
                            (ly:message
                             "\n\n~a\n"

-                            (format (_ "job ~a terminated with signal: ~a")
+                            (format #f (_ "job ~a terminated with signal: ~a")

                                     job (status:term-sig state)))
                            (ly:message
                             (_ "logfile ~a (exit ~a):\n~a")
                                     job (status:term-sig state)))
                            (ly:message
                             (_ "logfile ~a (exit ~a):\n~a")


@@ -648,11 +787,12 @@ PIDs or the number of the process."
                   (if (ly:get-option 'dump-profile)
                       (dump-profile "lily-run-total"
                                     '(0 0) (profile-measurements)))
                   (if (ly:get-option 'dump-profile)
                       (dump-profile "lily-run-total"
                                     '(0 0) (profile-measurements)))

-                  (exit (if (null? errors)
-                            0
-                            1))))))
+                  (if (null? errors)
+                      (ly:exit 0 #f)
+                      (ly:exit 1 #f))))))
+

   (if (string-or-symbol? (ly:get-option 'log-file))
   (if (string-or-symbol? (ly:get-option 'log-file))

-      (ly:stderr-redirect (format "~a.log" (ly:get-option 'log-file)) "w"))
+      (ly:stderr-redirect (format #f "~a.log" (ly:get-option 'log-file)) "w"))

   (let ((failed (lilypond-all files)))
     (if (ly:get-option 'trace-scheme-coverage)
        (begin
   (let ((failed (lilypond-all files)))
     (if (ly:get-option 'trace-scheme-coverage)
        (begin


@@ -660,11 +800,10 @@ PIDs or the number of the process."
                               (string-contains f "lilypond")))))
     (if (pair? failed)
        (begin (ly:error (_ "failed files: ~S") (string-join failed))
                               (string-contains f "lilypond")))))
     (if (pair? failed)
        (begin (ly:error (_ "failed files: ~S") (string-join failed))

-              (exit 1))
+              (ly:exit 1 #f))

        (begin
        (begin

-         ;; HACK: be sure to exit with single newline
-         (ly:message "")
-         (exit 0)))))
+         (ly:exit 0 #f)))))
+

 
 (define-public (lilypond-all files)
   (let* ((failed '())
 
 (define-public (lilypond-all files)
   (let* ((failed '())


@@ -672,8 +811,8 @@ PIDs or the number of the process."
         (ping-log
          (if separate-logs
              (open-file (if (string-or-symbol? (ly:get-option 'log-file))
         (ping-log
          (if separate-logs
              (open-file (if (string-or-symbol? (ly:get-option 'log-file))

-                            (format "~a.log" (ly:get-option 'log-file))
-                            "/dev/tty") "a") #f))
+                            (format #f "~a.log" (ly:get-option 'log-file))
+                            "/dev/stderr") "a") #f))

         (do-measurements (ly:get-option 'dump-profile))
         (handler (lambda (key failed-file)
                    (set! failed (append (list failed-file) failed)))))
         (do-measurements (ly:get-option 'dump-profile))
         (handler (lambda (key failed-file)
                    (set! failed (append (list failed-file) failed)))))


@@ -686,9 +825,9 @@ PIDs or the number of the process."
              (base (dir-basename x ".ly"))
              (all-settings (ly:all-options)))
         (if separate-logs
              (base (dir-basename x ".ly"))
              (all-settings (ly:all-options)))
         (if separate-logs

-            (ly:stderr-redirect (format "~a.log" base) "w"))
+            (ly:stderr-redirect (format #f "~a.log" base) "w"))

         (if ping-log
         (if ping-log

-            (format ping-log "Procesing ~a\n" base))
+            (format ping-log "Processing ~a\n" base))

         (if (ly:get-option 'trace-memory-frequency)
             (mtrace:start-trace  (ly:get-option 'trace-memory-frequency)))
         (lilypond-file handler x)
         (if (ly:get-option 'trace-memory-frequency)
             (mtrace:start-trace  (ly:get-option 'trace-memory-frequency)))
         (lilypond-file handler x)


@@ -700,17 +839,15 @@ PIDs or the number of the process."
         (for-each (lambda (s)
                     (ly:set-option (car s) (cdr s)))
                   all-settings)
         (for-each (lambda (s)
                     (ly:set-option (car s) (cdr s)))
                   all-settings)

-        (ly:clear-anonymous-modules)

         (ly:set-option 'debug-gc-assert-parsed-dead #t)
         (gc)
         (ly:set-option 'debug-gc-assert-parsed-dead #f)
         (if (ly:get-option 'debug-gc)
             (dump-gc-protects)
         (ly:set-option 'debug-gc-assert-parsed-dead #t)
         (gc)
         (ly:set-option 'debug-gc-assert-parsed-dead #f)
         (if (ly:get-option 'debug-gc)
             (dump-gc-protects)

-            (if (= (random 40) 1)
-                (ly:reset-all-fonts)))))
+             (ly:reset-all-fonts))))

      files)
 
      files)
 

-    ;; we want the failed-files notice in the aggregrate logfile.
+    ;; Ensure a notice re failed files is written to aggregate logfile.

     (if ping-log
        (format ping-log "Failed files: ~a\n" failed))
     (if (ly:get-option 'dump-profile)
     (if ping-log
        (format ping-log "Failed files: ~a\n" failed))
     (if (ly:get-option 'dump-profile)


@@ -743,7 +880,7 @@ PIDs or the number of the process."
              (ly:error (_ "failed files: ~S") (string-join failed))
              ;; not reached?
              (exit 1))
              (ly:error (_ "failed files: ~S") (string-join failed))
              ;; not reached?
              (exit 1))

-           (exit 0)))))
+           (ly:exit 0 #f)))))

 
 (define (gui-no-files-handler)
   (let* ((ly (string-append (ly:effective-prefix) "/ly/"))
 
 (define (gui-no-files-handler)
   (let* ((ly (string-append (ly:effective-prefix) "/ly/"))


@@ -752,4 +889,4 @@ PIDs or the number of the process."
         (cmd (get-editor-command welcome-ly 0 0 0)))
     (ly:message (_ "Invoking `~a'...\n") cmd)
     (system cmd)
         (cmd (get-editor-command welcome-ly 0 0 0)))
     (ly:message (_ "Invoking `~a'...\n") cmd)
     (system cmd)

-    (exit 1)))
+    (ly:exit 1 #f)))