lily/nested-property.cc

   1 #include "context.hh"
   2 #include "grob.hh"
   3
   4 // scm_reverse_x without the checks
   5 SCM
   6 fast_reverse_x (SCM lst, SCM tail)
   7 {
   8   while (!scm_is_null (lst))
   9     {
  10       SCM n = scm_cdr (lst);
  11       scm_set_cdr_x (lst, tail);
  12       tail = lst;
  13       lst = n;
  14     }
  15   return tail;
  16 }
  17
  18 // copy the spine of lst not including tail, appending newtail
  19 // returns new list.
  20 SCM
  21 partial_list_copy (SCM lst, SCM tail, SCM newtail)
  22 {
  23   SCM p = SCM_EOL;
  24   for (; !scm_is_eq (lst, tail); lst = scm_cdr (lst))
  25     p = scm_cons (scm_car (lst), p);
  26   return fast_reverse_x (p, newtail);
  27 }
  28
  29 SCM
  30 assq_tail (SCM key, SCM alist, SCM based_on = SCM_EOL)
  31 {
  32   for (SCM p = alist; !scm_is_eq (p, based_on); p = scm_cdr (p))
  33     {
  34       if (scm_is_eq (scm_caar (p), key))
  35         return p;
  36     }
  37   return SCM_BOOL_F;
  38 }
  39
  40 SCM
  41 assoc_tail (SCM key, SCM alist, SCM based_on = SCM_EOL)
  42 {
  43   for (SCM p = alist; !scm_is_eq (p, based_on); p = scm_cdr (p))
  44     {
  45       if (ly_is_equal (scm_caar (p), key))
  46         return p;
  47     }
  48   return SCM_BOOL_F;
  49 }
  50
  51 // Like assq, but removes the found element destructively
  52 SCM assq_pop_x (SCM key, SCM *alist)
  53 {
  54   for (SCM p = *alist; scm_is_pair (p); p = *(alist = SCM_CDRLOC (p)))
  55     {
  56       if (scm_is_eq (scm_caar (p), key))
  57         {
  58           *alist = scm_cdr (p);
  59           return scm_car (p);
  60         }
  61     }
  62   return SCM_BOOL_F;
  63 }
  64
  65 /*
  66   Drop key from the list alist..alist_end.
  67  */
  68 SCM
  69 evict_from_alist (SCM key, SCM alist, SCM alist_end)
  70 {
  71 // shortcircuit to an eq-using assoc_tail variant when key is a symbol
  72 // (common case)
  73   SCM p = scm_is_symbol (key) ? assq_tail (key, alist, alist_end)
  74     : assoc_tail (key, alist, alist_end);
  75   if (scm_is_true (p))
  76     return partial_list_copy (alist, p, scm_cdr (p));
  77   return alist;
  78 }
  79
  80 // This is the same as
  81 // nested_property_alist (SCM_EOL, prop_path, value) but faster
  82 SCM
  83 nested_create_alist (SCM prop_path, SCM value)
  84 {
  85   if (scm_is_null (prop_path))
  86     return value;
  87   return scm_acons (scm_car (prop_path),
  88                     nested_create_alist (scm_cdr (prop_path), value),
  89                     SCM_EOL);
  90 }
  91
  92 /*
  93   PROP_PATH should be big-to-small ordering
  94  */
  95
  96 // Take the given alist and replace the given nested property with the
  97 // given value.  Multiple overrides of the same property path are not
  98 // coalesced for efficiency reasons: they are considered rare enough
  99 // to not be worth the cost of detecting them.  When sublists are
 100 // modified, however, we remove the original sublist and copy the
 101 // spine before it.  The cost for finding the sublist has already been
 102 // paid anyway.
 103
 104 // A typical use case for this routine is applying (possibly nested)
 105 // tweaks to a grob property list.
 106
 107 SCM
 108 nested_property_alist (SCM alist, SCM prop_path, SCM value)
 109 {
 110   // replacement moves to the front.
 111   SCM key = scm_car (prop_path);
 112   SCM rest = scm_cdr (prop_path);
 113   if (scm_is_pair (rest))
 114     {
 115       SCM where = assq_tail (key, alist);
 116       if (scm_is_false (where))
 117         return scm_acons (key, nested_create_alist (rest, value), alist);
 118       return scm_acons (key, nested_property_alist (scm_cdar (where),
 119                                                     rest,
 120                                                     value),
 121                         partial_list_copy (alist, where, scm_cdr (where)));
 122     }
 123   // Outcommented code would coalesce multiple overrides of the same
 124   // property
 125 #if 0
 126   SCM where = assq_tail (alist, key);
 127   if (scm_is_true (where))
 128     return scm_acons (key, value,
 129                       partial_list_copy (alist, where, scm_cdr (where)));
 130 #endif
 131   return scm_acons (key, value, alist);
 132 }
 133
 134 void
 135 set_nested_property (Grob *me, SCM big_to_small, SCM value)
 136 {
 137   SCM alist = me->get_property (scm_car (big_to_small));
 138
 139   alist = nested_property_alist (alist, scm_cdr (big_to_small), value);
 140
 141   me->set_property (scm_car (big_to_small), alist);
 142 }
 143
 144 // This converts an alist with nested overrides in it to a proper
 145 // alist.  The number of nested overrides is known in advance,
 146 // everything up to the last nested override is copied, the tail is
 147 // shared
 148
 149 SCM
 150 nalist_to_alist (SCM nalist, int nested)
 151 {
 152   if (!nested)
 153     return nalist;
 154   SCM copied = SCM_EOL;
 155   SCM partials = SCM_EOL;
 156   // partials is a alist of partial overrides
 157   for (;;)
 158     {
 159       SCM elt = scm_car (nalist);
 160       nalist = scm_cdr (nalist);
 161       SCM key = scm_car (elt);
 162       if (scm_is_pair (key))
 163         // nested override: record for key in partial
 164         {
 165           SCM pair = scm_sloppy_assq (scm_car (key), partials);
 166           if (scm_is_false (pair))
 167             partials = scm_acons (scm_car (key), scm_list_1 (elt),
 168                                   partials);
 169           else
 170             scm_set_cdr_x (pair, scm_cons (elt, scm_cdr (pair)));
 171           if (!--nested)
 172             break;
 173         }
 174       else
 175         // plain override: apply any known corresponding partials
 176         {
 177           SCM pair = assq_pop_x (key, &partials);
 178           if (scm_is_true (pair))
 179             {
 180               SCM value = scm_cdr (elt);
 181               for (SCM pp = scm_cdr (pair); scm_is_pair (pp); pp = scm_cdr (pp))
 182                 value = nested_property_alist (value, scm_cdaar (pp), scm_cdar (pp));
 183               copied = scm_acons (key, value, copied);
 184             }
 185           else
 186             copied = scm_cons (elt, copied);
 187         }
 188     }
 189   // Now need to work off the remaining partials.  All of them are
 190   // unique, so we can push them to `copied' after resolving without
 191   // losing information.
 192
 193   for (;scm_is_pair (partials); partials = scm_cdr (partials))
 194     {
 195       SCM pair = scm_car (partials);
 196       SCM key = scm_car (pair);
 197       SCM elt = scm_sloppy_assq (key, nalist);
 198       SCM value = SCM_EOL;
 199       if (scm_is_true (elt))
 200         value = scm_cdr (elt);
 201
 202       for (SCM pp = scm_cdr (pair); scm_is_pair (pp); pp = scm_cdr (pp))
 203         value = nested_property_alist (value, scm_cdaar (pp), scm_cdar (pp));
 204
 205       copied = scm_acons (key, value, copied);
 206     }
 207   return fast_reverse_x (copied, nalist);
 208 }
 209
 210 #if 0
 211 // Alternative approach: don't unfold those partial overrides while
 212 // they are part of contexts but instead use a special accessor for
 213 // subproperties in the grob.  Not used or tested for now.
 214
 215 SCM
 216 nassq_ref (SCM key, SCM nalist, SCM fallback)
 217 {
 218   SCM partials = SCM_EOL;
 219   // partials is list of partial overrides for the given property
 220   for (SCM p = nalist; scm_is_pair (p); p = scm_cdr (p))
 221     {
 222       SCM elt = scm_car (p);
 223       SCM pkey = scm_car (elt);
 224       if (scm_is_pair (pkey))
 225         {
 226           if (scm_is_eq (scm_car (pkey), key))
 227             partials = scm_cons (elt, partials);
 228         }
 229       else if (scm_is_eq (pkey, key))
 230         {
 231           SCM value = scm_cdr (elt);
 232           for (; scm_is_pair (partials); partials = scm_cdr (partials))
 233             {
 234               value = nested_property_alist (value, scm_cdaar (partials),
 235                                             scm_cdar (partials));
 236             }
 237           return value;
 238         }
 239     }
 240   if (scm_is_pair (partials))
 241     {
 242       // Bit of a quandary here: we have only subproperty overrides
 243       // but no main property.  Could be a programming error, but we
 244       // instead override an empty list.
 245       SCM value = nested_create_alist (scm_cdaar (partials), scm_cdar (partials));
 246       partials = scm_cdr (partials);
 247       for (; scm_is_pair (partials); partials = scm_cdr (partials))
 248         value = nested_property_alist (value, scm_cdaar (partials),
 249                                       scm_cdar (partials));
 250       return value;
 251     }
 252   return SCM_UNBNDP (fallback) ? SCM_EOL : fallback;
 253 }
 254
 255 // Also needed for this approach to make sense: an accessor for true
 256 // subproperties.
 257 SCM
 258 nassq_nested_ref (SCM key, SCM subpath, SCM nalist, SCM fallback);
 259 // To be implemented
 260
 261 #endif