From 8fdc890bfaae2df85d5437d9ae495c45a54645c4 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 3 Sep 2019 23:30:22 -0700
Subject: list-builder: bugfix: broken self-appending.

The list builder is failing on the documented example

  (build
    (add 1 2)
    (pend (get))
    (pend (get)))
  -> (1 2 1 2 1 2 1 2)

wrongly constructing an infinite list.

* share/txr/stdlib/build.tl (list-builder pend): When
destructively appending the next argument, check whether
the current tail is a tail of that object. If so, copy
the object to prevent a cycle from forming.
(list-builder pend*): When appending the old head to the
catenated list, do the tail check and copy the object if
necessary to prevent the creation of a cycle.
---
 share/txr/stdlib/build.tl | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/share/txr/stdlib/build.tl b/share/txr/stdlib/build.tl
index 32df083d..a5960578 100644
--- a/share/txr/stdlib/build.tl
+++ b/share/txr/stdlib/build.tl
@@ -51,22 +51,25 @@
       (while lists
         (usr:rplacd tl (copy (cdr tl)))
         (set tl (last tl))
-        (usr:rplacd tl (car lists))
+        (let ((nx (car lists)))
+          (usr:rplacd tl (if (tailp tl nx)
+                           (copy nx)
+                           nx)))
         (set lists (cdr lists)))
       (set self.tail tl))
     nil)
 
   (:method pend* (self . lists)
-    (let* ((h self.head)
+    (let* ((h (cdr self.head))
            (nh (cons nil nil))
            (tl nh))
       (while lists
-        (usr:rplacd tl (copy tl))
+        (usr:rplacd tl (copy (cdr tl)))
         (set tl (last tl))
         (usr:rplacd tl (car lists))
         (set lists (cdr lists)))
       (set tl (last tl))
-      (usr:rplacd tl (cdr h))
+      (usr:rplacd tl (if (tailp tl h) (copy h) h))
       (set self.head nh))
     nil)
 
-- 
cgit v1.2.3