diff options
| author | dos-reis <gdr@axiomatics.org> | 2011-12-10 18:54:17 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2011-12-10 18:54:17 +0000 |
| commit | 49fc7b2f58f56ea7c9aa8169be3dfcc22b818be2 (patch) | |
| tree | b9475624cbe821fff9753a08ef614396ffe8f2e4 /src/boot/strap/translator.clisp | |
| parent | 1bee5e2ddcac5cd3a168f5f70a754fd8bee34021 (diff) | |
| download | open-axiom-49fc7b2f58f56ea7c9aa8169be3dfcc22b818be2.tar.gz | |
* boot/parser.boot (bpArgtypeList): Accept mapping types.
* boot/ast.boot (bfType): New.
* boot/translator.boot (genDeclaration): Use it.
* boot/utility.boot (every?): New. Export.
(any?): Likewise.
(takeWhile): Lilkewise.
Diffstat (limited to 'src/boot/strap/translator.clisp')
| -rw-r--r-- | src/boot/strap/translator.clisp | 20 |
1 files changed, 4 insertions, 16 deletions
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 9abbe2ca..4294b1ba 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -484,23 +484,11 @@ ((NULL |$stack|) (|bpGeneralErrorHere|) NIL) (T (CAR |$stack|))))))) (DEFUN |genDeclaration| (|n| |t|) - (PROG (|t'| |vars| |argTypes| |ISTMP#2| |valType| |ISTMP#1|) + (PROG (|t'| |ISTMP#2| |vars| |ISTMP#1|) (RETURN (COND - ((AND (CONSP |t|) (EQ (CAR |t|) '|%Mapping|) - (PROGN - (SETQ |ISTMP#1| (CDR |t|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |valType| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |argTypes| (CAR |ISTMP#2|)) T)))))) - (COND ((|bfTupleP| |argTypes|) (SETQ |argTypes| (CDR |argTypes|)))) - (COND - ((AND |argTypes| (SYMBOLP |argTypes|)) - (SETQ |argTypes| (LIST |argTypes|)))) - (LIST 'DECLAIM (LIST 'FTYPE (LIST 'FUNCTION |argTypes| |valType|) |n|))) + ((AND (CONSP |t|) (EQ (CAR |t|) '|%Mapping|)) + (LIST 'DECLAIM (LIST 'FTYPE (|bfType| |t|) |n|))) ((AND (CONSP |t|) (EQ (CAR |t|) '|%Forall|) (PROGN (SETQ |ISTMP#1| (CDR |t|)) @@ -533,7 +521,7 @@ (SETQ |bfVar#3| (CDR |bfVar#3|)))) (SETQ |bfVar#1| (CDR |bfVar#1|)))) |t'|))))) - (T (LIST 'DECLAIM (LIST 'TYPE |t| |n|))))))) + (T (LIST 'DECLAIM (LIST 'TYPE (|bfType| |t|) |n|))))))) (DEFUN |translateSignatureDeclaration| (|d|) (CASE (CAR |d|) |