aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog13
-rw-r--r--src/boot/ast.boot7
-rw-r--r--src/boot/parser.boot23
-rw-r--r--src/boot/strap/ast.clisp23
-rw-r--r--src/boot/strap/includer.clisp2
-rw-r--r--src/boot/strap/parser.clisp22
-rw-r--r--src/boot/strap/scanner.clisp4
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|)