From 2884891ad09003743454e676831f07df38c17da0 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 11 Jul 2018 06:50:13 -0700
Subject: list-build: rewrite methods for semantics & efficiency.

The list builder needlessly copies list structure. At
any given moment, the last piece of structure added to
the list can remain shared. We can leave the tail
pointing to that piece and copy it later in a nondestructive
operation.

Also, we would like (build (add 1) (pend 2)) to produce
(1 . 2) rather than an errror. The implementation gives this
to us in the same stroke.

* share/txr/stdlib/build.tl (list-builder :postinit): Just
initialize tail to be head, rather than eagerly chasing to the
last cons.
(list-builder add, list-builder pend, list-builder pend*,
list-builder ncon, list-builder ncon*): Rewrite.
---
 share/txr/stdlib/build.tl | 38 ++++++++++++++++++++++++++++----------
 1 file changed, 28 insertions(+), 10 deletions(-)

diff --git a/share/txr/stdlib/build.tl b/share/txr/stdlib/build.tl
index 6fc3c83b..76d0fa2c 100644
--- a/share/txr/stdlib/build.tl
+++ b/share/txr/stdlib/build.tl
@@ -29,10 +29,14 @@
 
   (:postinit (bc)
     (set bc.head (cons nil bc.head)
-         bc.tail (last bc.head)))
+         bc.tail bc.head))
 
   (:method add (self . items)
-    (set self.tail (last (usr:rplacd self.tail (copy items)))))
+    (let ((tl self.tail))
+      (usr:rplacd tl (copy (cdr tl)))
+      (set tl (last tl))
+      (usr:rplacd tl items)
+      (set self.tail tl)))
 
   (:method add* (self . items)
     (let ((ic (copy items))
@@ -41,28 +45,42 @@
       (usr:rplacd h ic)))
 
   (:method pend (self . lists)
-    (while lists
-      (set self.tail (last (usr:rplacd self.tail (copy (car lists)))))
-      (set lists (cdr lists))))
+    (let ((tl self.tail))
+      (while lists
+        (usr:rplacd tl (copy (cdr tl)))
+        (set tl (last tl))
+        (usr:rplacd tl (car lists))
+        (set lists (cdr lists)))
+      (set self.tail tl)))
 
   (:method pend* (self . lists)
     (let* ((h self.head)
            (nh (cons nil nil))
            (tl nh))
       (while lists
-        (set tl (last (usr:rplacd tl (copy (car lists)))))
+        (usr:rplacd tl (copy tl))
+        (set tl (last tl))
+        (usr:rplacd tl (car lists))
         (set lists (cdr lists)))
+
+      (set tl (last tl))
       (usr:rplacd tl (cdr h))
       (set self.head nh)))
 
   (:method ncon (self . lists)
-    (set self.tail (last (usr:rplacd self.tail (nconc . lists)))))
+    (let ((tl self.tail))
+      (while lists
+        (set tl (last tl))
+        (usr:rplacd tl (car lists))
+        (set lists (cdr lists)))
+      (set self.tail tl)))
 
   (:method ncon* (self . lists)
-    (let ((h self.head))
-      (set (cdr h) (nconc (nconc . lists) (cdr h)))
+    (let* ((h self.head)
+           (pf (nconc (nconc . lists) (cdr h))))
+      (usr:rplacd h pf)
       (if (eq self.tail h)
-        (set self.tail (last h)))))
+        (set self.tail pf))))
 
   (:method get (self)
     (cdr self.head)))
-- 
cgit v1.2.3