diff --git a/changelog b/changelog index 7482db5..0251ad9 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,8 @@ +20090815 tpd src/axiom-website/patches.html 20090815.01.tpd.patch +20090815 tpd src/interp/Makefile move cparse.boot to cparse.lisp +20090815 tpd src/interp/debugsys.lisp change astr.clisp to cparse.lisp +20090815 tpd src/interp/cparse.lisp added, rewritten from cparse.boot +20090815 tpd src/interp/cparse.boot removed, rewritten to cparse.lisp 20090814 tpd src/axiom-website/patches.html 20090814.01.tpd.patch 20090814 tpd src/interp/Makefile move compress.boot to compress.lisp 20090814 tpd src/interp/debugsys.lisp change astr.clisp to compress.lisp diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index d91a712..8ee4916 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1786,6 +1786,8 @@ clammed.lisp rewrite from boot to lisp
compat.lisp rewrite from boot to lisp
20090814.01.tpd.patch compress.lisp rewrite from boot to lisp
+20090815.01.tpd.patch +cparse.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index b455ce9..a28a5e2 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -418,7 +418,7 @@ DOCFILES=${DOC}/as.boot.dvi \ ${DOC}/c-doc.boot.dvi \ ${DOC}/cfuns.lisp.dvi \ ${DOC}/compiler.boot.dvi \ - ${DOC}/cparse.boot.dvi ${DOC}/cstream.boot.dvi \ + ${DOC}/cstream.boot.dvi \ ${DOC}/c-util.boot.dvi ${DOC}/daase.lisp.dvi \ ${DOC}/database.boot.dvi \ ${DOC}/define.boot.dvi \ @@ -5414,44 +5414,26 @@ ${DOC}/pile.boot.dvi: ${IN}/pile.boot.pamphlet @ -\subsection{cparse.boot} +\subsection{cparse.lisp} <>= -${OUT}/cparse.${O}: ${MID}/cparse.clisp - @ echo 513 making ${OUT}/cparse.${O} from ${MID}/cparse.clisp - @ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/cparse.clisp"' \ - ':output-file "${OUT}/cparse.${O}") (${BYE}))' | ${DEPSYS} ; \ +${OUT}/cparse.${O}: ${MID}/cparse.lisp + @ echo 136 making ${OUT}/cparse.${O} from ${MID}/cparse.lisp + @ ( cd ${MID} ; \ + if [ -z "${NOISE}" ] ; then \ + echo '(progn (compile-file "${MID}/cparse.lisp"' \ + ':output-file "${OUT}/cparse.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/cparse.clisp"' \ + echo '(progn (compile-file "${MID}/cparse.lisp"' \ ':output-file "${OUT}/cparse.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ - fi + fi ) @ -<>= -${MID}/cparse.clisp: ${IN}/cparse.boot.pamphlet - @ echo 514 making ${MID}/cparse.clisp from ${IN}/cparse.boot.pamphlet +<>= +${MID}/cparse.lisp: ${IN}/cparse.lisp.pamphlet + @ echo 137 making ${MID}/cparse.lisp from ${IN}/cparse.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/cparse.boot.pamphlet >cparse.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "${MID}/cparse.boot") (${BYE}))' \ - | ${BOOTSYS} ; \ - else \ - echo '(progn (boottran::boottocl "${MID}/cparse.boot") (${BYE}))' \ - | ${BOOTSYS} >${TMP}/trace ; \ - fi ; \ - rm cparse.boot ) - -@ -<>= -${DOC}/cparse.boot.dvi: ${IN}/cparse.boot.pamphlet - @echo 515 making ${DOC}/cparse.boot.dvi from ${IN}/cparse.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/cparse.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} cparse.boot ; \ - rm -f ${DOC}/cparse.boot.pamphlet ; \ - rm -f ${DOC}/cparse.boot.tex ; \ - rm -f ${DOC}/cparse.boot ) + ${TANGLE} ${IN}/cparse.lisp.pamphlet >cparse.lisp ) @ @@ -6773,8 +6755,7 @@ clean: <> <> -<> -<> +<> <> <> diff --git a/src/interp/cparse.boot.pamphlet b/src/interp/cparse.boot.pamphlet deleted file mode 100644 index afacbea..0000000 --- a/src/interp/cparse.boot.pamphlet +++ /dev/null @@ -1,900 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp cparse.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" - --- 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:=GET($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, []) - - - --- 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 - GET($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/cparse.lisp.pamphlet b/src/interp/cparse.lisp.pamphlet new file mode 100644 index 0000000..ef17595 --- /dev/null +++ b/src/interp/cparse.lisp.pamphlet @@ -0,0 +1,2324 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp cparse.boot} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= + +(IN-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 + +(DEFUN |npParse| (|stream|) + (PROG (|$ttok| |$stok| |$stack| |$inputStream| |found|) + (DECLARE (SPECIAL |$ttok| |$stack| |$inputStream| |$stok|)) + (RETURN + (PROGN + (SETQ |$inputStream| |stream|) + (SETQ |$stack| NIL) + (SETQ |$stok| NIL) + (SETQ |$ttok| NIL) + (|npFirstTok|) + (SETQ |found| (CATCH (QUOTE TRAPPOINT) (|npItem|))) + (COND + ((EQ |found| (QUOTE TRAPPED)) + (|ncSoftError| (|tokPosn| |$stok|) (QUOTE S2CY0006) NIL) + (|pfWrong| (|pfDocument| "top level syntax error") (|pfListOf| NIL))) + ((NULL (NULL |$inputStream|)) + (|ncSoftError| (|tokPosn| |$stok|) (QUOTE S2CY0002) NIL) + (|pfWrong| + (|pfDocument| (LIST "input stream not exhausted")) + (|pfListOf| NIL))) + ((NULL |$stack|) + (|ncSoftError| (|tokPosn| |$stok|) (QUOTE S2CY0009) NIL) + (|pfWrong| (|pfDocument| (LIST "stack empty")) (|pfListOf| NIL))) + ((QUOTE T) (CAR |$stack|))))))) + +;npItem()== +; npQualDef() => +; npEqKey "SEMICOLON" => +; [a,b]:=npItem1 npPop1 () +; c:=pfEnSequence b +; a => npPush c +; npPush pfNovalue c +; npPush pfEnSequence npPop1 () +; false + +(DEFUN |npItem| () + (PROG (|c| |b| |a| |LETTMP#1|) + (RETURN + (COND + ((|npQualDef|) + (COND + ((|npEqKey| (QUOTE SEMICOLON)) + (PROGN + (SETQ |LETTMP#1| (|npItem1| (|npPop1|))) + (SETQ |a| (CAR |LETTMP#1|)) + (SETQ |b| (CADR |LETTMP#1|)) + (SETQ |c| (|pfEnSequence| |b|)) + (COND + (|a| (|npPush| |c|)) + (#0=(QUOTE T) (|npPush| (|pfNovalue| |c|)))))) + (#0# (|npPush| (|pfEnSequence| (|npPop1|)))))) + (#0# NIL))))) + +;npItem1 c== +; npQualDef() => +; npEqKey "SEMICOLON" => +; [a,b]:=npItem1 npPop1 () +; [a,append(c,b)] +; [true,append (c,npPop1())] +; [false,c] +(DEFUN |npItem1| (|c|) + (PROG (|b| |a| |LETTMP#1|) + (RETURN + (COND + ((|npQualDef|) + (COND + ((|npEqKey| (QUOTE SEMICOLON)) + (PROGN + (SETQ |LETTMP#1| (|npItem1| (|npPop1|))) + (SETQ |a| (CAR |LETTMP#1|)) + (SETQ |b| (CADR |LETTMP#1|)) + (LIST |a| (APPEND |c| |b|)))) + (#0=(QUOTE T) (LIST T (APPEND |c| (|npPop1|)))))) + (#0# (LIST NIL |c|)))))) + +;npFirstTok()== +; $stok:= +; if null $inputStream +; then tokConstruct("ERROR","NOMORE",tokPosn $stok) +; else CAR $inputStream +; $ttok:=tokPart $stok +(DEFUN |npFirstTok| () + (PROG NIL + (DECLARE (SPECIAL |$ttok| |$stok| |$inputStream|)) + (RETURN + (PROGN + (SETQ |$stok| + (COND + ((NULL |$inputStream|) + (|tokConstruct| (QUOTE ERROR) (QUOTE NOMORE) (|tokPosn| |$stok|))) + ((QUOTE T) + (CAR |$inputStream|)))) + (SETQ |$ttok| (|tokPart| |$stok|)))))) + +;npNext() == +; $inputStream := CDR($inputStream) +; npFirstTok() +(DEFUN |npNext| () + (PROG NIL + (DECLARE (SPECIAL |$inputStream|)) + (RETURN + (PROGN + (SETQ |$inputStream| (CDR |$inputStream|)) + (|npFirstTok|))))) + +;npState()==cons($inputStream,$stack) +(DEFUN |npState| () + (PROG NIL + (DECLARE (SPECIAL |$stack| |$inputStream|)) + (RETURN + (CONS |$inputStream| |$stack|)))) + +;npRestore(x)== +; $inputStream:=CAR x +; npFirstTok() +; $stack:=CDR x +; true +(DEFUN |npRestore| (|x|) + (PROG NIL + (DECLARE (SPECIAL |$stack| |$inputStream|)) + (RETURN + (PROGN + (SETQ |$inputStream| (CAR |x|)) + (|npFirstTok|) + (SETQ |$stack| (CDR |x|)) T)))) + +;npPush x==$stack:=CONS(x,$stack) +(DEFUN |npPush| (|x|) + (PROG NIL + (DECLARE (SPECIAL |$stack|)) + (RETURN + (SETQ |$stack| (CONS |x| |$stack|))))) + +;npPushId()== +; a:=GET($ttok,'INFGENERIC) +; $ttok:= if a then a else $ttok +; $stack:=CONS(tokConstruct("id",$ttok,tokPosn $stok),$stack) +; npNext() +(DEFUN |npPushId| () + (PROG (|a|) + (DECLARE (SPECIAL |$stack| |$stok| |$ttok|)) + (RETURN + (PROGN + (SETQ |a| (GET |$ttok| (QUOTE INFGENERIC))) + (SETQ |$ttok| (COND (|a| |a|) ((QUOTE T) |$ttok|))) + (SETQ |$stack| + (CONS (|tokConstruct| (QUOTE |id|) |$ttok| (|tokPosn| |$stok|)) |$stack|)) + (|npNext|))))) + +;npPop1()== +; a:=CAR $stack +; $stack:=CDR $stack +; a +(DEFUN |npPop1| () + (PROG (|a|) + (DECLARE (SPECIAL |$stack|)) + (RETURN + (PROGN + (SETQ |a| (CAR |$stack|)) + (SETQ |$stack| (CDR |$stack|)) + |a|)))) + +;npPop2()== +; a:=CADR $stack +; RPLACD($stack,CDDR $stack) +; a +(DEFUN |npPop2| () + (PROG (|a|) + (DECLARE (SPECIAL |$stack|)) + (RETURN + (PROGN + (SETQ |a| (CADR |$stack|)) + (RPLACD |$stack| (CDDR |$stack|)) + |a|)))) + +;npPop3()== +; a:=CADDR $stack +; RPLACD(CDR $stack,CDDDR $stack) +; a +(DEFUN |npPop3| () + (PROG (|a|) + (DECLARE (SPECIAL |$stack|)) + (RETURN + (PROGN + (SETQ |a| (CADDR |$stack|)) + (RPLACD (CDR |$stack|) (CDDDR |$stack|)) |a|)))) + +;npParenthesized f== +; npParenthesize("(",")",f) or +; npParenthesize("(|","|)",f) +(DEFUN |npParenthesized| (|f|) + (PROG NIL + (RETURN + (OR + (|npParenthesize| (QUOTE |(|) (QUOTE |)|) |f|) + (|npParenthesize| (QUOTE |(\||) (QUOTE |\|)|) |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 +(DEFUN |npParenthesize| (|open| |close| |f|) + (PROG (|a|) + (DECLARE (SPECIAL |$stok|)) + (RETURN + (PROGN + (SETQ |a| |$stok|) + (COND + ((|npEqKey| |open|) + (COND + ((AND + (APPLY |f| NIL) + (OR (|npEqKey| |close|) (|npMissingMate| |close| |a|))) + T) + ((|npEqKey| |close|) (|npPush| NIL)) + (#0=(QUOTE T) (|npMissingMate| |close| |a|)))) + (#0# NIL)))))) + +;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 +(DEFUN |npEnclosed| (|open| |close| |fn| |f|) + (PROG (|a|) + (DECLARE (SPECIAL |$stok|)) + (RETURN + (PROGN + (SETQ |a| |$stok|) + (COND + ((|npEqKey| |open|) + (COND + ((|npEqKey| |close|) + (|npPush| (FUNCALL |fn| |a| (|pfTuple| (|pfListOf| NIL))))) + ((AND + (APPLY |f| NIL) + (OR (|npEqKey| |close|) (|npMissingMate| |close| |a|))) + (|npPush| (FUNCALL |fn| |a| (|pfEnSequence| (|npPop1|))))) + (#0=(QUOTE T) NIL))) + (#0# NIL)))))) + +;npParened f == +; npEnclosed("(",")",function pfParen,f) or +; npEnclosed("(|","|)",function pfParen,f) +(DEFUN |npParened| (|f|) + (PROG NIL + (RETURN + (OR + (|npEnclosed| (QUOTE |(|) (QUOTE |)|) (FUNCTION |pfParen|) |f|) + (|npEnclosed| (QUOTE |(\||) (QUOTE |\|)|) (FUNCTION |pfParen|) |f|))))) + +;npBracked f == +; npEnclosed("[","]",function pfBracket,f) or +; npEnclosed("[|","|]",function pfBracketBar,f) +(DEFUN |npBracked| (|f|) + (PROG NIL + (RETURN + (OR + (|npEnclosed| (QUOTE [) (QUOTE ]) (FUNCTION |pfBracket|) |f|) + (|npEnclosed| + (QUOTE |[\||) (QUOTE |\|]|) + (FUNCTION |pfBracketBar|) |f|))))) + +;npBraced f == +; npEnclosed("{","}",function pfBrace,f) or +; npEnclosed("{|","|}",function pfBraceBar,f) +(DEFUN |npBraced| (|f|) + (PROG NIL + (RETURN + (OR + (|npEnclosed| (QUOTE {) (QUOTE }) (FUNCTION |pfBrace|) |f|) + (|npEnclosed| (QUOTE |{\||) (QUOTE |\|}|) (FUNCTION |pfBraceBar|) |f|))))) + +;npAngleBared f == +; npEnclosed("<|","|>",function pfHide,f) +(DEFUN |npAngleBared| (|f|) + (PROG NIL + (RETURN + (|npEnclosed| (QUOTE |<\||) (QUOTE |\|>|) (FUNCTION |pfHide|) |f|)))) + +;npBracketed f== +; npParened f or npBracked f or npBraced f or npAngleBared f +(DEFUN |npBracketed| (|f|) + (PROG NIL + (RETURN + (OR + (|npParened| |f|) + (|npBracked| |f|) + (|npBraced| |f|) + (|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 +(DEFUN |npPileBracketed| (|f|) + (PROG NIL + (RETURN + (COND + ((|npEqKey| (QUOTE SETTAB)) + (COND + ((|npEqKey| (QUOTE BACKTAB)) (|npPush| (|pfNothing|))) + ((AND + (APPLY |f| NIL) + (OR (|npEqKey| (QUOTE BACKTAB)) (|npMissing| (QUOTE |backtab|)))) + (|npPush| (|pfPile| (|npPop1|)))) + (#0=(QUOTE T) NIL))) + (#0# NIL))))) + +;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 +(DEFUN |npListofFun| (|f| |h| |g|) + (PROG (|a|) + (DECLARE (SPECIAL |$stack|)) + (RETURN + (COND + ((APPLY |f| NIL) + (COND + ((AND (APPLY |h| NIL) (OR (APPLY |f| NIL) (|npTrap|))) + (SETQ |a| |$stack|) + (SETQ |$stack| NIL) + ((LAMBDA () + (LOOP + (COND + ((NOT (AND (APPLY |h| NIL) (OR (APPLY |f| NIL) (|npTrap|)))) + (RETURN NIL)) + ((QUOTE T) 0))))) + (SETQ |$stack| (CONS (NREVERSE |$stack|) |a|)) + (|npPush| (FUNCALL |g| (CONS (|npPop3|) (CONS (|npPop2|) (|npPop1|)))))) + (#0=(QUOTE T) T))) + (#0# NIL))))) + +;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, []) +; +(DEFUN |npList| (|f| |str1| |g|) + (PROG (|a|) + (DECLARE (SPECIAL |$stack|)) + (RETURN + (COND + ((APPLY |f| NIL) + (COND + ((AND + (|npEqKey| |str1|) + (OR (|npEqKey| (QUOTE BACKSET)) T) + (OR (APPLY |f| NIL) (|npTrap|))) + (SETQ |a| |$stack|) + (SETQ |$stack| NIL) + ((LAMBDA () + (LOOP + (COND + ((NOT + (AND + (|npEqKey| |str1|) + (OR (|npEqKey| (QUOTE BACKSET)) T) + (OR (APPLY |f| NIL) (|npTrap|)))) + (RETURN NIL)) + ((QUOTE T) 0))))) + (SETQ |$stack| (CONS (NREVERSE |$stack|) |a|)) + (|npPush| + (FUNCALL |g| (CONS (|npPop3|) (CONS (|npPop2|) (|npPop1|)))))) + (#0=(QUOTE T) (|npPush| (FUNCALL |g| (LIST (|npPop1|))))))) + (#0# (|npPush| (FUNCALL |g| NIL))))))) + + +;-- s must transform the head of the stack +; +;npAnyNo s== +; while APPLY(s,nil) repeat 0 +; true +(DEFUN |npAnyNo| (|s|) + (PROG NIL + (RETURN + (PROGN + ((LAMBDA () + (LOOP + (COND + ((NOT (APPLY |s| NIL)) (RETURN NIL)) + ((QUOTE T) 0))))) + T)))) + +;npAndOr(keyword,p,f)== +; npEqKey keyword and (APPLY(p,nil) or npTrap()) +; and npPush FUNCALL(f, npPop1()) +(DEFUN |npAndOr| (|keyword| |p| |f|) + (PROG NIL + (RETURN + (AND + (|npEqKey| |keyword|) + (OR (APPLY |p| NIL) (|npTrap|)) + (|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 +(DEFUN |npRightAssoc| (|o| |p|) + (PROG (|a|) + (RETURN + (PROGN + (SETQ |a| (|npState|)) + (COND + ((APPLY |p| NIL) + ((LAMBDA () + (LOOP + (COND + ((NOT + (AND + (|npInfGeneric| |o|) + (OR + (|npRightAssoc| |o| |p|) + (PROGN (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) NIL)))) + (RETURN NIL)) + ((QUOTE T) + (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) + T) + ((QUOTE T) (|npRestore| |a|) NIL)))))) + +;-- 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 +(DEFUN |npLeftAssoc| (|operations| |parser|) + (PROG NIL + (RETURN + (COND + ((APPLY |parser| NIL) + ((LAMBDA NIL + (LOOP + (COND + ((NOT + (AND + (|npInfGeneric| |operations|) + (OR + (APPLY |parser| NIL) + (PROGN (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) NIL)))) + (RETURN NIL)) + ((QUOTE T) + (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) + T) + ((QUOTE T) NIL))))) + +;npInfixOp()== +; EQ(CAAR $stok,"key") and +; GET($ttok,"INFGENERIC") and npPushId() +(DEFUN |npInfixOp| () + (PROG NIL + (DECLARE (SPECIAL |$ttok| |$stok|)) + (RETURN + (AND + (EQ (CAAR |$stok|) (QUOTE |key|)) + (GET |$ttok| (QUOTE INFGENERIC)) + (|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 +(DEFUN |npInfixOperator| () + (PROG (|b| |a|) + (DECLARE (SPECIAL |$stok|)) + (RETURN + (OR + (|npInfixOp|) + (PROGN + (SETQ |a| (|npState|)) + (SETQ |b| |$stok|) + (COND + ((AND (|npEqKey| (QUOTE |'|)) (|npInfixOp|)) + (|npPush| (|pfSymb| (|npPop1|) (|tokPosn| |b|)))) + (#0=(QUOTE T) + (PROGN + (|npRestore| |a|) + (COND + ((AND (|npEqKey| (QUOTE BACKQUOTE)) (|npInfixOp|)) + (PROGN + (SETQ |a| (|npPop1|)) + (|npPush| + (|tokConstruct| (QUOTE |idsy|) (|tokPart| |a|) (|tokPosn| |a|))))) + (#0# (PROGN (|npRestore| |a|) NIL))))))))))) + +;npInfKey s== EQ(CAAR $stok,"key") and MEMQ($ttok,s) and npPushId() +(DEFUN |npInfKey| (|s|) + (PROG NIL + (DECLARE (SPECIAL |$ttok| |$stok|)) + (RETURN + (AND (EQ (CAAR |$stok|) (QUOTE |key|)) (MEMQ |$ttok| |s|) (|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 +(DEFUN |npDDInfKey| (|s|) + (PROG (|b| |a|) + (DECLARE (SPECIAL |$stok|)) + (RETURN + (OR + (|npInfKey| |s|) + (PROGN + (SETQ |a| (|npState|)) + (SETQ |b| |$stok|) + (COND + ((AND (|npEqKey| (QUOTE |'|)) (|npInfKey| |s|)) + (|npPush| (|pfSymb| (|npPop1|) (|tokPosn| |b|)))) + (#0=(QUOTE T) + (PROGN + (|npRestore| |a|) + (COND + ((AND (|npEqKey| (QUOTE BACKQUOTE)) (|npInfKey| |s|)) + (PROGN + (SETQ |a| (|npPop1|)) + (|npPush| + (|tokConstruct| (QUOTE |idsy|) (|tokPart| |a|) (|tokPosn| |a|))))) + (#0# (PROGN (|npRestore| |a|) NIL))))))))))) + +;npInfGeneric s== npDDInfKey s and +; (npEqKey "BACKSET" or true) +(DEFUN |npInfGeneric| (|s|) + (PROG NIL + (RETURN + (AND + (|npDDInfKey| |s|) + (OR (|npEqKey| (QUOTE BACKSET)) T))))) + +;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 +(DEFUN |npConditional| (|f|) + (PROG NIL + (RETURN + (COND + ((AND + (|npEqKey| (QUOTE IF)) + (OR (|npLogical|) (|npTrap|)) + (OR (|npEqKey| (QUOTE BACKSET)) T)) + (COND + ((|npEqKey| (QUOTE SETTAB)) + (COND + ((|npEqKey| (QUOTE THEN)) + (AND + (OR (APPLY |f| NIL) (|npTrap|)) + (|npElse| |f|) + (|npEqKey| (QUOTE BACKTAB)))) + (#0=(QUOTE T) (|npMissing| (QUOTE |then|))))) + ((|npEqKey| (QUOTE THEN)) + (AND (OR (APPLY |f| NIL) (|npTrap|)) (|npElse| |f|))) + (#0# (|npMissing| (QUOTE |then|))))) + (#0# NIL))))) + +;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()) +(DEFUN |npElse| (|f|) + (PROG (|a|) + (RETURN + (PROGN + (SETQ |a| (|npState|)) + (COND + ((|npBacksetElse|) + (AND + (OR (APPLY |f| NIL) (|npTrap|)) + (|npPush| (|pfIf| (|npPop3|) (|npPop2|) (|npPop1|))))) + ((QUOTE T) + (|npRestore| |a|) (|npPush| (|pfIfThenOnly| (|npPop2|) (|npPop1|))))))))) + +;npBacksetElse()== +; if npEqKey "BACKSET" +; then npEqKey "ELSE" +; else npEqKey "ELSE" +(DEFUN |npBacksetElse| () + (PROG NIL + (RETURN + (COND + ((|npEqKey| (QUOTE BACKSET)) (|npEqKey| (QUOTE ELSE))) + ((QUOTE T) (|npEqKey| (QUOTE ELSE))))))) + +;npWConditional f== +; if npConditional f +; then npPush pfTweakIf npPop1() +; else false +(DEFUN |npWConditional| (|f|) + (PROG NIL + (RETURN + (COND + ((|npConditional| |f|) (|npPush| (|pfTweakIf| (|npPop1|)))) + ((QUOTE T) NIL))))) + +;-- Parsing functions +; +;-- peek for keyword s, no advance of token stream +; +;npEqPeek s == EQ(CAAR $stok,"key") and EQ(s,$ttok) +(DEFUN |npEqPeek| (|s|) + (PROG NIL + (DECLARE (SPECIAL |$ttok| |$stok|)) + (RETURN + (AND (EQ (CAAR |$stok|) (QUOTE |key|)) (EQ |s| |$ttok|))))) + +;-- test for keyword s, if found advance token stream +; +;npEqKey s == +; EQ(CAAR $stok,"key") and EQ(s,$ttok) and npNext() +(DEFUN |npEqKey| (|s|) + (PROG NIL + (DECLARE (SPECIAL |$ttok| |$stok|)) + (RETURN + (AND + (EQ (CAAR |$stok|) (QUOTE |key|)) + (EQ |s| |$ttok|) + (|npNext|))))) + +;$npTokToNames:= ["~","#","[]","{}", "[||]","{||}"] +(EVAL-WHEN (EVAL LOAD) + (SETQ |$npTokToNames| + (LIST + (QUOTE ~) + (QUOTE |#|) + (QUOTE []) + (QUOTE {}) + (QUOTE |[\|\|]|) + (QUOTE |{\|\|}|)))) + +;npId() == +; EQ(CAAR $stok,"id") => +; npPush $stok +; npNext() +; EQ(CAAR $stok,"key") and MEMQ($ttok,$npTokToNames)=> +; npPush tokConstruct("id",$ttok,tokPosn $stok) +; npNext() +; false +(DEFUN |npId| () + (PROG NIL + (DECLARE (SPECIAL |$npTokToNames| |$ttok| |$stok|)) + (RETURN + (COND + ((EQ (CAAR |$stok|) (QUOTE |id|)) + (PROGN (|npPush| |$stok|) (|npNext|))) + ((AND (EQ (CAAR |$stok|) (QUOTE |key|)) (MEMQ |$ttok| |$npTokToNames|)) + (PROGN + (|npPush| (|tokConstruct| (QUOTE |id|) |$ttok| (|tokPosn| |$stok|))) + (|npNext|))) + ((QUOTE T) NIL))))) + +;npSymbolVariable()== +; a:=npState() +; npEqKey "BACKQUOTE" and npId() => +; a:=npPop1() +; npPush tokConstruct("idsy",tokPart a,tokPosn a) +; npRestore a +; false +(DEFUN |npSymbolVariable| () + (PROG (|a|) + (RETURN + (PROGN + (SETQ |a| (|npState|)) + (COND + ((AND (|npEqKey| (QUOTE BACKQUOTE)) (|npId|)) + (PROGN + (SETQ |a| (|npPop1|)) + (|npPush| + (|tokConstruct| (QUOTE |idsy|) (|tokPart| |a|) (|tokPosn| |a|))))) + ((QUOTE T) (PROGN (|npRestore| |a|) NIL))))))) + +;npName()==npId() or npSymbolVariable() +(DEFUN |npName| () + (PROG NIL + (RETURN + (OR (|npId|) (|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 +(DEFUN |npConstTok| () + (PROG (|b| |a|) + (DECLARE (SPECIAL |$stok|)) + (RETURN + (COND + ((MEMQ + (|tokType| |$stok|) + (QUOTE (|integer| |string| |char| |float| |command|))) + (PROGN (|npPush| |$stok|) (|npNext|))) + ((|npEqPeek| (QUOTE |'|)) + (PROGN + (SETQ |a| |$stok|) + (SETQ |b| (|npState|)) + (|npNext|) + (COND + ((AND (|npPrimary1|) (|npPush| (|pfSymb| (|npPop1|) (|tokPosn| |a|)))) + T) + ((QUOTE T) + (|npRestore| |b|) NIL)))) + ((QUOTE T) + NIL))))) + +; +;npPrimary1() == +; npEncAp function npAtom1 or +; npLet() or +; npFix() or +; npMacro() or +; npBPileDefinition() or npDefn() or +; npRule() +(DEFUN |npPrimary1| () + (PROG NIL + (RETURN + (OR + (|npEncAp| (FUNCTION |npAtom1|)) + (|npLet|) + (|npFix|) + (|npMacro|) + (|npBPileDefinition|) + (|npDefn|) + (|npRule|))))) + +;npPrimary2()== npEncAp function npAtom2 -- or npBPileDefinition() +; or npAdd(pfNothing()) or npWith(pfNothing()) +; +(DEFUN |npPrimary2| () + (PROG NIL + (RETURN + (OR + (|npEncAp| (FUNCTION |npAtom2|)) + (|npAdd| (|pfNothing|)) + (|npWith| (|pfNothing|)))))) + +;npAtom1()== npPDefinition() or ((npName() or npConstTok() or +; npDollar() or npBDefinition()) and npFromdom()) +(DEFUN |npAtom1| () + (PROG NIL + (RETURN + (OR + (|npPDefinition|) + (AND + (OR (|npName|) (|npConstTok|) (|npDollar|) (|npBDefinition|)) + (|npFromdom|)))))) + +;npAtom2()== (npInfixOperator() or npAmpersand() or npPrefixColon()) +; and npFromdom() +(DEFUN |npAtom2| () + (PROG NIL + (RETURN + (AND + (OR (|npInfixOperator|) (|npAmpersand|) (|npPrefixColon|)) + (|npFromdom|))))) + +;npDollar()== npEqPeek "$" and +; npPush tokConstruct("id","$",tokPosn $stok) +; npNext() +(DEFUN |npDollar| () + (PROG NIL + (DECLARE (SPECIAL |$stok|)) + (RETURN + (AND + (|npEqPeek| (QUOTE $)) + (PROGN + (|npPush| (|tokConstruct| (QUOTE |id|) (QUOTE $) (|tokPosn| |$stok|))) + (|npNext|)))))) + +;npPrefixColon()== npEqPeek "COLON" and +; npPush tokConstruct("id",":",tokPosn $stok) +; npNext() +(DEFUN |npPrefixColon| () + (PROG NIL + (DECLARE (SPECIAL |$stok|)) + (RETURN + (AND + (|npEqPeek| (QUOTE COLON)) + (PROGN + (|npPush| (|tokConstruct| (QUOTE |id|) (QUOTE |:|) (|tokPosn| |$stok|))) + (|npNext|)))))) + +;-- silly +; +;npEncAp(f)== APPLY(f,nil) and npAnyNo function npEncl +; and npFromdom() +(DEFUN |npEncAp| (|f|) + (PROG NIL + (RETURN + (AND (APPLY |f| NIL) (|npAnyNo| (FUNCTION |npEncl|)) (|npFromdom|))))) + +; +;npEncl()== npBDefinition() and npPush pfApplication(npPop2(),npPop1()) +(DEFUN |npEncl| () + (PROG NIL + (RETURN + (AND + (|npBDefinition|) + (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))))))) + +;npFromdom()== +; npEqKey "$" and (npApplication() or npTrap()) +; and npFromdom1 npPop1() and npPush pfFromDom(npPop1(),npPop1()) +; or true +(DEFUN |npFromdom| () + (PROG NIL + (RETURN + (OR + (AND + (|npEqKey| (QUOTE $)) + (OR (|npApplication|) (|npTrap|)) + (|npFromdom1| (|npPop1|)) + (|npPush| (|pfFromDom| (|npPop1|) (|npPop1|)))) + T)))) + +;npFromdom1 c== +; npEqKey "$" and (npApplication() or npTrap()) +; and npFromdom1 npPop1() and npPush pfFromDom(npPop1(),c) +; or npPush c +(DEFUN |npFromdom1| (|c|) + (PROG NIL + (RETURN + (OR + (AND + (|npEqKey| (QUOTE $)) + (OR (|npApplication|) (|npTrap|)) + (|npFromdom1| (|npPop1|)) + (|npPush| (|pfFromDom| (|npPop1|) |c|))) + (|npPush| |c|))))) + +; +;npPrimary()== npPrimary1() or npPrimary2() +(DEFUN |npPrimary| () + (PROG NIL + (RETURN + (OR (|npPrimary1|) (|npPrimary2|))))) + +;npDotted f== APPLY(f,nil) and npAnyNo function npSelector +(DEFUN |npDotted| (|f|) + (PROG NIL + (RETURN + (AND (APPLY |f| NIL) (|npAnyNo| (FUNCTION |npSelector|)))))) + +;npSelector()== +; npEqKey "DOT" and (npPrimary() or npTrap()) and +; npPush(pfApplication(npPop2(),npPop1())) +(DEFUN |npSelector| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE DOT)) + (OR (|npPrimary|) (|npTrap|)) + (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))))))) + +;npApplication()== +; npDotted function npPrimary and +; (npApplication2() and +; npPush(pfApplication(npPop2(),npPop1())) or true) +(DEFUN |npApplication| () + (PROG NIL + (RETURN + (AND + (|npDotted| (FUNCTION |npPrimary|)) + (OR + (AND + (|npApplication2|) + (|npPush| (|pfApplication| (|npPop2|) (|npPop1|)))) + T))))) + +; +;npApplication2()== +; npDotted function npPrimary1 and +; (npApplication2() and +; npPush(pfApplication(npPop2(),npPop1())) or true) +(DEFUN |npApplication2| () + (PROG NIL + (RETURN + (AND + (|npDotted| (FUNCTION |npPrimary1|)) + (OR + (AND + (|npApplication2|) + (|npPush| (|pfApplication| (|npPop2|) (|npPop1|)))) + T))))) + +;npTypedForm1(sy,fn) == +; npEqKey sy and (npType() or npTrap()) and +; npPush FUNCALL(fn,npPop2(),npPop1()) +(DEFUN |npTypedForm1| (|sy| |fn|) + (PROG NIL + (RETURN + (AND + (|npEqKey| |sy|) + (OR (|npType|) (|npTrap|)) + (|npPush| (FUNCALL |fn| (|npPop2|) (|npPop1|))))))) + +;npTypedForm(sy,fn) == +; npEqKey sy and (npApplication() or npTrap()) and +; npPush FUNCALL(fn,npPop2(),npPop1()) +(DEFUN |npTypedForm| (|sy| |fn|) + (PROG NIL + (RETURN + (AND + (|npEqKey| |sy|) + (OR (|npApplication|) (|npTrap|)) + (|npPush| (FUNCALL |fn| (|npPop2|) (|npPop1|))))))) + +;npRestrict() == npTypedForm("AT",function pfRestrict) +(DEFUN |npRestrict| () + (PROG NIL + (RETURN + (|npTypedForm| (QUOTE AT) (FUNCTION |pfRestrict|))))) + +;npCoerceTo() == npTypedForm("COERCE",function pfCoerceto) +(DEFUN |npCoerceTo| () + (PROG NIL + (RETURN + (|npTypedForm| (QUOTE COERCE) (FUNCTION |pfCoerceto|))))) + +;npColonQuery() == npTypedForm("ATAT",function pfRetractTo) +(DEFUN |npColonQuery| () + (PROG NIL + (RETURN + (|npTypedForm| (QUOTE ATAT) (FUNCTION |pfRetractTo|))))) + +;npPretend() == npTypedForm("PRETEND",function pfPretend) +(DEFUN |npPretend| () + (PROG NIL + (RETURN + (|npTypedForm| (QUOTE PRETEND) (FUNCTION |pfPretend|))))) + +;npTypeStyle()== +; npCoerceTo() or npRestrict() or npPretend() or npColonQuery() +(DEFUN |npTypeStyle| () + (PROG NIL + (RETURN + (OR (|npCoerceTo|) (|npRestrict|) (|npPretend|) (|npColonQuery|))))) + +;npTypified ()==npApplication() and npAnyNo function npTypeStyle +(DEFUN |npTypified| () + (PROG NIL + (RETURN + (AND (|npApplication|) (|npAnyNo| (FUNCTION |npTypeStyle|)))))) + +;npTagged() == npTypedForm1("COLON",function pfTagged) +(DEFUN |npTagged| () + (PROG NIL + (RETURN + (|npTypedForm1| (QUOTE COLON) (FUNCTION |pfTagged|))))) + +;npColon () == npTypified() and npAnyNo function npTagged +(DEFUN |npColon| () + (PROG NIL + (RETURN + (AND (|npTypified|) (|npAnyNo| (FUNCTION |npTagged|)))))) + +;npPower() == npRightAssoc('(POWER CARAT),function npColon) +(DEFUN |npPower| () + (PROG NIL + (RETURN + (|npRightAssoc| (QUOTE (POWER CARAT)) (FUNCTION |npColon|))))) + +;npProduct()== +; npLeftAssoc('(TIMES SLASH BACKSLASH SLASHSLASH +; BACKSLASHBACKSLASH SLASHBACKSLASH BACKSLASHSLASH ) +; ,function npPower) +(DEFUN |npProduct| () + (PROG NIL + (RETURN + (|npLeftAssoc| + (QUOTE (TIMES SLASH BACKSLASH SLASHSLASH BACKSLASHBACKSLASH + SLASHBACKSLASH BACKSLASHSLASH)) + (FUNCTION |npPower|))))) + +;npRemainder()== +; npLeftAssoc('(REM QUO ) ,function npProduct) +(DEFUN |npRemainder| () + (PROG NIL + (RETURN + (|npLeftAssoc| (QUOTE (REM QUO)) (FUNCTION |npProduct|))))) + +;npTerm()== +; npInfGeneric '(MINUS PLUS) and (npRemainder() +; and npPush(pfApplication(npPop2(),npPop1())) or true) +; or npRemainder() +(DEFUN |npTerm| () + (PROG NIL + (RETURN + (OR + (AND + (|npInfGeneric| (QUOTE (MINUS PLUS))) + (OR + (AND (|npRemainder|) (|npPush| (|pfApplication| (|npPop2|) (|npPop1|)))) + T)) + (|npRemainder|))))) + +; +;npSum()==npLeftAssoc('(PLUS MINUS),function npTerm) +(DEFUN |npSum| () + (PROG NIL + (RETURN + (|npLeftAssoc| (QUOTE (PLUS MINUS)) (FUNCTION |npTerm|))))) + +;npArith()==npLeftAssoc('(MOD),function npSum) +(DEFUN |npArith| () + (PROG NIL + (RETURN + (|npLeftAssoc| (QUOTE (MOD)) (FUNCTION |npSum|))))) + +;npSegment()== npEqPeek "SEG" and npPushId() and npFromdom() +(DEFUN |npSegment| () + (PROG NIL + (RETURN + (AND (|npEqPeek| (QUOTE SEG)) (|npPushId|) (|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) +(DEFUN |npInterval| () + (PROG NIL + (RETURN + (AND + (|npArith|) + (OR + (AND + (|npSegment|) + (OR + (AND + (|npEqPeek| (QUOTE BAR)) + (|npPush| (|pfApplication| (|npPop1|) (|npPop1|)))) + (AND + (|npArith|) + (|npPush| (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))) + (|npPush| (|pfApplication| (|npPop1|) (|npPop1|))))) + T))))) + +;npBy()== npLeftAssoc ('(BY),function npInterval) +(DEFUN |npBy| () + (PROG NIL + (RETURN + (|npLeftAssoc| (QUOTE (BY)) (FUNCTION |npInterval|))))) + +;npAmpersand()== npEqKey "AMPERSAND" and (npName() or npTrap()) +(DEFUN |npAmpersand| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE AMPERSAND)) + (OR (|npName|) (|npTrap|)))))) + +;npAmpersandFrom()== npAmpersand() and npFromdom() +(DEFUN |npAmpersandFrom| () + (PROG NIL + (RETURN + (AND (|npAmpersand|) (|npFromdom|))))) + +;npSynthetic()== +; if npBy() +; then +; while npAmpersandFrom() and (npBy() or +; (npPush pfApplication(npPop2(),npPop1());false)) repeat +; npPush pfInfApplication(npPop2(),npPop2(),npPop1()) +; true +; else false +(DEFUN |npSynthetic| () + (PROG NIL + (RETURN + (COND + ((|npBy|) + ((LAMBDA () + (LOOP + (COND + ((NOT + (AND + (|npAmpersandFrom|) + (OR + (|npBy|) + (PROGN (|npPush| (|pfApplication| (|npPop2|) (|npPop1|))) NIL)))) + (RETURN NIL)) + ((QUOTE T) + (|npPush| + (|pfInfApplication| (|npPop2|) (|npPop2|) (|npPop1|)))))))) + T) + ((QUOTE T) NIL))))) + +;npRelation()== +; npLeftAssoc ('(EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE), +; function npSynthetic) +(DEFUN |npRelation| () + (PROG NIL + (RETURN + (|npLeftAssoc| + (QUOTE (EQUAL NOTEQUAL LT LE GT GE OANGLE CANGLE)) + (FUNCTION |npSynthetic|))))) + +;npQuiver() == npRightAssoc('(ARROW LARROW),function npRelation) +(DEFUN |npQuiver| () + (PROG NIL + (RETURN + (|npRightAssoc| (QUOTE (ARROW LARROW)) (FUNCTION |npRelation|))))) + +;npDiscrim() == npLeftAssoc ('(CASE HAS), function npQuiver) +(DEFUN |npDiscrim| () + (PROG NIL + (RETURN + (|npLeftAssoc| (QUOTE (CASE HAS)) (FUNCTION |npQuiver|))))) + +;npDisjand() == npLeftAssoc('(AND ),function npDiscrim) +(DEFUN |npDisjand| () + (PROG NIL + (RETURN + (|npLeftAssoc| (QUOTE (AND)) (FUNCTION |npDiscrim|))))) + +;npLogical() == npLeftAssoc('(OR ),function npDisjand) +(DEFUN |npLogical| () + (PROG NIL + (RETURN + (|npLeftAssoc| (QUOTE (OR)) (FUNCTION |npDisjand|))))) + +;npSuch() == npLeftAssoc( '(BAR),function npLogical) +(DEFUN |npSuch| () + (PROG NIL + (RETURN + (|npLeftAssoc| (QUOTE (BAR)) (FUNCTION |npLogical|))))) + +;npMatch() == npLeftAssoc ('(IS ISNT ), function npSuch) +(DEFUN |npMatch| () + (PROG NIL + (RETURN + (|npLeftAssoc| (QUOTE (IS ISNT)) (FUNCTION |npSuch|))))) + +;npType() == npMatch() and +; a:=npPop1() +; npWith(a) or npPush a +(DEFUN |npType| () + (PROG (|a|) + (RETURN + (AND + (|npMatch|) + (PROGN + (SETQ |a| (|npPop1|)) + (OR + (|npWith| |a|) + (|npPush| |a|))))))) + +;npADD() == npType() and +; a:=npPop1() +; npAdd(a) or npPush a +(DEFUN |npADD| () + (PROG (|a|) + (RETURN + (AND + (|npType|) + (PROGN + (SETQ |a| (|npPop1|)) + (OR + (|npAdd| |a|) + (|npPush| |a|))))))) + +;npConditionalStatement()==npConditional function npQualifiedDefinition +(DEFUN |npConditionalStatement| () + (PROG NIL + (RETURN + (|npConditional| (FUNCTION |npQualifiedDefinition|))))) + +;npExpress1()==npConditionalStatement() or npADD() +(DEFUN |npExpress1| () + (PROG NIL + (RETURN + (OR (|npConditionalStatement|) (|npADD|))))) + +;npCommaBackSet()== npEqKey "COMMA" and (npEqKey "BACKSET" or true) +(DEFUN |npCommaBackSet| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE COMMA)) + (OR (|npEqKey| (QUOTE BACKSET)) T))))) + +;npExpress()== +; npExpress1() and +; (npIterators() and +; npPush pfCollect (npPop2(),pfListOf npPop1()) or true) +(DEFUN |npExpress| () + (PROG NIL + (RETURN + (AND + (|npExpress1|) + (OR + (AND + (|npIterators|) + (|npPush| (|pfCollect| (|npPop2|) (|pfListOf| (|npPop1|))))) + T))))) + +;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 +(DEFUN |npZeroOrMore| (|f|) + (PROG (|a|) + (DECLARE (SPECIAL |$stack|)) + (RETURN + (COND + ((APPLY |f| NIL) + (PROGN + (SETQ |a| |$stack|) + (SETQ |$stack| NIL) + ((LAMBDA () + (LOOP + (COND + ((NOT (APPLY |f| NIL)) (RETURN NIL)) + ((QUOTE T) 0))))) + (SETQ |$stack| (CONS (NREVERSE |$stack|) |a|)) + (|npPush| (CONS (|npPop2|) (|npPop1|))))) + ((QUOTE T) (PROGN (|npPush| NIL) T)))))) + +;npIterators()== +; npForIn() and npZeroOrMore function npIterator +; and npPush cons(npPop2(),npPop1()) or +; npWhile() and (npIterators() and +; npPush cons(npPop2(),npPop1()) or npPush [npPop1()]) +(DEFUN |npIterators| () + (PROG NIL + (RETURN + (OR + (AND + (|npForIn|) + (|npZeroOrMore| (FUNCTION |npIterator|)) + (|npPush| (CONS (|npPop2|) (|npPop1|)))) + (AND + (|npWhile|) + (OR + (AND (|npIterators|) (|npPush| (CONS (|npPop2|) (|npPop1|)))) + (|npPush| (LIST (|npPop1|))))))))) + +;npIterator()== npForIn() or npSuchThat() or npWhile() +(DEFUN |npIterator| () + (PROG NIL + (RETURN + (OR + (|npForIn|) + (|npSuchThat|) + (|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() +(DEFUN |npStatement| () + (PROG NIL + (RETURN + (OR + (|npExpress|) + (|npLoop|) + (|npIterate|) + (|npReturn|) + (|npBreak|) + (|npFree|) + (|npImport|) + (|npInline|) + (|npLocal|) + (|npExport|) + (|npTyping|) + (|npVoid|))))) + +;npBackTrack(p1,p2,p3)== +; a:=npState() +; APPLY(p1,nil) => +; npEqPeek p2 => +; npRestore a +; APPLY(p3,nil) or npTrap() +; true +; false +(DEFUN |npBackTrack| (|p1| |p2| |p3|) + (PROG (|a|) + (RETURN + (PROGN + (SETQ |a| (|npState|)) + (COND + ((APPLY |p1| NIL) + (COND + ((|npEqPeek| |p2|) + (PROGN + (|npRestore| |a|) + (OR (APPLY |p3| NIL) (|npTrap|)))) + (#0=(QUOTE T) T))) + (#0# NIL)))))) + +;npMDEF()== npBackTrack(function npStatement,"MDEF",function npMDEFinition) +(DEFUN |npMDEF| () + (PROG NIL + (RETURN + (|npBackTrack| (FUNCTION |npStatement|) 'MDEF (FUNCTION |npMDEFinition|))))) + +;npMDEFinition() == npPP function npMdef +(DEFUN |npMDEFinition| () + (PROG NIL + (RETURN + (|npPP| (FUNCTION |npMdef|))))) + +;npAssign()== npBackTrack(function npMDEF,"BECOMES",function npAssignment) +(DEFUN |npAssign| () + (PROG NIL + (RETURN + (|npBackTrack| (FUNCTION |npMDEF|) 'BECOMES (FUNCTION |npAssignment|))))) + +;npAssignment()== +; npAssignVariable() and +; (npEqKey "BECOMES" or npTrap()) and +; (npGives() or npTrap()) and +; npPush pfAssign (npPop2(),npPop1()) +(DEFUN |npAssignment| () + (PROG NIL + (RETURN + (AND + (|npAssignVariable|) + (OR (|npEqKey| (QUOTE BECOMES)) (|npTrap|)) + (OR (|npGives|) (|npTrap|)) + (|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 +(DEFUN |npAssignVariableName| () + (PROG (|a|) + (RETURN + (AND + (|npApplication|) + (PROGN + (SETQ |a| (|npPop1|)) + (COND + ((|pfId?| |a|) + (OR + (AND (|npPush| |a|) (|npDecl|)) + (|npPush| (|pfTyped| (|npPop1|) (|pfNothing|))))) + ((QUOTE T) + (|npPush| |a|)))))))) + +;npAssignVariable()== npColon() and npPush pfListOf [npPop1()] +(DEFUN |npAssignVariable| () + (PROG NIL + (RETURN + (AND (|npColon|) (|npPush| (|pfListOf| (LIST (|npPop1|)))))))) + +;npAssignVariablelist()== npListing function npAssignVariableName +(DEFUN |npAssignVariablelist| () + (PROG NIL + (RETURN + (|npListing| (FUNCTION |npAssignVariableName|))))) + +;npExit()== npBackTrack(function npAssign,"EXIT",function npPileExit) +(DEFUN |npExit| () + (PROG NIL + (RETURN + (|npBackTrack| (FUNCTION |npAssign|) 'EXIT (FUNCTION |npPileExit|))))) + +;npPileExit()== +; npAssign() and (npEqKey "EXIT" or npTrap()) and +; (npStatement() or npTrap()) +; and npPush pfExit (npPop2(),npPop1()) +(DEFUN |npPileExit| () + (PROG NIL + (RETURN + (AND + (|npAssign|) + (OR (|npEqKey| (QUOTE EXIT)) (|npTrap|)) + (OR (|npStatement|) (|npTrap|)) + (|npPush| (|pfExit| (|npPop2|) (|npPop1|))))))) + +;npGives()== npBackTrack(function npExit,"GIVES",function npLambda) +(DEFUN |npGives| () + (PROG NIL + (RETURN + (|npBackTrack| (FUNCTION |npExit|) (QUOTE GIVES) (FUNCTION |npLambda|))))) + +;npDefinitionOrStatement()== +; npBackTrack(function npGives,"DEF",function npDef) +(DEFUN |npDefinitionOrStatement| () + (PROG NIL + (RETURN + (|npBackTrack| (FUNCTION |npGives|) (QUOTE DEF) (FUNCTION |npDef|))))) + +;npVoid()== npAndOr("DO",function npStatement,function pfNovalue) +(DEFUN |npVoid| () + (PROG NIL + (RETURN + (|npAndOr| (QUOTE 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()) +(DEFUN |npReturn| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE RETURN)) + (OR + (|npExpress|) + (|npPush| (|pfNothing|))) + (OR + (AND + (|npEqKey| (QUOTE FROM)) + (OR (|npName|) (|npTrap|)) + (|npPush| (|pfReturn| (|npPop2|) (|npPop1|)))) + (|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 () +(DEFUN |npLoop| () + (PROG NIL + (RETURN + (OR + (AND + (|npIterators|) + (|npCompMissing| (QUOTE REPEAT)) + (OR (|npAssign|) (|npTrap|)) + (|npPush| (|pfLp| (|npPop2|) (|npPop1|)))) + (AND + (|npEqKey| (QUOTE REPEAT)) + (OR (|npAssign|) (|npTrap|)) + (|npPush| (|pfLoop1| (|npPop1|)))))))) + +;npSuchThat()==npAndOr("BAR",function npLogical,function pfSuchthat) +(DEFUN |npSuchThat| () + (PROG NIL + (RETURN + (|npAndOr| (QUOTE BAR) (FUNCTION |npLogical|) (FUNCTION |pfSuchthat|))))) + +;npWhile()==npAndOr ("WHILE",function npLogical,function pfWhile) +(DEFUN |npWhile| () + (PROG NIL + (RETURN + (|npAndOr| (QUOTE WHILE) (FUNCTION |npLogical|) (FUNCTION |pfWhile|))))) + +;npForIn()== +; npEqKey "FOR" and (npVariable() or npTrap()) and (npCompMissing "IN") +; and ((npBy() or npTrap()) and +; npPush pfForin(npPop2(),npPop1())) +(DEFUN |npForIn| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE FOR)) + (OR (|npVariable|) (|npTrap|)) + (|npCompMissing| (QUOTE IN)) + (OR (|npBy|) (|npTrap|)) + (|npPush| (|pfForin| (|npPop2|) (|npPop1|))))))) + +;npBreak()== +; npEqKey "BREAK" and npPush pfBreak pfNothing () +(DEFUN |npBreak| () + (PROG NIL + (RETURN + (AND (|npEqKey| (QUOTE BREAK)) (|npPush| (|pfBreak| (|pfNothing|))))))) + +;npIterate()== +; npEqKey "ITERATE" and npPush pfIterate pfNothing () +(DEFUN |npIterate| () + (PROG NIL + (RETURN + (AND (|npEqKey| (QUOTE ITERATE)) (|npPush| (|pfIterate| (|pfNothing|))))))) + +;npQualType()== +; npType() and +; npPush pfQualType(npPop1(),pfNothing()) +(DEFUN |npQualType| () + (PROG NIL + (RETURN + (AND + (|npType|) + (|npPush| (|pfQualType| (|npPop1|) (|pfNothing|))))))) + +;npSQualTypelist()== npListing function npQualType +; and npPush pfParts npPop1 () +(DEFUN |npSQualTypelist| () + (PROG NIL + (RETURN + (AND + (|npListing| (FUNCTION |npQualType|)) + (|npPush| (|pfParts| (|npPop1|))))))) + +;npQualTypelist()== npPC function npSQualTypelist +; and npPush pfUnSequence npPop1 () +(DEFUN |npQualTypelist| () + (PROG NIL + (RETURN + (AND + (|npPC| (FUNCTION |npSQualTypelist|)) + (|npPush| (|pfUnSequence| (|npPop1|))))))) + +;npImport()==npAndOr("IMPORT",function npQualTypelist,function pfImport) +(DEFUN |npImport| () + (PROG NIL + (RETURN + (|npAndOr| 'IMPORT (FUNCTION |npQualTypelist|) (FUNCTION |pfImport|))))) + +;npInline()==npAndOr("INLINE",function npQualTypelist,function pfInline) +(DEFUN |npInline| () + (PROG NIL + (RETURN + (|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()) +(DEFUN |npLocalDecl| () + (PROG NIL + (RETURN + (OR + (AND + (|npEqKey| (QUOTE COLON)) + (OR (|npType|) (|npTrap|)) + (|npPush| (|pfSpread| (|pfParts| (|npPop2|)) (|npPop1|)))) + (|npPush| (|pfSpread| (|pfParts| (|npPop1|)) (|pfNothing|))))))) + +;npLocalItem()==npTypeVariable() and npLocalDecl() +(DEFUN |npLocalItem| () + (PROG NIL + (RETURN + (AND + (|npTypeVariable|) + (|npLocalDecl|))))) + +;npLocalItemlist()== npPC function npSLocalItem +; and npPush pfUnSequence npPop1 () +(DEFUN |npLocalItemlist| () + (PROG NIL + (RETURN + (AND + (|npPC| (FUNCTION |npSLocalItem|)) + (|npPush| (|pfUnSequence| (|npPop1|))))))) + +;npSLocalItem()== npListing function npLocalItem +; and npPush pfAppend pfParts npPop1() +(DEFUN |npSLocalItem| () + (PROG NIL + (RETURN + (AND + (|npListing| (FUNCTION |npLocalItem|)) + (|npPush| (|pfAppend| (|pfParts| (|npPop1|)))))))) + +;npFree()== npEqKey "FREE" and (npLocalItemlist() or npTrap()) +; and npPush pfFree npPop1() +(DEFUN |npFree| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE FREE)) + (OR (|npLocalItemlist|) (|npTrap|)) + (|npPush| (|pfFree| (|npPop1|))))))) + +;npLocal()== npEqKey "local" and (npLocalItemlist() or npTrap()) +; and npPush pfLocal npPop1() +(DEFUN |npLocal| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE |local|)) + (OR (|npLocalItemlist|) (|npTrap|)) + (|npPush| (|pfLocal| (|npPop1|))))))) + +;npExport()== npEqKey "EXPORT" and (npLocalItemlist() or npTrap()) +; and npPush pfExport npPop1() +(DEFUN |npExport| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE EXPORT)) + (OR (|npLocalItemlist|) (|npTrap|)) + (|npPush| (|pfExport| (|npPop1|))))))) + +;npLet()== npLetQualified function npDefinitionOrStatement +(DEFUN |npLet| () + (PROG NIL + (RETURN + (|npLetQualified| (FUNCTION |npDefinitionOrStatement|))))) + +;npDefn()== npEqKey "DEFN" and npPP function npDef +(DEFUN |npDefn| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE DEFN)) + (|npPP| (FUNCTION |npDef|)))))) + +;npFix()== npEqKey "FIX" and npPP function npDef +; and npPush pfFix npPop1 () +(DEFUN |npFix| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE FIX)) + (|npPP| (FUNCTION |npDef|)) + (|npPush| (|pfFix| (|npPop1|))))))) + +;npMacro()== npEqKey "MACRO" and npPP function npMdef +(DEFUN |npMacro| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE MACRO)) + (|npPP| (FUNCTION |npMdef|)))))) + +;npRule()== npEqKey "RULE" and npPP function npSingleRule +(DEFUN |npRule| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE RULE)) + (|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) +(DEFUN |npAdd| (|extra|) + (PROG (|a|) + (RETURN + (AND + (|npEqKey| (QUOTE ADD)) + (PROGN + (SETQ |a| (|npState|)) + (OR (|npDefinitionOrStatement|) (|npTrap|)) + (COND + ((|npEqPeek| (QUOTE IN)) + (PROGN + (|npRestore| |a|) + (AND + (OR (|npVariable|) (|npTrap|)) + (|npCompMissing| (QUOTE IN)) + (OR (|npDefinitionOrStatement|) (|npTrap|)) + (|npPush| (|pfAdd| (|npPop2|) (|npPop1|) |extra|))))) + ((QUOTE T) + (|npPush| (|pfAdd| (|pfNothing|) (|npPop1|) |extra|))))))))) + +;npDefaultValue()== +; npEqKey "DEFAULT" and +; (npDefinitionOrStatement() or npTrap()) +; and npPush [pfAdd(pfNothing(),npPop1(),pfNothing())] +(DEFUN |npDefaultValue| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE DEFAULT)) + (OR (|npDefinitionOrStatement|) (|npTrap|)) + (|npPush| (LIST (|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) +(DEFUN |npWith| (|extra|) + (PROG (|a|) + (RETURN + (AND + (|npEqKey| (QUOTE WITH)) + (PROGN + (SETQ |a| (|npState|)) + (OR (|npCategoryL|) (|npTrap|)) + (COND + ((|npEqPeek| (QUOTE IN)) + (PROGN + (|npRestore| |a|) + (AND + (OR (|npVariable|) (|npTrap|)) + (|npCompMissing| (QUOTE IN)) + (OR (|npCategoryL|) (|npTrap|)) + (|npPush| (|pfWith| (|npPop2|) (|npPop1|) |extra|))))) + ((QUOTE T) (|npPush| (|pfWith| (|pfNothing|) (|npPop1|) |extra|))))))))) + +;npCategoryL()== npCategory() and npPush pfUnSequence npPop1 () +(DEFUN |npCategoryL| () + (PROG NIL + (RETURN + (AND + (|npCategory|) + (|npPush| (|pfUnSequence| (|npPop1|))))))) + +;pfUnSequence x== +; pfSequence? x => pfListOf pfAppend pf0SequenceArgs x +; pfListOf x +(DEFUN |pfUnSequence| (|x|) + (PROG NIL + (RETURN + (COND + ((|pfSequence?| |x|) (|pfListOf| (|pfAppend| (|pf0SequenceArgs| |x|)))) + ((QUOTE T) (|pfListOf| |x|)))))) + +;npCategory()== npPP function npSCategory +(DEFUN |npCategory| () + (PROG NIL + (RETURN + (|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 +(DEFUN |npSCategory| () + (PROG (|a|) + (RETURN + (COND + ((|npWConditional| (FUNCTION |npCategoryL|)) (|npPush| (LIST (|npPop1|)))) + ((|npDefaultValue|) T) + (#0=(QUOTE T) + (SETQ |a| (|npState|)) + (COND + ((|npPrimary|) + (COND + ((|npEqPeek| (QUOTE COLON)) (|npRestore| |a|) (|npSignature|)) + (#0# + (|npRestore| |a|) + (OR + (AND (|npApplication|) (|npPush| (LIST (|pfAttribute| (|npPop1|))))) + (|npTrap|))))) + (#0# NIL))))))) + +; +;npSignatureDefinee()== +; npName() or npInfixOperator() or npPrefixColon() +(DEFUN |npSignatureDefinee| () + (PROG NIL + (RETURN + (OR (|npName|) (|npInfixOperator|) (|npPrefixColon|))))) + +; +;npSigDecl()== npEqKey "COLON" and (npType() or npTrap()) and +; npPush pfSpread (pfParts npPop2(),npPop1()) +(DEFUN |npSigDecl| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE COLON)) + (OR (|npType|) (|npTrap|)) + (|npPush| (|pfSpread| (|pfParts| (|npPop2|)) (|npPop1|))))))) + +;npSigItem()==npTypeVariable() and (npSigDecl() or npTrap()) +(DEFUN |npSigItem| () + (PROG NIL + (RETURN + (AND (|npTypeVariable|) (OR (|npSigDecl|) (|npTrap|)))))) + +;npSigItemlist()== npListing function npSigItem +; and npPush pfListOf pfAppend pfParts npPop1() +(DEFUN |npSigItemlist| () + (PROG NIL + (RETURN + (AND + (|npListing| (FUNCTION |npSigItem|)) + (|npPush| (|pfListOf| (|pfAppend| (|pfParts| (|npPop1|))))))))) + +;npSignature()== +; npSigItemlist() and +; npPush pfWDec(pfNothing(),npPop1()) +(DEFUN |npSignature| () + (PROG NIL + (RETURN + (AND (|npSigItemlist|) (|npPush| (|pfWDec| (|pfNothing|) (|npPop1|))))))) + +;npSemiListing (p)== +; npListofFun(p,function npSemiBackSet,function pfAppend) +(DEFUN |npSemiListing| (|p|) + (PROG NIL + (RETURN + (|npListofFun| |p| (FUNCTION |npSemiBackSet|) (FUNCTION |pfAppend|))))) + +;npSemiBackSet()== npEqKey "SEMICOLON" and (npEqKey "BACKSET" or true) +(DEFUN |npSemiBackSet| () + (PROG NIL + (RETURN + (AND (|npEqKey| (QUOTE SEMICOLON)) (OR (|npEqKey| (QUOTE BACKSET)) T))))) + +;npDecl()== npEqKey "COLON" and (npType() or npTrap()) and +; npPush pfTyped (npPop2(),npPop1()) +(DEFUN |npDecl| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE COLON)) + (OR (|npType|) (|npTrap|)) + (|npPush| (|pfTyped| (|npPop2|) (|npPop1|))))))) + +;npVariableName()==npName() and +; (npDecl() or npPush pfTyped(npPop1(),pfNothing())) +(DEFUN |npVariableName| () + (PROG NIL + (RETURN + (AND + (|npName|) + (OR (|npDecl|) (|npPush| (|pfTyped| (|npPop1|) (|pfNothing|)))))))) + +;npVariable()== npParenthesized function npVariablelist or +; (npVariableName() and npPush pfListOf [npPop1()]) +(DEFUN |npVariable| () + (PROG NIL + (RETURN + (OR + (|npParenthesized| (FUNCTION |npVariablelist|)) + (AND (|npVariableName|) (|npPush| (|pfListOf| (LIST (|npPop1|))))))))) + +;npVariablelist()== npListing function npVariableName +(DEFUN |npVariablelist| () + (PROG NIL + (RETURN + (|npListing| (FUNCTION |npVariableName|))))) + +;npListing (p)==npList(p,"COMMA",function pfListOf) +(DEFUN |npListing| (|p|) + (PROG NIL + (RETURN + (|npList| |p| (QUOTE 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 +(DEFUN |npQualified| (|f|) + (PROG NIL + (RETURN + (COND + ((FUNCALL |f|) + ((LAMBDA NIL + (LOOP + (COND + ((NOT (AND (|npEqKey| (QUOTE WHERE)) (OR (|npDefinition|) (|npTrap|)))) + (RETURN NIL)) + ((QUOTE T) + (|npPush| (|pfWhere| (|npPop1|) (|npPop1|)))))))) T) + ((QUOTE T) (|npLetQualified| |f|)))))) + +;npLetQualified f== +; npEqKey "LET" and +; (npDefinition() or npTrap()) and +; npCompMissing "IN" and +; (FUNCALL f or npTrap()) and +; npPush pfWhere(npPop2(),npPop1()) +(DEFUN |npLetQualified| (|f|) + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE LET)) + (OR (|npDefinition|) (|npTrap|)) + (|npCompMissing| (QUOTE IN)) + (OR (FUNCALL |f|) (|npTrap|)) + (|npPush| (|pfWhere| (|npPop2|) (|npPop1|))))))) + +; +;npQualifiedDefinition()== +; npQualified function npDefinitionOrStatement +(DEFUN |npQualifiedDefinition| () + (PROG NIL + (RETURN + (|npQualified| (FUNCTION |npDefinitionOrStatement|))))) + +;npTuple (p)== +; npListofFun(p,function npCommaBackSet,function pfTupleListOf) +(DEFUN |npTuple| (|p|) + (PROG NIL + (RETURN + (|npListofFun| |p| + (FUNCTION |npCommaBackSet|) + (FUNCTION |pfTupleListOf|))))) + +;npComma()== npTuple function npQualifiedDefinition +(DEFUN |npComma| () + (PROG NIL + (RETURN + (|npTuple| (FUNCTION |npQualifiedDefinition|))))) + +;npQualDef()== npComma() and npPush [npPop1()] +(DEFUN |npQualDef| () + (PROG NIL + (RETURN + (AND + (|npComma|) + (|npPush| (LIST (|npPop1|))))))) + +;npDefinitionlist ()==npSemiListing(function npQualDef) +(DEFUN |npDefinitionlist| () + (PROG NIL + (RETURN + (|npSemiListing| (FUNCTION |npQualDef|))))) + +;npPDefinition ()== +; npParenthesized function npDefinitionlist and +; npPush pfEnSequence npPop1() +(DEFUN |npPDefinition| () + (PROG NIL + (RETURN + (AND + (|npParenthesized| (FUNCTION |npDefinitionlist|)) + (|npPush| (|pfEnSequence| (|npPop1|))))))) + +;npBDefinition()== npPDefinition() or +; npBracketed function npDefinitionlist +(DEFUN |npBDefinition| () + (PROG NIL + (RETURN + (OR + (|npPDefinition|) + (|npBracketed| (FUNCTION |npDefinitionlist|)))))) + +;npPileDefinitionlist()== +; npListAndRecover function npDefinitionlist +; and npPush pfAppend npPop1() +(DEFUN |npPileDefinitionlist| () + (PROG NIL + (RETURN + (AND + (|npListAndRecover| (FUNCTION |npDefinitionlist|)) + (|npPush| (|pfAppend| (|npPop1|))))))) + +; +;npTypeVariable()== npParenthesized function npTypeVariablelist or +; npSignatureDefinee() and npPush pfListOf [npPop1()] +(DEFUN |npTypeVariable| () + (PROG NIL + (RETURN + (OR + (|npParenthesized| (FUNCTION |npTypeVariablelist|)) + (AND (|npSignatureDefinee|) (|npPush| (|pfListOf| (LIST (|npPop1|))))))))) + +;npTypeVariablelist()== npListing function npSignatureDefinee +(DEFUN |npTypeVariablelist| () + (PROG NIL + (RETURN + (|npListing| (FUNCTION |npSignatureDefinee|))))) + +;npTyping()== +; npEqKey "DEFAULT" and (npDefaultItemlist() or npTrap()) +; and npPush pfTyping npPop1() +(DEFUN |npTyping| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE DEFAULT)) + (OR (|npDefaultItemlist|) (|npTrap|)) + (|npPush| (|pfTyping| (|npPop1|))))))) + +;npDefaultItemlist()== npPC function npSDefaultItem +; and npPush pfUnSequence npPop1 () +(DEFUN |npDefaultItemlist| () + (PROG NIL + (RETURN + (AND + (|npPC| (FUNCTION |npSDefaultItem|)) + (|npPush| (|pfUnSequence| (|npPop1|))))))) + +;npDefaultDecl()== npEqKey "COLON" and (npType() or npTrap()) and +; npPush pfSpread (pfParts npPop2(),npPop1()) +(DEFUN |npDefaultDecl| () + (PROG NIL + (RETURN + (AND + (|npEqKey| (QUOTE COLON)) + (OR (|npType|) (|npTrap|)) + (|npPush| (|pfSpread| (|pfParts| (|npPop2|)) (|npPop1|))))))) + +;npDefaultItem()==npTypeVariable() and (npDefaultDecl() or npTrap()) +(DEFUN |npDefaultItem| () + (PROG NIL + (RETURN + (AND + (|npTypeVariable|) + (OR (|npDefaultDecl|) (|npTrap|)))))) + +;npSDefaultItem()== npListing function npDefaultItem +; and npPush pfAppend pfParts npPop1() +(DEFUN |npSDefaultItem| () + (PROG NIL + (RETURN + (AND + (|npListing| (FUNCTION |npDefaultItem|)) + (|npPush| (|pfAppend| (|pfParts| (|npPop1|)))))))) + +;npBPileDefinition()== +; npPileBracketed function npPileDefinitionlist +; and npPush pfSequence pfListOf npPop1 () +(DEFUN |npBPileDefinition| () + (PROG NIL + (RETURN + (AND + (|npPileBracketed| (FUNCTION |npPileDefinitionlist|)) + (|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()) +(DEFUN |npLambda| () + (PROG NIL + (RETURN + (OR + (AND + (|npVariable|) + (OR (|npLambda|) (|npTrap|)) + (|npPush| (|pfLam| (|npPop2|) (|npPop1|)))) + (AND + (|npEqKey| (QUOTE GIVES)) + (OR (|npDefinitionOrStatement|) (|npTrap|))) + (AND + (|npEqKey| (QUOTE COLON)) + (OR (|npType|) (|npTrap|)) + (|npEqKey| (QUOTE GIVES)) + (OR (|npDefinitionOrStatement|) (|npTrap|)) + (|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 +(DEFUN |npDef| () + (PROG (|body| |rt| |arg| |op| |LETTMP#1|) + (RETURN + (COND + ((|npMatch|) + (PROGN + (SETQ |LETTMP#1| (|pfCheckItOut| (|npPop1|))) + (SETQ |op| (CAR |LETTMP#1|)) + (SETQ |arg| (CADR . #0=(|LETTMP#1|))) + (SETQ |rt| (CADDR . #0#)) + (OR (|npDefTail|) (|npTrap|)) + (SETQ |body| (|npPop1|)) + (COND + ((NULL |arg|) + (|npPush| (|pfDefinition| |op| |body|))) + (#1=(QUOTE T) + (|npPush| (|pfDefinition| |op| (|pfPushBody| |rt| |arg| |body|))))))) + (#1# NIL))))) + +;--npDefTail()== npEqKey "DEF" and npDefinitionOrStatement() +;npDefTail()== (npEqKey "DEF" or npEqKey "MDEF") and npDefinitionOrStatement() +(DEFUN |npDefTail| () + (PROG NIL + (RETURN + (AND + (OR (|npEqKey| (QUOTE DEF)) (|npEqKey| (QUOTE MDEF))) + (|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 +(DEFUN |npMdef| () + (PROG (|body| |arg| |op| |LETTMP#1|) + (RETURN + (COND + ((|npQuiver|) + (PROGN + (SETQ |LETTMP#1| (|pfCheckMacroOut| (|npPop1|))) + (SETQ |op| (CAR |LETTMP#1|)) + (SETQ |arg| (CADR |LETTMP#1|)) + (OR (|npDefTail|) (|npTrap|)) + (SETQ |body| (|npPop1|)) + (COND + ((NULL |arg|) + (|npPush| (|pfMacro| |op| |body|))) + (#0=(QUOTE T) + (|npPush| (|pfMacro| |op| (|pfPushMacroBody| |arg| |body|))))))) + (#0# NIL))))) + +; +;npSingleRule()== +; npQuiver() => +; npDefTail() or npTrap() +; npPush pfRule (npPop2(),npPop1()) +; false +(DEFUN |npSingleRule| () + (PROG NIL + (RETURN + (COND + ((|npQuiver|) + (PROGN + (OR (|npDefTail|) (|npTrap|)) + (|npPush| (|pfRule| (|npPop2|) (|npPop1|))))) + ((QUOTE T) NIL))))) + +;npDefinitionItem()== +; npTyping() or +; npImport() or +; a:=npState() +; npStatement() => +; npEqPeek "DEF" => +; npRestore a +; npDef() +; npRestore a +; npMacro() or npDefn() +; npTrap() +(DEFUN |npDefinitionItem| () + (PROG (|a|) + (RETURN + (OR + (|npTyping|) + (|npImport|) + (PROGN + (SETQ |a| (|npState|)) + (COND + ((|npStatement|) + (COND + ((|npEqPeek| (QUOTE DEF)) (PROGN (|npRestore| |a|) (|npDef|))) + (#0=(QUOTE T) (PROGN (|npRestore| |a|) (OR (|npMacro|) (|npDefn|)))))) + (#0# (|npTrap|)))))))) + +;npDefinition()== npPP function npDefinitionItem +; and npPush pfSequenceToList npPop1 () +(DEFUN |npDefinition| () + (PROG NIL + (RETURN + (AND + (|npPP| (FUNCTION |npDefinitionItem|)) + (|npPush| (|pfSequenceToList| (|npPop1|))))))) + +;pfSequenceToList x== +; pfSequence? x => pfSequenceArgs x +; pfListOf [x] +(DEFUN |pfSequenceToList| (|x|) + (PROG NIL + (RETURN + (COND + ((|pfSequence?| |x|) (|pfSequenceArgs| |x|)) + ((QUOTE T) (|pfListOf| (LIST |x|))))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document} diff --git a/src/interp/debugsys.lisp.pamphlet b/src/interp/debugsys.lisp.pamphlet index c78c59f..a26734c 100644 --- a/src/interp/debugsys.lisp.pamphlet +++ b/src/interp/debugsys.lisp.pamphlet @@ -95,7 +95,7 @@ loaded by hand we need to establish a value. (thesymb "/int/interp/clammed.lisp") (thesymb "/int/interp/compat.lisp") (thesymb "/int/interp/compress.lisp") - (thesymb "/int/interp/cparse.clisp") + (thesymb "/int/interp/cparse.lisp") (thesymb "/int/interp/cstream.clisp") (thesymb "/int/interp/database.clisp") (thesymb "/int/interp/dq.lisp")