parser.yy: make Scheme and music expressions equivalent as function arguments.

diff --git a/lily/lexer.ll b/lily/lexer.ll
index 86375177cf125019f7eb086397f71eb3abd12f1c..01701b63f029d59cd9343225627f38a4a692bf8d 100644 (file)
--- a/lily/lexer.ll
+++ b/lily/lexer.ll
@@ -833,9 +833,7 @@ Lily_lexer::scan_escaped_word (string str)
                                cs = SCM_CAR (cs);
                        }
                        
-                       if (cs == ly_music_p_proc)
-                               push_extra_token (EXPECT_MUSIC);
-                       else if (cs == Pitch_type_p_proc)
+                       if (cs == Pitch_type_p_proc)
                                push_extra_token (EXPECT_PITCH);
                        else if (cs == Duration_type_p_proc)
                                push_extra_token (EXPECT_DURATION);

diff --git a/lily/parser.yy b/lily/parser.yy
index 756179233a9b4950dd2c9c78e24485bd753b82dd..f2ef9b0cb54f33892be60971ca930bbad9d4d3b3 100644 (file)
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -179,6 +179,7 @@ SCM get_first_context_id (SCM type, Music *m);
 SCM make_chord_elements (SCM pitch, SCM dur, SCM modification_list);
 SCM make_chord_step (int step, Rational alter);
 SCM make_simple_markup (SCM a);
+SCM try_unpack_lyrics (SCM pred, SCM arg);
 bool is_duration (int t);
 bool is_regular_identifier (SCM id);
 bool ly_input_procedure_p (SCM x);
@@ -292,7 +293,6 @@ If we give names, Bison complains.
 
 /* Artificial tokens, for more generic function syntax */
 %token <i> EXPECT_MARKUP "markup?"
-%token <i> EXPECT_MUSIC "ly:music?"
 %token <i> EXPECT_PITCH "ly:pitch?"
 %token <i> EXPECT_DURATION "ly:duration?"
 %token <scm> EXPECT_SCM "scheme?"
@@ -592,7 +592,8 @@ embedded_scm_bare:
 
 embedded_scm_bare_arg:
        embedded_scm_bare
-       | simple_string
+       | STRING
+       | STRING_IDENTIFIER
        | full_markup
        | full_markup_list
        | context_modification
@@ -629,6 +630,7 @@ embedded_scm:
 embedded_scm_arg:
        embedded_scm_bare_arg
        | scm_function_call
+       | music
        ;
 
 scm_function_call:
@@ -1188,29 +1190,27 @@ grouped_music_list:
        | sequential_music              { $$ = $1; }
        ;
 
-/* An argument list. If a function \foo expects scm scm music, then the lexer expands \foo into the token sequence:
- MUSIC_FUNCTION EXPECT_MUSIC EXPECT_SCM EXPECT_SCM EXPECT_NO_MORE_ARGS
+/* An argument list. If a function \foo expects scm scm pitch, then the lexer expands \foo into the token sequence:
+ MUSIC_FUNCTION EXPECT_PITCH EXPECT_SCM EXPECT_SCM EXPECT_NO_MORE_ARGS
 and this rule returns the reversed list of arguments. */
 
 
 function_arglist:
        function_arglist_bare
-       | EXPECT_MUSIC function_arglist_optional music
+       | EXPECT_SCM function_arglist_optional embedded_scm_arg
        {
-               $$ = scm_cons ($3, $2);
+               $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED,
+                                      $3, $2, $1);
        }
-       | EXPECT_SCM function_arglist_optional embedded_scm_arg
+       | EXPECT_SCM function_arglist_optional SKIPPED_SCM
        {
-               $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED, $3, $2, $1);
+               $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED,
+                                      $3, $2, $1);
        }
        ;
 
 function_arglist_optional:
        function_arglist_keep %prec FUNCTION_ARGUMENTS
-       | EXPECT_OPTIONAL EXPECT_MUSIC function_arglist_optional
-       {
-               $$ = scm_cons (loc_on_music (@3, $1), $3);
-       }
        | EXPECT_OPTIONAL EXPECT_PITCH function_arglist_optional
        {
                $$ = scm_cons ($1, $3);
@@ -1232,42 +1232,41 @@ function_arglist_keep:
        | EXPECT_OPTIONAL EXPECT_DURATION function_arglist_closed_keep duration_length {
                $$ = scm_cons ($4, $3);
        }
-       | EXPECT_OPTIONAL EXPECT_MUSIC function_arglist_keep closed_music
-       {
-               $$ = scm_cons ($4, $3);
-       }
-       | function_arglist
        | EXPECT_OPTIONAL EXPECT_SCM function_arglist_keep embedded_scm_arg_closed
        {
                if (scm_is_true (scm_call_1 ($2, $4)))
                {
                        $$ = scm_cons ($4, $3);
                } else {
-                       $$ = scm_cons (loc_on_music (@3, $1), $3);
-                       MYBACKUP (SKIPPED_SCM, $4, @4);
+                       $$ = try_unpack_lyrics ($2, $4);
+                       if (!SCM_UNBNDP ($$))
+                               $$ = scm_cons ($$, $3);
+                       else {
+                               $$ = scm_cons (loc_on_music (@3, $1), $3);
+                               MYBACKUP (SKIPPED_SCM, $4, @4);
+                       }
                }
        }
+       | function_arglist
        ;
 
 
 function_arglist_closed:
        function_arglist_bare
-       | EXPECT_MUSIC function_arglist_optional closed_music
+       | EXPECT_SCM function_arglist_optional embedded_scm_arg_closed
        {
-               $$ = scm_cons ($3, $2);
+               $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED,
+                                      $3, $2, $1);
        }
-       | EXPECT_SCM function_arglist_optional embedded_scm_arg_closed
+       | EXPECT_SCM function_arglist_optional SKIPPED_SCM
        {
-               $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED, $3, $2, $1);
+               $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED,
+                                      $3, $2, $1);
        }
        ;
 
 function_arglist_closed_optional:
        function_arglist_closed_keep %prec FUNCTION_ARGUMENTS
-       | EXPECT_OPTIONAL EXPECT_MUSIC function_arglist_closed_optional
-       {
-               $$ = scm_cons (loc_on_music (@3, $1), $3);
-       }
        | EXPECT_OPTIONAL EXPECT_PITCH function_arglist_closed_optional
        {
                $$ = scm_cons ($1, $3);
@@ -1289,18 +1288,19 @@ function_arglist_closed_keep:
        | EXPECT_OPTIONAL EXPECT_DURATION function_arglist_closed_keep duration_length {
                $$ = scm_cons ($4, $3);
        }
-       | EXPECT_OPTIONAL EXPECT_MUSIC function_arglist_keep closed_music
-       {
-               $$ = scm_cons ($4, $3);
-       }
        | EXPECT_OPTIONAL EXPECT_SCM function_arglist_keep embedded_scm_arg_closed
        {
                if (scm_is_true (scm_call_1 ($2, $4)))
                {
                        $$ = scm_cons ($4, $3);
                } else {
-                       $$ = scm_cons (loc_on_music (@3, $1), $3);
-                       MYBACKUP (SKIPPED_SCM, $4, @4);
+                       $$ = try_unpack_lyrics ($2, $4);
+                       if (!SCM_UNBNDP ($$))
+                               $$ = scm_cons ($$, $3);
+                       else {
+                               $$ = scm_cons (loc_on_music (@3, $1), $3);
+                               MYBACKUP (SKIPPED_SCM, $4, @4);
+                       }
                }
        }
        | function_arglist_closed
@@ -1314,6 +1314,7 @@ embedded_scm_closed:
 embedded_scm_arg_closed:
        embedded_scm_bare_arg
        | scm_function_call_closed
+       | closed_music
        ;
 
 scm_function_call_closed:
@@ -1333,10 +1334,6 @@ function_arglist_bare:
        | EXPECT_DURATION function_arglist_closed_optional duration_length {
                $$ = scm_cons ($3, $2);
        }
-       | EXPECT_SCM function_arglist_optional SKIPPED_SCM
-       {
-               $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED, $3, $2, $1);
-       }
        ;
 
 music_function_call:
@@ -1797,11 +1794,10 @@ chord_body_element:
 
 music_function_chord_body_arglist:
        function_arglist_bare
-       | EXPECT_MUSIC music_function_chord_body_arglist chord_body_element {
-               $$ = scm_cons ($3, $2);
-       }
-       | EXPECT_SCM function_arglist_optional embedded_scm_chord_body {
-               $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED, $3, $2, $1);
+       | EXPECT_SCM music_function_chord_body_arglist embedded_scm_chord_body
+       {
+               $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED,
+                                      $3, $2, $1);
        }
        ;
 
@@ -1811,6 +1807,8 @@ embedded_scm_chord_body:
                $$ = MAKE_SYNTAX ("music-function", @$,
                                         $1, $2);
        }
+       | chord_body_element
+       | SKIPPED_SCM
        ;
 
 music_function_chord_body:
@@ -1827,11 +1825,10 @@ music_function_chord_body:
  */
 music_function_event_arglist:
        function_arglist_bare
-       | EXPECT_MUSIC music_function_event_arglist post_event {
-               $$ = scm_cons ($3, $2);
-       }
-       | EXPECT_SCM function_arglist_optional embedded_scm_event {
-               $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED, $3, $2, $1);
+       | EXPECT_SCM music_function_event_arglist embedded_scm_event
+       {
+               $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED,
+                                      $3, $2, $1);
        }
        ;
 
@@ -1841,6 +1838,8 @@ embedded_scm_event:
                $$ = MAKE_SYNTAX ("music-function", @$,
                                         $1, $2);
        }
+       | post_event
+       | SKIPPED_SCM
        ;
 
 music_function_event:
@@ -2902,24 +2901,26 @@ get_next_unique_lyrics_context_id ()
        return scm_from_locale_string (s);
 }
 
-
-SCM check_scheme_arg (Lily_parser *parser, Input loc, SCM fallback,
+SCM check_scheme_arg (Lily_parser *my_lily_parser, Input loc, SCM fallback,
                      SCM arg, SCM args, SCM pred)
 {
-       SCM type_check_arg = ly_lily_module_constant ("type-check-arg");
-       if (scm_is_false (scm_call_4 (type_check_arg, make_input (loc),
-                                     arg, args, pred)))
-       {
-               if (SCM_UNBNDP (fallback))
-                       fallback = SCM_BOOL_F;
-               else
-                       fallback = loc_on_music (loc, fallback);
-                       
-               parser->error_level_ = 1;
-
-               return scm_cons (fallback, args);
-       }
-       return scm_cons (arg, args);
+       SCM unwrap = SCM_UNDEFINED;
+       if (scm_is_true (scm_call_1 (pred, arg)))
+               return scm_cons (arg, args);
+       unwrap = try_unpack_lyrics (pred, arg);
+       if (!SCM_UNBNDP (unwrap))
+               return scm_cons (unwrap, args);
+       if (SCM_UNBNDP (fallback)) {
+               args = scm_cons (SCM_BOOL_F, args);
+               fallback = SCM_BOOL_F;
+       } else {
+               args = scm_cons (loc_on_music (loc, fallback), args);
+               fallback = SCM_CDR (scm_last_pair (args));
+       }
+       scm_set_cdr_x (scm_last_pair (args), SCM_EOL);
+       MAKE_SYNTAX ("argument-error", loc, scm_length (args), pred, arg);
+       scm_set_cdr_x (scm_last_pair (args), fallback);
+       return args;
 }
 
 SCM loc_on_music (Input loc, SCM arg)
@@ -3013,6 +3014,17 @@ make_chord_elements (SCM pitch, SCM dur, SCM modification_list)
        return scm_call_3 (chord_ctor, pitch, dur, modification_list);
 }
 
+SCM
+try_unpack_lyrics (SCM pred, SCM arg)
+{
+       if (Music *m = unsmob_music (arg))
+               if (m->is_mus_type ("lyric-event")) {
+                       SCM text = m->get_property ("text");
+                       if (scm_is_true (scm_call_1 (pred, text)))
+                                       return text;
+                       }
+       return SCM_UNDEFINED;
+}      
 
 /* Todo: actually also use apply iso. call too ...  */
 bool

diff --git a/scm/lily.scm b/scm/lily.scm
index 24710c9e0c3e48161de2b7aea4c0dc63cc3f3c14..90df1f6a098b0ebe4eb4d1b9d652f937e901a7fc 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -344,18 +344,6 @@ messages into errors.")
                      (fresh-interface!))))
       (set-module-obarray! iface (module-obarray mod))))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (type-check-arg location arg args pred?)
-  "Typecheck an argument after previous arguments.
-Print a message at LOCATION if predicate fails and return #f"
-  (or (pred? arg)
-      (begin
-       (ly:input-warning
-        location
-        (_ "wrong type for argument ~a.  Expecting ~a, found ~s")
-        (1+ (length args)) (type-name pred?) arg)
-       #f)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Safe definitions utility
 

diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm
index ebd0a605a0c37b1cf1844e84b55d059354ecee31..841ad92e97f203717bfaf9181b9795f0546cc1b2 100644 (file)
--- a/scm/ly-syntax-constructors.scm
+++ b/scm/ly-syntax-constructors.scm
@@ -44,22 +44,37 @@
 
 ;; Music function: Apply function and check return value.
 ;; args are in reverse order, rest may specify additional ones
+;;
+;; If args is not a proper list, an error has been flagged earlier
+;; and no fallback value had been available.  In this case,
+;; we don't call the function but rather return the general
+;; fallback.
 (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)
+        (good (proper-list? args))
+        (m (and good (apply fun parser loc (reverse! args rest)))))
+    (if (and good (pred m))
        (begin
          (if (ly:music? m)
              (set! (ly:music-property m 'origin) loc))
          m)
        (begin
-         (ly:parser-error parser
-                          (format #f (_ "~a function cannot return ~a")
-                                  (type-name pred) m)
-                          loc)
+         (if good
+             (ly:parser-error parser
+                              (format #f (_ "~a function cannot return ~a")
+                                      (type-name pred) m)
+                              loc))
          (and (pair? (car sig)) (cdar sig))))))
 
+(define-ly-syntax (argument-error parser location n pred arg)
+  (ly:parser-error
+   parser
+   (format #f
+          (_ "wrong type for argument ~a.  Expecting ~a, found ~s")
+          n (type-name pred) arg)
+   location))
+
 (define-ly-syntax-simple (void-music)
   (make-music 'Music))
 

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index bfec250992e5c9c7910e496a7f40823a48fadd6e..a25deb60e4c958501795e922dbe18c7f3d8b5c69 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -856,7 +856,7 @@ void return value (i.e., what most Guile functions with `unspecified'
 value return).  Use this when defining functions for executing actions
 rather than returning values, to keep Lilypond from trying to interpret
 the return value."
-  `(define-syntax-function void? ,@rest #f (begin)))
+  `(define-syntax-function (void? (begin)) ,@rest #f (begin)))
 
 (defmacro-public define-event-function rest
   "Defining macro returning event functions.