/* Copyright (C) 1996 by Thomas Glen Smith.	All Rights Reserved. */
/* execdote APL2 V1.0.0 ************************************************
* Called from execdot to do inner product when form is left lo.ro rite,*
* and ro is scalar dyadic, e.g. + and lo uses APL variables as args.   *
***********************************************************************/
#define INCLUDES APLCB+APLDERIV
#include "includes.h"
Aplcb execdote(dp,left,rite)
Aplderiv dp; /* function describing derived function */
Aplcb left,rite;
{	Aplnest; Dtacopy; Dyadoper; Dyadrun; Errstop; Getcb; Innrcom;
	Nreduces; Matchok; Perm; Temp;
	extern int aplerr;
	void *lo,(*opera)(),(*operb)(),*identity;
	Scalar_dyadics *ro;
	int code,flags,typ=APLAPL,i,ityp,j,k,n,otyp,laxcnt,laxis,lbot,
		linc,ltop,ltyp,raxcnt,rbot,rinc,rtop,rtyp;
	char *dout,*ip,*ldata,*op,*rdata;
	Aplcb *odata,out,wrkh,wrkl,wrko,wrkr;
	double wrka,wrkb,wrkc;

	code = (((Codes *)(dp->deriv_rite.fun))->funky_code);
	flags = (((Codes *)(dp->deriv_rite.fun))->funky_flags);
	lo = dp->deriv_left.fun;
	ro = dp->deriv_rite.sdp;
	operb = dyadoper(ro,&ityp,&otyp,left->aplflags & (APLMASK | APLAPL),
		rite->aplflags & (APLMASK | APLAPL),flags,code);
	if (operb == NULL) return(errstop(1,left,rite,NULL));
	if (!matchok(&left,&rite,ityp)) return(NULL);
	ltyp = left->aplflags & (APLMASK | APLAPL);
	rtyp = rite->aplflags & (APLMASK | APLAPL);
	out = innrcom(2,left,rite,&laxis,&laxcnt,&lbot,&ltop,&linc,
		&raxcnt,&rbot,&rtop,&rinc,&typ,&dout,&ldata,&rdata);
	if (out == NULL) return(NULL);
	odata = out->aplptr.aplapl;
	for(;;) { /* Makes it easy to quit on error. */
		wrkl = getcb(NULL,laxcnt,ltyp,1,NULL);
		wrkr = getcb(NULL,raxcnt,rtyp,1,NULL);
		wrkh = getcb(NULL,laxcnt,otyp,1,NULL);
		if (aplerr) break;
		for (i=0; i<ltop; i++) { /* Once for each left vector. */
			dtacopy(wrkl->aplptr.aplvoid,ldata + i*laxcnt*
				left->aplsize,laxcnt,1,ltyp);
			for (j=0; j<rbot; j++) { /* Once for each rite vector. */
				dtacopy(wrkr->aplptr.aplvoid,
					rdata + (j*rite->aplsize),raxcnt,rbot,rtyp);
				wrko = dyadrun(operb,wrkl,wrkr,wrkh); /* Do scalar. */
				if (wrko != wrkh) { /* dyadrun changed datatype. */
					endoper(temp(wrkh));
					wrkh = wrko;
				}
				*odata++ = perm(nreduces(1,dp,aplnest(wrkh),1));
			}
		}
		break; /* Final break from for(;;) loop. */
	}
	endoper(temp(wrkh)); endoper(temp(wrkl)); endoper(temp(wrkr));
	return(errstop(0,left,rite,out));
}