X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Flily-guile.cc;h=09fc1075f5eb5ca101fd661c4344ec380a00c363;hb=d548c339bc07e4a707c1092507afe2d672e0457d;hp=e44e47f4be27f6f30b64817b760191a678e4441f;hpb=9f3572d98bb948c9689cd1f75401a029451fa001;p=lilypond.git

diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
index e44e47f4be..09fc1075f5 100644
--- a/lily/lily-guile.cc
+++ b/lily/lily-guile.cc
@@ -16,8 +16,6 @@
 
 using namespace std;
 
-#include "config.hh"
-
 #include "dimensions.hh"
 #include "direction.hh"
 #include "file-path.hh"
@@ -32,8 +30,10 @@ using namespace std;
 #include "version.hh"
 #include "warn.hh"
 
-// #define TEST_GC
 
+/*
+  symbols/strings.
+ */
 SCM
 ly_to_symbol (SCM scm)
 {
@@ -48,12 +48,6 @@ ly_to_string (SCM scm)
 		     scm_makfrom0str ("~S"), scm);
 }
 
-SCM
-ly_last (SCM list)
-{
-  return scm_car (scm_last_pair (list));
-}
-
 SCM
 ly_write2scm (SCM s)
 {
@@ -105,10 +99,8 @@ gulp_file_to_string (string fn, bool must_exist, int size)
   if (be_verbose_global)
     progress_indication ("[" + s);
 
-  int n = size;
-  char *str = gulp_file (s, &n);
-  string result (str, n);
-  delete[] str;
+  vector<char> chars = gulp_file (s, size);
+  string result (&chars[0], chars.size ());
 
   if (be_verbose_global)
     progress_indication ("]");
@@ -126,12 +118,15 @@ extern "C" {
   }
 };
 
+/*
+  STRINGS
+ */
 string
 ly_scm2string (SCM str)
 {
   assert (scm_is_string (str));
   return string (scm_i_string_chars (str),
-		     (int) scm_i_string_length (str));
+		 (int) scm_i_string_length (str));
 }
 
 char *
@@ -153,6 +148,10 @@ ly_scm2newstr (SCM str, size_t *lenp)
   return 0;
 }
 
+
+/*
+  PAIRS
+*/
 SCM
 index_get_cell (SCM s, Direction d)
 {
@@ -178,77 +177,62 @@ is_number_pair (SCM p)
     && scm_is_number (scm_car (p)) && scm_is_number (scm_cdr (p));
 }
 
-typedef void (*Void_fptr) ();
-vector<Void_fptr> *scm_init_funcs_;
 
-void add_scm_init_func (void (*f) ())
+unsigned int
+ly_scm_hash (SCM s)
 {
-  if (!scm_init_funcs_)
-    scm_init_funcs_ = new vector<Void_fptr>;
-
-  scm_init_funcs_->push_back (f);
+  return scm_ihashv (s, ~1u);
 }
 
-void
-ly_init_ly_module (void *)
-{
-  for (vsize i = scm_init_funcs_->size (); i--;)
-    (scm_init_funcs_->at (i)) ();
 
-  if (be_verbose_global)
+bool
+is_axis (SCM s)
+{
+  if (scm_is_number (s))
     {
-      progress_indication ("[");
-      scm_display (scm_c_eval_string ("(%search-load-path \"lily.scm\")"),
-		   scm_current_error_port ());
-      progress_indication ("]\n");
+      int i = scm_to_int (s);
+      return i == 0 || i == 1;
     }
-
-  scm_primitive_load_path (scm_makfrom0str ("lily.scm"));
+  return false;
 }
 
-SCM global_lily_module;
-
-void
-ly_c_init_guile ()
+bool
+to_boolean (SCM s)
 {
-  global_lily_module = scm_c_define_module ("lily", ly_init_ly_module, 0);
-  scm_c_use_module ("lily");
+  return scm_is_bool (s) && ly_scm2bool (s);
 }
 
-unsigned int
-ly_scm_hash (SCM s)
+/*
+  DIRECTIONS
+ */
+Direction
+to_dir (SCM s)
 {
-  return scm_ihashv (s, ~1u);
+  return scm_is_integer (s) ? (Direction) scm_to_int (s) : CENTER;
 }
 
-bool
-is_direction (SCM s)
+Direction
+robust_scm2dir (SCM d, Direction def)
 {
-  if (scm_is_number (s))
-    {
-      int i = scm_to_int (s);
-      return i >= -1 && i <= 1;
-    }
-  return false;
+  if (is_direction (d))
+    def = to_dir (d);
+  return def;
 }
 
 bool
-is_axis (SCM s)
+is_direction (SCM s)
 {
   if (scm_is_number (s))
     {
       int i = scm_to_int (s);
-      return i == 0 || i == 1;
+      return i >= -1 && i <= 1;
     }
   return false;
 }
 
-Direction
-to_dir (SCM s)
-{
-  return scm_is_integer (s) ? (Direction) scm_to_int (s) : CENTER;
-}
-
+/*
+  INTERVALS
+ */
 Interval
 ly_scm2interval (SCM p)
 {
@@ -268,32 +252,40 @@ ly_interval2scm (Drul_array<Real> i)
   return scm_cons (scm_from_double (i[LEFT]), scm_from_double (i[RIGHT]));
 }
 
-bool
-to_boolean (SCM s)
+
+Interval
+robust_scm2interval (SCM k, Drul_array<Real> v)
 {
-  return scm_is_bool (s) && ly_scm2bool (s);
+  Interval i;
+  i[LEFT] = v[LEFT];
+  i[RIGHT] = v[RIGHT];
+  if (is_number_pair (k))
+    i = ly_scm2interval (k);
+  return i;
 }
 
-/* Appendable list L: the cdr contains the list, the car the last cons
-   in the list.  */
-SCM
-appendable_list ()
+Drul_array<Real>
+robust_scm2drul (SCM k, Drul_array<Real> v)
 {
-  SCM s = scm_cons (SCM_EOL, SCM_EOL);
-  scm_set_car_x (s, s);
-
-  return s;
+  if (is_number_pair (k))
+    v = ly_scm2interval (k);
+  return v;
 }
 
-void
-appendable_list_append (SCM l, SCM elt)
+Drul_array<bool>
+robust_scm2booldrul (SCM k, Drul_array<bool> def)
 {
-  SCM newcons = scm_cons (elt, SCM_EOL);
-
-  scm_set_cdr_x (scm_car (l), newcons);
-  scm_set_car_x (l, newcons);
+  if (scm_is_pair (k))
+    {
+      def[LEFT] = to_boolean (scm_car (k));
+      def[RIGHT] = to_boolean (scm_cdr (k));
+    }
+  return def;
 }
 
+/*
+  OFFSET
+*/
 SCM
 ly_offset2scm (Offset o)
 {
@@ -307,24 +299,42 @@ ly_scm2offset (SCM s)
 		 scm_to_double (scm_cdr (s)));
 }
 
+Offset
+robust_scm2offset (SCM k, Offset o)
+{
+  if (is_number_pair (k))
+    o = ly_scm2offset (k);
+  return o;
+}
 SCM
-ly_deep_copy (SCM src)
+ly_offsets2scm (vector<Offset> os)
 {
-  if (scm_is_pair (src))
-    return scm_cons (ly_deep_copy (scm_car (src)), ly_deep_copy (scm_cdr (src)));
-  else if (scm_is_vector (src))
+  SCM l = SCM_EOL;
+  SCM *tail = &l;
+  for (vsize i = 0; i < os.size (); i++)
     {
-      int len = scm_c_vector_length (src);
-      SCM nv = scm_c_make_vector (len, SCM_UNDEFINED);
-      for (int i = 0;i < len; i++)
-	{
-	  SCM si = scm_from_int (i);
-	  scm_vector_set_x (nv, si, ly_deep_copy (scm_vector_ref (src, si)));
-	}
+      *tail = scm_cons (ly_offset2scm (os[i]), SCM_EOL);
+      tail = SCM_CDRLOC(*tail);
     }
-  return src;
+  return l;
 }
 
+vector<Offset>
+ly_scm2offsets (SCM s)
+{
+  vector<Offset> os;
+  for (; scm_is_pair (s); s = scm_cdr (s))
+    os.push_back (ly_scm2offset (scm_car (s)));
+  return os;
+}
+
+
+
+
+/*
+  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.
@@ -355,27 +365,70 @@ ly_assoc_cdr (SCM key, SCM alist)
   return SCM_BOOL_F;
 }
 
+
+bool
+alist_equal_p (SCM a, SCM b)
+{
+  for (SCM s = a;
+       scm_is_pair (s); s = scm_cdr (s))
+    {
+      SCM key = scm_caar (s);
+      SCM val = scm_cdar (s);
+      SCM l = scm_assoc (key, b);
+
+      if (l == SCM_BOOL_F
+	  || !ly_is_equal (scm_cdr (l), val))
+
+	return false;
+    }
+  return true;
+}
+
 SCM
-ly_string_array_to_scm (vector<string> a)
+ly_alist_vals (SCM alist)
 {
-  SCM s = SCM_EOL;
-  for (vsize i = a.size (); i ; i--)
-    s = scm_cons (ly_symbol2scm (a[i - 1].c_str ()), s);
-  return s;
+  SCM x = SCM_EOL;
+  for (SCM p = alist; scm_is_pair (p); p = scm_cdr (p))
+    x = scm_cons (scm_cdar (p), x);
+  return x;
 }
 
-/* SYMBOLS is a whitespace separated list.  */
+/*
+  LISTS
+ */
+
+/* Return I-th element, or last elt L. If I < 0, then we take the first
+   element.
+
+   PRE: length (L) > 0  */
 SCM
-parse_symbol_list (char const *symbols)
+robust_list_ref (int i, SCM l)
 {
-  while (isspace (*symbols))
-    *symbols++;
-  string s = symbols;
-  replace_all (s, '\n', ' ');
-  replace_all (s, '\t', ' ');
-  return ly_string_array_to_scm (string_split (s, ' '));
+  while (i-- > 0 && scm_is_pair (scm_cdr (l)))
+    l = scm_cdr (l);
+  return scm_car (l);
+}
+
+
+SCM
+ly_deep_copy (SCM src)
+{
+  if (scm_is_pair (src))
+    return scm_cons (ly_deep_copy (scm_car (src)), ly_deep_copy (scm_cdr (src)));
+  else if (scm_is_vector (src))
+    {
+      int len = scm_c_vector_length (src);
+      SCM nv = scm_c_make_vector (len, SCM_UNDEFINED);
+      for (int i = 0;i < len; i++)
+	{
+	  SCM si = scm_from_int (i);
+	  scm_vector_set_x (nv, si, ly_deep_copy (scm_vector_ref (src, si)));
+	}
+    }
+  return src;
 }
 
+
 SCM
 ly_truncate_list (int k, SCM lst)
 {
@@ -394,6 +447,30 @@ ly_truncate_list (int k, SCM lst)
   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)
 {
@@ -488,6 +565,7 @@ ly_unique (SCM list)
   return scm_reverse_x (unique, SCM_EOL);
 }
 
+
 static int
 scm_default_compare (void const *a, void const *b)
 {
@@ -527,13 +605,6 @@ ly_list_qsort_uniq_x (SCM lst)
   return lst;
 }
 
-/* tail add */
-SCM
-ly_snoc (SCM s, SCM list)
-{
-  return ly_append2 (list, scm_list_n (s, SCM_UNDEFINED));
-}
-
 /* Split list at member s, removing s.
    Return (BEFORE . AFTER)  */
 SCM
@@ -589,18 +660,6 @@ int_list_to_slice (SCM l)
   return s;
 }
 
-/* Return I-th element, or last elt L. If I < 0, then we take the first
-   element.
-
-   PRE: length (L) > 0  */
-SCM
-robust_list_ref (int i, SCM l)
-{
-  while (i-- > 0 && scm_is_pair (scm_cdr (l)))
-    l = scm_cdr (l);
-  return scm_car (l);
-}
-
 Real
 robust_scm2double (SCM k, double x)
 {
@@ -609,60 +668,39 @@ robust_scm2double (SCM k, double x)
   return x;
 }
 
-Direction
-robust_scm2dir (SCM d, Direction def)
-{
-  if (is_direction (d))
-    def = to_dir (d);
-  return def;
-}
 
-Interval
-robust_scm2interval (SCM k, Drul_array<Real> v)
+string
+robust_scm2string (SCM k, string s)
 {
-  Interval i;
-  i[LEFT] = v[LEFT];
-  i[RIGHT] = v[RIGHT];
-  if (is_number_pair (k))
-    i = ly_scm2interval (k);
-  return i;
+  if (scm_is_string (k))
+    s = ly_scm2string (k);
+  return s;
 }
 
-Drul_array<Real>
-robust_scm2drul (SCM k, Drul_array<Real> v)
+int
+robust_scm2int (SCM k, int o)
 {
-  if (is_number_pair (k))
-    v = ly_scm2interval (k);
-  return v;
+  if (scm_integer_p (k) == SCM_BOOL_T)
+    o = scm_to_int (k);
+  return o;
 }
 
-Drul_array<bool>
-robust_scm2booldrul (SCM k, Drul_array<bool> def)
-{
-  if (scm_is_pair (k))
-    {
-      def[LEFT] = to_boolean (scm_car (k));
-      def[RIGHT] = to_boolean (scm_cdr (k));
-    }
-  return def;
-}
 
-Offset
-robust_scm2offset (SCM k, Offset o)
+SCM
+ly_rational2scm (Rational r)
 {
-  if (is_number_pair (k))
-    o = ly_scm2offset (k);
-  return o;
+  return scm_divide (scm_from_int (r.numerator ()), scm_from_int (r.denominator ()));
 }
 
-int
-robust_scm2int (SCM k, int o)
+
+Rational
+ly_scm2rational (SCM r)
 {
-  if (scm_integer_p (k) == SCM_BOOL_T)
-    o = scm_to_int (k);
-  return o;
+  return Rational (scm_to_int (scm_numerator (r)),
+		   scm_to_int (scm_denominator (r)));
 }
 
+
 SCM
 alist_to_hashq (SCM alist)
 {
@@ -679,33 +717,6 @@ alist_to_hashq (SCM alist)
   return tab;
 }
 
-bool
-alist_equal_p (SCM a, SCM b)
-{
-  for (SCM s = a;
-       scm_is_pair (s); s = scm_cdr (s))
-    {
-      SCM key = scm_caar (s);
-      SCM val = scm_cdar (s);
-      SCM l = scm_assoc (key, b);
-
-      if (l == SCM_BOOL_F
-	  || !ly_is_equal (scm_cdr (l), val))
-
-	return false;
-    }
-  return true;
-}
-
-SCM
-ly_alist_vals (SCM alist)
-{
-  SCM x = SCM_EOL;
-  for (SCM p = alist; scm_is_pair (p); p = scm_cdr (p))
-    x = scm_cons (scm_cdar (p), x);
-  return x;
-}
-
 SCM
 ly_hash2alist (SCM tab)
 {
@@ -724,6 +735,10 @@ procedure_arity (SCM proc)
   return scm_to_int (fixed);
 }
 
+/*
+  C++ interfacing.
+ */
+
 string
 mangle_cxx_identifier (string cxx_id)
 {
@@ -742,3 +757,41 @@ mangle_cxx_identifier (string cxx_id)
   cxx_id = replace_all (cxx_id, '_', '-');
   return cxx_id;
 }
+
+
+
+SCM
+ly_string_array_to_scm (vector<string> a)
+{
+  SCM s = SCM_EOL;
+  for (vsize i = a.size (); i ; i--)
+    s = scm_cons (ly_symbol2scm (a[i - 1].c_str ()), s);
+  return s;
+}
+
+/* SYMBOLS is a whitespace separated list.  */
+SCM
+parse_symbol_list (char const *symbols)
+{
+  while (isspace (*symbols))
+    *symbols++;
+  string s = symbols;
+  replace_all (s, '\n', ' ');
+  replace_all (s, '\t', ' ');
+  return ly_string_array_to_scm (string_split (s, ' '));
+}
+
+
+bool
+ly_is_fraction (SCM x)
+{
+  return SCM_FRACTIONP(x);
+}
+
+struct ly_t_double_cell
+{
+  SCM a;
+  SCM b;
+  SCM c;
+  SCM d;
+};