X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily.scm;h=f6784594269a6c8aa9124a6521a0ade8f353fe32;hb=f23a0d9dcda87d3f6f072fba3addeae941cce4aa;hp=9ceb5333ed322b51231d33c066404b21a5db8127;hpb=fd58a98a46a3def26b80a895f1f7b81c92590fc3;p=lilypond.git

diff --git a/scm/lily.scm b/scm/lily.scm
index 9ceb5333ed..f678459426 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -1,17 +1,22 @@
-;;; 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
 ;;;; 
-;;;; (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
 
 
 (use-modules (ice-9 regex)
-	     (srfi srfi-1)		;lists
-	     (srfi srfi-13)		;strings
-	     )
+	     (ice-9 safe)
+	     (oop goops)
+	     (srfi srfi-1)  ; lists
+	     (srfi srfi-13)) ; strings
+
+(define-public safe-module (make-safe-module))
+
+(define-public (myd k v) (display k) (display ": ") (display v) (display ", "))
 
 ;;; General settings
 ;;; debugging evaluator is slower.  This should
@@ -22,7 +27,7 @@
     (begin
       (debug-enable 'debug)
       (debug-enable 'backtrace)
-      (read-enable 'positions)))
+      (read-enable 'positions) ))
 
 
 (define-public (line-column-location line col file)
@@ -79,6 +84,9 @@
 
 (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.
 (define-public default-script-alist '())
@@ -154,6 +162,42 @@
 	    (map-alist-keys func (cdr list)))
       ))
  
+;;;;;;;;;;;;;;;;
+;; 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))
+       
 
 
 ;;;;;;;;;;;;;;;;
@@ -174,14 +218,20 @@
 
 
 ;; TODO: use the srfi-1 partition function.
-(define-public (uniq-list list)
+(define-public (uniq-list l)
+  
   "Uniq LIST, assuming that it is sorted"
-  (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 (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)
@@ -258,7 +308,6 @@ L1 is copied, L2 not.
    (cons (- (car iv) amount)
          (+ (cdr iv) amount)))
 
-
 (define-public (interval-union i1 i2)
    (cons (min (car i1) (car i2))
 	 (max (cdr i1) (cdr i2))))
@@ -295,6 +344,9 @@ L1 is copied, L2 not.
       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)))
 
@@ -312,7 +364,6 @@ L1 is copied, L2 not.
 ;;  output
 (use-modules (scm output-tex)
 	     (scm output-ps)
-	     (scm output-ascii-script)
 	     (scm output-sketch)
 	     (scm output-sodipodi)
 	     (scm output-pdftex)
@@ -323,7 +374,6 @@ L1 is copied, L2 not.
     ("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))
@@ -361,6 +411,7 @@ L1 is copied, L2 not.
        "new-markup.scm"
        "bass-figure.scm"
        "music-functions.scm"
+       "part-combiner.scm"
        "define-music-properties.scm"
        "auto-beam.scm"
        "chord-name.scm"
@@ -368,7 +419,6 @@ L1 is copied, L2 not.
        "define-translator-properties.scm"
        "translation-functions.scm"
        "script.scm"
-       "drums.scm"
        "midi.scm"
 
        "beam.scm"
@@ -379,6 +429,8 @@ L1 is copied, L2 not.
        "define-grob-properties.scm"
        "define-grobs.scm"
        "define-grob-interfaces.scm"
+
+       "paper.scm"
        ))
 
 
@@ -420,3 +472,35 @@ L1 is copied, L2 not.
    (,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) )
+  
+  (display 
+   (map (lambda (y)
+	  (let
+	      ((x (car y))
+	       (c (cdr y)))
+
+	    (string-append
+	     (string-join
+	      (map object->string (list (object-address x) c x))
+	      " ")
+	     "\n")))
+
+	  (sort
+	   (hash-table->alist (ly:protects))
+	   (lambda (a b)
+	     (< (object-address (car a))
+		(object-address (car b)))))
+	  
+	  )
+      (open-file (string-append
+	       "gcstat-" (number->string gc-protect-stat-count)
+	       ".scm"
+	       ) "w")))
+