diff options
Diffstat (limited to 'src/boot/strap/parser.clisp')
| -rw-r--r-- | src/boot/strap/parser.clisp | 1294 |
1 files changed, 612 insertions, 682 deletions
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 0d5f4199..898c6192 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -10,39 +10,32 @@ (PROVIDE "parser") (DEFUN |bpFirstToken| () - (DECLARE (SPECIAL |$ttok| |$stok| |$inputStream|)) + (DECLARE (SPECIAL |$inputStream| |$stok| |$ttok|)) (PROGN - (SETQ |$stok| - (COND + (SETQ |$stok| + (COND ((NULL |$inputStream|) - (|shoeTokConstruct| 'ERROR 'NOMORE - (|shoeTokPosn| |$stok|))) + (|shoeTokConstruct| 'ERROR 'NOMORE (|shoeTokPosn| |$stok|))) (T (CAR |$inputStream|)))) - (SETQ |$ttok| (|shoeTokPart| |$stok|)) - T)) + (SETQ |$ttok| (|shoeTokPart| |$stok|)) + T)) (DEFUN |bpFirstTok| () - (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$ttok| |$stok| - |$inputStream|)) + (DECLARE (SPECIAL |$inputStream| |$stok| |$ttok| |$bpParenCount| |$bpCount|)) (PROGN - (SETQ |$stok| - (COND + (SETQ |$stok| + (COND ((NULL |$inputStream|) - (|shoeTokConstruct| 'ERROR 'NOMORE - (|shoeTokPosn| |$stok|))) + (|shoeTokConstruct| 'ERROR 'NOMORE (|shoeTokPosn| |$stok|))) (T (CAR |$inputStream|)))) - (SETQ |$ttok| (|shoeTokPart| |$stok|)) - (COND - ((AND (PLUSP |$bpParenCount|) (CONSP |$stok|) - (EQ (CAR |$stok|) 'KEY)) - (COND - ((EQ |$ttok| 'SETTAB) (SETQ |$bpCount| (+ |$bpCount| 1)) - (|bpNext|)) - ((EQ |$ttok| 'BACKTAB) (SETQ |$bpCount| (- |$bpCount| 1)) - (|bpNext|)) - ((EQ |$ttok| 'BACKSET) (|bpNext|)) - (T T))) - (T T)))) + (SETQ |$ttok| (|shoeTokPart| |$stok|)) + (COND + ((AND (PLUSP |$bpParenCount|) (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY)) + (COND ((EQ |$ttok| 'SETTAB) (SETQ |$bpCount| (+ |$bpCount| 1)) (|bpNext|)) + ((EQ |$ttok| 'BACKTAB) (SETQ |$bpCount| (- |$bpCount| 1)) + (|bpNext|)) + ((EQ |$ttok| 'BACKSET) (|bpNext|)) (T T))) + (T T)))) (DEFUN |bpNext| () (DECLARE (SPECIAL |$inputStream|)) @@ -53,201 +46,179 @@ (PROGN (SETQ |$inputStream| (CDR |$inputStream|)) (|bpFirstToken|))) (DEFUN |bpState| () - (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|)) + (DECLARE (SPECIAL |$inputStream| |$stack| |$bpParenCount| |$bpCount|)) (LIST |$inputStream| |$stack| |$bpParenCount| |$bpCount|)) (DEFUN |bpRestore| (|x|) - (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|)) + (DECLARE (SPECIAL |$inputStream| |$stack| |$bpParenCount| |$bpCount|)) (PROGN - (SETQ |$inputStream| (CAR |x|)) - (|bpFirstToken|) - (SETQ |$stack| (CADR |x|)) - (SETQ |$bpParenCount| (CADDR |x|)) - (SETQ |$bpCount| (CADDDR |x|)) - T)) + (SETQ |$inputStream| (CAR |x|)) + (|bpFirstToken|) + (SETQ |$stack| (CADR |x|)) + (SETQ |$bpParenCount| (CADDR |x|)) + (SETQ |$bpCount| (CADDDR |x|)) + T)) (DEFUN |bpPush| (|x|) (DECLARE (SPECIAL |$stack|)) (SETQ |$stack| (CONS |x| |$stack|))) (DEFUN |bpPushId| () - (DECLARE (SPECIAL |$stack| |$ttok|)) + (DECLARE (SPECIAL |$ttok| |$stack|)) (SETQ |$stack| (CONS (|bfReName| |$ttok|) |$stack|))) (DEFUN |bpPop1| () (PROG (|a|) (DECLARE (SPECIAL |$stack|)) (RETURN - (PROGN - (SETQ |a| (CAR |$stack|)) - (SETQ |$stack| (CDR |$stack|)) - |a|)))) + (PROGN (SETQ |a| (CAR |$stack|)) (SETQ |$stack| (CDR |$stack|)) |a|)))) (DEFUN |bpPop2| () (PROG (|a|) (DECLARE (SPECIAL |$stack|)) (RETURN - (PROGN - (SETQ |a| (CADR |$stack|)) - (RPLACD |$stack| (CDDR |$stack|)) - |a|)))) + (PROGN (SETQ |a| (CADR |$stack|)) (RPLACD |$stack| (CDDR |$stack|)) |a|)))) (DEFUN |bpPop3| () (PROG (|a|) (DECLARE (SPECIAL |$stack|)) (RETURN - (PROGN - (SETQ |a| (CADDR |$stack|)) - (RPLACD (CDR |$stack|) (CDDDR |$stack|)) - |a|)))) + (PROGN + (SETQ |a| (CADDR |$stack|)) + (RPLACD (CDR |$stack|) (CDDDR |$stack|)) + |a|)))) (DEFUN |bpIndentParenthesized| (|f|) (PROG (|$bpCount| |a|) - (DECLARE (SPECIAL |$inputStream| |$bpCount| |$bpParenCount| - |$stok|)) + (DECLARE (SPECIAL |$stok| |$bpParenCount| |$inputStream| |$bpCount|)) (RETURN - (PROGN - (SETQ |$bpCount| 0) - (SETQ |a| |$stok|) + (PROGN + (SETQ |$bpCount| 0) + (SETQ |a| |$stok|) + (COND + ((|bpEqPeek| 'OPAREN) (SETQ |$bpParenCount| (+ |$bpParenCount| 1)) + (|bpNext|) (COND - ((|bpEqPeek| 'OPAREN) - (SETQ |$bpParenCount| (+ |$bpParenCount| 1)) (|bpNext|) - (COND - ((AND (APPLY |f| NIL) (|bpFirstTok|) - (OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|))) - (SETQ |$bpParenCount| (- |$bpParenCount| 1)) - (|bpNextToken|) - (COND - ((EQL |$bpCount| 0) T) - (T (SETQ |$inputStream| - (|append| (|bpAddTokens| |$bpCount|) - |$inputStream|)) - (|bpFirstToken|) - (COND - ((EQL |$bpParenCount| 0) (|bpCancel|) T) - (T T))))) - ((|bpEqPeek| 'CPAREN) (|bpPush| (|bfTuple| NIL)) - (SETQ |$bpParenCount| (- |$bpParenCount| 1)) - (|bpNextToken|) T) - (T (|bpParenTrap| |a|)))) - (T NIL)))))) + ((AND (APPLY |f| NIL) (|bpFirstTok|) + (OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|))) + (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|) + (COND ((EQL |$bpCount| 0) T) + (T + (SETQ |$inputStream| + (|append| (|bpAddTokens| |$bpCount|) |$inputStream|)) + (|bpFirstToken|) + (COND ((EQL |$bpParenCount| 0) (|bpCancel|) T) (T T))))) + ((|bpEqPeek| 'CPAREN) (|bpPush| (|bfTuple| NIL)) + (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|) T) + (T (|bpParenTrap| |a|)))) + (T NIL)))))) (DEFUN |bpParenthesized| (|f|) (PROG (|a|) (DECLARE (SPECIAL |$stok|)) (RETURN - (PROGN - (SETQ |a| |$stok|) + (PROGN + (SETQ |a| |$stok|) + (COND + ((|bpEqKey| 'OPAREN) (COND - ((|bpEqKey| 'OPAREN) - (COND - ((AND (APPLY |f| NIL) - (OR (|bpEqKey| 'CPAREN) (|bpParenTrap| |a|))) - T) - ((|bpEqKey| 'CPAREN) (|bpPush| (|bfTuple| NIL)) T) - (T (|bpParenTrap| |a|)))) - (T NIL)))))) + ((AND (APPLY |f| NIL) (OR (|bpEqKey| 'CPAREN) (|bpParenTrap| |a|))) T) + ((|bpEqKey| 'CPAREN) (|bpPush| (|bfTuple| NIL)) T) + (T (|bpParenTrap| |a|)))) + (T NIL)))))) (DEFUN |bpBracket| (|f|) (PROG (|a|) (DECLARE (SPECIAL |$stok|)) (RETURN - (PROGN - (SETQ |a| |$stok|) + (PROGN + (SETQ |a| |$stok|) + (COND + ((|bpEqKey| 'OBRACK) (COND - ((|bpEqKey| 'OBRACK) - (COND - ((AND (APPLY |f| NIL) - (OR (|bpEqKey| 'CBRACK) (|bpBrackTrap| |a|))) - (|bpPush| (|bfBracket| (|bpPop1|)))) - ((|bpEqKey| 'CBRACK) (|bpPush| NIL)) - (T (|bpBrackTrap| |a|)))) - (T NIL)))))) + ((AND (APPLY |f| NIL) (OR (|bpEqKey| 'CBRACK) (|bpBrackTrap| |a|))) + (|bpPush| (|bfBracket| (|bpPop1|)))) + ((|bpEqKey| 'CBRACK) (|bpPush| NIL)) (T (|bpBrackTrap| |a|)))) + (T NIL)))))) (DEFUN |bpPileBracketed| (|f|) (COND - ((|bpEqKey| 'SETTAB) - (COND - ((|bpEqKey| 'BACKTAB) T) - ((AND (APPLY |f| NIL) (OR (|bpEqKey| 'BACKTAB) (|bpPileTrap|))) - (|bpPush| (|bfPile| (|bpPop1|)))) - (T NIL))) - (T NIL))) + ((|bpEqKey| 'SETTAB) + (COND ((|bpEqKey| 'BACKTAB) T) + ((AND (APPLY |f| NIL) (OR (|bpEqKey| 'BACKTAB) (|bpPileTrap|))) + (|bpPush| (|bfPile| (|bpPop1|)))) + (T NIL))) + (T NIL))) (DEFUN |bpListof| (|f| |str1| |g|) (PROG (|a|) (DECLARE (SPECIAL |$stack|)) (RETURN - (COND - ((APPLY |f| NIL) - (COND - ((AND (|bpEqKey| |str1|) (OR (APPLY |f| NIL) (|bpTrap|))) - (SETQ |a| |$stack|) (SETQ |$stack| NIL) - (LOOP - (COND - ((NOT (AND (|bpEqKey| |str1|) - (OR (APPLY |f| NIL) (|bpTrap|)))) - (RETURN NIL)) - (T 0))) - (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|)) - (|bpPush| - (FUNCALL |g| - (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|)))))) - (T T))) - (T NIL))))) + (COND + ((APPLY |f| NIL) + (COND + ((AND (|bpEqKey| |str1|) (OR (APPLY |f| NIL) (|bpTrap|))) + (SETQ |a| |$stack|) (SETQ |$stack| NIL) + (LOOP + (COND + ((NOT (AND (|bpEqKey| |str1|) (OR (APPLY |f| NIL) (|bpTrap|)))) + (RETURN NIL)) + (T 0))) + (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|)) + (|bpPush| + (FUNCALL |g| (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|)))))) + (T T))) + (T NIL))))) (DEFUN |bpListofFun| (|f| |h| |g|) (PROG (|a|) (DECLARE (SPECIAL |$stack|)) (RETURN - (COND - ((APPLY |f| NIL) - (COND - ((AND (APPLY |h| NIL) (OR (APPLY |f| NIL) (|bpTrap|))) - (SETQ |a| |$stack|) (SETQ |$stack| NIL) - (LOOP - (COND - ((NOT (AND (APPLY |h| NIL) - (OR (APPLY |f| NIL) (|bpTrap|)))) - (RETURN NIL)) - (T 0))) - (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|)) - (|bpPush| - (FUNCALL |g| - (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|)))))) - (T T))) - (T NIL))))) + (COND + ((APPLY |f| NIL) + (COND + ((AND (APPLY |h| NIL) (OR (APPLY |f| NIL) (|bpTrap|))) + (SETQ |a| |$stack|) (SETQ |$stack| NIL) + (LOOP + (COND + ((NOT (AND (APPLY |h| NIL) (OR (APPLY |f| NIL) (|bpTrap|)))) + (RETURN NIL)) + (T 0))) + (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|)) + (|bpPush| + (FUNCALL |g| (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|)))))) + (T T))) + (T NIL))))) (DEFUN |bpList| (|f| |str1|) (PROG (|a|) (DECLARE (SPECIAL |$stack|)) (RETURN - (COND - ((APPLY |f| NIL) - (COND - ((AND (|bpEqKey| |str1|) (OR (APPLY |f| NIL) (|bpTrap|))) - (SETQ |a| |$stack|) (SETQ |$stack| NIL) - (LOOP - (COND - ((NOT (AND (|bpEqKey| |str1|) - (OR (APPLY |f| NIL) (|bpTrap|)))) - (RETURN NIL)) - (T 0))) - (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|)) - (|bpPush| (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))) - (T (|bpPush| (LIST (|bpPop1|)))))) - (T (|bpPush| NIL)))))) + (COND + ((APPLY |f| NIL) + (COND + ((AND (|bpEqKey| |str1|) (OR (APPLY |f| NIL) (|bpTrap|))) + (SETQ |a| |$stack|) (SETQ |$stack| NIL) + (LOOP + (COND + ((NOT (AND (|bpEqKey| |str1|) (OR (APPLY |f| NIL) (|bpTrap|)))) + (RETURN NIL)) + (T 0))) + (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|)) + (|bpPush| (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))) + (T (|bpPush| (LIST (|bpPop1|)))))) + (T (|bpPush| NIL)))))) (DEFUN |bpOneOrMore| (|f|) (PROG (|a|) (DECLARE (SPECIAL |$stack|)) (RETURN - (COND - ((APPLY |f| NIL) (SETQ |a| |$stack|) (SETQ |$stack| NIL) - (LOOP (COND ((NOT (APPLY |f| NIL)) (RETURN NIL)) (T 0))) - (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|)) - (|bpPush| (CONS (|bpPop2|) (|bpPop1|)))) - (T NIL))))) + (COND + ((APPLY |f| NIL) (SETQ |a| |$stack|) (SETQ |$stack| NIL) + (LOOP (COND ((NOT (APPLY |f| NIL)) (RETURN NIL)) (T 0))) + (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|)) + (|bpPush| (CONS (|bpPop2|) (|bpPop1|)))) + (T NIL))))) (DEFUN |bpAnyNo| (|s|) (PROGN (LOOP (COND ((NOT (APPLY |s| NIL)) (RETURN NIL)) (T 0))) T)) @@ -258,48 +229,44 @@ (DEFUN |bpConditional| (|f|) (COND - ((AND (|bpEqKey| 'IF) (OR (|bpWhere|) (|bpTrap|)) - (OR (|bpEqKey| 'BACKSET) T)) - (COND - ((|bpEqKey| 'SETTAB) - (COND - ((|bpEqKey| 'THEN) - (AND (OR (APPLY |f| NIL) (|bpTrap|)) (|bpElse| |f|) - (|bpEqKey| 'BACKTAB))) - (T (|bpMissing| 'THEN)))) + ((AND (|bpEqKey| 'IF) (OR (|bpWhere|) (|bpTrap|)) + (OR (|bpEqKey| 'BACKSET) T)) + (COND + ((|bpEqKey| 'SETTAB) + (COND ((|bpEqKey| 'THEN) - (AND (OR (APPLY |f| NIL) (|bpTrap|)) (|bpElse| |f|))) - (T (|bpMissing| '|then|)))) - (T NIL))) + (AND (OR (APPLY |f| NIL) (|bpTrap|)) (|bpElse| |f|) + (|bpEqKey| 'BACKTAB))) + (T (|bpMissing| 'THEN)))) + ((|bpEqKey| 'THEN) (AND (OR (APPLY |f| NIL) (|bpTrap|)) (|bpElse| |f|))) + (T (|bpMissing| '|then|)))) + (T NIL))) (DEFUN |bpElse| (|f|) (PROG (|a|) (RETURN - (PROGN - (SETQ |a| (|bpState|)) - (COND - ((|bpBacksetElse|) - (AND (OR (APPLY |f| NIL) (|bpTrap|)) - (|bpPush| (|bfIf| (|bpPop3|) (|bpPop2|) (|bpPop1|))))) - (T (|bpRestore| |a|) - (|bpPush| (|bfIfThenOnly| (|bpPop2|) (|bpPop1|))))))))) + (PROGN + (SETQ |a| (|bpState|)) + (COND + ((|bpBacksetElse|) + (AND (OR (APPLY |f| NIL) (|bpTrap|)) + (|bpPush| (|bfIf| (|bpPop3|) (|bpPop2|) (|bpPop1|))))) + (T (|bpRestore| |a|) + (|bpPush| (|bfIfThenOnly| (|bpPop2|) (|bpPop1|))))))))) (DEFUN |bpBacksetElse| () - (COND - ((|bpEqKey| 'BACKSET) (|bpEqKey| 'ELSE)) - (T (|bpEqKey| 'ELSE)))) + (COND ((|bpEqKey| 'BACKSET) (|bpEqKey| 'ELSE)) (T (|bpEqKey| 'ELSE)))) (DEFUN |bpEqPeek| (|s|) - (DECLARE (SPECIAL |$ttok| |$stok|)) + (DECLARE (SPECIAL |$stok| |$ttok|)) (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|))) (DEFUN |bpEqKey| (|s|) - (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|) - (|bpNext|))) + (DECLARE (SPECIAL |$stok| |$ttok|)) + (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|) (|bpNext|))) (DEFUN |bpEqKeyNextTok| (|s|) - (DECLARE (SPECIAL |$ttok| |$stok|)) + (DECLARE (SPECIAL |$stok| |$ttok|)) (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|) (|bpNextToken|))) @@ -311,200 +278,186 @@ (DEFUN |bpMissingMate| (|close| |open|) (PROGN - (|bpSpecificErrorAtToken| |open| "possibly missing mate") - (|bpMissing| |close|))) + (|bpSpecificErrorAtToken| |open| "possibly missing mate") + (|bpMissing| |close|))) (DEFUN |bpMissing| (|s|) (PROGN - (|bpSpecificErrorHere| (CONCAT (PNAME |s|) " possibly missing")) - (THROW :OPEN-AXIOM-CATCH-POINT - (CONS :OPEN-AXIOM-CATCH-POINT - (CONS '(|BootParserException|) 'TRAPPED))))) + (|bpSpecificErrorHere| (CONCAT (PNAME |s|) " possibly missing")) + (THROW :OPEN-AXIOM-CATCH-POINT + (CONS :OPEN-AXIOM-CATCH-POINT (CONS '(|BootParserException|) 'TRAPPED))))) (DEFUN |bpCompMissing| (|s|) (OR (|bpEqKey| |s|) (|bpMissing| |s|))) (DEFUN |bpTrap| () (PROGN - (|bpGeneralErrorHere|) - (THROW :OPEN-AXIOM-CATCH-POINT - (CONS :OPEN-AXIOM-CATCH-POINT - (CONS '(|BootParserException|) 'TRAPPED))))) + (|bpGeneralErrorHere|) + (THROW :OPEN-AXIOM-CATCH-POINT + (CONS :OPEN-AXIOM-CATCH-POINT (CONS '(|BootParserException|) 'TRAPPED))))) (DEFUN |bpRecoverTrap| () (PROG (|pos2| |pos1|) (DECLARE (SPECIAL |$stok|)) (RETURN - (PROGN - (|bpFirstToken|) - (SETQ |pos1| (|shoeTokPosn| |$stok|)) - (|bpMoveTo| 0) - (SETQ |pos2| (|shoeTokPosn| |$stok|)) - (|bpIgnoredFromTo| |pos1| |pos2|) - (|bpPush| (LIST (LIST "pile syntax error"))))))) + (PROGN + (|bpFirstToken|) + (SETQ |pos1| (|shoeTokPosn| |$stok|)) + (|bpMoveTo| 0) + (SETQ |pos2| (|shoeTokPosn| |$stok|)) + (|bpIgnoredFromTo| |pos1| |pos2|) + (|bpPush| (LIST (LIST "pile syntax error"))))))) (DEFUN |bpListAndRecover| (|f|) (PROG (|found| |c| |done| |b| |a|) - (DECLARE (SPECIAL |$inputStream| |$stack|)) + (DECLARE (SPECIAL |$stack| |$inputStream|)) (RETURN - (PROGN - (SETQ |a| |$stack|) - (SETQ |b| NIL) - (SETQ |$stack| NIL) - (SETQ |done| NIL) - (SETQ |c| |$inputStream|) - (LOOP - (COND - (|done| (RETURN NIL)) - (T (SETQ |found| - (LET ((#0=#:G1354 - (CATCH :OPEN-AXIOM-CATCH-POINT - (APPLY |f| NIL)))) - (COND - ((AND (CONSP #0#) - (EQUAL (CAR #0#) - :OPEN-AXIOM-CATCH-POINT)) + (PROGN + (SETQ |a| |$stack|) + (SETQ |b| NIL) + (SETQ |$stack| NIL) + (SETQ |done| NIL) + (SETQ |c| |$inputStream|) + (LOOP + (COND (|done| (RETURN NIL)) + (T + (SETQ |found| + (LET ((#1=#:G719 + (CATCH :OPEN-AXIOM-CATCH-POINT (APPLY |f| NIL)))) + (COND + ((AND (CONSP #1#) + (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT)) (COND - ((EQUAL (CAR #1=(CDR #0#)) - '(|BootParserException|)) - (LET ((|e| (CDR #1#))) |e|)) - (T (THROW :OPEN-AXIOM-CATCH-POINT #0#)))) - (T #0#)))) - (COND - ((EQ |found| 'TRAPPED) (SETQ |$inputStream| |c|) - (|bpRecoverTrap|)) - ((NOT |found|) (SETQ |$inputStream| |c|) - (|bpGeneralErrorHere|) (|bpRecoverTrap|))) - (COND - ((|bpEqKey| 'BACKSET) (SETQ |c| |$inputStream|)) - ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|)) - (SETQ |done| T)) - (T (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|) - (|bpRecoverTrap|) - (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) (SETQ |$inputStream| |c|) + (|bpRecoverTrap|)) + ((NOT |found|) (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|) + (|bpRecoverTrap|))) + (COND ((|bpEqKey| 'BACKSET) (SETQ |c| |$inputStream|)) + ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|)) + (SETQ |done| T)) + (T (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|) + (|bpRecoverTrap|) + (COND ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|)) (SETQ |done| T)) (T (|bpNext|) (SETQ |c| |$inputStream|))))) - (SETQ |b| (CONS (|bpPop1|) |b|))))) - (SETQ |$stack| |a|) - (|bpPush| (|reverse!| |b|)))))) + (SETQ |b| (CONS (|bpPop1|) |b|))))) + (SETQ |$stack| |a|) + (|bpPush| (|reverse!| |b|)))))) (DEFUN |bpMoveTo| (|n|) - (DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$inputStream|)) - (COND - ((NULL |$inputStream|) T) - ((|bpEqPeek| 'BACKTAB) - (COND - ((EQL |n| 0) T) - (T (|bpNextToken|) (SETQ |$bpCount| (- |$bpCount| 1)) - (|bpMoveTo| (- |n| 1))))) - ((|bpEqPeek| 'BACKSET) - (COND ((EQL |n| 0) T) (T (|bpNextToken|) (|bpMoveTo| |n|)))) - ((|bpEqPeek| 'SETTAB) (|bpNextToken|) (|bpMoveTo| (+ |n| 1))) - ((|bpEqPeek| 'OPAREN) (|bpNextToken|) - (SETQ |$bpParenCount| (+ |$bpParenCount| 1)) (|bpMoveTo| |n|)) - ((|bpEqPeek| 'CPAREN) (|bpNextToken|) - (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpMoveTo| |n|)) - (T (|bpNextToken|) (|bpMoveTo| |n|)))) + (DECLARE (SPECIAL |$inputStream| |$bpCount| |$bpParenCount|)) + (COND ((NULL |$inputStream|) T) + ((|bpEqPeek| 'BACKTAB) + (COND ((EQL |n| 0) T) + (T (|bpNextToken|) (SETQ |$bpCount| (- |$bpCount| 1)) + (|bpMoveTo| (- |n| 1))))) + ((|bpEqPeek| 'BACKSET) + (COND ((EQL |n| 0) T) (T (|bpNextToken|) (|bpMoveTo| |n|)))) + ((|bpEqPeek| 'SETTAB) (|bpNextToken|) (|bpMoveTo| (+ |n| 1))) + ((|bpEqPeek| 'OPAREN) (|bpNextToken|) + (SETQ |$bpParenCount| (+ |$bpParenCount| 1)) (|bpMoveTo| |n|)) + ((|bpEqPeek| 'CPAREN) (|bpNextToken|) + (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpMoveTo| |n|)) + (T (|bpNextToken|) (|bpMoveTo| |n|)))) (DEFUN |bpQualifiedName| () (DECLARE (SPECIAL |$stok|)) (COND - ((|bpEqPeek| 'COLON-COLON) (|bpNext|) - (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID) (|bpPushId|) - (|bpNext|) (|bpPush| (|bfColonColon| (|bpPop2|) (|bpPop1|))))) - (T NIL))) + ((|bpEqPeek| 'COLON-COLON) (|bpNext|) + (AND (CONSP |$stok|) (EQ (CAR |$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|) (|bpAnyNo| #'|bpQualifiedName|)) - (T NIL))) + ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID)) (|bpPushId|) (|bpNext|) + (|bpAnyNo| #'|bpQualifiedName|)) + (T NIL))) (DEFUN |bpConstTok| () - (DECLARE (SPECIAL |$ttok| |$stok|)) + (DECLARE (SPECIAL |$stok| |$ttok|)) (COND - ((|symbolMember?| (|shoeTokType| |$stok|) '(INTEGER FLOAT)) - (|bpPush| |$ttok|) (|bpNext|)) - ((AND (CONSP |$stok|) (EQ (CAR |$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)) - (AND (|bpPush| (LIST '+LINE |$ttok|)) (|bpNext|))) - ((|bpEqPeek| 'QUOTE) (|bpNext|) - (AND (OR (|bpSexp|) (|bpTrap|)) - (|bpPush| (|bfSymbol| (|bpPop1|))))) - (T (|bpString|)))) + ((|symbolMember?| (|shoeTokType| |$stok|) '(INTEGER FLOAT)) + (|bpPush| |$ttok|) (|bpNext|)) + ((AND (CONSP |$stok|) (EQ (CAR |$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)) + (AND (|bpPush| (LIST '+LINE |$ttok|)) (|bpNext|))) + ((|bpEqPeek| 'QUOTE) (|bpNext|) + (AND (OR (|bpSexp|) (|bpTrap|)) (|bpPush| (|bfSymbol| (|bpPop1|))))) + (T (|bpString|)))) (DEFUN |bpExportItemTail| () - (OR (AND (|bpEqKey| 'BEC) (OR (|bpAssign|) (|bpTrap|)) - (|bpPush| (|%Assignment| (|bpPop2|) (|bpPop1|)))) - (|bpSimpleDefinitionTail|))) + (OR + (AND (|bpEqKey| 'BEC) (OR (|bpAssign|) (|bpTrap|)) + (|bpPush| (|%Assignment| (|bpPop2|) (|bpPop1|)))) + (|bpSimpleDefinitionTail|))) (DEFUN |bpExportItem| () (PROG (|a|) (RETURN - (COND - ((|bpEqPeek| 'STRUCTURE) (|bpStruct|)) - (T (SETQ |a| (|bpState|)) - (COND + (COND ((|bpEqPeek| 'STRUCTURE) (|bpStruct|)) + (T (SETQ |a| (|bpState|)) + (COND ((|bpName|) (COND - ((|bpEqPeek| 'COLON) (|bpRestore| |a|) - (OR (|bpSignature|) (|bpTrap|)) - (OR (|bpExportItemTail|) T)) - (T (|bpRestore| |a|) (|bpTypeAliasDefition|)))) + ((|bpEqPeek| 'COLON) (|bpRestore| |a|) + (OR (|bpSignature|) (|bpTrap|)) (OR (|bpExportItemTail|) T)) + (T (|bpRestore| |a|) (|bpTypeAliasDefition|)))) (T NIL))))))) (DEFUN |bpExportItemList| () (|bpListAndRecover| #'|bpExportItem|)) (DEFUN |bpModuleInterface| () (COND - ((|bpEqKey| 'WHERE) - (OR (|bpPileBracketed| #'|bpExportItemList|) - (AND (|bpExportItem|) (|bpPush| (LIST (|bpPop1|)))) - (|bpTrap|))) - (T (|bpPush| NIL)))) + ((|bpEqKey| 'WHERE) + (OR (|bpPileBracketed| #'|bpExportItemList|) + (AND (|bpExportItem|) (|bpPush| (LIST (|bpPop1|)))) (|bpTrap|))) + (T (|bpPush| NIL)))) (DEFUN |bpModuleExports| () - (COND - ((|bpParenthesized| #'|bpIdList|) - (|bpPush| (|bfUntuple| (|bpPop1|)))) - (T (|bpPush| NIL)))) + (COND ((|bpParenthesized| #'|bpIdList|) (|bpPush| (|bfUntuple| (|bpPop1|)))) + (T (|bpPush| NIL)))) (DEFUN |bpModule| () (COND - ((|bpEqKey| 'MODULE) (OR (|bpName|) (|bpTrap|)) (|bpModuleExports|) - (|bpModuleInterface|) - (|bpPush| (|%Module| (|bpPop3|) (|bpPop2|) (|bpPop1|)))) - (T NIL))) + ((|bpEqKey| 'MODULE) (OR (|bpName|) (|bpTrap|)) (|bpModuleExports|) + (|bpModuleInterface|) + (|bpPush| (|%Module| (|bpPop3|) (|bpPop2|) (|bpPop1|)))) + (T NIL))) (DEFUN |bpImport| () (PROG (|a|) (RETURN - (COND - ((|bpEqKey| 'IMPORT) - (COND - ((|bpNamespace|) (|bpPush| (|%Import| (|bpPop1|)))) - (T (SETQ |a| (|bpState|)) (OR (|bpName|) (|bpTrap|)) + (COND + ((|bpEqKey| 'IMPORT) + (COND ((|bpNamespace|) (|bpPush| (|%Import| (|bpPop1|)))) + (T (SETQ |a| (|bpState|)) (OR (|bpName|) (|bpTrap|)) (COND - ((|bpEqPeek| 'COLON) (|bpRestore| |a|) - (AND (OR (|bpSignature|) (|bpTrap|)) - (OR (|bpEqKey| 'FOR) (|bpTrap|)) - (OR (|bpName|) (|bpTrap|)) - (|bpPush| - (|%ImportSignature| (|bpPop1|) (|bpPop1|))))) - (T (|bpPush| (|%Import| (|bpPop1|)))))))) - (T NIL))))) + ((|bpEqPeek| 'COLON) (|bpRestore| |a|) + (AND (OR (|bpSignature|) (|bpTrap|)) + (OR (|bpEqKey| 'FOR) (|bpTrap|)) + (OR (|bpName|) (|bpTrap|)) + (|bpPush| (|%ImportSignature| (|bpPop1|) (|bpPop1|))))) + (T (|bpPush| (|%Import| (|bpPop1|)))))))) + (T NIL))))) (DEFUN |bpNamespace| () (AND (|bpEqKey| 'NAMESPACE) (OR (|bpName|) (|bpDot|)) (|bpPush| (|bfNamespace| (|bpPop1|))))) (DEFUN |bpTypeAliasDefition| () - (AND (OR (|bpTerm| #'|bpIdList|) (|bpTrap|)) (|bpEqKey| 'TDEF) - (|bpLogical|) (|bpPush| (|%TypeAlias| (|bpPop2|) (|bpPop1|))))) + (AND (OR (|bpTerm| #'|bpIdList|) (|bpTrap|)) (|bpEqKey| 'TDEF) (|bpLogical|) + (|bpPush| (|%TypeAlias| (|bpPop2|) (|bpPop1|))))) (DEFUN |bpSignature| () (AND (|bpName|) (|bpEqKey| 'COLON) (|bpTyping|) @@ -512,11 +465,11 @@ (DEFUN |bpSimpleMapping| () (COND - ((|bpApplication|) - (AND (|bpEqKey| 'ARROW) (OR (|bpApplication|) (|bpTrap|)) - (|bpPush| (|%Mapping| (|bpPop1|) (LIST (|bpPop1|))))) - T) - (T NIL))) + ((|bpApplication|) + (AND (|bpEqKey| 'ARROW) (OR (|bpApplication|) (|bpTrap|)) + (|bpPush| (|%Mapping| (|bpPop1|) (LIST (|bpPop1|))))) + T) + (T NIL))) (DEFUN |bpArgtypeList| () (|bpTuple| #'|bpApplication|)) @@ -528,28 +481,25 @@ (DEFUN |bpCancel| () (PROG (|a|) (RETURN - (PROGN - (SETQ |a| (|bpState|)) + (PROGN + (SETQ |a| (|bpState|)) + (COND + ((|bpEqKeyNextTok| 'SETTAB) (COND - ((|bpEqKeyNextTok| 'SETTAB) - (COND - ((|bpCancel|) - (COND - ((|bpEqKeyNextTok| 'BACKTAB) T) - (T (|bpRestore| |a|) NIL))) - ((|bpEqKeyNextTok| 'BACKTAB) T) - (T (|bpRestore| |a|) NIL))) - (T NIL)))))) + ((|bpCancel|) + (COND ((|bpEqKeyNextTok| 'BACKTAB) T) (T (|bpRestore| |a|) NIL))) + ((|bpEqKeyNextTok| 'BACKTAB) T) (T (|bpRestore| |a|) NIL))) + (T NIL)))))) (DEFUN |bpAddTokens| (|n|) (DECLARE (SPECIAL |$stok|)) - (COND - ((EQL |n| 0) NIL) - ((PLUSP |n|) - (CONS (|shoeTokConstruct| 'KEY 'SETTAB (|shoeTokPosn| |$stok|)) - (|bpAddTokens| (- |n| 1)))) - (T (CONS (|shoeTokConstruct| 'KEY 'BACKTAB (|shoeTokPosn| |$stok|)) - (|bpAddTokens| (+ |n| 1)))))) + (COND ((EQL |n| 0) NIL) + ((PLUSP |n|) + (CONS (|shoeTokConstruct| 'KEY 'SETTAB (|shoeTokPosn| |$stok|)) + (|bpAddTokens| (- |n| 1)))) + (T + (CONS (|shoeTokConstruct| 'KEY 'BACKTAB (|shoeTokPosn| |$stok|)) + (|bpAddTokens| (+ |n| 1)))))) (DEFUN |bpExceptions| () (OR (|bpEqPeek| 'DOT) (|bpEqPeek| 'QUOTE) (|bpEqPeek| 'OPAREN) @@ -558,27 +508,24 @@ (DEFUN |bpSexpKey| () (PROG (|a|) - (DECLARE (SPECIAL |$ttok| |$stok|)) + (DECLARE (SPECIAL |$stok| |$ttok|)) (RETURN - (COND - ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) - (NOT (|bpExceptions|))) - (SETQ |a| (GET |$ttok| 'SHOEINF)) - (COND - ((NULL |a|) (AND (|bpPush| |$ttok|) (|bpNext|))) - (T (AND (|bpPush| |a|) (|bpNext|))))) - (T NIL))))) + (COND + ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (NOT (|bpExceptions|))) + (SETQ |a| (GET |$ttok| 'SHOEINF)) + (COND ((NULL |a|) (AND (|bpPush| |$ttok|) (|bpNext|))) + (T (AND (|bpPush| |a|) (|bpNext|))))) + (T NIL))))) (DEFUN |bpAnyId| () - (DECLARE (SPECIAL |$ttok| |$stok|)) - (OR (AND (|bpEqKey| 'MINUS) - (OR (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'INTEGER)) - (|bpTrap|)) - (|bpPush| (- |$ttok|)) (|bpNext|)) - (|bpSexpKey|) - (AND (|symbolMember?| (|shoeTokType| |$stok|) - '(ID INTEGER STRING FLOAT)) - (|bpPush| |$ttok|) (|bpNext|)))) + (DECLARE (SPECIAL |$stok| |$ttok|)) + (OR + (AND (|bpEqKey| 'MINUS) + (OR (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'INTEGER)) (|bpTrap|)) + (|bpPush| (- |$ttok|)) (|bpNext|)) + (|bpSexpKey|) + (AND (|symbolMember?| (|shoeTokType| |$stok|) '(ID INTEGER STRING FLOAT)) + (|bpPush| |$ttok|) (|bpNext|)))) (DEFUN |bpSexp| () (OR (|bpAnyId|) @@ -587,24 +534,23 @@ (|bpIndentParenthesized| #'|bpSexp1|))) (DEFUN |bpSexp1| () - (OR (AND (|bpFirstTok|) (|bpSexp|) - (OR (AND (|bpEqKey| 'DOT) (|bpSexp|) - (|bpPush| (CONS (|bpPop2|) (|bpPop1|)))) - (AND (|bpSexp1|) - (|bpPush| (CONS (|bpPop2|) (|bpPop1|)))))) - (|bpPush| NIL))) + (OR + (AND (|bpFirstTok|) (|bpSexp|) + (OR + (AND (|bpEqKey| 'DOT) (|bpSexp|) + (|bpPush| (CONS (|bpPop2|) (|bpPop1|)))) + (AND (|bpSexp1|) (|bpPush| (CONS (|bpPop2|) (|bpPop1|)))))) + (|bpPush| NIL))) (DEFUN |bpPrimary1| () - (OR (|bpParenthesizedApplication|) (|bpDot|) (|bpConstTok|) - (|bpConstruct|) (|bpCase|) (|bpStruct|) (|bpPDefinition|) - (|bpBPileDefinition|))) + (OR (|bpParenthesizedApplication|) (|bpDot|) (|bpConstTok|) (|bpConstruct|) + (|bpCase|) (|bpStruct|) (|bpPDefinition|) (|bpBPileDefinition|))) (DEFUN |bpParenthesizedApplication| () (AND (|bpName|) (|bpAnyNo| #'|bpArgumentList|))) (DEFUN |bpArgumentList| () - (AND (|bpPDefinition|) - (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|))))) + (AND (|bpPDefinition|) (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|))))) (DEFUN |bpPrimary| () (AND (|bpFirstTok|) (OR (|bpPrimary1|) (|bpPrefixOperator|)))) @@ -612,95 +558,94 @@ (DEFUN |bpDot| () (AND (|bpEqKey| 'DOT) (|bpPush| (|bfDot|)))) (DEFUN |bpPrefixOperator| () - (DECLARE (SPECIAL |$ttok| |$stok|)) + (DECLARE (SPECIAL |$stok| |$ttok|)) (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (GET |$ttok| 'SHOEPRE) (|bpPushId|) (|bpNext|))) (DEFUN |bpInfixOperator| () - (DECLARE (SPECIAL |$ttok| |$stok|)) + (DECLARE (SPECIAL |$stok| |$ttok|)) (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (GET |$ttok| 'SHOEINF) (|bpPushId|) (|bpNext|))) (DEFUN |bpSelector| () (AND (|bpEqKey| 'DOT) - (OR (AND (|bpPrimary|) - (|bpPush| (|bfElt| (|bpPop2|) (|bpPop1|)))) + (OR (AND (|bpPrimary|) (|bpPush| (|bfElt| (|bpPop2|) (|bpPop1|)))) (|bpPush| (|bfSuffixDot| (|bpPop1|)))))) (DEFUN |bpApplication| () - (OR (AND (|bpPrimary|) (|bpAnyNo| #'|bpSelector|) - (OR (AND (|bpApplication|) - (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|)))) - T)) - (|bpNamespace|))) + (OR + (AND (|bpPrimary|) (|bpAnyNo| #'|bpSelector|) + (OR + (AND (|bpApplication|) + (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|)))) + T)) + (|bpNamespace|))) (DEFUN |bpTyping| () (COND - ((|bpEqKey| 'FORALL) (OR (|bpVariable|) (|bpTrap|)) - (OR (AND (|bpDot|) (|bpPop1|)) (|bpTrap|)) - (OR (|bpTyping|) (|bpTrap|)) - (|bpPush| (|%Forall| (|bpPop2|) (|bpPop1|)))) - (T (OR (|bpMapping|) (|bpSimpleMapping|))))) + ((|bpEqKey| 'FORALL) (OR (|bpVariable|) (|bpTrap|)) + (OR (AND (|bpDot|) (|bpPop1|)) (|bpTrap|)) (OR (|bpTyping|) (|bpTrap|)) + (|bpPush| (|%Forall| (|bpPop2|) (|bpPop1|)))) + (T (OR (|bpMapping|) (|bpSimpleMapping|))))) (DEFUN |bpTagged| () (AND (|bpApplication|) - (OR (AND (|bpEqKey| 'COLON) (OR (|bpTyping|) (|bpTrap|)) - (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|)))) - T))) + (OR + (AND (|bpEqKey| 'COLON) (OR (|bpTyping|) (|bpTrap|)) + (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|)))) + T))) (DEFUN |bpExpt| () (|bpRightAssoc| '(POWER) #'|bpTagged|)) (DEFUN |bpInfKey| (|s|) - (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) - (|symbolMember?| |$ttok| |s|) (|bpPushId|) (|bpNext|))) + (DECLARE (SPECIAL |$stok| |$ttok|)) + (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (|symbolMember?| |$ttok| |s|) + (|bpPushId|) (|bpNext|))) -(DEFUN |bpInfGeneric| (|s|) - (AND (|bpInfKey| |s|) (OR (|bpEqKey| 'BACKSET) T))) +(DEFUN |bpInfGeneric| (|s|) (AND (|bpInfKey| |s|) (OR (|bpEqKey| 'BACKSET) T))) (DEFUN |bpRightAssoc| (|o| |p|) (PROG (|a|) (RETURN - (PROGN - (SETQ |a| (|bpState|)) - (COND - ((APPLY |p| NIL) - (LOOP - (COND - ((NOT (AND (|bpInfGeneric| |o|) - (OR (|bpRightAssoc| |o| |p|) (|bpTrap|)))) - (RETURN NIL)) - (T (|bpPush| - (|bfInfApplication| (|bpPop2|) (|bpPop2|) - (|bpPop1|)))))) - T) - (T (|bpRestore| |a|) NIL)))))) + (PROGN + (SETQ |a| (|bpState|)) + (COND + ((APPLY |p| NIL) + (LOOP + (COND + ((NOT + (AND (|bpInfGeneric| |o|) + (OR (|bpRightAssoc| |o| |p|) (|bpTrap|)))) + (RETURN NIL)) + (T + (|bpPush| (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|)))))) + T) + (T (|bpRestore| |a|) NIL)))))) (DEFUN |bpLeftAssoc| (|operations| |parser|) (COND - ((APPLY |parser| NIL) - (LOOP - (COND - ((NOT (AND (|bpInfGeneric| |operations|) - (OR (APPLY |parser| NIL) (|bpTrap|)))) - (RETURN NIL)) - (T (|bpPush| - (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|)))))) - T) - (T NIL))) + ((APPLY |parser| NIL) + (LOOP + (COND + ((NOT + (AND (|bpInfGeneric| |operations|) + (OR (APPLY |parser| NIL) (|bpTrap|)))) + (RETURN NIL)) + (T (|bpPush| (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|)))))) + T) + (T NIL))) (DEFUN |bpString| () - (DECLARE (SPECIAL |$ttok| |$stok|)) + (DECLARE (SPECIAL |$stok| |$ttok|)) (AND (EQ (|shoeTokType| |$stok|) 'STRING) (|bpPush| (|quote| (INTERN |$ttok|))) (|bpNext|))) (DEFUN |bpThetaName| () - (DECLARE (SPECIAL |$ttok| |$stok|)) + (DECLARE (SPECIAL |$stok| |$ttok|)) (COND - ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID) - (GET |$ttok| 'SHOETHETA)) - (|bpPushId|) (|bpNext|)) - (T NIL))) + ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID) (GET |$ttok| 'SHOETHETA)) + (|bpPushId|) (|bpNext|)) + (T NIL))) (DEFUN |bpReduceOperator| () (OR (|bpInfixOperator|) (|bpString|) (|bpThetaName|))) @@ -708,82 +653,80 @@ (DEFUN |bpReduce| () (PROG (|a|) (RETURN - (PROGN - (SETQ |a| (|bpState|)) + (PROGN + (SETQ |a| (|bpState|)) + (COND + ((AND (|bpReduceOperator|) (|bpEqKey| 'SLASH)) (COND - ((AND (|bpReduceOperator|) (|bpEqKey| 'SLASH)) - (COND - ((|bpEqPeek| 'OBRACK) - (AND (OR (|bpDConstruct|) (|bpTrap|)) - (|bpPush| (|bfReduceCollect| (|bpPop2|) (|bpPop1|))))) - (T (AND (OR (|bpApplication|) (|bpTrap|)) - (|bpPush| (|bfReduce| (|bpPop2|) (|bpPop1|))))))) - (T (|bpRestore| |a|) NIL)))))) + ((|bpEqPeek| 'OBRACK) + (AND (OR (|bpDConstruct|) (|bpTrap|)) + (|bpPush| (|bfReduceCollect| (|bpPop2|) (|bpPop1|))))) + (T + (AND (OR (|bpApplication|) (|bpTrap|)) + (|bpPush| (|bfReduce| (|bpPop2|) (|bpPop1|))))))) + (T (|bpRestore| |a|) NIL)))))) -(DEFUN |bpTimes| () - (OR (|bpReduce|) (|bpLeftAssoc| '(TIMES SLASH) #'|bpExpt|))) +(DEFUN |bpTimes| () (OR (|bpReduce|) (|bpLeftAssoc| '(TIMES SLASH) #'|bpExpt|))) (DEFUN |bpEuclid| () (|bpLeftAssoc| '(QUO REM) #'|bpTimes|)) (DEFUN |bpMinus| () - (OR (AND (|bpInfGeneric| '(MINUS)) (OR (|bpEuclid|) (|bpTrap|)) - (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|)))) - (|bpEuclid|))) + (OR + (AND (|bpInfGeneric| '(MINUS)) (OR (|bpEuclid|) (|bpTrap|)) + (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|)))) + (|bpEuclid|))) (DEFUN |bpArith| () (|bpLeftAssoc| '(PLUS MINUS) #'|bpMinus|)) (DEFUN |bpIs| () (AND (|bpArith|) (COND - ((AND (|bpInfKey| '(IS ISNT)) (OR (|bpPattern|) (|bpTrap|))) - (|bpPush| - (|bfISApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|)))) - ((AND (|bpEqKey| 'HAS) (OR (|bpApplication|) (|bpTrap|))) - (|bpPush| (|bfHas| (|bpPop2|) (|bpPop1|)))) - (T T)))) + ((AND (|bpInfKey| '(IS ISNT)) (OR (|bpPattern|) (|bpTrap|))) + (|bpPush| (|bfISApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|)))) + ((AND (|bpEqKey| 'HAS) (OR (|bpApplication|) (|bpTrap|))) + (|bpPush| (|bfHas| (|bpPop2|) (|bpPop1|)))) + (T T)))) (DEFUN |bpBracketConstruct| (|f|) (AND (|bpBracket| |f|) (|bpPush| (|bfConstruct| (|bpPop1|))))) (DEFUN |bpCompare| () - (OR (AND (|bpIs|) - (OR (AND (|bpInfKey| '(SHOEEQ SHOENE LT LE GT GE IN)) - (OR (|bpIs|) (|bpTrap|)) - (|bpPush| - (|bfInfApplication| (|bpPop2|) (|bpPop2|) - (|bpPop1|)))) - T)) - (|bpLeave|) (|bpThrow|))) + (OR + (AND (|bpIs|) + (OR + (AND (|bpInfKey| '(SHOEEQ SHOENE LT LE GT GE IN)) + (OR (|bpIs|) (|bpTrap|)) + (|bpPush| (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|)))) + T)) + (|bpLeave|) (|bpThrow|))) (DEFUN |bpAnd| () (|bpLeftAssoc| '(AND) #'|bpCompare|)) (DEFUN |bpThrow| () (COND - ((AND (|bpEqKey| 'THROW) (|bpApplication|)) - (COND - ((|bpEqKey| 'COLON) (OR (|bpApplication|) (|bpTrap|)) - (|bpPush| (|%Pretend| (|bpPop2|) (|bpPop1|))))) - (|bpPush| (|bfThrow| (|bpPop1|)))) - (T NIL))) + ((AND (|bpEqKey| 'THROW) (|bpApplication|)) + (COND + ((|bpEqKey| 'COLON) (OR (|bpApplication|) (|bpTrap|)) + (|bpPush| (|%Pretend| (|bpPop2|) (|bpPop1|))))) + (|bpPush| (|bfThrow| (|bpPop1|)))) + (T NIL))) (DEFUN |bpTry| () (PROG (|cs|) (RETURN - (COND - ((|bpEqKey| 'TRY) (|bpAssign|) (SETQ |cs| NIL) - (LOOP - (COND - ((NOT (|bpHandler| 'CATCH)) (RETURN NIL)) - (T (|bpCatchItem|) (SETQ |cs| (CONS (|bpPop1|) |cs|))))) - (COND - ((|bpHandler| 'FINALLY) - (AND (|bpFinally|) - (|bpPush| - (|bfTry| (|bpPop2|) - (|reverse!| (CONS (|bpPop1|) |cs|)))))) - ((NULL |cs|) (|bpTrap|)) - (T (|bpPush| (|bfTry| (|bpPop1|) (|reverse!| |cs|)))))) - (T NIL))))) + (COND + ((|bpEqKey| 'TRY) (|bpAssign|) (SETQ |cs| NIL) + (LOOP + (COND ((NOT (|bpHandler| 'CATCH)) (RETURN NIL)) + (T (|bpCatchItem|) (SETQ |cs| (CONS (|bpPop1|) |cs|))))) + (COND + ((|bpHandler| 'FINALLY) + (AND (|bpFinally|) + (|bpPush| + (|bfTry| (|bpPop2|) (|reverse!| (CONS (|bpPop1|) |cs|)))))) + ((NULL |cs|) (|bpTrap|)) + (T (|bpPush| (|bfTry| (|bpPop1|) (|reverse!| |cs|)))))) + (T NIL))))) (DEFUN |bpCatchItem| () (AND (OR (|bpExceptionVariable|) (|bpTrap|)) @@ -794,11 +737,12 @@ (PROG (|t|) (DECLARE (SPECIAL |$stok|)) (RETURN - (PROGN - (SETQ |t| |$stok|) - (OR (AND (|bpEqKey| 'OPAREN) (OR (|bpSignature|) (|bpTrap|)) - (OR (|bpEqKey| 'CPAREN) (|bpMissing| |t|))) - (|bpTrap|)))))) + (PROGN + (SETQ |t| |$stok|) + (OR + (AND (|bpEqKey| 'OPAREN) (OR (|bpSignature|) (|bpTrap|)) + (OR (|bpEqKey| 'CPAREN) (|bpMissing| |t|))) + (|bpTrap|)))))) (DEFUN |bpFinally| () (AND (OR (|bpAssign|) (|bpTrap|)) (|bpPush| (|%Finally| (|bpPop1|))))) @@ -806,13 +750,13 @@ (DEFUN |bpHandler| (|key|) (PROG (|s|) (RETURN - (PROGN - (SETQ |s| (|bpState|)) - (COND - ((AND (OR (|bpEqKey| 'BACKSET) (|bpEqKey| 'SEMICOLON)) - (|bpEqKey| |key|)) - T) - (T (|bpRestore| |s|) NIL)))))) + (PROGN + (SETQ |s| (|bpState|)) + (COND + ((AND (OR (|bpEqKey| 'BACKSET) (|bpEqKey| 'SEMICOLON)) + (|bpEqKey| |key|)) + T) + (T (|bpRestore| |s|) NIL)))))) (DEFUN |bpLeave| () (AND (|bpEqKey| 'LEAVE) (OR (|bpLogical|) (|bpTrap|)) @@ -820,36 +764,36 @@ (DEFUN |bpDo| () (COND - ((|bpEqKey| 'IN) (OR (|bpNamespace|) (|bpTrap|)) - (OR (|bpDo|) (|bpTrap|)) - (|bpPush| (|bfAtScope| (|bpPop2|) (|bpPop1|)))) - (T (AND (|bpEqKey| 'DO) (OR (|bpAssign|) (|bpTrap|)) - (|bpPush| (|bfDo| (|bpPop1|))))))) + ((|bpEqKey| 'IN) (OR (|bpNamespace|) (|bpTrap|)) (OR (|bpDo|) (|bpTrap|)) + (|bpPush| (|bfAtScope| (|bpPop2|) (|bpPop1|)))) + (T + (AND (|bpEqKey| 'DO) (OR (|bpAssign|) (|bpTrap|)) + (|bpPush| (|bfDo| (|bpPop1|))))))) (DEFUN |bpReturn| () - (OR (AND (|bpEqKey| 'RETURN) (OR (|bpAssign|) (|bpTrap|)) - (|bpPush| (|bfReturnNoName| (|bpPop1|)))) - (|bpLeave|) (|bpThrow|) (|bpAnd|) (|bpDo|))) + (OR + (AND (|bpEqKey| 'RETURN) (OR (|bpAssign|) (|bpTrap|)) + (|bpPush| (|bfReturnNoName| (|bpPop1|)))) + (|bpLeave|) (|bpThrow|) (|bpAnd|) (|bpDo|))) (DEFUN |bpLogical| () (|bpLeftAssoc| '(OR) #'|bpReturn|)) (DEFUN |bpExpression| () - (OR (AND (|bpEqKey| 'COLON) - (OR (AND (|bpLogical|) - (|bpPush| (|bfApplication| 'COLON (|bpPop1|)))) - (|bpTrap|))) - (|bpLogical|))) + (OR + (AND (|bpEqKey| 'COLON) + (OR (AND (|bpLogical|) (|bpPush| (|bfApplication| 'COLON (|bpPop1|)))) + (|bpTrap|))) + (|bpLogical|))) (DEFUN |bpStatement| () - (OR (|bpConditional| #'|bpWhere|) (|bpLoop|) (|bpExpression|) - (|bpTry|))) + (OR (|bpConditional| #'|bpWhere|) (|bpLoop|) (|bpExpression|) (|bpTry|))) (DEFUN |bpLoop| () - (OR (AND (|bpIterators|) (|bpCompMissing| 'REPEAT) - (OR (|bpWhere|) (|bpTrap|)) - (|bpPush| (|bfLp| (|bpPop2|) (|bpPop1|)))) - (AND (|bpEqKey| 'REPEAT) (OR (|bpLogical|) (|bpTrap|)) - (|bpPush| (|bfLoop1| (|bpPop1|)))))) + (OR + (AND (|bpIterators|) (|bpCompMissing| 'REPEAT) (OR (|bpWhere|) (|bpTrap|)) + (|bpPush| (|bfLp| (|bpPop2|) (|bpPop1|)))) + (AND (|bpEqKey| 'REPEAT) (OR (|bpLogical|) (|bpTrap|)) + (|bpPush| (|bfLoop1| (|bpPop1|)))))) (DEFUN |bpSuchThat| () (|bpAndOr| 'BAR #'|bpWhere| #'|bfSuchthat|)) @@ -860,32 +804,28 @@ (DEFUN |bpFormal| () (OR (|bpVariable|) (|bpDot|))) (DEFUN |bpForIn| () - (AND (|bpEqKey| 'FOR) (OR (|bpFormal|) (|bpTrap|)) - (|bpCompMissing| 'IN) - (OR (AND (OR (|bpSeg|) (|bpTrap|)) (|bpEqKey| 'BY) - (OR (|bpArith|) (|bpTrap|)) - (|bpPush| - (|bfForInBy| (|bpPop3|) (|bpPop2|) (|bpPop1|)))) - (|bpPush| (|bfForin| (|bpPop2|) (|bpPop1|)))))) + (AND (|bpEqKey| 'FOR) (OR (|bpFormal|) (|bpTrap|)) (|bpCompMissing| 'IN) + (OR + (AND (OR (|bpSeg|) (|bpTrap|)) (|bpEqKey| 'BY) + (OR (|bpArith|) (|bpTrap|)) + (|bpPush| (|bfForInBy| (|bpPop3|) (|bpPop2|) (|bpPop1|)))) + (|bpPush| (|bfForin| (|bpPop2|) (|bpPop1|)))))) (DEFUN |bpSeg| () (AND (|bpArith|) - (OR (AND (|bpEqKey| 'SEG) - (OR (AND (|bpArith|) - (|bpPush| - (|bfSegment2| (|bpPop2|) (|bpPop1|)))) - (|bpPush| (|bfSegment1| (|bpPop1|))))) - T))) + (OR + (AND (|bpEqKey| 'SEG) + (OR + (AND (|bpArith|) (|bpPush| (|bfSegment2| (|bpPop2|) (|bpPop1|)))) + (|bpPush| (|bfSegment1| (|bpPop1|))))) + T))) -(DEFUN |bpIterator| () - (OR (|bpForIn|) (|bpSuchThat|) (|bpWhile|) (|bpUntil|))) +(DEFUN |bpIterator| () (OR (|bpForIn|) (|bpSuchThat|) (|bpWhile|) (|bpUntil|))) (DEFUN |bpIteratorList| () - (AND (|bpOneOrMore| #'|bpIterator|) - (|bpPush| (|bfIterators| (|bpPop1|))))) + (AND (|bpOneOrMore| #'|bpIterator|) (|bpPush| (|bfIterators| (|bpPop1|))))) -(DEFUN |bpCrossBackSet| () - (AND (|bpEqKey| 'CROSS) (OR (|bpEqKey| 'BACKSET) T))) +(DEFUN |bpCrossBackSet| () (AND (|bpEqKey| 'CROSS) (OR (|bpEqKey| 'BACKSET) T))) (DEFUN |bpIterators| () (|bpListofFun| #'|bpIteratorList| #'|bpCrossBackSet| #'|bfCross|)) @@ -893,21 +833,18 @@ (DEFUN |bpAssign| () (PROG (|a|) (RETURN - (PROGN - (SETQ |a| (|bpState|)) + (PROGN + (SETQ |a| (|bpState|)) + (COND + ((|bpStatement|) (COND - ((|bpStatement|) - (COND - ((|bpEqPeek| 'BEC) (|bpRestore| |a|) - (OR (|bpAssignment|) (|bpTrap|))) - ((|bpEqPeek| 'GIVES) (|bpRestore| |a|) - (OR (|bpLambda|) (|bpTrap|))) - (T T))) - (T (|bpRestore| |a|) NIL)))))) + ((|bpEqPeek| 'BEC) (|bpRestore| |a|) (OR (|bpAssignment|) (|bpTrap|))) + ((|bpEqPeek| 'GIVES) (|bpRestore| |a|) (OR (|bpLambda|) (|bpTrap|))) + (T T))) + (T (|bpRestore| |a|) NIL)))))) (DEFUN |bpAssignment| () - (AND (|bpAssignVariable|) (|bpEqKey| 'BEC) - (OR (|bpAssign|) (|bpTrap|)) + (AND (|bpAssignVariable|) (|bpEqKey| 'BEC) (OR (|bpAssign|) (|bpTrap|)) (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))) (DEFUN |bpLambda| () @@ -916,35 +853,35 @@ (DEFUN |bpExit| () (AND (|bpAssign|) - (OR (AND (|bpEqKey| 'EXIT) (OR (|bpWhere|) (|bpTrap|)) - (|bpPush| (|bfExit| (|bpPop2|) (|bpPop1|)))) - T))) + (OR + (AND (|bpEqKey| 'EXIT) (OR (|bpWhere|) (|bpTrap|)) + (|bpPush| (|bfExit| (|bpPop2|) (|bpPop1|)))) + T))) (DEFUN |bpDefinition| () (PROG (|a|) (RETURN - (COND - ((|bpEqKey| 'MACRO) - (OR (AND (|bpName|) (|bpStoreName|) - (|bpCompoundDefinitionTail| #'|%Macro|)) - (|bpTrap|))) - (T (SETQ |a| (|bpState|)) - (COND - ((|bpExit|) - (COND - ((|bpEqPeek| 'DEF) (|bpRestore| |a|) (|bpDef|)) - ((|bpEqPeek| 'TDEF) (|bpRestore| |a|) - (|bpTypeAliasDefition|)) - (T T))) - (T (|bpRestore| |a|) NIL))))))) + (COND + ((|bpEqKey| 'MACRO) + (OR + (AND (|bpName|) (|bpStoreName|) + (|bpCompoundDefinitionTail| #'|%Macro|)) + (|bpTrap|))) + (T (SETQ |a| (|bpState|)) + (COND + ((|bpExit|) + (COND ((|bpEqPeek| 'DEF) (|bpRestore| |a|) (|bpDef|)) + ((|bpEqPeek| 'TDEF) (|bpRestore| |a|) (|bpTypeAliasDefition|)) + (T T))) + (T (|bpRestore| |a|) NIL))))))) (DEFUN |bpStoreName| () - (DECLARE (SPECIAL |$typings| |$wheredefs| |$op| |$stack|)) + (DECLARE (SPECIAL |$stack| |$op| |$wheredefs| |$typings|)) (PROGN - (SETQ |$op| (CAR |$stack|)) - (SETQ |$wheredefs| NIL) - (SETQ |$typings| NIL) - T)) + (SETQ |$op| (CAR |$stack|)) + (SETQ |$wheredefs| NIL) + (SETQ |$typings| NIL) + T)) (DEFUN |bpDef| () (AND (|bpName|) (|bpStoreName|) (|bpDefTail| #'|%Definition|))) @@ -964,24 +901,22 @@ (DEFUN |bpWhere| () (AND (|bpDefinition|) - (OR (AND (|bpEqKey| 'WHERE) (OR (|bpDefinitionItem|) (|bpTrap|)) - (|bpPush| (|bfWhere| (|bpPop1|) (|bpPop1|)))) - T))) + (OR + (AND (|bpEqKey| 'WHERE) (OR (|bpDefinitionItem|) (|bpTrap|)) + (|bpPush| (|bfWhere| (|bpPop1|) (|bpPop1|)))) + T))) (DEFUN |bpDefinitionItem| () (PROG (|a|) (RETURN - (PROGN - (SETQ |a| (|bpState|)) - (COND - ((|bpDDef|) T) - (T (|bpRestore| |a|) - (COND - ((|bpBDefinitionPileItems|) T) - (T (|bpRestore| |a|) - (COND - ((|bpPDefinitionItems|) T) - (T (|bpRestore| |a|) (|bpWhere|))))))))))) + (PROGN + (SETQ |a| (|bpState|)) + (COND ((|bpDDef|) T) + (T (|bpRestore| |a|) + (COND ((|bpBDefinitionPileItems|) T) + (T (|bpRestore| |a|) + (COND ((|bpPDefinitionItems|) T) + (T (|bpRestore| |a|) (|bpWhere|))))))))))) (DEFUN |bpDefinitionPileItems| () (AND (|bpListAndRecover| #'|bpDefinitionItem|) @@ -993,23 +928,18 @@ (DEFUN |bpSemiColonDefinition| () (|bpSemiListing| #'|bpDefinitionItem| #'|%Pile|)) -(DEFUN |bpPDefinitionItems| () - (|bpParenthesized| #'|bpSemiColonDefinition|)) +(DEFUN |bpPDefinitionItems| () (|bpParenthesized| #'|bpSemiColonDefinition|)) (DEFUN |bpComma| () - (OR (|bpModule|) (|bpImport|) (|bpNamespace|) - (|bpTuple| #'|bpWhere|))) + (OR (|bpModule|) (|bpImport|) (|bpNamespace|) (|bpTuple| #'|bpWhere|))) -(DEFUN |bpTuple| (|p|) - (|bpListofFun| |p| #'|bpCommaBackSet| #'|bfTuple|)) +(DEFUN |bpTuple| (|p|) (|bpListofFun| |p| #'|bpCommaBackSet| #'|bfTuple|)) -(DEFUN |bpCommaBackSet| () - (AND (|bpEqKey| 'COMMA) (OR (|bpEqKey| 'BACKSET) T))) +(DEFUN |bpCommaBackSet| () (AND (|bpEqKey| 'COMMA) (OR (|bpEqKey| 'BACKSET) T))) (DEFUN |bpSemiColon| () (|bpSemiListing| #'|bpComma| #'|bfSequence|)) -(DEFUN |bpSemiListing| (|p| |f|) - (|bpListofFun| |p| #'|bpSemiBackSet| |f|)) +(DEFUN |bpSemiListing| (|p| |f|) (|bpListofFun| |p| #'|bpSemiBackSet| |f|)) (DEFUN |bpSemiBackSet| () (AND (|bpEqKey| 'SEMICOLON) (OR (|bpEqKey| 'BACKSET) T))) @@ -1022,39 +952,39 @@ (DEFUN |bpBPileDefinition| () (|bpPileBracketed| #'|bpPileItems|)) -(DEFUN |bpIteratorTail| () - (AND (OR (|bpEqKey| 'REPEAT) T) (|bpIterators|))) +(DEFUN |bpIteratorTail| () (AND (OR (|bpEqKey| 'REPEAT) T) (|bpIterators|))) (DEFUN |bpConstruct| () (|bpBracket| #'|bpConstruction|)) (DEFUN |bpConstruction| () (AND (|bpComma|) - (OR (AND (|bpIteratorTail|) - (|bpPush| (|bfCollect| (|bpPop2|) (|bpPop1|)))) - (|bpPush| (|bfTupleConstruct| (|bpPop1|)))))) + (OR + (AND (|bpIteratorTail|) (|bpPush| (|bfCollect| (|bpPop2|) (|bpPop1|)))) + (|bpPush| (|bfTupleConstruct| (|bpPop1|)))))) (DEFUN |bpDConstruct| () (|bpBracket| #'|bpDConstruction|)) (DEFUN |bpDConstruction| () (AND (|bpComma|) - (OR (AND (|bpIteratorTail|) - (|bpPush| (|bfDCollect| (|bpPop2|) (|bpPop1|)))) - (|bpPush| (|bfDTuple| (|bpPop1|)))))) + (OR + (AND (|bpIteratorTail|) + (|bpPush| (|bfDCollect| (|bpPop2|) (|bpPop1|)))) + (|bpPush| (|bfDTuple| (|bpPop1|)))))) (DEFUN |bpPattern| () (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpName|) (|bpConstTok|))) (DEFUN |bpEqual| () - (AND (|bpEqKey| 'SHOEEQ) - (OR (|bpApplication|) (|bpConstTok|) (|bpTrap|)) + (AND (|bpEqKey| 'SHOEEQ) (OR (|bpApplication|) (|bpConstTok|) (|bpTrap|)) (|bpPush| (|bfEqual| (|bpPop1|))))) (DEFUN |bpRegularPatternItem| () (OR (|bpEqual|) (|bpConstTok|) (|bpDot|) (AND (|bpName|) - (OR (AND (|bpEqKey| 'BEC) (OR (|bpPattern|) (|bpTrap|)) - (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|)))) - T)) + (OR + (AND (|bpEqKey| 'BEC) (OR (|bpPattern|) (|bpTrap|)) + (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|)))) + T)) (|bpBracketConstruct| #'|bpPatternL|))) (DEFUN |bpRegularPatternItemL| () @@ -1072,37 +1002,40 @@ (DEFUN |bpPatternList| () (COND - ((|bpRegularPatternItemL|) - (LOOP - (COND - ((NOT (AND (|bpEqKey| 'COMMA) - (OR (|bpRegularPatternItemL|) - (PROGN - (OR (AND (|bpPatternTail|) - (|bpPush| - (|append| (|bpPop2|) (|bpPop1|)))) - (|bpTrap|)) - NIL)))) - (RETURN NIL)) - (T (|bpPush| (|append| (|bpPop2|) (|bpPop1|)))))) - T) - (T (|bpPatternTail|)))) + ((|bpRegularPatternItemL|) + (LOOP + (COND + ((NOT + (AND (|bpEqKey| 'COMMA) + (OR (|bpRegularPatternItemL|) + (PROGN + (OR + (AND (|bpPatternTail|) + (|bpPush| (|append| (|bpPop2|) (|bpPop1|)))) + (|bpTrap|)) + NIL)))) + (RETURN NIL)) + (T (|bpPush| (|append| (|bpPop2|) (|bpPop1|)))))) + T) + (T (|bpPatternTail|)))) (DEFUN |bpPatternTail| () (AND (|bpPatternColon|) - (OR (AND (|bpEqKey| 'COMMA) (OR (|bpRegularList|) (|bpTrap|)) - (|bpPush| (|append| (|bpPop2|) (|bpPop1|)))) - T))) + (OR + (AND (|bpEqKey| 'COMMA) (OR (|bpRegularList|) (|bpTrap|)) + (|bpPush| (|append| (|bpPop2|) (|bpPop1|)))) + T))) (DEFUN |bpRegularBVItemTail| () - (OR (AND (|bpEqKey| 'COLON) (OR (|bpApplication|) (|bpTrap|)) - (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|)))) - (AND (|bpEqKey| 'BEC) (OR (|bpPattern|) (|bpTrap|)) - (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|)))) - (AND (|bpEqKey| 'IS) (OR (|bpPattern|) (|bpTrap|)) - (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|)))) - (AND (|bpEqKey| 'DEF) (OR (|bpApplication|) (|bpTrap|)) - (|bpPush| (|%DefaultValue| (|bpPop2|) (|bpPop1|)))))) + (OR + (AND (|bpEqKey| 'COLON) (OR (|bpApplication|) (|bpTrap|)) + (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|)))) + (AND (|bpEqKey| 'BEC) (OR (|bpPattern|) (|bpTrap|)) + (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|)))) + (AND (|bpEqKey| 'IS) (OR (|bpPattern|) (|bpTrap|)) + (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|)))) + (AND (|bpEqKey| 'DEF) (OR (|bpApplication|) (|bpTrap|)) + (|bpPush| (|%DefaultValue| (|bpPop2|) (|bpPop1|)))))) (DEFUN |bpRegularBVItem| () (OR (|bpBVString|) (|bpConstTok|) @@ -1110,7 +1043,7 @@ (|bpBracketConstruct| #'|bpPatternL|))) (DEFUN |bpBVString| () - (DECLARE (SPECIAL |$ttok| |$stok|)) + (DECLARE (SPECIAL |$stok| |$ttok|)) (AND (EQ (|shoeTokType| |$stok|) 'STRING) (|bpPush| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext|))) @@ -1122,54 +1055,53 @@ (DEFUN |bpBoundVariablelist| () (COND - ((|bpRegularBVItemL|) - (LOOP - (COND - ((NOT (AND (|bpEqKey| 'COMMA) - (OR (|bpRegularBVItemL|) - (PROGN - (OR (AND (|bpColonName|) - (|bpPush| - (|bfColonAppend| (|bpPop2|) - (|bpPop1|)))) - (|bpTrap|)) - NIL)))) - (RETURN NIL)) - (T (|bpPush| (|append| (|bpPop2|) (|bpPop1|)))))) - T) - (T (AND (|bpColonName|) - (|bpPush| (|bfColonAppend| NIL (|bpPop1|))))))) + ((|bpRegularBVItemL|) + (LOOP + (COND + ((NOT + (AND (|bpEqKey| 'COMMA) + (OR (|bpRegularBVItemL|) + (PROGN + (OR + (AND (|bpColonName|) + (|bpPush| (|bfColonAppend| (|bpPop2|) (|bpPop1|)))) + (|bpTrap|)) + NIL)))) + (RETURN NIL)) + (T (|bpPush| (|append| (|bpPop2|) (|bpPop1|)))))) + T) + (T (AND (|bpColonName|) (|bpPush| (|bfColonAppend| NIL (|bpPop1|))))))) (DEFUN |bpVariable| () - (OR (AND (|bpParenthesized| #'|bpBoundVariablelist|) - (|bpPush| (|bfTupleIf| (|bpPop1|)))) - (|bpBracketConstruct| #'|bpPatternL|) (|bpName|) (|bpConstTok|))) + (OR + (AND (|bpParenthesized| #'|bpBoundVariablelist|) + (|bpPush| (|bfTupleIf| (|bpPop1|)))) + (|bpBracketConstruct| #'|bpPatternL|) (|bpName|) (|bpConstTok|))) (DEFUN |bpAssignVariable| () (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpAssignLHS|))) (DEFUN |bpAssignLHS| () - (COND - ((NOT (|bpName|)) NIL) - ((|bpEqKey| 'COLON) (OR (|bpApplication|) (|bpTrap|)) - (|bpPush| (|bfLocal| (|bpPop2|) (|bpPop1|)))) - (T (AND (|bpArgumentList|) - (OR (|bpEqPeek| 'DOT) - (AND (|bpEqPeek| 'BEC) - (|bpPush| (|bfPlace| (|bpPop1|)))) - (|bpTrap|))) - (COND - ((|bpEqKey| 'DOT) - (AND (|bpList| #'|bpPrimary| 'DOT) (|bpChecknull|) - (|bpPush| (|bfTuple| (CONS (|bpPop2|) (|bpPop1|)))))) - (T T))))) + (COND ((NOT (|bpName|)) NIL) + ((|bpEqKey| 'COLON) (OR (|bpApplication|) (|bpTrap|)) + (|bpPush| (|bfLocal| (|bpPop2|) (|bpPop1|)))) + (T + (AND (|bpArgumentList|) + (OR (|bpEqPeek| 'DOT) + (AND (|bpEqPeek| 'BEC) (|bpPush| (|bfPlace| (|bpPop1|)))) + (|bpTrap|))) + (COND + ((|bpEqKey| 'DOT) + (AND (|bpList| #'|bpPrimary| 'DOT) (|bpChecknull|) + (|bpPush| (|bfTuple| (CONS (|bpPop2|) (|bpPop1|)))))) + (T T))))) (DEFUN |bpChecknull| () (PROG (|a|) (RETURN - (PROGN - (SETQ |a| (|bpPop1|)) - (COND ((NULL |a|) (|bpTrap|)) (T (|bpPush| |a|))))))) + (PROGN + (SETQ |a| (|bpPop1|)) + (COND ((NULL |a|) (|bpTrap|)) (T (|bpPush| |a|))))))) (DEFUN |bpStruct| () (AND (|bpEqKey| 'STRUCTURE) (OR (|bpName|) (|bpTrap|)) @@ -1185,12 +1117,13 @@ (DEFUN |bpTypeItemList| () (|bpListAndRecover| #'|bpTypeItem|)) (DEFUN |bpTerm| (|idListParser|) - (OR (AND (OR (|bpName|) (|bpTrap|)) - (OR (AND (|bpParenthesized| |idListParser|) - (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|)))) - (AND (|bpName|) - (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|)))))) - (|bpPush| (|bfNameOnly| (|bpPop1|))))) + (OR + (AND (OR (|bpName|) (|bpTrap|)) + (OR + (AND (|bpParenthesized| |idListParser|) + (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|)))) + (AND (|bpName|) (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|)))))) + (|bpPush| (|bfNameOnly| (|bpPop1|))))) (DEFUN |bpIdList| () (|bpTuple| #'|bpName|)) @@ -1215,29 +1148,26 @@ (DEFUN |bpOutItem| () (PROG (|$GenVarCounter| |$op| |r| |ISTMP#2| |l| |ISTMP#1| |b|) - (DECLARE (SPECIAL |$GenVarCounter| |$op| |$InteractiveMode|)) + (DECLARE (SPECIAL |$op| |$GenVarCounter| |$InteractiveMode|)) (RETURN - (PROGN - (SETQ |$op| NIL) - (SETQ |$GenVarCounter| 0) - (OR (|bpComma|) (|bpTrap|)) - (SETQ |b| (|bpPop1|)) - (|bpPush| - (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| |b| NIL)))))))) + (PROGN + (SETQ |$op| NIL) + (SETQ |$GenVarCounter| 0) + (OR (|bpComma|) (|bpTrap|)) + (SETQ |b| (|bpPop1|)) + (|bpPush| + (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| |b| NIL)))))))) |