lily/prob.cc

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 2004--2014 Jan Nieuwenhuizen <janneke@gnu.org>
   5
   6   LilyPond is free software: you can redistribute it and/or modify
   7   it under the terms of the GNU General Public License as published by
   8   the Free Software Foundation, either version 3 of the License, or
   9   (at your option) any later version.
  10
  11   LilyPond is distributed in the hope that it will be useful,
  12   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14   GNU General Public License for more details.
  15
  16   You should have received a copy of the GNU General Public License
  17   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18 */
  19
  20 #include "prob.hh"
  21 #include "main.hh"
  22 #include "item.hh"
  23 #include "input.hh"
  24 #include "profile.hh"
  25
  26
  27 const char Prob::type_p_name_[] = "ly:prob?";
  28
  29 SCM
  30 Prob::equal_p (SCM sa, SCM sb)
  31 {
  32   /* This comparison function is only designed to make the copy
  33      constructor preserve equality.
  34
  35      Perhaps it would be better to use a more strict definition of
  36      equality; e.g., that two probs are equal iff they can be
  37      distinguished by calls to ly:prob-property.
  38   */
  39   Prob *probs[2] = {Prob::unsmob (sa), Prob::unsmob (sb)};
  40   SCM props[2][2];
  41   int i;
  42
  43   for (i = 0; i < 2; i++)
  44     {
  45       props[i][0] = probs[i]->immutable_property_alist_;
  46       props[i][1] = probs[i]->mutable_property_alist_;
  47     }
  48
  49   if (strcmp (probs[0]->class_name (), probs[1]->class_name ()))
  50     return SCM_BOOL_F;
  51
  52   /* Compare mutable and immutable lists, element by element. */
  53   for (i = 0; i < 2; i++)
  54     {
  55       SCM aprop = props[0][i];
  56       SCM bprop = props[1][i];
  57
  58       for (;
  59            scm_is_pair (aprop) && scm_is_pair (bprop);
  60            aprop = scm_cdr (aprop), bprop = scm_cdr (bprop))
  61         {
  62           SCM aval = scm_cdar (aprop);
  63           SCM bval = scm_cdar (bprop);
  64           if (scm_caar (aprop) != scm_caar (bprop)
  65               || (!(Input::is_smob (aval) && Input::is_smob (bval))
  66                   &&
  67                   !to_boolean (scm_equal_p (aval, bval))))
  68             return SCM_BOOL_F;
  69         }
  70
  71       /* is one list shorter? */
  72       if (aprop != SCM_EOL || bprop != SCM_EOL)
  73         return SCM_BOOL_F;
  74     }
  75
  76   return SCM_BOOL_T;
  77 }
  78
  79 Prob::Prob (SCM type, SCM immutable_init) : Smob<Prob> ()
  80 {
  81   mutable_property_alist_ = SCM_EOL;
  82   immutable_property_alist_ = immutable_init;
  83   type_ = type;
  84   smobify_self ();
  85 }
  86
  87 Prob::~Prob ()
  88 {
  89 }
  90
  91 Prob::Prob (Prob const &src)
  92   : Smob<Prob> ()
  93 {
  94   immutable_property_alist_ = src.immutable_property_alist_;
  95   mutable_property_alist_ = SCM_EOL;
  96   type_ = src.type_;
  97
  98   /* First we smobify_self, then we copy over the stuff.  If we don't,
  99      stack vars that hold the copy might be optimized away, meaning
 100      that they won't be protected from GC. */
 101   smobify_self ();
 102   mutable_property_alist_ = src.copy_mutable_properties ();
 103 }
 104
 105 SCM
 106 Prob::copy_mutable_properties () const
 107 {
 108   return ly_deep_copy (mutable_property_alist_);
 109 }
 110
 111 void
 112 Prob::derived_mark () const
 113 {
 114 }
 115
 116 SCM
 117 Prob::mark_smob ()
 118 {
 119   ASSERT_LIVE_IS_ALLOWED (self_scm ());
 120
 121   scm_gc_mark (mutable_property_alist_);
 122   derived_mark ();
 123
 124   return immutable_property_alist_;
 125 }
 126
 127 int
 128 Prob::print_smob (SCM port, scm_print_state *)
 129 {
 130   scm_puts ("#<", port);
 131   scm_puts ("Prob: ", port);
 132   scm_display (type_, port);
 133   scm_puts (" C++: ", port);
 134   scm_puts (class_name (), port);
 135   scm_display (mutable_property_alist_, port);
 136   scm_display (immutable_property_alist_, port);
 137
 138   scm_puts (" >\n", port);
 139   return 1;
 140 }
 141
 142 SCM
 143 Prob::internal_get_property (SCM sym) const
 144 {
 145 #ifndef NDEBUG
 146   if (profile_property_accesses)
 147     note_property_access (&prob_property_lookup_table, sym);
 148 #endif
 149
 150   /*
 151     TODO: type checking
 152    */
 153   SCM s = scm_sloppy_assq (sym, mutable_property_alist_);
 154   if (s != SCM_BOOL_F)
 155     return scm_cdr (s);
 156
 157   s = scm_sloppy_assq (sym, immutable_property_alist_);
 158   return (s == SCM_BOOL_F) ? SCM_EOL : scm_cdr (s);
 159 }
 160
 161 /* We don't (yet) instrument probs */
 162 void
 163 Prob::instrumented_set_property (SCM sym, SCM val, const char *, int, const char *)
 164 {
 165   internal_set_property (sym, val);
 166 }
 167
 168 void
 169 Prob::internal_set_property (SCM sym, SCM val)
 170 {
 171   if (do_internal_type_checking_global)
 172     type_check_assignment (sym, val);
 173
 174   mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, sym, val);
 175 }
 176
 177 void
 178 Prob::type_check_assignment (SCM, SCM) const
 179 {
 180   /* empty */
 181 }
 182
 183 SCM
 184 Prob::get_property_alist (bool m) const
 185 {
 186   return (m) ? mutable_property_alist_ : immutable_property_alist_;
 187 }
 188
 189 string
 190 Prob::name () const
 191 {
 192   SCM nm = get_property ("name");
 193   if (scm_is_symbol (nm))
 194     return ly_symbol2string (nm);
 195   else
 196     return this->class_name ();
 197 }