* boot/Makefile.pamphlet: Remove.

	* boot/translator.boot: New.
	* boot/translator.boot: Remove.
	* boot/tokens.boot: New.
	* boot/tokens.boot.pamphlet: Remove.
	* boot/scanner.boot: New.
	* boot/scanner.boot.pamphlet: Remove.
	* boot/pile.boot: New.
	* boot/pile.boot.pamphlet: Remove.
	* boot/parser.boot: New.
	* boot/parser.boot.pamphlet: New.
	* boot/initial-env.lisp: New.
	* boot/initial-env.lisp.pamphlet: Remove.
	* boot/includer.boot: New.
	* boot/includer.boot.pamphlet: Remove.
	* boot/ast.boot: New.
	* boot/ast.boot.pamphlet: Remove.

1 files changed, 0 insertions, 2460 deletions

diff --git a/src/boot/parser.boot.pamphlet b/src/boot/parser.boot.pamphlet
deleted file mode 100644
index 2ff33d38..00000000
--- a/src/boot/parser.boot.pamphlet
+++ /dev/null
@@ -1,2460 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\usepackage{fancyvrb}
-
-\CustomVerbatimEnvironment{Grammar}{Verbatim}%
-  {frame=none,fontsize=\small,commandchars=\\\{\}}
-\newcommand{\production}[1]{{\rmfamily\itshape{#1}}}
-\newcommand{\Terminal}[1]{\ensuremath{\mathbf{#1}}}
-\newcommand{\Bar}{\ensuremath{\mid}}
-\newcommand{\Comment}[1]{-- \textrm{#1}}
-
-\title{\File{src/boot/parser.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\maketitle
-
-\begin{abstract}
-  This file defines the Boot grammar and parser.  The parser
-  is hand-written based on \emph{parser combinators} technology.
-\end{abstract}
-
-\tableofcontents
-\eject
-
-\section{Introduction}
-\label{sec:intro}
-
-This file defines the grammar, and implements the parser for the
-Boot language.  The parser is
-recursive descent and uses \emph{parser combinators} techniques.
-
-\section{The Parser}
-\label{sec:parser}
-
-
-\subsection{Names}
-\label{sec:parser:name}
-
-\begin{Grammar}
-   \production{Name:}
-       \Terminal{ID}
-       \production{Name} :: \Terminal{ID}
-\end{Grammar}
-
-<<Name>>=
--- A fully qualified name could be interpreted as a left reduction
--- of an '::' infix operator.  At the moment, we don't use
--- that general interpretation.
-
--- When this routine is called, a symbol is already pushed on the
--- stack.  When this routine finished execution, we have either
--- reduced a '::' and a name, or nothing.  In either case, a 
--- symbol is present on the stack.
-bpQualifiedName() ==
-  bpEqPeek "COLON-COLON" =>
-    bpNext()
-    EQCAR($stok, "ID") and bpPushId() and bpNext()
-      and bpPush bfColonColon(bpPop2(), bpPop1())
-  false
-
-bpName() ==
-  EQCAR( $stok,"ID") =>
-    bpPushId()
-    bpNext()
-    bpAnyNo function bpQualifiedName
-  false
-@
-
-
-\subsection{Constants}
-\label{sec:parser:constant}
-
-\begin{Grammar}
-   \production{Constant:}
-       \Terminal{INTEGER}
-      \Bar \Terminal{FLOAT}
-      \Bar \Terminal{LISP}
-      \Bar \Terminal{LISPEXPR}
-      \Bar \Terminal{LINE}
-      \Bar \Terminal{QUOTE} \production{S-Expression}
-      \Bar \Terminal{STRING}
-\end{Grammar}
-
-<<Constant>>=
-bpConstTok() ==
-     MEMQ(shoeTokType $stok, '(INTEGER FLOAT)) =>
-          bpPush $ttok
-          bpNext()
-     EQCAR($stok,"LISP")=> bpPush bfReadLisp $ttok and bpNext()
-     EQCAR($stok,"LISPEXP")=> bpPush $ttok and bpNext()
-     EQCAR($stok,"LINE")=> bpPush ["+LINE", $ttok] and bpNext()
-     bpEqPeek "QUOTE" =>
-          bpNext()
-          (bpSexp() or bpTrap()) and
-               bpPush bfSymbol bpPop1()
-     bpString()
-@
-
-\subsection{Wildchar}
-\label{sec:parser:dot}
-
-The dot character (\verb!.!) is used both as a selection operator and
-as wild character in patterns.
-\begin{Grammar}
-   \production{Dot:}
-       \Terminal{DOT}
-\end{Grammar}
-
-<<Dot>>=
-bpDot()== bpEqKey "DOT" and bpPush bfDot ()
-@
-
-
-\subsection{Prefix operators}
-\label{sec:parser:prefix-op}
-
-Boot has two prefix operators.  
-\begin{Grammar}
-   \production{PrefixOperator:} \textrm{one of}
-       ^   #
-\end{Grammar}
-
-<<PrefixOperator>>=
-bpPrefixOperator()==
-   EQCAR( $stok,"KEY") and
-     GET($ttok,"SHOEPRE") and bpPushId() and  bpNext()
-@
-
-\subsection{Infix operators}
-\label{sec:parser:infix-op}
-
-\begin{Grammar}
-   \production{InfixOperator:} \textrm{one of}
-       =   *   +   is   isnt   and   or   /   **   -   <   >   <=   >=   ^=
-\end{Grammar}
-
-<<InfixOperator>>=
-bpInfixOperator()==
-  EQCAR( $stok,"KEY") and
-    GET($ttok,"SHOEINF") and bpPushId() and  bpNext()
-@
-
-\section{License}
-
-<<license>>=
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
---
--- Redistribution and use in source and binary forms, with or without
--- modification, are permitted provided that the following conditions are
--- met:
---
---     - Redistributions of source code must retain the above copyright
---       notice, this list of conditions and the following disclaimer.
---
---     - Redistributions in binary form must reproduce the above copyright
---       notice, this list of conditions and the following disclaimer in
---       the documentation and/or other materials provided with the
---       distribution.
---
---     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
---       names of its contributors may be used to endorse or promote products
---       derived from this software without specific prior written permission.
---
--- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-@
-<<*>>=
-<<license>>
-
-module '"boot-parser"
-import '"includer"
-import '"scanner"
-import '"ast"
- 
-)package "BOOTTRAN"
- 
-
-++ true when the current function definition has its parameters 
-++ written round parenthesis.
-$sawParenthesizedHead := false
-
-++ true if the current function definition has a return statement.
-$bodyHasReturn := false
-
-
-bpFirstToken()==
-      $stok:=
-          if null $inputStream
-          then shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok)
-          else CAR $inputStream
-      $ttok:=shoeTokPart $stok
-      true
- 
-bpFirstTok()==
-      $stok:=
-          if null $inputStream
-          then shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok)
-          else CAR $inputStream
-      $ttok:=shoeTokPart $stok
-      $bpParenCount>0 and EQCAR($stok,"KEY") =>
-             EQ($ttok,"SETTAB")=>
-                $bpCount:=$bpCount+1
-                bpNext()
-             EQ($ttok,"BACKTAB")=>
-                $bpCount:=$bpCount-1
-                bpNext()
-             EQ($ttok,"BACKSET")=>
-                bpNext()
-             true
-      true
- 
-bpNext() ==
-     $inputStream := CDR($inputStream)
-     bpFirstTok()
- 
-bpNextToken() ==
-     $inputStream := CDR($inputStream)
-     bpFirstToken()
- 
-bpState()== [$inputStream,$stack,$bpParenCount,$bpCount]
---cons($inputStream,$stack)
- 
-bpRestore(x)==
-      $inputStream:=CAR x
-      bpFirstToken()
-      $stack:=CADR x
-      $bpParenCount:=CADDR x
-      $bpCount:=CADDDR x
-      true
- 
-bpPush x==$stack:=CONS(x,$stack)
- 
-bpPushId()==
-   $stack:=CONS(bfReName $ttok,$stack)
- 
-bpPop1()==
-       a:=CAR $stack
-       $stack:=CDR $stack
-       a
- 
-bpPop2()==
-       a:=CADR $stack
-       RPLACD($stack,CDDR $stack)
-       a
- 
-bpPop3()==
-       a:=CADDR $stack
-       RPLACD(CDR $stack,CDDDR $stack)
-       a
- 
-bpIndentParenthesized f==
-    $bpCount:local:=0
-    a:=$stok
-    if bpEqPeek "OPAREN"
-    then
-      $bpParenCount:=$bpParenCount+1
-      bpNext()
-      if APPLY(f,nil) and bpFirstTok() and
-              (bpEqPeek "CPAREN" or bpParenTrap(a))
-      then
-            $bpParenCount:=$bpParenCount-1
-            bpNextToken()
-            $bpCount=0 => true
-            $inputStream:=append( bpAddTokens $bpCount,$inputStream)
-            bpFirstToken()
-            $bpParenCount=0 =>
-                     bpCancel()
-                     true
-            true
-      else if bpEqPeek "CPAREN"
-           then
-              bpPush  bfTuple []
-              $bpParenCount:=$bpParenCount-1
-              bpNextToken()
-              true
-           else bpParenTrap(a)
-    else false
- 
-bpParenthesized f==
-    a:=$stok
-    if bpEqKey "OPAREN"
-    then
-      if APPLY(f,nil) and (bpEqKey "CPAREN" or bpParenTrap(a))
-      then true
-      else if bpEqKey "CPAREN"
-           then
-              bpPush  bfTuple []
-              true
-           else bpParenTrap(a)
-    else false
- 
-bpBracket f==
-    a:=$stok
-    if bpEqKey "OBRACK"
-    then
-      if APPLY(f,nil) and (bpEqKey "CBRACK" or bpBrackTrap(a))
-      then bpPush bfBracket bpPop1 ()
-      else if bpEqKey "CBRACK"
-           then bpPush  []
-           else bpBrackTrap(a)
-    else false
- 
-bpPileBracketed f==
-              if bpEqKey "SETTAB"
-              then if bpEqKey "BACKTAB"
-                   then true
-                   else if APPLY(f,nil) and
-                            (bpEqKey "BACKTAB" or bpPileTrap())
-                        then bpPush bfPile bpPop1()
-                        else false
-              else false
- 
-bpListof(f,str1,g)==
-    if APPLY(f,nil)
-    then
-        if bpEqKey str1 and (APPLY(f,nil) or bpTrap())
-        then
-          a:=$stack
-          $stack:=nil
-          while bpEqKey str1 and (APPLY(f,nil) or bpTrap()) repeat 0
-          $stack:=cons(NREVERSE $stack,a)
-          bpPush FUNCALL(g, [bpPop3(),bpPop2(),:bpPop1()])
-        else
-          true
-    else false
- 
- 
--- to do ,<backset>
-bpListofFun(f,h,g)==
-    if APPLY(f,nil)
-    then
-        if APPLY(h,nil) and (APPLY(f,nil) or bpTrap())
-        then
-          a:=$stack
-          $stack:=nil
-          while APPLY(h,nil) and (APPLY(f,nil) or bpTrap()) repeat 0
-          $stack:=cons(NREVERSE $stack,a)
-          bpPush FUNCALL(g, bfListOf [bpPop3(),bpPop2(),:bpPop1()])
-        else
-          true
-    else false
- 
-bpList(f,str1,g)==
-    if APPLY(f,nil)
-    then
-        if bpEqKey str1 and (APPLY(f,nil) or bpTrap())
-        then
-          a:=$stack
-          $stack:=nil
-          while bpEqKey str1 and (APPLY(f,nil) or bpTrap()) repeat 0
-          $stack:=cons(NREVERSE $stack,a)
-          bpPush FUNCALL(g,  [bpPop3(),bpPop2(),:bpPop1()])
-        else
-          bpPush FUNCALL(g, [bpPop1()])
-    else bpPush FUNCALL(g, [])
- 
-bpOneOrMore f==
-       APPLY(f,nil)=>
-         a:=$stack
-         $stack:=nil
-         while APPLY(f,nil) repeat 0
-         $stack:=cons(NREVERSE $stack,a)
-         bpPush cons(bpPop2(),bpPop1())
-       false
- 
- 
--- s must transform the head of the stack
-bpAnyNo s==
-     while APPLY(s,nil) repeat 0
-     true
- 
- 
--- AndOr(k,p,f)= k p
-bpAndOr(keyword,p,f)==
-   bpEqKey keyword and (APPLY(p,nil) or bpTrap())
-          and bpPush FUNCALL(f, bpPop1())
- 
-bpConditional f==
-  if  bpEqKey "IF" and (bpWhere() or bpTrap()) and
-                   (bpEqKey "BACKSET" or true)
-  then
-           if bpEqKey "SETTAB"
-           then if bpEqKey "THEN"
-                then  (APPLY(f,nil) or bpTrap()) and bpElse(f) and bpEqKey "BACKTAB"
-                else  bpMissing "THEN"
-           else if bpEqKey "THEN"
-                then (APPLY(f,nil) or bpTrap()) and bpElse(f)
-                else bpMissing "then"
-  else false
- 
-bpElse(f)==
-           a:=bpState()
-           if bpBacksetElse()
-           then  (APPLY(f,nil) or bpTrap()) and
-                 bpPush bfIf(bpPop3(),bpPop2(),bpPop1())
-           else
-              bpRestore a
-              bpPush bfIfThenOnly(bpPop2(),bpPop1())
- 
-bpBacksetElse()==
-    if bpEqKey "BACKSET"
-    then bpEqKey "ELSE"
-    else bpEqKey "ELSE"
- 
-bpEqPeek s ==  EQCAR($stok,"KEY") and EQ(s,$ttok)
- 
-bpEqKey s ==   EQCAR($stok,"KEY") and EQ(s,$ttok) and bpNext()
-bpEqKeyNextTok s ==   EQCAR($stok,"KEY") and EQ(s,$ttok) and
-                  bpNextToken()
- 
-bpPileTrap()   == bpMissing  "BACKTAB"
-bpBrackTrap(x) == bpMissingMate("]",x)
-bpParenTrap(x) == bpMissingMate(")",x)
- 
-bpMissingMate(close,open)==
-   bpSpecificErrorAtToken(open, '"possibly missing mate")
-   bpMissing close
- 
-bpMissing s==
-   bpSpecificErrorHere(CONCAT(PNAME s,'" possibly missing"))
-   THROW("TRAPPOINT","TRAPPED")
- 
-bpCompMissing s == bpEqKey s or bpMissing s
- 
-bpTrap()==
-   bpGeneralErrorHere()
-   THROW("TRAPPOINT","TRAPPED")
- 
-bpRecoverTrap()==
-  bpFirstToken()
-  pos1 := shoeTokPosn $stok
-  bpMoveTo 0
-  pos2 := shoeTokPosn $stok
-  bpIgnoredFromTo(pos1, pos2)
-  bpPush  [['"pile syntax error"]]
- 
-bpListAndRecover(f)==
-   a:=$stack
-   b:=nil
-   $stack:=nil
-   done:=false
-   c:=$inputStream
-   while not done repeat
---   $trapped:local:=false
-     found:=CATCH("TRAPPOINT",APPLY(f,nil))
-     if found="TRAPPED"
-     then
-        $inputStream:=c
-        bpRecoverTrap()
-     else if not found
-          then
-            $inputStream:=c
-            bpGeneralErrorHere()
-            bpRecoverTrap()
-     if bpEqKey "BACKSET"
-     then
-        c:=$inputStream
-     else if bpEqPeek "BACKTAB"  or null $inputStream
-          then
-             done:=true
-          else
-            $inputStream:=c
-            bpGeneralErrorHere()
-            bpRecoverTrap()
-            if bpEqPeek "BACKTAB"  or null $inputStream
-            then done:=true
-            else
-                bpNext()
-                c:=$inputStream
-     b:=cons(bpPop1(),b)
-   $stack:=a
-   bpPush NREVERSE b
- 
-bpMoveTo n==
-     null $inputStream  => true
-     bpEqPeek "BACKTAB" =>
-                n=0  => true
-                bpNextToken()
-                $bpCount:=$bpCount-1
-                bpMoveTo(n-1)
-     bpEqPeek "BACKSET" =>
-                n=0  => true
-                bpNextToken()
-                bpMoveTo n
-     bpEqPeek "SETTAB"  =>
-                bpNextToken()
-                bpMoveTo(n+1)
-     bpEqPeek "OPAREN"  =>
-                bpNextToken()
-                $bpParenCount:=$bpParenCount+1
-                bpMoveTo n
-     bpEqPeek "CPAREN"  =>
-                bpNextToken()
-                $bpParenCount:=$bpParenCount-1
-                bpMoveTo n
-     bpNextToken()
-     bpMoveTo n
- 
-<<Name>>
-
-<<Constant>>
-
-++ Parse a module definitoin
-++   Module:
-++     MODULE QUOTE String
-bpModule() ==
-  bpEqKey "MODULE" =>
-    -- we really want to check that the next token is indeed
-    -- a string.  For the moment, we delay the type checking
-    -- to the Lisp compiler/interpreter.  That is likely to 
-    -- cause cryptic diagnostics.  To be fixed.
-    bpConstTok() and bpPush Module bpPop1()
-  false
-
-++ Parse a module import, or a import declaration for a foreign entity.
-++ Import:
-++    IMPORT Name for Signature
-++    IMPORT QUOTE String
-bpImport() ==
-  bpEqKey "IMPORT" =>
-    (bpName() and (bpEqKey "FOR" or bpTrap()) and bpSignature()
-       and bpPush ImportSignature(bpPop2(), bpPop1()))
-         or 
-	  -- we really want to check that the next token is indeed
-	  -- a string.  For the moment, we delay the type checking
-	  -- to the Lisp compiler/interpreter.  That is likely to 
-	  -- cause cryptic diagnostics.  To be fixed.
-	   (bpConstTok() and bpPush Import bpPop1())
-  false
-
--- Parse a type alias defnition:
---    type-alias-definition: 
---          identifier <=> logical-expression
-bpTypeAliasDefition() ==
-  (bpName() or bpTrap()) and 
-    bpEqKey "TDEF" and bpLogical() and
-      bpPush TypeAlias(bpPop2(), nil, bpPop1())
-
-++ Parse a signature declaration
-++  Signature:
-++    Name COLON Mapping
-bpSignature() ==
-  bpName() and bpEqKey "COLON" and bpMapping()
-    and bpPush Signature(bpPop2(), bpPop1())
-
-++ Parse a mapping expression
-++   Mapping:
-++      (Name | IdList) -> Name
-bpMapping() ==
-  (bpName() or bpIdList()) and bpEqKey "ARROW" and bpName()
-    and bpPush Mapping(bpPop1(), bpPop1())
-
-bpCancel()==
-    a:=bpState()
-    if bpEqKeyNextTok  "SETTAB"
-    then if bpCancel()
-         then  if bpEqKeyNextTok  "BACKTAB"
-               then true
-               else
-                   bpRestore a
-                   false
-         else
-           if bpEqKeyNextTok "BACKTAB"
-           then true
-           else
-              bpRestore a
-              false
-    else false
-bpAddTokens n==
-         n=0 => nil
-         n>0=> cons(shoeTokConstruct("KEY","SETTAB",shoeTokPosn $stok),bpAddTokens(n-1))
-         cons(shoeTokConstruct("KEY","BACKTAB",shoeTokPosn $stok),bpAddTokens(n+1))
- 
-bpExceptions()==
-     bpEqPeek "DOT" or bpEqPeek "QUOTE" or
-          bpEqPeek "OPAREN" or bpEqPeek "CPAREN" or
-             bpEqPeek "SETTAB" or bpEqPeek "BACKTAB"
-                or bpEqPeek "BACKSET"
- 
- 
-bpSexpKey()==
-      EQCAR( $stok,"KEY") and not bpExceptions()=>
-               a:=GET($ttok,"SHOEINF")
-               null a=>  bpPush $ttok and bpNext()
-               bpPush a and bpNext()
-      false
- 
-bpAnyId()==
-  bpEqKey "MINUS"  and (EQCAR($stok,"INTEGER") or bpTrap()) and
-          bpPush MINUS $ttok and bpNext() or
-             bpSexpKey() or
-                   MEMQ(shoeTokType $stok, '(ID INTEGER STRING FLOAT))
-                      and  bpPush $ttok and  bpNext()
- 
-bpSexp()==
-    bpAnyId() or
-        bpEqKey "QUOTE"  and  (bpSexp() or bpTrap())
-           and bpPush bfSymbol bpPop1() or
-               bpIndentParenthesized function bpSexp1
- 
-bpSexp1()== bpFirstTok() and
-    bpSexp() and
-     (bpEqKey "DOT" and bpSexp() and bpPush CONS (bpPop2(),bpPop1())or
-           bpSexp1() and bpPush CONS (bpPop2(),bpPop1())) or
-               bpPush nil
- 
-bpPrimary1() ==
-   bpName() or
-     bpDot() or
-      bpConstTok() or
-       bpConstruct() or
-        bpCase() or
-         bpStruct() or
-          bpPDefinition() or
-           bpBPileDefinition()
- 
-bpPrimary()==  bpFirstTok() and (bpPrimary1() or bpPrefixOperator())
- 
-<<Dot>>
- 
-<<PrefixOperator>>
- 
-<<InfixOperator>>
- 
-bpSelector()==
-            bpEqKey "DOT" and (bpPrimary()
-               and bpPush(bfElt(bpPop2(),bpPop1()))
-                  or bpPush bfSuffixDot bpPop1() )
- 
-bpOperator()==   bpPrimary() and bpAnyNo function bpSelector
- 
-bpApplication()==
-   bpPrimary() and bpAnyNo function bpSelector and
-      (bpApplication() and
-            bpPush(bfApplication(bpPop2(),bpPop1())) or true)
- 
-bpTagged()==
-      bpApplication() and
-         (bpEqKey "COLON" and (bpApplication() or bpTrap()) and
-           bpPush bfTagged(bpPop2(),bpPop1()) or true)
- 
-bpExpt()== bpRightAssoc('(POWER),function bpTagged)
- 
-bpInfKey s==
- EQCAR( $stok,"KEY") and
-   MEMBER($ttok,s) and bpPushId() and bpNext()
- 
-bpInfGeneric s== bpInfKey s and  (bpEqKey "BACKSET" or true)
- 
-bpRightAssoc(o,p)==
-    a:=bpState()
-    if APPLY(p,nil)
-    then
-       while  bpInfGeneric o and (bpRightAssoc(o,p) or bpTrap()) repeat
-             bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
-       true
-    else
-       bpRestore a
-       false
- 
-bpLeftAssoc(operations,parser)==
-    if APPLY(parser,nil)
-    then
-       while bpInfGeneric(operations) and
-         (APPLY(parser,nil) or bpTrap())
-           repeat
-             bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
-       true
-    else false
- 
-bpString()==
-     EQ(shoeTokType $stok,"STRING") and
-         bpPush(["QUOTE",INTERN $ttok]) and bpNext()
- 
-bpThetaName() ==
-        if EQCAR( $stok,"ID") and GET($ttok,"SHOETHETA")
-        then
-           bpPushId()
-           bpNext()
-        else false
- 
-bpReduceOperator()==
-         bpInfixOperator() or bpString()
-                or bpThetaName()
- 
-bpReduce()==
-     a:=bpState()
-     if bpReduceOperator() and bpEqKey "SLASH"
-     then
-        bpEqPeek "OBRACK" => (bpDConstruct() or bpTrap()) and
-                     bpPush bfReduceCollect(bpPop2(),bpPop1())
-        (bpApplication() or bpTrap()) and
-                bpPush bfReduce(bpPop2(),bpPop1())
-     else
-        bpRestore a
-        false
- 
-bpTimes()==
-    bpReduce() or bpLeftAssoc('(TIMES  SLASH),function bpExpt)
- 
-bpMinus()==
-   bpInfGeneric '(MINUS) and (bpTimes() or bpTrap())
-        and bpPush(bfApplication(bpPop2(),bpPop1()))
-          or bpTimes()
- 
-bpArith()==bpLeftAssoc('(PLUS MINUS),function bpMinus)
- 
-bpIs()==
-     bpArith() and (bpInfKey '(IS ISNT) and (bpPattern() or bpTrap())
-        and bpPush bfISApplication(bpPop2(),bpPop2(),bpPop1())
-           or true)
- 
-bpBracketConstruct(f)==
-        bpBracket f and bpPush bfConstruct bpPop1 ()
- 
-bpCompare()==
-     bpIs() and (bpInfKey  '(SHOEEQ SHOENE LT LE GT GE IN)
-        and (bpIs() or bpTrap())
-           and bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
-               or true)
- 
-bpAnd()== bpLeftAssoc('(AND),function bpCompare)
- 
-
-++ Note the fact that a return statement is used in the body
-++ of current function definition.
-bpNoteReturnStmt() ==
-  $bodyHasReturn := true
-  true
-
-bpReturn()==
-         (bpEqKey "RETURN" and bpNoteReturnStmt() and
-           (bpAnd() or bpTrap()) and
-                bpPush bfReturnNoName bpPop1()) or bpAnd()
- 
- 
-bpLogical()== bpLeftAssoc('(OR),function bpReturn)
- 
-bpExpression()==
-     bpEqKey "COLON" and (bpLogical() and
-              bpPush bfApplication ("COLON",bpPop1())
-                    or bpTrap()) or bpLogical()
- 
-bpStatement()==
-  bpConditional function bpWhere or bpLoop()  or bpExpression()
- 
-bpLoop()==
-     bpIterators() and
-      (bpCompMissing "REPEAT" and
-         (bpWhere() or bpTrap()) and
-            bpPush bfLp(bpPop2(),bpPop1()))
-                or
-                  bpEqKey "REPEAT" and (bpLogical() or bpTrap()) and
-                       bpPush bfLoop1 bpPop1 ()
- 
-bpSuchThat()==bpAndOr("BAR",function bpWhere,function bfSuchthat)
- 
-bpWhile()==bpAndOr ("WHILE",function bpLogical,function bfWhile)
- 
-bpUntil()==bpAndOr ("UNTIL",function bpLogical,function bfUntil)
- 
-bpForIn()==
-  bpEqKey "FOR" and (bpVariable() or bpTrap()) and (bpCompMissing "IN")
-      and ((bpSeg()  or bpTrap()) and
-       (bpEqKey "BY" and (bpArith() or bpTrap()) and
-        bpPush bfForInBy(bpPop3(),bpPop2(),bpPop1())) or
-         bpPush bfForin(bpPop2(),bpPop1()))
- 
-bpSeg()==
-   bpArith() and
-      (bpEqKey "SEG" and
-       (bpArith() and bpPush(bfSegment2(bpPop2(),bpPop1()))
-         or bpPush(bfSegment1(bpPop1()))) or true)
- 
-bpIterator()==
-  bpForIn() or bpSuchThat() or bpWhile() or bpUntil()
- 
-bpIteratorList()==bpOneOrMore function bpIterator
-       and bpPush bfIterators bpPop1 ()
- 
-bpCrossBackSet()== bpEqKey "CROSS" and (bpEqKey "BACKSET" or true)
- 
-bpIterators()==
-         bpListofFun(function bpIteratorList,
-              function bpCrossBackSet,function bfCross)
- 
-bpAssign()==
-            a:=bpState()
-            if bpStatement()
-            then
-                 if bpEqPeek "BEC"
-                 then
-                   bpRestore a
-                   bpAssignment() or bpTrap()
-                 else true
-            else
-                 bpRestore a
-                 false
- 
-bpAssignment()==
-       bpAssignVariable() and
-         bpEqKey "BEC" and
-           (bpAssign() or bpTrap()) and
-              bpPush bfAssign (bpPop2(),bpPop1())
- 
--- should only be allowed in sequences
-bpExit()==
-     bpAssign() and (bpEqKey "EXIT" and
-         ((bpWhere() or bpTrap()) and
-            bpPush bfExit (bpPop2(),bpPop1()))
-              or true)
-
-++ returns true if the next token introduces a definition.
-bpBeginDefinition() ==
-  bpEqPeek "DEF" or 
-    $sawParenthesizedHead and bpEqPeek "COLON"
-
-bpDefinition()==
-        a:=bpState()
-        bpExit() =>
-             bpBeginDefinition() =>
-                bpRestore a
-                bpDef()
-             bpEqPeek "TDEF" =>
-                bpRestore a
-                bpTypeAliasDefition()
-             bpEqPeek "MDEF" =>
-                bpRestore a
-                bpMdef()
-             true
-        bpRestore a
-        false
- 
-bpStoreName()==
-  $op := car $stack
-  $wheredefs := nil
-  $typings := nil
-  $returnType := true		-- assume we may return anything
-  $bodyHasReturn := false
-  true
-
-bpReturnType() ==
-  -- a return type is acceptable for a function definition only
-  -- if its parameters are written in round parenthesis.  
-  -- In particular, we reject the situation `foo x:Integer == ...'
-  $sawParenthesizedHead and bpEqKey "COLON" =>
-    bpApplication() or bpTrap()
-    $returnType := bpPop1()
-    true
-  true
- 
-bpDef() ==  
-  bpName() and bpStoreName() and
-    bpDefTail() and bpPush bfCompDef bpPop1 ()
- 
-bpDDef() ==  bpName() and bpDefTail()
-
-++ Parse the remaining of a simple definition.
-bpSimpleDefinitionTail() ==
-  bpEqKey "DEF" and
-    (bpWhere() or bpTrap())
-      and bpPush ConstantDefinition(bpPop2(), bpPop1())
-
-++ Parse the remaining of a compound definition.
-bpCompoundDefinitionTail() ==
-  bpVariable()  and bpReturnType()  and
-    bpEqKey "DEF" and (bpWhere() or bpTrap())
-      and bpPush bfDefinition(bpPop3(),bpPop2(),bpPop1())
-
-
-++ Parse the remainding of a definition.  When we reach this point
-++ we know we must parse a definition and we have already parsed
-++ the name of the main operator in the definition.
-bpDefTail() ==
-  bpSimpleDefinitionTail()
-    or bpCompoundDefinitionTail()
- 
- 
-bpMDefTail()==
- --   bpEqKey "MDEF" and
- --   (bpWhere() or bpTrap())
- --     and bpPush bfMDefinition1(bpPop2(),bpPop1())
- --      or
-           (bpVariable() or bpTrap()) and
-             bpEqKey "MDEF" and (bpWhere() or bpTrap())
-                 and bpPush bfMDefinition(bpPop3(),bpPop2(),bpPop1())
- 
-bpMdef()== bpName() and bpStoreName() and bpMDefTail()
- 
-bpWhere()==
-    bpDefinition() and
-       (bpEqKey "WHERE" and (bpDefinitionItem() or bpTrap())
-           and bpPush bfWhere(bpPop1(),bpPop1()) or true)
- 
-bpDefinitionItem()==
-          a:=bpState()
-          if bpDDef()
-          then true
-          else
-             bpRestore a
-             if bpBDefinitionPileItems()
-             then true
-             else
-               bpRestore a
-               if bpPDefinitionItems()
-               then true
-               else
-                   bpRestore a
-                   bpWhere()
- 
-bpDefinitionPileItems()==
-    bpListAndRecover function bpDefinitionItem
-           and bpPush bfDefSequence bpPop1()
- 
-bpBDefinitionPileItems()== bpPileBracketed function bpDefinitionPileItems
- 
-bpSemiColonDefinition()==bpSemiListing
-    (function bpDefinitionItem,function bfDefSequence)
- 
-bpPDefinitionItems()==bpParenthesized function bpSemiColonDefinition
- 
-bpComma()== 
-  bpModule() or bpImport() or
-    bpTuple function bpWhere
- 
-bpTuple(p)==bpListofFun(p,function bpCommaBackSet,function bfTuple)
- 
-bpCommaBackSet()== bpEqKey "COMMA" and (bpEqKey "BACKSET" or true)
- 
-bpSemiColon()==bpSemiListing (function bpComma,function bfSequence)
- 
-bpSemiListing(p,f)==bpListofFun(p,function bpSemiBackSet,f)
- 
-bpSemiBackSet()== bpEqKey "SEMICOLON" and (bpEqKey "BACKSET" or true)
- 
-bpPDefinition()==  bpIndentParenthesized function bpSemiColon
- 
-bpPileItems()==
-    bpListAndRecover function bpSemiColon and bpPush bfSequence bpPop1()
- 
-bpBPileDefinition()==  bpPileBracketed function bpPileItems
- 
-bpIteratorTail()==
-     (bpEqKey "REPEAT" or true) and bpIterators()
- 
---bpExpression()==  bpLogical()
- 
-bpConstruct()==bpBracket function bpConstruction
- 
-bpConstruction()==
-     bpComma() and
-        (bpIteratorTail() and
-             bpPush bfCollect (bpPop2(),bpPop1()) or
-                bpPush bfTupleConstruct bpPop1())
- 
-bpDConstruct()==bpBracket function bpDConstruction
- 
-bpDConstruction()==
-     bpComma() and
-        (bpIteratorTail() and
-             bpPush bfDCollect (bpPop2(),bpPop1()) or
-                bpPush bfDTuple bpPop1())
- 
- 
- 
---PATTERN
- 
---bpNameOrDot() == bpName() or bpDot() or bpEqual()
- 
-bpPattern()== bpBracketConstruct function bpPatternL
-                or bpName() or bpConstTok()
- 
-bpEqual()==
-   bpEqKey "SHOEEQ" and (bpApplication() or bpConstTok() or
-                bpTrap()) and bpPush bfEqual bpPop1()
- 
-bpRegularPatternItem() ==
-   bpEqual() or
-     bpConstTok() or bpDot() or
-      bpName() and
-         ((bpEqKey "BEC" and (bpPattern() or bpTrap())
-              and bpPush bfAssign(bpPop2(),bpPop1())) or true)
-                    or bpBracketConstruct function bpPatternL
- 
-bpRegularPatternItemL()==
-      bpRegularPatternItem() and bpPush [bpPop1()]
- 
-bpRegularList()==
-       bpListof(function bpRegularPatternItemL,"COMMA",function bfAppend)
- 
-bpPatternColon()==
-     bpEqKey "COLON" and (bpRegularPatternItem() or bpTrap())
-              and bpPush [bfColon bpPop1()]
- 
- 
--- only one colon
-bpPatternL() == bpPatternList() and bpPush bfTuple bpPop1()
- 
-bpPatternList()==
-     if bpRegularPatternItemL()
-     then
-        while (bpEqKey  "COMMA" and (bpRegularPatternItemL() or
-            (bpPatternTail()
-              and bpPush append(bpPop2(),bpPop1())
-                or bpTrap();false) )) repeat
-                  bpPush append(bpPop2(),bpPop1())
-        true
-     else bpPatternTail()
- 
-bpPatternTail()==
-     bpPatternColon() and
-         (bpEqKey "COMMA" and (bpRegularList() or bpTrap())
-              and bpPush append (bpPop2(),bpPop1()) or true)
- 
--- BOUND VARIABLE
-bpRegularBVItem() ==
-  bpBVString() or
-     bpConstTok() or
-      (bpName() and
-         (bpEqKey "COLON" and (bpApplication() or bpTrap())
-            and bpPush bfTagged(bpPop2(), bpPop1()) or
-              bpEqKey "BEC" and (bpPattern() or bpTrap())
-                and bpPush bfAssign(bpPop2(),bpPop1()) or
-                  (bpEqKey "IS" and (bpPattern() or bpTrap())
-                     and bpPush bfAssign(bpPop2(),bpPop1())) or true))
-                       or bpBracketConstruct function bpPatternL
- 
-bpBVString()==
-     EQ(shoeTokType $stok,"STRING") and
-         bpPush(["BVQUOTE",INTERN $ttok]) and bpNext()
- 
-bpRegularBVItemL() ==
-      bpRegularBVItem() and bpPush [bpPop1()]
- 
-bpColonName()==
-     bpEqKey "COLON" and (bpName() or bpBVString() or bpTrap())
- 
- 
--- at most one colon at end
-bpBoundVariablelist()==
-     if bpRegularBVItemL()
-     then
-        while (bpEqKey  "COMMA" and (bpRegularBVItemL() or
-            (bpColonName()
-              and bpPush  bfColonAppend(bpPop2(),bpPop1())
-                or bpTrap();false) )) repeat
-                   bpPush append(bpPop2(),bpPop1())
-        true
-     else bpColonName() and bpPush bfColonAppend(nil,bpPop1())
- 
-
-++ Mark the start of parameter list enclosed in round parenthesis
-bpBeginParameterList() ==
-  $sawParenthesizedHead := false
-  true
-
-++ Mark the end of parameter list enclosed in round parenthesis
-bpEndParameterList() ==
-  $sawParenthesizedHead := true
-
-bpVariable()==
-  bpBeginParameterList() and
-    bpParenthesized function bpBoundVariablelist and
-       bpPush bfTupleIf bpPop1() and bpEndParameterList()
-	 or bpBracketConstruct function bpPatternL
-		or bpName() or bpConstTok()
- 
-bpAssignVariable()==
-      bpBracketConstruct function bpPatternL or bpAssignLHS()
- 
-bpAssignLHS()==
-   bpName() and (bpEqKey "COLON" and (bpApplication() or bpTrap())
-     and bpPush bfLocal(bpPop2(),bpPop1())
-        or bpEqKey "DOT" and bpList(function bpPrimary,"DOT",
-              function bfListOf)
-          and bpChecknull() and
-            bpPush bfTuple(cons(bpPop2(),bpPop1()))
-                 or true)
-bpChecknull()==
-      a:=bpPop1()
-      if null a
-      then bpTrap()
-      else bpPush a
-
-bpStruct()==
-   bpEqKey "STRUCTURE" and
-      (bpName() or bpTrap()) and
-        (bpEqKey "DEF" or bpTrap()) and
-           bpTypeList() and bpPush bfStruct(bpPop2(),bpPop1())
- 
-bpTypeList() == bpPileBracketed function bpTypeItemList
-       or bpTerm() and bpPush [bpPop1()]
- 
-bpTypeItemList() ==  bpListAndRecover function bpTerm
- 
-bpTerm() ==
-          (bpName() or bpTrap()) and
-            ((bpParenthesized function bpIdList and
-              bpPush bfNameArgs (bpPop2(),bpPop1()))
-                or bpName() and bpPush bfNameArgs(bpPop2(),bpPop1()))
-                 or bpPush(bfNameOnly bpPop1())
- 
-bpIdList()== bpTuple function bpName
- 
-bpCase()==
-      bpEqKey "CASE" and
-        (bpWhere() or bpTrap()) and
-           (bpEqKey "OF" or bpMissing "OF") and
-                 bpPiledCaseItems()
- 
-bpPiledCaseItems()==
-   bpPileBracketed function bpCaseItemList and
-       bpPush bfCase(bpPop2(),bpPop1())
-bpCaseItemList()==
-   bpListAndRecover function bpCaseItem
- 
-bpCaseItem()==
-    (bpTerm() or bpTrap()) and
-       (bpEqKey "EXIT" or bpTrap()) and
-         (bpWhere() or bpTrap()) and
-            bpPush bfCaseItem (bpPop2(),bpPop1())
-
-@
-
-
-\section{The Common Lisp translation}
-\label{sec:cl-translation}
-
-<<parser.clisp>>=
-(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-parser"))
-
-(IMPORT-MODULE "includer")
-
-(IMPORT-MODULE "scanner")
-
-(IMPORT-MODULE "ast")
-
-(IN-PACKAGE "BOOTTRAN")
-
-(DEFPARAMETER |$sawParenthesizedHead| NIL)
-
-(DEFPARAMETER |$bodyHasReturn| NIL)
-
-(DEFUN |bpFirstToken| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$ttok| |$stok| |$inputStream|))
-    (RETURN
-      (PROGN
-        (SETQ |$stok|
-              (COND
-                ((NULL |$inputStream|)
-                 (|shoeTokConstruct| 'ERROR 'NOMORE
-                     (|shoeTokPosn| |$stok|)))
-                ('T (CAR |$inputStream|))))
-        (SETQ |$ttok| (|shoeTokPart| |$stok|))
-        T))))
-
-(DEFUN |bpFirstTok| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$ttok| |$stok|
-                      |$inputStream|))
-    (RETURN
-      (PROGN
-        (SETQ |$stok|
-              (COND
-                ((NULL |$inputStream|)
-                 (|shoeTokConstruct| 'ERROR 'NOMORE
-                     (|shoeTokPosn| |$stok|)))
-                ('T (CAR |$inputStream|))))
-        (SETQ |$ttok| (|shoeTokPart| |$stok|))
-        (COND
-          ((AND (< 0 |$bpParenCount|) (EQCAR |$stok| 'KEY))
-           (COND
-             ((EQ |$ttok| 'SETTAB)
-              (PROGN (SETQ |$bpCount| (+ |$bpCount| 1)) (|bpNext|)))
-             ((EQ |$ttok| 'BACKTAB)
-              (PROGN (SETQ |$bpCount| (- |$bpCount| 1)) (|bpNext|)))
-             ((EQ |$ttok| 'BACKSET) (|bpNext|))
-             (#0='T T)))
-          (#0# T))))))
-
-(DEFUN |bpNext| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$inputStream|))
-    (RETURN
-      (PROGN
-        (SETQ |$inputStream| (CDR |$inputStream|))
-        (|bpFirstTok|)))))
-
-(DEFUN |bpNextToken| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$inputStream|))
-    (RETURN
-      (PROGN
-        (SETQ |$inputStream| (CDR |$inputStream|))
-        (|bpFirstToken|)))))
-
-(DEFUN |bpState| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack|
-                      |$inputStream|))
-    (RETURN (LIST |$inputStream| |$stack| |$bpParenCount| |$bpCount|))))
-
-(DEFUN |bpRestore| (|x|)
-  (PROG ()
-    (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack|
-                      |$inputStream|))
-    (RETURN
-      (PROGN
-        (SETQ |$inputStream| (CAR |x|))
-        (|bpFirstToken|)
-        (SETQ |$stack| (CADR |x|))
-        (SETQ |$bpParenCount| (CADDR |x|))
-        (SETQ |$bpCount| (CADDDR |x|))
-        T))))
-
-(DEFUN |bpPush| (|x|)
-  (PROG ()
-    (DECLARE (SPECIAL |$stack|))
-    (RETURN (SETQ |$stack| (CONS |x| |$stack|)))))
-
-(DEFUN |bpPushId| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$stack| |$ttok|))
-    (RETURN (SETQ |$stack| (CONS (|bfReName| |$ttok|) |$stack|)))))
-
-(DEFUN |bpPop1| ()
-  (PROG (|a|)
-    (DECLARE (SPECIAL |$stack|))
-    (RETURN
-      (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|))))
-
-(DEFUN |bpPop3| ()
-  (PROG (|a|)
-    (DECLARE (SPECIAL |$stack|))
-    (RETURN
-      (PROGN
-        (SETQ |a| (CADDR |$stack|))
-        (RPLACD (CDR |$stack|) (CDDDR |$stack|))
-        |a|))))
-
-(DEFUN |bpIndentParenthesized| (|f|)
-  (PROG (|$bpCount| |a|)
-    (DECLARE (SPECIAL |$inputStream| |$bpCount| |$bpParenCount|
-                      |$stok|))
-    (RETURN
-      (PROGN
-        (SETQ |$bpCount| 0)
-        (SETQ |a| |$stok|)
-        (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)
-                (#0='T
-                 (PROGN
-                   (SETQ |$inputStream|
-                         (APPEND (|bpAddTokens| |$bpCount|)
-                                 |$inputStream|))
-                   (|bpFirstToken|)
-                   (COND
-                     ((EQL |$bpParenCount| 0) (PROGN (|bpCancel|) T))
-                     (#0# T))))))
-             ((|bpEqPeek| 'CPAREN) (|bpPush| (|bfTuple| NIL))
-              (SETQ |$bpParenCount| (- |$bpParenCount| 1))
-              (|bpNextToken|) T)
-             (#1='T (|bpParenTrap| |a|))))
-          (#1# NIL))))))
-
-(DEFUN |bpParenthesized| (|f|)
-  (PROG (|a|)
-    (DECLARE (SPECIAL |$stok|))
-    (RETURN
-      (PROGN
-        (SETQ |a| |$stok|)
-        (COND
-          ((|bpEqKey| 'OPAREN)
-           (COND
-             ((AND (APPLY |f| NIL)
-                   (OR (|bpEqKey| 'CPAREN) (|bpParenTrap| |a|)))
-              T)
-             ((|bpEqKey| 'CPAREN) (|bpPush| (|bfTuple| NIL)) T)
-             (#0='T (|bpParenTrap| |a|))))
-          (#0# NIL))))))
-
-(DEFUN |bpBracket| (|f|)
-  (PROG (|a|)
-    (DECLARE (SPECIAL |$stok|))
-    (RETURN
-      (PROGN
-        (SETQ |a| |$stok|)
-        (COND
-          ((|bpEqKey| 'OBRACK)
-           (COND
-             ((AND (APPLY |f| NIL)
-                   (OR (|bpEqKey| 'CBRACK) (|bpBrackTrap| |a|)))
-              (|bpPush| (|bfBracket| (|bpPop1|))))
-             ((|bpEqKey| 'CBRACK) (|bpPush| NIL))
-             (#0='T (|bpBrackTrap| |a|))))
-          (#0# NIL))))))
-
-(DEFUN |bpPileBracketed| (|f|)
-  (PROG ()
-    (RETURN
-      (COND
-        ((|bpEqKey| 'SETTAB)
-         (COND
-           ((|bpEqKey| 'BACKTAB) T)
-           ((AND (APPLY |f| NIL)
-                 (OR (|bpEqKey| 'BACKTAB) (|bpPileTrap|)))
-            (|bpPush| (|bfPile| (|bpPop1|))))
-           (#0='T NIL)))
-        (#0# 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 (NREVERSE |$stack|) |a|))
-            (|bpPush|
-                (FUNCALL |g|
-                         (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
-           (#0='T T)))
-        (#0# 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 (NREVERSE |$stack|) |a|))
-            (|bpPush|
-                (FUNCALL |g|
-                         (|bfListOf|
-                             (CONS (|bpPop3|)
-                                   (CONS (|bpPop2|) (|bpPop1|)))))))
-           (#0='T T)))
-        (#0# NIL)))))
-
-(DEFUN |bpList| (|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 (NREVERSE |$stack|) |a|))
-            (|bpPush|
-                (FUNCALL |g|
-                         (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
-           (#0='T (|bpPush| (FUNCALL |g| (LIST (|bpPop1|)))))))
-        (#0# (|bpPush| (FUNCALL |g| NIL)))))))
-
-(DEFUN |bpOneOrMore| (|f|)
-  (PROG (|a|)
-    (DECLARE (SPECIAL |$stack|))
-    (RETURN
-      (COND
-        ((APPLY |f| NIL)
-         (PROGN
-           (SETQ |a| |$stack|)
-           (SETQ |$stack| NIL)
-           (LOOP (COND ((NOT (APPLY |f| NIL)) (RETURN NIL)) ('T 0)))
-           (SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
-           (|bpPush| (CONS (|bpPop2|) (|bpPop1|)))))
-        ('T NIL)))))
-
-(DEFUN |bpAnyNo| (|s|)
-  (PROG ()
-    (RETURN
-      (PROGN
-        (LOOP (COND ((NOT (APPLY |s| NIL)) (RETURN NIL)) ('T 0)))
-        T))))
-
-(DEFUN |bpAndOr| (|keyword| |p| |f|)
-  (PROG ()
-    (RETURN
-      (AND (|bpEqKey| |keyword|) (OR (APPLY |p| NIL) (|bpTrap|))
-           (|bpPush| (FUNCALL |f| (|bpPop1|)))))))
-
-(DEFUN |bpConditional| (|f|)
-  (PROG ()
-    (RETURN
-      (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)))
-              (#0='T (|bpMissing| 'THEN))))
-           ((|bpEqKey| 'THEN)
-            (AND (OR (APPLY |f| NIL) (|bpTrap|)) (|bpElse| |f|)))
-           (#0# (|bpMissing| '|then|))))
-        (#0# 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|)))))))))
-
-(DEFUN |bpBacksetElse| ()
-  (PROG ()
-    (RETURN
-      (COND
-        ((|bpEqKey| 'BACKSET) (|bpEqKey| 'ELSE))
-        ('T (|bpEqKey| 'ELSE))))))
-
-(DEFUN |bpEqPeek| (|s|)
-  (PROG ()
-    (DECLARE (SPECIAL |$ttok| |$stok|))
-    (RETURN (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|)))))
-
-(DEFUN |bpEqKey| (|s|)
-  (PROG ()
-    (DECLARE (SPECIAL |$ttok| |$stok|))
-    (RETURN (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|) (|bpNext|)))))
-
-(DEFUN |bpEqKeyNextTok| (|s|)
-  (PROG ()
-    (DECLARE (SPECIAL |$ttok| |$stok|))
-    (RETURN
-      (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|) (|bpNextToken|)))))
-
-(DEFUN |bpPileTrap| () (PROG () (RETURN (|bpMissing| 'BACKTAB))))
-
-(DEFUN |bpBrackTrap| (|x|)
-  (PROG () (RETURN (|bpMissingMate| '] |x|))))
-
-(DEFUN |bpParenTrap| (|x|)
-  (PROG () (RETURN (|bpMissingMate| '|)| |x|))))
-
-(DEFUN |bpMissingMate| (|close| |open|)
-  (PROG ()
-    (RETURN
-      (PROGN
-        (|bpSpecificErrorAtToken| |open| "possibly missing mate")
-        (|bpMissing| |close|)))))
-
-(DEFUN |bpMissing| (|s|)
-  (PROG ()
-    (RETURN
-      (PROGN
-        (|bpSpecificErrorHere|
-            (CONCAT (PNAME |s|) " possibly missing"))
-        (THROW 'TRAPPOINT 'TRAPPED)))))
-
-(DEFUN |bpCompMissing| (|s|)
-  (PROG () (RETURN (OR (|bpEqKey| |s|) (|bpMissing| |s|)))))
-
-(DEFUN |bpTrap| ()
-  (PROG ()
-    (RETURN
-      (PROGN (|bpGeneralErrorHere|) (THROW 'TRAPPOINT '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")))))))
-
-(DEFUN |bpListAndRecover| (|f|)
-  (PROG (|found| |c| |done| |b| |a|)
-    (DECLARE (SPECIAL |$inputStream| |$stack|))
-    (RETURN
-      (PROGN
-        (SETQ |a| |$stack|)
-        (SETQ |b| NIL)
-        (SETQ |$stack| NIL)
-        (SETQ |done| NIL)
-        (SETQ |c| |$inputStream|)
-        (LOOP
-          (COND
-            (|done| (RETURN NIL))
-            ('T
-             (PROGN
-               (SETQ |found| (CATCH 'TRAPPOINT (APPLY |f| NIL)))
-               (COND
-                 ((EQ |found| 'TRAPPED) (SETQ |$inputStream| |c|)
-                  (|bpRecoverTrap|))
-                 ((NULL |found|) (SETQ |$inputStream| |c|)
-                  (|bpGeneralErrorHere|) (|bpRecoverTrap|)))
-               (COND
-                 ((|bpEqKey| 'BACKSET) (SETQ |c| |$inputStream|))
-                 ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|))
-                  (SETQ |done| T))
-                 (#0='T (SETQ |$inputStream| |c|)
-                  (|bpGeneralErrorHere|) (|bpRecoverTrap|)
-                  (COND
-                    ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|))
-                     (SETQ |done| T))
-                    (#0# (|bpNext|) (SETQ |c| |$inputStream|)))))
-               (SETQ |b| (CONS (|bpPop1|) |b|))))))
-        (SETQ |$stack| |a|)
-        (|bpPush| (NREVERSE |b|))))))
-
-(DEFUN |bpMoveTo| (|n|)
-  (PROG ()
-    (DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$inputStream|))
-    (RETURN
-      (COND
-        ((NULL |$inputStream|) T)
-        ((|bpEqPeek| 'BACKTAB)
-         (COND
-           ((EQL |n| 0) T)
-           (#0='T
-            (PROGN
-              (|bpNextToken|)
-              (SETQ |$bpCount| (- |$bpCount| 1))
-              (|bpMoveTo| (- |n| 1))))))
-        ((|bpEqPeek| 'BACKSET)
-         (COND
-           ((EQL |n| 0) T)
-           (#0# (PROGN (|bpNextToken|) (|bpMoveTo| |n|)))))
-        ((|bpEqPeek| 'SETTAB)
-         (PROGN (|bpNextToken|) (|bpMoveTo| (+ |n| 1))))
-        ((|bpEqPeek| 'OPAREN)
-         (PROGN
-           (|bpNextToken|)
-           (SETQ |$bpParenCount| (+ |$bpParenCount| 1))
-           (|bpMoveTo| |n|)))
-        ((|bpEqPeek| 'CPAREN)
-         (PROGN
-           (|bpNextToken|)
-           (SETQ |$bpParenCount| (- |$bpParenCount| 1))
-           (|bpMoveTo| |n|)))
-        (#0# (PROGN (|bpNextToken|) (|bpMoveTo| |n|)))))))
-
-(DEFUN |bpQualifiedName| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$stok|))
-    (RETURN
-      (COND
-        ((|bpEqPeek| 'COLON-COLON)
-         (PROGN
-           (|bpNext|)
-           (AND (EQCAR |$stok| 'ID) (|bpPushId|) (|bpNext|)
-                (|bpPush| (|bfColonColon| (|bpPop2|) (|bpPop1|))))))
-        ('T NIL)))))
-
-(DEFUN |bpName| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$stok|))
-    (RETURN
-      (COND
-        ((EQCAR |$stok| 'ID)
-         (PROGN
-           (|bpPushId|)
-           (|bpNext|)
-           (|bpAnyNo| #'|bpQualifiedName|)))
-        ('T NIL)))))
-
-(DEFUN |bpConstTok| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$ttok| |$stok|))
-    (RETURN
-      (COND
-        ((MEMQ (|shoeTokType| |$stok|) '(INTEGER FLOAT))
-         (PROGN (|bpPush| |$ttok|) (|bpNext|)))
-        ((EQCAR |$stok| 'LISP)
-         (AND (|bpPush| (|bfReadLisp| |$ttok|)) (|bpNext|)))
-        ((EQCAR |$stok| 'LISPEXP) (AND (|bpPush| |$ttok|) (|bpNext|)))
-        ((EQCAR |$stok| 'LINE)
-         (AND (|bpPush| (LIST '+LINE |$ttok|)) (|bpNext|)))
-        ((|bpEqPeek| 'QUOTE)
-         (PROGN
-           (|bpNext|)
-           (AND (OR (|bpSexp|) (|bpTrap|))
-                (|bpPush| (|bfSymbol| (|bpPop1|))))))
-        ('T (|bpString|))))))
-
-(DEFUN |bpModule| ()
-  (PROG ()
-    (RETURN
-      (COND
-        ((|bpEqKey| 'MODULE)
-         (AND (|bpConstTok|) (|bpPush| (|Module| (|bpPop1|)))))
-        ('T NIL)))))
-
-(DEFUN |bpImport| ()
-  (PROG ()
-    (RETURN
-      (COND
-        ((|bpEqKey| 'IMPORT)
-         (AND (|bpConstTok|) (|bpPush| (|Import| (|bpPop1|)))))
-        ('T NIL)))))
-
-(DEFUN |bpTypeAliasDefition| ()
-  (PROG ()
-    (RETURN
-      (AND (OR (|bpName|) (|bpTrap|)) (|bpEqKey| 'TDEF) (|bpLogical|)
-           (|bpPush| (|TypeAlias| (|bpPop2|) NIL (|bpPop1|)))))))
-
-(DEFUN |bpCancel| ()
-  (PROG (|a|)
-    (RETURN
-      (PROGN
-        (SETQ |a| (|bpState|))
-        (COND
-          ((|bpEqKeyNextTok| 'SETTAB)
-           (COND
-             ((|bpCancel|)
-              (COND
-                ((|bpEqKeyNextTok| 'BACKTAB) T)
-                (#0='T (|bpRestore| |a|) NIL)))
-             ((|bpEqKeyNextTok| 'BACKTAB) T)
-             (#0# (|bpRestore| |a|) NIL)))
-          (#0# NIL))))))
-
-(DEFUN |bpAddTokens| (|n|)
-  (PROG ()
-    (DECLARE (SPECIAL |$stok|))
-    (RETURN
-      (COND
-        ((EQL |n| 0) NIL)
-        ((< 0 |n|)
-         (CONS (|shoeTokConstruct| 'KEY 'SETTAB
-                   (|shoeTokPosn| |$stok|))
-               (|bpAddTokens| (- |n| 1))))
-        ('T
-         (CONS (|shoeTokConstruct| 'KEY 'BACKTAB
-                   (|shoeTokPosn| |$stok|))
-               (|bpAddTokens| (+ |n| 1))))))))
-
-(DEFUN |bpExceptions| ()
-  (PROG ()
-    (RETURN
-      (OR (|bpEqPeek| 'DOT) (|bpEqPeek| 'QUOTE) (|bpEqPeek| 'OPAREN)
-          (|bpEqPeek| 'CPAREN) (|bpEqPeek| 'SETTAB)
-          (|bpEqPeek| 'BACKTAB) (|bpEqPeek| 'BACKSET)))))
-
-(DEFUN |bpSexpKey| ()
-  (PROG (|a|)
-    (DECLARE (SPECIAL |$ttok| |$stok|))
-    (RETURN
-      (COND
-        ((AND (EQCAR |$stok| 'KEY) (NULL (|bpExceptions|)))
-         (PROGN
-           (SETQ |a| (GET |$ttok| 'SHOEINF))
-           (COND
-             ((NULL |a|) (AND (|bpPush| |$ttok|) (|bpNext|)))
-             (#0='T (AND (|bpPush| |a|) (|bpNext|))))))
-        (#0# NIL)))))
-
-(DEFUN |bpAnyId| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$ttok| |$stok|))
-    (RETURN
-      (OR (AND (|bpEqKey| 'MINUS)
-               (OR (EQCAR |$stok| 'INTEGER) (|bpTrap|))
-               (|bpPush| (- |$ttok|)) (|bpNext|))
-          (|bpSexpKey|)
-          (AND (MEMQ (|shoeTokType| |$stok|)
-                     '(ID INTEGER STRING FLOAT))
-               (|bpPush| |$ttok|) (|bpNext|))))))
-
-(DEFUN |bpSexp| ()
-  (PROG ()
-    (RETURN
-      (OR (|bpAnyId|)
-          (AND (|bpEqKey| 'QUOTE) (OR (|bpSexp|) (|bpTrap|))
-               (|bpPush| (|bfSymbol| (|bpPop1|))))
-          (|bpIndentParenthesized| #'|bpSexp1|)))))
-
-(DEFUN |bpSexp1| ()
-  (PROG ()
-    (RETURN
-      (OR (AND (|bpFirstTok|) (|bpSexp|)
-               (OR (AND (|bpEqKey| 'DOT) (|bpSexp|)
-                        (|bpPush| (CONS (|bpPop2|) (|bpPop1|))))
-                   (AND (|bpSexp1|)
-                        (|bpPush| (CONS (|bpPop2|) (|bpPop1|))))))
-          (|bpPush| NIL)))))
-
-(DEFUN |bpPrimary1| ()
-  (PROG ()
-    (RETURN
-      (OR (|bpName|) (|bpDot|) (|bpConstTok|) (|bpConstruct|)
-          (|bpCase|) (|bpStruct|) (|bpPDefinition|)
-          (|bpBPileDefinition|)))))
-
-(DEFUN |bpPrimary| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpFirstTok|) (OR (|bpPrimary1|) (|bpPrefixOperator|))))))
-
-(DEFUN |bpDot| ()
-  (PROG () (RETURN (AND (|bpEqKey| 'DOT) (|bpPush| (|bfDot|))))))
-
-(DEFUN |bpPrefixOperator| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$ttok| |$stok|))
-    (RETURN
-      (AND (EQCAR |$stok| 'KEY) (GET |$ttok| 'SHOEPRE) (|bpPushId|)
-           (|bpNext|)))))
-
-(DEFUN |bpInfixOperator| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$ttok| |$stok|))
-    (RETURN
-      (AND (EQCAR |$stok| 'KEY) (GET |$ttok| 'SHOEINF) (|bpPushId|)
-           (|bpNext|)))))
-
-(DEFUN |bpSelector| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpEqKey| 'DOT)
-           (OR (AND (|bpPrimary|)
-                    (|bpPush| (|bfElt| (|bpPop2|) (|bpPop1|))))
-               (|bpPush| (|bfSuffixDot| (|bpPop1|))))))))
-
-(DEFUN |bpOperator| ()
-  (PROG () (RETURN (AND (|bpPrimary|) (|bpAnyNo| #'|bpSelector|)))))
-
-(DEFUN |bpApplication| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpPrimary|) (|bpAnyNo| #'|bpSelector|)
-           (OR (AND (|bpApplication|)
-                    (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|))))
-               T)))))
-
-(DEFUN |bpTagged| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpApplication|)
-           (OR (AND (|bpEqKey| 'COLON)
-                    (OR (|bpApplication|) (|bpTrap|))
-                    (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|))))
-               T)))))
-
-(DEFUN |bpExpt| ()
-  (PROG () (RETURN (|bpRightAssoc| '(POWER) #'|bpTagged|))))
-
-(DEFUN |bpInfKey| (|s|)
-  (PROG ()
-    (DECLARE (SPECIAL |$ttok| |$stok|))
-    (RETURN
-      (AND (EQCAR |$stok| 'KEY) (MEMBER |$ttok| |s|) (|bpPushId|)
-           (|bpNext|)))))
-
-(DEFUN |bpInfGeneric| (|s|)
-  (PROG ()
-    (RETURN (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))))))
-
-(DEFUN |bpLeftAssoc| (|operations| |parser|)
-  (PROG ()
-    (RETURN
-      (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)))))
-
-(DEFUN |bpString| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$ttok| |$stok|))
-    (RETURN
-      (AND (EQ (|shoeTokType| |$stok|) 'STRING)
-           (|bpPush| (LIST 'QUOTE (INTERN |$ttok|))) (|bpNext|)))))
-
-(DEFUN |bpThetaName| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$ttok| |$stok|))
-    (RETURN
-      (COND
-        ((AND (EQCAR |$stok| 'ID) (GET |$ttok| 'SHOETHETA))
-         (|bpPushId|) (|bpNext|))
-        ('T NIL)))))
-
-(DEFUN |bpReduceOperator| ()
-  (PROG ()
-    (RETURN (OR (|bpInfixOperator|) (|bpString|) (|bpThetaName|)))))
-
-(DEFUN |bpReduce| ()
-  (PROG (|a|)
-    (RETURN
-      (PROGN
-        (SETQ |a| (|bpState|))
-        (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))))))
-
-(DEFUN |bpTimes| ()
-  (PROG ()
-    (RETURN
-      (OR (|bpReduce|) (|bpLeftAssoc| '(TIMES SLASH) #'|bpExpt|)))))
-
-(DEFUN |bpMinus| ()
-  (PROG ()
-    (RETURN
-      (OR (AND (|bpInfGeneric| '(MINUS)) (OR (|bpTimes|) (|bpTrap|))
-               (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|))))
-          (|bpTimes|)))))
-
-(DEFUN |bpArith| ()
-  (PROG () (RETURN (|bpLeftAssoc| '(PLUS MINUS) #'|bpMinus|))))
-
-(DEFUN |bpIs| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpArith|)
-           (OR (AND (|bpInfKey| '(IS ISNT))
-                    (OR (|bpPattern|) (|bpTrap|))
-                    (|bpPush|
-                        (|bfISApplication| (|bpPop2|) (|bpPop2|)
-                            (|bpPop1|))))
-               T)))))
-
-(DEFUN |bpBracketConstruct| (|f|)
-  (PROG ()
-    (RETURN
-      (AND (|bpBracket| |f|) (|bpPush| (|bfConstruct| (|bpPop1|)))))))
-
-(DEFUN |bpCompare| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpIs|)
-           (OR (AND (|bpInfKey| '(SHOEEQ SHOENE LT LE GT GE IN))
-                    (OR (|bpIs|) (|bpTrap|))
-                    (|bpPush|
-                        (|bfInfApplication| (|bpPop2|) (|bpPop2|)
-                            (|bpPop1|))))
-               T)))))
-
-(DEFUN |bpAnd| ()
-  (PROG () (RETURN (|bpLeftAssoc| '(AND) #'|bpCompare|))))
-
-(DEFUN |bpNoteReturnStmt| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$bodyHasReturn|))
-    (RETURN (PROGN (SETQ |$bodyHasReturn| T) T))))
-
-(DEFUN |bpReturn| ()
-  (PROG ()
-    (RETURN
-      (OR (AND (|bpEqKey| 'RETURN) (|bpNoteReturnStmt|)
-               (OR (|bpAnd|) (|bpTrap|))
-               (|bpPush| (|bfReturnNoName| (|bpPop1|))))
-          (|bpAnd|)))))
-
-(DEFUN |bpLogical| ()
-  (PROG () (RETURN (|bpLeftAssoc| '(OR) #'|bpReturn|))))
-
-(DEFUN |bpExpression| ()
-  (PROG ()
-    (RETURN
-      (OR (AND (|bpEqKey| 'COLON)
-               (OR (AND (|bpLogical|)
-                        (|bpPush| (|bfApplication| 'COLON (|bpPop1|))))
-                   (|bpTrap|)))
-          (|bpLogical|)))))
-
-(DEFUN |bpStatement| ()
-  (PROG ()
-    (RETURN
-      (OR (|bpConditional| #'|bpWhere|) (|bpLoop|) (|bpExpression|)))))
-
-(DEFUN |bpLoop| ()
-  (PROG ()
-    (RETURN
-      (OR (AND (|bpIterators|) (|bpCompMissing| 'REPEAT)
-               (OR (|bpWhere|) (|bpTrap|))
-               (|bpPush| (|bfLp| (|bpPop2|) (|bpPop1|))))
-          (AND (|bpEqKey| 'REPEAT) (OR (|bpLogical|) (|bpTrap|))
-               (|bpPush| (|bfLoop1| (|bpPop1|))))))))
-
-(DEFUN |bpSuchThat| ()
-  (PROG () (RETURN (|bpAndOr| 'BAR #'|bpWhere| #'|bfSuchthat|))))
-
-(DEFUN |bpWhile| ()
-  (PROG () (RETURN (|bpAndOr| 'WHILE #'|bpLogical| #'|bfWhile|))))
-
-(DEFUN |bpUntil| ()
-  (PROG () (RETURN (|bpAndOr| 'UNTIL #'|bpLogical| #'|bfUntil|))))
-
-(DEFUN |bpForIn| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpEqKey| 'FOR) (OR (|bpVariable|) (|bpTrap|))
-           (|bpCompMissing| 'IN)
-           (OR (AND (OR (|bpSeg|) (|bpTrap|)) (|bpEqKey| 'BY)
-                    (OR (|bpArith|) (|bpTrap|))
-                    (|bpPush|
-                        (|bfForInBy| (|bpPop3|) (|bpPop2|) (|bpPop1|))))
-               (|bpPush| (|bfForin| (|bpPop2|) (|bpPop1|))))))))
-
-(DEFUN |bpSeg| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpArith|)
-           (OR (AND (|bpEqKey| 'SEG)
-                    (OR (AND (|bpArith|)
-                             (|bpPush|
-                                 (|bfSegment2| (|bpPop2|) (|bpPop1|))))
-                        (|bpPush| (|bfSegment1| (|bpPop1|)))))
-               T)))))
-
-(DEFUN |bpIterator| ()
-  (PROG ()
-    (RETURN (OR (|bpForIn|) (|bpSuchThat|) (|bpWhile|) (|bpUntil|)))))
-
-(DEFUN |bpIteratorList| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpOneOrMore| #'|bpIterator|)
-           (|bpPush| (|bfIterators| (|bpPop1|)))))))
-
-(DEFUN |bpCrossBackSet| ()
-  (PROG ()
-    (RETURN (AND (|bpEqKey| 'CROSS) (OR (|bpEqKey| 'BACKSET) T)))))
-
-(DEFUN |bpIterators| ()
-  (PROG ()
-    (RETURN
-      (|bpListofFun| #'|bpIteratorList| #'|bpCrossBackSet| #'|bfCross|))))
-
-(DEFUN |bpAssign| ()
-  (PROG (|a|)
-    (RETURN
-      (PROGN
-        (SETQ |a| (|bpState|))
-        (COND
-          ((|bpStatement|)
-           (COND
-             ((|bpEqPeek| 'BEC) (|bpRestore| |a|)
-              (OR (|bpAssignment|) (|bpTrap|)))
-             (#0='T T)))
-          (#0# (|bpRestore| |a|) NIL))))))
-
-(DEFUN |bpAssignment| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpAssignVariable|) (|bpEqKey| 'BEC)
-           (OR (|bpAssign|) (|bpTrap|))
-           (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|)))))))
-
-(DEFUN |bpExit| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpAssign|)
-           (OR (AND (|bpEqKey| 'EXIT) (OR (|bpWhere|) (|bpTrap|))
-                    (|bpPush| (|bfExit| (|bpPop2|) (|bpPop1|))))
-               T)))))
-
-(DEFUN |bpBeginDefinition| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$sawParenthesizedHead|))
-    (RETURN
-      (OR (|bpEqPeek| 'DEF)
-          (AND |$sawParenthesizedHead| (|bpEqPeek| 'COLON))))))
-
-(DEFUN |bpDefinition| ()
-  (PROG (|a|)
-    (RETURN
-      (PROGN
-        (SETQ |a| (|bpState|))
-        (COND
-          ((|bpExit|)
-           (COND
-             ((|bpBeginDefinition|)
-              (PROGN (|bpRestore| |a|) (|bpDef|)))
-             ((|bpEqPeek| 'TDEF)
-              (PROGN (|bpRestore| |a|) (|bpTypeAliasDefition|)))
-             ((|bpEqPeek| 'MDEF) (PROGN (|bpRestore| |a|) (|bpMdef|)))
-             (#0='T T)))
-          (#0# (PROGN (|bpRestore| |a|) NIL)))))))
-
-(DEFUN |bpStoreName| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$bodyHasReturn| |$returnType| |$typings|
-                      |$wheredefs| |$op| |$stack|))
-    (RETURN
-      (PROGN
-        (SETQ |$op| (CAR |$stack|))
-        (SETQ |$wheredefs| NIL)
-        (SETQ |$typings| NIL)
-        (SETQ |$returnType| T)
-        (SETQ |$bodyHasReturn| NIL)
-        T))))
-
-(DEFUN |bpReturnType| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$returnType| |$sawParenthesizedHead|))
-    (RETURN
-      (COND
-        ((AND |$sawParenthesizedHead| (|bpEqKey| 'COLON))
-         (PROGN
-           (OR (|bpApplication|) (|bpTrap|))
-           (SETQ |$returnType| (|bpPop1|))
-           T))
-        ('T T)))))
-
-(DEFUN |bpDef| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpName|) (|bpStoreName|) (|bpDefTail|)
-           (|bpPush| (|bfCompDef| (|bpPop1|)))))))
-
-(DEFUN |bpDDef| () (PROG () (RETURN (AND (|bpName|) (|bpDefTail|)))))
-
-(DEFUN |bpSimpleDefinitionTail| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpEqKey| 'DEF) (OR (|bpWhere|) (|bpTrap|))
-           (|bpPush| (|ConstantDefinition| (|bpPop2|) (|bpPop1|)))))))
-
-(DEFUN |bpCompoundDefinitionTail| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpVariable|) (|bpReturnType|) (|bpEqKey| 'DEF)
-           (OR (|bpWhere|) (|bpTrap|))
-           (|bpPush| (|bfDefinition| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))))
-
-(DEFUN |bpDefTail| ()
-  (PROG ()
-    (RETURN
-      (OR (|bpSimpleDefinitionTail|) (|bpCompoundDefinitionTail|)))))
-
-(DEFUN |bpMDefTail| ()
-  (PROG ()
-    (RETURN
-      (AND (OR (|bpVariable|) (|bpTrap|)) (|bpEqKey| 'MDEF)
-           (OR (|bpWhere|) (|bpTrap|))
-           (|bpPush|
-               (|bfMDefinition| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))))
-
-(DEFUN |bpMdef| ()
-  (PROG () (RETURN (AND (|bpName|) (|bpStoreName|) (|bpMDefTail|)))))
-
-(DEFUN |bpWhere| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpDefinition|)
-           (OR (AND (|bpEqKey| 'WHERE)
-                    (OR (|bpDefinitionItem|) (|bpTrap|))
-                    (|bpPush| (|bfWhere| (|bpPop1|) (|bpPop1|))))
-               T)))))
-
-(DEFUN |bpDefinitionItem| ()
-  (PROG (|a|)
-    (RETURN
-      (PROGN
-        (SETQ |a| (|bpState|))
-        (COND
-          ((|bpDDef|) T)
-          (#0='T (|bpRestore| |a|)
-           (COND
-             ((|bpBDefinitionPileItems|) T)
-             (#0# (|bpRestore| |a|)
-              (COND
-                ((|bpPDefinitionItems|) T)
-                (#0# (|bpRestore| |a|) (|bpWhere|)))))))))))
-
-(DEFUN |bpDefinitionPileItems| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpListAndRecover| #'|bpDefinitionItem|)
-           (|bpPush| (|bfDefSequence| (|bpPop1|)))))))
-
-(DEFUN |bpBDefinitionPileItems| ()
-  (PROG () (RETURN (|bpPileBracketed| #'|bpDefinitionPileItems|))))
-
-(DEFUN |bpSemiColonDefinition| ()
-  (PROG ()
-    (RETURN (|bpSemiListing| #'|bpDefinitionItem| #'|bfDefSequence|))))
-
-(DEFUN |bpPDefinitionItems| ()
-  (PROG () (RETURN (|bpParenthesized| #'|bpSemiColonDefinition|))))
-
-(DEFUN |bpComma| ()
-  (PROG ()
-    (RETURN (OR (|bpModule|) (|bpImport|) (|bpTuple| #'|bpWhere|)))))
-
-(DEFUN |bpTuple| (|p|)
-  (PROG ()
-    (RETURN (|bpListofFun| |p| #'|bpCommaBackSet| #'|bfTuple|))))
-
-(DEFUN |bpCommaBackSet| ()
-  (PROG ()
-    (RETURN (AND (|bpEqKey| 'COMMA) (OR (|bpEqKey| 'BACKSET) T)))))
-
-(DEFUN |bpSemiColon| ()
-  (PROG () (RETURN (|bpSemiListing| #'|bpComma| #'|bfSequence|))))
-
-(DEFUN |bpSemiListing| (|p| |f|)
-  (PROG () (RETURN (|bpListofFun| |p| #'|bpSemiBackSet| |f|))))
-
-(DEFUN |bpSemiBackSet| ()
-  (PROG ()
-    (RETURN (AND (|bpEqKey| 'SEMICOLON) (OR (|bpEqKey| 'BACKSET) T)))))
-
-(DEFUN |bpPDefinition| ()
-  (PROG () (RETURN (|bpIndentParenthesized| #'|bpSemiColon|))))
-
-(DEFUN |bpPileItems| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpListAndRecover| #'|bpSemiColon|)
-           (|bpPush| (|bfSequence| (|bpPop1|)))))))
-
-(DEFUN |bpBPileDefinition| ()
-  (PROG () (RETURN (|bpPileBracketed| #'|bpPileItems|))))
-
-(DEFUN |bpIteratorTail| ()
-  (PROG () (RETURN (AND (OR (|bpEqKey| 'REPEAT) T) (|bpIterators|)))))
-
-(DEFUN |bpConstruct| ()
-  (PROG () (RETURN (|bpBracket| #'|bpConstruction|))))
-
-(DEFUN |bpConstruction| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpComma|)
-           (OR (AND (|bpIteratorTail|)
-                    (|bpPush| (|bfCollect| (|bpPop2|) (|bpPop1|))))
-               (|bpPush| (|bfTupleConstruct| (|bpPop1|))))))))
-
-(DEFUN |bpDConstruct| ()
-  (PROG () (RETURN (|bpBracket| #'|bpDConstruction|))))
-
-(DEFUN |bpDConstruction| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpComma|)
-           (OR (AND (|bpIteratorTail|)
-                    (|bpPush| (|bfDCollect| (|bpPop2|) (|bpPop1|))))
-               (|bpPush| (|bfDTuple| (|bpPop1|))))))))
-
-(DEFUN |bpPattern| ()
-  (PROG ()
-    (RETURN
-      (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpName|)
-          (|bpConstTok|)))))
-
-(DEFUN |bpEqual| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpEqKey| 'SHOEEQ)
-           (OR (|bpApplication|) (|bpConstTok|) (|bpTrap|))
-           (|bpPush| (|bfEqual| (|bpPop1|)))))))
-
-(DEFUN |bpRegularPatternItem| ()
-  (PROG ()
-    (RETURN
-      (OR (|bpEqual|) (|bpConstTok|) (|bpDot|)
-          (AND (|bpName|)
-               (OR (AND (|bpEqKey| 'BEC) (OR (|bpPattern|) (|bpTrap|))
-                        (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
-                   T))
-          (|bpBracketConstruct| #'|bpPatternL|)))))
-
-(DEFUN |bpRegularPatternItemL| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpRegularPatternItem|) (|bpPush| (LIST (|bpPop1|)))))))
-
-(DEFUN |bpRegularList| ()
-  (PROG ()
-    (RETURN
-      (|bpListof| #'|bpRegularPatternItemL| 'COMMA #'|bfAppend|))))
-
-(DEFUN |bpPatternColon| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpEqKey| 'COLON) (OR (|bpRegularPatternItem|) (|bpTrap|))
-           (|bpPush| (LIST (|bfColon| (|bpPop1|))))))))
-
-(DEFUN |bpPatternL| ()
-  (PROG ()
-    (RETURN (AND (|bpPatternList|) (|bpPush| (|bfTuple| (|bpPop1|)))))))
-
-(DEFUN |bpPatternList| ()
-  (PROG ()
-    (RETURN
-      (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|))))))
-
-(DEFUN |bpPatternTail| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpPatternColon|)
-           (OR (AND (|bpEqKey| 'COMMA)
-                    (OR (|bpRegularList|) (|bpTrap|))
-                    (|bpPush| (APPEND (|bpPop2|) (|bpPop1|))))
-               T)))))
-
-(DEFUN |bpRegularBVItem| ()
-  (PROG ()
-    (RETURN
-      (OR (|bpBVString|) (|bpConstTok|)
-          (AND (|bpName|)
-               (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|))))
-                   T))
-          (|bpBracketConstruct| #'|bpPatternL|)))))
-
-(DEFUN |bpBVString| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$ttok| |$stok|))
-    (RETURN
-      (AND (EQ (|shoeTokType| |$stok|) 'STRING)
-           (|bpPush| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext|)))))
-
-(DEFUN |bpRegularBVItemL| ()
-  (PROG ()
-    (RETURN (AND (|bpRegularBVItem|) (|bpPush| (LIST (|bpPop1|)))))))
-
-(DEFUN |bpColonName| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpEqKey| 'COLON)
-           (OR (|bpName|) (|bpBVString|) (|bpTrap|))))))
-
-(DEFUN |bpBoundVariablelist| ()
-  (PROG ()
-    (RETURN
-      (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|)))))))))
-
-(DEFUN |bpBeginParameterList| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$sawParenthesizedHead|))
-    (RETURN (PROGN (SETQ |$sawParenthesizedHead| NIL) T))))
-
-(DEFUN |bpEndParameterList| ()
-  (PROG ()
-    (DECLARE (SPECIAL |$sawParenthesizedHead|))
-    (RETURN (SETQ |$sawParenthesizedHead| T))))
-
-(DEFUN |bpVariable| ()
-  (PROG ()
-    (RETURN
-      (OR (AND (|bpBeginParameterList|)
-               (|bpParenthesized| #'|bpBoundVariablelist|)
-               (|bpPush| (|bfTupleIf| (|bpPop1|)))
-               (|bpEndParameterList|))
-          (|bpBracketConstruct| #'|bpPatternL|) (|bpName|)
-          (|bpConstTok|)))))
-
-(DEFUN |bpAssignVariable| ()
-  (PROG ()
-    (RETURN
-      (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpAssignLHS|)))))
-
-(DEFUN |bpAssignLHS| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpName|)
-           (OR (AND (|bpEqKey| 'COLON)
-                    (OR (|bpApplication|) (|bpTrap|))
-                    (|bpPush| (|bfLocal| (|bpPop2|) (|bpPop1|))))
-               (AND (|bpEqKey| 'DOT)
-                    (|bpList| #'|bpPrimary| 'DOT #'|bfListOf|)
-                    (|bpChecknull|)
-                    (|bpPush| (|bfTuple| (CONS (|bpPop2|) (|bpPop1|)))))
-               T)))))
-
-(DEFUN |bpChecknull| ()
-  (PROG (|a|)
-    (RETURN
-      (PROGN
-        (SETQ |a| (|bpPop1|))
-        (COND ((NULL |a|) (|bpTrap|)) ('T (|bpPush| |a|)))))))
-
-(DEFUN |bpStruct| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpEqKey| 'STRUCTURE) (OR (|bpName|) (|bpTrap|))
-           (OR (|bpEqKey| 'DEF) (|bpTrap|)) (|bpTypeList|)
-           (|bpPush| (|bfStruct| (|bpPop2|) (|bpPop1|)))))))
-
-(DEFUN |bpTypeList| ()
-  (PROG ()
-    (RETURN
-      (OR (|bpPileBracketed| #'|bpTypeItemList|)
-          (AND (|bpTerm|) (|bpPush| (LIST (|bpPop1|))))))))
-
-(DEFUN |bpTypeItemList| ()
-  (PROG () (RETURN (|bpListAndRecover| #'|bpTerm|))))
-
-(DEFUN |bpTerm| ()
-  (PROG ()
-    (RETURN
-      (OR (AND (OR (|bpName|) (|bpTrap|))
-               (OR (AND (|bpParenthesized| #'|bpIdList|)
-                        (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))
-                   (AND (|bpName|)
-                        (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))))
-          (|bpPush| (|bfNameOnly| (|bpPop1|)))))))
-
-(DEFUN |bpIdList| () (PROG () (RETURN (|bpTuple| #'|bpName|))))
-
-(DEFUN |bpCase| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpEqKey| 'CASE) (OR (|bpWhere|) (|bpTrap|))
-           (OR (|bpEqKey| 'OF) (|bpMissing| 'OF)) (|bpPiledCaseItems|)))))
-
-(DEFUN |bpPiledCaseItems| ()
-  (PROG ()
-    (RETURN
-      (AND (|bpPileBracketed| #'|bpCaseItemList|)
-           (|bpPush| (|bfCase| (|bpPop2|) (|bpPop1|)))))))
-
-(DEFUN |bpCaseItemList| ()
-  (PROG () (RETURN (|bpListAndRecover| #'|bpCaseItem|))))
-
-(DEFUN |bpCaseItem| ()
-  (PROG ()
-    (RETURN
-      (AND (OR (|bpTerm|) (|bpTrap|)) (OR (|bpEqKey| 'EXIT) (|bpTrap|))
-           (OR (|bpWhere|) (|bpTrap|))
-           (|bpPush| (|bfCaseItem| (|bpPop2|) (|bpPop1|)))))))
-
-@
-
-\end{document}