Metropoli BBS
VIEWER: nwise.c MODE: TEXT (ASCII)
/* 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));
}
[ RETURN TO DIRECTORY ]