2 This file is part of LilyPond, the GNU music typesetter.
4 Copyright (C) 2004--2010 Jan Nieuwenhuizen <janneke@gnu.org>
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.
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.
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/>.
26 #include "ly-smobs.icc"
28 IMPLEMENT_SMOBS (Prob
);
29 IMPLEMENT_TYPE_P (Prob
, "ly:prob?");
32 Prob::equal_p (SCM sa
, SCM sb
)
34 /* This comparison function is only designed to make the copy
35 constructor preserve equality.
37 Perhaps it would be better to use a more strict definition of
38 equality; e.g., that that two probs are equal iff they can be
39 distinguished by calls to ly:prob-property.
41 Prob
*probs
[2] = {unsmob_prob (sa
), unsmob_prob (sb
)};
45 for (i
= 0; i
< 2; i
++)
47 props
[i
][0] = probs
[i
]->immutable_property_alist_
;
48 props
[i
][1] = probs
[i
]->mutable_property_alist_
;
51 if (strcmp (probs
[0]->class_name (), probs
[1]->class_name ()))
54 /* Compare mutable and immutable lists, element by element. */
55 for (i
= 0; i
< 2; i
++)
57 SCM aprop
= props
[0][i
];
58 SCM bprop
= props
[1][i
];
61 scm_is_pair (aprop
) && scm_is_pair (bprop
);
62 aprop
= scm_cdr (aprop
), bprop
= scm_cdr (bprop
))
64 SCM aval
= scm_cdar (aprop
);
65 SCM bval
= scm_cdar (bprop
);
66 if (scm_caar (aprop
) != scm_caar (bprop
) ||
68 !(unsmob_input (aval
) && unsmob_input (bval
))
70 !to_boolean (scm_equal_p (aval
, bval
))))
74 /* is one list shorter? */
75 if (aprop
!= SCM_EOL
|| bprop
!= SCM_EOL
)
82 Prob::Prob (SCM type
, SCM immutable_init
)
85 mutable_property_alist_
= SCM_EOL
;
86 immutable_property_alist_
= immutable_init
;
96 Prob::Prob (Prob
const &src
)
98 immutable_property_alist_
= src
.immutable_property_alist_
;
99 mutable_property_alist_
= SCM_EOL
;
103 /* First we smobify_self, then we copy over the stuff. If we don't,
104 stack vars that hold the copy might be optimized away, meaning
105 that they won't be protected from GC. */
107 mutable_property_alist_
= src
.copy_mutable_properties ();
112 Prob::copy_mutable_properties () const
114 return ly_deep_copy (mutable_property_alist_
);
118 Prob::derived_mark () const
123 Prob::mark_smob (SCM smob
)
125 ASSERT_LIVE_IS_ALLOWED ();
127 Prob
*system
= (Prob
*) SCM_CELL_WORD_1 (smob
);
128 scm_gc_mark (system
->mutable_property_alist_
);
129 system
->derived_mark ();
131 return system
->immutable_property_alist_
;
135 Prob::print_smob (SCM smob
, SCM port
, scm_print_state
*)
137 Prob
*p
= (Prob
*) SCM_CELL_WORD_1 (smob
);
138 scm_puts ("#<", port
);
139 scm_puts ("Prob: ", port
);
140 scm_display (p
->type_
, port
);
141 scm_puts (" C++: ", port
);
142 scm_puts (p
->class_name (), port
);
143 scm_display (p
->mutable_property_alist_
, port
);
144 scm_display (p
->immutable_property_alist_
, port
);
146 scm_puts (" >\n", port
);
153 Prob::internal_get_property (SCM sym
) const
156 if (profile_property_accesses
)
157 note_property_access (&prob_property_lookup_table
, sym
);
163 SCM s
= scm_sloppy_assq (sym
, mutable_property_alist_
);
167 s
= scm_sloppy_assq (sym
, immutable_property_alist_
);
168 return (s
== SCM_BOOL_F
) ? SCM_EOL
: scm_cdr (s
);
171 /* We don't (yet) instrument probs */
173 Prob::instrumented_set_property (SCM sym
, SCM val
, const char*, int, const char*)
175 internal_set_property (sym
, val
);
179 Prob::internal_set_property (SCM sym
, SCM val
)
181 if (do_internal_type_checking_global
)
182 type_check_assignment (sym
, val
);
184 mutable_property_alist_
= scm_assq_set_x (mutable_property_alist_
, sym
, val
);
188 Prob::type_check_assignment (SCM
, SCM
) const
194 Prob::get_property_alist (bool m
) const
196 return (m
) ? mutable_property_alist_
: immutable_property_alist_
;
202 SCM nm
= get_property ("name");
203 if (scm_is_symbol (nm
))
204 return ly_symbol2string (nm
);
206 return this->class_name ();