aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-04-28 04:45:25 +0000
committerdos-reis <gdr@axiomatics.org>2011-04-28 04:45:25 +0000
commit9c53b933216af4ae6c7233384ace756572dcb597 (patch)
tree37fe3f4c12745a5c0d81f8fe2155708d54cfa6fc
parent0df2bba385eeeaf650b6c13b2f4b10f991929ec8 (diff)
downloadopen-axiom-9c53b933216af4ae6c7233384ace756572dcb597.tar.gz
* boot/ast.boot (bfReduceCollect): Delegate to bfDoCollect if
op is append or append!.
-rw-r--r--src/ChangeLog5
-rw-r--r--src/boot/ast.boot2
-rw-r--r--src/boot/strap/ast.clisp13
3 files changed, 17 insertions, 3 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index c76fe320..b8c36c5d 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,10 @@
2011-04-27 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * boot/ast.boot (bfReduceCollect): Delegate to bfDoCollect if
+ op is append or append!.
+
+2011-04-27 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* boot/ast.boot (bfCollect): Use bfDoCollect.
(bfListReduce): Remove.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index bc444a4e..15a720bc 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -351,6 +351,8 @@ bfReduceCollect(op,y)==
a :=
op is ["QUOTE",:.] => second op
op
+ a is "append!" => bfDoCollect(body,itl,'lastNode,'skipNil)
+ a is "append" => bfDoCollect(['copyList,body],itl,'lastNode,'skipNil)
op := bfReName a
init := a has SHOETHETA or op has SHOETHETA
bfOpReduce(op,init,body,itl)
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index c4249a0d..9597b66d 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -484,9 +484,16 @@
((AND (CONSP |op|) (EQ (CAR |op|) 'QUOTE))
(CADR |op|))
(T |op|)))
- (SETQ |op| (|bfReName| |a|))
- (SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA)))
- (|bfOpReduce| |op| |init| |body| |itl|))
+ (COND
+ ((EQ |a| '|append!|)
+ (|bfDoCollect| |body| |itl| '|lastNode| '|skipNil|))
+ ((EQ |a| '|append|)
+ (|bfDoCollect| (LIST '|copyList| |body|) |itl| '|lastNode|
+ '|skipNil|))
+ (T (SETQ |op| (|bfReName| |a|))
+ (SETQ |init|
+ (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA)))
+ (|bfOpReduce| |op| |init| |body| |itl|))))
(T (SETQ |seq|
(COND ((NULL |y|) (|bfTuple| NIL)) (T (CADR |y|))))
(|bfReduce| |op| (|bfTupleConstruct| |seq|)))))))