Initial population.

1 files changed, 2453 insertions, 0 deletions

diff --git a/src/boot/parser.boot.pamphlet b/src/boot/parser.boot.pamphlet
new file mode 100644
index 00000000..043dde0f
--- /dev/null
+++ b/src/boot/parser.boot.pamphlet
@@ -0,0 +1,2453 @@
+\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>>
+
+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
+
+bpImport() ==
+  bpEqKey "IMPORT" =>
+    -- 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())
+ 
+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 NE 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 bfDefinition(bpPop2(),bfTuple nil, 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")
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+  (DEFPARAMETER |$sawParenthesizedHead| NIL))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+  (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)
+            ((LAMBDA ()
+               (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)
+            ((LAMBDA ()
+               (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)
+            ((LAMBDA ()
+               (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)
+           ((LAMBDA ()
+              (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
+        ((LAMBDA ()
+           (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|)
+        ((LAMBDA ()
+           (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)
+           ((LAMBDA ()
+              (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)
+         ((LAMBDA ()
+            (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 NE 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|
+               (|bfDefinition| (|bpPop2|) (|bfTuple| NIL) (|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|)
+         ((LAMBDA ()
+            (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|)
+         ((LAMBDA ()
+            (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}