source file of the GNU LilyPond music typesetter
- (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+ (c) 1998--2008 Jan Nieuwenhuizen <janneke@gnu.org>
Han-Wen Nienhuys <hanwen@xs4all.nl>
*/
/*
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),
// 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
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);
}
return scm_ihashv (s, ~1u);
}
-
bool
is_axis (SCM s)
{
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;
}
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)
{
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"
/* 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"));
}
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)
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.
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, "_2_", "->");
+ replace_all (&cxx_id, "__", "::");
+ replace_all (&cxx_id, '_', '-');
+
- cxx_id = replace_all (cxx_id, '_', '-');
return cxx_id;
}
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;
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));
+}
+
projects / lilypond.git / blobdiff