LEFT | RIGHT |
1 /* | 1 /* |
2 Implement storage and manipulation of grob properties. | 2 Implement storage and manipulation of grob properties. |
3 */ | 3 */ |
4 | 4 |
5 #include <cstring> | 5 #include <cstring> |
6 | 6 |
7 #include "main.hh" | 7 #include "main.hh" |
8 #include "input.hh" | 8 #include "input.hh" |
9 #include "pointer-group-interface.hh" | 9 #include "pointer-group-interface.hh" |
10 #include "misc.hh" | 10 #include "misc.hh" |
11 #include "paper-score.hh" | 11 #include "paper-score.hh" |
12 #include "output-def.hh" | 12 #include "output-def.hh" |
13 #include "spanner.hh" | 13 #include "spanner.hh" |
14 #include "international.hh" | 14 #include "international.hh" |
15 #include "item.hh" | 15 #include "item.hh" |
16 #include "misc.hh" | 16 #include "misc.hh" |
17 #include "item.hh" | 17 #include "item.hh" |
18 #include "program-option.hh" | 18 #include "program-option.hh" |
19 #include "profile.hh" | 19 #include "profile.hh" |
20 #include "pure-closure.hh" | |
21 #include "simple-closure.hh" | 20 #include "simple-closure.hh" |
| 21 #include "unpure-pure-container.hh" |
22 #include "warn.hh" | 22 #include "warn.hh" |
23 #include "protected-scm.hh" | 23 #include "protected-scm.hh" |
24 | 24 |
25 Protected_scm grob_property_callback_stack = SCM_EOL; | 25 Protected_scm grob_property_callback_stack = SCM_EOL; |
26 | 26 |
27 extern bool debug_property_callbacks; | 27 extern bool debug_property_callbacks; |
28 | 28 |
29 #ifndef NDEBUG | 29 #ifndef NDEBUG |
30 static void | 30 static void |
31 print_property_callback_stack () | 31 print_property_callback_stack () |
(...skipping 85 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
117 Grob::internal_set_value_on_alist (SCM *alist, SCM sym, SCM v) | 117 Grob::internal_set_value_on_alist (SCM *alist, SCM sym, SCM v) |
118 { | 118 { |
119 /* Perhaps we simply do the assq_set, but what the heck. */ | 119 /* Perhaps we simply do the assq_set, but what the heck. */ |
120 if (!is_live ()) | 120 if (!is_live ()) |
121 return; | 121 return; |
122 | 122 |
123 if (do_internal_type_checking_global) | 123 if (do_internal_type_checking_global) |
124 { | 124 { |
125 if (!ly_is_procedure (v) | 125 if (!ly_is_procedure (v) |
126 && !is_simple_closure (v) | 126 && !is_simple_closure (v) |
127 && !is_pure_closure (v) | 127 && !is_unpure_pure_container (v) |
128 && v != ly_symbol2scm ("calculation-in-progress")) | 128 && v != ly_symbol2scm ("calculation-in-progress")) |
129 type_check_assignment (sym, v, ly_symbol2scm ("backend-type?")); | 129 type_check_assignment (sym, v, ly_symbol2scm ("backend-type?")); |
130 | 130 |
131 check_interfaces_for_property (this, sym); | 131 check_interfaces_for_property (this, sym); |
132 } | 132 } |
133 | 133 |
134 *alist = scm_assq_set_x (*alist, sym, v); | 134 *alist = scm_assq_set_x (*alist, sym, v); |
135 } | 135 } |
136 | 136 |
137 SCM | 137 SCM |
138 Grob::internal_get_property_data (SCM sym) const | 138 Grob::internal_get_property_data (SCM sym) const |
139 { | 139 { |
140 #ifndef NDEBUG | 140 #ifndef NDEBUG |
141 if (profile_property_accesses) | 141 if (profile_property_accesses) |
142 note_property_access (&grob_property_lookup_table, sym); | 142 note_property_access (&grob_property_lookup_table, sym); |
143 #endif | 143 #endif |
144 | 144 |
145 SCM handle = scm_sloppy_assq (sym, mutable_property_alist_); | 145 SCM handle = scm_sloppy_assq (sym, mutable_property_alist_); |
146 if (handle != SCM_BOOL_F) | 146 if (handle != SCM_BOOL_F) |
147 return scm_cdr (handle); | 147 return scm_cdr (handle); |
148 | 148 |
149 handle = scm_sloppy_assq (sym, immutable_property_alist_); | 149 handle = scm_sloppy_assq (sym, immutable_property_alist_); |
150 | 150 |
151 if (do_internal_type_checking_global && scm_is_pair (handle)) | 151 if (do_internal_type_checking_global && scm_is_pair (handle)) |
152 { | 152 { |
153 SCM val = scm_cdr (handle); | 153 SCM val = scm_cdr (handle); |
154 if (!ly_is_procedure (val) && !is_simple_closure (val) && !is_pure_closure
(val)) | 154 if (!ly_is_procedure (val) && !is_simple_closure (val) && !is_unpure_pure_
container (val)) |
155 type_check_assignment (sym, val, ly_symbol2scm ("backend-type?")); | 155 type_check_assignment (sym, val, ly_symbol2scm ("backend-type?")); |
156 | 156 |
157 check_interfaces_for_property (this, sym); | 157 check_interfaces_for_property (this, sym); |
158 } | 158 } |
159 | 159 |
160 return (handle == SCM_BOOL_F) ? SCM_EOL : scm_cdr (handle); | 160 return (handle == SCM_BOOL_F) ? SCM_EOL : scm_cdr (handle); |
161 } | 161 } |
162 | 162 |
163 SCM | 163 SCM |
164 Grob::internal_get_property (SCM sym) const | 164 Grob::internal_get_property (SCM sym) const |
165 { | 165 { |
166 SCM val = get_property_data (sym); | 166 SCM val = get_property_data (sym); |
167 | 167 |
168 #ifndef NDEBUG | 168 #ifndef NDEBUG |
169 if (val == ly_symbol2scm ("calculation-in-progress")) | 169 if (val == ly_symbol2scm ("calculation-in-progress")) |
170 { | 170 { |
171 programming_error (_f ("cyclic dependency: calculation-in-progress encount
ered for #'%s (%s)", | 171 programming_error (_f ("cyclic dependency: calculation-in-progress encount
ered for #'%s (%s)", |
172 ly_symbol2string (sym).c_str (), | 172 ly_symbol2string (sym).c_str (), |
173 name ().c_str ())); | 173 name ().c_str ())); |
174 if (debug_property_callbacks) | 174 if (debug_property_callbacks) |
175 { | 175 { |
176 message ("backtrace: "); | 176 message ("backtrace: "); |
177 print_property_callback_stack (); | 177 print_property_callback_stack (); |
178 } | 178 } |
179 } | 179 } |
180 #endif | 180 #endif |
181 | 181 |
182 if (is_pure_closure (val)) | 182 if (is_unpure_pure_container (val)) |
183 val = pure_closure_unpure_part (val); | 183 val = unpure_pure_container_unpure_part (val); |
184 if (ly_is_procedure (val) | 184 if (ly_is_procedure (val) |
185 || is_simple_closure (val)) | 185 || is_simple_closure (val)) |
186 { | 186 { |
187 Grob *me = ((Grob *)this); | 187 Grob *me = ((Grob *)this); |
188 val = me->try_callback_on_alist (&me->mutable_property_alist_, sym, val); | 188 val = me->try_callback_on_alist (&me->mutable_property_alist_, sym, val); |
189 } | 189 } |
190 | 190 |
191 return val; | 191 return val; |
192 } | 192 } |
193 | 193 |
194 /* Unlike internal_get_property, this function does no caching. Use it, therefor
e, with caution. */ | 194 /* Unlike internal_get_property, this function does no caching. Use it, therefor
e, with caution. */ |
195 SCM | 195 SCM |
196 Grob::internal_get_pure_property (SCM sym, int start, int end) const | 196 Grob::internal_get_pure_property (SCM sym, int start, int end) const |
197 { | 197 { |
198 SCM val = internal_get_property_data (sym); | 198 SCM val = internal_get_property_data (sym); |
199 if (is_pure_closure (val)) | 199 if (ly_is_procedure (val) || is_unpure_pure_container (val)) |
200 val = pure_closure_pure_part (val); | |
201 if (ly_is_procedure (val)) | |
202 return call_pure_function (val, scm_list_1 (self_scm ()), start, end); | 200 return call_pure_function (val, scm_list_1 (self_scm ()), start, end); |
203 if (is_simple_closure (val)) | 201 if (is_simple_closure (val)) |
204 return evaluate_with_simple_closure (self_scm (), | 202 return evaluate_with_simple_closure (self_scm (), |
205 simple_closure_expression (val), | 203 simple_closure_expression (val), |
206 true, start, end); | 204 true, start, end); |
207 return val; | 205 return val; |
208 } | 206 } |
209 | 207 |
210 SCM | 208 SCM |
211 Grob::internal_get_maybe_pure_property (SCM sym, bool pure, int start, int end)
const | 209 Grob::internal_get_maybe_pure_property (SCM sym, bool pure, int start, int end)
const |
(...skipping 82 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
294 if (profile_property_accesses) | 292 if (profile_property_accesses) |
295 note_property_access (&grob_property_lookup_table, sym); | 293 note_property_access (&grob_property_lookup_table, sym); |
296 | 294 |
297 SCM s = scm_sloppy_assq (sym, object_alist_); | 295 SCM s = scm_sloppy_assq (sym, object_alist_); |
298 | 296 |
299 if (s != SCM_BOOL_F) | 297 if (s != SCM_BOOL_F) |
300 { | 298 { |
301 SCM val = scm_cdr (s); | 299 SCM val = scm_cdr (s); |
302 if (ly_is_procedure (val) | 300 if (ly_is_procedure (val) |
303 || is_simple_closure (val) | 301 || is_simple_closure (val) |
304 || is_pure_closure (val)) | 302 || is_unpure_pure_container (val)) |
305 { | 303 { |
306 Grob *me = ((Grob *)this); | 304 Grob *me = ((Grob *)this); |
307 val = me->try_callback_on_alist (&me->object_alist_, sym, val); | 305 val = me->try_callback_on_alist (&me->object_alist_, sym, val); |
308 } | 306 } |
309 | 307 |
310 return val; | 308 return val; |
311 } | 309 } |
312 | 310 |
313 return SCM_EOL; | 311 return SCM_EOL; |
314 } | 312 } |
(...skipping 12 matching lines...) Expand all Loading... |
327 | 325 |
328 SCM | 326 SCM |
329 call_pure_function (SCM unpure, SCM args, int start, int end) | 327 call_pure_function (SCM unpure, SCM args, int start, int end) |
330 { | 328 { |
331 SCM scm_call_pure_function = ly_lily_module_constant ("call-pure-function"); | 329 SCM scm_call_pure_function = ly_lily_module_constant ("call-pure-function"); |
332 | 330 |
333 return scm_apply_0 (scm_call_pure_function, | 331 return scm_apply_0 (scm_call_pure_function, |
334 scm_list_4 (unpure, args, scm_from_int (start), scm_from_i
nt (end))); | 332 scm_list_4 (unpure, args, scm_from_int (start), scm_from_i
nt (end))); |
335 } | 333 } |
336 | 334 |
LEFT | RIGHT |