From 1f4cde420a19e5bef9160c08b95e1723d4895d01 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 23 Jul 2024 20:32:39 -0700
Subject: make-like: use seq_build.

* lib.c (make_like): Simplify implementation using seq_build,
which also lets it handle more cases.

* tests/012/seq.tl: New tests. Some existing test fixed,
including one for tuples*.

* txr.1: Documentation updated: mainly that make-like
doesn't strictly require a list argument.
---
 lib.c            | 59 ++++++++++++++++++--------------------------------------
 tests/012/seq.tl |  8 +++++---
 txr.1            | 14 +++++++-------
 3 files changed, 31 insertions(+), 50 deletions(-)

diff --git a/lib.c b/lib.c
index ed7f0b90..193f8196 100644
--- a/lib.c
+++ b/lib.c
@@ -2419,46 +2419,25 @@ val copy_list(val list)
 
 val make_like(val list, val thatobj)
 {
-  if (list != thatobj) {
-    switch (type(thatobj)) {
-    case VEC:
-      return vec_list(list);
-    case STR:
-    case LIT:
-    case LSTR:
-      if (!opt_compat || opt_compat > 101) {
-        if (!list)
-          return null_string;
-      }
-      if (is_chr(car(list)))
-        return cat_str(list, nil);
-      break;
-    case BUF:
-      if (!list)
-        return make_buf(zero, zero, zero);
-      if (integerp(car(list)))
-        return buf_list(list);
-      break;
-    case COBJ:
-      if (thatobj->co.cls == seq_iter_cls)
-      {
-        struct seq_iter *si = coerce(struct seq_iter *, thatobj->co.handle);
-        return make_like(list, si->inf.obj);
-      }
-      if (obj_struct_p(thatobj)) {
-        val from_list_meth = get_special_slot(thatobj, from_list_m);
-        if (from_list_meth)
-          return funcall1(from_list_meth, list);
-      }
-      if (thatobj->co.cls == carray_cls)
-        return carray_list(list, carray_type(thatobj), nil);
-      break;
-    case NIL:
-    case CONS:
-    case LCONS:
-    default:
-      break;
-    }
+  val self = lit("make-like");
+  type_t tli = type(list);
+  type_t tbj = type(thatobj);
+
+  if (tli != tbj &&
+      !(tli == NIL && tbj == CONS) &&
+      !(tli == CONS && tbj == NIL))
+  {
+    seq_iter_t it;
+    seq_build_t bu;
+    val elem;
+
+    seq_build_init(self, &bu, thatobj);
+    seq_iter_init(self, &it, list);
+
+    while (seq_get(&it, &elem))
+      seq_add(&bu, elem);
+
+    return seq_finish(&bu);
   }
 
   return list;
diff --git a/tests/012/seq.tl b/tests/012/seq.tl
index 97549500..29fea518 100644
--- a/tests/012/seq.tl
+++ b/tests/012/seq.tl
@@ -309,7 +309,7 @@
   (tuples* 3 #() 1) (#(1 1 1)))
 
 (test
-  (lforce (tuples* 3 "a" 1)) :error)
+  (lforce (tuples* 3 "a" 1)) ((#\a 1 1)))
 
 (mtest
   (take 3 (tuples* 3 (range 0))) ((0 1 2) (1 2 3) (2 3 4))
@@ -1602,9 +1602,11 @@
 (mtest
   (make-like '(1 2 3) "") (1 2 3)
   (make-like '(#\a #\b #\c) "") "abc"
-  (make-like '(#\a #\b 3) "") :error
+  (make-like '(#\a #\b 3) "") (#\a #\b 3)
   (make-like '(1 2 3) #()) #(1 2 3)
-  (make-like '(1 2 3) #b'') #b'010203')
+  (make-like '(1 2 3) #b'') #b'010203'
+  (make-like #(1 2 3) nil) (1 2 3)
+  (make-like #(1 2 3) '(x)) (1 2 3))
 
 (mtest
   (seq-like "" 1 2 3) (1 2 3)
diff --git a/txr.1 b/txr.1
index a5fb51fa..a92a484a 100644
--- a/txr.1
+++ b/txr.1
@@ -34410,22 +34410,22 @@ of the language may specify additional iterable objects.
 
 .coNP Functions @ make-like and @ seq-like
 .synb
-.mets (make-like < list << object )
+.mets (make-like < seq << object )
 .mets (seq-like < object << arg *)
 .syne
 .desc
 The
 .code make-like
 function's
-.meta list
-argument must be a list.  If
+.meta seq
+argument must be a sequence.  If
 .meta object
 is a sequence type,
 then
 .meta list
 is converted to the same type of sequence, if possible, and returned.
 Otherwise the original
-.meta list
+.meta seq
 is returned.
 
 Conversion is supported to string and vector type, plus
@@ -34438,7 +34438,7 @@ is an object of a structure type which has a static function
 then
 .code make-like
 calls that function, passing to it, and the resulting value is returned.
-.meta list
+.meta seq
 and returns whatever value that function returns.
 
 If
@@ -34484,10 +34484,10 @@ The result of
 .code seq-like
 is consistent with what the
 .code make-like
-function would return if given a list of the
+function would return if given a sequence of the
 .meta arg
 values as the
-.meta list
+.meta seq
 argument. That is to say, the following equivalence holds:
 
 .verb
-- 
cgit v1.2.3