#define INCLUDES APLCB+APLCHDEF+APLMAIN+STDIO+APLDERIV
#include "includes.h"
main()
{
     Cdyadic; Chrvect; Cne; Dervfree; Each; Endoper; Execdot; Indxsub;
     Litvect; Newderiv; Partitn; Perm; Quadout; Reducef; Reshape; Temp;
     void subfill(int, Deriv_sub*);
     Aplderiv dpa,dpb;
	Aplcb text,counts;
     #include "aplinit.h"

     dpa = newderiv(NULL,NULL,NULL); /* New aplderiv structure. */
     dpa->deriv_flags |= DERPERM; /* Mark it permanent. */
     dpa->deriv_func = execdot; /* Process for inner product. */
     subfill(PLUS,  &(dpa->deriv_left));
     subfill(TIMES, &(dpa->deriv_rite));
     endoper(quadout(dpa->deriv_func(dpa,
          reshape(litvect("2 3"),indxsub(6)),
          reshape(litvect("3 2"),indxsub(6))
     )));

	dpa->deriv_func = each;
     subfill(EQUAL,&(dpa->deriv_left));
	text=perm(chrvect("Still round the corner there may wait"));
	counts=each(dpa,chrvect("e"),
		partitn(cdyadic(cne,chrvect(" "),text),text,NULL));
     dpb = newderiv(NULL,NULL,NULL); /* New aplderiv structure. */
     dpb->deriv_flags |= DERPERM; /* Mark it permanent. */
	dpb->deriv_func = reducef;
     subfill(PLUS,&(dpb->deriv_left));
	dpa->deriv_left.funcode = DERIVED_FUNCTION;
	dpa->deriv_left.fun = dpb;
	endoper(quadout(
		each(dpa,NULL,counts) /* counts w/b freed */
	));
	endoper(temp(text)); /* free aplcb */	
     dpa->deriv_flags &= ~DERPERM;
     dervfree(dpa); /* Frees both dpa and dpb */
}

void subfill(code,sub)
int code;
Deriv_sub *sub;
{
     Funexec; Pickdyad;
     struct apltoken tok;
     Apltoken tokptr;

     tok.token_code = code;
     tok.token_flags=0; /* So funexec won't replicate token. */
     tokptr = funexec(&tok); /* Get info. on code. */
     sub->funcode = tok.token_code;
     sub->fun = tok.token_ptr.token_function;
     sub->sdp = pickdyad(sub->fun);
}