diff options
| -rw-r--r-- | args.c | 9 | ||||
| -rw-r--r-- | args.h | 1 | ||||
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | lib.c | 89 | ||||
| -rw-r--r-- | lib.h | 2 | ||||
| -rw-r--r-- | tests/010/vec.tl | 21 | ||||
| -rw-r--r-- | txr.1 | 81 |
7 files changed, 185 insertions, 20 deletions
@@ -106,6 +106,15 @@ varg args_cat(varg to, varg from) return to; } +varg args_cat_from(varg to, varg from, cnum index) +{ + size_t size = sizeof *from->arg * (from->fill - index); + to->list = from->list; + memcpy(to->arg + to->fill, from->arg + index, size); + to->fill += from->fill - index; + return to; +} + varg args_cat_zap(varg to, varg from) { size_t size = sizeof *from->arg * from->fill; @@ -202,6 +202,7 @@ val args_get_checked(val name, varg args, cnum *arg_index); varg args_copy(varg to, varg from); varg args_copy_zap(varg to, varg from); varg args_cat(varg to, varg from); +varg args_cat_from(varg to, varg from, cnum index); varg args_cat_zap(varg to, varg from); varg args_cat_zap_from(varg to, varg from, cnum index); varg args_copy_reverse(varg to, varg from, cnum nargs); @@ -7684,6 +7684,8 @@ void eval_init(void) reg_fun(intern(lit("replace-vec"), user_package), func_n4o(replace_vec, 2)); reg_fun(intern(lit("fill-vec"), user_package), func_n4o(fill_vec, 2)); reg_fun(intern(lit("cat-vec"), user_package), func_n1(cat_vec)); + reg_fun(intern(lit("nested-vec-of"), user_package), func_n1v(nested_vec_of_v)); + reg_fun(intern(lit("nested-vec"), user_package), func_n0v(nested_vec_v)); reg_fun(intern(lit("assoc"), user_package), func_n2(assoc)); reg_fun(intern(lit("assql"), user_package), func_n2(assql)); @@ -9460,17 +9460,18 @@ val dupl(val fun) return func_f1(fun, do_dup); } -val vector(val length, val initval) +static val *vec_allocate(ucnum len, val self) { - val self = lit("vector"); - unsigned i; - ucnum len = c_unum(length, self); ucnum alloc_plus = len + 2; ucnum size = if3(alloc_plus > len, alloc_plus, convert(ucnum, -1)); - val *v = coerce(val *, chk_xalloc(size, sizeof *v, self)); + return coerce(val *, chk_xalloc(size, sizeof (val), self)); +} + +static val vec_own(val *v, val length) +{ val vec = make_obj(); + vec->v.type = VEC; - initval = default_null_arg(initval); #if HAVE_VALGRIND vec->v.vec_true_start = v; #endif @@ -9478,8 +9479,27 @@ val vector(val length, val initval) vec->v.vec = v; v[vec_alloc] = length; v[vec_length] = length; - for (i = 0; i < alloc_plus - 2; i++) - vec->v.vec[i] = initval; + + return vec; +} + +static void vec_init(val *v, ucnum len, val initval_in) +{ + ucnum i; + val initval = default_null_arg(initval_in); + v += 2; + for (i = 0; i < len; i++) + v[i] = initval; +} + +val vector(val length, val initval) +{ + val self = lit("vector"); + + ucnum len = c_unum(length, self); + val *v = vec_allocate(len, self); + val vec = vec_own(v, length); + vec_init(v, len, initval); return vec; } @@ -9647,18 +9667,10 @@ val copy_vec(val vec_in) { val self = lit("copy-vec"); val length = length_vec(vec_in); - ucnum alloc_plus = c_unum(length, self) + 2; - val *v = coerce(val *, chk_xalloc(alloc_plus, sizeof *v, self)); - val vec = make_obj(); - vec->v.type = VEC; -#if HAVE_VALGRIND - vec->v.vec_true_start = v; -#endif - v += 2; - vec->v.vec = v; - v[vec_alloc] = length; - v[vec_length] = length; - memcpy(vec->v.vec, vec_in->v.vec, (alloc_plus - 2) * sizeof *vec->v.vec); + ucnum len = c_unum(length, self); + val *v = vec_allocate(len, self); + val vec = vec_own(v, length); + memcpy(v + 2, vec_in->v.vec, len * sizeof *v); return vec; } @@ -9931,6 +9943,43 @@ toobig: uw_throwf(error_s, lit("~a: resulting vector too large"), self, nao); } +val nested_vec_of_v(val initval, struct args *args) +{ + val self = lit("nested-vec-of"); + cnum index = 0; + + if (!args_more(args, index)) + return nil; + + { + val dim = args_get(args, &index); + + if (args_more(args, index)) { + ucnum i, n = c_num(dim, self); + val *rawvec = vec_allocate(n, self); + args_decl(args_copy, max(args->fill, ARGS_MIN)); + int gc_save = gc_state(0); + val vec; + + args_cat_from(args_copy, args, index); + + for (i = 0; i < n; i++) + rawvec[i + 2] = nested_vec_of_v(initval, args_copy); + + vec = vec_own(rawvec, dim); + gc_state(gc_save); + return vec; + } else { + return vector(dim, initval); + } + } +} + +val nested_vec_v(struct args *args) +{ + return nested_vec_of_v(nil, args); +} + static val simple_lazy_stream_func(val stream, val lcons) { if (set(mkloc(lcons->lc.car, lcons), get_line(stream)) != nil) { @@ -1262,6 +1262,8 @@ val replace_vec(val vec_in, val items, val from, val to); val replace_obj(val obj, val items, val from, val to); val fill_vec(val vec, val item, val from_in, val to_in); val cat_vec(val list); +val nested_vec_of_v(val initval, struct args *); +val nested_vec_v(struct args *); val lazy_stream_cons(val stream, val no_throw_close); val lazy_str(val list, val term, val limit); val lazy_str_force_upto(val lstr, val index); diff --git a/tests/010/vec.tl b/tests/010/vec.tl index c1d435b9..f7b182c1 100644 --- a/tests/010/vec.tl +++ b/tests/010/vec.tl @@ -30,3 +30,24 @@ (fill-vec v3 2 -1) #(1 0 2) (fill-vec v3 3 -3) #(3 3 3)) (fill-vec v3 0 -2 -1) #(3 0 3)) + +(mtest + (nested-vec) nil + (nested-vec-of 0 4) #(0 0 0 0) + (nested-vec-of 0 4 3) #(#(0 0 0) + #(0 0 0) + #(0 0 0) + #(0 0 0)) + (nested-vec-of 'a 4 3 2) #(#(#(a a) #(a a) #(a a)) + #(#(a a) #(a a) #(a a)) + #(#(a a) #(a a) #(a a)) + #(#(a a) #(a a) #(a a))) + (nested-vec-of 'a 1 1 1) #(#(#(a))) + (nested-vec-of 'a 1 1 0) #(#(#())) + (nested-vec-of 'a 1 0 1) #(#()) + (nested-vec-of 'a 1 0) #(#()) + (nested-vec-of 'a 0 1) #() + (nested-vec-of 'a 0) #() + + (nested-vec-of 'a 4 0 1) #(#() #() #() #()) + (nested-vec-of 'a 4 0) #(#() #() #() #())) @@ -27930,6 +27930,87 @@ It returns a single large vector formed by catenating those vectors together in order. +.coNP Functions @ nested-vec and @ nested-vec-of +.synb +.mets (nested-vec << dimension *) +.mets (nested-vec-of < object << dimension *) +.syne +.desc +The +.code nested-vec-of +function constructs a nested vector according to the +.meta dimension +arguments, described in detail below. + +The +.code nested-vec +function is equivalent to +.code nested-vec-of +with an +.meta object +argument of +.codn nil . + +When there are no +.meta dimension +arguments, +.code nested-vec-of +returns +.codn nil . + +If there is exactly one +.meta dimension +argument, it must be a nonnegative integer. A newly created +having that many elements is returned, with each element of the +vector being +.metn object . + +If there are two or more +.meta dimension +arguments, nested vector is returned. The first +.meta dimension +argument specifies the outermost dimension: a vector of that many elements are +returned. Each element of that vector is a vector whose length is given by the +second dimension. This nesting pattern continues through the remaining +dimensions. The last dimension specifies the length of vectors which +are filled with +.metn object . + +From the above it follows that if a zero-valued +.meta dimension +is encountered, every vector corresponding to that level of nesting shall be empty, +and that shall be the last dimension regardless of the presence of additional +.meta dimension +arguments. + +.TP* Examples: + +.verb + (nested-vec) -> nil + + (nested-vec-of 0 4) -> #(0 0 0 0) + + (nested-vec-of 0 4 3) -> #(#(0 0 0) + #(0 0 0) + #(0 0 0) + #(0 0 0)) + + (nested-vec-of 'a 4 3 2) -> #(#(#(a a) #(a a) #(a a)) + #(#(a a) #(a a) #(a a)) + #(#(a a) #(a a) #(a a)) + #(#(a a) #(a a) #(a a))) + + (nested-vec-of 'a 1 1 1) -> #(#(#(a))) + (nested-vec-of 'a 1 1 0) -> #(#(#())) + (nested-vec-of 'a 1 0 1) -> #(#()) + (nested-vec-of 'a 1 0) -> #(#()) + (nested-vec-of 'a 0 1) -> #() + (nested-vec-of 'a 0) -> #() + + (nested-vec-of 'a 4 0 1) #(#() #() #() #()) + (nested-vec-of 'a 4 0) #(#() #() #() #())) +.brev + .SS* Buffers .coNP The @ buf type |