/* Copyright (C) 1993 by Thomas Glen Smith.	All Rights Reserved. */
/* nreduces APL2 V1.0.0 ************************************************
* Called by execdote. Identical in structure to reducesb, but produces *
* a nested result from nested input.                                   *
***********************************************************************/
#define INCLUDES APLCB+APLDERIV
#include "includes.h"
Aplcb nreduces(id,dp,rite,axis)
int id;		/* 1=reduce, 0=scan */
Aplderiv dp;	/* function describing reduce function */
Aplcb rite;	/* nested APL variable */
int axis;
{
	Aplcopy; Apltype; Execdyan; First; Errinit; Errstop; Perm; Reducecm;
	extern int aplerr;
	int axicnt,botcnt,topcnt;
	int i,j,k,m,n,p,q,r,tempsave,type;
	Aplcb *icp, *kp, *op, out, wrk;

	if (errinit())
		return(errstop(0,NULL,rite,NULL));
	out=reducecm(id,&id,rite,&axis,&axicnt,&botcnt,&topcnt,APLAPL);
	if (aplerr) return(NULL);
	n = (id) ? 1 : axicnt; /* n == 1 if reduce, axicnt if scan */
	if (out->aplcount) { /* 1 or more elements of output */
		op = out->aplptr.aplapl;
		if (0 == rite->aplcount) { /* is input empty? */
			tempsave = rite->aplflags & APLTEMP;
			rite->aplflags -= tempsave;
			for(i = out->aplcount; i; i--)
				*op++=perm(first(apltype(rite)));
			rite->aplflags += tempsave;
		}
		else {
			for (i=0; i<topcnt; i++) {
				icp=rite->aplptr.aplapl+(p=i*botcnt*axicnt);
				for (j=0; j<botcnt; j++)
					for (m=n; m>0; m--) {
						wrk=*(kp=icp+j+(axicnt-m)*botcnt);
						if (1 < (r = axicnt-m+1))
							for (k=1; k<r; k++)
								wrk=execdyan(
									dp->deriv_left.funcode,
									dp->deriv_left.fun,
									*(kp -= botcnt), wrk);
						if (wrk->aplflags & APLTEMP)
							wrk->aplflags -= APLTEMP;
						else wrk = aplcopy(wrk);
						if (id) *op++=wrk; /* reduce */
						else { /* bypass bug in compiler */
							q = p+j+(axicnt-m)*botcnt;
							*(op+q)=wrk;
						}
					}
			}
		}
	}
	return(errstop(0,NULL,rite,out));
}