From cd24428e6115e6d96e42993966dc9175426f9baa Mon Sep 17 00:00:00 2001
From: David Kastrup <dak@gnu.org>
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<Simple_closure>
+{
+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 ("#<simple-closure ", port);
scm_display (scm_cdr (s), port);
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