Issue 4086/4: Reimplement Simple_closure using Smob1

diff --git a/lily/context-property.cc b/lily/context-property.cc
index 07d512d6e3a39b47afe818a5f023f82d14f7b264..cc98feeba05dfc3a9840bde07122b67994d1fc33 100644 (file)
--- 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 4c63fe3c0c55436c4a608e0747582ff026c6ffd7..06a947d0de3a169a721ba45c2cc5d04ffe3dd672 100644 (file)
--- 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 32ff49124dff37919c6e21b5b8778874338c188b..e88e6e34069bdb630739635b111db1ea8e61de1b 100644 (file)
--- 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 065cc991d832d31aea83cd68a6da6d2659fca2a0..c9b7bdaccbc40a4632a7dfbdd00e662108226912 100644 (file)
--- 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 9f4186e58ba8fb3c9d30f58c2a02f46505891467..3ce4f20d9483a987b2816524020aec49b1dac4d2 100644 (file)
--- 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 a9aa435cab7fb19731382a4a825e0f59cfde028c..bfc4b34bb8a3a13d392edf0f9b8fefd639ca3989 100644 (file)
--- 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);