Mercurial > hg > jgplsrc
view p.c @ 0:e0bbaa717f41 draft default tip
lol J
author | Jordi Gutiérrez Hermoso <jordigh@octave.org> |
---|---|
date | Mon, 25 Nov 2013 11:56:30 -0500 |
parents | |
children |
line wrap: on
line source
/* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */ /* License in license.txt. */ /* */ /* Parsing; see APL Dictionary, pp. 12-13 & 38. */ #include "j.h" #include "p.h" /* NVR - named value reference */ /* a value referenced in the parser which is the value of a name */ /* (that is, in some symbol table). */ /* */ /* jt->nvra NVR stack a: stack of A values */ /* jt->nvrav AAV(jt->nvra) */ /* jt->nvrb NVR stack b: corresponding to stack a -- */ /* 1 if unchanged; 0 if redefined */ /* jt->nvrbv BAV(jt->nvrb) */ /* jt->nvrtop index of top of stack */ /* */ /* Each call of the parser records the current NVR stack top (nvrtop), */ /* (nvrtop), and pop stuff off the stack back to that top on exit */ /* */ /* nvrpush(w): w is a named value just moved from the parser queue */ /* to the parser stack. Push w onto the NVR stack. */ /* nvrpop(otop): pop stuff off the NVR stack back to the old top otop */ /* nvrredef(w): w is the value of a name about to be redefined */ /* (reassigned or erased). checks whether w is in the */ /* NVR stack */ B jtparseinit(J jt){A x; GA(x,INT,20,1,0); ra(x); jt->nvra=x; jt->nvrav=AAV(x); GA(x,B01,20,1,0); ra(x); jt->nvrb=x; jt->nvrbv=BAV(x); R 1; } static F1(jtnvrpush){ if(jt->nvrtop==AN(jt->nvra)){ RZ(jt->nvra=ext(1,jt->nvra)); jt->nvrav=AAV(jt->nvra); while(AN(jt->nvrb)<AN(jt->nvra))RZ(jt->nvrb=ext(1,jt->nvrb)); jt->nvrbv=BAV(jt->nvrb); } jt->nvrav[jt->nvrtop]=w; jt->nvrbv[jt->nvrtop]=1; ++jt->nvrtop; R w; } static void jtnvrpop(J jt,I otop){A*v=otop+jt->nvrav;B*b=otop+jt->nvrbv; DO(jt->nvrtop-otop, if(!*b++)fa(*v); ++v;); jt->nvrtop=otop; } void jtnvrredef(J jt,A w){A*v=jt->nvrav;B*b=jt->nvrbv; DO(jt->nvrtop, if(w==*v++){if(b[i]){ra(w); b[i]=0;} break;}); } /* stack handling for w which is about to be redefined */ ACTION(jtmonad ){R dfs1(stack[e],stack[b]);} ACTION(jtdyad ){R dfs2(stack[b],stack[e],stack[1+b]);} ACTION(jtadv ){R dfs1(stack[b],stack[e]);} ACTION(jtconj ){R dfs2(stack[b],stack[e],stack[1+b]);} ACTION(jttrident){R folk(stack[b],stack[1+b],stack[e]);} ACTION(jtbident ){R hook(stack[b],stack[e]);} ACTION(jtpunc ){R stack[e-1];} static ACTION(jtmove){A z; z=stack[MAX(0,e)]; if(!(NAME&AT(z))||ASGN&AT(stack[b]))R z; RZ(z=jt->xdefn&&NMDOT&NAV(z)->flag?symbrd(z):nameref(z)); R nvrpush(z); } static F2(jtisf){R symbis(onm(a),CALL1(jt->pre,w,0L),jt->symb);} ACTION(jtis){A f,n,v;B ger=0;C c,*s; n=stack[b]; v=stack[e]; if(LIT&AT(n)&&1>=AR(n)){ ASSERT(1>=AR(n),EVRANK); s=CAV(n); ger=CGRAVE==*s; RZ(n=words(ger?str(AN(n)-1,1+s):n)); if(1==AN(n))RZ(n=head(n)); } ASSERT(AN(n)||!IC(v),EVILNAME); f=stack[1+b]; c=*CAV(f); jt->symb=jt->local&&c==CASGN?jt->local:jt->global; if(NAME&AT(n)) symbis(n,v,jt->symb); else if(!AR(n))symbis(onm(n),v,jt->symb); else {ASSERT(1==AR(n),EVRANK); jt->pre=ger?jtfxx:jtope; rank2ex(n,v,0L,-1L,-1L,jtisf);} jt->symb=0; RNE(v); } #define AVN ( ADV+VERB+NOUN) #define CAVN (CONJ+ADV+VERB+NOUN) #define EDGE (MARK+ASGN+LPAR) PT cases[] = { EDGE, VERB, NOUN, ANY, jtmonad, jtvmonad, 1,2,1, EDGE+AVN, VERB, VERB, NOUN, jtmonad, jtvmonad, 2,3,2, EDGE+AVN, NOUN, VERB, NOUN, jtdyad, jtvdyad, 1,3,2, EDGE+AVN, VERB+NOUN, ADV, ANY, jtadv, jtvadv, 1,2,1, EDGE+AVN, VERB+NOUN, CONJ, VERB+NOUN, jtconj, jtvconj, 1,3,1, EDGE+AVN, VERB+NOUN, VERB, VERB, jttrident, jtvfolk, 1,3,1, EDGE, CAVN, CAVN, ANY, jtbident, jtvhook, 1,2,1, NAME+NOUN, ASGN, CAVN, ANY, jtis, jtvis, 0,2,1, LPAR, CAVN, RPAR, ANY, jtpunc, jtvpunc, 0,2,0, }; F1(jtparse){A*u,*v,y,z;I n; RZ(w); n=AN(w); v=AAV(w); GA(y,BOX,5+n,1,0); u=AAV(y); RZ(deba(DCPARSE,0L,w,0L)); *u++=mark; DO(n, *u++=*v++;); *u++=mark; *u++=mark; *u++=mark; *u++=mark; z=parsea(y); debz(); R z; } F1(jtparsea){A*s,*stack,y,z;AF f;I b,*c,e,i,j,k,m,n,otop=jt->nvrtop,*sp; RZ(w); n=m=AN(w)-4; stack=AAV(w); jt->asgn=0; ++jt->parsercalls; if(1>=n)R mark; RZ(y=IX(AN(w))); sp=AV(y); /* current location in tokens */ do{ for(i=0;i<NCASES;i++){ c=cases[i].c; s=n+stack; if(*c++&AT(*s++)&&*c++&AT(*s++)&&*c++&AT(*s++)&&*c++&AT(*s++)) break; } if(i<NCASES){ b=cases[i].b; j=n+b; e=cases[i].e; k=n+e; jt->sitop->dci=sp[k]=sp[n+cases[i].k]; f=cases[i].f; jt->asgn=f==jtis; stack[k]=y=f(jt,j,k,stack); DO(b, stack[--k]=stack[--j]; sp[k]=sp[j];); n=k; }else{ jt->sitop->dci=sp[MAX(0,n-1)]=sp[MAX(0,m-1)]; stack[n-1]=y=move(n,m-1,stack); n-=0<m--; }} while(y&&0<=m); nvrpop(otop); RZ(y); z=stack[1+n]; ASSERT(AT(z)&MARK+CAVN&&AT(stack[2+n])&MARK,EVSYNTAX); R z; } /* locals in parsea */ /* b: beginning index in stack that action applies to */ /* c: temp on cases[] used to match 4-patterns */ /* e: ending index in stack that action applies to */ /* f: current action */ /* i: index in cases[] of matching 4-pattern */ /* j: absolute index corresponding to b */ /* k: absolute index corresponding to e */ /* m: current # of words in the queue */ /* n: index of top of stack */ /* otop: old value of jt->nvrtop */ /* s: temp on stack used to match 4-patterns */ /* sp: index in original sentence of stack elements */ /* stack: parser stack as described in dictionary */ /* w: argument; contains both the queue and the stack */ /* y: array temp */ /* z: result */