(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|)

(DEFMACRO |mk%ParserState| (|toks| |trees| |pren| |scp|)
  (LIST '|MAKE-%ParserState| :|toks| |toks| :|trees| |trees| :|pren| |pren|
        :|scp| |scp|))

(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|))

(DEFUN |makeParserState| (|toks|) (|mk%ParserState| |toks| NIL 0 0))

(DEFSTRUCT (|%Translator| (:COPIER |copy%Translator|))
  |ipath|
  |fdefs|
  |sigs|
  |xports|
  |csts|)

(DEFMACRO |mk%Translator| (|ipath| |fdefs| |sigs| |xports| |csts|)
  (LIST '|MAKE-%Translator| :|ipath| |ipath| :|fdefs| |fdefs| :|sigs| |sigs|
        :|xports| |xports| :|csts| |csts|))

(DEFMACRO |inputFilePath| (|bfVar#1|) (LIST '|%Translator-ifile| |bfVar#1|))

(DEFMACRO |functionDefinitions| (|bfVar#1|)
  (LIST '|%Translator-fdefs| |bfVar#1|))

(DEFMACRO |globalSignatures| (|bfVar#1|) (LIST '|%Translator-sigs| |bfVar#1|))

(DEFMACRO |exportedNames| (|bfVar#1|) (LIST '|%Translator-xports| |bfVar#1|))

(DEFMACRO |constantBindings| (|bfVar#1|) (LIST '|%Translator-csts| |bfVar#1|))

(DEFUN |makeTranslator| (|ip|) (|mk%Translator| |ip| NIL NIL NIL NIL))

(DEFUN |bpFirstToken| ()
  (DECLARE (SPECIAL |$ttok| |$stok| |$inputStream|))
  (PROGN
   (SETQ |$stok|
           (COND
            ((NULL |$inputStream|)
             (|mk%Token| 'ERROR 'NOMORE (|tokenPosition| |$stok|)))
            (T (CAR |$inputStream|))))
   (SETQ |$ttok| (|tokenValue| |$stok|))
   T))

(DEFUN |bpFirstTok| ()
  (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$ttok| |$stok| |$inputStream|))
  (PROGN
   (SETQ |$stok|
           (COND
            ((NULL |$inputStream|)
             (|mk%Token| 'ERROR 'NOMORE (|tokenPosition| |$stok|)))
            (T (CAR |$inputStream|))))
   (SETQ |$ttok| (|tokenValue| |$stok|))
   (COND
    ((AND (PLUSP |$bpParenCount|) (EQ (|tokenClass| |$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|))
  (PROGN (SETQ |$inputStream| (CDR |$inputStream|)) (|bpFirstTok|)))

(DEFUN |bpNextToken| ()
  (DECLARE (SPECIAL |$inputStream|))
  (PROGN (SETQ |$inputStream| (CDR |$inputStream|)) (|bpFirstToken|)))

(DEFUN |bpRequire| (|ps| |f|) (OR (APPLY |f| |ps| NIL) (|bpTrap|)))

(DEFUN |bpState| ()
  (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|))
  (LIST |$inputStream| |$stack| |$bpParenCount| |$bpCount|))

(DEFUN |bpRestore| (|x|)
  (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|))
  (PROGN
   (SETQ |$inputStream| (CAR |x|))
   (|bpFirstToken|)
   (SETQ |$stack| (CADR |x|))
   (SETQ |$bpParenCount| (CADDR |x|))
   (SETQ |$bpCount| (CADDDR |x|))
   T))

(DEFUN |bpPush| (|ps| |x|)
  (DECLARE (SPECIAL |$stack|))
  (SETQ |$stack| (CONS |x| |$stack|)))

(DEFUN |bpPushId| (|ps|)
  (DECLARE (SPECIAL |$stack| |$ttok|))
  (SETQ |$stack| (CONS (|bfReName| |$ttok|) |$stack|)))

(DEFUN |bpPop1| ()
  (LET* (|a|)
    (DECLARE (SPECIAL |$stack|))
    (PROGN (SETQ |a| (CAR |$stack|)) (SETQ |$stack| (CDR |$stack|)) |a|)))

(DEFUN |bpPop2| ()
  (LET* (|a|)
    (DECLARE (SPECIAL |$stack|))
    (PROGN (SETQ |a| (CADR |$stack|)) (RPLACD |$stack| (CDDR |$stack|)) |a|)))

(DEFUN |bpPop3| ()
  (LET* (|a|)
    (DECLARE (SPECIAL |$stack|))
    (PROGN
     (SETQ |a| (CADDR |$stack|))
     (RPLACD (CDR |$stack|) (CDDDR |$stack|))
     |a|)))

(DEFUN |bpIndentParenthesized| (|ps| |f|)
  (LET* (|a|)
    (DECLARE (SPECIAL |$inputStream| |$bpParenCount| |$stok|))
    (LET ((|$bpCount| 0))
      (DECLARE (SPECIAL |$bpCount|))
      (PROGN
       (SETQ |a| |$stok|)
       (COND
        ((|bpEqPeek| 'OPAREN) (SETQ |$bpParenCount| (+ |$bpParenCount| 1))
         (|bpNext|)
         (COND
          ((AND (APPLY |f| |ps| 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| |ps| (|bfTuple| NIL))
           (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|) T)
          (T (|bpParenTrap| |a|))))
        (T NIL))))))

(DEFUN |bpParenthesized| (|ps| |f|)
  (LET* (|a|)
    (DECLARE (SPECIAL |$stok|))
    (PROGN
     (SETQ |a| |$stok|)
     (COND
      ((|bpEqKey| 'OPAREN)
       (COND
        ((AND (APPLY |f| |ps| NIL)
              (OR (|bpEqKey| 'CPAREN) (|bpParenTrap| |a|)))
         T)
        ((|bpEqKey| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL)) T)
        (T (|bpParenTrap| |a|))))
      (T NIL)))))

(DEFUN |bpBracket| (|ps| |f|)
  (LET* (|a|)
    (DECLARE (SPECIAL |$stok|))
    (PROGN
     (SETQ |a| |$stok|)
     (COND
      ((|bpEqKey| 'OBRACK)
       (COND
        ((AND (APPLY |f| |ps| NIL)
              (OR (|bpEqKey| 'CBRACK) (|bpBrackTrap| |a|)))
         (|bpPush| |ps| (|bfBracket| (|bpPop1|))))
        ((|bpEqKey| 'CBRACK) (|bpPush| |ps| NIL)) (T (|bpBrackTrap| |a|))))
      (T NIL)))))

(DEFUN |bpPileBracketed| (|ps| |f|)
  (COND
   ((|bpEqKey| 'SETTAB)
    (COND ((|bpEqKey| 'BACKTAB) T)
          ((AND (APPLY |f| |ps| NIL) (OR (|bpEqKey| 'BACKTAB) (|bpPileTrap|)))
           (|bpPush| |ps| (|bfPile| (|bpPop1|))))
          (T NIL)))
   (T NIL)))

(DEFUN |bpListof| (|ps| |f| |str1| |g|)
  (LET* (|a|)
    (DECLARE (SPECIAL |$stack|))
    (COND
     ((APPLY |f| |ps| NIL)
      (COND
       ((AND (|bpEqKey| |str1|) (|bpRequire| |ps| |f|)) (SETQ |a| |$stack|)
        (SETQ |$stack| NIL)
        (LOOP
         (COND
          ((NOT (AND (|bpEqKey| |str1|) (|bpRequire| |ps| |f|))) (RETURN NIL))
          (T NIL)))
        (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
        (|bpPush| |ps|
                  (FUNCALL |g|
                           (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
       (T T)))
     (T NIL))))

(DEFUN |bpListofFun| (|ps| |f| |h| |g|)
  (LET* (|a|)
    (DECLARE (SPECIAL |$stack|))
    (COND
     ((APPLY |f| |ps| NIL)
      (COND
       ((AND (APPLY |h| |ps| NIL) (|bpRequire| |ps| |f|)) (SETQ |a| |$stack|)
        (SETQ |$stack| NIL)
        (LOOP
         (COND
          ((NOT (AND (APPLY |h| |ps| NIL) (|bpRequire| |ps| |f|)))
           (RETURN NIL))
          (T NIL)))
        (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
        (|bpPush| |ps|
                  (FUNCALL |g|
                           (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
       (T T)))
     (T NIL))))

(DEFUN |bpList| (|ps| |f| |str1|)
  (LET* (|a|)
    (DECLARE (SPECIAL |$stack|))
    (COND
     ((APPLY |f| |ps| NIL)
      (COND
       ((AND (|bpEqKey| |str1|) (|bpRequire| |ps| |f|)) (SETQ |a| |$stack|)
        (SETQ |$stack| NIL)
        (LOOP
         (COND
          ((NOT (AND (|bpEqKey| |str1|) (|bpRequire| |ps| |f|))) (RETURN NIL))
          (T NIL)))
        (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
        (|bpPush| |ps| (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|)))))
       (T (|bpPush| |ps| (LIST (|bpPop1|))))))
     (T (|bpPush| |ps| NIL)))))

(DEFUN |bpOneOrMore| (|ps| |f|)
  (LET* (|a|)
    (DECLARE (SPECIAL |$stack|))
    (COND
     ((APPLY |f| |ps| NIL) (SETQ |a| |$stack|) (SETQ |$stack| NIL)
      (LOOP (COND ((NOT (APPLY |f| |ps| NIL)) (RETURN NIL)) (T NIL)))
      (SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
      (|bpPush| |ps| (CONS (|bpPop2|) (|bpPop1|))))
     (T NIL))))

(DEFUN |bpAnyNo| (|ps| |s|)
  (PROGN (LOOP (COND ((NOT (APPLY |s| |ps| NIL)) (RETURN NIL)) (T NIL))) T))

(DEFUN |bpAndOr| (|ps| |keyword| |p| |f|)
  (AND (|bpEqKey| |keyword|) (|bpRequire| |ps| |p|)
       (|bpPush| |ps| (FUNCALL |f| (|bpPop1|)))))

(DEFUN |bpConditional| (|ps| |f|)
  (COND
   ((AND (|bpEqKey| 'IF) (|bpRequire| |ps| #'|bpWhere|)
         (OR (|bpEqKey| 'BACKSET) T))
    (COND
     ((|bpEqKey| 'SETTAB)
      (COND
       ((|bpEqKey| 'THEN)
        (AND (|bpRequire| |ps| |f|) (|bpElse| |ps| |f|) (|bpEqKey| 'BACKTAB)))
       (T (|bpMissing| 'THEN))))
     ((|bpEqKey| 'THEN) (AND (|bpRequire| |ps| |f|) (|bpElse| |ps| |f|)))
     (T (|bpMissing| '|then|))))
   (T NIL)))

(DEFUN |bpElse| (|ps| |f|)
  (LET* (|a|)
    (PROGN
     (SETQ |a| (|bpState|))
     (COND
      ((|bpBacksetElse|)
       (AND (|bpRequire| |ps| |f|)
            (|bpPush| |ps| (|bfIf| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))
      (T (|bpRestore| |a|)
       (|bpPush| |ps| (|bfIfThenOnly| (|bpPop2|) (|bpPop1|))))))))

(DEFUN |bpBacksetElse| ()
  (COND ((|bpEqKey| 'BACKSET) (|bpEqKey| 'ELSE)) (T (|bpEqKey| 'ELSE))))

(DEFUN |bpEqPeek| (|s|)
  (DECLARE (SPECIAL |$ttok| |$stok|))
  (AND (EQ (|tokenClass| |$stok|) 'KEY) (EQ |s| |$ttok|)))

(DEFUN |bpEqKey| (|s|)
  (DECLARE (SPECIAL |$ttok| |$stok|))
  (AND (EQ (|tokenClass| |$stok|) 'KEY) (EQ |s| |$ttok|) (|bpNext|)))

(DEFUN |bpEqKeyNextTok| (|s|)
  (DECLARE (SPECIAL |$ttok| |$stok|))
  (AND (EQ (|tokenClass| |$stok|) 'KEY) (EQ |s| |$ttok|) (|bpNextToken|)))

(DEFUN |bpPileTrap| () (|bpMissing| 'BACKTAB))

(DEFUN |bpBrackTrap| (|x|) (|bpMissingMate| '] |x|))

(DEFUN |bpParenTrap| (|x|) (|bpMissingMate| '|)| |x|))

(DEFUN |bpMissingMate| (|close| |open|)
  (PROGN
   (|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)))))

(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)))))

(DEFUN |bpRecoverTrap| (|ps|)
  (LET* (|pos2| |pos1|)
    (DECLARE (SPECIAL |$stok|))
    (PROGN
     (|bpFirstToken|)
     (SETQ |pos1| (|tokenPosition| |$stok|))
     (|bpMoveTo| 0)
     (SETQ |pos2| (|tokenPosition| |$stok|))
     (|bpIgnoredFromTo| |pos1| |pos2|)
     (|bpPush| |ps| (LIST (LIST "pile syntax error"))))))

(DEFUN |bpListAndRecover| (|ps| |f|)
  (LET* (|found| |c| |done| |b| |a|)
    (DECLARE (SPECIAL |$inputStream| |$stack|))
    (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| |ps| NIL))))
                       (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) (SETQ |$inputStream| |c|)
               (|bpRecoverTrap| |ps|))
              ((NOT |found|) (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|)
               (|bpRecoverTrap| |ps|)))
             (COND ((|bpEqKey| 'BACKSET) (SETQ |c| |$inputStream|))
                   ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|))
                    (SETQ |done| T))
                   (T (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|)
                    (|bpRecoverTrap| |ps|)
                    (COND
                     ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|))
                      (SETQ |done| T))
                     (T (|bpNext|) (SETQ |c| |$inputStream|)))))
             (SETQ |b| (CONS (|bpPop1|) |b|)))))
     (SETQ |$stack| |a|)
     (|bpPush| |ps| (|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|))))

(DEFUN |bpQualifiedName| (|ps|)
  (DECLARE (SPECIAL |$stok|))
  (COND
   ((|bpEqPeek| 'COLON-COLON) (|bpNext|)
    (AND (EQ (|tokenClass| |$stok|) 'ID) (|bpPushId| |ps|) (|bpNext|)
         (|bpPush| |ps| (|bfColonColon| (|bpPop2|) (|bpPop1|)))))
   (T NIL)))

(DEFUN |bpName| (|ps|)
  (DECLARE (SPECIAL |$stok|))
  (COND
   ((EQ (|tokenClass| |$stok|) 'ID) (|bpPushId| |ps|) (|bpNext|)
    (|bpAnyNo| |ps| #'|bpQualifiedName|))
   (T NIL)))

(DEFUN |bpConstTok| (|ps|)
  (DECLARE (SPECIAL |$ttok| |$stok|))
  (COND
   ((|symbolMember?| (|tokenClass| |$stok|) '(INTEGER FLOAT))
    (|bpPush| |ps| |$ttok|) (|bpNext|))
   ((EQ (|tokenClass| |$stok|) 'LISP)
    (AND (|bpPush| |ps| (|%Lisp| |$ttok|)) (|bpNext|)))
   ((EQ (|tokenClass| |$stok|) 'LISPEXP)
    (AND (|bpPush| |ps| |$ttok|) (|bpNext|)))
   ((EQ (|tokenClass| |$stok|) 'LINE)
    (AND (|bpPush| |ps| (LIST '+LINE |$ttok|)) (|bpNext|)))
   ((|bpEqPeek| 'QUOTE) (|bpNext|)
    (AND (|bpRequire| |ps| #'|bpSexp|)
         (|bpPush| |ps| (|bfSymbol| (|bpPop1|)))))
   (T (OR (|bpString| |ps|) (|bpFunction| |ps|)))))

(DEFUN |bpChar| (|ps|)
  (LET* (|ISTMP#1| |s| |a|)
    (DECLARE (SPECIAL |$ttok| |$stok|))
    (COND
     ((AND (EQ (|tokenClass| |$stok|) 'ID) (EQ |$ttok| '|char|))
      (SETQ |a| (|bpState|))
      (COND
       ((|bpApplication| |ps|) (SETQ |s| (|bpPop1|))
        (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| |a|) NIL)))
       (T NIL)))
     (T NIL))))

(DEFUN |bpExportItemTail| (|ps|)
  (OR
   (AND (|bpEqKey| 'BEC) (|bpRequire| |ps| #'|bpAssign|)
        (|bpPush| |ps| (|%Assignment| (|bpPop2|) (|bpPop1|))))
   (|bpSimpleDefinitionTail| |ps|)))

(DEFUN |bpExportItem| (|ps|)
  (LET* (|a|)
    (COND ((|bpEqPeek| 'STRUCTURE) (|bpStruct| |ps|))
          (T (SETQ |a| (|bpState|))
           (COND
            ((|bpName| |ps|)
             (COND
              ((|bpEqPeek| 'COLON) (|bpRestore| |a|)
               (|bpRequire| |ps| #'|bpSignature|)
               (OR (|bpExportItemTail| |ps|) T))
              (T (|bpRestore| |a|) (|bpTypeAliasDefition| |ps|))))
            (T NIL))))))

(DEFUN |bpExportItemList| (|ps|) (|bpListAndRecover| |ps| #'|bpExportItem|))

(DEFUN |bpModuleInterface| (|ps|)
  (COND
   ((|bpEqKey| 'WHERE)
    (OR (|bpPileBracketed| |ps| #'|bpExportItemList|)
        (AND (|bpExportItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1|))))
        (|bpTrap|)))
   (T (|bpPush| |ps| NIL))))

(DEFUN |bpModuleExports| (|ps|)
  (COND
   ((|bpParenthesized| |ps| #'|bpIdList|)
    (|bpPush| |ps| (|bfUntuple| (|bpPop1|))))
   (T (|bpPush| |ps| NIL))))

(DEFUN |bpModule| (|ps|)
  (COND
   ((|bpEqKey| 'MODULE) (|bpRequire| |ps| #'|bpName|) (|bpModuleExports| |ps|)
    (|bpModuleInterface| |ps|)
    (|bpPush| |ps| (|%Module| (|bpPop3|) (|bpPop2|) (|bpPop1|))))
   (T NIL)))

(DEFUN |bpImport| (|ps|)
  (LET* (|a|)
    (COND
     ((|bpEqKey| 'IMPORT)
      (COND
       ((|bpEqKey| 'NAMESPACE)
        (OR
         (AND (|bpLeftAssoc| |ps| '(DOT) #'|bpName|)
              (|bpPush| |ps| (|%Import| (|bfNamespace| (|bpPop1|)))))
         (|bpTrap|)))
       (T (SETQ |a| (|bpState|)) (|bpRequire| |ps| #'|bpName|)
        (COND
         ((|bpEqPeek| 'COLON) (|bpRestore| |a|)
          (AND (|bpRequire| |ps| #'|bpSignature|)
               (OR (|bpEqKey| 'FOR) (|bpTrap|)) (|bpRequire| |ps| #'|bpName|)
               (|bpPush| |ps| (|%ImportSignature| (|bpPop1|) (|bpPop1|)))))
         (T (|bpPush| |ps| (|%Import| (|bpPop1|))))))))
     (T NIL))))

(DEFUN |bpNamespace| (|ps|)
  (AND (|bpEqKey| 'NAMESPACE) (OR (|bpName| |ps|) (|bpDot| |ps|))
       (|bpPush| |ps| (|bfNamespace| (|bpPop1|)))))

(DEFUN |bpTypeAliasDefition| (|ps|)
  (AND (OR (|bpTerm| |ps| #'|bpIdList|) (|bpTrap|)) (|bpEqKey| 'TDEF)
       (|bpLogical| |ps|) (|bpPush| |ps| (|%TypeAlias| (|bpPop2|) (|bpPop1|)))))

(DEFUN |bpSignature| (|ps|)
  (AND (|bpName| |ps|) (|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpTyping|)
       (|bpPush| |ps| (|%Signature| (|bpPop2|) (|bpPop1|)))))

(DEFUN |bpSimpleMapping| (|ps|)
  (COND
   ((|bpApplication| |ps|)
    (AND (|bpEqKey| 'ARROW) (|bpRequire| |ps| #'|bpApplication|)
         (|bpPush| |ps| (|%Mapping| (|bpPop1|) (LIST (|bpPop1|)))))
    T)
   (T NIL)))

(DEFUN |bpArgtypeList| (|ps|) (|bpTuple| |ps| #'|bpSimpleMapping|))

(DEFUN |bpMapping| (|ps|)
  (AND (|bpParenthesized| |ps| #'|bpArgtypeList|) (|bpEqKey| 'ARROW)
       (|bpApplication| |ps|)
       (|bpPush| |ps| (|%Mapping| (|bpPop1|) (|bfUntuple| (|bpPop1|))))))

(DEFUN |bpCancel| ()
  (LET* (|a|)
    (PROGN
     (SETQ |a| (|bpState|))
     (COND
      ((|bpEqKeyNextTok| 'SETTAB)
       (COND
        ((|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 (|mk%Token| 'KEY 'SETTAB (|tokenPosition| |$stok|))
               (|bpAddTokens| (- |n| 1))))
        (T
         (CONS (|mk%Token| 'KEY 'BACKTAB (|tokenPosition| |$stok|))
               (|bpAddTokens| (+ |n| 1))))))

(DEFUN |bpExceptions| ()
  (OR (|bpEqPeek| 'DOT) (|bpEqPeek| 'QUOTE) (|bpEqPeek| 'OPAREN)
      (|bpEqPeek| 'CPAREN) (|bpEqPeek| 'SETTAB) (|bpEqPeek| 'BACKTAB)
      (|bpEqPeek| 'BACKSET)))

(DEFUN |bpSexpKey| (|ps|)
  (LET* (|a|)
    (DECLARE (SPECIAL |$ttok| |$stok|))
    (COND
     ((AND (EQ (|tokenClass| |$stok|) 'KEY) (NOT (|bpExceptions|)))
      (SETQ |a| (GET |$ttok| 'SHOEINF))
      (COND ((NULL |a|) (AND (|bpPush| |ps| (|keywordId| |$ttok|)) (|bpNext|)))
            (T (AND (|bpPush| |ps| |a|) (|bpNext|)))))
     (T NIL))))

(DEFUN |bpAnyId| (|ps|)
  (DECLARE (SPECIAL |$ttok| |$stok|))
  (OR
   (AND (|bpEqKey| 'MINUS) (OR (EQ (|tokenClass| |$stok|) 'INTEGER) (|bpTrap|))
        (|bpPush| |ps| (- |$ttok|)) (|bpNext|))
   (|bpSexpKey| |ps|)
   (AND (|symbolMember?| (|tokenClass| |$stok|) '(ID INTEGER STRING FLOAT))
        (|bpPush| |ps| |$ttok|) (|bpNext|))))

(DEFUN |bpSexp| (|ps|)
  (OR (|bpAnyId| |ps|)
      (AND (|bpEqKey| 'QUOTE) (|bpRequire| |ps| #'|bpSexp|)
           (|bpPush| |ps| (|bfSymbol| (|bpPop1|))))
      (|bpIndentParenthesized| |ps| #'|bpSexp1|)))

(DEFUN |bpSexp1| (|ps|)
  (OR
   (AND (|bpFirstTok|) (|bpSexp| |ps|)
        (OR
         (AND (|bpEqKey| 'DOT) (|bpSexp| |ps|)
              (|bpPush| |ps| (CONS (|bpPop2|) (|bpPop1|))))
         (AND (|bpSexp1| |ps|) (|bpPush| |ps| (CONS (|bpPop2|) (|bpPop1|))))))
   (|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|) (|bpPop1|)))))

(DEFUN |bpPrimary| (|ps|)
  (AND (|bpFirstTok|) (OR (|bpPrimary1| |ps|) (|bpPrefixOperator| |ps|))))

(DEFUN |bpDot| (|ps|) (AND (|bpEqKey| 'DOT) (|bpPush| |ps| (|bfDot|))))

(DEFUN |bpPrefixOperator| (|ps|)
  (DECLARE (SPECIAL |$ttok| |$stok|))
  (AND (EQ (|tokenClass| |$stok|) 'KEY) (GET |$ttok| 'SHOEPRE)
       (|bpPushId| |ps|) (|bpNext|)))

(DEFUN |bpInfixOperator| (|ps|)
  (DECLARE (SPECIAL |$ttok| |$stok|))
  (AND (EQ (|tokenClass| |$stok|) 'KEY) (GET |$ttok| 'SHOEINF)
       (|bpPushId| |ps|) (|bpNext|)))

(DEFUN |bpSelector| (|ps|)
  (AND (|bpEqKey| 'DOT)
       (OR
        (AND (|bpPrimary| |ps|)
             (|bpPush| |ps| (|bfElt| (|bpPop2|) (|bpPop1|))))
        (|bpPush| |ps| (|bfSuffixDot| (|bpPop1|))))))

(DEFUN |bpApplication| (|ps|)
  (OR
   (AND (|bpPrimary| |ps|) (|bpAnyNo| |ps| #'|bpSelector|)
        (OR
         (AND (|bpApplication| |ps|)
              (|bpPush| |ps| (|bfApplication| (|bpPop2|) (|bpPop1|))))
         T))
   (|bpNamespace| |ps|)))

(DEFUN |bpTyping| (|ps|)
  (COND
   ((|bpEqKey| 'FORALL) (|bpRequire| |ps| #'|bpVariable|)
    (OR (AND (|bpDot| |ps|) (|bpPop1|)) (|bpTrap|))
    (|bpRequire| |ps| #'|bpTyping|)
    (|bpPush| |ps| (|%Forall| (|bpPop2|) (|bpPop1|))))
   (T (OR (|bpMapping| |ps|) (|bpSimpleMapping| |ps|)))))

(DEFUN |bpTyped| (|ps|)
  (AND (|bpApplication| |ps|)
       (COND
        ((|bpEqKey| 'COLON)
         (AND (|bpRequire| |ps| #'|bpTyping|)
              (|bpPush| |ps| (|bfTagged| (|bpPop2|) (|bpPop1|)))))
        ((|bpEqKey| 'AT)
         (AND (|bpRequire| |ps| #'|bpTyping|)
              (|bpPush| |ps| (|bfRestrict| (|bpPop2|) (|bpPop1|)))))
        (T T))))

(DEFUN |bpExpt| (|ps|) (|bpRightAssoc| |ps| '(POWER) #'|bpTyped|))

(DEFUN |bpInfKey| (|ps| |s|)
  (DECLARE (SPECIAL |$ttok| |$stok|))
  (AND (EQ (|tokenClass| |$stok|) 'KEY) (|symbolMember?| |$ttok| |s|)
       (|bpPushId| |ps|) (|bpNext|)))

(DEFUN |bpInfGeneric| (|ps| |s|)
  (AND (|bpInfKey| |ps| |s|) (OR (|bpEqKey| 'BACKSET) T)))

(DEFUN |bpRightAssoc| (|ps| |o| |p|)
  (LET* (|a|)
    (PROGN
     (SETQ |a| (|bpState|))
     (COND
      ((APPLY |p| |ps| NIL)
       (LOOP
        (COND
         ((NOT
           (AND (|bpInfGeneric| |ps| |o|)
                (OR (|bpRightAssoc| |ps| |o| |p|) (|bpTrap|))))
          (RETURN NIL))
         (T
          (|bpPush| |ps|
                    (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))))
       T)
      (T (|bpRestore| |a|) NIL)))))

(DEFUN |bpLeftAssoc| (|ps| |operations| |parser|)
  (COND
   ((APPLY |parser| |ps| NIL)
    (LOOP
     (COND
      ((NOT
        (AND (|bpInfGeneric| |ps| |operations|) (|bpRequire| |ps| |parser|)))
       (RETURN NIL))
      (T
       (|bpPush| |ps| (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))))
    T)
   (T NIL)))

(DEFUN |bpString| (|ps|)
  (DECLARE (SPECIAL |$ttok| |$stok|))
  (AND (EQ (|tokenClass| |$stok|) 'STRING)
       (|bpPush| |ps| (|quote| (INTERN |$ttok|))) (|bpNext|)))

(DEFUN |bpFunction| (|ps|)
  (AND (|bpEqKey| 'FUNCTION) (|bpRequire| |ps| #'|bpPrimary1|)
       (|bpPush| |ps| (|bfFunction| (|bpPop1|)))))

(DEFUN |bpThetaName| (|ps|)
  (DECLARE (SPECIAL |$ttok| |$stok|))
  (COND
   ((AND (EQ (|tokenClass| |$stok|) 'ID) (GET |$ttok| 'SHOETHETA))
    (|bpPushId| |ps|) (|bpNext|))
   (T NIL)))

(DEFUN |bpReduceOperator| (|ps|)
  (OR (|bpInfixOperator| |ps|) (|bpString| |ps|) (|bpThetaName| |ps|)))

(DEFUN |bpReduce| (|ps|)
  (LET* (|a|)
    (PROGN
     (SETQ |a| (|bpState|))
     (COND
      ((AND (|bpReduceOperator| |ps|) (|bpEqKey| 'SLASH))
       (COND
        ((|bpEqPeek| 'OBRACK)
         (AND (|bpRequire| |ps| #'|bpDConstruct|)
              (|bpPush| |ps| (|bfReduceCollect| (|bpPop2|) (|bpPop1|)))))
        (T
         (AND (|bpRequire| |ps| #'|bpApplication|)
              (|bpPush| |ps| (|bfReduce| (|bpPop2|) (|bpPop1|)))))))
      (T (|bpRestore| |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|) (|bpPop1|))))
   (|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| (|bpPop2|) (|bpPop2|) (|bpPop1|))))
        ((AND (|bpEqKey| 'HAS) (|bpRequire| |ps| #'|bpApplication|))
         (|bpPush| |ps| (|bfHas| (|bpPop2|) (|bpPop1|))))
        (T T))))

(DEFUN |bpBracketConstruct| (|ps| |f|)
  (AND (|bpBracket| |ps| |f|) (|bpPush| |ps| (|bfConstruct| (|bpPop1|)))))

(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|) (|bpPop2|) (|bpPop1|))))
         T))
   (|bpLeave| |ps|) (|bpThrow| |ps|)))

(DEFUN |bpAnd| (|ps|) (|bpLeftAssoc| |ps| '(AND) #'|bpCompare|))

(DEFUN |bpThrow| (|ps|)
  (COND
   ((AND (|bpEqKey| 'THROW) (|bpApplication| |ps|))
    (COND
     ((|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpApplication|)
      (|bpPush| |ps| (|%Pretend| (|bpPop2|) (|bpPop1|)))))
    (|bpPush| |ps| (|bfThrow| (|bpPop1|))))
   (T NIL)))

(DEFUN |bpTry| (|ps|)
  (LET* (|cs|)
    (COND
     ((|bpEqKey| 'TRY) (|bpAssign| |ps|) (SETQ |cs| NIL)
      (LOOP
       (COND ((NOT (|bpHandler| 'CATCH)) (RETURN NIL))
             (T (|bpCatchItem| |ps|) (SETQ |cs| (CONS (|bpPop1|) |cs|)))))
      (COND
       ((|bpHandler| 'FINALLY)
        (AND (|bpFinally| |ps|)
             (|bpPush| |ps|
                       (|bfTry| (|bpPop2|)
                                (|reverse!| (CONS (|bpPop1|) |cs|))))))
       ((NULL |cs|) (|bpTrap|))
       (T (|bpPush| |ps| (|bfTry| (|bpPop1|) (|reverse!| |cs|))))))
     (T NIL))))

(DEFUN |bpCatchItem| (|ps|)
  (AND (|bpRequire| |ps| #'|bpExceptionVariable|)
       (OR (|bpEqKey| 'EXIT) (|bpTrap|)) (|bpRequire| |ps| #'|bpAssign|)
       (|bpPush| |ps| (|%Catch| (|bpPop2|) (|bpPop1|)))))

(DEFUN |bpExceptionVariable| (|ps|)
  (LET* (|t|)
    (DECLARE (SPECIAL |$stok|))
    (PROGN
     (SETQ |t| |$stok|)
     (OR
      (AND (|bpEqKey| 'OPAREN) (|bpRequire| |ps| #'|bpSignature|)
           (OR (|bpEqKey| 'CPAREN) (|bpMissing| |t|)))
      (|bpTrap|)))))

(DEFUN |bpFinally| (|ps|)
  (AND (|bpRequire| |ps| #'|bpAssign|) (|bpPush| |ps| (|%Finally| (|bpPop1|)))))

(DEFUN |bpHandler| (|key|)
  (LET* (|s|)
    (PROGN
     (SETQ |s| (|bpState|))
     (COND
      ((AND (OR (|bpEqKey| 'BACKSET) (|bpEqKey| 'SEMICOLON)) (|bpEqKey| |key|))
       T)
      (T (|bpRestore| |s|) NIL)))))

(DEFUN |bpLeave| (|ps|)
  (AND (|bpEqKey| 'LEAVE) (|bpRequire| |ps| #'|bpLogical|)
       (|bpPush| |ps| (|bfLeave| (|bpPop1|)))))

(DEFUN |bpDo| (|ps|)
  (COND
   ((|bpEqKey| 'IN) (|bpRequire| |ps| #'|bpNamespace|)
    (|bpRequire| |ps| #'|bpDo|)
    (|bpPush| |ps| (|bfAtScope| (|bpPop2|) (|bpPop1|))))
   (T
    (AND (|bpEqKey| 'DO) (|bpRequire| |ps| #'|bpAssign|)
         (|bpPush| |ps| (|bfDo| (|bpPop1|)))))))

(DEFUN |bpReturn| (|ps|)
  (OR
   (AND (|bpEqKey| 'RETURN) (|bpRequire| |ps| #'|bpAssign|)
        (|bpPush| |ps| (|bfReturnNoName| (|bpPop1|))))
   (|bpLeave| |ps|) (|bpThrow| |ps|) (|bpAnd| |ps|) (|bpDo| |ps|)))

(DEFUN |bpLogical| (|ps|) (|bpLeftAssoc| |ps| '(OR) #'|bpReturn|))

(DEFUN |bpExpression| (|ps|)
  (OR
   (AND (|bpEqKey| 'COLON)
        (OR
         (AND (|bpLogical| |ps|)
              (|bpPush| |ps| (|bfApplication| 'COLON (|bpPop1|))))
         (|bpTrap|)))
   (|bpLogical| |ps|)))

(DEFUN |bpStatement| (|ps|)
  (OR (|bpConditional| |ps| #'|bpWhere|) (|bpLoop| |ps|) (|bpExpression| |ps|)
      (|bpTry| |ps|)))

(DEFUN |bpLoop| (|ps|)
  (OR
   (AND (|bpIterators| |ps|) (|bpCompMissing| 'REPEAT)
        (|bpRequire| |ps| #'|bpWhere|)
        (|bpPush| |ps| (|bfLp| (|bpPop2|) (|bpPop1|))))
   (AND (|bpEqKey| 'REPEAT) (|bpRequire| |ps| #'|bpLogical|)
        (|bpPush| |ps| (|bfLoop1| (|bpPop1|))))))

(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| 'FOR) (|bpRequire| |ps| #'|bpFormal|) (|bpCompMissing| 'IN)
       (OR
        (AND (|bpRequire| |ps| #'|bpSeg|) (|bpEqKey| 'BY)
             (|bpRequire| |ps| #'|bpArith|)
             (|bpPush| |ps| (|bfForInBy| (|bpPop3|) (|bpPop2|) (|bpPop1|))))
        (|bpPush| |ps| (|bfForin| (|bpPop2|) (|bpPop1|))))))

(DEFUN |bpSeg| (|ps|)
  (AND (|bpArith| |ps|)
       (OR
        (AND (|bpEqKey| 'SEG)
             (OR
              (AND (|bpArith| |ps|)
                   (|bpPush| |ps| (|bfSegment2| (|bpPop2|) (|bpPop1|))))
              (|bpPush| |ps| (|bfSegment1| (|bpPop1|)))))
        T)))

(DEFUN |bpIterator| (|ps|)
  (OR (|bpForIn| |ps|) (|bpSuchThat| |ps|) (|bpWhile| |ps|) (|bpUntil| |ps|)))

(DEFUN |bpIteratorList| (|ps|)
  (AND (|bpOneOrMore| |ps| #'|bpIterator|)
       (|bpPush| |ps| (|bfIterators| (|bpPop1|)))))

(DEFUN |bpCrossBackSet| (|ps|)
  (AND (|bpEqKey| 'CROSS) (OR (|bpEqKey| 'BACKSET) T)))

(DEFUN |bpIterators| (|ps|)
  (|bpListofFun| |ps| #'|bpIteratorList| #'|bpCrossBackSet| #'|bfCross|))

(DEFUN |bpAssign| (|ps|)
  (LET* (|a|)
    (PROGN
     (SETQ |a| (|bpState|))
     (COND
      ((|bpStatement| |ps|)
       (COND
        ((|bpEqPeek| 'BEC) (|bpRestore| |a|)
         (|bpRequire| |ps| #'|bpAssignment|))
        ((|bpEqPeek| 'GIVES) (|bpRestore| |a|) (|bpRequire| |ps| #'|bpLambda|))
        ((|bpEqPeek| 'LARROW) (|bpRestore| |a|)
         (|bpRequire| |ps| #'|bpKeyArg|))
        (T T)))
      (T (|bpRestore| |a|) NIL)))))

(DEFUN |bpAssignment| (|ps|)
  (AND (|bpAssignVariable| |ps|) (|bpEqKey| 'BEC)
       (|bpRequire| |ps| #'|bpAssign|)
       (|bpPush| |ps| (|bfAssign| (|bpPop2|) (|bpPop1|)))))

(DEFUN |bpLambda| (|ps|)
  (AND (|bpVariable| |ps|) (|bpEqKey| 'GIVES) (|bpRequire| |ps| #'|bpAssign|)
       (|bpPush| |ps| (|bfLambda| (|bpPop2|) (|bpPop1|)))))

(DEFUN |bpKeyArg| (|ps|)
  (AND (|bpName| |ps|) (|bpEqKey| 'LARROW) (|bpLogical| |ps|)
       (|bpPush| |ps| (|bfKeyArg| (|bpPop2|) (|bpPop1|)))))

(DEFUN |bpExit| (|ps|)
  (AND (|bpAssign| |ps|)
       (OR
        (AND (|bpEqKey| 'EXIT) (|bpRequire| |ps| #'|bpWhere|)
             (|bpPush| |ps| (|bfExit| (|bpPop2|) (|bpPop1|))))
        T)))

(DEFUN |bpDefinition| (|ps|)
  (LET* (|a|)
    (COND
     ((|bpEqKey| 'MACRO)
      (OR
       (AND (|bpName| |ps|) (|bpStoreName|)
            (|bpCompoundDefinitionTail| |ps| #'|%Macro|))
       (|bpTrap|)))
     (T (SETQ |a| (|bpState|))
      (COND
       ((|bpExit| |ps|)
        (COND ((|bpEqPeek| 'DEF) (|bpRestore| |a|) (|bpDef| |ps|))
              ((|bpEqPeek| 'TDEF) (|bpRestore| |a|)
               (|bpTypeAliasDefition| |ps|))
              (T T)))
       (T (|bpRestore| |a|) NIL))))))

(DEFUN |bpStoreName| ()
  (DECLARE (SPECIAL |$typings| |$wheredefs| |$op| |$stack|))
  (PROGN
   (SETQ |$op| (CAR |$stack|))
   (SETQ |$wheredefs| NIL)
   (SETQ |$typings| NIL)
   T))

(DEFUN |bpDef| (|ps|)
  (OR (AND (|bpName| |ps|) (|bpStoreName|) (|bpDefTail| |ps| #'|%Definition|))
      (AND (|bpNamespace| |ps|) (|bpSimpleDefinitionTail| |ps|))))

(DEFUN |bpDDef| (|ps|) (AND (|bpName| |ps|) (|bpDefTail| |ps| #'|%Definition|)))

(DEFUN |bpSimpleDefinitionTail| (|ps|)
  (AND (|bpEqKey| 'DEF) (|bpRequire| |ps| #'|bpWhere|)
       (|bpPush| |ps| (|%ConstantDefinition| (|bpPop2|) (|bpPop1|)))))

(DEFUN |bpCompoundDefinitionTail| (|ps| |f|)
  (AND (|bpVariable| |ps|) (|bpEqKey| 'DEF) (|bpRequire| |ps| #'|bpWhere|)
       (|bpPush| |ps| (APPLY |f| (LIST (|bpPop3|) (|bpPop2|) (|bpPop1|))))))

(DEFUN |bpDefTail| (|ps| |f|)
  (OR (|bpSimpleDefinitionTail| |ps|) (|bpCompoundDefinitionTail| |ps| |f|)))

(DEFUN |bpWhere| (|ps|)
  (AND (|bpDefinition| |ps|)
       (OR
        (AND (|bpEqKey| 'WHERE) (|bpRequire| |ps| #'|bpDefinitionItem|)
             (|bpPush| |ps| (|bfWhere| (|bpPop1|) (|bpPop1|))))
        T)))

(DEFUN |bpDefinitionItem| (|ps|)
  (LET* (|a|)
    (PROGN
     (SETQ |a| (|bpState|))
     (COND ((|bpDDef| |ps|) T)
           (T (|bpRestore| |a|)
            (COND ((|bpBDefinitionPileItems| |ps|) T)
                  (T (|bpRestore| |a|)
                   (COND ((|bpPDefinitionItems| |ps|) T)
                         (T (|bpRestore| |a|) (|bpWhere| |ps|))))))))))

(DEFUN |bpDefinitionPileItems| (|ps|)
  (AND (|bpListAndRecover| |ps| #'|bpDefinitionItem|)
       (|bpPush| |ps| (|%Pile| (|bpPop1|)))))

(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| 'COMMA) (OR (|bpEqKey| 'BACKSET) T)))

(DEFUN |bpSemiColon| (|ps|) (|bpSemiListing| |ps| #'|bpComma| #'|bfSequence|))

(DEFUN |bpSemiListing| (|ps| |p| |f|)
  (|bpListofFun| |ps| |p| #'|bpSemiBackSet| |f|))

(DEFUN |bpSemiBackSet| (|ps|)
  (AND (|bpEqKey| 'SEMICOLON) (OR (|bpEqKey| 'BACKSET) T)))

(DEFUN |bpPDefinition| (|ps|) (|bpIndentParenthesized| |ps| #'|bpSemiColon|))

(DEFUN |bpPileItems| (|ps|)
  (AND (|bpListAndRecover| |ps| #'|bpSemiColon|)
       (|bpPush| |ps| (|bfSequence| (|bpPop1|)))))

(DEFUN |bpBPileDefinition| (|ps|) (|bpPileBracketed| |ps| #'|bpPileItems|))

(DEFUN |bpIteratorTail| (|ps|)
  (AND (OR (|bpEqKey| 'REPEAT) T) (|bpIterators| |ps|)))

(DEFUN |bpConstruct| (|ps|) (|bpBracket| |ps| #'|bpConstruction|))

(DEFUN |bpConstruction| (|ps|)
  (AND (|bpComma| |ps|)
       (OR
        (AND (|bpIteratorTail| |ps|)
             (|bpPush| |ps| (|bfCollect| (|bpPop2|) (|bpPop1|))))
        (|bpPush| |ps| (|bfTupleConstruct| (|bpPop1|))))))

(DEFUN |bpDConstruct| (|ps|) (|bpBracket| |ps| #'|bpDConstruction|))

(DEFUN |bpDConstruction| (|ps|)
  (AND (|bpComma| |ps|)
       (OR
        (AND (|bpIteratorTail| |ps|)
             (|bpPush| |ps| (|bfDCollect| (|bpPop2|) (|bpPop1|))))
        (|bpPush| |ps| (|bfDTuple| (|bpPop1|))))))

(DEFUN |bpPattern| (|ps|)
  (OR (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpChar| |ps|)
      (|bpName| |ps|) (|bpConstTok| |ps|)))

(DEFUN |bpEqual| (|ps|)
  (AND (|bpEqKey| 'SHOEEQ)
       (OR (|bpApplication| |ps|) (|bpConstTok| |ps|) (|bpTrap|))
       (|bpPush| |ps| (|bfEqual| (|bpPop1|)))))

(DEFUN |bpRegularPatternItem| (|ps|)
  (OR (|bpEqual| |ps|) (|bpConstTok| |ps|) (|bpDot| |ps|)
      (AND (|bpName| |ps|)
           (OR
            (AND (|bpEqKey| 'BEC) (|bpRequire| |ps| #'|bpPattern|)
                 (|bpPush| |ps| (|bfAssign| (|bpPop2|) (|bpPop1|))))
            T))
      (|bpBracketConstruct| |ps| #'|bpPatternL|)))

(DEFUN |bpRegularPatternItemL| (|ps|)
  (AND (|bpRegularPatternItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1|)))))

(DEFUN |bpRegularList| (|ps|)
  (|bpListof| |ps| #'|bpRegularPatternItemL| 'COMMA #'|bfAppend|))

(DEFUN |bpPatternColon| (|ps|)
  (AND (|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpRegularPatternItem|)
       (|bpPush| |ps| (LIST (|bfColon| (|bpPop1|))))))

(DEFUN |bpPatternL| (|ps|)
  (AND (|bpPatternList| |ps|) (|bpPush| |ps| (|bfTuple| (|bpPop1|)))))

(DEFUN |bpPatternList| (|ps|)
  (COND
   ((|bpRegularPatternItemL| |ps|)
    (LOOP
     (COND
      ((NOT
        (AND (|bpEqKey| 'COMMA)
             (OR (|bpRegularPatternItemL| |ps|)
                 (PROGN
                  (OR
                   (AND (|bpPatternTail| |ps|)
                        (|bpPush| |ps| (|append| (|bpPop2|) (|bpPop1|))))
                   (|bpTrap|))
                  NIL))))
       (RETURN NIL))
      (T (|bpPush| |ps| (|append| (|bpPop2|) (|bpPop1|))))))
    T)
   (T (|bpPatternTail| |ps|))))

(DEFUN |bpPatternTail| (|ps|)
  (AND (|bpPatternColon| |ps|)
       (OR
        (AND (|bpEqKey| 'COMMA) (|bpRequire| |ps| #'|bpRegularList|)
             (|bpPush| |ps| (|append| (|bpPop2|) (|bpPop1|))))
        T)))

(DEFUN |bpRegularBVItemTail| (|ps|)
  (OR
   (AND (|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpApplication|)
        (|bpPush| |ps| (|bfTagged| (|bpPop2|) (|bpPop1|))))
   (AND (|bpEqKey| 'BEC) (|bpRequire| |ps| #'|bpPattern|)
        (|bpPush| |ps| (|bfAssign| (|bpPop2|) (|bpPop1|))))
   (AND (|bpEqKey| 'IS) (|bpRequire| |ps| #'|bpPattern|)
        (|bpPush| |ps| (|bfAssign| (|bpPop2|) (|bpPop1|))))
   (AND (|bpEqKey| 'DEF) (|bpRequire| |ps| #'|bpApplication|)
        (|bpPush| |ps| (|%DefaultValue| (|bpPop2|) (|bpPop1|))))))

(DEFUN |bpRegularBVItem| (|ps|)
  (OR (|bpBVString| |ps|) (|bpConstTok| |ps|)
      (AND (|bpName| |ps|) (OR (|bpRegularBVItemTail| |ps|) T))
      (|bpBracketConstruct| |ps| #'|bpPatternL|)))

(DEFUN |bpBVString| (|ps|)
  (DECLARE (SPECIAL |$ttok| |$stok|))
  (AND (EQ (|tokenClass| |$stok|) 'STRING)
       (|bpPush| |ps| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext|)))

(DEFUN |bpRegularBVItemL| (|ps|)
  (AND (|bpRegularBVItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1|)))))

(DEFUN |bpColonName| (|ps|)
  (AND (|bpEqKey| 'COLON) (OR (|bpName| |ps|) (|bpBVString| |ps|) (|bpTrap|))))

(DEFUN |bpBoundVariablelist| (|ps|)
  (COND
   ((|bpRegularBVItemL| |ps|)
    (LOOP
     (COND
      ((NOT
        (AND (|bpEqKey| 'COMMA)
             (OR (|bpRegularBVItemL| |ps|)
                 (PROGN
                  (OR
                   (AND (|bpColonName| |ps|)
                        (|bpPush| |ps|
                                  (|bfColonAppend| (|bpPop2|) (|bpPop1|))))
                   (|bpTrap|))
                  NIL))))
       (RETURN NIL))
      (T (|bpPush| |ps| (|append| (|bpPop2|) (|bpPop1|))))))
    T)
   (T
    (AND (|bpColonName| |ps|)
         (|bpPush| |ps| (|bfColonAppend| NIL (|bpPop1|)))))))

(DEFUN |bpVariable| (|ps|)
  (OR
   (AND (|bpParenthesized| |ps| #'|bpBoundVariablelist|)
        (|bpPush| |ps| (|bfTupleIf| (|bpPop1|))))
   (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpName| |ps|)
   (|bpConstTok| |ps|)))

(DEFUN |bpAssignVariable| (|ps|)
  (OR (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpAssignLHS| |ps|)))

(DEFUN |bpAssignLHS| (|ps|)
  (COND ((NOT (|bpName| |ps|)) NIL)
        ((|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpApplication|)
         (|bpPush| |ps| (|bfLocal| (|bpPop2|) (|bpPop1|))))
        (T
         (AND (|bpArgumentList| |ps|)
              (OR (|bpEqPeek| 'DOT)
                  (AND (|bpEqPeek| 'BEC)
                       (|bpPush| |ps| (|bfPlace| (|bpPop1|))))
                  (|bpTrap|)))
         (COND
          ((|bpEqKey| 'DOT)
           (AND (|bpList| |ps| #'|bpPrimary| 'DOT) (|bpChecknull| |ps|)
                (|bpPush| |ps| (|bfTuple| (CONS (|bpPop2|) (|bpPop1|))))))
          (T T)))))

(DEFUN |bpChecknull| (|ps|)
  (LET* (|a|)
    (PROGN
     (SETQ |a| (|bpPop1|))
     (COND ((NULL |a|) (|bpTrap|)) (T (|bpPush| |ps| |a|))))))

(DEFUN |bpStruct| (|ps|)
  (AND (|bpEqKey| 'STRUCTURE) (|bpRequire| |ps| #'|bpName|)
       (OR (|bpEqKey| 'DEF) (|bpTrap|))
       (OR (|bpRecord| |ps|) (|bpTypeList| |ps|))
       (|bpPush| |ps| (|%Structure| (|bpPop2|) (|bpPop1|)))))

(DEFUN |bpRecord| (|ps|)
  (LET* (|s|)
    (PROGN
     (SETQ |s| (|bpState|))
     (COND
      ((AND (|bpName| |ps|) (EQ (|bpPop1|) '|Record|))
       (AND (OR (|bpParenthesized| |ps| #'|bpFieldList|) (|bpTrap|))
            (|bpGlobalAccessors| |ps|)
            (|bpPush| |ps| (|%Record| (|bfUntuple| (|bpPop2|)) (|bpPop1|)))))
      (T (|bpRestore| |s|) NIL)))))

(DEFUN |bpFieldList| (|ps|) (|bpTuple| |ps| #'|bpSignature|))

(DEFUN |bpGlobalAccessors| (|ps|)
  (COND
   ((|bpEqKey| 'WITH)
    (OR (|bpPileBracketed| |ps| #'|bpAccessorDefinitionList|) (|bpTrap|)))
   (T (|bpPush| |ps| NIL))))

(DEFUN |bpAccessorDefinitionList| (|ps|)
  (|bpListAndRecover| |ps| #'|bpAccessorDefinition|))

(DEFUN |bpAccessorDefinition| (|ps|)
  (AND (|bpRequire| |ps| #'|bpName|) (OR (|bpEqKey| 'DEF) (|bpTrap|))
       (|bpRequire| |ps| #'|bpFieldSection|)
       (|bpPush| |ps| (|%AccessorDef| (|bpPop2|) (|bpPop1|)))))

(DEFUN |bpFieldSection| (|ps|) (|bpParenthesized| |ps| #'|bpSelectField|))

(DEFUN |bpSelectField| (|ps|) (AND (|bpEqKey| 'DOT) (|bpName| |ps|)))

(DEFUN |bpTypeList| (|ps|)
  (OR (|bpPileBracketed| |ps| #'|bpTypeItemList|)
      (AND (|bpTypeItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1|))))))

(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|) (|bpPop1|))))
         (AND (|bpName| |ps|)
              (|bpPush| |ps| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))))
   (|bpPush| |ps| (|bfNameOnly| (|bpPop1|)))))

(DEFUN |bpIdList| (|ps|) (|bpTuple| |ps| #'|bpName|))

(DEFUN |bpCase| (|ps|)
  (AND (|bpEqKey| 'CASE) (|bpRequire| |ps| #'|bpWhere|)
       (OR (|bpEqKey| 'OF) (|bpMissing| 'OF)) (|bpPiledCaseItems| |ps|)))

(DEFUN |bpPiledCaseItems| (|ps|)
  (AND (|bpPileBracketed| |ps| #'|bpCaseItemList|)
       (|bpPush| |ps| (|bfCase| (|bpPop2|) (|bpPop1|)))))

(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|))
       (OR (|bpEqKey| 'EXIT) (|bpTrap|)) (|bpRequire| |ps| #'|bpWhere|)
       (|bpPush| |ps| (|bfCaseItem| (|bpPop2|) (|bpPop1|)))))

(DEFUN |bpOutItem| (|ps|)
  (LET* (|t| |r| |ISTMP#2| |l| |ISTMP#1| |b|)
    (DECLARE (SPECIAL |$InteractiveMode|))
    (LET* ((|$op| NIL) (|$GenVarCounter| 0))
      (DECLARE (SPECIAL |$op| |$GenVarCounter|))
      (PROGN
       (|bpRequire| |ps| #'|bpComma|)
       (SETQ |b| (|bpPop1|))
       (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| |b| NIL))))
       (|bpPush| |ps| |t|)))))