/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */
/* nwise APL2 V1.0.0 ***************************************************
* Called from reducef to handle N-Wise Reduce. *
***********************************************************************/
#define INCLUDES APLCHDEF+FUNCODES+FUNSTRUC+APLDERIV+APLCB
#include "includes.h"
Aplcb nwise(dp,left,rite,axis)
Aplderiv dp; /* function describing derived function */
Aplcb left,rite; /* arguments */
int axis;
{
Aplcopy; Axispre; Errinit; Errstop; Getcb; Intcopy; Integer; Real;
typedef void (*Pep)(void*,void*,void*);
Aplcb nwisec(void *, int, int, Aplcb, int, int, int, int, int, int);
Aplcb nwised(void *, int, int, int, Aplcb, int, int, int, int, int, int);
Pep pep=NULL;
extern int aplerr, indxorg;
Aplcb out=NULL;
int axicnt,botcnt,code,datacnt,datatyp,err=0,i,intype,*ip,j,lef,labs,
naxicnt,outype,topcnt;
void *fun;
for (;;) { /* lets me use break */
if (errinit()) break;
if (!(left->aplflags & APLINT)) left = integer(left);
if (left == NULL) break;
if (left->aplcount != 1) { err = 126; break; }
lef = *(left->aplptr.aplint);
axis += (indxorg == 0); /* force to relative 1 */
if (OK != axispre(rite,axis,&axicnt,&botcnt,&topcnt)) break;
labs = (lef > 0) ? lef : -lef;
if (labs > axicnt) { err = 126; break; }
if (labs == 1) { /* special case */
out = aplcopy(rite);
out->aplflags |= APLTEMP;
break;
}
naxicnt = 1 + axicnt - labs;
datacnt = topcnt * naxicnt * botcnt;
fun = dp->deriv_left.fun;
i = ((Codes *)fun)->funky_flags;
j = dp->deriv_left.funcode;
if ((rite->aplflags & APLAPL) ||
!(j == FUNCTION_TOKEN && (i==SCMD || i==SCDO || i==EQNE)))
out = nwised(fun,j,lef,labs,rite,axis,
axicnt,botcnt,topcnt,naxicnt,datacnt);
else out = nwisec(fun,lef,labs,rite,axis,
axicnt,botcnt,topcnt,naxicnt,datacnt);
rite = NULL;
break;
}
return(errstop(err,left,rite,out));
}