From f3ec19a6d727f8e9fafa427859218f63dc884e82 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Fri, 23 Sep 2011 10:12:25 +0200 Subject: [PATCH] Revert "Merge branch 'musicfunction-optional-arguments'" This reverts commit 83055a30e52c14b0fd49d6df3eb1c7af476ecb4b, reversing changes made to 049021415e2af3a48b1ec6d724df3d2f1d9f7dd3. --- lily/include/lily-lexer.hh | 4 +- lily/lexer.ll | 39 ++----- lily/lily-lexer.cc | 3 - lily/parser.yy | 217 +++++++------------------------------ scm/lily.scm | 30 +++-- 5 files changed, 71 insertions(+), 222 deletions(-) diff --git a/lily/include/lily-lexer.hh b/lily/include/lily-lexer.hh index 54e068ee7a..9729ca7016 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: - SCM extra_tokens_; + vector extra_token_types_; 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, SCM scm = SCM_UNDEFINED); + void push_extra_token (int token_type); 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 3445b6b784..6b19c8f67d 100644 --- a/lily/lexer.ll +++ b/lily/lexer.ll @@ -173,10 +173,9 @@ BOM_UTF8 \357\273\277 yyless (0); /* produce requested token */ - 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_)) + int type = extra_token_types_.back (); + extra_token_types_.pop_back (); + if (extra_token_types_.empty ()) yy_pop_state (); return type; @@ -186,10 +185,9 @@ BOM_UTF8 \357\273\277 /* Generate a token without swallowing anything */ /* produce requested token */ - 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_)) + int type = extra_token_types_.back (); + extra_token_types_.pop_back (); + if (extra_token_types_.empty ()) yy_pop_state (); return type; @@ -590,7 +588,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, predicate); + push_extra_token(EXPECT_SCM); } return token_type; } @@ -723,15 +721,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, SCM scm) +Lily_lexer::push_extra_token (int token_type) { - if (scm_is_null (extra_tokens_)) + if (extra_token_types_.empty ()) { if (YY_START != extratoken) hidden_state_ = YY_START; yy_push_state (extratoken); } - extra_tokens_ = scm_acons (scm_from_int (token_type), scm, extra_tokens_); + extra_token_types_.push_back (token_type); } void @@ -828,14 +826,7 @@ 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); @@ -846,14 +837,8 @@ 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, cs); - else - { - programming_error ("Function parameter without type-checking predicate"); - continue; - } - if (!scm_is_eq (optional, SCM_UNDEFINED)) - push_extra_token (EXPECT_OPTIONAL, optional); + push_extra_token (EXPECT_SCM); + else programming_error ("Function parameter without type-checking predicate"); } return funtype; } diff --git a/lily/lily-lexer.cc b/lily/lily-lexer.cc index f80ea67703..4bba139d3f 100644 --- a/lily/lily-lexer.cc +++ b/lily/lily-lexer.cc @@ -105,7 +105,6 @@ 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)); @@ -128,7 +127,6 @@ 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 (); @@ -390,7 +388,6 @@ 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 4714f67326..c34c4acee4 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -43,6 +43,9 @@ 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 @@ -56,20 +59,6 @@ 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 @@ -158,9 +147,6 @@ 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); @@ -282,9 +268,8 @@ 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; @@ -417,12 +402,8 @@ 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 @@ -1133,131 +1114,22 @@ and this rule returns the reversed list of arguments. */ function_arglist: function_arglist_bare - | EXPECT_MUSIC function_arglist_optional music - { + | EXPECT_MUSIC function_arglist music { $$ = 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); + | EXPECT_SCM function_arglist embedded_scm { + $$ = scm_cons ($3, $2); } ; -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_optional closed_music - { + | EXPECT_MUSIC function_arglist closed_music { $$ = 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); + | EXPECT_SCM function_arglist embedded_scm_closed { + $$ = scm_cons ($3, $2); } - | function_arglist_closed ; embedded_scm_closed: @@ -1274,22 +1146,24 @@ 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_optional full_markup { + | EXPECT_MARKUP function_arglist full_markup { $$ = scm_cons ($3, $2); } - | EXPECT_MARKUP function_arglist_optional simple_string { + | EXPECT_MARKUP function_arglist simple_string { $$ = scm_cons ($3, $2); } - | EXPECT_PITCH function_arglist_optional pitch_also_in_chords { - $$ = scm_cons ($3, $2); + | EXPECT_PITCH function_arglist pitch_also_in_chords { + $$ = scm_cons ($3, $2); } - | EXPECT_DURATION function_arglist_closed_optional duration_length { - $$ = scm_cons ($3, $2); + | EXPECT_DURATION function_arglist_closed duration_length { + $$ = scm_cons ($3, $2); } - | EXPECT_SCM function_arglist_optional simple_string { - $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED, $3, $2, $1); + | EXPECT_SCM function_arglist simple_string { + $$ = scm_cons ($3, $2); } ; @@ -1761,8 +1635,8 @@ music_function_chord_body_arglist: | 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 function_arglist embedded_scm_chord_body { + $$ = scm_cons ($3, $2); } ; @@ -1791,8 +1665,8 @@ music_function_event_arglist: | 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 function_arglist embedded_scm_event { + $$ = scm_cons ($3, $2); } ; @@ -2695,7 +2569,7 @@ markup_command_basic_arguments: $$ = scm_cons ($3, $2); } | EXPECT_SCM markup_command_list_arguments embedded_scm_closed { - $$ = check_scheme_arg (PARSER, @3, SCM_UNDEFINED, $3, $2, $1); + $$ = scm_cons ($3, $2); } | EXPECT_NO_MORE_ARGS { $$ = SCM_EOL; @@ -2876,6 +2750,8 @@ 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; @@ -2883,42 +2759,23 @@ run_music_function (Lily_parser *parser, Input loc, SCM func, SCM args) if (scm_is_pair (pred)) { - fallback = loc_on_music (loc, scm_cdr (pred)); + fallback = scm_cdr (pred); + if (Music *m = unsmob_music (fallback)) { + m = m->clone (); + m->set_spot (loc); + fallback = m->unprotect (); + } pred = scm_car (pred); } - 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 (!to_boolean (scm_call_3 (type_check_proc, make_input (loc), scm_cdr (sig), args))) { - 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 fallback; } - return scm_cons (arg, 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; + 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); } bool diff --git a/scm/lily.scm b/scm/lily.scm index 193bf5df77..6230940860 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -345,16 +345,26 @@ messages into errors.") (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))) +(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)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Safe definitions utility -- 2.39.5