From e328b7a10ec1a4e13ba11104825bf54e027d0dd0 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Wed, 30 Jul 2014 17:34:55 +0200 Subject: [PATCH] Issue 2507: Stop the entanglement of context properties and grob property internals This introduces a semi-opaque structure Grob_properties meeting the predicate ly:grob-properties? that is algorithmically handled at the C++ level via a wrapper structure Grob_property_info. Encapsulating grob properties in that manner reduces the potential for clashes and makes it easier to change algorithms and/or internal representation. While the principal distinction between context properties (one value per context) and context-based grob property templates (one stack per context) remains, at least the separation of the handling is more pronounced. --- input/regression/scheme-text-spanner.ly | 4 +- lily/auto-beam-engraver.cc | 3 +- lily/context-property.cc | 306 ++++++++++++++---------- lily/context-scheme.cc | 3 +- lily/engraver-group.cc | 14 +- lily/engraver.cc | 3 +- lily/include/context.hh | 7 +- lily/include/grob-properties.hh | 59 +++++ lily/include/lily-proto.hh | 1 + lily/score-engraver.cc | 3 +- lily/span-bar-stub-engraver.cc | 3 +- ly/music-functions-init.ly | 4 +- scm/define-grobs.scm | 2 +- 13 files changed, 260 insertions(+), 152 deletions(-) create mode 100644 lily/include/grob-properties.hh diff --git a/input/regression/scheme-text-spanner.ly b/input/regression/scheme-text-spanner.ly index fc60c5b339..8442f60a96 100644 --- a/input/regression/scheme-text-spanner.ly +++ b/input/regression/scheme-text-spanner.ly @@ -1,4 +1,4 @@ -\version "2.17.6" +\version "2.19.12" \header { texidoc = "Use @code{define-event-class}, scheme engraver methods, @@ -12,7 +12,7 @@ in scheme." (let* ((meta-entry (assoc-get 'meta grob-entry)) (class (assoc-get 'class meta-entry)) (ifaces-entry (assoc-get 'interfaces meta-entry))) - (set-object-property! grob-name 'translation-type? list?) + (set-object-property! grob-name 'translation-type? ly:grob-properties?) (set-object-property! grob-name 'is-grob? #t) (set! ifaces-entry (append (case class ((Item) '(item-interface)) diff --git a/lily/auto-beam-engraver.cc b/lily/auto-beam-engraver.cc index cc756b7e21..c48fe6fe33 100644 --- a/lily/auto-beam-engraver.cc +++ b/lily/auto-beam-engraver.cc @@ -23,6 +23,7 @@ #include "context-handle.hh" #include "duration.hh" #include "engraver.hh" +#include "grob-properties.hh" #include "item.hh" #include "rest.hh" #include "spanner.hh" @@ -240,7 +241,7 @@ Auto_beam_engraver::begin_beam () stems_ = new vector; grouping_ = new Beaming_pattern (); beaming_options_.from_context (context ()); - beam_settings_ = updated_grob_properties (context (), ly_symbol2scm ("Beam")); + beam_settings_ = Grob_property_info (context (), ly_symbol2scm ("Beam")).updated (); beam_start_context_.set_context (context ()->get_parent_context ()); beam_start_moment_ = now_mom (); diff --git a/lily/context-property.cc b/lily/context-property.cc index b578321a93..a6aa3e4c5b 100644 --- a/lily/context-property.cc +++ b/lily/context-property.cc @@ -20,10 +20,12 @@ #include "context.hh" #include "engraver.hh" #include "global-context.hh" +#include "grob-properties.hh" #include "international.hh" #include "item.hh" #include "main.hh" #include "simple-closure.hh" +#include "smobs.hh" #include "spanner.hh" #include "unpure-pure-container.hh" #include "warn.hh" @@ -46,8 +48,8 @@ general_pushpop_property (Context *context, assert (false); } - sloppy_general_pushpop_property (context, context_property, - grob_property_path, new_value); + Grob_property_info (context, context_property).pushpop + (grob_property_path, new_value); } bool @@ -61,6 +63,117 @@ typecheck_grob (SCM symbol, SCM value) || type_check_assignment (symbol, value, ly_symbol2scm ("backend-type?")); } +class Grob_properties { + friend class Grob_property_info; + friend SCM ly_make_grob_properties (SCM); + SCM alist_; + SCM based_on_; + + Grob_properties (SCM alist, SCM based_on) : + alist_ (alist), based_on_ (based_on) { } + DECLARE_SIMPLE_SMOBS (Grob_properties); +}; + +#include "ly-smobs.icc" +IMPLEMENT_SIMPLE_SMOBS (Grob_properties); +IMPLEMENT_DEFAULT_EQUAL_P (Grob_properties); +IMPLEMENT_TYPE_P (Grob_properties, "ly:grob-properties?"); + +SCM +Grob_properties::mark_smob (SCM smob) +{ + Grob_properties *gp = (Grob_properties *) SCM_SMOB_DATA (smob); + scm_gc_mark (gp->alist_); + return gp->based_on_; +} + +int +Grob_properties::print_smob (SCM /*smob*/, SCM port, scm_print_state *) +{ + scm_puts ("#", port); + + return 1; +} + +LY_DEFINE (ly_make_grob_properties, "ly:make-grob-properties", + 1, 0, 0, (SCM alist), + "This packages the given property list @var{alist} in" + " a grob property container stored in a context property" + " with the name of a grob.") +{ + LY_ASSERT_TYPE (ly_is_list, alist, 1); + return Grob_properties (alist, SCM_EOL).smobbed_copy (); +} + + +Grob_property_info +Grob_property_info::find () +{ + if (props_) + return *this; + SCM res = SCM_UNDEFINED; + if (Context *c = context_->where_defined (symbol_, &res)) + if (c != context_) + return Grob_property_info (c, symbol_, Grob_properties::unsmob (res)); + props_ = Grob_properties::unsmob (res); + return *this; +} + +bool +Grob_property_info::check () +{ + if (props_) + return true; + SCM res = SCM_UNDEFINED; + if (context_->here_defined (symbol_, &res)) + props_ = Grob_properties::unsmob (res); + return props_; +} + +bool +Grob_property_info::create () +{ + // Using scm_hashq_create_handle_x would seem like the one-lookup + // way to create a handle if it does not exist yet. However, we + // need to check that there is a corresponding grob in this + // particular output first, and we have to do this in the global + // context. By far the most frequent case will be that a + // Grob_properties for this context already exists, so we optimize + // for that and only check the global handle when the local + // context is pristine. + if (check ()) + return true; + SCM current_context_val = SCM_EOL; + Context *g = context_->get_global_context (); + if (!g) + return false; // Context is probably dead + + /* + Don't mess with MIDI. + */ + if (g == context_ + || !g->here_defined (symbol_, ¤t_context_val)) + return false; + + Grob_properties *def = Grob_properties::unsmob (current_context_val); + + if (!def) + { + programming_error ("Grob definition expected"); + return false; + } + + // We create the new Grob_properties from the default definition + // since this is what we have available right now. It may or may + // not be accurate since we don't take into account any + // prospective overrides in intermediate contexts. If there are + // any, they will be factored in when `updated' is being called. + SCM props = Grob_properties (def->alist_, def->alist_).smobbed_copy (); + context_->set_property (symbol_, props); + props_ = Grob_properties::unsmob (props); + return props_; +} + /* Grob descriptions (ie. alists with layout properties) are represented as a (ALIST . BASED-ON) pair, where BASED-ON is the @@ -72,46 +185,18 @@ typecheck_grob (SCM symbol, SCM value) indicates nested alists, eg. '(beamed-stem-lengths details) */ void -execute_override_property (Context *context, - SCM context_property, - SCM grob_property_path, - SCM new_value) +Grob_property_info::push (SCM grob_property_path, SCM new_value) { - SCM current_context_val = SCM_EOL; - - if (!context->here_defined (context_property, ¤t_context_val)) - { - Context *g = context->get_global_context (); - if (!g) - return; // Context is probably dead - - /* - Don't mess with MIDI. - */ - if (g == context - || !g->here_defined (context_property, ¤t_context_val)) - return; - - /* where != context */ - - SCM base = updated_grob_properties (context->get_parent_context (), - context_property); - current_context_val = scm_cons (base, base); - context->set_property (context_property, current_context_val); - } - - if (!scm_is_pair (current_context_val)) - { - programming_error ("Grob definition should be cons"); - return; - } - - SCM target_alist = scm_car (current_context_val); + /* + Don't mess with MIDI. + */ + if (!create ()) + return; SCM symbol = scm_car (grob_property_path); if (scm_is_pair (scm_cdr (grob_property_path))) { - new_value = nested_property_alist (ly_assoc_get (symbol, target_alist, + new_value = nested_property_alist (ly_assoc_get (symbol, updated (), SCM_EOL), scm_cdr (grob_property_path), new_value); @@ -121,85 +206,60 @@ execute_override_property (Context *context, property. However, we have to keep this info around, in case we have to \revert back to it. */ - target_alist = scm_acons (symbol, new_value, target_alist); - - /* - tack onto alist. We can use set_car, since - updated_grob_properties () in child contexts will check - for changes in the car. - */ if (typecheck_grob (symbol, new_value)) - { - scm_set_car_x (current_context_val, target_alist); - } -} - -/* - do a pop (indicated by new_value==SCM_UNDEFINED) or push - */ -void -sloppy_general_pushpop_property (Context *context, - SCM context_property, - SCM grob_property_path, - SCM new_value) -{ - if (new_value == SCM_UNDEFINED) - execute_revert_property (context, context_property, - grob_property_path); - else - execute_override_property (context, context_property, - grob_property_path, - new_value); + props_->alist_ = scm_acons (symbol, new_value, props_->alist_); } /* Revert the property given by property_path. */ void -execute_revert_property (Context *context, - SCM context_property, - SCM grob_property_path) +Grob_property_info::pop (SCM grob_property_path) { - SCM current_context_val = SCM_EOL; - if (context->here_defined (context_property, ¤t_context_val)) + if (!check ()) + return; + + SCM current_alist = props_->alist_; + SCM daddy = props_->based_on_; + + if (!scm_is_pair (grob_property_path) + || !scm_is_symbol (scm_car (grob_property_path))) { - SCM current_alist = scm_car (current_context_val); - SCM daddy = scm_cdr (current_context_val); + programming_error ("Grob property path should be list of symbols."); + return; + } - if (!scm_is_pair (grob_property_path) - || !scm_is_symbol (scm_car (grob_property_path))) - { - programming_error ("Grob property path should be list of symbols."); - return; - } + SCM symbol = scm_car (grob_property_path); + if (scm_is_pair (scm_cdr (grob_property_path))) + { + // This is definitely wrong: the symbol must only be looked up + // in the part of the alist before daddy. We are not fixing + // this right now since this is slated for complete replacement. + SCM current_sub_alist = ly_assoc_get (symbol, current_alist, SCM_EOL); + SCM new_val + = nested_property_revert_alist (current_sub_alist, + scm_cdr (grob_property_path)); + + if (scm_is_pair (current_alist) + && scm_caar (current_alist) == symbol + && current_alist != daddy) + current_alist = scm_cdr (current_alist); + + current_alist = scm_acons (symbol, new_val, current_alist); + props_->alist_ = current_alist; + } + else + { + SCM new_alist = evict_from_alist (symbol, current_alist, daddy); - SCM symbol = scm_car (grob_property_path); - if (scm_is_pair (scm_cdr (grob_property_path))) + if (new_alist == daddy) { - SCM current_sub_alist = ly_assoc_get (symbol, current_alist, SCM_EOL); - SCM new_val - = nested_property_revert_alist (current_sub_alist, - scm_cdr (grob_property_path)); - - if (scm_is_pair (current_alist) - && scm_caar (current_alist) == symbol - && current_alist != daddy) - current_alist = scm_cdr (current_alist); - - current_alist = scm_acons (symbol, new_val, current_alist); - scm_set_car_x (current_context_val, current_alist); + props_ = 0; + context_->unset_property (symbol_); } else - { - SCM new_alist = evict_from_alist (symbol, current_alist, daddy); - - if (new_alist == daddy) - context->unset_property (context_property); - else - context->set_property (context_property, - scm_cons (new_alist, daddy)); - } + props_->alist_ = new_alist; } } /* @@ -208,13 +268,11 @@ execute_revert_property (Context *context, */ void execute_pushpop_property (Context *context, - SCM context_property, + SCM grob, SCM grob_property, SCM new_value) { - general_pushpop_property (context, context_property, - scm_list_1 (grob_property), - new_value); + Grob_property_info (context, grob).pushpop (scm_list_1 (grob_property), new_value); } /* @@ -234,14 +292,13 @@ apply_property_operations (Context *tg, SCM pre_init_ops) SCM context_prop = scm_car (entry); SCM val = scm_cadr (entry); SCM grob_prop_path = scm_cddr (entry); - sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val); + Grob_property_info (tg, context_prop).push (grob_prop_path, val); } else if (type == ly_symbol2scm ("pop")) { SCM context_prop = scm_car (entry); - SCM val = SCM_UNDEFINED; SCM grob_prop_path = scm_cdr (entry); - sloppy_general_pushpop_property (tg, context_prop, grob_prop_path, val); + Grob_property_info (tg, context_prop).pop (grob_prop_path); } else if (type == ly_symbol2scm ("assign")) tg->set_property (scm_car (entry), scm_cadr (entry)); @@ -256,35 +313,28 @@ apply_property_operations (Context *tg, SCM pre_init_ops) Return the object alist for SYM, checking if its base in enclosing contexts has changed. The alist is updated if necessary. */ -SCM -updated_grob_properties (Context *tg, SCM sym) +SCM Grob_property_info::updated () { - assert (scm_is_symbol (sym)); + assert (scm_is_symbol (symbol_)); - SCM props; - tg = tg->where_defined (sym, &props); - if (!tg) + Grob_property_info where = find (); + + if (!where) return SCM_EOL; - SCM daddy_props - = (tg->get_parent_context ()) - ? updated_grob_properties (tg->get_parent_context (), sym) - : SCM_EOL; + Context *dad = where.context_->get_parent_context (); - if (!scm_is_pair (props)) - { - programming_error ("grob props not a pair?"); - return SCM_EOL; - } + SCM daddy_props + = dad ? Grob_property_info (dad, symbol_).updated () : SCM_EOL; - SCM based_on = scm_cdr (props); + SCM based_on = where.props_->based_on_; if (based_on == daddy_props) - return scm_car (props); + return where.props_->alist_; else { SCM copy = daddy_props; SCM *tail = © - SCM p = scm_car (props); + SCM p = where.props_->alist_; while (p != based_on) { *tail = scm_cons (scm_car (p), daddy_props); @@ -292,8 +342,8 @@ updated_grob_properties (Context *tg, SCM sym) p = scm_cdr (p); } - scm_set_car_x (props, copy); - scm_set_cdr_x (props, daddy_props); + where.props_->alist_ = copy; + where.props_->based_on_ = daddy_props; return copy; } diff --git a/lily/context-scheme.cc b/lily/context-scheme.cc index aaa5b529b3..c3822100af 100644 --- a/lily/context-scheme.cc +++ b/lily/context-scheme.cc @@ -21,6 +21,7 @@ #include "context.hh" #include "context-def.hh" #include "dispatcher.hh" +#include "grob-properties.hh" LY_DEFINE (ly_context_current_moment, "ly:context-current-moment", @@ -70,7 +71,7 @@ LY_DEFINE (ly_context_grob_definition, "ly:context-grob-definition", LY_ASSERT_SMOB (Context, context, 1); LY_ASSERT_TYPE (ly_is_symbol, name, 2); - return updated_grob_properties (tr, name); + return Grob_property_info (tr, name).updated (); } LY_DEFINE (ly_context_pushpop_property, "ly:context-pushpop-property", diff --git a/lily/engraver-group.cc b/lily/engraver-group.cc index 4a897c6092..a9048ccb9c 100644 --- a/lily/engraver-group.cc +++ b/lily/engraver-group.cc @@ -21,6 +21,7 @@ #include "dispatcher.hh" #include "engraver-group.hh" #include "grob.hh" +#include "grob-properties.hh" #include "paper-score.hh" #include "translator-dispatch-list.hh" #include "warn.hh" @@ -31,10 +32,9 @@ Engraver_group::override (SCM sev) { Stream_event *ev = Stream_event::unsmob (sev); - sloppy_general_pushpop_property (context (), - ev->get_property ("symbol"), - ev->get_property ("property-path"), - ev->get_property ("value")); + Grob_property_info (context (), ev->get_property ("symbol")) + .push (ev->get_property ("property-path"), + ev->get_property ("value")); } IMPLEMENT_LISTENER (Engraver_group, revert); @@ -43,10 +43,8 @@ Engraver_group::revert (SCM sev) { Stream_event *ev = Stream_event::unsmob (sev); - sloppy_general_pushpop_property (context (), - ev->get_property ("symbol"), - ev->get_property ("property-path"), - SCM_UNDEFINED); + Grob_property_info (context (), ev->get_property ("symbol")) + .pop (ev->get_property ("property-path")); } void diff --git a/lily/engraver.cc b/lily/engraver.cc index 74a6554e3a..76117a66e8 100644 --- a/lily/engraver.cc +++ b/lily/engraver.cc @@ -20,6 +20,7 @@ #include "engraver.hh" #include "context.hh" +#include "grob-properties.hh" #include "international.hh" #include "music.hh" #include "paper-column.hh" @@ -117,7 +118,7 @@ Engraver::internal_make_grob (SCM symbol, (void)fun; #endif - SCM props = updated_grob_properties (context (), symbol); + SCM props = Grob_property_info (context (), symbol).updated (); Grob *grob = 0; diff --git a/lily/include/context.hh b/lily/include/context.hh index 0595bf8513..cc90d2ebb0 100644 --- a/lily/include/context.hh +++ b/lily/include/context.hh @@ -137,13 +137,8 @@ public: */ void apply_property_operations (Context *tg, SCM pre_init_ops); -void execute_revert_property (Context *context, - SCM context_property, - SCM grob_property_path); void execute_pushpop_property (Context *trg, SCM prop, SCM eltprop, SCM val); -void sloppy_general_pushpop_property (Context *context, - SCM context_property, SCM grob_property_path, SCM val); -SCM updated_grob_properties (Context *tg, SCM sym); + Context *find_context_below (Context *where, SCM type_sym, const string &id); bool melisma_busy (Context *); diff --git a/lily/include/grob-properties.hh b/lily/include/grob-properties.hh new file mode 100644 index 0000000000..37569442c6 --- /dev/null +++ b/lily/include/grob-properties.hh @@ -0,0 +1,59 @@ +/* + This file is part of LilyPond, the GNU music typesetter. + + Copyright (C) 2014 David Kastrup + + LilyPond is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + LilyPond is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with LilyPond. If not, see . +*/ + +// This module is concerned with managing grob-properties (more +// exactly, grob property templates, as they are not yet part of a +// grob) inside of context properties, in a context-hierarchical +// manner, with one stack for properties and subproperties per +// context. + +#ifndef GROB_PROPERTIES_HH +#define GROB_PROPERTIES_HH + +#include "lily-proto.hh" + +// Several algorithms on Grob_properties need self-identifying +// information to work properly, but there is no point in storing them +// in the Grob_properties data structure itself. Instead we create a +// reflective data structure containing all necessary information for +// the algorithms processing Grob_properties. + +class Grob_property_info { + Context * const context_; + SCM const symbol_; + Grob_properties *props_; +public: + Grob_property_info (Context *context, SCM symbol, Grob_properties *props = 0) + : context_ (context), symbol_ (symbol), props_ (props) + { } + operator bool () { return props_; } + Grob_property_info find (); + bool check (); + bool create (); + SCM updated (); + void push (SCM path, SCM value); + void pop (SCM path); + void pushpop (SCM path, SCM value) + { + if (SCM_UNBNDP (value)) + return pop (path); + push (path, value); + } +}; +#endif diff --git a/lily/include/lily-proto.hh b/lily/include/lily-proto.hh index 22b989b6a6..3dd0825b27 100644 --- a/lily/include/lily-proto.hh +++ b/lily/include/lily-proto.hh @@ -73,6 +73,7 @@ class Grace_music; class Grob; class Grob_array; class Grob_info; +class Grob_properties; class Includable_lexer; class Input; class Item; diff --git a/lily/score-engraver.cc b/lily/score-engraver.cc index b361d03fc1..54f34575d2 100644 --- a/lily/score-engraver.cc +++ b/lily/score-engraver.cc @@ -24,6 +24,7 @@ #include "context-def.hh" #include "dispatcher.hh" #include "global-context.hh" +#include "grob-properties.hh" #include "international.hh" #include "main.hh" #include "open-type-font.hh" @@ -88,7 +89,7 @@ Score_engraver::initialize () pscore_->unprotect (); context ()->set_property ("output", pscore_->self_scm ()); - SCM props = updated_grob_properties (context (), ly_symbol2scm ("System")); + SCM props = Grob_property_info (context (), ly_symbol2scm ("System")).updated (); pscore_->typeset_system (new System (props)); diff --git a/lily/span-bar-stub-engraver.cc b/lily/span-bar-stub-engraver.cc index d02ff4ae54..9cf52dc98f 100644 --- a/lily/span-bar-stub-engraver.cc +++ b/lily/span-bar-stub-engraver.cc @@ -22,6 +22,7 @@ #include "align-interface.hh" #include "context.hh" #include "grob.hh" +#include "grob-properties.hh" #include "item.hh" #include "pointer-group-interface.hh" #include "engraver.hh" @@ -142,7 +143,7 @@ Span_bar_stub_engraver::process_acknowledged () for (vsize j = 0; j < affected_contexts.size (); j++) { - Item *it = new Item (updated_grob_properties (affected_contexts[j], ly_symbol2scm ("SpanBarStub"))); + Item *it = new Item (Grob_property_info (affected_contexts[j], ly_symbol2scm ("SpanBarStub")).updated ()); it->set_parent (spanbars_[i], X_AXIS); Grob_info gi = make_grob_info (it, spanbars_[i]->self_scm ()); gi.rerouting_daddy_context_ = affected_contexts[j]; diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly index fea1c9b888..477c9c6538 100644 --- a/ly/music-functions-init.ly +++ b/ly/music-functions-init.ly @@ -467,8 +467,8 @@ grobdescriptions = in the format of @code{all-grob-descriptions}.") (ly:make-context-mod (map (lambda (p) - (list 'assign (car p) (list (cdr p)))) - descriptions))) + (list 'assign (car p) (ly:make-grob-properties (cdr p)))) + descriptions))) harmonicByFret = #(define-music-function (parser location fret music) (number? ly:music?) (_i "Convert @var{music} into mixed harmonics; the resulting notes resemble diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm index 813c93b131..46b15b6ce6 100644 --- a/scm/define-grobs.scm +++ b/scm/define-grobs.scm @@ -2816,7 +2816,7 @@ (for-each (lambda (x) ;; (display (car x)) (newline) - (set-object-property! (car x) 'translation-type? list?) + (set-object-property! (car x) 'translation-type? ly:grob-properties?) (set-object-property! (car x) 'is-grob? #t)) all-grob-descriptions) -- 2.39.2