/* Copyright (C) 1996 by Thomas Glen Smith.	All Rights Reserved. */
/* execspen APL2 V1.0.0 ************************************************
* Called by execspef to perform selective specification, e.g. (Er)#n,	 *
* Execspen differs from execspeh, which is alternatively called by     *
* execspef, in that it replaces a single element in *pleftorig with a  *
* single copy of rite. Cases where this applies are pick and first.    *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
int execspen(pleftorig, left, rite, ixp, ixc)
Aplcb *pleftorig,/* Variable to assign to, m/b permanent.			*/
	 left,	  /* Indices selected from. Same shape as leftorig, 	*/
			  /* but with unique indices for values.			*/
	 rite;	  /* Elements are assigned from here, m/b permanent.	*/
int	*ixp;	  /* Indices into leftorig to elements to replace with */
			  /* Successive elements of rite.					*/
int	 ixc;	  /* Count of indices pointed to by ixp.			*/
{
	Aplcopy; Aplnest; Dtacopy; Endoper; Execspen; Matchoks; Perm; Temp;
	extern int aplerr;
	int i,ltype,rtype;
	Aplcb *ileft,*oleft,*sleft,replaced,saveleft,*spot;

	if (left->aplflags & APLAPL) {
		ileft = left->aplptr.aplapl;
		oleft = (*pleftorig)->aplptr.aplapl;
		for(i = left->aplcount; i; i--) {
			saveleft = *(sleft = oleft++);
			if (execspen(sleft,*ileft++,rite,ixp,ixc)) {
				if (saveleft != *sleft) endoper(temp(saveleft));
				return(1);
			}
		}
		aplerr = 34; /* index out of range */
	} else {
		if (*(left->aplptr.aplint+left->aplcount-1) < *ixp)
			return(0);
		if (left->aplcount == ixc) /* replace the whole */
			*pleftorig = aplcopy(rite);
		else { /* replace one item */
			ltype = (*pleftorig)->aplflags & (APLMASK | APLAPL);
			rtype = rite->aplflags & (APLMASK | APLAPL);
			i = (ltype == rtype) ? 0 :
				0 == matchoks(pleftorig,&rite,(APLMASK - APLCHAR));
			if (i)
				*pleftorig = perm(aplnest(*pleftorig));
			ltype = (*pleftorig)->aplflags & (APLMASK | APLAPL);
			if (ltype == APLAPL) {
				spot = (*pleftorig)->aplptr.aplapl+*ixp;
				replaced = *spot;
				*spot = aplcopy(rite);
				endoper(temp(replaced));
			} else dtacopy((*pleftorig)->aplptr.aplchar,
				rite->aplptr.aplchar,1,1,ltype);
		}
	}
	return(1); /* assignment complete */
}