From 3465d3e1c1d2b87f7a1adc5c7c1dfe868c754e57 Mon Sep 17 00:00:00 2001 From: Erik Sandberg Date: Fri, 13 Oct 2006 10:48:17 +0000 Subject: [PATCH] * lily/input-smob.cc: add equal_p for Input * lily/music-scheme.cc (ly_camel_case_to_lisp_identifier): new function * lily/parser.yy: MY_MAKE_MUSIC sets music origin * lily/prob.cc: Add equal_p predicate for Prob * lily/translator.cc: small cleanup * scm/document-music.cc: use data from translator listener registration to generate documentation for event classes --- ChangeLog | 16 +++++++ lily/include/music.hh | 2 + lily/include/translator.hh | 6 ++- lily/include/translator.icc | 21 +-------- lily/input-smob.cc | 19 ++++++-- lily/music-scheme.cc | 24 ++++++++++ lily/music.cc | 16 +------ lily/parser.yy | 93 +++++++++++++++++-------------------- lily/prob.cc | 44 +++++++++++++++++- lily/translator.cc | 39 ++++++++++++---- scm/document-music.scm | 47 +++++++++++-------- 11 files changed, 209 insertions(+), 118 deletions(-) diff --git a/ChangeLog b/ChangeLog index a116415d2b..fdf468055b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,19 @@ +2006-10-13 Erik Sandberg + + * lily/input-smob.cc: add equal_p for Input + + * lily/music-scheme.cc (ly_camel_case_to_lisp_identifier): new + function + + * lily/parser.yy: MY_MAKE_MUSIC sets music origin + + * lily/prob.cc: Add equal_p predicate for Prob + + * lily/translator.cc: small cleanup + + * scm/document-music.cc: use data from translator listener + registration to generate documentation for event classes + 2006-10-13 Jan Nieuwenhuizen * GNUmakefile.in (SCRIPTS): Remove lexer-gcc-3.1.sh. diff --git a/lily/include/music.hh b/lily/include/music.hh index c307d07ff9..223764bb14 100644 --- a/lily/include/music.hh +++ b/lily/include/music.hh @@ -62,6 +62,8 @@ protected: Music *unsmob_music (SCM); Music *make_music_by_name (SCM sym); SCM ly_music_deep_copy (SCM); +SCM ly_camel_case_to_lisp_identifier (SCM name_sym); + extern SCM ly_music_p_proc; /* common transposition function for music and event */ diff --git a/lily/include/translator.hh b/lily/include/translator.hh index 14ff0b31a1..cadb56f1a9 100644 --- a/lily/include/translator.hh +++ b/lily/include/translator.hh @@ -131,7 +131,11 @@ protected: // should be private. void protect_event (SCM ev); virtual void derived_mark () const; static void add_translator_listener (translator_listener_record **listener_list, translator_listener_record *r, Listener (*get_listener) (void *), const char *ev_class); - SCM get_listened_class_list (const translator_listener_record *listeners) const; + SCM static_translator_description (const char *grobs, + const char *desc, + translator_listener_record *listener_list, + const char *read, + const char *write) const; friend class Translator_group; }; diff --git a/lily/include/translator.icc b/lily/include/translator.icc index fa2e2842bb..ed6b6de103 100644 --- a/lily/include/translator.icc +++ b/lily/include/translator.icc @@ -49,26 +49,7 @@ SCM \ classname::static_translator_description () const \ { \ - SCM static_properties = SCM_EOL; \ - /* static_properties = acons (name , gh_str02scm (Translator::name (self_scm ())), \ - static_properties_); \ - */ \ - static_properties = scm_acons (ly_symbol2scm ("grobs-created"), \ - parse_symbol_list (grobs), static_properties); \ - \ - static_properties = scm_acons (ly_symbol2scm ("description"), \ - scm_makfrom0str (desc), static_properties); \ - \ - static_properties = scm_acons (ly_symbol2scm ("events-accepted"), \ - get_listened_class_list (listener_list_), static_properties); \ - \ - static_properties = scm_acons (ly_symbol2scm ("properties-read"), \ - parse_symbol_list (read), static_properties); \ - \ - static_properties = scm_acons (ly_symbol2scm ("properties-written"), \ - parse_symbol_list (write), static_properties); \ - \ - return static_properties; \ + return Translator::static_translator_description (grobs, desc, listener_list_, read, write); \ } #define IMPLEMENT_FETCH_PRECOMPUTABLE_METHODS(T) \ diff --git a/lily/input-smob.cc b/lily/input-smob.cc index 7f66bcd3d3..1b66e9935f 100644 --- a/lily/input-smob.cc +++ b/lily/input-smob.cc @@ -17,8 +17,8 @@ Input dummy_input_global; static long input_tag; -static -SCM mark_smob (SCM s) +static SCM +mark_smob (SCM s) { Input *sc = (Input *) SCM_CELL_WORD_1 (s); @@ -43,6 +43,19 @@ free_smob (SCM s) return 0; } +static SCM +equal_smob (SCM sa, SCM sb) +{ + Input *a = (Input *) SCM_CELL_WORD_1 (sa); + Input *b = (Input *) SCM_CELL_WORD_1 (sb); + if (a->get_source_file () == b->get_source_file () && + a->start () == b->start () && + a->end () == b->end ()) + return SCM_BOOL_T; + else + return SCM_BOOL_F; +} + static void start_input_smobs () { @@ -50,7 +63,7 @@ start_input_smobs () scm_set_smob_mark (input_tag, mark_smob); scm_set_smob_free (input_tag, free_smob); scm_set_smob_print (input_tag, print_smob); - scm_set_smob_equalp (input_tag, 0); + scm_set_smob_equalp (input_tag, equal_smob); } SCM diff --git a/lily/music-scheme.cc b/lily/music-scheme.cc index 27e5db9880..dfe4f47c16 100644 --- a/lily/music-scheme.cc +++ b/lily/music-scheme.cc @@ -215,3 +215,27 @@ LY_DEFINE (ly_transpose_key_alist, "ly:transpose-key-alist", return scm_reverse_x (newlist, SCM_EOL); } +/* + TODO: does this belong here? +*/ +LY_DEFINE (ly_camel_case_to_lisp_identifier, "ly:camel-case->lisp-identifier", + 1, 0, 0, (SCM name_sym), + "Convert music name to corresponding event class name.") +{ + /* UGH. There should be a better way. */ + const string in = ly_symbol2string (name_sym); + /* this should be sufficient */ + char out[in.size() * 2 + 2]; + /* don't add '-' before first character */ + out[0] = tolower (in[0]); + size_t outpos = 1; + for (size_t inpos = 1; inpos < in.size (); inpos++) + { + if (isupper (in[inpos])) + out[outpos++] = '-'; + out[outpos++] = tolower (in[inpos]); + } + out[outpos] = 0; + + return ly_symbol2scm (out); +} diff --git a/lily/music.cc b/lily/music.cc index b938c86e22..1253e72860 100644 --- a/lily/music.cc +++ b/lily/music.cc @@ -253,21 +253,7 @@ Music::origin () const Stream_event * Music::to_event () const { - /* UGH. Temp hack */ - SCM orig_sym = get_property ("name"); - char out[200]; - string in = ly_symbol2string (orig_sym); - /* don't add '-' before first character */ - out[0] = tolower (in[0]); - size_t outpos = 1; - for (size_t inpos = 1; inpos < in.size () && outpos < 190; inpos++) - { - if (isupper (in[inpos])) - out[outpos++] = '-'; - out[outpos++] = tolower (in[inpos]); - } - out[outpos] = 0; - SCM class_name = ly_symbol2scm (out); + SCM class_name = ly_camel_case_to_lisp_identifier (get_property ("name")); // catch programming mistakes. if (!internal_is_music_type (class_name)) diff --git a/lily/parser.yy b/lily/parser.yy index 6299ad3eb9..06c38c4e0c 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -108,7 +108,7 @@ using namespace std; %{ -#define MY_MAKE_MUSIC(x) make_music_by_name (ly_symbol2scm (x)) +#define MY_MAKE_MUSIC(x, spot) make_music_with_input (ly_symbol2scm (x), spot) /* ES TODO: - Don't use lily module, create a new module instead. @@ -132,8 +132,8 @@ SCM get_next_unique_lyrics_context_id (); #endif - -SCM make_music_relative (Pitch start, SCM music); +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 *, SCM expr); SCM get_first_context_id (SCM type, Music *m); SCM make_chord_elements (SCM pitch, SCM dur, SCM modification_list); @@ -825,7 +825,7 @@ music_list: } | music_list error { - Music *m = MY_MAKE_MUSIC("Music"); + Music *m = MY_MAKE_MUSIC("Music", @$); // ugh. code dup m->set_property ("error-found", SCM_BOOL_T); SCM s = $$; @@ -1079,11 +1079,11 @@ mode_changing_head_with_context: relative_music: RELATIVE absolute_pitch music { Pitch start = *unsmob_pitch ($2); - $$ = make_music_relative (start, $3); + $$ = make_music_relative (start, $3, @$); } | RELATIVE composite_music { Pitch middle_c (0, 0, 0); - $$ = make_music_relative (middle_c, $2); + $$ = make_music_relative (middle_c, $2, @$); } ; @@ -1330,9 +1330,8 @@ chord_body_element: SCM check = $4; SCM post = $5; - Music *n = MY_MAKE_MUSIC ("NoteEvent"); + Music *n = MY_MAKE_MUSIC ("NoteEvent", @$); n->set_property ("pitch", $1); - n->set_spot (@$); if (q % 2) n->set_property ("cautionary", SCM_BOOL_T); if (ex % 2 || q % 2) @@ -1351,10 +1350,9 @@ chord_body_element: $$ = n->unprotect (); } | DRUM_PITCH post_events { - Music *n = MY_MAKE_MUSIC ("NoteEvent"); + Music *n = MY_MAKE_MUSIC ("NoteEvent", @$); n->set_property ("duration", $2); n->set_property ("drum-type", $1); - n->set_spot (@$); if (scm_is_pair ($2)) { SCM arts = scm_reverse_x ($2, SCM_EOL); @@ -1408,15 +1406,13 @@ command_element: $$ = MAKE_SYNTAX ("skip-music", @$, $2); } | E_BRACKET_OPEN { - Music *m = MY_MAKE_MUSIC ("LigatureEvent"); + Music *m = MY_MAKE_MUSIC ("LigatureEvent", @$); m->set_property ("span-direction", scm_from_int (START)); - m->set_spot (@$); $$ = m->unprotect(); } | E_BRACKET_CLOSE { - Music *m = MY_MAKE_MUSIC ("LigatureEvent"); + Music *m = MY_MAKE_MUSIC ("LigatureEvent", @$); m->set_property ("span-direction", scm_from_int (STOP)); - m->set_spot (@$); $$ = m->unprotect (); } | E_BACKSLASH { @@ -1456,22 +1452,23 @@ command_element: command_event: E_TILDE { - $$ = MY_MAKE_MUSIC ("PesOrFlexaEvent")->unprotect (); + $$ = MY_MAKE_MUSIC ("PesOrFlexaEvent", @$)->unprotect (); } | MARK DEFAULT { - Music *m = MY_MAKE_MUSIC ("MarkEvent"); + Music *m = MY_MAKE_MUSIC ("MarkEvent", @$); $$ = m->unprotect (); + scm_display($$, SCM_UNDEFINED); } | tempo_event { $$ = $1; } | KEY DEFAULT { - Music *key = MY_MAKE_MUSIC ("KeyChangeEvent"); + Music *key = MY_MAKE_MUSIC ("KeyChangeEvent", @$); $$ = key->unprotect (); } | KEY NOTENAME_PITCH SCM_IDENTIFIER { - Music *key = MY_MAKE_MUSIC ("KeyChangeEvent"); + Music *key = MY_MAKE_MUSIC ("KeyChangeEvent", @$); if (scm_ilength ($3) > 0) { key->set_property ("pitch-alist", $3); @@ -1506,12 +1503,12 @@ post_event: | HYPHEN { if (!PARSER->lexer_->is_lyric_state ()) PARSER->parser_error (@1, _ ("have to be in Lyric mode for lyrics")); - $$ = MY_MAKE_MUSIC ("HyphenEvent")->unprotect (); + $$ = MY_MAKE_MUSIC ("HyphenEvent", @$)->unprotect (); } | EXTENDER { if (!PARSER->lexer_->is_lyric_state ()) PARSER->parser_error (@1, _ ("have to be in Lyric mode for lyrics")); - $$ = MY_MAKE_MUSIC ("ExtenderEvent")->unprotect (); + $$ = MY_MAKE_MUSIC ("ExtenderEvent", @$)->unprotect (); } | script_dir direction_reqd_event { if ($1) @@ -1534,9 +1531,8 @@ post_event: string_number_event: E_UNSIGNED { - Music *s = MY_MAKE_MUSIC ("StringNumberEvent"); + Music *s = MY_MAKE_MUSIC ("StringNumberEvent", @$); s->set_property ("string-number", scm_from_int ($1)); - s->set_spot (@$); $$ = s->unprotect (); } ; @@ -1581,20 +1577,19 @@ direction_less_event: if (unsmob_music (predefd)) { m = unsmob_music (predefd)->clone (); + m->set_spot (@$); } else { - m = MY_MAKE_MUSIC ("Music"); + m = MY_MAKE_MUSIC ("Music", @$); } - m->set_spot (@$); $$ = m->unprotect (); } | EVENT_IDENTIFIER { $$ = $1; } | tremolo_type { - Music *a = MY_MAKE_MUSIC ("TremoloEvent"); - a->set_spot (@$); + Music *a = MY_MAKE_MUSIC ("TremoloEvent", @$); a->set_property ("tremolo-type", scm_from_int ($1)); $$ = a->unprotect (); } @@ -1606,7 +1601,7 @@ direction_reqd_event: } | script_abbreviation { SCM s = PARSER->lexer_->lookup_identifier ("dash" + ly_scm2string ($1)); - Music *a = MY_MAKE_MUSIC ("ArticulationEvent"); + Music *a = MY_MAKE_MUSIC ("ArticulationEvent", @$); if (scm_is_string (s)) a->set_property ("articulation-type", s); else PARSER->parser_error (@1, _ ("expecting string as script definition")); @@ -1689,22 +1684,19 @@ pitch_also_in_chords: gen_text_def: full_markup { - Music *t = MY_MAKE_MUSIC ("TextScriptEvent"); + Music *t = MY_MAKE_MUSIC ("TextScriptEvent", @$); t->set_property ("text", $1); - t->set_spot (@$); $$ = t->unprotect (); } | string { - Music *t = MY_MAKE_MUSIC ("TextScriptEvent"); + Music *t = MY_MAKE_MUSIC ("TextScriptEvent", @$); t->set_property ("text", make_simple_markup ($1)); - t->set_spot (@$); $$ = t->unprotect (); } | DIGIT { - Music *t = MY_MAKE_MUSIC ("FingeringEvent"); + Music *t = MY_MAKE_MUSIC ("FingeringEvent", @$); t->set_property ("digit", scm_from_int ($1)); - t->set_spot (@$); $$ = t->unprotect (); } ; @@ -1841,13 +1833,11 @@ figured_bass_alteration: bass_figure: FIGURE_SPACE { - Music *bfr = MY_MAKE_MUSIC ("BassFigureEvent"); - $$ = bfr->self_scm (); - bfr->unprotect (); - bfr->set_spot (@1); + Music *bfr = MY_MAKE_MUSIC ("BassFigureEvent", @$); + $$ = bfr->unprotect (); } | bass_number { - Music *bfr = MY_MAKE_MUSIC ("BassFigureEvent"); + Music *bfr = MY_MAKE_MUSIC ("BassFigureEvent", @$); $$ = bfr->self_scm (); if (scm_is_number ($1)) @@ -1856,7 +1846,6 @@ bass_figure: bfr->set_property ("text", $1); bfr->unprotect (); - bfr->set_spot (@1); } | bass_figure ']' { $$ = $1; @@ -1941,9 +1930,9 @@ simple_element: Music *n = 0; if ($6) - n = MY_MAKE_MUSIC ("RestEvent"); + n = MY_MAKE_MUSIC ("RestEvent", @$); else - n = MY_MAKE_MUSIC ("NoteEvent"); + n = MY_MAKE_MUSIC ("NoteEvent", @$); n->set_property ("pitch", $1); n->set_property ("duration", $5); @@ -1959,11 +1948,10 @@ simple_element: if ($2 % 2 || $3 % 2) n->set_property ("force-accidental", SCM_BOOL_T); - n->set_spot (@$); $$ = n->unprotect (); } | DRUM_PITCH optional_notemode_duration { - Music *n = MY_MAKE_MUSIC ("NoteEvent"); + Music *n = MY_MAKE_MUSIC ("NoteEvent", @$); n->set_property ("duration", $2); n->set_property ("drum-type", $1); @@ -1973,24 +1961,22 @@ simple_element: Music *ev = 0; if (ly_scm2string ($1) == "s") { /* Space */ - ev = MY_MAKE_MUSIC ("SkipEvent"); + ev = MY_MAKE_MUSIC ("SkipEvent", @$); } else { - ev = MY_MAKE_MUSIC ("RestEvent"); + ev = MY_MAKE_MUSIC ("RestEvent", @$); } ev->set_property ("duration", $2); - ev->set_spot (@$); $$ = ev->unprotect (); } | lyric_element optional_notemode_duration { if (!PARSER->lexer_->is_lyric_state ()) PARSER->parser_error (@1, _ ("have to be in Lyric mode for lyrics")); - Music *levent = MY_MAKE_MUSIC ("LyricEvent"); + Music *levent = MY_MAKE_MUSIC ("LyricEvent", @$); levent->set_property ("text", $1); levent->set_property ("duration",$2); - levent->set_spot (@$); $$= levent->unprotect (); } ; @@ -2445,6 +2431,13 @@ is_regular_identifier (SCM id) return v; } +Music * +make_music_with_input (SCM name, Input where) +{ + Music *m = make_music_by_name (name); + m->set_spot (where); + return m; +} SCM get_first_context_id (SCM type, Music *m) @@ -2509,9 +2502,9 @@ ly_input_procedure_p (SCM x) } SCM -make_music_relative (Pitch start, SCM music) +make_music_relative (Pitch start, SCM music, Input loc) { - Music *relative = MY_MAKE_MUSIC ("RelativeOctaveMusic"); + Music *relative = MY_MAKE_MUSIC ("RelativeOctaveMusic", loc); relative->set_property ("element", music); Music *m = unsmob_music (music); diff --git a/lily/prob.cc b/lily/prob.cc index bff24e5ade..2c651358f3 100644 --- a/lily/prob.cc +++ b/lily/prob.cc @@ -14,7 +14,49 @@ IMPLEMENT_SMOBS (Prob); IMPLEMENT_TYPE_P (Prob, "ly:prob?"); -IMPLEMENT_DEFAULT_EQUAL_P (Prob); + +SCM +Prob::equal_p (SCM sa, SCM sb) +{ + /* This comparison function is only designed to make the copy + constructor preserve equality. + + Perhaps it would be better to use a more strict definition of + equality; e.g., that that two probs are equal iff they can be + distinguished by calls to ly:prob-property. + */ + Prob *probs[2] = {unsmob_prob (sa), unsmob_prob (sb)}; + SCM props[2][2]; + int i; + + for (i = 0; i < 2; i++) + { + props[i][0] = probs[i]->immutable_property_alist_; + props[i][1] = probs[i]->mutable_property_alist_; + } + + if (strcmp (probs[0]->class_name (), probs[1]->class_name ())) + return SCM_BOOL_F; + + /* Compare mutable and immutable lists, element by element. */ + for (i = 0; i < 2; i++) + { + SCM aprop = props[0][i], bprop = props[1][i]; + + for (; scm_is_pair (aprop) && scm_is_pair(bprop); aprop = scm_cdr (aprop), bprop = scm_cdr (bprop)) + { + if (scm_caar (aprop) != scm_caar (bprop) || + !to_boolean (scm_equal_p (scm_cdar (aprop), scm_cdar (bprop)))) + return SCM_BOOL_F; + } + + /* is one list shorter? */ + if (aprop != SCM_EOL || bprop != SCM_EOL) + return SCM_BOOL_F; + } + + return SCM_BOOL_T; +} Prob::Prob (SCM type, SCM immutable_init) { diff --git a/lily/translator.cc b/lily/translator.cc index d90c8be045..4738465198 100644 --- a/lily/translator.cc +++ b/lily/translator.cc @@ -184,19 +184,38 @@ Translator::add_translator_listener (translator_listener_record **listener_list, } /* - Used by ADD_THIS_TRANSLATOR to extract a list of event-class names - for each translator. This list is used by the internals - documentation. + Helps the individual static_translator_description methods of translators. */ SCM -Translator::get_listened_class_list (const translator_listener_record *listeners) const +Translator::static_translator_description (const char *grobs, + const char *desc, + translator_listener_record *listener_list, + const char *read, + const char *write) const { + SCM static_properties = SCM_EOL; + + static_properties = scm_acons (ly_symbol2scm ("grobs-created"), + parse_symbol_list (grobs), static_properties); + + static_properties = scm_acons (ly_symbol2scm ("description"), + scm_makfrom0str (desc), static_properties); + SCM list = SCM_EOL; - for (; listeners; listeners = listeners->next_) - list = scm_cons (listeners->event_class_, list); - return list; + for (; listener_list; listener_list = listener_list->next_) + list = scm_cons (listener_list->event_class_, list); + static_properties = scm_acons (ly_symbol2scm ("events-accepted"), + list, static_properties); + + static_properties = scm_acons (ly_symbol2scm ("properties-read"), + parse_symbol_list (read), static_properties); + + static_properties = scm_acons (ly_symbol2scm ("properties-written"), + parse_symbol_list (write), static_properties); + + return static_properties; } - + /* SMOBS */ @@ -294,7 +313,9 @@ get_event_length (Stream_event *e) bool internal_event_assignment (Stream_event **old_ev, Stream_event *new_ev, const char *function) { - if (*old_ev) + if (*old_ev && + !to_boolean (scm_equal_p ((*old_ev)->self_scm (), + new_ev->self_scm ()))) { /* extract event class from function name */ const char *prefix = "listen_"; diff --git a/scm/document-music.scm b/scm/document-music.scm index d6bd4e1c59..b720b592f7 100644 --- a/scm/document-music.scm +++ b/scm/document-music.scm @@ -18,14 +18,18 @@ texi))) (define music-types->names (make-vector 61 '())) -(map (lambda (entry) - (let* ((types (cdr (assoc 'types (cdr entry))))) - (map (lambda (type) - (hashq-set! music-types->names type - (cons (car entry) - (hashq-ref music-types->names type '())))) - types))) - music-descriptions) +(filter-map (lambda (entry) + (let* ((class (ly:camel-case->lisp-identifier (car entry))) + (classes (ly:make-event-class class))) + (if classes + (map (lambda (cl) + (hashq-set! music-types->names cl + (cons (car entry) + (hashq-ref music-types->names cl '())))) + classes) + #f))) + + music-descriptions) (define (strip-description x) (cons (symbol->string (car x)) @@ -64,19 +68,24 @@ (define (music-doc-str obj) (let* ((namesym (car obj)) (props (cdr obj)) - (types (cdr (assoc 'types props)))) - + (class (ly:camel-case->lisp-identifier namesym)) + (classes (ly:make-event-class class)) + (event-texi (if classes + (string-append + "\n\nEvent classes:\n" + (human-listify (map ref-ify (map symbol->string classes))) + "\n\n" + "\n\nAccepted by: " + (human-listify + (map ref-ify + (map symbol->string (map ly:translator-name + (filter + (lambda (x) (engraver-accepts-music-types? classes x)) all-engravers-list)))))) + ""))) + (string-append (object-property namesym 'music-description) - "\n\nMusic types:\n" - (human-listify (map ref-ify (map symbol->string types))) - "\n\n" - "\n\nAccepted by: " - (human-listify - (map ref-ify - (map symbol->string (map ly:translator-name - (filter - (lambda (x) (engraver-accepts-music-types? types x)) all-engravers-list))))) + event-texi "\n\nProperties: \n" (description-list->texi (map -- 2.39.5