From: David Kastrup 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/lilypond.git?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 alistgrob-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)) - identifieralist (current-module)) + identifieralist (current-module)) - identifieralist (current-module)) + identifiernames (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-citexi 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 ) port) - (map (lambda (x) (display x port)) - (list - "#" - ))) + (for-each (lambda (x) (display x port)) + (list + "#" + ))) (define-method (display (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 stringnumber (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 . -(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)