New functions: nested-vec-of and nested-vec.

* eval.c (eval_init): Register nestd-vec-of and nested-vec
intrinsics.

* lib.[ch] (vec_allocate, vec_own, vec_init): New static functions.
(vector, copy_vec): Expressed in terms of new functions.
(nested_vec_of_v, nested_vec_v): New functions.

* args.[ch] (args_cat_from): New function.

* tests/010/vec.tl: New tests.

* txr.1: Documented.

7 files changed, 185 insertions, 20 deletions

diff --git a/args.c b/args.c
index bfb76fd5..219c47e8 100644
--- a/args.c
+++ b/args.c
@@ -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;
diff --git a/args.h b/args.h
index 6b9ace06..f2f5129e 100644
--- a/args.h
+++ b/args.h
@@ -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);
diff --git a/eval.c b/eval.c
index c02704db..d53a20be 100644
--- a/eval.c
+++ b/eval.c
@@ -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));
diff --git a/lib.c b/lib.c
index 6fd47a1c..a4f5db85 100644
--- a/lib.c
+++ b/lib.c
@@ -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) {
diff --git a/lib.h b/lib.h
index 4c101501..e3cc0f8b 100644
--- a/lib.h
+++ b/lib.h
@@ -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) #(#() #() #() #()))
diff --git a/txr.1 b/txr.1
index 40f96466..08eeff9b 100644
--- a/txr.1
+++ b/txr.1
@@ -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