aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap/ast.clisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/strap/ast.clisp')
-rw-r--r--src/boot/strap/ast.clisp27
1 files changed, 25 insertions, 2 deletions
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|))