lily/include/lily-guile-macros.hh

   1 /*
   2   lily-guile-macros.hh -- declare
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2005--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7 */
   8
   9 #ifndef LILY_GUILE_MACROS_HH
  10 #define LILY_GUILE_MACROS_HH
  11
  12 #ifndef SMOB_FREE_RETURN_VAL
  13 #define SMOB_FREE_RETURN_VAL(CL) 0
  14 #endif
  15
  16 #ifndef SCM_PACK
  17 #define SCM_PACK(x) ((SCM) x)
  18 #endif
  19
  20 #ifndef SCM_UNPACK
  21 #define SCM_UNPACK(x) (x)
  22 #endif
  23
  24 /* Unreliable with gcc-2.x
  25    FIXME: should add check for x86 as well?  */
  26 #define CACHE_SYMBOLS
  27
  28
  29
  30
  31 #ifdef CACHE_SYMBOLS
  32
  33 /* this lets us "overload" macros such as get_property to take
  34    symbols as well as strings */
  35 inline SCM
  36 scm_or_str2symbol (char const *c) { return scm_str2symbol (c); }
  37
  38 inline SCM
  39 scm_or_str2symbol (SCM s) {
  40   assert (scm_is_symbol (s));
  41   return s;
  42 }
  43
  44 /* Using this trick we cache the value of scm_str2symbol ("fooo") where
  45    "fooo" is a constant string. This is done at the cost of one static
  46    variable per ly_symbol2scm() use, and one boolean evaluation for
  47    every call.
  48  */
  49 #define ly_symbol2scm(x)                                                \
  50   ({                                                                    \
  51     static SCM cached;                                                  \
  52     /* We store this one locally, since G++ -O2 fucks up else */        \
  53     SCM value = cached;                                                 \
  54     if (__builtin_constant_p ((x)))                                     \
  55       {                                                                 \
  56         if (!cached)                                                    \
  57           value = cached = scm_gc_protect_object (scm_or_str2symbol (x)); \
  58       }                                                                 \
  59     else                                                                \
  60       value = scm_or_str2symbol (x);                                    \
  61     value;                                                              \
  62   })
  63 #else
  64 inline SCM ly_symbol2scm (char const *x) { return scm_str2symbol ((x)); }
  65 #endif
  66
  67 /*
  68   TODO: rename me to ly_c_lily_module_eval
  69
  70   we don't have to protect the result; it's already part of the
  71   exports list of the module.
  72 */
  73
  74 #define ly_lily_module_constant(x)                                      \
  75   ({                                                                    \
  76     static SCM cached;                                                  \
  77     /* We store this one locally, since G++ -O2 fucks up else */        \
  78     SCM value = cached;                                                 \
  79     if (__builtin_constant_p ((x)))                                     \
  80       {                                                                 \
  81         if (!cached)                                                    \
  82           value = cached = scm_eval (scm_str2symbol (x),                \
  83                                      global_lily_module);               \
  84       }                                                                 \
  85     else                                                                \
  86       value = scm_eval (scm_str2symbol (x), global_lily_module);        \
  87     value;                                                              \
  88   })
  89
  90 /*
  91   Adds the NAME as a Scheme function, and a variable to store the SCM
  92   version of the function in the static variable NAME_proc
  93 */
  94 #define DECLARE_SCHEME_CALLBACK(NAME, ARGS)     \
  95   static SCM NAME ARGS;                         \
  96   static SCM NAME ## _proc
  97
  98 /*
  99   Make TYPE::FUNC available as a Scheme function.
 100 */
 101 string mangle_cxx_identifier (string);
 102 #define MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE, FUNC, ARGCOUNT, OPTIONAL_COUNT, DOC) \
 103   SCM TYPE ::FUNC ## _proc;                                             \
 104   void                                                                  \
 105   TYPE ## _ ## FUNC ## _init_functions ()                               \
 106   {                                                                     \
 107     string id = mangle_cxx_identifier (string (#TYPE) + "::" + string (#FUNC)); \
 108     TYPE ::FUNC ## _proc = scm_c_define_gsubr (id.c_str(),                      \
 109                                                (ARGCOUNT-OPTIONAL_COUNT), OPTIONAL_COUNT, 0,    \
 110                                                (Scheme_function_unknown) TYPE::FUNC); \
 111     ly_add_function_documentation (TYPE :: FUNC ## _proc, id.c_str(), "", \
 112                                    DOC);                                \
 113     scm_c_export (id.c_str (), NULL);                                   \
 114   }                                                                     \
 115                                                                         \
 116   ADD_SCM_INIT_FUNC (TYPE ## _ ## FUNC ## _callback,                    \
 117                      TYPE ## _ ## FUNC ## _init_functions);
 118
 119 #define MAKE_DOCUMENTED_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT, DOC)              \
 120   MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE, FUNC, ARGCOUNT, 0, DOC);
 121
 122 #define MAKE_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT)                      \
 123   MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE,FUNC,ARGCOUNT, 0, "");
 124
 125 void
 126 ly_add_function_documentation (SCM proc, string fname, string varlist, string doc);
 127
 128 #define ADD_SCM_INIT_FUNC(name, func)           \
 129   class name ## _scm_initter                    \
 130   {                                             \
 131   public:                                       \
 132     name ## _scm_initter ()                     \
 133     {                                           \
 134       add_scm_init_func (func);                 \
 135     }                                           \
 136   }                                             \
 137     _ ## name ## _scm_initter;
 138
 139 /* end define */
 140
 141 #define LY_DEFINE_WITHOUT_DECL(INITPREFIX, FNAME, PRIMNAME, REQ, OPT, VAR, \
 142                                ARGLIST, DOCSTRING)                      \
 143   SCM FNAME ## _proc;                                                   \
 144   void                                                                  \
 145   INITPREFIX ## init ()                                                 \
 146   {                                                                     \
 147     FNAME ## _proc = scm_c_define_gsubr (PRIMNAME, REQ, OPT, VAR,       \
 148                                          (Scheme_function_unknown) FNAME); \
 149     ly_add_function_documentation (FNAME ## _proc, PRIMNAME, #ARGLIST,  \
 150                                    DOCSTRING);                          \
 151     scm_c_export (PRIMNAME, NULL);                                      \
 152   }                                                                     \
 153   ADD_SCM_INIT_FUNC (INITPREFIX ## init_unique_prefix, INITPREFIX ## init); \
 154   SCM                                                                   \
 155   FNAME ARGLIST
 156
 157 #define LY_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING)   \
 158   SCM FNAME ARGLIST;                                                    \
 159   LY_DEFINE_WITHOUT_DECL (FNAME, FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, \
 160                           DOCSTRING)
 161
 162 #define LY_DEFINE_MEMBER_FUNCTION(CLASS, FNAME, PRIMNAME, REQ, OPT, VAR, \
 163                                   ARGLIST, DOCSTRING)                   \
 164   SCM FNAME ARGLIST;                                                    \
 165   LY_DEFINE_WITHOUT_DECL (CLASS ## FNAME, CLASS::FNAME, PRIMNAME, REQ, OPT, \
 166                           VAR, ARGLIST, DOCSTRING)
 167
 168 #define get_property(x) internal_get_property (ly_symbol2scm (x))
 169 #define get_property_data(x) internal_get_property_data (ly_symbol2scm (x))
 170 #define get_object(x) internal_get_object (ly_symbol2scm (x))
 171 #define set_object(x, y) internal_set_object (ly_symbol2scm (x), y)
 172 #define del_property(x) internal_del_property (ly_symbol2scm (x))
 173
 174 #ifndef NDEBUG
 175 /*
 176   TODO: include modification callback support here, perhaps
 177   through intermediate Grob::instrumented_set_property( .. __LINE__ ).
 178  */
 179 #define set_property(x, y) internal_set_property (ly_symbol2scm (x), y)
 180 #else
 181 #define set_property(x, y) internal_set_property (ly_symbol2scm (x), y)
 182 #endif
 183
 184 #endif /* LILY_GUILE_MACROS_HH */