The prototype for pow(x:real(64), y:real(64)) is required by the procedures primer.

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@18563 3a8e244f-b0f2-452b-bcba-4c88e055c3ca

_extern const INFINITY: real(64);
_extern const NAN: real(64);

pragma "inline" proc abs(i : int(?w)) return if i < 0 then -i else i;
pragma "inline" proc abs(i : uint(?w)) return i;
pragma "inline" proc abs(x : complex(?w)) return sqrt(x.re*x.re + x.im*x.im);

pragma "inline" proc conjg(a: complex(?w)) return (a.re, -a.im):complex;

_extern proc isinf(x: real(64)): bool;
_extern proc isinf(x: real(32)): bool;
_extern proc isfinite(x: real(64)): bool;
_extern proc isfinite(x: real(32)): bool;
_extern proc isnan(x: real(64)): bool;
_extern proc isnan(x: real(32)): bool;

_extern proc acos(x: real(64)): real(64);
_extern proc acosh(x: real(64)): real(64);
_extern proc asin(x: real(64)): real(64);
_extern proc asinh(x: real(64)): real(64);
_extern proc atan(x: real(64)): real(64);
_extern proc atan2(y: real(64), x: real(64)): real(64);
_extern proc atanh(x: real(64)): real(64);
_extern proc cbrt(x: real(64)): real(64);
_extern proc ceil(x: real(64)): real(64);
_extern proc cos(x: real(64)): real(64);
_extern proc cosh(x: real(64)): real(64);
_extern proc erf(x: real(64)): real(64);
_extern proc erfc(x: real(64)): real(64);
_extern proc exp(x: real(64)): real(64);
_extern proc exp2(x: real(64)): real(64);
_extern proc expm1(x: real(64)): real(64);
_extern proc fabs(x: real(64)): real(64);
_extern proc floor(x: real(64)): real(64);
_extern proc lgamma(x: real(64)): real(64);
_extern proc log(x: real(64)): real(64);
_extern proc log2(x: real(64)): real(64);
_extern proc log10(x: real(64)): real(64);
_extern proc log1p(x: real(64)): real(64);
_extern proc nearbyint(x: real(64)): real(64);
_extern proc pow(x: real(64), y: real(64)): real(64);
_extern proc rint(x: real(64)): real(64);
_extern proc round(x: real(64)): real(64);
_extern proc sin(x: real(64)): real(64);
_extern proc sinh(x: real(64)): real(64);
_extern proc sqrt(x: real(64)): real(64);
_extern proc tan(x: real(64)): real(64);
_extern proc tanh(x: real(64)): real(64);
_extern proc tgamma(x: real(64)): real(64);
_extern proc trunc(x: real(64)): real(64);

pragma "inline" proc acos(x : real(32)) {
  _extern proc acosf(x: real(32)): real(32);
  return acosf(x);
}
pragma "inline" proc acosh(x : real(32)) {
  _extern proc acoshf(x: real(32)): real(32);
  return acoshf(x);
}
pragma "inline" proc asin(x : real(32)) {
  _extern proc asinf(x: real(32)): real(32);
  return asinf(x);
}
pragma "inline" proc asinh(x : real(32)) {
  _extern proc asinhf(x: real(32)): real(32);
  return asinhf(x);
}
pragma "inline" proc atan(x : real(32)) {
  _extern proc atanf(x: real(32)): real(32);
  return atanf(x);
}
pragma "inline" proc atan2(y : real(32), x: real(32)) {
  _extern proc atan2f(y: real(32), x: real(32)): real(32);
  return atan2f(y, x);
}
pragma "inline" proc atanh(x : real(32)) {
  _extern proc atanhf(x: real(32)): real(32);
  return atanhf(x);
}
pragma "inline" proc cbrt(x : real(32)) {
  _extern proc cbrtf(x: real(32)): real(32);
  return cbrtf(x);
}
pragma "inline" proc ceil(x : real(32)) {
  _extern proc ceilf(x: real(32)): real(32);
  return ceilf(x);
}
pragma "inline" proc cos(x : real(32)) {
  _extern proc cosf(x: real(32)): real(32);
  return cosf(x);
}
pragma "inline" proc cosh(x : real(32)) {
  _extern proc coshf(x: real(32)): real(32);
  return coshf(x);
}
pragma "inline" proc erf(x : real(32)) {
  _extern proc erff(x: real(32)): real(32);
  return erff(x);
}
pragma "inline" proc erfc(x : real(32)) {
  _extern proc erfcf(x: real(32)): real(32);
  return erfcf(x);
}
pragma "inline" proc exp(x : real(32)) {
  _extern proc expf(x: real(32)): real(32);
  return expf(x);
}
pragma "inline" proc exp2(x : real(32)) {
  _extern proc exp2f(x: real(32)): real(32);
  return exp2f(x);
}
pragma "inline" proc expm1(x : real(32)) {
  _extern proc expm1f(x: real(32)): real(32);
  return expm1f(x);
}
pragma "inline" proc abs(x : real(32)) {
  _extern proc fabsf(x: real(32)): real(32);
  return fabsf(x);
}
pragma "inline" proc floor(x : real(32)) {
  _extern proc floorf(x: real(32)): real(32);
  return floorf(x);
}
pragma "inline" proc lgamma(x : real(32)) {
  _extern proc lgammaf(x: real(32)): real(32);
  return lgammaf(x);
}
pragma "inline" proc log(x : real(32)) {
  _extern proc logf(x: real(32)): real(32);
  return logf(x);
}
pragma "inline" proc log2(x : real(32)) {
  _extern proc log2f(x: real(32)): real(32);
  return log2f(x);
}
pragma "inline" proc log10(x : real(32)) {
  _extern proc log10f(x: real(32)): real(32);
  return log10f(x);
}
pragma "inline" proc log1p(x : real(32)) {
  _extern proc log1pf(x: real(32)): real(32);
  return log1pf(x);
}
pragma "inline" proc nearbyint(x : real(32)) {
  _extern proc nearbyintf(x: real(32)): real(32);
  return nearbyintf(x);
}
pragma "inline" proc rint(x : real(32)) {
  _extern proc rintf(x: real(32)): real(32);
  return rintf(x);
}
pragma "inline" proc round(x : real(32)) {
  _extern proc roundf(x: real(32)): real(32);
  return roundf(x);
}
pragma "inline" proc sin(x: real(32)) {
  _extern proc sinf(x: real(32)): real(32);
  return sinf(x);
}
pragma "inline" proc sinh(x : real(32)) {
  _extern proc sinhf(x: real(32)): real(32);
  return sinhf(x);
}
pragma "inline" proc sqrt(x : real(32)): real(32) {
  _extern proc sqrtf(x: real(32)): real(32);
  return sqrtf(x);
}
pragma "inline" proc tan(x : real(32)) {
  _extern proc tanf(x: real(32)): real(32);
  return tanf(x);
}
pragma "inline" proc tanh(x : real(32)) {
  _extern proc tanhf(x: real(32)): real(32);
  return tanhf(x);
}
pragma "inline" proc tgamma(x : real(32)) {
  _extern proc tgammaf(x: real(32)): real(32);
  return tgammaf(x);
}
pragma "inline" proc trunc(x : real(32)) {
  _extern proc truncf(x: real(32)): real(32);
  return truncf(x);
}

proc _logBasePow2Help(in val, baseLog2) {
  var result = -1;
  while (val != 0) {
    val >>= baseLog2;
    result += 1;
  }
  return result;
}

proc logBasePow2(in val: int(?w), baseLog2) {
  if (val < 1) {
    halt("Can't take the log() of a non-positive integer");
  }
  return _logBasePow2Help(val, baseLog2);
}

proc logBasePow2(in val: uint(?w), baseLog2) {
  if (val < 1) {
    halt("Can't take the log() of a non-positive integer");
  }
  return _logBasePow2Help(val, baseLog2);
}

proc log2(in val: int(?w)) {
  return logBasePow2(val, 1);
}

proc log2(in val: uint(?w)) {
  return logBasePow2(val, 1);
}

_extern const INFINITY: real(64);
_extern const NAN: real(64);

pragma "inline" proc abs(i : int(?w)) return if i < 0 then -i else i;
pragma "inline" proc abs(i : uint(?w)) return i;
pragma "inline" proc abs(x : complex(?w)) return sqrt(x.re*x.re + x.im*x.im);

pragma "inline" proc conjg(a: complex(?w)) return (a.re, -a.im):complex;

_extern proc isinf(x: real(64)): bool;
_extern proc isinf(x: real(32)): bool;
_extern proc isfinite(x: real(64)): bool;
_extern proc isfinite(x: real(32)): bool;
_extern proc isnan(x: real(64)): bool;
_extern proc isnan(x: real(32)): bool;

_extern proc acos(x: real(64)): real(64);
_extern proc acosh(x: real(64)): real(64);
_extern proc asin(x: real(64)): real(64);
_extern proc asinh(x: real(64)): real(64);
_extern proc atan(x: real(64)): real(64);
_extern proc atan2(y: real(64), x: real(64)): real(64);
_extern proc atanh(x: real(64)): real(64);
_extern proc cbrt(x: real(64)): real(64);
_extern proc ceil(x: real(64)): real(64);
_extern proc cos(x: real(64)): real(64);
_extern proc cosh(x: real(64)): real(64);
_extern proc erf(x: real(64)): real(64);
_extern proc erfc(x: real(64)): real(64);
_extern proc exp(x: real(64)): real(64);
_extern proc exp2(x: real(64)): real(64);
_extern proc expm1(x: real(64)): real(64);
_extern proc fabs(x: real(64)): real(64);
_extern proc floor(x: real(64)): real(64);
_extern proc lgamma(x: real(64)): real(64);
_extern proc log(x: real(64)): real(64);
_extern proc log2(x: real(64)): real(64);
_extern proc log10(x: real(64)): real(64);
_extern proc log1p(x: real(64)): real(64);
_extern proc nearbyint(x: real(64)): real(64);
_extern proc rint(x: real(64)): real(64);
_extern proc round(x: real(64)): real(64);
_extern proc sin(x: real(64)): real(64);
_extern proc sinh(x: real(64)): real(64);
_extern proc sqrt(x: real(64)): real(64);
_extern proc tan(x: real(64)): real(64);
_extern proc tanh(x: real(64)): real(64);
_extern proc tgamma(x: real(64)): real(64);
_extern proc trunc(x: real(64)): real(64);

pragma "inline" proc acos(x : real(32)) {
  _extern proc acosf(x: real(32)): real(32);
  return acosf(x);
}
pragma "inline" proc acosh(x : real(32)) {
  _extern proc acoshf(x: real(32)): real(32);
  return acoshf(x);
}
pragma "inline" proc asin(x : real(32)) {
  _extern proc asinf(x: real(32)): real(32);
  return asinf(x);
}
pragma "inline" proc asinh(x : real(32)) {
  _extern proc asinhf(x: real(32)): real(32);
  return asinhf(x);
}
pragma "inline" proc atan(x : real(32)) {
  _extern proc atanf(x: real(32)): real(32);
  return atanf(x);
}
pragma "inline" proc atan2(y : real(32), x: real(32)) {
  _extern proc atan2f(y: real(32), x: real(32)): real(32);
  return atan2f(y, x);
}
pragma "inline" proc atanh(x : real(32)) {
  _extern proc atanhf(x: real(32)): real(32);
  return atanhf(x);
}
pragma "inline" proc cbrt(x : real(32)) {
  _extern proc cbrtf(x: real(32)): real(32);
  return cbrtf(x);
}
pragma "inline" proc ceil(x : real(32)) {
  _extern proc ceilf(x: real(32)): real(32);
  return ceilf(x);
}
pragma "inline" proc cos(x : real(32)) {
  _extern proc cosf(x: real(32)): real(32);
  return cosf(x);
}
pragma "inline" proc cosh(x : real(32)) {
  _extern proc coshf(x: real(32)): real(32);
  return coshf(x);
}
pragma "inline" proc erf(x : real(32)) {
  _extern proc erff(x: real(32)): real(32);
  return erff(x);
}
pragma "inline" proc erfc(x : real(32)) {
  _extern proc erfcf(x: real(32)): real(32);
  return erfcf(x);
}
pragma "inline" proc exp(x : real(32)) {
  _extern proc expf(x: real(32)): real(32);
  return expf(x);
}
pragma "inline" proc exp2(x : real(32)) {
  _extern proc exp2f(x: real(32)): real(32);
  return exp2f(x);
}
pragma "inline" proc expm1(x : real(32)) {
  _extern proc expm1f(x: real(32)): real(32);
  return expm1f(x);
}
pragma "inline" proc abs(x : real(32)) {
  _extern proc fabsf(x: real(32)): real(32);
  return fabsf(x);
}
pragma "inline" proc floor(x : real(32)) {
  _extern proc floorf(x: real(32)): real(32);
  return floorf(x);
}
pragma "inline" proc lgamma(x : real(32)) {
  _extern proc lgammaf(x: real(32)): real(32);
  return lgammaf(x);
}
pragma "inline" proc log(x : real(32)) {
  _extern proc logf(x: real(32)): real(32);
  return logf(x);
}
pragma "inline" proc log2(x : real(32)) {
  _extern proc log2f(x: real(32)): real(32);
  return log2f(x);
}
pragma "inline" proc log10(x : real(32)) {
  _extern proc log10f(x: real(32)): real(32);
  return log10f(x);
}
pragma "inline" proc log1p(x : real(32)) {
  _extern proc log1pf(x: real(32)): real(32);
  return log1pf(x);
}
pragma "inline" proc nearbyint(x : real(32)) {
  _extern proc nearbyintf(x: real(32)): real(32);
  return nearbyintf(x);
}
pragma "inline" proc rint(x : real(32)) {
  _extern proc rintf(x: real(32)): real(32);
  return rintf(x);
}
pragma "inline" proc round(x : real(32)) {
  _extern proc roundf(x: real(32)): real(32);
  return roundf(x);
}
pragma "inline" proc sin(x: real(32)) {
  _extern proc sinf(x: real(32)): real(32);
  return sinf(x);
}
pragma "inline" proc sinh(x : real(32)) {
  _extern proc sinhf(x: real(32)): real(32);
  return sinhf(x);
}
pragma "inline" proc sqrt(x : real(32)): real(32) {
  _extern proc sqrtf(x: real(32)): real(32);
  return sqrtf(x);
}
pragma "inline" proc tan(x : real(32)) {
  _extern proc tanf(x: real(32)): real(32);
  return tanf(x);
}
pragma "inline" proc tanh(x : real(32)) {
  _extern proc tanhf(x: real(32)): real(32);
  return tanhf(x);
}
pragma "inline" proc tgamma(x : real(32)) {
  _extern proc tgammaf(x: real(32)): real(32);
  return tgammaf(x);
}
pragma "inline" proc trunc(x : real(32)) {
  _extern proc truncf(x: real(32)): real(32);
  return truncf(x);
}

proc _logBasePow2Help(in val, baseLog2) {
  var result = -1;
  while (val != 0) {
    val >>= baseLog2;
    result += 1;
  }
  return result;
}

proc logBasePow2(in val: int(?w), baseLog2) {
  if (val < 1) {
    halt("Can't take the log() of a non-positive integer");
  }
  return _logBasePow2Help(val, baseLog2);
}

proc logBasePow2(in val: uint(?w), baseLog2) {
  if (val < 1) {
    halt("Can't take the log() of a non-positive integer");
  }
  return _logBasePow2Help(val, baseLog2);
}

proc log2(in val: int(?w)) {
  return logBasePow2(val, 1);
}

proc log2(in val: uint(?w)) {
  return logBasePow2(val, 1);
}


Add TODO for 004

Add TODO for 004

/*
 * Largest palindrome product
 */

config const width = 3;

// Setup a domain, which will allow us to iterate from 999 down to 100 in two
// dimension, i.e. 999, 999; 999, 998; 999, 997; ... ; 998, 999; ... ; etc.
const min = 10 ** (width - 1),
  max = (10 ** width) - 1,
  D = {min..max by -1, min..max by -1};

// Returns whether or not the number is a palindrome.
proc isPalindrome(num) {
  var strNum = num: string;
  for i in 1..(strNum.length / 2) {
    if strNum.substring(i) != strNum.substring(strNum.length - i + 1) {
      return false;
    }
  }
  return true;
}

// TODO: Maybe it would be faster to calculate all of the products in parallel
//       and then reduce the max. (thomasvandoren, 2014-08-19)
var maxResult = (0, -1, -1);
for (i, j) in D {
  var result = i * j;
  if result > maxResult(1) && isPalindrome(result) {
    maxResult = (result, i, j);
  }
}

writef("%di = %di * %di\n", maxResult(1), maxResult(2), maxResult(3));

/*
 * Largest palindrome product
 */

config const width = 3;

// Setup a domain, which will allow us to iterate from 999 down to 100 in two
// dimension, i.e. 999, 999; 999, 998; 999, 997; ... ; 998, 999; ... ; etc.
const min = 10 ** (width - 1),
  max = (10 ** width) - 1,
  D = {min..max by -1, min..max by -1};

// Returns whether or not the number is a palindrome.
proc isPalindrome(num) {
  var strNum = num: string;
  for i in 1..(strNum.length / 2) {
    if strNum.substring(i) != strNum.substring(strNum.length - i + 1) {
      return false;
    }
  }
  return true;
}

var maxResult = (0, -1, -1);
for (i, j) in D {
  var result = i * j;
  if result > maxResult(1) && isPalindrome(result) {
    maxResult = (result, i, j);
  }
}

writef("%di = %di * %di\n", maxResult(1), maxResult(2), maxResult(3));


Starting cleanup.  Converted [l..h-1] expressions to [l..h)
and cleaned up some debugging stuff.

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@7744 3a8e244f-b0f2-452b-bcba-4c88e055c3ca

// BLC: For certain inputs, not having a complex/real
// function can result in numerical instability.

// BLC: clean up complex arithmetic

use Random;
use Time;

config const logN = 5;

config const debug = false,
             printTiming = true;

config const epsilon = 2.0 ** -51.0,
             threshold = 16.0;

def main() {
  const N = 1 << logN;

  const D = [0..N);
  const DW = [0..N/4);

  var A: [D] complex;
  var B: [D] complex;
  var W: [DW] complex;

  [i in D] {
    A(i).real = 2*i;
    A(i).imag = A(i).real + 1.0;
  }

  fillRandomVec(A);

  B = A;                       // save A for verification step

  twiddles(W);
  W = bitReverse(W);

  // BLC: would like this to be:
  //  A.imag = -A.imag;            // conjugate data
  A = conjg(A);

  var fftTimer: Timer;
  fftTimer.start();

  A = bitReverse(A);

  // BLC: Why was John timing the second version?
  dfft(A, W);
  fftTimer.stop();

  // BLC: originally wrote this as:
  //  A.real =  A.real / N;        // conjugate and scale data
  //  A.imag = -A.imag / N;
  // but it doesn't currently work.  Maybe that's OK because the
  // rewrite is pretty clean

  // BLC: This line only works if /(complex,real) is implemented
  // correctly:
  A = conjg(A) / N;

  A = bitReverse(A);
  dfft(A, W);

  var time = fftTimer.elapsed();

  if debug then {
    var C: [D] float = sqrt((B.real - A.real)**2 + (B.imag - A.imag)**2);
    writeln("error[] =", C);
  }
  var maxerr = max reduce sqrt((B.real - A.real)**2 + (B.imag - A.imag)**2);

  maxerr = maxerr / logN / epsilon;

  var status = if (maxerr < threshold) then "SUCCESS" else "FAILURE";
  writeln(status, ", error = ", maxerr);
  writeln("\n");

  writeln("N      = ", N);
  if (printTiming) {
    writeln("Time   = ", time);
    const gflop = 5.0 * N * logN / 1000000000.0;
    writeln("GFlops = ", gflop / time);
  }
}

def twiddles(W: [?WD] complex) {
  const n = WD(1).length;
  const delta = 2.0 * atan(1.0) / n;

  W(0) = 1.0;
  W(n/2) = let cosDeltaN = cos(delta * n/2)
            in (cosDeltaN, cosDeltaN):complex;
  forall i in [1..n/2) {
    const x = cos(delta*i);
    const y = sin(delta*i);
    W(i)     = (x, y):complex;
    W(n - i) = (y, x):complex;
  }
}

// Check what the NSA supports for bit reversal
// rename this?
def bitReverse(W: [?WD] complex) {  // BLC: would be nice to drop complex?
  const n = WD(1).length;
  const reverse = lg(n);
  var V: [WD] complex;
  /* BLC: could we do this as a permutation instead?
  var P: [i in WD] index(WD) = i;
  bitReverse(P);
  V(P) = W;
  */
  forall i in WD {  // BLC: could this be a uint domain?
    // BLC: what does this bitReverse function do with high-order bits?
    // BLC: could this be rewritten as one line?
    var ndx = bitReverse(i:uint(64), numBits=reverse);
    V(ndx:int) = W(i); // BLC: unfortunate cast
  }
  // BLC: W = V would be preferable
  return V;
}

def dfft(A: [?AD] complex, W) {
  /*
  if (debug) {
    write("w[] =");
    for i in W.domain do write(W(i):" %g %g");
    writeln();
  }
  */

  if debug then writeln("cft1st();");
  cft1st(A, W);

  var l = 4;
  var lasti = 2;
  for i in 4..logN/2 by 2 {
    if debug then writeln("cftmd1(l=", l, ", A, W);");
    cftmd1(l, A, W);
    l *= 4;
    lasti = i;
  }
  //  writeln("lasti+2 = ", lasti+2, " logN-1 = ", logN-1);
  for i in [lasti+2..logN) by 2 {
    if debug then writeln("i=", i, "  cftmd2(l=", l, ", A, W);");
    cftmd2(l, A, W);
    if debug then writeln("i=", i, "  returned from cftmd2();");
    l *= 4;
  }

  const n = AD(1).length;
  if ((l << 2) == n) {
    if debug then writeln("l << 2 == n");
    forall j in [0..l) {
      butterfly(1.0, 1.0, 1.0, A[j..j+3*l by l]);
    }
  } else {
    if debug then writeln("l << 2 != n");
    forall j in [0..l) {
      var a = A(j);
      var b = A(j+l);
      A(j) = a + b;
      A(j+l) = a - b;
    }
  }
}

def cft1st(A, W) {
  const n = A.domain(1).length;
  var x0 = A(0) + A(1);
  var x1 = A(0) - A(1);
  var x2 = A(2) + A(3);
  var x3 = A(2) - A(3);

  const wk1r = W(1).real;

  A(0) = x0 + x2;
  A(2) = x0 - x2;
  A(1) = (x1.real - x3.imag, x1.imag + x3.real):complex;
  A(3) = (x1.real + x3.imag, x1.imag - x3.real):complex;

  x0 = A(4) + A(5);
  x1 = A(4) - A(5);
  x2 = A(6) + A(7);
  x3 = A(6) - A(7);
  A(4) = x0 + x2;
  A(6) = (x2.imag - x0.imag, x0.real - x2.real):complex;
  x0 = (x1.real - x3.imag, x1.imag + x3.real):complex;
  A(5) = wk1r * (x0.real - x0.imag, x0.real + x0.imag):complex;
  x0 = (x3.imag + x1.real, x3.real - x1.imag):complex;
  A(7) = wk1r * (x0.imag - x0.real, x0.imag + x0.real):complex;

  if debug then writeln("  // computes first 8 complexes manually");

  var k1 = 1;
  forall j in [8..n) by 8 {
    var wk2 = W(k1);
    var wk1 = W(2*k1);
    var wk3 = (wk1.real - 2* wk2.imag * wk1.imag,
               2 * wk2.imag * wk1.real - wk1.imag):complex;

    butterfly(wk1, wk2, wk3, A[j..j+3]);

    //    writeln("accessing: ", 2*k1+1);
    wk1 = W(2*k1+1);
    wk3 = (wk1.real - 2*wk2.real * wk1.imag,
           2*wk2.real * wk1.real - wk1.imag):complex;
    wk2 = (-wk2.imag, wk2.real): complex;
    butterfly(wk1, wk2, wk3, A[j+4..j+7]);

    k1 += 1;
  }
}

def cftmd0(l, A, W) {
  var wk1r = W(1).real;
  const m = l << 2;

  forall j in [0..l) {
    butterfly(1.0, 1.0, 1.0, A[j..j+3*l by l]);
  }

  forall j in [m..m+l) {
    butterfly((wk1r, wk1r):complex, 1.0i, (-wk1r, wk1r):complex,
              A[j..j+3*l by l]);
  }
}

def cftmd1(l, A, W) {
  const m = l << 2;
  const m2 = 2*m;
  const n = A.domain(1).length;

  if debug then writeln("  cftmd0(l=", l, ", A, W);");
  cftmd0(l, A, W);
  if debug then writeln("  returned from cftmd0();");
  var k1 = 1;
  forall k in [m2..n) by m2 {
    var wk2 = W[k1];
    var wk1 = W[2*k1];
    var wk3 = (wk1.real - 2 * wk2.imag * wk1.imag,
               2 * wk2.imag * wk1.real - wk1.imag):complex;
    for j in [k..k+l) {
      butterfly(wk1, wk2, wk3, A[j..j+3*l by l]);
    }

    wk1 = W[2*k1+1];
    wk3 = (wk1.real - 2 * wk2.real * wk1.imag,
           2 * wk2.real * wk1.real - wk1.imag):complex;

    for j in [k+m..k+m+l) {
      butterfly(wk1, (-wk2.imag, wk2.real):complex, wk3, A[j..j+3*l by l]);
    }

    k1 += 1;
  }
}

def cftmd2(l, A, W) {
  var m = l << 2;
  var m2 = 2*m;
  const n = A.domain(1).length;

  if debug then writeln("  cftmd0(l=", l, ", A, W);");
  cftmd0(l, A, W);
  if debug then writeln("  returned from cftmd0();");
  if (m2 >= n) return;
  if (m2 >= n / 8) {
    if debug then writeln("  cftmd21(l=", l, ", A, W);");
    cftmd21(l, A, W);
    if debug then writeln("  returned from cftmd21();");
    return;
  }

  forall j in [0..l) {
    var k1 = 1;  // BLC: zip this in
    forall k in [m2..n) by m2 {
      var wk2 = W[k1];
      var wk1 = W[k1 + k1];
      var wk3 = (wk1.real - 2*wk2.imag * wk1.imag,
                 2 * wk2.imag * wk1.real - wk1.imag): complex;
      butterfly(wk1, wk2, wk3, A[j+k..j+k+3*l by l]);

      k1 += 1;
    }

    k1 = 1;  // BLC: zip this in
    forall k in [m2..n) by m2 {
      var wk2 = W[k1];
      var wk1 = W[2*k1 + 1];
      var wk3 = (wk1.real - 2*wk2.real * wk1.imag,
                 2*wk2.real * wk1.real - wk1.imag): complex;
      wk2 = (-wk2.imag, wk2.real): complex;

      butterfly(wk1, wk2, wk3, A[j+k+m..j+k+m+3*l by l]);

      k1 += 1;
    }
  }
}

def cftmd21(l, A, W) {
  const n = A.domain(1).length;
  var m = l << 2;
  var m2 = 2*m;
  var m3 = 3*m;

  var k1 = 1;
  for k in [m2..n) by m2 {
    var wk2 = W[k1];
    var wk1 = W[2*k1];
    var wk3 = (wk1.real - 2*wk2.imag * wk1.imag,
               2* wk2.imag * wk1.real - wk1.imag): complex;

    forall j in [k..k+l) {
      butterfly(wk1, wk2, wk3, A[j..j+3*l by l]);
    }

    wk1 = W[2*k1 + 1];
    wk3 = (wk1.real - 2*wk2.real * wk1.imag,
           2*wk2.real * wk1.real - wk1.imag): complex;
    wk2 = (-wk2.imag, wk2.real): complex;

    forall j in [k+m..k+m+l) {
      butterfly(wk1, wk2, wk3, A[j..j+3*l by l]);
    }

    k1 += 1;
  }
}

def butterfly(wk1: complex, wk2: complex, wk3: complex,
              inout A:[1..4] complex) {
  var x0 = A[1] + A[2];
  var x1 = A[1] - A[2];
  var x2 = A[3] + A[4];
  var x3 = A[3] - A[4];

  if (debug) {
    writeln("    a=", A[1]:"{%g,%g}", ", b=", A[2]:"{%g,%g}", ", c=", A[3]:"{%g,%g}", ", d=", A[4]:"{%g,%g}");
    writeln("      wk1=", wk1:"%g + %gi");
    writeln("      wk2=", wk2:"%g + %gi");
    writeln("      wk3=", wk3:"%g + %gi");

    writeln();

    writeln("      x0=", x0:"%g %g");
    writeln("      x1=", x1:"%g %g");
    writeln("      x2=", x2:"%g %g");
    writeln("      x3=", x3:"%g %g");
  }

  A[1] = x0 + x2;
  x0 -= x2;
  if debug then writeln("      x0=", x0:"%g %g");
  A[3] = wk2 * x0;
  x0 = (x1.real - x3.imag, x1.imag + x3.real):complex;
  if debug then writeln("      x0=", x0:"%g %g");
  A[2] = wk1 * x0;
  x0 = (x1.real + x3.imag, x1.imag - x3.real):complex;
  if debug then writeln("      x0=", x0:"%g %g");
  A[4] = wk3 * x0;

  if (debug) {
    writeln("    a=", A[1]:"{%g,%g}", ", b=", A[2]:"{%g,%g}", ", c=", A[3]:"{%g,%g}", ", d=", A[4]:"{%g,%g}\n");
  }
}

use Random;
use Time;

// BLC: clean up complex arithmetic

config const logN = 5;
config const debug = false;
config const printTiming = false;

// BLC: This call needs to go away
def resetA(A: [?D] complex) {
  /*
  [i in D] {
    A(i).real = 2*i;
    A(i).imag = A(i).real + 1.0;
  }
  */
}

def writeA(A) {
  write("a[] =");
  for i in A.domain do write(A(i):" %g %g");
  writeln();
}

def main() {
  const N = 1 << logN;
  const gflop = 5.0 * N * logN / 1000000000.0;

  const EPS = 2.0 ** -51.0;
  const THRESHOLD = 16.0;

  const D = [0..N-1];
  const DW = [0..N/4-1];

  var A: [D] complex;
  var B: [D] complex;
  var W: [DW] complex;

  [i in D] {
    A(i).real = 2*i;
    A(i).imag = A(i).real + 1.0;
  }

  fillRandomVec(A);
  if debug then writeA(A);

  B = A;                       // save A for verification step

  twiddles(W);
  W = bitReverse(W);

  // BLC: would like this to be:
  //  A.imag = -A.imag;            // conjugate data
  A = conjg(A);
  if debug then writeA(A);

  var fftTimer: Timer;
  fftTimer.start();

  A = bitReverse(A);

  // BLC: This line needs to go away
  resetA(A);

  // BLC: Why was John timing the second version?
  if debug then writeA(A);
  dfft(A, W);
  if debug then writeA(A);
  fftTimer.stop();

  // BLC: originally wrote this as:
  //  A.real =  A.real / N;        // conjugate and scale data
  //  A.imag = -A.imag / N;
  // but it doesn't currently work.  Maybe that's OK because the
  // rewrite is pretty clean

  // BLC: This line only works if /(complex,real) is implemented
  // correctly:
  A = conjg(A) / N;

  if debug then writeA(A);

  A = bitReverse(A);
  dfft(A, W);
  if debug then writeA(A);

  var time = fftTimer.elapsed();

  if debug then {
    var C: [D] float = sqrt((B.real - A.real)**2 + (B.imag - A.imag)**2);
    writeln("error[] =", C);
  }
  var maxerr = max reduce sqrt((B.real - A.real)**2 + (B.imag - A.imag)**2);

  maxerr = maxerr / logN / EPS;

  var status = if (maxerr < THRESHOLD) then "SUCCESS" else "FAILURE";
  writeln(status, ", error = ", maxerr);
  writeln("\n");

  writeln("N      = ", N);
  if (printTiming) {
    writeln("Time   = ", time);
    writeln("GFlops = ", gflop / time);
  }
}

def twiddles(W: [?WD] complex) {
  const n = WD(1).length;
  const delta = 2.0 * atan(1.0) / n;

  W(0) = 1.0;
  W(n/2) = let cosDeltaN = cos(delta * n/2)
            in (cosDeltaN, cosDeltaN):complex;
  forall i in 1..n/2-1 {
    const x = cos(delta*i);
    const y = sin(delta*i);
    W(i)     = (x, y):complex;
    W(n - i) = (y, x):complex;
  }
}

// Check what the NSA supports for bit reversal
// rename this?
def bitReverse(W: [?WD] complex) {  // BLC: would be nice to drop complex?
  const n = WD(1).length;
  const reverse = lg(n);
  var V: [WD] complex;
  /* BLC: could we do this as a permutation instead?
  var P: [i in WD] index(WD) = i;
  bitReverse(P);
  V(P) = W;
  */
  forall i in WD {  // BLC: could this be a uint domain?
    // BLC: what does this bitReverse function do with high-order bits?
    // BLC: could this be rewritten as one line?
    var ndx = bitReverse(i:uint(64), numBits=reverse);
    V(ndx:int) = W(i); // BLC: unfortunate cast
  }
  // BLC: W = V would be preferable
  return V;
}

def dfft(A: [?AD] complex, W) {
  /*
  if (debug) {
    write("w[] =");
    for i in W.domain do write(W(i):" %g %g");
    writeln();
  }
  */

  if debug then writeln("cft1st();");
  cft1st(A, W);

  var l = 4;
  var lasti = 2;
  for i in 4..logN/2 by 2 {
    if debug then writeln("cftmd1(l=", l, ", A, W);");
    cftmd1(l, A, W);
    l *= 4;
    lasti = i;
  }
  //  writeln("lasti+2 = ", lasti+2, " logN-1 = ", logN-1);
  for i in lasti+2..logN-1 by 2 {
    if debug then writeln("i=", i, "  cftmd2(l=", l, ", A, W);");
    cftmd2(l, A, W);
    if debug then writeln("i=", i, "  returned from cftmd2();");
    l *= 4;
  }

  const n = AD(1).length;
  if ((l << 2) == n) {
    if debug then writeln("l << 2 == n");
    forall j in 0..l-1 {
      resetA(A);
      butterfly(1.0, 1.0, 1.0, A[j..j+3*l by l]);
    }
  } else {
    if debug then writeln("l << 2 != n");
    forall j in 0..l-1 {
      var a = A(j);
      var b = A(j+l);
      A(j) = a + b;
      A(j+l) = a - b;
    }
  }
}

def cft1st(A, W) {
  const n = A.domain(1).length;
  var x0 = A(0) + A(1);
  var x1 = A(0) - A(1);
  var x2 = A(2) + A(3);
  var x3 = A(2) - A(3);

  const wk1r = W(1).real;

  if debug then writeA(A);

  A(0) = x0 + x2;
  A(2) = x0 - x2;
  A(1) = (x1.real - x3.imag, x1.imag + x3.real):complex;
  A(3) = (x1.real + x3.imag, x1.imag - x3.real):complex;

  x0 = A(4) + A(5);
  x1 = A(4) - A(5);
  x2 = A(6) + A(7);
  x3 = A(6) - A(7);
  A(4) = x0 + x2;
  A(6) = (x2.imag - x0.imag, x0.real - x2.real):complex;
  x0 = (x1.real - x3.imag, x1.imag + x3.real):complex;
  A(5) = wk1r * (x0.real - x0.imag, x0.real + x0.imag):complex;
  x0 = (x3.imag + x1.real, x3.real - x1.imag):complex;
  A(7) = wk1r * (x0.imag - x0.real, x0.imag + x0.real):complex;

  if debug then writeln("  // computes first 8 complexes manually");

  if debug then writeA(A);

  var k1 = 1;
  forall j in 8..n-1 by 8 {
    var wk2 = W(k1);
    var wk1 = W(2*k1);
    var wk3 = (wk1.real - 2* wk2.imag * wk1.imag,
               2 * wk2.imag * wk1.real - wk1.imag):complex;

    resetA(A);
    butterfly(wk1, wk2, wk3, A[j..j+3]);

    //    writeln("accessing: ", 2*k1+1);
    wk1 = W(2*k1+1);
    wk3 = (wk1.real - 2*wk2.real * wk1.imag,
           2*wk2.real * wk1.real - wk1.imag):complex;
    wk2 = (-wk2.imag, wk2.real): complex;
    resetA(A);
    butterfly(wk1, wk2, wk3, A[j+4..j+7]);

    k1 += 1;
  }
}

def cftmd0(l, A, W) {
  var wk1r = W(1).real;
  const m = l << 2;

  //  if debug then writeA(A);

  forall j in 0..l-1 {
    resetA(A);
    butterfly(1.0, 1.0, 1.0, A[j..j+3*l by l]);
  }

  forall j in m..l+m-1 {
    resetA(A);
    butterfly((wk1r, wk1r):complex, 1.0i, (-wk1r, wk1r):complex,
              A[j..j+3*l by l]);
  }
}

def cftmd1(l, A, W) {
  const m = l << 2;
  const m2 = 2*m;
  const n = A.domain(1).length;

  if debug then writeln("  cftmd0(l=", l, ", A, W);");
  cftmd0(l, A, W);
  if debug then writeln("  returned from cftmd0();");
  var k1 = 1;
  forall k in m2..n-1 by m2 {
    var wk2 = W[k1];
    var wk1 = W[2*k1];
    var wk3 = (wk1.real - 2 * wk2.imag * wk1.imag,
               2 * wk2.imag * wk1.real - wk1.imag):complex;
    for j in k..l+k-1 {
      resetA(A);
      butterfly(wk1, wk2, wk3, A[j..j+3*l by l]);
    }

    wk1 = W[2*k1+1];
    wk3 = (wk1.real - 2 * wk2.real * wk1.imag,
           2 * wk2.real * wk1.real - wk1.imag):complex;

    for j in k+m..l+k+m-1 {
      resetA(A);
      butterfly(wk1, (-wk2.imag, wk2.real):complex, wk3, A[j..j+3*l by l]);
    }

    k1 += 1;
  }
}

def cftmd2(l, A, W) {
  var m = l << 2;
  var m2 = 2*m;
  const n = A.domain(1).length;

  if debug then writeln("  cftmd0(l=", l, ", A, W);");
  cftmd0(l, A, W);
  if debug then writeln("  returned from cftmd0();");
  if (m2 >= n) return;
  if (m2 >= n / 8) {
    if debug then writeln("  cftmd21(l=", l, ", A, W);");
    cftmd21(l, A, W);
    if debug then writeln("  returned from cftmd21();");
    return;
  }

  forall j in 0..l-1 {
    var k1 = 1;  // BLC: zip this in
    forall k in m2..n-1 by m2 {
      var wk2 = W[k1];
      var wk1 = W[k1 + k1];
      var wk3 = (wk1.real - 2*wk2.imag * wk1.imag,
                 2 * wk2.imag * wk1.real - wk1.imag): complex;
      resetA(A);
      butterfly(wk1, wk2, wk3, A[j+k..j+k+3*l by l]);

      k1 += 1;
    }

    k1 = 1;  // BLC: zip this in
    forall k in m2..n-1 by m2 {
      var wk2 = W[k1];
      var wk1 = W[2*k1 + 1];
      var wk3 = (wk1.real - 2*wk2.real * wk1.imag,
                 2*wk2.real * wk1.real - wk1.imag): complex;
      wk2 = (-wk2.imag, wk2.real): complex;

      resetA(A);
      butterfly(wk1, wk2, wk3, A[j+k+m..j+k+m+3*l by l]);

      k1 += 1;
    }
  }
}

def cftmd21(l, A, W) {
  const n = A.domain(1).length;
  var m = l << 2;
  var m2 = 2*m;
  var m3 = 3*m;

  var k1 = 1;
  for k in m2..n-1 by m2 {
    var wk2 = W[k1];
    var wk1 = W[2*k1];
    var wk3 = (wk1.real - 2*wk2.imag * wk1.imag,
               2* wk2.imag * wk1.real - wk1.imag): complex;

    forall j in k..k+l-1 {
      resetA(A);
      butterfly(wk1, wk2, wk3, A[j..j+3*l by l]);
    }

    wk1 = W[2*k1 + 1];
    wk3 = (wk1.real - 2*wk2.real * wk1.imag,
           2*wk2.real * wk1.real - wk1.imag): complex;
    wk2 = (-wk2.imag, wk2.real): complex;

    forall j in k+m..k+m+l-1 {
      resetA(A);
      butterfly(wk1, wk2, wk3, A[j..j+3*l by l]);
    }

    k1 += 1;
  }
}

def butterfly(wk1: complex, wk2: complex, wk3: complex,
              inout A:[1..4] complex) {
  var x0 = A[1] + A[2];
  var x1 = A[1] - A[2];
  var x2 = A[3] + A[4];
  var x3 = A[3] - A[4];

  if (debug) {
    writeln("    a=", A[1]:"{%g,%g}", ", b=", A[2]:"{%g,%g}", ", c=", A[3]:"{%g,%g}", ", d=", A[4]:"{%g,%g}");
    writeln("      wk1=", wk1:"%g + %gi");
    writeln("      wk2=", wk2:"%g + %gi");
    writeln("      wk3=", wk3:"%g + %gi");

    writeln();

    writeln("      x0=", x0:"%g %g");
    writeln("      x1=", x1:"%g %g");
    writeln("      x2=", x2:"%g %g");
    writeln("      x3=", x3:"%g %g");
  }

  A[1] = x0 + x2;
  x0 -= x2;
  if debug then writeln("      x0=", x0:"%g %g");
  A[3] = wk2 * x0;
  x0 = (x1.real - x3.imag, x1.imag + x3.real):complex;
  if debug then writeln("      x0=", x0:"%g %g");
  A[2] = wk1 * x0;
  x0 = (x1.real + x3.imag, x1.imag - x3.real):complex;
  if debug then writeln("      x0=", x0:"%g %g");
  A[4] = wk3 * x0;

  if (debug) {
    writeln("    a=", A[1]:"{%g,%g}", ", b=", A[2]:"{%g,%g}", ", c=", A[3]:"{%g,%g}", ", d=", A[4]:"{%g,%g}\n");
  }
}


Added a 'param' version of abs(integral).

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@19123 3a8e244f-b0f2-452b-bcba-4c88e055c3ca

_extern const INFINITY: real(64);
_extern const NAN: real(64);

pragma "inline" proc abs(i : int(?w)) return if i < 0 then -i else i;
pragma "inline" proc abs(i : uint(?w)) return i;
proc abs(param i : integral) param return if i < 0 then -i else i;
pragma "inline" proc abs(x : complex(?w)) return sqrt(x.re*x.re + x.im*x.im);

// We can't use "numeric" here because signum is not defined on a complex type.
// It might be good to have a "scalar" class to encompass integral and real but not complex.
pragma "inline" proc sgn(i : integral) return (i > 0) : i.type - (i < 0) : i.type;
pragma "inline" proc sgn(x : real(?w)) return (x > 0.0) : x.type - (x < 0.0) : x.type;

pragma "inline" proc conjg(a: complex(?w)) return (a.re, -a.im):complex;

_extern proc isinf(x: real(64)): bool;
_extern proc isinf(x: real(32)): bool;
_extern proc isfinite(x: real(64)): bool;
_extern proc isfinite(x: real(32)): bool;
_extern proc isnan(x: real(64)): bool;
_extern proc isnan(x: real(32)): bool;

_extern proc acos(x: real(64)): real(64);
_extern proc acosh(x: real(64)): real(64);
_extern proc asin(x: real(64)): real(64);
_extern proc asinh(x: real(64)): real(64);
_extern proc atan(x: real(64)): real(64);
_extern proc atan2(y: real(64), x: real(64)): real(64);
_extern proc atanh(x: real(64)): real(64);
_extern proc cbrt(x: real(64)): real(64);
_extern proc ceil(x: real(64)): real(64);
_extern proc cos(x: real(64)): real(64);
_extern proc cosh(x: real(64)): real(64);
_extern proc erf(x: real(64)): real(64);
_extern proc erfc(x: real(64)): real(64);
_extern proc exp(x: real(64)): real(64);
_extern proc exp2(x: real(64)): real(64);
_extern proc expm1(x: real(64)): real(64);
_extern proc fabs(x: real(64)): real(64);
_extern proc floor(x: real(64)): real(64);
_extern proc lgamma(x: real(64)): real(64);
_extern proc log(x: real(64)): real(64);
_extern proc log2(x: real(64)): real(64);
_extern proc log10(x: real(64)): real(64);
_extern proc log1p(x: real(64)): real(64);
_extern proc nearbyint(x: real(64)): real(64);
_extern proc rint(x: real(64)): real(64);
_extern proc round(x: real(64)): real(64);
_extern proc sin(x: real(64)): real(64);
_extern proc sinh(x: real(64)): real(64);
_extern proc sqrt(x: real(64)): real(64);
_extern proc tan(x: real(64)): real(64);
_extern proc tanh(x: real(64)): real(64);
_extern proc tgamma(x: real(64)): real(64);
_extern proc trunc(x: real(64)): real(64);

pragma "inline" proc acos(x : real(32)) {
  _extern proc acosf(x: real(32)): real(32);
  return acosf(x);
}
pragma "inline" proc acosh(x : real(32)) {
  _extern proc acoshf(x: real(32)): real(32);
  return acoshf(x);
}
pragma "inline" proc asin(x : real(32)) {
  _extern proc asinf(x: real(32)): real(32);
  return asinf(x);
}
pragma "inline" proc asinh(x : real(32)) {
  _extern proc asinhf(x: real(32)): real(32);
  return asinhf(x);
}
pragma "inline" proc atan(x : real(32)) {
  _extern proc atanf(x: real(32)): real(32);
  return atanf(x);
}
pragma "inline" proc atan2(y : real(32), x: real(32)) {
  _extern proc atan2f(y: real(32), x: real(32)): real(32);
  return atan2f(y, x);
}
pragma "inline" proc atanh(x : real(32)) {
  _extern proc atanhf(x: real(32)): real(32);
  return atanhf(x);
}
pragma "inline" proc cbrt(x : real(32)) {
  _extern proc cbrtf(x: real(32)): real(32);
  return cbrtf(x);
}
pragma "inline" proc ceil(x : real(32)) {
  _extern proc ceilf(x: real(32)): real(32);
  return ceilf(x);
}
pragma "inline" proc cos(x : real(32)) {
  _extern proc cosf(x: real(32)): real(32);
  return cosf(x);
}
pragma "inline" proc cosh(x : real(32)) {
  _extern proc coshf(x: real(32)): real(32);
  return coshf(x);
}
pragma "inline" proc erf(x : real(32)) {
  _extern proc erff(x: real(32)): real(32);
  return erff(x);
}
pragma "inline" proc erfc(x : real(32)) {
  _extern proc erfcf(x: real(32)): real(32);
  return erfcf(x);
}
pragma "inline" proc exp(x : real(32)) {
  _extern proc expf(x: real(32)): real(32);
  return expf(x);
}
pragma "inline" proc exp2(x : real(32)) {
  _extern proc exp2f(x: real(32)): real(32);
  return exp2f(x);
}
pragma "inline" proc expm1(x : real(32)) {
  _extern proc expm1f(x: real(32)): real(32);
  return expm1f(x);
}
pragma "inline" proc abs(x : real(32)) {
  _extern proc fabsf(x: real(32)): real(32);
  return fabsf(x);
}
pragma "inline" proc floor(x : real(32)) {
  _extern proc floorf(x: real(32)): real(32);
  return floorf(x);
}
pragma "inline" proc lgamma(x : real(32)) {
  _extern proc lgammaf(x: real(32)): real(32);
  return lgammaf(x);
}
pragma "inline" proc log(x : real(32)) {
  _extern proc logf(x: real(32)): real(32);
  return logf(x);
}
pragma "inline" proc log2(x : real(32)) {
  _extern proc log2f(x: real(32)): real(32);
  return log2f(x);
}
pragma "inline" proc log10(x : real(32)) {
  _extern proc log10f(x: real(32)): real(32);
  return log10f(x);
}
pragma "inline" proc log1p(x : real(32)) {
  _extern proc log1pf(x: real(32)): real(32);
  return log1pf(x);
}
pragma "inline" proc nearbyint(x : real(32)) {
  _extern proc nearbyintf(x: real(32)): real(32);
  return nearbyintf(x);
}
pragma "inline" proc rint(x : real(32)) {
  _extern proc rintf(x: real(32)): real(32);
  return rintf(x);
}
pragma "inline" proc round(x : real(32)) {
  _extern proc roundf(x: real(32)): real(32);
  return roundf(x);
}
pragma "inline" proc sin(x: real(32)) {
  _extern proc sinf(x: real(32)): real(32);
  return sinf(x);
}
pragma "inline" proc sinh(x : real(32)) {
  _extern proc sinhf(x: real(32)): real(32);
  return sinhf(x);
}
pragma "inline" proc sqrt(x : real(32)): real(32) {
  _extern proc sqrtf(x: real(32)): real(32);
  return sqrtf(x);
}
pragma "inline" proc tan(x : real(32)) {
  _extern proc tanf(x: real(32)): real(32);
  return tanf(x);
}
pragma "inline" proc tanh(x : real(32)) {
  _extern proc tanhf(x: real(32)): real(32);
  return tanhf(x);
}
pragma "inline" proc tgamma(x : real(32)) {
  _extern proc tgammaf(x: real(32)): real(32);
  return tgammaf(x);
}
pragma "inline" proc trunc(x : real(32)) {
  _extern proc truncf(x: real(32)): real(32);
  return truncf(x);
}

proc _logBasePow2Help(in val, baseLog2) {
  var result = -1;
  while (val != 0) {
    val >>= baseLog2;
    result += 1;
  }
  return result;
}

proc logBasePow2(in val: int(?w), baseLog2) {
  if (val < 1) {
    halt("Can't take the log() of a non-positive integer");
  }
  return _logBasePow2Help(val, baseLog2);
}

proc logBasePow2(in val: uint(?w), baseLog2) {
  if (val < 1) {
    halt("Can't take the log() of a non-positive integer");
  }
  return _logBasePow2Help(val, baseLog2);
}

proc log2(in val: int(?w)) {
  return logBasePow2(val, 1);
}

proc log2(in val: uint(?w)) {
  return logBasePow2(val, 1);
}

// Performance note: if argument(s) is(are) of unsigned type(s),
// fewer condititionals will be evaluated at run time.
proc divceil(m: integral, n: integral) return
  if isNonnegative(m) then
    if isNonnegative(n) then (m + n - 1) / n
    else                     m / n
  else
    if isNonnegative(n) then m / n
    else                     (m + n + 1) / n;

proc divceil(param m: integral, param n: integral) param return
  if isNonnegative(m) then
    if isNonnegative(n) then (m + n - 1) / n
    else                     m / n
  else
    if isNonnegative(n) then m / n
    else                     (m + n + 1) / n;

// Performance note: if argument(s) is(are) of unsigned type(s),
// fewer condititionals will be evaluated at run time.
proc divfloor(m: integral, n: integral) return
  if isNonnegative(m) then
    if isNonnegative(n) then m / n
    else                     (m - n - 1) / n
  else
    if isNonnegative(n) then (m - n + 1) / n
    else                     m / n;

proc divfloor(param m: integral, param n: integral) param return
  if isNonnegative(m) then
    if isNonnegative(n) then m / n
    else                     (m - n - 1) / n
  else
    if isNonnegative(n) then (m - n + 1) / n
    else                     m / n;

// This codes up the standard definition, according to Wikipedia.
// Is there a more efficient implementation for reals?
proc mod(x: real(?w), y: real(w)): real(w) {
  return x - y*floor(x/y);
}

// Performance note: if argument(s) is(are) of unsigned type(s),
// fewer condititionals will be evaluated at run time.
proc mod(m: integral, n: integral) {
  const temp = m % n;

  // eliminate some run-time tests if input(s) is(are) unsigned
  return
    if isNonnegative(n) then
      if _isUnsignedType(m.type)
      then temp
      else ( if temp >= 0 then temp else temp + n )
    else
      // n < 0
      ( if temp <= 0 then temp else temp + n );
}

proc mod(param m: integral, param n: integral) param {
  param temp = m % n;

  // verbatim copy from the other 'mod', to simplify maintenance
  return
    if isNonnegative(n) then
      if _isUnsignedType(m.type)
      then temp
      else ( if temp >= 0 then temp else temp + n )
    else
      // n < 0
      ( if temp <= 0 then temp else temp + n );
}

_extern const INFINITY: real(64);
_extern const NAN: real(64);

pragma "inline" proc abs(i : int(?w)) return if i < 0 then -i else i;
pragma "inline" proc abs(i : uint(?w)) return i;
pragma "inline" proc abs(x : complex(?w)) return sqrt(x.re*x.re + x.im*x.im);

// We can't use "numeric" here because signum is not defined on a complex type.
// It might be good to have a "scalar" class to encompass integral and real but not complex.
pragma "inline" proc sgn(i : integral) return (i > 0) : i.type - (i < 0) : i.type;
pragma "inline" proc sgn(x : real(?w)) return (x > 0.0) : x.type - (x < 0.0) : x.type;

pragma "inline" proc conjg(a: complex(?w)) return (a.re, -a.im):complex;

_extern proc isinf(x: real(64)): bool;
_extern proc isinf(x: real(32)): bool;
_extern proc isfinite(x: real(64)): bool;
_extern proc isfinite(x: real(32)): bool;
_extern proc isnan(x: real(64)): bool;
_extern proc isnan(x: real(32)): bool;

_extern proc acos(x: real(64)): real(64);
_extern proc acosh(x: real(64)): real(64);
_extern proc asin(x: real(64)): real(64);
_extern proc asinh(x: real(64)): real(64);
_extern proc atan(x: real(64)): real(64);
_extern proc atan2(y: real(64), x: real(64)): real(64);
_extern proc atanh(x: real(64)): real(64);
_extern proc cbrt(x: real(64)): real(64);
_extern proc ceil(x: real(64)): real(64);
_extern proc cos(x: real(64)): real(64);
_extern proc cosh(x: real(64)): real(64);
_extern proc erf(x: real(64)): real(64);
_extern proc erfc(x: real(64)): real(64);
_extern proc exp(x: real(64)): real(64);
_extern proc exp2(x: real(64)): real(64);
_extern proc expm1(x: real(64)): real(64);
_extern proc fabs(x: real(64)): real(64);
_extern proc floor(x: real(64)): real(64);
_extern proc lgamma(x: real(64)): real(64);
_extern proc log(x: real(64)): real(64);
_extern proc log2(x: real(64)): real(64);
_extern proc log10(x: real(64)): real(64);
_extern proc log1p(x: real(64)): real(64);
_extern proc nearbyint(x: real(64)): real(64);
_extern proc rint(x: real(64)): real(64);
_extern proc round(x: real(64)): real(64);
_extern proc sin(x: real(64)): real(64);
_extern proc sinh(x: real(64)): real(64);
_extern proc sqrt(x: real(64)): real(64);
_extern proc tan(x: real(64)): real(64);
_extern proc tanh(x: real(64)): real(64);
_extern proc tgamma(x: real(64)): real(64);
_extern proc trunc(x: real(64)): real(64);

pragma "inline" proc acos(x : real(32)) {
  _extern proc acosf(x: real(32)): real(32);
  return acosf(x);
}
pragma "inline" proc acosh(x : real(32)) {
  _extern proc acoshf(x: real(32)): real(32);
  return acoshf(x);
}
pragma "inline" proc asin(x : real(32)) {
  _extern proc asinf(x: real(32)): real(32);
  return asinf(x);
}
pragma "inline" proc asinh(x : real(32)) {
  _extern proc asinhf(x: real(32)): real(32);
  return asinhf(x);
}
pragma "inline" proc atan(x : real(32)) {
  _extern proc atanf(x: real(32)): real(32);
  return atanf(x);
}
pragma "inline" proc atan2(y : real(32), x: real(32)) {
  _extern proc atan2f(y: real(32), x: real(32)): real(32);
  return atan2f(y, x);
}
pragma "inline" proc atanh(x : real(32)) {
  _extern proc atanhf(x: real(32)): real(32);
  return atanhf(x);
}
pragma "inline" proc cbrt(x : real(32)) {
  _extern proc cbrtf(x: real(32)): real(32);
  return cbrtf(x);
}
pragma "inline" proc ceil(x : real(32)) {
  _extern proc ceilf(x: real(32)): real(32);
  return ceilf(x);
}
pragma "inline" proc cos(x : real(32)) {
  _extern proc cosf(x: real(32)): real(32);
  return cosf(x);
}
pragma "inline" proc cosh(x : real(32)) {
  _extern proc coshf(x: real(32)): real(32);
  return coshf(x);
}
pragma "inline" proc erf(x : real(32)) {
  _extern proc erff(x: real(32)): real(32);
  return erff(x);
}
pragma "inline" proc erfc(x : real(32)) {
  _extern proc erfcf(x: real(32)): real(32);
  return erfcf(x);
}
pragma "inline" proc exp(x : real(32)) {
  _extern proc expf(x: real(32)): real(32);
  return expf(x);
}
pragma "inline" proc exp2(x : real(32)) {
  _extern proc exp2f(x: real(32)): real(32);
  return exp2f(x);
}
pragma "inline" proc expm1(x : real(32)) {
  _extern proc expm1f(x: real(32)): real(32);
  return expm1f(x);
}
pragma "inline" proc abs(x : real(32)) {
  _extern proc fabsf(x: real(32)): real(32);
  return fabsf(x);
}
pragma "inline" proc floor(x : real(32)) {
  _extern proc floorf(x: real(32)): real(32);
  return floorf(x);
}
pragma "inline" proc lgamma(x : real(32)) {
  _extern proc lgammaf(x: real(32)): real(32);
  return lgammaf(x);
}
pragma "inline" proc log(x : real(32)) {
  _extern proc logf(x: real(32)): real(32);
  return logf(x);
}
pragma "inline" proc log2(x : real(32)) {
  _extern proc log2f(x: real(32)): real(32);
  return log2f(x);
}
pragma "inline" proc log10(x : real(32)) {
  _extern proc log10f(x: real(32)): real(32);
  return log10f(x);
}
pragma "inline" proc log1p(x : real(32)) {
  _extern proc log1pf(x: real(32)): real(32);
  return log1pf(x);
}
pragma "inline" proc nearbyint(x : real(32)) {
  _extern proc nearbyintf(x: real(32)): real(32);
  return nearbyintf(x);
}
pragma "inline" proc rint(x : real(32)) {
  _extern proc rintf(x: real(32)): real(32);
  return rintf(x);
}
pragma "inline" proc round(x : real(32)) {
  _extern proc roundf(x: real(32)): real(32);
  return roundf(x);
}
pragma "inline" proc sin(x: real(32)) {
  _extern proc sinf(x: real(32)): real(32);
  return sinf(x);
}
pragma "inline" proc sinh(x : real(32)) {
  _extern proc sinhf(x: real(32)): real(32);
  return sinhf(x);
}
pragma "inline" proc sqrt(x : real(32)): real(32) {
  _extern proc sqrtf(x: real(32)): real(32);
  return sqrtf(x);
}
pragma "inline" proc tan(x : real(32)) {
  _extern proc tanf(x: real(32)): real(32);
  return tanf(x);
}
pragma "inline" proc tanh(x : real(32)) {
  _extern proc tanhf(x: real(32)): real(32);
  return tanhf(x);
}
pragma "inline" proc tgamma(x : real(32)) {
  _extern proc tgammaf(x: real(32)): real(32);
  return tgammaf(x);
}
pragma "inline" proc trunc(x : real(32)) {
  _extern proc truncf(x: real(32)): real(32);
  return truncf(x);
}

proc _logBasePow2Help(in val, baseLog2) {
  var result = -1;
  while (val != 0) {
    val >>= baseLog2;
    result += 1;
  }
  return result;
}

proc logBasePow2(in val: int(?w), baseLog2) {
  if (val < 1) {
    halt("Can't take the log() of a non-positive integer");
  }
  return _logBasePow2Help(val, baseLog2);
}

proc logBasePow2(in val: uint(?w), baseLog2) {
  if (val < 1) {
    halt("Can't take the log() of a non-positive integer");
  }
  return _logBasePow2Help(val, baseLog2);
}

proc log2(in val: int(?w)) {
  return logBasePow2(val, 1);
}

proc log2(in val: uint(?w)) {
  return logBasePow2(val, 1);
}

// Performance note: if argument(s) is(are) of unsigned type(s),
// fewer condititionals will be evaluated at run time.
proc divceil(m: integral, n: integral) return
  if isNonnegative(m) then
    if isNonnegative(n) then (m + n - 1) / n
    else                     m / n
  else
    if isNonnegative(n) then m / n
    else                     (m + n + 1) / n;

proc divceil(param m: integral, param n: integral) param return
  if isNonnegative(m) then
    if isNonnegative(n) then (m + n - 1) / n
    else                     m / n
  else
    if isNonnegative(n) then m / n
    else                     (m + n + 1) / n;

// Performance note: if argument(s) is(are) of unsigned type(s),
// fewer condititionals will be evaluated at run time.
proc divfloor(m: integral, n: integral) return
  if isNonnegative(m) then
    if isNonnegative(n) then m / n
    else                     (m - n - 1) / n
  else
    if isNonnegative(n) then (m - n + 1) / n
    else                     m / n;

proc divfloor(param m: integral, param n: integral) param return
  if isNonnegative(m) then
    if isNonnegative(n) then m / n
    else                     (m - n - 1) / n
  else
    if isNonnegative(n) then (m - n + 1) / n
    else                     m / n;

// This codes up the standard definition, according to Wikipedia.
// Is there a more efficient implementation for reals?
proc mod(x: real(?w), y: real(w)): real(w) {
  return x - y*floor(x/y);
}

// Performance note: if argument(s) is(are) of unsigned type(s),
// fewer condititionals will be evaluated at run time.
proc mod(m: integral, n: integral) {
  const temp = m % n;

  // eliminate some run-time tests if input(s) is(are) unsigned
  return
    if isNonnegative(n) then
      if _isUnsignedType(m.type)
      then temp
      else ( if temp >= 0 then temp else temp + n )
    else
      // n < 0
      ( if temp <= 0 then temp else temp + n );
}

proc mod(param m: integral, param n: integral) param {
  param temp = m % n;

  // verbatim copy from the other 'mod', to simplify maintenance
  return
    if isNonnegative(n) then
      if _isUnsignedType(m.type)
      then temp
      else ( if temp >= 0 then temp else temp + n )
    else
      // n < 0
      ( if temp <= 0 then temp else temp + n );
}


BradsBlock1DPar.chpl: Minor edit, removed redundant serial iterators

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@14328 3a8e244f-b0f2-452b-bcba-4c88e055c3ca

// TODO: Have the global class leader/follower iterators defer to the
// local class leader/followers once we're within a locale?

// TODO: Make these into an official distribution?

// TODO: Would using nested classes allow me to avoid so much
// passing around of globIndexType and locIndexType?

config param debugBradsBlock1D = false;

// TODO: This would need to be moved somewhere more standard
enum IteratorType { leader, follower };

//
// The distribution class
//
class Block1DDist {
  //
  // The distribution's index type and domain's global index type
  //
  type glbIdxType = int(64);

  //
  // The bounding box that defines the block distribution
  //
  const boundingBox: domain(1, glbIdxType);

  //
  // a domain and array describing the set of target locales to which
  // the indices are mapped
  //
  const targetLocDom: domain(1);
  const targetLocs: [targetLocDom] locale;
  //
  // NOTE: originally I wrote this as:
  //
  //   const targetLocs = Locales;
  //   const targetLocDom = targetLocs.domain;
  //
  // but this had two interesting problems:
  //
  // (1) the capture of the targetLocs array only makes a copy of the
  //     array, not of its domain, so if someone were to resize the
  //     LocaleSpace domain outside of the class, this would inadvertantly
  //     get resized as well.  We really want to make a copy of both the
  //     domain and array (which I now do in the constructor).
  //
  // (2) Initializing targetLocs with Locales prevents us from assigning
  //     anything other than a numLocales-ary array of locales to it
  //     which is stricter than I wanted -- I only wanted to restrict
  //     us to a 1D array of locales.  In our current model, this would
  //     require us to have some sort of [domain(1)] locale declaration
  //     to make it work.  Or we could think about whether a model in
  //     which only the array's static type information is inferred
  //     for a field?

  //
  // an array of local distribution class descriptors -- set up in
  // initialize() below
  //
  // TODO: would like this to be const and initialize in-place,
  // removing the initialize method; would want to be able to use
  // an on-clause at the expression list to make this work.
  // Otherwise, would have to move the allocation into a function
  // just to get it at the statement level.
  //
  // WANTED:
  //
  /*
  const locDist: [loc in targetLocDom] LocBlock1DDist(glbIdxType)
                   = on targetLocs(loc) do
                       new LocBlock1DDist(glbIdxType, targetLocDom.order(loc), this);
  */
  //
  // but this doesn't work yet because an array forall initializer
  // apparently can't refer to a local member domain.
  //
  const locDist: [targetLocDom] LocBlock1DDist(glbIdxType);
  //
  // WORKAROUND: Initialize in the constructor instead
  //

  def Block1DDist(type glbIdxType = int(64), bbox: domain(1, glbIdxType),
                  targetLocales: [?targetLocalesDomain] locale) {
    boundingBox = bbox;
    targetLocDom = targetLocalesDomain;
    targetLocs = targetLocales;
    //
    // WANT TO DO:
    /*
    for locid in targetLocDom do
      on targetLocs(locid) do
        locDist(locid) = new LocBlock1DDist(glbIdxType, locid, this);
    */
    //
    // BUT results in a _heapAlloc(type int(64)) call.
    // WORKAROUND:
    helpConstruct();
  }
  //
  // WORKAROUND CONTINUED:
  //
  def helpConstruct() {
    for locid in targetLocDom do
      on targetLocs(locid) do
        locDist(locid) = new LocBlock1DDist(glbIdxType, locid, this);
  }
  //
  // END WORKAROUND
  //

  def writeThis(x:Writer) {
    x.writeln("BradsBlock1DPar");
    x.writeln("---------------");
    x.writeln("distributes: ", boundingBox);
    x.writeln("across locales: ", targetLocs);
    x.writeln("indexed via: ", targetLocDom);
    x.writeln("resulting in: ");
    for locid in targetLocDom do
      x.writeln("  [", locid, "] ", locDist(locid));
  }

  //
  // Create a new domain over this distribution with the given index
  // set (inds) and the given global and local index type (idxType,
  // locIdxType)
  //
  def newDomain(inds, type idxType = glbIdxType, type locIdxType = idxType) {
    // Note that I'm fixing the global and local index types to be the
    // same, but making this a generic function would fix this
    return new Block1DDom(idxType, locIdxType, this, inds);
  }

  //
  // compute what chunk of inds is owned by a given locale -- assumes
  // it's being called on the locale in question
  //
  def getChunk(inds, locid) {
    // use domain slicing to get the intersection between what the
    // locale owns and the domain's index set

    // TODO: Should this be able to be written as myChunk[inds] ???
    return locDist(locid).myChunk(inds.dim(1));
  }

  //
  // Determine which locale owns a particular index
  //
  def ind2locInd(ind: glbIdxType) {
    const ind0 = ind - boundingBox.low;
    const loc0 = (ind0 * targetLocs.numElements) / boundingBox.numIndices;
    const locInd = loc0: index(targetLocs.domain) + targetLocs.domain.low;
    return locInd;
  }

  def ind2loc(ind: glbIdxType) {
    return targetLocs(ind2locInd(ind));
  }
}

//
// A per-locale local distribution class
//
class LocBlock1DDist {
  //
  // The distribution's index type and domain's global index type
  //
  type glbIdxType;

  //
  // This stores the piece of the global bounding box owned by
  // the locale.  Note that my original guess that we'd want
  // to use lclIdxType here is wrong since we're talking about
  // the section of the global index space owned by the locale.
  //
  const myChunk: domain(1, glbIdxType);
  const locid: int;
  const loc: locale;

  //
  // Compute what chunk of index(1) is owned by the current locale
  // Arguments:
  //
  def LocBlock1DDist(type glbIdxType,
                     _locid: int, // the locale index from the target domain
                     dist: Block1DDist(glbIdxType) // reference to glob dist
                     ) {
    locid = _locid;
    loc = dist.targetLocs(locid);
    const lo = dist.boundingBox.low;
    const hi = dist.boundingBox.high;
    const numelems = hi - lo + 1;
    const numlocs = dist.targetLocDom.numIndices;
    const locid0 = dist.targetLocDom.order(locid); // 0-based locale ID
    const blo = if (locid == 0) then min(glbIdxType)
                else procToData((numelems: real * locid) / numlocs, lo);
    const bhi = if (locid == numlocs - 1) then max(glbIdxType)
                else procToData((numelems: real * (locid+1)) / numlocs, lo) - 1;
    myChunk = [blo..bhi];
    if debugBradsBlock1D then
      writeln("locale ", locid, " owns ", myChunk);
  }

  //
  // a helper function for mapping processors to indices
  //
  def procToData(x, lo)
    return (lo + (x: lo.type) + (x:real != x:int:real));

  def writeThis(x:Writer) {
    x.write("locale ", loc.id, " owns chunk: ", myChunk);
  }
}

//
// The global domain class
//
class Block1DDom {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // a pointer to the parent distribution
  //
  const dist: Block1DDist(glbIdxType);

  //
  // a domain describing the complete domain
  //
  const whole: domain(1, glbIdxType);

  //
  // an array of local domain class descriptors -- set up in
  // initialize() below
  //
  //
  // TODO: would like this to be const and initialize in-place,
  // removing the initialize method; would want to be able to use
  // an on-clause at the expression list to make this work.
  // Otherwise, would have to move the allocation into a function
  // just to get it at the statement level.
  //
  var locDoms: [dist.targetLocDom] LocBlock1DDom(glbIdxType, lclIdxType);

  def initialize() {
    for locid in dist.targetLocDom do
      on dist.targetLocs(locid) do
        locDoms(locid) = new LocBlock1DDom(glbIdxType, lclIdxType, this,
                                           dist.getChunk(whole, locid));
    if debugBradsBlock1D then
      [loc in dist.targetLocDom] writeln(loc, " owns ", locDoms(loc));
  }

  //
  // the iterator for the domain -- currently sequential
  //
  def these() {
    for blk in locDoms do
      // TODO: Would want to do something like:
      // on blk do
      // But can't currently have yields in on clauses
        for ind in blk do
          yield ind;
  }

  //
  // this is the parallel iterator for the global domain, following
  // a variation on Steve and David's proposals -- I've split the
  // single iterator into two iterators, distinguished by where
  // clauses on their parameter values.  This permits each to only
  // take the parameters it cares about; permits the leader to be
  // defined in an inlineable way; and permits the follower for an
  // array iterator to be a var iterator
  //
  // I've named these methods newThese() for the time being
  // to avoid conflicting with the above which is currently targeted
  // by the compiler.  My current assumption is that we would want to
  // overload these() to serve this purpose in the final language
  // definition.
  //
  def newThese(param iterator: IteratorType)
        where iterator == IteratorType.leader {
    //
    // TODO: This currently only results in a single level of
    // per-locale parallelism -- no per-core parallelism; maybe
    // approach this by deferring to the local leader/follower
    // iterators at some point?
    //
    // TODO: Really want the parallelism across the target locales
    // to be expressed more independently of the distribution by
    // pushing it into the leader iterator.  Need to get an on clause
    // into here somehow.  That is:
    //
    //   coforall locDom in locDoms do
    //     on locDom do
    //       yield locDom.myBlock - whole.low;
    //
    // TODO: And really want to split the inter- and intra-locale
    // parallelism into two separate stages for communication
    // optimization and the like
    //
    // TODO: Abstract this subtraction of low into a function?
    // Note relationship between this operation and the
    // order/position functions -- any chance for creating similar
    // support? (esp. given how frequent this seems likely to be?)
    //
    for locDom in locDoms do
      yield locDom.myBlock - whole.low;
  }

  def newThese(param iterator: IteratorType, followThis)
        where iterator == IteratorType.follower {
    //
    // TODO: Abstract this addition of low into a function?
    // Note relationship between this operation and the
    // order/position functions -- any chance for creating similar
    // support? (esp. given how frequent this seems likely to be?)
    //
    // TODO: Is there some clever way to invoke the leader/follower
    // iterator on the local blocks in here such that the per-core
    // parallelism is expressed at that level?  Seems like a nice
    // natural composition and might help with my fears about how
    // stencil communication will be done on a per-locale basis.
    for i in followThis {
      yield i + whole.low;
    }
  }

  //
  // the print method for the domain
  //
  def writeThis(x:Writer) {
    x.write(whole);
  }

  //
  // how to allocate a new array over this domain
  //
  def newArray(type elemType) {
    return new Block1DArr(glbIdxType, lclIdxType, elemType, this);
  }

  //
  // queries for the number of indices, low, and high bounds
  //
  def numIndices {
    return whole.numIndices;
  }

  def low {
    return whole.low;
  }

  def high {
    return whole.high;
  }
}

//
// the local domain class
//
class LocBlock1DDom {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // a reference to the parent global domain class
  //
  const wholeDom: Block1DDom(glbIdxType, lclIdxType);

  //
  // a local domain describing the indices owned by this locale
  //
  var myBlock: domain(1, lclIdxType);

  //
  // iterator over this locale's indices
  //
  def these() {
    // May want to do something like:
    // on this do
    // But can't currently have yields in on clauses
    for ind in myBlock do
      yield ind;
  }

  //
  // this is the parallel iterator for the local domain, see global
  // domain parallel iterators for general notes on the approach
  //
  def newThese(param iterator: IteratorType)
        where iterator == IteratorType.leader {
  }

  def newThese(param iterator: IteratorType, followThis)
        where iterator == IteratorType.follower {
  }

  //
  // how to write out this locale's indices
  //
  def writeThis(x:Writer) {
    x.write(myBlock);
  }

  //
  // queries for this locale's number of indices, low, and high bounds
  //
  def numIndices {
    return myBlock.numIndices;
  }

  def low {
    return myBlock.low;
  }

  def high {
    return myBlock.high;
  }
}

//
// the global array class
//
class Block1DArr {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // the array's element type
  //
  type elemType;

  //
  // the global domain descriptor for this array
  //
  var dom: Block1DDom(glbIdxType, lclIdxType);

  //
  // an array of local array classes
  //
  // TODO: would like this to be const and initialize in-place,
  // removing the initialize method; would want to be able to use
  // an on-clause at the expression list to make this work.
  // Otherwise, would have to move the allocation into a function
  // just to get it at the statement level.
  //
  var locArr: [dom.dist.targetLocDom] LocBlock1DArr(glbIdxType, lclIdxType, elemType);

  def initialize() {
    for locid in dom.dist.targetLocDom do
      on dom.dist.targetLocs(locid) do
        locArr(locid) = new LocBlock1DArr(glbIdxType, lclIdxType, elemType, dom.locDoms(locid));
  }

  //
  // the global accessor for the array
  //
  def this(i: glbIdxType) var {
    return locArr(dom.dist.ind2locInd(i))(i);
  }

  //
  // the iterator over the array's elements, currently sequential
  //
  def these() var {
    for loc in dom.dist.targetLocDom {
      // TODO: May want to do something like:
      // on this do
      // But can't currently have yields in on clauses
      for elem in locArr(loc) {
        yield elem;
      }
    }
  }

  //
  // this is the parallel iterator for the global array, see th
  // example for general notes on the approach
  //

  def newThese(param iterator: IteratorType)
        where iterator == IteratorType.leader {
    for blk in dom.newThese(IteratorType.leader) do
      yield blk;
  }

  def newThese(param iterator: IteratorType, followThis) var
        where iterator == IteratorType.follower {
    for i in followThis {
      yield this(i + dom.low);
    }
  }

  //
  // how to print out the whole array, sequentially
  //
  def writeThis(x: Writer) {
    var first = true;
    for loc in dom.dist.targetLocDom {
      // May want to do something like the following:
      //      on loc {
      // but it causes deadlock -- see writeThisUsingOn.chpl
        if (locArr(loc).numElements >= 1) {
          if (first) {
            first = false;
          } else {
            x.write(" ");
          }
          x.write(locArr(loc));
        }
        //    }
      stdout.flush();
    }
  }

  //
  // a query for the number of elements in the array
  //
  def numElements {
    return dom.numIndices;
  }
}

//
// the local array class
//
class LocBlock1DArr {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // the element type
  //
  type elemType;

  //
  // a reference to the local domain class for this array and locale
  //
  const locDom: LocBlock1DDom(glbIdxType, lclIdxType);

  //
  // the block of local array data
  //
  var myElems: [locDom.myBlock] elemType;

  //
  // the accessor for the local array -- assumes the index is local
  //
  def this(i: lclIdxType) var {
    return myElems(i);
  }

  //
  // iterator over the elements owned by this locale
  //
  def these() var {
    for elem in myElems {
      yield elem;
    }
  }

  //
  // this is the parallel iterator for the local array, see global
  // domain parallel iterators for general notes on the approach
  //
  def newThese(param iterator: IteratorType)
        where iterator == IteratorType.leader {
  }

  def newThese(param iterator: IteratorType, followThis)
        where iterator == IteratorType.follower {
  }

  //
  // prints out this locale's piece of the array
  //
  def writeThis(x: Writer) {
    // May want to do something like the following:
    //      on loc {
    // but it causes deadlock -- see writeThisUsingOn.chpl
    x.write(myElems);
  }

  //
  // query for the number of local array elements
  //
  def numElements {
    return myElems.numElements;
  }
}

// TODO: Have the global class leader/follower iterators defer to the
// local class leader/followers once we're within a locale?

// TODO: Make these into an official distribution?

// TODO: Would using nested classes allow me to avoid so much
// passing around of globIndexType and locIndexType?

config param debugBradsBlock1D = false;

// TODO: This would need to be moved somewhere more standard
enum IteratorType { leader, follower };

//
// The distribution class
//
class Block1DDist {
  //
  // The distribution's index type and domain's global index type
  //
  type glbIdxType = int(64);

  //
  // The bounding box that defines the block distribution
  //
  const boundingBox: domain(1, glbIdxType);

  //
  // a domain and array describing the set of target locales to which
  // the indices are mapped
  //
  const targetLocDom: domain(1);
  const targetLocs: [targetLocDom] locale;
  //
  // NOTE: originally I wrote this as:
  //
  //   const targetLocs = Locales;
  //   const targetLocDom = targetLocs.domain;
  //
  // but this had two interesting problems:
  //
  // (1) the capture of the targetLocs array only makes a copy of the
  //     array, not of its domain, so if someone were to resize the
  //     LocaleSpace domain outside of the class, this would inadvertantly
  //     get resized as well.  We really want to make a copy of both the
  //     domain and array (which I now do in the constructor).
  //
  // (2) Initializing targetLocs with Locales prevents us from assigning
  //     anything other than a numLocales-ary array of locales to it
  //     which is stricter than I wanted -- I only wanted to restrict
  //     us to a 1D array of locales.  In our current model, this would
  //     require us to have some sort of [domain(1)] locale declaration
  //     to make it work.  Or we could think about whether a model in
  //     which only the array's static type information is inferred
  //     for a field?

  //
  // an array of local distribution class descriptors -- set up in
  // initialize() below
  //
  // TODO: would like this to be const and initialize in-place,
  // removing the initialize method; would want to be able to use
  // an on-clause at the expression list to make this work.
  // Otherwise, would have to move the allocation into a function
  // just to get it at the statement level.
  //
  // WANTED:
  //
  /*
  const locDist: [loc in targetLocDom] LocBlock1DDist(glbIdxType)
                   = on targetLocs(loc) do
                       new LocBlock1DDist(glbIdxType, targetLocDom.order(loc), this);
  */
  //
  // but this doesn't work yet because an array forall initializer
  // apparently can't refer to a local member domain.
  //
  const locDist: [targetLocDom] LocBlock1DDist(glbIdxType);
  //
  // WORKAROUND: Initialize in the constructor instead
  //

  def Block1DDist(type glbIdxType = int(64), bbox: domain(1, glbIdxType),
                  targetLocales: [?targetLocalesDomain] locale) {
    boundingBox = bbox;
    targetLocDom = targetLocalesDomain;
    targetLocs = targetLocales;
    //
    // WANT TO DO:
    /*
    for locid in targetLocDom do
      on targetLocs(locid) do
        locDist(locid) = new LocBlock1DDist(glbIdxType, locid, this);
    */
    //
    // BUT results in a _heapAlloc(type int(64)) call.
    // WORKAROUND:
    helpConstruct();
  }
  //
  // WORKAROUND CONTINUED:
  //
  def helpConstruct() {
    for locid in targetLocDom do
      on targetLocs(locid) do
        locDist(locid) = new LocBlock1DDist(glbIdxType, locid, this);
  }
  //
  // END WORKAROUND
  //

  def writeThis(x:Writer) {
    x.writeln("BradsBlock1DPar");
    x.writeln("---------------");
    x.writeln("distributes: ", boundingBox);
    x.writeln("across locales: ", targetLocs);
    x.writeln("indexed via: ", targetLocDom);
    x.writeln("resulting in: ");
    for locid in targetLocDom do
      x.writeln("  [", locid, "] ", locDist(locid));
  }

  //
  // Create a new domain over this distribution with the given index
  // set (inds) and the given global and local index type (idxType,
  // locIdxType)
  //
  def newDomain(inds, type idxType = glbIdxType, type locIdxType = idxType) {
    // Note that I'm fixing the global and local index types to be the
    // same, but making this a generic function would fix this
    return new Block1DDom(idxType, locIdxType, this, inds);
  }

  //
  // compute what chunk of inds is owned by a given locale -- assumes
  // it's being called on the locale in question
  //
  def getChunk(inds, locid) {
    // use domain slicing to get the intersection between what the
    // locale owns and the domain's index set

    // TODO: Should this be able to be written as myChunk[inds] ???
    return locDist(locid).myChunk(inds.dim(1));
  }

  //
  // Determine which locale owns a particular index
  //
  def ind2locInd(ind: glbIdxType) {
    const ind0 = ind - boundingBox.low;
    const loc0 = (ind0 * targetLocs.numElements) / boundingBox.numIndices;
    const locInd = loc0: index(targetLocs.domain) + targetLocs.domain.low;
    return locInd;
  }

  def ind2loc(ind: glbIdxType) {
    return targetLocs(ind2locInd(ind));
  }
}

//
// A per-locale local distribution class
//
class LocBlock1DDist {
  //
  // The distribution's index type and domain's global index type
  //
  type glbIdxType;

  //
  // This stores the piece of the global bounding box owned by
  // the locale.  Note that my original guess that we'd want
  // to use lclIdxType here is wrong since we're talking about
  // the section of the global index space owned by the locale.
  //
  const myChunk: domain(1, glbIdxType);
  const locid: int;
  const loc: locale;

  //
  // Compute what chunk of index(1) is owned by the current locale
  // Arguments:
  //
  def LocBlock1DDist(type glbIdxType,
                     _locid: int, // the locale index from the target domain
                     dist: Block1DDist(glbIdxType) // reference to glob dist
                     ) {
    locid = _locid;
    loc = dist.targetLocs(locid);
    const lo = dist.boundingBox.low;
    const hi = dist.boundingBox.high;
    const numelems = hi - lo + 1;
    const numlocs = dist.targetLocDom.numIndices;
    const locid0 = dist.targetLocDom.order(locid); // 0-based locale ID
    const blo = if (locid == 0) then min(glbIdxType)
                else procToData((numelems: real * locid) / numlocs, lo);
    const bhi = if (locid == numlocs - 1) then max(glbIdxType)
                else procToData((numelems: real * (locid+1)) / numlocs, lo) - 1;
    myChunk = [blo..bhi];
    if debugBradsBlock1D then
      writeln("locale ", locid, " owns ", myChunk);
  }

  //
  // a helper function for mapping processors to indices
  //
  def procToData(x, lo)
    return (lo + (x: lo.type) + (x:real != x:int:real));

  def writeThis(x:Writer) {
    x.write("locale ", loc.id, " owns chunk: ", myChunk);
  }
}

//
// The global domain class
//
class Block1DDom {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // a pointer to the parent distribution
  //
  const dist: Block1DDist(glbIdxType);

  //
  // a domain describing the complete domain
  //
  const whole: domain(1, glbIdxType);

  //
  // an array of local domain class descriptors -- set up in
  // initialize() below
  //
  //
  // TODO: would like this to be const and initialize in-place,
  // removing the initialize method; would want to be able to use
  // an on-clause at the expression list to make this work.
  // Otherwise, would have to move the allocation into a function
  // just to get it at the statement level.
  //
  var locDoms: [dist.targetLocDom] LocBlock1DDom(glbIdxType, lclIdxType);

  def initialize() {
    for locid in dist.targetLocDom do
      on dist.targetLocs(locid) do
        locDoms(locid) = new LocBlock1DDom(glbIdxType, lclIdxType, this,
                                           dist.getChunk(whole, locid));
    if debugBradsBlock1D then
      [loc in dist.targetLocDom] writeln(loc, " owns ", locDoms(loc));
  }

  //
  // the iterator for the domain -- currently sequential
  //
  def these() {
    for blk in locDoms do
      // May want to do something like:
      // on blk do
      // But can't currently have yields in on clauses
        for ind in blk do
          yield ind;
  }

  //
  // this is the parallel iterator for the global domain, following
  // a variation on Steve and David's proposals -- I've split the
  // single iterator into multiple iterators, distinguished by where
  // clauses on their parameter values.  This permits each to only
  // take the parameters it cares about; permits the leader to be
  // defined in an inlineable way; and permits the follower for an
  // array iterator to be a var iterator
  //
  // I've named these methods newThese() for the time being
  // to avoid conflicting with the above which is currently targeted
  // by the compiler.  My current assumption is that we would want to
  // overload these() to serve this purpose in the final language
  // definition.
  //
  def newThese() {
    //
    // TODO: Should still have this move around between locales even
    // though it's serial
    //
    for i in these() do
      yield i;
  }

  def newThese(param iterator: IteratorType)
        where iterator == IteratorType.leader {
    //
    // TODO: This currently only results in a single level of
    // per-locale parallelism -- no per-core parallelism; maybe
    // approach this by deferring to the local leader/follower
    // iterators at some point?
    //
    // TODO: Really want the parallelism across the target locales
    // to be expressed more independently of the distribution by
    // pushing it into the leader iterator.  Need to get an on clause
    // into here somehow.  That is:
    //
    //   coforall locDom in locDoms do
    //     on locDom do
    //       yield locDom.myBlock - whole.low;
    //
    // TODO: And really want to split the inter- and intra-locale
    // parallelism into two separate stages for communication
    // optimization and the like
    //
    // TODO: Abstract this subtraction of low into a function?
    // Note relationship between this operation and the
    // order/position functions -- any chance for creating similar
    // support? (esp. given how frequent this seems likely to be?)
    //
    for locDom in locDoms do
      yield locDom.myBlock - whole.low;
  }

  def newThese(param iterator: IteratorType, followThis)
        where iterator == IteratorType.follower {
    //
    // TODO: Abstract this addition of low into a function?
    // Note relationship between this operation and the
    // order/position functions -- any chance for creating similar
    // support? (esp. given how frequent this seems likely to be?)
    //
    // TODO: Is there some clever way to invoke the leader/follower
    // iterator on the local blocks in here such that the per-core
    // parallelism is expressed at that level?  Seems like a nice
    // natural composition and might help with my fears about how
    // stencil communication will be done on a per-locale basis.
    for i in followThis {
      yield i + whole.low;
    }
  }

  //
  // the print method for the domain
  //
  def writeThis(x:Writer) {
    x.write(whole);
  }

  //
  // how to allocate a new array over this domain
  //
  def newArray(type elemType) {
    return new Block1DArr(glbIdxType, lclIdxType, elemType, this);
  }

  //
  // queries for the number of indices, low, and high bounds
  //
  def numIndices {
    return whole.numIndices;
  }

  def low {
    return whole.low;
  }

  def high {
    return whole.high;
  }
}

//
// the local domain class
//
class LocBlock1DDom {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // a reference to the parent global domain class
  //
  const wholeDom: Block1DDom(glbIdxType, lclIdxType);

  //
  // a local domain describing the indices owned by this locale
  //
  var myBlock: domain(1, lclIdxType);

  //
  // iterator over this locale's indices
  //
  def these() {
    // May want to do something like:
    // on this do
    // But can't currently have yields in on clauses
    for ind in myBlock do
      yield ind;
  }

  //
  // this is the parallel iterator for the local domain, see global
  // domain parallel iterators for general notes on the approach
  //
  def newThese() {
  }

  def newThese(param iterator: IteratorType)
        where iterator == IteratorType.leader {
  }

  def newThese(param iterator: IteratorType, followThis)
        where iterator == IteratorType.follower {
  }

  //
  // how to write out this locale's indices
  //
  def writeThis(x:Writer) {
    x.write(myBlock);
  }

  //
  // queries for this locale's number of indices, low, and high bounds
  //
  def numIndices {
    return myBlock.numIndices;
  }

  def low {
    return myBlock.low;
  }

  def high {
    return myBlock.high;
  }
}

//
// the global array class
//
class Block1DArr {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // the array's element type
  //
  type elemType;

  //
  // the global domain descriptor for this array
  //
  var dom: Block1DDom(glbIdxType, lclIdxType);

  //
  // an array of local array classes
  //
  // TODO: would like this to be const and initialize in-place,
  // removing the initialize method; would want to be able to use
  // an on-clause at the expression list to make this work.
  // Otherwise, would have to move the allocation into a function
  // just to get it at the statement level.
  //
  var locArr: [dom.dist.targetLocDom] LocBlock1DArr(glbIdxType, lclIdxType, elemType);

  def initialize() {
    for locid in dom.dist.targetLocDom do
      on dom.dist.targetLocs(locid) do
        locArr(locid) = new LocBlock1DArr(glbIdxType, lclIdxType, elemType, dom.locDoms(locid));
  }

  //
  // the global accessor for the array
  //
  def this(i: glbIdxType) var {
    return locArr(dom.dist.ind2locInd(i))(i);
  }

  //
  // the iterator over the array's elements, currently sequential
  //
  def these() var {
    for loc in dom.dist.targetLocDom {
      // May want to do something like:
      // on this do
      // But can't currently have yields in on clauses
      for elem in locArr(loc) {
        yield elem;
      }
    }
  }

  //
  // this is the parallel iterator for the global array, see th
  // example for general notes on the approach
  //
  def newThese() {
    //
    // TODO: Should still have this move around between locales even
    // though it's serial
    //
    for i in these() do
      yield i;
  }

  def newThese(param iterator: IteratorType)
        where iterator == IteratorType.leader {
    for blk in dom.newThese(IteratorType.leader) do
      yield blk;
  }

  def newThese(param iterator: IteratorType, followThis) var
        where iterator == IteratorType.follower {
    for i in followThis {
      yield this(i + dom.low);
    }
  }

  //
  // how to print out the whole array, sequentially
  //
  def writeThis(x: Writer) {
    var first = true;
    for loc in dom.dist.targetLocDom {
      // May want to do something like the following:
      //      on loc {
      // but it causes deadlock -- see writeThisUsingOn.chpl
        if (locArr(loc).numElements >= 1) {
          if (first) {
            first = false;
          } else {
            x.write(" ");
          }
          x.write(locArr(loc));
        }
        //    }
      stdout.flush();
    }
  }

  //
  // a query for the number of elements in the array
  //
  def numElements {
    return dom.numIndices;
  }
}

//
// the local array class
//
class LocBlock1DArr {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // the element type
  //
  type elemType;

  //
  // a reference to the local domain class for this array and locale
  //
  const locDom: LocBlock1DDom(glbIdxType, lclIdxType);

  //
  // the block of local array data
  //
  var myElems: [locDom.myBlock] elemType;

  //
  // the accessor for the local array -- assumes the index is local
  //
  def this(i: lclIdxType) var {
    return myElems(i);
  }

  //
  // iterator over the elements owned by this locale
  //
  def these() var {
    for elem in myElems {
      yield elem;
    }
  }

  //
  // this is the parallel iterator for the local array, see global
  // domain parallel iterators for general notes on the approach
  //
  def newThese() {
  }

  def newThese(param iterator: IteratorType)
        where iterator == IteratorType.leader {
  }

  def newThese(param iterator: IteratorType, followThis)
        where iterator == IteratorType.follower {
  }

  //
  // prints out this locale's piece of the array
  //
  def writeThis(x: Writer) {
    // May want to do something like the following:
    //      on loc {
    // but it causes deadlock -- see writeThisUsingOn.chpl
    x.write(myElems);
  }

  //
  // query for the number of local array elements
  //
  def numElements {
    return myElems.numElements;
  }
}