diff options
Diffstat (limited to 'src/boot')
| -rw-r--r-- | src/boot/parser.boot | 49 | ||||
| -rw-r--r-- | src/boot/strap/parser.clisp | 80 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 3 | ||||
| -rw-r--r-- | src/boot/translator.boot | 1 |
4 files changed, 63 insertions, 70 deletions
diff --git a/src/boot/parser.boot b/src/boot/parser.boot index d6b72f83..a6c349c1 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -95,22 +95,20 @@ bpFirstToken ps == parserCurrentToken(ps) := parserTokens ps = nil => mk%Token("ERROR","NOMORE",parserTokenPosition ps) first parserTokens ps - $ttok := parserTokenValue ps true bpFirstTok ps == parserCurrentToken(ps) := parserTokens ps = nil => mk%Token("ERROR","NOMORE",parserTokenPosition ps) first parserTokens ps - $ttok := parserTokenValue ps parserNesting ps > 0 and parserTokenClass ps = "KEY" => - $ttok is "SETTAB" => + parserTokenValue ps is "SETTAB" => parserScope(ps) := parserScope ps + 1 bpNext ps - $ttok is "BACKTAB" => + parserTokenValue ps is "BACKTAB" => parserScope(ps) := parserScope ps - 1 bpNext ps - $ttok is "BACKSET" => + parserTokenValue ps is "BACKSET" => bpNext ps true true @@ -142,7 +140,7 @@ bpPush(ps,x) == parserTrees(ps) := [x,:parserTrees ps] bpPushId ps == - parserTrees(ps) := [bfReName $ttok,:parserTrees ps] + parserTrees(ps) := [bfReName parserTokenValue ps,:parserTrees ps] bpPop1 ps == a := first parserTrees ps @@ -293,13 +291,13 @@ bpBacksetElse ps == bpEqKey(ps,"ELSE") bpEqPeek(ps,s) == - parserTokenClass ps = "KEY" and symbolEq?(s,$ttok) + parserTokenClass ps = "KEY" and symbolEq?(s,parserTokenValue ps) bpEqKey(ps,s) == - parserTokenClass ps = "KEY" and symbolEq?(s,$ttok) and bpNext ps + parserTokenClass ps = "KEY" and symbolEq?(s,parserTokenValue ps) and bpNext ps bpEqKeyNextTok(ps,s) == - parserTokenClass ps = "KEY" and symbolEq?(s,$ttok) and bpNextToken ps + parserTokenClass ps = "KEY" and symbolEq?(s,parserTokenValue ps) and bpNextToken ps bpPileTrap ps == bpMissing(ps,"BACKTAB") bpBrackTrap(ps,x) == bpMissingMate(ps,"]",x) @@ -444,11 +442,14 @@ bpName ps == ++ STRING bpConstTok ps == parserTokenClass ps in '(INTEGER FLOAT) => - bpPush(ps,$ttok) + bpPush(ps,parserTokenValue ps) bpNext ps - parserTokenClass ps = "LISP" => bpPush(ps,%Lisp $ttok) and bpNext ps - parserTokenClass ps = "LISPEXP" => bpPush(ps,$ttok) and bpNext ps - parserTokenClass ps = "LINE" => bpPush(ps,["+LINE", $ttok]) and bpNext ps + parserTokenClass ps = "LISP" => + bpPush(ps,%Lisp parserTokenValue ps) and bpNext ps + parserTokenClass ps = "LISPEXP" => + bpPush(ps,parserTokenValue ps) and bpNext ps + parserTokenClass ps = "LINE" => + bpPush(ps,["+LINE",parserTokenValue ps]) and bpNext ps bpEqPeek(ps,"QUOTE") => bpNext ps bpRequire(ps,function bpSexp) and @@ -456,7 +457,7 @@ bpConstTok ps == bpString ps or bpFunction ps bpChar ps == - parserTokenClass ps = "ID" and $ttok is "char" => + parserTokenClass ps = "ID" and parserTokenValue ps is "char" => a := bpState ps bpApplication ps => s := bpPop1 ps @@ -618,17 +619,17 @@ bpExceptions ps == bpSexpKey ps == parserTokenClass ps = "KEY" and not bpExceptions ps => - a := $ttok has SHOEINF - a = nil => bpPush(ps,keywordId $ttok) and bpNext ps + a := parserTokenValue ps has SHOEINF + a = nil => bpPush(ps,keywordId parserTokenValue ps) and bpNext ps bpPush(ps,a) and bpNext ps false bpAnyId ps == bpEqKey(ps,"MINUS") and (parserTokenClass ps = "INTEGER" or bpTrap ps) and - bpPush(ps,-$ttok) and bpNext ps + bpPush(ps,-parserTokenValue ps) and bpNext ps or bpSexpKey ps or parserTokenClass ps in '(ID INTEGER STRING FLOAT) and - bpPush(ps,$ttok) and bpNext ps + bpPush(ps,parserTokenValue ps) and bpNext ps bpSexp ps == bpAnyId ps or @@ -667,11 +668,11 @@ bpDot ps == bpPrefixOperator ps == parserTokenClass ps = "KEY" and - $ttok has SHOEPRE and bpPushId ps and bpNext ps + parserTokenValue ps has SHOEPRE and bpPushId ps and bpNext ps bpInfixOperator ps == parserTokenClass ps = "KEY" and - $ttok has SHOEINF and bpPushId ps and bpNext ps + parserTokenValue ps has SHOEINF and bpPushId ps and bpNext ps bpSelector ps == bpEqKey(ps,"DOT") and (bpPrimary ps @@ -713,7 +714,7 @@ bpExpt ps == bpRightAssoc(ps,'(POWER),function bpTyped) bpInfKey(ps,s) == parserTokenClass ps = "KEY" and - symbolMember?($ttok,s) and bpPushId ps and bpNext ps + symbolMember?(parserTokenValue ps,s) and bpPushId ps and bpNext ps bpInfGeneric(ps,s) == bpInfKey(ps,s) and (bpEqKey(ps,"BACKSET") or true) @@ -737,14 +738,14 @@ bpLeftAssoc(ps,operations,parser)== bpString ps == parserTokenClass ps = "STRING" and - bpPush(ps,quote makeSymbol $ttok) and bpNext ps + bpPush(ps,quote makeSymbol parserTokenValue ps) and bpNext ps bpFunction ps == bpEqKey(ps,"FUNCTION") and bpRequire(ps,function bpPrimary1) and bpPush(ps,bfFunction bpPop1 ps) bpThetaName ps == - parserTokenClass ps = "ID" and $ttok has SHOETHETA => + parserTokenClass ps = "ID" and parserTokenValue ps has SHOETHETA => bpPushId ps bpNext ps false @@ -1182,7 +1183,7 @@ bpRegularBVItem ps == bpBVString ps == parserTokenClass ps = "STRING" and - bpPush(ps,["BVQUOTE",makeSymbol $ttok]) and bpNext ps + bpPush(ps,["BVQUOTE",makeSymbol parserTokenValue ps]) and bpNext ps bpRegularBVItemL ps == bpRegularBVItem ps and bpPush(ps,[bpPop1 ps]) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index c8fd9105..cf7acb25 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -66,33 +66,29 @@ (DEFUN |makeTranslator| (|ip|) (|mk%Translator| |ip| NIL NIL NIL NIL)) (DEFUN |bpFirstToken| (|ps|) - (DECLARE (SPECIAL |$ttok|)) (PROGN (SETF (|parserCurrentToken| |ps|) (COND ((NULL (|parserTokens| |ps|)) (|mk%Token| 'ERROR 'NOMORE (|parserTokenPosition| |ps|))) (T (CAR (|parserTokens| |ps|))))) - (SETQ |$ttok| (|parserTokenValue| |ps|)) T)) (DEFUN |bpFirstTok| (|ps|) - (DECLARE (SPECIAL |$ttok|)) (PROGN (SETF (|parserCurrentToken| |ps|) (COND ((NULL (|parserTokens| |ps|)) (|mk%Token| 'ERROR 'NOMORE (|parserTokenPosition| |ps|))) (T (CAR (|parserTokens| |ps|))))) - (SETQ |$ttok| (|parserTokenValue| |ps|)) (COND ((AND (PLUSP (|parserNesting| |ps|)) (EQ (|parserTokenClass| |ps|) 'KEY)) (COND - ((EQ |$ttok| 'SETTAB) + ((EQ (|parserTokenValue| |ps|) 'SETTAB) (SETF (|parserScope| |ps|) (+ (|parserScope| |ps|) 1)) (|bpNext| |ps|)) - ((EQ |$ttok| 'BACKTAB) + ((EQ (|parserTokenValue| |ps|) 'BACKTAB) (SETF (|parserScope| |ps|) (- (|parserScope| |ps|) 1)) (|bpNext| |ps|)) - ((EQ |$ttok| 'BACKSET) (|bpNext| |ps|)) (T T))) + ((EQ (|parserTokenValue| |ps|) 'BACKSET) (|bpNext| |ps|)) (T T))) (T T)))) (DEFUN |bpNext| (|ps|) @@ -124,8 +120,8 @@ (SETF (|parserTrees| |ps|) (CONS |x| (|parserTrees| |ps|)))) (DEFUN |bpPushId| (|ps|) - (DECLARE (SPECIAL |$ttok|)) - (SETF (|parserTrees| |ps|) (CONS (|bfReName| |$ttok|) (|parserTrees| |ps|)))) + (SETF (|parserTrees| |ps|) + (CONS (|bfReName| (|parserTokenValue| |ps|)) (|parserTrees| |ps|)))) (DEFUN |bpPop1| (|ps|) (LET* (|a|) @@ -331,16 +327,14 @@ (T (|bpEqKey| |ps| 'ELSE)))) (DEFUN |bpEqPeek| (|ps| |s|) - (DECLARE (SPECIAL |$ttok|)) - (AND (EQ (|parserTokenClass| |ps|) 'KEY) (EQ |s| |$ttok|))) + (AND (EQ (|parserTokenClass| |ps|) 'KEY) (EQ |s| (|parserTokenValue| |ps|)))) (DEFUN |bpEqKey| (|ps| |s|) - (DECLARE (SPECIAL |$ttok|)) - (AND (EQ (|parserTokenClass| |ps|) 'KEY) (EQ |s| |$ttok|) (|bpNext| |ps|))) + (AND (EQ (|parserTokenClass| |ps|) 'KEY) (EQ |s| (|parserTokenValue| |ps|)) + (|bpNext| |ps|))) (DEFUN |bpEqKeyNextTok| (|ps| |s|) - (DECLARE (SPECIAL |$ttok|)) - (AND (EQ (|parserTokenClass| |ps|) 'KEY) (EQ |s| |$ttok|) + (AND (EQ (|parserTokenClass| |ps|) 'KEY) (EQ |s| (|parserTokenValue| |ps|)) (|bpNextToken| |ps|))) (DEFUN |bpPileTrap| (|ps|) (|bpMissing| |ps| 'BACKTAB)) @@ -476,16 +470,16 @@ (T NIL))) (DEFUN |bpConstTok| (|ps|) - (DECLARE (SPECIAL |$ttok|)) (COND ((|symbolMember?| (|parserTokenClass| |ps|) '(INTEGER FLOAT)) - (|bpPush| |ps| |$ttok|) (|bpNext| |ps|)) + (|bpPush| |ps| (|parserTokenValue| |ps|)) (|bpNext| |ps|)) ((EQ (|parserTokenClass| |ps|) 'LISP) - (AND (|bpPush| |ps| (|%Lisp| |$ttok|)) (|bpNext| |ps|))) + (AND (|bpPush| |ps| (|%Lisp| (|parserTokenValue| |ps|))) (|bpNext| |ps|))) ((EQ (|parserTokenClass| |ps|) 'LISPEXP) - (AND (|bpPush| |ps| |$ttok|) (|bpNext| |ps|))) + (AND (|bpPush| |ps| (|parserTokenValue| |ps|)) (|bpNext| |ps|))) ((EQ (|parserTokenClass| |ps|) 'LINE) - (AND (|bpPush| |ps| (LIST '+LINE |$ttok|)) (|bpNext| |ps|))) + (AND (|bpPush| |ps| (LIST '+LINE (|parserTokenValue| |ps|))) + (|bpNext| |ps|))) ((|bpEqPeek| |ps| 'QUOTE) (|bpNext| |ps|) (AND (|bpRequire| |ps| #'|bpSexp|) (|bpPush| |ps| (|bfSymbol| (|bpPop1| |ps|))))) @@ -493,9 +487,9 @@ (DEFUN |bpChar| (|ps|) (LET* (|ISTMP#1| |s| |a|) - (DECLARE (SPECIAL |$ttok|)) (COND - ((AND (EQ (|parserTokenClass| |ps|) 'ID) (EQ |$ttok| '|char|)) + ((AND (EQ (|parserTokenClass| |ps|) 'ID) + (EQ (|parserTokenValue| |ps|) '|char|)) (SETQ |a| (|bpState| |ps|)) (COND ((|bpApplication| |ps|) (SETQ |s| (|bpPop1| |ps|)) @@ -632,24 +626,24 @@ (DEFUN |bpSexpKey| (|ps|) (LET* (|a|) - (DECLARE (SPECIAL |$ttok|)) (COND ((AND (EQ (|parserTokenClass| |ps|) 'KEY) (NOT (|bpExceptions| |ps|))) - (SETQ |a| (GET |$ttok| 'SHOEINF)) + (SETQ |a| (GET (|parserTokenValue| |ps|) 'SHOEINF)) (COND - ((NULL |a|) (AND (|bpPush| |ps| (|keywordId| |$ttok|)) (|bpNext| |ps|))) + ((NULL |a|) + (AND (|bpPush| |ps| (|keywordId| (|parserTokenValue| |ps|))) + (|bpNext| |ps|))) (T (AND (|bpPush| |ps| |a|) (|bpNext| |ps|))))) (T NIL)))) (DEFUN |bpAnyId| (|ps|) - (DECLARE (SPECIAL |$ttok|)) (OR (AND (|bpEqKey| |ps| 'MINUS) (OR (EQ (|parserTokenClass| |ps|) 'INTEGER) (|bpTrap| |ps|)) - (|bpPush| |ps| (- |$ttok|)) (|bpNext| |ps|)) + (|bpPush| |ps| (- (|parserTokenValue| |ps|))) (|bpNext| |ps|)) (|bpSexpKey| |ps|) (AND (|symbolMember?| (|parserTokenClass| |ps|) '(ID INTEGER STRING FLOAT)) - (|bpPush| |ps| |$ttok|) (|bpNext| |ps|)))) + (|bpPush| |ps| (|parserTokenValue| |ps|)) (|bpNext| |ps|)))) (DEFUN |bpSexp| (|ps|) (OR (|bpAnyId| |ps|) @@ -685,14 +679,14 @@ (DEFUN |bpDot| (|ps|) (AND (|bpEqKey| |ps| 'DOT) (|bpPush| |ps| (|bfDot|)))) (DEFUN |bpPrefixOperator| (|ps|) - (DECLARE (SPECIAL |$ttok|)) - (AND (EQ (|parserTokenClass| |ps|) 'KEY) (GET |$ttok| 'SHOEPRE) - (|bpPushId| |ps|) (|bpNext| |ps|))) + (AND (EQ (|parserTokenClass| |ps|) 'KEY) + (GET (|parserTokenValue| |ps|) 'SHOEPRE) (|bpPushId| |ps|) + (|bpNext| |ps|))) (DEFUN |bpInfixOperator| (|ps|) - (DECLARE (SPECIAL |$ttok|)) - (AND (EQ (|parserTokenClass| |ps|) 'KEY) (GET |$ttok| 'SHOEINF) - (|bpPushId| |ps|) (|bpNext| |ps|))) + (AND (EQ (|parserTokenClass| |ps|) 'KEY) + (GET (|parserTokenValue| |ps|) 'SHOEINF) (|bpPushId| |ps|) + (|bpNext| |ps|))) (DEFUN |bpSelector| (|ps|) (AND (|bpEqKey| |ps| 'DOT) @@ -733,9 +727,9 @@ (DEFUN |bpExpt| (|ps|) (|bpRightAssoc| |ps| '(POWER) #'|bpTyped|)) (DEFUN |bpInfKey| (|ps| |s|) - (DECLARE (SPECIAL |$ttok|)) - (AND (EQ (|parserTokenClass| |ps|) 'KEY) (|symbolMember?| |$ttok| |s|) - (|bpPushId| |ps|) (|bpNext| |ps|))) + (AND (EQ (|parserTokenClass| |ps|) 'KEY) + (|symbolMember?| (|parserTokenValue| |ps|) |s|) (|bpPushId| |ps|) + (|bpNext| |ps|))) (DEFUN |bpInfGeneric| (|ps| |s|) (AND (|bpInfKey| |ps| |s|) (OR (|bpEqKey| |ps| 'BACKSET) T))) @@ -775,18 +769,18 @@ (T NIL))) (DEFUN |bpString| (|ps|) - (DECLARE (SPECIAL |$ttok|)) (AND (EQ (|parserTokenClass| |ps|) 'STRING) - (|bpPush| |ps| (|quote| (INTERN |$ttok|))) (|bpNext| |ps|))) + (|bpPush| |ps| (|quote| (INTERN (|parserTokenValue| |ps|)))) + (|bpNext| |ps|))) (DEFUN |bpFunction| (|ps|) (AND (|bpEqKey| |ps| 'FUNCTION) (|bpRequire| |ps| #'|bpPrimary1|) (|bpPush| |ps| (|bfFunction| (|bpPop1| |ps|))))) (DEFUN |bpThetaName| (|ps|) - (DECLARE (SPECIAL |$ttok|)) (COND - ((AND (EQ (|parserTokenClass| |ps|) 'ID) (GET |$ttok| 'SHOETHETA)) + ((AND (EQ (|parserTokenClass| |ps|) 'ID) + (GET (|parserTokenValue| |ps|) 'SHOETHETA)) (|bpPushId| |ps|) (|bpNext| |ps|)) (T NIL))) @@ -1226,9 +1220,9 @@ (|bpBracketConstruct| |ps| #'|bpPatternL|))) (DEFUN |bpBVString| (|ps|) - (DECLARE (SPECIAL |$ttok|)) (AND (EQ (|parserTokenClass| |ps|) 'STRING) - (|bpPush| |ps| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext| |ps|))) + (|bpPush| |ps| (LIST 'BVQUOTE (INTERN (|parserTokenValue| |ps|)))) + (|bpNext| |ps|))) (DEFUN |bpRegularBVItemL| (|ps|) (AND (|bpRegularBVItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1| |ps|))))) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 99469d72..6dd616b2 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -433,10 +433,9 @@ (DEFUN |shoeOutParse| (|toks|) (LET* (|found| |ps|) - (DECLARE (SPECIAL |$returns| |$typings| |$wheredefs| |$op| |$ttok|)) + (DECLARE (SPECIAL |$returns| |$typings| |$wheredefs| |$op|)) (PROGN (SETQ |ps| (|makeParserState| |toks|)) - (SETQ |$ttok| NIL) (SETQ |$op| NIL) (SETQ |$wheredefs| NIL) (SETQ |$typings| NIL) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 35eb7761..e0de5ef5 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -356,7 +356,6 @@ shoeAddComment l== shoeOutParse toks == ps := makeParserState toks - $ttok := nil $op :=nil $wheredefs := [] $typings := [] |