use Array: all;
use SimplePrint: all;
use SimpleFibre: all;
use Math: all;
use String:{tochar};
import Char:all;
use Bits:all;

/*
% This is the APEX stdlib.sis include file.
% Standard equates and constants for APL compiler
% Also standard coercion functions
*/

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

void APEXERROR(char[.] msg)
{
/* Error function. This needs work, as it should kill
 * the running task, too. 
 */
 /*print(msg); */
return();
}

/* Structural function utility functions */
/* Ravel utility */
#define APEXRavel(y) (reshape([prod(shape(y))],y))

inline int VectorRotateAmount(int x, int y)
{ /* Normalize x rotate for array of shape y on selected axis */
 /* normalize rotation count */

if ((0==x) || (0==y))
  z = 0; 
else if (x>0)
        z = _mod_(x,y);
     else
        z = y - _mod_(_abs_(x),y);
 return(z);
}

#define APEXRESHAPE(TYPE)					\
inline TYPE[*] APEXReshape(int[.] x, TYPE[*] y)			\
{ /* APEX vector x reshape, with item reuse */			\
  ry = APEXRavel(y);						\
  zxrho = prod(x); /* THIS NEEDS XRHO FOR CODE SAFETY!! */	\
  yxrho = shape(ry)[0];						\
  if( zxrho <= yxrho) { /* No element resuse case */		\
        z = take([zxrho],ry);					\
 } else {							\
        ncopies = zxrho/yxrho; /* # complete copies of y. */	\
        /* FIXME: y empty case !*/				\
        z = with(. <= [i] <= .)					\
                genarray( [ncopies], y,y);			\
        /* Now append the leftover bits */			\
        z = APEXRavel(z) ++ take([zxrho-(ncopies*yxrho)],ry);	\
 }								\
 return(reshape(x,z));						\
}

APEXRESHAPE(bool)
APEXRESHAPE(int)
APEXRESHAPE(double)
APEXRESHAPE(char)

#define APEXmiota(N) with (. <= [iv] <= .) genarray([N], iv)


#define APEXPI 3.1415926535897932d
#define APEXE  2.718281828d
/*  APEXPINFINITYI largest integer */
#define APEXPINFINITYD  1.7976931348623156D308
/*  APEXMINFINITYI smallest integer */
#define APEXMINFINITYD -1.7976931348623156D308


/*
% Floating-point utilities
% This taken from page 93 of the 1993-01-06 version 
% of Committee Draft 1 of the Extended ISO APL Standard
*/

inline double Dresidue(double x, double y, double QUADct)
{ /* Double residue double */
  /* See Iresidue for definition */
  if (0.0 == x)
	nx = 1.0;
  else 
	nx = x;
  z = y - x * tod(Dfloor(y/nx, QUADct));
  return(z);
}

inline int Dfloor(double y, double QUADct)
{ /* Fuzzy floor */
  /* Definition taken from SHARP APL Refman May 1991, p.6-23
   * floor:  n <- (signum y) times nofuzzfloor 0.5+abs y)
   *         z <- n-(QUADct times 1 max abs y)<(n-y)
   *
   * If you want a double result,  write: "y - 1| y".
   *
   */
   n = tod(toi(floor(0.5+fabs(y))));
   if (y < 0.0)
	n = -n;
   else if (0.0 == y)
	n = 0.0;
   range = fabs(y);
   if (1.0 > range)
	range = 1.0;
   fuzzlim = QUADct*range;
   ny = n-y;
   if (fuzzlim < ny)
	z = n - 1.0;
   else
	z = n;
   return(toi(z)); 
}

inline bool APEXFUZZEQ(double x, double y, double QUADct)
{ /* ISO APL Tolerant equality predicate */
 absx = abs(x);
 absy = abs(y);
 tolerance = QUADct * max(absx,absy);
 z = abs(x-y) <= tolerance;
 return(z);
}

/*
% 1996-12-07 Pearl Harbor Day. Try to fix bug in DBank infdivm 
% benchmark. (4 5 rho 6) + rank 1 (4 1 rho 7) introduces singleton
% vectors into scalar fn calls.
% Hence, we need support for singletons within scalar fns.
% There is an similar, but independent, bug in rank support for
% the extension case.
*/

/*  Lehmer's random number generator */
#define lehmer(qrl) mod(qrl*16807,2147483647)

inline bool greaterthan(char[+] x, char[+] y, double QUADct)
{ /* Char item comparator */
  /* This definition is sort of flakey - it really compares ravels... */
  /* It oughta also ensure that the arguments shapes match... */
  shp=shape(x)[0];
  z=false;
  for (i=0;i<shp;i++)
        if (x[i]!=y[i]){
                z= x[i]>y[i];
                i=shp;
        }
 return(z);
}
inline bool equals(char[+] x, char[+] y, double QUADct)
{ /* Char item comparator */
  /* This definition is sort of flakey - it really compares ravels... */
  /* It oughta also ensure that the arguments shapes match... */
  z = with(0*shape(x) <= iv < shape(x))
        fold(&, true, x[iv] == y[iv]);
 return(z);
}

inline bool lessthan(char[+] x, char[+] y, double QUADct)
{ /* Char item comparator */
  /* It oughta also ensure that the arguments shapes match... */
  shp=shape(x)[0];
  z=false;
  for (i=0;i<shp;i++)
        if (x[i]!=y[i]){
                z= x[i]<y[i];
                i=shp;
        }
 return(z);
}

/* Transposes */
#define APEXTRANSPOSE(TYPE,OTFILL)			\
inline TYPE[*] APEXTranspose(TYPE[*] y)			\
{							\
  z = with(iv)						\
	( . <= iv <= .) : y[reverse( iv)];		\
        genarray( reverse( shape(y)), OTFILL);		\
  return(z);						\
}

APEXTRANSPOSE(bool,false)
APEXTRANSPOSE(int,0)
APEXTRANSPOSE(double,0.0)
APEXTRANSPOSE(char,' ')
/* End of transposes */

/* End of boilerplate */


inline int[+] plusIII(int x, int[+] y)
{ /* SxA scalar function */
  xel = toI(x);
  z = with( . <= iv <= .) {
        yel = toI(y[iv]);
      }
        genarray(shape(y),
                plusIII(xel,yel),0);
  return(z);
}

inline int plusIII(int x, int y)
{ return(toI(x)+toI(y));
}

inline int plusBBI(bool x, bool y)
{ return(toI(x)+toI(y));
}

inline bool[.] comaXBB(bool y)
{
 return([y]);
}

inline int[*] rhoIII(int[.] x, int[*] y)
{
  z = APEXReshape(toi(x),y);
 return(z);
}


inline bool[+] rhoIBB(int[.] x, bool y)
{ /* Vector reshape scalar to matrix) */
 zxrho = prod(toi(x)); /* Result element count */
 z = genarray([zxrho], y); /* allocate result */
 z = reshape(toi(x),z);
 return(z);
}


inline int[.] iotaXII(int shp, int QUADio)
{ /* Index generator on scalar */
/* HELP! Needs domain check for negative shp */
  res = with( . <= [i] <= .)
        genarray( [toI(shp)], i+QUADio);
  return( res);
}
inline int[.] iotaXIINonNegsy(int shp, int QUADio)
{ /* Index generator on ScalarN when N is non-negative integer */
  res = with( . <= [i] <= .)
        genarray( [toI(shp)], i+QUADio);
  return( res);
}

inline int[.] iotaXBI(bool shp, int QUADio)
{ /* Index generator on scalar */
/* HELP! Needs domain check for negative shp */
  res = with( . <= [i] <= .)
        genarray( [toI(shp)], i+QUADio);
  return( res);
}
inline int[.] iotaXBINonNegsy(bool shp, int QUADio)
{ /* Index generator on ScalarN when N is non-negative integer */
  res = with( . <= [i] <= .)
        genarray( [toI(shp)], i+QUADio);
  return( res);
}

int quadXBB(bool[*] y, int QUADpp, int QUADpw)
{ /* {quad}{<-} anything */
 r=display(y); /* KLUDGE!!! print doesn't support booleans! */
/* MORE kludges - sac tends to evaporate side effects,
   so we'll help things along abit until that is repaired. */
 return(r);
}

int quadXII(int[*] y, int QUADpp, int QUADpw)
{ /* {quad}{<-} anything */
 r=display(y); /* KLUDGE!!! print doesn't support booleans! */
/* MORE kludges - sac tends to evaporate side effects,
   so we'll help things along abit until that is repaired. */
 return(r);
}

inline bool[2] comaBBB(bool x, bool y)
{/* SxS catenate first (or last) axis */
 return([toB(x)]++[toB(y)]);
}

inline bool[.] comaBBB(bool[.] x, bool y)
{/* VxS catenate first (or last) axis */
 return(toB(x)++[toB(y)]);
}

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

inline bool sameBIB(bool[.] x, int[.] y)
{ /* vector-vector match */
 z =(all(shape(x) == shape(y))) &&
   with(_mul_SxA_(0,shape(y)) <= iv < shape(y))
 fold(&, true,
  eqIIB(toI(x[iv]), toI(y[iv])));
 return(z);
}

inline bool eqBIB(bool x, int y)
{ return(toI(x) == toI(y));
}

inline bool sameBBB(bool[.] x, bool[.] y)
{ /* vector-vector match */
 z =(all(shape(x) == shape(y))) &&
   with(_mul_SxA_(0,shape(y)) <= iv < shape(y))
 fold(&, true,
  eqBBB(toB(x[iv]), toB(y[iv])));
 return(z);
}

inline bool eqBBB(bool x, bool y)
{ return(toB(x) == toB(y));
}

inline bool sameIBB(int[+] x, bool[+] y)
{ /* Non-scalar match non-scalar */
 if (dim(x) != dim(y))
 z = false;
 else
  if (! all(shape(x)==shape(y)))
 z = false;
  else
   z = with(_mul_SxA_(0,shape(y)) <= iv < shape(y))
 fold(&, true,
  eqIIB(toI(x[iv]), toI(y[iv])));
 return(z);
}

inline bool eqIBB(int x, bool y)
{ return(toI(x) == toI(y));
}

inline bool sameIIB(int[+] x, int[+] y)
{ /* Non-scalar match non-scalar */
 if (dim(x) != dim(y))
 z = false;
 else
  if (! all(shape(x)==shape(y)))
 z = false;
  else
   z = with(_mul_SxA_(0,shape(y)) <= iv < shape(y))
 fold(&, true,
  eqIIB(toI(x[iv]), toI(y[iv])));
 return(z);
}

inline bool eqIIB(int x, int y)
{ return(toI(x) == toI(y));
}

inline bool sameIIB(int[.] x, int[.] y)
{ /* vector-vector match */
 z =(all(shape(x) == shape(y))) &&
   with(_mul_SxA_(0,shape(y)) <= iv < shape(y))
 fold(&, true,
  eqIIB(toI(x[iv]), toI(y[iv])));
 return(z);
}

inline bool[.] slBBB(bool x, bool y)
{ /* Scalar replicate scalar */
 z = with(. <= iv <= .)
 genarray([toi(x)], y);
 return(z);
}

inline bool[.] slBBB(bool x, bool[.] y)
{ /* Scalar replicate vector */
 cell = genarray([toi(x)], false);
 z = with(. <= iv <= .)
 genarray(shape(y),
        genarray([toi(x)], y[iv]),cell);
 return(APEXRavel(z));
}

inline int[+] slBII(bool x, int[+] y)
{ /* Scalar compress non-scalar */
sy = shape(y);
if (true == tob(x))
 z = y;
else
 z = genarray(drop([-1],sy)++[0],0);
return(z);
}

inline bool[.] slBBB(bool[.] x, bool y)
{ /* Vector compress scalar */
 shpz = sum(toi(x));
 z = genarray([shpz],y);
 return(z);
}

inline bool[.] slBBB(bool[.] x, bool[.] y)
{/* vector compress/replicate vector */
 /* HELP! non-boolean left argument needs a range check */
 intx = toi(x);
 zxrho = sum(intx);
 z = genarray([zxrho], false);
 zi = 0;
 for(i=0; i<shape(x)[0]; i++)
   for(k=0; k<intx[i]; k++){
    z[zi] = y[i];
    zi++;
   }
 return(z);
}

inline bool[.] slBBB(bool[1] x, bool[.] y)
{/* 1-element-vector compress/replicate vector */
 /* HELP! non-boolean left argument needs a range check */
 if (true == tob(x[0]))
        z = y;
 else
        z = genarray([0], false);
 return(z);
}

inline int[+] slBII(bool[.] x, int[+] y)
{ /* Vector compress/replicate matrix */
  /* This needs conformability check FIXME */
  /* Also, x may be one-element vector */
 yt = APEXTranspose(y);
 frameshape = take([1],shape(yt));
 cellshape  = drop([1],shape(yt));
 defcell = genarray(cellshape,0);
 if (1 == shape(x)[0])  /* THIS IS BAD. Build x[1] version */
 x = genarray(frameshape, x[0]);
 z = genarray([sum(toi(x))], defcell);
 zi = 0;
 for(i=0; i<shape(x)[0]; i++) {
 for(j = 0; j<toi(x[i]);j++){
        z[zi] = yt[i];
        zi++;
  }
}
return(APEXTranspose(z));
}




inline int[.] slBII(bool[.] x, int[.] y)
{/* vector compress/replicate vector */
 /* HELP! non-boolean left argument needs a range check */
 intx = toi(x);
 zxrho = sum(intx);
 z = genarray([zxrho], 0);
 zi = 0;
 for(i=0; i<shape(x)[0]; i++)
   for(k=0; k<intx[i]; k++){
    z[zi] = y[i];
    zi++;
   }
 return(z);
}

inline int[.] slBII(bool[1] x, int[.] y)
{/* 1-element-vector compress/replicate vector */
 /* HELP! non-boolean left argument needs a range check */
 if (true == tob(x[0]))
        z = y;
 else
        z = genarray([0], 0);
 return(z);
}

inline bool[.] sl1BBB(bool x, bool y)
{ /* Scalar replicate scalar */
 z = with(. <= iv <= .)
 genarray([toi(x)], y);
 return(z);
}

inline bool[.] sl1BBB(bool x, bool[.] y)
{ /* Scalar replicate vector */
 cell = genarray([toi(x)], false);
 z = with(. <= iv <= .)
 genarray(shape(y),
        genarray([toi(x)], y[iv]),cell);
 return(APEXRavel(z));
}

inline int[+] sl1BII(bool x, int[+] y)
{ /* Boolean scalar compress non-scalar, first axis */
sy = shape(y);
if (true == tob(x))
        z = y;
else
        z = genarray([0]++drop([1],sy),0);
return(z);
}

inline bool[.] sl1BBB(bool[.] x, bool y)
{ /* Vector compress scalar */
 shpz = sum(toi(x));
 z = genarray([shpz],y);
 return(z);
}

inline bool[.] sl1BBB(bool[.] x, bool[.] y)
{/* vector compress/replicate vector */
 /* HELP! non-boolean left argument needs a range check */
 intx = toi(x);
 zxrho = sum(intx);
 z = genarray([zxrho], false);
 zi = 0;
 for(i=0; i<shape(x)[0]; i++)
   for(k=0; k<intx[i]; k++){
    z[zi] = y[i];
    zi++;
   }
 return(z);
}

inline bool[.] sl1BBB(bool[1] x, bool[.] y)
{/* 1-element-vector compress/replicate vector */
 /* HELP! non-boolean left argument needs a range check */
 if (true == tob(x[0]))
        z = y;
 else
        z = genarray([0], false);
 return(z);
}

inline int[+] sl1BII(bool[.] x, int[+] y)
{ /* Vector compress-first-axis matrix */
 intx = toi(x);
 zxrho = sum(intx);
 cellshape = drop([1],shape(y));
 defcell = genarray(cellshape,0);
 z = genarray([zxrho], defcell);
 for( k=0, i=0; k<zxrho; i++) {
        z[k] = y[i];
        k = k + intx[i];
}
return(z);
}


inline bool andslXBB(bool[.] y)
{ /* Last axis reduction of vector */
  z = with (_mul_SxA_(0,shape(y)) <= iv < shape(y))
        fold( andBBB, toB(1), toB(y[iv]));
  return(z);
}

inline bool andBBB(bool x, bool y)
{ return(tob(x)&tob(y));
}

int main()
{ /* Start of function main 2006-01-11 18:52:20.000 */

/*
r{<-}main;y;S0;S1;V0;V1;V1011;M234
@{#} Compress unit tests
S0{<-}0
S1{<-}1
V1{<-},1
V0{<-},0
V1011{<-}1 0 1 1
M234{<-}2 3 4{rho}{iota}24
@ Last axis tests
r{<-}  (S0/S0){match}{iota}0
r{<-}r,(S1/S0){match},S0
r{<-}r,(S1/S1){match},S1
r{<-}r,(S0/V1){match}{iota}0
r{<-}r,(S1/V1){match}V1
r{<-}r,(S0/M234){match}2 3 0{rho}0
r{<-}r,(S1/M234){match}M234
r{<-}r,(V0/S0){match}{iota}0
r{<-}r,(V1/S0){match},S0
r{<-}r,(V0/V0){match}{iota}0
r{<-}r,(V1/V0){match}V0
r{<-}r,(V0/M234){match}2 3 0{rho}0
r{<-}r,(V1/M234){match}M234
r{<-}r,(V1011/M234){match}2 3 3{rho}0 2 3, 4 6 7,8 10 11, 12 14 15,16 18 19,20 22 23
r{<-}r,(V1011/{iota}4){match}0 2 3
@ First axis tests
r{<-}r,(S0{slashbar}S0){match}{iota}0
r{<-}r,(S1{slashbar}S0){match},S0
r{<-}r,(S1{slashbar}S1){match},S1
r{<-}r,(S0{slashbar}V1){match}{iota}0
r{<-}r,(S1{slashbar}V1){match}V1
r{<-}r,(S0{slashbar}M234){match}0 3 4{rho}0
r{<-}r,(S1{slashbar}M234){match}M234
r{<-}r,(V0{slashbar}S0){match}{iota}0
r{<-}r,(V1{slashbar}S0){match},S0
r{<-}r,(V0{slashbar}V0){match}{iota}0
r{<-}r,(V1{slashbar}V0){match}V0
r{<-}r,(V0{slashbar}M234){match}0 3 4{rho}0
r{<-}r,(V1{slashbar}M234){match}M234
r{<-}r,(0 1{slashbar}M234){match}1 3 4{rho}12+{iota}12
r{<-}r,(1 0{slashbar}M234){match}1 3 4{rho}{iota}12
#{<-}r
#{<-}r{<-}1+^/r
*/
QUADio_0=toi(( false) );
 QUADct_0=( 1.0e-13) ;
 QUADpp_0=( 10) ;
 QUADpw_0=( 80) ;
 QUADrl_0=( 16807) ;
 S0_0=( false) ;
 S1_0=( true) ;
 V1_0=comaXBB( true) ;
 V0_0=comaXBB( false) ;
 V1011_0=( [true,false,true,true]) ;
/* works OK */
 TMP_251=rhoIBB([0, 3, 4],false) ;
 M234_0= reshape([2,3,4],iotaXII(24,0));
 TMP_252=sl1BII(V0_0,M234_0) ;
 TMP_254=sameIBB(TMP_252 ,TMP_251 ) ;
 r_26=[TMP_254] ;
/*
 TMP_256=sl1BII(V1_0,M234_0) ;
 TMP_258=sameIIB(TMP_256 ,M234_0) ;
 r_27=comaBBB(r_26,TMP_258 ) ;
/* kills sac2c here */
 TMP_261=iotaXII( 12,QUADio_0) ;
 TMP_262=plusIII(12,TMP_261 );
 TMP_263=rhoIII([1, 3, 4],TMP_262 ) ;
 TMP_264=sl1BII([false,true],M234_0) ;
 TMP_266=sameIIB(TMP_264 ,TMP_263 ) ;
 r_28=comaBBB(r_27,TMP_266 ) ;
 TMP_269=iotaXII( 12,QUADio_0) ;
 TMP_270=rhoIII([1, 3, 4],TMP_269 ) ;
 TMP_271=sl1BII([true,false],M234_0) ;
 TMP_273=sameIIB(TMP_271 ,TMP_270 ) ;
 r_29=comaBBB(r_28,TMP_273 ) ;
*/
r_29=r_26;
 TMP_277=quadXII( toi(r_29),QUADpp_0,QUADpw_0) ;
 TMP_278=andslXBB( r_29) ;
 r_30=plusBBI(true,TMP_278 );
 TMP_285=quadXII( r_30,QUADpp_0,QUADpw_0) ;
 r=r_30;
return(r_30+TMP_285+TMP_277);
}