class Grob_properties {
friend class Grob_property_info;
friend SCM ly_make_grob_properties (SCM);
+ // alist_ may contain unexpanded nested overrides
SCM alist_;
+ // based_on_ is the cooked_ value from the next higher context that
+ // alist_ is based on
SCM based_on_;
+ // cooked_ is a version of alist_ where nested overrides have been
+ // expanded
+ SCM cooked_;
+ // cooked_from_ is the value of alist_ from which the expansion has
+ // been done
+ SCM cooked_from_;
+ // nested_ is a count of nested overrides in alist_
+ int nested_;
Grob_properties (SCM alist, SCM based_on) :
- alist_ (alist), based_on_ (based_on) { }
+ alist_ (alist), based_on_ (based_on),
+ // if the constructor was called with lists possibly containing
+ // partial overrides, we would need to initialize with based_on in
+ // order to trigger an initial update. But this should never
+ // happen, so we initialize straight with alist.
+ cooked_ (alist), cooked_from_ (alist), nested_ (0) { }
DECLARE_SIMPLE_SMOBS (Grob_properties);
};
{
Grob_properties *gp = (Grob_properties *) SCM_SMOB_DATA (smob);
scm_gc_mark (gp->alist_);
- return gp->based_on_;
+ scm_gc_mark (gp->based_on_);
+ scm_gc_mark (gp->cooked_);
+ return gp->cooked_from_;
}
int
return;
SCM symbol = scm_car (grob_property_path);
- if (scm_is_pair (scm_cdr (grob_property_path)))
+ SCM rest = scm_cdr (grob_property_path);
+ if (scm_is_pair (rest))
{
- new_value = nested_property_alist (ly_assoc_get (symbol, updated (),
- SCM_EOL),
- scm_cdr (grob_property_path),
- new_value);
+ // poor man's typechecking
+ if (typecheck_grob (symbol, nested_create_alist (rest, new_value))) {
+ props_->alist_ = scm_acons (grob_property_path, new_value, props_->alist_);
+ props_->nested_++;
+ }
+ return;
}
/* it's tempting to replace the head of the list if it's the same
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;
+ SCM old_alist = current_alist;
+ current_alist = evict_from_alist (grob_property_path, current_alist, daddy);
+ if (scm_is_eq (old_alist, current_alist))
+ return;
+ props_->nested_--;
}
else
- {
- SCM new_alist = evict_from_alist (symbol, current_alist, daddy);
+ current_alist = evict_from_alist (scm_car (grob_property_path),
+ current_alist, daddy);
- if (new_alist == daddy)
- {
- props_ = 0;
- context_->unset_property (symbol_);
- }
- else
- props_->alist_ = new_alist;
+ if (scm_is_eq (current_alist, daddy))
+ {
+ assert (props_->nested_ == 0);
+ props_ = 0;
+ context_->unset_property (symbol_);
+ return;
}
+ props_->alist_ = current_alist;
}
/*
Convenience: a push/pop grob property using a single grob_property
= dad ? Grob_property_info (dad, symbol_).updated () : SCM_EOL;
SCM based_on = where.props_->based_on_;
- if (based_on == daddy_props)
- return where.props_->alist_;
- else
+ SCM alist = where.props_->alist_;
+ if (!scm_is_eq (based_on, daddy_props))
{
- SCM copy = daddy_props;
- SCM *tail = ©
- SCM p = where.props_->alist_;
- while (p != based_on)
- {
- *tail = scm_cons (scm_car (p), daddy_props);
- tail = SCM_CDRLOC (*tail);
- p = scm_cdr (p);
- }
-
- where.props_->alist_ = copy;
- where.props_->based_on_ = daddy_props;
-
- return copy;
+ where.props_->based_on_ = daddy_props;
+ alist = partial_list_copy (alist, based_on, daddy_props);
+ where.props_->alist_ = alist;
}
+ if (scm_is_eq (where.props_->cooked_from_, alist))
+ return where.props_->cooked_;
+ where.props_->cooked_from_ = alist;
+ where.props_->cooked_ = nalist_to_alist (alist, where.props_->nested_);
+ return where.props_->cooked_;
}
#include "context.hh"
#include "grob.hh"
-/*
- Drop symbol from the list alist..alist_end.
- */
+// scm_reverse_x without the checks
SCM
-evict_from_alist (SCM symbol, SCM alist, SCM alist_end)
+fast_reverse_x (SCM lst, SCM tail)
{
- SCM new_alist = SCM_EOL;
- SCM *tail = &new_alist;
-
- while (alist != alist_end)
+ while (!scm_is_null (lst))
{
- if (ly_is_equal (scm_caar (alist), symbol))
- {
- alist = scm_cdr (alist);
- break;
- }
-
- *tail = scm_cons (scm_car (alist), SCM_EOL);
- tail = SCM_CDRLOC (*tail);
- alist = scm_cdr (alist);
+ SCM n = scm_cdr (lst);
+ scm_set_cdr_x (lst, tail);
+ tail = lst;
+ lst = n;
}
+ return tail;
+}
- *tail = alist;
- return new_alist;
+// copy the spine of lst not including tail, appending newtail
+// returns new list.
+SCM
+partial_list_copy (SCM lst, SCM tail, SCM newtail)
+{
+ SCM p = SCM_EOL;
+ for (; !scm_is_eq (lst, tail); lst = scm_cdr (lst))
+ p = scm_cons (scm_car (lst), p);
+ return fast_reverse_x (p, newtail);
}
-/*
- PROP_PATH should be big-to-small ordering
- */
SCM
-nested_property_alist (SCM alist, SCM prop_path, SCM value)
+assq_tail (SCM key, SCM alist, SCM based_on = SCM_EOL)
{
- SCM new_value = SCM_BOOL_F;
- if (scm_is_pair (scm_cdr (prop_path)))
+ for (SCM p = alist; !scm_is_eq (p, based_on); p = scm_cdr (p))
{
- SCM sub_alist = ly_assoc_get (scm_car (prop_path), alist, SCM_EOL);
- new_value = nested_property_alist (sub_alist, scm_cdr (prop_path), value);
+ if (scm_is_eq (scm_caar (p), key))
+ return p;
}
- else
+ return SCM_BOOL_F;
+}
+
+SCM
+assoc_tail (SCM key, SCM alist, SCM based_on = SCM_EOL)
+{
+ for (SCM p = alist; !scm_is_eq (p, based_on); p = scm_cdr (p))
{
- new_value = value;
+ if (ly_is_equal (scm_caar (p), key))
+ return p;
}
+ return SCM_BOOL_F;
+}
- return scm_acons (scm_car (prop_path), new_value, alist);
+// Like assq, but removes the found element destructively
+SCM assq_pop_x (SCM key, SCM *alist)
+{
+ for (SCM p = *alist; scm_is_pair (p); p = *(alist = SCM_CDRLOC (p)))
+ {
+ if (scm_is_eq (scm_caar (p), key))
+ {
+ *alist = scm_cdr (p);
+ return scm_car (p);
+ }
+ }
+ return SCM_BOOL_F;
}
/*
- Recursively purge alist of prop_path:
+ Drop key from the list alist..alist_end.
+ */
+SCM
+evict_from_alist (SCM key, SCM alist, SCM alist_end)
+{
+// shortcircuit to an eq-using assoc_tail variant when key is a symbol
+// (common case)
+ SCM p = scm_is_symbol (key) ? assq_tail (key, alist, alist_end)
+ : assoc_tail (key, alist, alist_end);
+ if (scm_is_true (p))
+ return partial_list_copy (alist, p, scm_cdr (p));
+ return alist;
+}
- revert ((sym, val) : L, [sym]) = L
- revert ((sym, val) : L, sym : props) =
- (sym, revert (val, rest-props)) ++ L
- revert ((sym, val) : L, p ++ rest-props) =
- (sym, val) : revert (L, p ++ rest-props)
+// This is the same as
+// nested_property_alist (SCM_EOL, prop_path, value) but faster
+SCM
+nested_create_alist (SCM prop_path, SCM value)
+{
+ if (scm_is_null (prop_path))
+ return value;
+ return scm_acons (scm_car (prop_path),
+ nested_create_alist (scm_cdr (prop_path), value),
+ SCM_EOL);
+}
+/*
+ PROP_PATH should be big-to-small ordering
*/
+
+// Take the given alist and replace the given nested property with the
+// given value. Multiple overrides of the same property path are not
+// coalesced for efficiency reasons: they are considered rare enough
+// to not be worth the cost of detecting them. When sublists are
+// modified, however, we remove the original sublist and copy the
+// spine before it. The cost for finding the sublist has already been
+// paid anyway.
+
+// A typical use case for this routine is applying (possibly nested)
+// tweaks to a grob property list.
+
SCM
-nested_property_revert_alist (SCM alist, SCM prop_path)
+nested_property_alist (SCM alist, SCM prop_path, SCM value)
{
- assert (scm_is_pair (prop_path));
+ // replacement moves to the front.
+ SCM key = scm_car (prop_path);
+ SCM rest = scm_cdr (prop_path);
+ if (scm_is_pair (rest))
+ {
+ SCM where = assq_tail (key, alist);
+ if (scm_is_false (where))
+ return scm_acons (key, nested_create_alist (rest, value), alist);
+ return scm_acons (key, nested_property_alist (scm_cdar (where),
+ rest,
+ value),
+ partial_list_copy (alist, where, scm_cdr (where)));
+ }
+ // Outcommented code would coalesce multiple overrides of the same
+ // property
+#if 0
+ SCM where = assq_tail (alist, key);
+ if (scm_is_true (where))
+ return scm_acons (key, value,
+ partial_list_copy (alist, where, scm_cdr (where)));
+#endif
+ return scm_acons (key, value, alist);
+}
- SCM wanted_sym = scm_car (prop_path);
+void
+set_nested_property (Grob *me, SCM big_to_small, SCM value)
+{
+ SCM alist = me->get_property (scm_car (big_to_small));
- SCM new_list = SCM_EOL;
- SCM *tail = &new_list;
- for (SCM s = alist; scm_is_pair (s); s = scm_cdr (s))
- {
- SCM sub_sym = scm_caar (s);
- SCM old_val = scm_cdar (s);
+ alist = nested_property_alist (alist, scm_cdr (big_to_small), value);
- if (sub_sym == wanted_sym)
- {
- if (scm_is_pair (scm_cdr (prop_path)))
- {
- SCM new_val = nested_property_revert_alist (old_val, scm_cdr (prop_path));
+ me->set_property (scm_car (big_to_small), alist);
+}
- /* nothing changed: drop newly constructed list. */
- if (old_val == new_val)
- return alist;
+// This converts an alist with nested overrides in it to a proper
+// alist. The number of nested overrides is known in advance,
+// everything up to the last nested override is copied, the tail is
+// shared
- *tail = scm_acons (sub_sym, new_val, SCM_EOL);
- tail = SCM_CDRLOC (*tail);
- }
+SCM
+nalist_to_alist (SCM nalist, int nested)
+{
+ if (!nested)
+ return nalist;
+ SCM copied = SCM_EOL;
+ SCM partials = SCM_EOL;
+ // partials is a alist of partial overrides
+ for (;;)
+ {
+ SCM elt = scm_car (nalist);
+ nalist = scm_cdr (nalist);
+ SCM key = scm_car (elt);
+ if (scm_is_pair (key))
+ // nested override: record for key in partial
+ {
+ SCM pair = scm_sloppy_assq (scm_car (key), partials);
+ if (scm_is_false (pair))
+ partials = scm_acons (scm_car (key), scm_list_1 (elt),
+ partials);
else
+ scm_set_cdr_x (pair, scm_cons (elt, scm_cdr (pair)));
+ if (!--nested)
+ break;
+ }
+ else
+ // plain override: apply any known corresponding partials
+ {
+ SCM pair = assq_pop_x (key, &partials);
+ if (scm_is_true (pair))
{
- /* old value is dropped. */
+ SCM value = scm_cdr (elt);
+ for (SCM pp = scm_cdr (pair); scm_is_pair (pp); pp = scm_cdr (pp))
+ value = nested_property_alist (value, scm_cdaar (pp), scm_cdar (pp));
+ copied = scm_acons (key, value, copied);
}
-
- *tail = scm_cdr (s);
- return new_list;
+ else
+ copied = scm_cons (elt, copied);
}
-
- *tail = scm_acons (sub_sym, old_val, SCM_EOL);
- tail = SCM_CDRLOC (*tail);
}
+ // Now need to work off the remaining partials. All of them are
+ // unique, so we can push them to `copied' after resolving without
+ // losing information.
- /* Wanted symbol not found: drop newly constructed list. */
- return alist;
+ for (;scm_is_pair (partials); partials = scm_cdr (partials))
+ {
+ SCM pair = scm_car (partials);
+ SCM key = scm_car (pair);
+ SCM elt = scm_sloppy_assq (key, nalist);
+ SCM value = SCM_EOL;
+ if (scm_is_true (elt))
+ value = scm_cdr (elt);
+
+ for (SCM pp = scm_cdr (pair); scm_is_pair (pp); pp = scm_cdr (pp))
+ value = nested_property_alist (value, scm_cdaar (pp), scm_cdar (pp));
+
+ copied = scm_acons (key, value, copied);
+ }
+ return fast_reverse_x (copied, nalist);
}
-void
-set_nested_property (Grob *me, SCM big_to_small, SCM value)
+#if 0
+// Alternative approach: don't unfold those partial overrides while
+// they are part of contexts but instead use a special accessor for
+// subproperties in the grob. Not used or tested for now.
+
+SCM
+nassq_ref (SCM key, SCM nalist, SCM fallback)
{
- SCM alist = me->get_property (scm_car (big_to_small));
+ SCM partials = SCM_EOL;
+ // partials is list of partial overrides for the given property
+ for (SCM p = nalist; scm_is_pair (p); p = scm_cdr (p))
+ {
+ SCM elt = scm_car (p);
+ SCM pkey = scm_car (elt);
+ if (scm_is_pair (pkey))
+ {
+ if (scm_is_eq (scm_car (pkey), key))
+ partials = scm_cons (elt, partials);
+ }
+ else if (scm_is_eq (pkey, key))
+ {
+ SCM value = scm_cdr (elt);
+ for (; scm_is_pair (partials); partials = scm_cdr (partials))
+ {
+ value = nested_property_alist (value, scm_cdaar (partials),
+ scm_cdar (partials));
+ }
+ return value;
+ }
+ }
+ if (scm_is_pair (partials))
+ {
+ // Bit of a quandary here: we have only subproperty overrides
+ // but no main property. Could be a programming error, but we
+ // instead override an empty list.
+ SCM value = nested_create_alist (scm_cdaar (partials), scm_cdar (partials));
+ partials = scm_cdr (partials);
+ for (; scm_is_pair (partials); partials = scm_cdr (partials))
+ value = nested_property_alist (value, scm_cdaar (partials),
+ scm_cdar (partials));
+ return value;
+ }
+ return SCM_UNBNDP (fallback) ? SCM_EOL : fallback;
+}
- alist = nested_property_alist (alist, scm_cdr (big_to_small), value);
+// Also needed for this approach to make sense: an accessor for true
+// subproperties.
+SCM
+nassq_nested_ref (SCM key, SCM subpath, SCM nalist, SCM fallback);
+// To be implemented
- me->set_property (scm_car (big_to_small), alist);
-}
+#endif
projects / lilypond.git / commitdiff