* 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.

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|)