X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fscheme-engraver.cc;h=42ab3f036783cbc1c8489d6517b689cb33d7dd98;hb=a6a51abfd0195a3cf7d6ea095cf69808852f21ce;hp=cde829a60788bec5b140942dad26a6fd75168184;hpb=08560a1b8076630c4fc6cb9b902614d8b74fd6fc;p=lilypond.git diff --git a/lily/scheme-engraver.cc b/lily/scheme-engraver.cc index cde829a607..42ab3f0367 100644 --- a/lily/scheme-engraver.cc +++ b/lily/scheme-engraver.cc @@ -3,7 +3,7 @@ source file of the GNU LilyPond music typesetter - Copyright (c) 2009--2012 Han-Wen Nienhuys + Copyright (c) 2009--2015 Han-Wen Nienhuys LilyPond is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -25,40 +25,30 @@ #include "translator.icc" -Scheme_engraver::Scheme_engraver () +#include "scm-hash.hh" + +Preinit_Scheme_engraver::Preinit_Scheme_engraver () { - stop_translation_timestep_function_ = SCM_EOL; - start_translation_timestep_function_ = SCM_EOL; - process_music_function_ = SCM_EOL; - process_acknowledged_function_ = SCM_EOL; initialize_function_ = SCM_EOL; finalize_function_ = SCM_EOL; - listeners_alist_ = SCM_EOL; - interface_acknowledger_hash_ = SCM_EOL; - interface_end_acknowledger_hash_ = SCM_EOL; + interface_acknowledger_hash_.set (SCM_EOL, SCM_EOL); - must_be_last_ = false; - per_instance_listeners_ = 0; + per_instance_listeners_ = SCM_EOL; + for (int i = 0; i < TRANSLATOR_METHOD_PRECOMPUTE_COUNT; i++) + precomputable_methods_[i] = SCM_UNDEFINED; } Scheme_engraver::~Scheme_engraver () { - translator_listener_record *next = 0; - for (translator_listener_record *r = per_instance_listeners_; - r; r = next) - { - next = r->next_; - delete r; - } } -// Extracts the value if callable, if not return #f. +// Extracts the value if callable, if not return SCM_UNDEFINED; static SCM callable (SCM symbol, SCM defn) { SCM val = ly_assoc_get (symbol, defn, SCM_BOOL_F); - return ly_is_procedure (val) ? val : SCM_BOOL_F; + return ly_is_procedure (val) ? val : SCM_UNDEFINED; } bool @@ -68,28 +58,34 @@ Scheme_engraver::must_be_last () const } void -Scheme_engraver::init_from_scheme (SCM definition) +Scheme_engraver::fetch_precomputable_methods (SCM ptrs[]) +{ + for (int i = 0; i < TRANSLATOR_METHOD_PRECOMPUTE_COUNT; i++) + ptrs[i] = precomputable_methods_[i]; +} + +Scheme_engraver::Scheme_engraver (SCM definition, Context *c) + : Engraver (c) { - start_translation_timestep_function_ = callable (ly_symbol2scm ("start-translation-timestep"), - definition); - stop_translation_timestep_function_ = callable (ly_symbol2scm ("stop-translation-timestep"), - definition); - process_music_function_ = callable (ly_symbol2scm ("process-music"), definition); - process_acknowledged_function_ = callable (ly_symbol2scm ("process-acknowledged"), - definition); + precomputable_methods_[START_TRANSLATION_TIMESTEP] + = callable (ly_symbol2scm ("start-translation-timestep"), definition); + precomputable_methods_[STOP_TRANSLATION_TIMESTEP] + = callable (ly_symbol2scm ("stop-translation-timestep"), definition); + precomputable_methods_[PROCESS_MUSIC] + = callable (ly_symbol2scm ("process-music"), definition); + precomputable_methods_[PROCESS_ACKNOWLEDGED] + = callable (ly_symbol2scm ("process-acknowledged"), definition); initialize_function_ = callable (ly_symbol2scm ("initialize"), definition); finalize_function_ = callable (ly_symbol2scm ("finalize"), definition); - SCM listeners = ly_assoc_get (ly_symbol2scm ("listeners"), definition, SCM_EOL); - - listeners_alist_ = SCM_EOL; + SCM p = ly_assoc_get (ly_symbol2scm ("listeners"), definition, SCM_EOL); + SCM listeners = SCM_EOL; must_be_last_ = to_boolean (ly_assoc_get (ly_symbol2scm ("must-be-last"), definition, SCM_BOOL_F)); - translator_listener_record **tail = &per_instance_listeners_; - for (SCM p = listeners; scm_is_pair (p); p = scm_cdr (p)) + for (; scm_is_pair (p); p = scm_cdr (p)) { SCM event_class = scm_caar (p); SCM proc = scm_cdar (p); @@ -100,32 +96,35 @@ Scheme_engraver::init_from_scheme (SCM definition) // We should check the arity of the function? // Record for later lookup. - listeners_alist_ = scm_acons (event_class, proc, listeners_alist_); - - translator_listener_record *rec = new translator_listener_record; - *tail = rec; - rec->event_class_ = event_class; - rec->get_listener_ = &Scheme_engraver::get_listener; - tail = &rec->next_; + listeners = scm_acons (event_class, proc, listeners); } - init_acknowledgers (ly_assoc_get (ly_symbol2scm ("acknowledgers"), - definition, SCM_EOL), - &interface_acknowledger_hash_); + SCM hash1 = + init_acknowledgers (ly_assoc_get (ly_symbol2scm ("acknowledgers"), + definition, SCM_EOL)); + SCM hash2 = + init_acknowledgers (ly_assoc_get (ly_symbol2scm ("end-acknowledgers"), + definition, SCM_EOL)); + + per_instance_listeners_ = listeners; + interface_acknowledger_hash_.set (hash1, hash2); - init_acknowledgers (ly_assoc_get (ly_symbol2scm ("end-acknowledgers"), - definition, SCM_EOL), - &interface_end_acknowledger_hash_); + // It's not defined whether Scheme_engraver::derived_mark is already + // active while the construction is underway, so we make sure we + // keep a version of everything on the stack that is not still + // covered by `definition'. + + scm_remember_upto_here_2 (definition, listeners); + scm_remember_upto_here_2 (hash1, hash2); // TODO: hook up description, props read/written, grobs created // etc. to provide automatic documentation. } -void -Scheme_engraver::init_acknowledgers (SCM alist, - SCM *hash) +SCM +Scheme_engraver::init_acknowledgers (SCM alist) { - *hash = scm_c_make_hash_table (7); + SCM hash = Scheme_hash_table::make_smob (); for (SCM p = alist; scm_is_pair (p); p = scm_cdr (p)) { SCM iface = scm_caar (p); @@ -134,125 +133,40 @@ Scheme_engraver::init_acknowledgers (SCM alist, if (!(ly_is_procedure (proc) && ly_is_symbol (iface))) continue; - scm_hashq_set_x (*hash, iface, proc); + unsmob(hash)->set (iface, proc); } + return hash; } -// This is the easy way to do it, at the cost of too many invocations -// of Scheme_engraver::acknowledge_grob. The clever dispatching of -// acknowledgers is hardwired to have 1 method per engraver per -// grob-type, which doesn't work for this case. -void -Scheme_engraver::acknowledge_grob (Grob_info info) +SCM +Scheme_engraver::get_listener_list () const { - acknowledge_grob_by_hash (info, interface_acknowledger_hash_); + return per_instance_listeners_; } void -Scheme_engraver::acknowledge_end_grob (Grob_info info) +Scheme_engraver::initialize () { - acknowledge_grob_by_hash (info, interface_end_acknowledger_hash_); + if (!SCM_UNBNDP (initialize_function_)) + scm_call_1 (initialize_function_, self_scm ()); } void -Scheme_engraver::acknowledge_grob_by_hash (Grob_info info, - SCM iface_function_hash) -{ - SCM meta = info.grob ()->internal_get_property (ly_symbol2scm ("meta")); - SCM ifaces = scm_cdr (scm_assoc (ly_symbol2scm ("interfaces"), meta)); - for (SCM s = ifaces; scm_is_pair (s); s = scm_cdr (s)) - { - SCM func = scm_hashq_ref (iface_function_hash, - scm_car (s), SCM_BOOL_F); - - if (ly_is_procedure (func)) - scm_call_3 (func, self_scm (), info.grob ()->self_scm (), - info.origin_translator ()->self_scm ()); - } -} - -static -void call_listen_closure (void *target, SCM ev) +Scheme_engraver::finalize () { - SCM cl = (SCM) target; - SCM func = scm_car (cl); - SCM engraver = scm_cdr (cl); - scm_call_2 (func, engraver, ev); + if (!SCM_UNBNDP (finalize_function_)) + scm_call_1 (finalize_function_, self_scm ()); } -static -void mark_listen_closure (void *target) -{ - scm_gc_mark ((SCM)target); -} - -Listener_function_table listen_closure -= -{ - call_listen_closure, mark_listen_closure -}; - -/* static */ -Listener -Scheme_engraver::get_listener (void *arg, SCM name) -{ - Scheme_engraver *me = (Scheme_engraver *) arg; - SCM func = ly_assoc_get (name, me->listeners_alist_, SCM_BOOL_F); - assert (ly_is_procedure (func)); - - SCM closure = scm_cons (func, me->self_scm ()); - return Listener ((void *)closure, &listen_closure); -} - -translator_listener_record * -Scheme_engraver::get_listener_list () const -{ - return per_instance_listeners_; -} - -#define DISPATCH(what) \ - void \ - Scheme_engraver::what () \ - { \ - if (what ## _function_ != SCM_BOOL_F) \ - scm_call_1 (what ## _function_, self_scm ()); \ - } - -DISPATCH (start_translation_timestep); -DISPATCH (stop_translation_timestep); -DISPATCH (initialize); -DISPATCH (finalize); -DISPATCH (process_music); -DISPATCH (process_acknowledged); - void Scheme_engraver::derived_mark () const { - scm_gc_mark (start_translation_timestep_function_); - scm_gc_mark (stop_translation_timestep_function_); + for (int i = 0; i < TRANSLATOR_METHOD_PRECOMPUTE_COUNT; i++) + scm_gc_mark (precomputable_methods_[i]); + scm_gc_mark (initialize_function_); scm_gc_mark (finalize_function_); - scm_gc_mark (process_music_function_); - scm_gc_mark (process_acknowledged_function_); - scm_gc_mark (listeners_alist_); - scm_gc_mark (interface_acknowledger_hash_); - scm_gc_mark (interface_end_acknowledger_hash_); + scm_gc_mark (per_instance_listeners_); + scm_gc_mark (interface_acknowledger_hash_[START]); + scm_gc_mark (interface_acknowledger_hash_[STOP]); } - -ADD_ACKNOWLEDGER (Scheme_engraver, grob); -ADD_END_ACKNOWLEDGER (Scheme_engraver, grob); - -ADD_TRANSLATOR (Scheme_engraver, - /* doc */ - "Implement engravers in Scheme. Interprets arguments to" - " @code{\\consists} as callbacks.", - - /* create */ - "", - - /* read */ - "", - - /* write */ - "" - );