diff options
author | dos-reis <gdr@axiomatics.org> | 2011-04-23 07:00:16 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-04-23 07:00:16 +0000 |
commit | 867516e089b95f4495fd345aeda3fd5e40b76839 (patch) | |
tree | 6ddef57e11df66557cabf7f5360546b657bb7b45 | |
parent | 91d664eb6380ea490a6d30d0230f907a613652d3 (diff) | |
download | open-axiom-867516e089b95f4495fd345aeda3fd5e40b76839.tar.gz |
* boot/ast.boot (bf0APPEND): Remove.
(bf0COLLECT): Likewise.
(bfCollect): Tidy.
-rw-r--r-- | src/ChangeLog | 6 | ||||
-rw-r--r-- | src/boot/ast.boot | 15 | ||||
-rw-r--r-- | src/boot/strap/ast.clisp | 24 |
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|) |