From: David Kastrup Date: Wed, 19 May 2010 21:44:56 +0000 (-0600) Subject: Don't hardcode a limited set of markup signatures. X-Git-Tag: release/2.13.22-1~13 X-Git-Url: https://git.donarmstrong.com/lilypond.git?a=commitdiff_plain;h=9c31e340ad9e67bf74f75b9a28d57e432268e2fd;p=lilypond.git Don't hardcode a limited set of markup signatures. Remove the hardcoded limitations of markup signatures. This patch is moving toward a unified interface for music functions, markup functions, and user functions. --- diff --git a/Documentation/extending/programming-interface.itely b/Documentation/extending/programming-interface.itely index 7c8b287552..7848b0f1bd 100644 --- a/Documentation/extending/programming-interface.itely +++ b/Documentation/extending/programming-interface.itely @@ -418,59 +418,26 @@ If the command uses properties from the @var{props} arguments, the @code{#:properties} keyword can be used, to specify which properties are used, and their default values. -@knownissues -There are restrictions on the possible arguments to a markup command. - -Arguments are distingued according to their type: +Arguments are distinguished according to their type: @itemize @item a markup, corresponding to type predicate @code{markup?}; -@item a list of markup, corresponding to type predicate +@item a list of markups, corresponding to type predicate @code{markup-list?}; @item any other scheme object, corresponding to type predicates such as @code{list?}, @code{number?}, @code{boolean?}, etc. @end itemize -The available combinations of arguments (after the standard @var{layout} -and @var{props} arguments) to a markup command defined with -@code{define-markup-command} are limited as follows. - -@table @asis -@item (no argument) -@itemx @var{markup-list} -@itemx @var{markup} -@itemx @var{markup markup} -@itemx @var{scheme} -@itemx @var{scheme markup} -@itemx @var{scheme scheme} -@itemx @var{scheme scheme markup} -@itemx @var{scheme scheme markup markup} -@itemx @var{scheme markup markup} -@itemx @var{scheme scheme scheme} -@end table - -@noindent -This means that it is not possible to define with e.g. three scheme -arguments and a markup arguments, like: - -@example -#(define-markup-command (foo layout props - num1 num2 a-list a-markup) - (number? number? list? markup?) - ...) -@end example - -@noindent -If you apply it as, say, - -@example -\markup \foo #1 #2 #'(bar baz) Blah -@end example - -@cindex Scheme signature -@cindex signature, Scheme -@noindent -@command{lilypond} complains that it cannot parse @code{foo} due to its -unknown Scheme signature. +There is no limitation on the order of arguments (after the standard +@var{layout} and @var{props} arguments). However, markup functions +taking a markup as their last argument are somewhat special as you can +apply them to a markup list, and the result is a markup list where the +markup function (with the specified leading arguments) has been applied +to every element of the original markup list. + +Since replicating the leading arguments for applying a markup function +to a markup list is cheap mostly for Scheme arguments, you avoid +performance pitfalls by just using Scheme arguments for the leading +arguments of markup functions that take a markup as their last argument. @node On properties @unnumberedsubsubsec On properties diff --git a/lily/lexer.ll b/lily/lexer.ll index 82dbd695f0..aaa95d7980 100644 --- a/lily/lexer.ll +++ b/lily/lexer.ll @@ -431,7 +431,7 @@ BOM_UTF8 \357\273\277 \\{ESCAPED} { *yylval.string += to_string (escaped_char (YYText ()[1])); } - [^\\"]+ { + [^\\""]+ { *yylval.string += YYText (); } \" { @@ -528,58 +528,53 @@ BOM_UTF8 \357\273\277 } {MARKUPCOMMAND} { string str (YYText () + 1); + + int token_type = MARKUP_FUNCTION; SCM s = lookup_markup_command (str); - SCM s2 = lookup_markup_list_command (str); - if (scm_is_pair (s) && scm_is_symbol (scm_cdr (s)) ) { - yylval.scm = scm_car(s); - SCM tag = scm_cdr(s); - if (tag == ly_symbol2scm("markup0")) - return MARKUP_HEAD_MARKUP0; - if (tag == ly_symbol2scm("empty")) - return MARKUP_HEAD_EMPTY; - else if (tag == ly_symbol2scm ("markup0-markup1")) - return MARKUP_HEAD_MARKUP0_MARKUP1; - else if (tag == ly_symbol2scm ("markup-list0")) - return MARKUP_HEAD_LIST0; - else if (tag == ly_symbol2scm ("scheme0")) - return MARKUP_HEAD_SCM0; - else if (tag == ly_symbol2scm ("scheme0-scheme1")) - return MARKUP_HEAD_SCM0_SCM1; - else if (tag == ly_symbol2scm ("scheme0-markup1")) - return MARKUP_HEAD_SCM0_MARKUP1; - else if (tag == ly_symbol2scm ("scheme0-scheme1-markup2")) - return MARKUP_HEAD_SCM0_SCM1_MARKUP2; - else if (tag == ly_symbol2scm ("scheme0-scheme1-markup2-markup3")) - return MARKUP_HEAD_SCM0_SCM1_MARKUP2_MARKUP3; - else if (tag == ly_symbol2scm ("scheme0-markup1-markup2")) - return MARKUP_HEAD_SCM0_MARKUP1_MARKUP2; - else if (tag == ly_symbol2scm ("scheme0-scheme1-scheme2")) - return MARKUP_HEAD_SCM0_SCM1_SCM2; - else { - programming_error ("no parser tag defined for this markup signature"); - ly_display_scm (s); - assert(false); - } - } else if (scm_is_pair (s2) && scm_is_symbol (scm_cdr (s2))) { - yylval.scm = scm_car(s2); - SCM tag = scm_cdr(s2); - if (tag == ly_symbol2scm("empty")) - return MARKUP_LIST_HEAD_EMPTY; - else if (tag == ly_symbol2scm ("scheme0")) - return MARKUP_LIST_HEAD_SCM0; - else if (tag == ly_symbol2scm ("markup-list0")) - return MARKUP_LIST_HEAD_LIST0; - else if (tag == ly_symbol2scm ("scheme0-markup-list1")) - return MARKUP_LIST_HEAD_SCM0_LIST1; - else if (tag == ly_symbol2scm ("scheme0-scheme1-markup-list2")) - return MARKUP_LIST_HEAD_SCM0_SCM1_LIST2; - else { - programming_error ("no parser tag defined for this markup list signature"); - ly_display_scm (s); - assert(false); - } - } else - return scan_escaped_word (str); + + // lookup-markup-command returns a pair with the car + // being the function to call, and the cdr being the + // call signature specified to define-markup-command, + // a list of predicates. + + if (!scm_is_pair (s)) { + // If lookup-markup-command was not successful, we + // try lookup-markup-list-command instead. + // If this fails as well, we just scan and return + // the escaped word. + s = lookup_markup_list_command (str); + if (scm_is_pair (s)) + token_type = MARKUP_LIST_FUNCTION; + else + return scan_escaped_word (str); + } + + // If the list of predicates is, say, + // (number? number? markup?), then tokens + // EXPECT_MARKUP EXPECT_SCM EXPECT_SCM EXPECT_NO_MORE_ARGS + // will be generated. Note that we have to push them + // in reverse order, so the first token pushed in the + // loop will be EXPECT_NO_MORE_ARGS. + + yylval.scm = scm_car(s); + + // yylval now contains the function to call as token + // value (for token type MARKUP_FUNCTION or + // MARKUP_LIST_FUNCTION). + + push_extra_token(EXPECT_NO_MORE_ARGS); + s = scm_cdr(s); + for (; scm_is_pair(s); s = scm_cdr(s)) { + SCM predicate = scm_car(s); + + if (predicate == ly_lily_module_constant ("markup-list?")) + push_extra_token(EXPECT_MARKUP_LIST); + else if (predicate == ly_lily_module_constant ("markup?")) + push_extra_token(EXPECT_MARKUP); + else + push_extra_token(EXPECT_SCM); + } + return token_type; } [{}] { return YYText ()[0]; diff --git a/lily/parser.yy b/lily/parser.yy index d296086193..a9d8938889 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -271,6 +271,7 @@ If we give names, Bison complains. %token EXPECT_MARKUP; %token EXPECT_MUSIC; %token EXPECT_SCM; +%token EXPECT_MARKUP_LIST /* After the last argument. */ %token EXPECT_NO_MORE_ARGS; @@ -286,22 +287,8 @@ If we give names, Bison complains. %token FRACTION %token LYRICS_STRING %token LYRIC_MARKUP_IDENTIFIER -%token MARKUP_HEAD_EMPTY -%token MARKUP_HEAD_LIST0 -%token MARKUP_HEAD_MARKUP0 -%token MARKUP_HEAD_MARKUP0_MARKUP1 -%token MARKUP_HEAD_SCM0 -%token MARKUP_HEAD_SCM0_MARKUP1 -%token MARKUP_HEAD_SCM0_SCM1 -%token MARKUP_HEAD_SCM0_SCM1_MARKUP2 -%token MARKUP_HEAD_SCM0_SCM1_MARKUP2_MARKUP3 -%token MARKUP_HEAD_SCM0_MARKUP1_MARKUP2 -%token MARKUP_HEAD_SCM0_SCM1_SCM2 -%token MARKUP_LIST_HEAD_EMPTY -%token MARKUP_LIST_HEAD_LIST0 -%token MARKUP_LIST_HEAD_SCM0 -%token MARKUP_LIST_HEAD_SCM0_LIST1 -%token MARKUP_LIST_HEAD_SCM0_SCM1_LIST2 +%token MARKUP_FUNCTION +%token MARKUP_LIST_FUNCTION %token MARKUP_IDENTIFIER %token MUSIC_FUNCTION %token MUSIC_IDENTIFIER @@ -413,6 +400,8 @@ If we give names, Bison complains. %type markup_braced_list_body %type markup_composed_list %type markup_command_list +%type markup_command_list_arguments +%type markup_command_basic_arguments %type markup_head_1_item %type markup_head_1_list %type markup_list @@ -2451,37 +2440,38 @@ markup_braced_list_body: $$ = scm_cons ($2, $1); } | markup_braced_list_body markup_list { - $$ = scm_append_x (scm_list_2 (scm_reverse_x ($2, SCM_EOL), $1)); + $$ = scm_reverse_x ($2, $1); } ; markup_command_list: - MARKUP_LIST_HEAD_EMPTY { - $$ = scm_list_1 ($1); + MARKUP_LIST_FUNCTION markup_command_list_arguments { + $$ = scm_cons ($1, scm_reverse_x($2, SCM_EOL)); } - | MARKUP_LIST_HEAD_LIST0 markup_list { - $$ = scm_list_2 ($1, $2); + ; + +markup_command_basic_arguments: + EXPECT_MARKUP_LIST markup_command_list_arguments markup_list { + $$ = scm_cons ($3, $2); } - | MARKUP_LIST_HEAD_SCM0 embedded_scm { - $$ = scm_list_2 ($1, $2); + | EXPECT_SCM markup_command_list_arguments embedded_scm { + $$ = scm_cons ($3, $2); } - | MARKUP_LIST_HEAD_SCM0_LIST1 embedded_scm markup_list { - $$ = scm_list_3 ($1, $2, $3); + | EXPECT_NO_MORE_ARGS { + $$ = SCM_EOL; } - | MARKUP_LIST_HEAD_SCM0_SCM1_LIST2 embedded_scm embedded_scm markup_list { - $$ = scm_list_4 ($1, $2, $3, $4); + ; + +markup_command_list_arguments: + markup_command_basic_arguments { $$ = $1; } + | EXPECT_MARKUP markup_command_list_arguments markup { + $$ = scm_cons ($3, $2); } ; markup_head_1_item: - MARKUP_HEAD_MARKUP0 { - $$ = scm_list_1 ($1); - } - | MARKUP_HEAD_SCM0_MARKUP1 embedded_scm { - $$ = scm_list_2 ($1, $2); - } - | MARKUP_HEAD_SCM0_SCM1_MARKUP2 embedded_scm embedded_scm { - $$ = scm_list_3 ($1, $2, $3); + MARKUP_FUNCTION EXPECT_MARKUP markup_command_list_arguments { + $$ = scm_cons ($1, scm_reverse_x ($3, SCM_EOL)); } ; @@ -2516,29 +2506,8 @@ simple_markup: sc->unprotect (); PARSER->lexer_->pop_state (); } - | MARKUP_HEAD_SCM0 embedded_scm { - $$ = scm_list_2 ($1, $2); - } - | MARKUP_HEAD_SCM0_SCM1_SCM2 embedded_scm embedded_scm embedded_scm { - $$ = scm_list_4 ($1, $2, $3, $4); - } - | MARKUP_HEAD_SCM0_SCM1 embedded_scm embedded_scm { - $$ = scm_list_3 ($1, $2, $3); - } - | MARKUP_HEAD_SCM0_MARKUP1_MARKUP2 embedded_scm markup markup { - $$ = scm_list_4 ($1, $2, $3, $4); - } - | MARKUP_HEAD_SCM0_SCM1_MARKUP2_MARKUP3 embedded_scm embedded_scm markup markup { - $$ = scm_list_5 ($1, $2, $3, $4, $5); - } - | MARKUP_HEAD_EMPTY { - $$ = scm_list_1 ($1); - } - | MARKUP_HEAD_LIST0 markup_list { - $$ = scm_list_2 ($1,$2); - } - | MARKUP_HEAD_MARKUP0_MARKUP1 markup markup { - $$ = scm_list_3 ($1, $2, $3); + | MARKUP_FUNCTION markup_command_basic_arguments { + $$ = scm_cons ($1, scm_reverse_x ($2, SCM_EOL)); } ; diff --git a/scm/markup.scm b/scm/markup.scm index dfa349e959..92ffaf47c5 100644 --- a/scm/markup.scm +++ b/scm/markup.scm @@ -66,7 +66,7 @@ register COMMAND-markup and its signature, * add COMMAND-markup to markup-functions-by-category, -* sets COMMAND-markup markup-signature and markup-keyword object properties, +* sets COMMAND-markup markup-signature object property, * define a make-COMMAND-markup function. @@ -366,58 +366,28 @@ Use `markup*' in a \\notemode context." ;;;;;;;;;;;;;;; ;;; Utilities for storing and accessing markup commands signature -;;; and keyword. ;;; Examples: ;;; ;;; (set! (markup-command-signature raise-markup) (list number? markup?)) -;;; ==> ((# #) . scheme0-markup1) +;;; ==> (# #) ;;; ;;; (markup-command-signature raise-markup) ;;; ==> (# #) ;;; -;;; (markup-command-keyword raise-markup) ==> scheme0-markup1 -;;; - -(define-public (markup-command-keyword markup-command) - "Return markup-command's argument keyword, ie a symbol describing the command - arguments, eg. scheme0-markup1" - (object-property markup-command 'markup-keyword)) (define-public (markup-command-signature-ref markup-command) "Return markup-command's signature (the 'markup-signature object property)" (object-property markup-command 'markup-signature)) (define-public (markup-command-signature-set! markup-command signature) - "Set markup-command's signature and keyword (as object properties)" + "Set markup-command's signature (as object property)" (set-object-property! markup-command 'markup-signature signature) - (set-object-property! markup-command 'markup-keyword - (markup-signature-to-keyword signature)) signature) (define-public markup-command-signature (make-procedure-with-setter markup-command-signature-ref markup-command-signature-set!)) -(define-public (markup-signature-to-keyword sig) - " (A B C) -> a0-b1-c2 " - (if (null? sig) - 'empty - (string->symbol (string-join (map - (let* ((count 0)) - (lambda (func) - (set! count (+ count 1)) - (string-append - ;; for reasons I don't get, - ;; (case func ((markup?) .. ) - ;; doesn't work. - (cond - ((eq? func markup?) "markup") - ((eq? func markup-list?) "markup-list") - (else "scheme")) - (number->string (- count 1))))) - sig) - "-")))) - (define (lookup-markup-command-aux symbol) (let ((proc (catch 'misc-error (lambda () @@ -429,13 +399,13 @@ Use `markup*' in a \\notemode context." (let ((proc (lookup-markup-command-aux (string->symbol (format #f "~a-markup" code))))) (and proc (markup-function? proc) - (cons proc (markup-command-keyword proc))))) + (cons proc (markup-command-signature proc))))) (define-public (lookup-markup-list-command code) (let ((proc (lookup-markup-command-aux (string->symbol (format #f "~a-markup-list" code))))) (and proc (markup-list-function? proc) - (cons proc (markup-command-keyword proc))))) + (cons proc (markup-command-signature proc))))) ;;;;;;;;;;;;;;;;;;;;;; ;;; used in parser.yy to map a list of markup commands on markup arguments