From: David Kastrup Date: Thu, 24 Sep 2015 15:51:54 +0000 (+0200) Subject: Issue 4620/5: Remove/replace Simple_closure smob type X-Git-Tag: release/2.19.29-1~35 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=c5d9f09505f28e5b44c7070fd88a841a271b8028;p=lilypond.git Issue 4620/5: Remove/replace Simple_closure smob type --- diff --git a/lily/context-property.cc b/lily/context-property.cc index 87bfbc5b9d..534fced49a 100644 --- a/lily/context-property.cc +++ b/lily/context-property.cc @@ -24,7 +24,6 @@ #include "international.hh" #include "item.hh" #include "main.hh" -#include "simple-closure.hh" #include "smobs.hh" #include "spanner.hh" #include "unpure-pure-container.hh" @@ -59,7 +58,6 @@ typecheck_grob (SCM symbol, SCM value) return typecheck_grob (symbol, upc->unpure_part ()) && typecheck_grob (symbol, upc->pure_part ()); return ly_is_procedure (value) - || unsmob (value) || type_check_assignment (symbol, value, ly_symbol2scm ("backend-type?")); } diff --git a/lily/grob-closure.cc b/lily/grob-closure.cc index 978cbeb76c..bfafd4c982 100644 --- a/lily/grob-closure.cc +++ b/lily/grob-closure.cc @@ -1,5 +1,4 @@ #include "grob.hh" -#include "simple-closure.hh" #include "unpure-pure-container.hh" #include "lily-imports.hh" @@ -31,25 +30,9 @@ axis_parent_positioning (Axis a) void 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) - && !unsmob (data)) - { - g->set_property (axis_offset_symbol (a), proc); - return; - } - - if (ly_is_procedure (data) || unsmob (data)) - data = Simple_closure::make_smob (scm_list_1 (data)); - else if (Simple_closure *sc = unsmob (data)) - data = sc->expression (); - - if (ly_is_procedure (proc)) - proc = Simple_closure::make_smob (scm_list_1 (proc)); - - SCM expr = scm_list_3 (Guile_user::plus, proc, data); - g->set_property (axis_offset_symbol (a), Simple_closure::make_smob (expr)); + SCM sym = axis_offset_symbol (a); + SCM data = g->get_property_data (sym); + g->set_property (sym, Lily::grob_offset_function (proc, data)); } /* @@ -65,25 +48,7 @@ void chain_callback (Grob *g, SCM proc, SCM sym) { SCM data = g->get_property_data (sym); - - if (ly_is_procedure (data) || unsmob (data)) - data = Simple_closure::make_smob (scm_list_1 (data)); - else if (Simple_closure *sc = unsmob (data)) - data = sc->expression (); - else - /* - Data may be nonnumber. In that case, it is assumed to be - undefined. - */ - - data = SCM_UNDEFINED; - - SCM expr = scm_list_2 (proc, data); - g->set_property (sym, - - // twice: one as a wrapper for grob property routines, - // once for the actual delayed binding. - Simple_closure::make_smob (Simple_closure::make_smob (expr))); + g->set_property (sym, Lily::grob_compose_function (proc, data)); } void diff --git a/lily/grob-property.cc b/lily/grob-property.cc index e21ccf479d..260b6700c4 100644 --- a/lily/grob-property.cc +++ b/lily/grob-property.cc @@ -15,7 +15,6 @@ #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" @@ -121,7 +120,6 @@ Grob::internal_set_value_on_alist (SCM *alist, SCM sym, SCM v) if (do_internal_type_checking_global) { if (!ly_is_procedure (v) - && !unsmob (v) && !unsmob (v) && !scm_is_eq (v, ly_symbol2scm ("calculation-in-progress"))) type_check_assignment (sym, v, ly_symbol2scm ("backend-type?")); @@ -149,7 +147,7 @@ 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) && !unsmob (val) + if (!ly_is_procedure (val) && !unsmob (val)) type_check_assignment (sym, val, ly_symbol2scm ("backend-type?")); @@ -181,8 +179,7 @@ Grob::internal_get_property (SCM sym) const if (Unpure_pure_container *upc = unsmob (val)) val = upc->unpure_part (); - if (ly_is_procedure (val) - || unsmob (val)) + if (ly_is_procedure (val)) { Grob *me = ((Grob *)this); val = me->try_callback_on_alist (&me->mutable_property_alist_, sym, val); @@ -207,10 +204,6 @@ 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 (Simple_closure *sc = unsmob (val)) - return evaluate_with_simple_closure (self_scm (), - sc->expression (), - true, start, end); return val; } @@ -238,12 +231,6 @@ 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 (Simple_closure *sc = unsmob (proc)) - { - value = evaluate_with_simple_closure (self_scm (), - sc->expression (), - false, 0, 0); - } #ifdef DEBUG if (debug_property_callbacks) @@ -302,7 +289,6 @@ Grob::internal_get_object (SCM sym) const { SCM val = scm_cdr (s); if (ly_is_procedure (val) - || unsmob (val) || unsmob (val)) { Grob *me = ((Grob *)this); @@ -334,12 +320,6 @@ call_pure_function (SCM unpure, SCM args, int start, int end) { SCM pure = upc->pure_part (); - if (Simple_closure *sc = unsmob (pure)) - { - SCM expr = sc->expression (); - return evaluate_with_simple_closure (scm_car (args), expr, true, start, end); - } - if (ly_is_procedure (pure)) return scm_apply_0 (pure, scm_append (scm_list_2 (scm_list_3 (scm_car (args), @@ -350,15 +330,8 @@ call_pure_function (SCM unpure, SCM args, int start, int end) return pure; } - if (Simple_closure *sc = unsmob (unpure)) - { - SCM expr = sc->expression (); - return evaluate_with_simple_closure (scm_car (args), expr, true, start, end); - } - if (!ly_is_procedure (unpure)) return unpure; return SCM_BOOL_F; } - diff --git a/lily/grob-scheme.cc b/lily/grob-scheme.cc index 0924b0a58d..1a316b7ae1 100644 --- a/lily/grob-scheme.cc +++ b/lily/grob-scheme.cc @@ -23,7 +23,6 @@ #include "item.hh" #include "output-def.hh" #include "paper-score.hh" -#include "simple-closure.hh" #include "system.hh" #include "unpure-pure-container.hh" #include "warn.hh" // error () @@ -51,7 +50,6 @@ LY_DEFINE (ly_grob_set_property_x, "ly:grob-set-property!", LY_ASSERT_TYPE (ly_is_symbol, sym, 2); if (!ly_is_procedure (val) - && !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 deleted file mode 100644 index 49e501c80a..0000000000 --- a/lily/include/simple-closure.hh +++ /dev/null @@ -1,36 +0,0 @@ -/* - This file is part of LilyPond, the GNU music typesetter. - - Copyright (C) 2005--2015 Han-Wen Nienhuys - - LilyPond is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - LilyPond is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with LilyPond. If not, see . -*/ - -#ifndef SIMPLE_CLOSURE_HH -#define SIMPLE_CLOSURE_HH - -#include "lily-guile.hh" -#include "small-smobs.hh" - -class Simple_closure : public Smob1 -{ -public: - SCM expression() const { return scm1 (); } - int print_smob (SCM, scm_print_state *) const; - static const char type_p_name_[]; -}; - -SCM evaluate_with_simple_closure (SCM delayed_argument, SCM expr, bool pure, int start, int end); - -#endif /* SIMPLE_CLOSURE_HH */ diff --git a/lily/parenthesis-engraver.cc b/lily/parenthesis-engraver.cc index 160a393587..1479aa4c0b 100644 --- a/lily/parenthesis-engraver.cc +++ b/lily/parenthesis-engraver.cc @@ -22,7 +22,6 @@ #include "item.hh" #include "pointer-group-interface.hh" -#include "simple-closure.hh" #include "stream-event.hh" #include "warn.hh" diff --git a/lily/simple-closure.cc b/lily/simple-closure.cc deleted file mode 100644 index 465640eef5..0000000000 --- a/lily/simple-closure.cc +++ /dev/null @@ -1,123 +0,0 @@ -/* - This file is part of LilyPond, the GNU music typesetter. - - Copyright (C) 2005--2015 Han-Wen Nienhuys - - - LilyPond is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - LilyPond is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with LilyPond. If not, see . -*/ -#include "simple-closure.hh" -#include "unpure-pure-container.hh" - -#include "grob.hh" - -SCM -evaluate_args (SCM delayed_argument, SCM args, bool pure, int start, int end) -{ - SCM new_args = SCM_EOL; - SCM *tail = &new_args; - for (SCM s = args; scm_is_pair (s); s = scm_cdr (s)) - { - *tail = scm_cons (evaluate_with_simple_closure (delayed_argument, scm_car (s), - pure, start, end), - SCM_EOL); - if (scm_is_eq (scm_car (*tail), SCM_UNSPECIFIED)) - return SCM_UNSPECIFIED; - tail = SCM_CDRLOC (*tail); - } - - return new_args; -} - -SCM -evaluate_with_simple_closure (SCM delayed_argument, - SCM expr, - bool pure, - int start, - int end) -{ - if (Simple_closure *sc = unsmob (expr)) - { - SCM inside = sc->expression (); - SCM proc = !pure && unsmob (scm_car (inside)) - ? unsmob (scm_car (inside))->unpure_part () - : scm_car (inside); - SCM args = scm_cons (delayed_argument, - evaluate_args (delayed_argument, scm_cdr (inside), - pure, start, end)); - if (scm_is_eq (scm_cdr (args), SCM_UNSPECIFIED)) - return SCM_UNSPECIFIED; - if (pure) - return call_pure_function (proc, args, start, end); - return scm_apply_0 (proc, args); - } - else if (!scm_is_pair (expr)) - return expr; - else if (scm_is_eq (scm_car (expr), ly_symbol2scm ("quote"))) - return scm_cadr (expr); - else if (unsmob (scm_car (expr)) - || ly_is_procedure (scm_car (expr))) - { - SCM proc = !pure && unsmob (scm_car (expr)) - ? unsmob (scm_car (expr))->unpure_part () - : scm_car (expr); - SCM args = evaluate_args (delayed_argument, scm_cdr (expr), pure, start, end); - if (scm_is_eq (args, SCM_UNSPECIFIED)) - return SCM_UNSPECIFIED; - if (pure) - return call_pure_function (proc, args, start, end); - return scm_apply_0 (proc, args); - } - else - // ugh. deviation from standard. Should print error? - return evaluate_args (delayed_argument, scm_cdr (expr), pure, start, end); - - assert (false); - return SCM_EOL; -} - -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), - "Make a simple closure. @var{expr} should be form of" - " @code{(@var{func} @var{a1} @var{a2} @dots{})}, and will be" - " invoked as @code{(@var{func} @var{delayed-arg} @var{a1}" - " @var{a2} @dots{})}.") -{ - return Simple_closure::make_smob (expr); -} - -LY_DEFINE (ly_eval_simple_closure, "ly:eval-simple-closure", - 2, 2, 0, (SCM delayed, SCM closure, SCM scm_start, SCM scm_end), - "Evaluate a simple @var{closure} with the given @var{delayed}" - " 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 = unsmob (closure)->expression (); - return evaluate_with_simple_closure (delayed, expr, pure, start, end); -} - -int -Simple_closure::print_smob (SCM port, scm_print_state *) const -{ - scm_puts ("#", port); - return 1; -} diff --git a/scm/lily.scm b/scm/lily.scm index ff5d66dfed..c670eb15bf 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -732,7 +732,6 @@ messages into errors.") (,ly:pitch? . "pitch") (,ly:prob? . "property object") (,ly:score? . "score") - (,ly:simple-closure? . "simple closure") (,ly:skyline? . "skyline") (,ly:skyline-pair? . "pair of skylines") (,ly:source-file? . "source file")