From c129ad817cd16aef92f5b433a509e15254b9ccd3 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sat, 2 Aug 2008 10:21:14 +0000
Subject: 	* 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.

---
 src/boot/strap/ast.clisp      | 23 +++++++++++++----------
 src/boot/strap/includer.clisp |  2 +-
 src/boot/strap/parser.clisp   | 22 ++++++++++++++--------
 src/boot/strap/scanner.clisp  |  4 ++--
 4 files changed, 30 insertions(+), 21 deletions(-)

(limited to 'src/boot/strap')

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|)
-- 
cgit v1.2.3