From 499600fdff22b717a57aaee6934d1dbabe2723ef Mon Sep 17 00:00:00 2001 From: dos-reis Date: Thu, 13 Sep 2007 13:06:59 +0000 Subject: * Makefile.pamphlet (OBJS): Don't include ptrop.$(FASLEXT). (ptrees.$(FASLEXT)): New rule. (cparse.$(FASLEXT)): Likewise. * ptrop.boot.pamphlet: Move content to ptrees.boot.pamphlet. * ptrees.boot.pamphlet: Import posit, serror. * cparse.boot: New. Import ptrees. * cparse.boot.pamphlet: Move content to cparse.boot. Remove. * serror.boot: New. (pfSourceStok): Move to posit.boot. (npMissingMate): Move to cparse.boot. (npMissing): Likewise. (npCompMissing): Likewise. (npRecorverTrap): Likewise. (npListAndRecover): Likewise. (npMoveTo): Likewise. * serror.boot.pamphlet: Move content to serror.boot. Remove. --- src/interp/ChangeLog | 19 + src/interp/Makefile.in | 13 +- src/interp/Makefile.pamphlet | 30 +- src/interp/cparse.boot | 988 ++++++++++++++++++++++++++++++++++++++++ src/interp/cparse.boot.pamphlet | 941 -------------------------------------- src/interp/posit.boot | 7 + src/interp/ptrees.boot.pamphlet | 45 +- src/interp/ptrop.boot.pamphlet | 98 ---- src/interp/serror.boot | 68 +++ src/interp/serror.boot.pamphlet | 164 ------- 10 files changed, 1165 insertions(+), 1208 deletions(-) create mode 100644 src/interp/cparse.boot delete mode 100644 src/interp/cparse.boot.pamphlet delete mode 100644 src/interp/ptrop.boot.pamphlet create mode 100644 src/interp/serror.boot delete mode 100644 src/interp/serror.boot.pamphlet diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog index 2669f2de..6bc4a8e6 100644 --- a/src/interp/ChangeLog +++ b/src/interp/ChangeLog @@ -1,3 +1,22 @@ +2007-09-13 Gabriel Dos Reis + + * Makefile.pamphlet (OBJS): Don't include ptrop.$(FASLEXT). + (ptrees.$(FASLEXT)): New rule. + (cparse.$(FASLEXT)): Likewise. + * ptrop.boot.pamphlet: Move content to ptrees.boot.pamphlet. + * ptrees.boot.pamphlet: Import posit, serror. + * cparse.boot: New. Import ptrees. + * cparse.boot.pamphlet: Move content to cparse.boot. Remove. + * serror.boot: New. + (pfSourceStok): Move to posit.boot. + (npMissingMate): Move to cparse.boot. + (npMissing): Likewise. + (npCompMissing): Likewise. + (npRecorverTrap): Likewise. + (npListAndRecover): Likewise. + (npMoveTo): Likewise. + * serror.boot.pamphlet: Move content to serror.boot. Remove. + 2007-09-13 Gabriel Dos Reis * i-output.boot.pamphlet (exptNeedsPren): Use GETL, not GET. diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 948d730b..3a4f4720 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -91,7 +91,7 @@ OBJS= vmlisp.$(FASLEXT) hash.$(FASLEXT) \ packtran.$(FASLEXT) pathname.$(FASLEXT) \ pf2sex.$(FASLEXT) pile.$(FASLEXT) \ posit.$(FASLEXT) property.$(FASLEXT) \ - ptrees.$(FASLEXT) ptrop.$(FASLEXT) \ + ptrees.$(FASLEXT) \ record.$(FASLEXT) \ rulesets.$(FASLEXT) \ scan.$(FASLEXT) serror.$(FASLEXT) \ @@ -133,7 +133,7 @@ AXIOMsys_boot_sources = astr.boot alql.boot buildom.boot cattable.boot \ intfile.boot lisplib.boot macex.boot match.boot msg.boot \ msgdb.boot newfort.boot nrunfast.boot nrungo.boot nrunopt.boot \ nruntime.boot osyscmd.boot packtran.boot pathname.boot \ - pf2sex.boot pile.boot posit.boot ptrees.boot ptrop.boot \ + pf2sex.boot pile.boot posit.boot ptrees.boot \ record.boot rulesets.boot scan.boot serror.boot server.boot \ setvars.boot sfsfun.boot simpbool.boot slam.boot template.boot \ termrw.boot trace.boot fortcall.boot @@ -480,6 +480,12 @@ $(AUTO)/%.$(FASLEXT): %.$(FASLEXT) $(INSTALL) $< $@ +cparse.$(FASLEXT): cparse.clisp ptrees.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + +ptrees.$(FASLEXT): ptrees.clisp posit.$(FASLEXT) serror.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + pile.$(FASLEXT): pile.clisp scan.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< @@ -492,6 +498,9 @@ incl.$(FASLEXT): incl.clisp cstream.$(FASLEXT) cformat.$(FASLEXT) cformat.$(FASLEXT): cformat.clisp unlisp.$(FASLEXT) posit.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< +serror.$(FASLEXT): serror.boot posit.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + unlisp.$(FASLEXT): unlisp.lisp sys-macros.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 9861ca75..6441ae64 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -364,7 +364,7 @@ OBJS= vmlisp.$(FASLEXT) hash.$(FASLEXT) \ packtran.$(FASLEXT) pathname.$(FASLEXT) \ pf2sex.$(FASLEXT) pile.$(FASLEXT) \ posit.$(FASLEXT) property.$(FASLEXT) \ - ptrees.$(FASLEXT) ptrop.$(FASLEXT) \ + ptrees.$(FASLEXT) \ record.$(FASLEXT) \ rulesets.$(FASLEXT) \ scan.$(FASLEXT) serror.$(FASLEXT) \ @@ -406,7 +406,7 @@ AXIOMsys_boot_sources = astr.boot alql.boot buildom.boot cattable.boot \ intfile.boot lisplib.boot macex.boot match.boot msg.boot \ msgdb.boot newfort.boot nrunfast.boot nrungo.boot nrunopt.boot \ nruntime.boot osyscmd.boot packtran.boot pathname.boot \ - pf2sex.boot pile.boot posit.boot ptrees.boot ptrop.boot \ + pf2sex.boot pile.boot posit.boot ptrees.boot \ record.boot rulesets.boot scan.boot serror.boot server.boot \ setvars.boot sfsfun.boot simpbool.boot slam.boot template.boot \ termrw.boot trace.boot fortcall.boot @@ -1974,6 +1974,29 @@ distclean-local: clean-local $(AUTO)/%.$(FASLEXT): %.$(FASLEXT) $(INSTALL) $< $@ +## +## OpenAxiom's front-end consists of two parts: +## (a) the interprerter's parser -- also referred to as new parser +## (b) the compiler parser -- also referred to as parser +## +## The new parser component is always included in a running OpenAxiom +## image. However the old parser component is so called `autoloaded'. +## While in theory that should work, in practice it turns out that +## people tend to override functions in the autoload part, correcting +## bugs only there. The consequence is that the same function will +## bahave very differently based on the history of the seesion. Ideal +## recipe for creating heisenbugs. +## +## The new parser component roughtly is: +## astr.boot dq.boot incl.boot pile.boot ptrees.boot +## posit.boot cparse.boot format.boot cstream.boot +## + +cparse.$(FASLEXT): cparse.clisp ptrees.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + +ptrees.$(FASLEXT): ptrees.clisp posit.$(FASLEXT) serror.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< pile.$(FASLEXT): pile.clisp scan.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< @@ -1987,6 +2010,9 @@ incl.$(FASLEXT): incl.clisp cstream.$(FASLEXT) cformat.$(FASLEXT) cformat.$(FASLEXT): cformat.clisp unlisp.$(FASLEXT) posit.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< +serror.$(FASLEXT): serror.boot posit.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + unlisp.$(FASLEXT): unlisp.lisp sys-macros.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot new file mode 100644 index 00000000..c49ee250 --- /dev/null +++ b/src/interp/cparse.boot @@ -0,0 +1,988 @@ +-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- All rights reserved. +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- - Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. +-- +-- - Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in +-- the documentation and/or other materials provided with the +-- distribution. +-- +-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- names of its contributors may be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +import '"ptrees" + +)package "BOOT" + +-- npTerm introduced between npRemainder and npSum +-- rhs of assignment changed from npStatement to npGives + +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 + CAR $stack + +npItem()== + npQualDef() => + npEqKey "SEMICOLON" => + [a,b]:=npItem1 npPop1 () + c:=pfEnSequence b + a => npPush c + npPush pfNovalue c + npPush pfEnSequence npPop1 () + false + +npItem1 c== + npQualDef() => + npEqKey "SEMICOLON" => + [a,b]:=npItem1 npPop1 () + [a,append(c,b)] + [true,append (c,npPop1())] + [false,c] + +npFirstTok()== + $stok:= + if null $inputStream + then tokConstruct("ERROR","NOMORE",tokPosn $stok) + else CAR $inputStream + $ttok:=tokPart $stok + +npNext() == + $inputStream := CDR($inputStream) + npFirstTok() + +npState()==cons($inputStream,$stack) + +npRestore(x)== + $inputStream:=CAR x + npFirstTok() + $stack:=CDR x + true + +npPush x==$stack:=CONS(x,$stack) + +npPushId()== + a:=GETL($ttok,'INFGENERIC) + $ttok:= if a then a else $ttok + $stack:=CONS(tokConstruct("id",$ttok,tokPosn $stok),$stack) + npNext() + +npPop1()== + a:=CAR $stack + $stack:=CDR $stack + a + +npPop2()== + a:=CADR $stack + RPLACD($stack,CDDR $stack) + a + +npPop3()== + a:=CADDR $stack + RPLACD(CDR $stack,CDDDR $stack) + a + +npParenthesized f== + npParenthesize("(",")",f) or + npParenthesize("(|","|)",f) + +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 + +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 + false + +npParened f == + npEnclosed("(",")",function pfParen,f) or + npEnclosed("(|","|)",function pfParen,f) + +npBracked f == + npEnclosed("[","]",function pfBracket,f) or + npEnclosed("[|","|]",function pfBracketBar,f) + +npBraced f == + npEnclosed("{","}",function pfBrace,f) or + npEnclosed("{|","|}",function pfBraceBar,f) + +npAngleBared f == + npEnclosed("<|","|>",function pfHide,f) + +npBracketed f== + npParened f or npBracked f or npBraced f or npAngleBared f + +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 + +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:=cons(NREVERSE $stack,a) + npPush FUNCALL(g, [npPop3(),npPop2(),:npPop1()]) + else + true + else false + +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:=cons(NREVERSE $stack,a) + npPush FUNCALL(g, [npPop3(),npPop2(),:npPop1()]) + else + npPush FUNCALL(g, [npPop1()]) + else npPush FUNCALL(g, []) + + +++ rewrite flets, using global scoping +$npPParg := nil + +npPPff() == + FUNCALL $npPParg and npPush [npPop1()] + +npPPf() == + npSemiListing function npPPff + +npPPg() == + npListAndRecover function npPPf + and npPush pfAppend npPop1() + +npPP(f) == + $npPParg := f + npParened function npPPf + or npPileBracketed function npPPg and + npPush pfEnSequence npPop1() + or FUNCALL f + +++ rewrite flets, using global scoping +$npPCff := nil + +npPCff() == + FUNCALL $npPCff and npPush [npPop1()] + +npPCg() == + npListAndRecover function npPCff + and npPush pfAppend npPop1() + +npPC(f) == + $npPCff := f + npPileBracketed function npPCg and + npPush pfEnSequence npPop1() + or FUNCALL f + + +-- s must transform the head of the stack + +npAnyNo s== + while APPLY(s,nil) repeat 0 + true + +npAndOr(keyword,p,f)== + npEqKey keyword and (APPLY(p,nil) or npTrap()) + and npPush FUNCALL(f, npPop1()) + +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()== + EQ(CAAR $stok,"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 + +npInfKey s== EQ(CAAR $stok,"key") and MEMQ($ttok,s) and npPushId() + +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()) + +npBacksetElse()== + if npEqKey "BACKSET" + then npEqKey "ELSE" + else npEqKey "ELSE" + +npWConditional f== + if npConditional f + then npPush pfTweakIf npPop1() + else false + +-- Parsing functions + +-- peek for keyword s, no advance of token stream + +npEqPeek s == EQ(CAAR $stok,"key") and EQ(s,$ttok) + +-- test for keyword s, if found advance token stream + +npEqKey s == + EQ(CAAR $stok,"key") and EQ(s,$ttok) and npNext() + +$npTokToNames:= ["~","#","[]","{}", "[||]","{||}"] + +npId() == + EQ(CAAR $stok,"id") => + npPush $stok + npNext() + EQ(CAAR $stok,"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 + +npName()==npId() or npSymbolVariable() + +npConstTok() == + MEMQ(tokType $stok, '(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 + + +npPrimary1() == + npEncAp function npAtom1 or + npLet() or + npFix() or + npMacro() or + npBPileDefinition() or npDefn() or + npRule() + +npPrimary2()== npEncAp function npAtom2 -- or npBPileDefinition() + or npAdd(pfNothing()) or npWith(pfNothing()) + + +npAtom1()== npPDefinition() or ((npName() or npConstTok() or + npDollar() or npBDefinition()) and npFromdom()) + +npAtom2()== (npInfixOperator() or npAmpersand() or npPrefixColon()) + and npFromdom() + +npDollar()== npEqPeek "$" 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() + + +npEncl()== npBDefinition() and npPush pfApplication(npPop2(),npPop1()) + +npFromdom()== + npEqKey "$" and (npApplication() or npTrap()) + and npFromdom1 npPop1() and npPush pfFromDom(npPop1(),npPop1()) + or true + +npFromdom1 c== + npEqKey "$" and (npApplication() or npTrap()) + and npFromdom1 npPop1() and npPush pfFromDom(npPop1(),c) + or npPush c + + +npPrimary()== npPrimary1() or npPrimary2() + +npDotted f== APPLY(f,nil) and npAnyNo function npSelector + +npSelector()== + npEqKey "DOT" and (npPrimary() or npTrap()) and + npPush(pfApplication(npPop2(),npPop1())) + +npApplication()== + npDotted function npPrimary and + (npApplication2() and + npPush(pfApplication(npPop2(),npPop1())) or true) + + +npApplication2()== + npDotted function npPrimary1 and + (npApplication2() and + npPush(pfApplication(npPop2(),npPop1())) or true) + +npTypedForm1(sy,fn) == + npEqKey sy and (npType() or npTrap()) and + npPush FUNCALL(fn,npPop2(),npPop1()) + +npTypedForm(sy,fn) == + npEqKey sy and (npApplication() or npTrap()) and + npPush FUNCALL(fn,npPop2(),npPop1()) + +npRestrict() == npTypedForm("AT",function pfRestrict) + +npCoerceTo() == npTypedForm("COERCE",function pfCoerceto) + +npColonQuery() == npTypedForm("ATAT",function pfRetractTo) + +npPretend() == npTypedForm("PRETEND",function pfPretend) + +npTypeStyle()== + npCoerceTo() or npRestrict() or npPretend() or npColonQuery() + +npTypified ()==npApplication() and npAnyNo function npTypeStyle + +npTagged() == npTypedForm1("COLON",function pfTagged) + +npColon () == npTypified() and npAnyNo function npTagged + +npPower() == npRightAssoc('(POWER CARAT),function npColon) + +npProduct()== + npLeftAssoc('(TIMES SLASH BACKSLASH SLASHSLASH + BACKSLASHBACKSLASH SLASHBACKSLASH BACKSLASHSLASH ) + ,function npPower) + +npRemainder()== + npLeftAssoc('(REM QUO ) ,function npProduct) + +npTerm()== + npInfGeneric '(MINUS PLUS) and (npRemainder() + and npPush(pfApplication(npPop2(),npPop1())) or true) + or npRemainder() + + +npSum()==npLeftAssoc('(PLUS MINUS),function npTerm) + +npArith()==npLeftAssoc('(MOD),function npSum) + +npSegment()== npEqPeek "SEG" and npPushId() and npFromdom() + +npInterval()== + npArith() and + (npSegment() and ((npEqPeek "BAR" + and npPush(pfApplication(npPop1(),npPop1()))) or + (npArith() and npPush(pfInfApplication(npPop2(),npPop2(),npPop1()))) + or npPush(pfApplication(npPop1(),npPop1()))) or true) + +npBy()== npLeftAssoc ('(BY),function npInterval) + +npAmpersand()== npEqKey "AMPERSAND" and (npName() or npTrap()) +npAmpersandFrom()== npAmpersand() and npFromdom() + +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) + +npQuiver() == npRightAssoc('(ARROW LARROW),function npRelation) +npDiscrim() == npLeftAssoc ('(CASE HAS), function npQuiver) + +npDisjand() == npLeftAssoc('(AND ),function npDiscrim) + +npLogical() == npLeftAssoc('(OR ),function npDisjand) +npSuch() == npLeftAssoc( '(BAR),function npLogical) +npMatch() == npLeftAssoc ('(IS ISNT ), function npSuch) + +npType() == npMatch() and + a:=npPop1() + npWith(a) or npPush a + +npADD() == npType() and + a:=npPop1() + npAdd(a) or npPush a + +npConditionalStatement()==npConditional function npQualifiedDefinition + +npExpress1()==npConditionalStatement() or npADD() + +npCommaBackSet()== npEqKey "COMMA" and (npEqKey "BACKSET" or true) + +npExpress()== + 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:=cons(NREVERSE $stack,a) + npPush cons(npPop2(),npPop1()) + npPush nil + true + +npIterators()== + npForIn() and npZeroOrMore function npIterator + and npPush cons(npPop2(),npPop1()) or + npWhile() and (npIterators() and + npPush cons(npPop2(),npPop1()) or npPush [npPop1()]) + +npIterator()== npForIn() or npSuchThat() or npWhile() + +npStatement()== + npExpress() or + npLoop() or + npIterate() or + npReturn() or + npBreak() or + npFree() or + npImport() or + npInline() or + npLocal() or + npExport() or + npTyping() 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 npMDEFinition) + +npMDEFinition() == npPP function npMdef + +npAssign()== npBackTrack(function npMDEF,"BECOMES",function npAssignment) + +npAssignment()== + 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 + +npAssignVariable()== npColon() and npPush pfListOf [npPop1()] + +npAssignVariablelist()== npListing function npAssignVariableName + +npExit()== npBackTrack(function npAssign,"EXIT",function npPileExit) + +npPileExit()== + npAssign() and (npEqKey "EXIT" or npTrap()) and + (npStatement() or npTrap()) + and npPush pfExit (npPop2(),npPop1()) + +npGives()== npBackTrack(function npExit,"GIVES",function npLambda) + +npDefinitionOrStatement()== + npBackTrack(function npGives,"DEF",function npDef) + +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()) +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 () + +npSuchThat()==npAndOr("BAR",function npLogical,function pfSuchthat) + +npWhile()==npAndOr ("WHILE",function npLogical,function pfWhile) + +npForIn()== + npEqKey "FOR" and (npVariable() or npTrap()) and (npCompMissing "IN") + and ((npBy() or npTrap()) and + npPush pfForin(npPop2(),npPop1())) + +npBreak()== + npEqKey "BREAK" and npPush pfBreak pfNothing () + +npIterate()== + npEqKey "ITERATE" and npPush pfIterate pfNothing () + +npQualType()== + npType() and + npPush pfQualType(npPop1(),pfNothing()) + +npSQualTypelist()== npListing function npQualType + and npPush pfParts npPop1 () + +npQualTypelist()== npPC function npSQualTypelist + and npPush pfUnSequence npPop1 () + +npImport()==npAndOr("IMPORT",function npQualTypelist,function pfImport) + +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()) + +npLocalItem()==npTypeVariable() and npLocalDecl() + +npLocalItemlist()== npPC function npSLocalItem + and npPush pfUnSequence npPop1 () + +npSLocalItem()== npListing function npLocalItem + and npPush pfAppend pfParts npPop1() + +npFree()== npEqKey "FREE" and (npLocalItemlist() or npTrap()) + and npPush pfFree npPop1() + +npLocal()== npEqKey "local" and (npLocalItemlist() or npTrap()) + and npPush pfLocal npPop1() +npExport()== npEqKey "EXPORT" and (npLocalItemlist() or npTrap()) + and npPush pfExport npPop1() + +npLet()== npLetQualified function npDefinitionOrStatement + +npDefn()== npEqKey "DEFN" and npPP function npDef + +npFix()== npEqKey "FIX" and npPP function npDef + and npPush pfFix npPop1 () + +npMacro()== npEqKey "MACRO" and npPP function npMdef + +npRule()== npEqKey "RULE" and npPP function npSingleRule + +npAdd(extra)== + npEqKey "ADD" and + 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())] + +npWith(extra)== + npEqKey "WITH" and + 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 + +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 + + +npSignatureDefinee()== + npName() or npInfixOperator() or npPrefixColon() + + +npSigDecl()== npEqKey "COLON" and (npType() or npTrap()) and + npPush pfSpread (pfParts npPop2(),npPop1()) + +npSigItem()==npTypeVariable() and (npSigDecl() or npTrap()) + +npSigItemlist()== npListing function npSigItem + and npPush pfListOf pfAppend pfParts npPop1() + +npSignature()== + npSigItemlist() and + npPush pfWDec(pfNothing(),npPop1()) + +npSemiListing (p)== + npListofFun(p,function npSemiBackSet,function pfAppend) + +npSemiBackSet()== npEqKey "SEMICOLON" and (npEqKey "BACKSET" or true) +npDecl()== npEqKey "COLON" and (npType() or npTrap()) and + npPush pfTyped (npPop2(),npPop1()) + +npVariableName()==npName() and + (npDecl() or npPush pfTyped(npPop1(),pfNothing())) + +npVariable()== npParenthesized function npVariablelist or + (npVariableName() and npPush pfListOf [npPop1()]) + +npVariablelist()== npListing function npVariableName + +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 + +npLetQualified f== + npEqKey "LET" and + (npDefinition() or npTrap()) and + npCompMissing "IN" and + (FUNCALL f or npTrap()) and + npPush pfWhere(npPop2(),npPop1()) + + +npQualifiedDefinition()== + npQualified function npDefinitionOrStatement + +npTuple (p)== + npListofFun(p,function npCommaBackSet,function pfTupleListOf) +npComma()== npTuple function npQualifiedDefinition + +npQualDef()== npComma() and npPush [npPop1()] + +npDefinitionlist ()==npSemiListing(function npQualDef) + +npPDefinition ()== + npParenthesized function npDefinitionlist and + npPush pfEnSequence npPop1() + +npBDefinition()== npPDefinition() or + npBracketed function npDefinitionlist + +npPileDefinitionlist()== + npListAndRecover function npDefinitionlist + and npPush pfAppend npPop1() + + +npTypeVariable()== npParenthesized function npTypeVariablelist or + npSignatureDefinee() and npPush pfListOf [npPop1()] + +npTypeVariablelist()== npListing function npSignatureDefinee + +npTyping()== + npEqKey "DEFAULT" and (npDefaultItemlist() or npTrap()) + and npPush pfTyping npPop1() + +npDefaultItemlist()== npPC function npSDefaultItem + and npPush pfUnSequence npPop1 () + +npDefaultDecl()== npEqKey "COLON" and (npType() or npTrap()) and + npPush pfSpread (pfParts npPop2(),npPop1()) + +npDefaultItem()==npTypeVariable() and (npDefaultDecl() or npTrap()) + +npSDefaultItem()== npListing function npDefaultItem + and npPush pfAppend pfParts npPop1() + +npBPileDefinition()== + npPileBracketed function npPileDefinitionlist + and npPush pfSequence pfListOf npPop1 () + + +npLambda()== + (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 + npEqKey "GIVES" and (npDefinitionOrStatement() or npTrap()) + and + npPush pfReturnTyped(npPop2(),npPop1()) + +npDef()== + npMatch() => + [op,arg,rt]:= pfCheckItOut(npPop1()) + npDefTail() or npTrap() + body:=npPop1() + null arg => npPush pfDefinition (op,body) + npPush pfDefinition (op,pfPushBody(rt,arg,body)) + false + +--npDefTail()== npEqKey "DEF" and npDefinitionOrStatement() +npDefTail()== (npEqKey "DEF" or npEqKey "MDEF") and npDefinitionOrStatement() + +npMdef()== + npQuiver() => + [op,arg]:= pfCheckMacroOut(npPop1()) + npDefTail() or npTrap() + body:=npPop1() + null arg => npPush pfMacro (op,body) + npPush pfMacro (op,pfPushMacroBody(arg,body)) + false + + +npSingleRule()== + npQuiver() => + npDefTail() or npTrap() + npPush pfRule (npPop2(),npPop1()) + false + +npDefinitionItem()== + npTyping() or + npImport() or + a:=npState() + npStatement() => + npEqPeek "DEF" => + npRestore a + npDef() + npRestore a + npMacro() or npDefn() + npTrap() + +npDefinition()== npPP function npDefinitionItem + and npPush pfSequenceToList npPop1 () + +pfSequenceToList x== + pfSequence? x => pfSequenceArgs x + pfListOf [x] + +--% Diagnostic routines + +npMissingMate(close,open)== + ncSoftError(tokPosn open, 'S2CY0008, []) + npMissing close + +npMissing s== + ncSoftError(tokPosn $stok,'S2CY0007, [PNAME s]) + THROW("TRAPPOINT","TRAPPED") + +npCompMissing s == npEqKey s or npMissing s + +npRecoverTrap()== + npFirstTok() + pos1 := tokPosn $stok + npMoveTo 0 + pos2 := tokPosn $stok + syIgnoredFromTo(pos1, pos2) + npPush [pfWrong(pfDocument ['"pile syntax error"],pfListOf [])] + + +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:=cons(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) diff --git a/src/interp/cparse.boot.pamphlet b/src/interp/cparse.boot.pamphlet deleted file mode 100644 index 7e9aeaa0..00000000 --- a/src/interp/cparse.boot.pamphlet +++ /dev/null @@ -1,941 +0,0 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/cparse.boot} Pamphlet} -\author{The Axiom Team} - -\begin{document} -\maketitle - -\begin{abstract} -\end{abstract} - -\tableofcontents -\eject - -\section{License} - -<>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -)package "BOOT" - --- npTerm introduced between npRemainder and npSum --- rhs of assignment changed from npStatement to npGives - -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 - CAR $stack - -npItem()== - npQualDef() => - npEqKey "SEMICOLON" => - [a,b]:=npItem1 npPop1 () - c:=pfEnSequence b - a => npPush c - npPush pfNovalue c - npPush pfEnSequence npPop1 () - false - -npItem1 c== - npQualDef() => - npEqKey "SEMICOLON" => - [a,b]:=npItem1 npPop1 () - [a,append(c,b)] - [true,append (c,npPop1())] - [false,c] - -npFirstTok()== - $stok:= - if null $inputStream - then tokConstruct("ERROR","NOMORE",tokPosn $stok) - else CAR $inputStream - $ttok:=tokPart $stok - -npNext() == - $inputStream := CDR($inputStream) - npFirstTok() - -npState()==cons($inputStream,$stack) - -npRestore(x)== - $inputStream:=CAR x - npFirstTok() - $stack:=CDR x - true - -npPush x==$stack:=CONS(x,$stack) - -npPushId()== - a:=GETL($ttok,'INFGENERIC) - $ttok:= if a then a else $ttok - $stack:=CONS(tokConstruct("id",$ttok,tokPosn $stok),$stack) - npNext() - -npPop1()== - a:=CAR $stack - $stack:=CDR $stack - a - -npPop2()== - a:=CADR $stack - RPLACD($stack,CDDR $stack) - a - -npPop3()== - a:=CADDR $stack - RPLACD(CDR $stack,CDDDR $stack) - a - -npParenthesized f== - npParenthesize("(",")",f) or - npParenthesize("(|","|)",f) - -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 - -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 - false - -npParened f == - npEnclosed("(",")",function pfParen,f) or - npEnclosed("(|","|)",function pfParen,f) - -npBracked f == - npEnclosed("[","]",function pfBracket,f) or - npEnclosed("[|","|]",function pfBracketBar,f) - -npBraced f == - npEnclosed("{","}",function pfBrace,f) or - npEnclosed("{|","|}",function pfBraceBar,f) - -npAngleBared f == - npEnclosed("<|","|>",function pfHide,f) - -npBracketed f== - npParened f or npBracked f or npBraced f or npAngleBared f - -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 - -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:=cons(NREVERSE $stack,a) - npPush FUNCALL(g, [npPop3(),npPop2(),:npPop1()]) - else - true - else false - -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:=cons(NREVERSE $stack,a) - npPush FUNCALL(g, [npPop3(),npPop2(),:npPop1()]) - else - npPush FUNCALL(g, [npPop1()]) - else npPush FUNCALL(g, []) - - -++ rewrite flets, using global scoping -$npPParg := nil - -npPPff() == - FUNCALL $npPParg and npPush [npPop1()] - -npPPf() == - npSemiListing function npPPff - -npPPg() == - npListAndRecover function npPPf - and npPush pfAppend npPop1() - -npPP(f) == - $npPParg := f - npParened function npPPf - or npPileBracketed function npPPg and - npPush pfEnSequence npPop1() - or FUNCALL f - -++ rewrite flets, using global scoping -$npPCff := nil - -npPCff() == - FUNCALL $npPCff and npPush [npPop1()] - -npPCg() == - npListAndRecover function npPCff - and npPush pfAppend npPop1() - -npPC(f) == - $npPCff := f - npPileBracketed function npPCg and - npPush pfEnSequence npPop1() - or FUNCALL f - - --- s must transform the head of the stack - -npAnyNo s== - while APPLY(s,nil) repeat 0 - true - -npAndOr(keyword,p,f)== - npEqKey keyword and (APPLY(p,nil) or npTrap()) - and npPush FUNCALL(f, npPop1()) - -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()== - EQ(CAAR $stok,"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 - -npInfKey s== EQ(CAAR $stok,"key") and MEMQ($ttok,s) and npPushId() - -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()) - -npBacksetElse()== - if npEqKey "BACKSET" - then npEqKey "ELSE" - else npEqKey "ELSE" - -npWConditional f== - if npConditional f - then npPush pfTweakIf npPop1() - else false - --- Parsing functions - --- peek for keyword s, no advance of token stream - -npEqPeek s == EQ(CAAR $stok,"key") and EQ(s,$ttok) - --- test for keyword s, if found advance token stream - -npEqKey s == - EQ(CAAR $stok,"key") and EQ(s,$ttok) and npNext() - -$npTokToNames:= ["~","#","[]","{}", "[||]","{||}"] - -npId() == - EQ(CAAR $stok,"id") => - npPush $stok - npNext() - EQ(CAAR $stok,"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 - -npName()==npId() or npSymbolVariable() - -npConstTok() == - MEMQ(tokType $stok, '(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 - - -npPrimary1() == - npEncAp function npAtom1 or - npLet() or - npFix() or - npMacro() or - npBPileDefinition() or npDefn() or - npRule() - -npPrimary2()== npEncAp function npAtom2 -- or npBPileDefinition() - or npAdd(pfNothing()) or npWith(pfNothing()) - - -npAtom1()== npPDefinition() or ((npName() or npConstTok() or - npDollar() or npBDefinition()) and npFromdom()) - -npAtom2()== (npInfixOperator() or npAmpersand() or npPrefixColon()) - and npFromdom() - -npDollar()== npEqPeek "$" 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() - - -npEncl()== npBDefinition() and npPush pfApplication(npPop2(),npPop1()) - -npFromdom()== - npEqKey "$" and (npApplication() or npTrap()) - and npFromdom1 npPop1() and npPush pfFromDom(npPop1(),npPop1()) - or true - -npFromdom1 c== - npEqKey "$" and (npApplication() or npTrap()) - and npFromdom1 npPop1() and npPush pfFromDom(npPop1(),c) - or npPush c - - -npPrimary()== npPrimary1() or npPrimary2() - -npDotted f== APPLY(f,nil) and npAnyNo function npSelector - -npSelector()== - npEqKey "DOT" and (npPrimary() or npTrap()) and - npPush(pfApplication(npPop2(),npPop1())) - -npApplication()== - npDotted function npPrimary and - (npApplication2() and - npPush(pfApplication(npPop2(),npPop1())) or true) - - -npApplication2()== - npDotted function npPrimary1 and - (npApplication2() and - npPush(pfApplication(npPop2(),npPop1())) or true) - -npTypedForm1(sy,fn) == - npEqKey sy and (npType() or npTrap()) and - npPush FUNCALL(fn,npPop2(),npPop1()) - -npTypedForm(sy,fn) == - npEqKey sy and (npApplication() or npTrap()) and - npPush FUNCALL(fn,npPop2(),npPop1()) - -npRestrict() == npTypedForm("AT",function pfRestrict) - -npCoerceTo() == npTypedForm("COERCE",function pfCoerceto) - -npColonQuery() == npTypedForm("ATAT",function pfRetractTo) - -npPretend() == npTypedForm("PRETEND",function pfPretend) - -npTypeStyle()== - npCoerceTo() or npRestrict() or npPretend() or npColonQuery() - -npTypified ()==npApplication() and npAnyNo function npTypeStyle - -npTagged() == npTypedForm1("COLON",function pfTagged) - -npColon () == npTypified() and npAnyNo function npTagged - -npPower() == npRightAssoc('(POWER CARAT),function npColon) - -npProduct()== - npLeftAssoc('(TIMES SLASH BACKSLASH SLASHSLASH - BACKSLASHBACKSLASH SLASHBACKSLASH BACKSLASHSLASH ) - ,function npPower) - -npRemainder()== - npLeftAssoc('(REM QUO ) ,function npProduct) - -npTerm()== - npInfGeneric '(MINUS PLUS) and (npRemainder() - and npPush(pfApplication(npPop2(),npPop1())) or true) - or npRemainder() - - -npSum()==npLeftAssoc('(PLUS MINUS),function npTerm) - -npArith()==npLeftAssoc('(MOD),function npSum) - -npSegment()== npEqPeek "SEG" and npPushId() and npFromdom() - -npInterval()== - npArith() and - (npSegment() and ((npEqPeek "BAR" - and npPush(pfApplication(npPop1(),npPop1()))) or - (npArith() and npPush(pfInfApplication(npPop2(),npPop2(),npPop1()))) - or npPush(pfApplication(npPop1(),npPop1()))) or true) - -npBy()== npLeftAssoc ('(BY),function npInterval) - -npAmpersand()== npEqKey "AMPERSAND" and (npName() or npTrap()) -npAmpersandFrom()== npAmpersand() and npFromdom() - -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) - -npQuiver() == npRightAssoc('(ARROW LARROW),function npRelation) -npDiscrim() == npLeftAssoc ('(CASE HAS), function npQuiver) - -npDisjand() == npLeftAssoc('(AND ),function npDiscrim) - -npLogical() == npLeftAssoc('(OR ),function npDisjand) -npSuch() == npLeftAssoc( '(BAR),function npLogical) -npMatch() == npLeftAssoc ('(IS ISNT ), function npSuch) - -npType() == npMatch() and - a:=npPop1() - npWith(a) or npPush a - -npADD() == npType() and - a:=npPop1() - npAdd(a) or npPush a - -npConditionalStatement()==npConditional function npQualifiedDefinition - -npExpress1()==npConditionalStatement() or npADD() - -npCommaBackSet()== npEqKey "COMMA" and (npEqKey "BACKSET" or true) - -npExpress()== - 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:=cons(NREVERSE $stack,a) - npPush cons(npPop2(),npPop1()) - npPush nil - true - -npIterators()== - npForIn() and npZeroOrMore function npIterator - and npPush cons(npPop2(),npPop1()) or - npWhile() and (npIterators() and - npPush cons(npPop2(),npPop1()) or npPush [npPop1()]) - -npIterator()== npForIn() or npSuchThat() or npWhile() - -npStatement()== - npExpress() or - npLoop() or - npIterate() or - npReturn() or - npBreak() or - npFree() or - npImport() or - npInline() or - npLocal() or - npExport() or - npTyping() 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 npMDEFinition) - -npMDEFinition() == npPP function npMdef - -npAssign()== npBackTrack(function npMDEF,"BECOMES",function npAssignment) - -npAssignment()== - 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 - -npAssignVariable()== npColon() and npPush pfListOf [npPop1()] - -npAssignVariablelist()== npListing function npAssignVariableName - -npExit()== npBackTrack(function npAssign,"EXIT",function npPileExit) - -npPileExit()== - npAssign() and (npEqKey "EXIT" or npTrap()) and - (npStatement() or npTrap()) - and npPush pfExit (npPop2(),npPop1()) - -npGives()== npBackTrack(function npExit,"GIVES",function npLambda) - -npDefinitionOrStatement()== - npBackTrack(function npGives,"DEF",function npDef) - -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()) -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 () - -npSuchThat()==npAndOr("BAR",function npLogical,function pfSuchthat) - -npWhile()==npAndOr ("WHILE",function npLogical,function pfWhile) - -npForIn()== - npEqKey "FOR" and (npVariable() or npTrap()) and (npCompMissing "IN") - and ((npBy() or npTrap()) and - npPush pfForin(npPop2(),npPop1())) - -npBreak()== - npEqKey "BREAK" and npPush pfBreak pfNothing () - -npIterate()== - npEqKey "ITERATE" and npPush pfIterate pfNothing () - -npQualType()== - npType() and - npPush pfQualType(npPop1(),pfNothing()) - -npSQualTypelist()== npListing function npQualType - and npPush pfParts npPop1 () - -npQualTypelist()== npPC function npSQualTypelist - and npPush pfUnSequence npPop1 () - -npImport()==npAndOr("IMPORT",function npQualTypelist,function pfImport) - -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()) - -npLocalItem()==npTypeVariable() and npLocalDecl() - -npLocalItemlist()== npPC function npSLocalItem - and npPush pfUnSequence npPop1 () - -npSLocalItem()== npListing function npLocalItem - and npPush pfAppend pfParts npPop1() - -npFree()== npEqKey "FREE" and (npLocalItemlist() or npTrap()) - and npPush pfFree npPop1() - -npLocal()== npEqKey "local" and (npLocalItemlist() or npTrap()) - and npPush pfLocal npPop1() -npExport()== npEqKey "EXPORT" and (npLocalItemlist() or npTrap()) - and npPush pfExport npPop1() - -npLet()== npLetQualified function npDefinitionOrStatement - -npDefn()== npEqKey "DEFN" and npPP function npDef - -npFix()== npEqKey "FIX" and npPP function npDef - and npPush pfFix npPop1 () - -npMacro()== npEqKey "MACRO" and npPP function npMdef - -npRule()== npEqKey "RULE" and npPP function npSingleRule - -npAdd(extra)== - npEqKey "ADD" and - 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())] - -npWith(extra)== - npEqKey "WITH" and - 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 - -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 - - -npSignatureDefinee()== - npName() or npInfixOperator() or npPrefixColon() - - -npSigDecl()== npEqKey "COLON" and (npType() or npTrap()) and - npPush pfSpread (pfParts npPop2(),npPop1()) - -npSigItem()==npTypeVariable() and (npSigDecl() or npTrap()) - -npSigItemlist()== npListing function npSigItem - and npPush pfListOf pfAppend pfParts npPop1() - -npSignature()== - npSigItemlist() and - npPush pfWDec(pfNothing(),npPop1()) - -npSemiListing (p)== - npListofFun(p,function npSemiBackSet,function pfAppend) - -npSemiBackSet()== npEqKey "SEMICOLON" and (npEqKey "BACKSET" or true) -npDecl()== npEqKey "COLON" and (npType() or npTrap()) and - npPush pfTyped (npPop2(),npPop1()) - -npVariableName()==npName() and - (npDecl() or npPush pfTyped(npPop1(),pfNothing())) - -npVariable()== npParenthesized function npVariablelist or - (npVariableName() and npPush pfListOf [npPop1()]) - -npVariablelist()== npListing function npVariableName - -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 - -npLetQualified f== - npEqKey "LET" and - (npDefinition() or npTrap()) and - npCompMissing "IN" and - (FUNCALL f or npTrap()) and - npPush pfWhere(npPop2(),npPop1()) - - -npQualifiedDefinition()== - npQualified function npDefinitionOrStatement - -npTuple (p)== - npListofFun(p,function npCommaBackSet,function pfTupleListOf) -npComma()== npTuple function npQualifiedDefinition - -npQualDef()== npComma() and npPush [npPop1()] - -npDefinitionlist ()==npSemiListing(function npQualDef) - -npPDefinition ()== - npParenthesized function npDefinitionlist and - npPush pfEnSequence npPop1() - -npBDefinition()== npPDefinition() or - npBracketed function npDefinitionlist - -npPileDefinitionlist()== - npListAndRecover function npDefinitionlist - and npPush pfAppend npPop1() - - -npTypeVariable()== npParenthesized function npTypeVariablelist or - npSignatureDefinee() and npPush pfListOf [npPop1()] - -npTypeVariablelist()== npListing function npSignatureDefinee - -npTyping()== - npEqKey "DEFAULT" and (npDefaultItemlist() or npTrap()) - and npPush pfTyping npPop1() - -npDefaultItemlist()== npPC function npSDefaultItem - and npPush pfUnSequence npPop1 () - -npDefaultDecl()== npEqKey "COLON" and (npType() or npTrap()) and - npPush pfSpread (pfParts npPop2(),npPop1()) - -npDefaultItem()==npTypeVariable() and (npDefaultDecl() or npTrap()) - -npSDefaultItem()== npListing function npDefaultItem - and npPush pfAppend pfParts npPop1() - -npBPileDefinition()== - npPileBracketed function npPileDefinitionlist - and npPush pfSequence pfListOf npPop1 () - - -npLambda()== - (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 - npEqKey "GIVES" and (npDefinitionOrStatement() or npTrap()) - and - npPush pfReturnTyped(npPop2(),npPop1()) - -npDef()== - npMatch() => - [op,arg,rt]:= pfCheckItOut(npPop1()) - npDefTail() or npTrap() - body:=npPop1() - null arg => npPush pfDefinition (op,body) - npPush pfDefinition (op,pfPushBody(rt,arg,body)) - false - ---npDefTail()== npEqKey "DEF" and npDefinitionOrStatement() -npDefTail()== (npEqKey "DEF" or npEqKey "MDEF") and npDefinitionOrStatement() - -npMdef()== - npQuiver() => - [op,arg]:= pfCheckMacroOut(npPop1()) - npDefTail() or npTrap() - body:=npPop1() - null arg => npPush pfMacro (op,body) - npPush pfMacro (op,pfPushMacroBody(arg,body)) - false - - -npSingleRule()== - npQuiver() => - npDefTail() or npTrap() - npPush pfRule (npPop2(),npPop1()) - false - -npDefinitionItem()== - npTyping() or - npImport() or - a:=npState() - npStatement() => - npEqPeek "DEF" => - npRestore a - npDef() - npRestore a - npMacro() or npDefn() - npTrap() - -npDefinition()== npPP function npDefinitionItem - and npPush pfSequenceToList npPop1 () - -pfSequenceToList x== - pfSequence? x => pfSequenceArgs x - pfListOf [x] -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/posit.boot b/src/interp/posit.boot index b9c546e4..37ab021a 100644 --- a/src/interp/posit.boot +++ b/src/interp/posit.boot @@ -92,6 +92,13 @@ poGetLineObject posn == CAR posn pfGetLineObject posn == poGetLineObject posn +pfSourceStok x== + if pfLeaf? x + then x + else if null pfParts x + then 'NoToken + else pfSourceStok pfFirst x + pfSourceToken form == if pfLeaf? form then pfLeafToken form diff --git a/src/interp/ptrees.boot.pamphlet b/src/interp/ptrees.boot.pamphlet index dea41bdc..414b09af 100644 --- a/src/interp/ptrees.boot.pamphlet +++ b/src/interp/ptrees.boot.pamphlet @@ -62,6 +62,9 @@ THE PFORM DATA STRUCTURE <<*>>= <> +import '"posit" +import '"serror" + )package "BOOT" --% SPECIAL NODES @@ -741,7 +744,47 @@ pfFlattenApp x== [x] - +--% Utility operations on Abstract Syntax Trees + +-- An S-expression which people can read. +pfSexpr pform == + strip pform where + strip pform == + pfId? pform => pfIdSymbol pform + pfLiteral? pform => pfLiteralString pform + pfLeaf? pform => tokPart pform + + pfApplication? pform => + args := + a := pfApplicationArg pform + if pfTuple? a then pf0TupleParts a else [a] + [strip p for p in cons(pfApplicationOp pform, args)] + + cons(pfAbSynOp pform, [strip p for p in pfParts pform]) + +pfCopyWithPos( pform , pos ) == + pfLeaf? pform => pfLeaf( pfAbSynOp pform , tokPart pform , pos ) + pfTree( pfAbSynOp pform , [ pfCopyWithPos( p , pos ) for p in pfParts pform ] ) + +pfMapParts(f, pform) == + pfLeaf? pform => pform + parts0 := pfParts pform + parts1 := [FUNCALL(f, p) for p in parts0] + -- Return the original if no changes. + same := true + for p0 in parts0 for p1 in parts1 while same repeat same := EQ(p0,p1) + same => pform + pfTree(pfAbSynOp pform, parts1) + + +pf0ApplicationArgs pform == + arg := pfApplicationArg pform + pf0FlattenSyntacticTuple arg + +pf0FlattenSyntacticTuple pform == + not pfTuple? pform => [pform] + [:pf0FlattenSyntacticTuple p for p in pf0TupleParts pform] + @ \eject \begin{thebibliography}{99} diff --git a/src/interp/ptrop.boot.pamphlet b/src/interp/ptrop.boot.pamphlet deleted file mode 100644 index 70a65623..00000000 --- a/src/interp/ptrop.boot.pamphlet +++ /dev/null @@ -1,98 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp ptrop.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -)package "BOOT" - ---% Utility operations on Abstract Syntax Trees - --- An S-expression which people can read. -pfSexpr pform == - strip pform where - strip pform == - pfId? pform => pfIdSymbol pform - pfLiteral? pform => pfLiteralString pform - pfLeaf? pform => tokPart pform - - pfApplication? pform => - args := - a := pfApplicationArg pform - if pfTuple? a then pf0TupleParts a else [a] - [strip p for p in cons(pfApplicationOp pform, args)] - - cons(pfAbSynOp pform, [strip p for p in pfParts pform]) - -pfCopyWithPos( pform , pos ) == - pfLeaf? pform => pfLeaf( pfAbSynOp pform , tokPart pform , pos ) - pfTree( pfAbSynOp pform , [ pfCopyWithPos( p , pos ) for p in pfParts pform ] ) - -pfMapParts(f, pform) == - pfLeaf? pform => pform - parts0 := pfParts pform - parts1 := [FUNCALL(f, p) for p in parts0] - -- Return the original if no changes. - same := true - for p0 in parts0 for p1 in parts1 while same repeat same := EQ(p0,p1) - same => pform - pfTree(pfAbSynOp pform, parts1) - - -pf0ApplicationArgs pform == - arg := pfApplicationArg pform - pf0FlattenSyntacticTuple arg - -pf0FlattenSyntacticTuple pform == - not pfTuple? pform => [pform] - [:pf0FlattenSyntacticTuple p for p in pf0TupleParts pform] - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/serror.boot b/src/interp/serror.boot new file mode 100644 index 00000000..0435e7ac --- /dev/null +++ b/src/interp/serror.boot @@ -0,0 +1,68 @@ +-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- All rights reserved. +-- Copyright (C) 2007, Gabriel Dos Reis. +-- All rights reserved. +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- - Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. +-- +-- - Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in +-- the documentation and/or other materials provided with the +-- distribution. +-- +-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- names of its contributors may be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +import '"posit" + +--% Functions to handle specific errors (mostly syntax) + +)package "BOOT" + +syGeneralErrorHere() == + sySpecificErrorHere('S2CY0002, []) + +sySpecificErrorHere(key, args) == + sySpecificErrorAtToken($stok, key, args) + +sySpecificErrorAtToken(tok, key, args) == + pos := tokPosn tok + ncSoftError(pos, key, args) + +syIgnoredFromTo(pos1, pos2) == + if pfGlobalLinePosn pos1 = pfGlobalLinePosn pos2 then + ncSoftError(FromTo(pos1,pos2), 'S2CY0005, []) + else + ncSoftError(From pos1, 'S2CY0003, []) + ncSoftError(To pos2, 'S2CY0004, []) + +npTrapForm(x)== + a:=pfSourceStok x + EQ(a,'NoToken)=> + syGeneralErrorHere() + THROW("TRAPPOINT","TRAPPED") + ncSoftError(tokPosn a, 'S2CY0002, []) + THROW("TRAPPOINT","TRAPPED") + +npTrap()== + ncSoftError(tokPosn $stok,'S2CY0002,[]) + THROW("TRAPPOINT","TRAPPED") + diff --git a/src/interp/serror.boot.pamphlet b/src/interp/serror.boot.pamphlet deleted file mode 100644 index 753655e9..00000000 --- a/src/interp/serror.boot.pamphlet +++ /dev/null @@ -1,164 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp serror.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - ---% Functions to handle specific errors (mostly syntax) - -)package "BOOT" - -syGeneralErrorHere() == - sySpecificErrorHere('S2CY0002, []) - -sySpecificErrorHere(key, args) == - sySpecificErrorAtToken($stok, key, args) - -sySpecificErrorAtToken(tok, key, args) == - pos := tokPosn tok - ncSoftError(pos, key, args) - -syIgnoredFromTo(pos1, pos2) == - if pfGlobalLinePosn pos1 = pfGlobalLinePosn pos2 then - ncSoftError(FromTo(pos1,pos2), 'S2CY0005, []) - else - ncSoftError(From pos1, 'S2CY0003, []) - ncSoftError(To pos2, 'S2CY0004, []) - -npMissingMate(close,open)== - ncSoftError(tokPosn open, 'S2CY0008, []) - npMissing close - -npMissing s== - ncSoftError(tokPosn $stok,'S2CY0007, [PNAME s]) - THROW("TRAPPOINT","TRAPPED") - -npCompMissing s == npEqKey s or npMissing s - -pfSourceStok x== - if pfLeaf? x - then x - else if null pfParts x - then 'NoToken - else pfSourceStok pfFirst x - -npTrapForm(x)== - a:=pfSourceStok x - EQ(a,'NoToken)=> - syGeneralErrorHere() - THROW("TRAPPOINT","TRAPPED") - ncSoftError(tokPosn a, 'S2CY0002, []) - THROW("TRAPPOINT","TRAPPED") - -npTrap()== - ncSoftError(tokPosn $stok,'S2CY0002,[]) - THROW("TRAPPOINT","TRAPPED") - -npRecoverTrap()== - npFirstTok() - pos1 := tokPosn $stok - npMoveTo 0 - pos2 := tokPosn $stok - syIgnoredFromTo(pos1, pos2) - npPush [pfWrong(pfDocument ['"pile syntax error"],pfListOf [])] - - -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:=cons(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) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} -- cgit v1.2.3