diff options
| -rw-r--r-- | src/ChangeLog | 13 | ||||
| -rw-r--r-- | src/boot/ast.boot | 7 | ||||
| -rw-r--r-- | src/boot/parser.boot | 23 | ||||
| -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 |
7 files changed, 64 insertions, 30 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 29ed0049..cb41c8e3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,16 @@ +2008-08-02 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * 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. + 2008-08-01 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/macros.lisp (sayBrightlyNT1): Tidy. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index e42b0a7b..3e026fbf 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -201,7 +201,7 @@ bfMDefinition(bflhsitems, bfrhs,body) == bfCompDef: %Thing -> %List bfCompDef x == case x of - ConstantDefinition(n, e) => x + ConstantDefinition(.,.) => x otherwise => x is [def, op, args, body] => bfDef(def,op,args,body) @@ -781,7 +781,7 @@ defQuoteId x== EQCAR(x,"QUOTE") and IDENTP second x bfSmintable x== INTEGERP x or CONSP x and - MEMQ(first x, '(SIZE LENGTH)) + first x in '(SIZE LENGTH char) bfQ(l,r)== if bfSmintable l or bfSmintable r @@ -1167,7 +1167,8 @@ bfCI(g,x,y)== if null a then [first x,y] else - b:=[[i,bfCARCDR(j,g)] for i in a for j in 0..] + b:=[[i,bfCARCDR(j,g)] for i in a for j in 0.. | i ^= "DOT"] + null b => [first x,y] [first x,["LET",b,y]] bfCARCDR: (%Short,%Thing) -> %List diff --git a/src/boot/parser.boot b/src/boot/parser.boot index abb743f7..87ade687 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -473,7 +473,7 @@ bpImport() == -- type-alias-definition: -- identifier <=> logical-expression bpTypeAliasDefition() == - (bpTerm() or bpTrap()) and + (bpTerm function bpIdList or bpTrap()) and bpEqKey "TDEF" and bpLogical() and bpPush %TypeAlias(bpPop2(), bpPop1()) @@ -1110,13 +1110,17 @@ bpStruct()== bpTypeList() and bpPush bfStruct(bpPop2(),bpPop1()) bpTypeList() == bpPileBracketed function bpTypeItemList - or bpTerm() and bpPush [bpPop1()] + or bpTerm function bpIdList and bpPush [bpPop1()] + +bpTypeItem() == + bpTerm function bpIdList -bpTypeItemList() == bpListAndRecover function bpTerm +bpTypeItemList() == + bpListAndRecover function bpTypeItem -bpTerm() == +bpTerm idListParser == (bpName() or bpTrap()) and - ((bpParenthesized function bpIdList and + ((bpParenthesized idListParser and bpPush bfNameArgs (bpPop2(),bpPop1())) or bpName() and bpPush bfNameArgs(bpPop2(),bpPop1())) or bpPush(bfNameOnly bpPop1()) @@ -1132,11 +1136,18 @@ bpCase()== bpPiledCaseItems()== bpPileBracketed function bpCaseItemList and bpPush bfCase(bpPop2(),bpPop1()) + bpCaseItemList()== bpListAndRecover function bpCaseItem + +bpCasePatternVar() == + bpName() or bpDot() + +bpCasePatternVarList() == + bpTuple function bpCasePatternVar bpCaseItem()== - (bpTerm() or bpTrap()) and + (bpTerm function bpCasePatternVarList or bpTrap()) and (bpEqKey "EXIT" or bpTrap()) and (bpWhere() or bpTrap()) and bpPush bfCaseItem (bpPop2(),bpPop1()) 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|) |