aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-08-02 10:21:14 +0000
committerdos-reis <gdr@axiomatics.org>2008-08-02 10:21:14 +0000
commitc129ad817cd16aef92f5b433a509e15254b9ccd3 (patch)
tree006c41bd43cfeea3a3a85e007f2e2efbb6b9a410 /src/boot/strap
parented7ceb86d0c98c28c2dc545c3fc20594d6c325df (diff)
downloadopen-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.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
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|)