use Array: all;
use SimplePrint: all;
use SimpleFibre: all;
use Math: all;

#include "mscalar.sac"
#include "dscalar.sac"
#include "stdlib.sac"

#define toB(x) tob((x))
#define toI(x) toi((x))
#define toD(x) tod((x))
#define toC(x) toc((x))


inline bool[+] neCCBsy(char[*] x, char y , double QUADct)
{ /* AxS scalar function */
 yel = toC(y);
 z = with( . <= iv <= .) {
	xel = toC(_sel_(iv,x));
 }	
 genarray( _shape_(x),
		dneCCB(xel,yel, QUADct));
 return(z);
}

inline bool[+] orBBB(bool[+] x, bool[+] y )
{ /* AxA Dyadic scalar fn, shapes unknown, shapes may or may not match */
 /* Insert length error checking code here!! */
 z = with( . <= iv <= .) {
	xel = toB(_sel_(iv,x));
	yel = toB(_sel_(iv,y));
 }	
 genarray( _shape_(x),
		dorBBB(xel,yel));
 return(z);
}

inline bool[+] rotrXBB(bool[+] y)
{ /* First axis reverse on anything; vector reverse */
 lim = _sub_SxS_( _sel_( [0], _shape_(y)), 1);
 z = with( [0] <= iv = [i] <= [lim])
 modarray( y, iv, y[[_sub_SxS_(lim, i)]]);
 return(z);
}




inline int[.] takeBII(bool x, int[.] y)
/* LOTS of missing code here. (x0<0 for example */
{ /* Scalar take vector */
 z = with( . <= iv <= .)
	genarray([abs(toi(x))], _sel_(iv,y));
 return(z);
}

inline char[.,.] takeICC(int[.] x, char[.,.] y)
{ /* vector take matrix */
 offset = where( toI(x) < 0, _shape_(y) + toI(x), 0);
 res = with( . <= iv <= .)
 genarray( abs(x), _sel_( _add_AxA_( offset, iv), y));
 return( res);
}




inline int[2] rhoXCI(char[.,.] y)
{ /* Shape of matrix (rank-2) */
 return(_shape_(y));
}


inline int[.] comaIII(int[.] x, int y)
{/* VxS catenate first (or last) axis */
 return(toI(x)++[toI(y)]);
}






inline bool[+] orsl1XBB(bool[+] y)
{ /* first-axis reduce rank-2 or greater matrix */
/* This does not stop quick for Booleans... */
/* First y axis disappears from result shape */
/* Result is: transpose last-axis reduce transpose y */
	yt = APEXTranspose(y);
 rhrank = _dim_(yt);
 sy = _shape_(yt);
 zrho = _drop_SxV_(_neg_(1), sy);
 z = with (. <= iv <= .) {
 		val = with (_mul_SxA_(0,sy) <= iv < sy)
 	fold( +, toB(0), toB(_sel_(iv, yt)));
 }
 genarray(zrho, val);

 return(APEXTranspose(z));
}
inline bool[.] orbslXBB(bool[.] y)
{
/* This does the scan in the wrong direction, but since
 * we assume associative functions only, it should be ok.
 */
 size = _shape_(y);
 z = genarray(size,toB(0));
 if (0 != size[0]) {
 	/* real work to do */
 	z[[0]] = BtoB(y); /* Not sure about the coercion... */
 	for ( i=1; i<size[0]; i++) {
 		z[[i]] = +(toB(z[[i-1]]),toB(y[[i]]));
 	}
 }
 return(z);
}

inline int plusslXBI(bool[.] y)
{ /* Last axis reduction of vector */
 z = with (_mul_SxA_(0,_shape_(y)) <= iv < _shape_(y))
 fold( +, toI(0), toI(_sel_(iv, y)));
 return(z);
}







inline int[.] rhoIII(int x, int[*] y)
{ /* Scalar reshape non-scalar (to vector) */
	zxrho = prod(toi(x)); /* Result element count */
	ry = APEXRAVEL(y);
	count = _min_(_shape_(ry)[0],toi(x));
	z = genarray([zxrho], 0); /* allocate result */

	z = with([0] <= [iv] < [count]) 	/* non-reuse part */
		modarray(z, iv, _sel_([iv], ry));

	if (zxrho > count) /* Element reuse case */
	 for (i=count; i<zxrho; i++)
	 z = modarray(z, [i], _sel_([i-count], z));

	return(z);
}

inline char[*] rhoICC(int[.] x, char[*] y)
{
 rx = APEXRAVEL(x);
 ry = APEXRAVEL(y);
 rhxrho = prod(x); /* THIS NEEDS XRHO FOR CODE SAFETY!! */
 zxrho = _shape_(ry)[0];
 if( zxrho <= rhxrho) { /* No element resuse case */
 z = with(. <= [iv] <= .)
	genarray([rhxrho], _sel_([iv],ry));
 } else {
 z = with(. <= [i] <= .)
 genarray( [zxrho], _sel_([i%rhxrho],ry));
		/* i%len above fishy. Needed last iteration only? */
 }
 return( _reshape_(rx, z));
}




inline int[2] rhoXCI(char[.,.] y)
{ /* Shape of matrix (rank-2) */
 return(_shape_(y));
}


inline int[.] comaIII(int[.] x, int[.] y)
{ /* VxV last-axis catenate */
 return(toI(x)++toI(y));
}












inline int rhoCII(char[0] x, int[+] y)
{ /* Empty vector reshape non-scalar to scalar */
 return(_sel_(_mul_SxA_(0,_shape_(y)),y));
}

inline int rhoCII(char[0] x, int y)
{ /* Empty vector reshape scalar to scalar */
 return(y);
}



int quadXII(int[*] y, int QUADpp, int QUADpw)
{ /* {quad}{<-} anything */
	r=print(y); /* KLUDGE!!! print doesn't support booleans! */
	return(y);
}

inline int[1] rhoXII(int[+] y)
{ /* Shape of vector */
 return(_shape_(y));
}









char[.,.] dtbXCC(char[.,.] y,double QUADct)
{ 
/* Start of function dtb 2005-10-18 17:59:58.000 */


TMP_27=neCCBsy(y ,' ' ,QUADct);
 TMP_28=orsl1XBB( TMP_27 ) ;
 TMP_32=rotrXBB( TMP_28 ) ;
 TMP_33=orbslXBB( TMP_32 ) ;
 x_0=plusslXBI( TMP_33 ) ;
 TMP_41=rhoXCI( y ) ;
 TMP_42=takeBII(true ,TMP_41 ) ;
 TMP_43=comaIII(TMP_42 ,x_0 ) ;
 r_0=takeICC(TMP_43 ,y ) ;
 r=r_0;
 

return(r_0);

}


int[.] dtbtestXII(int[.] n, double QUADct)
{ 
/* Start of function dtbtest 2005-10-18 17:59:58.000 */


n_0=rhoIII(2 ,n ) ;
 d_0=rhoICC(n_0 ,'x' ) ;
 TMP_33=dtbXCC( d_0 ,QUADct) ;
 r_0=rhoXCI( TMP_33 ) ;
 d_1=rhoICC(n_0 ,' ' ) ;
 TMP_37=dtbXCC( d_1 ,QUADct) ;
 TMP_38=rhoXCI( TMP_37 ) ;
 r_1=comaIII(r_0 ,TMP_38 ) ;
 r=r_1;
 

return(r_1);

}


int main()
{ 
/* Start of function main 2005-10-18 17:59:58.000 */


QUADio_0=toi(( false ) );
 QUADct_0=( 1.0e-13 ) ;
 QUADpp_0=( 10 ) ;
 QUADpw_0=( 80 ) ;
 QUADrl_0=( 16807 ) ;
 QUADio_1=toi(( false ) );
 QUADct_1=tod(( false ) );
 n_0=( [30000, 150]) ;
 QUADrl_1=( 16807 ) ;
 QUADpp_1=( 10 ) ;
 QUADpw_1=( 80 ) ;
 r_0=dtbtestXII( n_0, QUADct_1 ) ;
 TMP_68=quadXII( r_0 ,QUADpp_1,QUADpw_1) ;
 TMP_69=rhoXII( r_0 ) ;
 r_1=rhoCII((EMPTYCHAR) ,TMP_69 ) ;
 r=r_1;
 

return(r_1);

}