Issue 3182: Defuse the obfuscated Scheme programming contest

This merely grepped for occurences of "reduce" and replaced most of
them (and possibly the close surroundings) with something saner.  The
winner definitely has been in bar-line.scm.  I have not touched the
occurences in stencil.scm since it would have been like putting
lipstick on a pig: the surroundings are even worse than the calls of
reduce.

5 files changed, 26 insertions, 52 deletions

diff --git a/scm/bar-line.scm b/scm/bar-line.scm
index 3cc956ee1c..8ac123e11e 100644
--- a/scm/bar-line.scm
+++ b/scm/bar-line.scm
@@ -327,34 +327,28 @@ is not used within the routine."
                                            line-pos) <))
                                (gap-to-find (/ (+ dot-y-length line-thickness)
                                                (/ staff-space 2)))
-                               (first (car folded-staff))
-                               (found #f))
+                               (first (car folded-staff)))
 
                           ;; find the first space big enough
                           ;; to hold a dot and a staff line
                           ;; (a space in the folded staff may be
                           ;; narrower but can't be wider than the
                           ;; corresponding original spaces)
-                          (reduce (lambda (x y) (if (and (> (- x y) gap-to-find)
-                                                         (not found))
-                                                    (begin
-                                                      (set! found #t)
-                                                      (set! dist (+ x y))))
-                                          x)
-                                  ""
-                                  folded-staff)
-
-                          (if (not found)
-                              (set! dist (if (< gap-to-find first)
-                                             ;; there's a central space big
-                                             ;; enough to hold both dots
-                                             first
-
-                                             ;; dots should go outside
-                                             (+ (* 2 (car
-                                                      (reverse folded-staff)))
-                                                (/ (* 4 dot-y-length)
-                                                   staff-space))))))))))))
+                          (set! dist
+                                (or
+                                 (any (lambda (x y)
+                                        (and (> (- y x) gap-to-find)
+                                             (+ x y)))
+                                      folded-staff (cdr folded-staff))
+                                 (if (< gap-to-find first)
+                                     ;; there's a central space big
+                                     ;; enough to hold both dots
+                                     first
+
+                                     ;; dots should go outside
+                                     (+ (* 2 (last folded-staff))
+                                        (/ (* 4 dot-y-length)
+                                           staff-space))))))))))))
         (set! staff-space 1.0))
 
     (let* ((stencil empty-stencil)
diff --git a/scm/chord-ignatzek-names.scm b/scm/chord-ignatzek-names.scm
index 69381836a7..b90d7c4ed5 100644
--- a/scm/chord-ignatzek-names.scm
+++ b/scm/chord-ignatzek-names.scm
@@ -284,8 +284,7 @@ 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)) #t
-                         (map is-natural-alteration? alterations)))
+                 (every is-natural-alteration? alterations))
                 (begin
                   (set! main-name (last alterations))
                   (set! alterations '())))
diff --git a/scm/define-woodwind-diagrams.scm b/scm/define-woodwind-diagrams.scm
index f60ba5a43b..d2da0dda0b 100644
--- a/scm/define-woodwind-diagrams.scm
+++ b/scm/define-woodwind-diagrams.scm
@@ -76,30 +76,17 @@ returns @samp{1/3}."
   "Returns true if x is the square of a value in input-list."
   (pair? (memv (inexact->exact (sqrt x)) input-list)))
 
-(define (satisfies-function? function input-list)
-  "Returns true if an element in @code{input-list} is true
-   when @code{function} is applied to it.
-   For example:
-   @code{guile> (satisfies-function? null? '((1 2) ()))}
-   @code{#t}
-   @code{guile> (satisfies-function? null? '((1 2) (3)))}
-   @code{#f}"
-  (if (null?  input-list)
-    #f
-    (or (function (car input-list))
-      (satisfies-function? function (cdr input-list)))))
-
 (define (true-entry? input-list)
   "Is there a true entry in @code{input-list}?"
-  (satisfies-function? identity input-list))
+  (any identity input-list))
 
 (define (entry-greater-than-x? input-list x)
   "Is there an entry greater than @code{x} in @code{input-list}?"
-  (satisfies-function? (lambda (y) (> y x)) input-list))
+  (any (lambda (y) (> y x)) input-list))
 
 (define (n-true-entries input-list)
   "Returns number of true entries in @code{input-list}."
-  (reduce + 0 (map (lambda (x) (if x 1 0)) input-list)))
+  (count identity input-list))
 
 (define (bezier-head-for-stencil bezier cut-point)
   "Prepares a split-bezier to be used in a connected path stencil."
diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 8866c0e887..bb5bb9ab88 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -806,7 +806,7 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
     (if (ly:music? e)
 	(set! (ly:music-property m 'element)  (voicify-music e)))
     (if (and (equal? (ly:music-property m 'name) 'SimultaneousMusic)
-	     (reduce (lambda (x y ) (or x y)) #f (map music-separator? es)))
+	     (any music-separator? es))
 	(set! m (context-spec-music (voicify-chord m) 'Staff)))
     m))
 
diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm
index 7f3305665e..5877674d10 100644
--- a/scm/translation-functions.scm
+++ b/scm/translation-functions.scm
@@ -338,17 +338,11 @@ if no fingering is present."
 
     (define (close-enough fret)
       "Decide if @var{fret} is acceptable, given the already used frets."
-      (if (null? specified-frets)
-	#t
-	(reduce
-	  (lambda (x y)
-	    (and x y))
-	  #t
-	  (map (lambda (specced-fret)
-		 (or (zero? specced-fret)
-		     (zero? fret)
-		     (>= maximum-stretch (abs (- fret specced-fret)))))
-	       specified-frets))))
+      (every (lambda (specced-fret)
+               (or (zero? specced-fret)
+                   (zero? fret)
+                   (>= maximum-stretch (abs (- fret specced-fret)))))
+             specified-frets))
 
     (define (string-qualifies string pitch)
       "Can @var{pitch} be played on @var{string}, given already placed