From fe844150ea39f75128706a8c6f242a26142fd181 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 11 Jun 2017 11:03:40 -0700
Subject: ffi: support sel operation on carray.

Thus (select ca '(0 3 4 ...)) works and so does the
sytnax [ca '(0 3 4 ...)]. This is inefficiently implemented.
The selected elements are extracted to a list which is then
converted to a carray of the same kind agan.

* ffi.c (carray_list): New function.
(ffi_init): Register carray-list intrinsic.

* ffi.h (carray_list): Declared.

* lib.c (make_like): Add carray case, so we can turn
a list into a carray based on an example carray.
This uses carray_list, with the type pulled from the
original carray. The target isn't null terminated.
(sel): Handle carray via vector case.

* txr.1: Document changes in select and make-like.
---
 ffi.c | 18 ++++++++++++++++++
 ffi.h |  1 +
 lib.c |  5 +++++
 txr.1 | 25 ++++++++++++++++++-------
 4 files changed, 42 insertions(+), 7 deletions(-)

diff --git a/ffi.c b/ffi.c
index c0bc40ee..1a40dcbb 100644
--- a/ffi.c
+++ b/ffi.c
@@ -4425,6 +4425,23 @@ val carray_vec(val vec, val type, val null_term_p)
   return carray;
 }
 
+val carray_list(val list, val type, val null_term_p)
+{
+  val nt_p = default_null_arg(null_term_p);
+  val len = if3(nt_p, succ(length(list)), length(list));
+  val carray = carray_blank(len, type);
+  cnum i;
+
+  (void) c_num(len);
+
+  for (i = 0; !endp(list); list = cdr(list), i++) {
+    val el = car(list);
+    carray_refset(carray, num_fast(i), el);
+  }
+
+  return carray;
+}
+
 val carray_blank(val nelem, val type)
 {
   val self = lit("carray-blank");
@@ -4704,6 +4721,7 @@ void ffi_init(void)
   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("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));
   reg_fun(intern(lit("carray-buf"), user_package), func_n2(carray_buf));
   reg_fun(intern(lit("carray-buf-sync"), user_package), func_n1(carray_buf_sync));
diff --git a/ffi.h b/ffi.h
index 88557b7b..2e88f167 100644
--- a/ffi.h
+++ b/ffi.h
@@ -95,6 +95,7 @@ val carray_type(val carray);
 val length_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);
 val carray_blank(val nelem, val type);
 val carray_buf(val buf, val type);
 val carray_buf_sync(val carray);
diff --git a/lib.c b/lib.c
index 95016a33..6e14e618 100644
--- a/lib.c
+++ b/lib.c
@@ -718,6 +718,8 @@ val make_like(val list, val thatobj)
         if (from_list_meth)
           return funcall1(from_list_meth, list);
       }
+      if (thatobj->co.cls == carray_s)
+        return carray_list(list, carray_type(thatobj), nil);
       break;
     case NIL:
     case CONS:
@@ -9633,6 +9635,8 @@ val sel(val seq_in, val where_in)
 
       return newhash;
     }
+    if (seq->co.cls == carray_s)
+      goto carray;
     /* fallthrough */
   case CONS:
   case LCONS:
@@ -9650,6 +9654,7 @@ val sel(val seq_in, val where_in)
       }
     }
     break;
+  carray:
   default:
     {
       val len = length(seq);
diff --git a/txr.1 b/txr.1
index 122c60e3..63515d87 100644
--- a/txr.1
+++ b/txr.1
@@ -56143,15 +56143,18 @@ in order to extract the return value of foreign function
 calls, and by the FFI callback mechanism to extract the
 arguments coming into a callback.
 
-.coNP Function @ carray-vec
+.coNP Functions @ carray-vec and @ carray-list
 .synb
 .mets (carray-vec < vec < type <> [ null-term-p ])
+.mets (carray-list < list < type <> [ null-term-p ])
 .syne
 .desc
 The
 .code carray-vec
-function allocates storage for the representation of a foreign array, and
-returns a
+and
+.code carray-list
+functions allocate storage for the representation of a foreign array, and
+return a
 .code carray
 object which holds a pointer to that storage.
 
@@ -56162,9 +56165,11 @@ is retained as the
 .code carray
 object's element type.
 
-Prior to returning, the function
+Prior to returning, the functions
 initializes the foreign array by converting the elements of
 .meta vec
+or, respectively,
+.meta list
 into elements of the foreign array.
 The conversion is performed using the put semantics of
 .metn type ,
@@ -56174,6 +56179,8 @@ The length of the returned
 .code carray
 is determined from the length of
 .meta vec
+or
+.meta list
 and from the value of the Boolean argument
 .metn null-term-p .
 
@@ -56183,8 +56190,10 @@ is
 .codn nil ,
 then the length of the
 .code carray
-is the same as that of
-.metn vec .
+is the same as that of the input
+.meta vec
+or
+.metn list .
 
 A true value of
 .meta null-term-p
@@ -56192,7 +56201,9 @@ indicates null termination.
 This causes the length of the
 .code carray
 to be one greater than that of
-.metn vec ,
+.meta vec
+or
+.metn list ,
 and the extra element allocated to the foreign array is filled with zero bytes.
 
 .coNP Function @ carray-blank
-- 
cgit v1.2.3