X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Flily-guile.cc;h=6f7bf37f709f072594426b884827e0e2cd9b2515;hb=8f2f4d6f0af1626a333050d367211a7d73437082;hp=27909a6bc2a43bccca2bcce48fdb029099f3eb6d;hpb=887000f61099efaf85d6d5b580f20fcf84c0fc6f;p=lilypond.git diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc index 27909a6bc2..6f7bf37f70 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 @@ -75,13 +75,13 @@ ly_symbol2string (SCM s) } string -robust_symbol2string (SCM sym, string str) +robust_symbol2string (SCM sym, const string &str) { return scm_is_symbol (sym) ? ly_symbol2string (sym) : str; } string -gulp_file_to_string (string fn, bool must_exist, int size) +gulp_file_to_string (const string &fn, bool must_exist, int size) { string s = global_path.find (fn); if (s == "") @@ -144,7 +144,7 @@ ly_string2scm (string const &str) char * ly_scm2str0 (SCM str) { - return scm_to_locale_string (str); + return scm_to_utf8_string (str); } /* @@ -399,25 +399,15 @@ print_scm_val (SCM val) bool type_check_assignment (SCM sym, SCM val, SCM type_symbol) { - bool ok = true; - - /* - Always succeeds. - - - TODO: should remove #f from allowed vals? - */ - if (val == SCM_EOL || val == SCM_BOOL_F) - return ok; // 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,26 +419,34 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol) scm_throw (ly_symbol2scm ("ly-file-failed"), scm_list_3 (ly_symbol2scm ("typecheck"), sym, val)); - warning (_ ("doing assignment anyway")); + warning (_ ("skipping assignment")); + return false; } - else + + /* + Always succeeds. + + + TODO: should remove #f from allowed vals? + */ + if (scm_is_null (val) || scm_is_false (val)) + return true; + + if (!scm_is_null (val) + && ly_is_procedure (type) + && scm_is_false (scm_call_1 (type, val))) { - if (val != SCM_EOL - && ly_is_procedure (type) - && scm_call_1 (type, val) == SCM_BOOL_F) - { - ok = false; - SCM typefunc = ly_lily_module_constant ("type-name"); - SCM type_name = scm_call_1 (typefunc, type); - - warning (_f ("type check for `%s' failed; value `%s' must be of type `%s'", - ly_symbol2string (sym).c_str (), - print_scm_val (val), - ly_scm2string (type_name).c_str ())); - progress_indication ("\n"); - } + SCM typefunc = ly_lily_module_constant ("type-name"); + SCM type_name = scm_call_1 (typefunc, type); + + warning (_f ("type check for `%s' failed; value `%s' must be of type `%s'", + ly_symbol2string (sym).c_str (), + print_scm_val (val), + ly_scm2string (type_name).c_str ())); + progress_indication ("\n"); + return false; } - return ok; + return true; } /* some SCM abbrevs @@ -556,17 +554,17 @@ ly_floatvector2scm (vector v) } string -robust_scm2string (SCM k, string s) +robust_scm2string (SCM k, const string &s) { if (scm_is_string (k)) - s = ly_scm2string (k); + return ly_scm2string (k); return 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; } @@ -574,7 +572,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)