aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-04-23 07:00:16 +0000
committerdos-reis <gdr@axiomatics.org>2011-04-23 07:00:16 +0000
commit867516e089b95f4495fd345aeda3fd5e40b76839 (patch)
tree6ddef57e11df66557cabf7f5360546b657bb7b45
parent91d664eb6380ea490a6d30d0230f907a613652d3 (diff)
downloadopen-axiom-867516e089b95f4495fd345aeda3fd5e40b76839.tar.gz
* boot/ast.boot (bf0APPEND): Remove.
(bf0COLLECT): Likewise. (bfCollect): Tidy.
-rw-r--r--src/ChangeLog6
-rw-r--r--src/boot/ast.boot15
-rw-r--r--src/boot/strap/ast.clisp24
3 files changed, 13 insertions, 32 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index f2dfe950..d309a18d 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,11 @@
2011-04-23 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * boot/ast.boot (bf0APPEND): Remove.
+ (bf0COLLECT): Likewise.
+ (bfCollect): Tidy.
+
+2011-04-23 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* lisp/core.lisp.in: Export basic types and compiler data types.
* interp/modemap.boot (knownInfo): Fix latent bug uncovered by
type declarations.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 2fee3a7a..e7a6f85e 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -368,22 +368,11 @@ bfDTuple x ==
["DTUPLE",x]
bfCollect(y,itl) ==
- y is ["COLON",a] => bf0APPEND(a,itl)
+ y is ["COLON",a] => bfListReduce('APPEND,['reverse,a],itl)
y is ["TUPLE",:.] =>
- newBody := bfConstruct y
- bf0APPEND(newBody,itl)
- bf0COLLECT(y,itl)
-
-bf0COLLECT(y,itl) ==
+ bfListReduce('APPEND,['reverse,bfConstruct y],itl)
bfListReduce('CONS,y,itl)
-
-bf0APPEND(y,itl)==
- g := bfGenSymbol()
- body := ['SETQ,g,['APPEND,['reverse,y],g]]
- extrait := [[[g],[nil],[],[],[],[['reverse!,g]]]]
- bfLp2(extrait,itl,body)
-
bfListReduce(op,y,itl)==
g := bfGenSymbol()
body := ['SETQ,g,[op,y,g]]
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index c9805a04..cfd5f684 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -494,7 +494,7 @@
(DEFUN |bfDTuple| (|x|) (LIST 'DTUPLE |x|))
(DEFUN |bfCollect| (|y| |itl|)
- (PROG (|newBody| |a| |ISTMP#1|)
+ (PROG (|a| |ISTMP#1|)
(RETURN
(COND
((AND (CONSP |y|) (EQ (CAR |y|) 'COLON)
@@ -502,25 +502,11 @@
(SETQ |ISTMP#1| (CDR |y|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
(PROGN (SETQ |a| (CAR |ISTMP#1|)) T))))
- (|bf0APPEND| |a| |itl|))
+ (|bfListReduce| 'APPEND (LIST '|reverse| |a|) |itl|))
((AND (CONSP |y|) (EQ (CAR |y|) 'TUPLE))
- (SETQ |newBody| (|bfConstruct| |y|))
- (|bf0APPEND| |newBody| |itl|))
- (T (|bf0COLLECT| |y| |itl|))))))
-
-(DEFUN |bf0COLLECT| (|y| |itl|) (|bfListReduce| 'CONS |y| |itl|))
-
-(DEFUN |bf0APPEND| (|y| |itl|)
- (PROG (|extrait| |body| |g|)
- (RETURN
- (PROGN
- (SETQ |g| (|bfGenSymbol|))
- (SETQ |body|
- (LIST 'SETQ |g| (LIST 'APPEND (LIST '|reverse| |y|) |g|)))
- (SETQ |extrait|
- (LIST (LIST (LIST |g|) (LIST NIL) NIL NIL NIL
- (LIST (LIST '|reverse!| |g|)))))
- (|bfLp2| |extrait| |itl| |body|)))))
+ (|bfListReduce| 'APPEND (LIST '|reverse| (|bfConstruct| |y|))
+ |itl|))
+ (T (|bfListReduce| 'CONS |y| |itl|))))))
(DEFUN |bfListReduce| (|op| |y| |itl|)
(PROG (|extrait| |body| |g|)