aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2012-05-30 01:29:11 +0000
committerdos-reis <gdr@axiomatics.org>2012-05-30 01:29:11 +0000
commitf41afae2b242dd56e8dbfa0b3f8cb16a6ab29ff0 (patch)
tree965cfaa10f1e8b18138765e758773eb026cd5515 /src/boot
parent6c9b37fd68b558bced11d67cfc798ca96800bc79 (diff)
downloadopen-axiom-f41afae2b242dd56e8dbfa0b3f8cb16a6ab29ff0.tar.gz
* boot/parser.boot: Add parser state argument to more functions.
Remove references to $inputStream. * boot/translator.boot (shoeOutParse): Remove $inputStream.
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/parser.boot661
-rw-r--r--src/boot/strap/parser.clisp670
-rw-r--r--src/boot/strap/translator.clisp2
-rw-r--r--src/boot/translator.boot5
4 files changed, 693 insertions, 645 deletions
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index e8843aa7..1348aa57 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -78,48 +78,48 @@ makeTranslator ip ==
--%
-bpFirstToken()==
+bpFirstToken ps ==
$stok:=
- $inputStream = nil => mk%Token("ERROR","NOMORE",tokenPosition $stok)
- first $inputStream
+ parserTokens ps = nil => mk%Token("ERROR","NOMORE",tokenPosition $stok)
+ first parserTokens ps
$ttok := tokenValue $stok
true
-bpFirstTok()==
+bpFirstTok ps ==
$stok:=
- $inputStream = nil => mk%Token("ERROR","NOMORE",tokenPosition $stok)
- first $inputStream
+ parserTokens ps = nil => mk%Token("ERROR","NOMORE",tokenPosition $stok)
+ first parserTokens ps
$ttok := tokenValue $stok
$bpParenCount > 0 and tokenClass $stok = "KEY" =>
$ttok is "SETTAB" =>
$bpCount:=$bpCount+1
- bpNext()
+ bpNext ps
$ttok is "BACKTAB" =>
$bpCount:=$bpCount-1
- bpNext()
+ bpNext ps
$ttok is "BACKSET" =>
- bpNext()
+ bpNext ps
true
true
-bpNext() ==
- $inputStream := rest($inputStream)
- bpFirstTok()
+bpNext ps ==
+ parserTokens(ps) := rest parserTokens ps
+ bpFirstTok ps
-bpNextToken() ==
- $inputStream := rest($inputStream)
- bpFirstToken()
+bpNextToken ps ==
+ parserTokens(ps) := rest parserTokens ps
+ bpFirstToken ps
bpRequire(ps,f) ==
apply(f,ps,nil) or bpTrap()
-bpState() ==
- [$inputStream,$stack,$bpParenCount,$bpCount]
+bpState ps ==
+ [parserTokens ps,$stack,$bpParenCount,$bpCount]
-bpRestore(x)==
- $inputStream:=first x
- bpFirstToken()
+bpRestore(ps,x)==
+ parserTokens(ps) := first x
+ bpFirstToken ps
$stack:=second x
$bpParenCount:=third x
$bpCount:=CADDDR x
@@ -131,17 +131,17 @@ bpPush(ps,x) ==
bpPushId ps ==
$stack:= [bfReName $ttok,:$stack]
-bpPop1()==
+bpPop1 ps ==
a:=first $stack
$stack:=rest $stack
a
-bpPop2()==
+bpPop2 ps ==
a:=second $stack
$stack.rest := CDDR $stack
a
-bpPop3()==
+bpPop3 ps ==
a:=third $stack
$stack.rest.rest := CDDDR $stack
a
@@ -151,31 +151,31 @@ bpIndentParenthesized(ps,f) ==
a:=$stok
bpEqPeek "OPAREN" =>
$bpParenCount:=$bpParenCount+1
- bpNext()
- apply(f,ps,nil) and bpFirstTok() and
+ bpNext ps
+ apply(f,ps,nil) and bpFirstTok ps and
(bpEqPeek "CPAREN" or bpParenTrap(a)) =>
$bpParenCount:=$bpParenCount-1
- bpNextToken()
+ bpNextToken ps
$bpCount=0 => true
- $inputStream:=append( bpAddTokens $bpCount,$inputStream)
- bpFirstToken()
+ parserTokens(ps) := append(bpAddTokens $bpCount,parserTokens ps)
+ bpFirstToken ps
$bpParenCount=0 =>
- bpCancel()
+ bpCancel ps
true
true
bpEqPeek "CPAREN" =>
bpPush(ps,bfTuple [])
$bpParenCount:=$bpParenCount-1
- bpNextToken()
+ bpNextToken ps
true
bpParenTrap(a)
false
bpParenthesized(ps,f) ==
a := $stok
- bpEqKey "OPAREN" =>
- apply(f,ps,nil) and (bpEqKey "CPAREN" or bpParenTrap(a)) => true
- bpEqKey "CPAREN" =>
+ bpEqKey(ps,"OPAREN") =>
+ apply(f,ps,nil) and (bpEqKey(ps,"CPAREN") or bpParenTrap(a)) => true
+ bpEqKey(ps,"CPAREN") =>
bpPush(ps,bfTuple [])
true
bpParenTrap(a)
@@ -183,29 +183,29 @@ bpParenthesized(ps,f) ==
bpBracket(ps,f) ==
a := $stok
- bpEqKey "OBRACK" =>
- apply(f,ps,nil) and (bpEqKey "CBRACK" or bpBrackTrap(a)) =>
- bpPush(ps,bfBracket bpPop1())
- bpEqKey "CBRACK" => bpPush(ps,[])
+ bpEqKey(ps,"OBRACK") =>
+ apply(f,ps,nil) and (bpEqKey(ps,"CBRACK") or bpBrackTrap(a)) =>
+ bpPush(ps,bfBracket bpPop1 ps)
+ bpEqKey(ps,"CBRACK") => bpPush(ps,[])
bpBrackTrap(a)
false
bpPileBracketed(ps,f) ==
- bpEqKey "SETTAB" =>
- bpEqKey "BACKTAB" => true
- apply(f,ps,nil) and (bpEqKey "BACKTAB" or bpPileTrap()) =>
- bpPush(ps,bfPile bpPop1())
+ bpEqKey(ps,"SETTAB") =>
+ bpEqKey(ps,"BACKTAB") => true
+ apply(f,ps,nil) and (bpEqKey(ps,"BACKTAB") or bpPileTrap()) =>
+ bpPush(ps,bfPile bpPop1 ps)
false
false
bpListof(ps,f,str1,g)==
apply(f,ps,nil) =>
- bpEqKey str1 and bpRequire(ps,f) =>
+ bpEqKey(ps,str1) and bpRequire(ps,f) =>
a:=$stack
$stack:=nil
- while bpEqKey str1 and bpRequire(ps,f) repeat nil
+ while bpEqKey(ps,str1) and bpRequire(ps,f) repeat nil
$stack:=[reverse! $stack,:a]
- bpPush(ps,FUNCALL(g, [bpPop3(),bpPop2(),:bpPop1()]))
+ bpPush(ps,FUNCALL(g, [bpPop3 ps,bpPop2 ps,:bpPop1 ps]))
true
false
@@ -218,19 +218,19 @@ bpListofFun(ps,f,h,g)==
$stack:=nil
while apply(h,ps,nil) and bpRequire(ps,f) repeat nil
$stack:=[reverse! $stack,:a]
- bpPush(ps,FUNCALL(g, [bpPop3(),bpPop2(),:bpPop1()]))
+ bpPush(ps,FUNCALL(g, [bpPop3 ps,bpPop2 ps,:bpPop1 ps]))
true
false
bpList(ps,f,str1)==
apply(f,ps,nil) =>
- bpEqKey str1 and bpRequire(ps,f) =>
+ bpEqKey(ps,str1) and bpRequire(ps,f) =>
a:=$stack
$stack:=nil
- while bpEqKey str1 and bpRequire(ps,f) repeat nil
+ while bpEqKey(ps,str1) and bpRequire(ps,f) repeat nil
$stack:=[reverse! $stack,:a]
- bpPush(ps,[bpPop3(),bpPop2(),:bpPop1()])
- bpPush(ps,[bpPop1()])
+ bpPush(ps,[bpPop3 ps,bpPop2 ps,:bpPop1 ps])
+ bpPush(ps,[bpPop1 ps])
bpPush(ps,nil)
bpOneOrMore(ps,f) ==
@@ -239,7 +239,7 @@ bpOneOrMore(ps,f) ==
$stack:=nil
while apply(f,ps,nil) repeat nil
$stack:=[reverse! $stack,:a]
- bpPush(ps,[bpPop2(),:bpPop1()])
+ bpPush(ps,[bpPop2 ps,:bpPop1 ps])
false
@@ -251,39 +251,39 @@ bpAnyNo(ps,s) ==
-- AndOr(k,p,f)= k p
bpAndOr(ps,keyword,p,f)==
- bpEqKey keyword and bpRequire(ps,p)
- and bpPush(ps,FUNCALL(f, bpPop1()))
+ bpEqKey(ps,keyword) and bpRequire(ps,p)
+ and bpPush(ps,FUNCALL(f, bpPop1 ps))
bpConditional(ps,f) ==
- bpEqKey "IF" and bpRequire(ps,function bpWhere) and (bpEqKey "BACKSET" or true) =>
- bpEqKey "SETTAB" =>
- bpEqKey "THEN" =>
- bpRequire(ps,f) and bpElse(ps,f) and bpEqKey "BACKTAB"
+ bpEqKey(ps,"IF") and bpRequire(ps,function bpWhere) and (bpEqKey(ps,"BACKSET") or true) =>
+ bpEqKey(ps,"SETTAB") =>
+ bpEqKey(ps,"THEN") =>
+ bpRequire(ps,f) and bpElse(ps,f) and bpEqKey(ps,"BACKTAB")
bpMissing "THEN"
- bpEqKey "THEN" => bpRequire(ps,f) and bpElse(ps,f)
+ bpEqKey(ps,"THEN") => bpRequire(ps,f) and bpElse(ps,f)
bpMissing "then"
false
bpElse(ps,f)==
- a:=bpState()
- bpBacksetElse() =>
+ a := bpState ps
+ bpBacksetElse ps =>
bpRequire(ps,f) and
- bpPush(ps,bfIf(bpPop3(),bpPop2(),bpPop1()))
- bpRestore a
- bpPush(ps,bfIfThenOnly(bpPop2(),bpPop1()))
+ bpPush(ps,bfIf(bpPop3 ps,bpPop2 ps,bpPop1 ps))
+ bpRestore(ps,a)
+ bpPush(ps,bfIfThenOnly(bpPop2 ps,bpPop1 ps))
-bpBacksetElse()==
- bpEqKey "BACKSET" => bpEqKey "ELSE"
- bpEqKey "ELSE"
+bpBacksetElse ps ==
+ bpEqKey(ps,"BACKSET") => bpEqKey(ps,"ELSE")
+ bpEqKey(ps,"ELSE")
bpEqPeek s ==
tokenClass $stok = "KEY" and symbolEq?(s,$ttok)
-bpEqKey s ==
- tokenClass $stok = "KEY" and symbolEq?(s,$ttok) and bpNext()
+bpEqKey(ps,s) ==
+ tokenClass $stok = "KEY" and symbolEq?(s,$ttok) and bpNext ps
-bpEqKeyNextTok s ==
- tokenClass $stok = "KEY" and symbolEq?(s,$ttok) and bpNextToken()
+bpEqKeyNextTok(ps,s) ==
+ tokenClass $stok = "KEY" and symbolEq?(s,$ttok) and bpNextToken ps
bpPileTrap() == bpMissing "BACKTAB"
bpBrackTrap(x) == bpMissingMate("]",x)
@@ -297,16 +297,17 @@ bpMissing s==
bpSpecificErrorHere strconc(PNAME s,'" possibly missing")
throw 'TRAPPED : BootParserException
-bpCompMissing s == bpEqKey s or bpMissing s
+bpCompMissing(ps,s) ==
+ bpEqKey(ps,s) or bpMissing s
bpTrap()==
bpGeneralErrorHere()
throw 'TRAPPED : BootParserException
bpRecoverTrap ps ==
- bpFirstToken()
+ bpFirstToken ps
pos1 := tokenPosition $stok
- bpMoveTo 0
+ bpMoveTo(ps,0)
pos2 := tokenPosition $stok
bpIgnoredFromTo(pos1, pos2)
bpPush(ps,[['"pile syntax error"]])
@@ -316,63 +317,63 @@ bpListAndRecover(ps,f)==
b := nil
$stack := nil
done := false
- c := $inputStream
+ c := parserTokens ps
while not done repeat
found :=
try apply(f,ps,nil)
catch(e: BootParserException) => e
if found is "TRAPPED"
then
- $inputStream:=c
+ parserTokens(ps) := c
bpRecoverTrap ps
else if not found
then
- $inputStream:=c
+ parserTokens(ps) := c
bpGeneralErrorHere()
bpRecoverTrap ps
- if bpEqKey "BACKSET"
+ if bpEqKey(ps,"BACKSET")
then
- c := $inputStream
- else if bpEqPeek "BACKTAB" or $inputStream = nil
+ c := parserTokens ps
+ else if bpEqPeek "BACKTAB" or parserTokens ps = nil
then
done := true
else
- $inputStream := c
+ parserTokens(ps) := c
bpGeneralErrorHere()
bpRecoverTrap ps
- if bpEqPeek "BACKTAB" or $inputStream = nil
+ if bpEqPeek "BACKTAB" or parserTokens ps = nil
then done:=true
else
- bpNext()
- c := $inputStream
- b := [bpPop1(),:b]
+ bpNext ps
+ c := parserTokens ps
+ b := [bpPop1 ps,:b]
$stack := a
bpPush(ps,reverse! b)
-bpMoveTo n==
- $inputStream = nil => true
+bpMoveTo(ps,n) ==
+ parserTokens ps = nil => true
bpEqPeek "BACKTAB" =>
n=0 => true
- bpNextToken()
+ bpNextToken ps
$bpCount:=$bpCount-1
- bpMoveTo(n-1)
+ bpMoveTo(ps,n-1)
bpEqPeek "BACKSET" =>
n=0 => true
- bpNextToken()
- bpMoveTo n
+ bpNextToken ps
+ bpMoveTo(ps,n)
bpEqPeek "SETTAB" =>
- bpNextToken()
- bpMoveTo(n+1)
+ bpNextToken ps
+ bpMoveTo(ps,n+1)
bpEqPeek "OPAREN" =>
- bpNextToken()
+ bpNextToken ps
$bpParenCount:=$bpParenCount+1
- bpMoveTo n
+ bpMoveTo(ps,n)
bpEqPeek "CPAREN" =>
- bpNextToken()
+ bpNextToken ps
$bpParenCount:=$bpParenCount-1
- bpMoveTo n
- bpNextToken()
- bpMoveTo n
+ bpMoveTo(ps,n)
+ bpNextToken ps
+ bpMoveTo(ps,n)
-- A fully qualified name could be interpreted as a left reduction
-- of an '::' infix operator. At the moment, we don't use
@@ -384,9 +385,9 @@ bpMoveTo n==
-- symbol is present on the stack.
bpQualifiedName ps ==
bpEqPeek "COLON-COLON" =>
- bpNext()
- tokenClass $stok = "ID" and bpPushId ps and bpNext()
- and bpPush(ps,bfColonColon(bpPop2(), bpPop1()))
+ bpNext ps
+ tokenClass $stok = "ID" and bpPushId ps and bpNext ps
+ and bpPush(ps,bfColonColon(bpPop2 ps, bpPop1 ps))
false
++ Name:
@@ -395,7 +396,7 @@ bpQualifiedName ps ==
bpName ps ==
tokenClass $stok = "ID" =>
bpPushId ps
- bpNext()
+ bpNext ps
bpAnyNo(ps,function bpQualifiedName)
false
@@ -410,31 +411,31 @@ bpName ps ==
bpConstTok ps ==
tokenClass $stok in '(INTEGER FLOAT) =>
bpPush(ps,$ttok)
- bpNext()
- tokenClass $stok = "LISP" => bpPush(ps,%Lisp $ttok) and bpNext()
- tokenClass $stok = "LISPEXP" => bpPush(ps,$ttok) and bpNext()
- tokenClass $stok = "LINE" => bpPush(ps,["+LINE", $ttok]) and bpNext()
+ bpNext ps
+ tokenClass $stok = "LISP" => bpPush(ps,%Lisp $ttok) and bpNext ps
+ tokenClass $stok = "LISPEXP" => bpPush(ps,$ttok) and bpNext ps
+ tokenClass $stok = "LINE" => bpPush(ps,["+LINE", $ttok]) and bpNext ps
bpEqPeek "QUOTE" =>
- bpNext()
+ bpNext ps
bpRequire(ps,function bpSexp) and
- bpPush(ps,bfSymbol bpPop1())
+ bpPush(ps,bfSymbol bpPop1 ps)
bpString ps or bpFunction ps
bpChar ps ==
tokenClass $stok = "ID" and $ttok is "char" =>
- a := bpState()
+ a := bpState ps
bpApplication ps =>
- s := bpPop1()
+ s := bpPop1 ps
s is ["char",.] => bpPush(ps,s)
- bpRestore a
+ bpRestore(ps,a)
false
false
false
++ Subroutine of bpExportItem. Parses tails of ExportItem.
bpExportItemTail ps ==
- bpEqKey "BEC" and bpRequire(ps,function bpAssign) and
- bpPush(ps,%Assignment(bpPop2(), bpPop1()))
+ bpEqKey(ps,"BEC") and bpRequire(ps,function bpAssign) and
+ bpPush(ps,%Assignment(bpPop2 ps, bpPop1 ps))
or bpSimpleDefinitionTail ps
++ ExportItem:
@@ -445,13 +446,13 @@ bpExportItemTail ps ==
++ Signature == Where
bpExportItem ps ==
bpEqPeek "STRUCTURE" => bpStruct ps
- a := bpState()
+ a := bpState ps
bpName ps =>
bpEqPeek "COLON" =>
- bpRestore a
+ bpRestore(ps,a)
bpRequire(ps,function bpSignature)
bpExportItemTail ps or true
- bpRestore a
+ bpRestore(ps,a)
bpTypeAliasDefition ps
false
@@ -464,27 +465,27 @@ bpExportItemList ps ==
++ ModuleInterface:
++ WHERE pile-bracketed ExporItemList
bpModuleInterface ps ==
- bpEqKey "WHERE" =>
+ bpEqKey(ps,"WHERE") =>
bpPileBracketed(ps,function bpExportItemList)
- or (bpExportItem ps and bpPush(ps,[bpPop1()]))
+ or (bpExportItem ps and bpPush(ps,[bpPop1 ps]))
or bpTrap()
bpPush(ps,nil)
++ ModuleExports:
++ OPAREN IdList CPAREN
bpModuleExports ps ==
- bpParenthesized(ps,function bpIdList) => bpPush(ps,bfUntuple bpPop1())
+ bpParenthesized(ps,function bpIdList) => bpPush(ps,bfUntuple bpPop1 ps)
bpPush(ps,nil)
++ Parse a module definitoin
++ Module:
++ MODULE Name OptionalModuleExports OptionalModuleInterface
bpModule ps ==
- bpEqKey "MODULE" =>
+ bpEqKey(ps,"MODULE") =>
bpRequire(ps,function bpName)
bpModuleExports ps
bpModuleInterface ps
- bpPush(ps,%Module(bpPop3(),bpPop2(),bpPop1()))
+ bpPush(ps,%Module(bpPop3 ps,bpPop2 ps,bpPop1 ps))
nil
++ Parse a module import, or a import declaration for a foreign entity.
@@ -493,51 +494,51 @@ bpModule ps ==
++ IMPORT Name
++ IMPORT NAMESPACE LongName
bpImport ps ==
- bpEqKey "IMPORT" =>
- bpEqKey "NAMESPACE" =>
+ bpEqKey(ps,"IMPORT") =>
+ bpEqKey(ps,"NAMESPACE") =>
bpLeftAssoc(ps,'(DOT),function bpName) and
- bpPush(ps,%Import bfNamespace bpPop1())
+ bpPush(ps,%Import bfNamespace bpPop1 ps)
or bpTrap()
- a := bpState()
+ a := bpState ps
bpRequire(ps,function bpName)
bpEqPeek "COLON" =>
- bpRestore a
+ bpRestore(ps,a)
bpRequire(ps,function bpSignature) and
- (bpEqKey "FOR" or bpTrap()) and
+ (bpEqKey(ps,"FOR") or bpTrap()) and
bpRequire(ps,function bpName) and
- bpPush(ps,%ImportSignature(bpPop1(), bpPop1()))
- bpPush(ps,%Import bpPop1())
+ bpPush(ps,%ImportSignature(bpPop1 ps, bpPop1 ps))
+ bpPush(ps,%Import bpPop1 ps)
false
++
++ Namespace:
++ NAMESPACE Name
bpNamespace ps ==
- bpEqKey "NAMESPACE" and (bpName ps or bpDot ps) and
- bpPush(ps,bfNamespace bpPop1())
+ bpEqKey(ps,"NAMESPACE") and (bpName ps or bpDot ps) and
+ bpPush(ps,bfNamespace bpPop1 ps)
-- Parse a type alias defnition:
-- type-alias-definition:
-- identifier <=> logical-expression
bpTypeAliasDefition ps ==
(bpTerm(ps,function bpIdList) or bpTrap()) and
- bpEqKey "TDEF" and bpLogical ps and
- bpPush(ps,%TypeAlias(bpPop2(), bpPop1()))
+ bpEqKey(ps,"TDEF") and bpLogical ps and
+ bpPush(ps,%TypeAlias(bpPop2 ps, bpPop1 ps))
++ Parse a signature declaration
++ Signature:
++ Name COLON Mapping
bpSignature ps ==
- bpName ps and bpEqKey "COLON" and bpRequire(ps,function bpTyping)
- and bpPush(ps,%Signature(bpPop2(), bpPop1()))
+ bpName ps and bpEqKey(ps,"COLON") and bpRequire(ps,function bpTyping)
+ and bpPush(ps,%Signature(bpPop2 ps, bpPop1 ps))
++ SimpleMapping:
++ Application
++ Application -> Application
bpSimpleMapping ps ==
bpApplication ps =>
- bpEqKey "ARROW" and bpRequire(ps,function bpApplication) and
- bpPush(ps,%Mapping(bpPop1(), [bpPop1()]))
+ bpEqKey(ps,"ARROW") and bpRequire(ps,function bpApplication) and
+ bpPush(ps,%Mapping(bpPop1 ps, [bpPop1 ps]))
true
false
@@ -554,18 +555,18 @@ bpArgtypeList ps ==
++ ArgtypeList -> Application
bpMapping ps ==
bpParenthesized(ps,function bpArgtypeList) and
- bpEqKey "ARROW" and bpApplication ps and
- bpPush(ps,%Mapping(bpPop1(), bfUntuple bpPop1()))
-
-bpCancel()==
- a := bpState()
- bpEqKeyNextTok "SETTAB" =>
- bpCancel() =>
- bpEqKeyNextTok "BACKTAB" => true
- bpRestore a
+ bpEqKey(ps,"ARROW") and bpApplication ps and
+ bpPush(ps,%Mapping(bpPop1 ps, bfUntuple bpPop1 ps))
+
+bpCancel ps ==
+ a := bpState ps
+ bpEqKeyNextTok(ps,"SETTAB") =>
+ bpCancel ps =>
+ bpEqKeyNextTok(ps,"BACKTAB") => true
+ bpRestore(ps,a)
false
- bpEqKeyNextTok "BACKTAB" => true
- bpRestore a
+ bpEqKeyNextTok(ps,"BACKTAB") => true
+ bpRestore(ps,a)
false
false
@@ -584,27 +585,27 @@ bpExceptions()==
bpSexpKey ps ==
tokenClass $stok = "KEY" and not bpExceptions() =>
a := $ttok has SHOEINF
- a = nil => bpPush(ps,keywordId $ttok) and bpNext()
- bpPush(ps,a) and bpNext()
+ a = nil => bpPush(ps,keywordId $ttok) and bpNext ps
+ bpPush(ps,a) and bpNext ps
false
bpAnyId ps ==
- bpEqKey "MINUS" and (tokenClass $stok = "INTEGER" or bpTrap()) and
- bpPush(ps,-$ttok) and bpNext() or
+ bpEqKey(ps,"MINUS") and (tokenClass $stok = "INTEGER" or bpTrap()) and
+ bpPush(ps,-$ttok) and bpNext ps or
bpSexpKey ps or
tokenClass $stok in '(ID INTEGER STRING FLOAT)
- and bpPush(ps,$ttok) and bpNext()
+ and bpPush(ps,$ttok) and bpNext ps
bpSexp ps ==
bpAnyId ps or
- bpEqKey "QUOTE" and bpRequire(ps,function bpSexp)
- and bpPush(ps,bfSymbol bpPop1()) or
+ bpEqKey(ps,"QUOTE") and bpRequire(ps,function bpSexp)
+ and bpPush(ps,bfSymbol bpPop1 ps) or
bpIndentParenthesized(ps,function bpSexp1)
-bpSexp1 ps == bpFirstTok() and
+bpSexp1 ps == bpFirstTok ps and
bpSexp ps and
- (bpEqKey "DOT" and bpSexp ps and bpPush(ps,[bpPop2(),:bpPop1()]) or
- bpSexp1 ps and bpPush(ps,[bpPop2(),:bpPop1()])) or
+ (bpEqKey(ps,"DOT") and bpSexp ps and bpPush(ps,[bpPop2 ps,:bpPop1 ps]) or
+ bpSexp1 ps and bpPush(ps,[bpPop2 ps,:bpPop1 ps])) or
bpPush(ps,nil)
bpPrimary1 ps ==
@@ -622,31 +623,31 @@ bpParenthesizedApplication ps ==
bpArgumentList ps ==
bpPDefinition ps and
- bpPush(ps,bfApplication(bpPop2(), bpPop1()))
+ bpPush(ps,bfApplication(bpPop2 ps, bpPop1 ps))
bpPrimary ps ==
- bpFirstTok() and (bpPrimary1 ps or bpPrefixOperator ps )
+ bpFirstTok ps and (bpPrimary1 ps or bpPrefixOperator ps )
bpDot ps ==
- bpEqKey "DOT" and bpPush(ps,bfDot())
+ bpEqKey(ps,"DOT") and bpPush(ps,bfDot())
bpPrefixOperator ps ==
tokenClass $stok = "KEY" and
- $ttok has SHOEPRE and bpPushId ps and bpNext()
+ $ttok has SHOEPRE and bpPushId ps and bpNext ps
bpInfixOperator ps ==
tokenClass $stok = "KEY" and
- $ttok has SHOEINF and bpPushId ps and bpNext()
+ $ttok has SHOEINF and bpPushId ps and bpNext ps
bpSelector ps ==
- bpEqKey "DOT" and (bpPrimary ps
- and bpPush(ps,bfElt(bpPop2(),bpPop1()))
- or bpPush(ps,bfSuffixDot bpPop1()))
+ bpEqKey(ps,"DOT") and (bpPrimary ps
+ and bpPush(ps,bfElt(bpPop2 ps,bpPop1 ps))
+ or bpPush(ps,bfSuffixDot bpPop1 ps))
bpApplication ps==
bpPrimary ps and bpAnyNo(ps,function bpSelector) and
(bpApplication ps and
- bpPush(ps,bfApplication(bpPop2(),bpPop1())) or true)
+ bpPush(ps,bfApplication(bpPop2 ps,bpPop1 ps)) or true)
or bpNamespace ps
++ Typing:
@@ -654,11 +655,11 @@ bpApplication ps==
++ Mapping
++ FORALL Variable DOT Typing
bpTyping ps ==
- bpEqKey "FORALL" =>
+ bpEqKey(ps,"FORALL") =>
bpRequire(ps,function bpVariable)
- (bpDot ps and bpPop1()) or bpTrap()
+ (bpDot ps and bpPop1 ps) or bpTrap()
bpRequire(ps,function bpTyping)
- bpPush(ps,%Forall(bpPop2(), bpPop1()))
+ bpPush(ps,%Forall(bpPop2 ps, bpPop1 ps))
bpMapping ps or bpSimpleMapping ps
++ Typed:
@@ -666,66 +667,66 @@ bpTyping ps ==
++ Application @ Typing
bpTyped ps ==
bpApplication ps and
- bpEqKey "COLON" =>
+ bpEqKey(ps,"COLON") =>
bpRequire(ps,function bpTyping) and
- bpPush(ps,bfTagged(bpPop2(),bpPop1()))
- bpEqKey "AT" =>
+ bpPush(ps,bfTagged(bpPop2 ps,bpPop1 ps))
+ bpEqKey(ps,"AT") =>
bpRequire(ps,function bpTyping) and
- bpPush(ps,bfRestrict(bpPop2(), bpPop1()))
+ bpPush(ps,bfRestrict(bpPop2 ps, bpPop1 ps))
true
bpExpt ps == bpRightAssoc(ps,'(POWER),function bpTyped)
bpInfKey(ps,s) ==
tokenClass $stok = "KEY" and
- symbolMember?($ttok,s) and bpPushId ps and bpNext()
+ symbolMember?($ttok,s) and bpPushId ps and bpNext ps
bpInfGeneric(ps,s) ==
- bpInfKey(ps,s) and (bpEqKey "BACKSET" or true)
+ bpInfKey(ps,s) and (bpEqKey(ps,"BACKSET") or true)
bpRightAssoc(ps,o,p)==
- a := bpState()
+ a := bpState ps
apply(p,ps,nil) =>
while bpInfGeneric(ps,o) and (bpRightAssoc(ps,o,p) or bpTrap()) repeat
- bpPush(ps,bfInfApplication(bpPop2(),bpPop2(),bpPop1()))
+ bpPush(ps,bfInfApplication(bpPop2 ps,bpPop2 ps,bpPop1 ps))
true
- bpRestore a
+ bpRestore(ps,a)
false
bpLeftAssoc(ps,operations,parser)==
apply(parser,ps,nil) =>
while bpInfGeneric(ps,operations) and bpRequire(ps,parser)
repeat
- bpPush(ps,bfInfApplication(bpPop2(),bpPop2(),bpPop1()))
+ bpPush(ps,bfInfApplication(bpPop2 ps,bpPop2 ps,bpPop1 ps))
true
false
bpString ps ==
tokenClass $stok = "STRING" and
- bpPush(ps,quote makeSymbol $ttok) and bpNext()
+ bpPush(ps,quote makeSymbol $ttok) and bpNext ps
bpFunction ps ==
- bpEqKey "FUNCTION" and bpRequire(ps,function bpPrimary1)
- and bpPush(ps,bfFunction bpPop1())
+ bpEqKey(ps,"FUNCTION") and bpRequire(ps,function bpPrimary1)
+ and bpPush(ps,bfFunction bpPop1 ps)
bpThetaName ps ==
tokenClass $stok = "ID" and $ttok has SHOETHETA =>
bpPushId ps
- bpNext()
+ bpNext ps
false
bpReduceOperator ps ==
bpInfixOperator ps or bpString ps or bpThetaName ps
-bpReduce ps==
- a := bpState()
- bpReduceOperator ps and bpEqKey "SLASH" =>
+bpReduce ps ==
+ a := bpState ps
+ bpReduceOperator ps and bpEqKey(ps,"SLASH") =>
bpEqPeek "OBRACK" =>
bpRequire(ps,function bpDConstruct) and
- bpPush(ps,bfReduceCollect(bpPop2(),bpPop1()))
+ bpPush(ps,bfReduceCollect(bpPop2 ps,bpPop1 ps))
bpRequire(ps,function bpApplication) and
- bpPush(ps,bfReduce(bpPop2(),bpPop1()))
- bpRestore a
+ bpPush(ps,bfReduce(bpPop2 ps,bpPop1 ps))
+ bpRestore(ps,a)
false
bpTimes ps ==
@@ -736,7 +737,7 @@ bpEuclid ps ==
bpMinus ps ==
bpInfGeneric(ps,'(MINUS)) and bpRequire(ps,function bpEuclid)
- and bpPush(ps,bfApplication(bpPop2(),bpPop1()))
+ and bpPush(ps,bfApplication(bpPop2 ps,bpPop1 ps))
or bpEuclid ps
bpArith ps ==
@@ -745,18 +746,18 @@ bpArith ps ==
bpIs ps ==
bpArith ps and
bpInfKey(ps,'(IS ISNT)) and bpRequire(ps,function bpPattern) =>
- bpPush(ps,bfISApplication(bpPop2(),bpPop2(),bpPop1()))
- bpEqKey "HAS" and bpRequire(ps,function bpApplication) =>
- bpPush(ps,bfHas(bpPop2(), bpPop1()))
+ bpPush(ps,bfISApplication(bpPop2 ps,bpPop2 ps,bpPop1 ps))
+ bpEqKey(ps,"HAS") and bpRequire(ps,function bpApplication) =>
+ bpPush(ps,bfHas(bpPop2 ps, bpPop1 ps))
true
bpBracketConstruct(ps,f)==
- bpBracket(ps,f) and bpPush(ps,bfConstruct bpPop1())
+ bpBracket(ps,f) and bpPush(ps,bfConstruct bpPop1 ps)
bpCompare ps ==
bpIs ps and (bpInfKey(ps,'(SHOEEQ SHOENE LT LE GT GE IN))
and bpRequire(ps,function bpIs)
- and bpPush(ps,bfInfApplication(bpPop2(),bpPop2(),bpPop1()))
+ and bpPush(ps,bfInfApplication(bpPop2 ps,bpPop2 ps,bpPop1 ps))
or true)
or bpLeave ps
or bpThrow ps
@@ -765,69 +766,69 @@ bpAnd ps ==
bpLeftAssoc(ps,'(AND),function bpCompare)
bpThrow ps ==
- bpEqKey "THROW" and bpApplication ps =>
+ bpEqKey(ps,"THROW") and bpApplication ps =>
-- Allow user-supplied matching type tag
- if bpEqKey "COLON" then
+ if bpEqKey(ps,"COLON") then
bpRequire(ps,function bpApplication)
- bpPush(ps,%Pretend(bpPop2(),bpPop1()))
- bpPush(ps,bfThrow bpPop1())
+ bpPush(ps,%Pretend(bpPop2 ps,bpPop1 ps))
+ bpPush(ps,bfThrow bpPop1 ps)
nil
++ Try:
++ try Assign CatchItems
bpTry ps ==
- bpEqKey "TRY" =>
+ bpEqKey(ps,"TRY") =>
bpAssign ps
cs := []
- while bpHandler "CATCH" repeat
+ while bpHandler(ps,"CATCH") repeat
bpCatchItem ps
- cs := [bpPop1(),:cs]
- bpHandler "FINALLY" =>
+ cs := [bpPop1 ps,:cs]
+ bpHandler(ps,"FINALLY") =>
bpFinally ps and
- bpPush(ps,bfTry(bpPop2(),reverse! [bpPop1(),:cs]))
+ bpPush(ps,bfTry(bpPop2 ps,reverse! [bpPop1 ps,:cs]))
cs = nil => bpTrap() -- missing handlers
- bpPush(ps,bfTry(bpPop1(),reverse! cs))
+ bpPush(ps,bfTry(bpPop1 ps,reverse! cs))
nil
bpCatchItem ps ==
bpRequire(ps,function bpExceptionVariable) and
- (bpEqKey "EXIT" or bpTrap()) and
+ (bpEqKey(ps,"EXIT") or bpTrap()) and
bpRequire(ps,function bpAssign) and
- bpPush(ps,%Catch(bpPop2(),bpPop1()))
+ bpPush(ps,%Catch(bpPop2 ps,bpPop1 ps))
bpExceptionVariable ps ==
t := $stok
- bpEqKey "OPAREN" and
+ bpEqKey(ps,"OPAREN") and
bpRequire(ps,function bpSignature) and
- (bpEqKey "CPAREN" or bpMissing t)
+ (bpEqKey(ps,"CPAREN") or bpMissing t)
or bpTrap()
bpFinally ps ==
bpRequire(ps,function bpAssign) and
- bpPush(ps,%Finally bpPop1())
+ bpPush(ps,%Finally bpPop1 ps)
-bpHandler key ==
- s := bpState()
- (bpEqKey "BACKSET" or bpEqKey "SEMICOLON") and bpEqKey key => true
- bpRestore s
+bpHandler(ps,key) ==
+ s := bpState ps
+ (bpEqKey(ps,"BACKSET") or bpEqKey(ps,"SEMICOLON")) and bpEqKey(ps,key) => true
+ bpRestore(ps,s)
false
++ Leave:
++ LEAVE Logical
bpLeave ps ==
- bpEqKey "LEAVE" and bpRequire(ps,function bpLogical) and
- bpPush(ps,bfLeave bpPop1())
+ bpEqKey(ps,"LEAVE") and bpRequire(ps,function bpLogical) and
+ bpPush(ps,bfLeave bpPop1 ps)
++ Do:
++ IN Namespace Do
++ DO Assign
bpDo ps ==
- bpEqKey "IN" =>
+ bpEqKey(ps,"IN") =>
bpRequire(ps,function bpNamespace)
bpRequire(ps,function bpDo)
- bpPush(ps,bfAtScope(bpPop2(),bpPop1()))
- bpEqKey "DO" and bpRequire(ps,function bpAssign) and
- bpPush(ps,bfDo bpPop1())
+ bpPush(ps,bfAtScope(bpPop2 ps,bpPop1 ps))
+ bpEqKey(ps,"DO") and bpRequire(ps,function bpAssign) and
+ bpPush(ps,bfDo bpPop1 ps)
++ Return:
++ RETURN Assign
@@ -835,8 +836,8 @@ bpDo ps ==
++ Throw
++ And
bpReturn ps==
- (bpEqKey "RETURN" and bpRequire(ps,function bpAssign) and
- bpPush(ps,bfReturnNoName bpPop1()))
+ (bpEqKey(ps,"RETURN") and bpRequire(ps,function bpAssign) and
+ bpPush(ps,bfReturnNoName bpPop1 ps))
or bpLeave ps
or bpThrow ps
or bpAnd ps
@@ -847,8 +848,8 @@ bpLogical ps ==
bpLeftAssoc(ps,'(OR),function bpReturn)
bpExpression ps ==
- bpEqKey "COLON" and (bpLogical ps and
- bpPush(ps,bfApplication ("COLON",bpPop1()))
+ bpEqKey(ps,"COLON") and (bpLogical ps and
+ bpPush(ps,bfApplication ("COLON",bpPop1 ps))
or bpTrap()) or bpLogical ps
bpStatement ps ==
@@ -858,12 +859,12 @@ bpStatement ps ==
bpLoop ps ==
bpIterators ps and
- (bpCompMissing "REPEAT" and
+ (bpCompMissing(ps,"REPEAT") and
bpRequire(ps,function bpWhere) and
- bpPush(ps,bfLp(bpPop2(),bpPop1())))
+ bpPush(ps,bfLp(bpPop2 ps,bpPop1 ps)))
or
- bpEqKey "REPEAT" and bpRequire(ps,function bpLogical) and
- bpPush(ps,bfLoop1 bpPop1())
+ bpEqKey(ps,"REPEAT") and bpRequire(ps,function bpLogical) and
+ bpPush(ps,bfLoop1 bpPop1 ps)
bpSuchThat ps ==
bpAndOr(ps,"BAR",function bpWhere,function bfSuchthat)
@@ -878,88 +879,88 @@ bpFormal ps ==
bpVariable ps or bpDot ps
bpForIn ps ==
- bpEqKey "FOR" and bpRequire(ps,function bpFormal) and (bpCompMissing "IN")
+ bpEqKey(ps,"FOR") and bpRequire(ps,function bpFormal) and (bpCompMissing(ps,"IN"))
and (bpRequire(ps,function bpSeg) and
- (bpEqKey "BY" and bpRequire(ps,function bpArith) and
- bpPush(ps,bfForInBy(bpPop3(),bpPop2(),bpPop1()))) or
- bpPush(ps,bfForin(bpPop2(),bpPop1())))
+ (bpEqKey(ps,"BY") and bpRequire(ps,function bpArith) and
+ bpPush(ps,bfForInBy(bpPop3 ps,bpPop2 ps,bpPop1 ps))) or
+ bpPush(ps,bfForin(bpPop2 ps,bpPop1 ps)))
bpSeg ps ==
bpArith ps and
- (bpEqKey "SEG" and
- (bpArith ps and bpPush(ps,bfSegment2(bpPop2(),bpPop1()))
- or bpPush(ps,bfSegment1(bpPop1()))) or true)
+ (bpEqKey(ps,"SEG") and
+ (bpArith ps and bpPush(ps,bfSegment2(bpPop2 ps,bpPop1 ps))
+ or bpPush(ps,bfSegment1(bpPop1 ps))) or true)
bpIterator ps ==
bpForIn ps or bpSuchThat ps or bpWhile ps or bpUntil ps
bpIteratorList ps ==
bpOneOrMore(ps,function bpIterator)
- and bpPush(ps,bfIterators bpPop1())
+ and bpPush(ps,bfIterators bpPop1 ps)
bpCrossBackSet ps ==
- bpEqKey "CROSS" and (bpEqKey "BACKSET" or true)
+ bpEqKey(ps,"CROSS") and (bpEqKey(ps,"BACKSET") or true)
bpIterators ps ==
bpListofFun(ps,function bpIteratorList,
function bpCrossBackSet,function bfCross)
bpAssign ps ==
- a := bpState()
+ a := bpState ps
bpStatement ps =>
bpEqPeek "BEC" =>
- bpRestore a
+ bpRestore(ps,a)
bpRequire(ps,function bpAssignment)
bpEqPeek "GIVES" =>
- bpRestore a
+ bpRestore(ps,a)
bpRequire(ps,function bpLambda)
bpEqPeek "LARROW" =>
- bpRestore a
+ bpRestore(ps,a)
bpRequire(ps,function bpKeyArg)
true
- bpRestore a
+ bpRestore(ps,a)
false
bpAssignment ps ==
bpAssignVariable ps and
- bpEqKey "BEC" and
+ bpEqKey(ps,"BEC") and
bpRequire(ps,function bpAssign) and
- bpPush(ps,bfAssign(bpPop2(),bpPop1()))
+ bpPush(ps,bfAssign(bpPop2 ps,bpPop1 ps))
++ Parse a lambda expression
++ Lambda ::= Variable +-> Assign
bpLambda ps ==
bpVariable ps and
- bpEqKey "GIVES" and
+ bpEqKey(ps,"GIVES") and
bpRequire(ps,function bpAssign) and
- bpPush(ps,bfLambda(bpPop2(),bpPop1()))
+ bpPush(ps,bfLambda(bpPop2 ps,bpPop1 ps))
bpKeyArg ps ==
- bpName ps and bpEqKey "LARROW" and bpLogical ps and
- bpPush(ps,bfKeyArg(bpPop2(),bpPop1()))
+ bpName ps and bpEqKey(ps,"LARROW") and bpLogical ps and
+ bpPush(ps,bfKeyArg(bpPop2 ps,bpPop1 ps))
-- should only be allowed in sequences
bpExit ps ==
- bpAssign ps and (bpEqKey "EXIT" and
+ bpAssign ps and (bpEqKey(ps,"EXIT") and
(bpRequire(ps,function bpWhere) and
- bpPush(ps,bfExit(bpPop2(),bpPop1())))
+ bpPush(ps,bfExit(bpPop2 ps,bpPop1 ps)))
or true)
bpDefinition ps ==
- bpEqKey "MACRO" =>
+ bpEqKey(ps,"MACRO") =>
bpName ps and bpStoreName() and
bpCompoundDefinitionTail(ps,function %Macro)
or bpTrap()
- a := bpState()
+ a := bpState ps
bpExit ps =>
bpEqPeek "DEF" =>
- bpRestore a
+ bpRestore(ps,a)
bpDef ps
bpEqPeek "TDEF" =>
- bpRestore a
+ bpRestore(ps,a)
bpTypeAliasDefition ps
true
- bpRestore a
+ bpRestore(ps,a)
false
bpStoreName()==
@@ -977,15 +978,15 @@ bpDDef ps ==
++ Parse the remaining of a simple definition.
bpSimpleDefinitionTail ps ==
- bpEqKey "DEF" and
+ bpEqKey(ps,"DEF") and
bpRequire(ps,function bpWhere)
- and bpPush(ps,%ConstantDefinition(bpPop2(), bpPop1()))
+ and bpPush(ps,%ConstantDefinition(bpPop2 ps, bpPop1 ps))
++ Parse the remaining of a compound definition.
bpCompoundDefinitionTail(ps,f) ==
bpVariable ps and
- bpEqKey "DEF" and bpRequire(ps,function bpWhere) and
- bpPush(ps,apply(f,[bpPop3(),bpPop2(),bpPop1()]))
+ bpEqKey(ps,"DEF") and bpRequire(ps,function bpWhere) and
+ bpPush(ps,apply(f,[bpPop3 ps,bpPop2 ps,bpPop1 ps]))
++ Parse the remainding of a definition. When we reach this point
@@ -997,22 +998,22 @@ bpDefTail(ps,f) ==
bpWhere ps ==
bpDefinition ps and
- (bpEqKey "WHERE" and bpRequire(ps,function bpDefinitionItem)
- and bpPush(ps,bfWhere(bpPop1(),bpPop1())) or true)
+ (bpEqKey(ps,"WHERE") and bpRequire(ps,function bpDefinitionItem)
+ and bpPush(ps,bfWhere(bpPop1 ps,bpPop1 ps)) or true)
bpDefinitionItem ps ==
- a := bpState()
+ a := bpState ps
bpDDef ps => true
- bpRestore a
+ bpRestore(ps,a)
bpBDefinitionPileItems ps => true
- bpRestore a
+ bpRestore(ps,a)
bpPDefinitionItems ps => true
- bpRestore a
+ bpRestore(ps,a)
bpWhere ps
bpDefinitionPileItems ps ==
bpListAndRecover(ps,function bpDefinitionItem)
- and bpPush(ps,%Pile bpPop1())
+ and bpPush(ps,%Pile bpPop1 ps)
bpBDefinitionPileItems ps ==
bpPileBracketed(ps,function bpDefinitionPileItems)
@@ -1030,7 +1031,7 @@ bpTuple(ps,p) ==
bpListofFun(ps,p,function bpCommaBackSet,function bfTuple)
bpCommaBackSet ps ==
- bpEqKey "COMMA" and (bpEqKey "BACKSET" or true)
+ bpEqKey(ps,"COMMA") and (bpEqKey(ps,"BACKSET") or true)
bpSemiColon ps ==
bpSemiListing(ps,function bpComma,function bfSequence)
@@ -1039,19 +1040,19 @@ bpSemiListing(ps,p,f) ==
bpListofFun(ps,p,function bpSemiBackSet,f)
bpSemiBackSet ps ==
- bpEqKey "SEMICOLON" and (bpEqKey "BACKSET" or true)
+ bpEqKey(ps,"SEMICOLON") and (bpEqKey(ps,"BACKSET") or true)
bpPDefinition ps ==
bpIndentParenthesized(ps,function bpSemiColon)
bpPileItems ps ==
- bpListAndRecover(ps,function bpSemiColon) and bpPush(ps,bfSequence bpPop1())
+ bpListAndRecover(ps,function bpSemiColon) and bpPush(ps,bfSequence bpPop1 ps)
bpBPileDefinition ps ==
bpPileBracketed(ps,function bpPileItems)
bpIteratorTail ps ==
- (bpEqKey "REPEAT" or true) and bpIterators ps
+ (bpEqKey(ps,"REPEAT") or true) and bpIterators ps
bpConstruct ps ==
bpBracket(ps,function bpConstruction)
@@ -1059,8 +1060,8 @@ bpConstruct ps ==
bpConstruction ps==
bpComma ps and
(bpIteratorTail ps and
- bpPush(ps,bfCollect(bpPop2(),bpPop1())) or
- bpPush(ps,bfTupleConstruct bpPop1()))
+ bpPush(ps,bfCollect(bpPop2 ps,bpPop1 ps)) or
+ bpPush(ps,bfTupleConstruct bpPop1 ps))
bpDConstruct ps ==
bpBracket(ps,function bpDConstruction)
@@ -1068,8 +1069,8 @@ bpDConstruct ps ==
bpDConstruction ps ==
bpComma ps and
(bpIteratorTail ps and
- bpPush(ps,bfDCollect(bpPop2(),bpPop1())) or
- bpPush(ps,bfDTuple bpPop1()))
+ bpPush(ps,bfDCollect(bpPop2 ps,bpPop1 ps)) or
+ bpPush(ps,bfDTuple bpPop1 ps))
@@ -1080,46 +1081,46 @@ bpPattern ps ==
or bpChar ps or bpName ps or bpConstTok ps
bpEqual ps ==
- bpEqKey "SHOEEQ" and (bpApplication ps or bpConstTok ps or
- bpTrap()) and bpPush(ps,bfEqual bpPop1())
+ bpEqKey(ps,"SHOEEQ") and (bpApplication ps or bpConstTok ps or
+ bpTrap()) and bpPush(ps,bfEqual bpPop1 ps)
bpRegularPatternItem ps ==
bpEqual ps or
bpConstTok ps or bpDot ps or
bpName ps and
- ((bpEqKey "BEC" and bpRequire(ps,function bpPattern)
- and bpPush(ps,bfAssign(bpPop2(),bpPop1()))) or true)
+ ((bpEqKey(ps,"BEC") and bpRequire(ps,function bpPattern)
+ and bpPush(ps,bfAssign(bpPop2 ps,bpPop1 ps))) or true)
or bpBracketConstruct(ps,function bpPatternL)
bpRegularPatternItemL ps ==
- bpRegularPatternItem ps and bpPush(ps,[bpPop1()])
+ bpRegularPatternItem ps and bpPush(ps,[bpPop1 ps])
bpRegularList ps ==
bpListof(ps,function bpRegularPatternItemL,"COMMA",function bfAppend)
bpPatternColon ps ==
- bpEqKey "COLON" and bpRequire(ps,function bpRegularPatternItem)
- and bpPush(ps,[bfColon bpPop1()])
+ bpEqKey(ps,"COLON") and bpRequire(ps,function bpRegularPatternItem)
+ and bpPush(ps,[bfColon bpPop1 ps])
-- only one colon
bpPatternL ps ==
- bpPatternList ps and bpPush(ps,bfTuple bpPop1())
+ bpPatternList ps and bpPush(ps,bfTuple bpPop1 ps)
bpPatternList ps ==
bpRegularPatternItemL ps =>
- while (bpEqKey "COMMA" and (bpRegularPatternItemL ps or
+ while (bpEqKey(ps,"COMMA") and (bpRegularPatternItemL ps or
(bpPatternTail ps
- and bpPush(ps,append(bpPop2(),bpPop1()))
+ and bpPush(ps,append(bpPop2 ps,bpPop1 ps))
or bpTrap();false) )) repeat
- bpPush(ps,append(bpPop2(),bpPop1()))
+ bpPush(ps,append(bpPop2 ps,bpPop1 ps))
true
bpPatternTail ps
bpPatternTail ps ==
bpPatternColon ps and
- (bpEqKey "COMMA" and bpRequire(ps,function bpRegularList)
- and bpPush(ps,append(bpPop2(),bpPop1())) or true)
+ (bpEqKey(ps,"COMMA") and bpRequire(ps,function bpRegularList)
+ and bpPush(ps,append(bpPop2 ps,bpPop1 ps)) or true)
-- BOUND VARIABLE
@@ -1129,14 +1130,14 @@ bpPatternTail ps ==
++ a form with a specific pattern structure, or whether it has
++ a default value.
bpRegularBVItemTail ps ==
- bpEqKey "COLON" and bpRequire(ps,function bpApplication) and
- bpPush(ps,bfTagged(bpPop2(), bpPop1()))
- or bpEqKey "BEC" and bpRequire(ps,function bpPattern) and
- bpPush(ps,bfAssign(bpPop2(),bpPop1()))
- or bpEqKey "IS" and bpRequire(ps,function bpPattern) and
- bpPush(ps,bfAssign(bpPop2(),bpPop1()))
- or bpEqKey "DEF" and bpRequire(ps,function bpApplication) and
- bpPush(ps,%DefaultValue(bpPop2(), bpPop1()))
+ bpEqKey(ps,"COLON") and bpRequire(ps,function bpApplication) and
+ bpPush(ps,bfTagged(bpPop2 ps, bpPop1 ps))
+ or bpEqKey(ps,"BEC") and bpRequire(ps,function bpPattern) and
+ bpPush(ps,bfAssign(bpPop2 ps,bpPop1 ps))
+ or bpEqKey(ps,"IS") and bpRequire(ps,function bpPattern) and
+ bpPush(ps,bfAssign(bpPop2 ps,bpPop1 ps))
+ or bpEqKey(ps,"DEF") and bpRequire(ps,function bpApplication) and
+ bpPush(ps,%DefaultValue(bpPop2 ps, bpPop1 ps))
bpRegularBVItem ps ==
@@ -1147,30 +1148,30 @@ bpRegularBVItem ps ==
bpBVString ps ==
tokenClass $stok = "STRING" and
- bpPush(ps,["BVQUOTE",makeSymbol $ttok]) and bpNext()
+ bpPush(ps,["BVQUOTE",makeSymbol $ttok]) and bpNext ps
bpRegularBVItemL ps ==
- bpRegularBVItem ps and bpPush(ps,[bpPop1()])
+ bpRegularBVItem ps and bpPush(ps,[bpPop1 ps])
bpColonName ps ==
- bpEqKey "COLON" and (bpName ps or bpBVString ps or bpTrap())
+ bpEqKey(ps,"COLON") and (bpName ps or bpBVString ps or bpTrap())
-- at most one colon at end
bpBoundVariablelist ps ==
bpRegularBVItemL ps =>
- while (bpEqKey "COMMA" and (bpRegularBVItemL ps or
+ while (bpEqKey(ps,"COMMA") and (bpRegularBVItemL ps or
(bpColonName ps
- and bpPush(ps,bfColonAppend(bpPop2(),bpPop1()))
+ and bpPush(ps,bfColonAppend(bpPop2 ps,bpPop1 ps))
or bpTrap();false) )) repeat
- bpPush(ps,append(bpPop2(),bpPop1()))
+ bpPush(ps,append(bpPop2 ps,bpPop1 ps))
true
- bpColonName ps and bpPush(ps,bfColonAppend(nil,bpPop1()))
+ bpColonName ps and bpPush(ps,bfColonAppend(nil,bpPop1 ps))
bpVariable ps ==
bpParenthesized(ps,function bpBoundVariablelist) and
- bpPush(ps,bfTupleIf bpPop1())
+ bpPush(ps,bfTupleIf bpPop1 ps)
or bpBracketConstruct(ps,function bpPatternL)
or bpName ps or bpConstTok ps
@@ -1179,40 +1180,40 @@ bpAssignVariable ps ==
bpAssignLHS ps ==
not bpName ps => false
- bpEqKey "COLON" => -- variable declaration
+ bpEqKey(ps,"COLON") => -- variable declaration
bpRequire(ps,function bpApplication)
- bpPush(ps,bfLocal(bpPop2(),bpPop1()))
+ bpPush(ps,bfLocal(bpPop2 ps,bpPop1 ps))
bpArgumentList ps and
(bpEqPeek "DOT"
- or (bpEqPeek "BEC" and bpPush(ps,bfPlace bpPop1()))
+ or (bpEqPeek "BEC" and bpPush(ps,bfPlace bpPop1 ps))
or bpTrap())
- bpEqKey "DOT" => -- field path
+ bpEqKey(ps,"DOT") => -- field path
bpList(ps,function bpPrimary,"DOT") and
bpChecknull ps and
- bpPush(ps,bfTuple([bpPop2(),:bpPop1()]))
+ bpPush(ps,bfTuple([bpPop2 ps,:bpPop1 ps]))
true
bpChecknull ps ==
- a := bpPop1()
+ a := bpPop1 ps
a = nil => bpTrap()
bpPush(ps,a)
bpStruct ps ==
- bpEqKey "STRUCTURE" and
+ bpEqKey(ps,"STRUCTURE") and
bpRequire(ps,function bpName) and
- (bpEqKey "DEF" or bpTrap()) and
+ (bpEqKey(ps,"DEF") or bpTrap()) and
(bpRecord ps or bpTypeList ps) and
- bpPush(ps,%Structure(bpPop2(),bpPop1()))
+ bpPush(ps,%Structure(bpPop2 ps,bpPop1 ps))
++ Record:
++ "Record" "(" FieldList ")"
bpRecord ps ==
- s := bpState()
- bpName ps and bpPop1() is "Record" =>
+ s := bpState ps
+ bpName ps and bpPop1 ps is "Record" =>
(bpParenthesized(ps,function bpFieldList) or bpTrap()) and
bpGlobalAccessors ps and
- bpPush(ps,%Record(bfUntuple bpPop2(),bpPop1()))
- bpRestore s
+ bpPush(ps,%Record(bfUntuple bpPop2 ps,bpPop1 ps))
+ bpRestore(ps,s)
false
++ FieldList:
@@ -1222,7 +1223,7 @@ bpFieldList ps ==
bpTuple(ps,function bpSignature)
bpGlobalAccessors ps ==
- bpEqKey "WITH" =>
+ bpEqKey(ps,"WITH") =>
bpPileBracketed(ps,function bpAccessorDefinitionList) or bpTrap()
bpPush(ps,nil)
@@ -1233,9 +1234,9 @@ bpAccessorDefinitionList ps ==
++ Name DEF FieldSection
bpAccessorDefinition ps ==
bpRequire(ps,function bpName) and
- (bpEqKey "DEF" or bpTrap()) and
+ (bpEqKey(ps,"DEF") or bpTrap()) and
bpRequire(ps,function bpFieldSection) and
- bpPush(ps,%AccessorDef(bpPop2(),bpPop1()))
+ bpPush(ps,%AccessorDef(bpPop2 ps,bpPop1 ps))
++ FieldSection:
++ "(" DOT Name ")"
@@ -1243,11 +1244,11 @@ bpFieldSection ps ==
bpParenthesized(ps,function bpSelectField)
bpSelectField ps ==
- bpEqKey "DOT" and bpName ps
+ bpEqKey(ps,"DOT") and bpName ps
bpTypeList ps ==
bpPileBracketed(ps,function bpTypeItemList)
- or bpTypeItem ps and bpPush(ps,[bpPop1()])
+ or bpTypeItem ps and bpPush(ps,[bpPop1 ps])
bpTypeItem ps ==
bpTerm(ps,function bpIdList)
@@ -1258,22 +1259,22 @@ bpTypeItemList ps ==
bpTerm(ps,idListParser) ==
bpRequire(ps,function bpName) and
((bpParenthesized(ps,idListParser) and
- bpPush(ps,bfNameArgs(bpPop2(),bpPop1())))
- or bpName ps and bpPush(ps,bfNameArgs(bpPop2(),bpPop1())))
- or bpPush(ps,bfNameOnly bpPop1())
+ bpPush(ps,bfNameArgs(bpPop2 ps,bpPop1 ps)))
+ or bpName ps and bpPush(ps,bfNameArgs(bpPop2 ps,bpPop1 ps)))
+ or bpPush(ps,bfNameOnly bpPop1 ps)
bpIdList ps ==
bpTuple(ps,function bpName)
bpCase ps ==
- bpEqKey "CASE" and
+ bpEqKey(ps,"CASE") and
bpRequire(ps,function bpWhere) and
- (bpEqKey "OF" or bpMissing "OF") and
+ (bpEqKey(ps,"OF") or bpMissing "OF") and
bpPiledCaseItems ps
bpPiledCaseItems ps ==
bpPileBracketed(ps,function bpCaseItemList) and
- bpPush(ps,bfCase(bpPop2(),bpPop1()))
+ bpPush(ps,bfCase(bpPop2 ps,bpPop1 ps))
bpCaseItemList ps ==
bpListAndRecover(ps,function bpCaseItem)
@@ -1286,9 +1287,9 @@ bpCasePatternVarList ps ==
bpCaseItem ps ==
(bpTerm(ps,function bpCasePatternVarList) or bpTrap()) and
- (bpEqKey "EXIT" or bpTrap()) and
+ (bpEqKey(ps,"EXIT") or bpTrap()) and
bpRequire(ps,function bpWhere) and
- bpPush(ps,bfCaseItem(bpPop2(),bpPop1()))
+ bpPush(ps,bfCaseItem(bpPop2 ps,bpPop1 ps))
++ Main entry point into the parser module.
@@ -1296,7 +1297,7 @@ bpOutItem ps ==
$op: local := nil
$GenVarCounter: local := 0
bpRequire(ps,function bpComma)
- b := bpPop1()
+ b := bpPop1 ps
t :=
b is ["+LINE",:.] => [ b ]
b is ["L%T",l,r] and symbol? l =>
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index e876b3ba..ded828e4 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -53,7 +53,7 @@
(DEFUN |makeTranslator| (|ip|) (|mk%Translator| |ip| NIL NIL NIL NIL))
-(DEFUN |bpFirstToken| ()
+(DEFUN |bpFirstToken| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok| |$inputStream|))
(PROGN
(SETQ |$stok|
@@ -64,7 +64,7 @@
(SETQ |$ttok| (|tokenValue| |$stok|))
T))
-(DEFUN |bpFirstTok| ()
+(DEFUN |bpFirstTok| (|ps|)
(DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$ttok| |$stok| |$inputStream|))
(PROGN
(SETQ |$stok|
@@ -75,31 +75,32 @@
(SETQ |$ttok| (|tokenValue| |$stok|))
(COND
((AND (PLUSP |$bpParenCount|) (EQ (|tokenClass| |$stok|) 'KEY))
- (COND ((EQ |$ttok| 'SETTAB) (SETQ |$bpCount| (+ |$bpCount| 1)) (|bpNext|))
- ((EQ |$ttok| 'BACKTAB) (SETQ |$bpCount| (- |$bpCount| 1))
- (|bpNext|))
- ((EQ |$ttok| 'BACKSET) (|bpNext|)) (T T)))
+ (COND
+ ((EQ |$ttok| 'SETTAB) (SETQ |$bpCount| (+ |$bpCount| 1)) (|bpNext| |ps|))
+ ((EQ |$ttok| 'BACKTAB) (SETQ |$bpCount| (- |$bpCount| 1))
+ (|bpNext| |ps|))
+ ((EQ |$ttok| 'BACKSET) (|bpNext| |ps|)) (T T)))
(T T))))
-(DEFUN |bpNext| ()
+(DEFUN |bpNext| (|ps|)
(DECLARE (SPECIAL |$inputStream|))
- (PROGN (SETQ |$inputStream| (CDR |$inputStream|)) (|bpFirstTok|)))
+ (PROGN (SETQ |$inputStream| (CDR |$inputStream|)) (|bpFirstTok| |ps|)))
-(DEFUN |bpNextToken| ()
+(DEFUN |bpNextToken| (|ps|)
(DECLARE (SPECIAL |$inputStream|))
- (PROGN (SETQ |$inputStream| (CDR |$inputStream|)) (|bpFirstToken|)))
+ (PROGN (SETQ |$inputStream| (CDR |$inputStream|)) (|bpFirstToken| |ps|)))
(DEFUN |bpRequire| (|ps| |f|) (OR (APPLY |f| |ps| NIL) (|bpTrap|)))
-(DEFUN |bpState| ()
+(DEFUN |bpState| (|ps|)
(DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|))
(LIST |$inputStream| |$stack| |$bpParenCount| |$bpCount|))
-(DEFUN |bpRestore| (|x|)
+(DEFUN |bpRestore| (|ps| |x|)
(DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|))
(PROGN
(SETQ |$inputStream| (CAR |x|))
- (|bpFirstToken|)
+ (|bpFirstToken| |ps|)
(SETQ |$stack| (CADR |x|))
(SETQ |$bpParenCount| (CADDR |x|))
(SETQ |$bpCount| (CADDDR |x|))
@@ -113,17 +114,17 @@
(DECLARE (SPECIAL |$stack| |$ttok|))
(SETQ |$stack| (CONS (|bfReName| |$ttok|) |$stack|)))
-(DEFUN |bpPop1| ()
+(DEFUN |bpPop1| (|ps|)
(LET* (|a|)
(DECLARE (SPECIAL |$stack|))
(PROGN (SETQ |a| (CAR |$stack|)) (SETQ |$stack| (CDR |$stack|)) |a|)))
-(DEFUN |bpPop2| ()
+(DEFUN |bpPop2| (|ps|)
(LET* (|a|)
(DECLARE (SPECIAL |$stack|))
(PROGN (SETQ |a| (CADR |$stack|)) (RPLACD |$stack| (CDDR |$stack|)) |a|)))
-(DEFUN |bpPop3| ()
+(DEFUN |bpPop3| (|ps|)
(LET* (|a|)
(DECLARE (SPECIAL |$stack|))
(PROGN
@@ -140,19 +141,19 @@
(SETQ |a| |$stok|)
(COND
((|bpEqPeek| 'OPAREN) (SETQ |$bpParenCount| (+ |$bpParenCount| 1))
- (|bpNext|)
+ (|bpNext| |ps|)
(COND
- ((AND (APPLY |f| |ps| NIL) (|bpFirstTok|)
+ ((AND (APPLY |f| |ps| NIL) (|bpFirstTok| |ps|)
(OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|)))
- (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|)
+ (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken| |ps|)
(COND ((EQL |$bpCount| 0) T)
(T
(SETQ |$inputStream|
(|append| (|bpAddTokens| |$bpCount|) |$inputStream|))
- (|bpFirstToken|)
- (COND ((EQL |$bpParenCount| 0) (|bpCancel|) T) (T T)))))
+ (|bpFirstToken| |ps|)
+ (COND ((EQL |$bpParenCount| 0) (|bpCancel| |ps|) T) (T T)))))
((|bpEqPeek| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL))
- (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|) T)
+ (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken| |ps|) T)
(T (|bpParenTrap| |a|))))
(T NIL))))))
@@ -162,12 +163,12 @@
(PROGN
(SETQ |a| |$stok|)
(COND
- ((|bpEqKey| 'OPAREN)
+ ((|bpEqKey| |ps| 'OPAREN)
(COND
((AND (APPLY |f| |ps| NIL)
- (OR (|bpEqKey| 'CPAREN) (|bpParenTrap| |a|)))
+ (OR (|bpEqKey| |ps| 'CPAREN) (|bpParenTrap| |a|)))
T)
- ((|bpEqKey| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL)) T)
+ ((|bpEqKey| |ps| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL)) T)
(T (|bpParenTrap| |a|))))
(T NIL)))))
@@ -177,20 +178,22 @@
(PROGN
(SETQ |a| |$stok|)
(COND
- ((|bpEqKey| 'OBRACK)
+ ((|bpEqKey| |ps| 'OBRACK)
(COND
((AND (APPLY |f| |ps| NIL)
- (OR (|bpEqKey| 'CBRACK) (|bpBrackTrap| |a|)))
- (|bpPush| |ps| (|bfBracket| (|bpPop1|))))
- ((|bpEqKey| 'CBRACK) (|bpPush| |ps| NIL)) (T (|bpBrackTrap| |a|))))
+ (OR (|bpEqKey| |ps| 'CBRACK) (|bpBrackTrap| |a|)))
+ (|bpPush| |ps| (|bfBracket| (|bpPop1| |ps|))))
+ ((|bpEqKey| |ps| 'CBRACK) (|bpPush| |ps| NIL))
+ (T (|bpBrackTrap| |a|))))
(T NIL)))))
(DEFUN |bpPileBracketed| (|ps| |f|)
(COND
- ((|bpEqKey| 'SETTAB)
- (COND ((|bpEqKey| 'BACKTAB) T)
- ((AND (APPLY |f| |ps| NIL) (OR (|bpEqKey| 'BACKTAB) (|bpPileTrap|)))
- (|bpPush| |ps| (|bfPile| (|bpPop1|))))
+ ((|bpEqKey| |ps| 'SETTAB)
+ (COND ((|bpEqKey| |ps| 'BACKTAB) T)
+ ((AND (APPLY |f| |ps| NIL)
+ (OR (|bpEqKey| |ps| 'BACKTAB) (|bpPileTrap|)))
+ (|bpPush| |ps| (|bfPile| (|bpPop1| |ps|))))
(T NIL)))
(T NIL)))
@@ -200,16 +203,18 @@
(COND
((APPLY |f| |ps| NIL)
(COND
- ((AND (|bpEqKey| |str1|) (|bpRequire| |ps| |f|)) (SETQ |a| |$stack|)
- (SETQ |$stack| NIL)
+ ((AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|))
+ (SETQ |a| |$stack|) (SETQ |$stack| NIL)
(LOOP
(COND
- ((NOT (AND (|bpEqKey| |str1|) (|bpRequire| |ps| |f|))) (RETURN NIL))
+ ((NOT (AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|)))
+ (RETURN NIL))
(T NIL)))
(SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
(|bpPush| |ps|
(FUNCALL |g|
- (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
+ (CONS (|bpPop3| |ps|)
+ (CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))))
(T T)))
(T NIL))))
@@ -229,7 +234,8 @@
(SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
(|bpPush| |ps|
(FUNCALL |g|
- (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
+ (CONS (|bpPop3| |ps|)
+ (CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))))
(T T)))
(T NIL))))
@@ -239,15 +245,18 @@
(COND
((APPLY |f| |ps| NIL)
(COND
- ((AND (|bpEqKey| |str1|) (|bpRequire| |ps| |f|)) (SETQ |a| |$stack|)
- (SETQ |$stack| NIL)
+ ((AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|))
+ (SETQ |a| |$stack|) (SETQ |$stack| NIL)
(LOOP
(COND
- ((NOT (AND (|bpEqKey| |str1|) (|bpRequire| |ps| |f|))) (RETURN NIL))
+ ((NOT (AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|)))
+ (RETURN NIL))
(T NIL)))
(SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
- (|bpPush| |ps| (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|)))))
- (T (|bpPush| |ps| (LIST (|bpPop1|))))))
+ (|bpPush| |ps|
+ (CONS (|bpPop3| |ps|)
+ (CONS (|bpPop2| |ps|) (|bpPop1| |ps|)))))
+ (T (|bpPush| |ps| (LIST (|bpPop1| |ps|))))))
(T (|bpPush| |ps| NIL)))))
(DEFUN |bpOneOrMore| (|ps| |f|)
@@ -257,55 +266,59 @@
((APPLY |f| |ps| NIL) (SETQ |a| |$stack|) (SETQ |$stack| NIL)
(LOOP (COND ((NOT (APPLY |f| |ps| NIL)) (RETURN NIL)) (T NIL)))
(SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
- (|bpPush| |ps| (CONS (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps| (CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T NIL))))
(DEFUN |bpAnyNo| (|ps| |s|)
(PROGN (LOOP (COND ((NOT (APPLY |s| |ps| NIL)) (RETURN NIL)) (T NIL))) T))
(DEFUN |bpAndOr| (|ps| |keyword| |p| |f|)
- (AND (|bpEqKey| |keyword|) (|bpRequire| |ps| |p|)
- (|bpPush| |ps| (FUNCALL |f| (|bpPop1|)))))
+ (AND (|bpEqKey| |ps| |keyword|) (|bpRequire| |ps| |p|)
+ (|bpPush| |ps| (FUNCALL |f| (|bpPop1| |ps|)))))
(DEFUN |bpConditional| (|ps| |f|)
(COND
- ((AND (|bpEqKey| 'IF) (|bpRequire| |ps| #'|bpWhere|)
- (OR (|bpEqKey| 'BACKSET) T))
+ ((AND (|bpEqKey| |ps| 'IF) (|bpRequire| |ps| #'|bpWhere|)
+ (OR (|bpEqKey| |ps| 'BACKSET) T))
(COND
- ((|bpEqKey| 'SETTAB)
+ ((|bpEqKey| |ps| 'SETTAB)
(COND
- ((|bpEqKey| 'THEN)
- (AND (|bpRequire| |ps| |f|) (|bpElse| |ps| |f|) (|bpEqKey| 'BACKTAB)))
+ ((|bpEqKey| |ps| 'THEN)
+ (AND (|bpRequire| |ps| |f|) (|bpElse| |ps| |f|)
+ (|bpEqKey| |ps| 'BACKTAB)))
(T (|bpMissing| 'THEN))))
- ((|bpEqKey| 'THEN) (AND (|bpRequire| |ps| |f|) (|bpElse| |ps| |f|)))
+ ((|bpEqKey| |ps| 'THEN) (AND (|bpRequire| |ps| |f|) (|bpElse| |ps| |f|)))
(T (|bpMissing| '|then|))))
(T NIL)))
(DEFUN |bpElse| (|ps| |f|)
(LET* (|a|)
(PROGN
- (SETQ |a| (|bpState|))
+ (SETQ |a| (|bpState| |ps|))
(COND
- ((|bpBacksetElse|)
+ ((|bpBacksetElse| |ps|)
(AND (|bpRequire| |ps| |f|)
- (|bpPush| |ps| (|bfIf| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))
- (T (|bpRestore| |a|)
- (|bpPush| |ps| (|bfIfThenOnly| (|bpPop2|) (|bpPop1|))))))))
+ (|bpPush| |ps|
+ (|bfIf| (|bpPop3| |ps|) (|bpPop2| |ps|)
+ (|bpPop1| |ps|)))))
+ (T (|bpRestore| |ps| |a|)
+ (|bpPush| |ps| (|bfIfThenOnly| (|bpPop2| |ps|) (|bpPop1| |ps|))))))))
-(DEFUN |bpBacksetElse| ()
- (COND ((|bpEqKey| 'BACKSET) (|bpEqKey| 'ELSE)) (T (|bpEqKey| 'ELSE))))
+(DEFUN |bpBacksetElse| (|ps|)
+ (COND ((|bpEqKey| |ps| 'BACKSET) (|bpEqKey| |ps| 'ELSE))
+ (T (|bpEqKey| |ps| 'ELSE))))
(DEFUN |bpEqPeek| (|s|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(AND (EQ (|tokenClass| |$stok|) 'KEY) (EQ |s| |$ttok|)))
-(DEFUN |bpEqKey| (|s|)
+(DEFUN |bpEqKey| (|ps| |s|)
(DECLARE (SPECIAL |$ttok| |$stok|))
- (AND (EQ (|tokenClass| |$stok|) 'KEY) (EQ |s| |$ttok|) (|bpNext|)))
+ (AND (EQ (|tokenClass| |$stok|) 'KEY) (EQ |s| |$ttok|) (|bpNext| |ps|)))
-(DEFUN |bpEqKeyNextTok| (|s|)
+(DEFUN |bpEqKeyNextTok| (|ps| |s|)
(DECLARE (SPECIAL |$ttok| |$stok|))
- (AND (EQ (|tokenClass| |$stok|) 'KEY) (EQ |s| |$ttok|) (|bpNextToken|)))
+ (AND (EQ (|tokenClass| |$stok|) 'KEY) (EQ |s| |$ttok|) (|bpNextToken| |ps|)))
(DEFUN |bpPileTrap| () (|bpMissing| 'BACKTAB))
@@ -324,7 +337,7 @@
(THROW :OPEN-AXIOM-CATCH-POINT
(CONS :OPEN-AXIOM-CATCH-POINT (CONS '(|BootParserException|) 'TRAPPED)))))
-(DEFUN |bpCompMissing| (|s|) (OR (|bpEqKey| |s|) (|bpMissing| |s|)))
+(DEFUN |bpCompMissing| (|ps| |s|) (OR (|bpEqKey| |ps| |s|) (|bpMissing| |s|)))
(DEFUN |bpTrap| ()
(PROGN
@@ -336,9 +349,9 @@
(LET* (|pos2| |pos1|)
(DECLARE (SPECIAL |$stok|))
(PROGN
- (|bpFirstToken|)
+ (|bpFirstToken| |ps|)
(SETQ |pos1| (|tokenPosition| |$stok|))
- (|bpMoveTo| 0)
+ (|bpMoveTo| |ps| 0)
(SETQ |pos2| (|tokenPosition| |$stok|))
(|bpIgnoredFromTo| |pos1| |pos2|)
(|bpPush| |ps| (LIST (LIST "pile syntax error"))))))
@@ -373,7 +386,7 @@
(|bpRecoverTrap| |ps|))
((NOT |found|) (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|)
(|bpRecoverTrap| |ps|)))
- (COND ((|bpEqKey| 'BACKSET) (SETQ |c| |$inputStream|))
+ (COND ((|bpEqKey| |ps| 'BACKSET) (SETQ |c| |$inputStream|))
((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|))
(SETQ |done| T))
(T (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|)
@@ -381,39 +394,39 @@
(COND
((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|))
(SETQ |done| T))
- (T (|bpNext|) (SETQ |c| |$inputStream|)))))
- (SETQ |b| (CONS (|bpPop1|) |b|)))))
+ (T (|bpNext| |ps|) (SETQ |c| |$inputStream|)))))
+ (SETQ |b| (CONS (|bpPop1| |ps|) |b|)))))
(SETQ |$stack| |a|)
(|bpPush| |ps| (|reverse!| |b|)))))
-(DEFUN |bpMoveTo| (|n|)
+(DEFUN |bpMoveTo| (|ps| |n|)
(DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$inputStream|))
(COND ((NULL |$inputStream|) T)
((|bpEqPeek| 'BACKTAB)
(COND ((EQL |n| 0) T)
- (T (|bpNextToken|) (SETQ |$bpCount| (- |$bpCount| 1))
- (|bpMoveTo| (- |n| 1)))))
+ (T (|bpNextToken| |ps|) (SETQ |$bpCount| (- |$bpCount| 1))
+ (|bpMoveTo| |ps| (- |n| 1)))))
((|bpEqPeek| 'BACKSET)
- (COND ((EQL |n| 0) T) (T (|bpNextToken|) (|bpMoveTo| |n|))))
- ((|bpEqPeek| 'SETTAB) (|bpNextToken|) (|bpMoveTo| (+ |n| 1)))
- ((|bpEqPeek| 'OPAREN) (|bpNextToken|)
- (SETQ |$bpParenCount| (+ |$bpParenCount| 1)) (|bpMoveTo| |n|))
- ((|bpEqPeek| 'CPAREN) (|bpNextToken|)
- (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpMoveTo| |n|))
- (T (|bpNextToken|) (|bpMoveTo| |n|))))
+ (COND ((EQL |n| 0) T) (T (|bpNextToken| |ps|) (|bpMoveTo| |ps| |n|))))
+ ((|bpEqPeek| 'SETTAB) (|bpNextToken| |ps|) (|bpMoveTo| |ps| (+ |n| 1)))
+ ((|bpEqPeek| 'OPAREN) (|bpNextToken| |ps|)
+ (SETQ |$bpParenCount| (+ |$bpParenCount| 1)) (|bpMoveTo| |ps| |n|))
+ ((|bpEqPeek| 'CPAREN) (|bpNextToken| |ps|)
+ (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpMoveTo| |ps| |n|))
+ (T (|bpNextToken| |ps|) (|bpMoveTo| |ps| |n|))))
(DEFUN |bpQualifiedName| (|ps|)
(DECLARE (SPECIAL |$stok|))
(COND
- ((|bpEqPeek| 'COLON-COLON) (|bpNext|)
- (AND (EQ (|tokenClass| |$stok|) 'ID) (|bpPushId| |ps|) (|bpNext|)
- (|bpPush| |ps| (|bfColonColon| (|bpPop2|) (|bpPop1|)))))
+ ((|bpEqPeek| 'COLON-COLON) (|bpNext| |ps|)
+ (AND (EQ (|tokenClass| |$stok|) 'ID) (|bpPushId| |ps|) (|bpNext| |ps|)
+ (|bpPush| |ps| (|bfColonColon| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(T NIL)))
(DEFUN |bpName| (|ps|)
(DECLARE (SPECIAL |$stok|))
(COND
- ((EQ (|tokenClass| |$stok|) 'ID) (|bpPushId| |ps|) (|bpNext|)
+ ((EQ (|tokenClass| |$stok|) 'ID) (|bpPushId| |ps|) (|bpNext| |ps|)
(|bpAnyNo| |ps| #'|bpQualifiedName|))
(T NIL)))
@@ -421,16 +434,16 @@
(DECLARE (SPECIAL |$ttok| |$stok|))
(COND
((|symbolMember?| (|tokenClass| |$stok|) '(INTEGER FLOAT))
- (|bpPush| |ps| |$ttok|) (|bpNext|))
+ (|bpPush| |ps| |$ttok|) (|bpNext| |ps|))
((EQ (|tokenClass| |$stok|) 'LISP)
- (AND (|bpPush| |ps| (|%Lisp| |$ttok|)) (|bpNext|)))
+ (AND (|bpPush| |ps| (|%Lisp| |$ttok|)) (|bpNext| |ps|)))
((EQ (|tokenClass| |$stok|) 'LISPEXP)
- (AND (|bpPush| |ps| |$ttok|) (|bpNext|)))
+ (AND (|bpPush| |ps| |$ttok|) (|bpNext| |ps|)))
((EQ (|tokenClass| |$stok|) 'LINE)
- (AND (|bpPush| |ps| (LIST '+LINE |$ttok|)) (|bpNext|)))
- ((|bpEqPeek| 'QUOTE) (|bpNext|)
+ (AND (|bpPush| |ps| (LIST '+LINE |$ttok|)) (|bpNext| |ps|)))
+ ((|bpEqPeek| 'QUOTE) (|bpNext| |ps|)
(AND (|bpRequire| |ps| #'|bpSexp|)
- (|bpPush| |ps| (|bfSymbol| (|bpPop1|)))))
+ (|bpPush| |ps| (|bfSymbol| (|bpPop1| |ps|)))))
(T (OR (|bpString| |ps|) (|bpFunction| |ps|)))))
(DEFUN |bpChar| (|ps|)
@@ -438,117 +451,124 @@
(DECLARE (SPECIAL |$ttok| |$stok|))
(COND
((AND (EQ (|tokenClass| |$stok|) 'ID) (EQ |$ttok| '|char|))
- (SETQ |a| (|bpState|))
+ (SETQ |a| (|bpState| |ps|))
(COND
- ((|bpApplication| |ps|) (SETQ |s| (|bpPop1|))
+ ((|bpApplication| |ps|) (SETQ |s| (|bpPop1| |ps|))
(COND
((AND (CONSP |s|) (EQ (CAR |s|) '|char|)
(PROGN
(SETQ |ISTMP#1| (CDR |s|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))))
(|bpPush| |ps| |s|))
- (T (|bpRestore| |a|) NIL)))
+ (T (|bpRestore| |ps| |a|) NIL)))
(T NIL)))
(T NIL))))
(DEFUN |bpExportItemTail| (|ps|)
(OR
- (AND (|bpEqKey| 'BEC) (|bpRequire| |ps| #'|bpAssign|)
- (|bpPush| |ps| (|%Assignment| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| |ps| 'BEC) (|bpRequire| |ps| #'|bpAssign|)
+ (|bpPush| |ps| (|%Assignment| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(|bpSimpleDefinitionTail| |ps|)))
(DEFUN |bpExportItem| (|ps|)
(LET* (|a|)
(COND ((|bpEqPeek| 'STRUCTURE) (|bpStruct| |ps|))
- (T (SETQ |a| (|bpState|))
+ (T (SETQ |a| (|bpState| |ps|))
(COND
((|bpName| |ps|)
(COND
- ((|bpEqPeek| 'COLON) (|bpRestore| |a|)
+ ((|bpEqPeek| 'COLON) (|bpRestore| |ps| |a|)
(|bpRequire| |ps| #'|bpSignature|)
(OR (|bpExportItemTail| |ps|) T))
- (T (|bpRestore| |a|) (|bpTypeAliasDefition| |ps|))))
+ (T (|bpRestore| |ps| |a|) (|bpTypeAliasDefition| |ps|))))
(T NIL))))))
(DEFUN |bpExportItemList| (|ps|) (|bpListAndRecover| |ps| #'|bpExportItem|))
(DEFUN |bpModuleInterface| (|ps|)
(COND
- ((|bpEqKey| 'WHERE)
+ ((|bpEqKey| |ps| 'WHERE)
(OR (|bpPileBracketed| |ps| #'|bpExportItemList|)
- (AND (|bpExportItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1|))))
+ (AND (|bpExportItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1| |ps|))))
(|bpTrap|)))
(T (|bpPush| |ps| NIL))))
(DEFUN |bpModuleExports| (|ps|)
(COND
((|bpParenthesized| |ps| #'|bpIdList|)
- (|bpPush| |ps| (|bfUntuple| (|bpPop1|))))
+ (|bpPush| |ps| (|bfUntuple| (|bpPop1| |ps|))))
(T (|bpPush| |ps| NIL))))
(DEFUN |bpModule| (|ps|)
(COND
- ((|bpEqKey| 'MODULE) (|bpRequire| |ps| #'|bpName|) (|bpModuleExports| |ps|)
- (|bpModuleInterface| |ps|)
- (|bpPush| |ps| (|%Module| (|bpPop3|) (|bpPop2|) (|bpPop1|))))
+ ((|bpEqKey| |ps| 'MODULE) (|bpRequire| |ps| #'|bpName|)
+ (|bpModuleExports| |ps|) (|bpModuleInterface| |ps|)
+ (|bpPush| |ps|
+ (|%Module| (|bpPop3| |ps|) (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T NIL)))
(DEFUN |bpImport| (|ps|)
(LET* (|a|)
(COND
- ((|bpEqKey| 'IMPORT)
+ ((|bpEqKey| |ps| 'IMPORT)
(COND
- ((|bpEqKey| 'NAMESPACE)
+ ((|bpEqKey| |ps| 'NAMESPACE)
(OR
(AND (|bpLeftAssoc| |ps| '(DOT) #'|bpName|)
- (|bpPush| |ps| (|%Import| (|bfNamespace| (|bpPop1|)))))
+ (|bpPush| |ps| (|%Import| (|bfNamespace| (|bpPop1| |ps|)))))
(|bpTrap|)))
- (T (SETQ |a| (|bpState|)) (|bpRequire| |ps| #'|bpName|)
+ (T (SETQ |a| (|bpState| |ps|)) (|bpRequire| |ps| #'|bpName|)
(COND
- ((|bpEqPeek| 'COLON) (|bpRestore| |a|)
+ ((|bpEqPeek| 'COLON) (|bpRestore| |ps| |a|)
(AND (|bpRequire| |ps| #'|bpSignature|)
- (OR (|bpEqKey| 'FOR) (|bpTrap|)) (|bpRequire| |ps| #'|bpName|)
- (|bpPush| |ps| (|%ImportSignature| (|bpPop1|) (|bpPop1|)))))
- (T (|bpPush| |ps| (|%Import| (|bpPop1|))))))))
+ (OR (|bpEqKey| |ps| 'FOR) (|bpTrap|))
+ (|bpRequire| |ps| #'|bpName|)
+ (|bpPush| |ps|
+ (|%ImportSignature| (|bpPop1| |ps|)
+ (|bpPop1| |ps|)))))
+ (T (|bpPush| |ps| (|%Import| (|bpPop1| |ps|))))))))
(T NIL))))
(DEFUN |bpNamespace| (|ps|)
- (AND (|bpEqKey| 'NAMESPACE) (OR (|bpName| |ps|) (|bpDot| |ps|))
- (|bpPush| |ps| (|bfNamespace| (|bpPop1|)))))
+ (AND (|bpEqKey| |ps| 'NAMESPACE) (OR (|bpName| |ps|) (|bpDot| |ps|))
+ (|bpPush| |ps| (|bfNamespace| (|bpPop1| |ps|)))))
(DEFUN |bpTypeAliasDefition| (|ps|)
- (AND (OR (|bpTerm| |ps| #'|bpIdList|) (|bpTrap|)) (|bpEqKey| 'TDEF)
- (|bpLogical| |ps|) (|bpPush| |ps| (|%TypeAlias| (|bpPop2|) (|bpPop1|)))))
+ (AND (OR (|bpTerm| |ps| #'|bpIdList|) (|bpTrap|)) (|bpEqKey| |ps| 'TDEF)
+ (|bpLogical| |ps|)
+ (|bpPush| |ps| (|%TypeAlias| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpSignature| (|ps|)
- (AND (|bpName| |ps|) (|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpTyping|)
- (|bpPush| |ps| (|%Signature| (|bpPop2|) (|bpPop1|)))))
+ (AND (|bpName| |ps|) (|bpEqKey| |ps| 'COLON) (|bpRequire| |ps| #'|bpTyping|)
+ (|bpPush| |ps| (|%Signature| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpSimpleMapping| (|ps|)
(COND
((|bpApplication| |ps|)
- (AND (|bpEqKey| 'ARROW) (|bpRequire| |ps| #'|bpApplication|)
- (|bpPush| |ps| (|%Mapping| (|bpPop1|) (LIST (|bpPop1|)))))
+ (AND (|bpEqKey| |ps| 'ARROW) (|bpRequire| |ps| #'|bpApplication|)
+ (|bpPush| |ps| (|%Mapping| (|bpPop1| |ps|) (LIST (|bpPop1| |ps|)))))
T)
(T NIL)))
(DEFUN |bpArgtypeList| (|ps|) (|bpTuple| |ps| #'|bpSimpleMapping|))
(DEFUN |bpMapping| (|ps|)
- (AND (|bpParenthesized| |ps| #'|bpArgtypeList|) (|bpEqKey| 'ARROW)
+ (AND (|bpParenthesized| |ps| #'|bpArgtypeList|) (|bpEqKey| |ps| 'ARROW)
(|bpApplication| |ps|)
- (|bpPush| |ps| (|%Mapping| (|bpPop1|) (|bfUntuple| (|bpPop1|))))))
+ (|bpPush| |ps|
+ (|%Mapping| (|bpPop1| |ps|) (|bfUntuple| (|bpPop1| |ps|))))))
-(DEFUN |bpCancel| ()
+(DEFUN |bpCancel| (|ps|)
(LET* (|a|)
(PROGN
- (SETQ |a| (|bpState|))
+ (SETQ |a| (|bpState| |ps|))
(COND
- ((|bpEqKeyNextTok| 'SETTAB)
+ ((|bpEqKeyNextTok| |ps| 'SETTAB)
(COND
- ((|bpCancel|)
- (COND ((|bpEqKeyNextTok| 'BACKTAB) T) (T (|bpRestore| |a|) NIL)))
- ((|bpEqKeyNextTok| 'BACKTAB) T) (T (|bpRestore| |a|) NIL)))
+ ((|bpCancel| |ps|)
+ (COND ((|bpEqKeyNextTok| |ps| 'BACKTAB) T)
+ (T (|bpRestore| |ps| |a|) NIL)))
+ ((|bpEqKeyNextTok| |ps| 'BACKTAB) T) (T (|bpRestore| |ps| |a|) NIL)))
(T NIL)))))
(DEFUN |bpAddTokens| (|n|)
@@ -572,32 +592,35 @@
(COND
((AND (EQ (|tokenClass| |$stok|) 'KEY) (NOT (|bpExceptions|)))
(SETQ |a| (GET |$ttok| 'SHOEINF))
- (COND ((NULL |a|) (AND (|bpPush| |ps| (|keywordId| |$ttok|)) (|bpNext|)))
- (T (AND (|bpPush| |ps| |a|) (|bpNext|)))))
+ (COND
+ ((NULL |a|) (AND (|bpPush| |ps| (|keywordId| |$ttok|)) (|bpNext| |ps|)))
+ (T (AND (|bpPush| |ps| |a|) (|bpNext| |ps|)))))
(T NIL))))
(DEFUN |bpAnyId| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(OR
- (AND (|bpEqKey| 'MINUS) (OR (EQ (|tokenClass| |$stok|) 'INTEGER) (|bpTrap|))
- (|bpPush| |ps| (- |$ttok|)) (|bpNext|))
+ (AND (|bpEqKey| |ps| 'MINUS)
+ (OR (EQ (|tokenClass| |$stok|) 'INTEGER) (|bpTrap|))
+ (|bpPush| |ps| (- |$ttok|)) (|bpNext| |ps|))
(|bpSexpKey| |ps|)
(AND (|symbolMember?| (|tokenClass| |$stok|) '(ID INTEGER STRING FLOAT))
- (|bpPush| |ps| |$ttok|) (|bpNext|))))
+ (|bpPush| |ps| |$ttok|) (|bpNext| |ps|))))
(DEFUN |bpSexp| (|ps|)
(OR (|bpAnyId| |ps|)
- (AND (|bpEqKey| 'QUOTE) (|bpRequire| |ps| #'|bpSexp|)
- (|bpPush| |ps| (|bfSymbol| (|bpPop1|))))
+ (AND (|bpEqKey| |ps| 'QUOTE) (|bpRequire| |ps| #'|bpSexp|)
+ (|bpPush| |ps| (|bfSymbol| (|bpPop1| |ps|))))
(|bpIndentParenthesized| |ps| #'|bpSexp1|)))
(DEFUN |bpSexp1| (|ps|)
(OR
- (AND (|bpFirstTok|) (|bpSexp| |ps|)
+ (AND (|bpFirstTok| |ps|) (|bpSexp| |ps|)
(OR
- (AND (|bpEqKey| 'DOT) (|bpSexp| |ps|)
- (|bpPush| |ps| (CONS (|bpPop2|) (|bpPop1|))))
- (AND (|bpSexp1| |ps|) (|bpPush| |ps| (CONS (|bpPop2|) (|bpPop1|))))))
+ (AND (|bpEqKey| |ps| 'DOT) (|bpSexp| |ps|)
+ (|bpPush| |ps| (CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))
+ (AND (|bpSexp1| |ps|)
+ (|bpPush| |ps| (CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))))
(|bpPush| |ps| NIL)))
(DEFUN |bpPrimary1| (|ps|)
@@ -610,56 +633,57 @@
(DEFUN |bpArgumentList| (|ps|)
(AND (|bpPDefinition| |ps|)
- (|bpPush| |ps| (|bfApplication| (|bpPop2|) (|bpPop1|)))))
+ (|bpPush| |ps| (|bfApplication| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpPrimary| (|ps|)
- (AND (|bpFirstTok|) (OR (|bpPrimary1| |ps|) (|bpPrefixOperator| |ps|))))
+ (AND (|bpFirstTok| |ps|) (OR (|bpPrimary1| |ps|) (|bpPrefixOperator| |ps|))))
-(DEFUN |bpDot| (|ps|) (AND (|bpEqKey| 'DOT) (|bpPush| |ps| (|bfDot|))))
+(DEFUN |bpDot| (|ps|) (AND (|bpEqKey| |ps| 'DOT) (|bpPush| |ps| (|bfDot|))))
(DEFUN |bpPrefixOperator| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(AND (EQ (|tokenClass| |$stok|) 'KEY) (GET |$ttok| 'SHOEPRE)
- (|bpPushId| |ps|) (|bpNext|)))
+ (|bpPushId| |ps|) (|bpNext| |ps|)))
(DEFUN |bpInfixOperator| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(AND (EQ (|tokenClass| |$stok|) 'KEY) (GET |$ttok| 'SHOEINF)
- (|bpPushId| |ps|) (|bpNext|)))
+ (|bpPushId| |ps|) (|bpNext| |ps|)))
(DEFUN |bpSelector| (|ps|)
- (AND (|bpEqKey| 'DOT)
+ (AND (|bpEqKey| |ps| 'DOT)
(OR
(AND (|bpPrimary| |ps|)
- (|bpPush| |ps| (|bfElt| (|bpPop2|) (|bpPop1|))))
- (|bpPush| |ps| (|bfSuffixDot| (|bpPop1|))))))
+ (|bpPush| |ps| (|bfElt| (|bpPop2| |ps|) (|bpPop1| |ps|))))
+ (|bpPush| |ps| (|bfSuffixDot| (|bpPop1| |ps|))))))
(DEFUN |bpApplication| (|ps|)
(OR
(AND (|bpPrimary| |ps|) (|bpAnyNo| |ps| #'|bpSelector|)
(OR
(AND (|bpApplication| |ps|)
- (|bpPush| |ps| (|bfApplication| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps|
+ (|bfApplication| (|bpPop2| |ps|) (|bpPop1| |ps|))))
T))
(|bpNamespace| |ps|)))
(DEFUN |bpTyping| (|ps|)
(COND
- ((|bpEqKey| 'FORALL) (|bpRequire| |ps| #'|bpVariable|)
- (OR (AND (|bpDot| |ps|) (|bpPop1|)) (|bpTrap|))
+ ((|bpEqKey| |ps| 'FORALL) (|bpRequire| |ps| #'|bpVariable|)
+ (OR (AND (|bpDot| |ps|) (|bpPop1| |ps|)) (|bpTrap|))
(|bpRequire| |ps| #'|bpTyping|)
- (|bpPush| |ps| (|%Forall| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps| (|%Forall| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T (OR (|bpMapping| |ps|) (|bpSimpleMapping| |ps|)))))
(DEFUN |bpTyped| (|ps|)
(AND (|bpApplication| |ps|)
(COND
- ((|bpEqKey| 'COLON)
+ ((|bpEqKey| |ps| 'COLON)
(AND (|bpRequire| |ps| #'|bpTyping|)
- (|bpPush| |ps| (|bfTagged| (|bpPop2|) (|bpPop1|)))))
- ((|bpEqKey| 'AT)
+ (|bpPush| |ps| (|bfTagged| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
+ ((|bpEqKey| |ps| 'AT)
(AND (|bpRequire| |ps| #'|bpTyping|)
- (|bpPush| |ps| (|bfRestrict| (|bpPop2|) (|bpPop1|)))))
+ (|bpPush| |ps| (|bfRestrict| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(T T))))
(DEFUN |bpExpt| (|ps|) (|bpRightAssoc| |ps| '(POWER) #'|bpTyped|))
@@ -667,15 +691,15 @@
(DEFUN |bpInfKey| (|ps| |s|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(AND (EQ (|tokenClass| |$stok|) 'KEY) (|symbolMember?| |$ttok| |s|)
- (|bpPushId| |ps|) (|bpNext|)))
+ (|bpPushId| |ps|) (|bpNext| |ps|)))
(DEFUN |bpInfGeneric| (|ps| |s|)
- (AND (|bpInfKey| |ps| |s|) (OR (|bpEqKey| 'BACKSET) T)))
+ (AND (|bpInfKey| |ps| |s|) (OR (|bpEqKey| |ps| 'BACKSET) T)))
(DEFUN |bpRightAssoc| (|ps| |o| |p|)
(LET* (|a|)
(PROGN
- (SETQ |a| (|bpState|))
+ (SETQ |a| (|bpState| |ps|))
(COND
((APPLY |p| |ps| NIL)
(LOOP
@@ -686,9 +710,10 @@
(RETURN NIL))
(T
(|bpPush| |ps|
- (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))))
+ (|bfInfApplication| (|bpPop2| |ps|) (|bpPop2| |ps|)
+ (|bpPop1| |ps|))))))
T)
- (T (|bpRestore| |a|) NIL)))))
+ (T (|bpRestore| |ps| |a|) NIL)))))
(DEFUN |bpLeftAssoc| (|ps| |operations| |parser|)
(COND
@@ -699,24 +724,26 @@
(AND (|bpInfGeneric| |ps| |operations|) (|bpRequire| |ps| |parser|)))
(RETURN NIL))
(T
- (|bpPush| |ps| (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))))
+ (|bpPush| |ps|
+ (|bfInfApplication| (|bpPop2| |ps|) (|bpPop2| |ps|)
+ (|bpPop1| |ps|))))))
T)
(T NIL)))
(DEFUN |bpString| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(AND (EQ (|tokenClass| |$stok|) 'STRING)
- (|bpPush| |ps| (|quote| (INTERN |$ttok|))) (|bpNext|)))
+ (|bpPush| |ps| (|quote| (INTERN |$ttok|))) (|bpNext| |ps|)))
(DEFUN |bpFunction| (|ps|)
- (AND (|bpEqKey| 'FUNCTION) (|bpRequire| |ps| #'|bpPrimary1|)
- (|bpPush| |ps| (|bfFunction| (|bpPop1|)))))
+ (AND (|bpEqKey| |ps| 'FUNCTION) (|bpRequire| |ps| #'|bpPrimary1|)
+ (|bpPush| |ps| (|bfFunction| (|bpPop1| |ps|)))))
(DEFUN |bpThetaName| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(COND
((AND (EQ (|tokenClass| |$stok|) 'ID) (GET |$ttok| 'SHOETHETA))
- (|bpPushId| |ps|) (|bpNext|))
+ (|bpPushId| |ps|) (|bpNext| |ps|))
(T NIL)))
(DEFUN |bpReduceOperator| (|ps|)
@@ -725,17 +752,18 @@
(DEFUN |bpReduce| (|ps|)
(LET* (|a|)
(PROGN
- (SETQ |a| (|bpState|))
+ (SETQ |a| (|bpState| |ps|))
(COND
- ((AND (|bpReduceOperator| |ps|) (|bpEqKey| 'SLASH))
+ ((AND (|bpReduceOperator| |ps|) (|bpEqKey| |ps| 'SLASH))
(COND
((|bpEqPeek| 'OBRACK)
(AND (|bpRequire| |ps| #'|bpDConstruct|)
- (|bpPush| |ps| (|bfReduceCollect| (|bpPop2|) (|bpPop1|)))))
+ (|bpPush| |ps|
+ (|bfReduceCollect| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(T
(AND (|bpRequire| |ps| #'|bpApplication|)
- (|bpPush| |ps| (|bfReduce| (|bpPop2|) (|bpPop1|)))))))
- (T (|bpRestore| |a|) NIL)))))
+ (|bpPush| |ps| (|bfReduce| (|bpPop2| |ps|) (|bpPop1| |ps|)))))))
+ (T (|bpRestore| |ps| |a|) NIL)))))
(DEFUN |bpTimes| (|ps|)
(OR (|bpReduce| |ps|) (|bpLeftAssoc| |ps| '(TIMES SLASH) #'|bpExpt|)))
@@ -745,7 +773,7 @@
(DEFUN |bpMinus| (|ps|)
(OR
(AND (|bpInfGeneric| |ps| '(MINUS)) (|bpRequire| |ps| #'|bpEuclid|)
- (|bpPush| |ps| (|bfApplication| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps| (|bfApplication| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(|bpEuclid| |ps|)))
(DEFUN |bpArith| (|ps|) (|bpLeftAssoc| |ps| '(PLUS MINUS) #'|bpMinus|))
@@ -754,13 +782,15 @@
(AND (|bpArith| |ps|)
(COND
((AND (|bpInfKey| |ps| '(IS ISNT)) (|bpRequire| |ps| #'|bpPattern|))
- (|bpPush| |ps| (|bfISApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))
- ((AND (|bpEqKey| 'HAS) (|bpRequire| |ps| #'|bpApplication|))
- (|bpPush| |ps| (|bfHas| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps|
+ (|bfISApplication| (|bpPop2| |ps|) (|bpPop2| |ps|)
+ (|bpPop1| |ps|))))
+ ((AND (|bpEqKey| |ps| 'HAS) (|bpRequire| |ps| #'|bpApplication|))
+ (|bpPush| |ps| (|bfHas| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T T))))
(DEFUN |bpBracketConstruct| (|ps| |f|)
- (AND (|bpBracket| |ps| |f|) (|bpPush| |ps| (|bfConstruct| (|bpPop1|)))))
+ (AND (|bpBracket| |ps| |f|) (|bpPush| |ps| (|bfConstruct| (|bpPop1| |ps|)))))
(DEFUN |bpCompare| (|ps|)
(OR
@@ -769,7 +799,8 @@
(AND (|bpInfKey| |ps| '(SHOEEQ SHOENE LT LE GT GE IN))
(|bpRequire| |ps| #'|bpIs|)
(|bpPush| |ps|
- (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))
+ (|bfInfApplication| (|bpPop2| |ps|) (|bpPop2| |ps|)
+ (|bpPop1| |ps|))))
T))
(|bpLeave| |ps|) (|bpThrow| |ps|)))
@@ -777,34 +808,34 @@
(DEFUN |bpThrow| (|ps|)
(COND
- ((AND (|bpEqKey| 'THROW) (|bpApplication| |ps|))
+ ((AND (|bpEqKey| |ps| 'THROW) (|bpApplication| |ps|))
(COND
- ((|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpApplication|)
- (|bpPush| |ps| (|%Pretend| (|bpPop2|) (|bpPop1|)))))
- (|bpPush| |ps| (|bfThrow| (|bpPop1|))))
+ ((|bpEqKey| |ps| 'COLON) (|bpRequire| |ps| #'|bpApplication|)
+ (|bpPush| |ps| (|%Pretend| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
+ (|bpPush| |ps| (|bfThrow| (|bpPop1| |ps|))))
(T NIL)))
(DEFUN |bpTry| (|ps|)
(LET* (|cs|)
(COND
- ((|bpEqKey| 'TRY) (|bpAssign| |ps|) (SETQ |cs| NIL)
+ ((|bpEqKey| |ps| 'TRY) (|bpAssign| |ps|) (SETQ |cs| NIL)
(LOOP
- (COND ((NOT (|bpHandler| 'CATCH)) (RETURN NIL))
- (T (|bpCatchItem| |ps|) (SETQ |cs| (CONS (|bpPop1|) |cs|)))))
+ (COND ((NOT (|bpHandler| |ps| 'CATCH)) (RETURN NIL))
+ (T (|bpCatchItem| |ps|) (SETQ |cs| (CONS (|bpPop1| |ps|) |cs|)))))
(COND
- ((|bpHandler| 'FINALLY)
+ ((|bpHandler| |ps| 'FINALLY)
(AND (|bpFinally| |ps|)
(|bpPush| |ps|
- (|bfTry| (|bpPop2|)
- (|reverse!| (CONS (|bpPop1|) |cs|))))))
+ (|bfTry| (|bpPop2| |ps|)
+ (|reverse!| (CONS (|bpPop1| |ps|) |cs|))))))
((NULL |cs|) (|bpTrap|))
- (T (|bpPush| |ps| (|bfTry| (|bpPop1|) (|reverse!| |cs|))))))
+ (T (|bpPush| |ps| (|bfTry| (|bpPop1| |ps|) (|reverse!| |cs|))))))
(T NIL))))
(DEFUN |bpCatchItem| (|ps|)
(AND (|bpRequire| |ps| #'|bpExceptionVariable|)
- (OR (|bpEqKey| 'EXIT) (|bpTrap|)) (|bpRequire| |ps| #'|bpAssign|)
- (|bpPush| |ps| (|%Catch| (|bpPop2|) (|bpPop1|)))))
+ (OR (|bpEqKey| |ps| 'EXIT) (|bpTrap|)) (|bpRequire| |ps| #'|bpAssign|)
+ (|bpPush| |ps| (|%Catch| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpExceptionVariable| (|ps|)
(LET* (|t|)
@@ -812,49 +843,51 @@
(PROGN
(SETQ |t| |$stok|)
(OR
- (AND (|bpEqKey| 'OPAREN) (|bpRequire| |ps| #'|bpSignature|)
- (OR (|bpEqKey| 'CPAREN) (|bpMissing| |t|)))
+ (AND (|bpEqKey| |ps| 'OPAREN) (|bpRequire| |ps| #'|bpSignature|)
+ (OR (|bpEqKey| |ps| 'CPAREN) (|bpMissing| |t|)))
(|bpTrap|)))))
(DEFUN |bpFinally| (|ps|)
- (AND (|bpRequire| |ps| #'|bpAssign|) (|bpPush| |ps| (|%Finally| (|bpPop1|)))))
+ (AND (|bpRequire| |ps| #'|bpAssign|)
+ (|bpPush| |ps| (|%Finally| (|bpPop1| |ps|)))))
-(DEFUN |bpHandler| (|key|)
+(DEFUN |bpHandler| (|ps| |key|)
(LET* (|s|)
(PROGN
- (SETQ |s| (|bpState|))
+ (SETQ |s| (|bpState| |ps|))
(COND
- ((AND (OR (|bpEqKey| 'BACKSET) (|bpEqKey| 'SEMICOLON)) (|bpEqKey| |key|))
+ ((AND (OR (|bpEqKey| |ps| 'BACKSET) (|bpEqKey| |ps| 'SEMICOLON))
+ (|bpEqKey| |ps| |key|))
T)
- (T (|bpRestore| |s|) NIL)))))
+ (T (|bpRestore| |ps| |s|) NIL)))))
(DEFUN |bpLeave| (|ps|)
- (AND (|bpEqKey| 'LEAVE) (|bpRequire| |ps| #'|bpLogical|)
- (|bpPush| |ps| (|bfLeave| (|bpPop1|)))))
+ (AND (|bpEqKey| |ps| 'LEAVE) (|bpRequire| |ps| #'|bpLogical|)
+ (|bpPush| |ps| (|bfLeave| (|bpPop1| |ps|)))))
(DEFUN |bpDo| (|ps|)
(COND
- ((|bpEqKey| 'IN) (|bpRequire| |ps| #'|bpNamespace|)
+ ((|bpEqKey| |ps| 'IN) (|bpRequire| |ps| #'|bpNamespace|)
(|bpRequire| |ps| #'|bpDo|)
- (|bpPush| |ps| (|bfAtScope| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps| (|bfAtScope| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T
- (AND (|bpEqKey| 'DO) (|bpRequire| |ps| #'|bpAssign|)
- (|bpPush| |ps| (|bfDo| (|bpPop1|)))))))
+ (AND (|bpEqKey| |ps| 'DO) (|bpRequire| |ps| #'|bpAssign|)
+ (|bpPush| |ps| (|bfDo| (|bpPop1| |ps|)))))))
(DEFUN |bpReturn| (|ps|)
(OR
- (AND (|bpEqKey| 'RETURN) (|bpRequire| |ps| #'|bpAssign|)
- (|bpPush| |ps| (|bfReturnNoName| (|bpPop1|))))
+ (AND (|bpEqKey| |ps| 'RETURN) (|bpRequire| |ps| #'|bpAssign|)
+ (|bpPush| |ps| (|bfReturnNoName| (|bpPop1| |ps|))))
(|bpLeave| |ps|) (|bpThrow| |ps|) (|bpAnd| |ps|) (|bpDo| |ps|)))
(DEFUN |bpLogical| (|ps|) (|bpLeftAssoc| |ps| '(OR) #'|bpReturn|))
(DEFUN |bpExpression| (|ps|)
(OR
- (AND (|bpEqKey| 'COLON)
+ (AND (|bpEqKey| |ps| 'COLON)
(OR
(AND (|bpLogical| |ps|)
- (|bpPush| |ps| (|bfApplication| 'COLON (|bpPop1|))))
+ (|bpPush| |ps| (|bfApplication| 'COLON (|bpPop1| |ps|))))
(|bpTrap|)))
(|bpLogical| |ps|)))
@@ -864,11 +897,11 @@
(DEFUN |bpLoop| (|ps|)
(OR
- (AND (|bpIterators| |ps|) (|bpCompMissing| 'REPEAT)
+ (AND (|bpIterators| |ps|) (|bpCompMissing| |ps| 'REPEAT)
(|bpRequire| |ps| #'|bpWhere|)
- (|bpPush| |ps| (|bfLp| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'REPEAT) (|bpRequire| |ps| #'|bpLogical|)
- (|bpPush| |ps| (|bfLoop1| (|bpPop1|))))))
+ (|bpPush| |ps| (|bfLp| (|bpPop2| |ps|) (|bpPop1| |ps|))))
+ (AND (|bpEqKey| |ps| 'REPEAT) (|bpRequire| |ps| #'|bpLogical|)
+ (|bpPush| |ps| (|bfLoop1| (|bpPop1| |ps|))))))
(DEFUN |bpSuchThat| (|ps|) (|bpAndOr| |ps| 'BAR #'|bpWhere| #'|bfSuchthat|))
@@ -879,21 +912,25 @@
(DEFUN |bpFormal| (|ps|) (OR (|bpVariable| |ps|) (|bpDot| |ps|)))
(DEFUN |bpForIn| (|ps|)
- (AND (|bpEqKey| 'FOR) (|bpRequire| |ps| #'|bpFormal|) (|bpCompMissing| 'IN)
+ (AND (|bpEqKey| |ps| 'FOR) (|bpRequire| |ps| #'|bpFormal|)
+ (|bpCompMissing| |ps| 'IN)
(OR
- (AND (|bpRequire| |ps| #'|bpSeg|) (|bpEqKey| 'BY)
+ (AND (|bpRequire| |ps| #'|bpSeg|) (|bpEqKey| |ps| 'BY)
(|bpRequire| |ps| #'|bpArith|)
- (|bpPush| |ps| (|bfForInBy| (|bpPop3|) (|bpPop2|) (|bpPop1|))))
- (|bpPush| |ps| (|bfForin| (|bpPop2|) (|bpPop1|))))))
+ (|bpPush| |ps|
+ (|bfForInBy| (|bpPop3| |ps|) (|bpPop2| |ps|)
+ (|bpPop1| |ps|))))
+ (|bpPush| |ps| (|bfForin| (|bpPop2| |ps|) (|bpPop1| |ps|))))))
(DEFUN |bpSeg| (|ps|)
(AND (|bpArith| |ps|)
(OR
- (AND (|bpEqKey| 'SEG)
+ (AND (|bpEqKey| |ps| 'SEG)
(OR
(AND (|bpArith| |ps|)
- (|bpPush| |ps| (|bfSegment2| (|bpPop2|) (|bpPop1|))))
- (|bpPush| |ps| (|bfSegment1| (|bpPop1|)))))
+ (|bpPush| |ps|
+ (|bfSegment2| (|bpPop2| |ps|) (|bpPop1| |ps|))))
+ (|bpPush| |ps| (|bfSegment1| (|bpPop1| |ps|)))))
T)))
(DEFUN |bpIterator| (|ps|)
@@ -901,10 +938,10 @@
(DEFUN |bpIteratorList| (|ps|)
(AND (|bpOneOrMore| |ps| #'|bpIterator|)
- (|bpPush| |ps| (|bfIterators| (|bpPop1|)))))
+ (|bpPush| |ps| (|bfIterators| (|bpPop1| |ps|)))))
(DEFUN |bpCrossBackSet| (|ps|)
- (AND (|bpEqKey| 'CROSS) (OR (|bpEqKey| 'BACKSET) T)))
+ (AND (|bpEqKey| |ps| 'CROSS) (OR (|bpEqKey| |ps| 'BACKSET) T)))
(DEFUN |bpIterators| (|ps|)
(|bpListofFun| |ps| #'|bpIteratorList| #'|bpCrossBackSet| #'|bfCross|))
@@ -912,54 +949,56 @@
(DEFUN |bpAssign| (|ps|)
(LET* (|a|)
(PROGN
- (SETQ |a| (|bpState|))
+ (SETQ |a| (|bpState| |ps|))
(COND
((|bpStatement| |ps|)
(COND
- ((|bpEqPeek| 'BEC) (|bpRestore| |a|)
+ ((|bpEqPeek| 'BEC) (|bpRestore| |ps| |a|)
(|bpRequire| |ps| #'|bpAssignment|))
- ((|bpEqPeek| 'GIVES) (|bpRestore| |a|) (|bpRequire| |ps| #'|bpLambda|))
- ((|bpEqPeek| 'LARROW) (|bpRestore| |a|)
+ ((|bpEqPeek| 'GIVES) (|bpRestore| |ps| |a|)
+ (|bpRequire| |ps| #'|bpLambda|))
+ ((|bpEqPeek| 'LARROW) (|bpRestore| |ps| |a|)
(|bpRequire| |ps| #'|bpKeyArg|))
(T T)))
- (T (|bpRestore| |a|) NIL)))))
+ (T (|bpRestore| |ps| |a|) NIL)))))
(DEFUN |bpAssignment| (|ps|)
- (AND (|bpAssignVariable| |ps|) (|bpEqKey| 'BEC)
+ (AND (|bpAssignVariable| |ps|) (|bpEqKey| |ps| 'BEC)
(|bpRequire| |ps| #'|bpAssign|)
- (|bpPush| |ps| (|bfAssign| (|bpPop2|) (|bpPop1|)))))
+ (|bpPush| |ps| (|bfAssign| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpLambda| (|ps|)
- (AND (|bpVariable| |ps|) (|bpEqKey| 'GIVES) (|bpRequire| |ps| #'|bpAssign|)
- (|bpPush| |ps| (|bfLambda| (|bpPop2|) (|bpPop1|)))))
+ (AND (|bpVariable| |ps|) (|bpEqKey| |ps| 'GIVES)
+ (|bpRequire| |ps| #'|bpAssign|)
+ (|bpPush| |ps| (|bfLambda| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpKeyArg| (|ps|)
- (AND (|bpName| |ps|) (|bpEqKey| 'LARROW) (|bpLogical| |ps|)
- (|bpPush| |ps| (|bfKeyArg| (|bpPop2|) (|bpPop1|)))))
+ (AND (|bpName| |ps|) (|bpEqKey| |ps| 'LARROW) (|bpLogical| |ps|)
+ (|bpPush| |ps| (|bfKeyArg| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpExit| (|ps|)
(AND (|bpAssign| |ps|)
(OR
- (AND (|bpEqKey| 'EXIT) (|bpRequire| |ps| #'|bpWhere|)
- (|bpPush| |ps| (|bfExit| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| |ps| 'EXIT) (|bpRequire| |ps| #'|bpWhere|)
+ (|bpPush| |ps| (|bfExit| (|bpPop2| |ps|) (|bpPop1| |ps|))))
T)))
(DEFUN |bpDefinition| (|ps|)
(LET* (|a|)
(COND
- ((|bpEqKey| 'MACRO)
+ ((|bpEqKey| |ps| 'MACRO)
(OR
(AND (|bpName| |ps|) (|bpStoreName|)
(|bpCompoundDefinitionTail| |ps| #'|%Macro|))
(|bpTrap|)))
- (T (SETQ |a| (|bpState|))
+ (T (SETQ |a| (|bpState| |ps|))
(COND
((|bpExit| |ps|)
- (COND ((|bpEqPeek| 'DEF) (|bpRestore| |a|) (|bpDef| |ps|))
- ((|bpEqPeek| 'TDEF) (|bpRestore| |a|)
+ (COND ((|bpEqPeek| 'DEF) (|bpRestore| |ps| |a|) (|bpDef| |ps|))
+ ((|bpEqPeek| 'TDEF) (|bpRestore| |ps| |a|)
(|bpTypeAliasDefition| |ps|))
(T T)))
- (T (|bpRestore| |a|) NIL))))))
+ (T (|bpRestore| |ps| |a|) NIL))))))
(DEFUN |bpStoreName| ()
(DECLARE (SPECIAL |$typings| |$wheredefs| |$op| |$stack|))
@@ -976,12 +1015,15 @@
(DEFUN |bpDDef| (|ps|) (AND (|bpName| |ps|) (|bpDefTail| |ps| #'|%Definition|)))
(DEFUN |bpSimpleDefinitionTail| (|ps|)
- (AND (|bpEqKey| 'DEF) (|bpRequire| |ps| #'|bpWhere|)
- (|bpPush| |ps| (|%ConstantDefinition| (|bpPop2|) (|bpPop1|)))))
+ (AND (|bpEqKey| |ps| 'DEF) (|bpRequire| |ps| #'|bpWhere|)
+ (|bpPush| |ps| (|%ConstantDefinition| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpCompoundDefinitionTail| (|ps| |f|)
- (AND (|bpVariable| |ps|) (|bpEqKey| 'DEF) (|bpRequire| |ps| #'|bpWhere|)
- (|bpPush| |ps| (APPLY |f| (LIST (|bpPop3|) (|bpPop2|) (|bpPop1|))))))
+ (AND (|bpVariable| |ps|) (|bpEqKey| |ps| 'DEF) (|bpRequire| |ps| #'|bpWhere|)
+ (|bpPush| |ps|
+ (APPLY |f|
+ (LIST (|bpPop3| |ps|) (|bpPop2| |ps|)
+ (|bpPop1| |ps|))))))
(DEFUN |bpDefTail| (|ps| |f|)
(OR (|bpSimpleDefinitionTail| |ps|) (|bpCompoundDefinitionTail| |ps| |f|)))
@@ -989,24 +1031,24 @@
(DEFUN |bpWhere| (|ps|)
(AND (|bpDefinition| |ps|)
(OR
- (AND (|bpEqKey| 'WHERE) (|bpRequire| |ps| #'|bpDefinitionItem|)
- (|bpPush| |ps| (|bfWhere| (|bpPop1|) (|bpPop1|))))
+ (AND (|bpEqKey| |ps| 'WHERE) (|bpRequire| |ps| #'|bpDefinitionItem|)
+ (|bpPush| |ps| (|bfWhere| (|bpPop1| |ps|) (|bpPop1| |ps|))))
T)))
(DEFUN |bpDefinitionItem| (|ps|)
(LET* (|a|)
(PROGN
- (SETQ |a| (|bpState|))
+ (SETQ |a| (|bpState| |ps|))
(COND ((|bpDDef| |ps|) T)
- (T (|bpRestore| |a|)
+ (T (|bpRestore| |ps| |a|)
(COND ((|bpBDefinitionPileItems| |ps|) T)
- (T (|bpRestore| |a|)
+ (T (|bpRestore| |ps| |a|)
(COND ((|bpPDefinitionItems| |ps|) T)
- (T (|bpRestore| |a|) (|bpWhere| |ps|))))))))))
+ (T (|bpRestore| |ps| |a|) (|bpWhere| |ps|))))))))))
(DEFUN |bpDefinitionPileItems| (|ps|)
(AND (|bpListAndRecover| |ps| #'|bpDefinitionItem|)
- (|bpPush| |ps| (|%Pile| (|bpPop1|)))))
+ (|bpPush| |ps| (|%Pile| (|bpPop1| |ps|)))))
(DEFUN |bpBDefinitionPileItems| (|ps|)
(|bpPileBracketed| |ps| #'|bpDefinitionPileItems|))
@@ -1024,7 +1066,7 @@
(|bpListofFun| |ps| |p| #'|bpCommaBackSet| #'|bfTuple|))
(DEFUN |bpCommaBackSet| (|ps|)
- (AND (|bpEqKey| 'COMMA) (OR (|bpEqKey| 'BACKSET) T)))
+ (AND (|bpEqKey| |ps| 'COMMA) (OR (|bpEqKey| |ps| 'BACKSET) T)))
(DEFUN |bpSemiColon| (|ps|) (|bpSemiListing| |ps| #'|bpComma| #'|bfSequence|))
@@ -1032,18 +1074,18 @@
(|bpListofFun| |ps| |p| #'|bpSemiBackSet| |f|))
(DEFUN |bpSemiBackSet| (|ps|)
- (AND (|bpEqKey| 'SEMICOLON) (OR (|bpEqKey| 'BACKSET) T)))
+ (AND (|bpEqKey| |ps| 'SEMICOLON) (OR (|bpEqKey| |ps| 'BACKSET) T)))
(DEFUN |bpPDefinition| (|ps|) (|bpIndentParenthesized| |ps| #'|bpSemiColon|))
(DEFUN |bpPileItems| (|ps|)
(AND (|bpListAndRecover| |ps| #'|bpSemiColon|)
- (|bpPush| |ps| (|bfSequence| (|bpPop1|)))))
+ (|bpPush| |ps| (|bfSequence| (|bpPop1| |ps|)))))
(DEFUN |bpBPileDefinition| (|ps|) (|bpPileBracketed| |ps| #'|bpPileItems|))
(DEFUN |bpIteratorTail| (|ps|)
- (AND (OR (|bpEqKey| 'REPEAT) T) (|bpIterators| |ps|)))
+ (AND (OR (|bpEqKey| |ps| 'REPEAT) T) (|bpIterators| |ps|)))
(DEFUN |bpConstruct| (|ps|) (|bpBracket| |ps| #'|bpConstruction|))
@@ -1051,8 +1093,8 @@
(AND (|bpComma| |ps|)
(OR
(AND (|bpIteratorTail| |ps|)
- (|bpPush| |ps| (|bfCollect| (|bpPop2|) (|bpPop1|))))
- (|bpPush| |ps| (|bfTupleConstruct| (|bpPop1|))))))
+ (|bpPush| |ps| (|bfCollect| (|bpPop2| |ps|) (|bpPop1| |ps|))))
+ (|bpPush| |ps| (|bfTupleConstruct| (|bpPop1| |ps|))))))
(DEFUN |bpDConstruct| (|ps|) (|bpBracket| |ps| #'|bpDConstruction|))
@@ -1060,39 +1102,39 @@
(AND (|bpComma| |ps|)
(OR
(AND (|bpIteratorTail| |ps|)
- (|bpPush| |ps| (|bfDCollect| (|bpPop2|) (|bpPop1|))))
- (|bpPush| |ps| (|bfDTuple| (|bpPop1|))))))
+ (|bpPush| |ps| (|bfDCollect| (|bpPop2| |ps|) (|bpPop1| |ps|))))
+ (|bpPush| |ps| (|bfDTuple| (|bpPop1| |ps|))))))
(DEFUN |bpPattern| (|ps|)
(OR (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpChar| |ps|)
(|bpName| |ps|) (|bpConstTok| |ps|)))
(DEFUN |bpEqual| (|ps|)
- (AND (|bpEqKey| 'SHOEEQ)
+ (AND (|bpEqKey| |ps| 'SHOEEQ)
(OR (|bpApplication| |ps|) (|bpConstTok| |ps|) (|bpTrap|))
- (|bpPush| |ps| (|bfEqual| (|bpPop1|)))))
+ (|bpPush| |ps| (|bfEqual| (|bpPop1| |ps|)))))
(DEFUN |bpRegularPatternItem| (|ps|)
(OR (|bpEqual| |ps|) (|bpConstTok| |ps|) (|bpDot| |ps|)
(AND (|bpName| |ps|)
(OR
- (AND (|bpEqKey| 'BEC) (|bpRequire| |ps| #'|bpPattern|)
- (|bpPush| |ps| (|bfAssign| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| |ps| 'BEC) (|bpRequire| |ps| #'|bpPattern|)
+ (|bpPush| |ps| (|bfAssign| (|bpPop2| |ps|) (|bpPop1| |ps|))))
T))
(|bpBracketConstruct| |ps| #'|bpPatternL|)))
(DEFUN |bpRegularPatternItemL| (|ps|)
- (AND (|bpRegularPatternItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1|)))))
+ (AND (|bpRegularPatternItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1| |ps|)))))
(DEFUN |bpRegularList| (|ps|)
(|bpListof| |ps| #'|bpRegularPatternItemL| 'COMMA #'|bfAppend|))
(DEFUN |bpPatternColon| (|ps|)
- (AND (|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpRegularPatternItem|)
- (|bpPush| |ps| (LIST (|bfColon| (|bpPop1|))))))
+ (AND (|bpEqKey| |ps| 'COLON) (|bpRequire| |ps| #'|bpRegularPatternItem|)
+ (|bpPush| |ps| (LIST (|bfColon| (|bpPop1| |ps|))))))
(DEFUN |bpPatternL| (|ps|)
- (AND (|bpPatternList| |ps|) (|bpPush| |ps| (|bfTuple| (|bpPop1|)))))
+ (AND (|bpPatternList| |ps|) (|bpPush| |ps| (|bfTuple| (|bpPop1| |ps|)))))
(DEFUN |bpPatternList| (|ps|)
(COND
@@ -1100,36 +1142,37 @@
(LOOP
(COND
((NOT
- (AND (|bpEqKey| 'COMMA)
+ (AND (|bpEqKey| |ps| 'COMMA)
(OR (|bpRegularPatternItemL| |ps|)
(PROGN
(OR
(AND (|bpPatternTail| |ps|)
- (|bpPush| |ps| (|append| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps|
+ (|append| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(|bpTrap|))
NIL))))
(RETURN NIL))
- (T (|bpPush| |ps| (|append| (|bpPop2|) (|bpPop1|))))))
+ (T (|bpPush| |ps| (|append| (|bpPop2| |ps|) (|bpPop1| |ps|))))))
T)
(T (|bpPatternTail| |ps|))))
(DEFUN |bpPatternTail| (|ps|)
(AND (|bpPatternColon| |ps|)
(OR
- (AND (|bpEqKey| 'COMMA) (|bpRequire| |ps| #'|bpRegularList|)
- (|bpPush| |ps| (|append| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| |ps| 'COMMA) (|bpRequire| |ps| #'|bpRegularList|)
+ (|bpPush| |ps| (|append| (|bpPop2| |ps|) (|bpPop1| |ps|))))
T)))
(DEFUN |bpRegularBVItemTail| (|ps|)
(OR
- (AND (|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpApplication|)
- (|bpPush| |ps| (|bfTagged| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'BEC) (|bpRequire| |ps| #'|bpPattern|)
- (|bpPush| |ps| (|bfAssign| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'IS) (|bpRequire| |ps| #'|bpPattern|)
- (|bpPush| |ps| (|bfAssign| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'DEF) (|bpRequire| |ps| #'|bpApplication|)
- (|bpPush| |ps| (|%DefaultValue| (|bpPop2|) (|bpPop1|))))))
+ (AND (|bpEqKey| |ps| 'COLON) (|bpRequire| |ps| #'|bpApplication|)
+ (|bpPush| |ps| (|bfTagged| (|bpPop2| |ps|) (|bpPop1| |ps|))))
+ (AND (|bpEqKey| |ps| 'BEC) (|bpRequire| |ps| #'|bpPattern|)
+ (|bpPush| |ps| (|bfAssign| (|bpPop2| |ps|) (|bpPop1| |ps|))))
+ (AND (|bpEqKey| |ps| 'IS) (|bpRequire| |ps| #'|bpPattern|)
+ (|bpPush| |ps| (|bfAssign| (|bpPop2| |ps|) (|bpPop1| |ps|))))
+ (AND (|bpEqKey| |ps| 'DEF) (|bpRequire| |ps| #'|bpApplication|)
+ (|bpPush| |ps| (|%DefaultValue| (|bpPop2| |ps|) (|bpPop1| |ps|))))))
(DEFUN |bpRegularBVItem| (|ps|)
(OR (|bpBVString| |ps|) (|bpConstTok| |ps|)
@@ -1139,13 +1182,14 @@
(DEFUN |bpBVString| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(AND (EQ (|tokenClass| |$stok|) 'STRING)
- (|bpPush| |ps| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext|)))
+ (|bpPush| |ps| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext| |ps|)))
(DEFUN |bpRegularBVItemL| (|ps|)
- (AND (|bpRegularBVItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1|)))))
+ (AND (|bpRegularBVItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1| |ps|)))))
(DEFUN |bpColonName| (|ps|)
- (AND (|bpEqKey| 'COLON) (OR (|bpName| |ps|) (|bpBVString| |ps|) (|bpTrap|))))
+ (AND (|bpEqKey| |ps| 'COLON)
+ (OR (|bpName| |ps|) (|bpBVString| |ps|) (|bpTrap|))))
(DEFUN |bpBoundVariablelist| (|ps|)
(COND
@@ -1153,26 +1197,27 @@
(LOOP
(COND
((NOT
- (AND (|bpEqKey| 'COMMA)
+ (AND (|bpEqKey| |ps| 'COMMA)
(OR (|bpRegularBVItemL| |ps|)
(PROGN
(OR
(AND (|bpColonName| |ps|)
(|bpPush| |ps|
- (|bfColonAppend| (|bpPop2|) (|bpPop1|))))
+ (|bfColonAppend| (|bpPop2| |ps|)
+ (|bpPop1| |ps|))))
(|bpTrap|))
NIL))))
(RETURN NIL))
- (T (|bpPush| |ps| (|append| (|bpPop2|) (|bpPop1|))))))
+ (T (|bpPush| |ps| (|append| (|bpPop2| |ps|) (|bpPop1| |ps|))))))
T)
(T
(AND (|bpColonName| |ps|)
- (|bpPush| |ps| (|bfColonAppend| NIL (|bpPop1|)))))))
+ (|bpPush| |ps| (|bfColonAppend| NIL (|bpPop1| |ps|)))))))
(DEFUN |bpVariable| (|ps|)
(OR
(AND (|bpParenthesized| |ps| #'|bpBoundVariablelist|)
- (|bpPush| |ps| (|bfTupleIf| (|bpPop1|))))
+ (|bpPush| |ps| (|bfTupleIf| (|bpPop1| |ps|))))
(|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpName| |ps|)
(|bpConstTok| |ps|)))
@@ -1181,48 +1226,51 @@
(DEFUN |bpAssignLHS| (|ps|)
(COND ((NOT (|bpName| |ps|)) NIL)
- ((|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpApplication|)
- (|bpPush| |ps| (|bfLocal| (|bpPop2|) (|bpPop1|))))
+ ((|bpEqKey| |ps| 'COLON) (|bpRequire| |ps| #'|bpApplication|)
+ (|bpPush| |ps| (|bfLocal| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T
(AND (|bpArgumentList| |ps|)
(OR (|bpEqPeek| 'DOT)
(AND (|bpEqPeek| 'BEC)
- (|bpPush| |ps| (|bfPlace| (|bpPop1|))))
+ (|bpPush| |ps| (|bfPlace| (|bpPop1| |ps|))))
(|bpTrap|)))
(COND
- ((|bpEqKey| 'DOT)
+ ((|bpEqKey| |ps| 'DOT)
(AND (|bpList| |ps| #'|bpPrimary| 'DOT) (|bpChecknull| |ps|)
- (|bpPush| |ps| (|bfTuple| (CONS (|bpPop2|) (|bpPop1|))))))
+ (|bpPush| |ps|
+ (|bfTuple| (CONS (|bpPop2| |ps|) (|bpPop1| |ps|))))))
(T T)))))
(DEFUN |bpChecknull| (|ps|)
(LET* (|a|)
(PROGN
- (SETQ |a| (|bpPop1|))
+ (SETQ |a| (|bpPop1| |ps|))
(COND ((NULL |a|) (|bpTrap|)) (T (|bpPush| |ps| |a|))))))
(DEFUN |bpStruct| (|ps|)
- (AND (|bpEqKey| 'STRUCTURE) (|bpRequire| |ps| #'|bpName|)
- (OR (|bpEqKey| 'DEF) (|bpTrap|))
+ (AND (|bpEqKey| |ps| 'STRUCTURE) (|bpRequire| |ps| #'|bpName|)
+ (OR (|bpEqKey| |ps| 'DEF) (|bpTrap|))
(OR (|bpRecord| |ps|) (|bpTypeList| |ps|))
- (|bpPush| |ps| (|%Structure| (|bpPop2|) (|bpPop1|)))))
+ (|bpPush| |ps| (|%Structure| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpRecord| (|ps|)
(LET* (|s|)
(PROGN
- (SETQ |s| (|bpState|))
+ (SETQ |s| (|bpState| |ps|))
(COND
- ((AND (|bpName| |ps|) (EQ (|bpPop1|) '|Record|))
+ ((AND (|bpName| |ps|) (EQ (|bpPop1| |ps|) '|Record|))
(AND (OR (|bpParenthesized| |ps| #'|bpFieldList|) (|bpTrap|))
(|bpGlobalAccessors| |ps|)
- (|bpPush| |ps| (|%Record| (|bfUntuple| (|bpPop2|)) (|bpPop1|)))))
- (T (|bpRestore| |s|) NIL)))))
+ (|bpPush| |ps|
+ (|%Record| (|bfUntuple| (|bpPop2| |ps|))
+ (|bpPop1| |ps|)))))
+ (T (|bpRestore| |ps| |s|) NIL)))))
(DEFUN |bpFieldList| (|ps|) (|bpTuple| |ps| #'|bpSignature|))
(DEFUN |bpGlobalAccessors| (|ps|)
(COND
- ((|bpEqKey| 'WITH)
+ ((|bpEqKey| |ps| 'WITH)
(OR (|bpPileBracketed| |ps| #'|bpAccessorDefinitionList|) (|bpTrap|)))
(T (|bpPush| |ps| NIL))))
@@ -1230,17 +1278,17 @@
(|bpListAndRecover| |ps| #'|bpAccessorDefinition|))
(DEFUN |bpAccessorDefinition| (|ps|)
- (AND (|bpRequire| |ps| #'|bpName|) (OR (|bpEqKey| 'DEF) (|bpTrap|))
+ (AND (|bpRequire| |ps| #'|bpName|) (OR (|bpEqKey| |ps| 'DEF) (|bpTrap|))
(|bpRequire| |ps| #'|bpFieldSection|)
- (|bpPush| |ps| (|%AccessorDef| (|bpPop2|) (|bpPop1|)))))
+ (|bpPush| |ps| (|%AccessorDef| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpFieldSection| (|ps|) (|bpParenthesized| |ps| #'|bpSelectField|))
-(DEFUN |bpSelectField| (|ps|) (AND (|bpEqKey| 'DOT) (|bpName| |ps|)))
+(DEFUN |bpSelectField| (|ps|) (AND (|bpEqKey| |ps| 'DOT) (|bpName| |ps|)))
(DEFUN |bpTypeList| (|ps|)
(OR (|bpPileBracketed| |ps| #'|bpTypeItemList|)
- (AND (|bpTypeItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1|))))))
+ (AND (|bpTypeItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1| |ps|))))))
(DEFUN |bpTypeItem| (|ps|) (|bpTerm| |ps| #'|bpIdList|))
@@ -1251,20 +1299,20 @@
(AND (|bpRequire| |ps| #'|bpName|)
(OR
(AND (|bpParenthesized| |ps| |idListParser|)
- (|bpPush| |ps| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps| (|bfNameArgs| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(AND (|bpName| |ps|)
- (|bpPush| |ps| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))))
- (|bpPush| |ps| (|bfNameOnly| (|bpPop1|)))))
+ (|bpPush| |ps| (|bfNameArgs| (|bpPop2| |ps|) (|bpPop1| |ps|))))))
+ (|bpPush| |ps| (|bfNameOnly| (|bpPop1| |ps|)))))
(DEFUN |bpIdList| (|ps|) (|bpTuple| |ps| #'|bpName|))
(DEFUN |bpCase| (|ps|)
- (AND (|bpEqKey| 'CASE) (|bpRequire| |ps| #'|bpWhere|)
- (OR (|bpEqKey| 'OF) (|bpMissing| 'OF)) (|bpPiledCaseItems| |ps|)))
+ (AND (|bpEqKey| |ps| 'CASE) (|bpRequire| |ps| #'|bpWhere|)
+ (OR (|bpEqKey| |ps| 'OF) (|bpMissing| 'OF)) (|bpPiledCaseItems| |ps|)))
(DEFUN |bpPiledCaseItems| (|ps|)
(AND (|bpPileBracketed| |ps| #'|bpCaseItemList|)
- (|bpPush| |ps| (|bfCase| (|bpPop2|) (|bpPop1|)))))
+ (|bpPush| |ps| (|bfCase| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpCaseItemList| (|ps|) (|bpListAndRecover| |ps| #'|bpCaseItem|))
@@ -1274,8 +1322,8 @@
(DEFUN |bpCaseItem| (|ps|)
(AND (OR (|bpTerm| |ps| #'|bpCasePatternVarList|) (|bpTrap|))
- (OR (|bpEqKey| 'EXIT) (|bpTrap|)) (|bpRequire| |ps| #'|bpWhere|)
- (|bpPush| |ps| (|bfCaseItem| (|bpPop2|) (|bpPop1|)))))
+ (OR (|bpEqKey| |ps| 'EXIT) (|bpTrap|)) (|bpRequire| |ps| #'|bpWhere|)
+ (|bpPush| |ps| (|bfCaseItem| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpOutItem| (|ps|)
(LET* (|t| |r| |ISTMP#2| |l| |ISTMP#1| |b|)
@@ -1284,7 +1332,7 @@
(DECLARE (SPECIAL |$op| |$GenVarCounter|))
(PROGN
(|bpRequire| |ps| #'|bpComma|)
- (SETQ |b| (|bpPop1|))
+ (SETQ |b| (|bpPop1| |ps|))
(SETQ |t|
(COND ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|))
((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index d71a5351..a799d9fa 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -448,7 +448,7 @@
(SETQ |$returns| NIL)
(SETQ |$bpCount| 0)
(SETQ |$bpParenCount| 0)
- (|bpFirstTok|)
+ (|bpFirstTok| |ps|)
(SETQ |found|
(LET ((#1=#:G729
(CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem| |ps|))))
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index d103351e..58711e1b 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -355,7 +355,6 @@ shoeAddComment l==
strconc('"; ", first l)
shoeOutParse toks ==
- $inputStream := toks
ps := makeParserState toks
$stack := []
$stok := nil
@@ -366,12 +365,12 @@ shoeOutParse toks ==
$returns := []
$bpCount := 0
$bpParenCount := 0
- bpFirstTok()
+ bpFirstTok ps
found :=
try bpOutItem ps
catch(e: BootParserException) => e
found = 'TRAPPED => nil
- not bStreamNull $inputStream =>
+ not bStreamNull parserTokens ps =>
bpGeneralErrorHere()
nil
$stack = nil =>
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 12:26:00 +0000