aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2012-05-29 23:50:08 +0000
committerdos-reis <gdr@axiomatics.org>2012-05-29 23:50:08 +0000
commit6c9b37fd68b558bced11d67cfc798ca96800bc79 (patch)
treeccc64628c69ca1d1fcb71c7b20c030d896d62d05
parentd310a5d012161a4515d5c9e96e992fc6977d8f6b (diff)
downloadopen-axiom-6c9b37fd68b558bced11d67cfc798ca96800bc79.tar.gz
* boot/parser.boot (%ParserState): New.
(makeParserState): Likewise. (%Translator): Likewise. (makeTranslator): Likewise. Make all parsing functions take a parser state argument. * boot/translator.boot (shoeOutParse): Adjust. * interp/spad-parser.boot (stringPrefix?): Remove redudant definition.
Diffstat
-rwxr-xr-xconfigure20
-rw-r--r--configure.ac2
-rw-r--r--src/ChangeLog10
-rw-r--r--src/boot/parser.boot1155
-rw-r--r--src/boot/strap/includer.clisp4
-rw-r--r--src/boot/strap/parser.clisp1131
-rw-r--r--src/boot/strap/translator.clisp20
-rw-r--r--src/boot/strap/utility.clisp20
-rw-r--r--src/boot/translator.boot7
-rw-r--r--src/interp/spad-parser.boot7
10 files changed, 1277 insertions, 1099 deletions
diff --git a/configure b/configure
index 0b1206ab..275e2cfb 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.68 for OpenAxiom 1.5.0-2012-05-28.
+# Generated by GNU Autoconf 2.68 for OpenAxiom 1.5.0-2012-05-29.
#
# Report bugs to <open-axiom-bugs@lists.sf.net>.
#
@@ -570,8 +570,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='OpenAxiom'
PACKAGE_TARNAME='openaxiom'
-PACKAGE_VERSION='1.5.0-2012-05-28'
-PACKAGE_STRING='OpenAxiom 1.5.0-2012-05-28'
+PACKAGE_VERSION='1.5.0-2012-05-29'
+PACKAGE_STRING='OpenAxiom 1.5.0-2012-05-29'
PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net'
PACKAGE_URL=''
@@ -1365,7 +1365,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures OpenAxiom 1.5.0-2012-05-28 to adapt to many kinds of systems.
+\`configure' configures OpenAxiom 1.5.0-2012-05-29 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1440,7 +1440,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OpenAxiom 1.5.0-2012-05-28:";;
+ short | recursive ) echo "Configuration of OpenAxiom 1.5.0-2012-05-29:";;
esac
cat <<\_ACEOF
@@ -1553,7 +1553,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OpenAxiom configure 1.5.0-2012-05-28
+OpenAxiom configure 1.5.0-2012-05-29
generated by GNU Autoconf 2.68
Copyright (C) 2010 Free Software Foundation, Inc.
@@ -2546,7 +2546,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by OpenAxiom $as_me 1.5.0-2012-05-28, which was
+It was created by OpenAxiom $as_me 1.5.0-2012-05-29, which was
generated by GNU Autoconf 2.68. Invocation command line was
$ $0 $@
@@ -3479,7 +3479,7 @@ fi
# Define the identity of the package.
PACKAGE='openaxiom'
- VERSION='1.5.0-2012-05-28'
+ VERSION='1.5.0-2012-05-29'
cat >>confdefs.h <<_ACEOF
@@ -20276,7 +20276,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by OpenAxiom $as_me 1.5.0-2012-05-28, which was
+This file was extended by OpenAxiom $as_me 1.5.0-2012-05-29, which was
generated by GNU Autoconf 2.68. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -20342,7 +20342,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-OpenAxiom config.status 1.5.0-2012-05-28
+OpenAxiom config.status 1.5.0-2012-05-29
configured by $0, generated by GNU Autoconf 2.68,
with options \\"\$ac_cs_config\\"
diff --git a/configure.ac b/configure.ac
index 0c11c545..d11c2742 100644
--- a/configure.ac
+++ b/configure.ac
@@ -33,7 +33,7 @@ dnl Makefiles for building OpenAxiom interpreter, compiler, libraries, and
dnl auxiliary tools where appropriate.
dnl
-AC_INIT([OpenAxiom], [1.5.0-2012-05-28],
+AC_INIT([OpenAxiom], [1.5.0-2012-05-29],
[open-axiom-bugs@lists.sf.net])
dnl Most of the macros used in this configure.ac are defined in files
diff --git a/src/ChangeLog b/src/ChangeLog
index 9d3b39d2..1f8cc64b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,13 @@
+2012-05-29 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * boot/parser.boot (%ParserState): New.
+ (makeParserState): Likewise.
+ (%Translator): Likewise.
+ (makeTranslator): Likewise.
+ Make all parsing functions take a parser state argument.
+ * boot/translator.boot (shoeOutParse): Adjust.
+ * interp/spad-parser.boot (stringPrefix?): Remove redudant definition.
+
2012-05-28 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/lexing.boot: Use makeToken directly.
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index a830a7d9..e8843aa7 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -45,6 +45,38 @@ import ast
namespace BOOTTRAN
module parser
+--%
+--% Snapshot of the parser state
+--%
+
+structure %ParserState ==
+ Record(toks: %List %Tokens, trees: %List %Ast, pren: %Short, scp: %Short)
+ with
+ parserTokens == (.toks) -- remaining token sequence
+ parserTrees == (.trees) -- list of successful parse trees
+ parserNesting == (.pren) -- parenthesis nesting level
+ parserScope == (.scp) -- scope nesting level
+
+makeParserState toks ==
+ mk%ParserState(toks,nil,0,0)
+
+--%
+--% Translator global state
+--%
+structure %Translator ==
+ Record(ipath: %String, fdefs: %List %Thing, sigs: %List %Thing,
+ xports: %List %Identifier, csts: %List %Binding) with
+ inputFilePath == (.ifile) -- path to the input file
+ functionDefinitions == (.fdefs) -- functions defined in this TU
+ globalSignatures == (.sigs) -- signatures proclaimed by this TU
+ exportedNames == (.xports) -- names exported by this TU
+ constantBindings == (.csts) -- constants defined in this TU
+
+makeTranslator ip ==
+ mk%Translator(ip,nil,nil,nil,nil)
+
+--%
+
bpFirstToken()==
$stok:=
@@ -78,8 +110,8 @@ bpNextToken() ==
$inputStream := rest($inputStream)
bpFirstToken()
-bpRequire f ==
- apply(f,nil) or bpTrap()
+bpRequire(ps,f) ==
+ apply(f,ps,nil) or bpTrap()
bpState() ==
[$inputStream,$stack,$bpParenCount,$bpCount]
@@ -93,9 +125,10 @@ bpRestore(x)==
$bpCount:=CADDDR x
true
-bpPush x==$stack:=[x,:$stack]
+bpPush(ps,x) ==
+ $stack:=[x,:$stack]
-bpPushId()==
+bpPushId ps ==
$stack:= [bfReName $ttok,:$stack]
bpPop1()==
@@ -113,13 +146,13 @@ bpPop3()==
$stack.rest.rest := CDDDR $stack
a
-bpIndentParenthesized f==
+bpIndentParenthesized(ps,f) ==
$bpCount:local:=0
a:=$stok
bpEqPeek "OPAREN" =>
$bpParenCount:=$bpParenCount+1
bpNext()
- apply(f,nil) and bpFirstTok() and
+ apply(f,ps,nil) and bpFirstTok() and
(bpEqPeek "CPAREN" or bpParenTrap(a)) =>
$bpParenCount:=$bpParenCount-1
bpNextToken()
@@ -131,113 +164,113 @@ bpIndentParenthesized f==
true
true
bpEqPeek "CPAREN" =>
- bpPush bfTuple []
+ bpPush(ps,bfTuple [])
$bpParenCount:=$bpParenCount-1
bpNextToken()
true
bpParenTrap(a)
false
-bpParenthesized f==
+bpParenthesized(ps,f) ==
a := $stok
bpEqKey "OPAREN" =>
- apply(f,nil) and (bpEqKey "CPAREN" or bpParenTrap(a)) => true
+ apply(f,ps,nil) and (bpEqKey "CPAREN" or bpParenTrap(a)) => true
bpEqKey "CPAREN" =>
- bpPush bfTuple []
+ bpPush(ps,bfTuple [])
true
bpParenTrap(a)
false
-bpBracket f==
+bpBracket(ps,f) ==
a := $stok
bpEqKey "OBRACK" =>
- apply(f,nil) and (bpEqKey "CBRACK" or bpBrackTrap(a)) =>
- bpPush bfBracket bpPop1()
- bpEqKey "CBRACK" => bpPush []
+ apply(f,ps,nil) and (bpEqKey "CBRACK" or bpBrackTrap(a)) =>
+ bpPush(ps,bfBracket bpPop1())
+ bpEqKey "CBRACK" => bpPush(ps,[])
bpBrackTrap(a)
false
-bpPileBracketed f==
+bpPileBracketed(ps,f) ==
bpEqKey "SETTAB" =>
bpEqKey "BACKTAB" => true
- apply(f,nil) and (bpEqKey "BACKTAB" or bpPileTrap()) =>
- bpPush bfPile bpPop1()
+ apply(f,ps,nil) and (bpEqKey "BACKTAB" or bpPileTrap()) =>
+ bpPush(ps,bfPile bpPop1())
false
false
-bpListof(f,str1,g)==
- apply(f,nil) =>
- bpEqKey str1 and bpRequire f =>
+bpListof(ps,f,str1,g)==
+ apply(f,ps,nil) =>
+ bpEqKey str1 and bpRequire(ps,f) =>
a:=$stack
$stack:=nil
- while bpEqKey str1 and bpRequire f repeat 0
+ while bpEqKey str1 and bpRequire(ps,f) repeat nil
$stack:=[reverse! $stack,:a]
- bpPush FUNCALL(g, [bpPop3(),bpPop2(),:bpPop1()])
+ bpPush(ps,FUNCALL(g, [bpPop3(),bpPop2(),:bpPop1()]))
true
false
-- to do ,<backset>
-bpListofFun(f,h,g)==
- apply(f,nil) =>
- apply(h,nil) and bpRequire f =>
+bpListofFun(ps,f,h,g)==
+ apply(f,ps,nil) =>
+ apply(h,ps,nil) and bpRequire(ps,f) =>
a:=$stack
$stack:=nil
- while apply(h,nil) and bpRequire f repeat 0
+ while apply(h,ps,nil) and bpRequire(ps,f) repeat nil
$stack:=[reverse! $stack,:a]
- bpPush FUNCALL(g, [bpPop3(),bpPop2(),:bpPop1()])
+ bpPush(ps,FUNCALL(g, [bpPop3(),bpPop2(),:bpPop1()]))
true
false
-bpList(f,str1)==
- apply(f,nil) =>
- bpEqKey str1 and bpRequire f =>
+bpList(ps,f,str1)==
+ apply(f,ps,nil) =>
+ bpEqKey str1 and bpRequire(ps,f) =>
a:=$stack
$stack:=nil
- while bpEqKey str1 and bpRequire f repeat 0
+ while bpEqKey str1 and bpRequire(ps,f) repeat nil
$stack:=[reverse! $stack,:a]
- bpPush [bpPop3(),bpPop2(),:bpPop1()]
- bpPush [bpPop1()]
- bpPush nil
+ bpPush(ps,[bpPop3(),bpPop2(),:bpPop1()])
+ bpPush(ps,[bpPop1()])
+ bpPush(ps,nil)
-bpOneOrMore f==
- apply(f,nil)=>
+bpOneOrMore(ps,f) ==
+ apply(f,ps,nil)=>
a:=$stack
$stack:=nil
- while apply(f,nil) repeat 0
+ while apply(f,ps,nil) repeat nil
$stack:=[reverse! $stack,:a]
- bpPush [bpPop2(),:bpPop1()]
+ bpPush(ps,[bpPop2(),:bpPop1()])
false
-- s must transform the head of the stack
-bpAnyNo s==
- while apply(s,nil) repeat 0
+bpAnyNo(ps,s) ==
+ while apply(s,ps,nil) repeat nil
true
-- AndOr(k,p,f)= k p
-bpAndOr(keyword,p,f)==
- bpEqKey keyword and bpRequire p
- and bpPush FUNCALL(f, bpPop1())
+bpAndOr(ps,keyword,p,f)==
+ bpEqKey keyword and bpRequire(ps,p)
+ and bpPush(ps,FUNCALL(f, bpPop1()))
-bpConditional f==
- bpEqKey "IF" and bpRequire function bpWhere and (bpEqKey "BACKSET" or true) =>
+bpConditional(ps,f) ==
+ bpEqKey "IF" and bpRequire(ps,function bpWhere) and (bpEqKey "BACKSET" or true) =>
bpEqKey "SETTAB" =>
bpEqKey "THEN" =>
- bpRequire f and bpElse(f) and bpEqKey "BACKTAB"
+ bpRequire(ps,f) and bpElse(ps,f) and bpEqKey "BACKTAB"
bpMissing "THEN"
- bpEqKey "THEN" => bpRequire f and bpElse(f)
+ bpEqKey "THEN" => bpRequire(ps,f) and bpElse(ps,f)
bpMissing "then"
false
-bpElse(f)==
+bpElse(ps,f)==
a:=bpState()
bpBacksetElse() =>
- bpRequire f and
- bpPush bfIf(bpPop3(),bpPop2(),bpPop1())
+ bpRequire(ps,f) and
+ bpPush(ps,bfIf(bpPop3(),bpPop2(),bpPop1()))
bpRestore a
- bpPush bfIfThenOnly(bpPop2(),bpPop1())
+ bpPush(ps,bfIfThenOnly(bpPop2(),bpPop1()))
bpBacksetElse()==
bpEqKey "BACKSET" => bpEqKey "ELSE"
@@ -270,15 +303,15 @@ bpTrap()==
bpGeneralErrorHere()
throw 'TRAPPED : BootParserException
-bpRecoverTrap()==
+bpRecoverTrap ps ==
bpFirstToken()
pos1 := tokenPosition $stok
bpMoveTo 0
pos2 := tokenPosition $stok
bpIgnoredFromTo(pos1, pos2)
- bpPush [['"pile syntax error"]]
+ bpPush(ps,[['"pile syntax error"]])
-bpListAndRecover(f)==
+bpListAndRecover(ps,f)==
a := $stack
b := nil
$stack := nil
@@ -286,17 +319,17 @@ bpListAndRecover(f)==
c := $inputStream
while not done repeat
found :=
- try apply(f,nil)
+ try apply(f,ps,nil)
catch(e: BootParserException) => e
if found is "TRAPPED"
then
$inputStream:=c
- bpRecoverTrap()
+ bpRecoverTrap ps
else if not found
then
$inputStream:=c
bpGeneralErrorHere()
- bpRecoverTrap()
+ bpRecoverTrap ps
if bpEqKey "BACKSET"
then
c := $inputStream
@@ -306,7 +339,7 @@ bpListAndRecover(f)==
else
$inputStream := c
bpGeneralErrorHere()
- bpRecoverTrap()
+ bpRecoverTrap ps
if bpEqPeek "BACKTAB" or $inputStream = nil
then done:=true
else
@@ -314,7 +347,7 @@ bpListAndRecover(f)==
c := $inputStream
b := [bpPop1(),:b]
$stack := a
- bpPush reverse! b
+ bpPush(ps,reverse! b)
bpMoveTo n==
$inputStream = nil => true
@@ -349,21 +382,21 @@ bpMoveTo n==
-- 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() ==
+bpQualifiedName ps ==
bpEqPeek "COLON-COLON" =>
bpNext()
- tokenClass $stok = "ID" and bpPushId() and bpNext()
- and bpPush bfColonColon(bpPop2(), bpPop1())
+ tokenClass $stok = "ID" and bpPushId ps and bpNext()
+ and bpPush(ps,bfColonColon(bpPop2(), bpPop1()))
false
++ Name:
++ ID
++ Name :: ID
-bpName() ==
+bpName ps ==
tokenClass $stok = "ID" =>
- bpPushId()
+ bpPushId ps
bpNext()
- bpAnyNo function bpQualifiedName
+ bpAnyNo(ps,function bpQualifiedName)
false
++ Constant:
@@ -374,35 +407,35 @@ bpName() ==
++ LINE
++ QUOTE S-Expression
++ STRING
-bpConstTok() ==
+bpConstTok ps ==
tokenClass $stok in '(INTEGER FLOAT) =>
- bpPush $ttok
+ bpPush(ps,$ttok)
bpNext()
- tokenClass $stok = "LISP" => bpPush %Lisp $ttok and bpNext()
- tokenClass $stok = "LISPEXP" => bpPush $ttok and bpNext()
- tokenClass $stok = "LINE" => bpPush ["+LINE", $ttok] and 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()
bpEqPeek "QUOTE" =>
bpNext()
- bpRequire function bpSexp and
- bpPush bfSymbol bpPop1()
- bpString() or bpFunction()
+ bpRequire(ps,function bpSexp) and
+ bpPush(ps,bfSymbol bpPop1())
+ bpString ps or bpFunction ps
-bpChar() ==
+bpChar ps ==
tokenClass $stok = "ID" and $ttok is "char" =>
a := bpState()
- bpApplication() =>
+ bpApplication ps =>
s := bpPop1()
- s is ["char",.] => bpPush s
+ s is ["char",.] => bpPush(ps,s)
bpRestore a
false
false
false
++ Subroutine of bpExportItem. Parses tails of ExportItem.
-bpExportItemTail() ==
- bpEqKey "BEC" and bpRequire function bpAssign and
- bpPush %Assignment(bpPop2(), bpPop1())
- or bpSimpleDefinitionTail()
+bpExportItemTail ps ==
+ bpEqKey "BEC" and bpRequire(ps,function bpAssign) and
+ bpPush(ps,%Assignment(bpPop2(), bpPop1()))
+ or bpSimpleDefinitionTail ps
++ ExportItem:
++ Structure
@@ -410,48 +443,48 @@ bpExportItemTail() ==
++ Signature
++ Signature := Where
++ Signature == Where
-bpExportItem() ==
- bpEqPeek "STRUCTURE" => bpStruct()
+bpExportItem ps ==
+ bpEqPeek "STRUCTURE" => bpStruct ps
a := bpState()
- bpName() =>
+ bpName ps =>
bpEqPeek "COLON" =>
bpRestore a
- bpRequire function bpSignature
- bpExportItemTail() or true
+ bpRequire(ps,function bpSignature)
+ bpExportItemTail ps or true
bpRestore a
- bpTypeAliasDefition()
+ bpTypeAliasDefition ps
false
++ ExportItemList:
++ Signature
++ ExportItemList Signature
-bpExportItemList() ==
- bpListAndRecover function bpExportItem
+bpExportItemList ps ==
+ bpListAndRecover(ps,function bpExportItem)
++ ModuleInterface:
++ WHERE pile-bracketed ExporItemList
-bpModuleInterface() ==
+bpModuleInterface ps ==
bpEqKey "WHERE" =>
- bpPileBracketed function bpExportItemList
- or (bpExportItem() and bpPush [bpPop1()])
+ bpPileBracketed(ps,function bpExportItemList)
+ or (bpExportItem ps and bpPush(ps,[bpPop1()]))
or bpTrap()
- bpPush nil
+ bpPush(ps,nil)
++ ModuleExports:
++ OPAREN IdList CPAREN
-bpModuleExports() ==
- bpParenthesized function bpIdList => bpPush bfUntuple bpPop1()
- bpPush nil
+bpModuleExports ps ==
+ bpParenthesized(ps,function bpIdList) => bpPush(ps,bfUntuple bpPop1())
+ bpPush(ps,nil)
++ Parse a module definitoin
++ Module:
++ MODULE Name OptionalModuleExports OptionalModuleInterface
-bpModule() ==
+bpModule ps ==
bpEqKey "MODULE" =>
- bpRequire function bpName
- bpModuleExports()
- bpModuleInterface()
- bpPush %Module(bpPop3(),bpPop2(),bpPop1())
+ bpRequire(ps,function bpName)
+ bpModuleExports ps
+ bpModuleInterface ps
+ bpPush(ps,%Module(bpPop3(),bpPop2(),bpPop1()))
nil
++ Parse a module import, or a import declaration for a foreign entity.
@@ -459,52 +492,52 @@ bpModule() ==
++ IMPORT Signature FOR Name
++ IMPORT Name
++ IMPORT NAMESPACE LongName
-bpImport() ==
+bpImport ps ==
bpEqKey "IMPORT" =>
bpEqKey "NAMESPACE" =>
- bpLeftAssoc('(DOT),function bpName) and
- bpPush %Import bfNamespace bpPop1()
+ bpLeftAssoc(ps,'(DOT),function bpName) and
+ bpPush(ps,%Import bfNamespace bpPop1())
or bpTrap()
a := bpState()
- bpRequire function bpName
+ bpRequire(ps,function bpName)
bpEqPeek "COLON" =>
bpRestore a
- bpRequire function bpSignature and
+ bpRequire(ps,function bpSignature) and
(bpEqKey "FOR" or bpTrap()) and
- bpRequire function bpName and
- bpPush %ImportSignature(bpPop1(), bpPop1())
- bpPush %Import bpPop1()
+ bpRequire(ps,function bpName) and
+ bpPush(ps,%ImportSignature(bpPop1(), bpPop1()))
+ bpPush(ps,%Import bpPop1())
false
++
++ Namespace:
++ NAMESPACE Name
-bpNamespace() ==
- bpEqKey "NAMESPACE" and (bpName() or bpDot()) and
- bpPush bfNamespace bpPop1()
+bpNamespace ps ==
+ bpEqKey "NAMESPACE" and (bpName ps or bpDot ps) and
+ bpPush(ps,bfNamespace bpPop1())
-- Parse a type alias defnition:
-- type-alias-definition:
-- identifier <=> logical-expression
-bpTypeAliasDefition() ==
- (bpTerm function bpIdList or bpTrap()) and
- bpEqKey "TDEF" and bpLogical() and
- bpPush %TypeAlias(bpPop2(), bpPop1())
+bpTypeAliasDefition ps ==
+ (bpTerm(ps,function bpIdList) or bpTrap()) and
+ bpEqKey "TDEF" and bpLogical ps and
+ bpPush(ps,%TypeAlias(bpPop2(), bpPop1()))
++ Parse a signature declaration
++ Signature:
++ Name COLON Mapping
-bpSignature() ==
- bpName() and bpEqKey "COLON" and bpRequire function bpTyping
- and bpPush %Signature(bpPop2(), bpPop1())
+bpSignature ps ==
+ bpName ps and bpEqKey "COLON" and bpRequire(ps,function bpTyping)
+ and bpPush(ps,%Signature(bpPop2(), bpPop1()))
++ SimpleMapping:
++ Application
++ Application -> Application
-bpSimpleMapping() ==
- bpApplication() =>
- bpEqKey "ARROW" and bpRequire function bpApplication and
- bpPush %Mapping(bpPop1(), [bpPop1()])
+bpSimpleMapping ps ==
+ bpApplication ps =>
+ bpEqKey "ARROW" and bpRequire(ps,function bpApplication) and
+ bpPush(ps,%Mapping(bpPop1(), [bpPop1()]))
true
false
@@ -513,16 +546,16 @@ bpSimpleMapping() ==
++ ArgtypeSequence:
++ SimpleMapping
++ SimpleMapping , ArgtypeSequence
-bpArgtypeList() ==
- bpTuple function bpSimpleMapping
+bpArgtypeList ps ==
+ bpTuple(ps,function bpSimpleMapping)
++ Parse a mapping expression
++ Mapping:
++ ArgtypeList -> Application
-bpMapping() ==
- bpParenthesized function bpArgtypeList and
- bpEqKey "ARROW" and bpApplication() and
- bpPush %Mapping(bpPop1(), bfUntuple bpPop1())
+bpMapping ps ==
+ bpParenthesized(ps,function bpArgtypeList) and
+ bpEqKey "ARROW" and bpApplication ps and
+ bpPush(ps,%Mapping(bpPop1(), bfUntuple bpPop1()))
bpCancel()==
a := bpState()
@@ -548,227 +581,230 @@ bpExceptions()==
or bpEqPeek "BACKSET"
-bpSexpKey()==
+bpSexpKey ps ==
tokenClass $stok = "KEY" and not bpExceptions() =>
a := $ttok has SHOEINF
- a = nil => bpPush keywordId $ttok and bpNext()
- bpPush a and bpNext()
+ a = nil => bpPush(ps,keywordId $ttok) and bpNext()
+ bpPush(ps,a) and bpNext()
false
-bpAnyId()==
+bpAnyId ps ==
bpEqKey "MINUS" and (tokenClass $stok = "INTEGER" or bpTrap()) and
- bpPush(-$ttok) and bpNext() or
- bpSexpKey() or
+ bpPush(ps,-$ttok) and bpNext() or
+ bpSexpKey ps or
tokenClass $stok in '(ID INTEGER STRING FLOAT)
- and bpPush $ttok and bpNext()
-
-bpSexp()==
- bpAnyId() or
- bpEqKey "QUOTE" and bpRequire function bpSexp
- and bpPush bfSymbol bpPop1() or
- bpIndentParenthesized function bpSexp1
-
-bpSexp1()== bpFirstTok() and
- bpSexp() and
- (bpEqKey "DOT" and bpSexp() and bpPush [bpPop2(),:bpPop1()] or
- bpSexp1() and bpPush [bpPop2(),:bpPop1()]) or
- bpPush nil
-
-bpPrimary1() ==
- bpParenthesizedApplication() or
- bpDot() or
- bpConstTok() or
- bpConstruct() or
- bpCase() or
- bpStruct() or
- bpPDefinition() or
- bpBPileDefinition()
-
-bpParenthesizedApplication() ==
- bpName() and bpAnyNo function bpArgumentList
-
-bpArgumentList() ==
- bpPDefinition() and
- bpPush bfApplication(bpPop2(), bpPop1())
-
-bpPrimary()== bpFirstTok() and (bpPrimary1() or bpPrefixOperator())
-
-bpDot()== bpEqKey "DOT" and bpPush bfDot ()
-
-bpPrefixOperator()==
+ and bpPush(ps,$ttok) and bpNext()
+
+bpSexp ps ==
+ bpAnyId ps or
+ bpEqKey "QUOTE" and bpRequire(ps,function bpSexp)
+ and bpPush(ps,bfSymbol bpPop1()) or
+ bpIndentParenthesized(ps,function bpSexp1)
+
+bpSexp1 ps == bpFirstTok() and
+ bpSexp ps and
+ (bpEqKey "DOT" and bpSexp ps and bpPush(ps,[bpPop2(),:bpPop1()]) or
+ bpSexp1 ps and bpPush(ps,[bpPop2(),:bpPop1()])) or
+ bpPush(ps,nil)
+
+bpPrimary1 ps ==
+ bpParenthesizedApplication ps or
+ bpDot ps or
+ bpConstTok ps or
+ bpConstruct ps or
+ bpCase ps or
+ bpStruct ps or
+ bpPDefinition ps or
+ bpBPileDefinition ps
+
+bpParenthesizedApplication ps ==
+ bpName ps and bpAnyNo(ps,function bpArgumentList)
+
+bpArgumentList ps ==
+ bpPDefinition ps and
+ bpPush(ps,bfApplication(bpPop2(), bpPop1()))
+
+bpPrimary ps ==
+ bpFirstTok() and (bpPrimary1 ps or bpPrefixOperator ps )
+
+bpDot ps ==
+ bpEqKey "DOT" and bpPush(ps,bfDot())
+
+bpPrefixOperator ps ==
tokenClass $stok = "KEY" and
- $ttok has SHOEPRE and bpPushId() and bpNext()
+ $ttok has SHOEPRE and bpPushId ps and bpNext()
-bpInfixOperator()==
+bpInfixOperator ps ==
tokenClass $stok = "KEY" and
- $ttok has SHOEINF and bpPushId() and bpNext()
+ $ttok has SHOEINF and bpPushId ps and bpNext()
-bpSelector()==
- bpEqKey "DOT" and (bpPrimary()
- and bpPush(bfElt(bpPop2(),bpPop1()))
- or bpPush bfSuffixDot bpPop1() )
+bpSelector ps ==
+ bpEqKey "DOT" and (bpPrimary ps
+ and bpPush(ps,bfElt(bpPop2(),bpPop1()))
+ or bpPush(ps,bfSuffixDot bpPop1()))
-bpApplication()==
- bpPrimary() and bpAnyNo function bpSelector and
- (bpApplication() and
- bpPush(bfApplication(bpPop2(),bpPop1())) or true)
- or bpNamespace()
+bpApplication ps==
+ bpPrimary ps and bpAnyNo(ps,function bpSelector) and
+ (bpApplication ps and
+ bpPush(ps,bfApplication(bpPop2(),bpPop1())) or true)
+ or bpNamespace ps
++ Typing:
++ SimpleType
++ Mapping
++ FORALL Variable DOT Typing
-bpTyping() ==
+bpTyping ps ==
bpEqKey "FORALL" =>
- bpRequire function bpVariable
- (bpDot() and bpPop1()) or bpTrap()
- bpRequire function bpTyping
- bpPush %Forall(bpPop2(), bpPop1())
- bpMapping() or bpSimpleMapping()
+ bpRequire(ps,function bpVariable)
+ (bpDot ps and bpPop1()) or bpTrap()
+ bpRequire(ps,function bpTyping)
+ bpPush(ps,%Forall(bpPop2(), bpPop1()))
+ bpMapping ps or bpSimpleMapping ps
++ Typed:
++ Application : Typing
++ Application @ Typing
-bpTyped()==
- bpApplication() and
+bpTyped ps ==
+ bpApplication ps and
bpEqKey "COLON" =>
- bpRequire function bpTyping and
- bpPush bfTagged(bpPop2(),bpPop1())
+ bpRequire(ps,function bpTyping) and
+ bpPush(ps,bfTagged(bpPop2(),bpPop1()))
bpEqKey "AT" =>
- bpRequire function bpTyping and
- bpPush bfRestrict(bpPop2(), bpPop1())
+ bpRequire(ps,function bpTyping) and
+ bpPush(ps,bfRestrict(bpPop2(), bpPop1()))
true
-bpExpt()== bpRightAssoc('(POWER),function bpTyped)
+bpExpt ps == bpRightAssoc(ps,'(POWER),function bpTyped)
-bpInfKey s ==
+bpInfKey(ps,s) ==
tokenClass $stok = "KEY" and
- symbolMember?($ttok,s) and bpPushId() and bpNext()
+ symbolMember?($ttok,s) and bpPushId ps and bpNext()
-bpInfGeneric s==
- bpInfKey s and (bpEqKey "BACKSET" or true)
+bpInfGeneric(ps,s) ==
+ bpInfKey(ps,s) and (bpEqKey "BACKSET" or true)
-bpRightAssoc(o,p)==
+bpRightAssoc(ps,o,p)==
a := bpState()
- apply(p,nil) =>
- while bpInfGeneric o and (bpRightAssoc(o,p) or bpTrap()) repeat
- bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
+ apply(p,ps,nil) =>
+ while bpInfGeneric(ps,o) and (bpRightAssoc(ps,o,p) or bpTrap()) repeat
+ bpPush(ps,bfInfApplication(bpPop2(),bpPop2(),bpPop1()))
true
bpRestore a
false
-bpLeftAssoc(operations,parser)==
- apply(parser,nil) =>
- while bpInfGeneric(operations) and bpRequire parser
+bpLeftAssoc(ps,operations,parser)==
+ apply(parser,ps,nil) =>
+ while bpInfGeneric(ps,operations) and bpRequire(ps,parser)
repeat
- bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
+ bpPush(ps,bfInfApplication(bpPop2(),bpPop2(),bpPop1()))
true
false
-bpString()==
+bpString ps ==
tokenClass $stok = "STRING" and
- bpPush(quote makeSymbol $ttok) and bpNext()
+ bpPush(ps,quote makeSymbol $ttok) and bpNext()
-bpFunction() ==
- bpEqKey "FUNCTION" and bpRequire function bpPrimary1
- and bpPush bfFunction bpPop1()
+bpFunction ps ==
+ bpEqKey "FUNCTION" and bpRequire(ps,function bpPrimary1)
+ and bpPush(ps,bfFunction bpPop1())
-bpThetaName() ==
+bpThetaName ps ==
tokenClass $stok = "ID" and $ttok has SHOETHETA =>
- bpPushId()
+ bpPushId ps
bpNext()
false
-bpReduceOperator()==
- bpInfixOperator() or bpString() or bpThetaName()
+bpReduceOperator ps ==
+ bpInfixOperator ps or bpString ps or bpThetaName ps
-bpReduce()==
+bpReduce ps==
a := bpState()
- bpReduceOperator() and bpEqKey "SLASH" =>
+ bpReduceOperator ps and bpEqKey "SLASH" =>
bpEqPeek "OBRACK" =>
- bpRequire function bpDConstruct and
- bpPush bfReduceCollect(bpPop2(),bpPop1())
- bpRequire function bpApplication and
- bpPush bfReduce(bpPop2(),bpPop1())
+ bpRequire(ps,function bpDConstruct) and
+ bpPush(ps,bfReduceCollect(bpPop2(),bpPop1()))
+ bpRequire(ps,function bpApplication) and
+ bpPush(ps,bfReduce(bpPop2(),bpPop1()))
bpRestore a
false
-bpTimes()==
- bpReduce() or bpLeftAssoc('(TIMES SLASH),function bpExpt)
+bpTimes ps ==
+ bpReduce ps or bpLeftAssoc(ps,'(TIMES SLASH),function bpExpt)
-bpEuclid() ==
- bpLeftAssoc('(QUO REM),function bpTimes)
+bpEuclid ps ==
+ bpLeftAssoc(ps,'(QUO REM),function bpTimes)
-bpMinus()==
- bpInfGeneric '(MINUS) and bpRequire function bpEuclid
- and bpPush(bfApplication(bpPop2(),bpPop1()))
- or bpEuclid()
+bpMinus ps ==
+ bpInfGeneric(ps,'(MINUS)) and bpRequire(ps,function bpEuclid)
+ and bpPush(ps,bfApplication(bpPop2(),bpPop1()))
+ or bpEuclid ps
-bpArith()==bpLeftAssoc('(PLUS MINUS),function bpMinus)
+bpArith ps ==
+ bpLeftAssoc(ps,'(PLUS MINUS),function bpMinus)
-bpIs()==
- bpArith() and
- bpInfKey '(IS ISNT) and bpRequire function bpPattern =>
- bpPush bfISApplication(bpPop2(),bpPop2(),bpPop1())
- bpEqKey "HAS" and bpRequire function bpApplication =>
- bpPush bfHas(bpPop2(), bpPop1())
+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()))
true
-bpBracketConstruct(f)==
- bpBracket f and bpPush bfConstruct bpPop1()
+bpBracketConstruct(ps,f)==
+ bpBracket(ps,f) and bpPush(ps,bfConstruct bpPop1())
-bpCompare()==
- bpIs() and (bpInfKey '(SHOEEQ SHOENE LT LE GT GE IN)
- and bpRequire function bpIs
- and bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1())
+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()))
or true)
- or bpLeave()
- or bpThrow()
+ or bpLeave ps
+ or bpThrow ps
-bpAnd() ==
- bpLeftAssoc('(AND),function bpCompare)
+bpAnd ps ==
+ bpLeftAssoc(ps,'(AND),function bpCompare)
-bpThrow() ==
- bpEqKey "THROW" and bpApplication() =>
+bpThrow ps ==
+ bpEqKey "THROW" and bpApplication ps =>
-- Allow user-supplied matching type tag
if bpEqKey "COLON" then
- bpRequire function bpApplication
- bpPush %Pretend(bpPop2(),bpPop1())
- bpPush bfThrow bpPop1()
+ bpRequire(ps,function bpApplication)
+ bpPush(ps,%Pretend(bpPop2(),bpPop1()))
+ bpPush(ps,bfThrow bpPop1())
nil
++ Try:
++ try Assign CatchItems
-bpTry() ==
+bpTry ps ==
bpEqKey "TRY" =>
- bpAssign()
+ bpAssign ps
cs := []
while bpHandler "CATCH" repeat
- bpCatchItem()
+ bpCatchItem ps
cs := [bpPop1(),:cs]
bpHandler "FINALLY" =>
- bpFinally() and
- bpPush bfTry(bpPop2(),reverse! [bpPop1(),:cs])
+ bpFinally ps and
+ bpPush(ps,bfTry(bpPop2(),reverse! [bpPop1(),:cs]))
cs = nil => bpTrap() -- missing handlers
- bpPush bfTry(bpPop1(),reverse! cs)
+ bpPush(ps,bfTry(bpPop1(),reverse! cs))
nil
-bpCatchItem() ==
- bpRequire function bpExceptionVariable and
+bpCatchItem ps ==
+ bpRequire(ps,function bpExceptionVariable) and
(bpEqKey "EXIT" or bpTrap()) and
- bpRequire function bpAssign and
- bpPush %Catch(bpPop2(),bpPop1())
+ bpRequire(ps,function bpAssign) and
+ bpPush(ps,%Catch(bpPop2(),bpPop1()))
-bpExceptionVariable() ==
+bpExceptionVariable ps ==
t := $stok
bpEqKey "OPAREN" and
- bpRequire function bpSignature and
+ bpRequire(ps,function bpSignature) and
(bpEqKey "CPAREN" or bpMissing t)
or bpTrap()
-bpFinally() ==
- bpRequire function bpAssign and
- bpPush %Finally bpPop1()
+bpFinally ps ==
+ bpRequire(ps,function bpAssign) and
+ bpPush(ps,%Finally bpPop1())
bpHandler key ==
s := bpState()
@@ -778,145 +814,150 @@ bpHandler key ==
++ Leave:
++ LEAVE Logical
-bpLeave() ==
- bpEqKey "LEAVE" and bpRequire function bpLogical and
- bpPush bfLeave bpPop1()
+bpLeave ps ==
+ bpEqKey "LEAVE" and bpRequire(ps,function bpLogical) and
+ bpPush(ps,bfLeave bpPop1())
++ Do:
++ IN Namespace Do
++ DO Assign
-bpDo() ==
+bpDo ps ==
bpEqKey "IN" =>
- bpRequire function bpNamespace
- bpRequire function bpDo
- bpPush bfAtScope(bpPop2(),bpPop1())
- bpEqKey "DO" and bpRequire function bpAssign and
- bpPush bfDo bpPop1()
+ 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())
++ Return:
++ RETURN Assign
++ Leave
++ Throw
++ And
-bpReturn()==
- (bpEqKey "RETURN" and bpRequire function bpAssign and
- bpPush bfReturnNoName bpPop1())
- or bpLeave()
- or bpThrow()
- or bpAnd()
- or bpDo()
-
-
-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()
- or bpTry()
-
-bpLoop()==
- bpIterators() and
+bpReturn ps==
+ (bpEqKey "RETURN" and bpRequire(ps,function bpAssign) and
+ bpPush(ps,bfReturnNoName bpPop1()))
+ or bpLeave ps
+ or bpThrow ps
+ or bpAnd ps
+ or bpDo ps
+
+
+bpLogical ps ==
+ bpLeftAssoc(ps,'(OR),function bpReturn)
+
+bpExpression ps ==
+ bpEqKey "COLON" and (bpLogical ps and
+ bpPush(ps,bfApplication ("COLON",bpPop1()))
+ or bpTrap()) or bpLogical ps
+
+bpStatement ps ==
+ bpConditional(ps,function bpWhere) or bpLoop ps
+ or bpExpression ps
+ or bpTry ps
+
+bpLoop ps ==
+ bpIterators ps and
(bpCompMissing "REPEAT" and
- bpRequire function bpWhere and
- bpPush bfLp(bpPop2(),bpPop1()))
+ bpRequire(ps,function bpWhere) and
+ bpPush(ps,bfLp(bpPop2(),bpPop1())))
or
- bpEqKey "REPEAT" and bpRequire function bpLogical and
- bpPush bfLoop1 bpPop1 ()
+ bpEqKey "REPEAT" and bpRequire(ps,function bpLogical) and
+ bpPush(ps,bfLoop1 bpPop1())
-bpSuchThat()==bpAndOr("BAR",function bpWhere,function bfSuchthat)
+bpSuchThat ps ==
+ bpAndOr(ps,"BAR",function bpWhere,function bfSuchthat)
-bpWhile()==bpAndOr ("WHILE",function bpLogical,function bfWhile)
+bpWhile ps ==
+ bpAndOr(ps,"WHILE",function bpLogical,function bfWhile)
-bpUntil()==bpAndOr ("UNTIL",function bpLogical,function bfUntil)
+bpUntil ps ==
+ bpAndOr(ps,"UNTIL",function bpLogical,function bfUntil)
-bpFormal() ==
- bpVariable() or bpDot()
+bpFormal ps ==
+ bpVariable ps or bpDot ps
-bpForIn()==
- bpEqKey "FOR" and bpRequire function bpFormal and (bpCompMissing "IN")
- and (bpRequire function bpSeg and
- (bpEqKey "BY" and bpRequire function bpArith and
- bpPush bfForInBy(bpPop3(),bpPop2(),bpPop1())) or
- bpPush bfForin(bpPop2(),bpPop1()))
+bpForIn ps ==
+ bpEqKey "FOR" and bpRequire(ps,function bpFormal) and (bpCompMissing "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())))
-bpSeg()==
- bpArith() and
+bpSeg ps ==
+ bpArith ps and
(bpEqKey "SEG" and
- (bpArith() and bpPush(bfSegment2(bpPop2(),bpPop1()))
- or bpPush(bfSegment1(bpPop1()))) or true)
+ (bpArith ps and bpPush(ps,bfSegment2(bpPop2(),bpPop1()))
+ or bpPush(ps,bfSegment1(bpPop1()))) or true)
-bpIterator()==
- bpForIn() or bpSuchThat() or bpWhile() or bpUntil()
+bpIterator ps ==
+ bpForIn ps or bpSuchThat ps or bpWhile ps or bpUntil ps
-bpIteratorList()==
- bpOneOrMore function bpIterator
- and bpPush bfIterators bpPop1 ()
+bpIteratorList ps ==
+ bpOneOrMore(ps,function bpIterator)
+ and bpPush(ps,bfIterators bpPop1())
-bpCrossBackSet()==
+bpCrossBackSet ps ==
bpEqKey "CROSS" and (bpEqKey "BACKSET" or true)
-bpIterators()==
- bpListofFun(function bpIteratorList,
+bpIterators ps ==
+ bpListofFun(ps,function bpIteratorList,
function bpCrossBackSet,function bfCross)
-bpAssign()==
+bpAssign ps ==
a := bpState()
- bpStatement() =>
+ bpStatement ps =>
bpEqPeek "BEC" =>
bpRestore a
- bpRequire function bpAssignment
+ bpRequire(ps,function bpAssignment)
bpEqPeek "GIVES" =>
bpRestore a
- bpRequire function bpLambda
+ bpRequire(ps,function bpLambda)
bpEqPeek "LARROW" =>
bpRestore a
- bpRequire function bpKeyArg
+ bpRequire(ps,function bpKeyArg)
true
bpRestore a
false
-bpAssignment()==
- bpAssignVariable() and
+bpAssignment ps ==
+ bpAssignVariable ps and
bpEqKey "BEC" and
- bpRequire function bpAssign and
- bpPush bfAssign (bpPop2(),bpPop1())
+ bpRequire(ps,function bpAssign) and
+ bpPush(ps,bfAssign(bpPop2(),bpPop1()))
++ Parse a lambda expression
++ Lambda ::= Variable +-> Assign
-bpLambda() ==
- bpVariable() and
+bpLambda ps ==
+ bpVariable ps and
bpEqKey "GIVES" and
- bpRequire function bpAssign and
- bpPush bfLambda(bpPop2(),bpPop1())
+ bpRequire(ps,function bpAssign) and
+ bpPush(ps,bfLambda(bpPop2(),bpPop1()))
-bpKeyArg() ==
- bpName() and bpEqKey "LARROW" and bpLogical() and
- bpPush bfKeyArg(bpPop2(),bpPop1())
+bpKeyArg ps ==
+ bpName ps and bpEqKey "LARROW" and bpLogical ps and
+ bpPush(ps,bfKeyArg(bpPop2(),bpPop1()))
-- should only be allowed in sequences
-bpExit()==
- bpAssign() and (bpEqKey "EXIT" and
- (bpRequire function bpWhere and
- bpPush bfExit (bpPop2(),bpPop1()))
+bpExit ps ==
+ bpAssign ps and (bpEqKey "EXIT" and
+ (bpRequire(ps,function bpWhere) and
+ bpPush(ps,bfExit(bpPop2(),bpPop1())))
or true)
-bpDefinition()==
+bpDefinition ps ==
bpEqKey "MACRO" =>
- bpName() and bpStoreName() and bpCompoundDefinitionTail function %Macro
- or bpTrap()
+ bpName ps and bpStoreName() and
+ bpCompoundDefinitionTail(ps,function %Macro)
+ or bpTrap()
a := bpState()
- bpExit() =>
+ bpExit ps =>
bpEqPeek "DEF" =>
bpRestore a
- bpDef()
+ bpDef ps
bpEqPeek "TDEF" =>
bpRestore a
- bpTypeAliasDefition()
+ bpTypeAliasDefition ps
true
bpRestore a
false
@@ -927,157 +968,158 @@ bpStoreName()==
$typings := nil
true
-bpDef() ==
- bpName() and bpStoreName() and bpDefTail function %Definition
- or bpNamespace() and bpSimpleDefinitionTail()
+bpDef ps ==
+ bpName ps and bpStoreName() and bpDefTail(ps,function %Definition)
+ or bpNamespace ps and bpSimpleDefinitionTail ps
-bpDDef() == bpName() and bpDefTail function %Definition
+bpDDef ps ==
+ bpName ps and bpDefTail(ps,function %Definition)
++ Parse the remaining of a simple definition.
-bpSimpleDefinitionTail() ==
+bpSimpleDefinitionTail ps ==
bpEqKey "DEF" and
- bpRequire function bpWhere
- and bpPush %ConstantDefinition(bpPop2(), bpPop1())
+ bpRequire(ps,function bpWhere)
+ and bpPush(ps,%ConstantDefinition(bpPop2(), bpPop1()))
++ Parse the remaining of a compound definition.
-bpCompoundDefinitionTail f ==
- bpVariable() and
- bpEqKey "DEF" and bpRequire function bpWhere and
- bpPush apply(f,[bpPop3(),bpPop2(),bpPop1()])
+bpCompoundDefinitionTail(ps,f) ==
+ bpVariable ps and
+ bpEqKey "DEF" and bpRequire(ps,function bpWhere) and
+ bpPush(ps,apply(f,[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 f ==
- bpSimpleDefinitionTail()
- or bpCompoundDefinitionTail f
+bpDefTail(ps,f) ==
+ bpSimpleDefinitionTail ps
+ or bpCompoundDefinitionTail(ps,f)
-bpWhere()==
- bpDefinition() and
- (bpEqKey "WHERE" and bpRequire function bpDefinitionItem
- and bpPush bfWhere(bpPop1(),bpPop1()) or true)
+bpWhere ps ==
+ bpDefinition ps and
+ (bpEqKey "WHERE" and bpRequire(ps,function bpDefinitionItem)
+ and bpPush(ps,bfWhere(bpPop1(),bpPop1())) or true)
-bpDefinitionItem()==
+bpDefinitionItem ps ==
a := bpState()
- bpDDef() => true
+ bpDDef ps => true
bpRestore a
- bpBDefinitionPileItems() => true
+ bpBDefinitionPileItems ps => true
bpRestore a
- bpPDefinitionItems() => true
+ bpPDefinitionItems ps => true
bpRestore a
- bpWhere()
+ bpWhere ps
-bpDefinitionPileItems()==
- bpListAndRecover function bpDefinitionItem
- and bpPush %Pile bpPop1()
+bpDefinitionPileItems ps ==
+ bpListAndRecover(ps,function bpDefinitionItem)
+ and bpPush(ps,%Pile bpPop1())
-bpBDefinitionPileItems()== bpPileBracketed function bpDefinitionPileItems
+bpBDefinitionPileItems ps ==
+ bpPileBracketed(ps,function bpDefinitionPileItems)
-bpSemiColonDefinition()==bpSemiListing
- (function bpDefinitionItem,function %Pile)
+bpSemiColonDefinition ps ==
+ bpSemiListing(ps,function bpDefinitionItem,function %Pile)
-bpPDefinitionItems()==
- bpParenthesized function bpSemiColonDefinition
+bpPDefinitionItems ps ==
+ bpParenthesized(ps,function bpSemiColonDefinition)
-bpComma()==
- bpModule() or bpImport() or bpTuple function bpWhere
+bpComma ps ==
+ bpModule ps or bpImport ps or bpTuple(ps,function bpWhere)
-bpTuple(p) ==
- bpListofFun(p,function bpCommaBackSet,function bfTuple)
+bpTuple(ps,p) ==
+ bpListofFun(ps,p,function bpCommaBackSet,function bfTuple)
-bpCommaBackSet() ==
+bpCommaBackSet ps ==
bpEqKey "COMMA" and (bpEqKey "BACKSET" or true)
-bpSemiColon() ==
- bpSemiListing (function bpComma,function bfSequence)
+bpSemiColon ps ==
+ bpSemiListing(ps,function bpComma,function bfSequence)
-bpSemiListing(p,f) ==
- bpListofFun(p,function bpSemiBackSet,f)
+bpSemiListing(ps,p,f) ==
+ bpListofFun(ps,p,function bpSemiBackSet,f)
-bpSemiBackSet()==
+bpSemiBackSet ps ==
bpEqKey "SEMICOLON" and (bpEqKey "BACKSET" or true)
-bpPDefinition()==
- bpIndentParenthesized function bpSemiColon
+bpPDefinition ps ==
+ bpIndentParenthesized(ps,function bpSemiColon)
-bpPileItems()==
- bpListAndRecover function bpSemiColon and bpPush bfSequence bpPop1()
+bpPileItems ps ==
+ bpListAndRecover(ps,function bpSemiColon) and bpPush(ps,bfSequence bpPop1())
-bpBPileDefinition()==
- bpPileBracketed function bpPileItems
+bpBPileDefinition ps ==
+ bpPileBracketed(ps,function bpPileItems)
-bpIteratorTail()==
- (bpEqKey "REPEAT" or true) and bpIterators()
+bpIteratorTail ps ==
+ (bpEqKey "REPEAT" or true) and bpIterators ps
-bpConstruct()==
- bpBracket function bpConstruction
+bpConstruct ps ==
+ bpBracket(ps,function bpConstruction)
-bpConstruction()==
- bpComma() and
- (bpIteratorTail() and
- bpPush bfCollect (bpPop2(),bpPop1()) or
- bpPush bfTupleConstruct bpPop1())
+bpConstruction ps==
+ bpComma ps and
+ (bpIteratorTail ps and
+ bpPush(ps,bfCollect(bpPop2(),bpPop1())) or
+ bpPush(ps,bfTupleConstruct bpPop1()))
-bpDConstruct()==
- bpBracket function bpDConstruction
+bpDConstruct ps ==
+ bpBracket(ps,function bpDConstruction)
-bpDConstruction()==
- bpComma() and
- (bpIteratorTail() and
- bpPush bfDCollect (bpPop2(),bpPop1()) or
- bpPush bfDTuple bpPop1())
+bpDConstruction ps ==
+ bpComma ps and
+ (bpIteratorTail ps and
+ bpPush(ps,bfDCollect(bpPop2(),bpPop1())) or
+ bpPush(ps,bfDTuple bpPop1()))
--PATTERN
---bpNameOrDot() == bpName() or bpDot() or bpEqual()
+bpPattern ps ==
+ bpBracketConstruct(ps,function bpPatternL)
+ or bpChar ps or bpName ps or bpConstTok ps
-bpPattern()==
- bpBracketConstruct function bpPatternL
- or bpChar() or bpName() or bpConstTok()
+bpEqual ps ==
+ bpEqKey "SHOEEQ" and (bpApplication ps or bpConstTok ps or
+ bpTrap()) and bpPush(ps,bfEqual bpPop1())
-bpEqual()==
- bpEqKey "SHOEEQ" and (bpApplication() or bpConstTok() or
- bpTrap()) and bpPush bfEqual bpPop1()
+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)
+ or bpBracketConstruct(ps,function bpPatternL)
-bpRegularPatternItem() ==
- bpEqual() or
- bpConstTok() or bpDot() or
- bpName() and
- ((bpEqKey "BEC" and bpRequire function bpPattern
- and bpPush bfAssign(bpPop2(),bpPop1())) or true)
- or bpBracketConstruct function bpPatternL
+bpRegularPatternItemL ps ==
+ bpRegularPatternItem ps and bpPush(ps,[bpPop1()])
-bpRegularPatternItemL()==
- bpRegularPatternItem() and bpPush [bpPop1()]
+bpRegularList ps ==
+ bpListof(ps,function bpRegularPatternItemL,"COMMA",function bfAppend)
-bpRegularList()==
- bpListof(function bpRegularPatternItemL,"COMMA",function bfAppend)
-
-bpPatternColon()==
- bpEqKey "COLON" and bpRequire function bpRegularPatternItem
- and bpPush [bfColon bpPop1()]
+bpPatternColon ps ==
+ bpEqKey "COLON" and bpRequire(ps,function bpRegularPatternItem)
+ and bpPush(ps,[bfColon bpPop1()])
-- only one colon
-bpPatternL() == bpPatternList() and bpPush bfTuple bpPop1()
-
-bpPatternList()==
- bpRegularPatternItemL() =>
- while (bpEqKey "COMMA" and (bpRegularPatternItemL() or
- (bpPatternTail()
- and bpPush append(bpPop2(),bpPop1())
+bpPatternL ps ==
+ bpPatternList ps and bpPush(ps,bfTuple bpPop1())
+
+bpPatternList ps ==
+ bpRegularPatternItemL ps =>
+ while (bpEqKey "COMMA" and (bpRegularPatternItemL ps or
+ (bpPatternTail ps
+ and bpPush(ps,append(bpPop2(),bpPop1()))
or bpTrap();false) )) repeat
- bpPush append(bpPop2(),bpPop1())
+ bpPush(ps,append(bpPop2(),bpPop1()))
true
- bpPatternTail()
+ bpPatternTail ps
-bpPatternTail()==
- bpPatternColon() and
- (bpEqKey "COMMA" and bpRequire function bpRegularList
- and bpPush append (bpPop2(),bpPop1()) or true)
+bpPatternTail ps ==
+ bpPatternColon ps and
+ (bpEqKey "COMMA" and bpRequire(ps,function bpRegularList)
+ and bpPush(ps,append(bpPop2(),bpPop1())) or true)
-- BOUND VARIABLE
@@ -1086,179 +1128,180 @@ bpPatternTail()==
++ it might be followed by a type annotation, or whether it actually
++ a form with a specific pattern structure, or whether it has
++ a default value.
-bpRegularBVItemTail() ==
- bpEqKey "COLON" and bpRequire function bpApplication and
- bpPush bfTagged(bpPop2(), bpPop1())
- or bpEqKey "BEC" and bpRequire function bpPattern and
- bpPush bfAssign(bpPop2(),bpPop1())
- or bpEqKey "IS" and bpRequire function bpPattern and
- bpPush bfAssign(bpPop2(),bpPop1())
- or bpEqKey "DEF" and bpRequire function bpApplication and
- bpPush %DefaultValue(bpPop2(), bpPop1())
-
-
-bpRegularBVItem() ==
- bpBVString()
- or bpConstTok()
- or (bpName() and (bpRegularBVItemTail() or true))
- or bpBracketConstruct function bpPatternL
-
-bpBVString()==
+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()))
+
+
+bpRegularBVItem ps ==
+ bpBVString ps
+ or bpConstTok ps
+ or (bpName ps and (bpRegularBVItemTail ps or true))
+ or bpBracketConstruct(ps,function bpPatternL)
+
+bpBVString ps ==
tokenClass $stok = "STRING" and
- bpPush(["BVQUOTE",makeSymbol $ttok]) and bpNext()
+ bpPush(ps,["BVQUOTE",makeSymbol $ttok]) and bpNext()
-bpRegularBVItemL() ==
- bpRegularBVItem() and bpPush [bpPop1()]
+bpRegularBVItemL ps ==
+ bpRegularBVItem ps and bpPush(ps,[bpPop1()])
-bpColonName()==
- bpEqKey "COLON" and (bpName() or bpBVString() or bpTrap())
+bpColonName ps ==
+ bpEqKey "COLON" and (bpName ps or bpBVString ps or bpTrap())
-- at most one colon at end
-bpBoundVariablelist()==
- bpRegularBVItemL() =>
- while (bpEqKey "COMMA" and (bpRegularBVItemL() or
- (bpColonName()
- and bpPush bfColonAppend(bpPop2(),bpPop1())
+bpBoundVariablelist ps ==
+ bpRegularBVItemL ps =>
+ while (bpEqKey "COMMA" and (bpRegularBVItemL ps or
+ (bpColonName ps
+ and bpPush(ps,bfColonAppend(bpPop2(),bpPop1()))
or bpTrap();false) )) repeat
- bpPush append(bpPop2(),bpPop1())
+ bpPush(ps,append(bpPop2(),bpPop1()))
true
- bpColonName() and bpPush bfColonAppend(nil,bpPop1())
+ bpColonName ps and bpPush(ps,bfColonAppend(nil,bpPop1()))
-bpVariable()==
- bpParenthesized function bpBoundVariablelist and
- bpPush bfTupleIf bpPop1()
- or bpBracketConstruct function bpPatternL
- or bpName() or bpConstTok()
+bpVariable ps ==
+ bpParenthesized(ps,function bpBoundVariablelist) and
+ bpPush(ps,bfTupleIf bpPop1())
+ or bpBracketConstruct(ps,function bpPatternL)
+ or bpName ps or bpConstTok ps
-bpAssignVariable()==
- bpBracketConstruct function bpPatternL or bpAssignLHS()
+bpAssignVariable ps ==
+ bpBracketConstruct(ps,function bpPatternL) or bpAssignLHS ps
-bpAssignLHS()==
- not bpName() => false
+bpAssignLHS ps ==
+ not bpName ps => false
bpEqKey "COLON" => -- variable declaration
- bpRequire function bpApplication
- bpPush bfLocal(bpPop2(),bpPop1())
- bpArgumentList() and
+ bpRequire(ps,function bpApplication)
+ bpPush(ps,bfLocal(bpPop2(),bpPop1()))
+ bpArgumentList ps and
(bpEqPeek "DOT"
- or (bpEqPeek "BEC" and bpPush bfPlace bpPop1())
+ or (bpEqPeek "BEC" and bpPush(ps,bfPlace bpPop1()))
or bpTrap())
bpEqKey "DOT" => -- field path
- bpList(function bpPrimary,"DOT") and
- bpChecknull() and
- bpPush bfTuple([bpPop2(),:bpPop1()])
+ bpList(ps,function bpPrimary,"DOT") and
+ bpChecknull ps and
+ bpPush(ps,bfTuple([bpPop2(),:bpPop1()]))
true
-bpChecknull()==
+bpChecknull ps ==
a := bpPop1()
a = nil => bpTrap()
- bpPush a
+ bpPush(ps,a)
-bpStruct()==
+bpStruct ps ==
bpEqKey "STRUCTURE" and
- bpRequire function bpName and
+ bpRequire(ps,function bpName) and
(bpEqKey "DEF" or bpTrap()) and
- (bpRecord() or bpTypeList()) and
- bpPush %Structure(bpPop2(),bpPop1())
+ (bpRecord ps or bpTypeList ps) and
+ bpPush(ps,%Structure(bpPop2(),bpPop1()))
++ Record:
++ "Record" "(" FieldList ")"
-bpRecord() ==
+bpRecord ps ==
s := bpState()
- bpName() and bpPop1() is "Record" =>
- (bpParenthesized function bpFieldList or bpTrap()) and
- bpGlobalAccessors() and
- bpPush %Record(bfUntuple bpPop2(),bpPop1())
+ bpName ps and bpPop1() is "Record" =>
+ (bpParenthesized(ps,function bpFieldList) or bpTrap()) and
+ bpGlobalAccessors ps and
+ bpPush(ps,%Record(bfUntuple bpPop2(),bpPop1()))
bpRestore s
false
++ FieldList:
++ Signature
++ Signature , FieldList
-bpFieldList() ==
- bpTuple function bpSignature
+bpFieldList ps ==
+ bpTuple(ps,function bpSignature)
-bpGlobalAccessors() ==
+bpGlobalAccessors ps ==
bpEqKey "WITH" =>
- bpPileBracketed function bpAccessorDefinitionList or bpTrap()
- bpPush nil
+ bpPileBracketed(ps,function bpAccessorDefinitionList) or bpTrap()
+ bpPush(ps,nil)
-bpAccessorDefinitionList() ==
- bpListAndRecover function bpAccessorDefinition
+bpAccessorDefinitionList ps ==
+ bpListAndRecover(ps,function bpAccessorDefinition)
++ AccessorDefinition:
++ Name DEF FieldSection
-bpAccessorDefinition() ==
- bpRequire function bpName and
+bpAccessorDefinition ps ==
+ bpRequire(ps,function bpName) and
(bpEqKey "DEF" or bpTrap()) and
- bpRequire function bpFieldSection and
- bpPush %AccessorDef(bpPop2(),bpPop1())
+ bpRequire(ps,function bpFieldSection) and
+ bpPush(ps,%AccessorDef(bpPop2(),bpPop1()))
++ FieldSection:
++ "(" DOT Name ")"
-bpFieldSection() ==
- bpParenthesized function bpSelectField
+bpFieldSection ps ==
+ bpParenthesized(ps,function bpSelectField)
-bpSelectField() ==
- bpEqKey "DOT" and bpName()
+bpSelectField ps ==
+ bpEqKey "DOT" and bpName ps
-bpTypeList() ==
- bpPileBracketed function bpTypeItemList
- or bpTypeItem() and bpPush [bpPop1()]
+bpTypeList ps ==
+ bpPileBracketed(ps,function bpTypeItemList)
+ or bpTypeItem ps and bpPush(ps,[bpPop1()])
-bpTypeItem() ==
- bpTerm function bpIdList
+bpTypeItem ps ==
+ bpTerm(ps,function bpIdList)
-bpTypeItemList() ==
- bpListAndRecover function bpTypeItem
+bpTypeItemList ps ==
+ bpListAndRecover(ps,function bpTypeItem)
-bpTerm idListParser ==
- bpRequire function bpName and
- ((bpParenthesized idListParser and
- bpPush bfNameArgs (bpPop2(),bpPop1()))
- or bpName() and bpPush bfNameArgs(bpPop2(),bpPop1()))
- or bpPush(bfNameOnly bpPop1())
+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())
-bpIdList()==
- bpTuple function bpName
+bpIdList ps ==
+ bpTuple(ps,function bpName)
-bpCase()==
+bpCase ps ==
bpEqKey "CASE" and
- bpRequire function bpWhere and
+ bpRequire(ps,function bpWhere) and
(bpEqKey "OF" or bpMissing "OF") and
- bpPiledCaseItems()
+ bpPiledCaseItems ps
-bpPiledCaseItems()==
- bpPileBracketed function bpCaseItemList and
- bpPush bfCase(bpPop2(),bpPop1())
+bpPiledCaseItems ps ==
+ bpPileBracketed(ps,function bpCaseItemList) and
+ bpPush(ps,bfCase(bpPop2(),bpPop1()))
-bpCaseItemList()==
- bpListAndRecover function bpCaseItem
+bpCaseItemList ps ==
+ bpListAndRecover(ps,function bpCaseItem)
-bpCasePatternVar() ==
- bpName() or bpDot()
+bpCasePatternVar ps ==
+ bpName ps or bpDot ps
-bpCasePatternVarList() ==
- bpTuple function bpCasePatternVar
+bpCasePatternVarList ps ==
+ bpTuple(ps,function bpCasePatternVar)
-bpCaseItem()==
- (bpTerm function bpCasePatternVarList or bpTrap()) and
+bpCaseItem ps ==
+ (bpTerm(ps,function bpCasePatternVarList) or bpTrap()) and
(bpEqKey "EXIT" or bpTrap()) and
- bpRequire function bpWhere and
- bpPush bfCaseItem (bpPop2(),bpPop1())
+ bpRequire(ps,function bpWhere) and
+ bpPush(ps,bfCaseItem(bpPop2(),bpPop1()))
++ Main entry point into the parser module.
-bpOutItem()==
+bpOutItem ps ==
$op: local := nil
$GenVarCounter: local := 0
- bpRequire function bpComma
+ bpRequire(ps,function bpComma)
b := bpPop1()
- bpPush
+ t :=
b is ["+LINE",:.] => [ b ]
b is ["L%T",l,r] and symbol? l =>
$InteractiveMode => [["SETQ",l,r]]
[["DEFPARAMETER",l,r]]
translateToplevel(b,false)
+ bpPush(ps,t)
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index ce957612..3ecb4580 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -20,7 +20,9 @@
(READ-FROM-STRING
(CONCAT "(" (|subString| |s| |n| (- |l| |n|)) ")")))))))
-(DEFUN |shoeConsole| (|line|) (WRITE-LINE |line| *TERMINAL-IO*))
+(DEFUN |shoeConsole| (|line|)
+ (DECLARE (SPECIAL |$stdio|))
+ (WRITE-LINE |line| |$stdio|))
(DEFUN |shoeSpaces| (|n|) (|makeString| |n| (|char| '|.|)))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index e4862eb5..e876b3ba 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -9,6 +9,50 @@
(PROVIDE "parser")
+(DEFSTRUCT (|%ParserState| (:COPIER |copy%ParserState|))
+ |toks|
+ |trees|
+ |pren|
+ |scp|)
+
+(DEFMACRO |mk%ParserState| (|toks| |trees| |pren| |scp|)
+ (LIST '|MAKE-%ParserState| :|toks| |toks| :|trees| |trees| :|pren| |pren|
+ :|scp| |scp|))
+
+(DEFMACRO |parserTokens| (|bfVar#1|) (LIST '|%ParserState-toks| |bfVar#1|))
+
+(DEFMACRO |parserTrees| (|bfVar#1|) (LIST '|%ParserState-trees| |bfVar#1|))
+
+(DEFMACRO |parserNesting| (|bfVar#1|) (LIST '|%ParserState-pren| |bfVar#1|))
+
+(DEFMACRO |parserScope| (|bfVar#1|) (LIST '|%ParserState-scp| |bfVar#1|))
+
+(DEFUN |makeParserState| (|toks|) (|mk%ParserState| |toks| NIL 0 0))
+
+(DEFSTRUCT (|%Translator| (:COPIER |copy%Translator|))
+ |ipath|
+ |fdefs|
+ |sigs|
+ |xports|
+ |csts|)
+
+(DEFMACRO |mk%Translator| (|ipath| |fdefs| |sigs| |xports| |csts|)
+ (LIST '|MAKE-%Translator| :|ipath| |ipath| :|fdefs| |fdefs| :|sigs| |sigs|
+ :|xports| |xports| :|csts| |csts|))
+
+(DEFMACRO |inputFilePath| (|bfVar#1|) (LIST '|%Translator-ifile| |bfVar#1|))
+
+(DEFMACRO |functionDefinitions| (|bfVar#1|)
+ (LIST '|%Translator-fdefs| |bfVar#1|))
+
+(DEFMACRO |globalSignatures| (|bfVar#1|) (LIST '|%Translator-sigs| |bfVar#1|))
+
+(DEFMACRO |exportedNames| (|bfVar#1|) (LIST '|%Translator-xports| |bfVar#1|))
+
+(DEFMACRO |constantBindings| (|bfVar#1|) (LIST '|%Translator-csts| |bfVar#1|))
+
+(DEFUN |makeTranslator| (|ip|) (|mk%Translator| |ip| NIL NIL NIL NIL))
+
(DEFUN |bpFirstToken| ()
(DECLARE (SPECIAL |$ttok| |$stok| |$inputStream|))
(PROGN
@@ -45,7 +89,7 @@
(DECLARE (SPECIAL |$inputStream|))
(PROGN (SETQ |$inputStream| (CDR |$inputStream|)) (|bpFirstToken|)))
-(DEFUN |bpRequire| (|f|) (OR (APPLY |f| NIL) (|bpTrap|)))
+(DEFUN |bpRequire| (|ps| |f|) (OR (APPLY |f| |ps| NIL) (|bpTrap|)))
(DEFUN |bpState| ()
(DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|))
@@ -61,11 +105,11 @@
(SETQ |$bpCount| (CADDDR |x|))
T))
-(DEFUN |bpPush| (|x|)
+(DEFUN |bpPush| (|ps| |x|)
(DECLARE (SPECIAL |$stack|))
(SETQ |$stack| (CONS |x| |$stack|)))
-(DEFUN |bpPushId| ()
+(DEFUN |bpPushId| (|ps|)
(DECLARE (SPECIAL |$stack| |$ttok|))
(SETQ |$stack| (CONS (|bfReName| |$ttok|) |$stack|)))
@@ -87,7 +131,7 @@
(RPLACD (CDR |$stack|) (CDDDR |$stack|))
|a|)))
-(DEFUN |bpIndentParenthesized| (|f|)
+(DEFUN |bpIndentParenthesized| (|ps| |f|)
(LET* (|a|)
(DECLARE (SPECIAL |$inputStream| |$bpParenCount| |$stok|))
(LET ((|$bpCount| 0))
@@ -98,7 +142,7 @@
((|bpEqPeek| 'OPAREN) (SETQ |$bpParenCount| (+ |$bpParenCount| 1))
(|bpNext|)
(COND
- ((AND (APPLY |f| NIL) (|bpFirstTok|)
+ ((AND (APPLY |f| |ps| NIL) (|bpFirstTok|)
(OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|)))
(SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|)
(COND ((EQL |$bpCount| 0) T)
@@ -107,12 +151,12 @@
(|append| (|bpAddTokens| |$bpCount|) |$inputStream|))
(|bpFirstToken|)
(COND ((EQL |$bpParenCount| 0) (|bpCancel|) T) (T T)))))
- ((|bpEqPeek| 'CPAREN) (|bpPush| (|bfTuple| NIL))
+ ((|bpEqPeek| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL))
(SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|) T)
(T (|bpParenTrap| |a|))))
(T NIL))))))
-(DEFUN |bpParenthesized| (|f|)
+(DEFUN |bpParenthesized| (|ps| |f|)
(LET* (|a|)
(DECLARE (SPECIAL |$stok|))
(PROGN
@@ -120,12 +164,14 @@
(COND
((|bpEqKey| 'OPAREN)
(COND
- ((AND (APPLY |f| NIL) (OR (|bpEqKey| 'CPAREN) (|bpParenTrap| |a|))) T)
- ((|bpEqKey| 'CPAREN) (|bpPush| (|bfTuple| NIL)) T)
+ ((AND (APPLY |f| |ps| NIL)
+ (OR (|bpEqKey| 'CPAREN) (|bpParenTrap| |a|)))
+ T)
+ ((|bpEqKey| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL)) T)
(T (|bpParenTrap| |a|))))
(T NIL)))))
-(DEFUN |bpBracket| (|f|)
+(DEFUN |bpBracket| (|ps| |f|)
(LET* (|a|)
(DECLARE (SPECIAL |$stok|))
(PROGN
@@ -133,110 +179,118 @@
(COND
((|bpEqKey| 'OBRACK)
(COND
- ((AND (APPLY |f| NIL) (OR (|bpEqKey| 'CBRACK) (|bpBrackTrap| |a|)))
- (|bpPush| (|bfBracket| (|bpPop1|))))
- ((|bpEqKey| 'CBRACK) (|bpPush| NIL)) (T (|bpBrackTrap| |a|))))
+ ((AND (APPLY |f| |ps| NIL)
+ (OR (|bpEqKey| 'CBRACK) (|bpBrackTrap| |a|)))
+ (|bpPush| |ps| (|bfBracket| (|bpPop1|))))
+ ((|bpEqKey| 'CBRACK) (|bpPush| |ps| NIL)) (T (|bpBrackTrap| |a|))))
(T NIL)))))
-(DEFUN |bpPileBracketed| (|f|)
+(DEFUN |bpPileBracketed| (|ps| |f|)
(COND
((|bpEqKey| 'SETTAB)
(COND ((|bpEqKey| 'BACKTAB) T)
- ((AND (APPLY |f| NIL) (OR (|bpEqKey| 'BACKTAB) (|bpPileTrap|)))
- (|bpPush| (|bfPile| (|bpPop1|))))
+ ((AND (APPLY |f| |ps| NIL) (OR (|bpEqKey| 'BACKTAB) (|bpPileTrap|)))
+ (|bpPush| |ps| (|bfPile| (|bpPop1|))))
(T NIL)))
(T NIL)))
-(DEFUN |bpListof| (|f| |str1| |g|)
+(DEFUN |bpListof| (|ps| |f| |str1| |g|)
(LET* (|a|)
(DECLARE (SPECIAL |$stack|))
(COND
- ((APPLY |f| NIL)
+ ((APPLY |f| |ps| NIL)
(COND
- ((AND (|bpEqKey| |str1|) (|bpRequire| |f|)) (SETQ |a| |$stack|)
+ ((AND (|bpEqKey| |str1|) (|bpRequire| |ps| |f|)) (SETQ |a| |$stack|)
(SETQ |$stack| NIL)
(LOOP
- (COND ((NOT (AND (|bpEqKey| |str1|) (|bpRequire| |f|))) (RETURN NIL))
- (T 0)))
+ (COND
+ ((NOT (AND (|bpEqKey| |str1|) (|bpRequire| |ps| |f|))) (RETURN NIL))
+ (T NIL)))
(SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
- (|bpPush|
- (FUNCALL |g| (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
+ (|bpPush| |ps|
+ (FUNCALL |g|
+ (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
(T T)))
(T NIL))))
-(DEFUN |bpListofFun| (|f| |h| |g|)
+(DEFUN |bpListofFun| (|ps| |f| |h| |g|)
(LET* (|a|)
(DECLARE (SPECIAL |$stack|))
(COND
- ((APPLY |f| NIL)
+ ((APPLY |f| |ps| NIL)
(COND
- ((AND (APPLY |h| NIL) (|bpRequire| |f|)) (SETQ |a| |$stack|)
+ ((AND (APPLY |h| |ps| NIL) (|bpRequire| |ps| |f|)) (SETQ |a| |$stack|)
(SETQ |$stack| NIL)
(LOOP
- (COND ((NOT (AND (APPLY |h| NIL) (|bpRequire| |f|))) (RETURN NIL))
- (T 0)))
+ (COND
+ ((NOT (AND (APPLY |h| |ps| NIL) (|bpRequire| |ps| |f|)))
+ (RETURN NIL))
+ (T NIL)))
(SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
- (|bpPush|
- (FUNCALL |g| (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
+ (|bpPush| |ps|
+ (FUNCALL |g|
+ (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
(T T)))
(T NIL))))
-(DEFUN |bpList| (|f| |str1|)
+(DEFUN |bpList| (|ps| |f| |str1|)
(LET* (|a|)
(DECLARE (SPECIAL |$stack|))
(COND
- ((APPLY |f| NIL)
+ ((APPLY |f| |ps| NIL)
(COND
- ((AND (|bpEqKey| |str1|) (|bpRequire| |f|)) (SETQ |a| |$stack|)
+ ((AND (|bpEqKey| |str1|) (|bpRequire| |ps| |f|)) (SETQ |a| |$stack|)
(SETQ |$stack| NIL)
(LOOP
- (COND ((NOT (AND (|bpEqKey| |str1|) (|bpRequire| |f|))) (RETURN NIL))
- (T 0)))
+ (COND
+ ((NOT (AND (|bpEqKey| |str1|) (|bpRequire| |ps| |f|))) (RETURN NIL))
+ (T NIL)))
(SETQ |$stack| (CONS (|reverse!| |$stack|) |a|))
- (|bpPush| (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|)))))
- (T (|bpPush| (LIST (|bpPop1|))))))
- (T (|bpPush| NIL)))))
+ (|bpPush| |ps| (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|)))))
+ (T (|bpPush| |ps| (LIST (|bpPop1|))))))
+ (T (|bpPush| |ps| NIL)))))
-(DEFUN |bpOneOrMore| (|f|)
+(DEFUN |bpOneOrMore| (|ps| |f|)
(LET* (|a|)
(DECLARE (SPECIAL |$stack|))
(COND
- ((APPLY |f| NIL) (SETQ |a| |$stack|) (SETQ |$stack| NIL)
- (LOOP (COND ((NOT (APPLY |f| NIL)) (RETURN NIL)) (T 0)))
+ ((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| (CONS (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps| (CONS (|bpPop2|) (|bpPop1|))))
(T NIL))))
-(DEFUN |bpAnyNo| (|s|)
- (PROGN (LOOP (COND ((NOT (APPLY |s| NIL)) (RETURN NIL)) (T 0))) T))
+(DEFUN |bpAnyNo| (|ps| |s|)
+ (PROGN (LOOP (COND ((NOT (APPLY |s| |ps| NIL)) (RETURN NIL)) (T NIL))) T))
-(DEFUN |bpAndOr| (|keyword| |p| |f|)
- (AND (|bpEqKey| |keyword|) (|bpRequire| |p|)
- (|bpPush| (FUNCALL |f| (|bpPop1|)))))
+(DEFUN |bpAndOr| (|ps| |keyword| |p| |f|)
+ (AND (|bpEqKey| |keyword|) (|bpRequire| |ps| |p|)
+ (|bpPush| |ps| (FUNCALL |f| (|bpPop1|)))))
-(DEFUN |bpConditional| (|f|)
+(DEFUN |bpConditional| (|ps| |f|)
(COND
- ((AND (|bpEqKey| 'IF) (|bpRequire| #'|bpWhere|) (OR (|bpEqKey| 'BACKSET) T))
+ ((AND (|bpEqKey| 'IF) (|bpRequire| |ps| #'|bpWhere|)
+ (OR (|bpEqKey| 'BACKSET) T))
(COND
((|bpEqKey| 'SETTAB)
(COND
((|bpEqKey| 'THEN)
- (AND (|bpRequire| |f|) (|bpElse| |f|) (|bpEqKey| 'BACKTAB)))
+ (AND (|bpRequire| |ps| |f|) (|bpElse| |ps| |f|) (|bpEqKey| 'BACKTAB)))
(T (|bpMissing| 'THEN))))
- ((|bpEqKey| 'THEN) (AND (|bpRequire| |f|) (|bpElse| |f|)))
+ ((|bpEqKey| 'THEN) (AND (|bpRequire| |ps| |f|) (|bpElse| |ps| |f|)))
(T (|bpMissing| '|then|))))
(T NIL)))
-(DEFUN |bpElse| (|f|)
+(DEFUN |bpElse| (|ps| |f|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpState|))
(COND
((|bpBacksetElse|)
- (AND (|bpRequire| |f|)
- (|bpPush| (|bfIf| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))
+ (AND (|bpRequire| |ps| |f|)
+ (|bpPush| |ps| (|bfIf| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))
(T (|bpRestore| |a|)
- (|bpPush| (|bfIfThenOnly| (|bpPop2|) (|bpPop1|))))))))
+ (|bpPush| |ps| (|bfIfThenOnly| (|bpPop2|) (|bpPop1|))))))))
(DEFUN |bpBacksetElse| ()
(COND ((|bpEqKey| 'BACKSET) (|bpEqKey| 'ELSE)) (T (|bpEqKey| 'ELSE))))
@@ -278,7 +332,7 @@
(THROW :OPEN-AXIOM-CATCH-POINT
(CONS :OPEN-AXIOM-CATCH-POINT (CONS '(|BootParserException|) 'TRAPPED)))))
-(DEFUN |bpRecoverTrap| ()
+(DEFUN |bpRecoverTrap| (|ps|)
(LET* (|pos2| |pos1|)
(DECLARE (SPECIAL |$stok|))
(PROGN
@@ -287,9 +341,9 @@
(|bpMoveTo| 0)
(SETQ |pos2| (|tokenPosition| |$stok|))
(|bpIgnoredFromTo| |pos1| |pos2|)
- (|bpPush| (LIST (LIST "pile syntax error"))))))
+ (|bpPush| |ps| (LIST (LIST "pile syntax error"))))))
-(DEFUN |bpListAndRecover| (|f|)
+(DEFUN |bpListAndRecover| (|ps| |f|)
(LET* (|found| |c| |done| |b| |a|)
(DECLARE (SPECIAL |$inputStream| |$stack|))
(PROGN
@@ -303,7 +357,8 @@
(T
(SETQ |found|
(LET ((#1=#:G719
- (CATCH :OPEN-AXIOM-CATCH-POINT (APPLY |f| NIL))))
+ (CATCH :OPEN-AXIOM-CATCH-POINT
+ (APPLY |f| |ps| NIL))))
(COND
((AND (CONSP #1#)
(EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
@@ -315,21 +370,21 @@
(T #1#))))
(COND
((EQ |found| 'TRAPPED) (SETQ |$inputStream| |c|)
- (|bpRecoverTrap|))
+ (|bpRecoverTrap| |ps|))
((NOT |found|) (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|)
- (|bpRecoverTrap|)))
+ (|bpRecoverTrap| |ps|)))
(COND ((|bpEqKey| 'BACKSET) (SETQ |c| |$inputStream|))
((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|))
(SETQ |done| T))
(T (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|)
- (|bpRecoverTrap|)
+ (|bpRecoverTrap| |ps|)
(COND
((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|))
(SETQ |done| T))
(T (|bpNext|) (SETQ |c| |$inputStream|)))))
(SETQ |b| (CONS (|bpPop1|) |b|)))))
(SETQ |$stack| |a|)
- (|bpPush| (|reverse!| |b|)))))
+ (|bpPush| |ps| (|reverse!| |b|)))))
(DEFUN |bpMoveTo| (|n|)
(DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$inputStream|))
@@ -347,136 +402,142 @@
(SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpMoveTo| |n|))
(T (|bpNextToken|) (|bpMoveTo| |n|))))
-(DEFUN |bpQualifiedName| ()
+(DEFUN |bpQualifiedName| (|ps|)
(DECLARE (SPECIAL |$stok|))
(COND
((|bpEqPeek| 'COLON-COLON) (|bpNext|)
- (AND (EQ (|tokenClass| |$stok|) 'ID) (|bpPushId|) (|bpNext|)
- (|bpPush| (|bfColonColon| (|bpPop2|) (|bpPop1|)))))
+ (AND (EQ (|tokenClass| |$stok|) 'ID) (|bpPushId| |ps|) (|bpNext|)
+ (|bpPush| |ps| (|bfColonColon| (|bpPop2|) (|bpPop1|)))))
(T NIL)))
-(DEFUN |bpName| ()
+(DEFUN |bpName| (|ps|)
(DECLARE (SPECIAL |$stok|))
(COND
- ((EQ (|tokenClass| |$stok|) 'ID) (|bpPushId|) (|bpNext|)
- (|bpAnyNo| #'|bpQualifiedName|))
+ ((EQ (|tokenClass| |$stok|) 'ID) (|bpPushId| |ps|) (|bpNext|)
+ (|bpAnyNo| |ps| #'|bpQualifiedName|))
(T NIL)))
-(DEFUN |bpConstTok| ()
+(DEFUN |bpConstTok| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(COND
((|symbolMember?| (|tokenClass| |$stok|) '(INTEGER FLOAT))
- (|bpPush| |$ttok|) (|bpNext|))
+ (|bpPush| |ps| |$ttok|) (|bpNext|))
((EQ (|tokenClass| |$stok|) 'LISP)
- (AND (|bpPush| (|%Lisp| |$ttok|)) (|bpNext|)))
- ((EQ (|tokenClass| |$stok|) 'LISPEXP) (AND (|bpPush| |$ttok|) (|bpNext|)))
+ (AND (|bpPush| |ps| (|%Lisp| |$ttok|)) (|bpNext|)))
+ ((EQ (|tokenClass| |$stok|) 'LISPEXP)
+ (AND (|bpPush| |ps| |$ttok|) (|bpNext|)))
((EQ (|tokenClass| |$stok|) 'LINE)
- (AND (|bpPush| (LIST '+LINE |$ttok|)) (|bpNext|)))
+ (AND (|bpPush| |ps| (LIST '+LINE |$ttok|)) (|bpNext|)))
((|bpEqPeek| 'QUOTE) (|bpNext|)
- (AND (|bpRequire| #'|bpSexp|) (|bpPush| (|bfSymbol| (|bpPop1|)))))
- (T (OR (|bpString|) (|bpFunction|)))))
+ (AND (|bpRequire| |ps| #'|bpSexp|)
+ (|bpPush| |ps| (|bfSymbol| (|bpPop1|)))))
+ (T (OR (|bpString| |ps|) (|bpFunction| |ps|)))))
-(DEFUN |bpChar| ()
+(DEFUN |bpChar| (|ps|)
(LET* (|ISTMP#1| |s| |a|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(COND
((AND (EQ (|tokenClass| |$stok|) 'ID) (EQ |$ttok| '|char|))
(SETQ |a| (|bpState|))
(COND
- ((|bpApplication|) (SETQ |s| (|bpPop1|))
+ ((|bpApplication| |ps|) (SETQ |s| (|bpPop1|))
(COND
((AND (CONSP |s|) (EQ (CAR |s|) '|char|)
(PROGN
(SETQ |ISTMP#1| (CDR |s|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))))
- (|bpPush| |s|))
+ (|bpPush| |ps| |s|))
(T (|bpRestore| |a|) NIL)))
(T NIL)))
(T NIL))))
-(DEFUN |bpExportItemTail| ()
+(DEFUN |bpExportItemTail| (|ps|)
(OR
- (AND (|bpEqKey| 'BEC) (|bpRequire| #'|bpAssign|)
- (|bpPush| (|%Assignment| (|bpPop2|) (|bpPop1|))))
- (|bpSimpleDefinitionTail|)))
+ (AND (|bpEqKey| 'BEC) (|bpRequire| |ps| #'|bpAssign|)
+ (|bpPush| |ps| (|%Assignment| (|bpPop2|) (|bpPop1|))))
+ (|bpSimpleDefinitionTail| |ps|)))
-(DEFUN |bpExportItem| ()
+(DEFUN |bpExportItem| (|ps|)
(LET* (|a|)
- (COND ((|bpEqPeek| 'STRUCTURE) (|bpStruct|))
+ (COND ((|bpEqPeek| 'STRUCTURE) (|bpStruct| |ps|))
(T (SETQ |a| (|bpState|))
(COND
- ((|bpName|)
+ ((|bpName| |ps|)
(COND
((|bpEqPeek| 'COLON) (|bpRestore| |a|)
- (|bpRequire| #'|bpSignature|) (OR (|bpExportItemTail|) T))
- (T (|bpRestore| |a|) (|bpTypeAliasDefition|))))
+ (|bpRequire| |ps| #'|bpSignature|)
+ (OR (|bpExportItemTail| |ps|) T))
+ (T (|bpRestore| |a|) (|bpTypeAliasDefition| |ps|))))
(T NIL))))))
-(DEFUN |bpExportItemList| () (|bpListAndRecover| #'|bpExportItem|))
+(DEFUN |bpExportItemList| (|ps|) (|bpListAndRecover| |ps| #'|bpExportItem|))
-(DEFUN |bpModuleInterface| ()
+(DEFUN |bpModuleInterface| (|ps|)
(COND
((|bpEqKey| 'WHERE)
- (OR (|bpPileBracketed| #'|bpExportItemList|)
- (AND (|bpExportItem|) (|bpPush| (LIST (|bpPop1|)))) (|bpTrap|)))
- (T (|bpPush| NIL))))
+ (OR (|bpPileBracketed| |ps| #'|bpExportItemList|)
+ (AND (|bpExportItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1|))))
+ (|bpTrap|)))
+ (T (|bpPush| |ps| NIL))))
-(DEFUN |bpModuleExports| ()
- (COND ((|bpParenthesized| #'|bpIdList|) (|bpPush| (|bfUntuple| (|bpPop1|))))
- (T (|bpPush| NIL))))
+(DEFUN |bpModuleExports| (|ps|)
+ (COND
+ ((|bpParenthesized| |ps| #'|bpIdList|)
+ (|bpPush| |ps| (|bfUntuple| (|bpPop1|))))
+ (T (|bpPush| |ps| NIL))))
-(DEFUN |bpModule| ()
+(DEFUN |bpModule| (|ps|)
(COND
- ((|bpEqKey| 'MODULE) (|bpRequire| #'|bpName|) (|bpModuleExports|)
- (|bpModuleInterface|)
- (|bpPush| (|%Module| (|bpPop3|) (|bpPop2|) (|bpPop1|))))
+ ((|bpEqKey| 'MODULE) (|bpRequire| |ps| #'|bpName|) (|bpModuleExports| |ps|)
+ (|bpModuleInterface| |ps|)
+ (|bpPush| |ps| (|%Module| (|bpPop3|) (|bpPop2|) (|bpPop1|))))
(T NIL)))
-(DEFUN |bpImport| ()
+(DEFUN |bpImport| (|ps|)
(LET* (|a|)
(COND
((|bpEqKey| 'IMPORT)
(COND
((|bpEqKey| 'NAMESPACE)
(OR
- (AND (|bpLeftAssoc| '(DOT) #'|bpName|)
- (|bpPush| (|%Import| (|bfNamespace| (|bpPop1|)))))
+ (AND (|bpLeftAssoc| |ps| '(DOT) #'|bpName|)
+ (|bpPush| |ps| (|%Import| (|bfNamespace| (|bpPop1|)))))
(|bpTrap|)))
- (T (SETQ |a| (|bpState|)) (|bpRequire| #'|bpName|)
+ (T (SETQ |a| (|bpState|)) (|bpRequire| |ps| #'|bpName|)
(COND
((|bpEqPeek| 'COLON) (|bpRestore| |a|)
- (AND (|bpRequire| #'|bpSignature|) (OR (|bpEqKey| 'FOR) (|bpTrap|))
- (|bpRequire| #'|bpName|)
- (|bpPush| (|%ImportSignature| (|bpPop1|) (|bpPop1|)))))
- (T (|bpPush| (|%Import| (|bpPop1|))))))))
+ (AND (|bpRequire| |ps| #'|bpSignature|)
+ (OR (|bpEqKey| 'FOR) (|bpTrap|)) (|bpRequire| |ps| #'|bpName|)
+ (|bpPush| |ps| (|%ImportSignature| (|bpPop1|) (|bpPop1|)))))
+ (T (|bpPush| |ps| (|%Import| (|bpPop1|))))))))
(T NIL))))
-(DEFUN |bpNamespace| ()
- (AND (|bpEqKey| 'NAMESPACE) (OR (|bpName|) (|bpDot|))
- (|bpPush| (|bfNamespace| (|bpPop1|)))))
+(DEFUN |bpNamespace| (|ps|)
+ (AND (|bpEqKey| 'NAMESPACE) (OR (|bpName| |ps|) (|bpDot| |ps|))
+ (|bpPush| |ps| (|bfNamespace| (|bpPop1|)))))
-(DEFUN |bpTypeAliasDefition| ()
- (AND (OR (|bpTerm| #'|bpIdList|) (|bpTrap|)) (|bpEqKey| 'TDEF) (|bpLogical|)
- (|bpPush| (|%TypeAlias| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpTypeAliasDefition| (|ps|)
+ (AND (OR (|bpTerm| |ps| #'|bpIdList|) (|bpTrap|)) (|bpEqKey| 'TDEF)
+ (|bpLogical| |ps|) (|bpPush| |ps| (|%TypeAlias| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpSignature| ()
- (AND (|bpName|) (|bpEqKey| 'COLON) (|bpRequire| #'|bpTyping|)
- (|bpPush| (|%Signature| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpSignature| (|ps|)
+ (AND (|bpName| |ps|) (|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpTyping|)
+ (|bpPush| |ps| (|%Signature| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpSimpleMapping| ()
+(DEFUN |bpSimpleMapping| (|ps|)
(COND
- ((|bpApplication|)
- (AND (|bpEqKey| 'ARROW) (|bpRequire| #'|bpApplication|)
- (|bpPush| (|%Mapping| (|bpPop1|) (LIST (|bpPop1|)))))
+ ((|bpApplication| |ps|)
+ (AND (|bpEqKey| 'ARROW) (|bpRequire| |ps| #'|bpApplication|)
+ (|bpPush| |ps| (|%Mapping| (|bpPop1|) (LIST (|bpPop1|)))))
T)
(T NIL)))
-(DEFUN |bpArgtypeList| () (|bpTuple| #'|bpSimpleMapping|))
+(DEFUN |bpArgtypeList| (|ps|) (|bpTuple| |ps| #'|bpSimpleMapping|))
-(DEFUN |bpMapping| ()
- (AND (|bpParenthesized| #'|bpArgtypeList|) (|bpEqKey| 'ARROW)
- (|bpApplication|)
- (|bpPush| (|%Mapping| (|bpPop1|) (|bfUntuple| (|bpPop1|))))))
+(DEFUN |bpMapping| (|ps|)
+ (AND (|bpParenthesized| |ps| #'|bpArgtypeList|) (|bpEqKey| 'ARROW)
+ (|bpApplication| |ps|)
+ (|bpPush| |ps| (|%Mapping| (|bpPop1|) (|bfUntuple| (|bpPop1|))))))
(DEFUN |bpCancel| ()
(LET* (|a|)
@@ -505,243 +566,258 @@
(|bpEqPeek| 'CPAREN) (|bpEqPeek| 'SETTAB) (|bpEqPeek| 'BACKTAB)
(|bpEqPeek| 'BACKSET)))
-(DEFUN |bpSexpKey| ()
+(DEFUN |bpSexpKey| (|ps|)
(LET* (|a|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(COND
((AND (EQ (|tokenClass| |$stok|) 'KEY) (NOT (|bpExceptions|)))
(SETQ |a| (GET |$ttok| 'SHOEINF))
- (COND ((NULL |a|) (AND (|bpPush| (|keywordId| |$ttok|)) (|bpNext|)))
- (T (AND (|bpPush| |a|) (|bpNext|)))))
+ (COND ((NULL |a|) (AND (|bpPush| |ps| (|keywordId| |$ttok|)) (|bpNext|)))
+ (T (AND (|bpPush| |ps| |a|) (|bpNext|)))))
(T NIL))))
-(DEFUN |bpAnyId| ()
+(DEFUN |bpAnyId| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(OR
(AND (|bpEqKey| 'MINUS) (OR (EQ (|tokenClass| |$stok|) 'INTEGER) (|bpTrap|))
- (|bpPush| (- |$ttok|)) (|bpNext|))
- (|bpSexpKey|)
+ (|bpPush| |ps| (- |$ttok|)) (|bpNext|))
+ (|bpSexpKey| |ps|)
(AND (|symbolMember?| (|tokenClass| |$stok|) '(ID INTEGER STRING FLOAT))
- (|bpPush| |$ttok|) (|bpNext|))))
+ (|bpPush| |ps| |$ttok|) (|bpNext|))))
-(DEFUN |bpSexp| ()
- (OR (|bpAnyId|)
- (AND (|bpEqKey| 'QUOTE) (|bpRequire| #'|bpSexp|)
- (|bpPush| (|bfSymbol| (|bpPop1|))))
- (|bpIndentParenthesized| #'|bpSexp1|)))
+(DEFUN |bpSexp| (|ps|)
+ (OR (|bpAnyId| |ps|)
+ (AND (|bpEqKey| 'QUOTE) (|bpRequire| |ps| #'|bpSexp|)
+ (|bpPush| |ps| (|bfSymbol| (|bpPop1|))))
+ (|bpIndentParenthesized| |ps| #'|bpSexp1|)))
-(DEFUN |bpSexp1| ()
+(DEFUN |bpSexp1| (|ps|)
(OR
- (AND (|bpFirstTok|) (|bpSexp|)
+ (AND (|bpFirstTok|) (|bpSexp| |ps|)
(OR
- (AND (|bpEqKey| 'DOT) (|bpSexp|)
- (|bpPush| (CONS (|bpPop2|) (|bpPop1|))))
- (AND (|bpSexp1|) (|bpPush| (CONS (|bpPop2|) (|bpPop1|))))))
- (|bpPush| NIL)))
+ (AND (|bpEqKey| 'DOT) (|bpSexp| |ps|)
+ (|bpPush| |ps| (CONS (|bpPop2|) (|bpPop1|))))
+ (AND (|bpSexp1| |ps|) (|bpPush| |ps| (CONS (|bpPop2|) (|bpPop1|))))))
+ (|bpPush| |ps| NIL)))
-(DEFUN |bpPrimary1| ()
- (OR (|bpParenthesizedApplication|) (|bpDot|) (|bpConstTok|) (|bpConstruct|)
- (|bpCase|) (|bpStruct|) (|bpPDefinition|) (|bpBPileDefinition|)))
+(DEFUN |bpPrimary1| (|ps|)
+ (OR (|bpParenthesizedApplication| |ps|) (|bpDot| |ps|) (|bpConstTok| |ps|)
+ (|bpConstruct| |ps|) (|bpCase| |ps|) (|bpStruct| |ps|)
+ (|bpPDefinition| |ps|) (|bpBPileDefinition| |ps|)))
-(DEFUN |bpParenthesizedApplication| ()
- (AND (|bpName|) (|bpAnyNo| #'|bpArgumentList|)))
+(DEFUN |bpParenthesizedApplication| (|ps|)
+ (AND (|bpName| |ps|) (|bpAnyNo| |ps| #'|bpArgumentList|)))
-(DEFUN |bpArgumentList| ()
- (AND (|bpPDefinition|) (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpArgumentList| (|ps|)
+ (AND (|bpPDefinition| |ps|)
+ (|bpPush| |ps| (|bfApplication| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpPrimary| ()
- (AND (|bpFirstTok|) (OR (|bpPrimary1|) (|bpPrefixOperator|))))
+(DEFUN |bpPrimary| (|ps|)
+ (AND (|bpFirstTok|) (OR (|bpPrimary1| |ps|) (|bpPrefixOperator| |ps|))))
-(DEFUN |bpDot| () (AND (|bpEqKey| 'DOT) (|bpPush| (|bfDot|))))
+(DEFUN |bpDot| (|ps|) (AND (|bpEqKey| 'DOT) (|bpPush| |ps| (|bfDot|))))
-(DEFUN |bpPrefixOperator| ()
+(DEFUN |bpPrefixOperator| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
- (AND (EQ (|tokenClass| |$stok|) 'KEY) (GET |$ttok| 'SHOEPRE) (|bpPushId|)
- (|bpNext|)))
+ (AND (EQ (|tokenClass| |$stok|) 'KEY) (GET |$ttok| 'SHOEPRE)
+ (|bpPushId| |ps|) (|bpNext|)))
-(DEFUN |bpInfixOperator| ()
+(DEFUN |bpInfixOperator| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
- (AND (EQ (|tokenClass| |$stok|) 'KEY) (GET |$ttok| 'SHOEINF) (|bpPushId|)
- (|bpNext|)))
+ (AND (EQ (|tokenClass| |$stok|) 'KEY) (GET |$ttok| 'SHOEINF)
+ (|bpPushId| |ps|) (|bpNext|)))
-(DEFUN |bpSelector| ()
+(DEFUN |bpSelector| (|ps|)
(AND (|bpEqKey| 'DOT)
- (OR (AND (|bpPrimary|) (|bpPush| (|bfElt| (|bpPop2|) (|bpPop1|))))
- (|bpPush| (|bfSuffixDot| (|bpPop1|))))))
+ (OR
+ (AND (|bpPrimary| |ps|)
+ (|bpPush| |ps| (|bfElt| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps| (|bfSuffixDot| (|bpPop1|))))))
-(DEFUN |bpApplication| ()
+(DEFUN |bpApplication| (|ps|)
(OR
- (AND (|bpPrimary|) (|bpAnyNo| #'|bpSelector|)
+ (AND (|bpPrimary| |ps|) (|bpAnyNo| |ps| #'|bpSelector|)
(OR
- (AND (|bpApplication|)
- (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpApplication| |ps|)
+ (|bpPush| |ps| (|bfApplication| (|bpPop2|) (|bpPop1|))))
T))
- (|bpNamespace|)))
+ (|bpNamespace| |ps|)))
-(DEFUN |bpTyping| ()
+(DEFUN |bpTyping| (|ps|)
(COND
- ((|bpEqKey| 'FORALL) (|bpRequire| #'|bpVariable|)
- (OR (AND (|bpDot|) (|bpPop1|)) (|bpTrap|)) (|bpRequire| #'|bpTyping|)
- (|bpPush| (|%Forall| (|bpPop2|) (|bpPop1|))))
- (T (OR (|bpMapping|) (|bpSimpleMapping|)))))
-
-(DEFUN |bpTyped| ()
- (AND (|bpApplication|)
+ ((|bpEqKey| 'FORALL) (|bpRequire| |ps| #'|bpVariable|)
+ (OR (AND (|bpDot| |ps|) (|bpPop1|)) (|bpTrap|))
+ (|bpRequire| |ps| #'|bpTyping|)
+ (|bpPush| |ps| (|%Forall| (|bpPop2|) (|bpPop1|))))
+ (T (OR (|bpMapping| |ps|) (|bpSimpleMapping| |ps|)))))
+
+(DEFUN |bpTyped| (|ps|)
+ (AND (|bpApplication| |ps|)
(COND
((|bpEqKey| 'COLON)
- (AND (|bpRequire| #'|bpTyping|)
- (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|)))))
+ (AND (|bpRequire| |ps| #'|bpTyping|)
+ (|bpPush| |ps| (|bfTagged| (|bpPop2|) (|bpPop1|)))))
((|bpEqKey| 'AT)
- (AND (|bpRequire| #'|bpTyping|)
- (|bpPush| (|bfRestrict| (|bpPop2|) (|bpPop1|)))))
+ (AND (|bpRequire| |ps| #'|bpTyping|)
+ (|bpPush| |ps| (|bfRestrict| (|bpPop2|) (|bpPop1|)))))
(T T))))
-(DEFUN |bpExpt| () (|bpRightAssoc| '(POWER) #'|bpTyped|))
+(DEFUN |bpExpt| (|ps|) (|bpRightAssoc| |ps| '(POWER) #'|bpTyped|))
-(DEFUN |bpInfKey| (|s|)
+(DEFUN |bpInfKey| (|ps| |s|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(AND (EQ (|tokenClass| |$stok|) 'KEY) (|symbolMember?| |$ttok| |s|)
- (|bpPushId|) (|bpNext|)))
+ (|bpPushId| |ps|) (|bpNext|)))
-(DEFUN |bpInfGeneric| (|s|) (AND (|bpInfKey| |s|) (OR (|bpEqKey| 'BACKSET) T)))
+(DEFUN |bpInfGeneric| (|ps| |s|)
+ (AND (|bpInfKey| |ps| |s|) (OR (|bpEqKey| 'BACKSET) T)))
-(DEFUN |bpRightAssoc| (|o| |p|)
+(DEFUN |bpRightAssoc| (|ps| |o| |p|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpState|))
(COND
- ((APPLY |p| NIL)
+ ((APPLY |p| |ps| NIL)
(LOOP
(COND
((NOT
- (AND (|bpInfGeneric| |o|) (OR (|bpRightAssoc| |o| |p|) (|bpTrap|))))
+ (AND (|bpInfGeneric| |ps| |o|)
+ (OR (|bpRightAssoc| |ps| |o| |p|) (|bpTrap|))))
(RETURN NIL))
- (T (|bpPush| (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))))
+ (T
+ (|bpPush| |ps|
+ (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))))
T)
(T (|bpRestore| |a|) NIL)))))
-(DEFUN |bpLeftAssoc| (|operations| |parser|)
+(DEFUN |bpLeftAssoc| (|ps| |operations| |parser|)
(COND
- ((APPLY |parser| NIL)
+ ((APPLY |parser| |ps| NIL)
(LOOP
(COND
- ((NOT (AND (|bpInfGeneric| |operations|) (|bpRequire| |parser|)))
+ ((NOT
+ (AND (|bpInfGeneric| |ps| |operations|) (|bpRequire| |ps| |parser|)))
(RETURN NIL))
- (T (|bpPush| (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))))
+ (T
+ (|bpPush| |ps| (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))))
T)
(T NIL)))
-(DEFUN |bpString| ()
+(DEFUN |bpString| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(AND (EQ (|tokenClass| |$stok|) 'STRING)
- (|bpPush| (|quote| (INTERN |$ttok|))) (|bpNext|)))
+ (|bpPush| |ps| (|quote| (INTERN |$ttok|))) (|bpNext|)))
-(DEFUN |bpFunction| ()
- (AND (|bpEqKey| 'FUNCTION) (|bpRequire| #'|bpPrimary1|)
- (|bpPush| (|bfFunction| (|bpPop1|)))))
+(DEFUN |bpFunction| (|ps|)
+ (AND (|bpEqKey| 'FUNCTION) (|bpRequire| |ps| #'|bpPrimary1|)
+ (|bpPush| |ps| (|bfFunction| (|bpPop1|)))))
-(DEFUN |bpThetaName| ()
+(DEFUN |bpThetaName| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(COND
- ((AND (EQ (|tokenClass| |$stok|) 'ID) (GET |$ttok| 'SHOETHETA)) (|bpPushId|)
- (|bpNext|))
+ ((AND (EQ (|tokenClass| |$stok|) 'ID) (GET |$ttok| 'SHOETHETA))
+ (|bpPushId| |ps|) (|bpNext|))
(T NIL)))
-(DEFUN |bpReduceOperator| ()
- (OR (|bpInfixOperator|) (|bpString|) (|bpThetaName|)))
+(DEFUN |bpReduceOperator| (|ps|)
+ (OR (|bpInfixOperator| |ps|) (|bpString| |ps|) (|bpThetaName| |ps|)))
-(DEFUN |bpReduce| ()
+(DEFUN |bpReduce| (|ps|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpState|))
(COND
- ((AND (|bpReduceOperator|) (|bpEqKey| 'SLASH))
+ ((AND (|bpReduceOperator| |ps|) (|bpEqKey| 'SLASH))
(COND
((|bpEqPeek| 'OBRACK)
- (AND (|bpRequire| #'|bpDConstruct|)
- (|bpPush| (|bfReduceCollect| (|bpPop2|) (|bpPop1|)))))
+ (AND (|bpRequire| |ps| #'|bpDConstruct|)
+ (|bpPush| |ps| (|bfReduceCollect| (|bpPop2|) (|bpPop1|)))))
(T
- (AND (|bpRequire| #'|bpApplication|)
- (|bpPush| (|bfReduce| (|bpPop2|) (|bpPop1|)))))))
+ (AND (|bpRequire| |ps| #'|bpApplication|)
+ (|bpPush| |ps| (|bfReduce| (|bpPop2|) (|bpPop1|)))))))
(T (|bpRestore| |a|) NIL)))))
-(DEFUN |bpTimes| () (OR (|bpReduce|) (|bpLeftAssoc| '(TIMES SLASH) #'|bpExpt|)))
+(DEFUN |bpTimes| (|ps|)
+ (OR (|bpReduce| |ps|) (|bpLeftAssoc| |ps| '(TIMES SLASH) #'|bpExpt|)))
-(DEFUN |bpEuclid| () (|bpLeftAssoc| '(QUO REM) #'|bpTimes|))
+(DEFUN |bpEuclid| (|ps|) (|bpLeftAssoc| |ps| '(QUO REM) #'|bpTimes|))
-(DEFUN |bpMinus| ()
+(DEFUN |bpMinus| (|ps|)
(OR
- (AND (|bpInfGeneric| '(MINUS)) (|bpRequire| #'|bpEuclid|)
- (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|))))
- (|bpEuclid|)))
+ (AND (|bpInfGeneric| |ps| '(MINUS)) (|bpRequire| |ps| #'|bpEuclid|)
+ (|bpPush| |ps| (|bfApplication| (|bpPop2|) (|bpPop1|))))
+ (|bpEuclid| |ps|)))
-(DEFUN |bpArith| () (|bpLeftAssoc| '(PLUS MINUS) #'|bpMinus|))
+(DEFUN |bpArith| (|ps|) (|bpLeftAssoc| |ps| '(PLUS MINUS) #'|bpMinus|))
-(DEFUN |bpIs| ()
- (AND (|bpArith|)
+(DEFUN |bpIs| (|ps|)
+ (AND (|bpArith| |ps|)
(COND
- ((AND (|bpInfKey| '(IS ISNT)) (|bpRequire| #'|bpPattern|))
- (|bpPush| (|bfISApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))
- ((AND (|bpEqKey| 'HAS) (|bpRequire| #'|bpApplication|))
- (|bpPush| (|bfHas| (|bpPop2|) (|bpPop1|))))
+ ((AND (|bpInfKey| |ps| '(IS ISNT)) (|bpRequire| |ps| #'|bpPattern|))
+ (|bpPush| |ps| (|bfISApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))
+ ((AND (|bpEqKey| 'HAS) (|bpRequire| |ps| #'|bpApplication|))
+ (|bpPush| |ps| (|bfHas| (|bpPop2|) (|bpPop1|))))
(T T))))
-(DEFUN |bpBracketConstruct| (|f|)
- (AND (|bpBracket| |f|) (|bpPush| (|bfConstruct| (|bpPop1|)))))
+(DEFUN |bpBracketConstruct| (|ps| |f|)
+ (AND (|bpBracket| |ps| |f|) (|bpPush| |ps| (|bfConstruct| (|bpPop1|)))))
-(DEFUN |bpCompare| ()
+(DEFUN |bpCompare| (|ps|)
(OR
- (AND (|bpIs|)
+ (AND (|bpIs| |ps|)
(OR
- (AND (|bpInfKey| '(SHOEEQ SHOENE LT LE GT GE IN))
- (|bpRequire| #'|bpIs|)
- (|bpPush| (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))
+ (AND (|bpInfKey| |ps| '(SHOEEQ SHOENE LT LE GT GE IN))
+ (|bpRequire| |ps| #'|bpIs|)
+ (|bpPush| |ps|
+ (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))
T))
- (|bpLeave|) (|bpThrow|)))
+ (|bpLeave| |ps|) (|bpThrow| |ps|)))
-(DEFUN |bpAnd| () (|bpLeftAssoc| '(AND) #'|bpCompare|))
+(DEFUN |bpAnd| (|ps|) (|bpLeftAssoc| |ps| '(AND) #'|bpCompare|))
-(DEFUN |bpThrow| ()
+(DEFUN |bpThrow| (|ps|)
(COND
- ((AND (|bpEqKey| 'THROW) (|bpApplication|))
+ ((AND (|bpEqKey| 'THROW) (|bpApplication| |ps|))
(COND
- ((|bpEqKey| 'COLON) (|bpRequire| #'|bpApplication|)
- (|bpPush| (|%Pretend| (|bpPop2|) (|bpPop1|)))))
- (|bpPush| (|bfThrow| (|bpPop1|))))
+ ((|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpApplication|)
+ (|bpPush| |ps| (|%Pretend| (|bpPop2|) (|bpPop1|)))))
+ (|bpPush| |ps| (|bfThrow| (|bpPop1|))))
(T NIL)))
-(DEFUN |bpTry| ()
+(DEFUN |bpTry| (|ps|)
(LET* (|cs|)
(COND
- ((|bpEqKey| 'TRY) (|bpAssign|) (SETQ |cs| NIL)
+ ((|bpEqKey| 'TRY) (|bpAssign| |ps|) (SETQ |cs| NIL)
(LOOP
(COND ((NOT (|bpHandler| 'CATCH)) (RETURN NIL))
- (T (|bpCatchItem|) (SETQ |cs| (CONS (|bpPop1|) |cs|)))))
+ (T (|bpCatchItem| |ps|) (SETQ |cs| (CONS (|bpPop1|) |cs|)))))
(COND
((|bpHandler| 'FINALLY)
- (AND (|bpFinally|)
- (|bpPush|
- (|bfTry| (|bpPop2|) (|reverse!| (CONS (|bpPop1|) |cs|))))))
+ (AND (|bpFinally| |ps|)
+ (|bpPush| |ps|
+ (|bfTry| (|bpPop2|)
+ (|reverse!| (CONS (|bpPop1|) |cs|))))))
((NULL |cs|) (|bpTrap|))
- (T (|bpPush| (|bfTry| (|bpPop1|) (|reverse!| |cs|))))))
+ (T (|bpPush| |ps| (|bfTry| (|bpPop1|) (|reverse!| |cs|))))))
(T NIL))))
-(DEFUN |bpCatchItem| ()
- (AND (|bpRequire| #'|bpExceptionVariable|) (OR (|bpEqKey| 'EXIT) (|bpTrap|))
- (|bpRequire| #'|bpAssign|) (|bpPush| (|%Catch| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpCatchItem| (|ps|)
+ (AND (|bpRequire| |ps| #'|bpExceptionVariable|)
+ (OR (|bpEqKey| 'EXIT) (|bpTrap|)) (|bpRequire| |ps| #'|bpAssign|)
+ (|bpPush| |ps| (|%Catch| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpExceptionVariable| ()
+(DEFUN |bpExceptionVariable| (|ps|)
(LET* (|t|)
(DECLARE (SPECIAL |$stok|))
(PROGN
(SETQ |t| |$stok|)
(OR
- (AND (|bpEqKey| 'OPAREN) (|bpRequire| #'|bpSignature|)
+ (AND (|bpEqKey| 'OPAREN) (|bpRequire| |ps| #'|bpSignature|)
(OR (|bpEqKey| 'CPAREN) (|bpMissing| |t|)))
(|bpTrap|)))))
-(DEFUN |bpFinally| ()
- (AND (|bpRequire| #'|bpAssign|) (|bpPush| (|%Finally| (|bpPop1|)))))
+(DEFUN |bpFinally| (|ps|)
+ (AND (|bpRequire| |ps| #'|bpAssign|) (|bpPush| |ps| (|%Finally| (|bpPop1|)))))
(DEFUN |bpHandler| (|key|)
(LET* (|s|)
@@ -752,121 +828,136 @@
T)
(T (|bpRestore| |s|) NIL)))))
-(DEFUN |bpLeave| ()
- (AND (|bpEqKey| 'LEAVE) (|bpRequire| #'|bpLogical|)
- (|bpPush| (|bfLeave| (|bpPop1|)))))
+(DEFUN |bpLeave| (|ps|)
+ (AND (|bpEqKey| 'LEAVE) (|bpRequire| |ps| #'|bpLogical|)
+ (|bpPush| |ps| (|bfLeave| (|bpPop1|)))))
-(DEFUN |bpDo| ()
+(DEFUN |bpDo| (|ps|)
(COND
- ((|bpEqKey| 'IN) (|bpRequire| #'|bpNamespace|) (|bpRequire| #'|bpDo|)
- (|bpPush| (|bfAtScope| (|bpPop2|) (|bpPop1|))))
+ ((|bpEqKey| 'IN) (|bpRequire| |ps| #'|bpNamespace|)
+ (|bpRequire| |ps| #'|bpDo|)
+ (|bpPush| |ps| (|bfAtScope| (|bpPop2|) (|bpPop1|))))
(T
- (AND (|bpEqKey| 'DO) (|bpRequire| #'|bpAssign|)
- (|bpPush| (|bfDo| (|bpPop1|)))))))
+ (AND (|bpEqKey| 'DO) (|bpRequire| |ps| #'|bpAssign|)
+ (|bpPush| |ps| (|bfDo| (|bpPop1|)))))))
-(DEFUN |bpReturn| ()
+(DEFUN |bpReturn| (|ps|)
(OR
- (AND (|bpEqKey| 'RETURN) (|bpRequire| #'|bpAssign|)
- (|bpPush| (|bfReturnNoName| (|bpPop1|))))
- (|bpLeave|) (|bpThrow|) (|bpAnd|) (|bpDo|)))
+ (AND (|bpEqKey| 'RETURN) (|bpRequire| |ps| #'|bpAssign|)
+ (|bpPush| |ps| (|bfReturnNoName| (|bpPop1|))))
+ (|bpLeave| |ps|) (|bpThrow| |ps|) (|bpAnd| |ps|) (|bpDo| |ps|)))
-(DEFUN |bpLogical| () (|bpLeftAssoc| '(OR) #'|bpReturn|))
+(DEFUN |bpLogical| (|ps|) (|bpLeftAssoc| |ps| '(OR) #'|bpReturn|))
-(DEFUN |bpExpression| ()
+(DEFUN |bpExpression| (|ps|)
(OR
(AND (|bpEqKey| 'COLON)
- (OR (AND (|bpLogical|) (|bpPush| (|bfApplication| 'COLON (|bpPop1|))))
- (|bpTrap|)))
- (|bpLogical|)))
+ (OR
+ (AND (|bpLogical| |ps|)
+ (|bpPush| |ps| (|bfApplication| 'COLON (|bpPop1|))))
+ (|bpTrap|)))
+ (|bpLogical| |ps|)))
-(DEFUN |bpStatement| ()
- (OR (|bpConditional| #'|bpWhere|) (|bpLoop|) (|bpExpression|) (|bpTry|)))
+(DEFUN |bpStatement| (|ps|)
+ (OR (|bpConditional| |ps| #'|bpWhere|) (|bpLoop| |ps|) (|bpExpression| |ps|)
+ (|bpTry| |ps|)))
-(DEFUN |bpLoop| ()
+(DEFUN |bpLoop| (|ps|)
(OR
- (AND (|bpIterators|) (|bpCompMissing| 'REPEAT) (|bpRequire| #'|bpWhere|)
- (|bpPush| (|bfLp| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'REPEAT) (|bpRequire| #'|bpLogical|)
- (|bpPush| (|bfLoop1| (|bpPop1|))))))
+ (AND (|bpIterators| |ps|) (|bpCompMissing| 'REPEAT)
+ (|bpRequire| |ps| #'|bpWhere|)
+ (|bpPush| |ps| (|bfLp| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'REPEAT) (|bpRequire| |ps| #'|bpLogical|)
+ (|bpPush| |ps| (|bfLoop1| (|bpPop1|))))))
-(DEFUN |bpSuchThat| () (|bpAndOr| 'BAR #'|bpWhere| #'|bfSuchthat|))
+(DEFUN |bpSuchThat| (|ps|) (|bpAndOr| |ps| 'BAR #'|bpWhere| #'|bfSuchthat|))
-(DEFUN |bpWhile| () (|bpAndOr| 'WHILE #'|bpLogical| #'|bfWhile|))
+(DEFUN |bpWhile| (|ps|) (|bpAndOr| |ps| 'WHILE #'|bpLogical| #'|bfWhile|))
-(DEFUN |bpUntil| () (|bpAndOr| 'UNTIL #'|bpLogical| #'|bfUntil|))
+(DEFUN |bpUntil| (|ps|) (|bpAndOr| |ps| 'UNTIL #'|bpLogical| #'|bfUntil|))
-(DEFUN |bpFormal| () (OR (|bpVariable|) (|bpDot|)))
+(DEFUN |bpFormal| (|ps|) (OR (|bpVariable| |ps|) (|bpDot| |ps|)))
-(DEFUN |bpForIn| ()
- (AND (|bpEqKey| 'FOR) (|bpRequire| #'|bpFormal|) (|bpCompMissing| 'IN)
+(DEFUN |bpForIn| (|ps|)
+ (AND (|bpEqKey| 'FOR) (|bpRequire| |ps| #'|bpFormal|) (|bpCompMissing| 'IN)
(OR
- (AND (|bpRequire| #'|bpSeg|) (|bpEqKey| 'BY) (|bpRequire| #'|bpArith|)
- (|bpPush| (|bfForInBy| (|bpPop3|) (|bpPop2|) (|bpPop1|))))
- (|bpPush| (|bfForin| (|bpPop2|) (|bpPop1|))))))
+ (AND (|bpRequire| |ps| #'|bpSeg|) (|bpEqKey| 'BY)
+ (|bpRequire| |ps| #'|bpArith|)
+ (|bpPush| |ps| (|bfForInBy| (|bpPop3|) (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps| (|bfForin| (|bpPop2|) (|bpPop1|))))))
-(DEFUN |bpSeg| ()
- (AND (|bpArith|)
+(DEFUN |bpSeg| (|ps|)
+ (AND (|bpArith| |ps|)
(OR
(AND (|bpEqKey| 'SEG)
(OR
- (AND (|bpArith|) (|bpPush| (|bfSegment2| (|bpPop2|) (|bpPop1|))))
- (|bpPush| (|bfSegment1| (|bpPop1|)))))
+ (AND (|bpArith| |ps|)
+ (|bpPush| |ps| (|bfSegment2| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps| (|bfSegment1| (|bpPop1|)))))
T)))
-(DEFUN |bpIterator| () (OR (|bpForIn|) (|bpSuchThat|) (|bpWhile|) (|bpUntil|)))
+(DEFUN |bpIterator| (|ps|)
+ (OR (|bpForIn| |ps|) (|bpSuchThat| |ps|) (|bpWhile| |ps|) (|bpUntil| |ps|)))
-(DEFUN |bpIteratorList| ()
- (AND (|bpOneOrMore| #'|bpIterator|) (|bpPush| (|bfIterators| (|bpPop1|)))))
+(DEFUN |bpIteratorList| (|ps|)
+ (AND (|bpOneOrMore| |ps| #'|bpIterator|)
+ (|bpPush| |ps| (|bfIterators| (|bpPop1|)))))
-(DEFUN |bpCrossBackSet| () (AND (|bpEqKey| 'CROSS) (OR (|bpEqKey| 'BACKSET) T)))
+(DEFUN |bpCrossBackSet| (|ps|)
+ (AND (|bpEqKey| 'CROSS) (OR (|bpEqKey| 'BACKSET) T)))
-(DEFUN |bpIterators| ()
- (|bpListofFun| #'|bpIteratorList| #'|bpCrossBackSet| #'|bfCross|))
+(DEFUN |bpIterators| (|ps|)
+ (|bpListofFun| |ps| #'|bpIteratorList| #'|bpCrossBackSet| #'|bfCross|))
-(DEFUN |bpAssign| ()
+(DEFUN |bpAssign| (|ps|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpState|))
(COND
- ((|bpStatement|)
+ ((|bpStatement| |ps|)
(COND
- ((|bpEqPeek| 'BEC) (|bpRestore| |a|) (|bpRequire| #'|bpAssignment|))
- ((|bpEqPeek| 'GIVES) (|bpRestore| |a|) (|bpRequire| #'|bpLambda|))
- ((|bpEqPeek| 'LARROW) (|bpRestore| |a|) (|bpRequire| #'|bpKeyArg|))
+ ((|bpEqPeek| 'BEC) (|bpRestore| |a|)
+ (|bpRequire| |ps| #'|bpAssignment|))
+ ((|bpEqPeek| 'GIVES) (|bpRestore| |a|) (|bpRequire| |ps| #'|bpLambda|))
+ ((|bpEqPeek| 'LARROW) (|bpRestore| |a|)
+ (|bpRequire| |ps| #'|bpKeyArg|))
(T T)))
(T (|bpRestore| |a|) NIL)))))
-(DEFUN |bpAssignment| ()
- (AND (|bpAssignVariable|) (|bpEqKey| 'BEC) (|bpRequire| #'|bpAssign|)
- (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpAssignment| (|ps|)
+ (AND (|bpAssignVariable| |ps|) (|bpEqKey| 'BEC)
+ (|bpRequire| |ps| #'|bpAssign|)
+ (|bpPush| |ps| (|bfAssign| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpLambda| ()
- (AND (|bpVariable|) (|bpEqKey| 'GIVES) (|bpRequire| #'|bpAssign|)
- (|bpPush| (|bfLambda| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpLambda| (|ps|)
+ (AND (|bpVariable| |ps|) (|bpEqKey| 'GIVES) (|bpRequire| |ps| #'|bpAssign|)
+ (|bpPush| |ps| (|bfLambda| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpKeyArg| ()
- (AND (|bpName|) (|bpEqKey| 'LARROW) (|bpLogical|)
- (|bpPush| (|bfKeyArg| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpKeyArg| (|ps|)
+ (AND (|bpName| |ps|) (|bpEqKey| 'LARROW) (|bpLogical| |ps|)
+ (|bpPush| |ps| (|bfKeyArg| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpExit| ()
- (AND (|bpAssign|)
+(DEFUN |bpExit| (|ps|)
+ (AND (|bpAssign| |ps|)
(OR
- (AND (|bpEqKey| 'EXIT) (|bpRequire| #'|bpWhere|)
- (|bpPush| (|bfExit| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'EXIT) (|bpRequire| |ps| #'|bpWhere|)
+ (|bpPush| |ps| (|bfExit| (|bpPop2|) (|bpPop1|))))
T)))
-(DEFUN |bpDefinition| ()
+(DEFUN |bpDefinition| (|ps|)
(LET* (|a|)
(COND
((|bpEqKey| 'MACRO)
(OR
- (AND (|bpName|) (|bpStoreName|) (|bpCompoundDefinitionTail| #'|%Macro|))
+ (AND (|bpName| |ps|) (|bpStoreName|)
+ (|bpCompoundDefinitionTail| |ps| #'|%Macro|))
(|bpTrap|)))
(T (SETQ |a| (|bpState|))
(COND
- ((|bpExit|)
- (COND ((|bpEqPeek| 'DEF) (|bpRestore| |a|) (|bpDef|))
- ((|bpEqPeek| 'TDEF) (|bpRestore| |a|) (|bpTypeAliasDefition|))
+ ((|bpExit| |ps|)
+ (COND ((|bpEqPeek| 'DEF) (|bpRestore| |a|) (|bpDef| |ps|))
+ ((|bpEqPeek| 'TDEF) (|bpRestore| |a|)
+ (|bpTypeAliasDefition| |ps|))
(T T)))
(T (|bpRestore| |a|) NIL))))))
@@ -878,320 +969,336 @@
(SETQ |$typings| NIL)
T))
-(DEFUN |bpDef| ()
- (OR (AND (|bpName|) (|bpStoreName|) (|bpDefTail| #'|%Definition|))
- (AND (|bpNamespace|) (|bpSimpleDefinitionTail|))))
+(DEFUN |bpDef| (|ps|)
+ (OR (AND (|bpName| |ps|) (|bpStoreName|) (|bpDefTail| |ps| #'|%Definition|))
+ (AND (|bpNamespace| |ps|) (|bpSimpleDefinitionTail| |ps|))))
-(DEFUN |bpDDef| () (AND (|bpName|) (|bpDefTail| #'|%Definition|)))
+(DEFUN |bpDDef| (|ps|) (AND (|bpName| |ps|) (|bpDefTail| |ps| #'|%Definition|)))
-(DEFUN |bpSimpleDefinitionTail| ()
- (AND (|bpEqKey| 'DEF) (|bpRequire| #'|bpWhere|)
- (|bpPush| (|%ConstantDefinition| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpSimpleDefinitionTail| (|ps|)
+ (AND (|bpEqKey| 'DEF) (|bpRequire| |ps| #'|bpWhere|)
+ (|bpPush| |ps| (|%ConstantDefinition| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpCompoundDefinitionTail| (|f|)
- (AND (|bpVariable|) (|bpEqKey| 'DEF) (|bpRequire| #'|bpWhere|)
- (|bpPush| (APPLY |f| (LIST (|bpPop3|) (|bpPop2|) (|bpPop1|))))))
+(DEFUN |bpCompoundDefinitionTail| (|ps| |f|)
+ (AND (|bpVariable| |ps|) (|bpEqKey| 'DEF) (|bpRequire| |ps| #'|bpWhere|)
+ (|bpPush| |ps| (APPLY |f| (LIST (|bpPop3|) (|bpPop2|) (|bpPop1|))))))
-(DEFUN |bpDefTail| (|f|)
- (OR (|bpSimpleDefinitionTail|) (|bpCompoundDefinitionTail| |f|)))
+(DEFUN |bpDefTail| (|ps| |f|)
+ (OR (|bpSimpleDefinitionTail| |ps|) (|bpCompoundDefinitionTail| |ps| |f|)))
-(DEFUN |bpWhere| ()
- (AND (|bpDefinition|)
+(DEFUN |bpWhere| (|ps|)
+ (AND (|bpDefinition| |ps|)
(OR
- (AND (|bpEqKey| 'WHERE) (|bpRequire| #'|bpDefinitionItem|)
- (|bpPush| (|bfWhere| (|bpPop1|) (|bpPop1|))))
+ (AND (|bpEqKey| 'WHERE) (|bpRequire| |ps| #'|bpDefinitionItem|)
+ (|bpPush| |ps| (|bfWhere| (|bpPop1|) (|bpPop1|))))
T)))
-(DEFUN |bpDefinitionItem| ()
+(DEFUN |bpDefinitionItem| (|ps|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpState|))
- (COND ((|bpDDef|) T)
+ (COND ((|bpDDef| |ps|) T)
(T (|bpRestore| |a|)
- (COND ((|bpBDefinitionPileItems|) T)
+ (COND ((|bpBDefinitionPileItems| |ps|) T)
(T (|bpRestore| |a|)
- (COND ((|bpPDefinitionItems|) T)
- (T (|bpRestore| |a|) (|bpWhere|))))))))))
+ (COND ((|bpPDefinitionItems| |ps|) T)
+ (T (|bpRestore| |a|) (|bpWhere| |ps|))))))))))
-(DEFUN |bpDefinitionPileItems| ()
- (AND (|bpListAndRecover| #'|bpDefinitionItem|)
- (|bpPush| (|%Pile| (|bpPop1|)))))
+(DEFUN |bpDefinitionPileItems| (|ps|)
+ (AND (|bpListAndRecover| |ps| #'|bpDefinitionItem|)
+ (|bpPush| |ps| (|%Pile| (|bpPop1|)))))
-(DEFUN |bpBDefinitionPileItems| ()
- (|bpPileBracketed| #'|bpDefinitionPileItems|))
+(DEFUN |bpBDefinitionPileItems| (|ps|)
+ (|bpPileBracketed| |ps| #'|bpDefinitionPileItems|))
-(DEFUN |bpSemiColonDefinition| ()
- (|bpSemiListing| #'|bpDefinitionItem| #'|%Pile|))
+(DEFUN |bpSemiColonDefinition| (|ps|)
+ (|bpSemiListing| |ps| #'|bpDefinitionItem| #'|%Pile|))
-(DEFUN |bpPDefinitionItems| () (|bpParenthesized| #'|bpSemiColonDefinition|))
+(DEFUN |bpPDefinitionItems| (|ps|)
+ (|bpParenthesized| |ps| #'|bpSemiColonDefinition|))
-(DEFUN |bpComma| () (OR (|bpModule|) (|bpImport|) (|bpTuple| #'|bpWhere|)))
+(DEFUN |bpComma| (|ps|)
+ (OR (|bpModule| |ps|) (|bpImport| |ps|) (|bpTuple| |ps| #'|bpWhere|)))
-(DEFUN |bpTuple| (|p|) (|bpListofFun| |p| #'|bpCommaBackSet| #'|bfTuple|))
+(DEFUN |bpTuple| (|ps| |p|)
+ (|bpListofFun| |ps| |p| #'|bpCommaBackSet| #'|bfTuple|))
-(DEFUN |bpCommaBackSet| () (AND (|bpEqKey| 'COMMA) (OR (|bpEqKey| 'BACKSET) T)))
+(DEFUN |bpCommaBackSet| (|ps|)
+ (AND (|bpEqKey| 'COMMA) (OR (|bpEqKey| 'BACKSET) T)))
-(DEFUN |bpSemiColon| () (|bpSemiListing| #'|bpComma| #'|bfSequence|))
+(DEFUN |bpSemiColon| (|ps|) (|bpSemiListing| |ps| #'|bpComma| #'|bfSequence|))
-(DEFUN |bpSemiListing| (|p| |f|) (|bpListofFun| |p| #'|bpSemiBackSet| |f|))
+(DEFUN |bpSemiListing| (|ps| |p| |f|)
+ (|bpListofFun| |ps| |p| #'|bpSemiBackSet| |f|))
-(DEFUN |bpSemiBackSet| ()
+(DEFUN |bpSemiBackSet| (|ps|)
(AND (|bpEqKey| 'SEMICOLON) (OR (|bpEqKey| 'BACKSET) T)))
-(DEFUN |bpPDefinition| () (|bpIndentParenthesized| #'|bpSemiColon|))
+(DEFUN |bpPDefinition| (|ps|) (|bpIndentParenthesized| |ps| #'|bpSemiColon|))
-(DEFUN |bpPileItems| ()
- (AND (|bpListAndRecover| #'|bpSemiColon|)
- (|bpPush| (|bfSequence| (|bpPop1|)))))
+(DEFUN |bpPileItems| (|ps|)
+ (AND (|bpListAndRecover| |ps| #'|bpSemiColon|)
+ (|bpPush| |ps| (|bfSequence| (|bpPop1|)))))
-(DEFUN |bpBPileDefinition| () (|bpPileBracketed| #'|bpPileItems|))
+(DEFUN |bpBPileDefinition| (|ps|) (|bpPileBracketed| |ps| #'|bpPileItems|))
-(DEFUN |bpIteratorTail| () (AND (OR (|bpEqKey| 'REPEAT) T) (|bpIterators|)))
+(DEFUN |bpIteratorTail| (|ps|)
+ (AND (OR (|bpEqKey| 'REPEAT) T) (|bpIterators| |ps|)))
-(DEFUN |bpConstruct| () (|bpBracket| #'|bpConstruction|))
+(DEFUN |bpConstruct| (|ps|) (|bpBracket| |ps| #'|bpConstruction|))
-(DEFUN |bpConstruction| ()
- (AND (|bpComma|)
+(DEFUN |bpConstruction| (|ps|)
+ (AND (|bpComma| |ps|)
(OR
- (AND (|bpIteratorTail|) (|bpPush| (|bfCollect| (|bpPop2|) (|bpPop1|))))
- (|bpPush| (|bfTupleConstruct| (|bpPop1|))))))
+ (AND (|bpIteratorTail| |ps|)
+ (|bpPush| |ps| (|bfCollect| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps| (|bfTupleConstruct| (|bpPop1|))))))
-(DEFUN |bpDConstruct| () (|bpBracket| #'|bpDConstruction|))
+(DEFUN |bpDConstruct| (|ps|) (|bpBracket| |ps| #'|bpDConstruction|))
-(DEFUN |bpDConstruction| ()
- (AND (|bpComma|)
+(DEFUN |bpDConstruction| (|ps|)
+ (AND (|bpComma| |ps|)
(OR
- (AND (|bpIteratorTail|)
- (|bpPush| (|bfDCollect| (|bpPop2|) (|bpPop1|))))
- (|bpPush| (|bfDTuple| (|bpPop1|))))))
-
-(DEFUN |bpPattern| ()
- (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpChar|) (|bpName|)
- (|bpConstTok|)))
-
-(DEFUN |bpEqual| ()
- (AND (|bpEqKey| 'SHOEEQ) (OR (|bpApplication|) (|bpConstTok|) (|bpTrap|))
- (|bpPush| (|bfEqual| (|bpPop1|)))))
-
-(DEFUN |bpRegularPatternItem| ()
- (OR (|bpEqual|) (|bpConstTok|) (|bpDot|)
- (AND (|bpName|)
+ (AND (|bpIteratorTail| |ps|)
+ (|bpPush| |ps| (|bfDCollect| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| |ps| (|bfDTuple| (|bpPop1|))))))
+
+(DEFUN |bpPattern| (|ps|)
+ (OR (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpChar| |ps|)
+ (|bpName| |ps|) (|bpConstTok| |ps|)))
+
+(DEFUN |bpEqual| (|ps|)
+ (AND (|bpEqKey| 'SHOEEQ)
+ (OR (|bpApplication| |ps|) (|bpConstTok| |ps|) (|bpTrap|))
+ (|bpPush| |ps| (|bfEqual| (|bpPop1|)))))
+
+(DEFUN |bpRegularPatternItem| (|ps|)
+ (OR (|bpEqual| |ps|) (|bpConstTok| |ps|) (|bpDot| |ps|)
+ (AND (|bpName| |ps|)
(OR
- (AND (|bpEqKey| 'BEC) (|bpRequire| #'|bpPattern|)
- (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'BEC) (|bpRequire| |ps| #'|bpPattern|)
+ (|bpPush| |ps| (|bfAssign| (|bpPop2|) (|bpPop1|))))
T))
- (|bpBracketConstruct| #'|bpPatternL|)))
+ (|bpBracketConstruct| |ps| #'|bpPatternL|)))
-(DEFUN |bpRegularPatternItemL| ()
- (AND (|bpRegularPatternItem|) (|bpPush| (LIST (|bpPop1|)))))
+(DEFUN |bpRegularPatternItemL| (|ps|)
+ (AND (|bpRegularPatternItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1|)))))
-(DEFUN |bpRegularList| ()
- (|bpListof| #'|bpRegularPatternItemL| 'COMMA #'|bfAppend|))
+(DEFUN |bpRegularList| (|ps|)
+ (|bpListof| |ps| #'|bpRegularPatternItemL| 'COMMA #'|bfAppend|))
-(DEFUN |bpPatternColon| ()
- (AND (|bpEqKey| 'COLON) (|bpRequire| #'|bpRegularPatternItem|)
- (|bpPush| (LIST (|bfColon| (|bpPop1|))))))
+(DEFUN |bpPatternColon| (|ps|)
+ (AND (|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpRegularPatternItem|)
+ (|bpPush| |ps| (LIST (|bfColon| (|bpPop1|))))))
-(DEFUN |bpPatternL| ()
- (AND (|bpPatternList|) (|bpPush| (|bfTuple| (|bpPop1|)))))
+(DEFUN |bpPatternL| (|ps|)
+ (AND (|bpPatternList| |ps|) (|bpPush| |ps| (|bfTuple| (|bpPop1|)))))
-(DEFUN |bpPatternList| ()
+(DEFUN |bpPatternList| (|ps|)
(COND
- ((|bpRegularPatternItemL|)
+ ((|bpRegularPatternItemL| |ps|)
(LOOP
(COND
((NOT
(AND (|bpEqKey| 'COMMA)
- (OR (|bpRegularPatternItemL|)
+ (OR (|bpRegularPatternItemL| |ps|)
(PROGN
(OR
- (AND (|bpPatternTail|)
- (|bpPush| (|append| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpPatternTail| |ps|)
+ (|bpPush| |ps| (|append| (|bpPop2|) (|bpPop1|))))
(|bpTrap|))
NIL))))
(RETURN NIL))
- (T (|bpPush| (|append| (|bpPop2|) (|bpPop1|))))))
+ (T (|bpPush| |ps| (|append| (|bpPop2|) (|bpPop1|))))))
T)
- (T (|bpPatternTail|))))
+ (T (|bpPatternTail| |ps|))))
-(DEFUN |bpPatternTail| ()
- (AND (|bpPatternColon|)
+(DEFUN |bpPatternTail| (|ps|)
+ (AND (|bpPatternColon| |ps|)
(OR
- (AND (|bpEqKey| 'COMMA) (|bpRequire| #'|bpRegularList|)
- (|bpPush| (|append| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'COMMA) (|bpRequire| |ps| #'|bpRegularList|)
+ (|bpPush| |ps| (|append| (|bpPop2|) (|bpPop1|))))
T)))
-(DEFUN |bpRegularBVItemTail| ()
+(DEFUN |bpRegularBVItemTail| (|ps|)
(OR
- (AND (|bpEqKey| 'COLON) (|bpRequire| #'|bpApplication|)
- (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'BEC) (|bpRequire| #'|bpPattern|)
- (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'IS) (|bpRequire| #'|bpPattern|)
- (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'DEF) (|bpRequire| #'|bpApplication|)
- (|bpPush| (|%DefaultValue| (|bpPop2|) (|bpPop1|))))))
-
-(DEFUN |bpRegularBVItem| ()
- (OR (|bpBVString|) (|bpConstTok|)
- (AND (|bpName|) (OR (|bpRegularBVItemTail|) T))
- (|bpBracketConstruct| #'|bpPatternL|)))
-
-(DEFUN |bpBVString| ()
+ (AND (|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpApplication|)
+ (|bpPush| |ps| (|bfTagged| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'BEC) (|bpRequire| |ps| #'|bpPattern|)
+ (|bpPush| |ps| (|bfAssign| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'IS) (|bpRequire| |ps| #'|bpPattern|)
+ (|bpPush| |ps| (|bfAssign| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'DEF) (|bpRequire| |ps| #'|bpApplication|)
+ (|bpPush| |ps| (|%DefaultValue| (|bpPop2|) (|bpPop1|))))))
+
+(DEFUN |bpRegularBVItem| (|ps|)
+ (OR (|bpBVString| |ps|) (|bpConstTok| |ps|)
+ (AND (|bpName| |ps|) (OR (|bpRegularBVItemTail| |ps|) T))
+ (|bpBracketConstruct| |ps| #'|bpPatternL|)))
+
+(DEFUN |bpBVString| (|ps|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(AND (EQ (|tokenClass| |$stok|) 'STRING)
- (|bpPush| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext|)))
+ (|bpPush| |ps| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext|)))
-(DEFUN |bpRegularBVItemL| ()
- (AND (|bpRegularBVItem|) (|bpPush| (LIST (|bpPop1|)))))
+(DEFUN |bpRegularBVItemL| (|ps|)
+ (AND (|bpRegularBVItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1|)))))
-(DEFUN |bpColonName| ()
- (AND (|bpEqKey| 'COLON) (OR (|bpName|) (|bpBVString|) (|bpTrap|))))
+(DEFUN |bpColonName| (|ps|)
+ (AND (|bpEqKey| 'COLON) (OR (|bpName| |ps|) (|bpBVString| |ps|) (|bpTrap|))))
-(DEFUN |bpBoundVariablelist| ()
+(DEFUN |bpBoundVariablelist| (|ps|)
(COND
- ((|bpRegularBVItemL|)
+ ((|bpRegularBVItemL| |ps|)
(LOOP
(COND
((NOT
(AND (|bpEqKey| 'COMMA)
- (OR (|bpRegularBVItemL|)
+ (OR (|bpRegularBVItemL| |ps|)
(PROGN
(OR
- (AND (|bpColonName|)
- (|bpPush| (|bfColonAppend| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpColonName| |ps|)
+ (|bpPush| |ps|
+ (|bfColonAppend| (|bpPop2|) (|bpPop1|))))
(|bpTrap|))
NIL))))
(RETURN NIL))
- (T (|bpPush| (|append| (|bpPop2|) (|bpPop1|))))))
+ (T (|bpPush| |ps| (|append| (|bpPop2|) (|bpPop1|))))))
T)
- (T (AND (|bpColonName|) (|bpPush| (|bfColonAppend| NIL (|bpPop1|)))))))
+ (T
+ (AND (|bpColonName| |ps|)
+ (|bpPush| |ps| (|bfColonAppend| NIL (|bpPop1|)))))))
-(DEFUN |bpVariable| ()
+(DEFUN |bpVariable| (|ps|)
(OR
- (AND (|bpParenthesized| #'|bpBoundVariablelist|)
- (|bpPush| (|bfTupleIf| (|bpPop1|))))
- (|bpBracketConstruct| #'|bpPatternL|) (|bpName|) (|bpConstTok|)))
-
-(DEFUN |bpAssignVariable| ()
- (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpAssignLHS|)))
-
-(DEFUN |bpAssignLHS| ()
- (COND ((NOT (|bpName|)) NIL)
- ((|bpEqKey| 'COLON) (|bpRequire| #'|bpApplication|)
- (|bpPush| (|bfLocal| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpParenthesized| |ps| #'|bpBoundVariablelist|)
+ (|bpPush| |ps| (|bfTupleIf| (|bpPop1|))))
+ (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpName| |ps|)
+ (|bpConstTok| |ps|)))
+
+(DEFUN |bpAssignVariable| (|ps|)
+ (OR (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpAssignLHS| |ps|)))
+
+(DEFUN |bpAssignLHS| (|ps|)
+ (COND ((NOT (|bpName| |ps|)) NIL)
+ ((|bpEqKey| 'COLON) (|bpRequire| |ps| #'|bpApplication|)
+ (|bpPush| |ps| (|bfLocal| (|bpPop2|) (|bpPop1|))))
(T
- (AND (|bpArgumentList|)
+ (AND (|bpArgumentList| |ps|)
(OR (|bpEqPeek| 'DOT)
- (AND (|bpEqPeek| 'BEC) (|bpPush| (|bfPlace| (|bpPop1|))))
+ (AND (|bpEqPeek| 'BEC)
+ (|bpPush| |ps| (|bfPlace| (|bpPop1|))))
(|bpTrap|)))
(COND
((|bpEqKey| 'DOT)
- (AND (|bpList| #'|bpPrimary| 'DOT) (|bpChecknull|)
- (|bpPush| (|bfTuple| (CONS (|bpPop2|) (|bpPop1|))))))
+ (AND (|bpList| |ps| #'|bpPrimary| 'DOT) (|bpChecknull| |ps|)
+ (|bpPush| |ps| (|bfTuple| (CONS (|bpPop2|) (|bpPop1|))))))
(T T)))))
-(DEFUN |bpChecknull| ()
+(DEFUN |bpChecknull| (|ps|)
(LET* (|a|)
(PROGN
(SETQ |a| (|bpPop1|))
- (COND ((NULL |a|) (|bpTrap|)) (T (|bpPush| |a|))))))
+ (COND ((NULL |a|) (|bpTrap|)) (T (|bpPush| |ps| |a|))))))
-(DEFUN |bpStruct| ()
- (AND (|bpEqKey| 'STRUCTURE) (|bpRequire| #'|bpName|)
- (OR (|bpEqKey| 'DEF) (|bpTrap|)) (OR (|bpRecord|) (|bpTypeList|))
- (|bpPush| (|%Structure| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpStruct| (|ps|)
+ (AND (|bpEqKey| 'STRUCTURE) (|bpRequire| |ps| #'|bpName|)
+ (OR (|bpEqKey| 'DEF) (|bpTrap|))
+ (OR (|bpRecord| |ps|) (|bpTypeList| |ps|))
+ (|bpPush| |ps| (|%Structure| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpRecord| ()
+(DEFUN |bpRecord| (|ps|)
(LET* (|s|)
(PROGN
(SETQ |s| (|bpState|))
(COND
- ((AND (|bpName|) (EQ (|bpPop1|) '|Record|))
- (AND (OR (|bpParenthesized| #'|bpFieldList|) (|bpTrap|))
- (|bpGlobalAccessors|)
- (|bpPush| (|%Record| (|bfUntuple| (|bpPop2|)) (|bpPop1|)))))
+ ((AND (|bpName| |ps|) (EQ (|bpPop1|) '|Record|))
+ (AND (OR (|bpParenthesized| |ps| #'|bpFieldList|) (|bpTrap|))
+ (|bpGlobalAccessors| |ps|)
+ (|bpPush| |ps| (|%Record| (|bfUntuple| (|bpPop2|)) (|bpPop1|)))))
(T (|bpRestore| |s|) NIL)))))
-(DEFUN |bpFieldList| () (|bpTuple| #'|bpSignature|))
+(DEFUN |bpFieldList| (|ps|) (|bpTuple| |ps| #'|bpSignature|))
-(DEFUN |bpGlobalAccessors| ()
+(DEFUN |bpGlobalAccessors| (|ps|)
(COND
((|bpEqKey| 'WITH)
- (OR (|bpPileBracketed| #'|bpAccessorDefinitionList|) (|bpTrap|)))
- (T (|bpPush| NIL))))
+ (OR (|bpPileBracketed| |ps| #'|bpAccessorDefinitionList|) (|bpTrap|)))
+ (T (|bpPush| |ps| NIL))))
-(DEFUN |bpAccessorDefinitionList| ()
- (|bpListAndRecover| #'|bpAccessorDefinition|))
+(DEFUN |bpAccessorDefinitionList| (|ps|)
+ (|bpListAndRecover| |ps| #'|bpAccessorDefinition|))
-(DEFUN |bpAccessorDefinition| ()
- (AND (|bpRequire| #'|bpName|) (OR (|bpEqKey| 'DEF) (|bpTrap|))
- (|bpRequire| #'|bpFieldSection|)
- (|bpPush| (|%AccessorDef| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpAccessorDefinition| (|ps|)
+ (AND (|bpRequire| |ps| #'|bpName|) (OR (|bpEqKey| 'DEF) (|bpTrap|))
+ (|bpRequire| |ps| #'|bpFieldSection|)
+ (|bpPush| |ps| (|%AccessorDef| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpFieldSection| () (|bpParenthesized| #'|bpSelectField|))
+(DEFUN |bpFieldSection| (|ps|) (|bpParenthesized| |ps| #'|bpSelectField|))
-(DEFUN |bpSelectField| () (AND (|bpEqKey| 'DOT) (|bpName|)))
+(DEFUN |bpSelectField| (|ps|) (AND (|bpEqKey| 'DOT) (|bpName| |ps|)))
-(DEFUN |bpTypeList| ()
- (OR (|bpPileBracketed| #'|bpTypeItemList|)
- (AND (|bpTypeItem|) (|bpPush| (LIST (|bpPop1|))))))
+(DEFUN |bpTypeList| (|ps|)
+ (OR (|bpPileBracketed| |ps| #'|bpTypeItemList|)
+ (AND (|bpTypeItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1|))))))
-(DEFUN |bpTypeItem| () (|bpTerm| #'|bpIdList|))
+(DEFUN |bpTypeItem| (|ps|) (|bpTerm| |ps| #'|bpIdList|))
-(DEFUN |bpTypeItemList| () (|bpListAndRecover| #'|bpTypeItem|))
+(DEFUN |bpTypeItemList| (|ps|) (|bpListAndRecover| |ps| #'|bpTypeItem|))
-(DEFUN |bpTerm| (|idListParser|)
+(DEFUN |bpTerm| (|ps| |idListParser|)
(OR
- (AND (|bpRequire| #'|bpName|)
+ (AND (|bpRequire| |ps| #'|bpName|)
(OR
- (AND (|bpParenthesized| |idListParser|)
- (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))
- (AND (|bpName|) (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))))
- (|bpPush| (|bfNameOnly| (|bpPop1|)))))
+ (AND (|bpParenthesized| |ps| |idListParser|)
+ (|bpPush| |ps| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpName| |ps|)
+ (|bpPush| |ps| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))))
+ (|bpPush| |ps| (|bfNameOnly| (|bpPop1|)))))
-(DEFUN |bpIdList| () (|bpTuple| #'|bpName|))
+(DEFUN |bpIdList| (|ps|) (|bpTuple| |ps| #'|bpName|))
-(DEFUN |bpCase| ()
- (AND (|bpEqKey| 'CASE) (|bpRequire| #'|bpWhere|)
- (OR (|bpEqKey| 'OF) (|bpMissing| 'OF)) (|bpPiledCaseItems|)))
+(DEFUN |bpCase| (|ps|)
+ (AND (|bpEqKey| 'CASE) (|bpRequire| |ps| #'|bpWhere|)
+ (OR (|bpEqKey| 'OF) (|bpMissing| 'OF)) (|bpPiledCaseItems| |ps|)))
-(DEFUN |bpPiledCaseItems| ()
- (AND (|bpPileBracketed| #'|bpCaseItemList|)
- (|bpPush| (|bfCase| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpPiledCaseItems| (|ps|)
+ (AND (|bpPileBracketed| |ps| #'|bpCaseItemList|)
+ (|bpPush| |ps| (|bfCase| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpCaseItemList| () (|bpListAndRecover| #'|bpCaseItem|))
+(DEFUN |bpCaseItemList| (|ps|) (|bpListAndRecover| |ps| #'|bpCaseItem|))
-(DEFUN |bpCasePatternVar| () (OR (|bpName|) (|bpDot|)))
+(DEFUN |bpCasePatternVar| (|ps|) (OR (|bpName| |ps|) (|bpDot| |ps|)))
-(DEFUN |bpCasePatternVarList| () (|bpTuple| #'|bpCasePatternVar|))
+(DEFUN |bpCasePatternVarList| (|ps|) (|bpTuple| |ps| #'|bpCasePatternVar|))
-(DEFUN |bpCaseItem| ()
- (AND (OR (|bpTerm| #'|bpCasePatternVarList|) (|bpTrap|))
- (OR (|bpEqKey| 'EXIT) (|bpTrap|)) (|bpRequire| #'|bpWhere|)
- (|bpPush| (|bfCaseItem| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpCaseItem| (|ps|)
+ (AND (OR (|bpTerm| |ps| #'|bpCasePatternVarList|) (|bpTrap|))
+ (OR (|bpEqKey| 'EXIT) (|bpTrap|)) (|bpRequire| |ps| #'|bpWhere|)
+ (|bpPush| |ps| (|bfCaseItem| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpOutItem| ()
- (LET* (|r| |ISTMP#2| |l| |ISTMP#1| |b|)
+(DEFUN |bpOutItem| (|ps|)
+ (LET* (|t| |r| |ISTMP#2| |l| |ISTMP#1| |b|)
(DECLARE (SPECIAL |$InteractiveMode|))
(LET* ((|$op| NIL) (|$GenVarCounter| 0))
(DECLARE (SPECIAL |$op| |$GenVarCounter|))
(PROGN
- (|bpRequire| #'|bpComma|)
+ (|bpRequire| |ps| #'|bpComma|)
(SETQ |b| (|bpPop1|))
- (|bpPush|
- (COND ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|))
- ((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
- (PROGN
- (SETQ |ISTMP#1| (CDR |b|))
- (AND (CONSP |ISTMP#1|)
- (PROGN
- (SETQ |l| (CAR |ISTMP#1|))
- (SETQ |ISTMP#2| (CDR |ISTMP#1|))
- (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
- (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))
- (SYMBOLP |l|))
- (COND (|$InteractiveMode| (LIST (LIST 'SETQ |l| |r|)))
- (T (LIST (LIST 'DEFPARAMETER |l| |r|)))))
- (T (|translateToplevel| |b| NIL))))))))
+ (SETQ |t|
+ (COND ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|))
+ ((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |b|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |l| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
+ (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))
+ (SYMBOLP |l|))
+ (COND (|$InteractiveMode| (LIST (LIST 'SETQ |l| |r|)))
+ (T (LIST (LIST 'DEFPARAMETER |l| |r|)))))
+ (T (|translateToplevel| |b| NIL))))
+ (|bpPush| |ps| |t|)))))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 37d7aa38..d71a5351 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -431,13 +431,14 @@
(DEFUN |shoeAddComment| (|l|) (CONCAT "; " (CAR |l|)))
-(DEFUN |shoeOutParse| (|stream|)
- (LET* (|found|)
+(DEFUN |shoeOutParse| (|toks|)
+ (LET* (|found| |ps|)
(DECLARE
(SPECIAL |$bpParenCount| |$bpCount| |$returns| |$typings| |$wheredefs|
|$op| |$ttok| |$stok| |$stack| |$inputStream|))
(PROGN
- (SETQ |$inputStream| |stream|)
+ (SETQ |$inputStream| |toks|)
+ (SETQ |ps| (|makeParserState| |toks|))
(SETQ |$stack| NIL)
(SETQ |$stok| NIL)
(SETQ |$ttok| NIL)
@@ -449,7 +450,8 @@
(SETQ |$bpParenCount| 0)
(|bpFirstTok|)
(SETQ |found|
- (LET ((#1=#:G729 (CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem|))))
+ (LET ((#1=#:G729
+ (CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem| |ps|))))
(COND
((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
(COND
@@ -1196,23 +1198,25 @@
(DEFUN BOOTLOOP ()
(LET* (|stream| |a|)
+ (DECLARE (SPECIAL |$stdio| |$stdin|))
(PROGN
- (SETQ |a| (|readLine| *STANDARD-INPUT*))
+ (SETQ |a| (|readLine| |$stdin|))
(COND
((EQL (LENGTH |a|) 0) (WRITE-LINE "Boot Loop; to exit type ] ")
(BOOTLOOP))
- ((|shoePrefix?| ")console" |a|) (SETQ |stream| *TERMINAL-IO*)
+ ((|shoePrefix?| ")console" |a|) (SETQ |stream| |$stdio|)
(PSTTOMC (|bRgen| |stream|)) (BOOTLOOP))
((CHAR= (SCHAR |a| 0) (|char| '])) NIL)
(T (PSTTOMC (LIST |a|)) (BOOTLOOP))))))
(DEFUN BOOTPO ()
(LET* (|stream| |a|)
+ (DECLARE (SPECIAL |$stdio| |$stdin|))
(PROGN
- (SETQ |a| (|readLine| *STANDARD-INPUT*))
+ (SETQ |a| (|readLine| |$stdin|))
(COND
((EQL (LENGTH |a|) 0) (WRITE-LINE "Boot Loop; to exit type ] ") (BOOTPO))
- ((|shoePrefix?| ")console" |a|) (SETQ |stream| *TERMINAL-IO*)
+ ((|shoePrefix?| ")console" |a|) (SETQ |stream| |$stdio|)
(PSTOUT (|bRgen| |stream|)) (BOOTPO))
((CHAR= (SCHAR |a| 0) (|char| '])) NIL)
(T (PSTOUT (LIST |a|)) (BOOTPO))))))
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index daec2a91..20efc228 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -22,7 +22,8 @@
|symbolAssoc| |applySubst| |applySubst!| |applySubstNQ|
|objectAssoc| |remove| |removeSymbol| |atomic?| |every?|
|any?| |take| |takeWhile| |drop| |copyTree| |finishLine|
- |stringSuffix?| |findChar| |charPosition|)))
+ |stringPrefix?| |stringSuffix?| |findChar|
+ |charPosition|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|) |substitute|))
@@ -106,6 +107,9 @@
(DECLAIM
(FTYPE (FUNCTION (|%String| |%String|) (|%Maybe| |%Short|)) |stringSuffix?|))
+(DECLAIM
+ (FTYPE (FUNCTION (|%String| |%String|) (|%Maybe| |%Short|)) |stringPrefix?|))
+
(|%defaultReadAndLoadSettings|)
(DEFUN |atomic?| (|x|) (OR (NOT (CONSP |x|)) (EQ (CAR |x|) 'QUOTE)))
@@ -493,5 +497,19 @@
|n|)
(T NIL)))))))
+(DEFUN |stringPrefix?| (|s1| |s2|)
+ (LET* (|n1|)
+ (PROGN
+ (SETQ |n1| (LENGTH |s1|))
+ (COND ((< (LENGTH |s2|) |n1|) NIL)
+ ((LET ((|bfVar#2| T) (|bfVar#1| (- |n1| 1)) (|i| 0))
+ (LOOP
+ (COND ((> |i| |bfVar#1|) (RETURN |bfVar#2|))
+ (T (SETQ |bfVar#2| (EQUAL (ELT |s1| |i|) (ELT |s2| |i|)))
+ (COND ((NOT |bfVar#2|) (RETURN NIL)))))
+ (SETQ |i| (+ |i| 1))))
+ |n1|)
+ (T NIL)))))
+
(DEFUN |finishLine| (|out|) (PROGN (TERPRI |out|) (FORCE-OUTPUT |out|)))
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 2302582d..d103351e 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -354,8 +354,9 @@ shoeConsoleTrees s ==
shoeAddComment l==
strconc('"; ", first l)
-shoeOutParse stream ==
- $inputStream := stream
+shoeOutParse toks ==
+ $inputStream := toks
+ ps := makeParserState toks
$stack := []
$stok := nil
$ttok := nil
@@ -367,7 +368,7 @@ shoeOutParse stream ==
$bpParenCount := 0
bpFirstTok()
found :=
- try bpOutItem()
+ try bpOutItem ps
catch(e: BootParserException) => e
found = 'TRAPPED => nil
not bStreamNull $inputStream =>
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index 266d966c..ff9051ed 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -48,7 +48,6 @@ namespace BOOT
module spad_-parser where
indentationLocation: %String -> %Maybe %Short
- stringPrefix?: (%String,%String) -> %Boolean
--%
@@ -79,12 +78,6 @@ indentationLocation line ==
tabChar? line.i => loc := 8 * (loc quo 8 + 1)
return loc
-++ Return true if the string `s1' is a prefix of `s2'.
-stringPrefix?(s1,s2) ==
- n1 := #s1
- n1 > #s2 => false
- and/[s1.i = s2.i for i in 0..(n1-1)]
-
skipIfBlock x ==
[n,:line] := z := preparseReadLine1 x
not string? line => z
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 12:32:25 +0000