Mercurial > hg > jgplsrc
diff cl.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 (2013-11-25) |
parents | |
children |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/cl.c @@ -0,0 +1,106 @@ +/* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */ +/* License in license.txt. */ +/* */ +/* Conjunctions: L: and S: */ + +#include "j.h" + + +static A jtlev1(J jt,A w,A self){A fs; + RZ(w&&self); + if(jt->lmon>=level(w)){fs=VAV(self)->f; R CALL1(VAV(fs)->f1,w,fs);} else R every(w,self,jtlev1); +} + +static A jtlev2(J jt,A a,A w,A self){A fs; + RZ(a&&w&&self); + switch((jt->lleft>=level(a)?2:0)+(jt->lright>=level(w))){ + case 0: R every2(a, w, self,jtlev2); + case 1: R every2(a, box(w),self,jtlev2); + case 2: R every2(box(a),w, self,jtlev2); + default: fs=VAV(self)->f; R CALL2(VAV(fs)->f2,a,w,fs); +}} + +static I jtefflev(J jt,I j,A h,A x){I n,t; n=*(j+AV(h)); R n>=0?n:(t=level(x),MAX(0,n+t));} + +static DF1(jtlcapco1){A z;I m;V*v=VAV(self); + RZ(w); + m=jt->lmon; jt->lmon=efflev(0L,v->h,w); + z=lev1(w,self); + jt->lmon=m; + R z; +} + +static DF2(jtlcapco2){A z;I l,r;V*v=VAV(self); + RZ(a&&w); + l=jt->lleft; jt->lleft =efflev(1L,v->h,a); + r=jt->lright; jt->lright=efflev(2L,v->h,w); + z=lev2(a,w,self); + jt->lleft =l; + jt->lright=r; + R z; +} + + +static F1(jtscfn){ + RZ(w); + if(jt->scn==AN(jt->sca)){RZ(jt->sca=ext(1,jt->sca)); jt->scv=AV(jt->sca);} + jt->scv[jt->scn++]=(I)w; + R zero; +} + +static A jtlevs1(J jt,A w,A self){A fs; + RZ(w&&self); + if(jt->lmon>=level(w)){fs=VAV(self)->f; R scfn(CALL1(VAV(fs)->f1,w,fs));}else R every(w,self,jtlevs1); +} + +static A jtlevs2(J jt,A a,A w,A self){A fs; + RZ(a&&w&&self); + switch((jt->lleft>=level(a)?2:0)+(jt->lright>=level(w))){ + case 0: R every2(a, w, self,jtlevs2); + case 1: R every2(a, box(w),self,jtlevs2); + case 2: R every2(box(a),w, self,jtlevs2); + default: fs=VAV(self)->f; R scfn(CALL2(VAV(fs)->f2,a,w,fs)); +}} + +static DF1(jtscapco1){A x,z=0;I m;V*v=VAV(self); + RZ(w); + m=jt->lmon; jt->lmon=efflev(0L,v->h,w); + GA(x,INT,100,1,0); jt->scv=AV(x); jt->sca=x; jt->scn=0; + ra(jt->sca); + x=levs1(w,self); + jt->lmon=m; + if(x)z=ope(vec(BOX,jt->scn,jt->scv)); + fa(jt->sca); + R z; +} + +static DF2(jtscapco2){A x,z=0;I l,r;V*v=VAV(self); + RZ(a&&w); + l=jt->lleft; jt->lleft =efflev(1L,v->h,a); + r=jt->lright; jt->lright=efflev(2L,v->h,w); + GA(x,INT,100,1,0); jt->scv=AV(x); jt->sca=x; jt->scn=0; + ra(jt->sca); + x=levs2(a,w,self); + jt->lleft =l; + jt->lright=r; + if(x)z=ope(vec(BOX,jt->scn,jt->scv)); + fa(jt->sca); + R z; +} + + +static A jtlsub(J jt,C id,A a,A w){A h,t;B b=id==CLCAPCO;I*hv,n,*v; + RZ(a&&w); + ASSERT(VERB&AT(a)&&NOUN&AT(w),EVDOMAIN); + n=AN(w); + ASSERT(1>=AR(w),EVRANK); + ASSERT(0<n&&n<4,EVLENGTH); + RZ(t=vib(w)); v=AV(t); + GA(h,INT,3,1,0); hv=AV(h); + hv[0]=v[2==n]; hv[1]=v[3==n]; hv[2]=v[n-1]; + R fdef(id,VERB, b?jtlcapco1:jtscapco1,b?jtlcapco2:jtscapco2, a,w,h, 0L, RMAX,RMAX,RMAX); +} + +F2(jtlcapco){R lsub(CLCAPCO,a,w);} +F2(jtscapco){R lsub(CSCAPCO,a,w);} +