From b579529b5f3f89a5b8a17760bb199b0eacc671be Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Thu, 9 Jul 2015 14:54:14 +0200 Subject: [PATCH] Issue 4487/2: Allow for chaining of several partial functions in a row Chaining only works when all function calls except the last one have all arguments supplied already, with their last argument being the rest of the chained call. --- input/regression/music-function-incomplete.ly | 15 +++++++ lily/parser.yy | 45 ++++++++++++++++--- scm/ly-syntax-constructors.scm | 38 +++++++++++++--- 3 files changed, 85 insertions(+), 13 deletions(-) create mode 100644 input/regression/music-function-incomplete.ly diff --git a/input/regression/music-function-incomplete.ly b/input/regression/music-function-incomplete.ly new file mode 100644 index 0000000000..24c2b56550 --- /dev/null +++ b/input/regression/music-function-incomplete.ly @@ -0,0 +1,15 @@ +\version "2.19.24" + +\header { + texidoc = "For defining a music function, one can supply one or + several music function calls chained together, cutting the last + call short using @code{\\etc}. The remaining arguments are + supplied when calling the music function defined in this manner." +} + +\layout { ragged-right = ##t } + +highlight = \tweak font-size 3 \tweak color #red \etc +mode = \key c \etc + +{ c' \highlight d' e'-\highlight -! \mode \minor c'' } diff --git a/lily/parser.yy b/lily/parser.yy index 581791d256..e8fb1b9383 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -695,23 +695,56 @@ identifier_init_nonumber: | full_markup_list | context_modification | partial_function ETC + { + $$ = MAKE_SYNTAX (partial_music_function, @$, + scm_reverse_x (scm_car ($1), SCM_EOL), + scm_reverse_x (scm_cdr ($1), SCM_EOL)); + } ; +// Partial functions partial_function: MUSIC_FUNCTION function_arglist_partial { - $$ = MAKE_SYNTAX (partial_music_function, @$, - $1, $2); + $$ = scm_cons (scm_list_1 ($1), scm_list_1 ($2)); } | EVENT_FUNCTION function_arglist_partial { - $$ = MAKE_SYNTAX (partial_music_function, @$, - $1, $2); + $$ = scm_cons (scm_list_1 ($1), scm_list_1 ($2)); } | SCM_FUNCTION function_arglist_partial { - $$ = MAKE_SYNTAX (partial_music_function, @$, - $1, $2); + $$ = scm_cons (scm_list_1 ($1), scm_list_1 ($2)); + } + | MUSIC_FUNCTION EXPECT_SCM function_arglist_optional partial_function + { + $$ = scm_cons (scm_cons ($1, scm_car ($4)), + scm_cons ($3, scm_cdr ($4))); + } + | EVENT_FUNCTION EXPECT_SCM function_arglist_optional partial_function + { + $$ = scm_cons (scm_cons ($1, scm_car ($4)), + scm_cons ($3, scm_cdr ($4))); + } + | SCM_FUNCTION EXPECT_SCM function_arglist_optional partial_function + { + $$ = scm_cons (scm_cons ($1, scm_car ($4)), + scm_cons ($3, scm_cdr ($4))); + } + | MUSIC_FUNCTION EXPECT_OPTIONAL EXPECT_SCM function_arglist_nonbackup partial_function + { + $$ = scm_cons (scm_cons ($1, scm_car ($5)), + scm_cons ($4, scm_cdr ($5))); + } + | EVENT_FUNCTION EXPECT_OPTIONAL EXPECT_SCM function_arglist_nonbackup partial_function + { + $$ = scm_cons (scm_cons ($1, scm_car ($5)), + scm_cons ($4, scm_cdr ($5))); + } + | SCM_FUNCTION EXPECT_OPTIONAL EXPECT_SCM function_arglist_nonbackup partial_function + { + $$ = scm_cons (scm_cons ($1, scm_car ($5)), + scm_cons ($4, scm_cdr ($5))); } ; diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm index b53e0cb34e..b617f72764 100644 --- a/scm/ly-syntax-constructors.scm +++ b/scm/ly-syntax-constructors.scm @@ -60,15 +60,39 @@ n (type-name pred) (music->make-music arg)) (*location*))) -(define-public (partial-music-function fun args) - (let* ((sig (ly:music-function-signature fun)) - (args (and (list args) (reverse! args)))) - (and args +;; Used for chaining several music functions together. `final' +;; contains the last argument and still needs typechecking. +(define (music-function-chain fun args final) + (let* ((siglast (last (ly:music-function-signature fun))) + (pred? (if (pair? siglast) (car siglast) siglast))) + (if (pred? final) + (music-function fun (cons final args)) + (begin + (argument-error (1+ (length args)) pred? final) + ;; call music function just for the error return value + (music-function fun #f))))) + +(define-public (partial-music-function fun-list arg-list) + (let* ((good (every list? arg-list)) + (sig (ly:music-function-signature (car fun-list)))) + (and good (ly:make-music-function - (cons (car sig) (list-tail (cdr sig) (length args))) + (cons (car sig) (list-tail (cdr sig) (length (car arg-list)))) (lambda rest - (apply (ly:music-function-extract fun) - (append args rest))))))) + ;; Every time we use music-function, it destructively + ;; reverses its list of arguments. Changing the calling + ;; convention would be non-trivial since we do error + ;; propagation to the reversed argument list by making it + ;; a non-proper list. So we just create a fresh copy of + ;; all argument lists for each call. We also want to + ;; avoid reusing any music expressions without copying and + ;; want to let them point to the location of the music + ;; function call rather than its definition. + (let ((arg-list (ly:music-deep-copy arg-list (*location*)))) + (fold music-function-chain + (music-function (car fun-list) + (reverse! rest (car arg-list))) + (cdr fun-list) (cdr arg-list)))))))) (define-public (void-music) (ly:set-origin! (make-music 'Music))) -- 2.39.2