diff options
author | dos-reis <gdr@axiomatics.org> | 2010-05-18 15:41:33 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2010-05-18 15:41:33 +0000 |
commit | 2103e6d257f78fae7c554ff8e5d2a289059fbcee (patch) | |
tree | fa34b52dcbc14a40939ae227b51543d6878ac0df /src | |
parent | ec55510a6ade5e3430f7000f464d4a7e205ed19f (diff) | |
download | open-axiom-2103e6d257f78fae7c554ff8e5d2a289059fbcee.tar.gz |
* interp/cparse.boot: Clean up.
Diffstat (limited to 'src')
-rw-r--r-- | src/ChangeLog | 4 | ||||
-rw-r--r-- | src/interp/cparse.boot | 1289 |
2 files changed, 691 insertions, 602 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index ae58e0db..0af6e3c3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2010-05-18 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/cparse.boot: Clean up. + 2010-05-17 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/fnewmeta.lisp: Remove out-of-date META grammar. diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot index d8d89c95..6714874c 100644 --- a/src/interp/cparse.boot +++ b/src/interp/cparse.boot @@ -37,167 +37,192 @@ namespace BOOT -- npTerm introduced between npRemainder and npSum -- rhs of assignment changed from npStatement to npGives +++ Entry point into the parser. npParse stream == - $inputStream:local := stream - $stack:local :=nil - $stok:local:=nil - $ttok:local:=nil - npFirstTok() - found:=CATCH("TRAPPOINT",npItem()) - if found="TRAPPED" - then - ncSoftError(tokPosn $stok,'S2CY0006, []) - pfWrong(pfDocument '"top level syntax error" ,pfListOf nil) - else if not null $inputStream - then - ncSoftError(tokPosn $stok,'S2CY0002,[]) - pfWrong(pfDocument ['"input stream not exhausted"],pfListOf []) - else if null $stack - then - ncSoftError(tokPosn $stok,'S2CY0009, []) - pfWrong(pfDocument ['"stack empty"],pfListOf []) - else - first $stack - + $inputStream: local := stream + $stack: local :=nil + $stok: local := nil + $ttok: local := nil + npFirstTok() + found := CATCH("TRAPPOINT",npItem()) + found = "TRAPPED" => + ncSoftError(tokPosn $stok,'S2CY0006, []) + pfWrong(pfDocument '"top level syntax error" ,pfListOf nil) + $inputStream ~= nil => + ncSoftError(tokPosn $stok,'S2CY0002,[]) + pfWrong(pfDocument ['"input stream not exhausted"],pfListOf []) + $stack = nil => + ncSoftError(tokPosn $stok,'S2CY0009, []) + pfWrong(pfDocument ['"stack empty"],pfListOf []) + first $stack + +++ Parse a toplevel item. +++ Item ::= QualifiedDefinition [ SEMICOLON Item ] npItem()== - npQualDef() => - npEqKey "SEMICOLON" => - [a,b]:=npItem1 npPop1 () - c:=pfEnSequence b - a => npPush c - npPush pfNovalue c - npPush pfEnSequence npPop1 () - false + npQualDef() => + npEqKey "SEMICOLON" => + [a,b] := npItem1 npPop1() + c := pfEnSequence b + a => npPush c + npPush pfNovalue c + npPush pfEnSequence npPop1 () + false +++ Subroutine of npItem1. npItem1 c== - npQualDef() => - npEqKey "SEMICOLON" => - [a,b]:=npItem1 npPop1 () - [a,append(c,b)] - [true,append (c,npPop1())] - [false,c] - + npQualDef() => + npEqKey "SEMICOLON" => + [a,b] := npItem1 npPop1() + [a,append(c,b)] + [true,append (c,npPop1())] + [false,c] + +++ Get the first token, if any, from the current input stream. npFirstTok()== - $stok:= - if null $inputStream - then tokConstruct("ERROR","NOMORE",tokPosn $stok) - else first $inputStream - $ttok:=tokPart $stok + $stok := + $inputStream = nil => tokConstruct("ERROR","NOMORE",tokPosn $stok) + first $inputStream + $ttok := tokPart $stok +++ Get next token from the current input stream. npNext() == - $inputStream := rest($inputStream) - npFirstTok() + $inputStream := rest $inputStream + npFirstTok() +++ Returns a snapshot of the current parser state. npState() == [$inputStream,:$stack] -npRestore(x)== - $inputStream:=first x - npFirstTok() - $stack:=rest x - true +++ Restore the parser state to a prevously saved state `x'. +npRestore x == + $inputStream := first x + npFirstTok() + $stack := rest x + true -npPush x== +++ Push a new parse tree on the current parse tree stack. +npPush x == $stack := [x,:$stack] -npPushId()== - a:=GETL($ttok,'INFGENERIC) - $ttok:= if a then a else $ttok - $stack := [tokConstruct("id",$ttok,tokPosn $stok),:$stack] - npNext() - -npPop1()== - a:=first $stack - $stack:=rest $stack - a - -npPop2()== - a:= second $stack - $stack.rest := CDDR $stack - a - -npPop3()== - a:= third $stack - $stack.rest.rest := CDDDR $stack - a - -npParenthesized f== - npParenthesize("(",")",f) or - npParenthesize("(|","|)",f) - +++ If the current token designates an infix operator, push its +++ name on the parsing tree stack, otherwise treat the token +++ has a name. +npPushId() == + a := GETL($ttok,'INFGENERIC) + $ttok := if a then a else $ttok + $stack := [tokConstruct("id",$ttok,tokPosn $stok),:$stack] + npNext() + +++ Remove the first item from the parse tree stack, and return it +npPop1() == + a := first $stack + $stack := rest $stack + a + +++ Remove the second item from the parse tree stack, and return it. +npPop2() == + a := second $stack + $stack.rest := $stack.rest.rest + a + +++ Remove the third item from the parse tree stack, and return it. +npPop3() == + a := third $stack + $stack.rest.rest := $stack.rest.rest.rest + a + +++ Parser combinator: parse the syntax `f' enclosed in round +++ round brackets +npParenthesized f == + npParenthesize("(",")",f) or npParenthesize("(|","|)",f) + +++ Parser combinator: parse the syntax `f' enclosed in brackets +++ as indicaed by `open' and `close'. npParenthesize (open,close,f)== - a:=$stok - npEqKey open => - apply(f,nil) and (npEqKey close or npMissingMate(close,a))=> true - npEqKey close => npPush [] - npMissingMate(close,a) - false + a := $stok + npEqKey open => + apply(f,nil) and (npEqKey close or npMissingMate(close,a)) => true + npEqKey close => npPush [] + npMissingMate(close,a) + false +++ Parser combinator: parse a syntax composed of an opening bracket +++ `open', followed by a syntax `f', terminated by the closing +++ bracket `close'. Use `fn' to construct the resulting parse tree. npEnclosed(open,close,fn,f)== - a:=$stok - npEqKey open => - npEqKey close => npPush FUNCALL(fn,a,pfTuple pfListOf []) - apply(f,nil) and (npEqKey close or npMissingMate(close,a))=> - npPush FUNCALL (fn,a,pfEnSequence npPop1()) - false + a := $stok + npEqKey open => + npEqKey close => npPush FUNCALL(fn,a,pfTuple pfListOf []) + apply(f,nil) and (npEqKey close or npMissingMate(close,a)) => + npPush FUNCALL (fn,a,pfEnSequence npPop1()) false + false +++ Parser combinator: parse a round-bracket syntax. +++ Note: The parenthesis are part of the parse tree. npParened f == - npEnclosed("(",")",function pfParen,f) or + npEnclosed("(",")",function pfParen,f) or npEnclosed("(|","|)",function pfParen,f) +++ Parser combinator: parse a square-bracket syntax. +++ Note: The brackets are part of the parse tree. npBracked f == - npEnclosed("[","]",function pfBracket,f) or + npEnclosed("[","]",function pfBracket,f) or npEnclosed("[|","|]",function pfBracketBar,f) +++ Parser combinator: parse a curly-bracket syntax. +++ Note: The braces are part of the parse tree. npBraced f == - npEnclosed("{","}",function pfBrace,f) or + npEnclosed("{","}",function pfBrace,f) or npEnclosed("{|","|}",function pfBraceBar,f) +++ Parser combinator: parse an angle-bracket syntax. +++ Note: The angles are part of the parse tree. npAngleBared f == - npEnclosed("<|","|>",function pfHide,f) + npEnclosed("<|","|>",function pfHide,f) +++ Parser combinator: parse a bracketed syntax. +++ Note: The brackets are part of the parse tree. npBracketed f== npParened f or npBracked f or npBraced f or npAngleBared f +++ Parse combinator: parse a sequence of syntax `f' in a pile. npPileBracketed f== - if npEqKey "SETTAB" - then if npEqKey "BACKTAB" - then npPush pfNothing() -- never happens - else if apply(f,nil) and (npEqKey "BACKTAB" or npMissing "backtab") - then npPush pfPile npPop1() - else false - else false + npEqKey "SETTAB" => + npEqKey "BACKTAB" => npPush pfNothing() -- never happens + apply(f,nil) and (npEqKey "BACKTAB" or npMissing "backtab") => + npPush pfPile npPop1() + false + false +++ Parser combinator: parse a either a single syntax `f', or a sequence +++ of syntax `f' separated by syntax `g'. In case of a sequence, use +++ `g' to build the resulting parse tree. npListofFun(f,h,g)== - if apply(f,nil) - then - if apply(h,nil) and (apply(f,nil) or npTrap()) - then - a:=$stack - $stack:=nil - while apply(h,nil) and (apply(f,nil) or npTrap()) repeat 0 - $stack := [nreverse $stack,:a] - npPush FUNCALL(g, [npPop3(),npPop2(),:npPop1()]) - else - true - else false + apply(f,nil) => + apply(h,nil) and (apply(f,nil) or npTrap()) => + a := $stack + $stack := nil + while apply(h,nil) and (apply(f,nil) or npTrap()) repeat 0 + $stack := [nreverse $stack,:a] + npPush FUNCALL(g, [npPop3(),npPop2(),:npPop1()]) + true + false +++ Parse combinator: parse a sequence of syntax `f' separated by +++ token `str1'. Build the resulting parse tree with `g'. npList(f,str1,g)== -- always produces a list, g is applied to it - if apply(f,nil) - then - if npEqKey str1 and (npEqKey "BACKSET" or true) - and (apply(f,nil) or npTrap()) - then - a:=$stack - $stack:=nil - while npEqKey str1 and (npEqKey "BACKSET" or true) and - (apply(f,nil) or npTrap()) repeat 0 - $stack := [nreverse $stack,:a] - npPush FUNCALL(g, [npPop3(),npPop2(),:npPop1()]) - else - npPush FUNCALL(g, [npPop1()]) - else npPush FUNCALL(g, []) + apply(f,nil) => + npEqKey str1 and (npEqKey "BACKSET" or true) + and (apply(f,nil) or npTrap()) => + a := $stack + $stack := nil + while npEqKey str1 and (npEqKey "BACKSET" or true) and + (apply(f,nil) or npTrap()) repeat 0 + $stack := [nreverse $stack,:a] + npPush FUNCALL(g,[npPop3(),npPop2(),:npPop1()]) + npPush FUNCALL(g, [npPop1()]) + npPush FUNCALL(g, []) npPPff f == @@ -229,108 +254,116 @@ npPC(f) == or FUNCALL f --- s must transform the head of the stack - -npAnyNo s== - while apply(s,nil) repeat 0 - true +++ Parser combinator: Apply the parser `s' any number of time it +++ it is possible. Note that `s' transforms the the top of the +++ parse tree stack. +npAnyNo s == + while apply(s,nil) repeat 0 + true +++ Parser combinator: parse `keyword' followed by the syntax `p', +++ and build the resulting parse tree with `f'. npAndOr(keyword,p,f)== - npEqKey keyword and (apply(p,nil) or npTrap()) - and npPush FUNCALL(f, npPop1()) + npEqKey keyword and (apply(p,nil) or npTrap()) and + npPush FUNCALL(f, npPop1()) +++ Parser combinator: parse a right-associative syntax with operand +++ syntax `p', and operator `o'. +++ p o p o p o p = (p o (p o (p o p))) +++ p o p o = (p o p) o npRightAssoc(o,p)== - a:=npState() - if apply(p,nil) - then - while npInfGeneric o and (npRightAssoc(o,p) - or (npPush pfApplication(npPop2(),npPop1());false)) repeat - npPush pfInfApplication(npPop2(),npPop2(),npPop1()) - true - else - npRestore a - false - --- p o p o p o p = (((p o p) o p) o p) --- p o p o = (p o p) o - -npLeftAssoc(operations,parser)== - if apply(parser,nil) - then - while npInfGeneric(operations) - and (apply(parser,nil) or - (npPush pfApplication(npPop2(),npPop1());false)) - repeat - npPush pfInfApplication(npPop2(),npPop2(),npPop1()) - true - else false - -npInfixOp()== - CAAR $stok = "key" and + a := npState() + apply(p,nil) => + while npInfGeneric o and (npRightAssoc(o,p) + or (npPush pfApplication(npPop2(),npPop1());false)) repeat + npPush pfInfApplication(npPop2(),npPop2(),npPop1()) + true + npRestore a + false + +++ Parser combinator: parse a left-associative syntax with operand +++ syntax `p', and operators in `operations'. +++ p o p o p o p = (((p o p) o p) o p) +++ p o p o = (p o p) o +npLeftAssoc(operations,parser) == + apply(parser,nil) => + while npInfGeneric(operations) and + (apply(parser,nil) or + (npPush pfApplication(npPop2(),npPop1());false)) repeat + npPush pfInfApplication(npPop2(),npPop2(),npPop1()) + true + false + +++ Parse an infix operator name. +npInfixOp() == + $stok.first.first = "key" and GETL($ttok,"INFGENERIC") and npPushId() -npInfixOperator()== npInfixOp() or - a:=npState() - b:=$stok - npEqKey "'" and npInfixOp() => - npPush pfSymb (npPop1 (),tokPosn b) - npRestore a - npEqKey "BACKQUOTE" and npInfixOp() => - a:=npPop1() - npPush tokConstruct("idsy",tokPart a,tokPosn a) - npRestore a - false +++ Parse an infix operator, either quoted or backquoted. +npInfixOperator() == + npInfixOp() or + a := npState() + b := $stok + npEqKey "'" and npInfixOp() => + npPush pfSymb(npPop1(),tokPosn b) + npRestore a + npEqKey "BACKQUOTE" and npInfixOp() => + a := npPop1() + npPush tokConstruct("idsy",tokPart a,tokPosn a) + npRestore a + false -npInfKey s== CAAR $stok="key" and MEMQ($ttok,s) and npPushId() +++ Parse any infix keyword in the list `s'. +npInfKey s == + $stok.first.first = "key" and MEMQ($ttok,s) and npPushId() + +++ Parse any infix keyword in the list `s', either in plain syntax +++ or quoted form. +npDDInfKey s == + npInfKey s or + a := npState() + b := $stok + npEqKey "'" and npInfKey s => + npPush pfSymb(npPop1(),tokPosn b) + npRestore a + npEqKey "BACKQUOTE" and npInfKey s => + a := npPop1() + npPush tokConstruct("idsy",tokPart a,tokPosn a) + npRestore a + false -npDDInfKey s== - npInfKey s or - a:=npState() - b:=$stok - npEqKey "'" and npInfKey s => - npPush pfSymb (npPop1 () ,tokPosn b) - npRestore a - npEqKey "BACKQUOTE" and npInfKey s => - a:=npPop1() - npPush tokConstruct("idsy",tokPart a,tokPosn a) - npRestore a - false - -npInfGeneric s== npDDInfKey s and - (npEqKey "BACKSET" or true) - -npConditional f== - if npEqKey "IF" and (npLogical() or npTrap()) and - (npEqKey "BACKSET" or true) - then - if npEqKey "SETTAB" - then if npEqKey "THEN" - then (apply(f,nil) or npTrap()) and npElse(f) - and npEqKey "BACKTAB" - else npMissing "then" - else if npEqKey "THEN" - then (apply(f,nil) or npTrap()) and npElse(f) - else npMissing "then" - else false - -npElse(f)== - a:=npState() - if npBacksetElse() - then (apply(f,nil) or npTrap()) and - npPush pfIf(npPop3(),npPop2(),npPop1()) - else - npRestore a - npPush pfIfThenOnly(npPop2(),npPop1()) +++ Same as npDDInfKey, except that newline+bakset are accepted. +npInfGeneric s == + npDDInfKey s and (npEqKey "BACKSET" or true) + +++ Parser combinator: Parse the syntax `f' as either the then-branch, +++ of both branches of a conditional expression. +npConditional f == + npEqKey "IF" and (npLogical() or npTrap()) and + (npEqKey "BACKSET" or true) => + npEqKey "SETTAB" => + npEqKey "THEN" => + (apply(f,nil) or npTrap()) and npElse f and npEqKey "BACKTAB" + npMissing "then" + npEqKey "THEN" => (apply(f,nil) or npTrap()) and npElse f + npMissing "then" + false + +npElse f == + a := npState() + npBacksetElse() => + (apply(f,nil) or npTrap()) and + npPush pfIf(npPop3(),npPop2(),npPop1()) + npRestore a + npPush pfIfThenOnly(npPop2(),npPop1()) npBacksetElse()== - if npEqKey "BACKSET" - then npEqKey "ELSE" - else npEqKey "ELSE" + npEqKey "BACKSET" => npEqKey "ELSE" + npEqKey "ELSE" npWConditional f== - if npConditional f - then npPush pfTweakIf npPop1() - else false + npConditional f => npPush pfTweakIf npPop1() + false npQuantified f == npEqPeek "FORALL" => @@ -345,49 +378,49 @@ npQuantified f == -- peek for keyword s, no advance of token stream -npEqPeek s == CAAR $stok="key" and EQ(s,$ttok) +npEqPeek s == + $stok.first.first = "key" and EQ(s,$ttok) -- test for keyword s, if found advance token stream npEqKey s == - CAAR $stok="key" and EQ(s,$ttok) and npNext() + $stok.first.first = "key" and EQ(s,$ttok) and npNext() -$npTokToNames:= ["~","#","[]","{}", "[||]","{||}"] +$npTokToNames == + ["~","#","[]","{}", "[||]","{||}"] npId() == - CAAR $stok="id" => - npPush $stok - npNext() - CAAR $stok="key" and MEMQ($ttok,$npTokToNames)=> - npPush tokConstruct("id",$ttok,tokPosn $stok) - npNext() - false + $stok.first.first = "id" => + npPush $stok + npNext() + $stok.first.first = "key" and MEMQ($ttok,$npTokToNames) => + npPush tokConstruct("id",$ttok,tokPosn $stok) + npNext() + false npSymbolVariable()== - a:=npState() - npEqKey "BACKQUOTE" and npId() => - a:=npPop1() - npPush tokConstruct("idsy",tokPart a,tokPosn a) - npRestore a - false + a := npState() + npEqKey "BACKQUOTE" and npId() => + a:=npPop1() + npPush tokConstruct("idsy",tokPart a,tokPosn a) + npRestore a + false -npName()==npId() or npSymbolVariable() +npName() == + npId() or npSymbolVariable() npConstTok() == - tokType $stok in '(integer string char float command) => - npPush $stok - npNext() - npEqPeek "'" => - a:=$stok - b:=npState() - npNext() - if - npPrimary1() and npPush pfSymb(npPop1(),tokPosn a) - then true - else - npRestore b - false - false + tokType $stok in '(integer string char float command) => + npPush $stok + npNext() + npEqPeek "'" => + a := $stok + b := npState() + npNext() + npPrimary1() and npPush pfSymb(npPop1(),tokPosn a) => true + npRestore b + false + false npPrimary1() == @@ -398,31 +431,35 @@ npPrimary1() == npBPileDefinition() or npDefn() or npRule() -npPrimary2()== npEncAp function npAtom2 -- or npBPileDefinition() - or npAdd(pfNothing()) or npWith(pfNothing()) +npPrimary2() == + npEncAp function npAtom2 -- or npBPileDefinition() + or npAdd(pfNothing()) or npWith(pfNothing()) -npAtom1()== npPDefinition() or ((npName() or npConstTok() or - npDollar() or npBDefinition()) and npFromdom()) +npAtom1() == + npPDefinition() or ((npName() or npConstTok() or + npDollar() or npBDefinition()) and npFromdom()) -npAtom2()== (npInfixOperator() or npAmpersand() or npPrefixColon()) - and npFromdom() +npAtom2() == + (npInfixOperator() or npAmpersand() or npPrefixColon()) and npFromdom() -npDollar()== npEqPeek "$" and - npPush tokConstruct("id","$",tokPosn $stok) - npNext() +npDollar() == + npEqPeek "$" and + npPush tokConstruct("id","$",tokPosn $stok) + npNext() -npPrefixColon()== npEqPeek "COLON" and - npPush tokConstruct("id",":",tokPosn $stok) - npNext() +npPrefixColon() == + npEqPeek "COLON" and + npPush tokConstruct("id",":",tokPosn $stok) + npNext() -- silly -npEncAp(f)== apply(f,nil) and npAnyNo function npEncl - and npFromdom() - +npEncAp f == + apply(f,nil) and npAnyNo function npEncl and npFromdom() -npEncl()== npBDefinition() and npPush pfApplication(npPop2(),npPop1()) +npEncl()== + npBDefinition() and npPush pfApplication(npPop2(),npPop1()) npFromdom()== npEqKey "$" and (npApplication() or npTrap()) @@ -435,21 +472,23 @@ npFromdom1 c== or npPush c -npPrimary()== npPrimary1() or npPrimary2() +npPrimary()== + npPrimary1() or npPrimary2() -npDotted f== apply(f,nil) and npAnyNo function npSelector +npDotted f == + apply(f,nil) and npAnyNo function npSelector npSelector()== - npEqKey "DOT" and (npPrimary() or npTrap()) and - npPush(pfApplication(npPop2(),npPop1())) + npEqKey "DOT" and (npPrimary() or npTrap()) and + npPush(pfApplication(npPop2(),npPop1())) -npApplication()== +npApplication() == npDotted function npPrimary and (npApplication2() and npPush(pfApplication(npPop2(),npPop1())) or true) -npApplication2()== +npApplication2() == npDotted function npPrimary1 and (npApplication2() and npPush(pfApplication(npPop2(),npPop1())) or true) @@ -462,30 +501,37 @@ npTypedForm(sy,fn) == npEqKey sy and (npApplication() or npTrap()) and npPush FUNCALL(fn,npPop2(),npPop1()) -npRestrict() == npTypedForm("AT",function pfRestrict) +npRestrict() == + npTypedForm("AT",function pfRestrict) -npCoerceTo() == npTypedForm("COERCE",function pfCoerceto) +npCoerceTo() == + npTypedForm("COERCE",function pfCoerceto) -npPretend() == npTypedForm("PRETEND",function pfPretend) +npPretend() == + npTypedForm("PRETEND",function pfPretend) npTypeStyle()== - npCoerceTo() or npRestrict() or npPretend() + npCoerceTo() or npRestrict() or npPretend() -npTypified ()==npApplication() and npAnyNo function npTypeStyle +npTypified() == + npApplication() and npAnyNo function npTypeStyle -npTagged() == npTypedForm1("COLON",function pfTagged) +npTagged() == + npTypedForm1("COLON",function pfTagged) -npColon () == npTypified() and npAnyNo function npTagged +npColon() == + npTypified() and npAnyNo function npTagged -npPower() == npRightAssoc('(POWER CARAT),function npColon) +npPower() == + npRightAssoc('(POWER CARAT),function npColon) npProduct()== - npLeftAssoc('(TIMES SLASH BACKSLASH SLASHSLASH - BACKSLASHBACKSLASH SLASHBACKSLASH BACKSLASHSLASH ) - ,function npPower) + npLeftAssoc('(TIMES SLASH BACKSLASH SLASHSLASH + BACKSLASHBACKSLASH SLASHBACKSLASH BACKSLASHSLASH ) + ,function npPower) npRemainder()== - npLeftAssoc('(REM QUO ) ,function npProduct) + npLeftAssoc('(REM QUO ),function npProduct) npTerm()== npInfGeneric '(MINUS PLUS) and (npRemainder() @@ -493,11 +539,14 @@ npTerm()== or npRemainder() -npSum()==npLeftAssoc('(PLUS MINUS),function npTerm) +npSum() == + npLeftAssoc('(PLUS MINUS),function npTerm) -npArith()==npLeftAssoc('(MOD),function npSum) +npArith() == + npLeftAssoc('(MOD),function npSum) -npSegment()== npEqPeek "SEG" and npPushId() and npFromdom() +npSegment() == + npEqPeek "SEG" and npPushId() and npFromdom() npInterval()== npArith() and @@ -506,32 +555,41 @@ npInterval()== (npArith() and npPush(pfInfApplication(npPop2(),npPop2(),npPop1()))) or npPush(pfApplication(npPop1(),npPop1()))) or true) -npBy()== npLeftAssoc ('(BY),function npInterval) +npBy() == + npLeftAssoc ('(BY),function npInterval) + +npAmpersand() == + npEqKey "AMPERSAND" and (npName() or npTrap()) + +npAmpersandFrom() == + npAmpersand() and npFromdom() -npAmpersand()== npEqKey "AMPERSAND" and (npName() or npTrap()) -npAmpersandFrom()== npAmpersand() and npFromdom() +npSynthetic() == + npBy() => + while npAmpersandFrom() and (npBy() or + (npPush pfApplication(npPop2(),npPop1());false)) repeat + npPush pfInfApplication(npPop2(),npPop2(),npPop1()) + true + false -npSynthetic()== - if npBy() - then - while npAmpersandFrom() and (npBy() or - (npPush pfApplication(npPop2(),npPop1());false)) repeat - npPush pfInfApplication(npPop2(),npPop2(),npPop1()) - true - else false +npRelation() == + npLeftAssoc ('(EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE), + function npSynthetic) -npRelation()== - npLeftAssoc ('(EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE), - function npSynthetic) +npQuiver() == + npRightAssoc('(ARROW LARROW),function npRelation) -npQuiver() == npRightAssoc('(ARROW LARROW),function npRelation) -npDiscrim() == +npDiscrim()== npLeftAssoc ('(CASE HAS IS ISNT), function npQuiver) -npDisjand() == npLeftAssoc('(AND ),function npDiscrim) +npDisjand() == + npLeftAssoc('(AND ),function npDiscrim) + +npLogical() == + npLeftAssoc('(OR ),function npDisjand) -npLogical() == npLeftAssoc('(OR ),function npDisjand) -npSuch() == npLeftAssoc( '(BAR),function npLogical) +npSuch() == + npLeftAssoc('(BAR),function npLogical) ++ Parse a type expression ++ Type: @@ -540,45 +598,49 @@ npSuch() == npLeftAssoc( '(BAR),function npLogical) npType() == npQuantified function npMonoType -npMonoType() == npSuch() and - a:=npPop1() - npWith(a) or npPush a +npMonoType() == + npSuch() and + a := npPop1() + npWith(a) or npPush a -npADD() == npMonoType() and - a:=npPop1() - npAdd(a) or npPush a +npADD() == + npMonoType() and + a := npPop1() + npAdd(a) or npPush a -npConditionalStatement()==npConditional function npQualifiedDefinition +npConditionalStatement() == + npConditional function npQualifiedDefinition npExpress1()== npConditionalStatement() or npBackTrack(function npADD, "BECOMES", function npAssignment) -npCommaBackSet()== npEqKey "COMMA" and (npEqKey "BACKSET" or true) +npCommaBackSet() == + npEqKey "COMMA" and (npEqKey "BACKSET" or true) npExpress()== - npExpress1() and - (npIterators() and - npPush pfCollect (npPop2(),pfListOf npPop1()) or true) + npExpress1() and + (npIterators() and + npPush pfCollect (npPop2(),pfListOf npPop1()) or true) npZeroOrMore f== - apply(f,nil)=> - a:=$stack - $stack:=nil - while apply(f,nil) repeat 0 - $stack := [nreverse $stack,:a] - npPush [npPop2(),:npPop1()] - npPush nil - true - -npIterators()== - npForIn() and npZeroOrMore function npIterator - and npPush [npPop2(),:npPop1()] or - npWhile() and (npIterators() and - npPush [npPop2(),:npPop1()] or npPush [npPop1()]) - -npIterator()== npForIn() or npSuchThat() or npWhile() - + apply(f,nil)=> + a := $stack + $stack := nil + while apply(f,nil) repeat 0 + $stack := [nreverse $stack,:a] + npPush [npPop2(),:npPop1()] + npPush nil + true + +npIterators() == + npForIn() and npZeroOrMore function npIterator + and npPush [npPop2(),:npPop1()] or + npWhile() and (npIterators() and + npPush [npPop2(),:npPop1()] or npPush [npPop1()]) + +npIterator() == + npForIn() or npSuchThat() or npWhile() ++ Parse a case-pattern expression. ++ Case: @@ -590,86 +652,95 @@ npCase() == and npPush pfCase(npPop2(), pfSequenceToList npPop1()) false -npStatement()== - npCase() or - npExpress() or - npLoop() or - npIterate() or - npReturn() or - npBreak() or - npFree() or - npImport() or - npInline() or - npLocal() or - npExport() or - npVoid() - -npBackTrack(p1,p2,p3)== - a:=npState() - apply(p1,nil) => - npEqPeek p2 => - npRestore a - apply(p3,nil) or npTrap() - true - false +npStatement() == + npCase() or + npExpress() or + npLoop() or + npIterate() or + npReturn() or + npBreak() or + npFree() or + npImport() or + npInline() or + npLocal() or + npExport() or + npVoid() + +npBackTrack(p1,p2,p3) == + a := npState() + apply(p1,nil) => + npEqPeek p2 => + npRestore a + apply(p3,nil) or npTrap() + true + false npMDEF() == npBackTrack(function npStatement,"MDEF", function (() +-> npMdef "MDEF")) -npAssign()== npBackTrack(function npMDEF,"BECOMES",function npAssignment) +npAssign()== + npBackTrack(function npMDEF,"BECOMES",function npAssignment) npAssignment()== - npAssignVariable() and - (npEqKey "BECOMES" or npTrap()) and - (npGives() or npTrap()) and - npPush pfAssign (npPop2(),npPop1()) + npAssignVariable() and + (npEqKey "BECOMES" or npTrap()) and + (npGives() or npTrap()) and + npPush pfAssign (npPop2(),npPop1()) -npAssignVariableName()==npApplication() and - a:=npPop1() - if pfId? a - then - (npPush a and npDecl() or npPush pfTyped(npPop1(),pfNothing())) - else npPush a +npAssignVariableName() == + npApplication() and + a := npPop1() + pfId? a => + (npPush a and npDecl() or npPush pfTyped(npPop1(),pfNothing())) + npPush a -npAssignVariable()== npColon() and npPush pfListOf [npPop1()] +npAssignVariable() == + npColon() and npPush pfListOf [npPop1()] -npAssignVariablelist()== npListing function npAssignVariableName +npAssignVariablelist() == + npListing function npAssignVariableName -npExit()== npBackTrack(function npAssign,"EXIT",function npPileExit) +npExit() == + npBackTrack(function npAssign,"EXIT",function npPileExit) npPileExit()== - npAssign() and (npEqKey "EXIT" or npTrap()) and - (npStatement() or npTrap()) - and npPush pfExit (npPop2(),npPop1()) + npAssign() and (npEqKey "EXIT" or npTrap()) and + (npStatement() or npTrap()) + and npPush pfExit(npPop2(),npPop1()) -npGives()== npBackTrack(function npExit,"GIVES",function npLambda) +npGives() == + npBackTrack(function npExit,"GIVES",function npLambda) npDefinitionOrStatement()== npQuantified function (() +-> npBackTrack(function npGives, "DEF",function npDef)) -npVoid()== npAndOr("DO",function npStatement,function pfNovalue) +npVoid() == + npAndOr("DO",function npStatement,function pfNovalue) npReturn()== - npEqKey "RETURN" and - (npExpress() or npPush pfNothing()) and - (npEqKey "FROM" and (npName() or npTrap()) and - npPush pfReturn (npPop2(),npPop1()) or - npPush pfReturnNoName npPop1()) + npEqKey "RETURN" and + (npExpress() or npPush pfNothing()) and + (npEqKey "FROM" and (npName() or npTrap()) and + npPush pfReturn (npPop2(),npPop1()) or + npPush pfReturnNoName npPop1()) + npLoop()== - npIterators() and - (npCompMissing "REPEAT" and - (npAssign() or npTrap()) and - npPush pfLp(npPop2(),npPop1())) - or - npEqKey "REPEAT" and (npAssign() or npTrap()) and - npPush pfLoop1 npPop1 () + npIterators() and + (npCompMissing "REPEAT" and + (npAssign() or npTrap()) and + npPush pfLp(npPop2(),npPop1())) + or + npEqKey "REPEAT" and (npAssign() or npTrap()) and + npPush pfLoop1 npPop1 () -npSuchThat()==npAndOr("BAR",function npLogical,function pfSuchthat) +npSuchThat() == + npAndOr("BAR",function npLogical,function pfSuchthat) -npWhile()==npAndOr ("WHILE",function npLogical,function pfWhile) +npWhile() == + npAndOr ("WHILE",function npLogical,function pfWhile) npForIn()== npEqKey "FOR" and (npVariable() or npTrap()) and (npCompMissing "IN") @@ -677,145 +748,156 @@ npForIn()== npPush pfForin(npPop2(),npPop1())) npBreak()== - npEqKey "BREAK" and npPush pfBreak pfNothing () + npEqKey "BREAK" and npPush pfBreak pfNothing() npIterate()== - npEqKey "ITERATE" and npPush pfIterate pfNothing () + npEqKey "ITERATE" and npPush pfIterate pfNothing() npQualType()== - npType() and - npPush pfQualType(npPop1(),pfNothing()) + npType() and npPush pfQualType(npPop1(),pfNothing()) + +npSQualTypelist() == + npListing function npQualType and npPush pfParts npPop1() -npSQualTypelist()== npListing function npQualType - and npPush pfParts npPop1 () +npQualTypelist()== + npPC function npSQualTypelist and npPush pfUnSequence npPop1() -npQualTypelist()== npPC function npSQualTypelist - and npPush pfUnSequence npPop1 () +npImport() == + npAndOr("IMPORT",function npQualTypelist,function pfImport) -npImport()==npAndOr("IMPORT",function npQualTypelist,function pfImport) +npInline() == + npAndOr("INLINE",function npQualTypelist,function pfInline) -npInline()==npAndOr("INLINE",function npQualTypelist,function pfInline) +npLocalDecl()== + npEqKey "COLON" and (npType() or npTrap()) and + npPush pfSpread (pfParts npPop2(),npPop1()) or + npPush pfSpread (pfParts npPop1(),pfNothing()) -npLocalDecl()== npEqKey "COLON" and (npType() or npTrap()) and - npPush pfSpread (pfParts npPop2(),npPop1()) or - npPush pfSpread (pfParts npPop1(),pfNothing()) +npLocalItem() == + npTypeVariable() and npLocalDecl() -npLocalItem()==npTypeVariable() and npLocalDecl() +npLocalItemlist()== + npPC function npSLocalItem and npPush pfUnSequence npPop1() -npLocalItemlist()== npPC function npSLocalItem - and npPush pfUnSequence npPop1 () +npSLocalItem()== + npListing function npLocalItem and npPush pfAppend pfParts npPop1() -npSLocalItem()== npListing function npLocalItem - and npPush pfAppend pfParts npPop1() +npFree()== + npEqKey "FREE" and (npLocalItemlist() or npTrap()) and + npPush pfFree npPop1() -npFree()== npEqKey "FREE" and (npLocalItemlist() or npTrap()) - and npPush pfFree npPop1() +npLocal()== + npEqKey "local" and (npLocalItemlist() or npTrap()) and + npPush pfLocal npPop1() -npLocal()== npEqKey "local" and (npLocalItemlist() or npTrap()) - and npPush pfLocal npPop1() -npExport()== npEqKey "EXPORT" and (npLocalItemlist() or npTrap()) - and npPush pfExport npPop1() +npExport()== + npEqKey "EXPORT" and (npLocalItemlist() or npTrap()) and + npPush pfExport npPop1() -npLet()== npLetQualified function npDefinitionOrStatement +npLet() == + npLetQualified function npDefinitionOrStatement -npDefn()== npEqKey "DEFN" and npPP function npDef +npDefn() == + npEqKey "DEFN" and npPP function npDef -npFix()== npEqKey "FIX" and npPP function npDef - and npPush pfFix npPop1 () +npFix() == + npEqKey "FIX" and npPP function npDef and npPush pfFix npPop1() npMacro() == npEqKey "MACRO" and npPP function (() +-> npMdef "DEF") -npRule()== npEqKey "RULE" and npPP function npSingleRule +npRule()== + npEqKey "RULE" and npPP function npSingleRule npAdd(extra)== - npEqKey "ADD" => - a:=npState() - npDefinitionOrStatement() or npTrap() - npEqPeek "IN" => - npRestore a - (npVariable() or npTrap()) and - npCompMissing "IN" and - (npDefinitionOrStatement() or npTrap()) and - npPush pfAdd(npPop2(),npPop1(),extra) - npPush pfAdd(pfNothing(),npPop1(),extra) + npEqKey "ADD" => + a:=npState() + npDefinitionOrStatement() or npTrap() + npEqPeek "IN" => + npRestore a + (npVariable() or npTrap()) and + npCompMissing "IN" and + (npDefinitionOrStatement() or npTrap()) and + npPush pfAdd(npPop2(),npPop1(),extra) + npPush pfAdd(pfNothing(),npPop1(),extra) npDefaultValue()== - npEqKey "DEFAULT" and - (npDefinitionOrStatement() or npTrap()) - and npPush [pfAdd(pfNothing(),npPop1(),pfNothing())] + npEqKey "DEFAULT" and + (npDefinitionOrStatement() or npTrap()) and + npPush [pfAdd(pfNothing(),npPop1(),pfNothing())] npWith(extra)== - npEqKey "WITH" => - a:=npState() - npCategoryL() or npTrap() - npEqPeek "IN" => - npRestore a - (npVariable() or npTrap()) and - npCompMissing "IN" and - (npCategoryL() or npTrap()) and - npPush pfWith(npPop2(),npPop1(),extra) - npPush pfWith(pfNothing(),npPop1(),extra) - -npCategoryL()== npCategory() and npPush pfUnSequence npPop1 () + npEqKey "WITH" => + a := npState() + npCategoryL() or npTrap() + npEqPeek "IN" => + npRestore a + (npVariable() or npTrap()) and + npCompMissing "IN" and + (npCategoryL() or npTrap()) and + npPush pfWith(npPop2(),npPop1(),extra) + npPush pfWith(pfNothing(),npPop1(),extra) + +npCategoryL()== + npCategory() and npPush pfUnSequence npPop1 () pfUnSequence x== - pfSequence? x => pfListOf pfAppend pf0SequenceArgs x - pfListOf x + pfSequence? x => pfListOf pfAppend pf0SequenceArgs x + pfListOf x -npCategory()== npPP function npSCategory +npCategory() == + npPP function npSCategory npSCategory()== - if npWConditional function npCategoryL - then npPush [npPop1()] - else - if npDefaultValue() - then true - else - a:=npState() - if npPrimary() - then if npEqPeek "COLON" - then - npRestore a - npSignature() - else - npRestore a - npApplication() and npPush [pfAttribute (npPop1())] - or npTrap() - - else false - + npWConditional function npCategoryL => npPush [npPop1()] + npDefaultValue() => true + a := npState() + npPrimary() => + npEqPeek "COLON" => + npRestore a + npSignature() + npRestore a + npApplication() and npPush [pfAttribute (npPop1())] or npTrap() + false -npSignatureDefinee()== - npName() or npInfixOperator() or npPrefixColon() +npSignatureDefinee() == + npName() or npInfixOperator() or npPrefixColon() +npSigDecl()== + npEqKey "COLON" and (npType() or npTrap()) and + npPush pfSpread (pfParts npPop2(),npPop1()) -npSigDecl()== npEqKey "COLON" and (npType() or npTrap()) and - npPush pfSpread (pfParts npPop2(),npPop1()) +npSigItem() == + npTypeVariable() and (npSigDecl() or npTrap()) -npSigItem()==npTypeVariable() and (npSigDecl() or npTrap()) +npSigItemlist() == + npListing function npSigItem and + npPush pfListOf pfAppend pfParts npPop1() -npSigItemlist()== npListing function npSigItem - and npPush pfListOf pfAppend pfParts npPop1() +npSignature() == + npSigItemlist() and + npPush pfWDec(pfNothing(),npPop1()) -npSignature()== - npSigItemlist() and - npPush pfWDec(pfNothing(),npPop1()) +npSemiListing(p) == + npListofFun(p,function npSemiBackSet,function pfAppend) -npSemiListing (p)== - npListofFun(p,function npSemiBackSet,function pfAppend) +npSemiBackSet() == + npEqKey "SEMICOLON" and (npEqKey "BACKSET" or true) -npSemiBackSet()== npEqKey "SEMICOLON" and (npEqKey "BACKSET" or true) -npDecl()== npEqKey "COLON" and (npType() or npTrap()) and - npPush pfTyped (npPop2(),npPop1()) +npDecl()== + npEqKey "COLON" and (npType() or npTrap()) and + npPush pfTyped (npPop2(),npPop1()) -npVariableName()==npName() and - (npDecl() or npPush pfTyped(npPop1(),pfNothing())) +npVariableName() == + npName() and + (npDecl() or npPush pfTyped(npPop1(),pfNothing())) -npVariable()== npParenthesized function npVariablelist or - (npVariableName() and npPush pfListOf [npPop1()]) +npVariable() == + npParenthesized function npVariablelist + or (npVariableName() and npPush pfListOf [npPop1()]) -npVariablelist()== npListing function npVariableName +npVariablelist() == + npListing function npVariableName ++ Parse binders of a quantified expression ++ QuantifiedVariable: @@ -824,63 +906,71 @@ npVariablelist()== npListing function npVariableName ++ EXIST ++ FORALL npQuantifierVariable quantifier == - npEqKey quantifier and (npVariable() or npTrap()) - and npEqKey "DOT" + npEqKey quantifier and + (npVariable() or npTrap()) and + npEqKey "DOT" + +npListing p == + npList(p,"COMMA",function pfListOf) -npListing (p)==npList(p,"COMMA",function pfListOf) npQualified(f)== - if FUNCALL f - then - while npEqKey "WHERE" and (npDefinition() or npTrap()) repeat - npPush pfWhere(npPop1(),npPop1()) - true - else npLetQualified f + FUNCALL f => + while npEqKey "WHERE" and (npDefinition() or npTrap()) repeat + npPush pfWhere(npPop1(),npPop1()) + true + npLetQualified f npLetQualified f== - npEqKey "%LET" and - (npDefinition() or npTrap()) and + npEqKey "%LET" and + (npDefinition() or npTrap()) and npCompMissing "IN" and - (FUNCALL f or npTrap()) and - npPush pfWhere(npPop2(),npPop1()) - + (FUNCALL f or npTrap()) and + npPush pfWhere(npPop2(),npPop1()) npQualifiedDefinition()== - npQualified function npDefinitionOrStatement + npQualified function npDefinitionOrStatement + +npTuple p == + npListofFun(p,function npCommaBackSet,function pfTupleListOf) -npTuple (p)== - npListofFun(p,function npCommaBackSet,function pfTupleListOf) -npComma()== npTuple function npQualifiedDefinition +npComma() == + npTuple function npQualifiedDefinition -npQualDef()== npComma() and npPush [npPop1()] +npQualDef() == + npComma() and npPush [npPop1()] -npDefinitionlist ()==npSemiListing(function npQualDef) +npDefinitionlist() == + npSemiListing(function npQualDef) -npPDefinition ()== - npParenthesized function npDefinitionlist and - npPush pfEnSequence npPop1() +npPDefinition() == + npParenthesized function npDefinitionlist and + npPush pfEnSequence npPop1() -npBDefinition()== npPDefinition() or - npBracketed function npDefinitionlist +npBDefinition()== + npPDefinition() + or npBracketed function npDefinitionlist npPileDefinitionlist()== - npListAndRecover function npDefinitionlist - and npPush pfAppend npPop1() + npListAndRecover function npDefinitionlist and + npPush pfAppend npPop1() -npTypeVariable()== npParenthesized function npTypeVariablelist or - npSignatureDefinee() and npPush pfListOf [npPop1()] +npTypeVariable()== + npParenthesized function npTypeVariablelist + or npSignatureDefinee() and npPush pfListOf [npPop1()] -npTypeVariablelist()== npListing function npSignatureDefinee +npTypeVariablelist() == + npListing function npSignatureDefinee npBPileDefinition()== - npPileBracketed function npPileDefinitionlist - and npPush pfSequence pfListOf npPop1 () + npPileBracketed function npPileDefinitionlist and + npPush pfSequence pfListOf npPop1() npLambda()== - (npVariable() and - ((npLambda() or npTrap()) and + (npVariable() and + ((npLambda() or npTrap()) and npPush pfLam(npPop2(),npPop1()))) or npEqKey "GIVES" and (npDefinitionOrStatement() or npTrap()) or npEqKey "COLON" and (npType() or npTrap()) and @@ -888,66 +978,68 @@ npLambda()== and npPush pfReturnTyped(npPop2(),npPop1()) -npDef()== - npSuch() => - [op,arg,rt]:= pfCheckItOut(npPop1()) - npDefTail "DEF" or npTrap() - body:=npPop1() - null arg => npPush pfDefinition (op,body) - npPush pfDefinition (op,pfPushBody(rt,arg,body)) - false +npDef() == + npSuch() => + [op,arg,rt] := pfCheckItOut(npPop1()) + npDefTail "DEF" or npTrap() + body := npPop1() + arg = nil => npPush pfDefinition (op,body) + npPush pfDefinition (op,pfPushBody(rt,arg,body)) + false npDefTail kw == npEqKey kw and npDefinitionOrStatement() npMdef kw == - npQuiver() => - [op,arg]:= pfCheckMacroOut(npPop1()) - npDefTail kw or npTrap() - body:=npPop1() - null arg => npPush pfMacro (op,body) - npPush pfMacro (op,pfPushMacroBody(arg,body)) - false + npQuiver() => + [op,arg] := pfCheckMacroOut(npPop1()) + npDefTail kw or npTrap() + body := npPop1() + arg = nil => npPush pfMacro (op,body) + npPush pfMacro(op,pfPushMacroBody(arg,body)) + false npSingleRule()== - npQuiver() => - npDefTail "DEF" or npTrap() - npPush pfRule (npPop2(),npPop1()) - false + npQuiver() => + npDefTail "DEF" or npTrap() + npPush pfRule(npPop2(),npPop1()) + false npDefinitionItem()== - npImport() or - a:=npState() - npStatement() => - npEqPeek "DEF" => - npRestore a - npDef() - npEqPeek "MDEF" => - npRestore a - npMdef "MDEF" - npRestore a - npMacro() or npDefn() - npTrap() - -npDefinition()== npPP function npDefinitionItem - and npPush pfSequenceToList npPop1 () + npImport() or + a := npState() + npStatement() => + npEqPeek "DEF" => + npRestore a + npDef() + npEqPeek "MDEF" => + npRestore a + npMdef "MDEF" + npRestore a + npMacro() or npDefn() + npTrap() + +npDefinition() == + npPP function npDefinitionItem and + npPush pfSequenceToList npPop1() pfSequenceToList x== - pfSequence? x => pfSequenceArgs x - pfListOf [x] + pfSequence? x => pfSequenceArgs x + pfListOf [x] --% Diagnostic routines npMissingMate(close,open)== - ncSoftError(tokPosn open, 'S2CY0008, []) - npMissing close + ncSoftError(tokPosn open, 'S2CY0008, []) + npMissing close npMissing s== - ncSoftError(tokPosn $stok,'S2CY0007, [PNAME s]) - THROW("TRAPPOINT","TRAPPED") + ncSoftError(tokPosn $stok,'S2CY0007, [PNAME s]) + THROW("TRAPPOINT","TRAPPED") -npCompMissing s == npEqKey s or npMissing s +npCompMissing s == + npEqKey s or npMissing s npRecoverTrap()== npFirstTok() @@ -959,53 +1051,46 @@ npRecoverTrap()== npListAndRecover(f)== - a:=$stack - b:=nil - $stack:=nil - done:=false - c:=$inputStream - while not done repeat - found:=CATCH("TRAPPOINT",apply(f,nil)) - if found="TRAPPED" - then - $inputStream:=c - npRecoverTrap() - else if not found - then - $inputStream:=c - syGeneralErrorHere() - npRecoverTrap() - if npEqKey "BACKSET" - then - c:=$inputStream - else if npEqPeek "BACKTAB" - then - done:=true - else - $inputStream:=c - syGeneralErrorHere() - npRecoverTrap() - if npEqPeek "BACKTAB" - then done:=true - else - npNext() - c:=$inputStream - b := [npPop1(),:b] - $stack:=a - npPush nreverse b + a := $stack + b := nil + $stack := nil + done := false + c := $inputStream + while not done repeat + found:=CATCH("TRAPPOINT",apply(f,nil)) + if found="TRAPPED" then + $inputStream:=c + npRecoverTrap() + else if not found + then + $inputStream:=c + syGeneralErrorHere() + npRecoverTrap() + if npEqKey "BACKSET" then + c:=$inputStream + else if npEqPeek "BACKTAB" + then + done:=true + else + $inputStream:=c + syGeneralErrorHere() + npRecoverTrap() + if npEqPeek "BACKTAB" + then done:=true + else + npNext() + c:=$inputStream + b := [npPop1(),:b] + $stack := a + npPush nreverse b npMoveTo n== - if null $inputStream - then true - else - if npEqPeek "BACKTAB" - then if n=0 - then true - else (npNext();npMoveTo(n-1)) - else if npEqPeek "BACKSET" - then if n=0 - then true - else (npNext();npMoveTo n) - else if npEqKey "SETTAB" - then npMoveTo(n+1) - else (npNext();npMoveTo n) + $inputStream = nil => true + npEqPeek "BACKTAB" => + n = 0 => true + (npNext();npMoveTo(n-1)) + npEqPeek "BACKSET" => + n = 0 => true + (npNext();npMoveTo n) + npEqKey "SETTAB" => npMoveTo(n+1) + (npNext();npMoveTo n) |