X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Finclude%2Flily-guile-macros.hh;h=495b86144f24188c20fab8d9f5b46f180da13a98;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=2138038481f9262fe2fbe49e2206bf5b14a172a1;hpb=bdf4ab13203502e7ec7cf9cf5896527643a07c1f;p=lilypond.git

diff --git a/lily/include/lily-guile-macros.hh b/lily/include/lily-guile-macros.hh
index 2138038481..495b86144f 100644
--- a/lily/include/lily-guile-macros.hh
+++ b/lily/include/lily-guile-macros.hh
@@ -1,9 +1,9 @@
 /*
-  lily-guile-macros.hh -- declare
+  lily-guile-macros.hh -- declare GUILE interaction macros.
 
   source file of the GNU LilyPond music typesetter
 
-  (c) 2005 Han-Wen Nienhuys <hanwen@xs4all.nl>
+  (c) 2005--2008 Han-Wen Nienhuys <hanwen@xs4all.nl>
 */
 
 #ifndef LILY_GUILE_MACROS_HH
@@ -21,20 +21,28 @@
 #define SCM_UNPACK(x) (x)
 #endif
 
-#if (__GNUC__ > 2)
 /* Unreliable with gcc-2.x
    FIXME: should add check for x86 as well?  */
 #define CACHE_SYMBOLS
-#endif
 
 #ifdef CACHE_SYMBOLS
 
+/* this lets us "overload" macros such as get_property to take
+   symbols as well as strings */
+inline SCM
+scm_or_str2symbol (char const *c) { return scm_str2symbol (c); }
+
+inline SCM
+scm_or_str2symbol (SCM s) {
+  assert (scm_is_symbol (s));
+  return s;
+}
+
 /* Using this trick we cache the value of scm_str2symbol ("fooo") where
    "fooo" is a constant string. This is done at the cost of one static
    variable per ly_symbol2scm() use, and one boolean evaluation for
    every call.
-
-   The overall speedup of lily is about 5% on a run of wtk1-fugue2.  */
+ */
 #define ly_symbol2scm(x)						\
   ({									\
     static SCM cached;							\
@@ -43,10 +51,10 @@
     if (__builtin_constant_p ((x)))					\
       {									\
 	if (!cached)							\
-	  value = cached = scm_gc_protect_object (scm_str2symbol ((x))); \
+	  value = cached = scm_gc_protect_object (scm_or_str2symbol (x)); \
       }									\
     else								\
-      value = scm_str2symbol ((char *) (x));				\
+      value = scm_or_str2symbol (x);					\
     value;								\
   })
 #else
@@ -55,7 +63,11 @@ inline SCM ly_symbol2scm (char const *x) { return scm_str2symbol ((x)); }
 
 /*
   TODO: rename me to ly_c_lily_module_eval
+
+  we don't have to protect the result; it's already part of the
+  exports list of the module.
 */
+
 #define ly_lily_module_constant(x)					\
   ({									\
     static SCM cached;							\
@@ -64,8 +76,8 @@ inline SCM ly_symbol2scm (char const *x) { return scm_str2symbol ((x)); }
     if (__builtin_constant_p ((x)))					\
       {									\
 	if (!cached)							\
-	  value = cached = scm_gc_protect_object (scm_eval (scm_str2symbol (x),	\
-							    global_lily_module)); \
+	  value = cached = scm_eval (scm_str2symbol (x),		\
+				     global_lily_module);		\
       }									\
     else								\
       value = scm_eval (scm_str2symbol (x), global_lily_module);	\
@@ -79,28 +91,57 @@ inline SCM ly_symbol2scm (char const *x) { return scm_str2symbol ((x)); }
 #define DECLARE_SCHEME_CALLBACK(NAME, ARGS)	\
   static SCM NAME ARGS;				\
   static SCM NAME ## _proc
+#define ADD_TYPE_PREDICATE(func, type_name) \
+  void \
+  func ## _type_adder ()			\
+  {\
+    ly_add_type_predicate ((Type_predicate_ptr)func, type_name);	\
+  }\
+  ADD_SCM_INIT_FUNC(func ## _type_adder_ctor, \
+		    func ## _type_adder);
+#define ADD_TYPE_PREDICATE(func, type_name) \
+  void \
+  func ## _type_adder ()			\
+  {\
+    ly_add_type_predicate ((Type_predicate_ptr)func, type_name);	\
+  }\
+  ADD_SCM_INIT_FUNC(func ## _type_adder_ctor, \
+		    func ## _type_adder);
+
+string mangle_cxx_identifier (string);
+
+void ly_add_type_predicate (void *ptr, string name);
+string predicate_to_typename (void *ptr);
 
 /*
   Make TYPE::FUNC available as a Scheme function.
 */
-#define MAKE_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT)			\
+#define MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE, FUNC, ARGCOUNT, OPTIONAL_COUNT, DOC) \
   SCM TYPE ::FUNC ## _proc;						\
   void									\
   TYPE ## _ ## FUNC ## _init_functions ()				\
   {									\
-    TYPE ::FUNC ## _proc = scm_c_define_gsubr (#TYPE "::" #FUNC,	\
-					       (ARGCOUNT), 0, 0,	\
-					       (Scheme_function_unknown)TYPE ::FUNC); \
-    scm_c_export (#TYPE "::" #FUNC, NULL);				\
+    string cxx = string (#TYPE) + "::" + string (#FUNC); \
+    string id = mangle_cxx_identifier (cxx); \
+    TYPE ::FUNC ## _proc = scm_c_define_gsubr (id.c_str(),			\
+					       (ARGCOUNT-OPTIONAL_COUNT), OPTIONAL_COUNT, 0,	\
+					       (Scheme_function_unknown) TYPE::FUNC); \
+    ly_add_function_documentation (TYPE :: FUNC ## _proc, id.c_str(), "", \
+				   DOC);				\
+    scm_c_export (id.c_str (), NULL);					\
   }									\
 									\
   ADD_SCM_INIT_FUNC (TYPE ## _ ## FUNC ## _callback,			\
 		     TYPE ## _ ## FUNC ## _init_functions);
 
-void
-ly_add_function_documentation (SCM proc, char const *fname,
-			       char const *varlist,
-			       char const *doc);
+#define MAKE_DOCUMENTED_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT, DOC)		\
+  MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE, FUNC, ARGCOUNT, 0, DOC);
+
+#define MAKE_SCHEME_CALLBACK(TYPE, FUNC, ARGCOUNT)			\
+  MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE,FUNC,ARGCOUNT, 0, "");
+
+void ly_add_function_documentation (SCM proc, string fname, string varlist, string doc);
+void ly_check_name (string cxx, string fname);
 
 #define ADD_SCM_INIT_FUNC(name, func)		\
   class name ## _scm_initter			\
@@ -123,6 +164,7 @@ ly_add_function_documentation (SCM proc, char const *fname,
   {									\
     FNAME ## _proc = scm_c_define_gsubr (PRIMNAME, REQ, OPT, VAR,	\
 					 (Scheme_function_unknown) FNAME); \
+    ly_check_name (#FNAME, PRIMNAME);\
     ly_add_function_documentation (FNAME ## _proc, PRIMNAME, #ARGLIST,	\
 				   DOCSTRING);				\
     scm_c_export (PRIMNAME, NULL);					\
@@ -143,6 +185,35 @@ ly_add_function_documentation (SCM proc, char const *fname,
 			  VAR, ARGLIST, DOCSTRING)
 
 #define get_property(x) internal_get_property (ly_symbol2scm (x))
+#define get_property_data(x) internal_get_property_data (ly_symbol2scm (x))
+#define get_object(x) internal_get_object (ly_symbol2scm (x))
+#define set_object(x, y) internal_set_object (ly_symbol2scm (x), y)
+#define del_property(x) internal_del_property (ly_symbol2scm (x))
+
+#ifndef NDEBUG
+/*
+  TODO: include modification callback support here, perhaps
+  through intermediate Grob::instrumented_set_property( .. __LINE__ ).
+ */
+#define set_property(x, y) instrumented_set_property (ly_symbol2scm (x), y, __FILE__, __LINE__, __FUNCTION__)
+#else
 #define set_property(x, y) internal_set_property (ly_symbol2scm (x), y)
+#endif
+
+
+
+#define LY_ASSERT_TYPE(pred, var, number)					\
+  {									\
+    if (!pred (var)) \
+      {									\
+	scm_wrong_type_arg_msg(mangle_cxx_identifier (__FUNCTION__).c_str(), \
+			       number, var, \
+			       predicate_to_typename ((void*) &pred).c_str()); \
+      }									\
+  }
+
+#define LY_ASSERT_SMOB(klass, var, number) LY_ASSERT_TYPE(klass::unsmob, var, number)
+
+
 
 #endif /* LILY_GUILE_MACROS_HH */