Пример #1
0
// 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"
}
Пример #2
0
Файл: cr.c Проект: joebo/jgplsrc
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"
}
Пример #3
0
Файл: cg.c Проект: iocane/unbox
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););
Пример #4
0
Файл: xf.c Проект: donguinn/core
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 */
Пример #5
0
Файл: cr.c Проект: joebo/jgplsrc
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"
}
Пример #6
0
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);); 
Пример #7
0
Файл: vo.c Проект: EdKeith/core
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;);