aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2012-05-30 12:59:38 +0000
committerdos-reis <gdr@axiomatics.org>2012-05-30 12:59:38 +0000
commite978fdb127b726df8a04c4f7f1936b7eaf5e227b (patch)
tree80db8682b8946bf97766476e219e803f56e3f2f2 /src/boot
parent6c514c2fb12c51eeb5f7745c85736cdc97abfc7f (diff)
downloadopen-axiom-e978fdb127b726df8a04c4f7f1936b7eaf5e227b.tar.gz
* boot/parser.boot: Remove references to $bpCount.
* boot/translator.boot (shoeOutParse): Likewise.
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/parser.boot59
-rw-r--r--src/boot/strap/parser.clisp78
-rw-r--r--src/boot/strap/translator.clisp4
-rw-r--r--src/boot/translator.boot1
4 files changed, 72 insertions, 70 deletions
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 68a8d11f..7ec02edf 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -92,10 +92,10 @@ bpFirstTok ps ==
$ttok := tokenValue $stok
parserNesting ps > 0 and tokenClass $stok = "KEY" =>
$ttok is "SETTAB" =>
- $bpCount:=$bpCount+1
+ parserScope(ps) := parserScope ps + 1
bpNext ps
$ttok is "BACKTAB" =>
- $bpCount:=$bpCount-1
+ parserScope(ps) := parserScope ps - 1
bpNext ps
$ttok is "BACKSET" =>
bpNext ps
@@ -114,7 +114,7 @@ bpRequire(ps,f) ==
apply(f,ps,nil) or bpTrap()
bpState ps ==
- [parserTokens ps,parserTrees ps,parserNesting ps,$bpCount]
+ [parserTokens ps,parserTrees ps,parserNesting ps,parserScope ps]
bpRestore(ps,x)==
@@ -122,7 +122,7 @@ bpRestore(ps,x)==
bpFirstToken ps
parserTrees(ps) := second x
parserNesting(ps) := third x
- $bpCount:=CADDDR x
+ parserScope(ps) := CADDDR x
true
bpPush(ps,x) ==
@@ -147,29 +147,32 @@ bpPop3 ps ==
a
bpIndentParenthesized(ps,f) ==
- $bpCount:local:=0
- a:=$stok
- bpEqPeek "OPAREN" =>
- parserNesting(ps) := parserNesting ps + 1
- bpNext ps
- apply(f,ps,nil) and bpFirstTok ps and
- (bpEqPeek "CPAREN" or bpParenTrap(a)) =>
- parserNesting(ps) := parserNesting ps - 1
- bpNextToken ps
- $bpCount=0 => true
- parserTokens(ps) := append(bpAddTokens $bpCount,parserTokens ps)
- bpFirstToken ps
- parserNesting ps = 0 =>
- bpCancel ps
- true
- true
- bpEqPeek "CPAREN" =>
- bpPush(ps,bfTuple [])
- parserNesting(ps) := parserNesting ps - 1
- bpNextToken ps
- true
- bpParenTrap(a)
- false
+ scope := parserScope ps
+ try
+ parserScope(ps) := 0
+ a:=$stok
+ bpEqPeek "OPAREN" =>
+ parserNesting(ps) := parserNesting ps + 1
+ bpNext ps
+ apply(f,ps,nil) and bpFirstTok ps and
+ (bpEqPeek "CPAREN" or bpParenTrap(a)) =>
+ parserNesting(ps) := parserNesting ps - 1
+ bpNextToken ps
+ parserScope ps = 0 => true
+ parserTokens(ps) := append(bpAddTokens parserScope ps,parserTokens ps)
+ bpFirstToken ps
+ parserNesting ps = 0 =>
+ bpCancel ps
+ true
+ true
+ bpEqPeek "CPAREN" =>
+ bpPush(ps,bfTuple [])
+ parserNesting(ps) := parserNesting ps - 1
+ bpNextToken ps
+ true
+ bpParenTrap(a)
+ false
+ finally parserScope(ps) := scope
bpParenthesized(ps,f) ==
a := $stok
@@ -355,7 +358,7 @@ bpMoveTo(ps,n) ==
bpEqPeek "BACKTAB" =>
n=0 => true
bpNextToken ps
- $bpCount:=$bpCount-1
+ parserScope(ps) := parserScope ps - 1
bpMoveTo(ps,n-1)
bpEqPeek "BACKSET" =>
n=0 => true
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index cf7c652c..620207d2 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -65,7 +65,7 @@
T))
(DEFUN |bpFirstTok| (|ps|)
- (DECLARE (SPECIAL |$bpCount| |$ttok| |$stok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(PROGN
(SETQ |$stok|
(COND
@@ -76,9 +76,10 @@
(COND
((AND (PLUSP (|parserNesting| |ps|)) (EQ (|tokenClass| |$stok|) 'KEY))
(COND
- ((EQ |$ttok| 'SETTAB) (SETQ |$bpCount| (+ |$bpCount| 1)) (|bpNext| |ps|))
- ((EQ |$ttok| 'BACKTAB) (SETQ |$bpCount| (- |$bpCount| 1))
- (|bpNext| |ps|))
+ ((EQ |$ttok| 'SETTAB)
+ (SETF (|parserScope| |ps|) (+ (|parserScope| |ps|) 1)) (|bpNext| |ps|))
+ ((EQ |$ttok| 'BACKTAB)
+ (SETF (|parserScope| |ps|) (- (|parserScope| |ps|) 1)) (|bpNext| |ps|))
((EQ |$ttok| 'BACKSET) (|bpNext| |ps|)) (T T)))
(T T))))
@@ -95,18 +96,16 @@
(DEFUN |bpRequire| (|ps| |f|) (OR (APPLY |f| |ps| NIL) (|bpTrap|)))
(DEFUN |bpState| (|ps|)
- (DECLARE (SPECIAL |$bpCount|))
(LIST (|parserTokens| |ps|) (|parserTrees| |ps|) (|parserNesting| |ps|)
- |$bpCount|))
+ (|parserScope| |ps|)))
(DEFUN |bpRestore| (|ps| |x|)
- (DECLARE (SPECIAL |$bpCount|))
(PROGN
(SETF (|parserTokens| |ps|) (CAR |x|))
(|bpFirstToken| |ps|)
(SETF (|parserTrees| |ps|) (CADR |x|))
(SETF (|parserNesting| |ps|) (CADDR |x|))
- (SETQ |$bpCount| (CADDDR |x|))
+ (SETF (|parserScope| |ps|) (CADDDR |x|))
T))
(DEFUN |bpPush| (|ps| |x|)
@@ -138,34 +137,37 @@
|a|)))
(DEFUN |bpIndentParenthesized| (|ps| |f|)
- (LET* (|a|)
+ (LET* (|a| |scope|)
(DECLARE (SPECIAL |$stok|))
- (LET ((|$bpCount| 0))
- (DECLARE (SPECIAL |$bpCount|))
- (PROGN
- (SETQ |a| |$stok|)
- (COND
- ((|bpEqPeek| 'OPAREN)
- (SETF (|parserNesting| |ps|) (+ (|parserNesting| |ps|) 1))
- (|bpNext| |ps|)
- (COND
- ((AND (APPLY |f| |ps| NIL) (|bpFirstTok| |ps|)
- (OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|)))
- (SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
- (|bpNextToken| |ps|)
- (COND ((EQL |$bpCount| 0) T)
- (T
- (SETF (|parserTokens| |ps|)
- (|append| (|bpAddTokens| |$bpCount|)
- (|parserTokens| |ps|)))
- (|bpFirstToken| |ps|)
- (COND ((EQL (|parserNesting| |ps|) 0) (|bpCancel| |ps|) T)
- (T T)))))
- ((|bpEqPeek| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL))
- (SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
- (|bpNextToken| |ps|) T)
- (T (|bpParenTrap| |a|))))
- (T NIL))))))
+ (PROGN
+ (SETQ |scope| (|parserScope| |ps|))
+ (UNWIND-PROTECT
+ (PROGN
+ (SETF (|parserScope| |ps|) 0)
+ (SETQ |a| |$stok|)
+ (COND
+ ((|bpEqPeek| 'OPAREN)
+ (SETF (|parserNesting| |ps|) (+ (|parserNesting| |ps|) 1))
+ (|bpNext| |ps|)
+ (COND
+ ((AND (APPLY |f| |ps| NIL) (|bpFirstTok| |ps|)
+ (OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|)))
+ (SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
+ (|bpNextToken| |ps|)
+ (COND ((EQL (|parserScope| |ps|) 0) T)
+ (T
+ (SETF (|parserTokens| |ps|)
+ (|append| (|bpAddTokens| (|parserScope| |ps|))
+ (|parserTokens| |ps|)))
+ (|bpFirstToken| |ps|)
+ (COND ((EQL (|parserNesting| |ps|) 0) (|bpCancel| |ps|) T)
+ (T T)))))
+ ((|bpEqPeek| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL))
+ (SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
+ (|bpNextToken| |ps|) T)
+ (T (|bpParenTrap| |a|))))
+ (T NIL)))
+ (SETF (|parserScope| |ps|) |scope|)))))
(DEFUN |bpParenthesized| (|ps| |f|)
(LET* (|a|)
@@ -378,7 +380,7 @@
(COND (|done| (RETURN NIL))
(T
(SETQ |found|
- (LET ((#1=#:G719
+ (LET ((#1=#:G720
(CATCH :OPEN-AXIOM-CATCH-POINT
(APPLY |f| |ps| NIL))))
(COND
@@ -409,11 +411,11 @@
(|bpPush| |ps| (|reverse!| |b|)))))
(DEFUN |bpMoveTo| (|ps| |n|)
- (DECLARE (SPECIAL |$bpCount|))
(COND ((NULL (|parserTokens| |ps|)) T)
((|bpEqPeek| 'BACKTAB)
(COND ((EQL |n| 0) T)
- (T (|bpNextToken| |ps|) (SETQ |$bpCount| (- |$bpCount| 1))
+ (T (|bpNextToken| |ps|)
+ (SETF (|parserScope| |ps|) (- (|parserScope| |ps|) 1))
(|bpMoveTo| |ps| (- |n| 1)))))
((|bpEqPeek| 'BACKSET)
(COND ((EQL |n| 0) T) (T (|bpNextToken| |ps|) (|bpMoveTo| |ps| |n|))))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 623bd82f..c9d4a9d5 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -434,8 +434,7 @@
(DEFUN |shoeOutParse| (|toks|)
(LET* (|found| |ps|)
(DECLARE
- (SPECIAL |$bpCount| |$returns| |$typings| |$wheredefs| |$op| |$ttok|
- |$stok|))
+ (SPECIAL |$returns| |$typings| |$wheredefs| |$op| |$ttok| |$stok|))
(PROGN
(SETQ |ps| (|makeParserState| |toks|))
(SETQ |$stok| NIL)
@@ -444,7 +443,6 @@
(SETQ |$wheredefs| NIL)
(SETQ |$typings| NIL)
(SETQ |$returns| NIL)
- (SETQ |$bpCount| 0)
(|bpFirstTok| |ps|)
(SETQ |found|
(LET ((#1=#:G729
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index b0d35442..bcfc5856 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -362,7 +362,6 @@ shoeOutParse toks ==
$wheredefs := []
$typings := []
$returns := []
- $bpCount := 0
bpFirstTok ps
found :=
try bpOutItem ps