lily/include/lily-guile-macros.hh

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 2005--2015 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 #include "config.hh"
  24
  25 #if GUILEV2
  26 // if Guile's internal representation switches to utf8, this should be
  27 // changed accordingly for efficiency's sake.  This is used for
  28 // strings known to be in ASCII entirely, including any string
  29 // constants in the C code.
  30 #define scm_from_ascii_string scm_from_latin1_string
  31 #define scm_from_ascii_stringn scm_from_latin1_stringn
  32 #define scm_from_ascii_symbol scm_from_latin1_symbol
  33 #else
  34 #define scm_from_ascii_string scm_from_locale_string
  35 #define scm_from_ascii_stringn scm_from_locale_stringn
  36 #define scm_from_ascii_symbol scm_from_locale_symbol
  37 #define scm_from_latin1_string scm_from_locale_string
  38 #define scm_from_latin1_stringn scm_from_locale_stringn
  39 #define scm_from_utf8_string scm_from_locale_string
  40 #define scm_from_utf8_symbol scm_from_locale_symbol
  41 #define scm_to_utf8_string scm_to_locale_string
  42 #endif
  43
  44 #ifndef SMOB_FREE_RETURN_VAL
  45 #define SMOB_FREE_RETURN_VAL(CL) 0
  46 #endif
  47
  48 #ifndef SCM_PACK
  49 #define SCM_PACK(x) ((SCM) x)
  50 #endif
  51
  52 #ifndef SCM_UNPACK
  53 #define SCM_UNPACK(x) (x)
  54 #endif
  55
  56 /* For backward compatability with Guile 1.8 */
  57 #if !HAVE_GUILE_SUBR_TYPE
  58 typedef SCM (*scm_t_subr) (GUILE_ELLIPSIS);
  59 #endif
  60
  61 /* Unreliable with gcc-2.x
  62    FIXME: should add check for x86 as well?  */
  63 #define CACHE_SYMBOLS
  64
  65 #ifdef CACHE_SYMBOLS
  66
  67 /* this lets us "overload" macros such as get_property to take
  68    symbols as well as strings */
  69 inline SCM
  70 scm_or_str2symbol (char const *c) { return scm_from_utf8_symbol (c); }
  71
  72 inline SCM
  73 scm_or_str2symbol (SCM s)
  74 {
  75   assert (scm_is_symbol (s));
  76   return s;
  77 }
  78
  79 /* Using this trick we cache the value of scm_from_locale_symbol ("fooo") where
  80    "fooo" is a constant string. This is done at the cost of one static
  81    variable per ly_symbol2scm() use, and one boolean evaluation for
  82    every call.
  83  */
  84 #define ly_symbol2scm(x)                                                \
  85   ({                                                                    \
  86     static SCM cached;                                                  \
  87     /* We store this one locally, since G++ -O2 fucks up else */        \
  88     SCM value = cached;                                                 \
  89     if (__builtin_constant_p ((x)))                                     \
  90       {                                                                 \
  91         if (!SCM_UNPACK (cached))                                       \
  92           value = cached = scm_gc_protect_object (scm_or_str2symbol (x)); \
  93       }                                                                 \
  94     else                                                                \
  95       value = scm_or_str2symbol (x);                                    \
  96     value;                                                              \
  97   })
  98 #else
  99 inline SCM ly_symbol2scm (char const *x) { return scm_from_utf8_symbol ((x)); }
 100 #endif
 101
 102 /*
 103   we don't have to protect the result; it's already part of the
 104   exports list of the module.
 105 */
 106
 107 #define ly_lily_module_constant(x)                                      \
 108   ({                                                                    \
 109     static SCM cached;                                                  \
 110     /* We store this one locally, since G++ -O2 fucks up else */        \
 111     SCM value = cached;                                                 \
 112     if (__builtin_constant_p ((x)))                                     \
 113       {                                                                 \
 114         if (!SCM_UNPACK (cached))                                       \
 115           value = cached =                                              \
 116             scm_variable_ref (scm_c_module_lookup (global_lily_module, (x))); \
 117       }                                                                 \
 118     else                                                                \
 119       value =                                                           \
 120         scm_variable_ref (scm_c_module_lookup (global_lily_module, (x))); \
 121     value;                                                              \
 122   })
 123
 124 /*
 125   Adds the NAME as a Scheme function, and a variable to store the SCM
 126   version of the function in the static variable NAME_proc
 127 */
 128 #define DECLARE_SCHEME_CALLBACK(NAME, ARGS)     \
 129   static SCM NAME ARGS;                         \
 130   static SCM NAME ## _proc
 131
 132 string mangle_cxx_identifier (string);
 133
 134 void ly_add_type_predicate (void *ptr, const string &name);
 135 string predicate_to_typename (void *ptr);
 136
 137 /*
 138   Make TYPE::FUNC available as a Scheme function.
 139 */
 140 #define MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE, FUNC, ARGCOUNT, OPTIONAL_COUNT, DOC) \
 141   SCM TYPE ::FUNC ## _proc;                                             \
 142   void                                                                  \
 143   TYPE ## _ ## FUNC ## _init_functions ()                               \
 144   {                                                                     \
 145     string cxx = string (#TYPE) + "::" + string (#FUNC); \
 146     string id = mangle_cxx_identifier (cxx); \
 147     TYPE ::FUNC ## _proc = scm_c_define_gsubr (id.c_str(),                      \
 148                                                (ARGCOUNT-OPTIONAL_COUNT), OPTIONAL_COUNT, 0,    \
 149                                                (scm_t_subr) TYPE::FUNC); \
 150     ly_add_function_documentation (TYPE :: FUNC ## _proc, id.c_str(), "", \
 151                                    DOC);                                \
 152     scm_c_export (id.c_str (), NULL);                                   \
 153   }                                                                     \
 154                                                                         \
 155   ADD_SCM_INIT_FUNC (TYPE ## _ ## FUNC ## _callback,                    \
 156                      TYPE ## _ ## FUNC ## _init_functions);
 157
 158 #define MAKE_DOCUMENTED_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT, DOC)              \
 159   MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE, FUNC, ARGCOUNT, 0, DOC);
 160
 161 #define MAKE_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT)                      \
 162   MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE,FUNC,ARGCOUNT, 0, "");
 163
 164 void ly_add_function_documentation (SCM proc, const string &fname, const string &varlist, const string &doc);
 165 void ly_check_name (const string &cxx, const string &fname);
 166
 167 #define ADD_SCM_INIT_FUNC(name, func)           \
 168   class name ## _scm_initter                    \
 169   {                                             \
 170   public:                                       \
 171     name ## _scm_initter ()                     \
 172     {                                           \
 173       add_scm_init_func (func);                 \
 174     }                                           \
 175   }                                             \
 176     _ ## name ## _scm_initter;
 177
 178 /* end define */
 179
 180 #define LY_DEFINE_WITHOUT_DECL(INITPREFIX, FNAME, PRIMNAME, REQ, OPT, VAR, \
 181                                ARGLIST, DOCSTRING)                      \
 182   SCM FNAME ## _proc;                                                   \
 183   void                                                                  \
 184   INITPREFIX ## init ()                                                 \
 185   {                                                                     \
 186     FNAME ## _proc = scm_c_define_gsubr (PRIMNAME, REQ, OPT, VAR,       \
 187                                          (scm_t_subr) FNAME); \
 188     ly_check_name (#FNAME, PRIMNAME);\
 189     ly_add_function_documentation (FNAME ## _proc, PRIMNAME, #ARGLIST,  \
 190                                    DOCSTRING);                          \
 191     scm_c_export (PRIMNAME, NULL);                                      \
 192   }                                                                     \
 193   ADD_SCM_INIT_FUNC (INITPREFIX ## init_unique_prefix, INITPREFIX ## init); \
 194   SCM                                                                   \
 195   FNAME ARGLIST
 196
 197 #define LY_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING)   \
 198   SCM FNAME ARGLIST;                                                    \
 199   LY_DEFINE_WITHOUT_DECL (FNAME, FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, \
 200                           DOCSTRING)
 201
 202 #define LY_DEFINE_MEMBER_FUNCTION(CLASS, FNAME, PRIMNAME, REQ, OPT, VAR, \
 203                                   ARGLIST, DOCSTRING)                   \
 204   SCM FNAME ARGLIST;                                                    \
 205   LY_DEFINE_WITHOUT_DECL (CLASS ## FNAME, CLASS::FNAME, PRIMNAME, REQ, OPT, \
 206                           VAR, ARGLIST, DOCSTRING)
 207
 208 #define get_property(x) internal_get_property (ly_symbol2scm (x))
 209 #define get_pure_property(x,y,z) \
 210   internal_get_pure_property (ly_symbol2scm (x), y, z)
 211 #define get_maybe_pure_property(w,x,y,z) \
 212   internal_get_maybe_pure_property (ly_symbol2scm (w), x, y, z)
 213 #define get_property_data(x) internal_get_property_data (ly_symbol2scm (x))
 214 #define get_object(x) internal_get_object (ly_symbol2scm (x))
 215 #define set_object(x, y) internal_set_object (ly_symbol2scm (x), y)
 216 #define del_property(x) internal_del_property (ly_symbol2scm (x))
 217
 218 #ifndef NDEBUG
 219 /*
 220   TODO: include modification callback support here, perhaps
 221   through intermediate Grob::instrumented_set_property( .. __LINE__ ).
 222  */
 223 #define set_property(x, y) instrumented_set_property (ly_symbol2scm (x), y, __FILE__, __LINE__, __FUNCTION__)
 224 #else
 225 #define set_property(x, y) internal_set_property (ly_symbol2scm (x), y)
 226 #endif
 227
 228 #define LY_ASSERT_TYPE(pred, var, number)                                       \
 229   {                                                                     \
 230     if (!pred (var)) \
 231       {                                                                 \
 232         scm_wrong_type_arg_msg(mangle_cxx_identifier (__FUNCTION__).c_str(), \
 233                                number, var, \
 234                                predicate_to_typename ((void*) &pred).c_str()); \
 235       }                                                                 \
 236   }
 237
 238 void ly_wrong_smob_arg (bool pred (SCM), SCM var, int number, const char *fun);
 239
 240 // Could be just implemented using LY_ASSERT_TYPE, but this variant
 241 // saves a slight amount of code
 242
 243 #define LY_ASSERT_SMOB(klass, var, number)                              \
 244   {                                                                     \
 245     if (!klass::is_smob (var))                                          \
 246       ly_wrong_smob_arg (klass::is_smob, var, number, __FUNCTION__);    \
 247   }
 248
 249 // This variant is for the case where klass::unsmob might actually be
 250 // situated in a base class of klass
 251 #define LY_ASSERT_DERIVED_SMOB(klass, var, number)                      \
 252   {                                                                     \
 253     if (!derived_unsmob<klass> (var))                                   \
 254       ly_wrong_smob_arg (klass::is_smob, var, number, __FUNCTION__);    \
 255   }
 256
 257 #endif /* LILY_GUILE_MACROS_HH */