From fb09dfc8559a5b01c75b691613cf9eda54f7bee5 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 27 Feb 2024 21:08:14 -0800
Subject: seq_build: support improper lists.

To be useful for some operations, the seq_build framework
must handle the pend operation on lists specially.
The appended piece must only be treated as a sequence if
it is a cons. Moreover, if it is an atom, or of it is
an improper list, then the list terminates. Subsequent
add and pend operations must fail. The atom must appear
as the terminator. We meet these objectives by switching
the object's operations, sb_list_ops, to a new set of
operations, sb_improper_ops.

* lib.c (seq_build_list_pend): New static function.
This individually adds all items from the input
list, until it hits a terminating atom. If the
atom isn't nil, it converts the seq_build_t object
to improper operations.
(seq_build_improper_add, seq_build_improper_pend):
New static functions. These throw an error:
adding anything to an improper list is impossible.
(seq_build_improper_finish): New function, which
does nothing: the improper list is finished already.
(sb_list_ops): Use the seq_build_list_pend operation
rather than the generic one.
(sb_improper_ops): New static structure.
(seq_build_convert_to_improper): New static function.
Finishes the list, giving it the specified terminating
atom, and then switches to sb_improper_ops so that
adding is no longer possible.
---
 lib.c | 54 +++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 53 insertions(+), 1 deletion(-)

(limited to 'lib.c')

diff --git a/lib.c b/lib.c
index 11c579c2..26eb8d45 100644
--- a/lib.c
+++ b/lib.c
@@ -1489,6 +1489,19 @@ static void seq_build_list_add(seq_build_t *bu, val item)
   }
 }
 
+static void seq_build_convert_to_improper(seq_build_t *bu, val atom);
+
+static void seq_build_list_pend(seq_build_t *bu, val item)
+{
+  while (consp(item)) {
+    seq_build_list_add(bu, us_car(item));
+    item = us_cdr(item);
+  }
+
+  if (item)
+    seq_build_convert_to_improper(bu, item);
+}
+
 static void seq_build_list_finish(seq_build_t *bu)
 {
   val obj = bu->obj;
@@ -1512,6 +1525,25 @@ static void seq_build_carray_finish(seq_build_t *bu)
   bu->obj = carray_list(bu->obj, bu->u.carray_type, nil);
 }
 
+static void seq_build_improper_add(seq_build_t *bu, val item)
+{
+  val atom = butlastn(zero, bu->obj);
+  (void) item;
+  uw_throwf(error_s, lit("~a: cannot add after atom ~s"), bu->self, atom, nao);
+}
+
+static void seq_build_improper_pend(seq_build_t *bu, val item)
+{
+  val atom = butlastn(zero, bu->obj);
+  (void) item;
+  uw_throwf(error_s, lit("~a: cannot append after atom ~s"), bu->self, atom, nao);
+}
+
+static void seq_build_improper_finish(seq_build_t *bu)
+{
+  (void) bu;
+}
+
 static struct seq_build_ops
   sb_vec_ops = seq_build_ops_init(seq_build_vec_add,
                                   seq_build_generic_pend,
@@ -1544,10 +1576,16 @@ static struct seq_build_ops
 
 static struct seq_build_ops
   sb_list_ops = seq_build_ops_init(seq_build_list_add,
-                                   seq_build_generic_pend,
+                                   seq_build_list_pend,
                                    seq_build_list_finish,
                                    seq_build_obj_mark);
 
+static struct seq_build_ops
+  sb_improper_ops = seq_build_ops_init(seq_build_improper_add,
+                                       seq_build_improper_pend,
+                                       seq_build_improper_finish,
+                                       seq_build_obj_mark);
+
 static void seq_build_convert_to_list(seq_build_t *bu, val list)
 {
   if (list) {
@@ -1561,6 +1599,20 @@ static void seq_build_convert_to_list(seq_build_t *bu, val list)
   bu->ops = &sb_list_ops;
 }
 
+static void seq_build_convert_to_improper(seq_build_t *bu, val atom)
+{
+  val obj = bu->obj;
+
+  if (obj) {
+    val head = us_cdr(obj);
+    us_rplacd(obj, atom);
+    bu->obj = head;
+  } else {
+    bu->obj = atom;
+  }
+
+  bu->ops = &sb_improper_ops;
+}
 
 void seq_build_init(val self, seq_build_t *bu, val likeobj)
 {
-- 
cgit v1.2.3