Extend core vector-copy to r7rs vector-copy

* libguile/vectors.h: Declare scm_vector_copy_partial.
* libguile/vectors.c (scm_vector_copy_partial): As stated.
  (scm_vector_copy): Reuse scm_vector_copy_partial.
* module/scheme/base.scm: Reuse core vector-copy.
* module/srfi/srfi-43: Reuse core vector-copy.
* test-suite/tests/vectors.test: Test vector-copy.

2 files changed, 35 insertions, 7 deletions

diff --git a/libguile/vectors.c b/libguile/vectors.c
index 4f95644ef..3a2ff7ab5 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -265,17 +265,36 @@ scm_c_make_vector (size_t k, SCM fill)
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vector_copy, "vector-copy", 1, 0, 0,
-	    (SCM vec),
-	    "Return a copy of @var{vec}.")
-#define FUNC_NAME s_scm_vector_copy
+SCM_DEFINE (scm_vector_copy_partial, "vector-copy", 1, 2, 0,
+	    (SCM vec, SCM start, SCM end),
+            "Returns a freshly allocated vector containing the elements\n"
+            "of @var{vec} between @var{start} and @var{end}.\n\n"
+            "@var{start} defaults to 0 and @var{end} defaults to the\n"
+            "length of @var{vec}.")
+#define FUNC_NAME s_scm_vector_copy_partial
 {
   SCM result;
   if (SCM_I_IS_VECTOR (vec))
     {
-      size_t len = SCM_I_VECTOR_LENGTH (vec);
+      size_t cstart = 0, cend = SCM_I_VECTOR_LENGTH (vec);
+      
+      if (!SCM_UNBNDP (start))
+        {
+          cstart = scm_to_size_t (start);
+          SCM_ASSERT_RANGE (SCM_ARG2, start, cstart<=cend);
+
+          if (!SCM_UNBNDP (end))
+            {
+              size_t e = scm_to_size_t (end);
+              SCM_ASSERT_RANGE (SCM_ARG3, end, e>=cstart && e<=cend);
+              cend = e;
+            }
+        }
+
+      size_t len = cend-cstart;
       result = make_vector (len);
-      memcpy (SCM_I_VECTOR_WELTS (result), SCM_I_VECTOR_ELTS (vec), len * sizeof(SCM));
+      memcpy (SCM_I_VECTOR_WELTS (result), SCM_I_VECTOR_ELTS (vec) + cstart,
+              len * sizeof(SCM));
     }
   else
     {
@@ -290,6 +309,9 @@ SCM_DEFINE (scm_vector_copy, "vector-copy", 1, 0, 0,
         ("Using vector-copy on arrays is deprecated.  "
          "Use array-copy instead.");
 
+      if (SCM_UNBNDP (start))
+        scm_misc_error (s_scm_vector_copy_partial, "Too many arguments", SCM_EOL);
+
       result = make_vector (len);
       dst = SCM_I_VECTOR_WELTS (result);
       for (i = 0; i < len; i++, src += inc)
@@ -301,6 +323,12 @@ SCM_DEFINE (scm_vector_copy, "vector-copy", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM
+scm_vector_copy (SCM vec)
+{
+  return scm_vector_copy_partial (vec, SCM_UNDEFINED, SCM_UNDEFINED);
+}
+
 
 SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0, 
 	    (SCM vec),
diff --git a/libguile/vectors.h b/libguile/vectors.h
index 41e2c8909..1c04f9afe 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -88,7 +88,7 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 #define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8)
 
 SCM_INTERNAL SCM  scm_i_vector_equal_p (SCM x, SCM y);
-
+SCM_INTERNAL SCM scm_vector_copy_partial (SCM vec, SCM start, SCM end);
 
 SCM_INTERNAL void scm_init_vectors (void);