1 files changed, 29 insertions, 38 deletions
diff --git a/share/txr/stdlib/build.tl b/share/txr/stdlib/build.tl
index 41826255..2c9f97ca 100644
--- a/share/txr/stdlib/build.tl
+++ b/share/txr/stdlib/build.tl
@@ -32,59 +32,50 @@
          bc.tail bc.head))
 
   (:method add (self . items)
-    (let ((tl self.tail))
-      (usr:rplacd tl (copy-list (cdr tl)))
-      (set tl (last tl))
-      (usr:rplacd tl items)
+    (let ((st self.tail))
+      (rplacd st (append (cdr st) nil)))
+    (let ((tl (last self.tail)))
+      (usr:rplacd tl (append (cdr tl) items))
       (set self.tail tl))
     nil)
 
   (:method add* (self . items)
-    (let ((ic (copy-list items))
-          (h self.head))
-      (usr:rplacd (last ic) (cdr h))
-      (usr:rplacd h ic))
+    (let ((h self.head))
+      (usr:rplacd h (append items (cdr h))))
     nil)
 
   (:method pend (self . lists)
-    (let ((tl self.tail))
-      (while lists
-        (usr:rplacd tl (copy-list (cdr tl)))
-        (set tl (last tl))
-        (let ((nx (car lists)))
-          (usr:rplacd tl (if (tailp tl nx)
-                           (copy-list nx)
-                           nx)))
-        (set lists (cdr lists)))
-      (set self.tail tl))
-    nil)
+    (when lists
+      (let ((st self.tail))
+        (rplacd st (append (cdr st) nil)))
+      (let* ((tl (last self.tail))
+             (cp (let ((ll (car (last lists))))
+                   (if (consp ll)
+                     (let ((lt (last ll)))
+                       (eq tl lt)))))
+             (nl [apply append lists]))
+        (usr:rplacd tl (append (cdr tl) (if cp (copy-list nl) nl)))
+        (set self.tail tl))
+      nil))
 
   (:method pend* (self . lists)
-    (let* ((h (cdr self.head))
-           (nh (cons nil nil))
-           (tl nh))
-      (while lists
-        (usr:rplacd tl (copy-list (cdr tl)))
-        (set tl (last tl))
-        (usr:rplacd tl (car lists))
-        (set lists (cdr lists)))
-      (set tl (last tl))
-      (usr:rplacd tl (if (tailp tl h) (copy-list h) h))
-      (set self.head nh))
+    (let* ((h self.head)
+           (pf [apply apply (append lists (list (cdr h)))]))
+      (usr:rplacd h pf)
+      (set self.tail self.head))
     nil)
 
   (:method ncon (self . lists)
-    (let ((tl self.tail))
-      (while lists
-        (set tl (last tl))
-        (usr:rplacd tl (car lists))
-        (set lists (cdr lists)))
-      (set self.tail tl))
-    nil)
+    (when lists
+      (let* ((tl (last self.tail))
+             (nl [apply nconc lists]))
+        (usr:rplacd tl (nconc (cdr tl) nl))
+        (set self.tail tl))
+      nil))
 
   (:method ncon* (self . lists)
     (let* ((h self.head)
-           (pf (nconc (nconc . lists) (cdr h))))
+           (pf [apply nconc (append lists (list (cdr h)))]))
       (usr:rplacd h pf)
       (if (eq self.tail h)
         (set self.tail pf)))