PACKETformulaanalyzerDEFINESclearformulaspaces,opindex,regenerateformula,arithnotation,printnotation,formulacomplexity,removeformulaobj,appendformulaobj,insertformulaobj,insertformulapars,createformulaobj,adjoinformulaobj,adjoinformulapars,getformulaposition,formulaposition,getformulanode,formulanode,getformulaterm,defformulaterm,formulaterm,getformulapos,defformulapos,formulabeg,formulaend,formulaindex,getformulaaddress,defformulaaddress,formulaaddress,getformulatree,defformulatree,expand,compress,getformulabox,defformulabox,getformulaobject,defformulaobject,getformulalength,getformula,writeformula,clearformula,outformula,out,:LETnilidx=0;INT VARnillbp,nilrbp;TEXT VARnilari;LETatomidx=1;INT VARatomlbp,atomrbp;TEXT VARatomari;LETtimesidx=2;INT VARtimeslbp,timesrbp;TEXT VARtimesari;LETapplyidx=3;INT VARapplylbp,applyrbp;TEXT VARapplyari;LETifidx=4;INT VARiflbp,ifrbp;TEXT VARifari;LETfiidx=5;INT VARfilbp,firbp;TEXT VARfiari;LETthenidx=6;INT VARthenlbp,thenrbp;TEXT VARthenari;LETelif1idx=7;INT VARelif1lbp,elif1rbp;TEXT VARelif1ari;LETelif2idx=8;INT VARelif2lbp,elif2rbp;TEXT VARelif2ari;LETelif3idx=9;INT VARelif3lbp,elif3rbp;TEXT VARelif3ari;LETmonadidx=10;INT VARprefixlbp,postfixrbp;LETlforceidx=11;INT VARlforcelbp,lforcerbp;TEXT VARlforceari;LETrforceidx=12;INT VARrforcelbp,rforcerbp;TEXT VARrforceari;LETlparidx=15;INT VARlparlbp,lparrbp;LETrparidx=16;INT VARrparlbp,rparrbp;LETinfixnpm=2;LETxmin=1,ymin=1,xmax=400,ymax=400,xsiz=400,ysiz=400;LET MEM=STRUCT(INTnodr,nodc,adrc,sp,ELEMROWstk,TEXTROWtrm,ELEMROWobj,ELEMROWadr,tre,alg,del,box);LET SCR=STRUCT(INTxbeg,ybeg,xend,yend,ROWysizTEXTrec);TEXT VARari:="",prt:="";INT VARanum:=0,alen:=0;BOOL VARariok,prtok,analyzeok;INITFLAG VARspacesok:=FALSE;DATASPACE VARmemds;BOUND MEM VARmem;DATASPACE VARscrds;BOUND SCR VARscr;INT VARdummy;TEXT VARemptyrec:=xsiz*" ";TEXT VARrec;PROCclearformulaspaces:disablestop;IFinitialized(spacesok)THENforget(memds);forget(scrds)FI;spacesok:=FALSE;END PROCclearformulaspaces;PROCinitformulaspaces:disablestop;IFinitialized(spacesok)THEN LEAVEinitformulaspacesFI;spacesok:=FALSE;enablestop;forget(memds);memds:=nilspace;mem:=memds;forget(scrds);scrds:=nilspace;scr:=scrds;ari:="";anum:=0;alen:=0;ariok:=FALSE;prt:="";prtok:=FALSE;mem.trm:=emptytextrow;clear(mem.obj);define(mem.obj,1,1,0,0,0);mem.nodr:=0;mem.nodc:=0;mem.adrc:=0;clear(mem.stk);mem.sp:=0;clear(mem.adr);clear(mem.tre);clear(mem.alg);clear(mem.del);clear(mem.box);scr.xbeg:=xmax+1;scr.ybeg:=ymax+1;scr.xend:=xmin-1;scr.yend:=ymin-1;analyzeok:=TRUE;spacesok:=TRUE;initops;END PROCinitformulaspaces;PROCgetfixedops:getoppower(nilidx,nillbp,nilrbp);nilari:=oparithsymbol(nilidx);getoppower(atomidx,atomlbp,atomrbp);atomari:=oparithsymbol(atomidx);getoppower(timesidx,timeslbp,timesrbp);timesari:=oparithsymbol(timesidx);getoppower(applyidx,applylbp,applyrbp);applyari:=oparithsymbol(applyidx);getoppower(ifidx,iflbp,ifrbp);ifari:=oparithsymbol(ifidx);getoppower(fiidx,filbp,firbp);fiari:=oparithsymbol(fiidx);getoppower(thenidx,thenlbp,thenrbp);thenari:=oparithsymbol(thenidx);getoppower(elif1idx,elif1lbp,elif1rbp);elif1ari:=oparithsymbol(elif1idx);getoppower(elif2idx,elif2lbp,elif2rbp);elif2ari:=oparithsymbol(elif2idx);getoppower(elif3idx,elif3lbp,elif3rbp);elif3ari:=oparithsymbol(elif3idx);getoppower(monadidx,prefixlbp,postfixrbp);getoppower(lforceidx,lforcelbp,lforcerbp);lforceari:=oparithsymbol(lforceidx);getoppower(rforceidx,rforcelbp,rforcerbp);rforceari:=oparithsymbol(rforceidx);getoppower(lparidx,lparlbp,lparrbp);getoppower(rparidx,rparlbp,rparrbp);END PROCgetfixedops;INT PROCopindex(TEXT CONSTamid,BOOL CONSTlft,rgt):INT VARidx:=opindex(amid);WHILEidx>atomidxAND(lftANDrgtANDopparams(idx)<>2OR NOTlftANDrgtANDoplbp(idx)<>lparlbpANDoplbp(idx)<>prefixlbpORlftAND NOTrgtANDoprbp(idx)<>rparrbpANDoprbp(idx)<>postfixrbp)REPidx:=opindex(amid,idx+1);PER;idxEND PROCopindex;PROCregenerateformula(INT VARnodc,adrc):initformulaspaces;mem.nodc:=nodc;mem.adrc:=adrc;ariok:=FALSE;ari:="";anum:=0;alen:=0;IFmem.nodr>0THENcatarith(
ari,anum,alen,mem.nodr,FALSE,FALSE)FI;ariok:=TRUE;prtok:=FALSE;analyzeok:=FALSE;analyzeformula;nodc:=mem.nodc;adrc:=mem.adrc;END PROCregenerateformula;PROCarithnotation(TEXT CONSTnewari):enablestop;initformulaspaces;IFariokANDnewari=ariTHEN LEAVEarithnotationFI;ariok:=TRUE;prtok:=FALSE;analyzeok:=FALSE;ari:=newari;alen:=LENGTHari;analyzeformula;END PROCarithnotation;TEXT PROCarithnotation:enablestop;IFariokTHEN LEAVEarithnotationWITHariFI;initformulaspaces;analyzeformula;TEXT CONSToldari:=ari;ariok:=FALSE;ari:="";anum:=0;alen:=0;IFmem.nodr>0THENcatarith(ari,anum,alen,mem.nodr,FALSE,FALSE)FI;ariok:=TRUE;IFari<>oldariTHENprtok:=FALSE;analyzeok:=FALSE FI;ariEND PROCarithnotation;TEXT PROCarithnotation(INT CONSTnod1):enablestop;initformulaspaces;analyzeformula;TEXT VARari:="";INT VARanum:=0;alen:=0;IFnod1>0THENcatarith(ari,anum,alen,nod1,FALSE,FALSE)FI;ariEND PROCarithnotation;TEXT PROCprintnotation:enablestop;IFprtokTHEN LEAVEprintnotationWITHprtFI;initformulaspaces;analyzeformula;prtok:=FALSE;prt:="";IFmem.nodr>0THENcatprint(prt,mem.nodr)FI;prtok:=TRUE;prtEND PROCprintnotation;TEXT PROCprintnotation(INT CONSTnod1):enablestop;initformulaspaces;analyzeformula;TEXT VARprt:="";IFnod1>0THENcatprint(prt,nod1)FI;prtEND PROCprintnotation;INT PROCformulacomplexity:initformulaspaces;mem.nodrEND PROCformulacomplexity;PROCgetformulaposition(INT CONSTapos,INT VARxpoi,ypoi):INT VARnod1,adr1;INT VARabeg,aend,idx;INT VARxdel,ydel;initformulaspaces;FORnod1FROM1UPTOmem.nodrREPadr1:=field(mem.adr,nod1,3);recall(mem.obj,adr1,abeg,aend,idx,dummy);IFapos>=abegANDapos<=aendTHENrecall(mem.del,nod1,xpoi,ypoi,xdel,ydel);xpoiINCRapos-abeg;LEAVEgetformulaposition;FI;PER;END PROCgetformulaposition;INT PROCformulaposition(INT CONSTxpoi,ypoi):INT VARnod1,adr1;INT VARxpos,ypos,xdel,ydel;INT VARabeg,aend,idx;initformulaspaces;nod1:=sup(mem.box,xpoi,ypoi);adr1:=field(mem.adr,nod1,3);recall(mem.del,nod1,xpos,ypos,xdel,ydel);recall(mem.obj,adr1,abeg,aend,idx,dummy);abegMAXabeg+xpoi-xposMINaendEND PROCformulaposition;INT PROCformulanode(INT CONSTapos):INT VARnod1,adr1;INT VARabeg,aend,idx;initformulaspaces;FORnod1FROM1UPTOmem.nodrREPadr1:=field(mem.adr,nod1,3);recall(mem.obj,adr1,abeg,aend,idx,dummy);IFapos>=abegANDapos<=aendTHEN LEAVEformulanodeWITHnod1;FI;PER;0END PROCformulanode;PROCgetformulanode(INT CONSTapos,INT VARnod1):nod1:=formulanode(apos);END PROCgetformulanode;INT PROCformulanode(INT CONSTxpoi,ypoi):initformulaspaces;sup(mem.box,xpoi,ypoi)END PROCformulanode;PROCgetformulanode(INT CONSTxpoi,ypoi,INT VARnod1):initformulaspaces;nod1:=sup(mem.box,xpoi,ypoi);END PROCgetformulanode;PROCdefformulaterm(INT CONSTadr1,TEXT CONSTsym):initformulaspaces;ariok:=FALSE;prtok:=FALSE;rename(mem.trm,adr1,sym);END PROCdefformulaterm;PROCdefformulaterm(INT CONSTadr1,TEXT CONSTsym,INT CONSTidx):initformulaspaces;ariok:=FALSE;prtok:=FALSE;rename(mem.trm,adr1,sym);field(mem.obj,adr1,3,idx);END PROCdefformulaterm;TEXT PROCformulaterm(INT CONSTadr1):initformulaspaces;name(mem.trm,adr1)END PROCformulaterm;PROCgetformulaterm(INT CONSTadr1,TEXT VARsym):sym:=formulaterm(adr1);END PROCgetformulaterm;PROCdefformulapos(INT CONSTadr1,INT CONSTabeg,aend,idx,dummy):initformulaspaces;define(mem.obj,adr1,abeg,aend,idx,dummy);END PROCdefformulapos;PROCgetformulapos(INT CONSTadr1,INT VARabeg,aend,idx,dummy):initformulaspaces;recall(mem.obj,adr1,abeg,aend,idx,dummy);END PROCgetformulapos;PROCgetformulapos(INT CONSTadr1,INT VARabeg,aend):INT VARidx;initformulaspaces;recall(mem.obj,adr1,abeg,aend,idx,dummy);END PROCgetformulapos;INT PROCformulabeg(INT CONSTadr1):initformulaspaces;field(mem.obj,adr1,1)END PROCformulabeg;INT PROCformulaend(INT CONSTadr1):initformulaspaces;field(mem.obj,adr1,2)END PROCformulaend;INT PROCformulaindex(INT CONSTadr1):initformulaspaces;field(mem.obj,adr1,3)END PROCformulaindex;PROCformulaindex(INT CONSTadr1,idx):initformulaspaces;field(mem.obj,adr1,3,idx)END PROCformulaindex;PROCdefformulaaddress(INT CONSTnod1,INT CONSTnod2,nodx,adr1,adr2):initformulaspaces;define(
mem.adr,nod1,nod2,nodx,adr1,adr2);END PROCdefformulaaddress;PROCgetformulaaddress(INT CONSTnod1,INT VARnod2,nodx,adr1,adr2):initformulaspaces;recall(mem.adr,nod1,nod2,nodx,adr1,adr2);END PROCgetformulaaddress;INT PROCformulaaddress(INT CONSTnod1):initformulaspaces;field(mem.adr,nod1,3)END PROCformulaaddress;PROCdefformulatree(INT CONSTnod1,INT CONSTlnod,rnod,pnod,inod):initformulaspaces;define(mem.tre,nod1,lnod,rnod,pnod,inod);END PROCdefformulatree;PROCgetformulatree(INT CONSTnod1,INT VARlnod,rnod,pnod,inod):initformulaspaces;recall(mem.tre,nod1,lnod,rnod,pnod,inod);END PROCgetformulatree;PROCexpand(INT VARlnod,rnod):INT VARnod1;initformulaspaces;REPnod1:=lnod;lnod:=field(mem.tre,nod1,1)UNTILlnod=0PER;lnod:=nod1;REPnod1:=rnod;rnod:=field(mem.tre,nod1,2)UNTILrnod=0PER;rnod:=nod1;END PROCexpand;PROCcompress(INT VARlnod,rnod):expand(rnod,lnod);END PROCcompress;PROCdefformulabox(INT CONSTnod1,INT CONSTxbeg,ybeg,xend,yend):initformulaspaces;define(mem.box,nod1,xbeg,ybeg,xend,yend);END PROCdefformulabox;PROCgetformulabox(INT CONSTnod1,INT VARxbeg,ybeg,xend,yend):initformulaspaces;recall(mem.box,nod1,xbeg,ybeg,xend,yend);END PROCgetformulabox;PROCdefformulaobject(INT CONSTnod1,INT CONSTxobj,yobj,xdel,ydel):initformulaspaces;define(mem.del,nod1,xobj,yobj,xdel,ydel);END PROCdefformulaobject;PROCgetformulaobject(INT CONSTnod1,INT VARxobj,yobj,xdel,ydel):initformulaspaces;recall(mem.del,nod1,xobj,yobj,xdel,ydel);END PROCgetformulaobject;PROCgetformulaobject(INT CONSTnod1,INT VARxobj,yobj):INT VARxdel,ydel;initformulaspaces;recall(mem.del,nod1,xobj,yobj,xdel,ydel);END PROCgetformulaobject;PROCcatarith(TEXT VARari,INT VARadrc,alen,INT CONSTnod1,BOOL CONSTforce,forcepending):INT VARnod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod;INT VARladr,radr;INT VARoidx,rbp,lbp;INT VARlidx,llbp,lrbp;INT VARridx,rlbp,rrbp;TEXT VARlsym,rsym;initformulaspaces;recall(mem.tre,nod1,lnod,rnod,pnod,inod);recall(mem.adr,nod1,nod2,nodx,adr1,adr2);oidx:=field(mem.obj,adr1,3);IFnodx=2THENcatterm2;catarith(ari,adrc,alen,lnod,FALSE,FALSE);catterm1;ELIFnod1<>nod2THENrnod:=field(mem.tre,nod2,1);catterm1;catarith(ari,adrc,alen,rnod,FALSE,FALSE);catterm2;ELSE IFforceAND(lnod>0ORrnod>0)THENcatarith(ari,adrc,alen,lforceari);FI;getoppower(oidx,lbp,rbp);IFlnod>0THENcatleftparamFI;catterm1;IFrnod>0THENcatrightparamFI;IFforceAND(lnod>0ORrnod>0)THENcatarith(ari,adrc,alen,rforceari);FI;FI;.catterm1:catarith(ari,adrc,alen,name(mem.trm,adr1));IFnod1=mem.nodcTHENmem.adrc:=adrcFI;.catterm2:catarith(ari,adrc,alen,name(mem.trm,adr2));IFnod2=mem.nodcTHENmem.adrc:=adrcFI;.catleftparam:ladr:=field(mem.adr,lnod,4);lidx:=field(mem.obj,ladr,3);lsym:=name(mem.trm,ladr);getoppower(lidx,llbp,lrbp);IFlrbp=postfixrbpTHENlrbp:=llbpFI;IFoplforce(oidx)=0ANDopoforce(lidx)=0THENcatarith(ari,adrc,alen,lnod,FALSE,forcependingORlrbp<lbp);ELIFforcependingORlrbp<lbpTHENcatarith(ari,adrc,alen,lnod,TRUE,FALSE);ELSEcatarith(ari,adrc,alen,lnod,FALSE,FALSE);FI;.catrightparam:radr:=field(mem.adr,rnod,3);ridx:=field(mem.obj,radr,3);rsym:=name(mem.trm,radr);getoppower(ridx,rlbp,rrbp);IFrlbp=prefixlbpTHENrlbp:=rrbpFI;IFoprforce(oidx)=0ANDopoforce(ridx)=0THENcatarith(ari,adrc,alen,rnod,FALSE,forcependingORrbp>rlbp);ELIFforcependingORrbp>rlbpTHENcatarith(ari,adrc,alen,rnod,TRUE,FALSE);ELSEcatarith(ari,adrc,alen,rnod,FALSE,FALSE);FI;.END PROCcatarith;PROCcatarith(TEXT VARari,INT VARadrc,alen,TEXT CONSTsym):IFsym=nilariTHEN LEAVEcatarithFI;IFpos(ari,delimiter,alen,alen)<>alenTHENariCATdelimiterFI;ariCATsym;adrcINCR1;alen:=LENGTHari;END PROCcatarith;PROCcatprint(TEXT VARprt,INT CONSTnod1):INT VARlnod,rnod,pnod,inod;INT VARadr1;INT VARoidx;TEXT VARplft,pmid,prgt;IFnod1<=0THEN LEAVEcatprintFI;initformulaspaces;recall(mem.tre,nod1,lnod,rnod,pnod,inod);adr1:=field(mem.adr,nod1,3);oidx:=field(mem.obj,adr1,3);IFoidx<=atomidxTHENplft:="";pmid:=name(mem.trm,adr1);prgt:="";ELSEgetopprintsymbols(oidx,plft,pmid,prgt);FI;prtCATplft;IFopparamexc(oidx)=0THENcatprint(prt,lnod);prtCATpmid;catprint(prt,rnod);ELSEcatprint(prt,rnod);prt
CATpmid;catprint(prt,lnod);FI;prtCATprgt;END PROCcatprint;PROCremoveformulaobj(INT CONSTnod1):INT VARnod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod,snod;initformulaspaces;analyzeformula;ariok:=FALSE;prtok:=FALSE;recall(mem.tre,nod1,lnod,rnod,pnod,inod);recall(mem.adr,nod1,nod2,nodx,adr1,adr2);define(mem.adr,nod1,nod1,1,adr1,adr1);define(mem.adr,nod2,nod2,1,adr2,adr2);rename(mem.trm,adr1,"");IFlnod=0THENsnod:=rnod;ELIFrnod=0THENsnod:=lnod;ELSE LEAVEremoveformulaobj;FI;IFpnod>0THENfield(mem.tre,pnod,inod,snod);FI;IFsnod>0THENfield(mem.tre,snod,3,pnod);field(mem.tre,snod,4,inod);FI;END PROCremoveformulaobj;PROCappendformulaobj(TEXT CONSTsym,INT CONSTidx,INT CONSTpnod,inod,INT VARnod1):INT VARlnod,rnod;initformulaspaces;SELECTinodOF CASE1:rnod:=0;lnod:=field(mem.tre,pnod,1);CASE2:lnod:=0;rnod:=field(mem.tre,pnod,2);OTHERWISElnod:=0;rnod:=0;END SELECT;insertformulaobj(sym,idx,lnod,rnod,pnod,inod,nod1);END PROCappendformulaobj;PROCinsertformulaobj(TEXT CONSTsym,INT CONSTidx,INT CONSTlnod,rnod,pnod,inod,INT VARnod1):initformulaspaces;analyzeformula;ariok:=FALSE;prtok:=FALSE;INT VARadr1;insert(mem.trm,sym);append(mem.obj,0,-1,idx,0);adr1:=length(mem.obj);append(mem.tre,lnod,rnod,pnod,inod);nod1:=length(mem.tre);append(mem.adr,nod1,1,adr1,adr1);IFlnod>0THENfield(mem.tre,lnod,3,nod1);field(mem.tre,lnod,4,1)FI;IFrnod>0THENfield(mem.tre,rnod,3,nod1);field(mem.tre,rnod,4,2)FI;IFpnod>0THENfield(mem.tre,pnod,inod,nod1)ELSEmem.nodr:=nod1FI;END PROCinsertformulaobj;PROCinsertformulapars(TEXT CONSTsym1,sym2,INT CONSTidx1,idx2,INT CONSTsnod,pnod,inod,INT VARnod1,nod2):adjoinformulaobj(sym2,idx2,snod,0,nod2);insertformulaobj(sym1,idx1,0,nod2,pnod,inod,nod1);END PROCinsertformulapars;PROCcreateformulaobj(TEXT CONSTsym,INT CONSTidx,INT VARnod1):adjoinformulaobj(sym,idx,0,0,nod1);END PROCcreateformulaobj;PROCadjoinformulaobj(TEXT CONSTsym,INT CONSTidx,INT CONSTlnod,rnod,INT VARnod1):initformulaspaces;analyzeformula;INT VARadr1;insert(mem.trm,sym);append(mem.obj,0,-1,idx,0);adr1:=length(mem.obj);append(mem.tre,lnod,rnod,0,0);nod1:=length(mem.tre);append(mem.adr,nod1,1,adr1,adr1);IFlnod>0THENfield(mem.tre,lnod,3,nod1);field(mem.tre,lnod,4,1)FI;IFrnod>0THENfield(mem.tre,rnod,3,nod1);field(mem.tre,rnod,4,2)FI;END PROCadjoinformulaobj;PROCadjoinformulapars(TEXT CONSTsym1,sym2,INT CONSTidx1,idx2,INT CONSTsnod,INT VARnod1,nod2):adjoinformulaobj(sym2,idx2,snod,0,nod2);adjoinformulaobj(sym1,idx1,0,nod2,nod1);END PROCadjoinformulapars;PROCputobjectontostack(INT VARnod1,INT CONSTadr1,TEXT CONSTsym,INT CONSTidx):INT VARlbp,rbp;getoppower(idx,lbp,rbp);getparamsfromstack(nod1,lbp);INT VARadr2;insert(mem.trm,sym,adr2);INT CONSTapos:=field(mem.obj,adr1,1)-1;define(mem.obj,adr2,apos,apos,idx,0);mem.spINCR1;define(mem.stk,mem.sp,nod1,adr2,idx,rbp);END PROCputobjectontostack;PROCgetparamsfromstack(INT VARnod1,INT CONSTlbp):INT VARstacknod,stackadr,stackidx,stackrbp;WHILEmem.sp>0REPrecall(mem.stk,mem.sp,stacknod,stackadr,stackidx,stackrbp);IFstackrbp<lbpTHEN LEAVEgetparamsfromstackFI;mem.spDECR1;IFstackidx<>lforceidxANDstackidx<>rforceidxTHENnod1INCR1;define(mem.adr,nod1,nod1,1,stackadr,stackadr);IFstackadr=mem.adrcTHENmem.nodc:=nod1FI;FI;PER;END PROCgetparamsfromstack;PROCfindprefixop(TEXT CONSTsym,INT VARidx,npm,lbp,rbp):REPidx:=opindex(sym,idx+1);IFidx<=atomidxTHENidx:=opindex(sym);getopparams(idx,npm);getoppower(idx,lbp,rbp);LEAVEfindprefixop;FI;getopparams(idx,npm);getoppower(idx,lbp,rbp);UNTILlbp=prefixlbpPER;END PROCfindprefixop;PROCfindpostfixop(TEXT CONSTsym,INT VARidx,npm,lbp,rbp):REPidx:=opindex(sym,idx+1);IFidx<=atomidxTHENidx:=opindex(sym);getopparams(idx,npm);getoppower(idx,lbp,rbp);LEAVEfindpostfixop;FI;getopparams(idx,npm);getoppower(idx,lbp,rbp);UNTILrbp=postfixrbpPER;END PROCfindpostfixop;PROCfindinfixop(TEXT CONSTsym,INT VARidx,npm,lbp,rbp):REPidx:=opindex(sym,idx+1);IFidx<=atomidxTHENidx:=opindex(sym);getopparams(idx,npm);getoppower(idx,lbp,rbp);LEAVEfindinfixop;FI;getopparams(idx,npm);getoppower(idx,lbp,rbp);UNTILnpm=infixnpmPER;END PROCfindinfixop
;PROCanalyzeformula:INT VARnod1,nod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod;INT VARabeg,aend;INT VARstackidx,stackrbp;INT VARlastidx,lastnpm,lastlbp,lastrbp;INT VARnextidx,nextnpm,nextlbp,nextrbp;TEXT VARsym;INT VARtlen;INT VARxfb,yfb,xfe,yfe;INT VARpxp,pyp,pxd,pyd;INT VARoxb,oyb,oxe,oye,oxp,oyp,oxd,oyd;INT VARlxb,lyb,lxe,lye,lxp,lyp,lxa,lya,lxd,lyd;INT VARrxb,ryb,rxe,rye,rxp,ryp,rxa,rya,rxd,ryd;INT VARoxc,oyc;IFanalyzeokTHEN LEAVEanalyzeformulaFI;getfixedops;splitari;computerpn;computetre;computealgdelandbox;computescr;analyzeok:=TRUE;.splitari:mem.trm:=emptytextrow;clear(mem.obj);aend:=0;REPabeg:=aend+1;aend:=pos(ari,delimiter,abeg);IFaend>abegTHENsym:=subtext(ari,abeg,aend-1);insert(mem.trm,sym);nextidx:=opindex(sym)MAXatomidx;append(mem.obj,abeg,aend-1,nextidx,0);FI;UNTILaend=0PER;IFabeg<=alenTHENsym:=subtext(ari,abeg,alen);insert(mem.trm,sym);nextidx:=opindex(sym)MAXatomidx;append(mem.obj,abeg,alen,nextidx,0);FI;.computerpn:clear(mem.adr);nod1:=0;clear(mem.stk);mem.sp:=0;lastidx:=nilidx;lastnpm:=0;lastlbp:=nillbp;lastrbp:=nilrbp;FORadr1FROM1UPTOlength(mem.obj)REPprocessobject;lastidx:=nextidx;lastnpm:=nextnpm;lastlbp:=nextlbp;lastrbp:=nextrbp;PER;nextidx:=nilidx;getoppower(nextidx,nextlbp,nextrbp);getopparams(nextidx,nextnpm);insertmissingobject;getparamsfromstack(nod1,nextlbp);mem.nodr:=nod1;.processobject:nextidx:=field(mem.obj,adr1,3);getoppower(nextidx,nextlbp,nextrbp);getopparams(nextidx,nextnpm);insertmissingobject;getparamsfromstack(nod1,nextlbp);IFnextidx=rforceidxTHEN IFfield(mem.stk,mem.sp,3)=lforceidxTHENfield(mem.stk,mem.sp,4,rforcerbp)FI;ELIFnextlbp=rparlbpTHENnod1INCR1;define(mem.adr,nod1,nod1,1,adr1,adr1);IFadr1=mem.adrcTHENmem.nodc:=nod1FI;IFfield(mem.stk,mem.sp,4)=lparrbpTHENfield(mem.stk,mem.sp,4,rparrbp)FI;ELSEmem.spINCR1;define(mem.stk,mem.sp,nod1,adr1,nextidx,nextrbp);FI;.insertmissingobject:IFnextidx=fiidxTHEN IFlastnpm=infixnpmORlastlbp=prefixlbpTHENpostfixlast;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFlastlbp=lparlbpORlastidx=lforceidxORlastidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;putobjectontostack(nod1,adr1,elif3ari,elif3idx);ELIFlastidx=elif1idxTHEN IFnextidx=elif1idxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;putobjectontostack(nod1,adr1,elif2ari,elif2idx);IFnextnpm=infixnpmTHENprefixnext;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpORnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;ELIFlastidx=atomidxORlastrbp=rparrbpORlastidx=rforceidxTHEN IFnextidx=atomidxORnextidx=lforceidxTHENputobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=prefixlbpTHENinfixnext;putobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=lparlbpTHENputobjectontostack(nod1,adr1,applyari,applyidx);FI;ELIFlastrbp=postfixrbpTHEN IFnextidx=atomidxORnextidx=lforceidxTHENinfixlast;putobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=prefixlbpTHENinfixlast;infixnext;putobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=lparlbpTHENinfixlast;putobjectontostack(nod1,adr1,applyari,applyidx);FI;ELIFlastnpm=infixnpmTHEN IFnextnpm=infixnpmTHENprefixnext;postfixlast;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpORnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENpostfixlast;putobjectontostack(nod1,adr1,atomari,atomidx);FI;ELIFlastlbp=prefixlbpTHEN IFnextnpm=infixnpmTHENprefixnext;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpORnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;ELIFlastlbp=lparlbpORlastidx=lforceidxORlastidx=nilidxTHEN IFnextnpm=infixnpmTHENprefixnext;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpTHENputobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;FI;.prefixnext:findprefixop(name(mem.trm,adr1),nextidx,nextnpm,nextlbp,nextrbp);IFnextlbp=prefixlbpTHENfield(mem.
obj,adr1,3,nextidx);LEAVEinsertmissingobject;FI;.infixnext:findinfixop(name(mem.trm,adr1),nextidx,nextnpm,nextlbp,nextrbp);IFnextnpm=infixnpmTHENfield(mem.obj,adr1,3,nextidx);LEAVEinsertmissingobject;FI;.infixlast:findinfixop(name(mem.trm,adr1-1),lastidx,lastnpm,lastlbp,lastrbp);IFlastnpm=infixnpmTHENfield(mem.stk,mem.sp,3,lastidx);field(mem.stk,mem.sp,4,lastrbp);field(mem.obj,adr1-1,3,lastidx);LEAVEinsertmissingobject;FI;.postfixlast:findpostfixop(name(mem.trm,adr1-1),lastidx,lastnpm,lastlbp,lastrbp);IFlastrbp=postfixrbpTHENfield(mem.stk,mem.sp,3,lastidx);field(mem.stk,mem.sp,4,lastrbp);field(mem.obj,adr1-1,3,lastidx);LEAVEinsertmissingobject;FI;.computetre:clear(mem.tre);define(mem.tre,mem.nodr,0,0,0,0);clear(mem.stk);mem.sp:=0;FORnod1FROM1UPTOlength(mem.adr)REPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);field(mem.adr,nod1,2,1);nextidx:=field(mem.obj,adr1,3);getopparams(nextidx,nextnpm);getoppower(nextidx,nextlbp,nextrbp);WHILEnextnpm>0REPrecall(mem.stk,mem.sp,nod2,adr2,stackidx,stackrbp);mem.spDECR1;IFstackrbp=rparrbpANDnextlbp=lparlbpTHENdefine(mem.adr,nod2,nod1,2,adr2,adr1);define(mem.adr,nod1,nod2,1,adr1,adr2);FI;field(mem.tre,nod2,3,nod1);IFnextnpm>1ORnextlbp=lparlbpORnextlbp=prefixlbpTHENfield(mem.tre,nod1,2,nod2);field(mem.tre,nod2,4,2);ELSEfield(mem.tre,nod1,1,nod2);field(mem.tre,nod2,4,1);FI;nextnpmDECR1;PER;mem.spINCR1;define(mem.stk,mem.sp,nod1,adr1,nextidx,nextrbp);PER;.computealgdelandbox:clear(mem.alg);define(mem.alg,mem.nodr,0,0,0,0);clear(mem.del);define(mem.del,mem.nodr,0,0,0,0);clear(mem.box);define(mem.box,mem.nodr,0,0,0,0);FORnod1FROM1UPTOmem.nodrREPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);recall(mem.tre,nod1,lnod,rnod,pnod,inod);sym:=name(mem.trm,adr1);tlen:=LENGTHsym;recall(mem.obj,adr1,abeg,aend,nextidx,dummy);oxb:=0;oyb:=0;oxe:=0;oye:=0;lxd:=0;lyd:=0;rxd:=0;ryd:=0;getopalignment(nextidx,lxa,lya,rxa,rya);getopposition(nextidx,lxp,lyp,rxp,ryp);IFnextidx<=atomidxTHEN IFtlen>0THENoxe:=tlen;ELSEoxe:=LENGTHopscreensymbol(nextidx);FI;rxp:=oxe+1;getopframe(nextidx,xfb,yfb,xfe,yfe);ELSEoxe:=LENGTHopscreensymbol(nextidx);getopframe(nextidx,xfb,yfb,xfe,yfe);FI;IFlnod>0THENdefine(mem.alg,lnod,lxa,lya,lxp,lyp);recall(mem.box,lnod,lxb,lyb,lxe,lye);align(lxa,lxp,lxb,lxe,lxd);align(lya,lyp,lyb,lye,lyd);define(mem.del,lnod,0,0,lxd,lyd);oxb:=oxbMINlxb;oyb:=oybMINlyb;oxe:=oxeMAXlxe;oye:=oyeMAXlye;FI;IFlnod>0ANDrnod>0THEN IFrxa>=4THEN IFrxp>0THENrxpINCRoxeELIFrxp<0THENrxpINCRoxbFI FI;IFrya>=4THEN IFryp>0THENrypINCRoyeELIFryp<0THENrypINCRoybFI FI;FI;IFrnod>0THENdefine(mem.alg,rnod,rxa,rya,rxp,ryp);recall(mem.box,rnod,rxb,ryb,rxe,rye);align(rxa,rxp,rxb,rxe,rxd);align(rya,ryp,ryb,rye,ryd);define(mem.del,rnod,0,0,rxd,ryd);oxb:=oxbMINrxb;oyb:=oybMINryb;oxe:=oxeMAXrxe;oye:=oyeMAXrye;FI;oxbINCRxfb;oybINCRyfb;oxeINCRxfe;oyeINCRyfe;define(mem.box,nod1,oxb,oyb,oxe,oye);PER;nod1:=mem.nodr;recall(mem.adr,nod1,nod2,nodx,adr1,adr2);recall(mem.box,nod1,oxb,oyb,oxe,oye);align(1,2,oxb,oxe,oxd);align(1,1,oyb,oye,oyd);define(mem.del,nod1,oxd,oyd,oxd,oyd);define(mem.box,nod1,oxb,oyb,oxe,oye);FORnod1FROMmem.nodr-1DOWNTO1REPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);pnod:=field(mem.tre,nod1,3);recall(mem.del,pnod,pxp,pyp,pxd,pyd);recall(mem.del,nod1,oxp,oyp,oxd,oyd);oxp:=pxp+oxd;oyp:=pyp+oyd;define(mem.del,nod1,oxp,oyp,oxd,oyd);shiftelement(mem.box,nod1,oxp,oyp);PER;.computescr:scr.xbeg:=xmax+1;scr.ybeg:=ymax+1;scr.xend:=xmin-1;scr.yend:=ymin-1;FORnod1FROMmem.nodrDOWNTO1REPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);recall(mem.tre,nod1,lnod,rnod,pnod,inod);recall(mem.obj,adr1,abeg,aend,nextidx,dummy);recall(mem.box,nod1,oxb,oyb,oxe,oye);recall(mem.del,nod1,oxp,oyp,oxd,oyd);IFscr.ybeg>scr.yendTHENscr.ybeg:=oyb;scr.yend:=oyb-1;FI;WHILEscr.ybeg>oybANDscr.ybeg>yminREPscr.ybegDECR1;scr.rec[scr.ybeg]:=emptyrecPER;WHILEscr.yend<oyeANDscr.yend<ymaxREPscr.yendINCR1;scr.rec[scr.yend]:=emptyrecPER;scr.xbeg:=scr.xbegMINoxb;scr.xend:=scr.xendMAXoxe;IFoyb>=yminANDoye<=ymaxTHEN IFnextidx<=atomidxTHENsym:=name(mem.trm,adr1);IFsym=""THENsym:=opscreensymbol(nextidx)FI
;replace(scr.rec[oyp],oxp,sym);ELSEgetopposition(nextidx,lxp,lyp,rxp,ryp);getopalignment(nextidx,lxa,lya,rxa,rya);sym:=opscreensymbol(nextidx);IFsym=""THEN ELIFlxa=2ANDlya=3ANDrxa=2ANDrya=1THENoxc:=oxb;WHILEoxc<oxeREPreplace(scr.rec[oyp],oxc,symSUB1);oxcINCR1PER;ELIFlxa=3ANDlya=3ANDrxa=1ANDrya=0THENoxc:=oxb;oyc:=oyp;WHILEoxc<oxpREPreplace(scr.rec[oyc],oxc,symSUB1);oxcINCR1PER;oyc:=oye;WHILEoyc>oybREPreplace(scr.rec[oyc],oxc,symSUB2);oycDECR1PER;WHILEoxc<oxeREPreplace(scr.rec[oyc],oxc,symSUB3);oxcINCR1PER;ELIFnod2<>nod1THENoyc:=oyb;WHILEoyc<=oyeREPreplace(scr.rec[oyc],oxp,sym);oycINCR1PER;ELSEreplace(scr.rec[oyp],oxp,sym);FI;FI;FI;PER;.END PROCanalyzeformula;PROCshiftelement(ELEMROW VARlist,INT CONSTnod1,INT CONSTxdel,ydel):INT VARxbeg,ybeg,xend,yend;recall(list,nod1,xbeg,ybeg,xend,yend);xbegINCRxdel;ybegINCRydel;xendINCRxdel;yendINCRydel;define(list,nod1,xbeg,ybeg,xend,yend);END PROCshiftelement;PROCalign(INT CONSTali,pos,INT VARbeg,end,INT VARdel):SELECTaliAND3OF CASE0:del:=0;CASE1:del:=beg;CASE2:del:=beg+end;IFdel<0THENdelDECR1FI;del:=delDIV2;CASE3:del:=end;OTHERWISEerrorstop("unzulässige Alignment-Kennung : "+text(ali));END SELECT;del:=pos-del;begINCRdel;endINCRdel;END PROCalign;PROCgetformulalength(INT VARxbeg,ybeg,xend,yend):initformulaspaces;xbeg:=scr.xbeg;ybeg:=scr.ybeg;xend:=scr.xend;yend:=scr.yend;END PROCgetformulalength;PROCgetformula(INT VARxbeg,ybeg,xend,yend,ROWymaxTEXT VARrec):INT VARypoi;initformulaspaces;xbeg:=scr.xbeg;ybeg:=scr.ybeg;xend:=scr.xend;yend:=scr.yend;FORypoiFROMybegUPTOyendREPrec[ypoi]:=subtext(scr.rec[ypoi],xbeg,xend)PER;END PROCgetformula;PROCwriteformula(FILE VARf):INT VARypoi;initformulaspaces;output(f);IFcol(f)<=16000THENline(f)FI;INT VARxbeg,ybeg,xend,yend;xbeg:=scr.xbeg;ybeg:=scr.ybeg;xend:=scr.xend;yend:=scr.yend;FORypoiFROMybegUPTOyendREPputline(f,subtext(scr.rec[ypoi],xbeg,xend))PER;END PROCwriteformula;PROCclearformula(INT CONSTxbeg,ybeg,xend,yend,INT CONSTxoff,yoff):IFxbeg>xendORxbeg>xmaxORxend<xminTHEN LEAVEclearformulaFI;IFybeg>yendORybeg>ymaxORyend<yminTHEN LEAVEclearformulaFI;INT VARypoi:=ybeg;WHILEypoi<yendREPclearformula(xbeg,xend,ypoi,xoff,yoff);ypoiINCR1;PER;clearformula(xbeg,xend,ypoi,xoff,yoff);END PROCclearformula;PROCoutformula(INT CONSTxbeg,ybeg,xend,yend,INT CONSTxoff,yoff):IFxbeg>xendORxbeg>xmaxORxend<xminTHEN LEAVEoutformulaFI;IFybeg>yendORybeg>ymaxORyend<yminTHEN LEAVEoutformulaFI;INT VARypoi:=ybeg;WHILEypoi<yendREPoutformula(xbeg,xend,ypoi,xoff,yoff);ypoiINCR1;PER;outformula(xbeg,xend,ypoi,xoff,yoff);END PROCoutformula;PROCclearformula(INT CONSTxbeg,xend,ypoi,INT CONSTxoff,yoff):IFypoi>=yminANDypoi<=ymaxTHENout(xbeg+xoff,ypoi+yoff,subtext(emptyrec,xbeg,xend));FI;END PROCclearformula;PROCoutformula(INT CONSTxbeg,xend,ypoi,INT CONSTxoff,yoff):IFypoi>=yminANDypoi<=ymaxTHENinitformulaspaces;IFypoi>=scr.ybegANDypoi<=scr.yendTHENout(xbeg+xoff,ypoi+yoff,subtext(scr.rec[ypoi],xbeg,xend));FI;FI;END PROCoutformula;PROCoutformula(INT CONSTxbeg,ybeg,xend,yend,INT CONSTxoff,yoff,TEXT CONSTframe):IFxbeg>xendORxbeg>xmaxORxend<xminTHEN LEAVEoutformulaFI;IFybeg>yendORybeg>ymaxORyend<yminTHEN LEAVEoutformulaFI;INT VARypoi:=ybeg;IFybeg<yendTHENoutformula(xbeg,xend,ypoi,xoff,yoff,frame,1);ypoiINCR1;WHILEypoi<yendREPoutformula(xbeg,xend,ypoi,xoff,yoff,frame,4);ypoiINCR1;PER;outformula(xbeg,xend,ypoi,xoff,yoff,frame,7);ELSEoutformula(xbeg,xend,ypoi,xoff,yoff,frame,10);FI;END PROCoutformula;PROCoutformula(INT CONSTxbeg,xend,ypoi,xoff,yoff,TEXT CONSTframe,INT CONSTfp):IFypoi>=yminANDypoi<=ymaxTHENinitformulaspaces;IFypoi>=scr.ybegANDypoi<=scr.yendTHENrec:=scr.rec[ypoi];ELSErec:=emptyrec;FI;replace(rec,xbeg,xend," ",frameSUBfp+1);replace(rec,xend,frameSUBfp+2);replace(rec,xbeg,frameSUBfp);out(xbeg+xoff,ypoi+yoff,subtext(rec,xbeg,xend));FI;END PROCoutformula;PROCreplace(TEXT VARrec,INT CONSTb,e,TEXT CONSTold,new):INT CONSTl:=LENGTHold;IFl<>LENGTHnewTHEN LEAVEreplaceFI;INT VARp:=pos(rec,old,b,e);WHILEp>0REPreplace(rec,p,new);p:=pos(rec,old,p+l,e)PER;END PROCreplace;PROCout(INT CONSTxcur,ycur,
TEXT CONSTrec):cursor(xcur,ycur);out(rec);END PROCout;PROCcatexpr(TEXT VARrec,INT CONSTadrb,adr1,adr2,adre):INT VARadr;initformulaspaces;IFadr1=adr2THENrecCAT"  ";FORadrFROMadrbUPTOadr1-1REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr1UPTOadr2REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr2+1UPTOadreREPrecCATname(mem.trm,adr)PER;recCAT"  ";ELSErecCAT" ";FORadrFROMadrbUPTOadr2REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr2+1UPTOadr1-1REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr1UPTOadreREPrecCATname(mem.trm,adr)PER;recCAT" ";FI;END PROCcatexpr;END PACKETformulaanalyzer;