Run grand-replace (issue 3765)

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

diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
index eb78d8bbfde1e3e5e60e6e7c8856eea4cf31b7ec..c37eb33844389b293f174af367ff93626c2722d6 100644 (file)
--- a/lily/lily-guile.cc
+++ b/lily/lily-guile.cc
@@ -1,7 +1,7 @@
 /*
   This file is part of LilyPond, the GNU music typesetter.
 
-  Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
+  Copyright (C) 1998--2014 Jan Nieuwenhuizen <janneke@gnu.org>
   Han-Wen Nienhuys <hanwen@xs4all.nl>
 
   LilyPond is free software: you can redistribute it and/or modify
@@ -75,13 +75,13 @@ ly_symbol2string (SCM s)
 }
 
 string
-robust_symbol2string (SCM sym, string str)
+robust_symbol2string (SCM sym, const string &str)
 {
   return scm_is_symbol (sym) ? ly_symbol2string (sym) : str;
 }
 
 string
-gulp_file_to_string (string fn, bool must_exist, int size)
+gulp_file_to_string (const string &fn, bool must_exist, int size)
 {
   string s = global_path.find (fn);
   if (s == "")
@@ -355,8 +355,23 @@ 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))
+    {
+      SCM res = SCM_EOL;
+      do
+        {
+          res = scm_cons (ly_deep_copy (scm_car (src)), res);
+          src = scm_cdr (src);
+        }
+      while (scm_is_pair (src));
+      // Oh, come on, GUILE.  Why do you require the second argument
+      // of scm_reverse_x to be a proper list?  That makes no sense.
+      // return scm_reverse_x (res, ly_deep_copy (src));
+      SCM last_cons = res;
+      res = scm_reverse_x (res, SCM_EOL);
+      scm_set_cdr_x (last_cons, ly_deep_copy (src));
+      return res;
+    }
+  if (scm_is_vector (src))
     {
       int len = scm_c_vector_length (src);
       SCM nv = scm_c_make_vector (len, SCM_UNDEFINED);
@@ -384,16 +399,6 @@ print_scm_val (SCM val)
 bool
 type_check_assignment (SCM sym, SCM val, SCM type_symbol)
 {
-  bool ok = true;
-
-  /*
-    Always succeeds.
-
-
-    TODO: should remove #f from allowed vals?
-  */
-  if (val == SCM_EOL || val == SCM_BOOL_F)
-    return ok;
 
   // If undefined, some internal function caused it...should never happen.
   assert (val != SCM_UNDEFINED);
@@ -414,26 +419,34 @@ type_check_assignment (SCM sym, SCM val, SCM type_symbol)
         scm_throw (ly_symbol2scm ("ly-file-failed"), scm_list_3 (ly_symbol2scm ("typecheck"),
                                                                  sym, val));
 
-      warning (_ ("doing assignment anyway"));
+      warning (_ ("skipping assignment"));
+      return false;
     }
-  else
+
+  /*
+    Always succeeds.
+
+
+    TODO: should remove #f from allowed vals?
+  */
+  if (val == SCM_EOL || val == SCM_BOOL_F)
+    return true;
+
+  if (val != SCM_EOL
+      && ly_is_procedure (type)
+      && scm_call_1 (type, val) == SCM_BOOL_F)
     {
-      if (val != SCM_EOL
-          && ly_is_procedure (type)
-          && scm_call_1 (type, val) == SCM_BOOL_F)
-        {
-          ok = false;
-          SCM typefunc = ly_lily_module_constant ("type-name");
-          SCM type_name = scm_call_1 (typefunc, type);
-
-          warning (_f ("type check for `%s' failed; value `%s' must be of type `%s'",
-                       ly_symbol2string (sym).c_str (),
-                       print_scm_val (val),
-                       ly_scm2string (type_name).c_str ()));
-          progress_indication ("\n");
-        }
+      SCM typefunc = ly_lily_module_constant ("type-name");
+      SCM type_name = scm_call_1 (typefunc, type);
+      
+      warning (_f ("type check for `%s' failed; value `%s' must be of type `%s'",
+                   ly_symbol2string (sym).c_str (),
+                   print_scm_val (val),
+                   ly_scm2string (type_name).c_str ()));
+      progress_indication ("\n");
+      return false;
     }
-  return ok;
+  return true;
 }
 
 /* some SCM abbrevs
@@ -541,10 +554,10 @@ ly_floatvector2scm (vector<Real> v)
 }
 
 string
-robust_scm2string (SCM k, string s)
+robust_scm2string (SCM k, const string &s)
 {
   if (scm_is_string (k))
-    s = ly_scm2string (k);
+    return ly_scm2string (k);
   return s;
 }