]> git.donarmstrong.com Git - lilypond.git/commitdiff
Issue 4487/2: Allow for chaining of several partial functions in a row
authorDavid Kastrup <dak@gnu.org>
Thu, 9 Jul 2015 12:54:14 +0000 (14:54 +0200)
committerDavid Kastrup <dak@gnu.org>
Sat, 18 Jul 2015 04:42:12 +0000 (06:42 +0200)
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 [new file with mode: 0644]
lily/parser.yy
scm/ly-syntax-constructors.scm

diff --git a/input/regression/music-function-incomplete.ly b/input/regression/music-function-incomplete.ly
new file mode 100644 (file)
index 0000000..24c2b56
--- /dev/null
@@ -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'' }
index 581791d256badd07139b44758f2ed9fedb4e4a1a..e8fb1b9383d028c580082cb2fcbfa8870e9a4bd7 100644 (file)
@@ -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)));
        }
        ;
 
index b53e0cb34e0a2bb479847e51ca553b5f5cabafb8..b617f72764eaa5a44e1af6414a5db2eea63a8116 100644 (file)
            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)))