From: David Kastrup <dak@gnu.org>
Date: Tue, 24 Sep 2013 14:40:02 +0000 (+0200)
Subject: Issue 3580: Replace unwarranted uses of map with for-each and other Scheme cleanups
X-Git-Tag: release/2.17.28-1~21
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=ef5c8e061ba49682c06cdfbd3816c971d6accba4;p=lilypond.git
Issue 3580: Replace unwarranted uses of map with for-each and other Scheme cleanups
Note that some uses of map actually relied on execution order (namely
expecting map to behave like map-in-order) and thus were not just
inelegant because of the side effect. There are also some other
mostly trivial simplification of Scheme constructs.
---
diff --git a/input/regression/tie-chord.ly b/input/regression/tie-chord.ly
index d830bd01a9..af3ec740a9 100644
--- a/input/regression/tie-chord.ly
+++ b/input/regression/tie-chord.ly
@@ -55,8 +55,8 @@ translate x y z to x~x y~y z~z
(list ch1 ch2)))
- (make-music 'SequentialMusic 'elements (apply append
- (map chord->tied-chord (ly:music-property chords 'elements)))))
+ (make-music 'SequentialMusic 'elements (append-map
+ chord->tied-chord (ly:music-property chords 'elements))))
baseChords =
\applyMusic #(lambda (mus)
diff --git a/ly/init.ly b/ly/init.ly
index 7dbb1042aa..acaa2c9899 100644
--- a/ly/init.ly
+++ b/ly/init.ly
@@ -55,15 +55,15 @@ $(if (ly:get-option 'include-settings)
toplevel-book-handler)))
(cond ((pair? toplevel-bookparts)
(let ((book (ly:make-book $defaultpaper $defaultheader)))
- (map (lambda (part)
- (ly:book-add-bookpart! book part))
- (reverse! toplevel-bookparts))
+ (for-each (lambda (part)
+ (ly:book-add-bookpart! book part))
+ (reverse! toplevel-bookparts))
(set! toplevel-bookparts (list))
;; if scores have been defined after the last explicit \bookpart:
(if (pair? toplevel-scores)
- (map (lambda (score)
- (ly:book-add-score! book score))
- (reverse! toplevel-scores)))
+ (for-each (lambda (score)
+ (ly:book-add-score! book score))
+ (reverse! toplevel-scores)))
(set! toplevel-scores (list))
(book-handler parser book)))
((or (pair? toplevel-scores) output-empty-score-list)
diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index 7f357376a3..a167718187 100644
--- a/scm/backend-library.scm
+++ b/scm/backend-library.scm
@@ -151,8 +151,7 @@
(define-public (output-scopes scopes fields basename)
(define (output-scope scope)
- (apply
- string-append
+ (string-concatenate
(module-map
(lambda (sym var)
(let ((val (if (variable-bound? var) (variable-ref var) "")))
@@ -160,7 +159,7 @@
(header-to-file basename sym val))
""))
scope)))
- (apply string-append (map output-scope scopes)))
+ (string-concatenate (map output-scope scopes)))
(define-public (relevant-book-systems book)
(let ((systems (ly:paper-book-systems book)))
@@ -190,15 +189,14 @@
(ly:warning (_ "missing stencil expression `~S'") name)
""))
- (map (lambda (x)
- (if (not (module-defined? output-module x))
- (begin
- (module-define! output-module x
- (lambda* (#:optional y . z)
- (missing-stencil-expression x)))
- (set! missing-stencil-list (append (list x)
- missing-stencil-list)))))
- (ly:all-stencil-commands)))
+ (for-each (lambda (x)
+ (if (not (module-defined? output-module x))
+ (begin
+ (module-define! output-module x
+ (lambda* (#:optional y . z)
+ (missing-stencil-expression x)))
+ (set! missing-stencil-list (cons x missing-stencil-list)))))
+ (ly:all-stencil-commands)))
(define-public (remove-stencil-warnings output-module)
(for-each
@@ -269,5 +267,5 @@ definition."
(define-pango-pf pango-pf font-name scaling)))
(string-append
- (apply string-append (map font-load-command other-fonts))
- (apply string-append (map pango-font-load-command pango-only-fonts)))))
+ (string-concatenate (map font-load-command other-fonts))
+ (string-concatenate (map pango-font-load-command pango-only-fonts)))))
diff --git a/scm/bar-line.scm b/scm/bar-line.scm
index fedd21be9a..03c6f80815 100644
--- a/scm/bar-line.scm
+++ b/scm/bar-line.scm
@@ -88,10 +88,10 @@ Pad the string with @code{annotation-char}s to the length of the
(if (pair? line-pos)
(begin
(set! iv (cons (car line-pos) (car line-pos)))
- (map (lambda (x)
- (set! iv (cons (min (car iv) x)
- (max (cdr iv) x))))
- (cdr line-pos)))
+ (for-each (lambda (x)
+ (set! iv (cons (min (car iv) x)
+ (max (cdr iv) x))))
+ (cdr line-pos)))
(let ((line-count (ly:grob-property grob 'line-count 0)))
@@ -179,18 +179,18 @@ annotation char from string @var{str}."
(last-pos (1- (length sorted-elts)))
(idx 0))
- (map (lambda (g)
- (ly:grob-set-property!
- g
- 'has-span-bar
- (cons (if (eq? idx last-pos)
- #f
- grob)
- (if (zero? idx)
- #f
- grob)))
- (set! idx (1+ idx)))
- sorted-elts)))
+ (for-each (lambda (g)
+ (ly:grob-set-property!
+ g
+ 'has-span-bar
+ (cons (if (eq? idx last-pos)
+ #f
+ grob)
+ (if (zero? idx)
+ #f
+ grob)))
+ (set! idx (1+ idx)))
+ sorted-elts)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Line break decisions.
@@ -400,21 +400,21 @@ is not used within the routine."
(half-thick (/ line-thickness 2.0))
(stencil empty-stencil))
- (map (lambda (i)
- (let ((top-y (min (* (+ i dash-size) half-space)
- (+ (* (1- line-count) half-space)
- half-thick)))
- (bot-y (max (* (- i dash-size) half-space)
- (- 0 (* (1- line-count) half-space)
- half-thick))))
-
- (set! stencil
- (ly:stencil-add
- stencil
- (ly:round-filled-box (cons 0 thickness)
- (cons bot-y top-y)
- blot)))))
- (iota line-count (1- line-count) (- 2)))
+ (for-each (lambda (i)
+ (let ((top-y (min (* (+ i dash-size) half-space)
+ (+ (* (1- line-count) half-space)
+ half-thick)))
+ (bot-y (max (* (- i dash-size) half-space)
+ (- 0 (* (1- line-count) half-space)
+ half-thick))))
+
+ (set! stencil
+ (ly:stencil-add
+ stencil
+ (ly:round-filled-box (cons 0 thickness)
+ (cons bot-y top-y)
+ blot)))))
+ (iota line-count (1- line-count) (- 2)))
stencil)
(let* ((dashes (/ height staff-space))
(total-dash-size (/ height dashes))
@@ -823,26 +823,26 @@ no elements."
;; we compute the extents of each system and store them
;; in a list; dito for the 'allow-span-bar property.
;; model-bar takes the bar grob, if given.
- (map (lambda (bar)
- (let ((ext (bar-line::bar-y-extent bar refp))
- (staff-symbol (ly:grob-object bar 'staff-symbol)))
-
- (if (ly:grob? staff-symbol)
- (let ((refp-extent (ly:grob-extent staff-symbol refp Y)))
-
- (set! ext (interval-union ext refp-extent))
-
- (if (> (interval-length ext) 0)
- (begin
- (set! extents (append extents (list ext)))
- (set! model-bar bar)
- (set! make-span-bars
- (append make-span-bars
- (list (ly:grob-property
- bar
- 'allow-span-bar
- #t))))))))))
- elts)
+ (for-each (lambda (bar)
+ (let ((ext (bar-line::bar-y-extent bar refp))
+ (staff-symbol (ly:grob-object bar 'staff-symbol)))
+
+ (if (ly:grob? staff-symbol)
+ (let ((refp-extent (ly:grob-extent staff-symbol refp Y)))
+
+ (set! ext (interval-union ext refp-extent))
+
+ (if (> (interval-length ext) 0)
+ (begin
+ (set! extents (append extents (list ext)))
+ (set! model-bar bar)
+ (set! make-span-bars
+ (append make-span-bars
+ (list (ly:grob-property
+ bar
+ 'allow-span-bar
+ #t))))))))))
+ elts)
;; if there is no bar grob, we use the callback argument
(if (not model-bar)
(set! model-bar grob))
diff --git a/scm/chord-generic-names.scm b/scm/chord-generic-names.scm
index c366a70b54..f7ba6b4edf 100644
--- a/scm/chord-generic-names.scm
+++ b/scm/chord-generic-names.scm
@@ -226,15 +226,15 @@ See @file{double-plus-new-chord-name.scm} for the signature of @var{style}.
partial-markup-prefix
(make-normal-size-super-markup
(markup-join
- (apply append
- (map step->markup
- (append altered
- (if (and (> (step-nr highest) 5)
- (not
- (step-even-or-altered? highest)))
- (list highest) '())))
- (list partial-markup-suffix)
- (list (map sub->markup missing)))
+ (append
+ (map step->markup
+ (append altered
+ (if (and (> (step-nr highest) 5)
+ (not
+ (step-even-or-altered? highest)))
+ (list highest) '())))
+ (list partial-markup-suffix)
+ (map sub->markup missing))
sep)))))))
diff --git a/scm/chord-ignatzek-names.scm b/scm/chord-ignatzek-names.scm
index b90d7c4ed5..fc32e6ba75 100644
--- a/scm/chord-ignatzek-names.scm
+++ b/scm/chord-ignatzek-names.scm
@@ -242,7 +242,7 @@ work than classifying the pitches."
;; no exception.
;; handle sus4 and sus2 suffix: if there is a 3 together with
;; sus2 or sus4, then we explicitly say add3.
- (map
+ (for-each
(lambda (j)
(if (get-step j pitches)
(begin
diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm
index 097ffdc370..9b1b4e71ca 100644
--- a/scm/define-grobs.scm
+++ b/scm/define-grobs.scm
@@ -2792,11 +2792,11 @@
;; make sure that \property Foo.Bar =\turnOff doesn't complain
-(map (lambda (x)
- ;; (display (car x)) (newline)
+(for-each (lambda (x)
+ ;; (display (car x)) (newline)
- (set-object-property! (car x) 'translation-type? list?)
- (set-object-property! (car x) 'is-grob? #t))
- all-grob-descriptions)
+ (set-object-property! (car x) 'translation-type? list?)
+ (set-object-property! (car x) 'is-grob? #t))
+ all-grob-descriptions)
(set! all-grob-descriptions (sort all-grob-descriptions alist<?))
diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index be87af5191..ca4fac36a9 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -1516,7 +1516,7 @@ the line width, where @var{X} is the number of staff spaces.
justify word-space
line-width text-direction)))
list-para-words)))
- (apply append para-lines)))
+ (concatenate para-lines)))
(define-markup-command (wordwrap-string layout props arg)
(string?)
diff --git a/scm/define-note-names.scm b/scm/define-note-names.scm
index 6136af0c51..62ef21a72c 100644
--- a/scm/define-note-names.scm
+++ b/scm/define-note-names.scm
@@ -959,13 +959,14 @@
))
;; add two native utf-8 aliases. Pairs obey cp-like order: '(old new)
-(map (lambda (pair)
- (set! language-pitch-names
- (append language-pitch-names
- (list (cons (cadr pair)
- (cdr (assoc (car pair) language-pitch-names)))))))
- '((espanol español)
- (italiano français)))
+(for-each
+ (lambda (pair)
+ (set! language-pitch-names
+ (append language-pitch-names
+ (list (cons (cadr pair)
+ (cdr (assoc (car pair) language-pitch-names)))))))
+ '((espanol español)
+ (italiano français)))
(define-public (note-names-language parser str)
(_ "Select note names language.")
diff --git a/scm/define-stencil-commands.scm b/scm/define-stencil-commands.scm
index a0a18603c2..4c834591a3 100644
--- a/scm/define-stencil-commands.scm
+++ b/scm/define-stencil-commands.scm
@@ -70,6 +70,6 @@ are used internally in @file{lily/@/stencil-interpret.cc}."
transparent-stencil
))
-(map ly:register-stencil-expression
- (append (ly:all-stencil-commands)
- (ly:all-output-backend-commands)))
+(for-each ly:register-stencil-expression
+ (append (ly:all-stencil-commands)
+ (ly:all-output-backend-commands)))
diff --git a/scm/define-woodwind-diagrams.scm b/scm/define-woodwind-diagrams.scm
index 16a4474b7e..0847d4c93f 100644
--- a/scm/define-woodwind-diagrams.scm
+++ b/scm/define-woodwind-diagrams.scm
@@ -1021,7 +1021,7 @@ returns @samp{1/3}."
(*
(car slope-offset1)
(+ keylen (list-ref first-bezier 6))) (cdr slope-offset1))))
- ((if bezier? (lambda (x) `(,(apply append x))) identity)
+ ((if bezier? (lambda (x) `(,(concatenate x))) identity)
`((,(+ (+ keylen 1.75) (list-ref first-bezier 6))
,(+
(*
diff --git a/scm/display-woodwind-diagrams.scm b/scm/display-woodwind-diagrams.scm
index f1190f13c6..5b34ac94fc 100644
--- a/scm/display-woodwind-diagrams.scm
+++ b/scm/display-woodwind-diagrams.scm
@@ -1685,8 +1685,7 @@
possibility-list))))
(define (translate-draw-instructions input-alist key-name-alist)
- (apply append
- (map (lambda (short long)
+ (append-map (lambda (short long)
(let*
((key-instructions
(map (lambda (instr)
@@ -1695,15 +1694,14 @@
(assoc-get long key-name-alist))))
(key-crawler (assoc-get short input-alist) key-instructions)))
'(hd cc lh rh)
- '(hidden central-column left-hand right-hand))))
+ '(hidden central-column left-hand right-hand)))
(define (uniform-draw-instructions key-name-alist)
- (apply append
- (map (lambda (long)
+ (append-map (lambda (long)
(map (lambda (key-instructions)
`((,long . ,(car key-instructions)) . 1))
(assoc-get long key-name-alist)))
- '(hidden central-column left-hand right-hand))))
+ '(hidden central-column left-hand right-hand)))
(define (list-all-possible-keys key-name-alist)
(map (lambda (short long)
diff --git a/scm/document-backend.scm b/scm/document-backend.scm
index a4c25cfe3c..c1288deff5 100644
--- a/scm/document-backend.scm
+++ b/scm/document-backend.scm
@@ -24,7 +24,7 @@
;; properly sort all grobs, properties, and interfaces
;; within the all-grob-descriptions alist
-(map
+(for-each
(lambda (x)
(let* ((props (assoc-ref all-grob-descriptions (car x)))
(meta (assoc-ref props 'meta))
@@ -70,17 +70,17 @@
(define iface->grob-table (make-hash-table 61))
;; extract ifaces, and put grob into the hash table.
-(map
+(for-each
(lambda (x)
(let* ((meta (assoc-get 'meta (cdr x)))
(ifaces (assoc-get 'interfaces meta)))
- (map (lambda (iface)
- (hashq-set!
- iface->grob-table iface
- (cons (car x)
- (hashq-ref iface->grob-table iface '()))))
- ifaces)))
+ (for-each (lambda (iface)
+ (hashq-set!
+ iface->grob-table iface
+ (cons (car x)
+ (hashq-ref iface->grob-table iface '()))))
+ ifaces)))
all-grob-descriptions)
;; First level Interface description
@@ -178,17 +178,17 @@ node."
;;;;;;;;;; check for dangling backend properties.
(define (mark-interface-properties entry)
- (map (lambda (x) (set-object-property! x 'iface-marked #t))
- (caddr (cdr entry))))
+ (for-each (lambda (x) (set-object-property! x 'iface-marked #t))
+ (caddr (cdr entry))))
-(map mark-interface-properties interface-description-alist)
+(for-each mark-interface-properties interface-description-alist)
(define (check-dangling-properties prop)
(if (not (object-property prop 'iface-marked))
(ly:error (string-append "define-grob-properties.scm: "
(_ "cannot find interface for property: ~S")) prop)))
-(map check-dangling-properties all-backend-properties)
+(for-each check-dangling-properties all-backend-properties)
;;;;;;;;;;;;;;;;
diff --git a/scm/document-context-mods.scm b/scm/document-context-mods.scm
index fc3c4ad28a..f5034d2ecc 100644
--- a/scm/document-context-mods.scm
+++ b/scm/document-context-mods.scm
@@ -81,11 +81,8 @@
(map document-mod-list mod-list))))
(define (document-mod obj-pair)
- (cond
- ((ly:context-mod? (cdr obj-pair))
- (document-context-mod obj-pair))
- (else
- #f)))
+ (and (ly:context-mod? (cdr obj-pair))
+ (document-context-mod obj-pair)))
(define context-mods-doc-string
(format
@@ -94,11 +91,9 @@
@end table
"
(string-join
- (filter
- identity
- (map
- document-mod
- (sort
- (ly:module->alist (current-module))
- identifier<?)))
- "")))
+ (filter-map
+ document-mod
+ (sort
+ (ly:module->alist (current-module))
+ identifier<?)))
+ ""))
diff --git a/scm/document-functions.scm b/scm/document-functions.scm
index 282bf24044..2102f640e0 100644
--- a/scm/document-functions.scm
+++ b/scm/document-functions.scm
@@ -50,6 +50,6 @@
#:name "Scheme functions"
#:desc "Primitive functions exported by LilyPond."
#:text
- (apply string-append sfdocs))))
+ (string-concatenate sfdocs))))
;; (dump-node (all-scheme-functions-doc) (current-output-port) 0 )
diff --git a/scm/document-identifiers.scm b/scm/document-identifiers.scm
index e17f7d308c..22088605d7 100644
--- a/scm/document-identifiers.scm
+++ b/scm/document-identifiers.scm
@@ -42,7 +42,7 @@
~a
"
name-sym (car type-names)
- (if (equal? "" signature-str) "" " - ") signature-str
+ (if (string-null? signature-str) "" " - ") signature-str
name-sym
(if doc
doc
@@ -52,11 +52,8 @@
(define (document-object obj-pair)
- (cond
- ((ly:music-function? (cdr obj-pair))
- (document-music-function obj-pair))
- (else
- #f)))
+ (and (ly:music-function? (cdr obj-pair))
+ (document-music-function obj-pair)))
(define-public (identifiers-doc-string)
(format #f
@@ -65,11 +62,9 @@
@end table
"
(string-join
- (filter
- identity
- (map
- document-object
- (sort
- (ly:module->alist (current-module))
- identifier<?)))
- "")))
+ (filter-map
+ document-object
+ (sort
+ (ly:module->alist (current-module))
+ identifier<?)))
+ ""))
diff --git a/scm/document-markup.scm b/scm/document-markup.scm
index 7096a09ec5..54c987b9bb 100644
--- a/scm/document-markup.scm
+++ b/scm/document-markup.scm
@@ -69,7 +69,7 @@
(if (null? prop-strings)
"\n"
(string-append "\n\n\nUsed properties:\n@itemize\n"
- (apply string-append prop-strings)
+ (string-concatenate prop-strings)
"@end itemize\n"))))))
(define (markup-function<? a b)
@@ -91,9 +91,9 @@
#:desc ""
#:text (string-append
"@table @asis"
- (apply string-append
- (map doc-markup-function
- (sort markup-functions markup-function<?)))
+ (string-concatenate
+ (map doc-markup-function
+ (sort markup-functions markup-function<?)))
"\n@end table"))))
(define (markup-doc-node)
@@ -117,11 +117,11 @@
(define (markup-list-doc-string)
(string-append
"@table @asis"
- (apply string-append
- (map doc-markup-function
- (sort (hash-fold (lambda (markup-list-function dummy functions)
- (cons markup-list-function functions))
- '()
- markup-list-functions)
- markup-function<?)))
+ (string-concatenate
+ (map doc-markup-function
+ (sort (hash-fold (lambda (markup-list-function dummy functions)
+ (cons markup-list-function functions))
+ '()
+ markup-list-functions)
+ markup-function<?)))
"\n@end table"))
diff --git a/scm/document-music.scm b/scm/document-music.scm
index ef31ec1f6a..0badbf899e 100644
--- a/scm/document-music.scm
+++ b/scm/document-music.scm
@@ -29,19 +29,18 @@
texi)))
(define music-types->names (make-hash-table 61))
-(filter-map (lambda (entry)
- (let* ((class (ly:camel-case->lisp-identifier (car entry)))
- (classes (ly:make-event-class class)))
- (if classes
- (map
- (lambda (cl)
- (hashq-set! music-types->names cl
- (cons (car entry)
- (hashq-ref music-types->names cl '()))))
- classes)
- #f)))
- music-descriptions)
+(for-each (lambda (entry)
+ (let* ((class (ly:camel-case->lisp-identifier (car entry)))
+ (classes (ly:make-event-class class)))
+ (if classes
+ (for-each
+ (lambda (cl)
+ (hashq-set! music-types->names cl
+ (cons (car entry)
+ (hashq-ref music-types->names cl '()))))
+ classes))))
+ music-descriptions)
(define (strip-description x)
(cons (symbol->string (car x))
diff --git a/scm/document-translation.scm b/scm/document-translation.scm
index 8237260c45..5e867bb4c2 100644
--- a/scm/document-translation.scm
+++ b/scm/document-translation.scm
@@ -78,20 +78,19 @@
(let* ((layout-alist (ly:output-description $defaultlayout))
(context-description-alist (map cdr layout-alist))
(contexts
- (apply append
- (map
- (lambda (x)
- (let* ((context (assoc-get 'context-name x))
- (group (assq-ref x 'group-type))
- (consists (append
- (if group
- (list group)
- '())
- (assoc-get 'consists x))))
- (if (member name-sym consists)
- (list context)
- '())))
- context-description-alist)))
+ (append-map
+ (lambda (x)
+ (let* ((context (assoc-get 'context-name x))
+ (group (assq-ref x 'group-type))
+ (consists (append
+ (if group
+ (list group)
+ '())
+ (assoc-get 'consists x))))
+ (if (member name-sym consists)
+ (list context)
+ '())))
+ context-description-alist))
(context-list (human-listify (map ref-ify
(sort
(map symbol->string contexts)
@@ -114,7 +113,7 @@
;; Second level, part of Context description
(define name->engraver-table (make-hash-table 61))
-(map
+(for-each
(lambda (x)
(hash-set! name->engraver-table (ly:translator-name x) x))
(ly:get-all-translators))
@@ -186,9 +185,9 @@
"."
(if (and (pair? props) (not (null? props)))
- (let ((str (apply string-append
- (sort (map document-property-operation props)
- ly:string-ci<?))))
+ (let ((str (string-concatenate
+ (sort (map document-property-operation props)
+ ly:string-ci<?))))
(if (string-null? str)
""
(string-append
@@ -231,8 +230,7 @@
(list group)
'())
(assoc-get 'consists context-desc)))
- (grobs (apply append
- (map engraver-grobs consists))))
+ (grobs (append-map engraver-grobs consists)))
grobs))
(define (all-contexts-doc)
diff --git a/scm/document-type-predicates.scm b/scm/document-type-predicates.scm
index e6cff904c3..2e94f2c3f8 100644
--- a/scm/document-type-predicates.scm
+++ b/scm/document-type-predicates.scm
@@ -40,9 +40,9 @@
"\n"
"@multitable @columnfractions .33 .66\n"
"@headitem Type predicate @tab Description\n"
- (apply string-append
- (sort (map document-type-predicate alist)
- ly:string-ci<?))
+ (string-concatenate
+ (sort (map document-type-predicate alist)
+ ly:string-ci<?))
"@end multitable\n"
"\n"))
@@ -56,8 +56,7 @@
"* LilyPond exported predicates::\n"
"@end menu\n"
"\n"
- (apply
- string-append
+ (string-concatenate
(map
(lambda (alist-nodename-list)
(apply document-type-predicate-category
diff --git a/scm/documentation-generate.scm b/scm/documentation-generate.scm
index cc4db2fb2d..d65d0edab7 100644
--- a/scm/documentation-generate.scm
+++ b/scm/documentation-generate.scm
@@ -29,16 +29,16 @@
(use-modules (scm accreg))
-(map ly:load '("documentation-lib.scm"
- "lily-sort.scm"
- "document-functions.scm"
- "document-translation.scm"
- "document-music.scm"
- "document-type-predicates.scm"
- "document-identifiers.scm"
- "document-context-mods.scm"
- "document-backend.scm"
- "document-markup.scm"))
+(for-each ly:load '("documentation-lib.scm"
+ "lily-sort.scm"
+ "document-functions.scm"
+ "document-translation.scm"
+ "document-music.scm"
+ "document-type-predicates.scm"
+ "document-identifiers.scm"
+ "document-context-mods.scm"
+ "document-backend.scm"
+ "document-markup.scm"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/scm/documentation-lib.scm b/scm/documentation-lib.scm
index 49a251720d..a098194586 100644
--- a/scm/documentation-lib.scm
+++ b/scm/documentation-lib.scm
@@ -52,8 +52,8 @@
(node-children node)))
""))
port)
- (map (lambda (x) (dump-node x port (+ 1 level)))
- (node-children node)))
+ (for-each (lambda (x) (dump-node x port (+ 1 level)))
+ (node-children node)))
(define (processing name)
(ly:basic-progress (_ "Processing ~S...") name))
@@ -101,7 +101,7 @@ string-to-use). If QUOTE? is #t, embed table in a @quotation environment."
"\n"
(if quote? "@quotation\n" "")
"@table @asis\n"
- (apply string-append (map one-item->texi items-alist))
+ (string-concatenate (map one-item->texi items-alist))
"\n"
"@end table\n"
(if quote? "@end quotation\n" "")))
@@ -113,14 +113,14 @@ string-to-use). If QUOTE? is #t, embed table in a @quotation environment."
(string-append
"\n@menu"
- (apply string-append
- (map (lambda (x)
- (string-append
- (string-pad-right
- (string-append "\n* " (car x) ":: ")
- (+ maxwid 8))
- (cdr x)))
- items-alist))
+ (string-concatenate
+ (map (lambda (x)
+ (string-append
+ (string-pad-right
+ (string-append "\n* " (car x) ":: ")
+ (+ maxwid 8))
+ (cdr x)))
+ items-alist))
"\n@end menu\n"
;; Menus don't appear in html, so we make a list ourselves
"\n@ignore\n"
diff --git a/scm/font.scm b/scm/font.scm
index 8753019fa7..45a54b5f8d 100644
--- a/scm/font.scm
+++ b/scm/font.scm
@@ -50,16 +50,16 @@
#:children (make-hash-table 11)))
(define-method (display (leaf <Font-tree-leaf>) port)
- (map (lambda (x) (display x port))
- (list
- "#<Font-size-family:\n"
- (slot-ref leaf 'default-size)
- (slot-ref leaf 'size-vector)
- "#>"
- )))
+ (for-each (lambda (x) (display x port))
+ (list
+ "#<Font-size-family:\n"
+ (slot-ref leaf 'default-size)
+ (slot-ref leaf 'size-vector)
+ "#>"
+ )))
(define-method (display (node <Font-tree-node>) port)
- (map
+ (for-each
(lambda (x)
(display x port))
(list
diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 3517f90ebb..d92affb11c 100644
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -109,15 +109,15 @@
(list (ly:font-name font))))
(let* ((fonts (ly:paper-fonts paper))
- (names (apply append (map extract-names fonts))))
- (apply string-append
- (map (lambda (f)
- (format #f
- (if load-fonts?
- "%%DocumentSuppliedResources: font ~a\n"
- "%%DocumentNeededResources: font ~a\n")
- f))
- (uniq-list (sort names string<?))))))
+ (names (append-map extract-names fonts)))
+ (string-concatenate
+ (map (lambda (f)
+ (format #f
+ (if load-fonts?
+ "%%DocumentSuppliedResources: font ~a\n"
+ "%%DocumentNeededResources: font ~a\n")
+ f))
+ (uniq-list (sort names string<?))))))
(define (eps-header paper bbox load-fonts?)
(string-append "%!PS-Adobe-2.0 EPSF-2.0\n"
@@ -359,7 +359,7 @@
(ly:font-sub-fonts font))))
fonts))
(font-names (uniq-list
- (sort (apply append all-font-names)
+ (sort (concatenate all-font-names)
(lambda (x y) (string<? (cadr x) (cadr y))))))
;; slightly spaghetti-ish: deciding what to load where
diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 22e5b67302..43b05e57c2 100644
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -535,10 +535,7 @@ For example:
(list elem)))
'() lst))
-(define-public (filtered-map proc lst)
- (filter
- (lambda (x) x)
- (map proc lst)))
+(define-public filtered-map filter-map)
(define-public (flatten-list x)
"Unnest list."
diff --git a/scm/lily.scm b/scm/lily.scm
index 0f711ed193..4a63be9908 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -841,11 +841,10 @@ messages into errors.")
(let* ((stat (gulp-file "/proc/self/status"))
(lines (string-split stat #\newline))
- (interesting (filter identity
- (map
- (lambda (l)
- (string-match "^VmData:[ \t]*([0-9]*) kB" l))
- lines)))
+ (interesting (filter-map
+ (lambda (l)
+ (string-match "^VmData:[ \t]*([0-9]*) kB" l))
+ lines))
(mem (string->number (match:substring (car interesting) 1))))
(format #t "VMDATA: ~a\n" mem)
(display (gc-stats))
@@ -898,12 +897,11 @@ PIDs or the number of the process."
(ly:exit 2 #t)))
(if (ly:get-option 'read-file-list)
(set! files
- (filter (lambda (s)
- (> (string-length s) 0))
- (apply append
- (map (lambda (f)
- (string-split (string-delete (ly:gulp-file f) #\cr) #\nl))
- files)))))
+ (remove string-null?
+ (append-map
+ (lambda (f)
+ (string-split (string-delete (ly:gulp-file f) #\cr) #\nl))
+ files))))
(if (and (number? (ly:get-option 'job-count))
(>= (length files) (ly:get-option 'job-count)))
(let* ((count (ly:get-option 'job-count))
diff --git a/scm/modal-transforms.scm b/scm/modal-transforms.scm
index 3db3904726..71892bde65 100644
--- a/scm/modal-transforms.scm
+++ b/scm/modal-transforms.scm
@@ -120,7 +120,7 @@ LilyPond scheme pitches, e.g. @code{(ly:make-pitch 0 2 0)}
(ly:music-set-property! music 'pitch (converter pitch)))
((pair? elements)
- (map (lambda (x) (change-pitches x converter)) elements))
+ (for-each (lambda (x) (change-pitches x converter)) elements))
((ly:music? element)
(change-pitches element converter)))))
@@ -206,7 +206,7 @@ Typically used to construct a scale for input to transposer-factory
(if (ly:dir? span-dir)
(ly:music-set-property! music 'span-direction (- span-dir)))
- (map retrograde-music reversed)
+ (for-each retrograde-music reversed)
music))
diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index fb29e73cd2..afcdb843e7 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -137,7 +137,7 @@ For instance,
(string-length "-markup")))))))
(define (transform-arg arg)
(cond ((and (pair? arg) (markup? (car arg))) ;; a markup list
- (apply append (map inner-markup->make-markup arg)))
+ (append-map inner-markup->make-markup arg))
((and (not (string? arg)) (markup? arg)) ;; a markup
(inner-markup->make-markup arg))
(else ;; scheme arg
@@ -164,12 +164,12 @@ equivalent to @var{obj}, that is, for a music expression, a
(ly:music? obj)
`(make-music
',(ly:music-property obj 'name)
- ,@(apply append (map (lambda (prop)
- `(',(car prop)
- ,(music->make-music (cdr prop))))
- (remove (lambda (prop)
- (eqv? (car prop) 'origin))
- (ly:music-mutable-properties obj))))))
+ ,@(append-map (lambda (prop)
+ `(',(car prop)
+ ,(music->make-music (cdr prop))))
+ (remove (lambda (prop)
+ (eqv? (car prop) 'origin))
+ (ly:music-mutable-properties obj)))))
(;; moment
(ly:moment? obj)
`(ly:make-moment ,(ly:moment-main-numerator obj)
@@ -1953,9 +1953,9 @@ base onto the following musical context."
(layout (ly:grob-layout root))
(blot (ly:output-def-lookup layout 'blot-diameter)))
;; Hide spanned stems
- (map (lambda (st)
- (set! (ly:grob-property st 'stencil) #f))
- stems)
+ (for-each (lambda (st)
+ (set! (ly:grob-property st 'stencil) #f))
+ stems)
;; Draw a nice looking stem with rounded corners
(ly:round-filled-box (ly:grob-extent root root X) yextent blot))
;; Nothing to connect, don't draw the span
@@ -1987,7 +1987,7 @@ other stems just because of that."
;; two stems at this musical moment
(if (<= 2 (length stems))
(let ((roots (filter stem-is-root? stems)))
- (map (make-stem-span! stems trans) roots))))
+ (for-each (make-stem-span! stems trans) roots))))
(define-public (Span_stem_engraver ctx)
"Connect cross-staff stems to the stems above in the system"
diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 33a03139de..dc88b4387a 100644
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -620,8 +620,8 @@ and duration-log @var{log}."
(define-public (color? x)
(and (list? x)
(= 3 (length x))
- (apply eq? #t (map number? x))
- (apply eq? #t (map (lambda (y) (<= 0 y 1)) x))))
+ (every number? x)
+ (every (lambda (y) (<= 0 y 1)) x)))
(define-public (rgb-color r g b) (list r g b))
diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index 1df5a53d70..cb9f598d3f 100644
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -40,14 +40,14 @@
;; Helper functions
(define-public (attributes attributes-alist)
- (apply string-append
- (map (lambda (x)
- (let ((attr (car x))
- (value (cdr x)))
- (if (number? value)
- (set! value (ly:format "~4f" value)))
- (format #f " ~s=\"~a\"" attr value)))
- attributes-alist)))
+ (string-concatenate
+ (map (lambda (x)
+ (let ((attr (car x))
+ (value (cdr x)))
+ (if (number? value)
+ (set! value (ly:format "~4f" value)))
+ (format #f " ~s=\"~a\"" attr value)))
+ attributes-alist)))
(define-public (eo entity . attributes-alist)
"o = open"
@@ -108,8 +108,8 @@
(integer->entity (char->integer char)))
(define (string->entities string)
- (apply string-append
- (map (lambda (x) (char->entity x)) (string->list string))))
+ (string-concatenate
+ (map char->entity (string->list string))))
(define svg-element-regexp
(make-regexp "^(<[a-z]+) ?(.*>)"))
@@ -552,7 +552,7 @@
`(stroke-linecap . ,(symbol->string cap-style))
'(stroke . "currentColor")
`(fill . ,(if fill? "currentColor" "none"))
- `(d . ,(apply string-append (convert-path-exps commands))))))
+ `(d . ,(string-concatenate (convert-path-exps commands))))))
(define (placebox x y expr)
(if (string-null? expr)
diff --git a/scm/page.scm b/scm/page.scm
index 428b95c87b..f6bb29d701 100644
--- a/scm/page.scm
+++ b/scm/page.scm
@@ -291,7 +291,7 @@
(append (cdr lines) (list #f)))
(paper-system-annotate-last (car (last-pair lines)) layout)))
- (map add-system lines)
+ (for-each add-system lines)
(ly:prob-set-property! page 'bottom-system-edge
diff --git a/scm/parser-clef.scm b/scm/parser-clef.scm
index 719cc4ce50..6ba1261ca7 100644
--- a/scm/parser-clef.scm
+++ b/scm/parser-clef.scm
@@ -119,7 +119,7 @@
"Generate the clef setting commands for a clef with name @var{clef-name}."
(define (make-prop-set props)
(let ((m (make-music 'PropertySet)))
- (map (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props)
+ (for-each (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props)
m))
(let ((e '())
(c0 0)
diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm
index dadce94863..4e3e4b6603 100644
--- a/scm/part-combiner.scm
+++ b/scm/part-combiner.scm
@@ -275,9 +275,9 @@ LilyPond version 2.8 and earlier."
(define (analyse-forced-combine result-idx prev-res)
(define (get-forced-event x)
- (if (ly:in-event-class? x 'part-combine-force-event)
- (cons (ly:event-property x 'forced-type) (ly:event-property x 'once))
- #f))
+ (and (ly:in-event-class? x 'part-combine-force-event)
+ (cons (ly:event-property x 'forced-type)
+ (ly:event-property x 'once))))
(define (part-combine-events vs)
(if (not vs)
'()
@@ -338,7 +338,7 @@ Only set if not set previously.
(prev (configuration prev-ss)))
(if (symbol? prev)
(put prev))))
- (map copy-one-state (span-state vs)))
+ (for-each copy-one-state (span-state vs)))
(define (analyse-notes now-state)
(let* ((vs1 (car (voice-states now-state)))
diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm
index 34887b0aec..948e56e145 100644
--- a/scm/ps-to-png.scm
+++ b/scm/ps-to-png.scm
@@ -167,7 +167,7 @@
(if (not (= 0 status))
(begin
- (map delete-file files)
+ (for-each delete-file files)
(exit 1)))
(if (and rename-page-1 multi-page?)
diff --git a/scm/safe-lily.scm b/scm/safe-lily.scm
index cfc088c8b3..25209e5a0b 100644
--- a/scm/safe-lily.scm
+++ b/scm/safe-lily.scm
@@ -15,7 +15,7 @@
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-(map
+(for-each
(lambda (sym)
(set! safe-objects (cons (cons sym (primitive-eval sym))
safe-objects)))
diff --git a/scm/song-util.scm b/scm/song-util.scm
index c0c226d7c2..31cb1e8d48 100644
--- a/scm/song-util.scm
+++ b/scm/song-util.scm
@@ -80,12 +80,11 @@
((record-constructor ,record) ,@(map car slots*))))
(set! ,$copy-record
(lambda (record)
- (,$make-record ,@(apply
- append
- (map (lambda (slot)
- (list (symbol->keyword slot)
- (list (make-symbol reader-format slot) 'record)))
- (map car slots*))))))
+ (,$make-record ,@(append-map
+ (lambda (slot)
+ (list (symbol->keyword slot)
+ (list (make-symbol reader-format slot) 'record)))
+ (map car slots*)))))
,@(map (lambda (s)
`(set! ,(make-symbol reader-format (car s))
(record-accessor ,record (quote ,(car s)))))
diff --git a/scm/stencil.scm b/scm/stencil.scm
index 65852fc305..0833382b61 100644
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -246,16 +246,16 @@ the partial ellipse until 7*PI/2. For example, in pseudo-code:
\n((0.0 . 2) (PI/2 . 3) (PI . -2) (3*PI/2 . -3)\
\n(2*PI . 2) (5*PI/2 . 3) (3*PI . -2) (7*PI/2 . -3))
"
- (apply append
- (map (lambda (adder)
- (map (lambda (quadrant)
- (cons (+ adder (car quadrant))
- (cdr quadrant)))
- `((0.0 . (,x-radius . 0.0))
- (,PI-OVER-TWO . (0.0 . ,y-radius))
- (,PI . (,(- x-radius) . 0.0))
- (,THREE-PI-OVER-TWO . (0.0 . ,(- y-radius))))))
- `(0.0 ,TWO-PI))))
+ (append-map
+ (lambda (adder)
+ (map (lambda (quadrant)
+ (cons (+ adder (car quadrant))
+ (cdr quadrant)))
+ `((0.0 . (,x-radius . 0.0))
+ (,PI-OVER-TWO . (0.0 . ,y-radius))
+ (,PI . (,(- x-radius) . 0.0))
+ (,THREE-PI-OVER-TWO . (0.0 . ,(- y-radius))))))
+ `(0.0 ,TWO-PI)))
(define
(insert-in-ordered-list ordering-function value inlist cutl? cutr?)
@@ -304,7 +304,7 @@ then reduce using @var{min-max}:
"
(reduce min-max
(if (eq? min-max min) 100000 -100000)
- (map (lambda (x) (side x)) l)))
+ (map side l)))
(let*
(;; the outside limit of the x-radius
@@ -647,12 +647,12 @@ with optional arrows of @code{max-size} on start and end controlled by
(null (cons 0 0))
(arrow-1
(ly:make-stencil
- `(polygon (quote ,(concatenate (map complex-to-offset p1s)))
+ `(polygon (quote ,(append-map complex-to-offset p1s))
0.0
#t) null null))
(arrow-2
(ly:make-stencil
- `(polygon (quote ,(concatenate (map complex-to-offset p2s)))
+ `(polygon (quote ,(append-map complex-to-offset p2s))
0.0
#t) null null ) )
(thickness (min (/ distance 12) 0.1))
diff --git a/scm/tablature.scm b/scm/tablature.scm
index d62f0aa017..e32d712e19 100644
--- a/scm/tablature.scm
+++ b/scm/tablature.scm
@@ -376,7 +376,7 @@
(elt (ly:music-property mus 'element)))
(cond
((pair? elts)
- (map make-harmonic elts))
+ (for-each make-harmonic elts))
((ly:music? elt)
(make-harmonic elt))
((music-is-of-type? mus 'note-event)
diff --git a/scm/time-signature-settings.scm b/scm/time-signature-settings.scm
index e2102e759e..82e22fe591 100644
--- a/scm/time-signature-settings.scm
+++ b/scm/time-signature-settings.scm
@@ -381,8 +381,8 @@ a fresh copy of the list-head is made."
;; Normalize to given beat, extract the beats and join them to one list
(let* ((beat (calculate-compound-base-beat-full time-sig))
(normalized (map (lambda (f) (normalize-fraction f beat)) time-sig))
- (beats (map (lambda (f) (reverse (cdr (reverse f)))) normalized)))
- (apply append beats)))
+ (beats (map (lambda (f) (drop-right f 1)) normalized)))
+ (concatenate beats)))
(define-public (calculate-compound-beat-grouping time-sig)
(cond
diff --git a/scm/to-xml.scm b/scm/to-xml.scm
index 8b33cbaccc..2407fe3766 100644
--- a/scm/to-xml.scm
+++ b/scm/to-xml.scm
@@ -70,7 +70,7 @@ is then separated.
(if (equal? (node-value node) "")
(string-append
(if xml-name "\n" "")
- (apply string-append (map musicxml-node->string (node-children node))))
+ (string-concatenate (map musicxml-node->string (node-children node))))
(node-value node))
(if xml-name (close-tag xml-name) "")
(if xml-name "\n" ""))))
@@ -80,8 +80,7 @@ is then separated.
"\n"
(open-tag (node-name node) (node-attributes node) '())
(if (equal? (node-value node) "")
- (string-append
- (apply string-append (map xml-node->string (node-children node))))
+ (string-concatenate (map xml-node->string (node-children node)))
(node-value node))
"\n"
(close-tag (node-name node))))
@@ -224,7 +223,7 @@ is then separated.
(string-append
"<" (symbol->string tag)
- (apply string-append (map dump-attr (filter candidate? attrs)))
+ (string-concatenate (map dump-attr (filter candidate? attrs)))
">"))
(define (close-tag name)
diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm
index 823668830a..9bc12cc53c 100644
--- a/scm/translation-functions.scm
+++ b/scm/translation-functions.scm
@@ -321,14 +321,14 @@ along with @var{minimum-fret}, @var{maximum-stretch}, and
if no fingering is present."
(let* ((articulations (ly:event-property ev 'articulations))
(finger-found #f))
- (map (lambda (art)
- (let* ((num (ly:event-property art 'digit)))
-
- (if (and (ly:in-event-class? art 'fingering-event)
- (number? num)
- (> num 0))
- (set! finger-found num))))
- articulations)
+ (for-each (lambda (art)
+ (let* ((num (ly:event-property art 'digit)))
+
+ (if (and (ly:in-event-class? art 'fingering-event)
+ (number? num)
+ (> num 0))
+ (set! finger-found num))))
+ articulations)
finger-found))
(define (delete-free-string string)