A jtfxeachv(J jt,I r,A w){A*wv,x,z,*zv;I n,wd; RZ(w); n=AN(w); wv=AAV(w); wd=(I)w*ARELATIVE(w); ASSERT(r>=AR(w),EVRANK); ASSERT(n,EVLENGTH); ASSERT(BOX&AT(w),EVDOMAIN); GA(z,BOX,n,AR(w),AS(w)); zv=AAV(z); DO(n, RZ(zv[i]=x=fx(WVR(i))); ASSERT(VERB&AT(x),EVDOMAIN););
static B jtixin(J jt,A w,I s,I*i,I*n){A in,*wv;I j,k,m,*u,wd; if(AT(w)&BOX){wv=AAV(w); wd=(I)w*ARELATIVE(w); RZ(in=vi(WVR(1))); k=AN(in); u=AV(in);} else{in=w; k=AN(in)-1; u=1+AV(in);} ASSERT(1>=AR(in),EVRANK); ASSERT(k&&k<=(n?2:1),EVLENGTH); j=u[0]; j=0>j?s+j:j; m=1==k?s-j:u[1]; ASSERT(0<=j&&(!n||j<s&&j+m<=s&&0<=m),EVINDEX); *i=j; if(n)*n=m; R 1; } /* process index file arg for index and length */
static I jtfdepger(J jt,A w){A*wv;I d=0,k,wd; wv=AAV(w); wd=(I)w*ARELATIVE(w); DO(AN(w), k=fdep(fx(WVR(i))); d=MAX(d,k););
/* Verbs: From & Associates. See Hui, Some Uses of { and }, APL87. */ #include "j.h" F1(jtcatalog){PROLOG(0072);A b,*wv,x,z,*zv;C*bu,*bv,**pv;I*cv,i,j,k,m=1,n,p,*qv,r=0,*s,t=0,*u,wd; F1RANK(1,jtcatalog,0); if(!(AN(w)&&AT(w)&BOX+SBOX))R box(w); n=AN(w); wv=AAV(w); wd=(I)w*ARELATIVE(w); DO(n, x=WVR(i); if(AN(x)){p=AT(x); t=t?t:p; ASSERT(H**O(t,p),EVDOMAIN); RE(t=maxtype(t,p));}); RE(t=maxtype(B01,t)); k=bp(t); GA(b,t,n,1,0); bv=CAV(b); GATV(x,INT,n,1,0); qv=AV(x); GATV(x,BOX,n,1,0); pv=(C**)AV(x); RZ(x=apv(n,0L,0L)); cv=AV(x); DO(n, x=WVR(i); if(TYPESNE(t,AT(x)))RZ(x=cvt(t,x)); r+=AR(x); qv[i]=p=AN(x); RE(m=mult(m,p)); pv[i]=CAV(x);); GATV(z,BOX,m,r,0); zv=AAV(z); s=AS(z); DO(n, x=WVR(i); u=AS(x); DO(AR(x),*s++=*u++;);); for(i=0;i<m;i++){ bu=bv-k; DO(n, MC(bu+=k,pv[i]+k*cv[i],k);); DO(n, j=n-1-i; if(qv[j]>++cv[j])break; cv[j]=0;); RZ(*zv++=ca(b)); } EPILOG(z); } #define SETJ(jexp) {j=(jexp); if(0<=j)ASSERT(j<p,EVINDEX) else{j+=p; ASSERT(0<=j,EVINDEX);}} #define IFROMLOOP(T) \ {T *v=(T*)wv,*x=(T*)zv; \
I level(A w){A*wv;I d,j,wd; if(!(AN(w)&&AT(w)&BOX+SBOX))R 0; d=0; wv=AAV(w); wd=(I)w*ARELATIVE(w); DO(AN(w), j=level(WVR(i)); if(d<j)d=j;);