// General setup for verbs with IRS that do not go through jtirs[12]
// A verb u["n] using this function checks to see whether it has multiple cells; if so,
// it calls here, giving a callback; we split the arguents into cells and call the callback,
// which is often the same original function that called here.
A jtrank2ex(J jt,A a,A w,A fs,I lr,I rr,AF f2){PROLOG(0042);A y,y0,ya,yw,z;B ab,b,wb;
C*u,*uu,*v,*vv;I acn,acr,af,ak,ar,*as,at,k,mn,n=1,p,q,*s,wcn,wcr,wf,wk,wr,*ws,wt,yn,yr,*ys,yt;
RZ(a&&w);
at=AT(a); wt=AT(w);
if(at&SPARSE||wt&SPARSE)R sprank2(a,w,fs,lr,rr,f2);
// ?r=rank, ?s->shape, ?cr=effective rank, ?f=#frame, ?b=relative flag, for each argument
ar=AR(a); as=AS(a); acr=efr(ar,lr); af=ar-acr; ab=ARELATIVE(a);
wr=AR(w); ws=AS(w); wcr=efr(wr,rr); wf=wr-wcr; wb=ARELATIVE(w);
if(!af&&!wf)R CALL2(f2,a,w,fs); // if there's only one cell, run on it, that's the result
// multiple cells. Loop through them.
// ?cn=number of atoms in a cell, ?k=#bytes in a cell, uv point to one cell before aw data
// Allocate y? to hold one cell of ?, with uu,vv pointing to the data of y?
RE(acn=prod(acr,as+af)); ak=acn*bp(at); u=CAV(a)-ak; NEWYA;
RE(wcn=prod(wcr,ws+wf)); wk=wcn*bp(wt); v=CAV(w)-wk; NEWYW;
// b means 'w frame is larger'; p=#larger frame; q=#shorter frame; s->larger frame
// mn=#cells in larger frame (& therefore #cells in result); n=# times to repeat each cell
// from shorter-frame argument
b=af<=wf; p=b?wf:af; q=b?af:wf; s=b?ws:as; RE(mn=prod(p,s)); RE(n=prod(p-q,s+q));
ASSERT(!ICMP(as,ws,q),EVLENGTH); // error if frames are not same as prefix
// Initialize y? to hold data for the first cell; but if ? is empty, set y? to a cell of fills
if(AN(a))MOVEYA else RZ(ya=reshape(vec(INT,acr,as+af),filler(a)));
if(AN(w))MOVEYW else RZ(yw=reshape(vec(INT,wcr,ws+wf),filler(w)));
#define VALENCE 2
#define TEMPLATE 0
#include "cr_t.h"
}
A jtrank1ex(J jt,A w,A fs,I mr,AF f1) {
PROLOG;
A y,y0,yw,z;
B wb;
C*v,*vv;
I k,mn,n=1,p,*s,wcn,wcr,wf,wk,wr,*ws,wt,yn,yr,*ys,yt;
RZ(w);
wt=AT(w);
if(wt&SPARSE)R sprank1(w,fs,mr,f1);
wr=AR(w);
ws=AS(w);
wcr=efr(wr,mr);
wf=wr-wcr;
wb=ARELATIVE(w);
if(!wf)R CALL1(f1,w,fs);
RE(wcn=prod(wcr,wf+ws));
wk=wcn*bp(wt);
v=CAV(w)-wk;
NEWYW;
p=wf;
s=ws;
RE(mn=prod(wf,ws));
if(AN(w))MOVEYW else RZ(yw=reshape(vec(INT,wcr,ws+wf),filler(w)));
#define VALENCE 1
#define TEMPLATE 0
#include "cr_t.h"
}
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 */
A jtrank2ex(J jt,A a,A w,A fs,I lr,I rr,AF f2) {
PROLOG;
A y,y0,ya,yw,z;
B ab,b,wb;
C*u,*uu,*v,*vv;
I acn,acr,af,ak,ar,*as,at,k,mn,n=1,p,q,*s,wcn,wcr,wf,wk,wr,*ws,wt,yn,yr,*ys,yt;
RZ(a&&w);
at=AT(a);
wt=AT(w);
if(at&SPARSE||wt&SPARSE)R sprank2(a,w,fs,lr,rr,f2);
ar=AR(a);
as=AS(a);
acr=efr(ar,lr);
af=ar-acr;
ab=ARELATIVE(a);
wr=AR(w);
ws=AS(w);
wcr=efr(wr,rr);
wf=wr-wcr;
wb=ARELATIVE(w);
if(!af&&!wf)R CALL2(f2,a,w,fs);
RE(acn=prod(acr,as+af));
ak=acn*bp(at);
u=CAV(a)-ak;
NEWYA;
RE(wcn=prod(wcr,ws+wf));
wk=wcn*bp(wt);
v=CAV(w)-wk;
NEWYW;
b=af<=wf;
p=b?wf:af;
q=b?af:wf;
s=b?ws:as;
RE(mn=prod(p,s));
RE(n=prod(p-q,s+q));
ASSERT(!ICMP(as,ws,q),EVLENGTH);
if(AN(a))MOVEYA else RZ(ya=reshape(vec(INT,acr,as+af),filler(a)));
if(AN(w))MOVEYW else RZ(yw=reshape(vec(INT,wcr,ws+wf),filler(w)));
#define VALENCE 2
#define TEMPLATE 0
#include "cr_t.h"
}
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););
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;);