Merge master into nested-bookparts

[lilypond.git] / lily / lily-guile.cc

diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
index 726470acee3f9cf4188b67d35d41bd33cd33997f..9c88983e4c88586d90fc52f643feacaefd6af3c4 100644 (file)
--- a/lily/lily-guile.cc
+++ b/lily/lily-guile.cc
@@ -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_from_locale_string ("~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,14 +111,19 @@ 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;
 }
 
 SCM
 ly_string2scm (string const &str)
 {
-  return scm_from_locale_stringn (str.c_str(),
+  return scm_from_locale_stringn (str.c_str (),
                                  str.length ());
 }
 
@@ -140,30 +131,16 @@ ly_string2scm (string const &str)
 char *
 ly_scm2newstr (SCM str, size_t *lenp)
 {
-  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';
-
-      if (lenp)
-       *lenp = len;
-
-      return new_str;
-    }
-  return 0;
+  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);
 }
@@ -192,7 +169,6 @@ ly_scm_hash (SCM s)
   return scm_ihashv (s, ~1u);
 }
 
-
 bool
 is_axis (SCM s)
 {
@@ -322,7 +298,7 @@ ly_offsets2scm (vector<Offset> 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;
 }
@@ -405,14 +381,10 @@ ly_deep_copy (SCM src)
   return src;
 }
 
-
-
-
-
 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"
@@ -460,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"));
     }
@@ -588,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_long_long (r.numerator ()),
+                    scm_from_long_long (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_long_long (scm_numerator (r)),
+                  scm_to_long_long (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)
@@ -623,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.
@@ -649,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, "_2_", "->");
+  replace_all (&cxx_id, "__", "::");
+  replace_all (&cxx_id, '_', '-');
+
 
-  cxx_id = replace_all (cxx_id, '_', '-');
   return cxx_id;
 }
 
@@ -675,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;