lily/include/lily-guile-macros.hh

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 2005--2010 Han-Wen Nienhuys <hanwen@xs4all.nl>
   5
   6   LilyPond is free software: you can redistribute it and/or modify
   7   it under the terms of the GNU General Public License as published by
   8   the Free Software Foundation, either version 3 of the License, or
   9   (at your option) any later version.
  10
  11   LilyPond is distributed in the hope that it will be useful,
  12   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14   GNU General Public License for more details.
  15
  16   You should have received a copy of the GNU General Public License
  17   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18 */
  19
  20 #ifndef LILY_GUILE_MACROS_HH
  21 #define LILY_GUILE_MACROS_HH
  22
  23 #ifndef SMOB_FREE_RETURN_VAL
  24 #define SMOB_FREE_RETURN_VAL(CL) 0
  25 #endif
  26
  27 #ifndef SCM_PACK
  28 #define SCM_PACK(x) ((SCM) x)
  29 #endif
  30
  31 #ifndef SCM_UNPACK
  32 #define SCM_UNPACK(x) (x)
  33 #endif
  34
  35 /* Unreliable with gcc-2.x
  36    FIXME: should add check for x86 as well?  */
  37 #define CACHE_SYMBOLS
  38
  39 #ifdef CACHE_SYMBOLS
  40
  41 /* this lets us "overload" macros such as get_property to take
  42    symbols as well as strings */
  43 inline SCM
  44 scm_or_str2symbol (char const *c) { return scm_str2symbol (c); }
  45
  46 inline SCM
  47 scm_or_str2symbol (SCM s) {
  48   assert (scm_is_symbol (s));
  49   return s;
  50 }
  51
  52 /* Using this trick we cache the value of scm_str2symbol ("fooo") where
  53    "fooo" is a constant string. This is done at the cost of one static
  54    variable per ly_symbol2scm() use, and one boolean evaluation for
  55    every call.
  56  */
  57 #define ly_symbol2scm(x)                                                \
  58   ({                                                                    \
  59     static SCM cached;                                                  \
  60     /* We store this one locally, since G++ -O2 fucks up else */        \
  61     SCM value = cached;                                                 \
  62     if (__builtin_constant_p ((x)))                                     \
  63       {                                                                 \
  64         if (!cached)                                                    \
  65           value = cached = scm_gc_protect_object (scm_or_str2symbol (x)); \
  66       }                                                                 \
  67     else                                                                \
  68       value = scm_or_str2symbol (x);                                    \
  69     value;                                                              \
  70   })
  71 #else
  72 inline SCM ly_symbol2scm (char const *x) { return scm_str2symbol ((x)); }
  73 #endif
  74
  75 /*
  76   TODO: rename me to ly_c_lily_module_eval
  77
  78   we don't have to protect the result; it's already part of the
  79   exports list of the module.
  80 */
  81
  82 #define ly_lily_module_constant(x)                                      \
  83   ({                                                                    \
  84     static SCM cached;                                                  \
  85     /* We store this one locally, since G++ -O2 fucks up else */        \
  86     SCM value = cached;                                                 \
  87     if (__builtin_constant_p ((x)))                                     \
  88       {                                                                 \
  89         if (!cached)                                                    \
  90           value = cached = scm_eval (scm_str2symbol (x),                \
  91                                      global_lily_module);               \
  92       }                                                                 \
  93     else                                                                \
  94       value = scm_eval (scm_str2symbol (x), global_lily_module);        \
  95     value;                                                              \
  96   })
  97
  98 /*
  99   Adds the NAME as a Scheme function, and a variable to store the SCM
 100   version of the function in the static variable NAME_proc
 101 */
 102 #define DECLARE_SCHEME_CALLBACK(NAME, ARGS)     \
 103   static SCM NAME ARGS;                         \
 104   static SCM NAME ## _proc
 105 #define ADD_TYPE_PREDICATE(func, type_name) \
 106   void \
 107   func ## _type_adder ()                        \
 108   {\
 109     ly_add_type_predicate ((Type_predicate_ptr)func, type_name);        \
 110   }\
 111   ADD_SCM_INIT_FUNC(func ## _type_adder_ctor, \
 112                     func ## _type_adder);
 113 #define ADD_TYPE_PREDICATE(func, type_name) \
 114   void \
 115   func ## _type_adder ()                        \
 116   {\
 117     ly_add_type_predicate ((Type_predicate_ptr)func, type_name);        \
 118   }\
 119   ADD_SCM_INIT_FUNC(func ## _type_adder_ctor, \
 120                     func ## _type_adder);
 121
 122 string mangle_cxx_identifier (string);
 123
 124 void ly_add_type_predicate (void *ptr, string name);
 125 string predicate_to_typename (void *ptr);
 126
 127 /*
 128   Make TYPE::FUNC available as a Scheme function.
 129 */
 130 #define MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE, FUNC, ARGCOUNT, OPTIONAL_COUNT, DOC) \
 131   SCM TYPE ::FUNC ## _proc;                                             \
 132   void                                                                  \
 133   TYPE ## _ ## FUNC ## _init_functions ()                               \
 134   {                                                                     \
 135     string cxx = string (#TYPE) + "::" + string (#FUNC); \
 136     string id = mangle_cxx_identifier (cxx); \
 137     TYPE ::FUNC ## _proc = scm_c_define_gsubr (id.c_str(),                      \
 138                                                (ARGCOUNT-OPTIONAL_COUNT), OPTIONAL_COUNT, 0,    \
 139                                                (Scheme_function_unknown) TYPE::FUNC); \
 140     ly_add_function_documentation (TYPE :: FUNC ## _proc, id.c_str(), "", \
 141                                    DOC);                                \
 142     scm_c_export (id.c_str (), NULL);                                   \
 143   }                                                                     \
 144                                                                         \
 145   ADD_SCM_INIT_FUNC (TYPE ## _ ## FUNC ## _callback,                    \
 146                      TYPE ## _ ## FUNC ## _init_functions);
 147
 148 #define MAKE_DOCUMENTED_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT, DOC)              \
 149   MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE, FUNC, ARGCOUNT, 0, DOC);
 150
 151 #define MAKE_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT)                      \
 152   MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE,FUNC,ARGCOUNT, 0, "");
 153
 154 void ly_add_function_documentation (SCM proc, string fname, string varlist, string doc);
 155 void ly_check_name (string cxx, string fname);
 156
 157 #define ADD_SCM_INIT_FUNC(name, func)           \
 158   class name ## _scm_initter                    \
 159   {                                             \
 160   public:                                       \
 161     name ## _scm_initter ()                     \
 162     {                                           \
 163       add_scm_init_func (func);                 \
 164     }                                           \
 165   }                                             \
 166     _ ## name ## _scm_initter;
 167
 168 /* end define */
 169
 170 #define LY_DEFINE_WITHOUT_DECL(INITPREFIX, FNAME, PRIMNAME, REQ, OPT, VAR, \
 171                                ARGLIST, DOCSTRING)                      \
 172   SCM FNAME ## _proc;                                                   \
 173   void                                                                  \
 174   INITPREFIX ## init ()                                                 \
 175   {                                                                     \
 176     FNAME ## _proc = scm_c_define_gsubr (PRIMNAME, REQ, OPT, VAR,       \
 177                                          (Scheme_function_unknown) FNAME); \
 178     ly_check_name (#FNAME, PRIMNAME);\
 179     ly_add_function_documentation (FNAME ## _proc, PRIMNAME, #ARGLIST,  \
 180                                    DOCSTRING);                          \
 181     scm_c_export (PRIMNAME, NULL);                                      \
 182   }                                                                     \
 183   ADD_SCM_INIT_FUNC (INITPREFIX ## init_unique_prefix, INITPREFIX ## init); \
 184   SCM                                                                   \
 185   FNAME ARGLIST
 186
 187 #define LY_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING)   \
 188   SCM FNAME ARGLIST;                                                    \
 189   LY_DEFINE_WITHOUT_DECL (FNAME, FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, \
 190                           DOCSTRING)
 191
 192 #define LY_DEFINE_MEMBER_FUNCTION(CLASS, FNAME, PRIMNAME, REQ, OPT, VAR, \
 193                                   ARGLIST, DOCSTRING)                   \
 194   SCM FNAME ARGLIST;                                                    \
 195   LY_DEFINE_WITHOUT_DECL (CLASS ## FNAME, CLASS::FNAME, PRIMNAME, REQ, OPT, \
 196                           VAR, ARGLIST, DOCSTRING)
 197
 198 #define get_property(x) internal_get_property (ly_symbol2scm (x))
 199 #define get_pure_property(x,y,z) \
 200   internal_get_pure_property (ly_symbol2scm (x), y, z)
 201 #define get_maybe_pure_property(w,x,y,z) \
 202   internal_get_maybe_pure_property (ly_symbol2scm (w), x, y, z)
 203 #define get_property_data(x) internal_get_property_data (ly_symbol2scm (x))
 204 #define get_object(x) internal_get_object (ly_symbol2scm (x))
 205 #define set_object(x, y) internal_set_object (ly_symbol2scm (x), y)
 206 #define del_property(x) internal_del_property (ly_symbol2scm (x))
 207
 208 #ifndef NDEBUG
 209 /*
 210   TODO: include modification callback support here, perhaps
 211   through intermediate Grob::instrumented_set_property( .. __LINE__ ).
 212  */
 213 #define set_property(x, y) instrumented_set_property (ly_symbol2scm (x), y, __FILE__, __LINE__, __FUNCTION__)
 214 #else
 215 #define set_property(x, y) internal_set_property (ly_symbol2scm (x), y)
 216 #endif
 217
 218
 219
 220 #define LY_ASSERT_TYPE(pred, var, number)                                       \
 221   {                                                                     \
 222     if (!pred (var)) \
 223       {                                                                 \
 224         scm_wrong_type_arg_msg(mangle_cxx_identifier (__FUNCTION__).c_str(), \
 225                                number, var, \
 226                                predicate_to_typename ((void*) &pred).c_str()); \
 227       }                                                                 \
 228   }
 229
 230 #define LY_ASSERT_SMOB(klass, var, number) LY_ASSERT_TYPE(klass::unsmob, var, number)
 231
 232
 233
 234 #endif /* LILY_GUILE_MACROS_HH */