From cd24428e6115e6d96e42993966dc9175426f9baa Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Sun, 31 Aug 2014 13:47:48 +0200 Subject: [PATCH] Issue 4086/4: Reimplement Simple_closure using Smob1 --- lily/context-property.cc | 2 +- lily/grob-closure.cc | 20 +++++++-------- lily/grob-property.cc | 25 ++++++++++--------- lily/grob-scheme.cc | 2 +- lily/include/simple-closure.hh | 12 ++++++--- lily/simple-closure.cc | 45 ++++++---------------------------- 6 files changed, 41 insertions(+), 65 deletions(-) diff --git a/lily/context-property.cc b/lily/context-property.cc index 07d512d6e3..cc98feeba0 100644 --- a/lily/context-property.cc +++ b/lily/context-property.cc @@ -59,7 +59,7 @@ typecheck_grob (SCM symbol, SCM value) return typecheck_grob (symbol, unpure_pure_container_unpure_part (value)) && typecheck_grob (symbol, unpure_pure_container_pure_part (value)); return ly_is_procedure (value) - || is_simple_closure (value) + || Simple_closure::unsmob (value) || type_check_assignment (symbol, value, ly_symbol2scm ("backend-type?")); } diff --git a/lily/grob-closure.cc b/lily/grob-closure.cc index 4c63fe3c0c..06a947d0de 100644 --- a/lily/grob-closure.cc +++ b/lily/grob-closure.cc @@ -33,24 +33,24 @@ add_offset_callback (Grob *g, SCM proc, Axis a) SCM data = g->get_property_data (axis_offset_symbol (a)); if (!scm_is_number (data) && !ly_is_procedure (data) - && !is_simple_closure (data)) + && !Simple_closure::unsmob (data)) { g->set_property (axis_offset_symbol (a), proc); return; } if (ly_is_procedure (data) || is_unpure_pure_container (data)) - data = ly_make_simple_closure (scm_list_1 (data)); - else if (is_simple_closure (data)) - data = simple_closure_expression (data); + data = Simple_closure::make_smob (scm_list_1 (data)); + else if (Simple_closure *sc = Simple_closure::unsmob (data)) + data = sc->expression (); SCM plus = ly_lily_module_constant ("+"); if (ly_is_procedure (proc)) - proc = ly_make_simple_closure (scm_list_1 (proc)); + proc = Simple_closure::make_smob (scm_list_1 (proc)); SCM expr = scm_list_3 (plus, proc, data); - g->set_property (axis_offset_symbol (a), ly_make_simple_closure (expr)); + g->set_property (axis_offset_symbol (a), Simple_closure::make_smob (expr)); } /* @@ -68,9 +68,9 @@ chain_callback (Grob *g, SCM proc, SCM sym) SCM data = g->get_property_data (sym); if (ly_is_procedure (data) || is_unpure_pure_container (data)) - data = ly_make_simple_closure (scm_list_1 (data)); - else if (is_simple_closure (data)) - data = simple_closure_expression (data); + data = Simple_closure::make_smob (scm_list_1 (data)); + else if (Simple_closure *sc = Simple_closure::unsmob (data)) + data = sc->expression (); else /* Data may be nonnumber. In that case, it is assumed to be @@ -84,7 +84,7 @@ chain_callback (Grob *g, SCM proc, SCM sym) // twice: one as a wrapper for grob property routines, // once for the actual delayed binding. - ly_make_simple_closure (ly_make_simple_closure (expr))); + Simple_closure::make_smob (Simple_closure::make_smob (expr))); } void diff --git a/lily/grob-property.cc b/lily/grob-property.cc index 32ff49124d..e88e6e3406 100644 --- a/lily/grob-property.cc +++ b/lily/grob-property.cc @@ -123,7 +123,7 @@ Grob::internal_set_value_on_alist (SCM *alist, SCM sym, SCM v) if (do_internal_type_checking_global) { if (!ly_is_procedure (v) - && !is_simple_closure (v) + && !Simple_closure::unsmob (v) && !is_unpure_pure_container (v) && v != ly_symbol2scm ("calculation-in-progress")) type_check_assignment (sym, v, ly_symbol2scm ("backend-type?")); @@ -151,7 +151,8 @@ Grob::internal_get_property_data (SCM sym) const if (do_internal_type_checking_global && scm_is_pair (handle)) { SCM val = scm_cdr (handle); - if (!ly_is_procedure (val) && !is_simple_closure (val) && !is_unpure_pure_container (val)) + if (!ly_is_procedure (val) && !Simple_closure::unsmob (val) + && !is_unpure_pure_container (val)) type_check_assignment (sym, val, ly_symbol2scm ("backend-type?")); check_interfaces_for_property (this, sym); @@ -183,7 +184,7 @@ Grob::internal_get_property (SCM sym) const val = unpure_pure_container_unpure_part (val); if (ly_is_procedure (val) - || is_simple_closure (val)) + || Simple_closure::unsmob (val)) { Grob *me = ((Grob *)this); val = me->try_callback_on_alist (&me->mutable_property_alist_, sym, val); @@ -208,9 +209,9 @@ Grob::internal_get_pure_property (SCM sym, int start, int end) const return call_pure_function (val, scm_list_1 (self_scm ()), start, end); } - if (is_simple_closure (val)) + if (Simple_closure *sc = Simple_closure::unsmob (val)) return evaluate_with_simple_closure (self_scm (), - simple_closure_expression (val), + sc->expression (), true, start, end); return val; } @@ -239,10 +240,10 @@ Grob::try_callback_on_alist (SCM *alist, SCM sym, SCM proc) SCM value = SCM_EOL; if (ly_is_procedure (proc)) value = scm_call_1 (proc, self_scm ()); - else if (is_simple_closure (proc)) + else if (Simple_closure *sc = Simple_closure::unsmob (proc)) { value = evaluate_with_simple_closure (self_scm (), - simple_closure_expression (proc), + sc->expression (), false, 0, 0); } @@ -303,7 +304,7 @@ Grob::internal_get_object (SCM sym) const { SCM val = scm_cdr (s); if (ly_is_procedure (val) - || is_simple_closure (val) + || Simple_closure::unsmob (val) || is_unpure_pure_container (val)) { Grob *me = ((Grob *)this); @@ -335,9 +336,9 @@ call_pure_function (SCM unpure, SCM args, int start, int end) { SCM pure = unpure_pure_container_pure_part (unpure); - if (is_simple_closure (pure)) + if (Simple_closure *sc = Simple_closure::unsmob (pure)) { - SCM expr = simple_closure_expression (pure); + SCM expr = sc->expression (); return evaluate_with_simple_closure (scm_car (args), expr, true, start, end); } @@ -351,9 +352,9 @@ call_pure_function (SCM unpure, SCM args, int start, int end) return pure; } - if (is_simple_closure (unpure)) + if (Simple_closure *sc = Simple_closure::unsmob (unpure)) { - SCM expr = simple_closure_expression (unpure); + SCM expr = sc->expression (); return evaluate_with_simple_closure (scm_car (args), expr, true, start, end); } diff --git a/lily/grob-scheme.cc b/lily/grob-scheme.cc index 065cc991d8..c9b7bdaccb 100644 --- a/lily/grob-scheme.cc +++ b/lily/grob-scheme.cc @@ -51,7 +51,7 @@ LY_DEFINE (ly_grob_set_property_x, "ly:grob-set-property!", LY_ASSERT_TYPE (ly_is_symbol, sym, 2); if (!ly_is_procedure (val) - && !is_simple_closure (val) + && !Simple_closure::unsmob (val) && !type_check_assignment (sym, val, ly_symbol2scm ("backend-type?"))) error ("typecheck failed"); diff --git a/lily/include/simple-closure.hh b/lily/include/simple-closure.hh index 9f4186e58b..3ce4f20d94 100644 --- a/lily/include/simple-closure.hh +++ b/lily/include/simple-closure.hh @@ -21,10 +21,16 @@ #define SIMPLE_CLOSURE_HH #include "lily-guile.hh" +#include "small-smobs.hh" + +class Simple_closure : public Smob1 +{ +public: + SCM expression() const { return scm1 (); } + static int print_smob (SCM, SCM, scm_print_state *); + static const char type_p_name_[]; +}; -bool is_simple_closure (SCM s); -SCM simple_closure_expression (SCM smob); SCM evaluate_with_simple_closure (SCM delayed_argument, SCM expr, bool pure, int start, int end); -SCM ly_make_simple_closure (SCM); #endif /* SIMPLE_CLOSURE_HH */ diff --git a/lily/simple-closure.cc b/lily/simple-closure.cc index a9aa435cab..bfc4b34bb8 100644 --- a/lily/simple-closure.cc +++ b/lily/simple-closure.cc @@ -22,21 +22,6 @@ #include "grob.hh" -static scm_t_bits simple_closure_tag; - -bool -is_simple_closure (SCM s) -{ - return (SCM_NIMP (s) && SCM_CELL_TYPE (s) == simple_closure_tag); -} - -SCM -simple_closure_expression (SCM smob) -{ - assert (is_simple_closure (smob)); - return (SCM) SCM_CELL_WORD_1 (smob); -} - SCM evaluate_args (SCM delayed_argument, SCM args, bool pure, int start, int end) { @@ -62,9 +47,9 @@ evaluate_with_simple_closure (SCM delayed_argument, int start, int end) { - if (is_simple_closure (expr)) + if (Simple_closure *sc = Simple_closure::unsmob (expr)) { - SCM inside = simple_closure_expression (expr); + SCM inside = sc->expression (); SCM proc = is_unpure_pure_container (scm_car (inside)) ? (pure ? scm_car (inside) : unpure_pure_container_unpure_part (scm_car (inside))) : scm_car (inside); @@ -102,12 +87,7 @@ evaluate_with_simple_closure (SCM delayed_argument, return SCM_EOL; } -LY_DEFINE (ly_simple_closure_p, "ly:simple-closure?", - 1, 0, 0, (SCM clos), - "Is @var{clos} a simple closure?") -{ - return scm_from_bool (is_simple_closure (clos)); -} +const char Simple_closure::type_p_name_[] = "ly:simple-closure?"; LY_DEFINE (ly_make_simple_closure, "ly:make-simple-closure", 1, 0, 0, (SCM expr), @@ -116,10 +96,7 @@ LY_DEFINE (ly_make_simple_closure, "ly:make-simple-closure", " invoked as @code{(@var{func} @var{delayed-arg} @var{a1}" " @var{a2} @dots{})}.") { - SCM z; - - SCM_NEWSMOB (z, simple_closure_tag, expr); - return z; + return Simple_closure::make_smob (expr); } LY_DEFINE (ly_eval_simple_closure, "ly:eval-simple-closure", @@ -128,27 +105,19 @@ LY_DEFINE (ly_eval_simple_closure, "ly:eval-simple-closure", " argument. If @var{scm-start} and @var{scm-end} are defined," " evaluate it purely with those start and end points.") { + LY_ASSERT_SMOB (Simple_closure, closure, 2); bool pure = (scm_is_number (scm_start) && scm_is_number (scm_end)); int start = robust_scm2int (scm_start, 0); int end = robust_scm2int (scm_end, 0); - SCM expr = simple_closure_expression (closure); + SCM expr = Simple_closure::unsmob (closure)->expression (); return evaluate_with_simple_closure (delayed, expr, pure, start, end); } int -print_simple_closure (SCM s, SCM port, scm_print_state *) +Simple_closure::print_smob (SCM s, SCM port, scm_print_state *) { scm_puts ("#", port); return 1; } - -void init_simple_closure () -{ - simple_closure_tag = scm_make_smob_type ("simple-closure", 0); - scm_set_smob_mark (simple_closure_tag, scm_markcdr); - scm_set_smob_print (simple_closure_tag, print_simple_closure); -}; - -ADD_SCM_INIT_FUNC (simple_closure, init_simple_closure); -- 2.39.5