X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Flily-guile.cc;h=ccc87807f05852445f8e1e1b933ecffcf0ac0587;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=11d21765a23d8da10e1ad15f90d0b6d568e53217;hpb=190f20aa82d91374e46f652c5272c216ebd02206;p=lilypond.git diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc index 11d21765a2..ccc87807f0 100644 --- a/lily/lily-guile.cc +++ b/lily/lily-guile.cc @@ -3,7 +3,7 @@ source file of the GNU LilyPond music typesetter - (c) 1998--2006 Jan Nieuwenhuizen + (c) 1998--2008 Jan Nieuwenhuizen Han-Wen Nienhuys */ @@ -34,22 +34,8 @@ using namespace std; /* symbols/strings. */ -SCM -ly_to_symbol (SCM scm) -{ - return scm_string_to_symbol (ly_to_string (scm)); -} - -SCM -ly_to_string (SCM scm) -{ - return scm_call_3 (ly_lily_module_constant ("format"), SCM_BOOL_F, - - scm_makfrom0str ("~S"), scm); -} - -SCM -ly_write2scm (SCM s) +string +ly_scm_write_string (SCM s) { SCM port = scm_mkstrport (SCM_INUM0, scm_make_string (SCM_INUM0, SCM_UNDEFINED), @@ -60,7 +46,7 @@ ly_write2scm (SCM s) // scm_apply (write, port, SCM_EOL); scm_call_2 (write, s, port); - return scm_strport_to_string (port); + return ly_scm2string (scm_strport_to_string (port)); } SCM @@ -125,37 +111,36 @@ string ly_scm2string (SCM str) { assert (scm_is_string (str)); - return string (scm_i_string_chars (str), - (int) scm_i_string_length (str)); + string result; + size_t len = scm_c_string_length (str); + if (len) { + result.resize(len); + scm_to_locale_stringbuf(str, &result.at(0), len); + } + return result; } -char * -ly_scm2newstr (SCM str, size_t *lenp) +SCM +ly_string2scm (string const &str) { - SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string"); - - size_t len = scm_i_string_length (str); - if (char *new_str = (char *) malloc ((len + 1) * sizeof (char))) - { - memcpy (new_str, scm_i_string_chars (str), len); - new_str[len] = '\0'; + return scm_from_locale_stringn (str.c_str (), + str.length ()); +} - if (lenp) - *lenp = len; - return new_str; - } - return 0; +char * +ly_scm2newstr (SCM str, size_t *lenp) +{ + char* p = scm_to_locale_stringn(str, lenp); + return p; } - /* PAIRS */ -SCM +SCM index_get_cell (SCM s, Direction d) { - assert (d); return (d == LEFT) ? scm_car (s) : scm_cdr (s); } @@ -184,7 +169,6 @@ ly_scm_hash (SCM s) return scm_ihashv (s, ~1u); } - bool is_axis (SCM s) { @@ -314,7 +298,7 @@ ly_offsets2scm (vector os) for (vsize i = 0; i < os.size (); i++) { *tail = scm_cons (ly_offset2scm (os[i]), SCM_EOL); - tail = SCM_CDRLOC(*tail); + tail = SCM_CDRLOC (*tail); } return l; } @@ -397,33 +381,10 @@ ly_deep_copy (SCM src) return src; } - -SCM -ly_truncate_list (int k, SCM lst) -{ - if (k == 0) - lst = SCM_EOL; - else - { - SCM s = lst; - k--; - for (; scm_is_pair (s) && k--; s = scm_cdr (s)) - ; - - if (scm_is_pair (s)) - scm_set_cdr_x (s, SCM_EOL); - } - return lst; -} - - - - - string print_scm_val (SCM val) { - string realval = ly_scm2string (ly_write2scm (val)); + string realval = ly_scm_write_string (val); if (realval.length () > 200) realval = realval.substr (0, 100) + "\n :\n :\n" @@ -471,7 +432,8 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol) /* Be strict when being anal :) */ if (do_internal_type_checking_global) - abort (); + scm_throw (ly_symbol2scm ("ly-file-failed"), scm_list_3 (ly_symbol2scm ("typecheck"), + sym, val)); warning (_ ("doing assignment anyway")); } @@ -599,17 +561,26 @@ robust_scm2int (SCM k, int o) SCM ly_rational2scm (Rational r) { - return scm_divide (scm_from_int (r.numerator ()), scm_from_int (r.denominator ())); + return scm_divide (scm_from_int64 (r.numerator ()), + scm_from_int64 (r.denominator ())); } Rational ly_scm2rational (SCM r) { - return Rational (scm_to_int (scm_numerator (r)), - scm_to_int (scm_denominator (r))); + return Rational (scm_to_int64 (scm_numerator (r)), + scm_to_int64 (scm_denominator (r))); } +Rational +robust_scm2rational (SCM n, Rational rat) +{ + if (ly_is_fraction (n)) + return ly_scm2rational (n); + else + return rat; +} SCM alist_to_hashq (SCM alist) @@ -634,16 +605,6 @@ ly_hash2alist (SCM tab) return scm_call_1 (func, tab); } -int -procedure_arity (SCM proc) -{ - assert (ly_is_procedure (proc)); - SCM arity = scm_procedure_property (proc, - ly_symbol2scm ("arity")); - - SCM fixed = scm_car (arity); - return scm_to_int (fixed); -} /* C++ interfacing. @@ -660,11 +621,16 @@ mangle_cxx_identifier (string cxx_id) cxx_id = "ly:" + cxx_id; } if (cxx_id.substr (cxx_id.length () - 2) == "_p") - cxx_id = cxx_id.replace (cxx_id.length () - 2, 1, "?"); + cxx_id = cxx_id.replace (cxx_id.length () - 2, 2, "?"); else if (cxx_id.substr (cxx_id.length () - 2) == "_x") - cxx_id = cxx_id.replace (cxx_id.length () - 2, 1, "!"); + cxx_id = cxx_id.replace (cxx_id.length () - 2, 2, "!"); + + replace_all (&cxx_id, "_less?", ""); + replace_all (&cxx_id, "__", "::"); + replace_all (&cxx_id, '_', '-'); + - cxx_id = replace_all (cxx_id, '_', '-'); return cxx_id; } @@ -686,18 +652,13 @@ parse_symbol_list (char const *symbols) while (isspace (*symbols)) *symbols++; string s = symbols; - replace_all (s, '\n', ' '); - replace_all (s, '\t', ' '); + replace_all (&s, '\n', ' '); + replace_all (&s, '\t', ' '); + replace_all (&s, " ", " "); return ly_string_array_to_scm (string_split (s, ' ')); } - -bool -ly_is_fraction (SCM x) -{ - return SCM_FRACTIONP(x); -} - +/* GDB debugging. */ struct ly_t_double_cell { SCM a;