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--2006 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 #if (__GNUC__ > 2)
  25 /* Unreliable with gcc-2.x
  26    FIXME: should add check for x86 as well?  */
  27 #define CACHE_SYMBOLS
  28 #endif
  29
  30 #ifdef CACHE_SYMBOLS
  31
  32 /* this lets us "overload" macros such as get_property to take
  33    symbols as well as strings */
  34 inline SCM
  35 scm_or_str2symbol (char const *c) { return scm_str2symbol (c); }
  36
  37 inline SCM
  38 scm_or_str2symbol (SCM s) { return s; }
  39
  40 /* Using this trick we cache the value of scm_str2symbol ("fooo") where
  41    "fooo" is a constant string. This is done at the cost of one static
  42    variable per ly_symbol2scm() use, and one boolean evaluation for
  43    every call.
  44
  45    The overall speedup of lily is about 5% on a run of wtk1-fugue2.  */
  46 #define ly_symbol2scm(x)                                                \
  47   ({                                                                    \
  48     static SCM cached;                                                  \
  49     /* We store this one locally, since G++ -O2 fucks up else */        \
  50     SCM value = cached;                                                 \
  51     if (__builtin_constant_p ((x)))                                     \
  52       {                                                                 \
  53         if (!cached)                                                    \
  54           value = cached = scm_gc_protect_object (scm_or_str2symbol (x)); \
  55       }                                                                 \
  56     else                                                                \
  57       value = scm_or_str2symbol (x);                                    \
  58     value;                                                              \
  59   })
  60 #else
  61 inline SCM ly_symbol2scm (char const *x) { return scm_str2symbol ((x)); }
  62 #endif
  63
  64 /*
  65   TODO: rename me to ly_c_lily_module_eval
  66
  67   we don't have to protect the result; it's already part of the
  68   exports list of the module.
  69 */
  70
  71 #define ly_lily_module_constant(x)                                      \
  72   ({                                                                    \
  73     static SCM cached;                                                  \
  74     /* We store this one locally, since G++ -O2 fucks up else */        \
  75     SCM value = cached;                                                 \
  76     if (__builtin_constant_p ((x)))                                     \
  77       {                                                                 \
  78         if (!cached)                                                    \
  79           value = cached = scm_eval (scm_str2symbol (x),                \
  80                                      global_lily_module);               \
  81       }                                                                 \
  82     else                                                                \
  83       value = scm_eval (scm_str2symbol (x), global_lily_module);        \
  84     value;                                                              \
  85   })
  86
  87 /*
  88   Adds the NAME as a Scheme function, and a variable to store the SCM
  89   version of the function in the static variable NAME_proc
  90 */
  91 #define DECLARE_SCHEME_CALLBACK(NAME, ARGS)     \
  92   static SCM NAME ARGS;                         \
  93   static SCM NAME ## _proc
  94
  95 /*
  96   Make TYPE::FUNC available as a Scheme function.
  97 */
  98 string mangle_cxx_identifier (string);
  99 #define MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE, FUNC, ARGCOUNT, OPTIONAL_COUNT) \
 100   SCM TYPE ::FUNC ## _proc;                                             \
 101   void                                                                  \
 102   TYPE ## _ ## FUNC ## _init_functions ()                               \
 103   {                                                                     \
 104     string id = mangle_cxx_identifier (string (#TYPE) + "::" + string (#FUNC)); \
 105     TYPE ::FUNC ## _proc = scm_c_define_gsubr (id.c_str(),                      \
 106                                                (ARGCOUNT-OPTIONAL_COUNT), OPTIONAL_COUNT, 0,    \
 107                                                (Scheme_function_unknown) TYPE::FUNC); \
 108     scm_c_export (id.c_str (), NULL);                                   \
 109   }                                                                     \
 110                                                                         \
 111   ADD_SCM_INIT_FUNC (TYPE ## _ ## FUNC ## _callback,                    \
 112                      TYPE ## _ ## FUNC ## _init_functions);
 113
 114 #define MAKE_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT)                      \
 115   MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE,FUNC,ARGCOUNT,0);
 116
 117 void
 118 ly_add_function_documentation (SCM proc, char const *fname,
 119                                char const *varlist,
 120                                char const *doc);
 121
 122 #define ADD_SCM_INIT_FUNC(name, func)           \
 123   class name ## _scm_initter                    \
 124   {                                             \
 125   public:                                       \
 126     name ## _scm_initter ()                     \
 127     {                                           \
 128       add_scm_init_func (func);                 \
 129     }                                           \
 130   }                                             \
 131     _ ## name ## _scm_initter;
 132
 133 /* end define */
 134
 135 #define LY_DEFINE_WITHOUT_DECL(INITPREFIX, FNAME, PRIMNAME, REQ, OPT, VAR, \
 136                                ARGLIST, DOCSTRING)                      \
 137   SCM FNAME ## _proc;                                                   \
 138   void                                                                  \
 139   INITPREFIX ## init ()                                                 \
 140   {                                                                     \
 141     FNAME ## _proc = scm_c_define_gsubr (PRIMNAME, REQ, OPT, VAR,       \
 142                                          (Scheme_function_unknown) FNAME); \
 143     ly_add_function_documentation (FNAME ## _proc, PRIMNAME, #ARGLIST,  \
 144                                    DOCSTRING);                          \
 145     scm_c_export (PRIMNAME, NULL);                                      \
 146   }                                                                     \
 147   ADD_SCM_INIT_FUNC (INITPREFIX ## init_unique_prefix, INITPREFIX ## init); \
 148   SCM                                                                   \
 149   FNAME ARGLIST
 150
 151 #define LY_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING)   \
 152   SCM FNAME ARGLIST;                                                    \
 153   LY_DEFINE_WITHOUT_DECL (FNAME, FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, \
 154                           DOCSTRING)
 155
 156 #define LY_DEFINE_MEMBER_FUNCTION(CLASS, FNAME, PRIMNAME, REQ, OPT, VAR, \
 157                                   ARGLIST, DOCSTRING)                   \
 158   SCM FNAME ARGLIST;                                                    \
 159   LY_DEFINE_WITHOUT_DECL (CLASS ## FNAME, CLASS::FNAME, PRIMNAME, REQ, OPT, \
 160                           VAR, ARGLIST, DOCSTRING)
 161
 162 #define get_property(x) internal_get_property (ly_symbol2scm (x))
 163 #define get_object(x) internal_get_object (ly_symbol2scm (x))
 164 #define set_object(x, y) internal_set_object (ly_symbol2scm (x), y)
 165 #define del_property(x) internal_del_property (ly_symbol2scm (x))
 166
 167 #ifndef NDEBUG
 168 #define set_property(x, y) internal_set_property (ly_symbol2scm (x), y, __FILE__, __LINE__, __FUNCTION__)
 169 #else
 170 #define set_property(x, y) internal_set_property (ly_symbol2scm (x), y)
 171 #endif
 172
 173 #endif /* LILY_GUILE_MACROS_HH */