(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=#:G393 (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 |bpProvenance| (|ps|) (LET* (|lib| |ISTMP#6| |ISTMP#5| |ISTMP#4| |ISTMP#3| |ISTMP#2| |ISTMP#1| |x|) (BLOCK NIL (COND ((|bpEqKey| |ps| 'IN) (OR (|bpApplication| |ps|) (RETURN (|bpTrap| |ps|))) (SETQ |x| (|bpPop1| |ps|)) (COND ((NOT (AND (CONSP |x|) (PROGN (SETQ |ISTMP#1| (CAR |x|)) (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'ELT) (PROGN (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (EQ (CAR |ISTMP#2|) '|System|) (PROGN (SETQ |ISTMP#3| (CDR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) (NULL (CDR |ISTMP#3|)) (EQ (CAR |ISTMP#3|) '|LoadUnit|))))))) (PROGN (SETQ |ISTMP#4| (CDR |x|)) (AND (CONSP |ISTMP#4|) (NULL (CDR |ISTMP#4|)) (PROGN (SETQ |ISTMP#5| (CAR |ISTMP#4|)) (AND (CONSP |ISTMP#5|) (EQ (CAR |ISTMP#5|) 'QUOTE) (PROGN (SETQ |ISTMP#6| (CDR |ISTMP#5|)) (AND (CONSP |ISTMP#6|) (NULL (CDR |ISTMP#6|)) (PROGN (SETQ |lib| (CAR |ISTMP#6|)) T))))))))) (|bpGeneralErrorHere| |ps|)) (T (|bpPush| |ps| (|%LoadUnit| |lib|))))) (T (|bpPush| |ps| 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|) (|bpRequire| |ps| #'|bpSignature|) (|bpProvenance| |ps|) (OR (|bpEqKey| |ps| 'FOR) (|bpTrap| |ps|)) (|bpRequire| |ps| #'|bpName|) (|bpPush| |ps| (|%ImportSignature| (|bpPop1| |ps|) (|bpPop2| |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 |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 (|bpBracketPattern| |ps|) (|bpChar| |ps|) (|bpName| |ps|) (|bpConstTok| |ps|))) (DEFUN |bpBracketPattern| (|ps|) (AND (|bpBracket| |ps| #'|bpPatternL|) (|bpPush| |ps| (|bfConstruct| (|bpPop1| |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)) (|bpBracketPattern| |ps|))) (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)) (|bpBracketPattern| |ps|))) (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|)))) (|bpBracketPattern| |ps|) (|bpName| |ps|) (|bpConstTok| |ps|))) (DEFUN |bpAssignVariable| (|ps|) (OR (|bpBracketPattern| |ps|) (|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=#:G394 (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|))))