/* Copyright (C) 1993, 1998 by Thomas Glen Smith.  All Rights Reserved. */
/* creduces APL2 V1.0.1 ************************************************
* Called by creduce and cscan.                                         *
* Identical in structure to reducesb, but produces an integer result   *
* from character input.                                                *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb creduces(id,oper,identity,rite,axis)
int id;			/* 1=reduce, 0=scan */
int (*oper)(char,char);	/* operator */
void *identity;		/* identity value */
Aplcb rite;		/* operand */
int axis;		/* axis of reduction */
{
	Intcopy; Errinit; Errstop; Reducecm;
	extern int aplerr;
	int axicnt,botcnt,topcnt;
	int i,j,k,m,n,*op,p,q,type,wrk;
	char *icp,*kp;
	Aplcb out;

	if (errinit())
		return(errstop(0,NULL,rite,NULL));
	out=reducecm(id,identity,rite,&axis,&axicnt,&botcnt,&topcnt,
     	APLCHAR); /* reducecm may change to APLINT */
	if (aplerr) return(NULL);
	type = out->aplflags & APLMASK;
	if (type == APLCHAR && out->aplcount == 1 && rite->aplcount == 1) {
		*(out->aplptr.aplchar)=*(rite->aplptr.aplchar);
		return(errstop(0,NULL,rite,out));
	}
	n = (id) ? 1 : axicnt; /* n == 1 if reduce, axicnt if scan */
	if (out->aplcount) { /* 1 or more elements of output */
		op = out->aplptr.aplint;
		if (0 == rite->aplcount) /* is input empty? */
			op=intcopy(op,identity,out->aplcount,0);
		else {
			for (i=0; i<topcnt; i++) {
				icp=rite->aplptr.aplchar+(p=i*botcnt*axicnt);
				for (j=0; j<botcnt; j++)
					for (m=n; m>0; m--) {
						wrk=*(kp=icp+j+(axicnt-m)*botcnt);
						for (k=1; k<axicnt-m+1; k++)
							wrk=(*oper)(*(kp-=botcnt),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));
}