/* Copyright (C) 1993 by Thomas Glen Smith.	All Rights Reserved. */
/* eachmona APL2 V1.0.0 ************************************************
* Called from each to handle monadic each.						 *
***********************************************************************/
#define INCLUDES APLCHDEF+APLDERIV+APLCB
#include "includes.h"
Aplcb eachmona(dp,rite)
Aplderiv dp; /* function describing derived function */
Aplcb rite; /* arguments */
{
	Aplcopy; Eachalc; Eachdyah; Eachwrk; Enclose; Errstop; Execmonj;
	Execmons; First; Getcode; Mod; Perm; Temp; Transpos;
	extern int aplerr;
	Aplcb *cp, lit, out=NULL, wrk, wrkrite=NULL;
	int axis,code,i;
	sub_dyad ep;
	void *arg=NULL;
	deriv_type ptype;

	if (mod(dp->deriv_axis_dbl,1.0) != 0.0)
		return(errstop(9,NULL,rite,NULL)); /* invalid axis */
	ptype = execmons(dp->deriv_left.funcode,
		dp->deriv_left.fun, &arg, &ep);
	if (aplerr || (NULL == (out = eachalc(rite))))
		return(errstop(0,NULL,rite,NULL));
	if (rite->aplcount) { /* non-empty input */
		wrkrite = eachwrk(rite);
		if (aplerr)
			return(errstop(0, wrkrite, rite, out));
		if (dp->deriv_left.funcode == DERIVED_FUNCTION)
			((Aplderiv)(dp->deriv_left.fun))->deriv_flags |= DERPERM;
		for (i=0, cp = out->aplptr.aplapl; i < out->aplcount; i++) {
			if (aplerr) *cp++ = NULL;
			else {
				wrk = execmonj(ptype, dp->deriv_left.fun, arg, ep,
					eachdyah(i, rite, wrkrite), dp->deriv_axis_cb);
				if (wrk == NULL) *cp++ = NULL;
				else if (wrk->aplflags & APLTEMP) *cp++ = perm(wrk);
				else *cp++ = aplcopy(wrk);
			}
		}
		if (dp->deriv_left.funcode == DERIVED_FUNCTION)
			((Aplderiv)(dp->deriv_left.fun))->deriv_flags -= DERPERM;
	}
	else if (dp->deriv_left.funcode == FUNCTION_TOKEN &&
		((Codes *)dp->deriv_left.fun)->funky_code == DOMINO)
		return(errstop(0,NULL,NULL,enclose(transpos(NULL,first(rite)),NULL)));
	else aplerr=999; /* empty input - do later */
	if (wrkrite) endoper(temp(wrkrite));
	return(errstop(0,NULL,rite,out));
}