/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */
/* drop2 APL2 V1.0.0 ***************************************************
* APL2 drop. *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb drop2(left, rite, axes)
Aplcb left, rite, axes;
{
Drop; Endoper; Errinit; Errstop; Getcb; Intcopy; Integer; Iscalar;
Ravel; Reshape; Shape; Vectin;
extern int aplerr, indxorg;
Aplcb newleft=NULL,out=NULL;
int i,*ip,j,k,rank;
static int izero=0;
if (axes == NULL) return(drop(left,rite));
for(;;) {
if (errinit()) break;
if (left->aplrank > 1) {aplerr = 15; break;}
if (!(APLINT & left->aplflags))
if (NULL == (left = integer(left))) break;
if (!(APLINT & axes->aplflags))
if (NULL == (axes = integer(axes))) break;
if (left->aplcount != axes->aplcount ||
left->aplcount > rite->aplrank) {aplerr = 16; break;}
newleft = getcb(NULL,rite->aplrank,APLINT+APLTEMP,1,NULL);
if (newleft == NULL) break;
ip = intcopy(newleft->aplptr.aplint,&izero,newleft->aplcount,0);
for(i = 0; i < axes->aplcount; i++) {
j = *(axes->aplptr.aplint + i) - indxorg; /* axis, rel 0 */
if (j < 0 || j >= rite->aplrank) aplerr = 9; /* bad axis */
else if (0 != *(ip = newleft->aplptr.aplint + j)) aplerr = 9;
else *ip = *(left->aplptr.aplint + i);
}
if (aplerr) break;
endoper(left);
endoper(axes);
return(drop(newleft,rite));
}
endoper(newleft);
endoper(axes);
return(errstop(0,left,rite,NULL));
}