open-axiom repository from github
(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "includer")
(IMPORT-MODULE "scanner")
(IMPORT-MODULE "ast")
(IN-PACKAGE "BOOTTRAN")
(PROVIDE "parser")
(DEFSTRUCT (|%ParserState| (:COPIER |copy%ParserState|))
|toks|
|trees|
|pren|
|scp|
|cur|
|tu|)
(DEFMACRO |mk%ParserState| (|toks| |trees| |pren| |scp| |cur| |tu|)
(LIST '|MAKE-%ParserState| :|toks| |toks| :|trees| |trees| :|pren| |pren|
:|scp| |scp| :|cur| |cur| :|tu| |tu|))
(DEFMACRO |parserTokens| (|bfVar#1|) (LIST '|%ParserState-toks| |bfVar#1|))
(DEFMACRO |parserTrees| (|bfVar#1|) (LIST '|%ParserState-trees| |bfVar#1|))
(DEFMACRO |parserNesting| (|bfVar#1|) (LIST '|%ParserState-pren| |bfVar#1|))
(DEFMACRO |parserScope| (|bfVar#1|) (LIST '|%ParserState-scp| |bfVar#1|))
(DEFMACRO |parserCurrentToken| (|bfVar#1|) (LIST '|%ParserState-cur| |bfVar#1|))
(DEFMACRO |parserLoadUnit| (|bfVar#1|) (LIST '|%ParserState-tu| |bfVar#1|))
(DEFUN |makeParserState| (|toks|)
(|mk%ParserState| |toks| NIL 0 0 NIL (|makeLoadUnit|)))
(DEFMACRO |parserTokenValue| (|ps|)
(LIST '|tokenValue| (LIST '|parserCurrentToken| |ps|)))
(DEFMACRO |parserTokenClass| (|ps|)
(LIST '|tokenClass| (LIST '|parserCurrentToken| |ps|)))
(DEFMACRO |parserTokenPosition| (|ps|)
(LIST '|tokenPosition| (LIST '|parserCurrentToken| |ps|)))
(DEFMACRO |parserGensymSequenceNumber| (|ps|)
(LIST '|currentGensymNumber| (LIST '|parserLoadUnit| |ps|)))
(DEFUN |bpFirstToken| (|ps|)
(PROGN
(SETF (|parserCurrentToken| |ps|)
(COND
((NULL (|parserTokens| |ps|))
(|mk%Token| 'ERROR 'NOMORE (|parserTokenPosition| |ps|)))
(T (CAR (|parserTokens| |ps|)))))
T))
(DEFUN |bpFirstTok| (|ps|)
(PROGN
(SETF (|parserCurrentToken| |ps|)
(COND
((NULL (|parserTokens| |ps|))
(|mk%Token| 'ERROR 'NOMORE (|parserTokenPosition| |ps|)))
(T (CAR (|parserTokens| |ps|)))))
(COND
((AND (PLUSP (|parserNesting| |ps|)) (EQ (|parserTokenClass| |ps|) 'KEY))
(COND
((EQ (|parserTokenValue| |ps|) 'SETTAB)
(SETF (|parserScope| |ps|) (+ (|parserScope| |ps|) 1)) (|bpNext| |ps|))
((EQ (|parserTokenValue| |ps|) 'BACKTAB)
(SETF (|parserScope| |ps|) (- (|parserScope| |ps|) 1)) (|bpNext| |ps|))
((EQ (|parserTokenValue| |ps|) 'BACKSET) (|bpNext| |ps|)) (T T)))
(T T))))
(DEFUN |bpNext| (|ps|)
(PROGN
(SETF (|parserTokens| |ps|) (CDR (|parserTokens| |ps|)))
(|bpFirstTok| |ps|)))
(DEFUN |bpNextToken| (|ps|)
(PROGN
(SETF (|parserTokens| |ps|) (CDR (|parserTokens| |ps|)))
(|bpFirstToken| |ps|)))
(DEFUN |bpRequire| (|ps| |f|) (OR (FUNCALL |f| |ps|) (|bpTrap| |ps|)))
(DEFUN |bpState| (|ps|)
(LIST (|parserTokens| |ps|) (|parserTrees| |ps|) (|parserNesting| |ps|)
(|parserScope| |ps|)))
(DEFUN |bpRestore| (|ps| |x|)
(PROGN
(SETF (|parserTokens| |ps|) (CAR |x|))
(|bpFirstToken| |ps|)
(SETF (|parserTrees| |ps|) (CADR |x|))
(SETF (|parserNesting| |ps|) (CADDR |x|))
(SETF (|parserScope| |ps|) (CADDDR |x|))
T))
(DEFUN |bpPush| (|ps| |x|)
(SETF (|parserTrees| |ps|) (CONS |x| (|parserTrees| |ps|))))
(DEFUN |bpPushId| (|ps|)
(SETF (|parserTrees| |ps|)
(CONS (|bfReName| (|parserTokenValue| |ps|)) (|parserTrees| |ps|))))
(DEFUN |bpPop1| (|ps|)
(LET* (|a|)
(PROGN
(SETQ |a| (CAR (|parserTrees| |ps|)))
(SETF (|parserTrees| |ps|) (CDR (|parserTrees| |ps|)))
|a|)))
(DEFUN |bpPop2| (|ps|)
(LET* (|a|)
(PROGN
(SETQ |a| (CADR (|parserTrees| |ps|)))
(RPLACD (|parserTrees| |ps|) (CDDR (|parserTrees| |ps|)))
|a|)))
(DEFUN |bpPop3| (|ps|)
(LET* (|a|)
(PROGN
(SETQ |a| (CADDR (|parserTrees| |ps|)))
(RPLACD (CDR (|parserTrees| |ps|)) (CDDDR (|parserTrees| |ps|)))
|a|)))
(DEFUN |bpIndentParenthesized| (|ps| |f|)
(LET* (|a| |scope|)
(PROGN
(SETQ |scope| (|parserScope| |ps|))
(UNWIND-PROTECT
(PROGN
(SETF (|parserScope| |ps|) 0)
(SETQ |a| (|parserCurrentToken| |ps|))
(COND
((|bpEqPeek| |ps| 'OPAREN)
(SETF (|parserNesting| |ps|) (+ (|parserNesting| |ps|) 1))
(|bpNext| |ps|)
(COND
((AND (FUNCALL |f| |ps|) (|bpFirstTok| |ps|)
(OR (|bpEqPeek| |ps| 'CPAREN) (|bpParenTrap| |ps| |a|)))
(SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
(|bpNextToken| |ps|)
(COND ((EQL (|parserScope| |ps|) 0) T)
(T
(SETF (|parserTokens| |ps|)
(|append|
(|bpAddTokens| |ps| (|parserScope| |ps|))
(|parserTokens| |ps|)))
(|bpFirstToken| |ps|)
(COND ((EQL (|parserNesting| |ps|) 0) (|bpCancel| |ps|) T)
(T T)))))
((|bpEqPeek| |ps| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL))
(SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
(|bpNextToken| |ps|) T)
(T (|bpParenTrap| |ps| |a|))))
(T NIL)))
(SETF (|parserScope| |ps|) |scope|)))))
(DEFUN |bpParenthesized| (|ps| |f|)
(LET* (|a|)
(PROGN
(SETQ |a| (|parserCurrentToken| |ps|))
(COND
((|bpEqKey| |ps| 'OPAREN)
(COND
((AND (FUNCALL |f| |ps|)
(OR (|bpEqKey| |ps| 'CPAREN) (|bpParenTrap| |ps| |a|)))
T)
((|bpEqKey| |ps| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL)) T)
(T (|bpParenTrap| |ps| |a|))))
(T NIL)))))
(DEFUN |bpBracket| (|ps| |f|)
(LET* (|a|)
(PROGN
(SETQ |a| (|parserCurrentToken| |ps|))
(COND
((|bpEqKey| |ps| 'OBRACK)
(COND
((AND (FUNCALL |f| |ps|)
(OR (|bpEqKey| |ps| 'CBRACK) (|bpBrackTrap| |ps| |a|)))
(|bpPush| |ps| (|bfBracket| (|bpPop1| |ps|))))
((|bpEqKey| |ps| 'CBRACK) (|bpPush| |ps| NIL))
(T (|bpBrackTrap| |ps| |a|))))
(T NIL)))))
(DEFUN |bpPileBracketed| (|ps| |f|)
(COND
((|bpEqKey| |ps| 'SETTAB)
(COND ((|bpEqKey| |ps| 'BACKTAB) T)
((AND (FUNCALL |f| |ps|)
(OR (|bpEqKey| |ps| 'BACKTAB) (|bpPileTrap| |ps|)))
(|bpPush| |ps| (|bfPile| (|bpPop1| |ps|))))
(T NIL)))
(T NIL)))
(DEFUN |bpListof| (|ps| |f| |str1| |g|)
(LET* (|a|)
(COND
((FUNCALL |f| |ps|)
(COND
((AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|))
(SETQ |a| (|parserTrees| |ps|)) (SETF (|parserTrees| |ps|) NIL)
(LOOP
(COND
((NOT (AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|)))
(RETURN NIL))
(T NIL)))
(SETF (|parserTrees| |ps|)
(CONS (|reverse!| (|parserTrees| |ps|)) |a|))
(|bpPush| |ps|
(FUNCALL |g|
(CONS (|bpPop3| |ps|)
(CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))))
(T T)))
(T NIL))))
(DEFUN |bpListofFun| (|ps| |f| |h| |g|)
(LET* (|a|)
(COND
((FUNCALL |f| |ps|)
(COND
((AND (FUNCALL |h| |ps|) (|bpRequire| |ps| |f|))
(SETQ |a| (|parserTrees| |ps|)) (SETF (|parserTrees| |ps|) NIL)
(LOOP
(COND
((NOT (AND (FUNCALL |h| |ps|) (|bpRequire| |ps| |f|))) (RETURN NIL))
(T NIL)))
(SETF (|parserTrees| |ps|)
(CONS (|reverse!| (|parserTrees| |ps|)) |a|))
(|bpPush| |ps|
(FUNCALL |g|
(CONS (|bpPop3| |ps|)
(CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))))
(T T)))
(T NIL))))
(DEFUN |bpList| (|ps| |f| |str1|)
(LET* (|a|)
(COND
((FUNCALL |f| |ps|)
(COND
((AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|))
(SETQ |a| (|parserTrees| |ps|)) (SETF (|parserTrees| |ps|) NIL)
(LOOP
(COND
((NOT (AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|)))
(RETURN NIL))
(T NIL)))
(SETF (|parserTrees| |ps|)
(CONS (|reverse!| (|parserTrees| |ps|)) |a|))
(|bpPush| |ps|
(CONS (|bpPop3| |ps|)
(CONS (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(T (|bpPush| |ps| (LIST (|bpPop1| |ps|))))))
(T (|bpPush| |ps| NIL)))))
(DEFUN |bpOneOrMore| (|ps| |f|)
(LET* (|a|)
(COND
((FUNCALL |f| |ps|) (SETQ |a| (|parserTrees| |ps|))
(SETF (|parserTrees| |ps|) NIL)
(LOOP (COND ((NOT (FUNCALL |f| |ps|)) (RETURN NIL)) (T NIL)))
(SETF (|parserTrees| |ps|) (CONS (|reverse!| (|parserTrees| |ps|)) |a|))
(|bpPush| |ps| (CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T NIL))))
(DEFUN |bpAnyNo| (|ps| |s|)
(PROGN (LOOP (COND ((NOT (FUNCALL |s| |ps|)) (RETURN NIL)) (T NIL))) T))
(DEFUN |bpAndOr| (|ps| |keyword| |p| |f|)
(AND (|bpEqKey| |ps| |keyword|) (|bpRequire| |ps| |p|)
(|bpPush| |ps| (FUNCALL |f| (|parserLoadUnit| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpConditional| (|ps| |f|)
(COND
((AND (|bpEqKey| |ps| 'IF) (|bpRequire| |ps| #'|bpWhere|)
(OR (|bpEqKey| |ps| 'BACKSET) T))
(COND
((|bpEqKey| |ps| 'SETTAB)
(COND
((|bpEqKey| |ps| 'THEN)
(AND (|bpRequire| |ps| |f|) (|bpElse| |ps| |f|)
(|bpEqKey| |ps| 'BACKTAB)))
(T (|bpMissing| |ps| 'THEN))))
((|bpEqKey| |ps| 'THEN) (AND (|bpRequire| |ps| |f|) (|bpElse| |ps| |f|)))
(T (|bpMissing| |ps| '|then|))))
(T NIL)))
(DEFUN |bpElse| (|ps| |f|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpState| |ps|))
(COND
((|bpBacksetElse| |ps|)
(AND (|bpRequire| |ps| |f|)
(|bpPush| |ps|
(|bfIf| (|bpPop3| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|)))))
(T (|bpRestore| |ps| |a|)
(|bpPush| |ps| (|bfIfThenOnly| (|bpPop2| |ps|) (|bpPop1| |ps|))))))))
(DEFUN |bpBacksetElse| (|ps|)
(COND ((|bpEqKey| |ps| 'BACKSET) (|bpEqKey| |ps| 'ELSE))
(T (|bpEqKey| |ps| 'ELSE))))
(DEFUN |bpEqPeek| (|ps| |s|)
(AND (EQ (|parserTokenClass| |ps|) 'KEY) (EQ |s| (|parserTokenValue| |ps|))))
(DEFUN |bpEqKey| (|ps| |s|)
(AND (EQ (|parserTokenClass| |ps|) 'KEY) (EQ |s| (|parserTokenValue| |ps|))
(|bpNext| |ps|)))
(DEFUN |bpEqKeyNextTok| (|ps| |s|)
(AND (EQ (|parserTokenClass| |ps|) 'KEY) (EQ |s| (|parserTokenValue| |ps|))
(|bpNextToken| |ps|)))
(DEFUN |bpPileTrap| (|ps|) (|bpMissing| |ps| 'BACKTAB))
(DEFUN |bpBrackTrap| (|ps| |x|) (|bpMissingMate| |ps| '] |x|))
(DEFUN |bpParenTrap| (|ps| |x|) (|bpMissingMate| |ps| '|)| |x|))
(DEFUN |bpSpecificErrorHere| (|ps| |key|)
(|bpSpecificErrorAtToken| (|parserCurrentToken| |ps|) |key|))
(DEFUN |bpSpecificErrorAtToken| (|tok| |key|)
(LET* (|a|)
(PROGN (SETQ |a| (|tokenPosition| |tok|)) (|SoftShoeError| |a| |key|))))
(DEFUN |bpGeneralErrorHere| (|ps|) (|bpSpecificErrorHere| |ps| "syntax error"))
(DEFUN |bpIgnoredFromTo| (|pos1| |pos2|)
(PROGN
(|shoeConsole|
(CONCAT "ignored from line " (WRITE-TO-STRING (|lineNo| |pos1|))))
(|shoeConsole| (|lineString| |pos1|))
(|shoeConsole| (CONCAT (|shoeSpaces| (|lineCharacter| |pos1|)) "|"))
(|shoeConsole|
(CONCAT "ignored through line " (WRITE-TO-STRING (|lineNo| |pos2|))))
(|shoeConsole| (|lineString| |pos2|))
(|shoeConsole| (CONCAT (|shoeSpaces| (|lineCharacter| |pos2|)) "|"))))
(DEFUN |bpMissingMate| (|ps| |close| |open|)
(PROGN
(|bpSpecificErrorAtToken| |open| "possibly missing mate")
(|bpMissing| |ps| |close|)))
(DEFUN |bpMissing| (|ps| |s|)
(PROGN
(|bpSpecificErrorHere| |ps| (CONCAT (PNAME |s|) " possibly missing"))
(THROW :OPEN-AXIOM-CATCH-POINT
(CONS :OPEN-AXIOM-CATCH-POINT (CONS '(|BootParserException|) 'TRAPPED)))))
(DEFUN |bpCompMissing| (|ps| |s|)
(OR (|bpEqKey| |ps| |s|) (|bpMissing| |ps| |s|)))
(DEFUN |bpTrap| (|ps|)
(PROGN
(|bpGeneralErrorHere| |ps|)
(THROW :OPEN-AXIOM-CATCH-POINT
(CONS :OPEN-AXIOM-CATCH-POINT (CONS '(|BootParserException|) 'TRAPPED)))))
(DEFUN |bpRecoverTrap| (|ps|)
(LET* (|pos2| |pos1|)
(PROGN
(|bpFirstToken| |ps|)
(SETQ |pos1| (|parserTokenPosition| |ps|))
(|bpMoveTo| |ps| 0)
(SETQ |pos2| (|parserTokenPosition| |ps|))
(|bpIgnoredFromTo| |pos1| |pos2|)
(|bpPush| |ps| (LIST (LIST "pile syntax error"))))))
(DEFUN |bpListAndRecover| (|ps| |f|)
(LET* (|found| |c| |done| |b| |a|)
(PROGN
(SETQ |a| (|parserTrees| |ps|))
(SETQ |b| NIL)
(SETF (|parserTrees| |ps|) NIL)
(SETQ |done| NIL)
(SETQ |c| (|parserTokens| |ps|))
(LOOP
(COND (|done| (RETURN NIL))
(T
(SETQ |found|
(LET ((#1=#:G392
(CATCH :OPEN-AXIOM-CATCH-POINT (FUNCALL |f| |ps|))))
(COND
((AND (CONSP #1#)
(EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
(COND
((EQUAL (CAR #2=(CDR #1#)) '(|BootParserException|))
(LET ((|e| (CDR #2#)))
|e|))
(T (THROW :OPEN-AXIOM-CATCH-POINT #1#))))
(T #1#))))
(COND
((EQ |found| 'TRAPPED) (SETF (|parserTokens| |ps|) |c|)
(|bpRecoverTrap| |ps|))
((NOT |found|) (SETF (|parserTokens| |ps|) |c|)
(|bpGeneralErrorHere| |ps|) (|bpRecoverTrap| |ps|)))
(COND ((|bpEqKey| |ps| 'BACKSET) (SETQ |c| (|parserTokens| |ps|)))
((OR (|bpEqPeek| |ps| 'BACKTAB)
(NULL (|parserTokens| |ps|)))
(SETQ |done| T))
(T (SETF (|parserTokens| |ps|) |c|)
(|bpGeneralErrorHere| |ps|) (|bpRecoverTrap| |ps|)
(COND
((OR (|bpEqPeek| |ps| 'BACKTAB)
(NULL (|parserTokens| |ps|)))
(SETQ |done| T))
(T (|bpNext| |ps|) (SETQ |c| (|parserTokens| |ps|))))))
(SETQ |b| (CONS (|bpPop1| |ps|) |b|)))))
(SETF (|parserTrees| |ps|) |a|)
(|bpPush| |ps| (|reverse!| |b|)))))
(DEFUN |bpMoveTo| (|ps| |n|)
(COND ((NULL (|parserTokens| |ps|)) T)
((|bpEqPeek| |ps| 'BACKTAB)
(COND ((EQL |n| 0) T)
(T (|bpNextToken| |ps|)
(SETF (|parserScope| |ps|) (- (|parserScope| |ps|) 1))
(|bpMoveTo| |ps| (- |n| 1)))))
((|bpEqPeek| |ps| 'BACKSET)
(COND ((EQL |n| 0) T) (T (|bpNextToken| |ps|) (|bpMoveTo| |ps| |n|))))
((|bpEqPeek| |ps| 'SETTAB) (|bpNextToken| |ps|)
(|bpMoveTo| |ps| (+ |n| 1)))
((|bpEqPeek| |ps| 'OPAREN) (|bpNextToken| |ps|)
(SETF (|parserNesting| |ps|) (+ (|parserNesting| |ps|) 1))
(|bpMoveTo| |ps| |n|))
((|bpEqPeek| |ps| 'CPAREN) (|bpNextToken| |ps|)
(SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
(|bpMoveTo| |ps| |n|))
(T (|bpNextToken| |ps|) (|bpMoveTo| |ps| |n|))))
(DEFUN |bpQualifiedName| (|ps|)
(COND
((|bpEqPeek| |ps| 'COLON-COLON) (|bpNext| |ps|)
(AND (EQ (|parserTokenClass| |ps|) 'ID) (|bpPushId| |ps|) (|bpNext| |ps|)
(|bpPush| |ps| (|bfColonColon| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(T NIL)))
(DEFUN |bpName| (|ps|)
(COND
((EQ (|parserTokenClass| |ps|) 'ID) (|bpPushId| |ps|) (|bpNext| |ps|)
(|bpAnyNo| |ps| #'|bpQualifiedName|))
(T NIL)))
(DEFUN |bpConstTok| (|ps|)
(COND
((|symbolMember?| (|parserTokenClass| |ps|) '(INTEGER FLOAT))
(|bpPush| |ps| (|parserTokenValue| |ps|)) (|bpNext| |ps|))
((EQ (|parserTokenClass| |ps|) 'LISP)
(AND (|bpPush| |ps| (|%Lisp| (|parserTokenValue| |ps|))) (|bpNext| |ps|)))
((EQ (|parserTokenClass| |ps|) 'LISPEXP)
(AND (|bpPush| |ps| (|parserTokenValue| |ps|)) (|bpNext| |ps|)))
((EQ (|parserTokenClass| |ps|) 'LINE)
(AND (|bpPush| |ps| (LIST '+LINE (|parserTokenValue| |ps|)))
(|bpNext| |ps|)))
((|bpEqPeek| |ps| 'QUOTE) (|bpNext| |ps|)
(AND (|bpRequire| |ps| #'|bpSexp|)
(|bpPush| |ps| (|bfSymbol| (|bpPop1| |ps|)))))
(T (OR (|bpString| |ps|) (|bpFunction| |ps|) (|bpInert| |ps|)))))
(DEFUN |bpInert| (|ps|)
(COND
((EQ (|parserTokenClass| |ps|) 'INERT)
(AND (|bpPush| |ps| (|bfInert| (|parserTokenValue| |ps|)))
(|bpNext| |ps|)))
(T NIL)))
(DEFUN |bpChar| (|ps|)
(LET* (|ISTMP#1| |s| |a|)
(COND
((AND (EQ (|parserTokenClass| |ps|) 'ID)
(EQ (|parserTokenValue| |ps|) '|char|))
(SETQ |a| (|bpState| |ps|))
(COND
((|bpApplication| |ps|) (SETQ |s| (|bpPop1| |ps|))
(COND
((AND (CONSP |s|) (EQ (CAR |s|) '|char|)
(PROGN
(SETQ |ISTMP#1| (CDR |s|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))))
(|bpPush| |ps| |s|))
(T (|bpRestore| |ps| |a|) NIL)))
(T NIL)))
(T NIL))))
(DEFUN |bpExportItemTail| (|ps|)
(OR
(AND (|bpEqKey| |ps| 'BEC) (|bpRequire| |ps| #'|bpAssign|)
(|bpPush| |ps| (|%Assignment| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(|bpSimpleDefinitionTail| |ps|)))
(DEFUN |bpExportItem| (|ps|)
(LET* (|a|)
(COND ((|bpEqPeek| |ps| 'STRUCTURE) (|bpStruct| |ps|))
(T (SETQ |a| (|bpState| |ps|))
(COND
((|bpName| |ps|)
(COND
((|bpEqPeek| |ps| 'COLON) (|bpRestore| |ps| |a|)
(|bpRequire| |ps| #'|bpSignature|)
(OR (|bpExportItemTail| |ps|) T))
(T (|bpRestore| |ps| |a|) (|bpTypeAliasDefinition| |ps|))))
(T NIL))))))
(DEFUN |bpExportItemList| (|ps|) (|bpListAndRecover| |ps| #'|bpExportItem|))
(DEFUN |bpModuleInterface| (|ps|)
(COND
((|bpEqKey| |ps| 'WHERE)
(OR (|bpPileBracketed| |ps| #'|bpExportItemList|)
(AND (|bpExportItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1| |ps|))))
(|bpTrap| |ps|)))
(T (|bpPush| |ps| NIL))))
(DEFUN |bpModuleExports| (|ps|)
(COND
((|bpParenthesized| |ps| #'|bpIdList|)
(|bpPush| |ps| (|bfUntuple| (|bpPop1| |ps|))))
(T (|bpPush| |ps| NIL))))
(DEFUN |bpModule| (|ps|)
(COND
((|bpEqKey| |ps| 'MODULE) (|bpRequire| |ps| #'|bpName|)
(|bpModuleExports| |ps|) (|bpModuleInterface| |ps|)
(|bpPush| |ps|
(|%Module| (|bpPop3| |ps|) (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T NIL)))
(DEFUN |bpImport| (|ps|)
(LET* (|a|)
(COND
((|bpEqKey| |ps| 'IMPORT)
(COND
((|bpEqKey| |ps| 'NAMESPACE)
(OR
(AND (|bpLeftAssoc| |ps| '(DOT) #'|bpName|)
(|bpPush| |ps| (|%Import| (|bfNamespace| (|bpPop1| |ps|)))))
(|bpTrap| |ps|)))
(T (SETQ |a| (|bpState| |ps|)) (|bpRequire| |ps| #'|bpName|)
(COND
((|bpEqPeek| |ps| 'COLON) (|bpRestore| |ps| |a|)
(AND (|bpRequire| |ps| #'|bpSignature|)
(OR (|bpEqKey| |ps| 'FOR) (|bpTrap| |ps|))
(|bpRequire| |ps| #'|bpName|)
(|bpPush| |ps|
(|%ImportSignature| (|bpPop1| |ps|)
(|bpPop1| |ps|)))))
(T (|bpPush| |ps| (|%Import| (|bpPop1| |ps|))))))))
(T NIL))))
(DEFUN |bpNamespace| (|ps|)
(AND (|bpEqKey| |ps| 'NAMESPACE) (OR (|bpName| |ps|) (|bpDot| |ps|))
(|bpPush| |ps| (|bfNamespace| (|bpPop1| |ps|)))))
(DEFUN |bpTypeAliasDefinition| (|ps|)
(AND (|bpTypeName| |ps|) (|bpEqKey| |ps| 'TDEF) (|bpLogical| |ps|)
(|bpPush| |ps| (|%TypeAlias| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpTypeName| (|ps|) (OR (|bpTerm| |ps| #'|bpIdList|) (|bpTrap| |ps|)))
(DEFUN |bpSignature| (|ps|) (AND (|bpName| |ps|) (|bpSignatureTail| |ps|)))
(DEFUN |bpSignatureTail| (|ps|)
(AND (|bpEqKey| |ps| 'COLON) (|bpRequire| |ps| #'|bpTyping|)
(|bpPush| |ps| (|bfSignature| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpSimpleMapping| (|ps|)
(COND
((|bpApplication| |ps|)
(AND (|bpEqKey| |ps| 'ARROW) (|bpRequire| |ps| #'|bpApplication|)
(|bpPush| |ps| (|%Mapping| (|bpPop1| |ps|) (LIST (|bpPop1| |ps|)))))
T)
(T NIL)))
(DEFUN |bpArgtypeList| (|ps|) (|bpTuple| |ps| #'|bpSimpleMapping|))
(DEFUN |bpMapping| (|ps|)
(AND (|bpParenthesized| |ps| #'|bpArgtypeList|) (|bpEqKey| |ps| 'ARROW)
(|bpApplication| |ps|)
(|bpPush| |ps|
(|%Mapping| (|bpPop1| |ps|) (|bfUntuple| (|bpPop1| |ps|))))))
(DEFUN |bpCancel| (|ps|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpState| |ps|))
(COND
((|bpEqKeyNextTok| |ps| 'SETTAB)
(COND
((|bpCancel| |ps|)
(COND ((|bpEqKeyNextTok| |ps| 'BACKTAB) T)
(T (|bpRestore| |ps| |a|) NIL)))
((|bpEqKeyNextTok| |ps| 'BACKTAB) T) (T (|bpRestore| |ps| |a|) NIL)))
(T NIL)))))
(DEFUN |bpAddTokens| (|ps| |n|)
(COND ((EQL |n| 0) NIL)
((PLUSP |n|)
(CONS (|mk%Token| 'KEY 'SETTAB (|parserTokenPosition| |ps|))
(|bpAddTokens| |ps| (- |n| 1))))
(T
(CONS (|mk%Token| 'KEY 'BACKTAB (|parserTokenPosition| |ps|))
(|bpAddTokens| |ps| (+ |n| 1))))))
(DEFUN |bpExceptions| (|ps|)
(OR (|bpEqPeek| |ps| 'DOT) (|bpEqPeek| |ps| 'QUOTE) (|bpEqPeek| |ps| 'OPAREN)
(|bpEqPeek| |ps| 'CPAREN) (|bpEqPeek| |ps| 'SETTAB)
(|bpEqPeek| |ps| 'BACKTAB) (|bpEqPeek| |ps| 'BACKSET)))
(DEFUN |bpSexpKey| (|ps|)
(LET* (|a|)
(COND
((AND (EQ (|parserTokenClass| |ps|) 'KEY) (NOT (|bpExceptions| |ps|)))
(SETQ |a| (GET (|parserTokenValue| |ps|) 'SHOEINF))
(COND
((NULL |a|)
(AND (|bpPush| |ps| (|keywordId| (|parserTokenValue| |ps|)))
(|bpNext| |ps|)))
(T (AND (|bpPush| |ps| |a|) (|bpNext| |ps|)))))
(T NIL))))
(DEFUN |bpAnyId| (|ps|)
(OR
(AND (|bpEqKey| |ps| 'MINUS)
(OR (EQ (|parserTokenClass| |ps|) 'INTEGER) (|bpTrap| |ps|))
(|bpPush| |ps| (- (|parserTokenValue| |ps|))) (|bpNext| |ps|))
(|bpSexpKey| |ps|)
(AND (|symbolMember?| (|parserTokenClass| |ps|) '(ID INTEGER STRING FLOAT))
(|bpPush| |ps| (|parserTokenValue| |ps|)) (|bpNext| |ps|))))
(DEFUN |bpSexp| (|ps|)
(OR (|bpAnyId| |ps|)
(AND (|bpEqKey| |ps| 'QUOTE) (|bpRequire| |ps| #'|bpSexp|)
(|bpPush| |ps| (|bfSymbol| (|bpPop1| |ps|))))
(|bpIndentParenthesized| |ps| #'|bpSexp1|)))
(DEFUN |bpSexp1| (|ps|)
(OR
(AND (|bpFirstTok| |ps|) (|bpSexp| |ps|)
(OR
(AND (|bpEqKey| |ps| 'DOT) (|bpSexp| |ps|)
(|bpPush| |ps| (CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))
(AND (|bpSexp1| |ps|)
(|bpPush| |ps| (CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))))
(|bpPush| |ps| NIL)))
(DEFUN |bpPrimary1| (|ps|)
(OR (|bpParenthesizedApplication| |ps|) (|bpDot| |ps|) (|bpConstTok| |ps|)
(|bpConstruct| |ps|) (|bpCase| |ps|) (|bpStruct| |ps|)
(|bpPDefinition| |ps|) (|bpBPileDefinition| |ps|)))
(DEFUN |bpParenthesizedApplication| (|ps|)
(AND (|bpName| |ps|) (|bpAnyNo| |ps| #'|bpArgumentList|)))
(DEFUN |bpArgumentList| (|ps|)
(AND (|bpPDefinition| |ps|)
(|bpPush| |ps| (|bfApplication| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpPrimary| (|ps|)
(AND (|bpFirstTok| |ps|) (OR (|bpPrimary1| |ps|) (|bpPrefixOperator| |ps|))))
(DEFUN |bpDot| (|ps|) (AND (|bpEqKey| |ps| 'DOT) (|bpPush| |ps| (|bfDot|))))
(DEFUN |bpPrefixOperator| (|ps|)
(AND (EQ (|parserTokenClass| |ps|) 'KEY)
(GET (|parserTokenValue| |ps|) 'SHOEPRE) (|bpPushId| |ps|)
(|bpNext| |ps|)))
(DEFUN |bpInfixOperator| (|ps|)
(AND (EQ (|parserTokenClass| |ps|) 'KEY)
(GET (|parserTokenValue| |ps|) 'SHOEINF) (|bpPushId| |ps|)
(|bpNext| |ps|)))
(DEFUN |bpSelector| (|ps|)
(AND (|bpEqKey| |ps| 'DOT)
(OR
(AND (|bpPrimary| |ps|)
(|bpPush| |ps| (|bfElt| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(|bpPush| |ps| (|bfSuffixDot| (|bpPop1| |ps|))))))
(DEFUN |bpApplication| (|ps|)
(OR
(AND (|bpPrimary| |ps|) (|bpAnyNo| |ps| #'|bpSelector|)
(OR
(AND (|bpApplication| |ps|)
(|bpPush| |ps|
(|bfApplication| (|bpPop2| |ps|) (|bpPop1| |ps|))))
T))
(|bpNamespace| |ps|)))
(DEFUN |bpTyping| (|ps|)
(COND
((|bpEqKey| |ps| 'FORALL) (|bpRequire| |ps| #'|bpVariable|)
(OR (AND (|bpDot| |ps|) (|bpPop1| |ps|)) (|bpTrap| |ps|))
(|bpRequire| |ps| #'|bpTyping|)
(|bpPush| |ps| (|%Forall| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T (OR (|bpMapping| |ps|) (|bpSimpleMapping| |ps|)))))
(DEFUN |bpTyped| (|ps|)
(AND (|bpApplication| |ps|)
(COND ((|bpSignatureTail| |ps|) T)
((|bpEqKey| |ps| 'AT)
(AND (|bpRequire| |ps| #'|bpTyping|)
(|bpPush| |ps|
(|bfRestrict| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(T T))))
(DEFUN |bpExpt| (|ps|) (|bpRightAssoc| |ps| '(POWER) #'|bpTyped|))
(DEFUN |bpInfKey| (|ps| |s|)
(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)))
(DEFUN |bpRightAssoc| (|ps| |o| |p|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpState| |ps|))
(COND
((FUNCALL |p| |ps|)
(LOOP
(COND
((NOT
(AND (|bpInfGeneric| |ps| |o|)
(OR (|bpRightAssoc| |ps| |o| |p|) (|bpTrap| |ps|))))
(RETURN NIL))
(T
(|bpPush| |ps|
(|bfInfApplication| (|bpPop2| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|))))))
T)
(T (|bpRestore| |ps| |a|) NIL)))))
(DEFUN |bpLeftAssoc| (|ps| |operations| |parser|)
(COND
((FUNCALL |parser| |ps|)
(LOOP
(COND
((NOT
(AND (|bpInfGeneric| |ps| |operations|) (|bpRequire| |ps| |parser|)))
(RETURN NIL))
(T
(|bpPush| |ps|
(|bfInfApplication| (|bpPop2| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|))))))
T)
(T NIL)))
(DEFUN |bpString| (|ps|)
(AND (EQ (|parserTokenClass| |ps|) 'STRING)
(|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|)
(COND
((AND (EQ (|parserTokenClass| |ps|) 'ID)
(GET (|parserTokenValue| |ps|) 'SHOETHETA))
(|bpPushId| |ps|) (|bpNext| |ps|))
(T NIL)))
(DEFUN |bpReduceOperator| (|ps|)
(OR (|bpInfixOperator| |ps|) (|bpString| |ps|) (|bpThetaName| |ps|)))
(DEFUN |bpReduce| (|ps|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpState| |ps|))
(COND
((AND (|bpReduceOperator| |ps|) (|bpEqKey| |ps| 'SLASH))
(COND
((|bpEqPeek| |ps| 'OBRACK)
(AND (|bpRequire| |ps| #'|bpDConstruct|)
(|bpPush| |ps|
(|bfReduceCollect| (|parserLoadUnit| |ps|)
(|bpPop2| |ps|) (|bpPop1| |ps|)))))
(T
(AND (|bpRequire| |ps| #'|bpApplication|)
(|bpPush| |ps|
(|bfReduce| (|parserLoadUnit| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|)))))))
(T (|bpRestore| |ps| |a|) NIL)))))
(DEFUN |bpTimes| (|ps|)
(OR (|bpReduce| |ps|) (|bpLeftAssoc| |ps| '(TIMES SLASH) #'|bpExpt|)))
(DEFUN |bpEuclid| (|ps|) (|bpLeftAssoc| |ps| '(QUO REM) #'|bpTimes|))
(DEFUN |bpMinus| (|ps|)
(OR
(AND (|bpInfGeneric| |ps| '(MINUS)) (|bpRequire| |ps| #'|bpEuclid|)
(|bpPush| |ps| (|bfApplication| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(|bpEuclid| |ps|)))
(DEFUN |bpArith| (|ps|) (|bpLeftAssoc| |ps| '(PLUS MINUS) #'|bpMinus|))
(DEFUN |bpIs| (|ps|)
(AND (|bpArith| |ps|)
(COND
((AND (|bpInfKey| |ps| '(IS ISNT)) (|bpRequire| |ps| #'|bpPattern|))
(|bpPush| |ps|
(|bfISApplication| (|parserLoadUnit| |ps|) (|bpPop2| |ps|)
(|bpPop2| |ps|) (|bpPop1| |ps|))))
((AND (|bpEqKey| |ps| 'HAS) (|bpRequire| |ps| #'|bpApplication|))
(|bpPush| |ps| (|bfHas| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T T))))
(DEFUN |bpBracketConstruct| (|ps| |f|)
(AND (|bpBracket| |ps| |f|) (|bpPush| |ps| (|bfConstruct| (|bpPop1| |ps|)))))
(DEFUN |bpCompare| (|ps|)
(OR
(AND (|bpIs| |ps|)
(OR
(AND (|bpInfKey| |ps| '(SHOEEQ SHOENE LT LE GT GE IN))
(|bpRequire| |ps| #'|bpIs|)
(|bpPush| |ps|
(|bfInfApplication| (|bpPop2| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|))))
T))
(|bpLeave| |ps|) (|bpThrow| |ps|)))
(DEFUN |bpAnd| (|ps|) (|bpLeftAssoc| |ps| '(AND) #'|bpCompare|))
(DEFUN |bpThrow| (|ps|)
(COND
((AND (|bpEqKey| |ps| 'THROW) (|bpApplication| |ps|))
(|bpSignatureTail| |ps|) (|bpPush| |ps| (|bfThrow| (|bpPop1| |ps|))))
(T NIL)))
(DEFUN |bpTry| (|ps|)
(LET* (|cs|)
(COND
((|bpEqKey| |ps| 'TRY) (|bpAssign| |ps|) (SETQ |cs| NIL)
(LOOP
(COND ((NOT (|bpHandler| |ps| 'CATCH)) (RETURN NIL))
(T (|bpCatchItem| |ps|) (SETQ |cs| (CONS (|bpPop1| |ps|) |cs|)))))
(COND
((|bpHandler| |ps| 'FINALLY)
(AND (|bpFinally| |ps|)
(|bpPush| |ps|
(|bfTry| (|bpPop2| |ps|)
(|reverse!| (CONS (|bpPop1| |ps|) |cs|))))))
((NULL |cs|) (|bpTrap| |ps|))
(T (|bpPush| |ps| (|bfTry| (|bpPop1| |ps|) (|reverse!| |cs|))))))
(T NIL))))
(DEFUN |bpCatchItem| (|ps|)
(AND (|bpRequire| |ps| #'|bpExceptionVariable|)
(OR (|bpEqKey| |ps| 'EXIT) (|bpTrap| |ps|))
(|bpRequire| |ps| #'|bpAssign|)
(|bpPush| |ps| (|%Catch| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpExceptionVariable| (|ps|)
(LET* (|t|)
(PROGN
(SETQ |t| (|parserCurrentToken| |ps|))
(OR
(AND (|bpEqKey| |ps| 'OPAREN) (|bpRequire| |ps| #'|bpSignature|)
(OR (|bpEqKey| |ps| 'CPAREN) (|bpMissing| |ps| |t|)))
(|bpTrap| |ps|)))))
(DEFUN |bpFinally| (|ps|)
(AND (|bpRequire| |ps| #'|bpAssign|)
(|bpPush| |ps| (|%Finally| (|bpPop1| |ps|)))))
(DEFUN |bpHandler| (|ps| |key|)
(LET* (|s|)
(PROGN
(SETQ |s| (|bpState| |ps|))
(COND
((AND (OR (|bpEqKey| |ps| 'BACKSET) (|bpEqKey| |ps| 'SEMICOLON))
(|bpEqKey| |ps| |key|))
T)
(T (|bpRestore| |ps| |s|) NIL)))))
(DEFUN |bpLeave| (|ps|)
(AND (|bpEqKey| |ps| 'LEAVE) (|bpRequire| |ps| #'|bpLogical|)
(|bpPush| |ps| (|bfLeave| (|bpPop1| |ps|)))))
(DEFUN |bpDo| (|ps|)
(COND
((|bpEqKey| |ps| 'IN) (|bpRequire| |ps| #'|bpNamespace|)
(|bpRequire| |ps| #'|bpDo|)
(|bpPush| |ps| (|bfAtScope| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T
(AND (|bpEqKey| |ps| 'DO) (|bpRequire| |ps| #'|bpAssign|)
(|bpPush| |ps| (|bfDo| (|bpPop1| |ps|)))))))
(DEFUN |bpReturn| (|ps|)
(OR
(AND (|bpEqKey| |ps| 'RETURN) (|bpRequire| |ps| #'|bpAssign|)
(|bpPush| |ps| (|bfReturnNoName| (|bpPop1| |ps|))))
(|bpLeave| |ps|) (|bpThrow| |ps|) (|bpAnd| |ps|) (|bpDo| |ps|)))
(DEFUN |bpLogical| (|ps|) (|bpLeftAssoc| |ps| '(OR) #'|bpReturn|))
(DEFUN |bpExpression| (|ps|)
(OR
(AND (|bpEqKey| |ps| 'COLON)
(OR
(AND (|bpLogical| |ps|)
(|bpPush| |ps| (|bfApplication| 'COLON (|bpPop1| |ps|))))
(|bpTrap| |ps|)))
(|bpLogical| |ps|)))
(DEFUN |bpStatement| (|ps|)
(OR (|bpConditional| |ps| #'|bpWhere|) (|bpLoop| |ps|) (|bpExpression| |ps|)
(|bpTry| |ps|)))
(DEFUN |bpLoop| (|ps|)
(OR
(AND (|bpIterators| |ps|) (|bpCompMissing| |ps| 'REPEAT)
(|bpRequire| |ps| #'|bpWhere|)
(|bpPush| |ps|
(|bfLp| (|parserLoadUnit| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|))))
(AND (|bpEqKey| |ps| 'REPEAT) (|bpRequire| |ps| #'|bpLogical|)
(|bpPush| |ps| (|bfLoop1| (|parserLoadUnit| |ps|) (|bpPop1| |ps|))))))
(DEFUN |bpSuchThat| (|ps|) (|bpAndOr| |ps| 'BAR #'|bpWhere| #'|bfSuchthat|))
(DEFUN |bpWhile| (|ps|) (|bpAndOr| |ps| 'WHILE #'|bpLogical| #'|bfWhile|))
(DEFUN |bpUntil| (|ps|) (|bpAndOr| |ps| 'UNTIL #'|bpLogical| #'|bfUntil|))
(DEFUN |bpFormal| (|ps|) (OR (|bpVariable| |ps|) (|bpDot| |ps|)))
(DEFUN |bpForIn| (|ps|)
(AND (|bpEqKey| |ps| 'FOR) (|bpRequire| |ps| #'|bpFormal|)
(|bpCompMissing| |ps| 'IN)
(OR
(AND (|bpRequire| |ps| #'|bpSeg|) (|bpEqKey| |ps| 'BY)
(|bpRequire| |ps| #'|bpArith|)
(|bpPush| |ps|
(|bfForInBy| (|parserLoadUnit| |ps|) (|bpPop3| |ps|)
(|bpPop2| |ps|) (|bpPop1| |ps|))))
(|bpPush| |ps|
(|bfForin| (|parserLoadUnit| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|))))))
(DEFUN |bpSeg| (|ps|)
(AND (|bpArith| |ps|)
(OR
(AND (|bpEqKey| |ps| 'SEG)
(OR
(AND (|bpArith| |ps|)
(|bpPush| |ps|
(|bfSegment2| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(|bpPush| |ps| (|bfSegment1| (|bpPop1| |ps|)))))
T)))
(DEFUN |bpIterator| (|ps|)
(OR (|bpForIn| |ps|) (|bpSuchThat| |ps|) (|bpWhile| |ps|) (|bpUntil| |ps|)))
(DEFUN |bpIteratorList| (|ps|)
(AND (|bpOneOrMore| |ps| #'|bpIterator|)
(|bpPush| |ps| (|bfIterators| (|bpPop1| |ps|)))))
(DEFUN |bpCrossBackSet| (|ps|)
(AND (|bpEqKey| |ps| 'CROSS) (OR (|bpEqKey| |ps| 'BACKSET) T)))
(DEFUN |bpIterators| (|ps|)
(|bpListofFun| |ps| #'|bpIteratorList| #'|bpCrossBackSet| #'|bfCross|))
(DEFUN |bpAssign| (|ps|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpState| |ps|))
(COND
((|bpStatement| |ps|)
(COND
((|bpEqPeek| |ps| 'BEC) (|bpRestore| |ps| |a|)
(|bpRequire| |ps| #'|bpAssignment|))
((|bpEqPeek| |ps| 'GIVES) (|bpRestore| |ps| |a|)
(|bpRequire| |ps| #'|bpLambda|))
((|bpEqPeek| |ps| 'LARROW) (|bpRestore| |ps| |a|)
(|bpRequire| |ps| #'|bpKeyArg|))
(T T)))
(T (|bpRestore| |ps| |a|) NIL)))))
(DEFUN |bpAssignment| (|ps|)
(AND (|bpAssignVariable| |ps|) (|bpEqKey| |ps| 'BEC)
(|bpRequire| |ps| #'|bpAssign|)
(|bpPush| |ps|
(|bfAssign| (|parserLoadUnit| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|)))))
(DEFUN |bpLambda| (|ps|)
(AND (|bpVariable| |ps|) (|bpEqKey| |ps| 'GIVES)
(|bpRequire| |ps| #'|bpAssign|)
(|bpPush| |ps| (|bfLambda| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpKeyArg| (|ps|)
(AND (|bpName| |ps|) (|bpEqKey| |ps| 'LARROW) (|bpLogical| |ps|)
(|bpPush| |ps| (|bfKeyArg| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpExit| (|ps|)
(AND (|bpAssign| |ps|)
(OR
(AND (|bpEqKey| |ps| 'EXIT) (|bpRequire| |ps| #'|bpWhere|)
(|bpPush| |ps| (|bfExit| (|bpPop2| |ps|) (|bpPop1| |ps|))))
T)))
(DEFUN |bpDefinition| (|ps|)
(LET* (|a|)
(COND
((|bpEqKey| |ps| 'MACRO)
(OR
(AND (|bpName| |ps|) (|bpStoreName| |ps|)
(|bpCompoundDefinitionTail| |ps| #'|%Macro|))
(|bpTrap| |ps|)))
(T (SETQ |a| (|bpState| |ps|))
(COND
((|bpExit| |ps|)
(COND ((|bpEqPeek| |ps| 'DEF) (|bpRestore| |ps| |a|) (|bpDef| |ps|))
((|bpEqPeek| |ps| 'TDEF) (|bpRestore| |ps| |a|)
(|bpTypeAliasDefinition| |ps|))
(T T)))
(T (|bpRestore| |ps| |a|) NIL))))))
(DEFUN |bpStoreName| (|ps|)
(PROGN
(SETF (|enclosingFunction| (|parserLoadUnit| |ps|))
(CAR (|parserTrees| |ps|)))
(SETF (|sideConditions| (|parserLoadUnit| |ps|)) NIL)
T))
(DEFUN |bpDef| (|ps|)
(OR
(AND (|bpName| |ps|) (|bpStoreName| |ps|)
(|bpDefTail| |ps| #'|%Definition|))
(AND (|bpNamespace| |ps|) (|bpSimpleDefinitionTail| |ps|))))
(DEFUN |bpDDef| (|ps|) (AND (|bpName| |ps|) (|bpDefTail| |ps| #'|%Definition|)))
(DEFUN |bpSimpleDefinitionTail| (|ps|)
(AND (|bpEqKey| |ps| 'DEF) (|bpRequire| |ps| #'|bpWhere|)
(|bpPush| |ps| (|%ConstantDefinition| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpCompoundDefinitionTail| (|ps| |f|)
(AND (|bpVariable| |ps|) (|bpEqKey| |ps| 'DEF) (|bpRequire| |ps| #'|bpWhere|)
(|bpPush| |ps|
(FUNCALL |f| (|bpPop3| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|)))))
(DEFUN |bpDefTail| (|ps| |f|)
(OR (|bpSimpleDefinitionTail| |ps|) (|bpCompoundDefinitionTail| |ps| |f|)))
(DEFUN |bpWhere| (|ps|)
(AND (|bpDefinition| |ps|)
(OR
(AND (|bpEqKey| |ps| 'WHERE) (|bpRequire| |ps| #'|bpDefinitionItem|)
(|bpPush| |ps|
(|bfWhere| (|parserLoadUnit| |ps|) (|bpPop1| |ps|)
(|bpPop1| |ps|))))
T)))
(DEFUN |bpDefinitionItem| (|ps|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpState| |ps|))
(COND ((|bpDDef| |ps|) T)
(T (|bpRestore| |ps| |a|)
(COND ((|bpBDefinitionPileItems| |ps|) T)
(T (|bpRestore| |ps| |a|)
(COND ((|bpPDefinitionItems| |ps|) T)
(T (|bpRestore| |ps| |a|) (|bpWhere| |ps|))))))))))
(DEFUN |bpDefinitionPileItems| (|ps|)
(AND (|bpListAndRecover| |ps| #'|bpDefinitionItem|)
(|bpPush| |ps| (|%Pile| (|bpPop1| |ps|)))))
(DEFUN |bpBDefinitionPileItems| (|ps|)
(|bpPileBracketed| |ps| #'|bpDefinitionPileItems|))
(DEFUN |bpSemiColonDefinition| (|ps|)
(|bpSemiListing| |ps| #'|bpDefinitionItem| #'|%Pile|))
(DEFUN |bpPDefinitionItems| (|ps|)
(|bpParenthesized| |ps| #'|bpSemiColonDefinition|))
(DEFUN |bpComma| (|ps|)
(OR (|bpModule| |ps|) (|bpImport| |ps|) (|bpTuple| |ps| #'|bpWhere|)))
(DEFUN |bpTuple| (|ps| |p|)
(|bpListofFun| |ps| |p| #'|bpCommaBackSet| #'|bfTuple|))
(DEFUN |bpCommaBackSet| (|ps|)
(AND (|bpEqKey| |ps| 'COMMA) (OR (|bpEqKey| |ps| 'BACKSET) T)))
(DEFUN |bpSemiColon| (|ps|) (|bpSemiListing| |ps| #'|bpComma| #'|bfSequence|))
(DEFUN |bpSemiListing| (|ps| |p| |f|)
(|bpListofFun| |ps| |p| #'|bpSemiBackSet| |f|))
(DEFUN |bpSemiBackSet| (|ps|)
(AND (|bpEqKey| |ps| 'SEMICOLON) (OR (|bpEqKey| |ps| 'BACKSET) T)))
(DEFUN |bpPDefinition| (|ps|) (|bpIndentParenthesized| |ps| #'|bpSemiColon|))
(DEFUN |bpPileItems| (|ps|)
(AND (|bpListAndRecover| |ps| #'|bpSemiColon|)
(|bpPush| |ps| (|bfSequence| (|bpPop1| |ps|)))))
(DEFUN |bpBPileDefinition| (|ps|) (|bpPileBracketed| |ps| #'|bpPileItems|))
(DEFUN |bpIteratorTail| (|ps|)
(AND (OR (|bpEqKey| |ps| 'REPEAT) T) (|bpIterators| |ps|)))
(DEFUN |bpConstruct| (|ps|) (|bpBracket| |ps| #'|bpConstruction|))
(DEFUN |bpConstruction| (|ps|)
(AND (|bpComma| |ps|)
(OR
(AND (|bpIteratorTail| |ps|)
(|bpPush| |ps|
(|bfCollect| (|parserLoadUnit| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|))))
(|bpPush| |ps| (|bfTupleConstruct| (|bpPop1| |ps|))))))
(DEFUN |bpDConstruct| (|ps|) (|bpBracket| |ps| #'|bpDConstruction|))
(DEFUN |bpDConstruction| (|ps|)
(AND (|bpComma| |ps|)
(OR
(AND (|bpIteratorTail| |ps|)
(|bpPush| |ps| (|bfDCollect| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(|bpPush| |ps| (|bfDTuple| (|bpPop1| |ps|))))))
(DEFUN |bpPattern| (|ps|)
(OR (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpChar| |ps|)
(|bpName| |ps|) (|bpConstTok| |ps|)))
(DEFUN |bpEqual| (|ps|)
(AND (|bpEqKey| |ps| 'SHOEEQ)
(OR (|bpApplication| |ps|) (|bpConstTok| |ps|) (|bpTrap| |ps|))
(|bpPush| |ps| (|bfEqual| (|bpPop1| |ps|)))))
(DEFUN |bpRegularPatternItem| (|ps|)
(OR (|bpEqual| |ps|) (|bpConstTok| |ps|) (|bpDot| |ps|)
(AND (|bpName| |ps|)
(OR
(AND (|bpEqKey| |ps| 'BEC) (|bpRequire| |ps| #'|bpPattern|)
(|bpPush| |ps|
(|bfAssign| (|parserLoadUnit| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|))))
T))
(|bpBracketConstruct| |ps| #'|bpPatternL|)))
(DEFUN |bpRegularPatternItemL| (|ps|)
(AND (|bpRegularPatternItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1| |ps|)))))
(DEFUN |bpRegularList| (|ps|)
(|bpListof| |ps| #'|bpRegularPatternItemL| 'COMMA #'|bfAppend|))
(DEFUN |bpPatternColon| (|ps|)
(AND (|bpEqKey| |ps| 'COLON) (|bpRequire| |ps| #'|bpRegularPatternItem|)
(|bpPush| |ps| (LIST (|bfColon| (|bpPop1| |ps|))))))
(DEFUN |bpPatternL| (|ps|)
(AND (|bpPatternList| |ps|) (|bpPush| |ps| (|bfTuple| (|bpPop1| |ps|)))))
(DEFUN |bpPatternList| (|ps|)
(COND
((|bpRegularPatternItemL| |ps|)
(LOOP
(COND
((NOT
(AND (|bpEqKey| |ps| 'COMMA)
(OR (|bpRegularPatternItemL| |ps|)
(PROGN
(OR
(AND (|bpPatternTail| |ps|)
(|bpPush| |ps|
(|append| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(|bpTrap| |ps|))
NIL))))
(RETURN NIL))
(T (|bpPush| |ps| (|append| (|bpPop2| |ps|) (|bpPop1| |ps|))))))
T)
(T (|bpPatternTail| |ps|))))
(DEFUN |bpPatternTail| (|ps|)
(AND (|bpPatternColon| |ps|)
(OR
(AND (|bpEqKey| |ps| 'COMMA) (|bpRequire| |ps| #'|bpRegularList|)
(|bpPush| |ps| (|append| (|bpPop2| |ps|) (|bpPop1| |ps|))))
T)))
(DEFUN |bpRegularBVItemTail| (|ps|)
(OR (|bpSignatureTail| |ps|)
(AND (|bpEqKey| |ps| 'BEC) (|bpRequire| |ps| #'|bpPattern|)
(|bpPush| |ps|
(|bfAssign| (|parserLoadUnit| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|))))
(AND (|bpEqKey| |ps| 'IS) (|bpRequire| |ps| #'|bpPattern|)
(|bpPush| |ps|
(|bfAssign| (|parserLoadUnit| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|))))
(AND (|bpEqKey| |ps| 'DEF) (|bpRequire| |ps| #'|bpApplication|)
(|bpPush| |ps| (|%DefaultValue| (|bpPop2| |ps|) (|bpPop1| |ps|))))))
(DEFUN |bpRegularBVItem| (|ps|)
(OR (|bpBVString| |ps|) (|bpConstTok| |ps|)
(AND (|bpName| |ps|) (OR (|bpRegularBVItemTail| |ps|) T))
(|bpBracketConstruct| |ps| #'|bpPatternL|)))
(DEFUN |bpBVString| (|ps|)
(AND (EQ (|parserTokenClass| |ps|) 'STRING)
(|bpPush| |ps| (LIST 'BVQUOTE (INTERN (|parserTokenValue| |ps|))))
(|bpNext| |ps|)))
(DEFUN |bpRegularBVItemL| (|ps|)
(AND (|bpRegularBVItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1| |ps|)))))
(DEFUN |bpColonName| (|ps|)
(AND (|bpEqKey| |ps| 'COLON)
(OR (|bpName| |ps|) (|bpBVString| |ps|) (|bpTrap| |ps|))))
(DEFUN |bpBoundVariablelist| (|ps|)
(COND
((|bpRegularBVItemL| |ps|)
(LOOP
(COND
((NOT
(AND (|bpEqKey| |ps| 'COMMA)
(OR (|bpRegularBVItemL| |ps|)
(PROGN
(OR
(AND (|bpColonName| |ps|)
(|bpPush| |ps|
(|bfColonAppend| (|bpPop2| |ps|)
(|bpPop1| |ps|))))
(|bpTrap| |ps|))
NIL))))
(RETURN NIL))
(T (|bpPush| |ps| (|append| (|bpPop2| |ps|) (|bpPop1| |ps|))))))
T)
(T
(AND (|bpColonName| |ps|)
(|bpPush| |ps| (|bfColonAppend| NIL (|bpPop1| |ps|)))))))
(DEFUN |bpVariable| (|ps|)
(OR
(AND (|bpParenthesized| |ps| #'|bpBoundVariablelist|)
(|bpPush| |ps| (|bfTupleIf| (|bpPop1| |ps|))))
(|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpName| |ps|)
(|bpConstTok| |ps|)))
(DEFUN |bpAssignVariable| (|ps|)
(OR (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpAssignLHS| |ps|)))
(DEFUN |bpAssignLHS| (|ps|)
(COND ((NOT (|bpName| |ps|)) NIL) ((|bpSignatureTail| |ps|) T)
(T
(AND (|bpArgumentList| |ps|)
(OR (|bpEqPeek| |ps| 'DOT)
(AND (|bpEqPeek| |ps| 'BEC)
(|bpPush| |ps| (|bfPlace| (|bpPop1| |ps|))))
(|bpTrap| |ps|)))
(COND
((|bpEqKey| |ps| 'DOT)
(AND (|bpList| |ps| #'|bpPrimary| 'DOT) (|bpChecknull| |ps|)
(|bpPush| |ps|
(|bfTuple| (CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))))
(T T)))))
(DEFUN |bpChecknull| (|ps|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpPop1| |ps|))
(COND ((NULL |a|) (|bpTrap| |ps|)) (T (|bpPush| |ps| |a|))))))
(DEFUN |bpStruct| (|ps|)
(AND (|bpEqKey| |ps| 'STRUCTURE) (|bpRequire| |ps| #'|bpTypeName|)
(OR (|bpEqKey| |ps| 'DEF) (|bpTrap| |ps|))
(OR (|bpRecord| |ps|) (|bpTypeList| |ps|))
(|bpPush| |ps| (|%Structure| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpRecord| (|ps|)
(LET* (|s|)
(PROGN
(SETQ |s| (|bpState| |ps|))
(COND
((AND (|bpName| |ps|) (EQ (|bpPop1| |ps|) '|Record|))
(AND (OR (|bpParenthesized| |ps| #'|bpFieldList|) (|bpTrap| |ps|))
(|bpGlobalAccessors| |ps|)
(|bpPush| |ps|
(|%Record| (|bfUntuple| (|bpPop2| |ps|))
(|bpPop1| |ps|)))))
(T (|bpRestore| |ps| |s|) NIL)))))
(DEFUN |bpFieldList| (|ps|) (|bpTuple| |ps| #'|bpSignature|))
(DEFUN |bpGlobalAccessors| (|ps|)
(COND
((|bpEqKey| |ps| 'WITH)
(OR (|bpPileBracketed| |ps| #'|bpAccessorDefinitionList|) (|bpTrap| |ps|)))
(T (|bpPush| |ps| NIL))))
(DEFUN |bpAccessorDefinitionList| (|ps|)
(|bpListAndRecover| |ps| #'|bpAccessorDefinition|))
(DEFUN |bpAccessorDefinition| (|ps|)
(AND (|bpRequire| |ps| #'|bpName|) (OR (|bpEqKey| |ps| 'DEF) (|bpTrap| |ps|))
(|bpRequire| |ps| #'|bpFieldSection|)
(|bpPush| |ps| (|%AccessorDef| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpFieldSection| (|ps|) (|bpParenthesized| |ps| #'|bpSelectField|))
(DEFUN |bpSelectField| (|ps|) (AND (|bpEqKey| |ps| 'DOT) (|bpName| |ps|)))
(DEFUN |bpTypeList| (|ps|)
(OR (|bpPileBracketed| |ps| #'|bpTypeItemList|)
(AND (|bpTypeItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1| |ps|))))))
(DEFUN |bpTypeItem| (|ps|) (|bpTerm| |ps| #'|bpIdList|))
(DEFUN |bpTypeItemList| (|ps|) (|bpListAndRecover| |ps| #'|bpTypeItem|))
(DEFUN |bpTerm| (|ps| |idListParser|)
(OR
(AND (|bpRequire| |ps| #'|bpName|)
(OR
(AND (|bpParenthesized| |ps| |idListParser|)
(|bpPush| |ps| (|bfNameArgs| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(AND (|bpName| |ps|)
(|bpPush| |ps| (|bfNameArgs| (|bpPop2| |ps|) (|bpPop1| |ps|))))))
(|bpPush| |ps| (|bfNameOnly| (|bpPop1| |ps|)))))
(DEFUN |bpIdList| (|ps|) (|bpTuple| |ps| #'|bpName|))
(DEFUN |bpCase| (|ps|)
(AND (|bpEqKey| |ps| 'CASE) (|bpRequire| |ps| #'|bpWhere|)
(OR (|bpEqKey| |ps| 'OF) (|bpMissing| |ps| 'OF))
(|bpPiledCaseItems| |ps|)))
(DEFUN |bpPiledCaseItems| (|ps|)
(AND (|bpPileBracketed| |ps| #'|bpCaseItemList|)
(|bpPush| |ps|
(|bfCase| (|parserLoadUnit| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|)))))
(DEFUN |bpCaseItemList| (|ps|) (|bpListAndRecover| |ps| #'|bpCaseItem|))
(DEFUN |bpCasePatternVar| (|ps|) (OR (|bpName| |ps|) (|bpDot| |ps|)))
(DEFUN |bpCasePatternVarList| (|ps|) (|bpTuple| |ps| #'|bpCasePatternVar|))
(DEFUN |bpCaseItem| (|ps|)
(AND (OR (|bpTerm| |ps| #'|bpCasePatternVarList|) (|bpTrap| |ps|))
(OR (|bpEqKey| |ps| 'EXIT) (|bpTrap| |ps|))
(|bpRequire| |ps| #'|bpWhere|)
(|bpPush| |ps| (|bfCaseItem| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpOutItem| (|ps|)
(LET* (|t| |r| |ISTMP#2| |l| |ISTMP#1| |b| |varno| |op|)
(DECLARE (SPECIAL |$InteractiveMode|))
(PROGN
(SETQ |op| (|enclosingFunction| (|parserLoadUnit| |ps|)))
(SETQ |varno| (|parserGensymSequenceNumber| |ps|))
(UNWIND-PROTECT
(LET ((#1=#:G393
(CATCH :OPEN-AXIOM-CATCH-POINT
(PROGN
(SETF (|enclosingFunction| (|parserLoadUnit| |ps|)) NIL)
(SETF (|parserGensymSequenceNumber| |ps|) 0)
(|bpRequire| |ps| #'|bpComma|)))))
(COND
((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
(COND
((EQUAL (CAR #2=(CDR #1#)) '(|BootSpecificError|))
(LET ((|e| (CDR #2#)))
(PROGN (|bpSpecificErrorHere| |ps| |e|) (|bpTrap| |ps|))))
(T (THROW :OPEN-AXIOM-CATCH-POINT #1#))))
(T #1#)))
(PROGN
(SETF (|parserGensymSequenceNumber| |ps|) |varno|)
(SETF (|enclosingFunction| (|parserLoadUnit| |ps|)) |op|)))
(SETQ |b| (|bpPop1| |ps|))
(SETQ |t|
(COND ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|))
((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
(PROGN
(SETQ |ISTMP#1| (CDR |b|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |l| (CAR |ISTMP#1|))
(SETQ |ISTMP#2| (CDR |ISTMP#1|))
(AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
(PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))
(SYMBOLP |l|))
(COND (|$InteractiveMode| (LIST (LIST 'SETQ |l| |r|)))
(T (LIST (LIST 'DEFPARAMETER |l| |r|)))))
(T (|translateToplevel| |ps| |b| NIL))))
(|bpPush| |ps| |t|))))