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.

diff --git a/scm/bar-line.scm b/scm/bar-line.scm
index 3cc956ee1c85a2e67c42170f7c6d6abf9d3e0163..8ac123e11e9f9d7bedfef87a7c3e2ed835e7c260 100644 (file)
--- 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 69381836a751107318fd4a457f523958fafa9dc6..b90d7c4ed5a95da6091ea81b551a2e8c0779043e 100644 (file)
--- 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 f60ba5a43b10a26ae4a9833492fe5e88c9ae83bd..d2da0dda0b5f635dcc715a299365e1357eb9544e 100644 (file)
--- 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 8866c0e8877d75c374f42ee56cd85c8114a7c361..bb5bb9ab88e5aa8b27f5486acd34407711b5211a 100644 (file)
--- 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 7f3305665ebef1dcc35d85f17e09a980e52bb67d..5877674d10e9e08d3d65538e762048b3b281627b 100644 (file)
--- 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