From: hanwen <hanwen>
Date: Wed, 2 Jul 2003 01:03:59 +0000 (+0000)
Subject: remove tail, filter-list, filter-out-list,
X-Git-Tag: release/1.7.25~64
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=375b4edd13b40ec43be7303e00ea3e27be152721;p=lilypond.git

remove tail, filter-list, filter-out-list,
first-n, butfirst-n in favor of srfi-1 functions
---

diff --git a/ChangeLog b/ChangeLog
index f028787940..af356fd9c6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2003-07-02  Han-Wen Nienhuys  <hanwen@cs.uu.nl>
 
+	* scm/lily.scm: remove tail, filter-list, filter-out-list,
+	first-n, butfirst-n in favor of srfi-1 functions
+
 	* mf/parmesan-custodes.mf (dir_down): remove _ from glyph names.
 
 	* NEWS: use complete sentences.
diff --git a/lily/molecule-scheme.cc b/lily/molecule-scheme.cc
index 6a611efcd4..8ba102f34d 100644
--- a/lily/molecule-scheme.cc
+++ b/lily/molecule-scheme.cc
@@ -119,7 +119,8 @@ LY_DEFINE(ly_molecule_combined_at_edge,
 }
 
 /*
-  FIXME: support variable number of arguments "
+  FIXME: support variable number of arguments. 
+  
  */
 LY_DEFINE(ly_molecule_add , 
 	  "ly:molecule-add", 2, 0, 0, (SCM first, SCM second),
diff --git a/scm/bass-figure.scm b/scm/bass-figure.scm
index cfe44b6b94..e65b116e49 100644
--- a/scm/bass-figure.scm
+++ b/scm/bass-figure.scm
@@ -9,7 +9,7 @@
   (if (null? l)
       '()
       (let*
-	  ((x (split-at pred? l)))
+	  ((x (split-at-predicate pred? l)))
 	(set-cdr! x (recursive-split-at pred? (cdr x)))
 	x
 	)))
diff --git a/scm/chord-entry.scm b/scm/chord-entry.scm
index f71ff58503..6b047797ff 100644
--- a/scm/chord-entry.scm
+++ b/scm/chord-entry.scm
@@ -113,8 +113,8 @@ the bass specified.
 			   (ly:pitch-alteration inversion))
 			)))
 		 
-	   (rest-of-chord (filter-out-list inv? complete-chord))
-	   (inversion-candidates (filter-list inv? complete-chord))
+	   (rest-of-chord (remove inv? complete-chord))
+	   (inversion-candidates (filter inv? complete-chord))
 	   (down-inversion (pitch-octavated-strictly-below inversion root))
 	   )
 
diff --git a/scm/chord-generic-names.scm b/scm/chord-generic-names.scm
index fb9c1d3b10..8caaa4c8d0 100644
--- a/scm/chord-generic-names.scm
+++ b/scm/chord-generic-names.scm
@@ -113,7 +113,7 @@ input/test/dpncnt.ly).
     (make-line-markup (list (make-simple-markup "no") (step->markup pitch))))
 			 
   (define (get-full-list pitch)
-    (if (<= (step-nr pitch) (step-nr (tail pitches)))
+    (if (<= (step-nr pitch) (step-nr (last pitches)))
 	(cons pitch (get-full-list (next-third pitch)))
 	'()))
 
@@ -139,7 +139,7 @@ input/test/dpncnt.ly).
     (if (pair? exceptions)
 	(let* ((e (car exceptions))
 	       (e-pitches (car e)))
-	  (if (equal? e-pitches (first-n (length e-pitches) pitches))
+	  (if (equal? e-pitches (take pitches (length e-pitches) ))
 	      e
 	      (partial-match (cdr exceptions))))
 	#f))
@@ -165,15 +165,15 @@ input/test/dpncnt.ly).
 	 ;; kludge alert: replace partial matched lower part of all with
 	 ;; 'normal' pitches from full
 	 ;; (all pitches)
-	 (all (append (first-n (length partial-pitches) full)
-		      (butfirst-n (length partial-pitches) pitches)))
+	 (all (append (take full (length partial-pitches) )
+		      (drop pitches (length partial-pitches) )))
 	      
-	 (highest (tail all))
+	 (highest (last all))
 	 (missing (list-minus full (map pitch-unalter all)))
 	 (consecutive (get-consecutive 1 all))
 	 (rest (list-minus all consecutive))
-	 (altered (filter-list step-even-or-altered? all))
-	 (cons-alt (filter-list step-even-or-altered? consecutive))
+	 (altered (filter step-even-or-altered? all))
+	 (cons-alt (filter step-even-or-altered? consecutive))
 	 (base (list-minus consecutive altered)))
 	 
 
@@ -260,7 +260,7 @@ input/test/dpncnt.ly).
 	       
 	       ;; kludge alert: omit <= 5
 	       ;;(markup-join (map step->markup
-	       ;;			 (cons (tail base) cons-alt)) sep)
+	       ;;			 (cons (last base) cons-alt)) sep)
 	       
 	       ;; This fixes:
 	       ;;  c     C5       -> C
@@ -269,7 +269,7 @@ input/test/dpncnt.ly).
 	       ;;  c:6.9 C5 6add9 -> C6 add 9 (add?)
 	       ;;  ch = \chords { c c:2 c:3- c:6.9^7 }
 	       (markup-join (map step->markup
-  				 (let ((tb (tail base)))
+  				 (let ((tb (last base)))
   				   (if (> (step-nr tb) 5)
   				       (cons tb cons-alt)
   				       cons-alt))) sep)
diff --git a/scm/chord-ignatzek-names.scm b/scm/chord-ignatzek-names.scm
index 120bd68127..3e19987611 100644
--- a/scm/chord-ignatzek-names.scm
+++ b/scm/chord-ignatzek-names.scm
@@ -152,7 +152,7 @@ work than classifying the pitches."
        '()
        (let*
 	   (
-	    (l (filter-list altered? alters))
+	    (l (filter altered? alters))
 	    (lp (last-pair alters))
 	    )
 
@@ -273,7 +273,7 @@ work than classifying the pitches."
 	   (
 	    (3-diff? (lambda (x y)
 		       (= (- (pitch-step y) (pitch-step x)) 2)))
-	    (split (split-at 3-diff? (remove-uptil-step 5 pitches)))
+	    (split (split-at-predicate 3-diff? (remove-uptil-step 5 pitches)))
 	    )
 	 (set! alterations (append alterations (car split)))
 	 (set! add-steps (append add-steps (cdr split)))
@@ -296,10 +296,10 @@ work than classifying the pitches."
 	      (= 7 (pitch-step main-name))
 	      (is-natural-alteration? main-name)
 	      (pair? (remove-uptil-step 7 alterations))
-	      (reduce (lambda (x y) (and x y))
+	      (reduce (lambda (x y) (and x y)) #t
 		      (map is-natural-alteration? alterations)))
 	     (begin
-	       (set! main-name (tail alterations))
+	       (set! main-name (last alterations))
 	       (set! alterations '())
 	       ))
 	 
diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index 3e5c9f0ea7..7ed0f184d4 100644
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -89,7 +89,7 @@ FOOBAR-MARKUP) if OMIT-ROOT is given and non-false.
     (let* ((elts (ly:get-mus-property m 'elements))
 	   (omit-root (and (pair? rest) (car rest)))
 	   (pitches (map (lambda (x) (ly:get-mus-property x 'pitch))
-			 (filter-list
+			 (filter
 			  (lambda (y) (memq 'note-event
 					    (ly:get-mus-property y 'types)))
 			  elts)))
@@ -104,7 +104,7 @@ FOOBAR-MARKUP) if OMIT-ROOT is given and non-false.
 	   (diff (ly:pitch-diff root (ly:make-pitch 0 0 0)))
 	   (normalized (map (lambda (x) (ly:pitch-diff x diff)) sorted))
 	   (texts (map (lambda (x) (ly:get-mus-property x 'text))
-		       (filter-list
+		       (filter
 			(lambda (y) (memq 'text-script-event
 					  (ly:get-mus-property y 'types)))
 			elts)))
@@ -117,9 +117,9 @@ FOOBAR-MARKUP) if OMIT-ROOT is given and non-false.
      (memq 'event-chord (ly:get-mus-property m 'types))
      (not (equal? (ly:make-moment 0 1) (ly:get-music-length m)))))
 
-  (let* ((elts (filter-list is-req-chord? (ly:get-mus-property seq 'elements)))
+  (let* ((elts (filter is-req-chord? (ly:get-mus-property seq 'elements)))
 	 (alist (map chord-to-exception-entry elts)))
-    (filter-list (lambda (x) (cdr x)) alist)))
+    (filter (lambda (x) (cdr x)) alist)))
 
 
 (define-public (new-chord-name-brew-molecule grob)
diff --git a/scm/document-backend.scm b/scm/document-backend.scm
index 94047ab8f8..7603f5d942 100644
--- a/scm/document-backend.scm
+++ b/scm/document-backend.scm
@@ -109,7 +109,7 @@ node."
 "\n\n"
 			(interface-doc-string iface description)))
 		      (reverse ifaces)))
-       (engravers (filter-list
+       (engravers (filter
 		   (lambda (x) (engraver-makes-grob? name x)) all-engravers-list))
        (namestr (symbol->string name))
        (engraver-names (map ly:translator-name engravers))
diff --git a/scm/document-music.scm b/scm/document-music.scm
index bd6a8ea7ef..9b14484a30 100644
--- a/scm/document-music.scm
+++ b/scm/document-music.scm
@@ -58,7 +58,7 @@
      (human-listify
       (map ref-ify
       (map ly:translator-name
-	   (filter-list
+	   (filter
 	    (lambda (x) (engraver-accepts-music-type? (car entry) x)) all-engravers-list))))
      "\n\n"
      )))
@@ -89,7 +89,7 @@
      (human-listify
       (map ref-ify
       (map ly:translator-name
-	   (filter-list
+	   (filter
 	    (lambda (x) (engraver-accepts-music-types? types x)) all-engravers-list))))
      "\n\nProperties: \n"
      (description-list->texi
diff --git a/scm/font.scm b/scm/font.scm
index 34dd63b130..fa6835c340 100644
--- a/scm/font.scm
+++ b/scm/font.scm
@@ -33,7 +33,7 @@
 
 (define (filter-field field-name value font-descr-alist)
   "return those descriptions from FONT-DESCR-LIST whose FIELD-NAME matches VALUE"
-      (filter-list
+      (filter
        (lambda (x) (let* (field-value (font-field field-name (car x))) 
 		     (or (eq? field-value '*) (eq? value field-value))))
        font-descr-alist)
@@ -346,7 +346,7 @@ and warn if the selected font is not unique.
 
 (if #f (begin
 	 (define (test-module)
-	   (display (filter-list pair? '(1 2 (1 2) (1 .2)))
+	   (display (filter pair? '(1 2 (1 2) (1 .2)))
 		    (display (filter-field 'font-name 'cmbx paper20-style-sheet-alist))
 		    
 		    (display (qualifiers-to-fontname '((font-name . cmbx)) paper20-style-sheet-alist))
diff --git a/scm/lily.scm b/scm/lily.scm
index 37b6812b28..9866b1efc6 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -8,8 +8,8 @@
 ;;; Library functions
 
 
-(use-modules (ice-9 regex))
-
+(use-modules (ice-9 regex)
+	     (srfi srfi-1))
 
 ;;; General settings
 ;; debugging evaluator is slower.
@@ -102,10 +102,6 @@
 
 ;;;;;;;;;;;;;;;;
 ; list
-(define (tail lst)
-  "Return tail element of LST."
-  (car (last-pair lst)))
-
 
 (define (flatten-list lst)
   "Unnest LST" 
@@ -118,44 +114,10 @@
 
 (define (list-minus a b)
   "Return list of elements in A that are not in B."
-  (if (pair? a)
-      (if (pair? b)
-	  (if (member (car a) b)
-	      (list-minus (cdr a) b)
-	      (cons (car a) (list-minus (cdr a) b)))
-	  a)
-      '()))
-
-;; TODO: use the srfi-1 partition function.
-
-;; why -list suffix (see reduce-list)
-(define-public (filter-list pred? list)
-  "return that part of LIST for which PRED is true.
-
- TODO: rewrite using accumulator. Now it takes O(n) stack. "
-  
-  (if (null? list) '()
-      (let* ((rest (filter-list pred? (cdr list))))
-	(if (pred? (car list))
-	    (cons (car list)  rest)
-	    rest))))
-
-(define-public (filter-out-list pred? list)
-  "return that part of LIST for which PRED is false."
-  (if (null? list) '()
-      (let* ((rest (filter-out-list pred? (cdr list))))
-	(if (not (pred? (car list)))
-	    (cons (car list)  rest)
-	    rest))))
-
+  (lset-difference eq? a b))
 
-(define (first-n n lst)
-  "Return first N elements of LST"
-  (if (and (pair? lst)
-	   (> n 0))
-      (cons (car lst) (first-n (- n 1) (cdr lst)))
-      '()))
 
+;; TODO: use the srfi-1 partition function.
 (define-public (uniq-list list)
   (if (null? list) '()
       (if (null? (cdr list))
@@ -164,21 +126,13 @@
 	      (uniq-list (cdr list))
 	      (cons (car list) (uniq-list (cdr list)))))))
 
-(define (butfirst-n n lst)
-  "Return all but first N entries of LST"
-  (if (pair? lst)
-      (if (> n 0)
-	  (butfirst-n (- n 1) (cdr lst))
-	  lst)
-      '()))
-  
-(define (split-at predicate l)
+(define (split-at-predicate predicate l)
  "Split L = (a_1 a_2 ... a_k b_1 ... b_k)
 into L1 = (a_1 ... a_k ) and L2 =(b_1 .. b_k) 
 Such that (PREDICATE a_i a_{i+1}) and not (PREDICATE a_k b_1).
 L1 is copied, L2 not.
 
-(split-at (lambda (x y) (= (- y x) 2))  '(1 3 5 9 11) (cons '() '()))"
+(split-at-predicate (lambda (x y) (= (- y x) 2))  '(1 3 5 9 11) (cons '() '()))"
 ;; "
 
 ;; KUT EMACS MODE.
@@ -208,19 +162,16 @@ L1 is copied, L2 not.
 
 
 (define-public (split-list l sep?)
-  "
-
+"
 (display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))) )
 =>
 ((a b c) (d e f) (g))
 
 "
+;; " KUT EMACS.
 
 (define (split-one sep?  l acc)
-  "Split off the first parts before separator and return both parts.
-
-"
-  ;; " KUT EMACS
+  "Split off the first parts before separator and return both parts."
   (if (null? l)
       (cons acc '())
       (if (sep? (car l))
@@ -233,19 +184,8 @@ L1 is copied, L2 not.
     '()
     (let* ((c (split-one sep? l '())))
       (cons (reverse! (car c) '()) (split-list (cdr c) sep?))
-      )
-    )
-)
-
-
-(define-public (range x y)
-  "Produce a list of integers starting at Y with X elements."
-  (if (<= x 0)
-      '()
-      (cons y (range (- x 1)  (+ y 1)))
+      )))
 
-      )
-  )
 
 (define-public (interval-length x)
   "Length of the number-pair X, when an interval"
@@ -276,30 +216,13 @@ L1 is copied, L2 not.
   "map F to contents of X"
   (cons (f (car x)) (f (cdr x))))
 
-;; used where?
-(define-public (reduce operator list)
+;; TODO: remove.
+(define-public (reduce-no-unit operator list)
   "reduce OP [A, B, C, D, ... ] =
    A op (B op (C ... ))
 "
       (if (null? (cdr list)) (car list)
-	  (operator (car list) (reduce operator (cdr list)))))
-
-(define (take-from-list-until todo gathered crit?)
-  "return (G, T), where (reverse G) + T = GATHERED + TODO, and the last of G
-is the  first to satisfy CRIT
-
- (take-from-list-until '(1 2 3  4 5) '() (lambda (x) (eq? x 3)))
-=>
- ((3 2 1) 4 5)
-
-"
-  (if (null? todo)
-      (cons gathered todo)
-      (if (crit? (car todo))
-	  (cons (cons (car todo) gathered) (cdr todo))
-	  (take-from-list-until (cdr todo) (cons (car todo) gathered) crit?)
-      )
-  ))
+	  (operator (car list) (reduce-no-unit operator (cdr list)))))
 
 (define-public (list-insert-separator list between)
   "Create new list, inserting BETWEEN between elements of LIST"
diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 3945e10a55..8bffc5e52f 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -272,8 +272,8 @@ a property set for MultiMeasureRestNumber."
 	  (
 	   (text? (lambda (x) (memq 'script-event (ly:get-mus-property x 'types))))
 	   (es (ly:get-mus-property  music 'elements))
-	   (texts (map script-to-mmrest-text  (filter-list text? es)))
-	   (others (filter-out-list text? es))
+	   (texts (map script-to-mmrest-text  (filter text? es)))
+	   (others (remove text? es))
 	   )
 	(if (pair? texts)
 	    (ly:set-mus-property!
@@ -452,7 +452,7 @@ Rest can contain a list of beat groupings
 	 (ly:set-mus-property! m 'element  (voicify-music e)))
      (if
       (and (equal? (ly:music-name m) "Simultaneous_music")
-	   (reduce (lambda (x y ) (or x y)) 	(map music-separator? es)))
+	   (reduce (lambda (x y ) (or x y)) #f (map music-separator? es)))
       (voicify-chord m)
       )
 
@@ -498,7 +498,7 @@ Rest can contain a list of beat groupings
 ;; warn for bare chords at start.
 
 (define (has-request-chord elts)
-  (reduce (lambda (x y) (or x y)) (map (lambda (x) (equal? (ly:music-name x)
+  (reduce (lambda (x y) (or x y)) #f (map (lambda (x) (equal? (ly:music-name x)
 							   "Request_chord")) elts)
   ))
 
diff --git a/scm/new-markup.scm b/scm/new-markup.scm
index 1ddde4bd9a..f04cf768d8 100644
--- a/scm/new-markup.scm
+++ b/scm/new-markup.scm
@@ -223,13 +223,13 @@ for the reader.
        (dot (ly:find-glyph-by-name font "dots-dot"))
        (dotwid  (interval-length (ly:molecule-get-extent dot X)))
        (dots (if (> dot-count 0)
-		 (reduce
+		 (reduce-no-unit 	; TODO: use reduce.
 		  (lambda (x y)
 		    (ly:molecule-add x y))
 		  (map (lambda (x)
 			 (ly:molecule-translate-axis
 			  dot  (* (+ 1 (* 2 x)) dotwid) X) )
-		       (range dot-count 1)))
+		       (iota dot-count 1)))
 		 #f
 		 ))
        
diff --git a/scm/to-xml.scm b/scm/to-xml.scm
index 52d3513ffe..88f84280e3 100644
--- a/scm/to-xml.scm
+++ b/scm/to-xml.scm
@@ -152,7 +152,7 @@ is then separated.
   (string-append
    "<" (symbol->string tag)
    (apply string-append
-	  (map dump-attr (filter-list candidate? attrs)))
+	  (map dump-attr (filter candidate? attrs)))
    ">\n")
    
   )