From: Han-Wen Nienhuys Date: Sat, 27 Jan 2007 00:48:53 +0000 (+0100) Subject: use generic typechecking macros. X-Git-Tag: release/2.11.15-1~30 X-Git-Url: https://git.donarmstrong.com/lilypond.git?a=commitdiff_plain;h=8e622ad48c6b9d5d1042a350befe322edf6404c5;p=lilypond.git use generic typechecking macros. --- diff --git a/lily/all-font-metrics-scheme.cc b/lily/all-font-metrics-scheme.cc new file mode 100644 index 0000000000..1783310066 --- /dev/null +++ b/lily/all-font-metrics-scheme.cc @@ -0,0 +1,37 @@ +/* + all-font-metrics-scheme.cc -- implement bindings for + All_font_metrics. + + source file of the GNU LilyPond music typesetter + + (c) 2007 Han-Wen Nienhuys + +*/ + +#include "all-font-metrics.hh" +#include "main.hh" + +LY_DEFINE (ly_reset_all_fonts, "ly:reset-all-fonts", 0, 0, 0, + (), + "Forget all about previously loaded fonts. ") +{ + delete all_fonts_global; + all_fonts_global = new All_font_metrics (global_path.to_string ()); + + return SCM_UNSPECIFIED; +} + + +LY_DEFINE (ly_font_load, "ly:font-load", 1, 0, 0, + (SCM name), + "Load the font @var{name}. ") +{ + LY_FUNC_NOTE_FIRST_ARG(name); + LY_ASSERT_TYPE(scm_is_string,1); + + Font_metric *fm = all_fonts_global->find_font (ly_scm2string (name)); + + return fm->self_scm (); +} + + diff --git a/lily/all-font-metrics.cc b/lily/all-font-metrics.cc index f8da4b2ecd..8a1143a537 100644 --- a/lily/all-font-metrics.cc +++ b/lily/all-font-metrics.cc @@ -147,27 +147,3 @@ All_font_metrics::find_font (string name) } All_font_metrics *all_fonts_global; - -LY_DEFINE (ly_reset_all_fonts, "ly:reset-all-fonts", 0, 0, 0, - (), - "Forget all about previously loaded fonts. ") -{ - delete all_fonts_global; - all_fonts_global = new All_font_metrics (global_path.to_string ()); - - return SCM_UNSPECIFIED; -} - - -LY_DEFINE (ly_font_load, "ly:font-load", 1, 0, 0, - (SCM name), - "Load the font @var{name}. ") -{ - SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, __FUNCTION__, "string"); - - Font_metric *fm = all_fonts_global->find_font (ly_scm2string (name)); - - return fm->self_scm (); -} - - diff --git a/lily/axis-group-interface-scheme.cc b/lily/axis-group-interface-scheme.cc index d0470b5a75..9a7c30cc8a 100644 --- a/lily/axis-group-interface-scheme.cc +++ b/lily/axis-group-interface-scheme.cc @@ -19,8 +19,9 @@ LY_DEFINE (ly_relative_group_extent, "ly:relative-group-extent", Grob_array *ga = unsmob_grob_array (elements); SCM_ASSERT_TYPE (ga || scm_is_pair (elements), elements, SCM_ARG1, __FUNCTION__, "list or Grob_array"); - SCM_ASSERT_TYPE (unsmob_grob (common), common, SCM_ARG2, __FUNCTION__, "grob"); - SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis"); + LY_FUNC_NOTE_FIRST_ARG(elements); + LY_ASSERT_SMOB(Grob, 2); + LY_ASSERT_TYPE(is_axis, 3); vector elts; if (!ga) diff --git a/lily/book-scheme.cc b/lily/book-scheme.cc index 3a162ac392..5a97504160 100644 --- a/lily/book-scheme.cc +++ b/lily/book-scheme.cc @@ -19,8 +19,7 @@ LY_DEFINE (ly_make_book, "ly:make-book", "containing @code{\\scores}.") { Output_def *odef = unsmob_output_def (paper); - SCM_ASSERT_TYPE (odef, paper, - SCM_ARG1, __FUNCTION__, "Output_def"); + LY_ASSERT_FIRST_SMOB (Output_def, paper) Book *book = new Book; book->paper_ = odef; @@ -47,11 +46,10 @@ LY_DEFINE (ly_book_process, "ly:book-process", { Book *book = unsmob_book (book_smob); - SCM_ASSERT_TYPE (book, book_smob, SCM_ARG1, __FUNCTION__, "Book"); - SCM_ASSERT_TYPE (unsmob_output_def (default_paper), - default_layout, SCM_ARG2, __FUNCTION__, "\\paper block"); - SCM_ASSERT_TYPE (unsmob_output_def (default_layout), - default_layout, SCM_ARG3, __FUNCTION__, "\\layout block"); + LY_FUNC_NOTE_FIRST_ARG(book_smob); + LY_ASSERT_SMOB(Book,1); + LY_ASSERT_SMOB(Output_def, 2); + LY_ASSERT_SMOB(Output_def, 3); Paper_book *pb = book->process (unsmob_output_def (default_paper), unsmob_output_def (default_layout)); @@ -77,11 +75,11 @@ LY_DEFINE (ly_book_process_to_systems, "ly:book-process-to-systems", { Book *book = unsmob_book (book_smob); - SCM_ASSERT_TYPE (book, book_smob, SCM_ARG1, __FUNCTION__, "Book"); - SCM_ASSERT_TYPE (unsmob_output_def (default_paper), - default_layout, SCM_ARG2, __FUNCTION__, "\\paper block"); - SCM_ASSERT_TYPE (unsmob_output_def (default_layout), - default_layout, SCM_ARG3, __FUNCTION__, "\\layout block"); + LY_FUNC_NOTE_FIRST_ARG(book_smob); + + LY_ASSERT_SMOB(Book,1); + LY_ASSERT_SMOB(Output_def, 2); + LY_ASSERT_SMOB(Output_def, 3); Paper_book *pb = book->process (unsmob_output_def (default_paper), unsmob_output_def (default_layout)); diff --git a/lily/context-scheme.cc b/lily/context-scheme.cc index f4a2f6191c..5ea55dc2bf 100644 --- a/lily/context-scheme.cc +++ b/lily/context-scheme.cc @@ -18,7 +18,8 @@ LY_DEFINE (ly_context_id, "ly:context-id", "return the string @code{one}.") { Context *tr = unsmob_context (context); - SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context"); + + LY_ASSERT_FIRST_SMOB (Context, context); return ly_string2scm (tr->id_string ()); } @@ -29,8 +30,10 @@ LY_DEFINE (ly_context_name, "ly:context-name", "i.e. for @code{\\context Voice = one .. } " "return the symbol @code{Voice}.") { + LY_ASSERT_FIRST_SMOB (Context, context); + Context *tr = unsmob_context (context); - SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context"); + return ly_symbol2scm (tr->context_name ().c_str ()); } @@ -40,8 +43,9 @@ LY_DEFINE (ly_context_grob_definition, "ly:context-grob-definition", "as an alist") { Context *tr = unsmob_context (context); - SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context"); - SCM_ASSERT_TYPE (scm_is_symbol (name), name, SCM_ARG2, __FUNCTION__, "symbol"); + + LY_ASSERT_FIRST_SMOB (Context, context); + LY_ASSERT_TYPE(ly_is_symbol, 2); return updated_grob_properties (tr, name); } @@ -54,9 +58,10 @@ LY_DEFINE (ly_context_pushpop_property, "ly:context-pushpop-property", "or reverted (if unspecified).") { Context *tg = unsmob_context (context); - SCM_ASSERT_TYPE (tg, context, SCM_ARG1, __FUNCTION__, "context"); - SCM_ASSERT_TYPE (scm_is_symbol (grob), grob, SCM_ARG2, __FUNCTION__, "symbol"); - SCM_ASSERT_TYPE (scm_is_symbol (eltprop), eltprop, SCM_ARG3, __FUNCTION__, "symbol"); + + LY_ASSERT_FIRST_SMOB (Context, context); + LY_ASSERT_TYPE(ly_is_symbol, 2); + LY_ASSERT_TYPE(ly_is_symbol, 3); execute_pushpop_property (tg, grob, eltprop, val); @@ -67,12 +72,11 @@ LY_DEFINE (ly_context_property, "ly:context-property", 2, 0, 0, (SCM c, SCM name), "Return the value of @var{name} from context @var{c}") { - Context *t = unsmob_context (c); - Context *tr = (t); - SCM_ASSERT_TYPE (tr, c, SCM_ARG1, __FUNCTION__, "Translator group"); - SCM_ASSERT_TYPE (scm_is_symbol (name), name, SCM_ARG2, __FUNCTION__, "symbol"); + LY_ASSERT_FIRST_SMOB (Context, c); + LY_ASSERT_TYPE(ly_is_symbol, 2); - return tr->internal_get_property (name); + Context *t = unsmob_context (c); + return t->internal_get_property (name); } LY_DEFINE (ly_context_set_property_x, "ly:context-set-property!", @@ -80,9 +84,10 @@ LY_DEFINE (ly_context_set_property_x, "ly:context-set-property!", "Set value of property @var{name} in context @var{context} " "to @var{val}.") { + LY_ASSERT_FIRST_SMOB (Context, context); + LY_ASSERT_TYPE(ly_is_symbol, 2); + Context *tr = unsmob_context (context); - SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context"); - SCM_ASSERT_TYPE (scm_is_symbol (name), name, SCM_ARG2, __FUNCTION__, "symbol"); tr->set_property (name, val); @@ -94,9 +99,10 @@ LY_DEFINE (ly_context_property_where_defined, "ly:context-property-where-defined "Return the context above @var{context} " "where @var{name} is defined.") { + LY_ASSERT_FIRST_SMOB (Context, context); + LY_ASSERT_TYPE(ly_is_symbol, 2); + Context *tr = unsmob_context (context); - SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context"); - SCM_ASSERT_TYPE (scm_is_symbol (name), name, SCM_ARG2, __FUNCTION__, "symbol"); SCM val; tr = tr->where_defined (name, &val); @@ -110,10 +116,10 @@ LY_DEFINE (ly_context_unset_property, "ly:context-unset-property", 2, 0, 0, (SCM context, SCM name), "Unset value of property @var{name} in context @var{context}.") { + LY_ASSERT_FIRST_SMOB (Context, context); + LY_ASSERT_TYPE(ly_is_symbol, 2); Context *tr = unsmob_context (context); - SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context"); - SCM_ASSERT_TYPE (scm_is_symbol (name), name, SCM_ARG2, __FUNCTION__, "symbol"); - + tr->unset_property (name); return SCM_UNSPECIFIED; } @@ -122,8 +128,8 @@ LY_DEFINE (ly_context_parent, "ly:context-parent", 1, 0, 0, (SCM context), "Return the parent of @var{context}, @code{#f} if none.") { + LY_ASSERT_FIRST_SMOB (Context, context); Context *tr = unsmob_context (context); - SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "Context"); tr = tr->get_parent_context (); if (tr) @@ -138,9 +144,9 @@ LY_DEFINE (ly_context_find, "ly:context-find", "Find a parent of @var{context} that has name or alias @var{name}. " "Return @code{#f} if not found.") { + LY_ASSERT_FIRST_SMOB (Context, context); + LY_ASSERT_TYPE(ly_is_symbol, 2); Context *tr = unsmob_context (context); - SCM_ASSERT_TYPE (tr, context, SCM_ARG1, __FUNCTION__, "context"); - SCM_ASSERT_TYPE (scm_is_symbol (name), name, SCM_ARG2, __FUNCTION__, "symbol"); while (tr) { @@ -156,8 +162,8 @@ LY_DEFINE (ly_context_now, "ly:context-now", 1, 0, 0, (SCM context), "Return now-moment of context CONTEXT") { + LY_ASSERT_FIRST_SMOB (Context, context); Context *ctx = unsmob_context (context); - SCM_ASSERT_TYPE (ctx, context, SCM_ARG1, __FUNCTION__, "Context"); return ctx->now_mom ().smobbed_copy (); } @@ -165,8 +171,8 @@ LY_DEFINE (ly_context_event_source, "ly:context-event-source", 1, 0, 0, (SCM context), "Return event-source of context CONTEXT") { + LY_ASSERT_FIRST_SMOB (Context, context); Context *ctx = unsmob_context (context); - SCM_ASSERT_TYPE (ctx, context, SCM_ARG1, __FUNCTION__, "Context"); return ctx->event_source ()->self_scm (); } @@ -175,7 +181,7 @@ LY_DEFINE (ly_context_events_below, "ly:context-events-below", "Return a stream-distributor that distributes all events\n" " from @var{context} and all its subcontexts.") { + LY_ASSERT_FIRST_SMOB (Context, context); Context *ctx = unsmob_context (context); - SCM_ASSERT_TYPE (ctx, context, SCM_ARG1, __FUNCTION__, "Context"); return ctx->events_below ()->self_scm (); } diff --git a/lily/dimensions-scheme.cc b/lily/dimensions-scheme.cc index 0d6ed607f7..a7b6a394f3 100644 --- a/lily/dimensions-scheme.cc +++ b/lily/dimensions-scheme.cc @@ -14,8 +14,7 @@ LY_DEFINE (ly_pt, "ly:pt", 1, 0, 0, (SCM num), "@var{num} printer points") { - SCM_ASSERT_TYPE (scm_is_number (num), num, SCM_ARG1, __FUNCTION__, - "number"); + LY_ASSERT_FIRST_TYPE(scm_is_number, num); return scm_from_double (point_constant * scm_to_double (num)); } @@ -24,8 +23,7 @@ LY_DEFINE (ly_cm, "ly:cm", 1, 0, 0, (SCM num), "@var{num} cm") { - SCM_ASSERT_TYPE (scm_is_number (num), num, SCM_ARG1, __FUNCTION__, - "number"); + LY_ASSERT_FIRST_TYPE(scm_is_number, num); return scm_from_double (cm_constant * scm_to_double (num)); } @@ -34,8 +32,7 @@ LY_DEFINE (ly_inch, "ly:inch", 1, 0, 0, (SCM num), "@var{num} inches") { - SCM_ASSERT_TYPE (scm_is_number (num), num, SCM_ARG1, __FUNCTION__, - "number"); + LY_ASSERT_FIRST_TYPE(scm_is_number, num); return scm_from_double (inch_constant * scm_to_double (num)); } @@ -44,8 +41,7 @@ LY_DEFINE (ly_mm, "ly:mm", 1, 0, 0, (SCM num), "@var{num} mm") { - SCM_ASSERT_TYPE (scm_is_number (num), num, SCM_ARG1, __FUNCTION__, - "number"); + LY_ASSERT_FIRST_TYPE(scm_is_number, num); return scm_from_double (mm_constant * scm_to_double (num)); } @@ -54,8 +50,7 @@ LY_DEFINE (ly_bp, "ly:bp", 1, 0, 0, (SCM num), "@var{num} bigpoints (1/72th inch)") { - SCM_ASSERT_TYPE (scm_is_number (num), num, SCM_ARG1, __FUNCTION__, - "number"); + LY_ASSERT_FIRST_TYPE(scm_is_number, num); return scm_from_double (bigpoint_constant * scm_to_double (num)); } diff --git a/lily/dispatcher-scheme.cc b/lily/dispatcher-scheme.cc index 06da9c1602..7940fb14a5 100644 --- a/lily/dispatcher-scheme.cc +++ b/lily/dispatcher-scheme.cc @@ -21,8 +21,10 @@ LY_DEFINE (ly_connect_dispatchers, "ly:connect-dispatchers", { Dispatcher *t = unsmob_dispatcher (to); Dispatcher *f = unsmob_dispatcher (from); - SCM_ASSERT_TYPE (t, from, SCM_ARG1, __FUNCTION__, "dispatcher"); - SCM_ASSERT_TYPE (f, to, SCM_ARG2, __FUNCTION__, "dispatcher"); + + LY_ASSERT_FIRST_SMOB(Dispatcher, to); + LY_ASSERT_SMOB(Dispatcher, 2); + t->register_as_listener (f); return SCM_UNDEFINED; @@ -35,8 +37,9 @@ LY_DEFINE (ly_add_listener, "ly:add-listener", { Listener *l = unsmob_listener (list); Dispatcher *d = unsmob_dispatcher (disp); - SCM_ASSERT_TYPE (l, list, SCM_ARG1, __FUNCTION__, "listener"); - SCM_ASSERT_TYPE (d, disp, SCM_ARG2, __FUNCTION__, "dispatcher"); + + LY_ASSERT_FIRST_SMOB(Listener, list); + LY_ASSERT_SMOB(Dispatcher, 2); for (int arg = SCM_ARG3; scm_is_pair (cl); cl = scm_cdr (cl), arg++) { @@ -55,8 +58,10 @@ LY_DEFINE (ly_broadcast, "ly:broadcast", { Dispatcher *d = unsmob_dispatcher (disp); Stream_event *e = unsmob_stream_event (ev); - SCM_ASSERT_TYPE (d, disp, SCM_ARG1, __FUNCTION__, "dispatcher"); - SCM_ASSERT_TYPE (e, ev, SCM_ARG2, __FUNCTION__, "stream event"); + + LY_ASSERT_FIRST_SMOB(Dispatcher, disp); + + LY_ASSERT_SMOB(Stream_event, 2); d->broadcast (e); return SCM_UNDEFINED; } diff --git a/lily/duration-scheme.cc b/lily/duration-scheme.cc index e2dfeec744..f52f9d8807 100644 --- a/lily/duration-scheme.cc +++ b/lily/duration-scheme.cc @@ -27,12 +27,12 @@ LY_DEFINE (ly_duration_less_p, "ly:durationduration_log ()); } @@ -100,7 +98,7 @@ LY_DEFINE (ly_duration_dot_count, "ly:duration-dot-count", 1, 0, 0, (SCM dur), "Extract the dot count from @var{dur}") { - SCM_ASSERT_TYPE (unsmob_duration (dur), dur, SCM_ARG1, __FUNCTION__, "duration"); + LY_ASSERT_FIRST_SMOB(Duration, dur); return scm_from_int (unsmob_duration (dur)->dot_count ()); } @@ -108,7 +106,7 @@ LY_DEFINE (ly_intlog2, "ly:intlog2", 1, 0, 0, (SCM d), "The 2-logarithm of 1/@var{d}.") { - SCM_ASSERT_TYPE (scm_is_number (d), d, SCM_ARG1, __FUNCTION__, "integer"); + LY_ASSERT_FIRST_TYPE (scm_is_number, d); int log = intlog2 (scm_to_int (d)); return scm_from_int (log); } @@ -117,7 +115,7 @@ LY_DEFINE (ly_duration_length, "ly:duration-length", 1, 0, 0, (SCM dur), "The length of the duration as a Moment.") { - SCM_ASSERT_TYPE (unsmob_duration (dur), dur, SCM_ARG1, __FUNCTION__, "duration"); + LY_ASSERT_FIRST_SMOB(Duration, dur); return Moment (unsmob_duration (dur)->get_length ()).smobbed_copy (); } @@ -125,7 +123,7 @@ LY_DEFINE (ly_duration_2_string, "ly:duration->string", 1, 0, 0, (SCM dur), "Convert @var{dur} to string.") { - SCM_ASSERT_TYPE (unsmob_duration (dur), dur, SCM_ARG1, __FUNCTION__, "duration"); + LY_ASSERT_FIRST_SMOB(Duration, dur); return ly_string2scm (unsmob_duration (dur)->to_string ()); } @@ -133,7 +131,7 @@ LY_DEFINE (ly_duration_factor, "ly:duration-factor", 1, 0, 0, (SCM dur), "Extract the compression factor from @var{dur}. Return as a pair.") { - SCM_ASSERT_TYPE (unsmob_duration (dur), dur, SCM_ARG1, __FUNCTION__, "duration"); + LY_ASSERT_FIRST_SMOB(Duration, dur); Rational r = unsmob_duration (dur)->factor (); return scm_cons (scm_from_int (r.num ()), scm_from_int (r.den ())); } diff --git a/lily/function-documentation.cc b/lily/function-documentation.cc index 622d3140bc..867911967f 100644 --- a/lily/function-documentation.cc +++ b/lily/function-documentation.cc @@ -74,3 +74,32 @@ predicate_to_typename (void *ptr) else return type_names[ptr]; } + +static int +arg_dir (int a, int b) +{ + if (&a < &b) + return 1; + else + return -1; +} + + +int function_argument_direction; +void +init_func_doc () +{ + function_argument_direction = arg_dir (2,3); + + ly_add_type_predicate ((void*) &scm_is_integer, "integer"); + ly_add_type_predicate ((void*) &scm_is_bool, "boolean"); + ly_add_type_predicate ((void*) &scm_is_pair, "pair"); + ly_add_type_predicate ((void*) &is_number_pair, "number pair"); + ly_add_type_predicate ((void*) &scm_is_number, "number"); + ly_add_type_predicate ((void*) &scm_is_string, "string"); + ly_add_type_predicate ((void*) &ly_is_symbol, "symbol"); + ly_add_type_predicate ((void*) &scm_is_vector, "vector"); + ly_add_type_predicate ((void*) &is_axis, "axis"); +} + +ADD_SCM_INIT_FUNC(func_doc, init_func_doc); diff --git a/lily/include/lily-guile-macros.hh b/lily/include/lily-guile-macros.hh index 8026eded97..0144523ffa 100644 --- a/lily/include/lily-guile-macros.hh +++ b/lily/include/lily-guile-macros.hh @@ -201,6 +201,7 @@ void ly_check_name (string cxx, string fname); #endif +extern int function_argument_direction; #define LY_FUNC_NOTE_FIRST_ARG(a) \ SCM *first_arg_ptr = &a; \ @@ -220,4 +221,12 @@ void ly_check_name (string cxx, string fname); #define LY_ASSERT_SMOB(klass, number) LY_ASSERT_TYPE(klass::unsmob, number) +#define LY_ASSERT_FIRST_TYPE(pred, var) \ + LY_FUNC_NOTE_FIRST_ARG(var); \ + LY_ASSERT_TYPE(pred, 1); + +#define LY_ASSERT_FIRST_SMOB(klass, var) \ + LY_ASSERT_FIRST_TYPE(klass::unsmob, var) + + #endif /* LILY_GUILE_MACROS_HH */ diff --git a/lily/include/lily-guile.hh b/lily/include/lily-guile.hh index 6f21a29b03..7349050810 100644 --- a/lily/include/lily-guile.hh +++ b/lily/include/lily-guile.hh @@ -88,6 +88,12 @@ inline bool ly_is_list (SCM x) { return SCM_NFALSEP (scm_list_p (x)); } inline bool ly_is_procedure (SCM x) { return SCM_NFALSEP (scm_procedure_p (x)); } inline bool ly_is_port (SCM x) { return SCM_NFALSEP (scm_port_p (x)); } +/* + want to take the address of this function; scm_is_symbol() is a + macro. + */ +inline bool ly_is_symbol (SCM x) { return scm_is_symbol (x); } + inline bool ly_is_equal (SCM x, SCM y) { return SCM_NFALSEP (scm_equal_p (x, y)); diff --git a/lily/include/smobs.hh b/lily/include/smobs.hh index 61b8ae37fd..9971b19da5 100644 --- a/lily/include/smobs.hh +++ b/lily/include/smobs.hh @@ -103,7 +103,7 @@ static int print_smob (SCM s, SCM p, scm_print_state*); \ public: \ static SCM equal_p (SCM a, SCM b); \ - static CL *unsmob (SCM s) \ + static CL *unsmob (SCM s) __attribute__((pure)) \ { \ if (SCM_NIMP (s) && SCM_CELL_TYPE (s) == smob_tag_) \ return (CL *) SCM_CELL_WORD_1 (s); \