use Array: all; use SimplePrint: all; use SimpleFibre: all; use Math: all; use String:{tochar}; import Char:all; use Bits:all; /* % This is the APEX stdlib.sis include file. % Standard equates and constants for APL compiler % Also standard coercion functions */ #define toB(x) tob((x)) #define toI(x) toi((x)) #define toD(x) tod((x)) #define toC(x) (x) #define toc(x) ((x)) void APEXERROR(char[.] msg) { /* Error function. This needs work, as it should kill * the running task, too. */ /*print(msg); */ return(); } /* Structural function utility functions */ /* Ravel utility */ #define APEXRavel(y) (reshape([prod(shape(y))],y)) inline int VectorRotateAmount(int x, int y) { /* Normalize x rotate for array of shape y on selected axis */ /* normalize rotation count */ if (x>0) z = _mod_(x,y); else z = y - _mod_(_abs_(x),y); return(z); } #define APEXRESHAPE(TYPE) \ inline TYPE[*] APEXReshape(int[.] x, TYPE[*] y) \ { /* APEX vector x reshape, with item reuse */ \ ry = APEXRavel(y); \ zxrho = prod(x); /* THIS NEEDS XRHO FOR CODE SAFETY!! */ \ yxrho = shape(ry)[0]; \ if( zxrho <= yxrho) { /* No element resuse case */ \ z = take([zxrho],ry); \ } else { \ ncopies = zxrho/yxrho; /* # complete copies of y. */ \ /* FIXME: y empty case !*/ \ z = with(. <= [i] <= .) \ genarray( [ncopies], y,y); \ /* Now append the leftover bits */ \ z = APEXRavel(z) ++ take([zxrho-(ncopies*yxrho)],ry); \ } \ return(reshape(x,z)); \ } APEXRESHAPE(bool) APEXRESHAPE(int) APEXRESHAPE(double) APEXRESHAPE(char) inline bool SameShape(int[*] x, int[*] y) { /* Predicate for two shape vectors having same shape */ if (dim(x) != dim(y)) z = false; else z = with ([0] <= i < [dim(y)]) fold(dandBBB, true, (shape(x))[i] == (shape(y))[i]); return(z); } #define APEXmiota(N) with (. <= [iv] <= .) genarray([N], iv) #define APEXPI 3.1415926535897932d #define APEXE 2.718281828d /* APEXPINFINITYI largest integer */ #define APEXPINFINITYD 1.7976931348623156D308 /* APEXMINFINITYI smallest integer */ #define APEXMINFINITYD -1.7976931348623156D308 /* % Floating-point utilities % This taken from page 93 of the 1993-01-06 version % of Committee Draft 1 of the Extended ISO APL Standard % NO {quad}ct support yet! */ inline int Dsignum(double y) { /* signum double */ if (0.0 == y) z = 0; else if (0.0 > y) z = -1; else z = 1; return(z); } inline int Isignum(int y) { /* signum int */ if (0 == y) z = 0; else if (0 > y) z = -1; else z = 1; return(z); } inline double Dresidue(double x, double y, double QUADct) { /* Double residue double */ /* See Iresidue for definition */ if (0.0 == x) nx = 1.0; else nx = x; z = y - x * Dfloor(y/nx, QUADct); return(z); } inline int Iresidue(int x, int y) { /* Integer residue integer */ /* This definition is taken from SHARP APL Refman May 1991, p.6-26. * It extends the definition of residue to fractional right arguments * and to zero, negative and fractional left arguments. * r= y-x times floor y divide x+0=x */ if (0 == x) nx = 1; else nx = x; z = y - x * (y/nx); return(z); } inline double DfloorNoFuzz(double y) { /* Exact floor (no fuzz) */ return(floor(y)); } inline double Dfloor(double y, double QUADct) { /* Fuzzy floor */ /* Definition taken from SHARP APL Refman May 1991, p.6-23 * floor: n <- (signum y) times nofuzzfloor 0.5+abs y) * z <- n-(QUADct times 1 max abs y)<(n-y) */ n = DfloorNoFuzz(0.5+fabs(y)); if (y < 0.0) n = -n; else if (0.0 == y) n = 0.0; range = fabs(y); if (1.0 > range) range = 1.0; fuzzlim = QUADct*range; ny = n-y; if (fuzzlim < ny) z = n - 1.0; else z = n; return(z); } /* % 1996-12-07 Pearl Harbor Day. Try to fix bug in DBank infdivm % benchmark. (4 5 rho 6) + rank 1 (4 1 rho 7) introduces singleton % vectors into scalar fn calls. % Hence, we need support for singletons within scalar fns. % There is an similar, but independent, bug in rank support for % the extension case. */ /* vector-scalar simple search loops * This is origin-0 x1 iota y0 * cfn is comparator function type suffix to use, e.g, b,i,d,c, */ #define FindFirst(x,y,cfn,QUADct) \ sx = shape(x)[0]; \ z = sx; /* if not found */ \ for(i=0; iy[i]; i=shp; } return(z); } inline bool comparatorfnb(bool x, bool y,double QUADct) { /* Boolean comparator */ z = (x == y); return(z); } inline bool comparatorfni(int x, int y, double QUADct) { /* integer comparator */ z = (x == y); return(z); } inline bool comparatorfnd(double x, double y, double QUADct) { /* double comparator with fuzz */ L = _abs_(x-y); /* Tolerant equality */ R = QUADct*max(_abs_(x),_abs_(y)); z = (L <= R); return(z); } inline bool comparatorfnc(char x, char y,double QUADct) { /* char comparator */ z = (x == y); return(z); } inline bool comparatorfndnf(double x,double y, double QUADct) { /* double comparator, no fuzz */ z = (x == y); return(z); } /* Lehmer's random number generator */ #define lehmer(qrl) mod(qrl*16807,2147483647) /* Transposes */ #define APEXTRANSPOSE(TYPE,OTFILL) \ inline TYPE[*] APEXTranspose(TYPE[*] y) \ { \ z = with(iv) \ ( . <= iv <= .) : y[reverse( iv)]; \ genarray( reverse( shape(y)), OTFILL); \ return(z); \ } APEXTRANSPOSE(bool,false) APEXTRANSPOSE(int,0) APEXTRANSPOSE(double,0.0) APEXTRANSPOSE(char,' ') /* End of transposes */ /* End of boilerplate */ /* % Dyadic Scalar Function kernel macro definitions % These are included in all generated code % Function names are defined as: % {valence, jsymbol, compute type, result type} % Having result type available will let us support things like % int*int where we know result will be integer, rather than being % required to support double_real result. 1996-05-05 */ /* x plus y */ #define dplusBBI(XV,YV) (toi(XV)+toi(YV)) #define dplusBII(XV,YV) (toi(XV)+YV) #define dplusIBI(XV,YV) (XV+toi(YV)) #define dplusIII(XV,YV) (XV+YV) #define dplusDDD(XV,YV) (XV+YV) #define dplusBDD(XV,YV) (tod(XV)+YV) #define dplusDBD(XV,YV) (XV+tod(YV)) #define dplusIDD(XY,YV) (tod(XV)+YV) #define dplusDID(XV,YV) (XV+tod(YV)) /* x minus y */ #define dbarBBI(XV,YV) (toi(XV)-toi(YV)) #define dbarIBI(XV,YV) (XV-toi(YV)) #define dbarBII(XV,YV) (XV-YV) #define dbarIII(XV,YV) (XV-YV) #define dbarIDD(XV,YV) (tod(XV)-YV) #define dbarDID(XV,YV) (XV-tod(YV)) #define dbarDDD(XV,YV) (XV-YV) #define dbarBDD(XV,YV) (tod(XV)-YV) #define dbarDBD(XV,YV) (XV-tod(YV)) /* x times y */ #define dmpyBBB(XV,YV) (XV&YV) #define dmpyIII(XV,YV) (XV*YV) #define dmpyDDD(XV,YV) (XV*YV) #define dmpyBII(XV,YV) (toi(XV)*YV) #define dmpyIBI(XV,YV) (XV*toi(YV)) #define dmpyBDD(XV,YV) (tod(XV)*YV) #define dmpyDBD(XV,YV) (XV*tod(YV)) #define dmpyDID(XV,YV) (XV*tod(YV)) #define dmpyIDD(XV,YV) (tod(XV)*YV) /* x divided by y */ inline double APEX_DIVIDEDD (double X, double Y) { if (X == Y) z = 1.0d; else z = X/Y; return(z); } #define ddivBDD(XV,YV) (APEX_DIVIDEDD(XV,YV)) #define ddivIDD(XV,YV) (APEX_DIVIDEDD(XV,YV)) #define ddivDDD(XV,YV) (APEX_DIVIDEDD(XV,YV)) #define ddivBID(XV,YV) (APEX_DIVIDEDD(XV,YV)) #define ddivIID(XV,YV) (APEX_DIVIDEDD(XV,YV)) #define ddivDID(XV,YV) (APEX_DIVIDEDD(XV,YV)) #define ddivBBD(XV,YV) (APEX_DIVIDEDD(XV,YV)) #define ddivIBD(XV,YV) (APEX_DIVIDEDD(XV,YV)) #define ddivDBD(XV,YV) (APEX_DIVIDEDD(XV,YV)) /* x min y */ inline int APEX_MINII (int x, int y) { if (x <= y) z = x; else z = y; return (z); } inline char APEX_MINCC (char x, char y) { if (x <= y) z = x; else z = y; return (z); } inline double APEX_MINDD (double x, double y) { if (x <= y) z = x; else z = y; return (z); } #define dminBBB(XV,YV) (XV&YV) #define dminIII(XV,YV) (APEX_MINII(XV,YV)) #define dminDDD(XV,YV) (APEX_MINDD(XV,YV)) #define dminCCC(XV,YV) (APEX_MINCC(XV,YV)) #define dminBII(XV,YV) (APEX_MINII(toi(XV),YV)) #define dminIBI(XV,YV) (APEX_MINII(XV,toi(YV))) #define dminBDD(XV,YV) (APEX_MINDD(tod(XV),YV)) #define dminDBD(XV,YV) (APEX_MINDD(XV,tod(YV))) #define dminIDD(XV,YV) (APEX_MINDD(tod(XV),YV)) #define dminDID(XV,YV) (APEX_MINDD(XV,tod(YV))) /* NB. max and min extended to characters */ inline int APEX_MAXII (int x, int y) { if (x >= y) z = x; else z = y; return (z); } inline char APEX_MAXCC (char x, char y) { if (x >= y) z = x; else z = y; return (z); } inline double APEX_MAXDD (double x, double y) { if (x >= y) z = x; else z = y; return (z); } /* x max y */ #define dmaxBBB(XV,YV) (XV|YV) #define dmaxIII(XV,YV) (APEX_MAXII(XV,YV)) #define dmaxDDD(XV,YV) (APEX_MAXDD(XV,YV)) #define dmaxCCC(XV,YV) (APEX_MAXCC(XV,YV)) #define dmaxBII(XV,YV) (APEX_MAXII(toi(XV),YV)) #define dmaxIBI(XV,YV) (APEX_MAXII(XV,toi(YV))) #define dmaxBDD(XV,YV) (APEX_MAXDD(tod(XV),YV)) #define dmaxDBD(XV,YV) (APEX_MAXDD(XV,tod(YV))) #define dmaxIDD(XV,YV) (APEX_MAXDD(tod(XV),YV)) #define dmaxDID(XV,YV) (APEX_MAXDD(XV,tod(YV))) /* x mod y */ #define dmodBBB(XV,YV) ((~XV)&YV) #define dmodIII(XV,YV) (Iresidue(XV,YV)) #define dmodDDD(XV,YV,QUADct) (Dresidue(XV,YV,QUADct)) /* x star y */ #define dstarBBB(XV,YV) (XV|~YV) #define dstarIDD(XV,YV) (exp(XV,YV)) #define dstarDDD(XV,YV) (exp(XV,YV)) /* The dstari fragment will not work in integer type because EmitDyadicScalarFns % (and everyone else!) uses lhtype,rhtype to compute fragment % type. This fails for general star because we do not know that % the result type is going to be double_real, as we can not % ascertain that the right argument is positive. % Do it the slow way for now... 1995-11-18 % Actually, now that we have predicates, we can do better! 1996-04-30 */ #define dlogBDD(XV,YV) (log(YV)/log(XV)) #define dlogIDD(XV,YV) (log(YV)/log(XV)) #define dlogDDD(XV,YV) (log(YV)/log(XV)) /* NB. Extension of ISO APL to allow comparison of characters */ /* relationals */ #define dltBBB(XV,YV) ((~XV)&YV) #define dltIBB(XV,YV) (XVYV) #define dgtDDB(XV,YV,QUADct) (XV>YV) #define dgtCCB(XV,YV) (XV>YV) #define dgeBBB(XV,YV) (XV|~YV) #define dgeIIB(XV,YV) (XV>=YV) #define dgeDDB(XV,YV,QUADct) (XV>=YV) #define dgeCCB(XV,YV) (XV>=YV) /* Boolean functions */ inline bool dorBBB(bool x, bool y) { return(x | y); } inline bool dandBBB(bool x, bool y) { return(x&y); } /* As of 2004-09-16, we don't support lcm/gcd. Needs work in code generator and dfa to support side effects in scan, etc. rbe */ /* Euclids algorithm for lcm */ #define dandII(XV,YV) (for initial ax := abs(XV); ay := abs(YV); \ u = min(ax,ay); v := max (ax,ay); \ while (v ~= 0) repeat \ v := mod(old u,old v); \ u := old v; \ returns value of (ax*ay)/u \ end for) /* Euclids algorithm for lcm */ #define dandDD(XV,YV) (for initial ax := abs(XV); ay := abs(YV); \ u = min(ax,ay); v := max (ax,ay); \ while (v ~= 0) repeat \ v := mod(old u,old v); \ u := old v; \ returns value of (ax*ay)/u \ end for) /* Euclids algorithm for gcd */ #define dorII(XV,YV) (for initial \ ax := abs(XV); ay := abs(YV); \ u = min(ax,ay); v := max (ax,ay); \ while (v ~= 0) repeat \ v := mod(old u,old v); \ u := old v; \ returns value of u \ end for) /* Euclids algorithm for gcd */ #define dorDDD(XV,YV) (for initial \ ax := abs(XV); ay := abs(YV); \ u = min(ax,ay); v := max (ax,ay); \ while (v ~= 0) repeat \ v := mod(old u,old v); \ u := old v; \ returns value of u \ end for) #define dnandBBB(XV,YV) (~XV&YV) #define dnorBBB(XV,YV) (~XV|YV) #define dcircDDD(XV,YV) (if (XV = 1.0d) then sin(YV) \ elseif (XV = 2.0d) then cos(YV) \ elseif (XV = 3.0d) then tan(YV) \ elseif (XV = 4.0d) then exp((1.0d+YV*YV),0.5d) \ else error[double_real] end if) /* domain error check above */ /* 1 circle */ #define dcirc1DDD(XV,YV) (sin(YV)) /* 2 circle */ #define dcirc2DDD(XV,YV) (cos(YV)) /* 3 circle */ #define dcirc3DDD(XV,YV) (tan(YV)) /* 3 circle */ #define dcirc4DDD(XV,YV) (exp((1.0d+YV*YV),0.5d)) inline bool[+] neBBB(bool[+] x, bool[+] y) { /* AxA Dyadic scalar fn, shapes unknown, shapes may or may not match */ /* Insert length error checking code here!! */ z = with( . <= iv <= .) { xel = toB(x[iv]); yel = toB(y[iv]); } genarray(shape(x), dneBBB(xel,yel),false); return(z); } inline int plusIIIsl(int x, int y) { /* SxS dyadic scalar fn, shapes match */ z = dplusIII(toI(x),toI(y)); return(z); } inline bool[+] andBBBsx(bool x, bool[+] y) { /* SxA scalar function */ xel = toB(x); z = with( . <= iv <= .) { yel = toB(y[iv]); } genarray(shape(y), dandBBB(xel,yel),false); return(z); } inline int[+] plusIIIsx(int x, int[+] y) { /* SxA scalar function */ xel = toI(x); z = with( . <= iv <= .) { yel = toI(y[iv]); } genarray(shape(y), dplusIII(xel,yel),0); return(z); } inline bool[+] andBBBsl(bool[+] x, bool[+] y) { /* AxA Dyadic scalar fn, shapes unknown, but known to match */ z = with( . <= iv <= .) { xel = toB(x[iv]); yel = toB(y[iv]); } genarray(shape(x), dandBBB(xel,yel),false); return(z); } inline int[+] modIIIsx(int x, int[+] y) { /* SxA scalar function */ xel = toI(x); z = with( . <= iv <= .) { yel = toI(y[iv]); } genarray(shape(y), dmodIII(xel,yel),0); return(z); } inline bool[+] eqBIBsx(bool x, int[+] y) { /* SxA scalar function */ xel = toI(x); z = with( . <= iv <= .) { yel = toI(y[iv]); } genarray(shape(y), deqIIB(xel,yel),false); return(z); } inline bool eqIIBsl(int x, int y) { /* SxS dyadic scalar fn, shapes match */ z = deqIIB(toI(x),toI(y)); return(z); } inline int plusBBIsl(bool x, bool y) { /* SxS dyadic scalar fn, shapes match */ z = dplusIII(toI(x),toI(y)); return(z); } inline bool[+] tranXBB(bool[+] y) { z = { [i,j] -> y[j,i] }; return(z); } inline bool[.] comaXBB(bool[+] y) { /* Ravel of anything of rank>1 */ z = _reshape_([prod(shape(y))],y); return(z); } inline bool[+] rotrXBB(bool[+] y) { /* First axis reverse on anything; vector reverse */ n = shape(y)[0]; cell = genarray(_drop_SxV_(1,shape(y)), false); z = with( . <= iv <= .) genarray([n], y[(n-1)-iv],cell); return(z); } inline bool[+] rotrXBB(bool[+] y) {/* Last axis reverse on rank>1 */ n = shape(y)[dim(y)-1]; cell = genarray([n], false); frame = drop([-1],shape(y)); z = with( . <= iv <= .) genarray(frame, y[(n-1)-iv],cell); return(z); } inline bool[+] rot1XBB(bool[+] y) { /* First axis reverse on anything; vector reverse */ n = shape(y)[0]; cell = genarray(_drop_SxV_(1,shape(y)), false); z = with( . <= iv <= .) genarray([n], y[(n-1)-iv],cell); return(z); } inline bool[+] tranXBB(bool[+] y) { z = APEXTranspose(y); return(z); } inline bool[*] tranIBB(int[.] x, bool[*] y) { /* General case of dyadic transpose. no dups in x! */ /* Someone has to validate x here! FIXME */ shpy = shape(y); wts = drop([1],shpy)++[1]; rankz = -1; for(i=shape(shpy)[0]-2; i>=0; i--){ /* times scan the hard way */ wts[i] = wts[i+1]*wts[i]; rankz = max(rankz,x[i]); } shpz = genarray([1+rankz],-1); weights = genarray([1+rankz],prod(shpy)); for(i=dim(y)-1; i>=0; i--){ shpz[x[i]] = shpy[i]; weights[x[i]] = min(weights[x[i]], wts[i]); } cp = CartProdPlus(weights, shpz); z = with(. <= iv <= .) genarray(shape(cp), (APEXRavel(y))[iv]); z = reshape(shpz,z); return(z); } inline int[.] CartProdPlus(int[.] weights, int[.] lengths) { /* Cartesian product, sum-like, for weights+each iota each lengths */ /* Weight and length vectors must be same length, and non-empty */ s = shape(weights)[0]; if (0 == s) z = s; else z = weights[0] * APEXmiota(lengths[0]); for(i=1; i=0; i--) weights[i]= weights[i+1]*toI(x); /* Now, we just do weights +.* y */ z = with([0] <= iv < ycols) fold(+, 0, weights[iv] * toI(y[iv])); return(z); } inline int[+] dtakIBI(int x, bool[+] y) { /* Scalar basevalue rank>1 */ yt = APEXTranspose(y); /* Dumb, but easy */ ycols=shape(y)[dim(y)-1]; cellshape=take([1],shape(y)); cell= genarray(cellshape, 0); frameshape = drop([1],shape(y)); weights = genarray(cellshape, toI(1)); for (i=ycols-2; i>=0; i--) weights[i]= weights[i+1]*toI(x); z = with(. <= iv <= .) genarray(frameshape, with([0] <= jv < cellshape) fold(+, 0, weights[jv] * toI(yt[iv++jv])),cell); return(z); } inline bool[*] indrfr(int fr, int[*] i, bool[+] X) { /* X[;;;i;;;], where i has fr semicolons to its left */ /* Indexing is origin-0. Caller will correct this */ /* This could stand some optimization, perhaps, for boolean i, * unless SAC avoids building an array-valued temp of toI(i). */ cellshape = shape(i)++_drop_SxV_(fr+1,shape(X)); cell = genarray(cellshape,false); /* not used, but SAC needs help */ frameshape = _take_SxV_(fr,shape(X)); z = with (. <= iv <= .) genarray(frameshape,indrfr0(i,X[iv]),cell); zshape = frameshape++cellshape; return(_reshape_(zshape,z)); } inline bool[*] indrfr0(int i, bool[*] X) { /* X[i;;;] i is scalar */ z = X[[i]]; return(z); } inline bool[*] indrfr0(int[*] i, bool[*] X) { /* X[im;;;] im is array */ cellshape = _drop_SxV_(1,shape(X)); cell = genarray(cellshape, false); raveli = APEXRavel(i); z = with (. <= iv <= .) genarray(shape(i), X[i[iv]],cell); /* Is next line needed? z = _reshape_(shape(i)++cellshape,z); */ return(z); } inline char[*] indrfr(int fr, int[*] i, char[+] X) { /* X[;;;i;;;], where i has fr semicolons to its left */ /* Indexing is origin-0. Caller will correct this */ /* This could stand some optimization, perhaps, for boolean i, * unless SAC avoids building an array-valued temp of toI(i). */ cellshape = shape(i)++_drop_SxV_(fr+1,shape(X)); cell = genarray(cellshape,' '); /* not used, but SAC needs help */ frameshape = _take_SxV_(fr,shape(X)); z = with (. <= iv <= .) genarray(frameshape,indrfr0(i,X[iv]),cell); zshape = frameshape++cellshape; return(_reshape_(zshape,z)); } inline char[*] indrfr0(int i, char[*] X) { /* X[i;;;] i is scalar */ z = X[[i]]; return(z); } inline char[*] indrfr0(int[*] i, char[*] X) { /* X[im;;;] im is array */ cellshape = _drop_SxV_(1,shape(X)); cell = genarray(cellshape, ' '); raveli = APEXRavel(i); z = with (. <= iv <= .) genarray(shape(i), X[i[iv]],cell); /* Is next line needed? z = _reshape_(shape(i)++cellshape,z); */ return(z); } inline int[*] indrfr(int fr, int[*] i, int[+] X) { /* X[;;;i;;;], where i has fr semicolons to its left */ /* Indexing is origin-0. Caller will correct this */ /* This could stand some optimization, perhaps, for boolean i, * unless SAC avoids building an array-valued temp of toI(i). */ cellshape = shape(i)++_drop_SxV_(fr+1,shape(X)); cell = genarray(cellshape,0); /* not used, but SAC needs help */ frameshape = _take_SxV_(fr,shape(X)); z = with (. <= iv <= .) genarray(frameshape,indrfr0(i,X[iv]),cell); zshape = frameshape++cellshape; return(_reshape_(zshape,z)); } inline int[*] indrfr0(int i, int[*] X) { /* X[i;;;] i is scalar */ z = X[[i]]; return(z); } inline int[*] indrfr0(int[*] i, int[*] X) { /* X[im;;;] im is array */ cellshape = _drop_SxV_(1,shape(X)); cell = genarray(cellshape, 0); raveli = APEXRavel(i); z = with (. <= iv <= .) genarray(shape(i), X[i[iv]],cell); /* Is next line needed? z = _reshape_(shape(i)++cellshape,z); */ return(z); } inline bool[+] indsfr(int fr, int[*] i, bool[+] X, bool[+] Y) { /* X[;;;i;;;]<- nonscalar Y, where i has fr semicolons to its left */ cellshape = shape(i)++_drop_SxV_(fr+1,shape(X)); cell = genarray(cellshape,false); /* not used, but SAC needs help */ frameshape = _take_SxV_(fr,shape(X)); z = with (. <= iv <= .) genarray(frameshape,indsfr0(i,X[iv], Y[iv]),cell); zshape = frameshape++cellshape; return(_reshape_(zshape,z)); } inline bool[+] indsfr(int fr, int[*] i, bool[+] X, bool Y) { /* X[;;;i;;;]<- scalar Y, where i has fr semicolons to its left */ cellshape = shape(X); cell = genarray(cellshape,false); /* not used, but SAC needs help */ frameshape = _take_SxV_(fr,shape(X)); z = with (. <= iv <= .) genarray(frameshape,indsfr0(i,X[iv], Y),cell); zshape = frameshape++cellshape; return(_reshape_(zshape,z)); } inline bool[+] indsfr(int fr, int i, bool[+] X, bool Y) { /* X[;;;i;;;]<- scalar Y, where i has fr semicolons to its left */ cellshape = shape(X); cell = genarray(cellshape,false); frameshape = _take_SxV_(fr,shape(X)); z = with (. <= iv <= .) genarray(frameshape,indsfr0(i,X[iv], Y),cell); zshape = frameshape++cellshape; return(_reshape_(zshape,z)); } inline bool[+] indsfr0(int i, bool[+] X, bool Y) { /* Case 1. X[scalarI;;]<- scalarY NB. Leading axis */ cell = genarray(_drop_SxV_(1,shape(X)),tob(Y)); z = tob(X); z[[i]] = cell; return(z); } inline bool[+] indsfr0(int[.] iv, bool[+] X, bool Y) { /* 2. X[non-scalarIV;;]<- scalarY NB. Leading axis */ /* This would almost work under a with-loop, but the potential * for duplicates in iv scuppers that. Ergo, FOR loop. */ z = tob(X); cellshape = _drop_SxV_(1,shape(X)); cell = genarray (cellshape, tob(Y)); raveli = APEXRavel(iv); for(i=0; i