aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog5
-rw-r--r--src/boot/parser.boot58
-rw-r--r--src/boot/strap/parser.clisp132
-rw-r--r--src/boot/strap/translator.clisp10
-rw-r--r--src/boot/translator.boot5
5 files changed, 110 insertions, 100 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 1ef83b96..647a7164 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,10 @@
2012-05-29 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * boot/parser.boot: Remove references to $stack.
+ * boot/translator.boot: Likewise.
+
+2012-05-29 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* boot/parser.boot: Add parser state argument to more functions.
Remove references to $inputStream.
* boot/translator.boot (shoeOutParse): Remove $inputStream.
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) ==
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-11 02:12:19 +0000