Remove forall here, we already have quite coarse grained parallelism

use Histogram;
use Random;
use Time;

// Test flags
config const isTest=false;
config const isPerf=false;
config const doBrute=false;

// Performance test parameters
config const nParticles=10000;

// Input/Output filenames
config const fn1 = "test.dat";
config const fn2 = "test.dat";
config const pairfn = "test-DD.dat";

// Dimension constanst
param NDIM=3;
param NEXT=2; // w, r2
param NTOT=NDIM+NEXT;
const W=NDIM;
const R2=NDIM+1;
const ParticleAttrib = 0.. #NTOT;
const DimSpace = 0.. #NDIM;

// Tree parameters
config const minpart=500;

// Histogram parameters
config const smax=200.0;
config const smax2=smax**2;
config const nmubins=5;
config const nsbins=5;

// Global variables
var gtime1 : Timer;

proc main() {
  doPairs();
}

class Particle3D {
  var npart : int = 0;
  var Darr : domain(2);
  var Dpart : domain(1);
  var arr : [Darr] real;

  var _tmp : [Dpart] real;
  var _n1, _ndx : [Dpart] int;

  proc Particle3D(npart1 : int, random : bool = false) {
    npart = npart1;
    Darr = {ParticleAttrib, 0.. #npart};
    Dpart = {0.. #npart};
    if random {
      var rng = new RandomStream();
      var x, y, z : real;
      for ii in Dpart {
        x = rng.getNext()*1000.0; y = rng.getNext()*1000.0; z = rng.getNext()*1000.0;
        arr[0,ii] = x; arr[1, ii] = y; arr[2, ii] = z;
        arr[3,ii] = 1.0;
        arr[4,ii] = x**2 + y**2 + z**2;
      }
      delete rng;
    }
  }

  proc this(ii : int) : NTOT*real {
    // ??? Hardcoded hack!
    return (arr[0,ii],arr[1,ii],arr[2,ii],arr[3,ii],arr[4,ii]);
  }

  // Reorder all the arrays according to _ndx (we assume you have set this)
  proc reorder(idom : domain(1)) {

    for kk in ParticleAttrib {
      forall ii in idom {
        _tmp[_ndx[ii]] = arr[kk,ii];
      }
      forall ii in idom {
        arr[kk,ii] = _tmp[ii];
      }
    }
  }

  // Shuffles the elements of the array...
  // Note that the random number generator cannot cover the space
  // of all permutations, but that's fine for what we need.
  proc shuffle() {
    // Fill in _ndx
    forall ii in Dpart {
      _ndx[ii] = ii;
    }

    // Set the random number generator
    var rng = new RandomStream(41);
    var jj : int;
    for ii in 0..(npart-2) {
      jj = (rng.getNext()*(npart-ii)):int + ii;
      _ndx[jj] <=> _ndx[ii];
    }
    delete rng;

    reorder(Dpart);
  }

}

proc countLines(fn : string) : int {
  var ff = open(fn, iomode.r);
  var ipart = 0;
  for iff in ff.lines() do ipart +=1;
  ff.close();
  return ipart;
}

proc readFile(fn : string) : Particle3D  {
  var npart = countLines(fn);
  var pp = new Particle3D(npart);

  var ff = openreader(fn);
  var ipart = 0;
  var x,y,z,w,r2 : real;
  while (ff.read(x,y,z,w)) {
    r2 = x**2 + y**2 + z**2;
    pp.arr[..,ipart] = [x,y,z,w,r2];
    ipart += 1;
  }
  ff.close();

  return pp;
}

proc splitOn(pp : Particle3D, idom : domain(1), splitDim : int, xsplit : real) : int {
  // Setup for a prefix scan
  forall ii in idom {
    if (pp.arr[splitDim,ii] < xsplit) {
      pp._n1[ii] = 1;
    } else {
      pp._n1[ii] = 0;
    }
  }

  var lnpart : int = 0;
  for ii in idom do lnpart += pp._n1[ii];
  var li = idom.low;
  var ri = li+lnpart;
  for ii in idom {
    if (pp._n1[ii] == 1) {
      pp._ndx[ii] = li;
      li += 1;
    } else {
      pp._ndx[ii] = ri;
      ri += 1;
    }
  }

  pp.reorder(idom);

  return lnpart;
}

class KDNode {
  var lo, hi,npart,id : int;
  var dom : domain(1);
  var xcen : [DimSpace]real;
  var rcell : real;
  var left, right : KDNode;

  proc isLeaf() : bool {
    return (left==nil) && (right==nil);
  }

  proc ~KDNode() {
    if left then delete left;
    if right then delete right;
  }

}

proc BuildTree(pp : Particle3D, lo : int, hi : int, id : int) : KDNode  {
  var me : KDNode = new KDNode();
  me.lo = lo;
  me.hi = hi;
  me.dom = {lo..hi};
  me.id = id;
  me.npart = (me.hi-me.lo)+1;

  //  work out xcen and vantage point radius
  var pmin, pmax : [DimSpace] real;
  for idim in DimSpace {
    pmin[idim] = min reduce pp.arr[idim,lo..hi];
    pmax[idim] = max reduce pp.arr[idim,lo..hi];
  }
  me.xcen = (pmax+pmin)/2.0;
  me.rcell = 0.0;
  var r1 : real;
  for ii in lo..hi {
    r1 = 0.0;
    for idim in DimSpace {
      r1 += (pp.arr[idim,ii]-me.xcen[idim])**2;
    }
    r1 = sqrt(r1);
    if (r1 > me.rcell) then me.rcell = r1;
  }

  // Continue to split
  if (me.npart <= minpart) then return me; // Don't split further.

  // Find dimension to split on
  var dx : [DimSpace] real;
  dx = pmax - pmin;
  var splitDim = 0;
  for idim in DimSpace {
    if (dx[idim] > dx[splitDim]) then splitDim=idim;
  }

  // Split
  var lnpart = splitOn(pp,me.dom,splitDim, me.xcen[splitDim]);
  me.left  = BuildTree(pp, lo, lo+lnpart-1, 2*id+1);
  me.right = BuildTree(pp, lo+lnpart, hi,2*id+2);
  return me;
}

proc TreeAccumulate(hh : UniformBins, p1, p2 : Particle3D, node1, node2 : KDNode) {
  // Compute the distance between node1 and node2
  var rr = sqrt (+ reduce(node1.xcen - node2.xcen)**2);
  var rmin = rr - (node1.rcell+node2.rcell);

  // If distance is greater than all cases
  if (rmin > smax) then return;

  // If both nodes are leaves
  if (node1.isLeaf() & node2.isLeaf()) {
    begin smuAccumulate(hh, p1, p2, node1.dom, node2.dom,1);
    return;
  }

  // If one node is a leaf
  if (node1.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }
  if (node2.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  }

  // Split the larger case;
  if (node1.npart > node2.npart) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  } else {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }

}

// The basic pair counter
proc smuAccumulate(hh : UniformBins, p1,p2 : Particle3D, d1,d2 : domain(1), scale : real) {
  for ii in d1 { // Loop over first set of particles

    var x1,y1,z1,w1,r2 : real;
    var sl, s2, l1, s1, l2, mu, wprod : real;
    (x1,y1,z1,w1,r2) = p1[ii];

    for jj in d2 { // Second set of particles
      mu=2*(p2.arr[0,jj]*x1 + p2.arr[1,jj]*y1 + p2.arr[2,jj]*z1);
      sl = r2 - p2.arr[R2,jj];
      l1 = r2 + p2.arr[R2,jj];
      s2 = l1 - mu;
      l2 = l1 + mu;
      if ((s2 < smax2) && (s2 > 1.0e-20)) {
        wprod = scale * w1 * p2.arr[W,jj];
        s1 = sqrt(s2);
        mu = sl/(s1*sqrt(l2));
        if (mu < 0) then mu = -mu;

        hh.add((s1,mu),wprod);
      }
    }
  }
}

proc doPairs() {
  var tt : Timer;

  // Read in the file
  tt.clear(); tt.start();
  var pp1, pp2 : Particle3D;
  if isPerf {
    pp1 = new Particle3D(nParticles, true);
    pp2 = new Particle3D(nParticles, true);
  } else {
    pp1 = readFile(fn1);
    pp2 = readFile(fn2);
    if !isTest {
      writef("Read in %i lines from file %s \n", pp1.npart, fn1);
      writef("Read in %i lines from file %s \n", pp2.npart, fn2);
    }
  }
  tt.stop();
  if !isTest {
    writef("Time to read : %r \n", tt.elapsed());
  }

  // Shuffle the particles -- this is not used here, but will be usef for the multilocale version
  tt.clear(); tt.start();
  pp1.shuffle();
  pp2.shuffle();
  tt.stop();
  if !isTest then writef("Time to shuffle : %r \n",tt.elapsed());

  // Build the tree
  tt.clear(); tt.start(); gtime1.clear();
  var root1 = BuildTree(pp1, 0, pp1.npart-1, 0);
  var root2 = BuildTree(pp2, 0, pp2.npart-1, 0);
  tt.stop();
  if !isTest then writef("Time to build trees : %r \n", tt.elapsed());
  //writef("Time in splitOn : %r \n", gtime1.elapsed());

  // Set up the histogram
  var hh = new UniformBins(2,(nsbins,nmubins), ((0.0,smax),(0.0,1.0+1.e-10)));

  // Do the paircounts with a tree
  hh.reset();
  tt.clear(); tt.start();
  sync TreeAccumulate(hh, pp1,pp2, root1, root2);
  tt.stop();
  if (!isTest) {
    writef("Time to tree paircount : %r \n", tt.elapsed());
    if !isPerf {
      var ff = openwriter("%s.tree".format(pairfn));
      writeHist(ff,hh);
      ff.close();
    }
  } else {
    hh.set((0,0),0.0);
    writeHist(stdout,hh,"%20.5er ");
  }

  //
  // clean up
  //
  delete pp1;
  delete pp2;
  delete root1;
  delete root2;
  delete hh;
}

use Histogram;
use Random;
use Time;

// Test flags
config const isTest=false;
config const isPerf=false;
config const doBrute=false;

// Performance test parameters
config const nParticles=10000;

// Input/Output filenames
config const fn1 = "test.dat";
config const fn2 = "test.dat";
config const pairfn = "test-DD.dat";

// Dimension constanst
param NDIM=3;
param NEXT=2; // w, r2
param NTOT=NDIM+NEXT;
const W=NDIM;
const R2=NDIM+1;
const ParticleAttrib = 0.. #NTOT;
const DimSpace = 0.. #NDIM;

// Tree parameters
config const minpart=500;

// Histogram parameters
config const smax=200.0;
config const smax2=smax**2;
config const nmubins=5;
config const nsbins=5;

// Global variables
var gtime1 : Timer;

proc main() {
  doPairs();
}

class Particle3D {
  var npart : int = 0;
  var Darr : domain(2);
  var Dpart : domain(1);
  var arr : [Darr] real;

  var _tmp : [Dpart] real;
  var _n1, _ndx : [Dpart] int;

  proc Particle3D(npart1 : int, random : bool = false) {
    npart = npart1;
    Darr = {ParticleAttrib, 0.. #npart};
    Dpart = {0.. #npart};
    if random {
      var rng = new RandomStream();
      var x, y, z : real;
      for ii in Dpart {
        x = rng.getNext()*1000.0; y = rng.getNext()*1000.0; z = rng.getNext()*1000.0;
        arr[0,ii] = x; arr[1, ii] = y; arr[2, ii] = z;
        arr[3,ii] = 1.0;
        arr[4,ii] = x**2 + y**2 + z**2;
      }
      delete rng;
    }
  }

  proc this(ii : int) : NTOT*real {
    // ??? Hardcoded hack!
    return (arr[0,ii],arr[1,ii],arr[2,ii],arr[3,ii],arr[4,ii]);
  }

  // Reorder all the arrays according to _ndx (we assume you have set this)
  proc reorder(idom : domain(1)) {

    for kk in ParticleAttrib {
      forall ii in idom {
        _tmp[_ndx[ii]] = arr[kk,ii];
      }
      forall ii in idom {
        arr[kk,ii] = _tmp[ii];
      }
    }
  }

  // Shuffles the elements of the array...
  // Note that the random number generator cannot cover the space
  // of all permutations, but that's fine for what we need.
  proc shuffle() {
    // Fill in _ndx
    forall ii in Dpart {
      _ndx[ii] = ii;
    }

    // Set the random number generator
    var rng = new RandomStream(41);
    var jj : int;
    for ii in 0..(npart-2) {
      jj = (rng.getNext()*(npart-ii)):int + ii;
      _ndx[jj] <=> _ndx[ii];
    }
    delete rng;

    reorder(Dpart);
  }

}

proc countLines(fn : string) : int {
  var ff = open(fn, iomode.r);
  var ipart = 0;
  for iff in ff.lines() do ipart +=1;
  ff.close();
  return ipart;
}

proc readFile(fn : string) : Particle3D  {
  var npart = countLines(fn);
  var pp = new Particle3D(npart);

  var ff = openreader(fn);
  var ipart = 0;
  var x,y,z,w,r2 : real;
  while (ff.read(x,y,z,w)) {
    r2 = x**2 + y**2 + z**2;
    pp.arr[..,ipart] = [x,y,z,w,r2];
    ipart += 1;
  }
  ff.close();

  return pp;
}

proc splitOn(pp : Particle3D, idom : domain(1), splitDim : int, xsplit : real) : int {
  // Setup for a prefix scan
  forall ii in idom {
    if (pp.arr[splitDim,ii] < xsplit) {
      pp._n1[ii] = 1;
    } else {
      pp._n1[ii] = 0;
    }
  }

  var lnpart : int = 0;
  for ii in idom do lnpart += pp._n1[ii];
  var li = idom.low;
  var ri = li+lnpart;
  for ii in idom {
    if (pp._n1[ii] == 1) {
      pp._ndx[ii] = li;
      li += 1;
    } else {
      pp._ndx[ii] = ri;
      ri += 1;
    }
  }

  pp.reorder(idom);

  return lnpart;
}

class KDNode {
  var lo, hi,npart,id : int;
  var dom : domain(1);
  var xcen : [DimSpace]real;
  var rcell : real;
  var left, right : KDNode;

  proc isLeaf() : bool {
    return (left==nil) && (right==nil);
  }

  proc ~KDNode() {
    if left then delete left;
    if right then delete right;
  }

}

proc BuildTree(pp : Particle3D, lo : int, hi : int, id : int) : KDNode  {
  var me : KDNode = new KDNode();
  me.lo = lo;
  me.hi = hi;
  me.dom = {lo..hi};
  me.id = id;
  me.npart = (me.hi-me.lo)+1;

  //  work out xcen and vantage point radius
  var pmin, pmax : [DimSpace] real;
  for idim in DimSpace {
    pmin[idim] = min reduce pp.arr[idim,lo..hi];
    pmax[idim] = max reduce pp.arr[idim,lo..hi];
  }
  me.xcen = (pmax+pmin)/2.0;
  me.rcell = 0.0;
  var r1 : real;
  for ii in lo..hi {
    r1 = 0.0;
    for idim in DimSpace {
      r1 += (pp.arr[idim,ii]-me.xcen[idim])**2;
    }
    r1 = sqrt(r1);
    if (r1 > me.rcell) then me.rcell = r1;
  }

  // Continue to split
  if (me.npart <= minpart) then return me; // Don't split further.

  // Find dimension to split on
  var dx : [DimSpace] real;
  dx = pmax - pmin;
  var splitDim = 0;
  for idim in DimSpace {
    if (dx[idim] > dx[splitDim]) then splitDim=idim;
  }

  // Split
  var lnpart = splitOn(pp,me.dom,splitDim, me.xcen[splitDim]);
  me.left  = BuildTree(pp, lo, lo+lnpart-1, 2*id+1);
  me.right = BuildTree(pp, lo+lnpart, hi,2*id+2);
  return me;
}

proc TreeAccumulate(hh : UniformBins, p1, p2 : Particle3D, node1, node2 : KDNode) {
  // Compute the distance between node1 and node2
  var rr = sqrt (+ reduce(node1.xcen - node2.xcen)**2);
  var rmin = rr - (node1.rcell+node2.rcell);

  // If distance is greater than all cases
  if (rmin > smax) then return;

  // If both nodes are leaves
  if (node1.isLeaf() & node2.isLeaf()) {
    begin smuAccumulate(hh, p1, p2, node1.dom, node2.dom,1);
    return;
  }

  // If one node is a leaf
  if (node1.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }
  if (node2.isLeaf()) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  }

  // Split the larger case;
  if (node1.npart > node2.npart) {
    TreeAccumulate(hh, p1, p2, node1.left, node2);
    TreeAccumulate(hh, p1, p2, node1.right, node2);
    return;
  } else {
    TreeAccumulate(hh, p1, p2, node1, node2.left);
    TreeAccumulate(hh, p1, p2, node1, node2.right);
    return;
  }

}

// The basic pair counter
proc smuAccumulate(hh : UniformBins, p1,p2 : Particle3D, d1,d2 : domain(1), scale : real) {
  forall ii in d1 { // Loop over first set of particles

    var x1,y1,z1,w1,r2 : real;
    (x1,y1,z1,w1,r2) = p1[ii];

    forall jj in d2 { // Second set of particles
      var sl, s2, l1, s1, l2, mu, wprod : real;
      mu=2*(p2.arr[0,jj]*x1 + p2.arr[1,jj]*y1 + p2.arr[2,jj]*z1);
      sl = r2 - p2.arr[R2,jj];
      l1 = r2 + p2.arr[R2,jj];
      s2 = l1 - mu;
      l2 = l1 + mu;
      if ((s2 < smax2) && (s2 > 1.0e-20)) {
        wprod = scale * w1 * p2.arr[W,jj];
        s1 = sqrt(s2);
        mu = sl/(s1*sqrt(l2));
        if (mu < 0) then mu = -mu;

        hh.add((s1,mu),wprod);
      }
    }
  }
}

proc doPairs() {
  var tt : Timer;

  // Read in the file
  tt.clear(); tt.start();
  var pp1, pp2 : Particle3D;
  if isPerf {
    pp1 = new Particle3D(nParticles, true);
    pp2 = new Particle3D(nParticles, true);
  } else {
    pp1 = readFile(fn1);
    pp2 = readFile(fn2);
    if !isTest {
      writef("Read in %i lines from file %s \n", pp1.npart, fn1);
      writef("Read in %i lines from file %s \n", pp2.npart, fn2);
    }
  }
  tt.stop();
  if !isTest {
    writef("Time to read : %r \n", tt.elapsed());
  }

  // Shuffle the particles -- this is not used here, but will be usef for the multilocale version
  tt.clear(); tt.start();
  pp1.shuffle();
  pp2.shuffle();
  tt.stop();
  if !isTest then writef("Time to shuffle : %r \n",tt.elapsed());

  // Build the tree
  tt.clear(); tt.start(); gtime1.clear();
  var root1 = BuildTree(pp1, 0, pp1.npart-1, 0);
  var root2 = BuildTree(pp2, 0, pp2.npart-1, 0);
  tt.stop();
  if !isTest then writef("Time to build trees : %r \n", tt.elapsed());
  //writef("Time in splitOn : %r \n", gtime1.elapsed());

  // Set up the histogram
  var hh = new UniformBins(2,(nsbins,nmubins), ((0.0,smax),(0.0,1.0+1.e-10)));

  // Do the paircounts with a tree
  hh.reset();
  tt.clear(); tt.start();
  sync TreeAccumulate(hh, pp1,pp2, root1, root2);
  tt.stop();
  if (!isTest) {
    writef("Time to tree paircount : %r \n", tt.elapsed());
    if !isPerf {
      var ff = openwriter("%s.tree".format(pairfn));
      writeHist(ff,hh);
      ff.close();
    }
  } else {
    hh.set((0,0),0.0);
    writeHist(stdout,hh,"%20.5er ");
  }

  //
  // clean up
  //
  delete pp1;
  delete pp2;
  delete root1;
  delete root2;
  delete hh;
}


First stab at making the RandomStream class parameterized by eltType

/*
 * Copyright 2004-2015 Cray Inc.
 * Other additional copyright holders may be indicated within.
 *
 * The entirety of this work is licensed under the Apache License,
 * Version 2.0 (the "License"); you may not use this file except
 * in compliance with the License.
 *
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

/*
   Support for pseudorandom number generation

   This module defines an abstraction for a stream of pseudorandom
   numbers, :class:`RandomStream`.  It also provides a
   convenience function, :proc:`fillRandom` that can be used to
   fill an array with random numbers in parallel.

   The current pseudorandom number generator (PRNG) implemented by
   this module uses the algorithm from the NAS Parallel Benchmarks
   (NPB, available at: http://www.nas.nasa.gov/publications/npb.html).
   The longer-term intention is to add knobs to select between a menu
   of PRNG algorithms, such as the Mersenne twister.

   Paraphrasing the comments from the NPB reference implementation:

     This generator returns uniform pseudorandom real values in the
     range (0, 1) by using the linear congruential generator

       x_{k+1} = a x_k  (mod 2**46)

     where 0 < x_k < 2**46 and 0 < a < 2**46.  This scheme generates
     2**44 numbers before repeating.  The generated values are
     normalized to be between 0 and 1, i.e., 2**(-46) * x_k.

     This generator should produce the same results on any computer
     with at least 48 mantissa bits for `real(64)` data.

   Here is a list of currently open issues (TODOs) for this module:

   1. This module is currently restricted to generating `real(64)`,
   `imag(64)`, and `complex(128)` complex values.  We would like to
   extend this support to include other primitive types as well.

   2. We plan to support general serial and parallel iterators on the
   RandomStream class; however, providing the full suite of iterators
   is not possible with our current parallel iterator framework.
   Specifically, if :class:`RandomStream` is a follower in a
   zippered iteration context, there is no way for it to update the
   total number of random numbers generated in a safe/sane/coordinated
   way.  We are exploring a revised leader-follower iterator framework
   that would support this idiom (and other cursor-based ones).

   3. If no seed is provided by the user, one is chosen based on the
   current time in microseconds, allowing for some degree of
   pseudorandomness in seed selection.  The intent of
   :record:`SeedGenerators` is to provide a menu of other options
   for initializing the random stream seed, but only one option is
   implemented at present.

   4. As noted above, we plan to add support for additional PRNG
   algorithms over time.

*/
module Random {

  /*
     Note for developers on "private" symbols:

     It is the intent that once Chapel supports a notion of 'private'
     symbols, everything prefixed with RandomPrivate will be made
     private to this module and everything prefixed with
     'RandomStreamPrivate_' will be made private to the RandomStream
     class.
  */

  /* Internal TODOs for developers:

     - should RandomStream be parameterized by the type to return?
       it seems odd that currently getNext() and getNth() return
       reals always...
  */

/*
   An instance of :record:`SeedGenerators` that provides a
   convenient means of generating seeds when the user does not wish to
   specify one manually.
*/
const SeedGenerator: SeedGenerators;

// CHPLDOC FIXME: Respect ordering of things in the file

/*
  Provides methods to help generate seeds when the user doesn't want
  to create one.  It currently only supports one such method, but the
  intention is to add more over time.

  (Note: once Chapel supports static class methods,
  :const:`SeedGenerator` and :record:`SeedGenerators` should
  be combined into a single record type with static methods).
*/

record SeedGenerators {
  /*
    Generate a seed based on the current time in microseconds as
    reported by :proc:`Time.getCurrentTime`, ensuring that it
    meets the PRNG's requirements.
  */
  proc currentTime: int(64) {
    use Time;
    const seed: int(64) = getCurrentTime(unit=TimeUnits.microseconds):int(64);
    return (if seed % 2 == 0 then seed + 1 else seed) % (1:int(64) << 46);
  }
};

// CHPLDOC FEEDBACK: If easy, I'd suggest either deprecating the
// :arg <type> <name>: form or else switching the order to
// :arg <name> <type>: as it's an easy trap to simply type the same
// argument as in the function's signature.

// CHPLDOC FIXME: if the first line below is shifted one character to the
// left, it ends up being rendered like a method

// CHPLDOC FIXME: if the first line below is shifted one character to the
// right, it ends up causing a warning (promoted to error) in the .rst
// file.  It'd be preferable to have it declare the issue in terms of
// the .chpl line numbers.
//

/*
  Fill an array of `real(64)`, `imag(64)`, or `complex(128)` elements
  with pseudorandom values in parallel using a new
  :class:`RandomStream` created specifically for this call.  The
  first `arr.size` values from the stream will be assigned to the
  array's elements in row-major order for `real` and `imag` elements.
  For `complex` elements, consecutive pairs of random numbers are
  assigned to the real and imaginary components, respectively.  The
  parallelization strategy is determined by the array.

  :arg arr: The array to be filled, where T is real(64), imag(64), or complex(128).
  :type arr: [] T

  :arg seed: The seed to use for the PRNG.  Defaults to :proc:`SeedGenerator.currentTime <SeedGenerators.currentTime>`.
  :type seed: int(64)
*/

proc fillRandom(arr: [], seed: int(64) = SeedGenerator.currentTime)
  where (arr.eltType == real || arr.eltType == imag || arr.eltType == complex) {
  var randNums = new RandomStream(seed, eltType=arr.eltType, parSafe=false);
  randNums.fillRandom(arr);
  delete randNums;
}

pragma "no doc"
proc fillRandom(arr: [], seed: int(64) = SeedGenerator.currentTime) {
  compilerError("Random.fillRandom is only defined for real(64), imag(64), and complex(128) arrays");
}

/*
  Models a stream of pseudorandom numbers.  See the module-level
  notes for :mod:`Random` for details on the PRNG used.
*/
class RandomStream {
  /*
    Specifies the type of value generated by the RandomStream.
    Currently, only `real(64)`, `imag(64)`, and `complex(128)` are
    supported.
  */
  type eltType = real(64);

  /*
    Indicates whether or not the RandomStream needs to be
    parallel-safe by default.  If multiple tasks interact with it in
    an uncoordinated fashion, this must be set to `true`.  If it will
    only be called from a single task, or if only one task will call
    into it at a time, setting to `false` will reduce overhead related
    to ensuring mutual exclusion.
  */
  param parSafe: bool = true;

  /*
    The seed value for the PRNG.  It must be an odd integer in the
    range (1, 2**46).
  */
  const seed: int(64);

  /*
    Constructs a new stream of random numbers using the specified seed
    and parallel safety.  Ensures that the seed value meets the PRNG's
    constraints.

    :arg seed: The seed to use for the PRNG.  Defaults to :proc:`SeedGenerator.currentTime <SeedGenerators.currentTime>`..
    :type seed: int(64)

    :arg parSafe: The parallel safety setting.  Defaults to `true`.
    :type parSafe: bool
  */
  proc RandomStream(seed: int(64) = SeedGenerator.currentTime,
                   param parSafe: bool = true) {
    if seed % 2 == 0 || seed < 1 || seed > 1:int(64)<<46 then
      halt("RandomStream seed must be an odd integer between 0 and 2**46");
    RandomStreamPrivate_init(seed);
  }

  pragma "no doc"
  proc RandomStreamPrivate_getNext_noLock() {
    var next: eltType;
    if (eltType == complex) {
      RandomStreamPrivate_count += 2;
      next.re = RandomPrivate_randlc(RandomStreamPrivate_cursor);
      next.im = RandomPrivate_randlc(RandomStreamPrivate_cursor);
    } else {
      RandomStreamPrivate_count += 1;
      next = RandomPrivate_randlc(RandomStreamPrivate_cursor): eltType;
    }
    return next;
  }

  pragma "no doc"
  proc RandomStreamPrivate_skipToNth_noLock(in n: integral) {
    if eltType == complex then n *= 2;
    RandomStreamPrivate_count = n;
    RandomStreamPrivate_cursor = RandomPrivate_randlc_skipto(seed, n);
  }

  /*
    Returns the next value in the random stream.`

    :returns: The next value in the random stream as type :type:`eltType`.
   */
  proc getNext(): eltType {
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    const result = RandomStreamPrivate_getNext_noLock();
    if parSafe then
      RandomStreamPrivate_lock$;
    return result;
  }

  /*
    Advances/rewinds the stream to the `n`-th value in the sequence.

    :arg n: The position in the stream to skip to.  Must be non-negative.
    :type n: integral
   */

  proc skipToNth(n: integral) {
    if n <= 0 then
      halt("RandomStream.skipToNth(n) called with non-positive 'n' value", n);
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    RandomStreamPrivate_skipToNth_noLock(n);
    if parSafe then
      RandomStreamPrivate_lock$;
  }

  /*
    Advance/rewind the stream to the `n`-th value and return it
    (advancing the strem by one).  This is equivalent to
    :proc:`skipToNth()` followed by :proc:`getNext()`.

    :arg n: The position in the stream to skip to.  Must be non-negative.
    :type n: integral

    :returns: The `n`-th value in the random stream as type :type:`eltType`.
  */

  proc getNth(n: integral): eltType {
    if (n <= 0) then
      halt("RandomStream.getNth(n) called with non-positive 'n' value", n);
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    RandomStreamPrivate_skipToNth_noLock(n);
    const result = RandomStreamPrivate_getNext_noLock();
    if parSafe then
      RandomStreamPrivate_lock$;
    return result;
  }

  /*
    Fill the argument array with pseudorandom values.  This method is
    identical to the standalone :proc:`fillRandom` procedure,
    except that it consumes random values from the
    :class:`RandomStream` object on which it's invoked rather
    than creating a new stream for the purpose of the call.

    :arg arr: The array to be filled
    :type arr: [] :type:`eltType`
  */
  proc fillRandom(arr: [] eltType) {
    forall (x, r) in zip(arr, iterate(arr.domain, arr.eltType)) do
      x = r;
  }

  pragma "no doc"
  proc fillRandom(arr: []) {
    compilerError("RandomStream(eltType=", typeToString(eltType), ") can only be used to fill arrays of ", typeToString(eltType));
  }

  pragma "no doc"
  proc iterate(D: domain, type resultType=real) {
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    const start = RandomStreamPrivate_count;
    RandomStreamPrivate_count += D.numIndices.safeCast(int(64));
    RandomStreamPrivate_skipToNth_noLock(RandomStreamPrivate_count);
    if parSafe then
      RandomStreamPrivate_lock$;
    return RandomPrivate_iterate(resultType, D, seed, start);
  }

  pragma "no doc"
  proc writeThis(f: Writer) {
    f <~> "RandomStream(parSafe=";
    f <~> parSafe;
    f <~> ", seed = ";
    f <~> seed;
    f <~> ")";
  }

  ///////////////////////////////////////////////////////////// CLASS PRIVATE //
  //
  // It is the intent that once Chapel supports the notion of
  // 'private', everything in this class declared below this line will
  // be made private to this class.
  //

  pragma "no doc"
  var RandomStreamPrivate_lock$: sync bool;
  pragma "no doc"
  var RandomStreamPrivate_cursor: real;
  pragma "no doc"
  var RandomStreamPrivate_count: int(64);

  pragma "no doc"
  proc RandomStreamPrivate_init(seed: int(64)) {
    this.seed = seed;
    RandomStreamPrivate_cursor = seed;
    RandomStreamPrivate_count = 1;
  }
}

////////////////////////////////////////////////////////////// MODULE PRIVATE //
//
// It is the intent that once Chapel supports the notion of 'private',
// everything declared below this line will be made private to this
// module.
//

//
// NPB-defined constants for linear congruential generator
//
pragma "no doc"
const RandomPrivate_r23   = 0.5**23,
      RandomPrivate_t23   = 2.0**23,
      RandomPrivate_r46   = 0.5**46,
      RandomPrivate_t46   = 2.0**46,
      RandomPrivate_arand = 1220703125.0; // TODO: Is arand something that a
                                          // user might want to set on a
                                          // case-by-case basis?

//
// NPB-defined randlc routine
//
pragma "no doc"
proc RandomPrivate_randlc(inout x: real, a: real = RandomPrivate_arand) {
  var t1 = RandomPrivate_r23 * a;
  const a1 = floor(t1),
    a2 = a - RandomPrivate_t23 * a1;
  t1 = RandomPrivate_r23 * x;
  const x1 = floor(t1),
    x2 = x - RandomPrivate_t23 * x1;
  t1 = a1 * x2 + a2 * x1;
  const t2 = floor(RandomPrivate_r23 * t1),
    z  = t1 - RandomPrivate_t23 * t2,
    t3 = RandomPrivate_t23 * z + a2 * x2,
    t4 = floor(RandomPrivate_r46 * t3),
    x3 = t3 - RandomPrivate_t46 * t4;
  x = x3;
  return RandomPrivate_r46 * x3;
}

// Wrapper that takes a result type (two calls for complex types)
pragma "no doc"
proc RandomPrivate_randlc(type resultType, inout x: real) {
  if resultType == complex then
    return (RandomPrivate_randlc(x), RandomPrivate_randlc(x)):complex;
  else
    return RandomPrivate_randlc(x):resultType;
}

//
// Return a value for the cursor so that the next call to randlc will
// return the same value as the nth call to randlc
//
pragma "no doc"
proc RandomPrivate_randlc_skipto(seed: int(64), in n: integral): real {
  var cursor = seed:real;
  n -= 1;
  var t = RandomPrivate_arand;
  RandomPrivate_arand;
  while (n != 0) {
    const i = n / 2;
    if (2 * i != n) then
      RandomPrivate_randlc(cursor, t);
    if i == 0 then
      break;
    else
      n = i;
    RandomPrivate_randlc(t, t);
    n = i;
  }
  return cursor;
}

//
// iterate over outer ranges in tuple of ranges
//
pragma "no doc"
iter RandomPrivate_outer(ranges, param dim: int = 1) {
  if dim + 1 == ranges.size {
    for i in ranges(dim) do
      yield (i,);
  } else if dim + 1 < ranges.size {
    for i in ranges(dim) do
      for j in RandomPrivate_outer(ranges, dim+1) do
        yield (i, (...j));
  } else {
    yield 0; // 1D case is a noop
  }
}

//
// RandomStream iterator implementation
//
pragma "no doc"
iter RandomPrivate_iterate(type resultType, D: domain, seed: int(64),
                          start: int(64)) {
  var cursor = RandomPrivate_randlc_skipto(seed, start);
  for i in D do
    yield RandomPrivate_randlc(resultType, cursor);
}

pragma "no doc"
iter RandomPrivate_iterate(type resultType, D: domain, seed: int(64),
                          start: int(64), param tag: iterKind)
      where tag == iterKind.leader {
  for block in D._value.these(tag=iterKind.leader) do
    yield block;
}

pragma "no doc"
iter RandomPrivate_iterate(type resultType, D: domain, seed: int(64),
                          start: int(64), param tag: iterKind, followThis)
      where tag == iterKind.follower {
  param multiplier = if resultType == complex then 2 else 1;
  const ZD = computeZeroBasedDomain(D);
  const innerRange = followThis(ZD.rank);
  var cursor: real;
  for outer in RandomPrivate_outer(followThis) {
    var myStart = start;
    if ZD.rank > 1 then
      myStart += multiplier * ZD.indexOrder(((...outer), innerRange.low)).safeCast(int(64));
    else
      myStart += multiplier * ZD.indexOrder(innerRange.low):int(64);
    if !innerRange.stridable {
      cursor = RandomPrivate_randlc_skipto(seed, myStart);
      for i in innerRange do
        yield RandomPrivate_randlc(resultType, cursor);
    } else {
      myStart -= innerRange.low.safeCast(int(64));
      for i in innerRange {
        cursor = RandomPrivate_randlc_skipto(seed, myStart + i:int(64) * multiplier);
        yield RandomPrivate_randlc(resultType, cursor);
      }
    }
  }
}

} // close module Random

/*
 * Copyright 2004-2015 Cray Inc.
 * Other additional copyright holders may be indicated within.
 *
 * The entirety of this work is licensed under the Apache License,
 * Version 2.0 (the "License"); you may not use this file except
 * in compliance with the License.
 *
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

/*
   Support for pseudorandom number generation

   This module defines an abstraction for a stream of pseudorandom
   numbers, :class:`RandomStream`.  It also provides a
   convenience function, :proc:`fillRandom` that can be used to
   fill an array with random numbers in parallel.

   The current pseudorandom number generator (PRNG) implemented by
   this module uses the algorithm from the NAS Parallel Benchmarks
   (NPB, available at: http://www.nas.nasa.gov/publications/npb.html).
   The longer-term intention is to add knobs to select between a menu
   of PRNG algorithms, such as the Mersenne twister.

   Paraphrasing the comments from the NPB reference implementation:

     This generator returns uniform pseudorandom real values in the
     range (0, 1) by using the linear congruential generator

       x_{k+1} = a x_k  (mod 2**46)

     where 0 < x_k < 2**46 and 0 < a < 2**46.  This scheme generates
     2**44 numbers before repeating.  The generated values are
     normalized to be between 0 and 1, i.e., 2**(-46) * x_k.

     This generator should produce the same results on any computer
     with at least 48 mantissa bits for `real(64)` data.

   Here is a list of currently open issues (TODOs) for this module:

   1. This module is currently restricted to generating `real(64)`,
   `imag(64)`, and `complex(128)` complex values.  We would like to
   extend this support to include other primitive types as well.

   2. We plan to support general serial and parallel iterators on the
   RandomStream class; however, providing the full suite of iterators
   is not possible with our current parallel iterator framework.
   Specifically, if :class:`RandomStream` is a follower in a
   zippered iteration context, there is no way for it to update the
   total number of random numbers generated in a safe/sane/coordinated
   way.  We are exploring a revised leader-follower iterator framework
   that would support this idiom (and other cursor-based ones).

   3. If no seed is provided by the user, one is chosen based on the
   current time in microseconds, allowing for some degree of
   pseudorandomness in seed selection.  The intent of
   :record:`SeedGenerators` is to provide a menu of other options
   for initializing the random stream seed, but only one option is
   implemented at present.

   4. As noted above, we plan to add support for additional PRNG
   algorithms over time.

*/
module Random {

  /*
     Note for developers on "private" symbols:

     It is the intent that once Chapel supports a notion of 'private'
     symbols, everything prefixed with RandomPrivate will be made
     private to this module and everything prefixed with
     'RandomStreamPrivate_' will be made private to the RandomStream
     class.
  */

  /* Internal TODOs for developers:

     - should RandomStream be parameterized by the type to return?
       it seems odd that currently getNext() and getNth() return
       reals always...
  */

/*
   An instance of :record:`SeedGenerators` that provides a
   convenient means of generating seeds when the user does not wish to
   specify one manually.
*/
const SeedGenerator: SeedGenerators;

// CHPLDOC FIXME: Respect ordering of things in the file

/*
  Provides methods to help generate seeds when the user doesn't want
  to create one.  It currently only supports one such method, but the
  intention is to add more over time.

  (Note: once Chapel supports static class methods,
  :const:`SeedGenerator` and :record:`SeedGenerators` should
  be combined into a single record type with static methods).
*/

record SeedGenerators {
  /*
    Generate a seed based on the current time in microseconds as
    reported by :proc:`Time.getCurrentTime`, ensuring that it
    meets the PRNG's requirements.
  */
  proc currentTime: int(64) {
    use Time;
    const seed: int(64) = getCurrentTime(unit=TimeUnits.microseconds):int(64);
    return (if seed % 2 == 0 then seed + 1 else seed) % (1:int(64) << 46);
  }
};

// CHPLDOC FEEDBACK: If easy, I'd suggest either deprecating the
// :arg <type> <name>: form or else switching the order to
// :arg <name> <type>: as it's an easy trap to simply type the same
// argument as in the function's signature.

// CHPLDOC FIXME: if the first line below is shifted one character to the
// left, it ends up being rendered like a method

// CHPLDOC FIXME: if the first line below is shifted one character to the
// right, it ends up causing a warning (promoted to error) in the .rst
// file.  It'd be preferable to have it declare the issue in terms of
// the .chpl line numbers.
//

/*
  Fill an array of `real(64)`, `imag(64)`, or `complex(128)` elements
  with pseudorandom values in parallel using a new
  :class:`RandomStream` created specifically for this call.  The
  first `arr.size` values from the stream will be assigned to the
  array's elements in row-major order for `real` and `imag` elements.
  For `complex` elements, consecutive pairs of random numbers are
  assigned to the real and imaginary components, respectively.  The
  parallelization strategy is determined by the array.

  :arg arr: The array to be filled, where T is real(64), imag(64), or complex(128).
  :type arr: [] T

  :arg seed: The seed to use for the PRNG.  Defaults to :proc:`SeedGenerator.currentTime <SeedGenerators.currentTime>`.
  :type seed: int(64)
*/

proc fillRandom(arr: [], seed: int(64) = SeedGenerator.currentTime)
  where (arr.eltType == real || arr.eltType == imag || arr.eltType == complex) {
  var randNums = new RandomStream(seed, parSafe=false);
  randNums.fillRandom(arr);
  delete randNums;
}

pragma "no doc"
proc fillRandom(arr: [], seed: int(64) = SeedGenerator.currentTime) {
  compilerError("Random.fillRandom is only defined for real(64), imag(64), and complex(128) arrays");
}

/*
  Models a stream of pseudorandom numbers.  See the module-level
  notes for :mod:`Random` for details on the PRNG used.
*/
class RandomStream {
  /*
    Indicates whether or not the RandomStream needs to be
    parallel-safe by default.  If multiple tasks interact with it in
    an uncoordinated fashion, this must be set to `true`.  If it will
    only be called from a single task, or if only one task will call
    into it at a time, setting to `false` will reduce overhead related
    to ensuring mutual exclusion.
  */
  param parSafe: bool = true;
  /*
    The seed value for the PRNG.  It must be an odd integer in the
    range (1, 2**46).
  */
  const seed: int(64);

  /*
    Constructs a new stream of random numbers using the specified seed
    and parallel safety.  Ensures that the seed value meets the PRNG's
    constraints.

    :arg seed: The seed to use for the PRNG.  Defaults to :proc:`SeedGenerator.currentTime <SeedGenerators.currentTime>`..
    :type seed: int(64)

    :arg parSafe: The parallel safety setting.  Defaults to `true`.
    :type parSafe: bool
  */
  proc RandomStream(seed: int(64) = SeedGenerator.currentTime,
                   param parSafe: bool = true) {
    if seed % 2 == 0 || seed < 1 || seed > 1:int(64)<<46 then
      halt("RandomStream seed must be an odd integer between 0 and 2**46");
    RandomStreamPrivate_init(seed);
  }

  pragma "no doc"
  proc RandomStreamPrivate_getNext_noLock() {
    RandomStreamPrivate_count += 1;
    return RandomPrivate_randlc(RandomStreamPrivate_cursor);
  }

  /*
    Returns the next value in the random stream as a `real(64)`

    :returns: The next value in the random stream as a `real(64)`.
   */
  proc getNext(): real(64) {
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    const result = RandomStreamPrivate_getNext_noLock();
    if parSafe then
      RandomStreamPrivate_lock$;
    return result;
  }

  pragma "no doc"
  proc RandomStreamPrivate_skipToNth_noLock(n: integral) {
    RandomStreamPrivate_count = n;
    RandomStreamPrivate_cursor = RandomPrivate_randlc_skipto(seed, n);
  }

  /*
    Advances/rewinds the stream to the `n`-th value in the sequence.

    :arg n: The position in the stream to skip to.  Must be non-negative.
    :type n: integral
   */

  proc skipToNth(n: integral) {
    if n <= 0 then
      halt("RandomStream.skipToNth(n) called with non-positive 'n' value", n);
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    RandomStreamPrivate_skipToNth_noLock(n);
    if parSafe then
      RandomStreamPrivate_lock$;
  }

  /*
    Advance/rewind the stream to the `n`-th value and return it
    (advancing the strem by one).  This is equivalent to
    :proc:`skipToNth()` followed by :proc:`getNext()`.

    :arg n: The position in the stream to skip to.  Must be non-negative.
    :type n: integral

    :returns: The `n`-th value in the random stream as a `real(64)`.
  */

  proc getNth(n: integral): real(64) {
    if (n <= 0) then
      halt("RandomStream.getNth(n) called with non-positive 'n' value", n);
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    RandomStreamPrivate_skipToNth_noLock(n);
    const result = RandomStreamPrivate_getNext_noLock();
    if parSafe then
      RandomStreamPrivate_lock$;
    return result;
  }

  /*
    Fill the argument array with pseudorandom values.  This method is
    identical to the standalone :proc:`fillRandom` procedure,
    except that it consumes random values from the
    :class:`RandomStream` object on which it's invoked rather
    than creating a new stream for the purpose of the call.

    :arg arr: The array to be filled, where T is real(64), imag(64), or complex(128).
    :type arr: [] T
  */

  proc fillRandom(arr: []) {
    if arr.eltType != complex && arr.eltType != real && arr.eltType != imag then
      compilerError("RandomStream.fillRandom is only defined for real(64), imag(64), and complex(128) arrays");
    forall (x, r) in zip(arr, iterate(arr.domain, arr.eltType)) do
      x = r;
  }

  pragma "no doc"
  proc iterate(D: domain, type resultType=real) {
    if resultType != complex && resultType != real && resultType != imag then
      compilerError("RandomStream.iterate is only defined for real(64), imag(64), and complex(128) result types");
    param cplxMultiplier = if resultType == complex then 2 else 1;
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    const start = RandomStreamPrivate_count;
    // NOTE: Not bothering to check to see if D.numIndices can fit into int(64)
    RandomStreamPrivate_count += cplxMultiplier * D.numIndices:int(64);
    RandomStreamPrivate_skipToNth_noLock(RandomStreamPrivate_count);
    if parSafe then
      RandomStreamPrivate_lock$;
    return RandomPrivate_iterate(resultType, D, seed, start);
  }

  pragma "no doc"
  proc writeThis(f: Writer) {
    f <~> "RandomStream(parSafe=";
    f <~> parSafe;
    f <~> ", seed = ";
    f <~> seed;
    f <~> ")";
  }

  ///////////////////////////////////////////////////////////// CLASS PRIVATE //
  //
  // It is the intent that once Chapel supports the notion of
  // 'private', everything in this class declared below this line will
  // be made private to this class.
  //

  pragma "no doc"
  var RandomStreamPrivate_lock$: sync bool;
  pragma "no doc"
  var RandomStreamPrivate_cursor: real;
  pragma "no doc"
  var RandomStreamPrivate_count: int(64);

  pragma "no doc"
  proc RandomStreamPrivate_init(seed: int(64)) {
    this.seed = seed;
    RandomStreamPrivate_cursor = seed;
    RandomStreamPrivate_count = 1;
  }
}

////////////////////////////////////////////////////////////// MODULE PRIVATE //
//
// It is the intent that once Chapel supports the notion of 'private',
// everything declared below this line will be made private to this
// module.
//

//
// NPB-defined constants for linear congruential generator
//
pragma "no doc"
const RandomPrivate_r23   = 0.5**23,
      RandomPrivate_t23   = 2.0**23,
      RandomPrivate_r46   = 0.5**46,
      RandomPrivate_t46   = 2.0**46,
      RandomPrivate_arand = 1220703125.0; // TODO: Is arand something that a
                                          // user might want to set on a
                                          // case-by-case basis?

//
// NPB-defined randlc routine
//
pragma "no doc"
proc RandomPrivate_randlc(inout x: real, a: real = RandomPrivate_arand) {
  var t1 = RandomPrivate_r23 * a;
  const a1 = floor(t1),
    a2 = a - RandomPrivate_t23 * a1;
  t1 = RandomPrivate_r23 * x;
  const x1 = floor(t1),
    x2 = x - RandomPrivate_t23 * x1;
  t1 = a1 * x2 + a2 * x1;
  const t2 = floor(RandomPrivate_r23 * t1),
    z  = t1 - RandomPrivate_t23 * t2,
    t3 = RandomPrivate_t23 * z + a2 * x2,
    t4 = floor(RandomPrivate_r46 * t3),
    x3 = t3 - RandomPrivate_t46 * t4;
  x = x3;
  return RandomPrivate_r46 * x3;
}

// Wrapper that takes a result type (two calls for complex types)
pragma "no doc"
proc RandomPrivate_randlc(type resultType, inout x: real) {
  if resultType == complex then
    return (RandomPrivate_randlc(x), RandomPrivate_randlc(x)):complex;
  else
    return RandomPrivate_randlc(x):resultType;
}

//
// Return a value for the cursor so that the next call to randlc will
// return the same value as the nth call to randlc
//
pragma "no doc"
proc RandomPrivate_randlc_skipto(seed: int(64), in n: integral): real {
  var cursor = seed:real;
  n -= 1;
  var t = RandomPrivate_arand;
  RandomPrivate_arand;
  while (n != 0) {
    const i = n / 2;
    if (2 * i != n) then
      RandomPrivate_randlc(cursor, t);
    if i == 0 then
      break;
    else
      n = i;
    RandomPrivate_randlc(t, t);
    n = i;
  }
  return cursor;
}

//
// iterate over outer ranges in tuple of ranges
//
pragma "no doc"
iter RandomPrivate_outer(ranges, param dim: int = 1) {
  if dim + 1 == ranges.size {
    for i in ranges(dim) do
      yield (i,);
  } else if dim + 1 < ranges.size {
    for i in ranges(dim) do
      for j in RandomPrivate_outer(ranges, dim+1) do
        yield (i, (...j));
  } else {
    yield 0; // 1D case is a noop
  }
}

//
// RandomStream iterator implementation
//
pragma "no doc"
iter RandomPrivate_iterate(type resultType, D: domain, seed: int(64),
                          start: int(64)) {
  var cursor = RandomPrivate_randlc_skipto(seed, start);
  for i in D do
    yield RandomPrivate_randlc(resultType, cursor);
}

pragma "no doc"
iter RandomPrivate_iterate(type resultType, D: domain, seed: int(64),
                          start: int(64), param tag: iterKind)
      where tag == iterKind.leader {
  for block in D._value.these(tag=iterKind.leader) do
    yield block;
}

pragma "no doc"
iter RandomPrivate_iterate(type resultType, D: domain, seed: int(64),
                          start: int(64), param tag: iterKind, followThis)
      where tag == iterKind.follower {
  param multiplier = if resultType == complex then 2 else 1;
  const ZD = computeZeroBasedDomain(D);
  const innerRange = followThis(ZD.rank);
  var cursor: real;
  for outer in RandomPrivate_outer(followThis) {
    var myStart = start;
    // NOTE: Not bothering to check to see if this can fit into int(64)
    if ZD.rank > 1 then
      myStart += multiplier * ZD.indexOrder(((...outer), innerRange.low)):int(64);
    else
      myStart += multiplier * ZD.indexOrder(innerRange.low):int(64);
    if !innerRange.stridable {
      cursor = RandomPrivate_randlc_skipto(seed, myStart);
      for i in innerRange do
        yield RandomPrivate_randlc(resultType, cursor);
    } else {
      // NOTE: Not bothering to check to see if this can fit into int(64)
      myStart -= innerRange.low:int(64);
      for i in innerRange {
        cursor = RandomPrivate_randlc_skipto(seed, myStart + i:int(64) * multiplier);
        yield RandomPrivate_randlc(resultType, cursor);
      }
    }
  }
}

} // close module Random


Minor change to ChapelRange to avoid unused label warning with Intel compiler

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

// ChapelRange.chpl
//

use ChapelRangeBase;

//
// range type
//
//   parameterized by:
//        1) an integral element type,
//        2) whether low and/or high bounds exist, and
//        3) whether the stride is one or not.
//
// A range can only be aligned if it is strided.  Since alignments are taken
// modulo the stride, if the stride is one, even a nonzero alignment has no effect.
// The alignment of a range is relative to the low bound if it exists, otherwise
// relative to the high bound if it exists, otherwise absolute.
//
// The type of the stride is a signed type with the same number of bits as the
// index type.  This means that for an unsigned index type, a maximal range can
// be reached in no less than two strides.
//
// Ranges are usually naturally aligned; the _unaligned flag indicates when the
// alignment has been set explicitly -- thus making it "unaligned" w.r.t. its
// natural alignment.
//
// Some ranges have ambiguous alignment -- by definition:
//  Those which lack an upper bound and have a stride less than -1; or
//  Those which lack a lower bound and have a stride greater than 1.
// Ambiguous alignment is propagated by some operations, such as striding and slicing.
// Ambiguous alignment is erased if the alignment is set explicitly.
//
// The _aligned flag is used to track whether a range has been explicitly aligned.
// Initially, all ranges are unaligned, but since they have a stride of 1
// their alignment is not ambiguous.
// When a stride is applied, we check to see if any of the above cases is created.
// If not, the _aligned flag is set indicating that the alignment for that range
// has been determined.  Further applications of the "by" operator preserve that bit.
// The _aligned bit can also be set through the application of an explicit alignment.
//

pragma "range"
record range
{
  type idxType = int;                            // element type
  param boundedType: BoundedRangeType = BoundedRangeType.bounded; // bounded or not
  param stridable: bool = false;                 // range can be strided

  var _base : rangeBase(idxType, boundedType, stridable);
  var _aligned : bool = false;

  // TODO: hilde 2011/03/31
  // This should be a pragma and not a var declaration.
  var _promotionType: idxType;                   // enables promotion

  pragma "inline" proc low return _base.low;       // public getter for low bound
  pragma "inline" proc high return _base.high;     // public getter for high bound
  pragma "inline" proc stride return _base.stride; // public getter for stride
  // public getter for alignment
  pragma "inline" proc alignment return _base.alignment;
  // public getter for the ambiguous alignment flag.
  pragma "inline" proc aligned return _aligned;

  // Returns the starting index in the sequence.
  pragma "inline" proc first return _base.first;
  // Returns the ending index.
  pragma "inline" proc last return _base.last;
  // Returns the low index, properly aligned.
  pragma "inline" proc alignedLow : idxType return _base.alignedLow;
  // Returns the high index, properly aligned.
  pragma "inline" proc alignedHigh : idxType return _base.alignedHigh;
  // Returns the number of elements in this range.
  pragma "inline" proc length return _base.length;
}

//################################################################################
//# Constructors
//#

// Declare this as constructor, so we can capture range creation.
// If it is not a constructor, then the user can still create a maximal range
// (for example) without being warned.
//
proc range.range(type idxType = int,
                 param boundedType : BoundedRangeType = BoundedRangeType.bounded,
                 param stridable : bool = false,
                 _low : idxType = 1,
                 _high : idxType = 0,
                 _stride : chpl__signedType(idxType) = 1,
                 _alignment : idxType = 0,
                 _aligned : bool = false)
{
  _base = new rangeBase(idxType, boundedType, stridable, _low, _high, _stride, _alignment);
  this._aligned = _aligned;
}

proc range.range(type idxType = int,
                 param boundedType = BoundedRangeType.bounded,
                 param stridable : bool = false,
                 _base : rangeBase(idxType, boundedType, stridable),
                 _aligned : bool = false)
{
  this._base = _base;
  this._aligned = _aligned;
}

//////////////////////////////////////////////////////////////////////////////////
// Range builders for bounded ranges
// Range builders are used by the parser to create literal ranges.
//
proc _build_range(low: int, high: int)
  return new range(idxType = int, _low = low, _high = high);
proc _build_range(low: uint, high: uint)
  return new range(uint, _low = low, _high = high);
proc _build_range(low: int(64), high: int(64))
  return new range(int(64), _low = low, _high = high);
proc _build_range(low: uint(64), high: uint(64))
  return new range(uint(64), _low = low, _high = high);

//////////////////////////////////////////////////////////////////////////////////
// Range builders for unbounded ranges
//
proc _build_range(param bt: BoundedRangeType, bound: int)
  return new range(int, bt, false, bound, bound);
proc _build_range(param bt: BoundedRangeType, bound: uint)
  return new range(uint, bt, false, bound, bound);
proc _build_range(param bt: BoundedRangeType, bound: int(64))
  return new range(int(64), bt, false, bound, bound);
proc _build_range(param bt: BoundedRangeType, bound: uint(64))
  return new range(uint(64), bt, false, bound, bound);
proc _build_range(param bt: BoundedRangeType)
  return new range(int, bt);

//################################################################################
//# Predicates
//#

// Returns true if this range has a low bound.
proc range.hasLowBound() param
  return boundedType == BoundedRangeType.bounded ||
         boundedType == BoundedRangeType.boundedLow;

// Returns true if this range has a high bound.
proc range.hasHighBound() param
  return boundedType == BoundedRangeType.bounded ||
         boundedType == BoundedRangeType.boundedHigh;

pragma "inline"
proc range.hasFirst()
  return if isAmbiguous() then false else _base.hasFirst();

pragma "inline"
proc range.hasLast()
  return if isAmbiguous() then false else _base.hasLast();

// Returns true if this range is naturally aligned, false otherwise.
// Note that this does not indicate if the range is ambiguously aligned.
pragma "inline"
proc range.isAligned()
  return _base.isAligned();

// Returns true if the alignment of this range is ambiguous.
// After a stride whose absolute value is 2 or greater is applied,
// the alignment must be positively established as evidenced by the _aligned
// flag being set to "true".
pragma "inline"
proc range.isAmbiguous()
{
  // If the range is not strided, then its alignment is unambiguously zero.
  if !stridable then return false;
  else return abs(stride) >= 2 && !aligned;
}

// Returns true if i is in this range.
pragma "inline" proc range.member(i: idxType)
{
  if this.isAmbiguous() then return false;
  return _base.member(i);
}

// Returns true if the other range is contained within this one.
pragma "inline" proc range.member(other: range(?))
{
  if this.isAmbiguous() || other.isAmbiguous() then return false;
  return _base.member(other);
}

// Returns true if this range is equivalent to the other.
// Equivalent ranges produce the same index set.
//
// This routine relies on the assumption that
// the stride of an unstrided range is set to 1.
proc ==(r1: range(?), r2: range(?))
{
  // Ambiguous ranges cannot be equal even if all their parameters match.
  if r1.isAmbiguous() || r2.isAmbiguous() then
    return false;
  else
    return r1._base == r2._base;
}

// This makes use of the fact that the default values for the
// stride and alignment fields are consistent, whether the two ranges
// being compared are stridable or not.
proc ident(r1: range(?), r2: range(?))
  where r1.idxType == r2.idxType &&
  r1.boundedType == r2.boundedType &&
  r1.stridable == r2.stridable
{
  if r1._aligned != r2._aligned then return false;
  return ident(r1._base, r2._base);
}

// If the parameters don't match, then the two ranges cannot be identical.
proc ident(r1: range(?), r2: range(?))
  return false;

//////////////////////////////////////////////////////////////////////////////////
// Bounds checking
//
// returns true if other is in bounds of this for all specified
// bounds; these functions are used to determine if an array slice is
// valid.  We break out the boundedNone case in order to permit
// unbounded ranges to slice ranges of various index types -- otherwise
// we get a compiler error in the boundsCheck function.
//

pragma "inline"
proc range.boundsCheck(other: range(?e,?b,?s))
  where b == BoundedRangeType.boundedNone
{
  if this.isAmbiguous() || other.isAmbiguous()
    then return false;

  return true;
}

pragma "inline"
proc range.boundsCheck(other: range(?e,?b,?s))
{
  if this.isAmbiguous() || other.isAmbiguous()
    then return false;

  return _base.boundsCheck(other._base);
}

pragma "inline"
proc range.boundsCheck(other: idxType)
  return member(other);

//################################################################################
//# Member functions
//#

// Moves the low bound of the range up to the next alignment point.
proc range.alignLow()
{
  if this.isAmbiguous() then
    __primitive("chpl_error", "alignLow -- Canot be applied to a range with ambiguous alignment.");

  _base.alignLow();
  return this;
}

// Moves the high bound of the range down to the next alignment point.
proc range.alignHigh()
{
  if this.isAmbiguous() then
    __primitive("chpl_error", "alignHigh -- Canot be applied to a range with ambiguous alignment.");

  _base.alignHigh();
  return this;
}

// Returns the ordinal of this index within the sequence described by this range.
proc range.indexOrder(i: idxType)
{
  if this.isAmbiguous() then
    __primitive("chpl_error", "indexOrder -- Undefined on a range with ambiguous alignment.");

  return _base.indexOrder(i);
}

//////////////////////////////////////////////////////////////////////////////////
// translate the indices in this range by i
// A range can be translated even if its alignment is ambiguous.
//
pragma "inline"
proc range.translate(i: integral)
  return new range(idxType, boundedType, stridable,
                   _base.translate(i), _aligned);

pragma "inline"
proc range.translate(i)
{
  compilerError("offsets must be of integral type");
}

// Return an interior portion of this range.
pragma "inline"
proc range.interior(i: idxType)
  return new range(idxType, boundedType, stridable,
                    _base.interior(i), _aligned);

// Return an exterior portion of this range.
pragma "inline"
proc range.exterior(i: idxType)
  return new range(idxType, boundedType, stridable,
                   _base.exterior(i), _aligned);

// Returns an expanded range, or a contracted range if i < 0.
// The existing absolute alignment is preserved.
pragma "inline"
proc range.expand(i: idxType)
  return new range(idxType, boundedType, stridable,
                   _base.expand(i), _aligned);

//################################################################################
//# Syntax Functions
//# These are special functions known to the compiler parser.
//#

// Assignment
pragma "inline"
proc =(r1: range(stridable=?s1), r2: range(stridable=?s2))
{
  r1._base = r2._base;
  r1._aligned = r2._aligned;
  return r1;
}

//////////////////////////////////////////////////////////////////////////////////
// Range arithmetic.
//
// Shifts and entire range to the right or left.
// Absolute alignment is not preserved
// (That is, the alignment shifts along with the range.)
//
pragma "inline"
proc +(r: range(?e, ?b, ?s), i: integral)
{
  var temp = r._base + i;
  return new range(temp.idxType, b, s, temp, r._aligned);
}

pragma "inline"
proc +(i:integral, r: range(?e,?b,?s))
  return r + i;

pragma "inline"
proc -(r: range(?e,?b,?s), i: integral)
{
  var temp = r._base - i;
  return new range(temp.idxType, b, s, temp, r._aligned);
}

// This is the syntax processing routine for the "by" keyword.
// The by operator always clobbers an existing alignment.
proc by(r : range(?), str)
{
  var temp = chpl__by(r._base, str);
  var result = new range(temp.idxType, temp.boundedType, temp.stridable);
  result._base = temp;
  result._aligned = r._aligned || chpl__hasAlignment(result);
  return result;
}

// This is the syntax processing routine for the "align" keyword.
// It produces a new range with the specified alignment.
// By definition, alignment is relative to the low bound of the range.
pragma "inline"
proc align(r : range(?e, ?b, ?s), algn)
  return new range(e, b, s, chpl__align(r._base, algn), true);

// Apply a natural alignment to an existing range.
proc range.offset(offs : integral)
{
  _base.offset(offs);
  this._aligned = true;
  return this;
}

// Composition
// Return the intersection of this and other.
proc range.this(other: range(?))
{
  // Two cases to consider:
  //  1) Both ranges unambiguously aligned
  //  2) One or both ranges ambiguously aligned.
  // In the latter case, we can obtain a result modulo alignment
  // as long as the two strides are relatively prime.
  // Otherwise, we can't know whether the two ranges intersect or not.
  var ambig = false;
  if this.isAmbiguous() || other.isAmbiguous()
  {
    var st1 = abs(this.stride);
    var st2 = abs(other.stride);
    var (g,x) = chpl__extendedEuclid(st1, st2);
    if g > 1 then
      __primitive("chpl_error", "Cannot slice ranges with ambiguous alignments unless their strides are relatively prime.");

    // OK, we can combine these two ranges, but the result is marked as ambiguous.
    ambig = true;
  }

  var temp = _base.this(other._base);
  var result = new range(temp.idxType, temp.boundedType, temp.stridable);
  result._base = temp;
  result._aligned = !ambig && (this._aligned || other._aligned);
  return result;
}

//////////////////////////////////////////////////////////////////////////////////
// syntax functions for counted ranges
//

// Creates a new range from an existing range, but with the specified number of
// elements.
// The new range has the same stride and alignment as the existing range.
// If the argument n is positive, the new range contains
// the first n elements in the existing range.
// If the argument n is negative, the new range contains
// the last abs(n) elements in the existing range.

proc #(r:range(?), i:integral)
{
  if r.isAmbiguous() then
    __primitive("chpl_error", "count -- Cannot count off elements from a range which is ambiguously aligned.");

  var temp = chpl__count(r._base, i);
  var result = new range(temp.idxType, temp.boundedType, temp.stridable);
  result._base = temp;
  result._aligned = r._aligned;
  return result;
}

//################################################################################
//# Iterators
//#
//#

iter range.these()
{
  // TODO: hilde
  // Does this test nesting affect performance?
  // Inline and remove the test if so.
  if this.isAmbiguous() then
    __primitive("chpl_error", "these -- Attempt to iterate over a range with ambiguous alignment.");
  for i in _base.these() do yield i;
}

iter range.these(param tag: iterator) where tag == iterator.leader
{
  if this.isAmbiguous() then
    __primitive("chpl_error", "these -- Attempt to iterate over a range with ambiguous alignment.");
  for i in _base.these(iterator.leader) do yield i;
}

iter range.these(param tag: iterator, follower) where tag == iterator.follower
{
  if this.isAmbiguous() then
    __primitive("chpl_error", "these -- Attempt to iterate over a range with ambiguous alignment.");
  for i in _base.these(iterator.follower, follower) do yield i;
}

//################################################################################
//# Utilities
//#

// Write implementation for ranges
proc range.writeThis(f: Writer)
{
  _base.writeThis(f);
}

// Return a substring of a string with a range of indices.
proc string.substring(r: range(?))
{
  if r.isAmbiguous() then
    __primitive("chpl_error", "substring -- Cannot select from a string using a range with ambiguous alignment.");

  return this.substring(r._base);
}

//################################################################################
//# Internal helper functions.
//#

pragma "inline"
proc range.chpl__unTranslate(i: idxType)
  return this - i;

pragma "inline"
proc range.chpl__unTranslate(i)
{
  if _isSignedType(i.type) then
    return this - i;
  else
    return this + abs(i);
}

  // Determine if a strided range has a definite alignment.
proc chpl__hasAlignment(r : range(?))
{
  if r.hasLowBound() && r.stride >= 2 then return true;
  if r.hasHighBound() && r.stride <= -2 then return true;
  return false;
}

// ChapelRange.chpl
//

use ChapelRangeBase;

//
// range type
//
//   parameterized by:
//        1) an integral element type,
//        2) whether low and/or high bounds exist, and
//        3) whether the stride is one or not.
//
// A range can only be aligned if it is strided.  Since alignments are taken
// modulo the stride, if the stride is one, even a nonzero alignment has no effect.
// The alignment of a range is relative to the low bound if it exists, otherwise
// relative to the high bound if it exists, otherwise absolute.
//
// The type of the stride is a signed type with the same number of bits as the
// index type.  This means that for an unsigned index type, a maximal range can
// be reached in no less than two strides.
//
// Ranges are usually naturally aligned; the _unaligned flag indicates when the
// alignment has been set explicitly -- thus making it "unaligned" w.r.t. its
// natural alignment.
//
// Some ranges have ambiguous alignment -- by definition:
//  Those which lack an upper bound and have a stride less than -1; or
//  Those which lack a lower bound and have a stride greater than 1.
// Ambiguous alignment is propagated by some operations, such as striding and slicing.
// Ambiguous alignment is erased if the alignment is set explicitly.
//
// The _aligned flag is used to track whether a range has been explicitly aligned.
// Initially, all ranges are unaligned, but since they have a stride of 1
// their alignment is not ambiguous.
// When a stride is applied, we check to see if any of the above cases is created.
// If not, the _aligned flag is set indicating that the alignment for that range
// has been determined.  Further applications of the "by" operator preserve that bit.
// The _aligned bit can also be set through the application of an explicit alignment.
//

pragma "range"
record range
{
  type idxType = int;                            // element type
  param boundedType: BoundedRangeType = BoundedRangeType.bounded; // bounded or not
  param stridable: bool = false;                 // range can be strided

  var _base : rangeBase(idxType, boundedType, stridable);
  var _aligned : bool = false;

  // TODO: hilde 2011/03/31
  // This should be a pragma and not a var declaration.
  var _promotionType: idxType;                   // enables promotion

  pragma "inline" proc low return _base.low;       // public getter for low bound
  pragma "inline" proc high return _base.high;     // public getter for high bound
  pragma "inline" proc stride return _base.stride; // public getter for stride
  // public getter for alignment
  pragma "inline" proc alignment return _base.alignment;
  // public getter for the ambiguous alignment flag.
  pragma "inline" proc aligned return _aligned;

  // Returns the starting index in the sequence.
  pragma "inline" proc first return _base.first;
  // Returns the ending index.
  pragma "inline" proc last return _base.last;
  // Returns the low index, properly aligned.
  pragma "inline" proc alignedLow : idxType return _base.alignedLow;
  // Returns the high index, properly aligned.
  pragma "inline" proc alignedHigh : idxType return _base.alignedHigh;
  // Returns the number of elements in this range.
  pragma "inline" proc length return _base.length;
}

//################################################################################
//# Constructors
//#

// Declare this as constructor, so we can capture range creation.
// If it is not a constructor, then the user can still create a maximal range
// (for example) without being warned.
//
proc range.range(type idxType = int,
                 param boundedType : BoundedRangeType = BoundedRangeType.bounded,
                 param stridable : bool = false,
                 _low : idxType = 1,
                 _high : idxType = 0,
                 _stride : chpl__signedType(idxType) = 1,
                 _alignment : idxType = 0,
                 _aligned : bool = false)
{
  _base = new rangeBase(idxType, boundedType, stridable, _low, _high, _stride, _alignment);
  this._aligned = _aligned;
}

proc range.range(type idxType = int,
                 param boundedType = BoundedRangeType.bounded,
                 param stridable : bool = false,
                 _base : rangeBase(idxType, boundedType, stridable),
                 _aligned : bool = false)
{
  this._base = _base;
  this._aligned = _aligned;
}

//////////////////////////////////////////////////////////////////////////////////
// Range builders for bounded ranges
// Range builders are used by the parser to create literal ranges.
//
proc _build_range(low: int, high: int)
  return new range(idxType = int, _low = low, _high = high);
proc _build_range(low: uint, high: uint)
  return new range(uint, _low = low, _high = high);
proc _build_range(low: int(64), high: int(64))
  return new range(int(64), _low = low, _high = high);
proc _build_range(low: uint(64), high: uint(64))
  return new range(uint(64), _low = low, _high = high);

//////////////////////////////////////////////////////////////////////////////////
// Range builders for unbounded ranges
//
proc _build_range(param bt: BoundedRangeType, bound: int)
  return new range(int, bt, false, bound, bound);
proc _build_range(param bt: BoundedRangeType, bound: uint)
  return new range(uint, bt, false, bound, bound);
proc _build_range(param bt: BoundedRangeType, bound: int(64))
  return new range(int(64), bt, false, bound, bound);
proc _build_range(param bt: BoundedRangeType, bound: uint(64))
  return new range(uint(64), bt, false, bound, bound);
proc _build_range(param bt: BoundedRangeType)
  return new range(int, bt);

//################################################################################
//# Predicates
//#

// Returns true if this range has a low bound.
proc range.hasLowBound() param
  return boundedType == BoundedRangeType.bounded ||
         boundedType == BoundedRangeType.boundedLow;

// Returns true if this range has a high bound.
proc range.hasHighBound() param
  return boundedType == BoundedRangeType.bounded ||
         boundedType == BoundedRangeType.boundedHigh;

pragma "inline"
proc range.hasFirst()
  return if isAmbiguous() then false else _base.hasFirst();

pragma "inline"
proc range.hasLast()
  return if isAmbiguous() then false else _base.hasLast();

// Returns true if this range is naturally aligned, false otherwise.
// Note that this does not indicate if the range is ambiguously aligned.
pragma "inline"
proc range.isAligned()
  return _base.isAligned();

// Returns true if the alignment of this range is ambiguous.
// After a stride whose absolute value is 2 or greater is applied,
// the alignment must be positively established as evidenced by the _aligned
// flag being set to "true".
pragma "inline"
proc range.isAmbiguous()
{
  // If the range is not strided, then its alignment is unambiguously zero.
  if !stridable then return false;
  else return abs(stride) >= 2 && !aligned;
}

// Returns true if i is in this range.
pragma "inline" proc range.member(i: idxType)
{
  if this.isAmbiguous() then return false;
  return _base.member(i);
}

// Returns true if the other range is contained within this one.
pragma "inline" proc range.member(other: range(?))
{
  if this.isAmbiguous() || other.isAmbiguous() then return false;
  return _base.member(other);
}

// Returns true if this range is equivalent to the other.
// Equivalent ranges produce the same index set.
//
// This routine relies on the assumption that
// the stride of an unstrided range is set to 1.
proc ==(r1: range(?), r2: range(?))
{
  // Ambiguous ranges cannot be equal even if all their parameters match.
  if r1.isAmbiguous() || r2.isAmbiguous() then return false;

  return r1._base == r2._base;
}

// This makes use of the fact that the default values for the
// stride and alignment fields are consistent, whether the two ranges
// being compared are stridable or not.
proc ident(r1: range(?), r2: range(?))
  where r1.idxType == r2.idxType &&
  r1.boundedType == r2.boundedType &&
  r1.stridable == r2.stridable
{
  if r1._aligned != r2._aligned then return false;
  return ident(r1._base, r2._base);
}

// If the parameters don't match, then the two ranges cannot be identical.
proc ident(r1: range(?), r2: range(?))
  return false;

//////////////////////////////////////////////////////////////////////////////////
// Bounds checking
//
// returns true if other is in bounds of this for all specified
// bounds; these functions are used to determine if an array slice is
// valid.  We break out the boundedNone case in order to permit
// unbounded ranges to slice ranges of various index types -- otherwise
// we get a compiler error in the boundsCheck function.
//

pragma "inline"
proc range.boundsCheck(other: range(?e,?b,?s))
  where b == BoundedRangeType.boundedNone
{
  if this.isAmbiguous() || other.isAmbiguous()
    then return false;

  return true;
}

pragma "inline"
proc range.boundsCheck(other: range(?e,?b,?s))
{
  if this.isAmbiguous() || other.isAmbiguous()
    then return false;

  return _base.boundsCheck(other._base);
}

pragma "inline"
proc range.boundsCheck(other: idxType)
  return member(other);

//################################################################################
//# Member functions
//#

// Moves the low bound of the range up to the next alignment point.
proc range.alignLow()
{
  if this.isAmbiguous() then
    __primitive("chpl_error", "alignLow -- Canot be applied to a range with ambiguous alignment.");

  _base.alignLow();
  return this;
}

// Moves the high bound of the range down to the next alignment point.
proc range.alignHigh()
{
  if this.isAmbiguous() then
    __primitive("chpl_error", "alignHigh -- Canot be applied to a range with ambiguous alignment.");

  _base.alignHigh();
  return this;
}

// Returns the ordinal of this index within the sequence described by this range.
proc range.indexOrder(i: idxType)
{
  if this.isAmbiguous() then
    __primitive("chpl_error", "indexOrder -- Undefined on a range with ambiguous alignment.");

  return _base.indexOrder(i);
}

//////////////////////////////////////////////////////////////////////////////////
// translate the indices in this range by i
// A range can be translated even if its alignment is ambiguous.
//
pragma "inline"
proc range.translate(i: integral)
  return new range(idxType, boundedType, stridable,
                   _base.translate(i), _aligned);

pragma "inline"
proc range.translate(i)
{
  compilerError("offsets must be of integral type");
}

// Return an interior portion of this range.
pragma "inline"
proc range.interior(i: idxType)
  return new range(idxType, boundedType, stridable,
                    _base.interior(i), _aligned);

// Return an exterior portion of this range.
pragma "inline"
proc range.exterior(i: idxType)
  return new range(idxType, boundedType, stridable,
                   _base.exterior(i), _aligned);

// Returns an expanded range, or a contracted range if i < 0.
// The existing absolute alignment is preserved.
pragma "inline"
proc range.expand(i: idxType)
  return new range(idxType, boundedType, stridable,
                   _base.expand(i), _aligned);

//################################################################################
//# Syntax Functions
//# These are special functions known to the compiler parser.
//#

// Assignment
pragma "inline"
proc =(r1: range(stridable=?s1), r2: range(stridable=?s2))
{
  r1._base = r2._base;
  r1._aligned = r2._aligned;
  return r1;
}

//////////////////////////////////////////////////////////////////////////////////
// Range arithmetic.
//
// Shifts and entire range to the right or left.
// Absolute alignment is not preserved
// (That is, the alignment shifts along with the range.)
//
pragma "inline"
proc +(r: range(?e, ?b, ?s), i: integral)
{
  var temp = r._base + i;
  return new range(temp.idxType, b, s, temp, r._aligned);
}

pragma "inline"
proc +(i:integral, r: range(?e,?b,?s))
  return r + i;

pragma "inline"
proc -(r: range(?e,?b,?s), i: integral)
{
  var temp = r._base - i;
  return new range(temp.idxType, b, s, temp, r._aligned);
}

// This is the syntax processing routine for the "by" keyword.
// The by operator always clobbers an existing alignment.
proc by(r : range(?), str)
{
  var temp = chpl__by(r._base, str);
  var result = new range(temp.idxType, temp.boundedType, temp.stridable);
  result._base = temp;
  result._aligned = r._aligned || chpl__hasAlignment(result);
  return result;
}

// This is the syntax processing routine for the "align" keyword.
// It produces a new range with the specified alignment.
// By definition, alignment is relative to the low bound of the range.
pragma "inline"
proc align(r : range(?e, ?b, ?s), algn)
  return new range(e, b, s, chpl__align(r._base, algn), true);

// Apply a natural alignment to an existing range.
proc range.offset(offs : integral)
{
  _base.offset(offs);
  this._aligned = true;
  return this;
}

// Composition
// Return the intersection of this and other.
proc range.this(other: range(?))
{
  // Two cases to consider:
  //  1) Both ranges unambiguously aligned
  //  2) One or both ranges ambiguously aligned.
  // In the latter case, we can obtain a result modulo alignment
  // as long as the two strides are relatively prime.
  // Otherwise, we can't know whether the two ranges intersect or not.
  var ambig = false;
  if this.isAmbiguous() || other.isAmbiguous()
  {
    var st1 = abs(this.stride);
    var st2 = abs(other.stride);
    var (g,x) = chpl__extendedEuclid(st1, st2);
    if g > 1 then
      __primitive("chpl_error", "Cannot slice ranges with ambiguous alignments unless their strides are relatively prime.");

    // OK, we can combine these two ranges, but the result is marked as ambiguous.
    ambig = true;
  }

  var temp = _base.this(other._base);
  var result = new range(temp.idxType, temp.boundedType, temp.stridable);
  result._base = temp;
  result._aligned = !ambig && (this._aligned || other._aligned);
  return result;
}

//////////////////////////////////////////////////////////////////////////////////
// syntax functions for counted ranges
//

// Creates a new range from an existing range, but with the specified number of
// elements.
// The new range has the same stride and alignment as the existing range.
// If the argument n is positive, the new range contains
// the first n elements in the existing range.
// If the argument n is negative, the new range contains
// the last abs(n) elements in the existing range.

proc #(r:range(?), i:integral)
{
  if r.isAmbiguous() then
    __primitive("chpl_error", "count -- Cannot count off elements from a range which is ambiguously aligned.");

  var temp = chpl__count(r._base, i);
  var result = new range(temp.idxType, temp.boundedType, temp.stridable);
  result._base = temp;
  result._aligned = r._aligned;
  return result;
}

//################################################################################
//# Iterators
//#
//#

iter range.these()
{
  // TODO: hilde
  // Does this test nesting affect performance?
  // Inline and remove the test if so.
  if this.isAmbiguous() then
    __primitive("chpl_error", "these -- Attempt to iterate over a range with ambiguous alignment.");
  for i in _base.these() do yield i;
}

iter range.these(param tag: iterator) where tag == iterator.leader
{
  if this.isAmbiguous() then
    __primitive("chpl_error", "these -- Attempt to iterate over a range with ambiguous alignment.");
  for i in _base.these(iterator.leader) do yield i;
}

iter range.these(param tag: iterator, follower) where tag == iterator.follower
{
  if this.isAmbiguous() then
    __primitive("chpl_error", "these -- Attempt to iterate over a range with ambiguous alignment.");
  for i in _base.these(iterator.follower, follower) do yield i;
}

//################################################################################
//# Utilities
//#

// Write implementation for ranges
proc range.writeThis(f: Writer)
{
  _base.writeThis(f);
}

// Return a substring of a string with a range of indices.
proc string.substring(r: range(?))
{
  if r.isAmbiguous() then
    __primitive("chpl_error", "substring -- Cannot select from a string using a range with ambiguous alignment.");

  return this.substring(r._base);
}

//################################################################################
//# Internal helper functions.
//#

pragma "inline"
proc range.chpl__unTranslate(i: idxType)
  return this - i;

pragma "inline"
proc range.chpl__unTranslate(i)
{
  if _isSignedType(i.type) then
    return this - i;
  else
    return this + abs(i);
}

  // Determine if a strided range has a definite alignment.
proc chpl__hasAlignment(r : range(?))
{
  if r.hasLowBound() && r.stride >= 2 then return true;
  if r.hasHighBound() && r.stride <= -2 then return true;
  return false;
}