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 /* 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) \
 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     scm_c_export (id.c_str (), NULL);                                   \
 112   }                                                                     \
 113                                                                         \
 114   ADD_SCM_INIT_FUNC (TYPE ## _ ## FUNC ## _callback,                    \
 115                      TYPE ## _ ## FUNC ## _init_functions);
 116
 117 #define MAKE_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT)                      \
 118   MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE,FUNC,ARGCOUNT,0);
 119
 120 void
 121 ly_add_function_documentation (SCM proc, char const *fname,
 122                                char const *varlist,
 123                                char const *doc);
 124
 125 #define ADD_SCM_INIT_FUNC(name, func)           \
 126   class name ## _scm_initter                    \
 127   {                                             \
 128   public:                                       \
 129     name ## _scm_initter ()                     \
 130     {                                           \
 131       add_scm_init_func (func);                 \
 132     }                                           \
 133   }                                             \
 134     _ ## name ## _scm_initter;
 135
 136 /* end define */
 137
 138 #define LY_DEFINE_WITHOUT_DECL(INITPREFIX, FNAME, PRIMNAME, REQ, OPT, VAR, \
 139                                ARGLIST, DOCSTRING)                      \
 140   SCM FNAME ## _proc;                                                   \
 141   void                                                                  \
 142   INITPREFIX ## init ()                                                 \
 143   {                                                                     \
 144     FNAME ## _proc = scm_c_define_gsubr (PRIMNAME, REQ, OPT, VAR,       \
 145                                          (Scheme_function_unknown) FNAME); \
 146     ly_add_function_documentation (FNAME ## _proc, PRIMNAME, #ARGLIST,  \
 147                                    DOCSTRING);                          \
 148     scm_c_export (PRIMNAME, NULL);                                      \
 149   }                                                                     \
 150   ADD_SCM_INIT_FUNC (INITPREFIX ## init_unique_prefix, INITPREFIX ## init); \
 151   SCM                                                                   \
 152   FNAME ARGLIST
 153
 154 #define LY_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING)   \
 155   SCM FNAME ARGLIST;                                                    \
 156   LY_DEFINE_WITHOUT_DECL (FNAME, FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, \
 157                           DOCSTRING)
 158
 159 #define LY_DEFINE_MEMBER_FUNCTION(CLASS, FNAME, PRIMNAME, REQ, OPT, VAR, \
 160                                   ARGLIST, DOCSTRING)                   \
 161   SCM FNAME ARGLIST;                                                    \
 162   LY_DEFINE_WITHOUT_DECL (CLASS ## FNAME, CLASS::FNAME, PRIMNAME, REQ, OPT, \
 163                           VAR, ARGLIST, DOCSTRING)
 164
 165 #define get_property(x) internal_get_property (ly_symbol2scm (x))
 166 #define get_object(x) internal_get_object (ly_symbol2scm (x))
 167 #define set_object(x, y) internal_set_object (ly_symbol2scm (x), y)
 168 #define del_property(x) internal_del_property (ly_symbol2scm (x))
 169
 170 #ifndef NDEBUG
 171 #define set_property(x, y) internal_set_property (ly_symbol2scm (x), y, __FILE__, __LINE__, __FUNCTION__)
 172 #else
 173 #define set_property(x, y) internal_set_property (ly_symbol2scm (x), y)
 174 #endif
 175
 176 #endif /* LILY_GUILE_MACROS_HH */