/* Copyright (C) 1993 by Thomas Glen Smith.  All Rights Reserved. */
/* preduces APL2 V1.0.0 ************************************************
* Called by redscan.  Handles reduce and scan with procedure calls     *
* instead of functions to do scalar dyadic processes.                  *
***********************************************************************/
#define INCLUDES APLCB+APLDERIV+FUNSTRUC+FUNCODES
#include "includes.h"
Aplcb preduces(id,dp,rite,axis)
int id;        /* 1=reduce, 0=scan */
Aplderiv dp;   /* function describing reduce function */
Aplcb rite;    /* nested APL variable */
int axis;
{
     Allcopy; Convert; Dyadcom; Errinit; Errstop; Preducet; Reducecm;
     extern int aplerr;
     int axicnt,botcnt,itype,otype,rtype,topcnt;
     Aplcb out;
     SCALAR_PROC oper=NULL;
     Scalars *fun;
     double ddentity[2];
     char *identp,*tdata;
     int identity;

     if (errinit())
          return(errstop(0,NULL,rite,NULL));
     rtype = rite->aplflags & APLMASK;
     fun = dp->deriv_left.sdp;
	oper = dyadcom(fun, &itype, &otype, rtype, rtype);
     if (itype != rtype) rite = convert(rite,otype);
     if (aplerr) return(errstop(0,NULL,rite,NULL));
     if (otype == APLINT) {
     	identity = fun->dyad.identities.iid;
          identp = (char *)&identity;
     }
     else {	
	     ddentity[0] = fun->dyad.identities.did;
	     ddentity[1] = 0e0;
          identp = (char *)ddentity;
     }
     out=reducecm(id,ddentity,rite,&axis,&axicnt,&botcnt,&topcnt,otype);
     if (aplerr) return(NULL);
     if (out->aplcount) { /* 1 or more elements of output */
		if (0 == rite->aplcount) /* is input empty? */
			tdata = allcopy(out->aplptr.aplchar,
				identp,out->aplcount,0,itype,otype);
		else preducet(id,axicnt,botcnt,topcnt,itype,otype,rite,out,
			oper,identp);
     }
     return(errstop(0,NULL,rite,out));
}