From 0687743dcfad79dba202b4411a5b51f6954cf3b2 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku 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 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'ffi.c') 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)); -- cgit v1.2.3