#include "item.hh"
#include "program-option.hh"
#include "profile.hh"
-#include "simple-closure.hh"
#include "unpure-pure-container.hh"
#include "warn.hh"
#include "protected-scm.hh"
SCM
Grob::get_property_alist_chain (SCM def) const
{
- return scm_list_n (mutable_property_alist_,
+ return scm_list_3 (mutable_property_alist_,
immutable_property_alist_,
- def,
- SCM_UNDEFINED);
+ def);
}
extern void check_interfaces_for_property (Grob const *me, SCM sym);
if (do_internal_type_checking_global)
{
if (!ly_is_procedure (v)
- && !unsmob<Simple_closure> (v)
&& !unsmob<Unpure_pure_container> (v)
&& !scm_is_eq (v, ly_symbol2scm ("calculation-in-progress")))
type_check_assignment (sym, v, ly_symbol2scm ("backend-type?"));
if (do_internal_type_checking_global && scm_is_pair (handle))
{
SCM val = scm_cdr (handle);
- if (!ly_is_procedure (val) && !unsmob<Simple_closure> (val)
+ if (!ly_is_procedure (val)
&& !unsmob<Unpure_pure_container> (val))
type_check_assignment (sym, val, ly_symbol2scm ("backend-type?"));
if (Unpure_pure_container *upc = unsmob<Unpure_pure_container> (val))
val = upc->unpure_part ();
- if (ly_is_procedure (val)
- || unsmob<Simple_closure> (val))
+ if (ly_is_procedure (val))
{
Grob *me = ((Grob *)this);
val = me->try_callback_on_alist (&me->mutable_property_alist_, sym, val);
return call_pure_function (val, scm_list_1 (self_scm ()), start, end);
}
- if (Simple_closure *sc = unsmob<Simple_closure> (val))
- return evaluate_with_simple_closure (self_scm (),
- sc->expression (),
- true, start, end);
return val;
}
SCM value = SCM_EOL;
if (ly_is_procedure (proc))
value = scm_call_1 (proc, self_scm ());
- else if (Simple_closure *sc = unsmob<Simple_closure> (proc))
- {
- value = evaluate_with_simple_closure (self_scm (),
- sc->expression (),
- false, 0, 0);
- }
#ifdef DEBUG
if (debug_property_callbacks)
{
#ifdef DEBUG
if (ly_is_procedure (cache_callback))
- scm_apply_0 (cache_callback,
- scm_list_n (self_scm (),
- sym,
- proc,
- value,
- SCM_UNDEFINED));
+ scm_call_4 (cache_callback,
+ self_scm (),
+ sym,
+ proc,
+ value);
#endif
internal_set_value_on_alist (alist, sym, value);
}
{
SCM val = scm_cdr (s);
if (ly_is_procedure (val)
- || unsmob<Simple_closure> (val)
|| unsmob<Unpure_pure_container> (val))
{
Grob *me = ((Grob *)this);
}
SCM
-call_pure_function (SCM unpure, SCM args, int start, int end)
+call_pure_function (SCM value, SCM args, int start, int end)
{
- if (Unpure_pure_container *upc = unsmob<Unpure_pure_container> (unpure))
+ if (Unpure_pure_container *upc = unsmob<Unpure_pure_container> (value))
{
- SCM pure = upc->pure_part ();
-
- if (Simple_closure *sc = unsmob<Simple_closure> (pure))
+ if (upc->is_unchanging ())
{
- SCM expr = sc->expression ();
- return evaluate_with_simple_closure (scm_car (args), expr, true, start, end);
+ // Don't bother forming an Unpure_pure_call here.
+ value = upc->unpure_part ();
+
+ if (ly_is_procedure (value))
+ return scm_apply_0 (value, args);
+ return value;
}
- if (ly_is_procedure (pure))
- return scm_apply_0 (pure,
- scm_append (scm_list_2 (scm_list_3 (scm_car (args),
- scm_from_int (start),
- scm_from_int (end)),
- scm_cdr (args))));
+ value = upc->pure_part ();
- return pure;
- }
+ if (ly_is_procedure (value))
+ return scm_apply_3 (value,
+ scm_car (args),
+ scm_from_int (start),
+ scm_from_int (end),
+ scm_cdr (args));
- if (Simple_closure *sc = unsmob<Simple_closure> (unpure))
- {
- SCM expr = sc->expression ();
- return evaluate_with_simple_closure (scm_car (args), expr, true, start, end);
+ return value;
}
- if (!ly_is_procedure (unpure))
- return unpure;
+ if (!ly_is_procedure (value))
+ return value;
return SCM_BOOL_F;
}
-