From: David Kastrup Date: Fri, 23 Sep 2011 18:14:56 +0000 (+0200) Subject: Revert "Revert "Merge branch 'musicfunction-optional-arguments'"" X-Git-Tag: release/2.15.13-1~16 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=2fb1c62f584241ee5713341852f667d8f7975025;p=lilypond.git Revert "Revert "Merge branch 'musicfunction-optional-arguments'"" This reverts commit f3ec19a6d727f8e9fafa427859218f63dc884e82. --- diff --git a/lily/include/lily-lexer.hh b/lily/include/lily-lexer.hh index 9729ca7016..54e068ee7a 100644 --- a/lily/include/lily-lexer.hh +++ b/lily/include/lily-lexer.hh @@ -62,7 +62,7 @@ private: SCM start_module_; int hidden_state_; public: - vector extra_token_types_; + SCM extra_tokens_; void *lexval_; Input *lexloc_; bool is_main_input_; @@ -101,7 +101,7 @@ public: SCM keyword_list () const; SCM lookup_identifier (string s); SCM lookup_identifier_symbol (SCM s); - void push_extra_token (int token_type); + void push_extra_token (int token_type, SCM scm = SCM_UNDEFINED); void push_chord_state (SCM tab); void push_figuredbass_state (); void push_lyric_state (); diff --git a/lily/lexer.ll b/lily/lexer.ll index 6b19c8f67d..3445b6b784 100644 --- a/lily/lexer.ll +++ b/lily/lexer.ll @@ -173,9 +173,10 @@ BOM_UTF8 \357\273\277 yyless (0); /* produce requested token */ - int type = extra_token_types_.back (); - extra_token_types_.pop_back (); - if (extra_token_types_.empty ()) + int type = scm_to_int (scm_caar (extra_tokens_)); + yylval.scm = scm_cdar (extra_tokens_); + extra_tokens_ = scm_cdr (extra_tokens_); + if (scm_is_null (extra_tokens_)) yy_pop_state (); return type; @@ -185,9 +186,10 @@ BOM_UTF8 \357\273\277 /* Generate a token without swallowing anything */ /* produce requested token */ - int type = extra_token_types_.back (); - extra_token_types_.pop_back (); - if (extra_token_types_.empty ()) + int type = scm_to_int (scm_caar (extra_tokens_)); + yylval.scm = scm_cdar (extra_tokens_); + extra_tokens_ = scm_cdr (extra_tokens_); + if (scm_is_null (extra_tokens_)) yy_pop_state (); return type; @@ -588,7 +590,7 @@ BOM_UTF8 \357\273\277 else if (predicate == ly_lily_module_constant ("markup?")) push_extra_token(EXPECT_MARKUP); else - push_extra_token(EXPECT_SCM); + push_extra_token(EXPECT_SCM, predicate); } return token_type; } @@ -721,15 +723,15 @@ BOM_UTF8 \357\273\277 /* Make the lexer generate a token of the given type as the next token. TODO: make it possible to define a value for the token as well */ void -Lily_lexer::push_extra_token (int token_type) +Lily_lexer::push_extra_token (int token_type, SCM scm) { - if (extra_token_types_.empty ()) + if (scm_is_null (extra_tokens_)) { if (YY_START != extratoken) hidden_state_ = YY_START; yy_push_state (extratoken); } - extra_token_types_.push_back (token_type); + extra_tokens_ = scm_acons (scm_from_int (token_type), scm, extra_tokens_); } void @@ -826,7 +828,14 @@ Lily_lexer::scan_escaped_word (string str) push_extra_token (EXPECT_NO_MORE_ARGS); for (s = scm_cdr (s); scm_is_pair (s); s = scm_cdr (s)) { + SCM optional = SCM_UNDEFINED; cs = scm_car (s); + + if (scm_is_pair (cs)) + { + optional = SCM_CDR (cs); + cs = SCM_CAR (cs); + } if (cs == ly_music_p_proc) push_extra_token (EXPECT_MUSIC); @@ -837,8 +846,14 @@ Lily_lexer::scan_escaped_word (string str) else if (cs == ly_lily_module_constant ("markup?")) push_extra_token (EXPECT_MARKUP); else if (ly_is_procedure (cs)) - push_extra_token (EXPECT_SCM); - else programming_error ("Function parameter without type-checking predicate"); + push_extra_token (EXPECT_SCM, cs); + else + { + programming_error ("Function parameter without type-checking predicate"); + continue; + } + if (!scm_is_eq (optional, SCM_UNDEFINED)) + push_extra_token (EXPECT_OPTIONAL, optional); } return funtype; } diff --git a/lily/lily-lexer.cc b/lily/lily-lexer.cc index 4bba139d3f..f80ea67703 100644 --- a/lily/lily-lexer.cc +++ b/lily/lily-lexer.cc @@ -105,6 +105,7 @@ Lily_lexer::Lily_lexer (Sources *sources, Lily_parser *parser) is_main_input_ = false; start_module_ = SCM_EOL; chord_repetition_ = Chord_repetition (); + extra_tokens_ = SCM_EOL; smobify_self (); add_scope (ly_make_module (false)); @@ -127,6 +128,7 @@ Lily_lexer::Lily_lexer (Lily_lexer const &src, Lily_parser *parser) is_main_input_ = src.is_main_input_; scopes_ = SCM_EOL; + extra_tokens_ = SCM_EOL; smobify_self (); @@ -388,6 +390,7 @@ Lily_lexer::mark_smob (SCM s) scm_gc_mark (lexer->parser_->self_scm ()); scm_gc_mark (lexer->pitchname_tab_stack_); scm_gc_mark (lexer->start_module_); + scm_gc_mark (lexer->extra_tokens_); return lexer->scopes_; } diff --git a/lily/parser.yy b/lily/parser.yy index c34c4acee4..4714f67326 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -43,9 +43,6 @@ of the parse stack onto the heap. */ %left PREC_BOT %nonassoc REPEAT %nonassoc ALTERNATIVE -%left ADDLYRICS -%left PREC_TOP - /* The above precedences tackle the shift/reduce problem @@ -59,6 +56,20 @@ or \repeat { \repeat } \alternative */ +%right FUNCTION_ARGUMENTS + MARKUP LYRICS_STRING MARKUP_IDENTIFIER STRING STRING_IDENTIFIER + SEQUENTIAL SIMULTANEOUS DOUBLE_ANGLE_OPEN MUSIC_IDENTIFIER '{' + PITCH_IDENTIFIER NOTENAME_PITCH TONICNAME_PITCH + SCM_FUNCTION SCM_IDENTIFIER SCM_TOKEN + UNSIGNED DURATION_IDENTIFIER + + /* The above are the symbols that can start function arguments */ + +%left ADDLYRICS +%left PREC_TOP + + + %pure_parser %locations @@ -147,6 +158,9 @@ SCM get_next_unique_lyrics_context_id (); static Music *make_music_with_input (SCM name, Input where); SCM make_music_relative (Pitch start, SCM music, Input loc); 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); 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); @@ -268,8 +282,9 @@ If we give names, Bison complains. %token EXPECT_MUSIC "ly:music?" %token EXPECT_PITCH "ly:pitch?" %token EXPECT_DURATION "ly:duration?" -%token EXPECT_SCM "scheme?" +%token EXPECT_SCM "scheme?" %token EXPECT_MARKUP_LIST "markup-list?" +%token EXPECT_OPTIONAL "optional?" /* After the last argument. */ %token EXPECT_NO_MORE_ARGS; @@ -402,8 +417,12 @@ If we give names, Bison complains. %type full_markup %type full_markup_list %type function_arglist +%type function_arglist_optional +%type function_arglist_keep %type function_arglist_bare %type function_arglist_closed +%type function_arglist_closed_optional +%type function_arglist_closed_keep %type identifier_init %type lilypond %type lilypond_header @@ -1114,22 +1133,131 @@ and this rule returns the reversed list of arguments. */ function_arglist: function_arglist_bare - | EXPECT_MUSIC function_arglist music { + | EXPECT_MUSIC function_arglist_optional music + { $$ = scm_cons ($3, $2); } - | EXPECT_SCM function_arglist embedded_scm { - $$ = scm_cons ($3, $2); + | EXPECT_SCM function_arglist_optional embedded_scm + { + $$ = 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); + } + | EXPECT_OPTIONAL EXPECT_DURATION function_arglist_optional + { + $$ = scm_cons ($1, $3); + } + | EXPECT_OPTIONAL EXPECT_MARKUP function_arglist_optional + { + $$ = scm_cons ($1, $3); + } + | EXPECT_OPTIONAL EXPECT_SCM function_arglist_optional + { + $$ = scm_cons (loc_on_music (@3, $1), $3); } ; +function_arglist_keep: + EXPECT_OPTIONAL EXPECT_MARKUP function_arglist_keep full_markup { + $$ = scm_cons ($4, $3); + } + | EXPECT_OPTIONAL EXPECT_MARKUP function_arglist_keep simple_string { + $$ = scm_cons ($4, $3); + } + | EXPECT_OPTIONAL EXPECT_PITCH function_arglist_keep pitch_also_in_chords { + $$ = scm_cons ($4, $3); + } + | EXPECT_OPTIONAL EXPECT_DURATION function_arglist_closed_keep duration_length { + $$ = scm_cons ($4, $3); + } + | EXPECT_OPTIONAL EXPECT_SCM function_arglist_keep simple_string + { + $$ = check_scheme_arg (PARSER, @4, $1, $4, $3, $2); + } + | EXPECT_OPTIONAL EXPECT_MUSIC function_arglist_keep closed_music + { + $$ = scm_cons ($4, $3); + } + | EXPECT_OPTIONAL EXPECT_SCM function_arglist_keep embedded_scm + { + $$ = check_scheme_arg (PARSER, @4, $1, $4, $3, $2); + } + | function_arglist + ; + + function_arglist_closed: function_arglist_bare - | EXPECT_MUSIC function_arglist closed_music { + | EXPECT_MUSIC function_arglist_optional closed_music + { $$ = scm_cons ($3, $2); } - | EXPECT_SCM function_arglist embedded_scm_closed { - $$ = scm_cons ($3, $2); + | EXPECT_SCM function_arglist_optional embedded_scm_closed + { + $$ = 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); + } + | EXPECT_OPTIONAL EXPECT_DURATION function_arglist_closed_optional + { + $$ = scm_cons ($1, $3); + } + | EXPECT_OPTIONAL EXPECT_MARKUP function_arglist_closed_optional + { + $$ = scm_cons ($1, $3); + } + | EXPECT_OPTIONAL EXPECT_SCM function_arglist_closed_optional + { + $$ = scm_cons (loc_on_music (@3, $1), $3); + } + ; + +function_arglist_closed_keep: + EXPECT_OPTIONAL EXPECT_MARKUP function_arglist_keep full_markup { + $$ = scm_cons ($4, $3); + } + | EXPECT_OPTIONAL EXPECT_MARKUP function_arglist_keep simple_string { + $$ = scm_cons ($4, $3); + } + | EXPECT_OPTIONAL EXPECT_PITCH function_arglist_keep pitch_also_in_chords { + $$ = scm_cons ($4, $3); + } + | EXPECT_OPTIONAL EXPECT_DURATION function_arglist_closed_keep duration_length { + $$ = scm_cons ($4, $3); + } + | EXPECT_OPTIONAL EXPECT_SCM function_arglist_keep simple_string + { + $$ = check_scheme_arg (PARSER, @4, $1, $4, $3, $2); + } + | EXPECT_OPTIONAL EXPECT_MUSIC function_arglist_keep closed_music + { + $$ = scm_cons ($4, $3); + } + | EXPECT_OPTIONAL EXPECT_SCM function_arglist_keep embedded_scm_closed + { + $$ = check_scheme_arg (PARSER, @4, $1, $4, $3, $2); } + | function_arglist_closed ; embedded_scm_closed: @@ -1146,24 +1274,22 @@ scm_function_call_closed: function_arglist_bare: EXPECT_NO_MORE_ARGS { - /* This is for 0-ary functions, so they don't need to - read a lookahead token */ $$ = SCM_EOL; } - | EXPECT_MARKUP function_arglist full_markup { + | EXPECT_MARKUP function_arglist_optional full_markup { $$ = scm_cons ($3, $2); } - | EXPECT_MARKUP function_arglist simple_string { + | EXPECT_MARKUP function_arglist_optional simple_string { $$ = scm_cons ($3, $2); } - | EXPECT_PITCH function_arglist pitch_also_in_chords { - $$ = scm_cons ($3, $2); + | EXPECT_PITCH function_arglist_optional pitch_also_in_chords { + $$ = scm_cons ($3, $2); } - | EXPECT_DURATION function_arglist_closed duration_length { - $$ = scm_cons ($3, $2); + | EXPECT_DURATION function_arglist_closed_optional duration_length { + $$ = scm_cons ($3, $2); } - | EXPECT_SCM function_arglist simple_string { - $$ = scm_cons ($3, $2); + | EXPECT_SCM function_arglist_optional simple_string { + $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED, $3, $2, $1); } ; @@ -1635,8 +1761,8 @@ music_function_chord_body_arglist: | EXPECT_MUSIC music_function_chord_body_arglist chord_body_element { $$ = scm_cons ($3, $2); } - | EXPECT_SCM function_arglist embedded_scm_chord_body { - $$ = scm_cons ($3, $2); + | EXPECT_SCM function_arglist_optional embedded_scm_chord_body { + $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED, $3, $2, $1); } ; @@ -1665,8 +1791,8 @@ music_function_event_arglist: | EXPECT_MUSIC music_function_event_arglist post_event { $$ = scm_cons ($3, $2); } - | EXPECT_SCM function_arglist embedded_scm_event { - $$ = scm_cons ($3, $2); + | EXPECT_SCM function_arglist_optional embedded_scm_event { + $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED, $3, $2, $1); } ; @@ -2569,7 +2695,7 @@ markup_command_basic_arguments: $$ = scm_cons ($3, $2); } | EXPECT_SCM markup_command_list_arguments embedded_scm_closed { - $$ = scm_cons ($3, $2); + $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED, $3, $2, $1); } | EXPECT_NO_MORE_ARGS { $$ = SCM_EOL; @@ -2750,8 +2876,6 @@ run_music_function (Lily_parser *parser, Input loc, SCM func, SCM args) { SCM sig = scm_object_property (func, ly_symbol2scm ("music-function-signature")); - SCM type_check_proc = ly_lily_module_constant ("type-check-list"); - args = scm_reverse_x (args, SCM_EOL); SCM fallback = SCM_BOOL_F; @@ -2759,23 +2883,42 @@ run_music_function (Lily_parser *parser, Input loc, SCM func, SCM args) if (scm_is_pair (pred)) { - fallback = scm_cdr (pred); - if (Music *m = unsmob_music (fallback)) { - m = m->clone (); - m->set_spot (loc); - fallback = m->unprotect (); - } + fallback = loc_on_music (loc, scm_cdr (pred)); pred = scm_car (pred); } - if (!to_boolean (scm_call_3 (type_check_proc, make_input (loc), scm_cdr (sig), args))) + 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) +{ + 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 fallback; + + return scm_cons (fallback, args); } + return scm_cons (arg, args); +} - 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 loc_on_music (Input loc, SCM arg) +{ + if (Music *m = unsmob_music (arg)) + { + m = m->clone (); + m->set_spot (loc); + return m->unprotect (); + } + return arg; } bool diff --git a/scm/lily.scm b/scm/lily.scm index 6230940860..193bf5df77 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -345,26 +345,16 @@ messages into errors.") (set-module-obarray! iface (module-obarray mod)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (type-check-list location signature arguments) - "Typecheck a list of arguments against a list of type predicates. -Print a message at LOCATION if any predicate failed." - (define (recursion-helper signature arguments count) - (define (helper pred? arg count) - (if (not (pred? arg)) - (begin - (ly:input-warning - location - (_ "wrong type for argument ~a. Expecting ~a, found ~s") - count (type-name pred?) arg) - #f) - #t)) - - (if (null? signature) - #t - (and (helper (car signature) (car arguments) count) - (recursion-helper (cdr signature) (cdr arguments) (1+ count))))) - (recursion-helper signature arguments 1)) - +(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