X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Flily-guile.cc;h=370dba2998e932f32b63520c3413da7d2b7af41d;hb=c5a3f0c024f4cb629811cff9eb04abff36e94138;hp=6e497fa8fa889eda4aa72e0da967397763579976;hpb=7a3c3526e082ada6fefbe564315046a14ecf609c;p=lilypond.git diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc index 6e497fa8fa..370dba2998 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--2007 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 @@ -129,10 +115,18 @@ ly_scm2string (SCM str) (int) scm_i_string_length (str)); } +SCM +ly_string2scm (string const &str) +{ + return scm_from_locale_stringn (str.c_str(), + str.length ()); +} + + char * ly_scm2newstr (SCM str, size_t *lenp) { - SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string"); + LY_ASSERT_TYPE (scm_is_string, str, 1); size_t len = scm_i_string_length (str); if (char *new_str = (char *) malloc ((len + 1) * sizeof (char))) @@ -335,37 +329,6 @@ ly_scm2offsets (SCM s) ALIST */ -/* looks the key up in the cdrs of the alist-keys - - ignoring the car and ignoring non-pair keys. - Returns first match found, i.e. - - alist = ((1 . 10) - ((1 . 2) . 11) - ((2 . 1) . 12) - ((3 . 0) . 13) - ((4 . 1) . 14) ) - - I would like (ly_assoc_cdr 1) to return 12 - because it's the first - element with the cdr of the key = 1. In other words (alloc_cdr key) - corresponds to call - - (alloc (anything . key)) -*/ -SCM -ly_assoc_cdr (SCM key, SCM alist) -{ - if (scm_is_pair (alist)) - { - SCM trykey = scm_caar (alist); - if (scm_is_pair (trykey) - && to_boolean (scm_equal_p (key, scm_cdr (trykey)))) - return scm_car (alist); - return ly_assoc_cdr (key, scm_cdr (alist)); - } - return SCM_BOOL_F; -} - - bool alist_equal_p (SCM a, SCM b) { @@ -428,53 +391,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; -} - - - - -/* Appendable list L: the cdr contains the list, the car the last cons - in the list. */ -SCM -appendable_list () -{ - SCM s = scm_cons (SCM_EOL, SCM_EOL); - scm_set_car_x (s, s); - - return s; -} - -void -appendable_list_append (SCM l, SCM elt) -{ - SCM newcons = scm_cons (elt, SCM_EOL); - - scm_set_cdr_x (scm_car (l), newcons); - scm_set_car_x (l, newcons); -} - - 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" @@ -522,7 +442,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")); } @@ -566,45 +487,6 @@ ly_unique (SCM list) } -static int -scm_default_compare (void const *a, void const *b) -{ - SCM pa = *(SCM *) a; - SCM pb = *(SCM *) b; - if (pa == pb) - return 0; - return pa < pb ? -1 : 1; -} - -/* Modify LST in place: qsort it. - -FIXME: unused, junk? */ -SCM -ly_list_qsort_uniq_x (SCM lst) -{ - int len = scm_ilength (lst); - SCM *arr = new SCM[len]; - int k = 0; - for (SCM s = lst; SCM_NNULLP (s); s = scm_cdr (s)) - arr[k++] = scm_car (s); - - assert (k == len); - qsort (arr, len, sizeof (SCM), &scm_default_compare); - - SCM *tail = &lst; - for (int i = 0; i < len; i++) - if (!i || arr[i] != arr[i - 1]) - { - SCM_SETCAR (*tail, arr[i]); - tail = SCM_CDRLOC (*tail); - } - - *tail = SCM_EOL; - delete[] arr; - - return lst; -} - /* Split list at member s, removing s. Return (BEFORE . AFTER) */ SCM @@ -700,6 +582,14 @@ ly_scm2rational (SCM r) scm_to_int (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) @@ -724,16 +614,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. @@ -750,11 +630,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, "!"); + cxx_id = replace_all (cxx_id, "_less?", ""); + cxx_id = replace_all (cxx_id, "__", "::"); cxx_id = replace_all (cxx_id, '_', '-'); + + return cxx_id; } @@ -781,13 +666,7 @@ parse_symbol_list (char const *symbols) 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; @@ -795,3 +674,10 @@ struct ly_t_double_cell SCM c; SCM d; }; + +/* inserts at front, removing duplicates */ +SCM ly_assoc_prepend_x (SCM alist, SCM key, SCM val) +{ + return scm_acons (key, val, scm_assoc_remove_x (alist, key)); +} +