lily/prob.cc

   1 /*
   2   prob.cc -- implement Prob
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2004--2006 Jan Nieuwenhuizen <janneke@gnu.org>
   7 */
   8
   9 #include "prob.hh"
  10 #include "main.hh"
  11 #include "item.hh"
  12
  13 #include "ly-smobs.icc"
  14
  15 IMPLEMENT_SMOBS (Prob);
  16 IMPLEMENT_TYPE_P (Prob, "ly:prob?");
  17
  18 SCM
  19 Prob::equal_p (SCM sa, SCM sb)
  20 {
  21   /* This comparison function is only designed to make the copy
  22      constructor preserve equality.
  23
  24      Perhaps it would be better to use a more strict definition of
  25      equality; e.g., that that two probs are equal iff they can be
  26      distinguished by calls to ly:prob-property.
  27   */
  28   Prob *probs[2] = {unsmob_prob (sa), unsmob_prob (sb)};
  29   SCM props[2][2];
  30   int i;
  31
  32   for (i = 0; i < 2; i++)
  33     {
  34       props[i][0] = probs[i]->immutable_property_alist_;
  35       props[i][1] = probs[i]->mutable_property_alist_;
  36     }
  37
  38   if (strcmp (probs[0]->class_name (), probs[1]->class_name ()))
  39     return SCM_BOOL_F;
  40
  41   /* Compare mutable and immutable lists, element by element. */
  42   for (i = 0; i < 2; i++)
  43     {
  44       SCM aprop = props[0][i], bprop = props[1][i];
  45
  46       for (; scm_is_pair (aprop) && scm_is_pair(bprop); aprop = scm_cdr (aprop), bprop = scm_cdr (bprop))
  47         {
  48           if (scm_caar (aprop) != scm_caar (bprop) ||
  49               !to_boolean (scm_equal_p (scm_cdar (aprop), scm_cdar (bprop))))
  50             return SCM_BOOL_F;
  51         }
  52
  53       /* is one list shorter? */
  54       if (aprop != SCM_EOL || bprop != SCM_EOL)
  55         return SCM_BOOL_F;
  56     }
  57
  58   return SCM_BOOL_T;
  59 }
  60
  61 Prob::Prob (SCM type, SCM immutable_init)
  62 {
  63   self_scm_ = SCM_EOL;
  64   mutable_property_alist_ = SCM_EOL;
  65   immutable_property_alist_ = immutable_init;
  66   type_ = type;
  67   smobify_self ();
  68 }
  69
  70
  71 Prob::~Prob ()
  72 {
  73 }
  74
  75 Prob::Prob (Prob const &src)
  76 {
  77   immutable_property_alist_ = src.immutable_property_alist_;
  78   mutable_property_alist_ = SCM_EOL;
  79   self_scm_ = SCM_EOL;
  80   type_ = src.type_;
  81
  82   /* First we smobify_self, then we copy over the stuff.  If we don't,
  83      stack vars that hold the copy might be optimized away, meaning
  84      that they won't be protected from GC. */
  85   smobify_self ();
  86   mutable_property_alist_ = src.copy_mutable_properties ();
  87 }
  88
  89
  90 SCM
  91 Prob::copy_mutable_properties () const
  92 {
  93   return ly_deep_copy (mutable_property_alist_);
  94 }
  95
  96 void
  97 Prob::derived_mark () const
  98 {
  99 }
 100
 101 SCM
 102 Prob::mark_smob (SCM smob)
 103 {
 104   Prob *system = (Prob *) SCM_CELL_WORD_1 (smob);
 105   scm_gc_mark (system->mutable_property_alist_);
 106   system->derived_mark ();
 107
 108   return system->immutable_property_alist_;
 109 }
 110
 111 int
 112 Prob::print_smob (SCM smob, SCM port, scm_print_state*)
 113 {
 114   Prob *p = (Prob *) SCM_CELL_WORD_1 (smob);
 115   scm_puts ("#<", port);
 116   scm_puts ("Prob: ", port);
 117   scm_display (p->type_, port);
 118   scm_puts (" C++: ", port);
 119   scm_puts (p->class_name (), port);
 120   scm_display (p->mutable_property_alist_, port);
 121   scm_display (p->immutable_property_alist_, port);
 122
 123   scm_puts (" >\n", port);
 124   return 1;
 125 }
 126
 127
 128
 129 SCM
 130 Prob::internal_get_property (SCM sym) const
 131 {
 132   /*
 133     TODO: type checking
 134    */
 135   SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
 136   if (s != SCM_BOOL_F)
 137     return scm_cdr (s);
 138
 139   s = scm_sloppy_assq (sym, immutable_property_alist_);
 140   return (s == SCM_BOOL_F) ? SCM_EOL : scm_cdr (s);
 141 }
 142
 143 void
 144 Prob::internal_set_property (SCM sym, SCM val
 145 #ifndef NDEBUG
 146                              , char const *file, int line, char const *fun
 147 #endif
 148                              )
 149 {
 150   if (do_internal_type_checking_global)
 151     type_check_assignment (sym, val);
 152
 153   mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, sym, val);
 154 }
 155
 156 void
 157 Prob::type_check_assignment (SCM sym, SCM val) const
 158 {
 159   (void) sym;
 160   (void) val;
 161 }
 162
 163 SCM
 164 Prob::get_property_alist (bool m) const
 165 {
 166   return (m) ? mutable_property_alist_ : immutable_property_alist_;
 167 }
 168
 169 string
 170 Prob::name () const
 171 {
 172   SCM nm = get_property ("name");
 173   if (scm_is_symbol (nm))
 174     return ly_symbol2string (nm);
 175   else
 176     return this->class_name ();
 177 }
 178