lexer.ll: Introduce Scheme functions

diff --git a/lily/lexer.ll b/lily/lexer.ll
index 708825279384502b81c47e8b56f092a820762692..c9c3c88ed89cfa9ce9ec2cd3b56a7d24396cb53c 100644 (file)
--- a/lily/lexer.ll
+++ b/lily/lexer.ll
@@ -818,11 +818,16 @@ Lily_lexer::scan_escaped_word (string str)
        SCM sid = lookup_identifier (str);
        if (is_music_function (sid))
        {
+               int funtype = MUSIC_FUNCTION;
+
                yylval.scm = get_music_function_transform (sid);
 
                SCM s = scm_object_property (yylval.scm, ly_symbol2scm ("music-function-signature"));
+               if (scm_is_eq (scm_car (s), ly_lily_module_constant ("scheme-function")))
+                       funtype = SCM_FUNCTION;
+                              
                push_extra_token (EXPECT_NO_MORE_ARGS);
-               for (; scm_is_pair (s); s = scm_cdr (s))
+               for (s = scm_cdr (s); scm_is_pair (s); s = scm_cdr (s))
                {
                        SCM cs = scm_car (s);
                        
@@ -838,7 +843,7 @@ Lily_lexer::scan_escaped_word (string str)
                                push_extra_token (EXPECT_SCM);
                        else programming_error ("Function parameter without type-checking predicate");
                }
-               return MUSIC_FUNCTION;
+               return funtype;
        }
 
        if (sid != SCM_UNDEFINED)

diff --git a/lily/music-function-scheme.cc b/lily/music-function-scheme.cc
index f78a387336021f9c1166aec680b9fb1cae610e5c..8470a97005e4d57db4c57203ee108459b217bc26 100644 (file)
--- a/lily/music-function-scheme.cc
+++ b/lily/music-function-scheme.cc
@@ -20,9 +20,9 @@ LY_DEFINE (ly_make_music_function, "ly:make-music-function", 2, 0, 0,
            (SCM signature, SCM func),
            "Make a function to process music, to be used for the"
            " parser.  @var{func} is the function, and @var{signature}"
-           " describes its arguments.  @var{signature} is a list"
+           " describes its arguments.  @var{signature}'s cdr is a list"
            " containing either @code{ly:music?} predicates or other type"
-           " predicates.")
+           " predicates.  Its car is the syntax function to call.")
 {
   LY_ASSERT_TYPE (ly_is_procedure, func, 1);
   return make_music_function (signature, func);

diff --git a/lily/parser.yy b/lily/parser.yy
index 71ae623749b221e870a51a7d50a455f069d20e99..032d24a07024f546557607da78e72532561b1872 100644 (file)
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -303,6 +303,7 @@ If we give names, Bison complains.
 %token <scm> OUTPUT_DEF_IDENTIFIER
 %token <scm> REAL
 %token <scm> RESTNAME
+%token <scm> SCM_FUNCTION
 %token <scm> SCM_IDENTIFIER
 %token <scm> SCM_TOKEN
 %token <scm> SCORE_IDENTIFIER
@@ -439,6 +440,7 @@ If we give names, Bison complains.
 %type <scm> property_operation
 %type <scm> property_path property_path_revved
 %type <scm> scalar
+%type <scm> scm_function_call
 %type <scm> script_abbreviation
 %type <scm> simple_chord_elements
 %type <scm> simple_markup
@@ -544,6 +546,15 @@ toplevel_expression:
 embedded_scm:
        SCM_TOKEN
        | SCM_IDENTIFIER
+       | scm_function_call
+       ;
+
+scm_function_call:
+       SCM_FUNCTION closed_function_arglist
+       {
+               $$ = run_music_function (PARSER, @$,
+                                        $1, $2);
+       }
        ;
 
 embedded_lilypond:
@@ -2689,14 +2700,14 @@ run_music_function (Lily_parser *parser, Input loc, SCM func, SCM args)
 
        SCM type_check_proc = ly_lily_module_constant ("type-check-list");
 
-       if (!to_boolean (scm_call_3  (type_check_proc, make_input (loc), sig, args)))
+       if (!to_boolean (scm_call_3  (type_check_proc, make_input (loc), scm_cdr (sig), args)))
        {
                parser->error_level_ = 1;
                return LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant ("void-music"), scm_list_2 (parser->self_scm (), make_input (loc)));
        }
 
        SCM syntax_args = scm_list_4 (parser->self_scm (), make_input (loc), func, args);
-       return LOWLEVEL_MAKE_SYNTAX (ly_lily_module_constant ("music-function"), syntax_args);
+       return LOWLEVEL_MAKE_SYNTAX (scm_car (sig), syntax_args);
 }
 
 bool

diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm
index 5633ad84a140a389d507c5a670a51ae76f6438d0..540cc24d741ec655faebb126f7a19d841a3db496 100644 (file)
--- a/scm/ly-syntax-constructors.scm
+++ b/scm/ly-syntax-constructors.scm
@@ -42,9 +42,13 @@
        (set! (ly:music-property m 'origin) location)
        m)))
 
+;; Scheme function: Apply function, return value can be anything
+(define-ly-syntax (scheme-function parser loc fun args)
+      (apply fun parser loc args))
+
 ;; Music function: Apply function and check return value.
 (define-ly-syntax-loc (music-function parser loc fun args)
-  (let ((m (apply fun (cons* parser loc args))))
+  (let ((m (apply fun parser loc args)))
     (if (ly:music? m)
        m
        (begin

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index d7fedb689d9cf3e69a445ec7c4731ce176fe75b0..f2b41292abe52d36b52f540d5bc639a7ac15408c 100644 (file)
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -769,11 +769,30 @@ Syntax:
       ;; (_i "doc string"), keep the literal string only
       (let ((docstring (cadar body))
            (body (cdr body)))
-       `(ly:make-music-function (list ,@signature)
+       `(ly:make-music-function (list music-function ,@signature)
                                 (lambda (,@args)
                                   ,docstring
                                   ,@body)))
-      `(ly:make-music-function (list ,@signature)
+      `(ly:make-music-function (list music-function ,@signature)
+                              (lambda (,@args)
+                                ,@body))))
+
+(defmacro-public define-scheme-function (args signature . body)
+  "Helper macro for `ly:make-music-function'.
+Syntax:
+  (define-scheme-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...)
+    ...function body...)
+"
+(if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body)))
+      ;; When the music function definition contains a i10n doc string,
+      ;; (_i "doc string"), keep the literal string only
+      (let ((docstring (cadar body))
+           (body (cdr body)))
+       `(ly:make-music-function (list scheme-function ,@signature)
+                                (lambda (,@args)
+                                  ,docstring
+                                  ,@body)))
+      `(ly:make-music-function (list scheme-function ,@signature)
                               (lambda (,@args)
                                 ,@body))))