Filing some TODOs that I inserted into a copy of my GMP test ages ago

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

/* Pi computation using Chudnovsky's algortithm.

 * Copyright 2002, 2005 Hanhong Xue (macroxue at yahoo dot com)

 * Slightly modified 2005 by Torbjorn Granlund (tege at swox dot com) to allow
   more than 2G digits to be computed.

 * Translated into Chapel by Brad Chamberlain, 2009-2010

 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 * 1. Redistributions of source code must retain the above copyright notice,
 * this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright notice,
 * this list of conditions and the following disclaimer in the documentation
 * and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO
 * EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

use GMP, Time;

param A = 13591409,
      B = 545140134,
      C = 640320,
      D = 12;

param BITS_PER_DIGIT  = 3.32192809488736234787,
      DIGITS_PER_ITER = 14.1816474627254776555,
      DOUBLE_PREC     = 53;

config param HAVE_DIVEXACT_PREINV = false;

config param printTimings = true;

proc CHECK_MEMUSAGE {
  //  writeln("CHECK_MEM_USAGE not implemented yet");
}

////////////////////////////////////////////////////////////////////////////

// TODO:
// Can variables be moved in to tighter scopes?
// Can casts between ulong and long be avoided/minimized?
// Can writeln be used to wrap gmp_printf and the like?
// Would we want to overload operators on these types?
// Refactor timing code into a routine
// Implement memory checks
// Fix timings -- currently they're bogus in some cases
// Use classes rather than records for fac_t and/or sieve_t?

var t1, t2: mpf_t;

config param do_gcd_time = false;

config const   d: long = 100,
             _out: c_int = 1;

const terms   = (d/DIGITS_PER_ITER): long,
      percent = terms/100.0;

record fac_t {
  var num_facs: long;
  const sdom: domain(1, idxType=long);
  var fac, pow: [sdom] c_ulong;
};

record sieve_t {
  var fac, pow, nxt: long;
};

const sieve_size = max(3*5*23*29+1, terms*6): long;
var sievedom = [0: long..#(sieve_size/2)];
var sieve: [sievedom] sieve_t;

var ftmp, fmul: fac_t;

param INIT_FACS = 32;

var gcd_time: long;

var gcd, mgcd: mpz_t;

var depth: long = 1;
while ((1<<depth) < terms) do
  depth += 1;
depth += 1;

var stackdom1 = [0..#depth],
    stackdom2 = stackdom1;

var gstack: [stackdom1] mpz_t,
    fpstack, fgstack: [stackdom1] fac_t,
    pstack, qstack: [stackdom2] mpz_t;

var top: long = 0;

proc main() {
  writeln("#terms=", terms, ", depth=", depth);

  const start = getCurrentTime();
  write("sieve   ");

  build_sieve(sieve);

  const mid0 = getCurrentTime();
  if (printTimings) then
    writeln("time = ", mid0-start);
  else
    writeln();

  mpz_init(pstack);
  mpz_init(qstack);
  mpz_init(gstack);
  fac_init(fpstack);
  fac_init(fgstack);
  mpz_init(gcd);

  if HAVE_DIVEXACT_PREINV then
    mpz_init(mgcd);

  fac_init(ftmp);
  fac_init(fmul);

  /* begin binary splitting process */
  if (terms <= 0) {
    mpz_set_ui(p2,1);
    mpz_set_ui(q2,0);
    mpz_set_ui(g2,1);
  } else {
    bs(0, terms: c_ulong, 0, 0);
  }

  const mid1 = getCurrentTime();
  write("\nbs      ");
  if (printTimings) then
    writeln("time = ", mid1-mid0);
  else
    writeln();
  write("   gcd  ");
  if (printTimings) then
    writeln("time = ", gcd_time);
  else
    writeln();

  //writeln("misc    ");

  /* free some resources */
  sievedom.clear();

  if HAVE_DIVEXACT_PREINV then
    mpz_clear(mgcd);

  mpz_clear(gcd);
  fac_clear(ftmp);
  fac_clear(fmul);

  for i in 1..depth-1 {
    mpz_clear(pstack[i]);
    mpz_clear(qstack[i]);
    mpz_clear(gstack[i]);
    fac_clear(fpstack[i]);
    fac_clear(fgstack[i]);
  }

  mpz_clear(gstack[0]);
  fac_clear(fpstack[0]);
  fac_clear(fgstack[0]);

  stackdom1.clear();

  /* prepare to convert integers to floats */
  mpf_set_default_prec((d*BITS_PER_DIGIT+16): mp_bitcnt_t);

  /*
	  p*(C/D)*sqrt(C)
    pi = -----------------
	     (q+A*p)
  */

  const psize = mpz_sizeinbase(p1,10),
        qsize = mpz_sizeinbase(q1,10);

  mpz_addmul_ui(q1, p1, A);
  mpz_mul_ui(p1, p1, C/D);

  var pi, qi: mpf_t;

  mpf_init(pi);
  mpf_set_z(pi, p1);
  mpz_clear(p1);

  mpf_init(qi);
  mpf_set_z(qi, q1);
  mpz_clear(q1);

  stackdom2.clear();

  const mid2 = getCurrentTime();

  /* initialize temp float variables for sqrt & div */
  mpf_init(t1);
  mpf_init(t2);
  //mpf_set_prec_raw(t1, mpf_get_prec(pi));

  /* final step */
  write("div     ");
  my_div(qi, pi, qi);
  const mid3 = getCurrentTime();
  if (printTimings) then
    writeln("time = ", mid3-mid2);
  else
    writeln();

  write("sqrt    ");
  my_sqrt_ui(pi, C);
  const mid4 = getCurrentTime();
  if (printTimings) then
    writeln("time = ", mid4-mid3);
  else
    writeln();

  write("mul     ");
  mpf_mul(qi, qi, pi);
  const end = getCurrentTime();
  if (printTimings) then
    writeln("time = ", end - mid4);
  else
    writeln();

  if (printTimings) then
    writeln("total   time = ", end - start);

  writeln("   P size=", psize, " digits (", format("%f", psize:real/d), ")\n",
          "   Q size=", qsize, " digits (", format("%f", qsize:real/d), ")");

  /* output Pi and timing statistics */
  if (_out&1)  {
    writeln("pi(0,", terms, ")=");
    mpf_out_str(stdout._fp, 10, d+2, qi);
    writeln();
  }

  /* free float resources */
  mpf_clear(pi);
  mpf_clear(qi);

  mpf_clear(t1);
  mpf_clear(t2);
}

proc build_sieve(s: [] sieve_t) {
  const n = s.numElements*2,
        m = sqrt(n): long;

  s[1/2].fac = 1;
  s[1/2].pow = 1;

  for i in 3..n by 2 {
    if (s[i/2].fac == 0) {
      s[i/2].fac = i;
      s[i/2].pow = 1;
      if (i<=m) {
        for (j,k) in (i*i..n by i+i, i/2..) {
	  if (s[j/2].fac==0) {
	    s[j/2].fac = i;
	    if (s[k].fac == i) {
	      s[j/2].pow = s[k].pow + 1;
	      s[j/2].nxt = s[k].nxt;
	    } else {
	      s[j/2].pow = 1;
	      s[j/2].nxt = k;
	    }
	  }
	}
      }
    }
  }
}

proc my_sqrt_ui(inout r: mpf_t, x: c_ulong) {
  const prec0 = mpf_get_prec(r);

  if (prec0 <= DOUBLE_PREC) {
    mpf_set_d(r, sqrt(x));
    return;
  }

  var bits: c_ulong = 0,
      prec = prec0;
  while (prec > DOUBLE_PREC) {
    const bit = prec&1;
    prec = (prec+bit)/2;
    bits = bits*2+bit;
  }

  mpf_set_prec_raw(t1, DOUBLE_PREC);
  mpf_set_d(t1, 1/sqrt(x));

  while (prec < prec0) {
    prec *= 2;
    if (prec < prec0) {
      /* t1 = t1+t1*(1-x*t1*t1)/2; */
      mpf_set_prec_raw(t2, prec);
      mpf_mul(t2, t1, t1);         // half x half -> full
      mpf_mul_ui(t2, t2, x);
      mpf_ui_sub(t2, 1, t2);
      mpf_set_prec_raw(t2, prec/2);
      mpf_div_2exp(t2, t2, 1);
      mpf_mul(t2, t2, t1);         // half x half -> half
      mpf_set_prec_raw(t1, prec);
      mpf_add(t1, t1, t2);
    } else {
      prec = prec0;
      /* t2=x*t1, t1 = t2+t1*(x-t2*t2)/2; */
      mpf_set_prec_raw(t2, prec/2);
      mpf_mul_ui(t2, t1, x);
      mpf_mul(r, t2, t2);          // half x half -> full
      mpf_ui_sub(r, x, r);
      mpf_mul(t1, t1, r);          // half x half -> half
      mpf_div_2exp(t1, t1, 1);
      mpf_add(r, t1, t2);
      break;
    }
    prec -= (bits&1);
    bits /=2;
  }
}

// r = y/x   WARNING: r cannot be the same as y.
proc my_div(inout r: mpf_t, inout y: mpf_t, in x: mpf_t) {
  const prec0 = mpf_get_prec(r);

  if (prec0<=DOUBLE_PREC) {
    mpf_set_d(r, mpf_get_d(y)/mpf_get_d(x));
    return;
  }

  var bits: c_ulong = 0,
      prec = prec0;
  while (prec > DOUBLE_PREC) {
    const bit = prec&1;
    prec = (prec+bit)/2;
    bits = bits*2 + bit;
  }

  mpf_set_prec_raw(t1, DOUBLE_PREC);
  mpf_ui_div(t1, 1, x);

  while (prec < prec0) {
    prec *= 2;
    if (prec < prec0) {
      /* t1 = t1+t1*(1-x*t1); */
      mpf_set_prec_raw(t2, prec);
      mpf_mul(t2, x, t1);          // full x half -> full
      mpf_ui_sub(t2, 1, t2);
      mpf_set_prec_raw(t2, prec/2);
      mpf_mul(t2, t2, t1);         // half x half -> half
      mpf_set_prec_raw(t1, prec);
      mpf_add(t1, t1, t2);
    } else {
      prec = prec0;
      /* t2=y*t1, t1 = t2+t1*(y-x*t2); */
      mpf_set_prec_raw(t2, prec/2);
      mpf_mul(t2, t1, y);          // half x half -> half
      mpf_mul(r, x, t2);           // full x half -> full
      mpf_sub(r, y, r);
      mpf_mul(t1, t1, r);          // half x half -> half
      mpf_add(r, t1, t2);
      break;
    }
    prec -= (bits&1);
    bits /=2;
  }
}

proc fac_show(f: fac_t) {
  for i in 0..#f.num_facs do
    if (f.pow[i]==1) then
      write(f.fac[i], " ");
    else
      write(f.fac[i], "^", f.pow[i], " ");
  writeln();
}

proc fac_reset(inout f: fac_t) {
  f.num_facs = 0;
}

proc fac_init_size(inout f: fac_t, in s: long) {
  if (s<INIT_FACS) then
    s=INIT_FACS;

  f.sdom = [0..#s];

  fac_reset(f);
}

proc fac_init(inout f: fac_t) {
  fac_init_size(f, INIT_FACS);
}

proc fac_clear(inout f: fac_t) {
  f.sdom.clear();
}

proc fac_resize(inout f: fac_t, s: long)
{
  if (f.sdom.numIndices < s) {
    fac_clear(f);
    fac_init_size(f, s);
  }
}

// BLC: unfortunate -- original GMP took advantage of long/ulong conversions
proc fac_set_bp(inout f: fac_t, base: c_ulong, pow: long) {
  assert (base < max(long): c_ulong);
  fac_set_bp(f, base: long, pow: long);
}

// f = base^pow
proc fac_set_bp(inout f: fac_t, in base: long, pow: long) {
  assert(base < sieve_size);
  var i: long;
  base /= 2;
  while (base > 0) {
    f.fac[i] = (sieve[base].fac): c_ulong;
    f.pow[i] = (sieve[base].pow*pow): c_ulong;
    base = sieve[base].nxt;
    i += 1;
  }
  f.num_facs = i;
  assert(i<=f.sdom.numIndices);
}

// r = f*g
proc fac_mul2(inout r: fac_t, f: fac_t, g: fac_t) {

  var i, j, k: long;
  while (i<f.num_facs & j<g.num_facs) {
    if (f.fac[i] == g.fac[j]) {
      r.fac[k] = f.fac[i];
      r.pow[k] = f.pow[i] + g.pow[j];
      i += 1; j += 1;
    } else if (f.fac[i] < g.fac[j]) {
      r.fac[k] = f.fac[i];
      r.pow[k] = f.pow[i];
      i += 1;
    } else {
      r.fac[k] = g.fac[j];
      r.pow[k] = g.pow[j];
      j += 1;
    }
    k += 1;
  }
  while (i < f.num_facs) {
    r.fac[k] = f.fac[i];
    r.pow[k] = f.pow[i];
    i += 1;
    k += 1;
  }
  while (j < g.num_facs) {
    r.fac[k] = g.fac[j];
    r.pow[k] = g.pow[j];
    j += 1;
    k += 1;
  }
  r.num_facs = k;
  assert(k<=r.sdom.numIndices);
}

// f *= g
proc fac_mul(inout f: fac_t, g: fac_t) {
  fac_resize(fmul, f.num_facs + g.num_facs);
  fac_mul2(fmul, f, g);
  f <=> fmul;
}

// BLC: unfortunate -- original GMP took advantage of long/ulong conversions
proc fac_mul_bp(inout f: fac_t, base: c_ulong, pow: long) {
  assert (base < max(long): c_ulong);
  fac_mul_bp(f, base:long, pow);
}

// f *= base^pow
proc fac_mul_bp(inout f: fac_t, base: long, pow: long) {
  fac_set_bp(ftmp, base, pow);
  fac_mul(f, ftmp);
}

// remove factors of power 0
proc fac_compact(inout f: fac_t) {
  var j: long;
  for i in 0..#f.num_facs {
    if (f.pow[i]>0) {
      if (j<i) {
	f.fac[j] = f.fac[i];
	f.pow[j] = f.pow[i];
      }
      j += 1;
    }
  }
  f.num_facs = j;
}

// convert factorized form to number
proc bs_mul(inout r: mpz_t, a: long, b: long) {
  if (b-a <= 32) {
    mpz_set_ui(r, 1);
    for i in a..b-1 do
      for j in 0..fmul.pow[i]-1 do  // BLC: would like to use # here
	mpz_mul_ui(r, r, fmul.fac[i]);
  } else {
    var r2: mpz_t;
    mpz_init(r2);
    bs_mul(r2, a, (a+b)/2);
    bs_mul(r, (a+b)/2, b);
    mpz_mul(r, r, r2);
    mpz_clear(r2);
  }
}

//#if HAVE_DIVEXACT_PREINV
//void mpz_invert_mod_2exp (mpz_ptr, mpz_srcptr);
//void mpz_divexact_pre (mpz_ptr, mpz_srcptr, mpz_srcptr, mpz_srcptr);
//
//#endif

// f /= gcd(f,g), g /= gcd(f,g)
proc fac_remove_gcd(inout p: mpz_t, inout fp: fac_t, inout g: mpz_t, inout fg: fac_t) {
  var i, j, k: long;
  var c: c_ulong;
  fac_resize(fmul, min(fp.num_facs, fg.num_facs));
  while (i < fp.num_facs && j < fg.num_facs) {
    if (fp.fac[i] == fg.fac[j]) {
      c = min(fp.pow[i], fg.pow[j]);
      fp.pow[i] -= c;
      fg.pow[j] -= c;
      fmul.fac[k] = fp.fac[i];
      fmul.pow[k] = c;
      i += 1; j += 1; k += 1;
    } else if (fp.fac[i] < fg.fac[j]) {
      i += 1;
    } else {
      j += 1;
    }
  }
  fmul.num_facs = k;
  assert(k <= fmul.sdom.numIndices);

  if (fmul.num_facs) {
    bs_mul(gcd, 0, fmul.num_facs);
    if HAVE_DIVEXACT_PREINV {
      mpz_invert_mod_2exp (mgcd, gcd);
      mpz_divexact_pre (p, p, gcd, mgcd);
      mpz_divexact_pre (g, g, gcd, mgcd);
    } else {
      mpz_tdiv_q(p, p, gcd);
      mpz_tdiv_q(g, g, gcd);
    }
    fac_compact(fp);
    fac_compact(fg);
  }
}

proc p1  var return  pstack[top];
proc q1  var return  qstack[top];
proc g1  var return  gstack[top];
proc fp1 var return fpstack[top];
proc fg1 var return fgstack[top];

proc p2  var return  pstack[top+1];
proc q2  var return  qstack[top+1];
proc g2  var return  gstack[top+1];
proc fp2 var return fpstack[top+1];
proc fg2 var return fgstack[top+1];

//////////////////////////////////////////////////////////////////////
//////

var progress = 0.0;

/*
proc mpz_t.writeThis(f) {
  var outfile = f: file;
    gmp_fprintf(outfile._fp, "%Zd", this);
  if (outfile) then
}
*/

// binary splitting
proc bs(a: c_ulong, b: c_ulong, gflag: c_uint, level: long) {
  if (b-a==1) {
    /*
      g(b-1,b) = (6b-5)(2b-1)(6b-1)
      p(b-1,b) = b^3 * C^3 / 24
      q(b-1,b) = (-1)^b*g(b-1,b)*(A+Bb).
    */
    mpz_set_ui(p1, b);
    mpz_mul_ui(p1, p1, b);
    mpz_mul_ui(p1, p1, b);
    mpz_mul_ui(p1, p1, (C/24)*(C/24));
    mpz_mul_ui(p1, p1, C*24);

    mpz_set_ui(g1, 2*b-1);
    mpz_mul_ui(g1, g1, 6*b-1);
    mpz_mul_ui(g1, g1, 6*b-5);

    mpz_set_ui(q1, b);
    mpz_mul_ui(q1, q1, B);
    mpz_add_ui(q1, q1, A);
    mpz_mul   (q1, q1, g1);
    if (b%2) then
      mpz_neg(q1, q1);

    var i = b;
    while ((i&1)==0) do i>>=1;
    fac_set_bp(fp1, i, 3);    // b^3
    fac_mul_bp(fp1, 3*5*23*29, 3);
    fp1.pow[0]-=1;

    fac_set_bp(fg1, 2*b-1, 1);   // 2b-1
    fac_mul_bp(fg1, 6*b-1, 1);   // 6b-1
    fac_mul_bp(fg1, 6*b-5, 1);   // 6b-5

    if (b > (progress:c_ulong)) {
      write(".");
      progress += percent*2;
    }

  } else {
    /*
      p(a,b) = p(a,m) * p(m,b)
      g(a,b) = g(a,m) * g(m,b)
      q(a,b) = q(a,m) * p(m,b) + q(m,b) * g(a,m)
    */
    const mid = (a+(b-a)*0.5224): c_ulong;     // tuning parameter
    bs(a, mid, 1, level+1);

    top += 1;
    bs(mid, b, gflag, level+1);
    top -= 1;

    if (level == 0) then
      write("");

    const ccc = level == 0;

    if (ccc) then CHECK_MEMUSAGE;

    if (level>=4) {           // tuning parameter
      if do_gcd_time {
        const t = getCurrentTime();
        fac_remove_gcd(p2, fp2, g1, fg1);
        gcd_time += getCurrentTime() - t;
      } else {
        fac_remove_gcd(p2, fp2, g1, fg1);
      }
    }

    if (ccc) then CHECK_MEMUSAGE;
    mpz_mul(p1, p1, p2);

    if (ccc) then CHECK_MEMUSAGE;
    mpz_mul(q1, q1, p2);

    if (ccc) then CHECK_MEMUSAGE;
    mpz_mul(q2, q2, g1);

    if (ccc) then CHECK_MEMUSAGE;
    mpz_add(q1, q1, q2);

    if (ccc) then CHECK_MEMUSAGE;
    fac_mul(fp1, fp2);

    if (gflag) {
      mpz_mul(g1, g1, g2);
      fac_mul(fg1, fg2);
    }
  }

  if (_out&2) {
    write("p(", a, ",", b, ")=");
    fac_show(fp1);
    if (gflag) then
      write("g(", a, ",", b, ")=");
    fac_show(fg1);
  }
}

/* Pi computation using Chudnovsky's algortithm.

 * Copyright 2002, 2005 Hanhong Xue (macroxue at yahoo dot com)

 * Slightly modified 2005 by Torbjorn Granlund (tege at swox dot com) to allow
   more than 2G digits to be computed.

 * Translated into Chapel by Brad Chamberlain, 2009-2010

 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 * 1. Redistributions of source code must retain the above copyright notice,
 * this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright notice,
 * this list of conditions and the following disclaimer in the documentation
 * and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO
 * EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

use GMP, Time;

param A = 13591409,
      B = 545140134,
      C = 640320,
      D = 12;

param BITS_PER_DIGIT  = 3.32192809488736234787,
      DIGITS_PER_ITER = 14.1816474627254776555,
      DOUBLE_PREC     = 53;

config param HAVE_DIVEXACT_PREINV = false;

config param printTimings = true;

proc CHECK_MEMUSAGE {
  //  writeln("CHECK_MEM_USAGE not implemented yet");
}

////////////////////////////////////////////////////////////////////////////

var t1, t2: mpf_t;

config param do_gcd_time = false;

config const   d: long = 100,
             _out: c_int = 1;

const terms   = (d/DIGITS_PER_ITER): long,
      percent = terms/100.0;

record fac_t {
  var num_facs: long;
  const sdom: domain(1, idxType=long);
  var fac, pow: [sdom] c_ulong;
};

record sieve_t {
  var fac, pow, nxt: long;
};

const sieve_size = max(3*5*23*29+1, terms*6): long;
var sievedom = [0: long..#(sieve_size/2)];
var sieve: [sievedom] sieve_t;

var ftmp, fmul: fac_t;

param INIT_FACS = 32;

var gcd_time: long;

var gcd, mgcd: mpz_t;

var depth: long = 1;
while ((1<<depth) < terms) do
  depth += 1;
depth += 1;

var stackdom1 = [0..#depth],
    stackdom2 = stackdom1;

var gstack: [stackdom1] mpz_t,
    fpstack, fgstack: [stackdom1] fac_t,
    pstack, qstack: [stackdom2] mpz_t;

var top: long = 0;

proc main() {
  writeln("#terms=", terms, ", depth=", depth);

  const start = getCurrentTime();
  write("sieve   ");

  build_sieve(sieve);

  const mid0 = getCurrentTime();
  if (printTimings) then
    writeln("time = ", mid0-start);
  else
    writeln();

  mpz_init(pstack);
  mpz_init(qstack);
  mpz_init(gstack);
  fac_init(fpstack);
  fac_init(fgstack);
  mpz_init(gcd);

  if HAVE_DIVEXACT_PREINV then
    mpz_init(mgcd);

  fac_init(ftmp);
  fac_init(fmul);

  /* begin binary splitting process */
  if (terms <= 0) {
    mpz_set_ui(p2,1);
    mpz_set_ui(q2,0);
    mpz_set_ui(g2,1);
  } else {
    bs(0, terms: c_ulong, 0, 0);
  }

  const mid1 = getCurrentTime();
  write("\nbs      ");
  if (printTimings) then
    writeln("time = ", mid1-mid0);
  else
    writeln();
  write("   gcd  ");
  if (printTimings) then
    writeln("time = ", gcd_time);
  else
    writeln();

  //writeln("misc    ");

  /* free some resources */
  sievedom.clear();

  if HAVE_DIVEXACT_PREINV then
    mpz_clear(mgcd);

  mpz_clear(gcd);
  fac_clear(ftmp);
  fac_clear(fmul);

  for i in 1..depth-1 {
    mpz_clear(pstack[i]);
    mpz_clear(qstack[i]);
    mpz_clear(gstack[i]);
    fac_clear(fpstack[i]);
    fac_clear(fgstack[i]);
  }

  mpz_clear(gstack[0]);
  fac_clear(fpstack[0]);
  fac_clear(fgstack[0]);

  stackdom1.clear();

  /* prepare to convert integers to floats */
  mpf_set_default_prec((d*BITS_PER_DIGIT+16): mp_bitcnt_t);

  /*
	  p*(C/D)*sqrt(C)
    pi = -----------------
	     (q+A*p)
  */

  const psize = mpz_sizeinbase(p1,10),
        qsize = mpz_sizeinbase(q1,10);

  mpz_addmul_ui(q1, p1, A);
  mpz_mul_ui(p1, p1, C/D);

  var pi, qi: mpf_t;

  mpf_init(pi);
  mpf_set_z(pi, p1);
  mpz_clear(p1);

  mpf_init(qi);
  mpf_set_z(qi, q1);
  mpz_clear(q1);

  stackdom2.clear();

  const mid2 = getCurrentTime();

  /* initialize temp float variables for sqrt & div */
  mpf_init(t1);
  mpf_init(t2);
  //mpf_set_prec_raw(t1, mpf_get_prec(pi));

  /* final step */
  write("div     ");
  my_div(qi, pi, qi);
  const mid3 = getCurrentTime();
  if (printTimings) then
    writeln("time = ", mid3-mid2);
  else
    writeln();

  write("sqrt    ");
  my_sqrt_ui(pi, C);
  const mid4 = getCurrentTime();
  if (printTimings) then
    writeln("time = ", mid4-mid3);
  else
    writeln();

  write("mul     ");
  mpf_mul(qi, qi, pi);
  const end = getCurrentTime();
  if (printTimings) then
    writeln("time = ", end - mid4);
  else
    writeln();

  if (printTimings) then
    writeln("total   time = ", end - start);

  writeln("   P size=", psize, " digits (", format("%f", psize:real/d), ")\n",
          "   Q size=", qsize, " digits (", format("%f", qsize:real/d), ")");

  /* output Pi and timing statistics */
  if (_out&1)  {
    writeln("pi(0,", terms, ")=");
    mpf_out_str(stdout._fp, 10, d+2, qi);
    writeln();
  }

  /* free float resources */
  mpf_clear(pi);
  mpf_clear(qi);

  mpf_clear(t1);
  mpf_clear(t2);
}

proc build_sieve(s: [] sieve_t) {
  const n = s.numElements*2,
        m = sqrt(n): long;

  s[1/2].fac = 1;
  s[1/2].pow = 1;

  for i in 3..n by 2 {
    if (s[i/2].fac == 0) {
      s[i/2].fac = i;
      s[i/2].pow = 1;
      if (i<=m) {
        for (j,k) in (i*i..n by i+i, i/2..) {
	  if (s[j/2].fac==0) {
	    s[j/2].fac = i;
	    if (s[k].fac == i) {
	      s[j/2].pow = s[k].pow + 1;
	      s[j/2].nxt = s[k].nxt;
	    } else {
	      s[j/2].pow = 1;
	      s[j/2].nxt = k;
	    }
	  }
	}
      }
    }
  }
}

proc my_sqrt_ui(inout r: mpf_t, x: c_ulong) {
  const prec0 = mpf_get_prec(r);

  if (prec0 <= DOUBLE_PREC) {
    mpf_set_d(r, sqrt(x));
    return;
  }

  var bits: c_ulong = 0,
      prec = prec0;
  while (prec > DOUBLE_PREC) {
    const bit = prec&1;
    prec = (prec+bit)/2;
    bits = bits*2+bit;
  }

  mpf_set_prec_raw(t1, DOUBLE_PREC);
  mpf_set_d(t1, 1/sqrt(x));

  while (prec < prec0) {
    prec *= 2;
    if (prec < prec0) {
      /* t1 = t1+t1*(1-x*t1*t1)/2; */
      mpf_set_prec_raw(t2, prec);
      mpf_mul(t2, t1, t1);         // half x half -> full
      mpf_mul_ui(t2, t2, x);
      mpf_ui_sub(t2, 1, t2);
      mpf_set_prec_raw(t2, prec/2);
      mpf_div_2exp(t2, t2, 1);
      mpf_mul(t2, t2, t1);         // half x half -> half
      mpf_set_prec_raw(t1, prec);
      mpf_add(t1, t1, t2);
    } else {
      prec = prec0;
      /* t2=x*t1, t1 = t2+t1*(x-t2*t2)/2; */
      mpf_set_prec_raw(t2, prec/2);
      mpf_mul_ui(t2, t1, x);
      mpf_mul(r, t2, t2);          // half x half -> full
      mpf_ui_sub(r, x, r);
      mpf_mul(t1, t1, r);          // half x half -> half
      mpf_div_2exp(t1, t1, 1);
      mpf_add(r, t1, t2);
      break;
    }
    prec -= (bits&1);
    bits /=2;
  }
}

// r = y/x   WARNING: r cannot be the same as y.
proc my_div(inout r: mpf_t, inout y: mpf_t, in x: mpf_t) {
  const prec0 = mpf_get_prec(r);

  if (prec0<=DOUBLE_PREC) {
    mpf_set_d(r, mpf_get_d(y)/mpf_get_d(x));
    return;
  }

  var bits: c_ulong = 0,
      prec = prec0;
  while (prec > DOUBLE_PREC) {
    const bit = prec&1;
    prec = (prec+bit)/2;
    bits = bits*2 + bit;
  }

  mpf_set_prec_raw(t1, DOUBLE_PREC);
  mpf_ui_div(t1, 1, x);

  while (prec < prec0) {
    prec *= 2;
    if (prec < prec0) {
      /* t1 = t1+t1*(1-x*t1); */
      mpf_set_prec_raw(t2, prec);
      mpf_mul(t2, x, t1);          // full x half -> full
      mpf_ui_sub(t2, 1, t2);
      mpf_set_prec_raw(t2, prec/2);
      mpf_mul(t2, t2, t1);         // half x half -> half
      mpf_set_prec_raw(t1, prec);
      mpf_add(t1, t1, t2);
    } else {
      prec = prec0;
      /* t2=y*t1, t1 = t2+t1*(y-x*t2); */
      mpf_set_prec_raw(t2, prec/2);
      mpf_mul(t2, t1, y);          // half x half -> half
      mpf_mul(r, x, t2);           // full x half -> full
      mpf_sub(r, y, r);
      mpf_mul(t1, t1, r);          // half x half -> half
      mpf_add(r, t1, t2);
      break;
    }
    prec -= (bits&1);
    bits /=2;
  }
}

proc fac_show(f: fac_t) {
  for i in 0..#f.num_facs do
    if (f.pow[i]==1) then
      write(f.fac[i], " ");
    else
      write(f.fac[i], "^", f.pow[i], " ");
  writeln();
}

proc fac_reset(inout f: fac_t) {
  f.num_facs = 0;
}

proc fac_init_size(inout f: fac_t, in s: long) {
  if (s<INIT_FACS) then
    s=INIT_FACS;

  f.sdom = [0..#s];

  fac_reset(f);
}

proc fac_init(inout f: fac_t) {
  fac_init_size(f, INIT_FACS);
}

proc fac_clear(inout f: fac_t) {
  f.sdom.clear();
}

proc fac_resize(inout f: fac_t, s: long)
{
  if (f.sdom.numIndices < s) {
    fac_clear(f);
    fac_init_size(f, s);
  }
}

// BLC: unfortunate -- original GMP took advantage of long/ulong conversions
proc fac_set_bp(inout f: fac_t, base: c_ulong, pow: long) {
  assert (base < max(long): c_ulong);
  fac_set_bp(f, base: long, pow: long);
}

// f = base^pow
proc fac_set_bp(inout f: fac_t, in base: long, pow: long) {
  assert(base < sieve_size);
  var i: long;
  base /= 2;
  while (base > 0) {
    f.fac[i] = (sieve[base].fac): c_ulong;
    f.pow[i] = (sieve[base].pow*pow): c_ulong;
    base = sieve[base].nxt;
    i += 1;
  }
  f.num_facs = i;
  assert(i<=f.sdom.numIndices);
}

// r = f*g
proc fac_mul2(inout r: fac_t, f: fac_t, g: fac_t) {

  var i, j, k: long;
  while (i<f.num_facs & j<g.num_facs) {
    if (f.fac[i] == g.fac[j]) {
      r.fac[k] = f.fac[i];
      r.pow[k] = f.pow[i] + g.pow[j];
      i += 1; j += 1;
    } else if (f.fac[i] < g.fac[j]) {
      r.fac[k] = f.fac[i];
      r.pow[k] = f.pow[i];
      i += 1;
    } else {
      r.fac[k] = g.fac[j];
      r.pow[k] = g.pow[j];
      j += 1;
    }
    k += 1;
  }
  while (i < f.num_facs) {
    r.fac[k] = f.fac[i];
    r.pow[k] = f.pow[i];
    i += 1;
    k += 1;
  }
  while (j < g.num_facs) {
    r.fac[k] = g.fac[j];
    r.pow[k] = g.pow[j];
    j += 1;
    k += 1;
  }
  r.num_facs = k;
  assert(k<=r.sdom.numIndices);
}

// f *= g
proc fac_mul(inout f: fac_t, g: fac_t) {
  fac_resize(fmul, f.num_facs + g.num_facs);
  fac_mul2(fmul, f, g);
  f <=> fmul;
}

// BLC: unfortunate -- original GMP took advantage of long/ulong conversions
proc fac_mul_bp(inout f: fac_t, base: c_ulong, pow: long) {
  assert (base < max(long): c_ulong);
  fac_mul_bp(f, base:long, pow);
}

// f *= base^pow
proc fac_mul_bp(inout f: fac_t, base: long, pow: long) {
  fac_set_bp(ftmp, base, pow);
  fac_mul(f, ftmp);
}

// remove factors of power 0
proc fac_compact(inout f: fac_t) {
  var j: long;
  for i in 0..#f.num_facs {
    if (f.pow[i]>0) {
      if (j<i) {
	f.fac[j] = f.fac[i];
	f.pow[j] = f.pow[i];
      }
      j += 1;
    }
  }
  f.num_facs = j;
}

// convert factorized form to number
proc bs_mul(inout r: mpz_t, a: long, b: long) {
  if (b-a <= 32) {
    mpz_set_ui(r, 1);
    for i in a..b-1 do
      for j in 0..fmul.pow[i]-1 do  // BLC: would like to use # here
	mpz_mul_ui(r, r, fmul.fac[i]);
  } else {
    var r2: mpz_t;
    mpz_init(r2);
    bs_mul(r2, a, (a+b)/2);
    bs_mul(r, (a+b)/2, b);
    mpz_mul(r, r, r2);
    mpz_clear(r2);
  }
}

//#if HAVE_DIVEXACT_PREINV
//void mpz_invert_mod_2exp (mpz_ptr, mpz_srcptr);
//void mpz_divexact_pre (mpz_ptr, mpz_srcptr, mpz_srcptr, mpz_srcptr);
//
//#endif

// f /= gcd(f,g), g /= gcd(f,g)
proc fac_remove_gcd(inout p: mpz_t, inout fp: fac_t, inout g: mpz_t, inout fg: fac_t) {
  var i, j, k: long;
  var c: c_ulong;
  fac_resize(fmul, min(fp.num_facs, fg.num_facs));
  while (i < fp.num_facs && j < fg.num_facs) {
    if (fp.fac[i] == fg.fac[j]) {
      c = min(fp.pow[i], fg.pow[j]);
      fp.pow[i] -= c;
      fg.pow[j] -= c;
      fmul.fac[k] = fp.fac[i];
      fmul.pow[k] = c;
      i += 1; j += 1; k += 1;
    } else if (fp.fac[i] < fg.fac[j]) {
      i += 1;
    } else {
      j += 1;
    }
  }
  fmul.num_facs = k;
  assert(k <= fmul.sdom.numIndices);

  if (fmul.num_facs) {
    bs_mul(gcd, 0, fmul.num_facs);
    if HAVE_DIVEXACT_PREINV {
      mpz_invert_mod_2exp (mgcd, gcd);
      mpz_divexact_pre (p, p, gcd, mgcd);
      mpz_divexact_pre (g, g, gcd, mgcd);
    } else {
      mpz_tdiv_q(p, p, gcd);
      mpz_tdiv_q(g, g, gcd);
    }
    fac_compact(fp);
    fac_compact(fg);
  }
}

proc p1  var return  pstack[top];
proc q1  var return  qstack[top];
proc g1  var return  gstack[top];
proc fp1 var return fpstack[top];
proc fg1 var return fgstack[top];

proc p2  var return  pstack[top+1];
proc q2  var return  qstack[top+1];
proc g2  var return  gstack[top+1];
proc fp2 var return fpstack[top+1];
proc fg2 var return fgstack[top+1];

//////////////////////////////////////////////////////////////////////
//////

var progress = 0.0;

/*
proc mpz_t.writeThis(f) {
  var outfile = f: file;
    gmp_fprintf(outfile._fp, "%Zd", this);
  if (outfile) then
}
*/

// binary splitting
proc bs(a: c_ulong, b: c_ulong, gflag: c_uint, level: long) {
  if (b-a==1) {
    /*
      g(b-1,b) = (6b-5)(2b-1)(6b-1)
      p(b-1,b) = b^3 * C^3 / 24
      q(b-1,b) = (-1)^b*g(b-1,b)*(A+Bb).
    */
    mpz_set_ui(p1, b);
    mpz_mul_ui(p1, p1, b);
    mpz_mul_ui(p1, p1, b);
    mpz_mul_ui(p1, p1, (C/24)*(C/24));
    mpz_mul_ui(p1, p1, C*24);

    mpz_set_ui(g1, 2*b-1);
    mpz_mul_ui(g1, g1, 6*b-1);
    mpz_mul_ui(g1, g1, 6*b-5);

    mpz_set_ui(q1, b);
    mpz_mul_ui(q1, q1, B);
    mpz_add_ui(q1, q1, A);
    mpz_mul   (q1, q1, g1);
    if (b%2) then
      mpz_neg(q1, q1);

    var i = b;
    while ((i&1)==0) do i>>=1;
    fac_set_bp(fp1, i, 3);    // b^3
    fac_mul_bp(fp1, 3*5*23*29, 3);
    fp1.pow[0]-=1;

    fac_set_bp(fg1, 2*b-1, 1);   // 2b-1
    fac_mul_bp(fg1, 6*b-1, 1);   // 6b-1
    fac_mul_bp(fg1, 6*b-5, 1);   // 6b-5

    if (b > (progress:c_ulong)) {
      write(".");
      progress += percent*2;
    }

  } else {
    /*
      p(a,b) = p(a,m) * p(m,b)
      g(a,b) = g(a,m) * g(m,b)
      q(a,b) = q(a,m) * p(m,b) + q(m,b) * g(a,m)
    */
    const mid = (a+(b-a)*0.5224): c_ulong;     // tuning parameter
    bs(a, mid, 1, level+1);

    top += 1;
    bs(mid, b, gflag, level+1);
    top -= 1;

    if (level == 0) then
      write("");

    const ccc = level == 0;

    if (ccc) then CHECK_MEMUSAGE;

    if (level>=4) {           // tuning parameter
      if do_gcd_time {
        const t = getCurrentTime();
        fac_remove_gcd(p2, fp2, g1, fg1);
        gcd_time += getCurrentTime() - t;
      } else {
        fac_remove_gcd(p2, fp2, g1, fg1);
      }
    }

    if (ccc) then CHECK_MEMUSAGE;
    mpz_mul(p1, p1, p2);

    if (ccc) then CHECK_MEMUSAGE;
    mpz_mul(q1, q1, p2);

    if (ccc) then CHECK_MEMUSAGE;
    mpz_mul(q2, q2, g1);

    if (ccc) then CHECK_MEMUSAGE;
    mpz_add(q1, q1, q2);

    if (ccc) then CHECK_MEMUSAGE;
    fac_mul(fp1, fp2);

    if (gflag) {
      mpz_mul(g1, g1, g2);
      fac_mul(fg1, fg2);
    }
  }

  if (_out&2) {
    write("p(", a, ",", b, ")=");
    fac_show(fp1);
    if (gflag) then
      write("g(", a, ",", b, ")=");
    fac_show(fg1);
  }
}


Spelling fix

Spelling fix

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

/*
 * Variables Primer
 *
 * This primer demonstrates variable declaration syntax.
 *
 */

//
// Variables are declared with the 'var' keyword.  Variable
// declarations must have a type, initializer, or both.  Here, we
// declare myVariable to be an int.  Since there was no initializer,
// it is initialized to the default value for the int type: 0.
//
var myVariable1: int;
writeln("myVariable1 = ", myVariable1);

//
// Here we declare a variable without a type.  Since 1.618 is a real
// value, the variable is inferred to be of type real.  Note that we
// print out the type by passing the type of the variable (via
// myVariable2.type) to the typeToString procedure.
//
var myVariable2 = 1.618;
writeln("myVariable2 = ", myVariable2, " (type = ",
        typeToString(myVariable2.type), ")");

//
// Variables can also be declared using type aliases.  Here we declare
// a type alias myType to be uint(16) and declare myVariable3 to be of
// type myType.
//
type myType = uint(16);
var myVariable3: myType = 3;
writeln("myType = ", typeToString(myType));
writeln("myVariable3 = ", myVariable3, " (type = ",
        typeToString(myVariable3.type), ")");

//
// Instead of 'var', 'const' and 'param' can be used to declare
// runtime constants and compile-time constants respectively.  A
// 'const' must be initialized in place, but can have its value
// generated at runtime.  A 'param' must be known at compile time.
//
const myConst: real = sqrt(myVariable2);
param myParam = 3.14;
writeln("myConst = ", myConst, ", myParam = ", myParam);

//
// At module scope, all three variable kinds can be qualified by the
// 'config' keyword.  This allows the initial value to be overridden
// on the command line.  A 'config var' or 'config const' may be
// overridden when the program is executed; a 'config param' may be
// overridden when the program is compiled.  Similarly, type aliases
// maybe be qualified by the 'config' keyword.  The comment following
// each declaration shows how the value can be modified.
//
config var cfgVar = "hello";         // ./a.out --cfgVar="world"
config const cfgConst: bool = false; // ./a.out --cfgConst=true
config param cfgParam = 4;           // chpl variables.chpl -s cfgParam=1
config type cfgType = complex;       // chpl variables.chpl -s cfgType=imag
writeln("cfgVar = ", cfgVar,
        ", cfgConst = ", cfgConst,
        ", cfgParam = ", cfgParam,
        ", cfgType = ", typeToString(cfgType));

//
// Variable types and values propagate to the left.  Here, 'a' is a
// real initialized to 1.0, 'b' and 'c' are integers initialized to 0,
// 'd' and 'e' are reals initialized to 1.0, and f is a real
// initialized to 0.0.
//
var a = 1.0, b, c: int, d, e = 1.0, f: real;
writeln("a = ", a, ", b = ", b, ", c = ", c,
        ", d = ", d, ", e = ", e, ", f = ", f);

/*
 * Variables Primer
 *
 * This primver demonstrates variable declaration syntax.
 *
 */

//
// Variables are declared with the 'var' keyword.  Variable
// declarations must have a type, initializer, or both.  Here, we
// declare myVariable to be an int.  Since there was no initializer,
// it is initialized to the default value for the int type: 0.
//
var myVariable1: int;
writeln("myVariable1 = ", myVariable1);

//
// Here we declare a variable without a type.  Since 1.618 is a real
// value, the variable is inferred to be of type real.  Note that we
// print out the type by passing the type of the variable (via
// myVariable2.type) to the typeToString procedure.
//
var myVariable2 = 1.618;
writeln("myVariable2 = ", myVariable2, " (type = ",
        typeToString(myVariable2.type), ")");

//
// Variables can also be declared using type aliases.  Here we declare
// a type alias myType to be uint(16) and declare myVariable3 to be of
// type myType.
//
type myType = uint(16);
var myVariable3: myType = 3;
writeln("myType = ", typeToString(myType));
writeln("myVariable3 = ", myVariable3, " (type = ",
        typeToString(myVariable3.type), ")");

//
// Instead of 'var', 'const' and 'param' can be used to declare
// runtime constants and compile-time constants respectively.  A
// 'const' must be initialized in place, but can have its value
// generated at runtime.  A 'param' must be known at compile time.
//
const myConst: real = sqrt(myVariable2);
param myParam = 3.14;
writeln("myConst = ", myConst, ", myParam = ", myParam);

//
// At module scope, all three variable kinds can be qualified by the
// 'config' keyword.  This allows the initial value to be overridden
// on the command line.  A 'config var' or 'config const' may be
// overridden when the program is executed; a 'config param' may be
// overridden when the program is compiled.  Similarly, type aliases
// maybe be qualified by the 'config' keyword.  The comment following
// each declaration shows how the value can be modified.
//
config var cfgVar = "hello";         // ./a.out --cfgVar="world"
config const cfgConst: bool = false; // ./a.out --cfgConst=true
config param cfgParam = 4;           // chpl variables.chpl -s cfgParam=1
config type cfgType = complex;       // chpl variables.chpl -s cfgType=imag
writeln("cfgVar = ", cfgVar,
        ", cfgConst = ", cfgConst,
        ", cfgParam = ", cfgParam,
        ", cfgType = ", typeToString(cfgType));

//
// Variable types and values propagate to the left.  Here, 'a' is a
// real initialized to 1.0, 'b' and 'c' are integers initialized to 0,
// 'd' and 'e' are reals initialized to 1.0, and f is a real
// initialized to 0.0.
//
var a = 1.0, b, c: int, d, e = 1.0, f: real;
writeln("a = ", a, ", b = ", b, ", c = ", c,
        ", d = ", d, ", e = ", e, ", f = ", f);


Fixed a typo in the autoDestroy function for UserMapAssocArr.

// TODO: Convert to Steve's leader/follower scheme (implemented in compiler)

// TODO: Make multidimensional

// TODO: Make this work for a strided domain of locales; for a strided
// domain implemented using this distribution.

// 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: implement the slicing interface?

config param debugUserMapAssoc = false;

// TODO: Need to make this generic
class AbstractMapper {
  proc idxToLocaleInd(ind, numlocs: int) {
    return 0;
  }
}

//
// The distribution class
//
class UserMapAssoc : BaseDist {

  // GENERICS:

  //
  // The distribution's index type and domain's global index type
  //
  type idxType = int(64);

  // STATE:

  const mapper : AbstractMapper;

  //
  // a domain and array describing the set of target locales to which
  // the indices are mapped
  //
  const targetLocDom: domain(1);
  const targetLocs: [targetLocDom] locale;

  // LINKAGE:

  //
  // DOWN: an array of local distribution class descriptors -- set up
  // in the class constructor
  //
  const locDist: [targetLocDom] LocUserMapAssocDist(idxType);

  // CONSTRUCTORS:

  proc UserMapAssoc(type idxType = int(64), initMapper: AbstractMapper,
                   targetLocales: [] locale = Locales) {
    mapper = initMapper;
    //
    // 0-base the local capture of the targetLocDom for simplicity
    // later on
    //
    // TODO: Create a helper function to create a domain like this for
    // arbitrary dimensions (since the k-D case is a bit harder?)
    //
    targetLocDom = {0..#targetLocales.numElements};
    targetLocs = targetLocales;

    for locid in targetLocDom do
      on targetLocs(locid) do
        locDist(locid) = new LocUserMapAssocDist(idxType, locid, this);
  }

  //
  // builds up a privatized (replicated copy)
  //
  proc UserMapAssoc(type idxType = int(64),
                   other: UserMapAssoc(idxType)) {
    mapper = other.mapper;
    targetLocDom = other.targetLocDom;
    targetLocs = other.targetLocs;
    locDist = other.locDist;
  }

  proc dsiClone() {
    return new UserMapAssoc(idxType, mapper, targetLocs);
  }

  // DISTRIBUTION INTERFACE:

  //
  // Create a new domain over this distribution with the given index
  // set (inds) and global index type (idxType, idxType)
  //
  // TODO: What should we do if domIdxType did not match idxType?
  //
  proc dsiNewAssociativeDom(type domIdxType, param parSafe: bool) where domIdxType != idxType {
    compilerError("Trying to create a domain whose index type does not match the distribution's");
  }

  //
  // INTERFACE NOTES: Should we support a form that passes in an
  // initial index set if one exists?  If not, we should rewrite the
  // global domain construction to not do anything with whole...
  //
  proc dsiNewAssociativeDom(type idxType, param parSafe: bool) {
    var dom = new UserMapAssocDom(idxType=idxType, dist=this);
    dom.setup();
    return dom;
  }

  //
  // print out the distribution
  //
  proc WriteThis(x:Writer) {
    x.writeln("UserMapAssoc");
    x.writeln("-------");
    x.writeln("distributed using: ", mapper);
    x.writeln("across locales: ", targetLocs);
    x.writeln("indexed via: ", targetLocDom);
    x.writeln("resulting in: ");
    for locid in targetLocDom do
      x.writeln("  [", locid, "] ", locDist(locid));
  }

  //
  // convert an index into a locale value
  //
  proc idxToLocale(ind: idxType) {
    return targetLocs(idxToLocaleInd(ind));
  }

  proc idxToLocaleInd(ind: idxType) {
    return mapper.idxToLocaleInd(ind, targetLocDom.numIndices);
  }
}

pragma "auto copy fn"
proc chpl__autoCopy(x: UserMapAssoc) {
  if ! noRefCount then
    x.incRefCount();
  return x;
}

proc chpl__autoDestroy(x: UserMapAssoc) {
  if !noRefCount {
    var cnt = x.destroyDist();
    if cnt == 0 then
      delete x;
  }
}

//
// A per-locale local distribution class
//
class LocUserMapAssocDist {

  // GENERICS:

  //
  // The distribution's index type and domain's global index type
  //
  type idxType;

  // STATE:

  //
  // The locale owning this class
  //
  // TODO: This is only used in the writeThis() class -- can we remove it?
  //
  const loc: locale;

  // CONSTRUCTORS:

  //
  // Constructor computes what chunk of index(1) is owned by the
  // current locale
  //
  proc LocUserMapAssocDist(type idxType,
                          _localeIdx: int, // the locale index from the target domain
                          dist: UserMapAssoc(idxType) // reference to glob dist
                         ) {
    const localeIdx = _localeIdx;
    loc = dist.targetLocs(localeIdx);
    //
    // TODO: Create these assertions for other local classes as well
    //
    if (loc != here) {
      halt("Creating a local distribution class on the wrong locale");
    }

    if debugUserMapAssoc then
      writeln(this);
  }

  // INTERNAL INTERFACE:

  //
  // print out the local distribution class
  //
  proc writeThis(x:Writer) {
    x.write("locale ", loc.id, " owns some indices");
  }
}

//
// The global domain class
//
class UserMapAssocDom: BaseAssociativeDom {
  param parSafe: bool=true; // we need this because of the wrapper interface

  // GENERICS:

  //
  // The index types of the domain
  //
  type idxType;

  // LINKAGE:

  //
  // LEFT: a pointer to the parent distribution
  //
  const dist: UserMapAssoc(idxType);

  //
  // DOWN: an array of local domain class descriptors -- set up in
  // setup() 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.
  // SJD: note cannot do this anymore because constructor does not
  // setup (for privatization reasons)
  //
  var locDoms: [dist.targetLocDom] LocUserMapAssocDom(idxType);

  // STATE:

  //
  // a domain describing the complete domain
  //

  var pid: int = -1;

  // GLOBAL DOMAIN INTERFACE:

  proc dsiAdd(i: idxType) {
    locDoms(dist.idxToLocaleInd(i)).add(i);
  }

  //
  // the iterator for the domain -- currently sequential
  //
  //
  // TODO: This really should go over the elements in row-major order,
  // not the block orders.
  //
  iter 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.
  //
  // TODO: Steve's question: how would a leader containing an on
  // clause interact with a loop that used an on clause explicitly
  // within its body?  How would it be done efficiently?
  //
  iter these(param tag: iterKind) where tag == iterKind.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?)
    //
    coforall locDom in locDoms do
      on locDom {
        yield locDom;
      }
  }

  iter these(param tag: iterKind, followThis) where tag == iterKind.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;
    }
  }

  //
  // the print method for the domain
  //
  proc dsiSerialWrite(x:Writer) {
    for locDom in locDoms do
      // TODO: This doesn't work -- accesses a bad file descriptor
      //      on locDom {
      //

      // TODO: The following doesn't work -- deadlock:
      //
      // writeln(""locale" + here.id + " owns: ");

      // TODO: The following didn't work either -- seg fault:
      //
      //        ("locale" + here.id + " owns: ").writeThis(x);

        x.write(locDom);
      //      }
  }

  //
  // how to allocate a new array over this domain
  //
  proc dsiBuildArray(type elemType) {
    var arr = new UserMapAssocArr(idxType=idxType, eltType=elemType, dom=this);
    arr.setup();
    return arr;
  }

  //
  // queries for the number of indices, low, and high bounds
  //
  proc dsiNumIndices {
    return + reduce [loc in dist.targetLocDom] locDoms[loc].myInds.numIndices;
  }

  //
  // INTERFACE NOTES: Could we make setIndices() for an arithmetic
  // domain take a domain rather than something else?
  //
  proc dsiSetIndices(x: domain) {
    writeln("setIndices not yet implemented");
  }

  proc dsiSetIndices(x) {
    writeln("setIndices not yet implemented");
  }

  proc dsiGetIndices() {
    writeln("getIndices not yet implemented");
  }

  //
  // INTERNAL INTERFACE
  //
  proc dsiMyDist(): UserMapAssoc(idxType) {
    return dist;
  }

  proc setup() {
    for localeIdx in dist.targetLocDom do
      on dist.targetLocs(localeIdx) do
        if (locDoms(localeIdx) == nil) then
          locDoms(localeIdx) = new LocUserMapAssocDom(idxType, this);
    if debugUserMapAssoc then
      [loc in dist.targetLocDom] writeln(loc, " owns ", locDoms(loc));

  }

  proc dsiSupportsPrivatization() param return true;
  proc dsiGetPrivatizeData() return 0;
  proc dsiPrivatize(privatizeData) {
    var privateDist = new UserMapAssoc(idxType, dist);
    var c = new UserMapAssocDom(idxType=idxType, dist=privateDist);
    c.locDoms = locDoms;
    return c;
  }
  proc dsiReprivatize(other) {
    locDoms = other.locDoms;
  }
}

pragma "auto copy fn"
proc chpl__autoCopy(x: UserMapAssocDom) {
  if ! noRefCount then
    x.incRefCount();
  return x;
}

proc chpl__autoDestroy(x: UserMapAssocDom) {
  if !noRefCount {
    var cnt = x.destroyDom();
    if cnt == 0 then
      delete x;
  }
}

//
// the local domain class
//
class LocUserMapAssocDom {

  // GENERICS:

  //
  // The index type of the domain
  //
  type idxType;

  // LINKAGE:

  //
  // UP: a reference to the parent global domain class
  //
  const wholeDom: UserMapAssocDom(idxType, parSafe=true);

  // STATE:

  //
  // a local domain describing the indices owned by this locale
  //
  // TODO: Steve would like to see the strided parameter pushed into
  // the global and local domain classes.
  //
  // NOTE: I used to use a local index type for this, but that would
  // require a glbIdxType offset in order to get from the global
  // indices back to the local index type.
  //
  var myInds: domain(idxType, parSafe=true);

  // LOCAL DOMAIN INTERFACE:

  proc add(i: idxType) {
    myInds += i;
  }

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

  //
  // this is the parallel iterator for the local domain, see global
  // domain parallel iterators for general notes on the approach
  //
  iter these(param tag: iterKind) where tag == iterKind.leader {
    halt("This is bogus");
    yield {1..100};
  }

  iter these(param tag: iterKind, followThis) where tag == iterKind.follower {
    halt("This is bogus");
    yield 2;
  }

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

  // INTERNAL INTERFACE:

  //
  // queries for this locale's number of indices, low, and high bounds
  //
  // TODO: I believe these are only used by the random number generator
  // in stream -- will they always be required once that is rewritten?
  //
  proc numIndices {
    return myInds.numIndices;
  }
}

//
// the global array class
//
class UserMapAssocArr: BaseArr {
  // GENERICS:

  //
  // The index type of the domain
  //
  type idxType;

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

  // LINKAGE:

  //
  // LEFT: the global domain descriptor for this array
  //
  var dom: UserMapAssocDom(idxType, parSafe=true);

  //
  // DOWN: 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.
  // SJD: note cannot do this anymore because constructor does not
  // setup (for privatization reasons)
  //
  var locArrs: [dom.dist.targetLocDom] LocUserMapAssocArr(idxType, eltType);

  var pid: int = -1; // privatized object id

  proc dsiGetBaseDom() return dom;

  proc setup() {
    coforall localeIdx in dom.dist.targetLocDom do
      on dom.dist.targetLocs(localeIdx) do
        locArrs(localeIdx) = new LocUserMapAssocArr(idxType, eltType, dom.locDoms(localeIdx));
  }

  proc dsiSupportsPrivatization() param return true;
  proc dsiGetPrivatizeData() return 0;
  proc dsiPrivatize(privatizeData) {
    var privdom = chpl_getPrivatizedCopy(dom.type, dom.pid);
    var c = new UserMapAssocArr(idxType=idxType, eltType=eltType, dom=privdom);
    c.locArrs = locArrs;
    return c;
  }

  // GLOBAL ARRAY INTERFACE:

  //
  // the global accessor for the array
  //
  // TODO: Do we need a global bounds check here or in idxToLocaleind?
  //
  proc dsiAccess(i: idxType) ref {
    const myLocArr = locArrs(here.id);
    local {
      if myLocArr.locDom.myInds.member(i) then
        return myLocArr.this(i);
    }
    return locArrs(dom.dist.idxToLocaleInd(i))(i);
  }

  //
  // the iterator over the array's elements, currently sequential
  //
  iter these() ref {
    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 locArrs(loc) {
        yield elem;
      }
    }
  }

  //
  // this is the parallel iterator for the global array, see the
  // example for general notes on the approach
  //
  iter these(param tag: iterKind) where tag == iterKind.leader {
    //
    // TODO: Rewrite this to reuse more of the global domain iterator
    // logic?  (e.g., can we forward the forall to the global domain
    // somehow?
    //
    coforall locDom in dom.locDoms do
      on locDom {
        yield locDom;
      }
  }

  proc supportsAlignedFollower() param return true;

  iter these(param tag: iterKind, followThis, param aligned: bool = false) ref where tag == iterKind.follower {
    //
    // TODO: Would like to write this as followThis += dom.low;
    //
    const myFollowThis = followThis;

    //
    // TODO: The following is a buggy hack that will only work when we're
    // distributing across the entire Locales array.  I still think the
    // locArrs/locDoms arrays should be associative over locale values.
    //
    const myLocArr = locArrs(here.id);
    if aligned {
      local {
        for i in myFollowThis {
          yield myLocArr.this(i);
        }
      }
    } else {
      //
      // we don't own all the elements we're following
      //
      // TODO: could do something smarter to only bring the non-local
      // elements over.
      proc accessHelper(i) ref {
        local {
          if myLocArr.locDom.myInds.member(i) then
            return myLocArr.this(i);
        }
        return this(i);
      }
      for i in myFollowThis {
        yield accessHelper(i);
      }
    }

    // SJD: This was here before I added aligned:
    /*
    //
    // TODO: The following is a buggy hack that will only work when we're
    // distributing across the entire Locales array.  I still think the
    // locArrs/locDoms arrays should be associative over locale values.
    //
    const myLocArr = locArrs(here.id);
    if (myLocArr.owns(myFollowThis)) {
      // we own all the elements we're following
      //

      //
      // TODO: Want this, but local does not currently work within
      // follower iterators:
      //
      //      local {
        for i in myFollowThis {
          yield myLocArr.this(i);
        }
        //      }
      //
    } else {
      writeln("Warning: doing expensive these iteration");
      //
      // we don't own all the elements we're following
      //
      // TODO: could do something smarter to only bring the non-local
      // elements over.
      for i in myFollowThis {
        yield this(i);
      }
    }
    */
  }

  //
  // how to print out the whole array, sequentially
  //
  proc dsiSerialWrite(x: Writer) {

    var first = true;
    for locArr in locArrs {
      if locArr.numElements {
        if first {
          first = false;
        } else {
          x.write(" ");
        }
      }
      x.write(locArr);
      stdout.flush();
    }
  }

  //
  // a query for the number of elements in the array
  //
  proc dsiNumElements {
    return dom.dsiNumIndices;
  }
}

pragma "auto copy fn"
proc chpl__autoCopy(x: UserMapAssocArr) {
  if ! noRefCount then
    x.incRefCount();
  return x;
}

proc chpl__autoDestroy(x: UserMapAssocArr) {
  if !noRefCount {
    var cnt = x.destroyArr();
    if cnt == 0 then
      delete x;
  }
}

//
// the local array class
//
class LocUserMapAssocArr {

  // GENERICS:

  //
  // The index type of the domain
  //
  type idxType;

  //
  // the element type
  //
  type eltType;

  // LINKAGE:

  //
  // LEFT: a reference to the local domain class for this array and locale
  //
  const locDom: LocUserMapAssocDom(idxType);

  // STATE:

  //
  // the block of local array data
  //
  var myElems: [locDom.myInds] eltType;

  // LOCAL ARRAY INTERFACE:

  //
  // the accessor for the local array -- assumes the index is local
  //
  proc this(i: idxType) ref {
    return myElems(i);
  }

  //
  // iterator over the elements owned by this locale
  //
  iter these() ref {
    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
  //
  iter these(param tag: iterKind) where tag == iterKind.leader {
    halt("This is bogus");
    yield {1..100};
  }

  iter these(param tag: iterKind, followThis) ref where tag == iterKind.follower {
    yield myElems(0);
  }

  //
  // prints out this locale's piece of the array
  //
  proc 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
  //
  proc numElements {
    return myElems.numElements;
  }

  // INTERNAL INTERFACE:

  proc owns(x) {
    //
    // TODO: When this is multidimensional need to do a reduction or something:
    //
    return locDom.myInds.dim(1).boundsCheck(x.dim(1));
  }
}

//
// a helper function for blocking index ranges:
//

proc chpl_computeBlock(waylo, numelems, lo, wayhi, numblocks, blocknum) {
  proc procToData(x, lo)
    return lo + (x: lo.type) + (x:real != x:int:real): lo.type;

  const blo = if (blocknum == 0) then waylo
              else procToData((numelems: real * blocknum) / numblocks, lo);
  const bhi = if (blocknum == numblocks - 1) then wayhi
              else procToData((numelems: real * (blocknum+1)) / numblocks, lo) - 1;

  return (blo, bhi);
}

// TODO: Convert to Steve's leader/follower scheme (implemented in compiler)

// TODO: Make multidimensional

// TODO: Make this work for a strided domain of locales; for a strided
// domain implemented using this distribution.

// 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: implement the slicing interface?

config param debugUserMapAssoc = false;

// TODO: Need to make this generic
class AbstractMapper {
  proc idxToLocaleInd(ind, numlocs: int) {
    return 0;
  }
}

//
// The distribution class
//
class UserMapAssoc : BaseDist {

  // GENERICS:

  //
  // The distribution's index type and domain's global index type
  //
  type idxType = int(64);

  // STATE:

  const mapper : AbstractMapper;

  //
  // a domain and array describing the set of target locales to which
  // the indices are mapped
  //
  const targetLocDom: domain(1);
  const targetLocs: [targetLocDom] locale;

  // LINKAGE:

  //
  // DOWN: an array of local distribution class descriptors -- set up
  // in the class constructor
  //
  const locDist: [targetLocDom] LocUserMapAssocDist(idxType);

  // CONSTRUCTORS:

  proc UserMapAssoc(type idxType = int(64), initMapper: AbstractMapper,
                   targetLocales: [] locale = Locales) {
    mapper = initMapper;
    //
    // 0-base the local capture of the targetLocDom for simplicity
    // later on
    //
    // TODO: Create a helper function to create a domain like this for
    // arbitrary dimensions (since the k-D case is a bit harder?)
    //
    targetLocDom = {0..#targetLocales.numElements};
    targetLocs = targetLocales;

    for locid in targetLocDom do
      on targetLocs(locid) do
        locDist(locid) = new LocUserMapAssocDist(idxType, locid, this);
  }

  //
  // builds up a privatized (replicated copy)
  //
  proc UserMapAssoc(type idxType = int(64),
                   other: UserMapAssoc(idxType)) {
    mapper = other.mapper;
    targetLocDom = other.targetLocDom;
    targetLocs = other.targetLocs;
    locDist = other.locDist;
  }

  proc dsiClone() {
    return new UserMapAssoc(idxType, mapper, targetLocs);
  }

  // DISTRIBUTION INTERFACE:

  //
  // Create a new domain over this distribution with the given index
  // set (inds) and global index type (idxType, idxType)
  //
  // TODO: What should we do if domIdxType did not match idxType?
  //
  proc dsiNewAssociativeDom(type domIdxType, param parSafe: bool) where domIdxType != idxType {
    compilerError("Trying to create a domain whose index type does not match the distribution's");
  }

  //
  // INTERFACE NOTES: Should we support a form that passes in an
  // initial index set if one exists?  If not, we should rewrite the
  // global domain construction to not do anything with whole...
  //
  proc dsiNewAssociativeDom(type idxType, param parSafe: bool) {
    var dom = new UserMapAssocDom(idxType=idxType, dist=this);
    dom.setup();
    return dom;
  }

  //
  // print out the distribution
  //
  proc WriteThis(x:Writer) {
    x.writeln("UserMapAssoc");
    x.writeln("-------");
    x.writeln("distributed using: ", mapper);
    x.writeln("across locales: ", targetLocs);
    x.writeln("indexed via: ", targetLocDom);
    x.writeln("resulting in: ");
    for locid in targetLocDom do
      x.writeln("  [", locid, "] ", locDist(locid));
  }

  //
  // convert an index into a locale value
  //
  proc idxToLocale(ind: idxType) {
    return targetLocs(idxToLocaleInd(ind));
  }

  proc idxToLocaleInd(ind: idxType) {
    return mapper.idxToLocaleInd(ind, targetLocDom.numIndices);
  }
}

pragma "auto copy fn"
proc chpl__autoCopy(x: UserMapAssoc) {
  if ! noRefCount then
    x.incRefCount();
  return x;
}

proc chpl__autoDestroy(x: UserMapAssoc) {
  if !noRefCount {
    var cnt = x.destroyDist();
    if cnt == 0 then
      delete x;
  }
}

//
// A per-locale local distribution class
//
class LocUserMapAssocDist {

  // GENERICS:

  //
  // The distribution's index type and domain's global index type
  //
  type idxType;

  // STATE:

  //
  // The locale owning this class
  //
  // TODO: This is only used in the writeThis() class -- can we remove it?
  //
  const loc: locale;

  // CONSTRUCTORS:

  //
  // Constructor computes what chunk of index(1) is owned by the
  // current locale
  //
  proc LocUserMapAssocDist(type idxType,
                          _localeIdx: int, // the locale index from the target domain
                          dist: UserMapAssoc(idxType) // reference to glob dist
                         ) {
    const localeIdx = _localeIdx;
    loc = dist.targetLocs(localeIdx);
    //
    // TODO: Create these assertions for other local classes as well
    //
    if (loc != here) {
      halt("Creating a local distribution class on the wrong locale");
    }

    if debugUserMapAssoc then
      writeln(this);
  }

  // INTERNAL INTERFACE:

  //
  // print out the local distribution class
  //
  proc writeThis(x:Writer) {
    x.write("locale ", loc.id, " owns some indices");
  }
}

//
// The global domain class
//
class UserMapAssocDom: BaseAssociativeDom {
  param parSafe: bool=true; // we need this because of the wrapper interface

  // GENERICS:

  //
  // The index types of the domain
  //
  type idxType;

  // LINKAGE:

  //
  // LEFT: a pointer to the parent distribution
  //
  const dist: UserMapAssoc(idxType);

  //
  // DOWN: an array of local domain class descriptors -- set up in
  // setup() 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.
  // SJD: note cannot do this anymore because constructor does not
  // setup (for privatization reasons)
  //
  var locDoms: [dist.targetLocDom] LocUserMapAssocDom(idxType);

  // STATE:

  //
  // a domain describing the complete domain
  //

  var pid: int = -1;

  // GLOBAL DOMAIN INTERFACE:

  proc dsiAdd(i: idxType) {
    locDoms(dist.idxToLocaleInd(i)).add(i);
  }

  //
  // the iterator for the domain -- currently sequential
  //
  //
  // TODO: This really should go over the elements in row-major order,
  // not the block orders.
  //
  iter 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.
  //
  // TODO: Steve's question: how would a leader containing an on
  // clause interact with a loop that used an on clause explicitly
  // within its body?  How would it be done efficiently?
  //
  iter these(param tag: iterKind) where tag == iterKind.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?)
    //
    coforall locDom in locDoms do
      on locDom {
        yield locDom;
      }
  }

  iter these(param tag: iterKind, followThis) where tag == iterKind.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;
    }
  }

  //
  // the print method for the domain
  //
  proc dsiSerialWrite(x:Writer) {
    for locDom in locDoms do
      // TODO: This doesn't work -- accesses a bad file descriptor
      //      on locDom {
      //

      // TODO: The following doesn't work -- deadlock:
      //
      // writeln(""locale" + here.id + " owns: ");

      // TODO: The following didn't work either -- seg fault:
      //
      //        ("locale" + here.id + " owns: ").writeThis(x);

        x.write(locDom);
      //      }
  }

  //
  // how to allocate a new array over this domain
  //
  proc dsiBuildArray(type elemType) {
    var arr = new UserMapAssocArr(idxType=idxType, eltType=elemType, dom=this);
    arr.setup();
    return arr;
  }

  //
  // queries for the number of indices, low, and high bounds
  //
  proc dsiNumIndices {
    return + reduce [loc in dist.targetLocDom] locDoms[loc].myInds.numIndices;
  }

  //
  // INTERFACE NOTES: Could we make setIndices() for an arithmetic
  // domain take a domain rather than something else?
  //
  proc dsiSetIndices(x: domain) {
    writeln("setIndices not yet implemented");
  }

  proc dsiSetIndices(x) {
    writeln("setIndices not yet implemented");
  }

  proc dsiGetIndices() {
    writeln("getIndices not yet implemented");
  }

  //
  // INTERNAL INTERFACE
  //
  proc dsiMyDist(): UserMapAssoc(idxType) {
    return dist;
  }

  proc setup() {
    for localeIdx in dist.targetLocDom do
      on dist.targetLocs(localeIdx) do
        if (locDoms(localeIdx) == nil) then
          locDoms(localeIdx) = new LocUserMapAssocDom(idxType, this);
    if debugUserMapAssoc then
      [loc in dist.targetLocDom] writeln(loc, " owns ", locDoms(loc));

  }

  proc dsiSupportsPrivatization() param return true;
  proc dsiGetPrivatizeData() return 0;
  proc dsiPrivatize(privatizeData) {
    var privateDist = new UserMapAssoc(idxType, dist);
    var c = new UserMapAssocDom(idxType=idxType, dist=privateDist);
    c.locDoms = locDoms;
    return c;
  }
  proc dsiReprivatize(other) {
    locDoms = other.locDoms;
  }
}

pragma "auto copy fn"
proc chpl__autoCopy(x: UserMapAssocDom) {
  if ! noRefCount then
    x.incRefCount();
  return x;
}

proc chpl__autoDestroy(x: UserMapAssocDom) {
  if !noRefCount {
    var cnt = x.destroyDom();
    if cnt == 0 then
      delete x;
  }
}

//
// the local domain class
//
class LocUserMapAssocDom {

  // GENERICS:

  //
  // The index type of the domain
  //
  type idxType;

  // LINKAGE:

  //
  // UP: a reference to the parent global domain class
  //
  const wholeDom: UserMapAssocDom(idxType, parSafe=true);

  // STATE:

  //
  // a local domain describing the indices owned by this locale
  //
  // TODO: Steve would like to see the strided parameter pushed into
  // the global and local domain classes.
  //
  // NOTE: I used to use a local index type for this, but that would
  // require a glbIdxType offset in order to get from the global
  // indices back to the local index type.
  //
  var myInds: domain(idxType, parSafe=true);

  // LOCAL DOMAIN INTERFACE:

  proc add(i: idxType) {
    myInds += i;
  }

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

  //
  // this is the parallel iterator for the local domain, see global
  // domain parallel iterators for general notes on the approach
  //
  iter these(param tag: iterKind) where tag == iterKind.leader {
    halt("This is bogus");
    yield {1..100};
  }

  iter these(param tag: iterKind, followThis) where tag == iterKind.follower {
    halt("This is bogus");
    yield 2;
  }

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

  // INTERNAL INTERFACE:

  //
  // queries for this locale's number of indices, low, and high bounds
  //
  // TODO: I believe these are only used by the random number generator
  // in stream -- will they always be required once that is rewritten?
  //
  proc numIndices {
    return myInds.numIndices;
  }
}

//
// the global array class
//
class UserMapAssocArr: BaseArr {
  // GENERICS:

  //
  // The index type of the domain
  //
  type idxType;

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

  // LINKAGE:

  //
  // LEFT: the global domain descriptor for this array
  //
  var dom: UserMapAssocDom(idxType, parSafe=true);

  //
  // DOWN: 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.
  // SJD: note cannot do this anymore because constructor does not
  // setup (for privatization reasons)
  //
  var locArrs: [dom.dist.targetLocDom] LocUserMapAssocArr(idxType, eltType);

  var pid: int = -1; // privatized object id

  proc dsiGetBaseDom() return dom;

  proc setup() {
    coforall localeIdx in dom.dist.targetLocDom do
      on dom.dist.targetLocs(localeIdx) do
        locArrs(localeIdx) = new LocUserMapAssocArr(idxType, eltType, dom.locDoms(localeIdx));
  }

  proc dsiSupportsPrivatization() param return true;
  proc dsiGetPrivatizeData() return 0;
  proc dsiPrivatize(privatizeData) {
    var privdom = chpl_getPrivatizedCopy(dom.type, dom.pid);
    var c = new UserMapAssocArr(idxType=idxType, eltType=eltType, dom=privdom);
    c.locArrs = locArrs;
    return c;
  }

  // GLOBAL ARRAY INTERFACE:

  //
  // the global accessor for the array
  //
  // TODO: Do we need a global bounds check here or in idxToLocaleind?
  //
  proc dsiAccess(i: idxType) ref {
    const myLocArr = locArrs(here.id);
    local {
      if myLocArr.locDom.myInds.member(i) then
        return myLocArr.this(i);
    }
    return locArrs(dom.dist.idxToLocaleInd(i))(i);
  }

  //
  // the iterator over the array's elements, currently sequential
  //
  iter these() ref {
    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 locArrs(loc) {
        yield elem;
      }
    }
  }

  //
  // this is the parallel iterator for the global array, see the
  // example for general notes on the approach
  //
  iter these(param tag: iterKind) where tag == iterKind.leader {
    //
    // TODO: Rewrite this to reuse more of the global domain iterator
    // logic?  (e.g., can we forward the forall to the global domain
    // somehow?
    //
    coforall locDom in dom.locDoms do
      on locDom {
        yield locDom;
      }
  }

  proc supportsAlignedFollower() param return true;

  iter these(param tag: iterKind, followThis, param aligned: bool = false) ref where tag == iterKind.follower {
    //
    // TODO: Would like to write this as followThis += dom.low;
    //
    const myFollowThis = followThis;

    //
    // TODO: The following is a buggy hack that will only work when we're
    // distributing across the entire Locales array.  I still think the
    // locArrs/locDoms arrays should be associative over locale values.
    //
    const myLocArr = locArrs(here.id);
    if aligned {
      local {
        for i in myFollowThis {
          yield myLocArr.this(i);
        }
      }
    } else {
      //
      // we don't own all the elements we're following
      //
      // TODO: could do something smarter to only bring the non-local
      // elements over.
      proc accessHelper(i) ref {
        local {
          if myLocArr.locDom.myInds.member(i) then
            return myLocArr.this(i);
        }
        return this(i);
      }
      for i in myFollowThis {
        yield accessHelper(i);
      }
    }

    // SJD: This was here before I added aligned:
    /*
    //
    // TODO: The following is a buggy hack that will only work when we're
    // distributing across the entire Locales array.  I still think the
    // locArrs/locDoms arrays should be associative over locale values.
    //
    const myLocArr = locArrs(here.id);
    if (myLocArr.owns(myFollowThis)) {
      // we own all the elements we're following
      //

      //
      // TODO: Want this, but local does not currently work within
      // follower iterators:
      //
      //      local {
        for i in myFollowThis {
          yield myLocArr.this(i);
        }
        //      }
      //
    } else {
      writeln("Warning: doing expensive these iteration");
      //
      // we don't own all the elements we're following
      //
      // TODO: could do something smarter to only bring the non-local
      // elements over.
      for i in myFollowThis {
        yield this(i);
      }
    }
    */
  }

  //
  // how to print out the whole array, sequentially
  //
  proc dsiSerialWrite(x: Writer) {

    var first = true;
    for locArr in locArrs {
      if locArr.numElements {
        if first {
          first = false;
        } else {
          x.write(" ");
        }
      }
      x.write(locArr);
      stdout.flush();
    }
  }

  //
  // a query for the number of elements in the array
  //
  proc dsiNumElements {
    return dom.dsiNumIndices;
  }
}

pragma "auto copy fn"
proc chpl__autoCopy(x: UserMapAssocArr) {
  if ! noRefCount then
    x.incRefCount();
  return x;
}

proc chpl__autoDestroy(x: UserMapAssocArr) {
  if !noRefCount {
    var cnt = x.destroyArray();
    if cnt == 0 then
      delete x;
  }
}

//
// the local array class
//
class LocUserMapAssocArr {

  // GENERICS:

  //
  // The index type of the domain
  //
  type idxType;

  //
  // the element type
  //
  type eltType;

  // LINKAGE:

  //
  // LEFT: a reference to the local domain class for this array and locale
  //
  const locDom: LocUserMapAssocDom(idxType);

  // STATE:

  //
  // the block of local array data
  //
  var myElems: [locDom.myInds] eltType;

  // LOCAL ARRAY INTERFACE:

  //
  // the accessor for the local array -- assumes the index is local
  //
  proc this(i: idxType) ref {
    return myElems(i);
  }

  //
  // iterator over the elements owned by this locale
  //
  iter these() ref {
    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
  //
  iter these(param tag: iterKind) where tag == iterKind.leader {
    halt("This is bogus");
    yield {1..100};
  }

  iter these(param tag: iterKind, followThis) ref where tag == iterKind.follower {
    yield myElems(0);
  }

  //
  // prints out this locale's piece of the array
  //
  proc 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
  //
  proc numElements {
    return myElems.numElements;
  }

  // INTERNAL INTERFACE:

  proc owns(x) {
    //
    // TODO: When this is multidimensional need to do a reduction or something:
    //
    return locDom.myInds.dim(1).boundsCheck(x.dim(1));
  }
}

//
// a helper function for blocking index ranges:
//

proc chpl_computeBlock(waylo, numelems, lo, wayhi, numblocks, blocknum) {
  proc procToData(x, lo)
    return lo + (x: lo.type) + (x:real != x:int:real): lo.type;

  const blo = if (blocknum == 0) then waylo
              else procToData((numelems: real * blocknum) / numblocks, lo);
  const bhi = if (blocknum == numblocks - 1) then wayhi
              else procToData((numelems: real * (blocknum+1)) / numblocks, lo) - 1;

  return (blo, bhi);
}


Making this example clearer

Making this example clearer

/*

  Associative Primer

  This is a tutorial on Chapel's associative domains and arrays.

  It would be beneficial to read the 'arrays.chpl' and 'domains.chpl'
  primers before proceeding.

*/

config const n = 20;

//
// Associative domains represent an arbitrary index set of any type.
//
// Names is an associative domain whose indices are strings.  Associative domains
// start out empty (no indices).
//
var Names: domain(string);
writeln("An empty associative domain: ", Names);
writeln();

//
// The '+=' operator can be used to add indices to an associative domain.
//
Names += "Alice";
Names += "Bob";
Names += "Clark";
Names += "Dana";

//
// The 'add' method is equivalent to '+='
//
Names.add("Ellen");
Names.add("Frank");
writeln("A populated associative domain of strings: ", Names);
writeln();

//
// The '-=' operator is used to remove indices from an associative domain.
// The 'remove' method performs the same function.
//
Names -= "Bob";
Names += "Robert";
writeln("Removed 'Bob', added 'Robert': ", Names);
writeln();

//
// If we want to check that "Bob" was indeed removed we can use the
// 'member' function, which returns a boolean.
//
assert(!Names.member("Bob"));

//
// Like all other domains, we can use associative domains to define an array.
// Scores is the Chapel-equivalent of a 'map', 'dictionary', or 'hash' found in
// other languages.
//
// Scores: an associative array of strings to integers.
//
var Scores : [Names] int;

//
// All array elements are initialized to the default value for that type.
//
writeln("Our first associative array: ", Scores);

//
// Printing an array only prints its values. Let's write a function that
// prints our associative array in a more human-readable format.
//

//
// given an array, print in the following format:
// { idx => val, ... }
//
proc prettyPrint(arr : []) {
  write("{ ");
  var first = true;
  for k in arr.domain.sorted() {
    if !first then write(", ", k, " => ", arr[k]);
    else {
      write(k, " => ", arr[k]);
      first = false;
    }
  }
  writeln(" }");
}

write("Our first array, pretty-printed: ");
prettyPrint(Scores);
writeln();

//
// We can also implicitly add indices to an associative array if the
// underlying domain defines only one array.
//
// Here, the string "Gary" is added as an index, and the corresponding
// array element is initialized to 10.
//
Scores["Gary"] = 10;
write("Our Scores array after adding 'Gary': ");
prettyPrint(Scores);
writeln();

//
// We can also verify that the underlying 'Names' domain was modified:
//
assert(Names.member("Gary"));

//
// If we were to define another array with 'Names' as the backing domain,
// then we could no longer use this convenient syntax.
//
// Here, Ages and Scores are backed by the same associative domain, Names.
// We can no longer write something like
//   Ages["Mark"] = 18;
// or
//   Score["Sam"] = 10;
// if "Mark" or "Sam" are not a valid indices in the 'Names' domain.
//
var Ages : [Names] int;

//
// This limitation exists because it is not obvious that other arrays
// are being modified. After you define multiple arrays with one domain,
// you should use that domain to add more indices.
//
Names.add("Mark");
Ages["Mark"] = 18;

//
// The program will still halt if one tries to access an index
// not in the domain.
//
// HALTS: writeln(Scores["Sally"]);
//

//
// Various set operations are available on associative domains and arrays.
// Union (| or +)
// Intersection (&)
// Difference (-)
// Symmetric Difference (^)
//

//
// We'll use domains of integers for convenience, but
// these set operations work for any index type.
//

var odds, evens, ltHalf : domain(int);
odds += 1..n by 2;
evens += 1..n by 2 align 2;
ltHalf += 1..(n/2);

//
// Note: The sorted() method returns an array, not a sorted domain
//
writeln("Integers from 1..n composed of odds | evens: ", (odds | evens).sorted());
writeln("Odd integers below n/2: odds & ltHalf = ", (odds & ltHalf).sorted());
writeln("Another way to get the same result: ltHalf - evens = ", (ltHalf - evens).sorted());
writeln("Even below n/2, odd above: ltHalf ^ odds = ", (ltHalf ^ odds).sorted());
writeln();

//
// Let's use the array-literal syntax to create a couple of arrays to use
// as examples for set operations.
//
var A = ["a" => true, "b" => false, "c" => true];
var B = ["b" => true, "c" => false, "d" => true];
writeln("Some simple associative arrays:");
write("A = ");
prettyPrint(A);
write("B = ");
prettyPrint(B);

//
// When performing a union between two arrays and indices conflict, the values
// of the second array take precedence.
//
var C = A | B;
write("C is the union of A and B; C = A | B : ");
prettyPrint(C);

//
// We can also use the |= operator on associative arrays. However, this
// is only permitted when the array's domain doesn't define any other arrays.
// Again, this is limitation exists so that other arrays aren't modified in
// a surprising way.
//
A |= B;
write("A becomes the union of A and B; A |= B: ");
prettyPrint(A);

/*

  Associative Primer

  This is a tutorial on Chapel's associative domains and arrays.

  It would be beneficial to read the 'arrays.chpl' and 'domains.chpl'
  primers before proceeding.

*/

config const n = 20;

//
// Associative domains represent an arbitrary index set of any type.
//
// Names is an associative domain whose indices are strings.  Associative domains
// start out empty (no indices).
//
var Names: domain(string);
writeln("An empty associative domain: ", Names);
writeln();

//
// The '+=' operator can be used to add indices to an associative domain.
//
Names += "Alice";
Names += "Bob";
Names += "Clark";
Names += "Dana";

//
// The 'add' method is equivalent to '+='
//
Names.add("Ellen");
Names.add("Frank");
writeln("A populated associative domain of strings: ", Names);
writeln();

//
// The '-=' operator is used to remove indices from an associative domain.
// The 'remove' method performs the same function.
//
Names -= "Bob";
Names += "Robert";
writeln("Removed 'Bob', added 'Robert': ", Names);
writeln();

//
// If we want to check that "Bob" was indeed removed we can use the
// 'member' function, which returns a boolean.
//
assert(!Names.member("Bob"));

//
// Like all other domains, we can use associative domains to define an array.
// Scores is the Chapel-equivalent of a 'map', 'dictionary', or 'hash' found in
// other languages.
//
// Scores: an associative array of strings to integers.
//
var Scores : [Names] int;

//
// All array elements are initialized to the default value for that type.
//
writeln("Our first associative array: ", Scores);

//
// Printing an array only prints its values. Let's write a function that
// prints our associative array in a more human-readable format.
//

//
// given an array, print in the following format:
// { idx => val, ... }
//
proc prettyPrint(arr : []) {
  write("{ ");
  var first = true;
  for k in arr.domain.sorted() {
    if !first then write(", ", k, " => ", arr[k]);
    else {
      write(k, " => ", arr[k]);
      first = false;
    }
  }
  writeln(" }");
}

write("Our first array, pretty-printed: ");
prettyPrint(Scores);
writeln();

//
// We can also implicitly add indices to an associative array if the
// underlying domain defines only one array.
//
// Here, the string "Gary" is added as an index, and the corresponding
// array element is initialized to 10.
//
Scores["Gary"] = 10;
write("Our Scores array after adding 'Gary': ");
prettyPrint(Scores);
writeln();

//
// We can also verify that the underlying 'Names' domain was modified:
//
assert(Names.member("Gary"));

//
// If we were to define another array with 'Names' as the backing domain,
// then we could no longer use this convenient syntax.
//
// Here, Ages and Scores are backed by the same associative domain, Names.
// We can no longer write something like
//   Ages["Mark"] = 18;
// if "Mark" is not a valid index.
//
var Ages : [Names] int;

//
// This limitation exists because it is not obvious that other arrays
// are being modified. After you define multiple arrays with one domain,
// you should use that domain to add more indices.
//
Names.add("Mark");
Ages["Mark"] = 18;

//
// The program will still halt if one tries to access an index
// not in the domain.
//
// HALTS: writeln(Scores["Sally"]);
//

//
// Various set operations are available on associative domains and arrays.
// Union (| or +)
// Intersection (&)
// Difference (-)
// Symmetric Difference (^)
//

//
// We'll use domains of integers for convenience, but
// these set operations work for any index type.
//

var odds, evens, ltHalf : domain(int);
odds += 1..n by 2;
evens += 1..n by 2 align 2;
ltHalf += 1..(n/2);

//
// Note: The sorted() method returns an array, not a sorted domain
//
writeln("Integers from 1..n composed of odds | evens: ", (odds | evens).sorted());
writeln("Odd integers below n/2: odds & ltHalf = ", (odds & ltHalf).sorted());
writeln("Another way to get the same result: ltHalf - evens = ", (ltHalf - evens).sorted());
writeln("Even below n/2, odd above: ltHalf ^ odds = ", (ltHalf ^ odds).sorted());
writeln();

//
// Let's use the array-literal syntax to create a couple of arrays to use
// as examples for set operations.
//
var A = ["a" => true, "b" => false, "c" => true];
var B = ["b" => true, "c" => false, "d" => true];
writeln("Some simple associative arrays:");
write("A = ");
prettyPrint(A);
write("B = ");
prettyPrint(B);

//
// When performing a union between two arrays and indices conflict, the values
// of the second array take precedence.
//
var C = A | B;
write("C is the union of A and B; C = A | B : ");
prettyPrint(C);

//
// We can also use the |= operator on associative arrays. However, this
// is only permitted when the array's domain doesn't define any other arrays.
// Again, this is limitation exists so that other arrays aren't modified in
// a surprising way.
//
A |= B;
write("A becomes the union of A and B; A |= B: ");
prettyPrint(A);


Convert fat TABs to 2-space TABs

Convert fat TABs to 2-space TABs

/* nbody_forloop + vectorized operations
 * We also shorten exponential functions using the shorthand
 * operator.
 *
 * The Great Computer Language Shootout
 * http://shootout.alioth.debian.org/
 *
 * contributed by Albert Sidelnik
 *
*/

config var n = 10000;
param PI = 3.141592653589793;
const solar_mass = (4 * PI * PI);
param days_per_year = 365.24;

record Planet {
  var coord_vector : [0..2] real; // x,y,z
  var vel_vector : [0..2] real;   // vx,vy,vz
  var mass : real;
}

proc advance(B: [] Planet, dt: real) {
  for (b1, i) in zip(B, 0..) do {
    for b2 in B[i+1..] do {
      var d : [0..2] real = b1.coord_vector - b2.coord_vector;
      //var d : [] real = b1.coord_vector - b2.coord_vector;
      var distance = sqrt(d[0]**2 + d[1]**2 + d[2]**2);
      var mag = dt / (distance**3);
      b1.vel_vector -= d * b2.mass * mag;
      b2.vel_vector += d * b1.mass * mag;
    }
  }
  for b in B do
    b.coord_vector += dt * b.vel_vector;
}

proc energy(B : [] Planet) : real {
  var e : real;
  for (b1,i) in zip(B,0..) do {
    e += 0.5 * b1.mass * (b1.vel_vector(0)**2 +
                          b1.vel_vector(1)**2 +
                          b1.vel_vector(2)**2);
    for b2 in B[i+1..] do {
      var d : [0..2] real = b1.coord_vector - b2.coord_vector;
      var distance = sqrt(d[0]**2 + d[1]**2 + d[2]**2);
      e -= (b1.mass * b2.mass) / distance;
    }
  }
  return e;
}

proc offset_momentum(B : [] Planet) {
  var p : [0..2] real;
  for b in B do
    p += b.vel_vector * b.mass;
  B(0).vel_vector = -p / solar_mass;
}

proc main() {
  param NBODIES = 5;
  var bodies : [0..#NBODIES] Planet;

  var p0,v0 : [0..2] real = (0,0,0);
  bodies(0) = new Planet(p0,v0, solar_mass);
  var p1 : [0..2] real = 	(4.84143144246472090e+00,
                                 -1.16032004402742839e+00,
                                 -1.03622044471123109e-01);
  var v1 : [0..2] real = 	(1.66007664274403694e-03 * days_per_year,
                                 7.69901118419740425e-03 * days_per_year,
                                 -6.90460016972063023e-05 * days_per_year);
  bodies(1) = new Planet(p1, v1, 9.54791938424326609e-04 * solar_mass);
  var p2 : [0..2] real = (8.34336671824457987e+00,
                          4.12479856412430479e+00,
                          -4.03523417114321381e-01);
  var v2 : [0..2] real = (-2.76742510726862411e-03 * days_per_year,
                          4.99852801234917238e-03 * days_per_year,
                          2.30417297573763929e-05 * days_per_year);
  bodies(2) = new Planet(p2, v2, 2.85885980666130812e-04 * solar_mass);
  var p3 : [0..2] real = (1.28943695621391310e+01,
                          -1.51111514016986312e+01,
                          -2.23307578892655734e-01);
  var v3 : [0..2] real = (2.96460137564761618e-03 * days_per_year,
                          2.37847173959480950e-03 * days_per_year,
                          -2.96589568540237556e-05 * days_per_year);
  bodies(3) = new Planet(p3,v3, 4.36624404335156298e-05 * solar_mass);
  var p4 : [0..2] real = (1.53796971148509165e+01,
                          -2.59193146099879641e+01,
                          1.79258772950371181e-01);
  var v4 : [0..2] real = (2.68067772490389322e-03 * days_per_year,
                          1.62824170038242295e-03 * days_per_year,
                          -9.51592254519715870e-05 * days_per_year);
  bodies(4) = new Planet(p4,v4, 5.15138902046611451e-05 * solar_mass);

  offset_momentum(bodies);
  writeln(format("#.#########", energy(bodies)));
  for 1..n do {
    advance(bodies, 0.01);
  }
  writeln(format("#.#########", energy(bodies)));
}


Fixed outdated halt statement

Fixed outdated halt statement

/*
  A 'Collection' is a data structure, a container for elements that provide support
  for insert, lookup, remove, and iteration operations.
*/
class Collection {
  /*
    The type of element that this Collection holds.
  */
  type eltType;

  /*
    Adds an element to this data structure.
  */
  inline proc add(elt : eltType) : bool {
    halt("'proc add(elt : eltType) : bool' is not supported...");
  }

  /*
    Removes an arbitrary element from this data structure.

    **BUG:** Compiler will segfault if the returned value is not captured at callsite.
    Issue: #6542

    **FIX:** Ensure that you always capture the return value...

    ::

      var capturedRetval = c.remove()

    **BUG:** Loop Invariant Code Motion causes undefined behavior if assigned to a
    variable declared outside of loop. Issue: #7003

    **FIX:** Use the `--no-loop-invariant-code-motion` to disable LICM.
    Otherwise, just make sure you always capture the return value inside of a loop
    in a variable not declared outside of loop...

    ::

      for i in 1 .. N {
        var retval = c.remove();
      }

  */
  inline proc remove() : (bool, eltType) {
    halt("'proc remove() : (bool, eltType)' is not supported...");
  }

  /*
    Determine whether an element exists in this collection.
  */
  inline proc contains(elt : eltType) : bool {
    halt("'proc contains(elt : eltType) : bool' is not supported...");
  }

  /*
    Clears all elements in this collection.
  */
  inline proc clear() {
    while !remove()[1] do ;
  }

  /*
    Check if this data structure is empty.
  */
  inline proc isEmpty() : bool {
    return getSize() == 0;
  }

  /*
    Syntactic sugar for `size`.
  */
  inline proc length : int {
    return size();
  }

  inline proc size : int {
    return getSize();
  }

  /*
    Obtain the number of elements contained in this collection.
  */
  inline proc getSize() : int {
    halt("'proc size() : int' is not supported...");
  }

  /*
    Iterate over all elements in the data structure.

    **BUG:** Compiler does not currently allow overloading standalone or leader/follower
    iterators, and as such only serial iterators may be used with the base type. See
    issue #6998
  */
  iter these() : eltType {
    halt("'iter these() : eltType' is not supported...");
    yield _defaultOf(eltType);
  }
}

/*
  Syntactic sugar for 'add'.

  **BUG:** Compiler produces a warning that `c` should be a `ref`, when it is not needed
  because it is a class and can be used by value. Need a pragma to disable this?
  As such, this cannot be used where `ref` intents cannot be used, such as ``forall``
  and ``coforall`` loops.
*/
proc +=(ref c : Collection(?eltType), elt : eltType) {
  c.add(elt);
}

/*
  A 'Collection' is a data structure, a container for elements that provide support
  for insert, lookup, remove, and iteration operations.
*/
class Collection {
  /*
    The type of element that this Collection holds.
  */
  type eltType;

  /*
    Adds an element to this data structure.
  */
  inline proc add(elt : eltType) : bool {
    halt("'proc add(elts : eltType ... ?nElts) : bool' is not supported...");
  }

  /*
    Removes an arbitrary element from this data structure.

    **BUG:** Compiler will segfault if the returned value is not captured at callsite.
    Issue: #6542

    **FIX:** Ensure that you always capture the return value...

    ::

      var capturedRetval = c.remove()

    **BUG:** Loop Invariant Code Motion causes undefined behavior if assigned to a
    variable declared outside of loop. Issue: #7003

    **FIX:** Use the `--no-loop-invariant-code-motion` to disable LICM.
    Otherwise, just make sure you always capture the return value inside of a loop
    in a variable not declared outside of loop...

    ::

      for i in 1 .. N {
        var retval = c.remove();
      }

  */
  inline proc remove() : (bool, eltType) {
    halt("'proc remove() : (bool, eltType)' is not supported...");
  }

  /*
    Determine whether an element exists in this collection.
  */
  inline proc contains(elt : eltType) : bool {
    halt("'proc contains(elt : eltType) : bool' is not supported...");
  }

  /*
    Clears all elements in this collection.
  */
  inline proc clear() {
    while !remove()[1] do ;
  }

  /*
    Check if this data structure is empty.
  */
  inline proc isEmpty() : bool {
    return getSize() == 0;
  }

  /*
    Syntactic sugar for `size`.
  */
  inline proc length : int {
    return size();
  }

  inline proc size : int {
    return getSize();
  }

  /*
    Obtain the number of elements contained in this collection.
  */
  inline proc getSize() : int {
    halt("'proc size() : int' is not supported...");
  }

  /*
    Iterate over all elements in the data structure.

    **BUG:** Compiler does not currently allow overloading standalone or leader/follower
    iterators, and as such only serial iterators may be used with the base type. See
    issue #6998
  */
  iter these() : eltType {
    halt("'iter these() : eltType' is not supported...");
    yield _defaultOf(eltType);
  }
}

/*
  Syntactic sugar for 'add'.

  **BUG:** Compiler produces a warning that `c` should be a `ref`, when it is not needed
  because it is a class and can be used by value. Need a pragma to disable this?
  As such, this cannot be used where `ref` intents cannot be used, such as ``forall``
  and ``coforall`` loops.
*/
proc +=(ref c : Collection(?eltType), elt : eltType) {
  c.add(elt);
}