Permits all positive and zero-length buildings in skylines (issue 3161)

[lilypond.git] / scm / lily.scm

diff --git a/scm/lily.scm b/scm/lily.scm
index 9a152ed0aa66f3384f32644b3c16fc080f9eccc3..c1f8f1fe3453362e9af71b0f6f47c83788a5dfa2 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;

-;;;; Copyright (C) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>

 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify


@@ -27,14 +27,99 @@
 
 (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-set! show-file-name #t)))

 
 (define-public PLATFORM
   (string->symbol
    (string-downcase
     (car (string-tokenize (utsname:sysname (uname)))))))
 
 
 (define-public PLATFORM
   (string->symbol
    (string-downcase
     (car (string-tokenize (utsname:sysname (uname)))))))
 

+(define lilypond-declarations '())
+
+(defmacro-public define-session (name value)
+  "This defines a variable @var{name} with the starting value
+@var{value} that is reinitialized at the start of each session.
+A@tie{}session basically corresponds to one LilyPond file on the
+command line.  The value is recorded at the start of the first session
+after loading all initialization files and before loading the user
+file and is reinstated for all of the following sessions.  This
+happens just by replacing the value, not by copying structures, so you
+should not destructively modify them.  For example, lists defined in
+this manner should be changed within a session only be adding material
+to their front or replacing them altogether, not by modifying parts of
+them.  It is an error to call @code{define-session} after the first
+session has started."
+  (define (add-session-variable name value)
+    (if (ly:undead? lilypond-declarations)
+        (ly:error (_ "define-session used after session start")))
+    (let ((var (make-variable value)))
+      (module-add! (current-module) name var)
+      (set! lilypond-declarations (cons var lilypond-declarations))))
+  `(,add-session-variable ',name ,value))
+
+(defmacro-public define-session-public (name value)
+  "Like @code{define-session}, but also exports @var{name}."
+  `(begin
+     (define-session ,name ,value)
+     (export ,name)))
+
+(define (session-terminate)
+  (if (ly:undead? lilypond-declarations)
+      (for-each
+       (lambda (p) (variable-set! (cadr p) (cddr p)))
+       (ly:get-undead lilypond-declarations))))
+
+(define-public (session-initialize thunk)
+  "Initialize this session.  The first session in a LilyPond run is
+initialized by calling @var{thunk}, then recording the values of all
+variables in the current module as well as those defined with
+@code{define-session}.  Subsequent calls of @code{session-initialize}
+ignore @var{thunk} and instead just reinitialize all recorded
+variables to their value after the initial call of @var{thunk}."
+
+;; We need to save the variables of the current module along with
+;; their values: functions defined in the module might refer to the
+;; variables.
+
+;; The entries in lilypond-declarations consist of a cons* consisting
+;; of symbol, variable, and value.  Variables defined with
+;; define-session have the symbol set to #f.
+
+  (if (ly:undead? lilypond-declarations)
+      (begin
+        (for-each
+         (lambda (p)
+           (let ((var (cadr p))
+                 (val (cddr p)))
+             (variable-set! var val)
+             (if (car p)
+                 (module-add! (current-module) (car p) var))))
+         (ly:get-undead lilypond-declarations)))
+      (begin
+        (thunk)
+        (let ((decl (map! (lambda (v)
+                            (cons* #f v (variable-ref v)))
+                          lilypond-declarations)))
+          (module-for-each
+           (lambda (s v)
+             (let ((val (variable-ref v)))
+               (if (not (ly:lily-parser? val))
+                   (set! decl
+                         (cons
+                          (cons* s v val)
+                          decl)))))
+           (current-module))
+          (set! lilypond-declarations (ly:make-undead decl))))))
+

 (define scheme-options-definitions
   `(
     ;; NAMING: either
 (define scheme-options-definitions
   `(
     ;; NAMING: either


@@ -49,8 +134,8 @@
 "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 
+    (aux-files #t
+"Create .tex, .texi, .count files in the

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


@@ -104,20 +189,26 @@ 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.")
     (log-file #f
 "If string FOO is given as argument, redirect
 output to log file `FOO.log'.")
     (job-count #f
 "Process in parallel, using the given number of
 jobs.")
     (log-file #f
 "If string FOO is given as argument, redirect
 output to log file `FOO.log'.")

+    (max-markup-depth 1024
+"Maximum depth for the markup tree. If a markup has more levels,
+assume it will not terminate on its own, print a warning and return a
+null markup instead.")

     (midi-extension ,(if (eq? PLATFORM 'windows)
     (midi-extension ,(if (eq? PLATFORM 'windows)

-                        "mid"
-                        "midi")
+                         "mid"
+                         "midi")

 "Set the default file extension for MIDI output
 file to given string.")
 "Set the default file extension for MIDI output
 file to given string.")

-    (old-relative #f
-"Make \\relative mode for simultaneous music work
-similar to chord syntax.")
+    (music-strings-to-paths #f
+"Convert text strings to paths when glyphs belong
+to a music font.")

     (point-and-click #t
 "Add point & click links to PDF output.")
     (paper-size "a4"
     (point-and-click #t
 "Add point & click links to PDF output.")
     (paper-size "a4"


@@ -125,7 +216,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


@@ -146,26 +237,28 @@ 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:verbose-output?)
+"Verbose output, i.e. loglevel at least DEBUG (read-only).")

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


@@ -175,38 +268,57 @@ messages into errors.")
 ;; initialization depend on these options.
 
 (for-each (lambda (x)
 ;; initialization depend on these options.
 
 (for-each (lambda (x)

-           (ly:add-option (car x) (cadr x) (caddr x)))
-         scheme-options-definitions)
+            (ly:add-option (car x) (cadr x) (caddr x)))
+          scheme-options-definitions)

 
 (for-each (lambda (x)
 
 (for-each (lambda (x)

-           (ly:set-option (car x) (cdr x)))
-         (eval-string (ly:command-line-options)))
+            (ly:set-option (car x) (cdr x)))
+          (eval-string (ly:command-line-options)))

 
 (debug-set! stack 0)
 
 (if (defined? 'set-debug-cell-accesses!)
     (set-debug-cell-accesses! #f))
 
 
 (debug-set! stack 0)
 
 (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)
 
 (use-modules (ice-9 regex)

-              (ice-9 safe)
-              (ice-9 format)
-              (ice-9 rdelim)
-              (ice-9 optargs)
-              (oop goops)
-              (srfi srfi-1)
-              (srfi srfi-13)
-              (srfi srfi-14)
-              (scm clip-region)
-              (scm memory-trace)
-              (scm coverage))
+             (ice-9 safe)
+             (ice-9 format)
+             (ice-9 rdelim)
+             (ice-9 optargs)
+             (oop goops)
+             (srfi srfi-1)
+             (srfi srfi-13)
+             (srfi srfi-14)
+             (scm clip-region)
+             (scm memory-trace)
+             (scm coverage)
+            (scm safe-utility-defs))
+
+(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)
+   (ly:debug (_ "Using (ice-9 curried-definitions) module\n"))
+   (use-modules (ice-9 curried-definitions)))
+  (else
+    (ly:debug (_ "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))))


@@ -231,12 +343,12 @@ messages into errors.")
 ;;; Debugging evaluator is slower.  This should have a more sensible
 ;;; default.
 
 ;;; Debugging evaluator is slower.  This should have a more sensible
 ;;; default.
 

+

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

-       (ly:get-option 'trace-memory-frequency)
-       (ly:get-option 'trace-scheme-coverage))
+        (ly:get-option 'trace-memory-frequency)
+        (ly:get-option 'trace-scheme-coverage))

     (begin
       (ly:set-option 'protected-scheme-parsing #f)
     (begin
       (ly:set-option 'protected-scheme-parsing #f)

-      (debug-enable 'debug)

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


@@ -245,110 +357,74 @@ messages into errors.")
 
 (define-public parser #f)
 
 
 (define-public parser #f)
 

+(define music-string-to-path-backends
+  '(svg))

 
 

-;; gettext wrapper for guile < 1.7.2
-(if (defined? 'gettext)
-    (define-public _ gettext)
-    (define-public _ ly:gettext))
+(if (memq (ly:get-option 'backend) music-string-to-path-backends)
+    (ly:set-option 'music-strings-to-paths #t))

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

-    (if (ly:get-option 'verbose)
-       (ly:progress "[~A" file-name))
+    (ly:debug "[~A" file-name)

     (if (not file-name)
     (if (not file-name)

-       (ly:error (_ "cannot find: ~A") x))
-    (primitive-load file-name)
+        (ly:error (_ "cannot find: ~A") x))
+    (primitive-load-path file-name)  ;; to support Guile V2 autocompile
+    ;; TODO: Any chance to use ly:debug here? Need to extend it to prevent
+    ;;       a newline in this case

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

-       (ly:progress "]\n"))))
+        (ly:progress "]\n"))))

 
 (define-public DOS
   (let ((platform (string-tokenize
 
 (define-public DOS
   (let ((platform (string-tokenize

-                  (vector-ref (uname) 0) char-set:letter+digit)))
+                   (vector-ref (uname) 0) char-set:letter+digit)))

     (if (null? (cdr platform)) #f
     (if (null? (cdr platform)) #f

-       (member (string-downcase (cadr platform)) '("95" "98" "me")))))
-
-(case PLATFORM
-  ((windows)
-   (define native-getcwd
-     getcwd)
+        (member (string-downcase (cadr platform)) '("95" "98" "me")))))

 
 

-   (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)))
     (if (= file-name-length 0)
 
 (define-public (is-absolute? file-name)
   (let ((file-name-length (string-length file-name)))
     (if (= file-name-length 0)

-       #f
-       (or (eq? (string-ref file-name 0) #\/)
-           (and (eq? PLATFORM 'windows)
-                (> file-name-length 2)
-                (eq? (string-ref file-name 1) #\:)
-                (eq? (string-ref file-name 2) #\/))))))
+        #f
+        (or (eq? (string-ref file-name 0) #\/)
+            (and (eq? PLATFORM 'windows)
+                 (> file-name-length 2)
+                 (eq? (string-ref file-name 1) #\:)
+                 (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 (recursion-helper signature arguments count)
-    (define (helper pred? arg count)
-      (if (not (pred? arg))
-         (begin
-           (ly:input-message
-            location
-            (format
-             #f (_ "wrong type for argument ~a.  Expecting ~a, found ~s")
-             count (type-name pred?) arg))
-           #f)
-         #t))
-
-    (if (null? signature)
-       #t
-       (and (helper (car signature) (car arguments) count)
-            (recursion-helper (cdr signature) (cdr arguments) (1+ count)))))
-  (recursion-helper signature arguments 1))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Safe definitions utility
-
-(define safe-objects
-  (list))
-
-(define-macro (define-safe-public arglist . body)
-  "Define a variable, export it, and mark it as safe, i.e. usable in
-LilyPond safe mode.  The syntax is the same as `define*-public'."
-  (define (get-symbol arg)
-    (if (pair? arg)
-        (get-symbol (car arg))
-        arg))
-
-  (let ((safe-symbol (get-symbol arglist)))
-    `(begin
-       (define*-public ,arglist
-         ,@body)
-       (set! safe-objects (cons (cons ',safe-symbol ,safe-symbol)
-                                safe-objects))
-       ,safe-symbol)))

 
 (define-safe-public (lilypond-version)
   (string-join
    (map (lambda (x) (if (symbol? x)
 
 (define-safe-public (lilypond-version)
   (string-join
    (map (lambda (x) (if (symbol? x)

-                       (symbol->string x)
-                       (number->string x)))
-       (ly:version))
+                        (symbol->string x)
+                        (number->string x)))
+        (ly:version))

    "."))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    "."))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


@@ -359,27 +435,41 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; other files.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; other files.
 

-(define init-scheme-files
+;;
+;;  List of Scheme files to be loaded into the (lily) module.
+;;
+;;  - Library definitions, need to be at the head of the list
+(define init-scheme-files-lib

   '("lily-library.scm"
   '("lily-library.scm"

-    "file-cache.scm"
+    "output-lib.scm"))
+;;  - Files containing definitions used later by other files later in load
+(define init-scheme-files-used
+  '("markup-macros.scm"
+    "parser-ly-from-scheme.scm"))
+;;  - Main body of files to be loaded
+(define init-scheme-files-body
+  '("file-cache.scm"

     "define-event-classes.scm"
     "define-event-classes.scm"

+    "define-music-callbacks.scm"

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

-    "output-lib.scm"
+    "define-note-names.scm"

     "c++.scm"
     "c++.scm"

-    "chord-ignatzek-names.scm"

     "chord-entry.scm"
     "chord-entry.scm"

-    "chord-generic-names.scm"
+    "skyline.scm"

     "stencil.scm"
     "stencil.scm"

+    "define-markup-commands.scm"

     "markup.scm"
     "markup.scm"

+    "modal-transforms.scm"
+    "chord-generic-names.scm"
+    "chord-ignatzek-names.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"

-    "beam-settings.scm"
+    "time-signature-settings.scm"

     "auto-beam.scm"
     "chord-name.scm"
     "auto-beam.scm"
     "chord-name.scm"

-
-    "parser-ly-from-scheme.scm"
+    "bezier-tools.scm"

     "ly-syntax-constructors.scm"
 
     "define-context-properties.scm"
     "ly-syntax-constructors.scm"
 
     "define-context-properties.scm"


@@ -392,90 +482,189 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
     "font.scm"
     "encoding.scm"
 
     "font.scm"
     "encoding.scm"
 

+    "bar-line.scm"

     "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-stencil-commands.scm"
     "define-grob-properties.scm"
     "define-grobs.scm"
     "define-grob-interfaces.scm"
     "define-stencil-commands.scm"

+    "scheme-engravers.scm"

     "titling.scm"
     "titling.scm"

+    "text.scm"

 
     "paper.scm"
     "backend-library.scm"
 
     "paper.scm"
     "backend-library.scm"

-    "x11-color.scm"
-    "tablature.scm"
-
-    ;; must be after everything has been defined
-    "safe-lily.scm"))
+    "x11-color.scm"))
+;;  - Files to be loaded last
+(define init-scheme-files-tail
+;;  - must be after everything has been defined
+  '("safe-lily.scm"))
+;;
+;; Now construct the load list
+;;
+(define init-scheme-files
+  (append init-scheme-files-lib
+          init-scheme-files-used
+          init-scheme-files-body
+          init-scheme-files-tail))

 
 (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")
+    (,fraction? . "fraction, as pair")
+    (,grob-list? . "list of grobs")
+    (,index? . "non-negative integer")
+    (,markup? . "markup")
+    (,markup-command-list? . "markup command list")
+    (,markup-list? . "markup list")
+    (,moment-pair? . "pair of moment objects")
+    (,number-list? . "number list")
+    (,number-or-grob? . "number or grob")
+    (,number-or-markup? . "number or markup")
+    (,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-music? . "string or music")
+    (,string-or-symbol? . "string or symbol")
+    (,symbol-list? . "symbol list")
+    (,symbol-list-or-music? . "symbol list or music")
+    (,symbol-list-or-symbol? . "symbol list or symbol")
+    (,void? . "void")
+    ))
+
+(define-public lilypond-exported-predicates
+  `((,ly:book? . "book")
+    (,ly:box? . "box")
+    (,ly:context? . "context")
+    (,ly:context-def? . "context definition")
+    (,ly:context-mod? . "context modification")
+    (,ly:dimension? . "dimension, in staff space")
+    (,ly:dir? . "direction")
+    (,ly:dispatcher? . "dispatcher")
+    (,ly:duration? . "duration")
+    (,ly:event? . "post event")
+    (,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:spring? . "spring")
+    (,ly:stencil? . "stencil")
+    (,ly:stream-event? . "stream event")
+    (,ly:translator? . "translator")
+    (,ly:translator-group? . "translator group")
+    (,ly:unpure-pure-container? . "unpure/pure container")
+    ))
+
+

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

-      `((,boolean? . "boolean")
-       (,boolean-or-symbol? . "boolean or symbol")
-       (,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:font-metric? . "font metric")
-       (,ly:grob? . "layout object")
-       (,ly:grob-array? . "array of grobs")
-       (,ly:input-location? . "input location")
-       (,ly:moment? . "moment")
-       (,ly:music? . "music")
-       (,ly:music-list? . "list of music objects")
-       (,ly:music-output? . "music output")
-       (,ly:pitch? . "pitch")
-       (,ly:translator? . "translator")
-        (,ly:score? . "score")
-       (,ly:simple-closure? . "simple closure")
-       (,ly:skyline-pair? . "pair of skylines")
-       (,ly:stencil? . "stencil")
-       (,markup-list? . "list of markups")
-       (,markup? . "markup")
-       (,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
 
 (define (profile-measurements)
   (let* ((t (times))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; timing
 
 (define (profile-measurements)
   (let* ((t (times))

-        (stats (gc-stats)))
+         (stats (gc-stats)))

     (list (- (+ (tms:cutime t)
     (list (- (+ (tms:cutime t)

-               (tms:utime t))
-            (assoc-get 'gc-time-taken stats))
-         (assoc-get 'total-cells-allocated  stats 0))))
+                (tms:utime t))
+             (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")))
-        (diff (map (lambda (y) (apply - y)) (zip this last))))
+  (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")
     (ly:progress "\nWriting timing to ~a..." outname)
     (format (open-file outname "w")

-           "time: ~a\ncells: ~a\n"
-           (if (ly:get-option 'dump-cpu-profile)
-               (car diff)
-               0)
-           (cadr diff))))
+            "time: ~a\ncells: ~a\n"
+            (if (ly:get-option 'dump-cpu-profile)
+                (car diff)
+                0)
+            (cadr diff))))

 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; debug memory leaks
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; debug memory leaks


@@ -486,69 +675,74 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
 (define gc-protect-stat-count
   0)
 
 (define gc-protect-stat-count
   0)
 

+;; Undead objects that should be ignored after the first time round
+(define gc-zombies
+  (make-weak-key-hash-table 0))
+

 (define-public (dump-live-object-stats outfile)
   (for-each (lambda (x)
 (define-public (dump-live-object-stats outfile)
   (for-each (lambda (x)

-             (format outfile "~a: ~a\n" (car x) (cdr x)))
-           (sort (gc-live-object-stats)
-                 (lambda (x y)
-                   (string<? (car x) (car y))))))
+              (format outfile "~a: ~a\n" (car x) (cdr x)))
+            (sort (gc-live-object-stats)
+                  (lambda (x y)
+                    (string<? (car x) (car y))))))

 
 (define-public (dump-gc-protects)
   (set! gc-protect-stat-count (1+ gc-protect-stat-count))
   (let* ((protects (sort (hash-table->alist (ly:protects))
 
 (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))))))
-        (out-file-name (string-append
-                        "gcstat-" (number->string gc-protect-stat-count)
-                        ".scm"))
-        (outfile (open-file out-file-name "w")))
+                         (lambda (a b)
+                           (< (object-address (car a))
+                              (object-address (car b))))))
+        (out-file-name (string-append
+                       "gcstat-" (number->string gc-protect-stat-count)
+                       ".scm"))
+        (outfile (open-file out-file-name "w")))

     (set! gc-dumping #t)
     (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)
+    (ly:progress "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"
     (format outfile "\nprotected symbols: ~a\n"

-           (apply + (map (lambda (obj-count)
-                           (if (symbol? (car obj-count))
-                               (cdr obj-count)
-                               0))
-                         protects)))
+            (apply + (map (lambda (obj-count)
+                            (if (symbol? (car obj-count))
+                                (cdr obj-count)
+                                0))
+                          protects)))

 
     ;; (display (ly:smob-protects))
     (newline outfile)
     (if (defined? 'gc-live-object-stats)
 
     ;; (display (ly:smob-protects))
     (newline outfile)
     (if (defined? 'gc-live-object-stats)

-       (let* ((stats #f))
-         (display "Live object statistics: GC'ing\n")
-         (ly:reset-all-fonts)
-         (gc)
-         (gc)
-         (display "Asserting dead objects\n")
-         (ly:set-option 'debug-gc-assert-parsed-dead #t)
-         (gc)
-         (ly:set-option 'debug-gc-assert-parsed-dead #f)
-         (set! stats (gc-live-object-stats))
-         (display "Dumping live object statistics.\n")
-         (dump-live-object-stats outfile)))
+        (let* ((stats #f))
+          (ly:progress "Live object statistics: GC'ing\n")
+          (ly:reset-all-fonts)
+          (gc)
+          (gc)
+          (ly:progress "Asserting dead objects\n")
+          (ly:set-option 'debug-gc-assert-parsed-dead #t)
+          (gc)
+          (ly:set-option 'debug-gc-assert-parsed-dead #f)
+         (for-each
+          (lambda (x)
+            (if (not (hashq-ref gc-zombies x))
+                (begin
+                  (ly:programming-error "Parsed object should be dead: ~a" x)
+                  (hashq-set! gc-zombies x #t))))
+          (ly:parsed-undead-list!))
+          (set! stats (gc-live-object-stats))
+          (ly:progress "Dumping live object statistics.\n")
+          (dump-live-object-stats outfile)))

     (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
-                          (assoc-get sym stats "?"))
-
-                  outfile))
-               '(protected-objects bytes-malloced cell-heap-size)))
+                  (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)))
 
     (set! gc-dumping #f)
     (close-port outfile)))
 


@@ -556,23 +750,24 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
   "Read `/proc/self' to check up on memory use."
   (define (gulp-file name)
     (let* ((file (open-input-file name))
   "Read `/proc/self' to check up on memory use."
   (define (gulp-file name)
     (let* ((file (open-input-file name))

-          (text (read-delimited "" file)))
+           (text (read-delimited "" file)))

       (close file)
       text))
 
   (let* ((stat (gulp-file "/proc/self/status"))
       (close file)
       text))
 
   (let* ((stat (gulp-file "/proc/self/status"))

-        (lines (string-split stat #\newline))
-        (interesting (filter identity
-                             (map
-                              (lambda (l)
-                                (string-match "^VmData:[ \t]*([0-9]*) kB" l))
-                              lines)))
-        (mem (string->number (match:substring (car interesting) 1))))
-    (display (format  "VMDATA: ~a\n" mem))
+         (lines (string-split stat #\newline))
+         (interesting (filter identity
+                              (map
+                               (lambda (l)
+                                 (string-match "^VmData:[ \t]*([0-9]*) kB" l))
+                               lines)))
+         (mem (string->number (match:substring (car interesting) 1))))
+    (format #t "VMDATA: ~a\n" mem)

     (display (gc-stats))
     (display (gc-stats))

-    (if (> mem 100000)
-       (begin (dump-gc-protects)
-              (raise 1)))))
+    (newline)
+    (if (> mem 500000)
+        (begin (dump-gc-protects)
+               (raise 1)))))

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


@@ -581,158 +776,178 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
 PIDs or the number of the process."
   (define (helper count acc)
     (if (> count 0)
 PIDs or the number of the process."
   (define (helper count acc)
     (if (> count 0)

-       (let* ((pid (primitive-fork)))
-         (if (= pid 0)
-             (1- count)
-             (helper (1- count) (cons pid acc))))
-       acc))
+        (let* ((pid (primitive-fork)))
+              (if (= pid 0)
+                  (1- count)
+                  (helper (1- count) (cons pid acc))))
+        acc))

 
   (helper count '()))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
   (helper count '()))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

+(define* (ly:exit status #:optional (silently #f))
+  "Exit function for lilypond"
+  (if (not silently)
+      (case status
+        ((0) (ly:basic-progress (_ "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
   (if (ly:get-option 'read-file-list)
       (set! files

-           (filter (lambda (s)
-                     (> (string-length s) 0))
-                   (apply append
-                          (map (lambda (f)
-                                 (string-split (ly:gulp-file f) #\nl))
-                               files)))))
+            (filter (lambda (s)
+                      (> (string-length s) 0))
+                    (apply append
+                           (map (lambda (f)
+                                  (string-split (string-delete (ly:gulp-file f) #\cr) #\nl))
+                                files)))))

   (if (and (number? (ly:get-option 'job-count))
   (if (and (number? (ly:get-option 'job-count))

-          (>= (length files) (ly:get-option 'job-count)))
+           (>= (length files) (ly:get-option 'job-count)))

       (let* ((count (ly:get-option 'job-count))
       (let* ((count (ly:get-option 'job-count))

-            (split-todo (split-list files count))
-            (joblist (multi-fork count))
-            (errors '()))
-       (if (not (string-or-symbol? (ly:get-option 'log-file)))
-           (ly:set-option 'log-file "lilypond-multi-run"))
-       (if (number? joblist)
-           (begin (ly:set-option
-                   'log-file (format "~a-~a"
-                                     (ly:get-option 'log-file) joblist))
-                  (set! files (vector-ref split-todo joblist)))
-           (begin (ly:progress "\nForking into jobs:  ~a\n" joblist)
-                  (for-each
-                   (lambda (pid)
-                     (let* ((stat (cdr (waitpid pid))))
-                       (if (not (= stat 0))
-                           (set! errors
-                                 (acons (list-element-index joblist pid)
-                                        stat errors)))))
-                   joblist)
-                  (for-each
-                   (lambda (x)
-                     (let* ((job (car x))
-                            (state (cdr x))
-                            (logfile (format "~a-~a.log"
-                                             (ly:get-option 'log-file) job))
-                            (log (ly:gulp-file logfile))
-                            (len (string-length log))
-                            (tail (substring  log (max 0 (- len 1024)))))
-                       (if (status:term-sig state)
-                           (ly:message
-                            "\n\n~a\n"
-                            (format (_ "job ~a terminated with signal: ~a")
-                                    job (status:term-sig state)))
-                           (ly:message
-                            (_ "logfile ~a (exit ~a):\n~a")
-                            logfile (status:exit-val state) tail))))
-                   errors)
-                  (if (pair? errors)
-                      (ly:error "Children ~a exited with errors."
-                                (map car errors)))
-                  ;; must overwrite individual entries
-                  (if (ly:get-option 'dump-profile)
-                      (dump-profile "lily-run-total"
-                                    '(0 0) (profile-measurements)))
-                  (exit (if (null? errors)
-                            0
-                            1))))))
+             (split-todo (split-list files count))
+             (joblist (multi-fork count))
+             (errors '()))
+        (if (not (string-or-symbol? (ly:get-option 'log-file)))
+            (ly:set-option 'log-file "lilypond-multi-run"))
+        (if (number? joblist)
+            (begin (ly:set-option
+                    '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)
+                   (for-each
+                    (lambda (pid)
+                      (let* ((stat (cdr (waitpid pid))))
+                        (if (not (= stat 0))
+                            (set! errors
+                                  (acons (list-element-index joblist pid)
+                                 stat errors)))))
+                    joblist)
+                   (for-each
+                    (lambda (x)
+                      (let* ((job (car x))
+                             (state (cdr x))
+                             (logfile (format #f "~a-~a.log"
+                                              (ly:get-option 'log-file) job))
+                             (log (ly:gulp-file logfile))
+                             (len (string-length log))
+                             (tail (substring  log (max 0 (- len 1024)))))
+                        (if (status:term-sig state)
+                            (ly:message
+                             "\n\n~a\n"
+                             (format #f (_ "job ~a terminated with signal: ~a")
+                                     job (status:term-sig state)))
+                            (ly:message
+                             (_ "logfile ~a (exit ~a):\n~a")
+                             logfile (status:exit-val state) tail))))
+                      errors)
+                     (if (pair? errors)
+                         (ly:error "Children ~a exited with errors."
+                                   (map car errors)))
+                     ;; must overwrite individual entries
+                     (if (ly:get-option 'dump-profile)
+                         (dump-profile "lily-run-total"
+                                       '(0 0) (profile-measurements)))
+                     (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)
   (let ((failed (lilypond-all files)))
     (if (ly:get-option 'trace-scheme-coverage)

-       (begin
-         (coverage:show-all (lambda (f)
-                              (string-contains f "lilypond")))))
+        (begin
+          (coverage:show-all (lambda (f)
+                               (string-contains f "lilypond")))))

     (if (pair? failed)
     (if (pair? failed)

-       (begin (ly:error (_ "failed files: ~S") (string-join failed))
-              (exit 1))
-       (begin
-         ;; HACK: be sure to exit with single newline
-         (ly:message "")
-         (exit 0)))))
+        (begin (ly:error (_ "failed files: ~S") (string-join failed))
+               (ly:exit 1 #f))
+        (begin
+          (ly:exit 0 #f)))))
+

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

-        (separate-logs (ly:get-option 'separate-log-files))
-        (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))
-        (do-measurements (ly:get-option 'dump-profile))
-        (handler (lambda (key failed-file)
-                   (set! failed (append (list failed-file) failed)))))
+         (separate-logs (ly:get-option 'separate-log-files))
+         (ping-log
+          (and separate-logs
+               (if (string-or-symbol? (ly:get-option 'log-file))
+                   (open-file (format #f "~a.log" (ly:get-option 'log-file))
+                              "a")
+                   (fdes->outport 2))))
+         (do-measurements (ly:get-option 'dump-profile))
+         (handler (lambda (key failed-file)
+                    (set! failed (append (list failed-file) failed)))))

     (gc)
     (for-each
      (lambda (x)
        (let* ((start-measurements (if do-measurements
     (gc)
     (for-each
      (lambda (x)
        (let* ((start-measurements (if do-measurements

-                                     (profile-measurements)
-                                     #f))
-             (base (dir-basename x ".ly"))
-             (all-settings (ly:all-options)))
-        (if separate-logs
-            (ly:stderr-redirect (format "~a.log" base) "w"))
-        (if ping-log
-            (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 start-measurements
-            (dump-profile x start-measurements (profile-measurements)))
-        (if (ly:get-option 'trace-memory-frequency)
-            (begin (mtrace:stop-trace)
-                   (mtrace:dump-results base)))
-        (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)
-            (if (= (random 40) 1)
-                (ly:reset-all-fonts)))))
+                                      (profile-measurements)
+                                      #f))
+              (base (dir-basename x ".ly"))
+              (all-settings (ly:all-options)))
+         (if separate-logs
+             (ly:stderr-redirect (format #f "~a.log" base) "w"))
+         (if ping-log
+             (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)
+         (ly:check-expected-warnings)
+         (session-terminate)
+         (if start-measurements
+             (dump-profile x start-measurements (profile-measurements)))
+         (if (ly:get-option 'trace-memory-frequency)
+             (begin (mtrace:stop-trace)
+                    (mtrace:dump-results base)))
+         (for-each (lambda (s)
+                     (ly:set-option (car s) (cdr s)))
+                   all-settings)
+         (ly:set-option 'debug-gc-assert-parsed-dead #t)
+         (gc)
+         (ly:set-option 'debug-gc-assert-parsed-dead #f)
+         (for-each
+          (lambda (x)
+            (if (not (hashq-ref gc-zombies x))
+                (begin
+                  (ly:programming-error "Parsed object should be dead: ~a" x)
+                  (hashq-set! gc-zombies x #t))))
+          (ly:parsed-undead-list!))
+         (if (ly:get-option 'debug-gc)
+             (dump-gc-protects)
+             (ly:reset-all-fonts))
+         (flush-all-ports)))

      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
     (if ping-log

-       (format ping-log "Failed files: ~a\n" failed))
+        (format ping-log "Failed files: ~a\n" failed))

     (if (ly:get-option 'dump-profile)
     (if (ly:get-option 'dump-profile)

-       (dump-profile "lily-run-total" '(0 0) (profile-measurements)))
+        (dump-profile "lily-run-total" '(0 0) (profile-measurements)))

     failed))
 
 (define (lilypond-file handler file-name)
   (catch 'ly-file-failed
     failed))
 
 (define (lilypond-file handler file-name)
   (catch 'ly-file-failed

-        (lambda () (ly:parse-file file-name))
-        (lambda (x . args) (handler x file-name))))
+         (lambda () (ly:parse-file file-name))
+         (lambda (x . args) (handler x file-name))))

 
 (use-modules (scm editor))
 
 
 (use-modules (scm editor))
 


@@ -741,27 +956,27 @@ PIDs or the number of the process."
       (gui-no-files-handler))
   (if (not (string? (ly:get-option 'log-file)))
       (let* ((base (dir-basename (car files) ".ly"))
       (gui-no-files-handler))
   (if (not (string? (ly:get-option 'log-file)))
       (let* ((base (dir-basename (car files) ".ly"))

-            (log-name (string-append base ".log")))
-       (if (not (ly:get-option 'gui))
-           (ly:message (_ "Redirecting output to ~a...") log-name))
-       (ly:stderr-redirect log-name "w")
-       (ly:message "# -*-compilation-*-"))
+             (log-name (string-append base ".log")))
+        (if (not (ly:get-option 'gui))
+            (ly:message (_ "Redirecting output to ~a...") log-name))
+        (ly:stderr-redirect log-name "w")
+        (ly:message "# -*-compilation-*-"))

       (let ((failed (lilypond-all files)))
       (let ((failed (lilypond-all files)))

-       (if (pair? failed)
-           (begin
-             ;; ugh
-             (ly:stderr-redirect "foo" "r")
-             (system (get-editor-command log-name 0 0 0))
-             (ly:error (_ "failed files: ~S") (string-join failed))
-             ;; not reached?
-             (exit 1))
-           (exit 0)))))
+        (if (pair? failed)
+            (begin
+              ;; ugh
+              (ly:stderr-redirect "foo" "r")
+              (system (get-editor-command log-name 0 0 0))
+              (ly:error (_ "failed files: ~S") (string-join failed))
+              ;; not reached?
+              (exit 1))
+            (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/"))

-        ;; FIXME: soft-code, localize
-        (welcome-ly (string-append ly "Welcome_to_LilyPond.ly"))
-        (cmd (get-editor-command welcome-ly 0 0 0)))
+         ;; FIXME: soft-code, localize
+         (welcome-ly (string-append ly "Welcome_to_LilyPond.ly"))
+         (cmd (get-editor-command welcome-ly 0 0 0)))

     (ly:message (_ "Invoking `~a'...\n") cmd)
     (system cmd)
     (ly:message (_ "Invoking `~a'...\n") cmd)
     (system cmd)

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