自学教程：C++ AR函数代码示例

// 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"}

static A jtcants(J jt,A a,A w,A z){A a1,q,y;B*b,*c;I*u,wr,zr;P*wp,*zp; RZ(a&&w&&z); RZ(a=grade1(a)); wr=AR(w); wp=PAV(w); a1=SPA(wp,a); zr=AR(z); zp=PAV(z); ASSERT(wr==zr,EVNONCE); RZ(b=bfi(wr,a1,1)); GA(q,B01,wr,1,0); c=BAV(q); u=AV(a); DO(wr, c[i]=b[u[i]];);

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 A jtipprep(J jt,A a,A w,I zt,I*pm,I*pn,I*pp){A z=mark;I*as,ar,ar1,m,mn,n,p,*ws,wr,wr1; ar=AR(a); as=AS(a); ar1=ar?ar-1:0; RE(*pm=m=prod(ar1,  as)); wr=AR(w); ws=AS(w); wr1=wr?wr-1:0; RE(*pn=n=prod(wr1,1+ws)); RE(mn=mult(m,n)); *pp=p=ar?*(as+ar1):wr?*ws:1; ASSERT(!(ar&&wr)||p==*ws,EVLENGTH); GA(z,zt,mn,ar1+wr1,0); ICPY(AS(z),      as,ar1); ICPY(AS(z)+ar1,1+ws,wr1); R z;}    /* argument validation & result for an inner product */

// Analysis for inner product// a,w are arguments// zt is type of result// *pm is # 1-cells of a// *pn is # atoms in an item of w// *pp is number of inner-product muladds//   (in each, an atom of a multiplies an item of w)static A jtipprep(J jt,A a,A w,I zt,I*pm,I*pn,I*pp){A z=mark;I*as,ar,ar1,m,mn,n,p,*ws,wr,wr1; ar=AR(a); as=AS(a); ar1=ar?ar-1:0; RE(*pm=m=prod(ar1,as));  // m=# 1-cells of a.  It could overflow, if there are no atoms wr=AR(w); ws=AS(w); wr1=wr?wr-1:0; RE(*pn=n=prod(wr1,1+ws)); RE(mn=mult(m,n));  // n=#atoms in 1-cell of w; mn = #atoms in result *pp=p=ar?*(as+ar1):wr?*ws:1;  // if a is an array, the length of a 1-cell; otherwise, the number of items of w ASSERT(!(ar&&wr)||p==*ws,EVLENGTH); GA(z,zt,mn,ar1+wr1,0);   // allocate result area ICPY(AS(z),      as,ar1);  // Set shape: 1-frame of a followed by shape of item of w ICPY(AS(z)+ar1,1+ws,wr1); R z;}    /* argument validation & result for an inner product */

static DF2(rank2) {    DECLF;    A h=sv->h;    I ar,l,r,*v=AV(h),wr;    RZ(a&&w);    ar=AR(a);    l=efr(ar,v[1]);    wr=AR(w);    r=efr(wr,v[2]);    R l<ar||r<wr?rank2ex(a,w,fs,l,r,f2):CALL2(f2,a,w,fs);}

// IRS setup for dyads x op y// a is x, w is y// fs is the f field of the verb (the verb to be applied repeatedly) - or 0 if none// l, r are nominal ranks of fs// f2 is a setup verb (jtover, jtreshape, etc)A jtirs2(J jt,A a,A w,A fs,I l,I r,AF f2){A z;I af,ar,*old=jt->rank,rv[2],wf,wr; // push the jt->rank (pointer to ranks) stack.  push/pop may not match, no problem RZ(a&&w); ar=AR(a); rv[0]=l=efr(ar,l); af=ar-l;  // get rank, effective rank, length of frame... wr=AR(w); rv[1]=r=efr(wr,r); wf=wr-r;     // ...for both args if(!(af||wf))R CALL2(f2,a,w,fs);   // if no frame, call setup verb and return result ASSERT(!ICMP(AS(a),AS(w),MIN(af,wf)),EVLENGTH);   // verify agreement /* if(af&&wf&&af!=wf)R rank2ex(a,w,fs,l,r,f2); */ jt->rank=rv; z=CALL2(f2,a,w,fs); jt->rank=old;   // save ranks, call setup verb, pop rank stack  // Not all setup verbs (*f2)() use the fs argument.   R z;}

AF jtatcompf(J jt,A a,A w,A self){AF f;I ar,at,m,wr,wt; RZ(a&&w); at=AT(a); ar=AR(a); wt=AT(w); wr=AR(w); m=VAV(self)->flag%256; if(1<ar||1<wr){if(32<=m&&m<=37||40<=m&&m<=45||48<=m&&m<=53)R(AF)jtfslashatg; RZ(7==m%8);} ASSERT(AN(a)==AN(w)||!ar||!wr||5<m%8,EVLENGTH); f=atcompX[m]; if(!f){  if(at&B01+INT+FL&&wt&B01+INT+FL)f=atcompxy[9*m+3*(at&B01?0:at&INT?1:2)+(wt&B01?0:wt&INT?1:2)];  else if(at&LIT&&wt&LIT)         f=atcompC[m];  else if(at&SBT&&wt&SBT)         f=atcompSB[m]; } R f;}    /* function table look-up for  comp i. 1:  and  i.&[email
C++ AR5416DESC函数代码示例
C++ AP_INIT_TAKE1函数代码示例