lily/include/lily-guile-macros.hh

   1 /*
   2   lily-guile-macros.hh -- declare GUILE interaction macros.
   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 #ifdef CACHE_SYMBOLS
  29
  30 /* this lets us "overload" macros such as get_property to take
  31    symbols as well as strings */
  32 inline SCM
  33 scm_or_str2symbol (char const *c) { return scm_str2symbol (c); }
  34
  35 inline SCM
  36 scm_or_str2symbol (SCM s) {
  37   assert (scm_is_symbol (s));
  38   return s;
  39 }
  40
  41 /* Using this trick we cache the value of scm_str2symbol ("fooo") where
  42    "fooo" is a constant string. This is done at the cost of one static
  43    variable per ly_symbol2scm() use, and one boolean evaluation for
  44    every call.
  45  */
  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 #define ADD_TYPE_PREDICATE(func, type_name) \
  95   void \
  96   func ## _type_adder ()                        \
  97   {\
  98     ly_add_type_predicate ((Type_predicate_ptr)func, type_name);        \
  99   }\
 100   ADD_SCM_INIT_FUNC(func ## _type_adder_ctor, \
 101                     func ## _type_adder);
 102 #define ADD_TYPE_PREDICATE(func, type_name) \
 103   void \
 104   func ## _type_adder ()                        \
 105   {\
 106     ly_add_type_predicate ((Type_predicate_ptr)func, type_name);        \
 107   }\
 108   ADD_SCM_INIT_FUNC(func ## _type_adder_ctor, \
 109                     func ## _type_adder);
 110
 111 string mangle_cxx_identifier (string);
 112
 113 void ly_add_type_predicate (void *ptr, string name);
 114 string predicate_to_typename (void *ptr);
 115
 116 /*
 117   Make TYPE::FUNC available as a Scheme function.
 118 */
 119 #define MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE, FUNC, ARGCOUNT, OPTIONAL_COUNT, DOC) \
 120   SCM TYPE ::FUNC ## _proc;                                             \
 121   void                                                                  \
 122   TYPE ## _ ## FUNC ## _init_functions ()                               \
 123   {                                                                     \
 124     string cxx = string (#TYPE) + "::" + string (#FUNC); \
 125     string id = mangle_cxx_identifier (cxx); \
 126     TYPE ::FUNC ## _proc = scm_c_define_gsubr (id.c_str(),                      \
 127                                                (ARGCOUNT-OPTIONAL_COUNT), OPTIONAL_COUNT, 0,    \
 128                                                (Scheme_function_unknown) TYPE::FUNC); \
 129     ly_add_function_documentation (TYPE :: FUNC ## _proc, id.c_str(), "", \
 130                                    DOC);                                \
 131     scm_c_export (id.c_str (), NULL);                                   \
 132   }                                                                     \
 133                                                                         \
 134   ADD_SCM_INIT_FUNC (TYPE ## _ ## FUNC ## _callback,                    \
 135                      TYPE ## _ ## FUNC ## _init_functions);
 136
 137 #define MAKE_DOCUMENTED_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT, DOC)              \
 138   MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE, FUNC, ARGCOUNT, 0, DOC);
 139
 140 #define MAKE_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT)                      \
 141   MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE,FUNC,ARGCOUNT, 0, "");
 142
 143 void ly_add_function_documentation (SCM proc, string fname, string varlist, string doc);
 144 void ly_check_name (string cxx, string fname);
 145
 146 #define ADD_SCM_INIT_FUNC(name, func)           \
 147   class name ## _scm_initter                    \
 148   {                                             \
 149   public:                                       \
 150     name ## _scm_initter ()                     \
 151     {                                           \
 152       add_scm_init_func (func);                 \
 153     }                                           \
 154   }                                             \
 155     _ ## name ## _scm_initter;
 156
 157 /* end define */
 158
 159 #define LY_DEFINE_WITHOUT_DECL(INITPREFIX, FNAME, PRIMNAME, REQ, OPT, VAR, \
 160                                ARGLIST, DOCSTRING)                      \
 161   SCM FNAME ## _proc;                                                   \
 162   void                                                                  \
 163   INITPREFIX ## init ()                                                 \
 164   {                                                                     \
 165     FNAME ## _proc = scm_c_define_gsubr (PRIMNAME, REQ, OPT, VAR,       \
 166                                          (Scheme_function_unknown) FNAME); \
 167     ly_check_name (#FNAME, PRIMNAME);\
 168     ly_add_function_documentation (FNAME ## _proc, PRIMNAME, #ARGLIST,  \
 169                                    DOCSTRING);                          \
 170     scm_c_export (PRIMNAME, NULL);                                      \
 171   }                                                                     \
 172   ADD_SCM_INIT_FUNC (INITPREFIX ## init_unique_prefix, INITPREFIX ## init); \
 173   SCM                                                                   \
 174   FNAME ARGLIST
 175
 176 #define LY_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING)   \
 177   SCM FNAME ARGLIST;                                                    \
 178   LY_DEFINE_WITHOUT_DECL (FNAME, FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, \
 179                           DOCSTRING)
 180
 181 #define LY_DEFINE_MEMBER_FUNCTION(CLASS, FNAME, PRIMNAME, REQ, OPT, VAR, \
 182                                   ARGLIST, DOCSTRING)                   \
 183   SCM FNAME ARGLIST;                                                    \
 184   LY_DEFINE_WITHOUT_DECL (CLASS ## FNAME, CLASS::FNAME, PRIMNAME, REQ, OPT, \
 185                           VAR, ARGLIST, DOCSTRING)
 186
 187 #define get_property(x) internal_get_property (ly_symbol2scm (x))
 188 #define get_property_data(x) internal_get_property_data (ly_symbol2scm (x))
 189 #define get_object(x) internal_get_object (ly_symbol2scm (x))
 190 #define set_object(x, y) internal_set_object (ly_symbol2scm (x), y)
 191 #define del_property(x) internal_del_property (ly_symbol2scm (x))
 192
 193 #ifndef NDEBUG
 194 /*
 195   TODO: include modification callback support here, perhaps
 196   through intermediate Grob::instrumented_set_property( .. __LINE__ ).
 197  */
 198 #define set_property(x, y) instrumented_set_property (ly_symbol2scm (x), y, __FILE__, __LINE__, __FUNCTION__)
 199 #else
 200 #define set_property(x, y) internal_set_property (ly_symbol2scm (x), y)
 201 #endif
 202
 203
 204
 205 #define LY_ASSERT_TYPE(pred, var, number)                                       \
 206   {                                                                     \
 207     if (!pred (var)) \
 208       {                                                                 \
 209         scm_wrong_type_arg_msg(mangle_cxx_identifier (__FUNCTION__).c_str(), \
 210                                number, var, \
 211                                predicate_to_typename ((void*) &pred).c_str()); \
 212       }                                                                 \
 213   }
 214
 215 #define LY_ASSERT_SMOB(klass, var, number) LY_ASSERT_TYPE(klass::unsmob, var, number)
 216
 217
 218
 219 #endif /* LILY_GUILE_MACROS_HH */