From 69f0ae1e5ecfb627aec832a7f7a03382b7981d95 Mon Sep 17 00:00:00 2001
From: David Kastrup <dak@gnu.org>
Date: Sat, 15 Oct 2011 14:13:06 +0200
Subject: [PATCH] parser.yy et al: move functionality of run_music_function
 into syntax constructor

---
 lily/parser.yy                 | 37 ++++++++--------------------------
 scm/ly-syntax-constructors.scm |  9 ++++++---
 2 files changed, 14 insertions(+), 32 deletions(-)

diff --git a/lily/parser.yy b/lily/parser.yy
index 8a5cf3c322..670e1a82fa 100644
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -156,7 +156,6 @@ SCM get_next_unique_lyrics_context_id ();
 
 
 static Music *make_music_with_input (SCM name, Input where);
-SCM run_music_function (Lily_parser *parser, Input loc, SCM func, SCM args);
 SCM check_scheme_arg (Lily_parser *parser, Input loc, SCM fallback,
 		      SCM arg, SCM args, SCM pred);
 SCM loc_on_music (Input loc, SCM arg);
@@ -578,7 +577,7 @@ embedded_scm:
 
 scm_function_call:
 	SCM_FUNCTION function_arglist {
-		$$ = run_music_function (PARSER, @$,
+		$$ = MAKE_SYNTAX ("music-function", @$,
 					 $1, $2);
 	}
 	;
@@ -1266,7 +1265,7 @@ embedded_scm_closed:
 
 scm_function_call_closed:
 	SCM_FUNCTION function_arglist_closed {
-		$$ = run_music_function (PARSER, @$,
+		$$ = MAKE_SYNTAX ("music-function", @$,
 					 $1, $2);
 	}
 	;
@@ -1294,7 +1293,7 @@ function_arglist_bare:
 
 music_function_call:
 	MUSIC_FUNCTION function_arglist {
-		$$ = run_music_function (PARSER, @$,
+		$$ = MAKE_SYNTAX ("music-function", @$,
 					 $1, $2);
 	}
 	;
@@ -1755,14 +1754,14 @@ music_function_chord_body_arglist:
 embedded_scm_chord_body:
 	embedded_scm_bare
 	| SCM_FUNCTION music_function_chord_body_arglist {
-		$$ = run_music_function (PARSER, @$,
+		$$ = MAKE_SYNTAX ("music-function", @$,
 					 $1, $2);
 	}
 	;
 
 music_function_chord_body:
 	MUSIC_FUNCTION music_function_chord_body_arglist {
-		$$ = run_music_function (PARSER, @$,
+		$$ = MAKE_SYNTAX ("music-function", @$,
 					 $1, $2);
 	}
 	;
@@ -1785,21 +1784,21 @@ music_function_event_arglist:
 embedded_scm_event:
 	embedded_scm_bare
 	| SCM_FUNCTION music_function_event_arglist {
-		$$ = run_music_function (PARSER, @$,
+		$$ = MAKE_SYNTAX ("music-function", @$,
 					 $1, $2);
 	}
 	;
 
 music_function_event:
 	MUSIC_FUNCTION music_function_event_arglist {
-		$$ = run_music_function (PARSER, @$,
+		$$ = MAKE_SYNTAX ("music-function", @$,
 					 $1, $2);
 	}
 	;
 
 event_function_event:
 	EVENT_FUNCTION music_function_event_arglist {
-		$$ = run_music_function (PARSER, @$,
+		$$ = MAKE_SYNTAX ("music-function", @$,
 					 $1, $2);
 	}
 	;
@@ -2850,26 +2849,6 @@ get_next_unique_lyrics_context_id ()
 }
 
 
-SCM
-run_music_function (Lily_parser *parser, Input loc, SCM func, SCM args)
-{
-	SCM sig = scm_object_property (func, ly_symbol2scm ("music-function-signature"));
-
-	args = scm_reverse_x (args, SCM_EOL);
-
-	SCM fallback = SCM_BOOL_F;
-	SCM pred = scm_car (sig);
-
-	if (scm_is_pair (pred))
-	{
-		fallback = loc_on_music (loc, scm_cdr (pred));
-		pred = scm_car (pred);
-	}
-
-	SCM syntax_args = scm_list_n (parser->self_scm (), make_input (loc), pred, fallback, func, args, SCM_UNDEFINED);
-	return LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant ("music-function"), syntax_args);
-}
-
 SCM check_scheme_arg (Lily_parser *parser, Input loc, SCM fallback,
 		      SCM arg, SCM args, SCM pred)
 {
diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm
index c57917316b..f7f89cd0e1 100644
--- a/scm/ly-syntax-constructors.scm
+++ b/scm/ly-syntax-constructors.scm
@@ -43,8 +43,11 @@
        m)))
 
 ;; Music function: Apply function and check return value.
-(define-ly-syntax (music-function parser loc pred default fun args)
-  (let ((m (apply fun parser loc args)))
+;; args are in reverse order, rest may specify additional ones
+(define-ly-syntax (music-function parser loc fun args . rest)
+  (let* ((sig (object-property fun 'music-function-signature))
+	 (pred (if (pair? (car sig)) (caar sig) (car sig)))
+	 (m (apply fun parser loc (reverse! args rest))))
     (if (pred m)
 	(begin
 	  (if (ly:music? m)
@@ -55,7 +58,7 @@
 			   (format #f (_ "~a function cannot return ~a")
 				   (type-name pred) m)
 			   loc)
-	  default))))
+	  (and (pair? (car sig)) (cdar sig))))))
 
 (define-ly-syntax-simple (void-music)
   (make-music 'Music))
-- 
2.39.5