diff options
author | dos-reis <gdr@axiomatics.org> | 2012-05-30 01:42:38 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2012-05-30 01:42:38 +0000 |
commit | 7ce6e4867ffda62855e183baceb02747408a86ca (patch) | |
tree | e56fa54ae893bb380db25b5426ae3e1babf06a39 /src/boot | |
parent | f41afae2b242dd56e8dbfa0b3f8cb16a6ab29ff0 (diff) | |
download | open-axiom-7ce6e4867ffda62855e183baceb02747408a86ca.tar.gz |
* boot/parser.boot: Remove references to $stack.
* boot/translator.boot: Likewise.
Diffstat (limited to 'src/boot')
-rw-r--r-- | src/boot/parser.boot | 58 | ||||
-rw-r--r-- | src/boot/strap/parser.clisp | 132 | ||||
-rw-r--r-- | src/boot/strap/translator.clisp | 10 | ||||
-rw-r--r-- | src/boot/translator.boot | 5 |
4 files changed, 105 insertions, 100 deletions
diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 1348aa57..90d72172 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -114,36 +114,36 @@ bpRequire(ps,f) == apply(f,ps,nil) or bpTrap() bpState ps == - [parserTokens ps,$stack,$bpParenCount,$bpCount] + [parserTokens ps,parserTrees ps,$bpParenCount,$bpCount] bpRestore(ps,x)== parserTokens(ps) := first x bpFirstToken ps - $stack:=second x + parserTrees(ps) := second x $bpParenCount:=third x $bpCount:=CADDDR x true bpPush(ps,x) == - $stack:=[x,:$stack] + parserTrees(ps) := [x,:parserTrees ps] bpPushId ps == - $stack:= [bfReName $ttok,:$stack] + parserTrees(ps) := [bfReName $ttok,:parserTrees ps] bpPop1 ps == - a:=first $stack - $stack:=rest $stack + a := first parserTrees ps + parserTrees(ps) := rest parserTrees ps a bpPop2 ps == - a:=second $stack - $stack.rest := CDDR $stack + a := second parserTrees ps + parserTrees(ps).rest := CDDR parserTrees ps a bpPop3 ps == - a:=third $stack - $stack.rest.rest := CDDDR $stack + a := third parserTrees ps + parserTrees(ps).rest.rest := CDDDR parserTrees ps a bpIndentParenthesized(ps,f) == @@ -201,10 +201,10 @@ bpPileBracketed(ps,f) == bpListof(ps,f,str1,g)== apply(f,ps,nil) => bpEqKey(ps,str1) and bpRequire(ps,f) => - a:=$stack - $stack:=nil + a := parserTrees ps + parserTrees(ps) := nil while bpEqKey(ps,str1) and bpRequire(ps,f) repeat nil - $stack:=[reverse! $stack,:a] + parserTrees(ps) := [reverse! parserTrees ps,:a] bpPush(ps,FUNCALL(g, [bpPop3 ps,bpPop2 ps,:bpPop1 ps])) true false @@ -214,10 +214,10 @@ bpListof(ps,f,str1,g)== bpListofFun(ps,f,h,g)== apply(f,ps,nil) => apply(h,ps,nil) and bpRequire(ps,f) => - a:=$stack - $stack:=nil + a := parserTrees ps + parserTrees(ps) := nil while apply(h,ps,nil) and bpRequire(ps,f) repeat nil - $stack:=[reverse! $stack,:a] + parserTrees(ps) := [reverse! parserTrees ps,:a] bpPush(ps,FUNCALL(g, [bpPop3 ps,bpPop2 ps,:bpPop1 ps])) true false @@ -225,20 +225,20 @@ bpListofFun(ps,f,h,g)== bpList(ps,f,str1)== apply(f,ps,nil) => bpEqKey(ps,str1) and bpRequire(ps,f) => - a:=$stack - $stack:=nil + a := parserTrees ps + parserTrees(ps) := nil while bpEqKey(ps,str1) and bpRequire(ps,f) repeat nil - $stack:=[reverse! $stack,:a] + parserTrees(ps) := [reverse! parserTrees ps,:a] bpPush(ps,[bpPop3 ps,bpPop2 ps,:bpPop1 ps]) bpPush(ps,[bpPop1 ps]) bpPush(ps,nil) bpOneOrMore(ps,f) == apply(f,ps,nil)=> - a:=$stack - $stack:=nil + a := parserTrees ps + parserTrees(ps) := nil while apply(f,ps,nil) repeat nil - $stack:=[reverse! $stack,:a] + parserTrees(ps) := [reverse! parserTrees ps,:a] bpPush(ps,[bpPop2 ps,:bpPop1 ps]) false @@ -313,9 +313,9 @@ bpRecoverTrap ps == bpPush(ps,[['"pile syntax error"]]) bpListAndRecover(ps,f)== - a := $stack + a := parserTrees ps b := nil - $stack := nil + parserTrees(ps) := nil done := false c := parserTokens ps while not done repeat @@ -347,7 +347,7 @@ bpListAndRecover(ps,f)== bpNext ps c := parserTokens ps b := [bpPop1 ps,:b] - $stack := a + parserTrees(ps) := a bpPush(ps,reverse! b) bpMoveTo(ps,n) == @@ -948,7 +948,7 @@ bpExit ps == bpDefinition ps == bpEqKey(ps,"MACRO") => - bpName ps and bpStoreName() and + bpName ps and bpStoreName ps and bpCompoundDefinitionTail(ps,function %Macro) or bpTrap() a := bpState ps @@ -963,14 +963,14 @@ bpDefinition ps == bpRestore(ps,a) false -bpStoreName()== - $op := first $stack +bpStoreName ps == + $op := first parserTrees ps $wheredefs := nil $typings := nil true bpDef ps == - bpName ps and bpStoreName() and bpDefTail(ps,function %Definition) + bpName ps and bpStoreName ps and bpDefTail(ps,function %Definition) or bpNamespace ps and bpSimpleDefinitionTail ps bpDDef ps == diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index ded828e4..d96379e5 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -54,24 +54,24 @@ (DEFUN |makeTranslator| (|ip|) (|mk%Translator| |ip| NIL NIL NIL NIL)) (DEFUN |bpFirstToken| (|ps|) - (DECLARE (SPECIAL |$ttok| |$stok| |$inputStream|)) + (DECLARE (SPECIAL |$ttok| |$stok|)) (PROGN (SETQ |$stok| (COND - ((NULL |$inputStream|) + ((NULL (|parserTokens| |ps|)) (|mk%Token| 'ERROR 'NOMORE (|tokenPosition| |$stok|))) - (T (CAR |$inputStream|)))) + (T (CAR (|parserTokens| |ps|))))) (SETQ |$ttok| (|tokenValue| |$stok|)) T)) (DEFUN |bpFirstTok| (|ps|) - (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$ttok| |$stok| |$inputStream|)) + (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$ttok| |$stok|)) (PROGN (SETQ |$stok| (COND - ((NULL |$inputStream|) + ((NULL (|parserTokens| |ps|)) (|mk%Token| 'ERROR 'NOMORE (|tokenPosition| |$stok|))) - (T (CAR |$inputStream|)))) + (T (CAR (|parserTokens| |ps|))))) (SETQ |$ttok| (|tokenValue| |$stok|)) (COND ((AND (PLUSP |$bpParenCount|) (EQ (|tokenClass| |$stok|) 'KEY)) @@ -83,58 +83,62 @@ (T T)))) (DEFUN |bpNext| (|ps|) - (DECLARE (SPECIAL |$inputStream|)) - (PROGN (SETQ |$inputStream| (CDR |$inputStream|)) (|bpFirstTok| |ps|))) + (PROGN + (SETF (|parserTokens| |ps|) (CDR (|parserTokens| |ps|))) + (|bpFirstTok| |ps|))) (DEFUN |bpNextToken| (|ps|) - (DECLARE (SPECIAL |$inputStream|)) - (PROGN (SETQ |$inputStream| (CDR |$inputStream|)) (|bpFirstToken| |ps|))) + (PROGN + (SETF (|parserTokens| |ps|) (CDR (|parserTokens| |ps|))) + (|bpFirstToken| |ps|))) (DEFUN |bpRequire| (|ps| |f|) (OR (APPLY |f| |ps| NIL) (|bpTrap|))) (DEFUN |bpState| (|ps|) - (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|)) - (LIST |$inputStream| |$stack| |$bpParenCount| |$bpCount|)) + (DECLARE (SPECIAL |$bpCount| |$bpParenCount|)) + (LIST (|parserTokens| |ps|) (|parserTrees| |ps|) |$bpParenCount| |$bpCount|)) (DEFUN |bpRestore| (|ps| |x|) - (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|)) + (DECLARE (SPECIAL |$bpCount| |$bpParenCount|)) (PROGN - (SETQ |$inputStream| (CAR |x|)) + (SETF (|parserTokens| |ps|) (CAR |x|)) (|bpFirstToken| |ps|) - (SETQ |$stack| (CADR |x|)) + (SETF (|parserTrees| |ps|) (CADR |x|)) (SETQ |$bpParenCount| (CADDR |x|)) (SETQ |$bpCount| (CADDDR |x|)) T)) (DEFUN |bpPush| (|ps| |x|) - (DECLARE (SPECIAL |$stack|)) - (SETQ |$stack| (CONS |x| |$stack|))) + (SETF (|parserTrees| |ps|) (CONS |x| (|parserTrees| |ps|)))) (DEFUN |bpPushId| (|ps|) - (DECLARE (SPECIAL |$stack| |$ttok|)) - (SETQ |$stack| (CONS (|bfReName| |$ttok|) |$stack|))) + (DECLARE (SPECIAL |$ttok|)) + (SETF (|parserTrees| |ps|) (CONS (|bfReName| |$ttok|) (|parserTrees| |ps|)))) (DEFUN |bpPop1| (|ps|) (LET* (|a|) - (DECLARE (SPECIAL |$stack|)) - (PROGN (SETQ |a| (CAR |$stack|)) (SETQ |$stack| (CDR |$stack|)) |a|))) + (PROGN + (SETQ |a| (CAR (|parserTrees| |ps|))) + (SETF (|parserTrees| |ps|) (CDR (|parserTrees| |ps|))) + |a|))) (DEFUN |bpPop2| (|ps|) (LET* (|a|) - (DECLARE (SPECIAL |$stack|)) - (PROGN (SETQ |a| (CADR |$stack|)) (RPLACD |$stack| (CDDR |$stack|)) |a|))) + (PROGN + (SETQ |a| (CADR (|parserTrees| |ps|))) + (RPLACD (|parserTrees| |ps|) (CDDR (|parserTrees| |ps|))) + |a|))) (DEFUN |bpPop3| (|ps|) (LET* (|a|) - (DECLARE (SPECIAL |$stack|)) (PROGN - (SETQ |a| (CADDR |$stack|)) - (RPLACD (CDR |$stack|) (CDDDR |$stack|)) + (SETQ |a| (CADDR (|parserTrees| |ps|))) + (RPLACD (CDR (|parserTrees| |ps|)) (CDDDR (|parserTrees| |ps|))) |a|))) (DEFUN |bpIndentParenthesized| (|ps| |f|) (LET* (|a|) - (DECLARE (SPECIAL |$inputStream| |$bpParenCount| |$stok|)) + (DECLARE (SPECIAL |$bpParenCount| |$stok|)) (LET ((|$bpCount| 0)) (DECLARE (SPECIAL |$bpCount|)) (PROGN @@ -148,8 +152,9 @@ (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken| |ps|) (COND ((EQL |$bpCount| 0) T) (T - (SETQ |$inputStream| - (|append| (|bpAddTokens| |$bpCount|) |$inputStream|)) + (SETF (|parserTokens| |ps|) + (|append| (|bpAddTokens| |$bpCount|) + (|parserTokens| |ps|))) (|bpFirstToken| |ps|) (COND ((EQL |$bpParenCount| 0) (|bpCancel| |ps|) T) (T T))))) ((|bpEqPeek| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL)) @@ -199,18 +204,18 @@ (DEFUN |bpListof| (|ps| |f| |str1| |g|) (LET* (|a|) - (DECLARE (SPECIAL |$stack|)) (COND ((APPLY |f| |ps| NIL) (COND ((AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|)) - (SETQ |a| |$stack|) (SETQ |$stack| NIL) + (SETQ |a| (|parserTrees| |ps|)) (SETF (|parserTrees| |ps|) NIL) (LOOP (COND ((NOT (AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|))) (RETURN NIL)) (T NIL))) - (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|)) + (SETF (|parserTrees| |ps|) + (CONS (|reverse!| (|parserTrees| |ps|)) |a|)) (|bpPush| |ps| (FUNCALL |g| (CONS (|bpPop3| |ps|) @@ -220,18 +225,18 @@ (DEFUN |bpListofFun| (|ps| |f| |h| |g|) (LET* (|a|) - (DECLARE (SPECIAL |$stack|)) (COND ((APPLY |f| |ps| NIL) (COND - ((AND (APPLY |h| |ps| NIL) (|bpRequire| |ps| |f|)) (SETQ |a| |$stack|) - (SETQ |$stack| NIL) + ((AND (APPLY |h| |ps| NIL) (|bpRequire| |ps| |f|)) + (SETQ |a| (|parserTrees| |ps|)) (SETF (|parserTrees| |ps|) NIL) (LOOP (COND ((NOT (AND (APPLY |h| |ps| NIL) (|bpRequire| |ps| |f|))) (RETURN NIL)) (T NIL))) - (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|)) + (SETF (|parserTrees| |ps|) + (CONS (|reverse!| (|parserTrees| |ps|)) |a|)) (|bpPush| |ps| (FUNCALL |g| (CONS (|bpPop3| |ps|) @@ -241,18 +246,18 @@ (DEFUN |bpList| (|ps| |f| |str1|) (LET* (|a|) - (DECLARE (SPECIAL |$stack|)) (COND ((APPLY |f| |ps| NIL) (COND ((AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|)) - (SETQ |a| |$stack|) (SETQ |$stack| NIL) + (SETQ |a| (|parserTrees| |ps|)) (SETF (|parserTrees| |ps|) NIL) (LOOP (COND ((NOT (AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|))) (RETURN NIL)) (T NIL))) - (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|)) + (SETF (|parserTrees| |ps|) + (CONS (|reverse!| (|parserTrees| |ps|)) |a|)) (|bpPush| |ps| (CONS (|bpPop3| |ps|) (CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))) @@ -261,11 +266,11 @@ (DEFUN |bpOneOrMore| (|ps| |f|) (LET* (|a|) - (DECLARE (SPECIAL |$stack|)) (COND - ((APPLY |f| |ps| NIL) (SETQ |a| |$stack|) (SETQ |$stack| NIL) + ((APPLY |f| |ps| NIL) (SETQ |a| (|parserTrees| |ps|)) + (SETF (|parserTrees| |ps|) NIL) (LOOP (COND ((NOT (APPLY |f| |ps| NIL)) (RETURN NIL)) (T NIL))) - (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|)) + (SETF (|parserTrees| |ps|) (CONS (|reverse!| (|parserTrees| |ps|)) |a|)) (|bpPush| |ps| (CONS (|bpPop2| |ps|) (|bpPop1| |ps|)))) (T NIL)))) @@ -358,13 +363,12 @@ (DEFUN |bpListAndRecover| (|ps| |f|) (LET* (|found| |c| |done| |b| |a|) - (DECLARE (SPECIAL |$inputStream| |$stack|)) (PROGN - (SETQ |a| |$stack|) + (SETQ |a| (|parserTrees| |ps|)) (SETQ |b| NIL) - (SETQ |$stack| NIL) + (SETF (|parserTrees| |ps|) NIL) (SETQ |done| NIL) - (SETQ |c| |$inputStream|) + (SETQ |c| (|parserTokens| |ps|)) (LOOP (COND (|done| (RETURN NIL)) (T @@ -382,26 +386,26 @@ (T (THROW :OPEN-AXIOM-CATCH-POINT #1#)))) (T #1#)))) (COND - ((EQ |found| 'TRAPPED) (SETQ |$inputStream| |c|) + ((EQ |found| 'TRAPPED) (SETF (|parserTokens| |ps|) |c|) (|bpRecoverTrap| |ps|)) - ((NOT |found|) (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|) - (|bpRecoverTrap| |ps|))) - (COND ((|bpEqKey| |ps| 'BACKSET) (SETQ |c| |$inputStream|)) - ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|)) + ((NOT |found|) (SETF (|parserTokens| |ps|) |c|) + (|bpGeneralErrorHere|) (|bpRecoverTrap| |ps|))) + (COND ((|bpEqKey| |ps| 'BACKSET) (SETQ |c| (|parserTokens| |ps|))) + ((OR (|bpEqPeek| 'BACKTAB) (NULL (|parserTokens| |ps|))) (SETQ |done| T)) - (T (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|) + (T (SETF (|parserTokens| |ps|) |c|) (|bpGeneralErrorHere|) (|bpRecoverTrap| |ps|) (COND - ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|)) + ((OR (|bpEqPeek| 'BACKTAB) (NULL (|parserTokens| |ps|))) (SETQ |done| T)) - (T (|bpNext| |ps|) (SETQ |c| |$inputStream|))))) + (T (|bpNext| |ps|) (SETQ |c| (|parserTokens| |ps|)))))) (SETQ |b| (CONS (|bpPop1| |ps|) |b|))))) - (SETQ |$stack| |a|) + (SETF (|parserTrees| |ps|) |a|) (|bpPush| |ps| (|reverse!| |b|))))) (DEFUN |bpMoveTo| (|ps| |n|) - (DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$inputStream|)) - (COND ((NULL |$inputStream|) T) + (DECLARE (SPECIAL |$bpParenCount| |$bpCount|)) + (COND ((NULL (|parserTokens| |ps|)) T) ((|bpEqPeek| 'BACKTAB) (COND ((EQL |n| 0) T) (T (|bpNextToken| |ps|) (SETQ |$bpCount| (- |$bpCount| 1)) @@ -988,7 +992,7 @@ (COND ((|bpEqKey| |ps| 'MACRO) (OR - (AND (|bpName| |ps|) (|bpStoreName|) + (AND (|bpName| |ps|) (|bpStoreName| |ps|) (|bpCompoundDefinitionTail| |ps| #'|%Macro|)) (|bpTrap|))) (T (SETQ |a| (|bpState| |ps|)) @@ -1000,17 +1004,19 @@ (T T))) (T (|bpRestore| |ps| |a|) NIL)))))) -(DEFUN |bpStoreName| () - (DECLARE (SPECIAL |$typings| |$wheredefs| |$op| |$stack|)) +(DEFUN |bpStoreName| (|ps|) + (DECLARE (SPECIAL |$typings| |$wheredefs| |$op|)) (PROGN - (SETQ |$op| (CAR |$stack|)) + (SETQ |$op| (CAR (|parserTrees| |ps|))) (SETQ |$wheredefs| NIL) (SETQ |$typings| NIL) T)) (DEFUN |bpDef| (|ps|) - (OR (AND (|bpName| |ps|) (|bpStoreName|) (|bpDefTail| |ps| #'|%Definition|)) - (AND (|bpNamespace| |ps|) (|bpSimpleDefinitionTail| |ps|)))) + (OR + (AND (|bpName| |ps|) (|bpStoreName| |ps|) + (|bpDefTail| |ps| #'|%Definition|)) + (AND (|bpNamespace| |ps|) (|bpSimpleDefinitionTail| |ps|)))) (DEFUN |bpDDef| (|ps|) (AND (|bpName| |ps|) (|bpDefTail| |ps| #'|%Definition|))) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index a799d9fa..a77d32ee 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -435,11 +435,9 @@ (LET* (|found| |ps|) (DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$returns| |$typings| |$wheredefs| - |$op| |$ttok| |$stok| |$stack| |$inputStream|)) + |$op| |$ttok| |$stok|)) (PROGN - (SETQ |$inputStream| |toks|) (SETQ |ps| (|makeParserState| |toks|)) - (SETQ |$stack| NIL) (SETQ |$stok| NIL) (SETQ |$ttok| NIL) (SETQ |$op| NIL) @@ -461,8 +459,10 @@ (T (THROW :OPEN-AXIOM-CATCH-POINT #1#)))) (T #1#)))) (COND ((EQ |found| 'TRAPPED) NIL) - ((NOT (|bStreamNull| |$inputStream|)) (|bpGeneralErrorHere|) NIL) - ((NULL |$stack|) (|bpGeneralErrorHere|) NIL) (T (CAR |$stack|)))))) + ((NOT (|bStreamNull| (|parserTokens| |ps|))) (|bpGeneralErrorHere|) + NIL) + ((NULL (|parserTrees| |ps|)) (|bpGeneralErrorHere|) NIL) + (T (CAR (|parserTrees| |ps|))))))) (DEFUN |genDeclaration| (|n| |t|) (LET* (|t'| |ISTMP#2| |vars| |ISTMP#1|) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 58711e1b..7f85b60a 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -356,7 +356,6 @@ shoeAddComment l== shoeOutParse toks == ps := makeParserState toks - $stack := [] $stok := nil $ttok := nil $op :=nil @@ -373,10 +372,10 @@ shoeOutParse toks == not bStreamNull parserTokens ps => bpGeneralErrorHere() nil - $stack = nil => + parserTrees ps = nil => bpGeneralErrorHere() nil - first $stack + first parserTrees ps ++ Generate a global signature declaration for symbol `n'. genDeclaration(n,t) == |