zip: make more generic.

* lib.c (do_pa_12_1_v, pa_12_1_v): Static functions removed.
(transposev, transpose): Functions removed.

* lib.c (transposev, transpose): Declarations removed.

* eval.c (join_f): New global variable.
(zip_fun, zipv, transpose): New static functions.
(eval_init): gc-protect join_f, and initialize it.
Registration of zip intrinsic goes to zipv rather
than transposev. sys:fmt-join and join registered
with help of global join_f rather than local.

* tests/012/seq.tl: New zip test cases.

4 files changed, 120 insertions, 48 deletions

diff --git a/eval.c b/eval.c
index 675c1e04..cd87c3a9 100644
--- a/eval.c
+++ b/eval.c
@@ -115,6 +115,7 @@ val last_form_evaled;
 
 val call_f, iter_begin_f, iter_from_binding_f, iter_more_f;
 val iter_item_f, iter_step_f;
+val join_f;
 
 val origin_hash;
 
@@ -5835,6 +5836,54 @@ static val mapdov(val fun, varg lists)
   return map_common(lit("mapdo"), fun, lists, 0, mapdo);
 }
 
+static val zip_fun(val ziparg0, varg args)
+{
+  seq_build_t bu;
+  cnum index = 0;
+  seq_build_init(lit("zip"), &bu, ziparg0);
+  while (args_more(args, index))
+    seq_add(&bu, args_get(args, &index));
+  return seq_finish(&bu);
+}
+
+static val zipv(varg zipargs)
+{
+  if (!args_more(zipargs, 0))
+    return nil;
+
+  {
+    val ziparg0 = args_at(zipargs, 0);
+    val func = nil;
+
+    switch (type(ziparg0)) {
+    case NIL:
+    case CONS:
+    case LCONS:
+      func = list_f;
+      break;
+    case STR:
+    case LSTR:
+    case LIT:
+      func = join_f;
+      break;
+    case VEC:
+      func = func_n0v(vectorv);
+      break;
+    default:
+      func = func_f0v(ziparg0, zip_fun);
+      break;
+    }
+
+    return mapcarv(func, zipargs);
+  }
+}
+
+static val transpose(val seq)
+{
+  args_decl_list(args, ARGS_MIN, tolist(seq));
+  return make_like(zipv(args), seq);
+}
+
 static val lazy_mapcar_func(val env, val lcons)
 {
   us_cons_bind (fun, iter, env);
@@ -6951,7 +7000,7 @@ void eval_init(void)
   protect(&top_vb, &top_fb, &top_mb, &top_smb, &special, &builtin, &dyn_env,
           &op_table, &pm_table, &last_form_evaled,
           &call_f, &iter_begin_f, &iter_from_binding_f, &iter_more_f,
-          &iter_item_f, &iter_step_f,
+          &iter_item_f, &iter_step_f, &join_f,
           &unbound_s, &origin_hash, &const_foldable_hash,
           &unused_arg_s, convert(val *, 0));
   top_fb = make_hash(hash_weak_and, nil);
@@ -6969,6 +7018,7 @@ void eval_init(void)
   iter_more_f = func_n1(iter_more);
   iter_item_f = func_n1(iter_item);
   iter_step_f = func_n1(iter_step);
+  join_f = func_n0v(fmt_join);
 
   origin_hash = make_eq_hash(hash_weak_keys);
 
@@ -7294,7 +7344,7 @@ void eval_init(void)
   reg_fun(intern(lit("reduce-left"), user_package), func_n4o(reduce_left, 2));
   reg_fun(intern(lit("reduce-right"), user_package), func_n4o(reduce_right, 2));
   reg_fun(intern(lit("transpose"), user_package), func_n1(transpose));
-  reg_fun(intern(lit("zip"), user_package), func_n0v(transposev));
+  reg_fun(intern(lit("zip"), user_package), func_n0v(zipv));
   reg_fun(intern(lit("interpose"), user_package), func_n2(interpose));
 
   reg_fun(intern(lit("second"), user_package), second_f);
@@ -7519,11 +7569,8 @@ void eval_init(void)
 
   reg_fun(intern(lit("fmt-simple"), system_package), func_n5o(fmt_simple, 1));
   reg_fun(intern(lit("fmt-flex"), system_package), func_n2v(fmt_flex));
-  {
-    val join_f = func_n0v(fmt_join);
-    reg_fun(intern(lit("fmt-join"), system_package), join_f);
-    reg_fun(intern(lit("join"), user_package), join_f);
-  }
+  reg_fun(intern(lit("fmt-join"), system_package), join_f);
+  reg_fun(intern(lit("join"), user_package), join_f);
   reg_fun(intern(lit("join-with"), user_package), func_n1v(join_with));
 
   reg_varl(user_package_s = intern(lit("user-package"), user_package), user_package);
diff --git a/lib.c b/lib.c
index 52326b2d..339fec2f 100644
--- a/lib.c
+++ b/lib.c
@@ -9227,16 +9227,6 @@ val pa_12_1(val fun2, val arg2)
   return func_f1(cons(fun2, arg2), do_pa_12_1);
 }
 
-static val do_pa_12_1_v(val fcons, varg args)
-{
-  return funcall2(car(fcons), args_get_list(args), cdr(fcons));
-}
-
-static val pa_12_1_v(val fun2, val arg2)
-{
-  return func_f0v(cons(fun2, arg2), do_pa_12_1_v);
-}
-
 static val do_pa_123_3(val fcons, val arg3)
 {
   return funcall3(car(fcons), car(cdr(fcons)), cdr(cdr(fcons)), arg3);
@@ -9292,35 +9282,6 @@ val pa_1234_34(val fun4, val arg1, val arg2)
   return func_f2(cons(fun4, cons(arg1, arg2)), do_pa_1234_34);
 }
 
-val transposev(varg list)
-{
-  val func = list_f;
-
-  if (!args_more(list, 0))
-    return nil;
-
-  switch (type(args_at(list, 0))) {
-  case STR:
-  case LSTR:
-  case LIT:
-    func = pa_12_1_v(func_n2(cat_str), nil);
-    break;
-  case VEC:
-    func = func_n0v(vectorv);
-    break;
-  default:
-    break;
-  }
-
-  return mapcarv(func, list);
-}
-
-val transpose(val seq)
-{
-  args_decl_list(args, ARGS_MIN, tolist(seq));
-  return make_like(transposev(args), seq);
-}
-
 static val do_chain(val fun1_list, varg args)
 {
   val arg = nil;
diff --git a/lib.h b/lib.h
index e3816473..2c1e307c 100644
--- a/lib.h
+++ b/lib.h
@@ -1249,8 +1249,6 @@ val funcall3(val fun, val arg1, val arg2, val arg3);
 val funcall4(val fun, val arg1, val arg2, val arg3, val arg4);
 val reduce_left(val fun, val list, val init, val key);
 val reduce_right(val fun, val list, val init, val key);
-val transposev(varg lists);
-val transpose(val lists);
 /* The notation pa_12_2 means take some function f(arg1, arg2) and
    fix a value for argument 1 to create a g(arg2).
    Other variations follow by analogy. */
diff --git a/tests/012/seq.tl b/tests/012/seq.tl
index 144c6971..6ea572fe 100644
--- a/tests/012/seq.tl
+++ b/tests/012/seq.tl
@@ -756,3 +756,69 @@
               (lambda (z)
                 (+ x y z))))))
   (test [mref cf 1 2 3] 6))
+
+(test
+  (zip) nil)
+
+(mtest
+  (zip '()) nil
+  (zip #()) #()
+  (zip "") ""
+  (zip #b'') #b'')
+
+(mtest
+  (zip '(a)) ((a))
+  (zip '(a b)) ((a) (b))
+  (zip '(a b c)) ((a) (b) (c)))
+
+(mtest
+  (zip #(a)) #(#(a))
+  (zip #(a b)) #(#(a) #(b))
+  (zip #(a b c)) #(#(a) #(b) #(c)))
+
+(mtest
+  (zip "a") ("a")
+  (zip "ab") ("a" "b")
+  (zip "abc") ("a" "b" "c"))
+
+(mtest
+  (zip #b'aa') (#b'aa')
+  (zip #b'aabb') (#b'aa' #b'bb')
+  (zip #b'aabbcc') (#b'aa' #b'bb' #b'cc'))
+
+(mtest
+  (zip '(a) '(b)) ((a b))
+  (zip '(a c) '(b d)) ((a b) (c d))
+  (zip '(a c e) '(b d f)) ((a b) (c d) (e f))
+  (zip '(a d) '(b e) '(c f)) ((a b c) (d e f)))
+
+(mtest
+  (zip #(a) #(b)) #(#(a b))
+  (zip #(a c) #(b d)) #(#(a b) #(c d))
+  (zip #(a c e) #(b d f)) #(#(a b) #(c d) #(e f))
+  (zip #(a d) #(b e) #(c f)) #(#(a b c) #(d e f)))
+
+(mtest
+  (zip #(a) #(b)) #(#(a b))
+  (zip #(a c) #(b d)) #(#(a b) #(c d))
+  (zip #(a c e) #(b d f)) #(#(a b) #(c d) #(e f))
+  (zip #(a d) #(b e) #(c f)) #(#(a b c) #(d e f)))
+
+(mtest
+  (zip "a" "b") ("ab")
+  (zip "ac" "bd") ("ab" "cd")
+  (zip "ace" "bdf") ("ab" "cd" "ef")
+  (zip "ad" "bef" "cf") ("abc" "def"))
+
+(mtest
+  (zip #b'aa' #b'bb') (#b'aabb')
+  (zip #b'aacc' #b'bbdd') (#b'aabb' #b'ccdd')
+  (zip #b'aaccee' #b'bbddff') (#b'aabb' #b'ccdd' #b'eeff')
+  (zip #b'aaddee' #b'bbeeff' #b'ccff') (#b'aabbcc' #b'ddeeff'))
+
+(test
+  (zip "ab" "ijklm" "xy") ("aix" "bjy"))
+
+(test
+  (zip "ab" '(#\i #\j) #("x" "y")) ("aix" "bjy"))
+