diff options
| -rw-r--r-- | ffi.c | 93 | ||||
| -rw-r--r-- | ffi.h | 1 | ||||
| -rw-r--r-- | lib.c | 4 | ||||
| -rw-r--r-- | txr.1 | 77 |
4 files changed, 175 insertions, 0 deletions
@@ -4600,6 +4600,98 @@ val carray_sub(val carray, val from, val to) } } +val carray_replace(val carray, val values, val from, val to) +{ + val self = lit("carray-replace"); + struct carray *scry = carray_struct_checked(carray); + cnum ln = scry->nelem; + val len = num(ln); + val vlen = length(values); + + if (null_or_missing_p(from)) + from = zero; + + if (null_or_missing_p(to)) + to = len; + + if (minusp(to)) + to = plus(to, len); + + if (minusp(from)) + from = plus(from, len); + + { + cnum fn = c_num(from); + cnum tn = c_num(to); + struct txr_ffi_type *eltft = scry->eltft; + cnum elsize = eltft->size; + cnum size = (ucnum) ln * (ucnum) elsize; + cnum vn = c_num(vlen); + cnum sn; + mem_t *ptr; + + if (fn < 0) + fn = 0; + + if (tn < 0) + tn = 0; + + if (tn > ln) + tn = ln; + + if (fn > ln) + fn = ln; + + if (tn < fn) + tn = fn; + + sn = fn + vn; + + if (sn > ln) + sn = ln; + + if ((ln != 0 && size / elsize != ln) || (sn < fn)) + uw_throwf(error_s, lit("~a: array size overflow"), self, nao); + + ptr = scry->data + fn * elsize; + + { + cnum oldrange = (tn - fn) * elsize; + cnum newrange = (sn - fn) * elsize; + cnum tail = (ln - tn) * elsize; + cnum whole = ln * elsize; + + if (newrange > oldrange) { + cnum delta = newrange - oldrange; + memmove(ptr + newrange, ptr + oldrange, tail - delta); + } else if (newrange < oldrange) { + cnum delta = oldrange - newrange; + memmove(ptr + newrange, ptr + oldrange, tail); + memset(ptr + whole - delta, 0, delta); + } + } + + if (consp(values)) { + val iter; + + for (iter = values; fn < sn; iter = cdr(iter), fn++, ptr += elsize) + { + val newval = car(iter); + eltft->put(eltft, newval, ptr, self); + } + } else if (values) { + cnum i; + + for (i = 0; fn < sn; i++, fn++, ptr += elsize) { + val newval = ref(values, num_fast(i)); + eltft->put(eltft, newval, ptr, self); + } + } + + return carray; + } +} + static void carray_ensure_artype(val carray, struct carray *scry) { if (!scry->artype) { @@ -4793,6 +4885,7 @@ void ffi_init(void) reg_fun(intern(lit("carray-ref"), user_package), func_n2(carray_ref)); reg_fun(intern(lit("carray-refset"), user_package), func_n3(carray_refset)); reg_fun(intern(lit("carray-sub"), user_package), func_n3o(carray_sub, 1)); + reg_fun(intern(lit("carray-replace"), user_package), func_n4o(carray_replace, 2)); reg_fun(intern(lit("carray-get"), user_package), func_n1(carray_get)); reg_fun(intern(lit("carray-getz"), user_package), func_n1(carray_getz)); reg_fun(intern(lit("carray-put"), user_package), func_n2(carray_put)); @@ -105,6 +105,7 @@ val list_carray(val carray, val null_term_p); val carray_ref(val carray, val idx); val carray_refset(val carray, val idx, val newval); val carray_sub(val carray, val from, val to); +val carray_replace(val carray, val values, val from, val to); val carray_get(val carray); val carray_getz(val carray); val carray_put(val array, val seq); @@ -9263,6 +9263,10 @@ val replace(val seq, val items, val from, val to) return replace_str(seq, items, from, to); case VEC: return replace_vec(seq, items, from, to); + case COBJ: + if (seq->co.cls == carray_s) + return carray_replace(seq, items, from, to); + /* fallthrough */ default: type_mismatch(lit("replace: ~s is not a sequence"), seq, nao); } @@ -25115,6 +25115,15 @@ is a list, then must be monotonically increasing. +If +.meta sequence +is a +.code carray +object, then +.code replace +behaves like +.codn carray-replace . + .coNP Function @ take .synb .mets (take < count << sequence ) @@ -56861,6 +56870,74 @@ can be severed by invoking on the returned object, after which the two no longer share storage, and modifications in the original are not reflected in the subrange. +.coNP Function @ carray-replace +.synb +.mets (carray-replace < carray < item-sequence >> [ from <> [ to ]]) +.syne +.desc +The +.code carray-replace +function is a specialized version of +.code replace +which works on +.code carray +objects. It replaces a sub-range of +.meta carray +with elements from +.metn item-sequence . +The replacement sequence need not have the same length +as the range which it replaces. + +The semantics of +.meta from +and +.meta to +work exactly like the corresponding arguments of the +.code replace +function, following the same conventions. + +The semantics of the +.code carray-replace +operation itself differs from the +.code replace +semantics on sequences in one important regard: the +.code carray +object's length always remains the same. + +The range indicated by +.meta from +and +.meta to +is deleted from +.meta carray +and replaced by elements of +.metn item-sequence , +which undergo conversion to the foreign type that defines the +elements of +.metn carray . + +If this operation would make the +.code carray +longer, any elements in excess of the object's length are discarded, +whether they are the original elements, or whether they come from +.metn item-sequence . +Under no circumstances does +.code carray-replace +write an element beyond the length of the underlying storage. + +If this operation would make the +.meta carray +shorter (the range being replaced is longer than +.metn item-sequence ) +then the downward relocation of items above the replacement range +creates a gap at the end of +.meta carray +which is filled with zero bytes. + +The return value is +.meta carray +itself. + .coNP Function @ carray-pun .synb .mets (carray-sub < carray << type ) |