More performance- and debuggin-oriented changes in the "performance" version of HPL.

schurComplement: Convert Ab and its replicated copies to DefaultRectangular
  before each dgemm (the triply-nested loop).
  Added a version of localSlice for that.

panelSolve, updateBlockRow: Introduced replication.
  Added replXX and replicate() variants for those.

initAB: Inserted faster initialization, although sometimes it results
  in degenerate matrices.

verify: Creates a local copy of Ab and runs verification on a single
  locale, for speed. If Ab does not fit on a single locale, verification
  will probably be too slow anyway.

Also added debugging and timer hooks and explicit distribution objects.

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

//
// Use standard modules for vector and matrix Norms, Random numbers
// and Timing routines
//
use Norm, Random, Time;
use utils, UtilMath;

//
// Use the user module for computing HPCC problem sizes
//
use HPCCProblemSize;

//
// Use the distributions we need for this computation
//
use DimensionalDist2D, ReplicatedDim, BlockCycDim;
use ReplicatedDist;

//
// The number of matrices and the element type of those matrices
// indexType can be int or int(64), elemType can be real or complex
//
const numMatrices = 1;
type indexType = int,
     elemType = real;

//
// Configuration constants indicating the problem size (n) and the
// block size (blkSize)
//
config const n = 62,
             blkSize = 8;

//
// Configuration constant used for verification thresholds
//
config const epsilon = 2.0e-15;

//
// Configuration constants to indicate whether or not to use a
// pseudo-random seed (based on the clock) or a fixed seed; and to
// specify the fixed seed explicitly
//
config const useRandomSeed = false,
             seed = if useRandomSeed then SeedGenerator.currentTime else 31415;

//
// Configuration constants to control what's printed -- benchmark
// parameters, input and output arrays, and/or statistics
//
config const printParams = false,
             printArrays = false,
             printStats = true;

// These are solely to make the testing system happy given the COMPOPTS file.
// To be removed once COMPOPTS becomes a non-issue.
config var reproducible = false, verbose = false;

// skip some things
config var verify = true;
config var blast = max(n.type);
config var onlyBsub = false;
config var maxKinPS = max(int);
config var realInitAB = true;

// hooks for debugging
proc vmsg(args...) {}
proc vmsgmore(args...) {}
record VTimer { proc start(){} proc stop(){} proc printTotal(){} }
var tPS1iter, tUBR1iter, tSC1call, tLF1iter, tBScall, tVer: VTimer;

//
// The program entry point, currently module initialization
//
  printConfiguration();

  //
  // Compute targetLocales - required for Dimensional.
  // We hard-code 2 dimensions.
  //
  var targetIds: domain(2);
  var targetLocales: [targetIds] locale;
  setupTargetLocalesArray(targetIds, targetLocales, Locales);

  // Here are the dimensions of our grid of locales.
  const tl1 = targetIds.dim(1).length,
        tl2 = targetIds.dim(2).length;
/*
  if printParams && printStats then
    writeln("target locales ", tl1, " x ", tl2);
*/

  writeln("HPL  n ", n, "  blkSize ", blkSize, "  blk/node ",
          divceilpos(n, blkSize*tl1), "*", divceilpos(n+1, blkSize*tl2),
          "  locs ", tl1, "*", tl2, "  dPTPL ", dataParTasksPerLocale);

  const distReplicated = new ReplicatedDist();

  const
    // block-cyclic for 1st dimension
    bdim1 = new BlockCyclicDim(lowIdx=1, blockSize=blkSize, numLocales=tl1),
    // replicated for 1st dimension
    rdim1 = new ReplicatedDim(tl1),

    // block-cyclic for 2nd dimension
    bdim2 = new BlockCyclicDim(lowIdx=1, blockSize=blkSize, numLocales=tl2),
    // replicated for 2nd dimension
    rdim2 = new ReplicatedDim(tl2);

  const
    dist1b2b = new DimensionalDist2D(targetLocales, bdim1, bdim2, "dist1b2b"),
    dist1b2r = new DimensionalDist2D(targetLocales, bdim1, rdim2, "dist1b2r"),
    dist1r2b = new DimensionalDist2D(targetLocales, rdim1, bdim2, "dist1r2b");

  //
  // MatVectSpace is a 2D domain of type indexType that represents the
  // n x n matrix adjacent to the column vector b.  MatrixSpace is a
  // subdomain that is created by slicing into MatVectSpace,
  // inheriting all of its rows and its low column bound.  As our
  // standard distribution library is filled out, MatVectSpace will be
  // distributed using a BlockCyclic(blkSize) distribution.
  //
  // We use 'AbD' instead of 'MatVectSpace' throughout.
  //
  const AbD = {1..n, 1..n+1} dmapped new dmap(dist1b2b);

  var Ab : [AbD] elemType,           // the matrix A and vector b
      piv: [1..n] indexType;         // a vector of pivot values

  vmsg("allocated Ab");

  //
  // Create the 1-d replicated arrays for schurComplement().
  //
  const replAD = {1..n, 1..blkSize}   dmapped new dmap(dist1b2r),
        replBD = {1..blkSize, 1..n+1} dmapped new dmap(dist1r2b);

  var replA: [replAD] elemType,
      replB: [replBD] elemType;

  vmsg("allocated replA,B");

  const replKD = {0..0, 1..n+1} dmapped new dmap(dist1r2b);
  var   replK: [replKD] elemType;

  const replUD = {0..#blkSize, 0..#blkSize} dmapped new dmap(distReplicated);
        // can't use targetLocales because of "consistency" req. - that's OK
  var   replU: [replUD] elemType;

  vmsg("allocated replK,U");

  initAB();

  const startTime = getCurrentTime();     // capture the start time

 if !onlyBsub then
  LUFactorize(n, piv);                 // compute the LU factorization

  var x => backwardSub(n);  // perform the back substitution

  const execTime = getCurrentTime() - startTime;  // store the elapsed time
  printTime(execTime);
  quit(doExit = false);

  //
  // Validate the answer and print the results
  const validAnswer = verifyResults(x);
  printResults(validAnswer, execTime);

//
// blocked LU factorization with pivoting for matrix augmented with
// vector of RHS values.
//
proc LUFactorize(n: indexType,
                piv: [1..n] indexType) {

  // Initialize the pivot vector to represent the initially unpivoted matrix.
  piv = 1..n;

  /* The following diagram illustrates how we partition the matrix.
     Each iteration of the loop increments a variable blk by blkSize;
     point (blk, blk) is the upper-left location of the currently
     unfactored matrix (the dotted region represents the areas
     factored in prior iterations).  The unfactored matrix is
     partioned into four subdomains: tl, tr, bl, and br, and an
     additional domain (not shown), l, that is the union of tl and bl.

                (point blk, blk)
       +-------//------------------+
       |......//...................|
       |.....//....................|
       |....+-----+----------------|
       |....|     |                |
       |....| tl  |      tr        |
       |....|     |                |
       |....+-----+----------------|
       |....|     |                |
       |....|     |                |
       |....| bl  |      br        |
       |....|     |                |
       |....|     |                |
       +----+-----+----------------+
  */
  for blk in 1..n by blkSize {
    if blk > blast {
      writeln("terminating early before blk ", blk);
      quit();
    }

    tLF1iter.start();
    if printStats then writeln("processing block ", blk);
    else vmsg("BLOCK  blk ", blk);

    const tl = AbD[blk..#blkSize, blk..#blkSize],
          tr = AbD[blk..#blkSize, blk+blkSize..],
          bl = AbD[blk+blkSize.., blk..#blkSize],
          br = AbD[blk+blkSize.., blk+blkSize..],
          l  = AbD[blk.., blk..#blkSize];
    vmsg("slices");

    //
    // Now that we've sliced and diced Ab properly, do the blocked-LU
    // computation:
    //
    panelSolve(l, piv);
    updateBlockRow(tl, tr);

    //
    // update trailing submatrix (if any)
    //
    schurComplement(blk, bl, tr, br);
    tLF1iter.stop();
  }
}

//
// Distributed matrix-multiply for HPL. The idea behind this algorithm is that
// some point the matrix will be partioned as shown in the following diagram:
//
//    [1]----+-----+-----+-----+
//     |     |bbbbb|bbbbb|bbbbb|  Solve for the dotted region by
//     |     |bbbbb|bbbbb|bbbbb|  multiplying the 'a' and 'b' region.
//     |     |bbbbb|bbbbb|bbbbb|  The 'a' region is a block column, the
//     +----[2]----+-----+-----+  'b' region is a block row.
//     |aaaaa|.....|.....|.....|
//     |aaaaa|.....|.....|.....|  The 'a' region was 'bl' in the calling
//     |aaaaa|.....|.....|.....|  function but called AD here.  Similarly,
//     +-----+-----+-----+-----+  'b' was 'tr' in the calling code, but BD
//     |aaaaa|.....|.....|.....|  here.
//     |aaaaa|.....|.....|.....|
//     |aaaaa|.....|.....|.....|
//     +-----+-----+-----+-----+
//
// Every locale with a block of data in the dotted region updates
// itself by multiplying the neighboring a-region block to its left
// with the neighboring b-region block above it and subtracting its
// current data from the result of this multiplication. To ensure that
// all locales have local copies of the data needed to perform this
// multiplication we copy the data A and B data into the replA and
// replB arrays, which will use a dimensional (block-cyclic,
// replicated-block) distribution (or vice-versa) to ensure that every
// locale only stores one copy of each block it requires for all of
// its rows/columns.
//
proc schurComplement(blk, AD, BD, Rest) {

  // Prevent replication of unequal-sized slices
  if Rest.numIndices == 0 then return;

  tSC1call.start();

  //
  // Copy data into replicated arrays so every processor has a local copy
  // of the data it will need to perform a local matrix-multiply.
  //

  const AbSlice1 => Ab[1..n, AD.dim(2)],
        AbSlice2 => Ab[BD.dim(1), 1..n+1];
  vmsgmore("  AbSlices");

  forall (ab, ra) in zip(AbSlice1, replA) do
    local
      ra = ab;
  replicateA(blk);
  vmsgmore("  replA");

  forall (ab, rb) in zip(AbSlice2, replB) do
    local
      rb = ab;
  replicateB(blk);
  vmsgmore("  replB");

  // do local matrix-multiply on a block-by-block basis
  forall (row,col) in Rest by (blkSize, blkSize) {
    // localize Rest explicitly as a workaround;
    // also hoist the innerRange computation
    const outterRange = Rest.dim(1)(row..#blkSize),
          innerRange  = Rest.dim(2)(col..#blkSize),
          blkRange = 1..blkSize;

   local {

    var h1 => Ab._value.dsiLocalSlice1((outterRange, innerRange)),
        h2 => replA._value.dsiLocalSlice1((outterRange, blkRange)),
        h3 => replB._value.dsiLocalSlice1((blkRange, innerRange));

      for a in outterRange do
        for w in blkRange do
          for b in innerRange do
            //Ab[a,b] -= replA[a,w] * replB[w,b];
            h1[a,b] -= h2[a,w] * h3[w,b];
   } // local
  } // forall
  vmsg("schurComplement()");
  tSC1call.stop();
}

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

// NB works only when storage indices for sliceDim1,2 are contiguous
// Each sliceDim1,2 can be either a range or an int

proc DimensionalArr.dsiLocalSlice1((sliceDim1, sliceDim2)) {
  // might be more elegant to replace the explicit arg tuple with 'slice'
  proc toScalar(slice)
    return if _isIntegralType(slice.type) then slice else slice.low;
  proc toRange(slice)
    return if _isIntegralType(slice.type) then slice..slice else slice;
  proc origScalar(param dim) param
    return _isIntegralType(if dim==1 then sliceDim1.type else sliceDim2.type);
  proc toOrig(param dim, arg)
    return if origScalar(dim) then toScalar(arg) else toRange(arg);

  const dom = this.dom;
  const dist = dom.dist;
  // todo: cache (l1, l2) in privatized copies when possible
  // (i.e. if privatization is supported and there is no oversubscription)
  // Assuming dsiLocalSlice is guaranteed to be local to 'here'.
  const l1 = dist.di1.dsiIndexToLocale1d(toScalar(sliceDim1)),
        l2 = dist.di2.dsiIndexToLocale1d(toScalar(sliceDim2)),
        locAdesc = this.localAdescs[l1, l2],
        r1 = if dom.dom1.dsiStorageUsesUserIndices()
             then if origScalar(1) then sliceDim1 else dom.whole.dim(1)(sliceDim1)
             else toOrig(1, locAdesc.locDom.doml1.dsiLocalSliceStorageIndices1d(dom.dom1, toRange(sliceDim1))),
        r2 = if dom.dom2.dsiStorageUsesUserIndices()
             then if origScalar(2) then sliceDim2 else dom.whole.dim(2)(sliceDim2)
             else toOrig(2, locAdesc.locDom.doml2.dsiLocalSliceStorageIndices1d(dom.dom2, toRange(sliceDim2)));

  const reindexExpr =
    if origScalar(1) then
      if origScalar(2) then compilerError("dsiLocalSlice1 is not supported for two scalars")
      else tuple(sliceDim2)
    else
      if origScalar(2) then tuple(sliceDim1)
      else tuple(sliceDim1, sliceDim2);
  var result: [(...reindexExpr)] => locAdesc.myStorageArr[r1, r2];
  return result;
}

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

//
// do unblocked-LU decomposition within the specified panel, update the
// pivot vector accordingly
//
proc panelSolve(
               panel: domain,
               piv: [] indexType) {

  const blk = panel.dim(1).low;
  const cornerLocale = targetLocaleCorner(blk);
  var kCount = maxKinPS;

  for k in panel.dim(2) {             // iterate through the columns

    kCount -= 1;
    if kCount <= 0 {
      vmsg("panelSolve() skipping from k ", k);
      return;
    }

    tPS1iter.start();
    const col = panel[k.., k..k];
    vmsgmore("  col");

    // If there are no rows below the current column return
    if col.numIndices == 0 then { vmsg("panelSolve()"); return; }

    // Find the pivot, the element with the largest absolute value.
    const (_, (pivotRow, _)) = maxloc reduce zip(abs(Ab(col)), col);
    vmsgmore("  reduce");

    // Capture the pivot value explicitly (note that result of maxloc
    // is absolute value, so it can't be used directly).
    //
    const pivotVal = Ab[pivotRow, k];

    // Swap the current row with the pivot row and update the pivot vector
    // to reflect that
    Ab[k..k, ..] <=> Ab[pivotRow..pivotRow, ..];
    piv[k] <=> piv[pivotRow];
    vmsgmore("  swaps");

    if (pivotVal == 0) then
      halt("Matrix cannot be factorized");

    // divide all values below and in the same col as the pivot by
    // the pivot value
    Ab[k+1.., k..k] /= pivotVal;
    vmsgmore("  pivotVal");

    // update all other values below the pivot
/*
    forall (i,j) in panel[k+1.., k+1..] do
      Ab[i,j] -= Ab[i,k] * Ab[k,j];
*/
    // replicate
    on cornerLocale {
      local
        for j in panel.dim(2)[k+1..] do
          replK[0,j] = Ab[k,j];
      vmsgmore("  seeding replication");
      replicateK(blk);
      vmsgmore("  replicating K");
    }
    // compute
    forall (i,j) in panel[k+1.., k+1..] do
      local
        Ab[i,j] -= Ab[i,k] * replK[0,j];

    vmsgmore("panelSolve ", k);
    tPS1iter.stop();
  }
  vmsg("panelSolve()");
}

//
// Update the block row (tr for top-right) portion of the matrix in a
// blocked LU decomposition.  Each step of the LU decomposition will
// solve a block (tl for top-left) portion of a matrix. This function
// solves the rows to the right of the block.
//
proc updateBlockRow(
                   tl: domain,
                   tr: domain) {
  const blk = tl.dim(1).low;
  const cornerLocale = targetLocaleCorner(blk);
  // 'tl' is a Dimensional-mapped domain, so has stuff
  // on all locales, even where the index set is empty
  const tlDims = tl.dims();
  on cornerLocale {
    const tlDimsLocal = tlDims; // where is value forwarding???
    local
      // we do not need the last row of tl, but pruning it off seems expensive
      forall (i,j) in {(...tlDimsLocal)} do
        replU[i-blk, j-blk] = Ab[i,j];
    vmsgmore("  seeding replication");
    replicateU(blk);
    vmsgmore("  replicating U");
  }
  for row in tr.dim(1) {
    tUBR1iter.start();
    const activeRow = tr[row..row, ..],
          prevRows = tr.dim(1).low..row-1;

    forall (i,j) in activeRow do
      for k in prevRows {
        if boundsChecking {
          const v1 = Ab[i,k];
          const v2 = replU[i-blk, k-blk];
          if v1 != v2 then halt("replU mismatch ", v1, " vs ", v2,
                                "  at ", (i,k,j));
        }
        local
          Ab[i, j] -= replU[i-blk, k-blk] * Ab[k,j];
      }

    vmsgmore("  row ", row);
    tUBR1iter.stop();
  }
  vmsg("updateBlockRow()");
}

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

//
// compute the backwards substitution
//
proc backwardSub(n: indexType) {
  const bd = Ab.domain.dim(1);  // or simply 1..n
  var x: [bd] elemType;

  for i in bd by -1 do
    x[i] = (Ab[i,n+1] - (+ reduce [j in i+1..bd.high] (Ab[i,j] * x[j])))
            / Ab[i,i];

  return x;
}

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

//
// print out the problem size and block size if requested
//
proc printConfiguration() {
  if (printParams) {
    if (printStats) then printLocalesTasks();
    printProblemSize(elemType, numMatrices, n, rank=2);
    writeln("block size = ", blkSize, "\n");
  }
}

proc quit(doExit = true) {
  writeln();
  writeln("Timer totals are:");
  tPS1iter.printTotal();
  tUBR1iter.printTotal();
  tSC1call.printTotal();
  tLF1iter.printTotal();
  tBScall.printTotal();
  writeln();
  if doExit { writeln("quit(): exiting");  exit(0); }
}

//
// construct an n by n+1 matrix filled with random values and scale
// it to be in the range -1.0..1.0
//
proc initAB() {
  tInit.start();
 if realInitAB {
  fillRandom(Ab, seed);
  vmsg("fillRandom");
  forall ab in Ab do local { ab = ab * 2.0 - 1.0; }  //Ab = Ab * 2.0 - 1.0;
  vmsg("Ab computation in initAB");
 } else {
   forall (ab, init) in zip(Ab, initABalt()) {
     ab = init;
   }
   vmsg("initABalt()");
 }
  tInit.stop();
}

iter initABalt(param tag: iterKind, followThis): real
  where tag == iterKind.follower
{
  const iaStart = -0.912534, iaStep = 0.983, iaBound = 0.99,
        iaReset = -1.98234;

  //writeln("follower ", followThis, "  on ", here.id);
  // we know that followThis.low will be >= 0
  const f1 = followThis(1).low + 1,
        f2 = followThis(2).low + 1;
  var cur = iaStart + 0.77 / f1 + 0.83 / f2;
  const step = iaStep / f1 / f2;

  inline proc advance() {
    if boundsChecking then
      if cur <= -1 || cur >= 1 then halt("initABalt: invalid cur = ", cur);
    cur += step;
    if cur > iaBound then cur += iaReset;
    return cur;
  }

  if boundsChecking {
    for f1 in followThis(1) do
      for f2 in followThis(2) do
        yield advance();
  } else {
    // we don't care how many times to do this
    while true do
      yield advance();
  }
}

iter initABalt(): real
{
  writeln("dummy initABalt");
  yield 0;
}

//
// calculate norms and residuals to verify the results
//
proc verifyResults(x) {
  if !verify then return true;
  writeln("verifying results locally...");
  tVer.start();
  initAB();
  var ABglobal => Ab;
  var checkOK: bool;
 { // hide global Ab
  var Ab: [1..n, 1..n+1] elemType;
  if numLocales <= 4 {  // heuristic
    Ab = ABglobal;
    vmsg("localized Ab - 1");
  } else {
    forall (g,l) in zip(ABglobal,Ab) do l = g;
    vmsg("localized Ab - 2");
  }

  const axmbNorm = norm(gaxpyMinus(Ab[.., 1..n], x, Ab[.., n+1..n+1]), normType.normInf);
  vmsgmore("axmbNorm");

  const a1norm   = norm(Ab[.., 1..n], normType.norm1),
        aInfNorm = norm(Ab[.., 1..n], normType.normInf),
        x1Norm   = norm(Ab[.., n+1..n+1], normType.norm1),
        xInfNorm = norm(Ab[.., n+1..n+1], normType.normInf);
  vmsgmore("four norms");

  const resid1 = axmbNorm / (epsilon * a1norm * n),
        resid2 = axmbNorm / (epsilon * a1norm * x1Norm),
        resid3 = axmbNorm / (epsilon * aInfNorm * xInfNorm);
  vmsgmore("three resids");

  checkOK = max(resid1, resid2, resid3) < 16.0;
  if (printStats && !checkOK) {
    writeln("resid1: ", resid1);
    writeln("resid2: ", resid2);
    writeln("resid3: ", resid3);
  }
 } // hide global Ab
  tVer.stop();
  return checkOK;
}

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

proc replicateA(abIx) {
    const fromLocId2 = targetLocalesIndexForAbIndex(2, abIx);
    coforall lid1 in 0..#tl1 do
      on targetLocales(lid1, fromLocId2) do
        coforall lid2 in 0..#tl2 do
          if lid2 != fromLocId2 then
            replA._value.localAdescs[lid1,lid2].myStorageArr =
              replA._value.localAdescs[lid1,fromLocId2].myStorageArr;
}

proc replicateB(abIx) {
    const fromLocId1 = targetLocalesIndexForAbIndex(1, abIx);
    coforall lid2 in 0..#tl2 do
      on targetLocales(fromLocId1, lid2) do
        coforall lid1 in 0..#tl1 do
          if lid1 != fromLocId1 then
            replB._value.localAdescs[lid1,lid2].myStorageArr =
              replB._value.localAdescs[fromLocId1,lid2].myStorageArr;
}

// replicate only along one column of processors,
// starting on a good locale
proc replicateK(abIx) {
    const fromLocId1 = targetLocalesIndexForAbIndex(1, abIx);
    const fromLocId2 = targetLocalesIndexForAbIndex(2, abIx);
    // verify that we are on a good locale, optionally
    if boundsChecking {
      const fromLocale = targetLocales(fromLocId1, fromLocId2);
      if here != fromLocale then
        halt("replicateK(abIx=", abIx, ")  executing on ",
             here.id, "  expecting ", fromLocale.id, " ",
             (fromLocId1, fromLocId2));
    }
    const lid2 = fromLocId2;
        coforall lid1 in 0..#tl1 do
          if lid1 != fromLocId1 then
            replK._value.localAdescs[lid1,lid2].myStorageArr =
              replK._value.localAdescs[fromLocId1,lid2].myStorageArr;
}

proc replicateU(abIx) {
    const fromLocId1 = targetLocalesIndexForAbIndex(1, abIx);
    const fromLocId2 = targetLocalesIndexForAbIndex(2, abIx);
    // verify that we are on a good locale, optionally
    if boundsChecking {
      const fromLocale = targetLocales(fromLocId1, fromLocId2);
      if here != fromLocale then
        // todo: halt or writeln?
        halt("replicateU(abIx=", abIx, ")  executing on ",
                here.id, "  expecting ", fromLocale.id, " ",
                (fromLocId1, fromLocId2));
    }
    var myLocalArr => replU._value.localArrs[here.id].arrLocalRep;
    coforall targloc in targetLocales[fromLocId1, ..] do
      if targloc != here then
        replU._value.localArrs[targloc.id].arrLocalRep = myLocalArr;
}

proc targetLocalesIndexForAbIndex(param dim, abIx)
  return (abIx / blkSize) % (if dim == 1 then tl1 else tl2);

proc targetLocaleForAbIndex(i,j)
  return targetLocales[targetLocalesIndexForAbIndex(1, i),
                       targetLocalesIndexForAbIndex(2, j)];

proc targetLocaleCorner(blk) {
  const cornerLocale = targetLocaleForAbIndex(blk, blk);
  if boundsChecking {
    const altLocale = Ab[blk,blk].locale;
    if cornerLocale != altLocale then
      halt("cornerLocale(blk=", blk, ")  mismatch:",
           "  comp1 -> ", cornerLocale.id, " locale idx ",
           (targetLocalesIndexForAbIndex(1, blk),
            targetLocalesIndexForAbIndex(2, blk)),
           "  comp2 -> ", altLocale.id);
  }
  return cornerLocale;
}

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

//
// print success/failure, the execution time and the Gflop/s value
//
proc printResults(successful, execTime) {
  writeln("Validation: ", if successful then "SUCCESS" else "FAILURE");
  if (printStats) {
    writeln("Execution time = ", execTime);
    const GflopPerSec = ((2.0/3.0) * n**3 + (3.0/2.0) * n**2) / execTime * 10e-9;
    writeln("Performance (Gflop/s) = ", GflopPerSec);
  }
}
proc printTime(execTime) {
  if (printStats) {
    const GflopPerSec = ((2.0/3.0) * n**3 + (3.0/2.0) * n**2) / execTime * 10e-9;
    writeln(execTime, " sec   ", GflopPerSec, " GFLOPS");
  }
}

//
// simple matrix-vector multiplication, solve equation A*x-y
//
proc gaxpyMinus(A: [],
                x: [?xD],
                y: [?yD]) {
  var res: [1..n] elemType;

  forall i in 1..n do
    // 'serial' to avoid spawning more tasks
    serial(true) { res[i] = (+ reduce [j in xD] (A[i,j] * x[j])) - y[i,n+1]; }

  return res;
}

//
// Use standard modules for vector and matrix Norms, Random numbers
// and Timing routines
//
use Norm, Random, Time;

//
// Use the user module for computing HPCC problem sizes
//
use HPCCProblemSize;

//
// Use the distributions we need for this computation
//
use DimensionalDist2D, ReplicatedDim, BlockCycDim;

//
// The number of matrices and the element type of those matrices
// indexType can be int or int(64), elemType can be real or complex
//
const numMatrices = 1;
type indexType = int,
     elemType = real;

//
// Configuration constants indicating the problem size (n) and the
// block size (blkSize)
//
config const n = computeProblemSize(numMatrices, elemType, rank=2,
                                    memFraction=2, retType=indexType),
             blkSize = 8;

//
// Configuration constant used for verification thresholds
//
config const epsilon = 2.0e-15;

//
// Configuration constants to indicate whether or not to use a
// pseudo-random seed (based on the clock) or a fixed seed; and to
// specify the fixed seed explicitly
//
config const useRandomSeed = true,
             seed = if useRandomSeed then SeedGenerator.currentTime else 31415;

//
// Configuration constants to control what's printed -- benchmark
// parameters, input and output arrays, and/or statistics
//
config const printParams = true,
             printArrays = false,
             printStats = true;

// These are solely to make the testing system happy given the COMPOPTS file.
// To be removed once COMPOPTS becomes a non-issue.
config var reproducible = false, verbose = false;

//
// The program entry point, currently module initialization
//
  printConfiguration();

  //
  // Compute targetLocales - required for Dimensional.
  // We hard-code 2 dimensions.
  //
  var targetIds: domain(2);
  var targetLocales: [targetIds] locale;
  setupTargetLocalesArray(targetIds, targetLocales, Locales);

  // Here are the dimensions of our grid of locales.
  const tl1 = targetIds.dim(1).length,
        tl2 = targetIds.dim(2).length;
  if printParams && printStats then
    writeln("target locales ", tl1, " x ", tl2);

  // Create individual dimension descriptors
  const
    // block-cyclic for 1st dimension
    bdim1 = new BlockCyclicDim(lowIdx=1, blockSize=blkSize, numLocales=tl1),
    // replicated for 1st dimension
    rdim1 = new ReplicatedDim(tl1),

    // block-cyclic for 2nd dimension
    bdim2 = new BlockCyclicDim(lowIdx=1, blockSize=blkSize, numLocales=tl2),
    // replicated for 2nd dimension
    rdim2 = new ReplicatedDim(tl2);

  //
  // MatVectSpace is a 2D domain of type indexType that represents the
  // n x n matrix adjacent to the column vector b.  MatrixSpace is a
  // subdomain that is created by slicing into MatVectSpace,
  // inheriting all of its rows and its low column bound.  As our
  // standard distribution library is filled out, MatVectSpace will be
  // distributed using a BlockCyclic(blkSize) distribution.
  //
  // We use 'AbD' instead of 'MatVectSpace' throughout.
  //
  const AbD: domain(2, indexType)
          dmapped DimensionalDist2D(targetLocales, bdim1, bdim2, "dim")
          = {1..n, 1..n+1},
        MatrixSpace = AbD[.., ..n];

  var Ab : [AbD] elemType,           // the matrix A and vector b
      piv: [1..n] indexType;         // a vector of pivot values

  //
  // Create the 1-d replicated arrays for schurComplement().
  //
  const
    replAD = {1..n, 1..blkSize}
      dmapped DimensionalDist2D(targetLocales, bdim1, rdim2, "distBR"),
    replBD = {1..blkSize, 1..n+1}
      dmapped DimensionalDist2D(targetLocales, rdim1, bdim2, "distRB");

  var replA: [replAD] elemType,
      replB: [replBD] elemType;

  const
    replKD = {0..0, 1..n+1}
      dmapped new dmap(replBD._value.dist);
//    dmapped DimensionalDist2D(targetLocales, rdim1, bdim2, "distRB-replK");

  var replK: [replKD] elemType;

  initAB();

  const startTime = getCurrentTime();     // capture the start time

  LUFactorize(n, piv);                 // compute the LU factorization

  var x = backwardSub(n);  // perform the back substitution

  const execTime = getCurrentTime() - startTime;  // store the elapsed time

  //
  // Validate the answer and print the results
  const validAnswer = verifyResults(x);
  printResults(validAnswer, execTime);

//
// blocked LU factorization with pivoting for matrix augmented with
// vector of RHS values.
//
proc LUFactorize(n: indexType,
                piv: [1..n] indexType) {

  // Initialize the pivot vector to represent the initially unpivoted matrix.
  piv = 1..n;

  /* The following diagram illustrates how we partition the matrix.
     Each iteration of the loop increments a variable blk by blkSize;
     point (blk, blk) is the upper-left location of the currently
     unfactored matrix (the dotted region represents the areas
     factored in prior iterations).  The unfactored matrix is
     partioned into four subdomains: tl, tr, bl, and br, and an
     additional domain (not shown), l, that is the union of tl and bl.

                (point blk, blk)
       +-------//------------------+
       |......//...................|
       |.....//....................|
       |....+-----+----------------|
       |....|     |                |
       |....| tl  |      tr        |
       |....|     |                |
       |....+-----+----------------|
       |....|     |                |
       |....|     |                |
       |....| bl  |      br        |
       |....|     |                |
       |....|     |                |
       +----+-----+----------------+
  */
  for blk in 1..n by blkSize {
    if printStats then writeln("processing block ", blk);

    const tl = AbD[blk..#blkSize, blk..#blkSize],
          tr = AbD[blk..#blkSize, blk+blkSize..],
          bl = AbD[blk+blkSize.., blk..#blkSize],
          br = AbD[blk+blkSize.., blk+blkSize..],
          l  = AbD[blk.., blk..#blkSize];

    //
    // Now that we've sliced and diced Ab properly, do the blocked-LU
    // computation:
    //
    panelSolve(l, piv);
    updateBlockRow(tl, tr);

    //
    // update trailing submatrix (if any)
    //
    schurComplement(blk, bl, tr, br);
  }
}

//
// Distributed matrix-multiply for HPL. The idea behind this algorithm is that
// some point the matrix will be partioned as shown in the following diagram:
//
//    [1]----+-----+-----+-----+
//     |     |bbbbb|bbbbb|bbbbb|  Solve for the dotted region by
//     |     |bbbbb|bbbbb|bbbbb|  multiplying the 'a' and 'b' region.
//     |     |bbbbb|bbbbb|bbbbb|  The 'a' region is a block column, the
//     +----[2]----+-----+-----+  'b' region is a block row.
//     |aaaaa|.....|.....|.....|
//     |aaaaa|.....|.....|.....|  The 'a' region was 'bl' in the calling
//     |aaaaa|.....|.....|.....|  function but called AD here.  Similarly,
//     +-----+-----+-----+-----+  'b' was 'tr' in the calling code, but BD
//     |aaaaa|.....|.....|.....|  here.
//     |aaaaa|.....|.....|.....|
//     |aaaaa|.....|.....|.....|
//     +-----+-----+-----+-----+
//
// Every locale with a block of data in the dotted region updates
// itself by multiplying the neighboring a-region block to its left
// with the neighboring b-region block above it and subtracting its
// current data from the result of this multiplication. To ensure that
// all locales have local copies of the data needed to perform this
// multiplication we copy the data A and B data into the replA and
// replB arrays, which will use a dimensional (block-cyclic,
// replicated-block) distribution (or vice-versa) to ensure that every
// locale only stores one copy of each block it requires for all of
// its rows/columns.
//
proc schurComplement(blk, AD: domain, BD: domain, Rest: domain) {

  // Prevent replication of unequal-sized slices
  if Rest.numIndices == 0 then return;

  //
  // Copy data into replicated arrays so every processor has a local copy
  // of the data it will need to perform a local matrix-multiply.
  //

  const AbSlice1 => Ab[1..n, AD.dim(2)],
        AbSlice2 => Ab[BD.dim(1), 1..n+1];

  forall (ab, ra) in zip(AbSlice1, replA) do
    local
      ra = ab;
  replicateA(blk);

  forall (ab, rb) in zip(AbSlice2, replB) do
    local
      rb = ab;
  replicateB(blk);

  // do local matrix-multiply on a block-by-block basis
  forall (row,col) in Rest by (blkSize, blkSize) {
    // localize Rest explicitly as a workaround;
    // also hoist the innerRange computation
    const outterRange = Rest.dim(1)(row..#blkSize),
          innerRange  = Rest.dim(2)(col..#blkSize);

    local {
      for a in outterRange do
        for w in 1..blkSize do
          for b in innerRange do
            Ab[a,b] -= replA[a,w] * replB[w,b];
    }
  }
}

//
// do unblocked-LU decomposition within the specified panel, update the
// pivot vector accordingly
//
proc panelSolve(
               panel: domain,
               piv: [] indexType) {

  const blk = panel.dim(1).low;
  const cornerLocale = Ab[blk,blk].locale;

  for k in panel.dim(2) {             // iterate through the columns
    const col = panel[k.., k..k];

    // If there are no rows below the current column return
    if col.numIndices == 0 then return;

    // Find the pivot, the element with the largest absolute value.
    const (_, (pivotRow, _)) = maxloc reduce(abs(Ab(col)), col);

    // Capture the pivot value explicitly (note that result of maxloc
    // is absolute value, so it can't be used directly).
    //
    const pivotVal = Ab[pivotRow, k];

    // Swap the current row with the pivot row and update the pivot vector
    // to reflect that
    Ab[k..k, ..] <=> Ab[pivotRow..pivotRow, ..];
    piv[k] <=> piv[pivotRow];

    if (pivotVal == 0) then
      halt("Matrix cannot be factorized");

    // divide all values below and in the same col as the pivot by
    // the pivot value
    Ab[k+1.., k..k] /= pivotVal;

    // update all other values below the pivot
    // (a) replicate
    on cornerLocale {
      local
        for j in panel.dim(2)[k+1..] do
          replK[0,j] = Ab[k,j];
      replicateK(blk);
    }
    // (b) compute
    forall (i,j) in panel[k+1.., k+1..] do
      local
        Ab[i,j] -= Ab[i,k] * replK[0,j];
  }
}

//
// Update the block row (tr for top-right) portion of the matrix in a
// blocked LU decomposition.  Each step of the LU decomposition will
// solve a block (tl for top-left) portion of a matrix. This function
// solves the rows to the right of the block.
//
proc updateBlockRow(
                   tl: domain,
                   tr: domain) {

  for row in tr.dim(1) {
    const activeRow = tr[row..row, ..],
          prevRows = tr.dim(1).low..row-1;

    forall (i,j) in activeRow do
      for k in prevRows do
        Ab[i, j] -= Ab[i, k] * Ab[k,j];
  }
}

//
// compute the backwards substitution
//
proc backwardSub(n: indexType) {
  const bd = Ab.domain.dim(1);  // or simply 1..n
  var x: [bd] elemType;

  for i in bd by -1 do
    x[i] = (Ab[i,n+1] - (+ reduce [j in i+1..bd.high] (Ab[i,j] * x[j])))
            / Ab[i,i];

  return x;
}

//
// print out the problem size and block size if requested
//
proc printConfiguration() {
  if (printParams) {
    if (printStats) then printLocalesTasks();
    printProblemSize(elemType, numMatrices, n, rank=2);
    writeln("block size = ", blkSize, "\n");
  }
}

//
// construct an n by n+1 matrix filled with random values and scale
// it to be in the range -1.0..1.0
//
proc initAB() {
  fillRandom(Ab, seed);
  Ab = Ab * 2.0 - 1.0;
}

//
// calculate norms and residuals to verify the results
//
proc verifyResults(x) {
  initAB();

  const axmbNorm = norm(gaxpyMinus(Ab[.., 1..n], x, Ab[.., n+1..n+1]), normType.normInf);

  const a1norm   = norm(Ab[.., 1..n], normType.norm1),
        aInfNorm = norm(Ab[.., 1..n], normType.normInf),
        x1Norm   = norm(Ab[.., n+1..n+1], normType.norm1),
        xInfNorm = norm(Ab[.., n+1..n+1], normType.normInf);

  const resid1 = axmbNorm / (epsilon * a1norm * n),
        resid2 = axmbNorm / (epsilon * a1norm * x1Norm),
        resid3 = axmbNorm / (epsilon * aInfNorm * xInfNorm);

  if (printStats) {
    writeln("resid1: ", resid1);
    writeln("resid2: ", resid2);
    writeln("resid3: ", resid3);
  }

  return max(resid1, resid2, resid3) < 16.0;
}

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

proc replicateA(abIx) {
    const fromLocId2 = targetLocalesIndexForAbIndex(2, abIx);
    coforall lid1 in 0..#tl1 do
      on targetLocales(lid1, fromLocId2) do
        coforall lid2 in 0..#tl2 do
          if lid2 != fromLocId2 then
            replA._value.localAdescs[lid1,lid2].myStorageArr =
              replA._value.localAdescs[lid1,fromLocId2].myStorageArr;
}

proc replicateB(abIx) {
    const fromLocId1 = targetLocalesIndexForAbIndex(1, abIx);
    coforall lid2 in 0..#tl2 do
      on targetLocales(fromLocId1, lid2) do
        coforall lid1 in 0..#tl1 do
          if lid1 != fromLocId1 then
            replB._value.localAdescs[lid1,lid2].myStorageArr =
              replB._value.localAdescs[fromLocId1,lid2].myStorageArr;
}

// replicate only along one column of processors,
// starting on a good locale
proc replicateK(abIx) {
    const fromLocId1 = targetLocalesIndexForAbIndex(1, abIx);
    const fromLocId2 = targetLocalesIndexForAbIndex(2, abIx);
    // verify that we are on a good locale, optionally
    if boundsChecking {
      const fromLocale = targetLocales(fromLocId1, fromLocId2);
      if here != fromLocale then
        halt("replicateK(abIx=", abIx, ")  executing on ",
             here.id, "  expecting ", fromLocale.id, " ",
             (fromLocId1, fromLocId2));
    }
    const lid2 = fromLocId2;
        coforall lid1 in 0..#tl1 do
          if lid1 != fromLocId1 then
            replK._value.localAdescs[lid1,lid2].myStorageArr =
              replK._value.localAdescs[fromLocId1,lid2].myStorageArr;
}

proc targetLocalesIndexForAbIndex(param dim, abIx)
  return (abIx / blkSize) % (if dim == 1 then tl1 else tl2);

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

//
// print success/failure, the execution time and the Gflop/s value
//
proc printResults(successful, execTime) {
  writeln("Validation: ", if successful then "SUCCESS" else "FAILURE");
  if (printStats) {
    writeln("Execution time = ", execTime);
    const GflopPerSec = ((2.0/3.0) * n**3 + (3.0/2.0) * n**2) / execTime * 10e-9;
    writeln("Performance (Gflop/s) = ", GflopPerSec);
  }
}

//
// simple matrix-vector multiplication, solve equation A*x-y
//
proc gaxpyMinus(A: [],
                x: [?xD],
                y: [?yD]) {
  var res: [1..n] elemType;

  forall i in 1..n do
    // 'serial' to avoid spawning more tasks
    serial(true) { res[i] = (+ reduce [j in xD] (A[i,j] * x[j])) - y[i,n+1]; }

  return res;
}


Apply private to some helper functions in the AdvancedIters module

Helpers functions do not need to be visible outside the module in which
they are defined.

/*
 * 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.
 */

/*
  This module contains several iterators that can be used to drive a `forall`
  loop by performing dynamic and adaptive splitting of a range's iterations.

  For more information, see *User-Defined Parallel Zippered Iterators
  in Chapel*. Bradford L. Chamberlain, Sung-Eun Choi, Steven J. Deitz,
  Angeles Navarro. *PGAS 2011: Fifth Conference on Partitioned Global
  Address Space Programming Models*, October 2011.
*/
module AdvancedIters {

/*
   An atomic test-and-set lock.
*/
pragma "no doc"
record vlock {
  var l: atomic bool;
  proc lock() {
    on this do while l.testAndSet() != false do chpl_task_yield();
  }
  proc unlock() {
    l.write(false);
  }
}

/*
   Toggle debugging output.
*/
config param debugAdvancedIters:bool=false;

//************************* Dynamic iterator

/*
   The serial version of the dynamic iterator.

   Equivalent to serial iteration over the range ``c``.
*/
iter dynamic(c:range(?), chunkSize:int, numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial dynamic Iterator. Working with range ", c);

  for i in c do yield i;
}

// Parallel iterator

/*

  :arg c: The range to iterate over. The length of the range must be greater
          than zero.
  :type c: range(?)

  :arg chunkSize: The size of chunks to be yielded to each thread. Must be
                  greater than zero.
  :type chunkSize: int

  :arg numTasks: The number of tasks to use. Must be >= zero. If this argument
                 has the value 0, it will use the value indicated by
                 ``dataParTasksPerLocale``.
  :type numTasks: int

  :yields: Indices in the range ``c``.

  This iterator is equivalent to the dynamic scheduling approach of OpenMP.

  Given an input range ``c``, each task is assigned chunks of size
  ``chunkSize`` from ``c`` (or the remaining iterations if there are fewer
  than ``chunkSize``). This continues until there are no remaining iterations
  in ``c``.

*/
iter dynamic(param tag:iterKind, c:range(?), chunkSize:int, numTasks:int=0)
where tag == iterKind.leader
{
  assert(chunkSize > 0); // caller's responsibility

  // # of tasks the range can fill. (fast) ceil so all work is represented
  const chunkTasks = divceilpos(c.length, chunkSize): int;

  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks = min(chunkTasks, defaultNumTasks(numTasks));

  type rType=c.type;

  // We're going to have to densify at some point, might as well
  // do it early and make range slicing easier.
  const remain:rType=densify(c,c);

  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Dynamic Iterator: serial execution because there is not enough work");
    yield (remain,);
  } else {
    var moreWork : bool =true;
    var curIndex : atomic remain.low.type;
    curIndex.write(remain.low);

    coforall tid in 0..#nTasks with (ref remain, ref moreWork, ref curIndex) do {
      while moreWork do {
        // There is local work in remain
        const low = curIndex.fetchAdd(chunkSize);
        var high = low + chunkSize-1;

        if low > remain.high {
          break;
        } else if high > remain.high {
          high = remain.high;
          moreWork = false;
        }

        const current:rType = remain(low .. high);

        if high >= low then {
          if debugAdvancedIters then
            writeln("Parallel dynamic Iterator. Working at tid ", tid, " with range ", unDensify(current,c), " yielded as ", current);
          yield (current,);
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter dynamic(param tag:iterKind, c:range(?), chunkSize:int, numTasks:int, followThis)
where tag == iterKind.follower
{
  type rType=c.type;
  const current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Guided iterator

/*
   The serial version of the guided iterator.

   Equivalent to serial iteration over the range ``c``.
*/
iter guided(c:range(?), numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial guided Iterator. Working with range ", c);

  for i in c do yield i;
}

/*

  :arg c: The range to iterate over. Must have a length greater than zero.
  :type c: range(?)

  :arg numTasks: The number of tasks to use. Must be >= zero. If this argument
                 has the value 0, it will use the value indicated by
                 ``dataParTasksPerLocale``.
  :type numTasks: int

  :yields: Indices in the range ``c``.

  This iterator is equivalent to the guided policy of OpenMP: Given an input
  range ``c``, each task is assigned chunks of variable size, until there are
  no remaining iterations in ``c``. The size of each chunk is the number of
  unassigned iterations divided by the number of tasks, ``numTasks``. The size
  decreases approximately exponentially to 1. The splitting strategy is
  therefore adaptive.

*/
iter guided(param tag:iterKind, c:range(?), numTasks:int=0)
where tag == iterKind.leader
{
  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=min(c.length, defaultNumTasks(numTasks));
  type rType=c.type;
  var remain:rType = densify(c,c);
  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Guided Iterator: serial execution because there is not enoguh work");
    yield (remain,);
  }

  else {
    var undone=true;
    const factor=nTasks;
    var lock : vlock;

    coforall tid in 0..#nTasks with (ref remain, ref undone, ref lock) do {
      while undone do {
        // There is local work in remain(tid)
        const current:rType=adaptSplit(remain, factor, undone, lock);
        if current.length !=0 then {
          if debugAdvancedIters then
            writeln("Parallel guided Iterator. Working at tid ", tid, " with range ", unDensify(current,c), " yielded as ", current);
          yield (current,);
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter guided(param tag:iterKind, c:range(?), numTasks:int, followThis)
where tag == iterKind.follower

{
  type rType=c.type;
  const current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Adaptive work-stealing iterator
/*
   The serial version of the adaptive iterator.

   Equivalent to serial iteration over the range ``c``.
*/
iter adaptive(c:range(?), numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial adaptive work-stealing Iterator. Working with range ", c);

  for i in c do yield i;

}

// Parallel iterator
/*
The enum used to represent adaptive methods.

- ``Whole``
  Each task without work tries to steal from its neighbor range
  until it exhausts that range. Then the task continues with the next
  neighbor range, and so on until there is no more work. This is the default
  policy.

- ``RoundRobin``
  Each task without work tries to steal once from its neighbor range, next
  from the following neighbor range and so on in a round-robin way until
  there is no more work.

- ``WholeTail``
  Similar to the ``Whole`` method, but now the splitting in the victim
  range is performed from its tail.
*/
enum Method {
  Whole = 0,
  RoundRobin = 1,
  WholeTail = 2
};

/*
  Used to select the adaptive stealing method. Defaults to ``Whole``.
  See :data:`Method` for more information.
*/
config param methodStealing = Method.Whole;

/*

  :arg c: The range to iterate over. Must have a length greater than zero.
  :type c: range(?)

  :arg numTasks: The number of tasks to use. Must be >= zero. If this argument
                 has the value 0, it will use the value indicated by
                 ``dataParTasksPerLocale``.
  :type numTasks: int

  :yields: Indices in the range ``c``.

  This iterator implements a naive adaptive binary splitting work-stealing
  strategy: Initially the leader iterator distributes the range to split, ``c``,
  evenly among the ``numTasks`` tasks.

  Then, each task performs adaptive splitting on its local sub-range's iterations.
  When a task exhausts its local iterations, it steals and splits from the
  range of another task (the victim). The splitting method on the local range
  and on the victim range is binary: i.e. the size of each chunk is computed as
  the number of unassigned iterations divided by 2. There are three stealing
  strategies that can be selected at compile time using the config param
  :param:`methodStealing`.
*/
iter adaptive(param tag:iterKind, c:range(?), numTasks:int=0)
where tag == iterKind.leader

{
  /*if (methodStealing != Method.Whole || methodStealing != Method.WholeTail) then
    compilerError("methodStealing value must be between 0 and 2");*/

  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=min(c.length, defaultNumTasks(numTasks));
  type rType=c.type;

  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Adaptive work-stealing Iterator: serial execution because there is not enough work");
    yield (densify(c,c),);

  }
  else {
    const r:rType=densify(c,c);
    const SpaceThreads:domain(1)=0..#nTasks;
    var localWork:[SpaceThreads] rType; // The remaining range to split on each Thread
    var moreLocalWork:[SpaceThreads] bool=true; // bool var to signal there is still work on each local range
    var locks:[SpaceThreads] vlock; // sync var to control the splitting on each Thread
    const factor:int=2;

    const factorSteal:int=2;
    var moreWork:bool=true; // A global var to control the termination

    // Variables to put a barrier to ensure the initial range is computed on each Thread
    var barrier : atomic int;

    // Start the parallel work
    coforall tid in 0..#nTasks with (ref localWork, ref moreLocalWork, ref moreWork, ref r) do {

      // Step 1: Initial range per Thread/Task

      // Initial Local range in localWork[tid]
      const chunkSize = c.length/nTasks;
      localWork[tid]=
      if tid==nTasks-1 then
        r#(chunkSize*(nTasks-1)-r.length)
      else
        (r+tid*chunkSize)#chunkSize;
      barrier.add(1);

      if debugAdvancedIters then
        writeln("Parallel adaptive work-stealing Iterator. Working at tid ", tid, " with initial range ", localWork[tid]);

      // A barrier waiting for each thread to finish the initial assignment
      barrier.waitFor(nTasks);

      // Step 2: While there is work at tid, do splitting

      while moreLocalWork[tid] do {
        // There is local work
        // The current range we get after splitting locally
        const zeroBasedIters:rType=adaptSplit(localWork[tid], factorSteal, moreLocalWork[tid], locks[tid]);
        if zeroBasedIters.length !=0 then {
          if debugAdvancedIters then
            writeln("Parallel adaptive Iterator. Working locally at tid ", tid, " with range yielded as ", zeroBasedIters);
          yield (zeroBasedIters,);
        }
      }

      // Step3: Task tid finished its work, so it will try to steal from a neighbor

      var nVisitedVictims:int=0;
      var victim=(tid+1) % nTasks;
      var stealFailed:bool=false;

      while moreWork do {
        if debugAdvancedIters then
          writeln("Entering at Stealing phase in tid ", tid," with victim ", victim, " using method of Stealing ", methodStealing);

        // Perform the spliting at the victim remaining range

        if methodStealing == Method.RoundRobin {
          if moreLocalWork[victim] then {
            // There is work in victim
            const zeroBasedIters2:rType=adaptSplit(localWork[victim], factorSteal, moreLocalWork[victim], locks[victim]);
            if zeroBasedIters2.length !=0 then {
              if debugAdvancedIters then
                writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
              yield (zeroBasedIters2,);
            }
          } else {
            stealFailed=true;
          }
        } else {
          while moreLocalWork[victim] do {
            // There is work in victim
            const zeroBasedIters2:rType=adaptSplit(localWork[victim], factorSteal, moreLocalWork[victim], locks[victim], methodStealing==Method.WholeTail);
                                          //after splitting from a victim range
            if zeroBasedIters2.length !=0 then {
              if debugAdvancedIters then
                writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
              yield (zeroBasedIters2,);
            }
          }
        }

        // If here, then it can have failed the stealing intent at the victim (method 1),
        // or we have exhausted the victim range (methods 0, 2)

        if (methodStealing==Method.Whole || methodStealing==Method.WholeTail || (methodStealing==Method.RoundRobin && stealFailed)) then {
          nVisitedVictims += 1; // Signal that there is no more work in victim
          stealFailed=false;
          if debugAdvancedIters then
            writeln("Failed Stealing intent at tid ", tid," with victim ", victim, " and total no. of visited victims ", nVisitedVictims);
        }
        // Check if there is no more work
        if nVisitedVictims >= nTasks-1 then
          moreWork=false; // Signal that there is no more work in any victim
        else {  // There can be still work in other victim
          victim=(victim+1) % nTasks; // New victim to steal
          if methodStealing==Method.RoundRobin && victim==tid then
            victim=(victim+1) % nTasks;
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter adaptive(param tag:iterKind, c:range(?), numTasks:int, followThis)
where tag == iterKind.follower
{
  type rType=c.type;
  var current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Helper functions
pragma "no doc"
private proc defaultNumTasks(nTasks:int)
{
  var dnTasks=nTasks;
  if nTasks==0 then {
    if dataParTasksPerLocale==0 then dnTasks=here.maxTaskPar;
      else dnTasks=dataParTasksPerLocale;
  } else if nTasks<0 then {
    halt("'numTasks' is negative");
  }
  return dnTasks;
}

pragma "no doc"
private proc adaptSplit(ref rangeToSplit:range(?), splitFactor:int, ref itLeft:bool, ref lock : vlock, splitTail:bool=false)
{
  type rType=rangeToSplit.type;
  type lenType=rangeToSplit.length.type;
  var totLen, size:lenType;
  const profThreshold=1;

  lock.lock();
  totLen=rangeToSplit.length;
  if totLen > profThreshold then
    size=max(totLen/splitFactor, profThreshold);
  else {
    size=totLen;
    itLeft=false;}
  const direction = if splitTail then -1 else 1;
  const firstRange:rType=rangeToSplit#(direction*size);
  rangeToSplit=rangeToSplit#(direction*(size-totLen));
  lock.unlock();
  return firstRange;
}

}

/*
 * 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.
 */

/*
  This module contains several iterators that can be used to drive a `forall`
  loop by performing dynamic and adaptive splitting of a range's iterations.

  For more information, see *User-Defined Parallel Zippered Iterators
  in Chapel*. Bradford L. Chamberlain, Sung-Eun Choi, Steven J. Deitz,
  Angeles Navarro. *PGAS 2011: Fifth Conference on Partitioned Global
  Address Space Programming Models*, October 2011.
*/
module AdvancedIters {

/*
   An atomic test-and-set lock.
*/
pragma "no doc"
record vlock {
  var l: atomic bool;
  proc lock() {
    on this do while l.testAndSet() != false do chpl_task_yield();
  }
  proc unlock() {
    l.write(false);
  }
}

/*
   Toggle debugging output.
*/
config param debugAdvancedIters:bool=false;

//************************* Dynamic iterator

/*
   The serial version of the dynamic iterator.

   Equivalent to serial iteration over the range ``c``.
*/
iter dynamic(c:range(?), chunkSize:int, numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial dynamic Iterator. Working with range ", c);

  for i in c do yield i;
}

// Parallel iterator

/*

  :arg c: The range to iterate over. The length of the range must be greater
          than zero.
  :type c: range(?)

  :arg chunkSize: The size of chunks to be yielded to each thread. Must be
                  greater than zero.
  :type chunkSize: int

  :arg numTasks: The number of tasks to use. Must be >= zero. If this argument
                 has the value 0, it will use the value indicated by
                 ``dataParTasksPerLocale``.
  :type numTasks: int

  :yields: Indices in the range ``c``.

  This iterator is equivalent to the dynamic scheduling approach of OpenMP.

  Given an input range ``c``, each task is assigned chunks of size
  ``chunkSize`` from ``c`` (or the remaining iterations if there are fewer
  than ``chunkSize``). This continues until there are no remaining iterations
  in ``c``.

*/
iter dynamic(param tag:iterKind, c:range(?), chunkSize:int, numTasks:int=0)
where tag == iterKind.leader
{
  assert(chunkSize > 0); // caller's responsibility

  // # of tasks the range can fill. (fast) ceil so all work is represented
  const chunkTasks = divceilpos(c.length, chunkSize): int;

  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks = min(chunkTasks, defaultNumTasks(numTasks));

  type rType=c.type;

  // We're going to have to densify at some point, might as well
  // do it early and make range slicing easier.
  const remain:rType=densify(c,c);

  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Dynamic Iterator: serial execution because there is not enough work");
    yield (remain,);
  } else {
    var moreWork : bool =true;
    var curIndex : atomic remain.low.type;
    curIndex.write(remain.low);

    coforall tid in 0..#nTasks with (ref remain, ref moreWork, ref curIndex) do {
      while moreWork do {
        // There is local work in remain
        const low = curIndex.fetchAdd(chunkSize);
        var high = low + chunkSize-1;

        if low > remain.high {
          break;
        } else if high > remain.high {
          high = remain.high;
          moreWork = false;
        }

        const current:rType = remain(low .. high);

        if high >= low then {
          if debugAdvancedIters then
            writeln("Parallel dynamic Iterator. Working at tid ", tid, " with range ", unDensify(current,c), " yielded as ", current);
          yield (current,);
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter dynamic(param tag:iterKind, c:range(?), chunkSize:int, numTasks:int, followThis)
where tag == iterKind.follower
{
  type rType=c.type;
  const current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Guided iterator

/*
   The serial version of the guided iterator.

   Equivalent to serial iteration over the range ``c``.
*/
iter guided(c:range(?), numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial guided Iterator. Working with range ", c);

  for i in c do yield i;
}

/*

  :arg c: The range to iterate over. Must have a length greater than zero.
  :type c: range(?)

  :arg numTasks: The number of tasks to use. Must be >= zero. If this argument
                 has the value 0, it will use the value indicated by
                 ``dataParTasksPerLocale``.
  :type numTasks: int

  :yields: Indices in the range ``c``.

  This iterator is equivalent to the guided policy of OpenMP: Given an input
  range ``c``, each task is assigned chunks of variable size, until there are
  no remaining iterations in ``c``. The size of each chunk is the number of
  unassigned iterations divided by the number of tasks, ``numTasks``. The size
  decreases approximately exponentially to 1. The splitting strategy is
  therefore adaptive.

*/
iter guided(param tag:iterKind, c:range(?), numTasks:int=0)
where tag == iterKind.leader
{
  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=min(c.length, defaultNumTasks(numTasks));
  type rType=c.type;
  var remain:rType = densify(c,c);
  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Guided Iterator: serial execution because there is not enoguh work");
    yield (remain,);
  }

  else {
    var undone=true;
    const factor=nTasks;
    var lock : vlock;

    coforall tid in 0..#nTasks with (ref remain, ref undone, ref lock) do {
      while undone do {
        // There is local work in remain(tid)
        const current:rType=adaptSplit(remain, factor, undone, lock);
        if current.length !=0 then {
          if debugAdvancedIters then
            writeln("Parallel guided Iterator. Working at tid ", tid, " with range ", unDensify(current,c), " yielded as ", current);
          yield (current,);
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter guided(param tag:iterKind, c:range(?), numTasks:int, followThis)
where tag == iterKind.follower

{
  type rType=c.type;
  const current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Adaptive work-stealing iterator
/*
   The serial version of the adaptive iterator.

   Equivalent to serial iteration over the range ``c``.
*/
iter adaptive(c:range(?), numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial adaptive work-stealing Iterator. Working with range ", c);

  for i in c do yield i;

}

// Parallel iterator
/*
The enum used to represent adaptive methods.

- ``Whole``
  Each task without work tries to steal from its neighbor range
  until it exhausts that range. Then the task continues with the next
  neighbor range, and so on until there is no more work. This is the default
  policy.

- ``RoundRobin``
  Each task without work tries to steal once from its neighbor range, next
  from the following neighbor range and so on in a round-robin way until
  there is no more work.

- ``WholeTail``
  Similar to the ``Whole`` method, but now the splitting in the victim
  range is performed from its tail.
*/
enum Method {
  Whole = 0,
  RoundRobin = 1,
  WholeTail = 2
};

/*
  Used to select the adaptive stealing method. Defaults to ``Whole``.
  See :data:`Method` for more information.
*/
config param methodStealing = Method.Whole;

/*

  :arg c: The range to iterate over. Must have a length greater than zero.
  :type c: range(?)

  :arg numTasks: The number of tasks to use. Must be >= zero. If this argument
                 has the value 0, it will use the value indicated by
                 ``dataParTasksPerLocale``.
  :type numTasks: int

  :yields: Indices in the range ``c``.

  This iterator implements a naive adaptive binary splitting work-stealing
  strategy: Initially the leader iterator distributes the range to split, ``c``,
  evenly among the ``numTasks`` tasks.

  Then, each task performs adaptive splitting on its local sub-range's iterations.
  When a task exhausts its local iterations, it steals and splits from the
  range of another task (the victim). The splitting method on the local range
  and on the victim range is binary: i.e. the size of each chunk is computed as
  the number of unassigned iterations divided by 2. There are three stealing
  strategies that can be selected at compile time using the config param
  :param:`methodStealing`.
*/
iter adaptive(param tag:iterKind, c:range(?), numTasks:int=0)
where tag == iterKind.leader

{
  /*if (methodStealing != Method.Whole || methodStealing != Method.WholeTail) then
    compilerError("methodStealing value must be between 0 and 2");*/

  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=min(c.length, defaultNumTasks(numTasks));
  type rType=c.type;

  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Adaptive work-stealing Iterator: serial execution because there is not enough work");
    yield (densify(c,c),);

  }
  else {
    const r:rType=densify(c,c);
    const SpaceThreads:domain(1)=0..#nTasks;
    var localWork:[SpaceThreads] rType; // The remaining range to split on each Thread
    var moreLocalWork:[SpaceThreads] bool=true; // bool var to signal there is still work on each local range
    var locks:[SpaceThreads] vlock; // sync var to control the splitting on each Thread
    const factor:int=2;

    const factorSteal:int=2;
    var moreWork:bool=true; // A global var to control the termination

    // Variables to put a barrier to ensure the initial range is computed on each Thread
    var barrier : atomic int;

    // Start the parallel work
    coforall tid in 0..#nTasks with (ref localWork, ref moreLocalWork, ref moreWork, ref r) do {

      // Step 1: Initial range per Thread/Task

      // Initial Local range in localWork[tid]
      const chunkSize = c.length/nTasks;
      localWork[tid]=
      if tid==nTasks-1 then
        r#(chunkSize*(nTasks-1)-r.length)
      else
        (r+tid*chunkSize)#chunkSize;
      barrier.add(1);

      if debugAdvancedIters then
        writeln("Parallel adaptive work-stealing Iterator. Working at tid ", tid, " with initial range ", localWork[tid]);

      // A barrier waiting for each thread to finish the initial assignment
      barrier.waitFor(nTasks);

      // Step 2: While there is work at tid, do splitting

      while moreLocalWork[tid] do {
        // There is local work
        // The current range we get after splitting locally
        const zeroBasedIters:rType=adaptSplit(localWork[tid], factorSteal, moreLocalWork[tid], locks[tid]);
        if zeroBasedIters.length !=0 then {
          if debugAdvancedIters then
            writeln("Parallel adaptive Iterator. Working locally at tid ", tid, " with range yielded as ", zeroBasedIters);
          yield (zeroBasedIters,);
        }
      }

      // Step3: Task tid finished its work, so it will try to steal from a neighbor

      var nVisitedVictims:int=0;
      var victim=(tid+1) % nTasks;
      var stealFailed:bool=false;

      while moreWork do {
        if debugAdvancedIters then
          writeln("Entering at Stealing phase in tid ", tid," with victim ", victim, " using method of Stealing ", methodStealing);

        // Perform the spliting at the victim remaining range

        if methodStealing == Method.RoundRobin {
          if moreLocalWork[victim] then {
            // There is work in victim
            const zeroBasedIters2:rType=adaptSplit(localWork[victim], factorSteal, moreLocalWork[victim], locks[victim]);
            if zeroBasedIters2.length !=0 then {
              if debugAdvancedIters then
                writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
              yield (zeroBasedIters2,);
            }
          } else {
            stealFailed=true;
          }
        } else {
          while moreLocalWork[victim] do {
            // There is work in victim
            const zeroBasedIters2:rType=adaptSplit(localWork[victim], factorSteal, moreLocalWork[victim], locks[victim], methodStealing==Method.WholeTail);
                                          //after splitting from a victim range
            if zeroBasedIters2.length !=0 then {
              if debugAdvancedIters then
                writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
              yield (zeroBasedIters2,);
            }
          }
        }

        // If here, then it can have failed the stealing intent at the victim (method 1),
        // or we have exhausted the victim range (methods 0, 2)

        if (methodStealing==Method.Whole || methodStealing==Method.WholeTail || (methodStealing==Method.RoundRobin && stealFailed)) then {
          nVisitedVictims += 1; // Signal that there is no more work in victim
          stealFailed=false;
          if debugAdvancedIters then
            writeln("Failed Stealing intent at tid ", tid," with victim ", victim, " and total no. of visited victims ", nVisitedVictims);
        }
        // Check if there is no more work
        if nVisitedVictims >= nTasks-1 then
          moreWork=false; // Signal that there is no more work in any victim
        else {  // There can be still work in other victim
          victim=(victim+1) % nTasks; // New victim to steal
          if methodStealing==Method.RoundRobin && victim==tid then
            victim=(victim+1) % nTasks;
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter adaptive(param tag:iterKind, c:range(?), numTasks:int, followThis)
where tag == iterKind.follower
{
  type rType=c.type;
  var current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Helper functions
pragma "no doc"
proc defaultNumTasks(nTasks:int)
{
  var dnTasks=nTasks;
  if nTasks==0 then {
    if dataParTasksPerLocale==0 then dnTasks=here.maxTaskPar;
      else dnTasks=dataParTasksPerLocale;
  } else if nTasks<0 then {
    halt("'numTasks' is negative");
  }
  return dnTasks;
}

pragma "no doc"
proc adaptSplit(ref rangeToSplit:range(?), splitFactor:int, ref itLeft:bool, ref lock : vlock, splitTail:bool=false)
{
  type rType=rangeToSplit.type;
  type lenType=rangeToSplit.length.type;
  var totLen, size:lenType;
  const profThreshold=1;

  lock.lock();
  totLen=rangeToSplit.length;
  if totLen > profThreshold then
    size=max(totLen/splitFactor, profThreshold);
  else {
    size=totLen;
    itLeft=false;}
  const direction = if splitTail then -1 else 1;
  const firstRange:rType=rangeToSplit#(direction*size);
  rangeToSplit=rangeToSplit#(direction*(size-totLen));
  lock.unlock();
  return firstRange;
}

}


Added support for assigning an arithmetic sequence to an array.

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

//
// Arrays and domains
//

pragma "array"
class _array {
  type _array_type;
  type elt_type;
  param rank : int;
  var _value : _array_type;
  var dom : _domain;

  def this(d : _domain) {
    var a = d._build_array(elt_type);
    for i in d do
      a(i) = this(i);
    return a;
  }

  def =this(d : _domain, v) {
    for i in d do
      this(i) = v;
  }

  // need this function to compete with string indexing function
  // (scalar promotion on array of strings or scalar promotion and
  // coercion on array of ints/floats)
  def this(i:int...?k) var
    return _value((...i));

  def this(i...?k) var
    return _value((...i));

  def getHeadCursor()
    return _value.getHeadCursor();

  def getNextCursor(c)
    return _value.getNextCursor(c);

  def getValue(c)
    return _value.getValue(c);

  def isValidCursor?(c)
    return _value.isValidCursor?(c);

  iterator this() : elt_type {
    forall x in _value
      yield x;
  }

  def view(d: _domain)
    return _value.view(d._value);
}

def =(a: _array, b: _array) {
  a._value = b._value;
  return a;
}

def =(a: _array, b) {
  a._value = b;
  return a;
}

def _copy(a: _array) {
  var b : [a.dom] a.elt_type;
  b = a;
  return b;
}

def _init(a: _array) {
  var b : [a.dom] a.elt_type;
  return b;
}

def fwrite(f : file, a: _array) {
  fwrite(f, a._value);
}

class _domain {
  type _domain_type;
  param rank : int;
  var _value : _domain_type;

  def getHeadCursor()
    return _value.getHeadCursor();

  def getNextCursor(c)
    return _value.getNextCursor(c);

  def getValue(c)
    return _value.getValue(c);

  def isValidCursor?(c)
    return _value.isValidCursor?(c);

  def this(dim : int)
    return _value(dim);

  def _build_array(type elt_type) {
    var x = _value._build_array(elt_type);
    return _array(x.type, elt_type, rank, x, this);
  }

  def _build_index()
    return _value._build_index();

  def _build_sparse_domain() {
    var x = _value._build_sparse_domain();
    return _domain(x.type, rank, x);
  }

  def add(i) {
    _value.add(i);
  }

  def expand(i...?k) {
    var x = _value.expand((...i));
    return _domain(x.type, rank, x);
  }

  def exterior(i...?k) {
    var x = _value.exterior((...i));
    return _domain(x.type, rank, x);
  }

  def interior(i...?k) {
    var x = _value.interior((...i));
    return _domain(x.type, rank, x);
  }

  def translate(i...?k) {
    var x = _value.translate((...i));
    return _domain(x.type, rank, x);
  }
}

def =(a: _domain, b: _domain) {
  a._value = b._value;
  return a;
}

def fwrite(f : file, a: _domain) {
  fwrite(f, a._value);
}

def by(a: _domain, b) {
  var x = a._value by b;
  return _domain(x.type, a.rank, x);
}

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

def _build_domain(x)
  return x;

def _build_domain(ranges : _aseq ...?rank) {
  var x = _adomain(rank, ranges);
  return _domain(x.type, rank, x);
}

def _build_domain_type(param rank : int) {
  var x = _adomain(rank);
  return _domain(x.type, rank, x);
}

def _build_domain_type(type ind_type) {
  var x = _idomain(ind_type);
  return _domain(x.type, 1, x);
}

def _build_sparse_domain_type(dom)
  return dom._build_sparse_domain();

def _build_array_type(dom, type elt_type)
  return dom._build_array(elt_type);

def _build_index_type(param i: int) where i > 1 {
  var x : i*int;
  return x;
}

def _build_index_type(param i: int) where i == 1 {
  var x : int;
  return x;
}

def _build_index_type(dom) {
  return dom._build_index();
}

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

def _aseq._translate(i : int) : _aseq {
  return _low+i.._high+i by _stride;
}

def _aseq._interior(i : int) : _aseq {
  var x : _aseq = _low.._high by _stride;
  if (i < 0) {
    x = _low.._low-1-i by _stride;
  } else if (i > 0) {
    x = _high+1-i.._high by _stride;
  }
  return x;
}

def _aseq._exterior(i : int) : _aseq {
  var x : _aseq = _low.._high by _stride;
  if (i < 0) {
    x = _low+i.._low-1 by _stride;
  } else if (i > 0) {
    x = _high+1.._high+i by _stride;
  }
  return x;
}

def _aseq._expand(i : int) : _aseq {
  return _low-i.._high+i by _stride;
}

class _adomain {
  param rank : int;
  var ranges : rank*_aseq;

  def getHeadCursor() {
    var c : rank*int;
    for param i in 1..rank do
      c(i) = ranges(i).getHeadCursor();
    return c;
  }

  def getNextCursor(c) {
    for param i in 1..rank {
      c(i) = ranges(i).getNextCursor(c(i));
      if ranges(i).isValidCursor?(c(i)) then
        return c;
      else
        c(i) = ranges(i).getHeadCursor();
    }
    c(1) = ranges(1)._high+1;
    return c;
  }

  def getValue(c) {
    if rank == 1 then
      return c(1);
    else
      return c;
  }

  def isValidCursor?(c) {
    for param i in 1..rank do
      if !ranges(i).isValidCursor?(c(i)) then
        return false;
    return true;
  }

  def this(dim : int)
    return ranges(dim);

  def _build_array(type elt_type)
    return _aarray(elt_type, rank, dom=this);

  def _build_sparse_domain()
    return _sdomain(rank, adomain=this);

  def _build_index() {
    var x : rank*int;
    return x;
  }

  def translate(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do
      x.ranges(i) = this(i)._translate(dim(i));
    return x;
  }

  def translate(dim : int ...?numDims) {
    return translate(dim);
  }

  def interior(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do {
      if ((dim(i) > 0) && (this(i)._high+1-dim(i) < this(i)._low) ||
          (dim(i) < 0) && (this(i)._low-1-dim(i) > this(i)._high)) {
        halt("***Error: Argument to 'interior' function out of range in dimension ", i, "***");
      }
      x.ranges(i) = this(i)._interior(dim(i));
    }
    return x;
  }

  def interior(dim : int ...?numDims) {
    return interior(dim);
  }

  def exterior(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do
      x.ranges(i) = this(i)._exterior(dim(i));
    return x;
  }

  def exterior(dim : int ...?numDims) {
    return exterior(dim);
  }

  def expand(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do {
      x.ranges(i) = ranges(i)._expand(dim(i));
      if (x.ranges(i)._low > x.ranges(i)._high) {
        halt("***Error: Degenerate dimension created in dimension ", i, "***");
      }
    }
    return x;
  }

  def expand(dim : int ...?numDims) {
    var x = _adomain(rank);
    if (rank == numDims) {
      -- NOTE: would probably like to get rid of this assignment
      -- since domain assignment is/will eventually be nontrivial
      -- in cost;  yet returning expand(dim) currently causes
      -- problems as captured in trivial/shannon/condReturn3.chpl
      x = expand(dim);
    } else if (numDims == 1) {
      for i in 1..rank do
        x.ranges(i) = ranges(i)._expand(dim(1));
    } else {
      halt("***Error: Rank mismatch between domain and expand() arguments (", rank, " != ", numDims, ")***");
    }
    return x;
  }
}

def by(dom : _adomain, dim : dom.rank*int) {
  var x = _adomain(dom.rank);
  for i in 1..dom.rank do
    x.ranges(i) = dom.ranges(i) by dim(i);
  return x;
}

def by(dom : _adomain, dim : int) {
  var x = _adomain(dom.rank);
  for i in 1..dom.rank do
    x.ranges(i) = dom.ranges(i) by dim;
  return x;
}

record _aarray {
  type elt_type;
  param rank : int;

  var dom : _adomain(rank);
  var info : rank*2*int;
  var size : int;
  var data : _ddata(elt_type);
  var noinit: bool = false;

  def getHeadCursor()
    return 0;

  def getNextCursor(c)
    return c + 1;

  def getValue(c)
    return data(c);

  def isValidCursor?(c)
    return c < size;

  iterator this() : elt_type {
    forall x in dom
      yield x;
  }

  def off(dim : int) var
    return info(dim)(1);

  def blk(dim : int) var
    return info(dim)(2);

  def initialize() {
    if dom == nil then return;
    if noinit == true then return;
    for dim in 1..rank do
      off(dim) = dom(dim)._low;
    blk(rank) = 1;
    for dim in 1..rank-1 by -1 do
      blk(dim) = blk(dim+1) * dom(dim+1).length;
    size = blk(1) * dom(1).length;
    data = _ddata(elt_type, size);
    data.init();
  }

  def this(d : _adomain) {
    var a : [d] elt_type;
    for i in d do
      a(i) = this(i);
    return a;
  }

  def =this(d : _adomain, v) {
    for i in d do
      this(i) = v;
  }

  def this(ind : rank*int) var {
    for param i in 1..rank do
      if !_in(dom(i), ind(i)) {
        halt("array index out of bounds: ", ind);
      }
    var sum : int;
    for param i in 1..rank do
      sum = sum + (ind(i) - off(i)) * blk(i);
    return data(sum);
  }

  def this(ind : int ...rank) var
    return this(ind);

  def view(d: _adomain) {
    if rank != d.rank then
      halt("array rank change not supported");
    for param i in 1..rank do
      if d(i).length != dom(i).length then
        halt("extent in dimension ", i, " does not match actual");
    var alias: _aarray(elt_type, rank, d, noinit=true);
    alias.data = data;
    alias.size = size;
    for param i in 1..rank {
      alias.off(i) = d(i)._low;
      alias.blk(i) = blk(i);
    }
    return _array(alias.type, elt_type, rank, alias, _domain(d.type, rank, d));
  }
}

def =(x : _aarray, y : _aarray) {
  var j : int;
  for e in y {
    x.data(j) = e;
    j = j + 1;
  }
  return x;
}

def =(x : _aarray, y : seq) {
  var j : int;
  for e in y {
    x.data(j) = e;
    j = j + 1;
  }
  return x;
}

def =(x: _aarray, y: _aseq) {
  var j : int;
  for e in y {
    x.data(j) = e;
    j = j + 1;
  }
  return x;
}

def =(x : _aarray, y) {
  for i in 0..x.size-1 do
    x.data(i) = y;
  return x;
}

def fwrite(f : file, x : _adomain) {
  fwrite(f, "[", x(1));
  for i in 2..x.rank do
    fwrite(f, ", ", x(i));
  fwrite(f, "]");
}

def fwrite(f : file, x : _aarray) {
  var i : x.rank*int;
  for dim in 1..x.rank do
    i(dim) = x.dom(dim)._low;
  label next while true {
    fwrite(f, x(i));
    if i(x.rank) < x.dom(x.rank)._high {
      fwrite(f, " ");
      i(x.rank) += x.dom(x.rank)._stride;
    } else {
      for dim in 1..x.rank-1 by -1 {
        if i(dim) < x.dom(dim)._high {
          i(dim) += x.dom(dim)._stride;
          for dim2 in dim+1..x.rank {
            fwrite(f, "\n");
            i(dim2) = x.dom(dim2)._low;
          }
          continue next;
        }
      }
      break;
    }
  }
}

//
// Arrays and domains
//

pragma "array"
class _array {
  type _array_type;
  type elt_type;
  param rank : int;
  var _value : _array_type;
  var dom : _domain;

  def this(d : _domain) {
    var a = d._build_array(elt_type);
    for i in d do
      a(i) = this(i);
    return a;
  }

  def =this(d : _domain, v) {
    for i in d do
      this(i) = v;
  }

  // need this function to compete with string indexing function
  // (scalar promotion on array of strings or scalar promotion and
  // coercion on array of ints/floats)
  def this(i:int...?k) var
    return _value((...i));

  def this(i...?k) var
    return _value((...i));

  def getHeadCursor()
    return _value.getHeadCursor();

  def getNextCursor(c)
    return _value.getNextCursor(c);

  def getValue(c)
    return _value.getValue(c);

  def isValidCursor?(c)
    return _value.isValidCursor?(c);

  iterator this() : elt_type {
    forall x in _value
      yield x;
  }

  def view(d: _domain)
    return _value.view(d._value);
}

def =(a: _array, b: _array) {
  a._value = b._value;
  return a;
}

def =(a: _array, b) {
  a._value = b;
  return a;
}

def _copy(a: _array) {
  var b : [a.dom] a.elt_type;
  b = a;
  return b;
}

def _init(a: _array) {
  var b : [a.dom] a.elt_type;
  return b;
}

def fwrite(f : file, a: _array) {
  fwrite(f, a._value);
}

class _domain {
  type _domain_type;
  param rank : int;
  var _value : _domain_type;

  def getHeadCursor()
    return _value.getHeadCursor();

  def getNextCursor(c)
    return _value.getNextCursor(c);

  def getValue(c)
    return _value.getValue(c);

  def isValidCursor?(c)
    return _value.isValidCursor?(c);

  def this(dim : int)
    return _value(dim);

  def _build_array(type elt_type) {
    var x = _value._build_array(elt_type);
    return _array(x.type, elt_type, rank, x, this);
  }

  def _build_index()
    return _value._build_index();

  def _build_sparse_domain() {
    var x = _value._build_sparse_domain();
    return _domain(x.type, rank, x);
  }

  def add(i) {
    _value.add(i);
  }

  def expand(i...?k) {
    var x = _value.expand((...i));
    return _domain(x.type, rank, x);
  }

  def exterior(i...?k) {
    var x = _value.exterior((...i));
    return _domain(x.type, rank, x);
  }

  def interior(i...?k) {
    var x = _value.interior((...i));
    return _domain(x.type, rank, x);
  }

  def translate(i...?k) {
    var x = _value.translate((...i));
    return _domain(x.type, rank, x);
  }
}

def =(a: _domain, b: _domain) {
  a._value = b._value;
  return a;
}

def fwrite(f : file, a: _domain) {
  fwrite(f, a._value);
}

def by(a: _domain, b) {
  var x = a._value by b;
  return _domain(x.type, a.rank, x);
}

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

def _build_domain(x)
  return x;

def _build_domain(ranges : _aseq ...?rank) {
  var x = _adomain(rank, ranges);
  return _domain(x.type, rank, x);
}

def _build_domain_type(param rank : int) {
  var x = _adomain(rank);
  return _domain(x.type, rank, x);
}

def _build_domain_type(type ind_type) {
  var x = _idomain(ind_type);
  return _domain(x.type, 1, x);
}

def _build_sparse_domain_type(dom)
  return dom._build_sparse_domain();

def _build_array_type(dom, type elt_type)
  return dom._build_array(elt_type);

def _build_index_type(param i: int) where i > 1 {
  var x : i*int;
  return x;
}

def _build_index_type(param i: int) where i == 1 {
  var x : int;
  return x;
}

def _build_index_type(dom) {
  return dom._build_index();
}

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

def _aseq._translate(i : int) : _aseq {
  return _low+i.._high+i by _stride;
}

def _aseq._interior(i : int) : _aseq {
  var x : _aseq = _low.._high by _stride;
  if (i < 0) {
    x = _low.._low-1-i by _stride;
  } else if (i > 0) {
    x = _high+1-i.._high by _stride;
  }
  return x;
}

def _aseq._exterior(i : int) : _aseq {
  var x : _aseq = _low.._high by _stride;
  if (i < 0) {
    x = _low+i.._low-1 by _stride;
  } else if (i > 0) {
    x = _high+1.._high+i by _stride;
  }
  return x;
}

def _aseq._expand(i : int) : _aseq {
  return _low-i.._high+i by _stride;
}

class _adomain {
  param rank : int;
  var ranges : rank*_aseq;

  def getHeadCursor() {
    var c : rank*int;
    for param i in 1..rank do
      c(i) = ranges(i).getHeadCursor();
    return c;
  }

  def getNextCursor(c) {
    for param i in 1..rank {
      c(i) = ranges(i).getNextCursor(c(i));
      if ranges(i).isValidCursor?(c(i)) then
        return c;
      else
        c(i) = ranges(i).getHeadCursor();
    }
    c(1) = ranges(1)._high+1;
    return c;
  }

  def getValue(c) {
    if rank == 1 then
      return c(1);
    else
      return c;
  }

  def isValidCursor?(c) {
    for param i in 1..rank do
      if !ranges(i).isValidCursor?(c(i)) then
        return false;
    return true;
  }

  def this(dim : int)
    return ranges(dim);

  def _build_array(type elt_type)
    return _aarray(elt_type, rank, dom=this);

  def _build_sparse_domain()
    return _sdomain(rank, adomain=this);

  def _build_index() {
    var x : rank*int;
    return x;
  }

  def translate(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do
      x.ranges(i) = this(i)._translate(dim(i));
    return x;
  }

  def translate(dim : int ...?numDims) {
    return translate(dim);
  }

  def interior(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do {
      if ((dim(i) > 0) && (this(i)._high+1-dim(i) < this(i)._low) ||
          (dim(i) < 0) && (this(i)._low-1-dim(i) > this(i)._high)) {
        halt("***Error: Argument to 'interior' function out of range in dimension ", i, "***");
      }
      x.ranges(i) = this(i)._interior(dim(i));
    }
    return x;
  }

  def interior(dim : int ...?numDims) {
    return interior(dim);
  }

  def exterior(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do
      x.ranges(i) = this(i)._exterior(dim(i));
    return x;
  }

  def exterior(dim : int ...?numDims) {
    return exterior(dim);
  }

  def expand(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do {
      x.ranges(i) = ranges(i)._expand(dim(i));
      if (x.ranges(i)._low > x.ranges(i)._high) {
        halt("***Error: Degenerate dimension created in dimension ", i, "***");
      }
    }
    return x;
  }

  def expand(dim : int ...?numDims) {
    var x = _adomain(rank);
    if (rank == numDims) {
      -- NOTE: would probably like to get rid of this assignment
      -- since domain assignment is/will eventually be nontrivial
      -- in cost;  yet returning expand(dim) currently causes
      -- problems as captured in trivial/shannon/condReturn3.chpl
      x = expand(dim);
    } else if (numDims == 1) {
      for i in 1..rank do
        x.ranges(i) = ranges(i)._expand(dim(1));
    } else {
      halt("***Error: Rank mismatch between domain and expand() arguments (", rank, " != ", numDims, ")***");
    }
    return x;
  }
}

def by(dom : _adomain, dim : dom.rank*int) {
  var x = _adomain(dom.rank);
  for i in 1..dom.rank do
    x.ranges(i) = dom.ranges(i) by dim(i);
  return x;
}

def by(dom : _adomain, dim : int) {
  var x = _adomain(dom.rank);
  for i in 1..dom.rank do
    x.ranges(i) = dom.ranges(i) by dim;
  return x;
}

record _aarray {
  type elt_type;
  param rank : int;

  var dom : _adomain(rank);
  var info : rank*2*int;
  var size : int;
  var data : _ddata(elt_type);
  var noinit: bool = false;

  def getHeadCursor()
    return 0;

  def getNextCursor(c)
    return c + 1;

  def getValue(c)
    return data(c);

  def isValidCursor?(c)
    return c < size;

  iterator this() : elt_type {
    forall x in dom
      yield x;
  }

  def off(dim : int) var
    return info(dim)(1);

  def blk(dim : int) var
    return info(dim)(2);

  def initialize() {
    if dom == nil then return;
    if noinit == true then return;
    for dim in 1..rank do
      off(dim) = dom(dim)._low;
    blk(rank) = 1;
    for dim in 1..rank-1 by -1 do
      blk(dim) = blk(dim+1) * dom(dim+1).length;
    size = blk(1) * dom(1).length;
    data = _ddata(elt_type, size);
    data.init();
  }

  def this(d : _adomain) {
    var a : [d] elt_type;
    for i in d do
      a(i) = this(i);
    return a;
  }

  def =this(d : _adomain, v) {
    for i in d do
      this(i) = v;
  }

  def this(ind : rank*int) var {
    for param i in 1..rank do
      if !_in(dom(i), ind(i)) {
        halt("array index out of bounds: ", ind);
      }
    var sum : int;
    for param i in 1..rank do
      sum = sum + (ind(i) - off(i)) * blk(i);
    return data(sum);
  }

  def this(ind : int ...rank) var
    return this(ind);

  def view(d: _adomain) {
    if rank != d.rank then
      halt("array rank change not supported");
    for param i in 1..rank do
      if d(i).length != dom(i).length then
        halt("extent in dimension ", i, " does not match actual");
    var alias: _aarray(elt_type, rank, d, noinit=true);
    alias.data = data;
    alias.size = size;
    for param i in 1..rank {
      alias.off(i) = d(i)._low;
      alias.blk(i) = blk(i);
    }
    return _array(alias.type, elt_type, rank, alias, _domain(d.type, rank, d));
  }
}

def =(x : _aarray, y : _aarray) {
  var j : int;
  for e in y {
    x.data(j) = e;
    j = j + 1;
  }
  return x;
}

def =(x : _aarray, y : seq) {
  var j : int;
  for e in y {
    x.data(j) = e;
    j = j + 1;
  }
  return x;
}

def =(x : _aarray, y) {
  for i in 0..x.size-1 do
    x.data(i) = y;
  return x;
}

def fwrite(f : file, x : _adomain) {
  fwrite(f, "[", x(1));
  for i in 2..x.rank do
    fwrite(f, ", ", x(i));
  fwrite(f, "]");
}

def fwrite(f : file, x : _aarray) {
  var i : x.rank*int;
  for dim in 1..x.rank do
    i(dim) = x.dom(dim)._low;
  label next while true {
    fwrite(f, x(i));
    if i(x.rank) < x.dom(x.rank)._high {
      fwrite(f, " ");
      i(x.rank) += x.dom(x.rank)._stride;
    } else {
      for dim in 1..x.rank-1 by -1 {
        if i(dim) < x.dom(dim)._high {
          i(dim) += x.dom(dim)._stride;
          for dim2 in dim+1..x.rank {
            fwrite(f, "\n");
            i(dim2) = x.dom(dim2)._low;
          }
          continue next;
        }
      }
      break;
    }
  }
}