From: David Kastrup Date: Mon, 5 Sep 2011 11:51:48 +0000 (+0200) Subject: lexer.ll: Introduce Scheme functions X-Git-Tag: release/2.15.11-1~12^2~2 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=2c9e52c2ccbb24b97514686ee649fff906d35ce0;p=lilypond.git lexer.ll: Introduce Scheme functions --- diff --git a/lily/lexer.ll b/lily/lexer.ll index 7088252793..c9c3c88ed8 100644 --- 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 f78a387336..8470a97005 100644 --- 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 71ae623749..032d24a070 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -303,6 +303,7 @@ If we give names, Bison complains. %token OUTPUT_DEF_IDENTIFIER %token REAL %token RESTNAME +%token SCM_FUNCTION %token SCM_IDENTIFIER %token SCM_TOKEN %token SCORE_IDENTIFIER @@ -439,6 +440,7 @@ If we give names, Bison complains. %type property_operation %type property_path property_path_revved %type scalar +%type scm_function_call %type script_abbreviation %type simple_chord_elements %type 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 5633ad84a1..540cc24d74 100644 --- 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 d7fedb689d..f2b41292ab 100644 --- 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))))