]> git.donarmstrong.com Git - lilypond.git/blobdiff - lily/lily-guile.cc
coverage fixes.
[lilypond.git] / lily / lily-guile.cc
index dd5080b36737a88a98f90996470bb70b4b702a0d..e7e286d5a64c1d4d0a0445bf4b8b392d0f09930e 100644 (file)
@@ -3,7 +3,7 @@
 
   source file of the GNU LilyPond music typesetter
 
-  (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+  (c) 1998--2007 Jan Nieuwenhuizen <janneke@gnu.org>
   Han-Wen Nienhuys <hanwen@xs4all.nl>
 */
 
@@ -34,19 +34,6 @@ 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)
@@ -129,6 +116,14 @@ 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)
 {
@@ -335,37 +330,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)
 {
@@ -429,25 +393,6 @@ ly_deep_copy (SCM 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;
-}
-
-
 
 
 
@@ -502,7 +447,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"));
     }
@@ -665,16 +611,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.
@@ -736,3 +672,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));
+}
+