/* Copyright (C) 1993 by Thomas Glen Smith.	All Rights Reserved. */
/* execdotf APL2 V1.0.0 ************************************************
* Called from execdot to do inner product when form is left lo.ro rite,*
* and lo is scalar dyadics, e.g. + and ro uses APL variables as args.  *
***********************************************************************/
#define INCLUDES APLCB+APLDERIV
#include "includes.h"
Aplcb execdotf(dp,left,rite)
Aplderiv dp; /* function describing derived function */
Aplcb left,rite;
{Disclose;Dtacopy;Errstop;Execdyan;Execdyas;Getcb;Innrcom;Perm;Reducef;
	Temp; extern int aplerr;
	int otyp=APLAPL,hit,i,j,k,n,rsw=1,laxcnt,laxis,lbot,linc,ltop,ltyp,
		raxcnt,rbot,rinc,rtop,rtyp;
	char *dout,*ip,*ld,*op,*rd;
	Aplcb *od,oh,out,oreal,wrkm,wrkl,wrkr;
	void *ro,(*opera)(),(*operb)(),*identity;
	Scalar_dyadics *lo;

	out = innrcom(3,left,rite,&laxis,&laxcnt,&lbot,&ltop,&linc,
		&raxcnt,&rbot,&rtop,&rinc,&otyp,&dout,&ld,&rd);
	if (out == NULL) return(NULL);
	dp->deriv_left.type = execdyas(dp->deriv_left.fun,
		&(dp->deriv_left.sdp),&(dp->deriv_left.func));
	od = out->aplptr.aplapl;
	for(;;) { /* Makes it easy to quit on error. */
		ltyp = left->aplflags & (APLMASK | APLAPL);
		rtyp = rite->aplflags & (APLMASK | APLAPL);
		wrkl = getcb(NULL,laxcnt,ltyp,1,NULL);
		wrkr = getcb(NULL,raxcnt,rtyp,1,NULL);
		if (aplerr) break;
		for (i=0; i<ltop; i++) { /* Once for each left vector. */
			dtacopy(wrkl->aplptr.aplvoid,ld+i*laxcnt*left->aplsize,
				laxcnt,1,ltyp);
			for (j=0; j<rbot; j++) { /* Once for each rite vector. */
				dtacopy(wrkr->aplptr.aplvoid,rd + (j*rite->aplsize),
					raxcnt,rbot,rtyp);
				*od++ = oh = perm(reducef(dp,NULL,
					execdyan(dp->deriv_rite.funcode,
						dp->deriv_rite.fun,wrkl,wrkr)));
				hit = 0;
				for (;;) {
					if (oh == NULL) break;
					if (oh->aplcount > 1) break;
					if (!(oh->aplflags & APL_REAL)) break;
					hit = 1;
					break; /* final break from for(;;) */
				} /* End for(;;) */
				if (!hit) rsw = 0; /* Leave output nested. */
			}
		}
		if (aplerr) break;
		if (rsw) /* Convert to from nested. */
			out = disclose(out, NULL);
		break; /* Final break from for(;;) loop. */
	}
	endoper(temp(wrkl)); endoper(temp(wrkr));
	return(errstop(0,left,rite,out));
}