diff options
author | dos-reis <gdr@axiomatics.org> | 2008-08-02 10:21:14 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2008-08-02 10:21:14 +0000 |
commit | c129ad817cd16aef92f5b433a509e15254b9ccd3 (patch) | |
tree | 006c41bd43cfeea3a3a85e007f2e2efbb6b9a410 /src/boot/strap | |
parent | ed7ceb86d0c98c28c2dc545c3fc20594d6c325df (diff) | |
download | open-axiom-c129ad817cd16aef92f5b433a509e15254b9ccd3.tar.gz |
* boot/parser.boot (bpTerm): Term forms depend on the kind of
variable.
(bpTypeItem): New.
(bpTypeItemList): Use it.
(bpTypeAliasDefition): Tidy.
(bpCaseItem): Accept wildchars in pattern terms.
* boot/ast.boot (bfCompDef): Don't name unused pattern variables.
(bfSmintable): A character compares EQL.
(bfCI): Ignore wildcard pattern variables.
* boot/strap: Update cached Lisp translation.
Diffstat (limited to 'src/boot/strap')
-rw-r--r-- | src/boot/strap/ast.clisp | 23 | ||||
-rw-r--r-- | src/boot/strap/includer.clisp | 2 | ||||
-rw-r--r-- | src/boot/strap/parser.clisp | 22 | ||||
-rw-r--r-- | src/boot/strap/scanner.clisp | 4 |
4 files changed, 30 insertions, 21 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index fdfc2f47..8f1b5b77 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -96,8 +96,8 @@ (DEFUN |SuchThat| #0=(|bfVar#51|) (CONS '|SuchThat| (LIST . #0#))) -(DEFUN |Assignment| #0=(|bfVar#52| |bfVar#53|) - (CONS '|Assignment| (LIST . #0#))) +(DEFUN |%Assignment| #0=(|bfVar#52| |bfVar#53|) + (CONS '|%Assignment| (LIST . #0#))) (DEFUN |While| #0=(|bfVar#54|) (CONS '|While| (LIST . #0#))) @@ -229,9 +229,7 @@ (SETQ |bfVar#78| |x|) (SETQ |bfVar#79| (CDR |bfVar#78|)) (CASE (CAR |bfVar#78|) - (|ConstantDefinition| - (LET ((|n| (CAR |bfVar#79|)) (|e| (CADR |bfVar#79|))) - |x|)) + (|ConstantDefinition| |x|) (T (COND ((AND (CONSP |x|) (PROGN @@ -1252,7 +1250,8 @@ (AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|)))) (DEFUN |bfSmintable| (|x|) - (OR (INTEGERP |x|) (AND (CONSP |x|) (MEMQ (CAR |x|) '(SIZE LENGTH))))) + (OR (INTEGERP |x|) + (AND (CONSP |x|) (MEMBER (CAR |x|) '(SIZE LENGTH |char|))))) (DEFUN |bfQ| (|l| |r|) (COND @@ -2119,12 +2118,16 @@ (PROGN (SETQ |i| (CAR |bfVar#126|)) NIL)) (RETURN (NREVERSE |bfVar#127|))) ('T - (SETQ |bfVar#127| - (CONS (LIST |i| (|bfCARCDR| |j| |g|)) - |bfVar#127|)))) + (AND (NOT (EQ |i| 'DOT)) + (SETQ |bfVar#127| + (CONS + (LIST |i| (|bfCARCDR| |j| |g|)) + |bfVar#127|))))) (SETQ |bfVar#126| (CDR |bfVar#126|)) (SETQ |j| (+ |j| 1))))) - (LIST (CAR |x|) (LIST 'LET |b| |y|)))))))) + (COND + ((NULL |b|) (LIST (CAR |x|) |y|)) + ('T (LIST (CAR |x|) (LIST 'LET |b| |y|)))))))))) (DECLAIM (FTYPE (FUNCTION (|%Short| |%Thing|) |%List|) |bfCARCDR|)) diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp index c4a036de..8fb93c82 100644 --- a/src/boot/strap/includer.clisp +++ b/src/boot/strap/includer.clisp @@ -273,7 +273,7 @@ (DEFUN |shoePlainLine?| (|s|) (COND ((EQL (LENGTH |s|) 0) T) - ('T (NOT (EQUAL (ELT |s| 0) (|char| '|)|)))))) + ('T (NOT (EQL (ELT |s| 0) (|char| '|)|)))))) (DEFUN |shoeSay?| (|s|) (|shoePrefix?| ")say" |s|)) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 2e23da3f..9cd82f72 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -495,8 +495,8 @@ (#0# NIL))) (DEFUN |bpTypeAliasDefition| () - (AND (OR (|bpTerm|) (|bpTrap|)) (|bpEqKey| 'TDEF) (|bpLogical|) - (|bpPush| (|%TypeAlias| (|bpPop2|) (|bpPop1|))))) + (AND (OR (|bpTerm| #'|bpIdList|) (|bpTrap|)) (|bpEqKey| 'TDEF) + (|bpLogical|) (|bpPush| (|%TypeAlias| (|bpPop2|) (|bpPop1|))))) (DEFUN |bpSignature| () (AND (|bpName|) (|bpEqKey| 'COLON) (|bpMapping|) @@ -1144,13 +1144,15 @@ (DEFUN |bpTypeList| () (OR (|bpPileBracketed| #'|bpTypeItemList|) - (AND (|bpTerm|) (|bpPush| (LIST (|bpPop1|)))))) + (AND (|bpTerm| #'|bpIdList|) (|bpPush| (LIST (|bpPop1|)))))) -(DEFUN |bpTypeItemList| () (|bpListAndRecover| #'|bpTerm|)) +(DEFUN |bpTypeItem| () (|bpTerm| #'|bpIdList|)) -(DEFUN |bpTerm| () +(DEFUN |bpTypeItemList| () (|bpListAndRecover| #'|bpTypeItem|)) + +(DEFUN |bpTerm| (|idListParser|) (OR (AND (OR (|bpName|) (|bpTrap|)) - (OR (AND (|bpParenthesized| #'|bpIdList|) + (OR (AND (|bpParenthesized| |idListParser|) (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|)))) (AND (|bpName|) (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|)))))) @@ -1168,8 +1170,12 @@ (DEFUN |bpCaseItemList| () (|bpListAndRecover| #'|bpCaseItem|)) +(DEFUN |bpCasePatternVar| () (OR (|bpName|) (|bpDot|))) + +(DEFUN |bpCasePatternVarList| () (|bpTuple| #'|bpCasePatternVar|)) + (DEFUN |bpCaseItem| () - (AND (OR (|bpTerm|) (|bpTrap|)) (OR (|bpEqKey| 'EXIT) (|bpTrap|)) - (OR (|bpWhere|) (|bpTrap|)) + (AND (OR (|bpTerm| #'|bpCasePatternVarList|) (|bpTrap|)) + (OR (|bpEqKey| 'EXIT) (|bpTrap|)) (OR (|bpWhere|) (|bpTrap|)) (|bpPush| (|bfCaseItem| (|bpPop2|) (|bpPop1|))))) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 5e527e50..b6eae196 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -2,10 +2,10 @@ (IMPORT-MODULE "includer") -(PROVIDE "scanner") - (IN-PACKAGE "BOOTTRAN") +(PROVIDE "scanner") + (DEFUN |double| (|x|) (FLOAT |x| 1.0)) (DEFUN |dqUnit| (|s|) |