diff options
Diffstat (limited to 'src/boot/strap/parser.clisp')
-rw-r--r-- | src/boot/strap/parser.clisp | 65 |
1 files changed, 31 insertions, 34 deletions
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index fa16a127..53eb4f53 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -15,9 +15,9 @@ (SETQ |$stok| (COND ((NULL |$inputStream|) - (|shoeTokConstruct| 'ERROR 'NOMORE (|shoeTokPosn| |$stok|))) + (|mk%Token| 'ERROR 'NOMORE (|tokenPosition| |$stok|))) (T (CAR |$inputStream|)))) - (SETQ |$ttok| (|shoeTokPart| |$stok|)) + (SETQ |$ttok| (|tokenValue| |$stok|)) T)) (DEFUN |bpFirstTok| () @@ -26,11 +26,11 @@ (SETQ |$stok| (COND ((NULL |$inputStream|) - (|shoeTokConstruct| 'ERROR 'NOMORE (|shoeTokPosn| |$stok|))) + (|mk%Token| 'ERROR 'NOMORE (|tokenPosition| |$stok|))) (T (CAR |$inputStream|)))) - (SETQ |$ttok| (|shoeTokPart| |$stok|)) + (SETQ |$ttok| (|tokenValue| |$stok|)) (COND - ((AND (PLUSP |$bpParenCount|) (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY)) + ((AND (PLUSP |$bpParenCount|) (EQ (|tokenClass| |$stok|) 'KEY)) (COND ((EQ |$ttok| 'SETTAB) (SETQ |$bpCount| (+ |$bpCount| 1)) (|bpNext|)) ((EQ |$ttok| 'BACKTAB) (SETQ |$bpCount| (- |$bpCount| 1)) (|bpNext|)) @@ -243,16 +243,15 @@ (DEFUN |bpEqPeek| (|s|) (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|))) + (AND (EQ (|tokenClass| |$stok|) 'KEY) (EQ |s| |$ttok|))) (DEFUN |bpEqKey| (|s|) (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|) (|bpNext|))) + (AND (EQ (|tokenClass| |$stok|) 'KEY) (EQ |s| |$ttok|) (|bpNext|))) (DEFUN |bpEqKeyNextTok| (|s|) (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|) - (|bpNextToken|))) + (AND (EQ (|tokenClass| |$stok|) 'KEY) (EQ |s| |$ttok|) (|bpNextToken|))) (DEFUN |bpPileTrap| () (|bpMissing| 'BACKTAB)) @@ -284,9 +283,9 @@ (DECLARE (SPECIAL |$stok|)) (PROGN (|bpFirstToken|) - (SETQ |pos1| (|shoeTokPosn| |$stok|)) + (SETQ |pos1| (|tokenPosition| |$stok|)) (|bpMoveTo| 0) - (SETQ |pos2| (|shoeTokPosn| |$stok|)) + (SETQ |pos2| (|tokenPosition| |$stok|)) (|bpIgnoredFromTo| |pos1| |pos2|) (|bpPush| (LIST (LIST "pile syntax error")))))) @@ -352,27 +351,26 @@ (DECLARE (SPECIAL |$stok|)) (COND ((|bpEqPeek| 'COLON-COLON) (|bpNext|) - (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID) (|bpPushId|) (|bpNext|) + (AND (EQ (|tokenClass| |$stok|) 'ID) (|bpPushId|) (|bpNext|) (|bpPush| (|bfColonColon| (|bpPop2|) (|bpPop1|))))) (T NIL))) (DEFUN |bpName| () (DECLARE (SPECIAL |$stok|)) (COND - ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID)) (|bpPushId|) (|bpNext|) + ((EQ (|tokenClass| |$stok|) 'ID) (|bpPushId|) (|bpNext|) (|bpAnyNo| #'|bpQualifiedName|)) (T NIL))) (DEFUN |bpConstTok| () (DECLARE (SPECIAL |$ttok| |$stok|)) (COND - ((|symbolMember?| (|shoeTokType| |$stok|) '(INTEGER FLOAT)) + ((|symbolMember?| (|tokenClass| |$stok|) '(INTEGER FLOAT)) (|bpPush| |$ttok|) (|bpNext|)) - ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'LISP)) + ((EQ (|tokenClass| |$stok|) 'LISP) (AND (|bpPush| (|%Lisp| |$ttok|)) (|bpNext|))) - ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'LISPEXP)) - (AND (|bpPush| |$ttok|) (|bpNext|))) - ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'LINE)) + ((EQ (|tokenClass| |$stok|) 'LISPEXP) (AND (|bpPush| |$ttok|) (|bpNext|))) + ((EQ (|tokenClass| |$stok|) 'LINE) (AND (|bpPush| (LIST '+LINE |$ttok|)) (|bpNext|))) ((|bpEqPeek| 'QUOTE) (|bpNext|) (AND (|bpRequire| #'|bpSexp|) (|bpPush| (|bfSymbol| (|bpPop1|))))) @@ -382,7 +380,7 @@ (LET* (|ISTMP#1| |s| |a|) (DECLARE (SPECIAL |$ttok| |$stok|)) (COND - ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID) (EQ |$ttok| '|char|)) + ((AND (EQ (|tokenClass| |$stok|) 'ID) (EQ |$ttok| '|char|)) (SETQ |a| (|bpState|)) (COND ((|bpApplication|) (SETQ |s| (|bpPop1|)) @@ -496,10 +494,10 @@ (DECLARE (SPECIAL |$stok|)) (COND ((EQL |n| 0) NIL) ((PLUSP |n|) - (CONS (|shoeTokConstruct| 'KEY 'SETTAB (|shoeTokPosn| |$stok|)) + (CONS (|mk%Token| 'KEY 'SETTAB (|tokenPosition| |$stok|)) (|bpAddTokens| (- |n| 1)))) (T - (CONS (|shoeTokConstruct| 'KEY 'BACKTAB (|shoeTokPosn| |$stok|)) + (CONS (|mk%Token| 'KEY 'BACKTAB (|tokenPosition| |$stok|)) (|bpAddTokens| (+ |n| 1)))))) (DEFUN |bpExceptions| () @@ -511,7 +509,7 @@ (LET* (|a|) (DECLARE (SPECIAL |$ttok| |$stok|)) (COND - ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (NOT (|bpExceptions|))) + ((AND (EQ (|tokenClass| |$stok|) 'KEY) (NOT (|bpExceptions|))) (SETQ |a| (GET |$ttok| 'SHOEINF)) (COND ((NULL |a|) (AND (|bpPush| (|keywordId| |$ttok|)) (|bpNext|))) (T (AND (|bpPush| |a|) (|bpNext|))))) @@ -520,11 +518,10 @@ (DEFUN |bpAnyId| () (DECLARE (SPECIAL |$ttok| |$stok|)) (OR - (AND (|bpEqKey| 'MINUS) - (OR (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'INTEGER)) (|bpTrap|)) + (AND (|bpEqKey| 'MINUS) (OR (EQ (|tokenClass| |$stok|) 'INTEGER) (|bpTrap|)) (|bpPush| (- |$ttok|)) (|bpNext|)) (|bpSexpKey|) - (AND (|symbolMember?| (|shoeTokType| |$stok|) '(ID INTEGER STRING FLOAT)) + (AND (|symbolMember?| (|tokenClass| |$stok|) '(ID INTEGER STRING FLOAT)) (|bpPush| |$ttok|) (|bpNext|)))) (DEFUN |bpSexp| () @@ -559,13 +556,13 @@ (DEFUN |bpPrefixOperator| () (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (GET |$ttok| 'SHOEPRE) - (|bpPushId|) (|bpNext|))) + (AND (EQ (|tokenClass| |$stok|) 'KEY) (GET |$ttok| 'SHOEPRE) (|bpPushId|) + (|bpNext|))) (DEFUN |bpInfixOperator| () (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (GET |$ttok| 'SHOEINF) - (|bpPushId|) (|bpNext|))) + (AND (EQ (|tokenClass| |$stok|) 'KEY) (GET |$ttok| 'SHOEINF) (|bpPushId|) + (|bpNext|))) (DEFUN |bpSelector| () (AND (|bpEqKey| 'DOT) @@ -599,7 +596,7 @@ (DEFUN |bpInfKey| (|s|) (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (|symbolMember?| |$ttok| |s|) + (AND (EQ (|tokenClass| |$stok|) 'KEY) (|symbolMember?| |$ttok| |s|) (|bpPushId|) (|bpNext|))) (DEFUN |bpInfGeneric| (|s|) (AND (|bpInfKey| |s|) (OR (|bpEqKey| 'BACKSET) T))) @@ -632,7 +629,7 @@ (DEFUN |bpString| () (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (EQ (|shoeTokType| |$stok|) 'STRING) + (AND (EQ (|tokenClass| |$stok|) 'STRING) (|bpPush| (|quote| (INTERN |$ttok|))) (|bpNext|))) (DEFUN |bpFunction| () @@ -642,8 +639,8 @@ (DEFUN |bpThetaName| () (DECLARE (SPECIAL |$ttok| |$stok|)) (COND - ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID) (GET |$ttok| 'SHOETHETA)) - (|bpPushId|) (|bpNext|)) + ((AND (EQ (|tokenClass| |$stok|) 'ID) (GET |$ttok| 'SHOETHETA)) (|bpPushId|) + (|bpNext|)) (T NIL))) (DEFUN |bpReduceOperator| () @@ -1038,7 +1035,7 @@ (DEFUN |bpBVString| () (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (EQ (|shoeTokType| |$stok|) 'STRING) + (AND (EQ (|tokenClass| |$stok|) 'STRING) (|bpPush| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext|))) (DEFUN |bpRegularBVItemL| () |