X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Flily-guile.cc;h=f37380f024fc4b65fc9b368564c26dd3dd4a3190;hb=8e2eaf4959bec63a1128a444591a540f4f1e2937;hp=06018c4c9c48502dde6b90eedd16fd05c17c6acf;hpb=00216e16c717470ae53dbbfd1d52850d1b102e29;p=lilypond.git diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc index 06018c4c9c..f37380f024 100644 --- a/lily/lily-guile.cc +++ b/lily/lily-guile.cc @@ -1,7 +1,7 @@ /* This file is part of LilyPond, the GNU music typesetter. - Copyright (C) 1998--2012 Jan Nieuwenhuizen + Copyright (C) 1998--2015 Jan Nieuwenhuizen Han-Wen Nienhuys LilyPond is free software: you can redistribute it and/or modify @@ -40,6 +40,7 @@ using namespace std; #include "source-file.hh" #include "version.hh" #include "warn.hh" +#include "lily-imports.hh" /* symbols/strings. @@ -144,7 +145,7 @@ ly_string2scm (string const &str) char * ly_scm2str0 (SCM str) { - return scm_to_locale_string (str); + return scm_to_utf8_string (str); } /* @@ -401,13 +402,13 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol) { // If undefined, some internal function caused it...should never happen. - assert (val != SCM_UNDEFINED); + assert (!SCM_UNBNDP (val)); if (!scm_is_symbol (sym)) return false; SCM type = scm_object_property (sym, type_symbol); - if (type != SCM_EOL && !ly_is_procedure (type)) + if (!scm_is_null (type) && !ly_is_procedure (type)) { warning (_f ("cannot find property type-check for `%s' (%s).", ly_symbol2string (sym).c_str (), @@ -429,16 +430,15 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol) TODO: should remove #f from allowed vals? */ - if (val == SCM_EOL || val == SCM_BOOL_F) + if (scm_is_null (val) || scm_is_false (val)) return true; - if (val != SCM_EOL + if (!scm_is_null (val) && ly_is_procedure (type) - && scm_call_1 (type, val) == SCM_BOOL_F) + && scm_is_false (scm_call_1 (type, val))) { - SCM typefunc = ly_lily_module_constant ("type-name"); - SCM type_name = scm_call_1 (typefunc, type); - + SCM type_name = Lily::type_name (type); + warning (_f ("type check for `%s' failed; value `%s' must be of type `%s'", ly_symbol2string (sym).c_str (), print_scm_val (val), @@ -449,6 +449,23 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol) return true; } +void +ly_wrong_smob_arg (bool pred (SCM), SCM var, int number, const char *fun) +{ + string type = predicate_to_typename ((void *) pred); + if (pred (var)) + { + // Uh oh. unsmob delivered 0, yet + // unsmob delivers true. This means that unsmob is a + // matching check from a base class of T, but var is of an + // incompatible derived type. + type = string (_ ("Wrong kind of ")).append (type); + } + scm_wrong_type_arg_msg (mangle_cxx_identifier (fun).c_str (), + number, var, type.c_str ()); +} + + /* some SCM abbrevs zijn deze nou handig? @@ -512,6 +529,18 @@ display_list (SCM s) return SCM_UNSPECIFIED; } +// Needed as complement to int_list_to_slice since scm_c_memq refuses +// to work with dotted lists. + +SCM +ly_memv (SCM v, SCM l) +{ + for (; scm_is_pair (l); l = scm_cdr (l)) + if (scm_is_true (scm_eqv_p (v, scm_car (l)))) + return l; + return SCM_BOOL_F; +} + Slice int_list_to_slice (SCM l) { @@ -564,7 +593,7 @@ robust_scm2string (SCM k, const string &s) int robust_scm2int (SCM k, int o) { - if (scm_integer_p (k) == SCM_BOOL_T) + if (scm_is_integer (k)) o = scm_to_int (k); return o; } @@ -572,7 +601,7 @@ robust_scm2int (SCM k, int o) vsize robust_scm2vsize (SCM k, vsize o) { - if (scm_integer_p (k) == SCM_BOOL_T) + if (scm_is_integer (k)) { int i = scm_to_int (k); if (i >= 0) @@ -655,8 +684,7 @@ alist_to_hashq (SCM alist) SCM ly_hash2alist (SCM tab) { - SCM func = ly_lily_module_constant ("hash-table->alist"); - return scm_call_1 (func, tab); + return Lily::hash_table_to_alist (tab); } /*