Issue 4086/5: Introduce callable Smob infrastructure

diff --git a/lily/include/smobs.hh b/lily/include/smobs.hh
index 4bf07245febe0ea2d9925b18cd088b6c30eda574..373bf77c6f0ca2ba1d0e5e7a9619029bb4e8cb56 100644 (file)
--- a/lily/include/smobs.hh
+++ b/lily/include/smobs.hh
@@ -181,6 +181,8 @@ private:
 
   static const int mark_smob = 0;
   static const int equal_p = 0;
+  static const int smob_proc = 0;
+  static const int smob_proc_signature_ = 0;
   static int print_smob (SCM, SCM, scm_print_state *);
   static size_t free_smob (SCM obj)
   {
@@ -199,6 +201,20 @@ private:
   // trickier in its failure symptoms when things go wrong.  So we
   // just do things like with the other specializations.
   static const int type_p_name_ = 0;
+  // This macro is used in the Super class definition for making a
+  // smob callable like a function.  Declaration has to be public.  It
+  // may be either be completed with a semicolon in which case a
+  // definition of the member function smob_proc has to be done
+  // outside of the class body, or the semicolon is left off and an
+  // inline function body is added immediately below.  It would be
+  // nice if this were a non-static member function but it would seem
+  // tricky to do the required trampolining for unsmobbing the first
+  // argument of the callback and using it as a this pointer.
+#define LY_DECLARE_SMOB_PROC(REQ, OPT, VAR, ARGLIST)                    \
+  static const int smob_proc_signature_ = ((REQ)<<8)|((OPT)<<4)|(VAR);  \
+  static SCM smob_proc ARGLIST
+  // a separate LY_DEFINE_SMOB_PROC seems sort of pointless as it
+  // would just result in SCM CLASS::smob_proc ARGLIST
 public:
   static bool is_smob (SCM s)
   {

diff --git a/lily/include/smobs.tcc b/lily/include/smobs.tcc
index f7b6fe3e4b0a9a55a1746670092863afa312dc45..f990a08f539abbb94120ac559b9be310374f7a30 100644 (file)
--- a/lily/include/smobs.tcc
+++ b/lily/include/smobs.tcc
@@ -107,6 +107,11 @@ void Smob_base<Super>::init ()
       scm_c_export (Super::type_p_name_, NULL);
     }
   ly_add_type_predicate ((void *) unsmob, smob_name_.c_str ());
+  if (Super::smob_proc != 0)
+    scm_set_smob_apply (smob_tag_,
+                        (scm_t_subr)Super::smob_proc,
+                        Super::smob_proc_signature_ >> 8,
+                        (Super::smob_proc_signature_ >> 4)&0xf,
+                        Super::smob_proc_signature_ & 0xf);
 }
-
 #endif