From 74c61cc4ee63bbca2cf202eba531c1d388829e5b Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 15 Jun 2017 22:29:09 -0700
Subject: ffi: copy-carray, hooked into copy.

* ffi.c (copy_carray): New function
(ffi_init): Register copy-carray intrinsic.

* ffi.h (copy_carray): Declared.

* lib.c (copy): Call copy_array for carray objects.

* txr.1: Documented copy-carray and updated
copy description.
---
 ffi.c |  9 +++++++++
 ffi.h |  1 +
 lib.c |  2 ++
 txr.1 | 25 +++++++++++++++++++++++++
 4 files changed, 37 insertions(+)

diff --git a/ffi.c b/ffi.c
index 47155ec2..f8e133c9 100644
--- a/ffi.c
+++ b/ffi.c
@@ -4407,6 +4407,14 @@ val length_carray(val carray)
   return if3(scry->nelem < 0, nil, num(scry->nelem));
 }
 
+val copy_carray(val carray)
+{
+  struct carray *scry = carray_struct_checked(carray);
+  val copy = make_carray(scry->eltype, scry->data, scry->nelem, nil);
+  carray_dup(copy);
+  return copy;
+}
+
 mem_t *carray_ptr(val carray, val type, val self)
 {
   struct carray *scry = carray_struct_checked(carray);
@@ -5014,6 +5022,7 @@ void ffi_init(void)
   reg_fun(intern(lit("carray-free"), user_package), func_n1(carray_free));
   reg_fun(intern(lit("carray-type"), user_package), func_n1(carray_type));
   reg_fun(intern(lit("length-carray"), user_package), func_n1(length_carray));
+  reg_fun(intern(lit("copy-carray"), user_package), func_n1(copy_carray));
   reg_fun(intern(lit("carray-vec"), user_package), func_n3o(carray_vec, 2));
   reg_fun(intern(lit("carray-list"), user_package), func_n3o(carray_list, 2));
   reg_fun(intern(lit("carray-blank"), user_package), func_n2(carray_blank));
diff --git a/ffi.h b/ffi.h
index 984d97ee..37758d09 100644
--- a/ffi.h
+++ b/ffi.h
@@ -94,6 +94,7 @@ val carray_own(val carray);
 val carray_free(val carray);
 val carray_type(val carray);
 val length_carray(val carray);
+val copy_carray(val carray);
 mem_t *carray_ptr(val carray, val type, val self);
 val carray_vec(val vec, val type, val null_term_p);
 val carray_list(val list, val type, val null_term_p);
diff --git a/lib.c b/lib.c
index 07f733a7..ee7e8eeb 100644
--- a/lib.c
+++ b/lib.c
@@ -9131,6 +9131,8 @@ val copy(val seq)
       return copy_hash(seq);
     if (seq->co.cls == random_state_s)
       return make_random_state(seq, nil);
+    if (seq->co.cls == carray_s)
+      return copy_carray(seq);
     if (structp(seq))
       return copy_struct(seq);
     /* fallthrough */
diff --git a/txr.1 b/txr.1
index db723a7a..40eea806 100644
--- a/txr.1
+++ b/txr.1
@@ -24908,6 +24908,14 @@ is a structure, it returns
 .cblk
 .meti (copy-struct << object ).
 .cble
+If
+.meta object
+is a
+.codn carray ,
+it returns
+.cblk
+.meti (copy-carray << object ).
+.cble
 Lastly, if
 .meta object
 is a random state, it returns
@@ -56540,6 +56548,23 @@ has an unknown length, then
 .code nil
 is returned.
 
+.coNP Function @ copy-carray
+.synb
+.mets (copy-carray << carray )
+.syne
+.desc
+The
+.code copy-carray
+function returns a duplicate of
+.metn carray .
+
+The duplicate has the same element type and length, but has its own
+copy of the underlying storage. This is true whether or not
+.meta carray
+owns its storage or not. In either case, the duplicate owns
+.I its
+copy of the storage.
+
 .coNP Function @ carray-set-length
 .synb
 .mets (carray-set-length < carray << length )
-- 
cgit v1.2.3