diff options
author | dos-reis <gdr@axiomatics.org> | 2012-05-30 12:59:38 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2012-05-30 12:59:38 +0000 |
commit | e978fdb127b726df8a04c4f7f1936b7eaf5e227b (patch) | |
tree | 80db8682b8946bf97766476e219e803f56e3f2f2 /src/boot | |
parent | 6c514c2fb12c51eeb5f7745c85736cdc97abfc7f (diff) | |
download | open-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.boot | 59 | ||||
-rw-r--r-- | src/boot/strap/parser.clisp | 78 | ||||
-rw-r--r-- | src/boot/strap/translator.clisp | 4 | ||||
-rw-r--r-- | src/boot/translator.boot | 1 |
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 |