zip: more permissive implementation.

zip and transpose should allow non-character data
when the leftmost column is a string, falling back
on making lists, like seq_build.

We can't use seq_build as-is because of the special
semantics of transpose/zip with regard to strings.
We introduce a "strcat" variant of seq_build
for this purpose.

* lib.c (seq_build_strcat_add): New static function.
(sb_strcat_ops): New static structure like sb_str_ops,
but with seq_build_strcat_add as the add operation,
which allows string arguments to be appended to the
string rather than switching to a list.
(seq_build_strcat_init): New function.

* lib.h (seq_build_strcat_init): Declared.

* eval.c (zip_strcat): New static function; uses
seq_build_strcat_init.
(zipv): Only recognize strings specially; all else goes
through the existing default case.
Strings use zip_strcat.

* tests/012/seq.tl: New test case.

* txr.1: Describe special semantics of zip/tranpose;
previously only documented in one example.
Clarify that the rows are only sequences of the
same kind as the leftmost column if possible,
otherwise lists.  Remove text which says that it's an error
for the other columns to contain non-string, non-character
objects if the leftmost column is a string.

5 files changed, 58 insertions, 22 deletions

diff --git a/eval.c b/eval.c
index 91220930..b5eb32dc 100644
--- a/eval.c
+++ b/eval.c
@@ -5874,6 +5874,16 @@ static val seq_like(val ziparg0, varg args)
   return seq_finish(&bu);
 }
 
+static val zip_strcat(varg args)
+{
+  seq_build_t bu;
+  cnum index = 0;
+  seq_build_strcat_init(&bu);
+  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))
@@ -5884,18 +5894,10 @@ static val zipv(varg zipargs)
     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);
+      func = func_n0v(zip_strcat);
       break;
     default:
       func = func_f0v(ziparg0, seq_like);
diff --git a/lib.c b/lib.c
index 193f8196..077d51ea 100644
--- a/lib.c
+++ b/lib.c
@@ -1597,6 +1597,16 @@ static void seq_build_str_add(seq_build_t *bu, val item)
   }
 }
 
+static void seq_build_strcat_add(seq_build_t *bu, val item)
+{
+  if (chrp(item) || stringp(item)) {
+    string_extend(bu->obj, item, nil);
+  } else {
+    seq_build_convert_to_list(bu, list_str(bu->obj));
+    bu->ops->add(bu, item);
+  }
+}
+
 static void seq_build_str_finish(seq_build_t *bu)
 {
   string_finish(bu->obj);
@@ -1669,6 +1679,13 @@ static struct seq_build_ops
                                   seq_build_obj_mark);
 
 static struct seq_build_ops
+  sb_strcat_ops = seq_build_ops_init(seq_build_strcat_add,
+                                     seq_build_generic_pend,
+                                     seq_build_generic_pend,
+                                     seq_build_str_finish,
+                                     seq_build_obj_mark);
+
+static struct seq_build_ops
   sb_buf_ops = seq_build_ops_init(seq_build_buf_add,
                                   seq_build_generic_pend,
                                   seq_build_generic_pend,
@@ -1772,6 +1789,12 @@ void seq_build_init(val self, seq_build_t *bu, val likeobj)
   }
 }
 
+void seq_build_strcat_init(seq_build_t *bu)
+{
+  bu->obj = string(L"");
+  bu->ops = &sb_strcat_ops;
+}
+
 void seq_add(seq_build_t *bu, val item)
 {
   bu->ops->add(bu, item);
diff --git a/lib.h b/lib.h
index 79ac403f..6010ebd2 100644
--- a/lib.h
+++ b/lib.h
@@ -781,6 +781,7 @@ val iter_reset(val iter, val obj);
 val iter_catv(varg iters);
 val copy_iter(val iter);
 void seq_build_init(val self, seq_build_t *bu, val likeobj);
+void seq_build_strcat_init(seq_build_t *bu);
 void seq_add(seq_build_t *bu, val item);
 void seq_pend(seq_build_t *bu, val items);
 void seq_nconc(seq_build_t *bu, val items);
diff --git a/tests/012/seq.tl b/tests/012/seq.tl
index 29fea518..148f1899 100644
--- a/tests/012/seq.tl
+++ b/tests/012/seq.tl
@@ -844,6 +844,9 @@
 (test
   (zip "ab" '(#\i #\j) #("x" "y")) ("aix" "bjy"))
 
+(test
+  (zip "abc" '(#\a 2 3)) ("aa" (#\b 2) (#\c 3)))
+
 (vtest
   [apply mapcar join (list-seq "aaa".."zzz")]
   (transpose (list-seq "aaa".."zzz")))
diff --git a/txr.1 b/txr.1
index a92a484a..b2acfb14 100644
--- a/txr.1
+++ b/txr.1
@@ -38388,19 +38388,10 @@ elements of
 must be iterable.  These iterables are understood to be
 columns; transpose exchanges rows and columns, returning a sequence of the rows
 which make up the columns.  The returned sequence is of the same kind as
-.metn iterable ,
-and the rows are also the same kind of sequence as the first column
-of the original sequence. The number of rows returned is limited by the
-shortest column among the sequences.
-
-All of the input sequences (the elements of
-.metn iterable )
-must have elements
-which are compatible with the first sequence. This means that if the first
-element of
-.meta iterable
-is a string, then the remaining sequences must be
-strings, or else sequences of characters, or of strings.
+.metn iterable .
+The rows are also the same kind of sequence as the first element
+of the original sequence, if possible, otherwise they are lists. The number of
+rows returned is limited by the shortest column among the sequences.
 
 The
 .code zip
@@ -38414,6 +38405,22 @@ on a list of the arguments. The following equivalences hold:
    [apply zip x] <--> (transpose x)
 .brev
 
+A special requirement applies when the first argument of
+.code zip
+or the first element of the
+.meta iterable
+argument of
+.code transpose
+is a string. In this situation, the tuples which emerge are strings,
+if possible. The special requirement is that column elements which are
+strings are treated as individual items and appended to the row strings.
+For example,
+.code "(zip \(dqab\(dq #(\(dqrst\(dq \(dqxyz\(dq))"
+produces
+.codn "(\(dqarst\(dq \(dqbxyz\(dq)" ,
+rather than
+.codn "((\(dqa\(dq \(dqrst\(dq) (\(dqb\(dq \(dqxyz\(dq))" .
+
 .TP* Examples:
 .verb
   ;; transpose list of lists