From 388e8d25163ff696be7df9dc3415746f1f0392c7 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Fri, 15 Feb 2013 13:58:16 +0100 Subject: [PATCH] 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. --- scm/bar-line.scm | 38 ++++++++++++++------------------ scm/chord-ignatzek-names.scm | 3 +-- scm/define-woodwind-diagrams.scm | 19 +++------------- scm/music-functions.scm | 2 +- scm/translation-functions.scm | 16 +++++--------- 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 -- 2.39.2