/* Copyright (C) 1993 by Thomas Glen Smith.  All Rights Reserved. */
/* laminate APL2 V1.0.0 ************************************************
* Called by eachdyad.                                                  *
* Joins two APL variables of identical shape and rank along a new axis *
* indicated by a fractional number.  A number between 0 and 1          *
* indicates the new axis is to be first.  A number between the last    *
* present axis and one greater means the new axis is to be last.  The  *
* result will have rank 1 greater than the arguments, and the same     *
* shape except for the new axis, is always 2.                          *
***********************************************************************/
#define INCLUDES APLCB+APLMEM
#include "includes.h"
Aplcb laminate(left,rite,paxis)
Aplcb left, rite;
double paxis;
{
	Catlamcm; Conform; Errstop; Getcb; Imax; Matchok;
	Aplcb big, lit, out=NULL;
	int axicnt,axis,botcnt,datacnt,datatyp,*dimptr,i,*ip,j,leftcnt,*op,
		rank,ritecnt,topcnt;

	if (!matchok(&left,&rite,APLMASK+APLAPL))
		return(NULL); /* data types must match */
	if (OK != conform(left,rite,0,&big,&lit))
		return(errstop(50,left,rite,NULL)); /* shapes must match */
	if (paxis < 0.0)
		return(errstop(51,left,rite,NULL)); /* axis m/b positive */
	rank=imax(1,big->aplrank)+1;
	if (rank < (axis = 1 + paxis))
		return(errstop(52,left,rite,NULL)); /* axis too big */
	dimptr = op = malloc(rank*sizeof(int));
	if (big->aplrank) { /* copy dimensions */
		ip = big->apldim;
		datacnt = 1;
		for(i=1; i<=rank; i++) {
			if (i != axis)
				*op++ = j = *ip++;
			else
				*op++ = j = 2; /* axis dimension is always 2 */
			datacnt *= j;
		}
	}
	else { /* laminating two scalars */
		datacnt = 2;
		*(op+axis%2) = 1; /* non-axis dimension is 1 */
		*(op+axis-1) = 2; /* make axis dimension 2 */
	}
	out = getcb(NULL,datacnt,
		(datatyp=left->aplflags & (APLMASK+APLAPL))+APLTEMP,
          rank,dimptr);
	if ((out->aplcount == 0) || 
		(OK != axispre(out,axis,&axicnt,&botcnt,&topcnt)))
		return(errstop(0,left,rite,out));
	leftcnt=ritecnt=botcnt;
	return(catlamcm(left,rite,out,axis,
		axicnt,botcnt,topcnt,leftcnt,ritecnt));
}