source file of the GNU LilyPond music typesetter
- Copyright (c) 2009--2012 Han-Wen Nienhuys <hanwen@lilypond.org>
+ Copyright (c) 2009--2015 Han-Wen Nienhuys <hanwen@lilypond.org>
LilyPond is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
#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
}
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);
// 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);
if (!(ly_is_procedure (proc) && ly_is_symbol (iface)))
continue;
- scm_hashq_set_x (*hash, iface, proc);
+ unsmob<Scheme_hash_table>(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 */
- ""
- );
projects / lilypond.git / blobdiff