From 6887546c5caf87cdc94252c020f39b43a57bf057 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Tue, 16 Jun 2015 14:14:27 +0200 Subject: [PATCH] Issue 1375/2: Create Translator_creator class Previously, translators were created by copying from a context-less instantiation of the translator containing its documentation. This had several unpleasant consequences, the most problematic likely being the inability to register Scheme engravers because their documentation would be identical to all other Scheme engravers. A new Translator_creator class takes over the task of creating Translator instances when called with a context argument. As a result of joining the mechanisms for Scheme engravers and C++ engravers, ly:translator-name and ly:translator-description are reimplemented in a manner resembling object properties. --- lily/context-def.cc | 2 +- lily/include/lily-proto.hh | 1 + lily/include/scheme-engraver.hh | 5 +-- lily/include/translator.hh | 73 +++++++++++++++++++++++++-------- lily/include/translator.icc | 36 ++++++++-------- lily/scheme-engraver.cc | 4 +- lily/translator-ctors.cc | 67 +++++++++++++++++++++++++----- lily/translator-group.cc | 56 +++++++++---------------- lily/translator-scheme.cc | 20 --------- lily/translator.cc | 8 +--- 10 files changed, 157 insertions(+), 115 deletions(-) diff --git a/lily/context-def.cc b/lily/context-def.cc index 402bd80b6e..5768ee5471 100644 --- a/lily/context-def.cc +++ b/lily/context-def.cc @@ -294,7 +294,7 @@ Context_def::get_translator_names (SCM user_mod) const else if (scm_is_eq (tag, ly_symbol2scm ("remove")) && (scm_is_pair (arg) || ly_is_procedure (arg) - || get_translator (arg))) + || get_translator_creator (arg))) l1 = scm_delete_x (arg, l1); } diff --git a/lily/include/lily-proto.hh b/lily/include/lily-proto.hh index 6de69e16b9..5550fd405f 100644 --- a/lily/include/lily-proto.hh +++ b/lily/include/lily-proto.hh @@ -171,6 +171,7 @@ class Time_scaled_music_iterator; class Time_signature_performer; class Timing_translator; class Translator; +class Translator_creator; class Translator_group; #endif /* LILY_PROTO_HH */ diff --git a/lily/include/scheme-engraver.hh b/lily/include/scheme-engraver.hh index 11caf9f9c2..79e01a7e1d 100644 --- a/lily/include/scheme-engraver.hh +++ b/lily/include/scheme-engraver.hh @@ -41,7 +41,7 @@ class Scheme_engraver : Preinit_Scheme_engraver, public Engraver { public: TRANSLATOR_FAMILY_DECLARATIONS (Scheme_engraver); - Scheme_engraver (SCM definition); + Scheme_engraver (SCM definition, Context *c); protected: ~Scheme_engraver (); @@ -60,9 +60,6 @@ private: } SCM init_acknowledgers (SCM alist); - // For now no description. In future, something derived from the - // definition might make sense. - SCM translator_description () const { return SCM_EOL; } bool must_be_last_; }; diff --git a/lily/include/translator.hh b/lily/include/translator.hh index ffd134efab..91bd59fe4a 100644 --- a/lily/include/translator.hh +++ b/lily/include/translator.hh @@ -30,9 +30,50 @@ #include "std-vector.hh" #include "protected-scm.hh" +// The Translator_creator class is only for translators defined in C. +// Its elements are callable entities taking a context argument and +// returning a corresponding translator. +// +// Other translator-creating entities may be alists and functions returning +// such alists. Information for those, such as created grobs/properties +// is attached via object properties. + +// Smob rather than Simple_smob since we want an entity for +// property lookup. + +class Translator_creator : public Smob +{ + Translator_creator (Translator_creator const &); // don't define + Translator * (*allocate_)(Context *); + template + static Translator *allocate (Context *ctx); + + Translator_creator (Translator * (*allocate)(Context *)) + : allocate_(allocate) + { + smobify_self (); + } +public: + // This is stupid, but constructors cannot have explicit template + // argument lists. + template + static Translator_creator *alloc() + { + return new Translator_creator(&allocate); + } + SCM call (SCM ctx); + LY_DECLARE_SMOB_PROC (&Translator_creator::call, 1, 0, 0); +}; + +template Translator * +Translator_creator::allocate (Context *ctx) +{ + return new T(ctx); +} + #define TRANSLATOR_FAMILY_DECLARATIONS(NAME) \ public: \ - VIRTUAL_COPY_CONSTRUCTOR (Translator, NAME); \ + DECLARE_CLASSNAME (NAME); \ virtual void fetch_precomputable_methods (SCM methods[]); \ DECLARE_TRANSLATOR_CALLBACKS (NAME); \ TRANSLATOR_INHERIT (Translator); \ @@ -69,7 +110,6 @@ public: \ TRANSLATOR_FAMILY_DECLARATIONS (NAME); \ static Drul_array acknowledge_static_array_drul_; \ - static SCM static_description_; \ static Protected_scm listener_list_; \ static SCM static_get_acknowledger (SCM sym, Direction start_end); \ virtual SCM get_acknowledger (SCM sym, Direction start_end) \ @@ -79,8 +119,7 @@ public: \ NAME (Context *); \ static void boot (); \ - virtual SCM static_translator_description () const; \ - virtual SCM translator_description () const; \ + static SCM static_translator_description (); \ virtual SCM get_listener_list () const \ { \ return listener_list_; \ @@ -109,8 +148,11 @@ public: Context *context () const { return daddy_context_; } +protected: Translator (Context *); - Translator (Translator const &); +private: + Translator (Translator const &); // not copyable +public: SCM internal_get_property (SCM symbol) const; @@ -134,10 +176,9 @@ public: Global_context *get_global_context () const; DECLARE_CLASSNAME (Translator); - virtual Translator *clone () const = 0; + virtual void fetch_precomputable_methods (SCM methods[]) = 0; virtual SCM get_listener_list () const = 0; - virtual SCM translator_description () const = 0; virtual SCM get_acknowledger (SCM sym, Direction start_end) = 0; protected: // should be private. @@ -164,22 +205,22 @@ protected: // should be private. virtual void derived_mark () const; static SCM event_class_symbol (const char *ev_class); - SCM static_translator_description (const char *grobs, - const char *desc, - SCM listener_list, - const char *read, - const char *write) const; + static SCM + static_translator_description (const char *grobs, + const char *desc, + SCM listener_list, + const char *read, + const char *write); friend class Translator_group; }; -void add_translator (Translator *trans); - -Translator *get_translator (SCM s); - SCM generic_get_acknowledger (SCM sym, SCM ack_hash); +void add_translator_creator (SCM creator, SCM name, SCM description); + +SCM get_translator_creator (SCM s); Moment get_event_length (Stream_event *s, Moment now); Moment get_event_length (Stream_event *s); diff --git a/lily/include/translator.icc b/lily/include/translator.icc index 20954ead0b..9bd6163fea 100644 --- a/lily/include/translator.icc +++ b/lily/include/translator.icc @@ -32,24 +32,19 @@ A macro to automate administration of translators. */ #define ADD_THIS_TRANSLATOR(T) \ - SCM T::static_description_ = SCM_EOL; \ static void _ ## T ## _adder () \ { \ T::boot (); \ - T *t = new T(0); \ - T::static_description_ = \ - scm_permanent_object (t->static_translator_description ()); \ - add_translator (t); \ - } \ - SCM T::translator_description () const \ - { \ - return static_description_; \ + add_translator_creator (Translator_creator::alloc()->unprotect (), \ + scm_from_ascii_symbol (#T), \ + T::static_translator_description ()); \ } \ ADD_GLOBAL_CTOR (_ ## T ## _adder); \ /* end define */ -#define DEFINE_TRANSLATOR_LISTENER_LIST(T) \ - Protected_scm T::listener_list_ (SCM_EOL) +#define DEFINE_TRANSLATOR_LISTENER_LIST(T) \ + Protected_scm T::listener_list_ (SCM_EOL); \ + /* end define */ #define DEFINE_ACKNOWLEDGERS(classname) \ Drul_array classname::acknowledge_static_array_drul_; \ @@ -61,9 +56,9 @@ } \ /* end define */ -#define DEFINE_TRANSLATOR_DOC(classname, desc, grobs, read, write) \ +#define DEFINE_TRANSLATOR_DOC(classname, desc, grobs, read, write) \ SCM \ - classname::static_translator_description () const \ + classname::static_translator_description () \ { \ return Translator::static_translator_description (grobs, desc, listener_list_, read, write); \ } @@ -81,14 +76,14 @@ { \ ptrs[START_TRANSLATION_TIMESTEP] = \ method_finder <&T::start_translation_timestep> (); \ - \ - ptrs[STOP_TRANSLATION_TIMESTEP] = \ + \ + ptrs[STOP_TRANSLATION_TIMESTEP] = \ method_finder <&T::stop_translation_timestep> (); \ \ - ptrs[PROCESS_MUSIC] = \ + ptrs[PROCESS_MUSIC] = \ method_finder <&T::process_music> (); \ - \ - ptrs[PROCESS_ACKNOWLEDGED] = \ + \ + ptrs[PROCESS_ACKNOWLEDGED] = \ method_finder <&T::process_acknowledged> (); \ } @@ -115,6 +110,11 @@ void add_acknowledger (SCM ptr, /* Implement the method cl::listen_##m, and make it listen to stream events of class m. + + At macro call time, neither creator instances (which are anonymous + and only accessible via the translator registry) nor translator + instances exist, so the only named place where we can store it is in + a static member of the translator class. */ #define ADD_LISTENER_FOR(cl, m, ev) \ listener_list_ = scm_acons \ diff --git a/lily/scheme-engraver.cc b/lily/scheme-engraver.cc index ad4186d81c..42ab3f0367 100644 --- a/lily/scheme-engraver.cc +++ b/lily/scheme-engraver.cc @@ -64,8 +64,8 @@ Scheme_engraver::fetch_precomputable_methods (SCM ptrs[]) ptrs[i] = precomputable_methods_[i]; } -Scheme_engraver::Scheme_engraver (SCM definition) - : Engraver (0) +Scheme_engraver::Scheme_engraver (SCM definition, Context *c) + : Engraver (c) { precomputable_methods_[START_TRANSLATION_TIMESTEP] = callable (ly_symbol2scm ("start-translation-timestep"), definition); diff --git a/lily/translator-ctors.cc b/lily/translator-ctors.cc index 67fa95a610..7559bf30b4 100644 --- a/lily/translator-ctors.cc +++ b/lily/translator-ctors.cc @@ -17,18 +17,22 @@ along with LilyPond. If not, see . */ +#include "context.hh" #include "translator.hh" - +#include "lily-imports.hh" #include "international.hh" #include "scm-hash.hh" #include "warn.hh" #include "protected-scm.hh" -/* - should delete these after exit. -*/ +SCM +Translator_creator::call (SCM ctx) +{ + return (allocate_ (LY_ASSERT_SMOB (Context, ctx, 1)))->unprotect (); +} Protected_scm global_translator_dict; +Protected_scm global_translator_dict_rev; LY_DEFINE (get_all_translators, "ly:get-all-translators", 0, 0, 0, (), "Return a list of all translator objects that may be" @@ -44,21 +48,63 @@ LY_DEFINE (get_all_translators, "ly:get-all-translators", 0, 0, 0, (), } void -add_translator (Translator *t) +add_translator_creator (SCM creator, SCM name, SCM description) { Scheme_hash_table *dict = unsmob (global_translator_dict); if (!dict) { global_translator_dict = Scheme_hash_table::make_smob (); + global_translator_dict_rev = + scm_make_weak_key_hash_table (scm_from_int (119)); dict = unsmob (global_translator_dict); } + dict->set (name, creator); + scm_hashq_set_x (global_translator_dict_rev, creator, scm_cons (name, description)); +} - SCM k = ly_symbol2scm (t->class_name ()); - dict->set (k, t->unprotect ()); +LY_DEFINE (ly_translator_name, "ly:translator-name", + 1, 0, 0, (SCM creator), + "Return the type name of the translator definition @var{creator}." + " The name is a symbol.") +{ + SCM res = SCM_UNBNDP (SCM (global_translator_dict_rev)) ? SCM_BOOL_F + : scm_hashq_ref (global_translator_dict_rev, creator, SCM_BOOL_F); + SCM_ASSERT_TYPE (scm_is_pair (res), + creator, SCM_ARG1, __FUNCTION__, "translator definition"); + return scm_car (res); +} + +LY_DEFINE (ly_translator_description, "ly:translator-description", + 1, 0, 0, (SCM creator), + "Return an alist of properties of translator definition @var{creator}.") +{ + SCM res = SCM_UNBNDP (SCM (global_translator_dict_rev)) ? SCM_BOOL_F + : scm_hashq_ref (global_translator_dict_rev, creator, SCM_BOOL_F); + SCM_ASSERT_TYPE (scm_is_pair (res), + creator, SCM_ARG1, __FUNCTION__, "translator definition"); + return scm_cdr (res); +} + +LY_DEFINE (ly_register_translator, "ly:register-translator", + 2, 1, 0, (SCM creator, SCM name, SCM description), + "Register a translator @var{creator} (usually a descriptive" + " alist or a function/closure returning one when given a" + " context argument) with the given symbol @var{name} and" + " the given @var{description} alist.") +{ + SCM_ASSERT_TYPE (ly_is_procedure (creator) || scm_is_pair (creator), + creator, SCM_ARG1, __FUNCTION__, "translator creator"); + LY_ASSERT_TYPE (ly_is_symbol, name, 2); + if (SCM_UNBNDP (description)) + description = SCM_EOL; + else + LY_ASSERT_TYPE (ly_is_list, description, 3); + add_translator_creator (creator, name, description); + return SCM_UNSPECIFIED; } -Translator * -get_translator (SCM sym) +SCM +get_translator_creator (SCM sym) { SCM v = SCM_BOOL_F; Scheme_hash_table *dict = unsmob (global_translator_dict); @@ -68,8 +114,7 @@ get_translator (SCM sym) if (scm_is_false (v)) { warning (_f ("unknown translator: `%s'", ly_symbol2string (sym).c_str ())); - return 0; } - return unsmob (v); + return v; } diff --git a/lily/translator-group.cc b/lily/translator-group.cc index a9f1690f62..5aba7bd6d4 100644 --- a/lily/translator-group.cc +++ b/lily/translator-group.cc @@ -162,48 +162,32 @@ Translator_group::create_child_translator (SCM sev) for (SCM s = trans_names; scm_is_pair (s); s = scm_cdr (s)) { - SCM definition = scm_car (s); - bool is_scheme = false; - - Translator *type = 0; - if (ly_is_symbol (definition)) - type = get_translator (definition); - else if (ly_is_pair (definition)) - { - is_scheme = true; - } - else if (ly_is_procedure (definition)) + SCM trans = scm_car (s); + + if (ly_is_symbol (trans)) + trans = get_translator_creator (trans); + if (ly_is_procedure (trans)) + trans = scm_call_1 (trans, cs); + if (scm_is_pair (trans)) + trans = (new Scheme_engraver (trans, new_context))->unprotect (); + Translator *instance = unsmob (trans); + if (!instance) { - // `definition' is a procedure, which takes the context as - // an argument and evaluates to an a-list scheme engraver - // definition. - definition = scm_call_1 (definition, cs); - is_scheme = true; + warning (_f ("cannot find: `%s'", ly_symbol2string (scm_car (s)).c_str ())); + continue; } - if (!is_scheme && !type) - warning (_f ("cannot find: `%s'", ly_symbol2string (scm_car (s)).c_str ())); - else + if (instance->must_be_last ()) { - Translator *instance = is_scheme ? new Scheme_engraver (definition) - : type->clone (); - - SCM str = instance->self_scm (); - - if (instance->must_be_last ()) - { - SCM cons = scm_cons (str, SCM_EOL); - if (scm_is_pair (trans_list)) - scm_set_cdr_x (scm_last_pair (trans_list), cons); - else - trans_list = cons; - } + SCM cons = scm_cons (trans, SCM_EOL); + if (scm_is_pair (trans_list)) + scm_set_cdr_x (scm_last_pair (trans_list), cons); else - trans_list = scm_cons (str, trans_list); - - instance->daddy_context_ = new_context; - instance->unprotect (); + trans_list = cons; } + else + trans_list = scm_cons (trans, trans_list); + } /* Filter unwanted translator types. Required to make diff --git a/lily/translator-scheme.cc b/lily/translator-scheme.cc index 3aaf92fc3d..5499b5e2e2 100644 --- a/lily/translator-scheme.cc +++ b/lily/translator-scheme.cc @@ -22,26 +22,6 @@ #include "translator-group.hh" #include "moment.hh" -LY_DEFINE (ly_translator_name, "ly:translator-name", - 1, 0, 0, (SCM trans), - "Return the type name of the translator object @var{trans}." - " The name is a symbol.") -{ - LY_ASSERT_SMOB (Translator, trans, 1); - Translator *tr = unsmob (trans); - char const *nm = tr->class_name (); - return ly_symbol2scm (nm); -} - -LY_DEFINE (ly_translator_description, "ly:translator-description", - 1, 0, 0, (SCM me), - "Return an alist of properties of translator @var{me}.") -{ - LY_ASSERT_SMOB (Translator, me, 1); - Translator *tr = unsmob (me); - return tr->translator_description (); -} - LY_DEFINE (ly_translator_context, "ly:translator-context", 1, 0, 0, (SCM trans), "Return the context of the translator object @var{trans}.") diff --git a/lily/translator.cc b/lily/translator.cc index 112d4cdd5f..e57e1c391a 100644 --- a/lily/translator.cc +++ b/lily/translator.cc @@ -48,12 +48,6 @@ Translator::Translator (Context *c) smobify_self (); } -Translator::Translator (Translator const &) - : Smob () -{ - smobify_self (); -} - Moment Translator::now_mom () const { @@ -154,7 +148,7 @@ Translator::static_translator_description (const char *grobs, const char *desc, SCM listener_list, const char *read, - const char *write) const + const char *write) { SCM static_properties = SCM_EOL; -- 2.39.2