From: Han-Wen Nienhuys Date: Fri, 26 Jan 2007 23:31:30 +0000 (+0100) Subject: more generic SCM arg typechecking X-Git-Tag: release/2.11.15-1~31 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=ee4bc843ba15ebbedd8578cbb8e5e477925c413f;p=lilypond.git more generic SCM arg typechecking --- diff --git a/lily/book.cc b/lily/book.cc index f4d4dd790e..01e52ce9cd 100644 --- a/lily/book.cc +++ b/lily/book.cc @@ -83,11 +83,6 @@ Book::mark_smob (SCM s) { Book *book = (Book *) SCM_CELL_WORD_1 (s); -#if 0 - if (book->key_) - scm_gc_mark (book->key_->self_scm ()); -#endif - if (book->paper_) scm_gc_mark (book->paper_->self_scm ()); scm_gc_mark (book->scores_); diff --git a/lily/function-documentation.cc b/lily/function-documentation.cc index e59df62192..622d3140bc 100644 --- a/lily/function-documentation.cc +++ b/lily/function-documentation.cc @@ -53,3 +53,24 @@ LY_DEFINE (ly_get_all_function_documentation, "ly:get-all-function-documentation { return doc_hash_table; } + + +#include + +map type_names; + +void +ly_add_type_predicate (void *ptr, + string name) +{ + type_names[ptr] = name; +} + +string +predicate_to_typename (void *ptr) +{ + if (type_names.find (ptr) == type_names.end ()) + return "unknown type"; + else + return type_names[ptr]; +} diff --git a/lily/grob-scheme.cc b/lily/grob-scheme.cc index 6938ee25a1..b9ca2d8aa2 100644 --- a/lily/grob-scheme.cc +++ b/lily/grob-scheme.cc @@ -20,7 +20,10 @@ LY_DEFINE (ly_grob_property_data, "ly:grob-property-data", "Retrieve @var{sym} for @var{grob} but don't process callbacks.") { Grob *sc = unsmob_grob (grob); - SCM_ASSERT_TYPE (sc, grob, SCM_ARG1, __FUNCTION__, "grob"); + + LY_FUNC_NOTE_FIRST_ARG(grob); + LY_ASSERT_SMOB(Grob, 1); + SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); return sc->get_property_data (sym); diff --git a/lily/include/lily-guile-macros.hh b/lily/include/lily-guile-macros.hh index 400ead26ea..8026eded97 100644 --- a/lily/include/lily-guile-macros.hh +++ b/lily/include/lily-guile-macros.hh @@ -1,5 +1,5 @@ /* - lily-guile-macros.hh -- declare + lily-guile-macros.hh -- declare GUILE interaction macros. source file of the GNU LilyPond music typesetter @@ -25,9 +25,6 @@ FIXME: should add check for x86 as well? */ #define CACHE_SYMBOLS - - - #ifdef CACHE_SYMBOLS /* this lets us "overload" macros such as get_property to take @@ -94,11 +91,31 @@ 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. */ -string mangle_cxx_identifier (string); #define MAKE_SCHEME_CALLBACK_WITH_OPTARGS(TYPE, FUNC, ARGCOUNT, OPTIONAL_COUNT, DOC) \ SCM TYPE ::FUNC ## _proc; \ void \ @@ -183,4 +200,24 @@ void ly_check_name (string cxx, string fname); #define set_property(x, y) internal_set_property (ly_symbol2scm (x), y) #endif + + +#define LY_FUNC_NOTE_FIRST_ARG(a) \ + SCM *first_arg_ptr = &a; \ + int stack_grow_dir = 0; \ + stack_grow_dir = ((void*) &first_arg_ptr < (void*) &stack_grow_dir) ? -1 : 1; + +#define LY_ASSERT_TYPE(pred, number) \ + { \ + if (!pred (first_arg_ptr[(number-1)*stack_grow_dir])) \ + { \ + scm_wrong_type_arg_msg(mangle_cxx_identifier (__FUNCTION__).c_str(), \ + number, first_arg_ptr[(number-1)*stack_grow_dir], \ + predicate_to_typename ((void*) &pred).c_str()); \ + } \ + } + +#define LY_ASSERT_SMOB(klass, number) LY_ASSERT_TYPE(klass::unsmob, number) + + #endif /* LILY_GUILE_MACROS_HH */ diff --git a/lily/include/ly-smobs.icc b/lily/include/ly-smobs.icc index a77da17fc8..af8035644c 100644 --- a/lily/include/ly-smobs.icc +++ b/lily/include/ly-smobs.icc @@ -25,6 +25,14 @@ ADD_SCM_INIT_FUNC (init_type_ ## CL, init_type_ ## CL) #define IMPLEMENT_BASE_SMOBS(CL) \ + void \ + CL ## _type_adder () \ + {\ + ly_add_type_predicate ((void*) &CL::unsmob, #CL); \ + }\ + ADD_SCM_INIT_FUNC(CL ## _type_adder_ctor, \ + CL ## _type_adder);\ + const char *CL::smob_name_ = #CL; \ scm_t_bits CL::smob_tag_; \ SCM \ CL::smob_p (SCM s) \ diff --git a/lily/include/smobs.hh b/lily/include/smobs.hh index 5bd403bce4..61b8ae37fd 100644 --- a/lily/include/smobs.hh +++ b/lily/include/smobs.hh @@ -96,6 +96,7 @@ #define DECLARE_BASE_SMOBS(CL) \ friend class Non_existent_class; \ private: \ + static const char* smob_name_; \ static scm_t_bits smob_tag_; \ static SCM mark_smob (SCM); \ static size_t free_smob (SCM s); \ diff --git a/lily/input-scheme.cc b/lily/input-scheme.cc index 3f14236759..b2d5d84b92 100644 --- a/lily/input-scheme.cc +++ b/lily/input-scheme.cc @@ -23,7 +23,7 @@ LY_DEFINE (ly_input_message, "ly:input-message", 2, 0, 1, (SCM sip, SCM msg, SCM "location in @var{sip}. @var{msg} is interpreted similar to @code{format}'s argument\n") { Input *ip = unsmob_input (sip); - SCM_ASSERT_TYPE (ip, sip, SCM_ARG1, __FUNCTION__, "input location"); + SCM_ASSERT_TYPE (scm_is_string (msg), msg, SCM_ARG2, __FUNCTION__, "string"); msg = scm_simple_format (SCM_BOOL_F, msg, rest);