* boot/ast.boot (bfAppend): Write in full.

	* interp/ptrees.boot (pfAppend): Likewise.

6 files changed, 66 insertions, 9 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 9fd9d5a5..f0942507 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,10 @@
 2011-04-30  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* boot/ast.boot (bfAppend): Write in full.
+	* interp/ptrees.boot (pfAppend): Likewise.
+
+2011-04-30  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/vmlisp.lisp (NREMOVE): Remove.
 	(EFFACE): Likewise.
 	* interp/sys-utility.boot (remove!): New.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index ab945fd0..bb1b9819 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -160,9 +160,16 @@ bfPile: %List %Form -> %List %Form
 bfPile(part) == 
   part
  
-bfAppend: %List %Form -> %Form
-bfAppend x== 
-  apply(function append,x)
+bfAppend: %List %List %List %Form -> %List %Form
+bfAppend ls ==
+  ls isnt [l,:ls] => nil
+  r := copyList l
+  p := r
+  repeat
+    ls isnt [l,:ls] => return r
+    l = nil => nil
+    lastNode(p).rest := copyList l
+    p := rest p
  
 bfColonAppend: (%List %Form,%Form) -> %Form
 bfColonAppend(x,y) ==
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 67d31787..081dab12 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -194,9 +194,32 @@
 
 (DEFUN |bfPile| (|part|) |part|)
 
-(DECLAIM (FTYPE (FUNCTION ((|%List| |%Form|)) |%Form|) |bfAppend|))
+(DECLAIM (FTYPE (FUNCTION ((|%List| (|%List| (|%List| |%Form|))))
+                    (|%List| |%Form|))
+                |bfAppend|))
 
-(DEFUN |bfAppend| (|x|) (APPLY #'APPEND |x|))
+(DEFUN |bfAppend| (|ls|)
+  (PROG (|p| |r| |l|)
+    (RETURN
+      (COND
+        ((NOT (AND (CONSP |ls|)
+                   (PROGN
+                     (SETQ |l| (CAR |ls|))
+                     (SETQ |ls| (CDR |ls|))
+                     T)))
+         NIL)
+        (T (SETQ |r| (|copyList| |l|)) (SETQ |p| |r|)
+           (LOOP
+             (COND
+               ((NOT (AND (CONSP |ls|)
+                          (PROGN
+                            (SETQ |l| (CAR |ls|))
+                            (SETQ |ls| (CDR |ls|))
+                            T)))
+                (RETURN |r|))
+               ((NULL |l|) NIL)
+               (T (RPLACD (|lastNode| |p|) (|copyList| |l|))
+                  (SETQ |p| (CDR |p|))))))))))
 
 (DECLAIM (FTYPE (FUNCTION ((|%List| |%Form|) |%Form|) |%Form|)
                 |bfColonAppend|))
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 48ac0037..2d531fd2 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -11,8 +11,19 @@
              |setDifference| |applySubst| |applySubst!| |remove|
              |removeSymbol|))
 
-(DECLAIM (FTYPE (FUNCTION ((|%List| |%Symbol|) |%Symbol|)
-                    (|%List| |%Symbol|))
+(DECLAIM (FTYPE (FUNCTION ((|%List| (|%List| |%Thing|)))
+                    (|%List| |%Thing|))
+                |append!|))
+
+(DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|)) (|%List| |%Thing|))
+                |copyList|))
+
+(DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|))
+                    (|%Maybe| (|%Node| |%Thing|)))
+                |lastNode|))
+
+(DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) |%Symbol|)
+                    (|%List| |%Thing|))
                 |removeSymbol|))
 
 (DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) |%Thing|)
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index c24ed738..101b10e3 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -36,6 +36,9 @@ module utility (objectMember?, symbolMember?, stringMember?,
   charMember?, scalarMember?, listMember?, reverse, reverse!,
   lastNode, append!, copyList, substitute, substitute!, setDifference,
   applySubst, applySubst!,remove,removeSymbol) where
+    append!: %List %List %Thing -> %List %Thing
+    copyList: %List %Thing -> %List %Thing
+    lastNode: %List %Thing -> %Maybe %Node %Thing
     removeSymbol: (%List %Thing, %Symbol) -> %List %Thing
     remove: (%List %Thing, %Thing) ->% List %Thing
 
diff --git a/src/interp/ptrees.boot b/src/interp/ptrees.boot
index cbd4ac4f..4ec6f7e5 100644
--- a/src/interp/ptrees.boot
+++ b/src/interp/ptrees.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -60,7 +60,15 @@ structure %Ast ==
 --% SPECIAL NODES
 pfListOf x          == pfTree('listOf,x)
 pfListOf? x         == pfAbSynOp?(x,'listOf)
-pfAppend list       == apply(function append,list)
+pfAppend ls ==
+  ls isnt [l,:ls] => nil
+  r := copyList l
+  p := r
+  repeat
+    ls isnt [l,:ls] => return r
+    l = nil => nil
+    lastNode(p).rest := copyList l
+    p := rest p
 
 pfNothing ()        == pfTree('nothing, [])
 pfNothing? form     == pfAbSynOp?(form, 'nothing)