Change range.sharedInternalIterator() into the default serial range iterator.

It had a comment explaining that it was a workaround for a circularity problem
in function resolution. Resolving the serial iterator caused the parallel
iterator to be resolved which depended on the type of the serial iterator.

This function was preventing zipping Block domains with ranges because the
Block domain leader iterator yields domains instead of ranges, and the range
follower was calling sharedInternalIterator on them.

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

//
// range type
//
//   parameterized by an integral element type, by whether low and/or
//   high bounds exist, and by whether the stride is one or not
//
enum BoundedRangeType { bounded, boundedLow, boundedHigh, boundedNone };

pragma "range"
record range {
  type eltType = int;                            // element type
  param boundedType: BoundedRangeType = BoundedRangeType.bounded; // bounded or not
  param stridable: bool = false;                 // range can be strided
  var _low: eltType = 1;                         // lower bound
  var _high: eltType = 0;                        // upper bound
  var _stride: int = 1;                          // integer stride of range
  var _promotionType : eltType;                  // enables promotion

  pragma "inline" def low return _low;       // public getter for low bound
  pragma "inline" def high return _high;     // public getter for high bound
  pragma "inline" def stride return _stride; // public getter for stride
}

////////////////////////////////////////////////////////////////////////////////
// SYNTAX FUNCTIONS

//
// syntax function for bounded ranges
//
def _build_range(low: int, high: int)
  return new range(int, BoundedRangeType.bounded, false, low, high);
def _build_range(low: uint, high: uint)
  return new range(uint, BoundedRangeType.bounded, false, low, high);
def _build_range(low: int(64), high: int(64))
  return new range(int(64), BoundedRangeType.bounded, false, low, high);
def _build_range(low: uint(64), high: uint(64))
  return new range(uint(64), BoundedRangeType.bounded, false, low, high);

//
// syntax function for unbounded ranges
//
def _build_range(param bt: BoundedRangeType, bound: int)
  return new range(int, bt, false, bound, bound);
def _build_range(param bt: BoundedRangeType, bound: uint)
  return new range(uint, bt, false, bound, bound);
def _build_range(param bt: BoundedRangeType, bound: int(64))
  return new range(int(64), bt, false, bound, bound);
def _build_range(param bt: BoundedRangeType, bound: uint(64))
  return new range(uint(64), bt, false, bound, bound);
def _build_range(param bt: BoundedRangeType)
  return new range(int, bt, false);

//
// syntax function for by-expressions
//
def by(r : range(?), i : int) {
  if i == 0 then
    halt("range cannot be strided by zero");
  if r.boundedType == BoundedRangeType.boundedNone then
    halt("unbounded range cannot be strided");
  var result = new range(r.eltType, r.boundedType, true, r.low, r.high, r.stride*i);
  if r.low > r.high then
    return result;
  if result.stride < 0 then
    result._alignLow(result.high);
  else
    result._alignHigh(result.low);
  return result;
}

//
// syntax functions for counted ranges
//
def #(r:range(?), i:integral)
  where r.boundedType == BoundedRangeType.boundedLow {
  type resultType = (r.low + i).type;
  if i < 0 then
    halt("range cannot have a negative number of elements");
  if i == 0 then
    return new range(eltType = resultType,
                     boundedType = BoundedRangeType.bounded,
                     stridable = r.stridable,
                     _low = r.low + 1,
                     _high = r.low,
                     _stride = r.stride);

  return new range(eltType = resultType,
                   boundedType = BoundedRangeType.bounded,
                   stridable = r.stridable,
                   _low = r.low,
                   _high = r.low + (i-1)*abs(r.stride):resultType,
                   _stride = r.stride);
}

def #(r:range(?), i:integral)
  where r.boundedType == BoundedRangeType.boundedHigh {
  type resultType = (r.low + i).type;
  if i < 0 then
    halt("range cannot have a negative number of elements");
  if i == 0 then
    return new range(eltType = resultType,
                   boundedType = BoundedRangeType.bounded,
                   stridable = r.stridable,
                   _low = r.high,
                   _high = r.high - 1,
                   _stride = r.stride);

  return new range(eltType = resultType,
                   boundedType = BoundedRangeType.bounded,
                   stridable = r.stridable,
                   _low = r.high - (i-1)*abs(r.stride):resultType,
                   _high = r.high,
                   _stride = r.stride);
}

def #(r:range(?), i:integral)
  where r.boundedType == BoundedRangeType.bounded {
  type resultType = (r.low + i).type;
  if i < 0 then
    halt("range cannot have a negative number of elements");
  if i > r.length then
    halt("bounded range is too small to access ", i, " elements");
  if i == 0 then
    return new range(eltType = resultType,
                     boundedType = BoundedRangeType.bounded,
                     stridable = r.stridable,
                     _low = r.high,
                     _high = r.low,
                     _stride = r.stride);

  return new range(eltType = resultType,
                   boundedType = BoundedRangeType.bounded,
                   stridable = r.stridable,
                   _low = if r.stride < 0 then r.high + (i-1)*r.stride:resultType else r.low,
                   _high = if r.stride < 0 then r.high else r.low + (i-1)*r.stride:resultType,
                   _stride = r.stride);
}

def #(r:range(?), i:integral)
  where r.boundedType == BoundedRangeType.boundedNone {
  halt("cannot use # operator on an unbounded range");
}

////////////////////////////////////////////////////////////////////////////////
// INTERNAL FUNCTIONS

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

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

//
// Return the number in the range 0 <= result < b that is congruent to a (mod b)
//
def mod(a:integral, b:integral) {
  if (b <= 0) then
    halt("modulus divisor must be positive");
  var tmp = a % b:a.type;
  return if tmp < 0 then b:a.type + tmp else tmp;
}

//
// align low bound of this range to an alignment; snap up
//
def range._alignLow(alignment: eltType) {
  var s = abs(stride):eltType;
  // The following is equivalent to var d = abs(alignment - low) % s;
  // except that it avoids problems with an overflow in the subtraction.
  // It uses the fact that if a1 == b1 mod n and a2 == b2 mod n then
  // a1 - a2 == b1 - b2 mod n and the fact that abs(a-b) is a-b if a > b
  // and is b-a when b >= a.
  var d = if(alignment > low) then
    mod(mod(alignment,s):int - mod(low,s):int, s):eltType
  else
    mod(mod(low,s):int - mod(alignment, s):int, s):eltType;
  if d != 0 {
    if low < alignment then
      _low += d;
    else
      _low += s - d;
  }
}

//
// align high bound of this range to an alignment; snap down
//
def range._alignHigh(alignment: eltType) {
  var s = abs(stride):eltType;
  // See the note about this declaration in range._alignLow. It is like
  // var d = abs(alignment - high) % s; but avoids overflow problems.
  var d = if(alignment > high) then
    mod(mod(alignment,s):int - mod(high,s):int, s):eltType
  else
    mod(mod(high,s):int - mod(alignment,s):int,s):eltType;
  if d != 0 {
    if high > alignment then
      _high -= d;
    else
      _high -= s - d;
  }
}

//
// range assignment
//
def =(r1: range(stridable=?s1), r2: range(stridable=?s2)) {
  if r1.boundedType != r2.boundedType then
    compilerError("type mismatch in assignment of ranges with different boundedType parameters");
  if !s1 && s2 then
    if r2.stride != 1 then
      halt("non-stridable range assigned non-unit stride");
  r1._low = r2.low;
  r1._high = r2.high;
  r1._stride = r2.stride;
  return r1;
}

////////////////////////////////////////////////////////////////////////////////
// EXTERNAL FUNCTIONS

//
// return the intersection of this and other
//
def range.this(other: range(?eltType, ?boundedType, ?stridable)) {

  //
  // determine boundedType of result
  //
  def computeBoundedType(r1, r2) param {
    param low = r1._hasLow() || r2._hasLow();
    param high = r1._hasHigh() || r2._hasHigh();
    if low && high then
      return BoundedRangeType.bounded;
    else if low then
      return BoundedRangeType.boundedLow;
    else if high then
      return BoundedRangeType.boundedHigh;
    else
      return BoundedRangeType.boundedNone;
  }

  //
  // returns (gcd(u, v), x) where x is set such that u*x + v*y =
  // gcd(u, v) assuming u and v are non-negative
  //
  // source: Knuth Volume 2 --- Section 4.5.2
  //
  def extendedEuclid(u: int, v: int) {
    var U = (1, 0, u);
    var V = (0, 1, v);
    while V(3) != 0 {
      (U, V) = let q = U(3)/V(3) in (V, U - V * (q, q, q));
    }
    return (U(3), U(1));
  }

  var lo1 = if _hasLow() then this.low:eltType else other.low;
  var hi1 = if _hasHigh() then this.high:eltType else other.high;
  var st1 = abs(this.stride);
  var al1 = if this.stride < 0 then hi1 else lo1;

  var lo2 = if other._hasLow() then other.low else this.low:eltType;
  var hi2 = if other._hasHigh() then other.high else this.high:eltType;
  var st2 = abs(other.stride);
  var al2 = if this.stride < 0 then hi2 else lo2;

  var (g, x) = extendedEuclid(st1, st2);

  var result = new range(eltType,
                         computeBoundedType(this, other),
                         this.stridable | other.stridable,
                         max(lo1, lo2),
                         min(hi1, hi2),
                         st1 * st2 / g);

  if abs(lo1 - lo2) % g:eltType != 0 {
    // empty intersection, return degenerate result
    result._low <=> result._high;
  } else {
    // non-empty intersection

    if other.stride < 0 then
      result._stride = -result.stride;

    var al = al1 + (al2 - al1) * x:eltType * st1:eltType / g:eltType;

    result._alignLow(al);
    result._alignHigh(al);
  }

  return result;
}

//
// default iterator optimized for unit stride
//
def range.these() {
  if boundedType != BoundedRangeType.bounded {
    if boundedType == BoundedRangeType.boundedNone then
      halt("iteration over a range with no bounds");
    if stridable {
      if boundedType == BoundedRangeType.boundedLow then
        if stride < 0 then
          halt("iteration over range with negative stride but no high bound");
      if boundedType == BoundedRangeType.boundedHigh then
        if stride > 0 then
          halt("iteration over range with positive stride but no low bound");
      var i = if stride > 0 then low else high;
      while true {
        yield i;
        i = i + stride:eltType;
      }
    } else {
      if boundedType == BoundedRangeType.boundedHigh then
        halt("iteration over range with positive stride but no low bound");
      var i = low;
      while true {
        yield i;
        i = i + 1;
      }
    }
  } else {
    if stridable {
      var i = if stride > 0 then low else high;
      while low <= i && i <= high {
        yield i;
        i = i + stride:eltType;
      }
    } else {
      var i = low;
      while i <= high {
        yield i;
        i = i + 1;
      }
    }
  }
}

def range.these(param tag: iterator) where tag == iterator.leader {
  // want "yield 0..length-1;"
  // but compilerError in length causes a problem because leaders are
  // resolved wherever an iterator is.
  if boundedType == BoundedRangeType.boundedNone then
    halt("iteration over a range with no bounds");
  var v: eltType;
  if stride > 0 then
    v = (high - low) / stride:eltType + 1;
  else
    v = (low - high) / stride:eltType + 1;
  if v < 0 then
    v = 0;
  yield 0..v-1;
}

def range.these(param tag: iterator, follower) where tag == iterator.follower {
  if boundedType == BoundedRangeType.boundedNone then
    halt("iteration over a range with no bounds");
  if stridable {
    var r = if stride > 0 then
        low+follower.low*stride:eltType..low+follower.high*stride:eltType by stride
      else
        high+follower.high*stride:eltType..high+follower.low*stride:eltType by stride;
    for i in r do
      yield i;
  } else {
    var r = low+follower;
    for i in r do
      yield i;
  }
}

//
// returns the number of elements in this range
//
def range.length {
  if boundedType != BoundedRangeType.bounded then
    compilerError("unbounded range has infinite length");
  const retVal = if stride > 0
               then (high - low) / stride:eltType + 1
               else (low - high) / stride:eltType + 1;
  return if (retVal < 0) then 0 else retVal;
}

//
// returns true if i is in this range
//
def range.member(i: eltType) {
  if stridable {
    if boundedType == BoundedRangeType.bounded {
      return i >= low && i <= high && (i - low) % abs(stride):eltType == 0;
    } else if boundedType == BoundedRangeType.boundedLow {
      return i >= low && (i - low) % abs(stride):eltType == 0;
    } else if boundedType == BoundedRangeType.boundedHigh {
      return i <= high && (high - i) % abs(stride):eltType == 0;
    } else {
      return true;
    }
  } else {
    if boundedType == BoundedRangeType.bounded {
      return i >= low && i <= high;
    } else if boundedType == BoundedRangeType.boundedLow {
      return i >= low;
    } else if boundedType == BoundedRangeType.boundedHigh {
      return i <= high;
    } else {
      return true;
    }
  }
}

def range.order(i: eltType) {
  if (!member(i)) then return (-1):eltType;
  return (i-low)/abs(stride);
}

//
// 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.
//
def range.boundsCheck(other: range(?e,?b,?s)) where b == BoundedRangeType.boundedNone {
  return true;
}

def range.boundsCheck(other: range(?e,?b,?s)) where b != BoundedRangeType.boundedNone {
  var boundedOther: range(e,BoundedRangeType.bounded,s||this.stridable);
  if other._hasLow() then
    boundedOther._low = other.low;
  else
    boundedOther._low = low;
  if other._hasHigh() then
    boundedOther._high = other.high;
  else
    boundedOther._high = high;
  boundedOther._stride = other.stride;
  return (boundedOther.length == 0) || (this(boundedOther) == boundedOther);
}

//
// returns true if every i in other is in this range
//
def range.member(other: range(?))
  return this(other) == other;

//
// write implementation for ranges
//
def range.writeThis(f: Writer) {
  if _hasLow() then
    f.write(low);
  f.write("..");
  if _hasHigh() then
    f.write(high);
  if stride != 1 then
    f.write(" by ", stride);
}

//
// translate the indices in this range by i
//
def range.translate(i: eltType)
  return this + i;

//
// intended for internal use only:
//
def range.chpl__unTranslate(i: eltType) {
  return this - i;
}

//
// return an interior portion of this range
//
def range.interior(i: eltType) {
  if boundedType != BoundedRangeType.bounded then
    compilerError("interior is not supported on unbounded ranges");
  if i == 0 then
    return this;
  else if i < 0 then
    return new range(eltType, boundedType, stridable, low, low-1-i, stride);
  else
    return new range(eltType, boundedType, stridable, high+1-i, high, stride);
}

//
// return an exterior portion of this range
//
def range.exterior(i: eltType) {
  if boundedType != BoundedRangeType.bounded then
    compilerError("exterior is not supported on unbounded ranges");
  if i == 0 then
    return this;
  else if i < 0 then
    return new range(eltType, boundedType, stridable, low+i, low-1, stride);
  else
    return new range(eltType, boundedType, stridable, high+1, high+i, stride);
}

//
// returns an expanded range, or a contracted range if i < 0
//
def range.expand(i: eltType)
  return new range(eltType, boundedType, stridable, low-i, high+i, stride);

//
// range op scalar and scalar op range arithmetic
//
def +(r: range(?e,?b,?s), i: integral)
  return new range((r.low+i).type, b, s, r.low+i, r.high+i, r.stride);

def +(i:integral, r: range(?e,?b,?s))
  return new range((i+r.low).type, b, s, i+r.low, i+r.high, r.stride);

def -(r: range(?e,?b,?s), i: integral)
  return new range((r.low-i).type, b, s, r.low-i, r.high-i, r.stride);

//
// return a substring of a string with a range of indices
//
pragma "inline" def string.substring(s: range(?e,?b,?st)) {
  if s.boundedType != BoundedRangeType.bounded then
    compilerError("substring indexing undefined on unbounded ranges");
  if s.stride != 1 then
    return __primitive("string_strided_select", this, s.low, s.high, s.stride);
  else
    return __primitive("string_select", this, s.low, s.high);
}

//
// range type
//
//   parameterized by an integral element type, by whether low and/or
//   high bounds exist, and by whether the stride is one or not
//
enum BoundedRangeType { bounded, boundedLow, boundedHigh, boundedNone };

pragma "range"
record range {
  type eltType = int;                            // element type
  param boundedType: BoundedRangeType = BoundedRangeType.bounded; // bounded or not
  param stridable: bool = false;                 // range can be strided
  var _low: eltType = 1;                         // lower bound
  var _high: eltType = 0;                        // upper bound
  var _stride: int = 1;                          // integer stride of range
  var _promotionType : eltType;                  // enables promotion

  pragma "inline" def low return _low;       // public getter for low bound
  pragma "inline" def high return _high;     // public getter for high bound
  pragma "inline" def stride return _stride; // public getter for stride
}

////////////////////////////////////////////////////////////////////////////////
// SYNTAX FUNCTIONS

//
// syntax function for bounded ranges
//
def _build_range(low: int, high: int)
  return new range(int, BoundedRangeType.bounded, false, low, high);
def _build_range(low: uint, high: uint)
  return new range(uint, BoundedRangeType.bounded, false, low, high);
def _build_range(low: int(64), high: int(64))
  return new range(int(64), BoundedRangeType.bounded, false, low, high);
def _build_range(low: uint(64), high: uint(64))
  return new range(uint(64), BoundedRangeType.bounded, false, low, high);

//
// syntax function for unbounded ranges
//
def _build_range(param bt: BoundedRangeType, bound: int)
  return new range(int, bt, false, bound, bound);
def _build_range(param bt: BoundedRangeType, bound: uint)
  return new range(uint, bt, false, bound, bound);
def _build_range(param bt: BoundedRangeType, bound: int(64))
  return new range(int(64), bt, false, bound, bound);
def _build_range(param bt: BoundedRangeType, bound: uint(64))
  return new range(uint(64), bt, false, bound, bound);
def _build_range(param bt: BoundedRangeType)
  return new range(int, bt, false);

//
// syntax function for by-expressions
//
def by(r : range(?), i : int) {
  if i == 0 then
    halt("range cannot be strided by zero");
  if r.boundedType == BoundedRangeType.boundedNone then
    halt("unbounded range cannot be strided");
  var result = new range(r.eltType, r.boundedType, true, r.low, r.high, r.stride*i);
  if r.low > r.high then
    return result;
  if result.stride < 0 then
    result._alignLow(result.high);
  else
    result._alignHigh(result.low);
  return result;
}

//
// syntax functions for counted ranges
//
def #(r:range(?), i:integral)
  where r.boundedType == BoundedRangeType.boundedLow {
  type resultType = (r.low + i).type;
  if i < 0 then
    halt("range cannot have a negative number of elements");
  if i == 0 then
    return new range(eltType = resultType,
                     boundedType = BoundedRangeType.bounded,
                     stridable = r.stridable,
                     _low = r.low + 1,
                     _high = r.low,
                     _stride = r.stride);

  return new range(eltType = resultType,
                   boundedType = BoundedRangeType.bounded,
                   stridable = r.stridable,
                   _low = r.low,
                   _high = r.low + (i-1)*abs(r.stride):resultType,
                   _stride = r.stride);
}

def #(r:range(?), i:integral)
  where r.boundedType == BoundedRangeType.boundedHigh {
  type resultType = (r.low + i).type;
  if i < 0 then
    halt("range cannot have a negative number of elements");
  if i == 0 then
    return new range(eltType = resultType,
                   boundedType = BoundedRangeType.bounded,
                   stridable = r.stridable,
                   _low = r.high,
                   _high = r.high - 1,
                   _stride = r.stride);

  return new range(eltType = resultType,
                   boundedType = BoundedRangeType.bounded,
                   stridable = r.stridable,
                   _low = r.high - (i-1)*abs(r.stride):resultType,
                   _high = r.high,
                   _stride = r.stride);
}

def #(r:range(?), i:integral)
  where r.boundedType == BoundedRangeType.bounded {
  type resultType = (r.low + i).type;
  if i < 0 then
    halt("range cannot have a negative number of elements");
  if i > r.length then
    halt("bounded range is too small to access ", i, " elements");
  if i == 0 then
    return new range(eltType = resultType,
                     boundedType = BoundedRangeType.bounded,
                     stridable = r.stridable,
                     _low = r.high,
                     _high = r.low,
                     _stride = r.stride);

  return new range(eltType = resultType,
                   boundedType = BoundedRangeType.bounded,
                   stridable = r.stridable,
                   _low = if r.stride < 0 then r.high + (i-1)*r.stride:resultType else r.low,
                   _high = if r.stride < 0 then r.high else r.low + (i-1)*r.stride:resultType,
                   _stride = r.stride);
}

def #(r:range(?), i:integral)
  where r.boundedType == BoundedRangeType.boundedNone {
  halt("cannot use # operator on an unbounded range");
}

////////////////////////////////////////////////////////////////////////////////
// INTERNAL FUNCTIONS

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

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

//
// Return the number in the range 0 <= result < b that is congruent to a (mod b)
//
def mod(a:integral, b:integral) {
  if (b <= 0) then
    halt("modulus divisor must be positive");
  var tmp = a % b:a.type;
  return if tmp < 0 then b:a.type + tmp else tmp;
}

//
// align low bound of this range to an alignment; snap up
//
def range._alignLow(alignment: eltType) {
  var s = abs(stride):eltType;
  // The following is equivalent to var d = abs(alignment - low) % s;
  // except that it avoids problems with an overflow in the subtraction.
  // It uses the fact that if a1 == b1 mod n and a2 == b2 mod n then
  // a1 - a2 == b1 - b2 mod n and the fact that abs(a-b) is a-b if a > b
  // and is b-a when b >= a.
  var d = if(alignment > low) then
    mod(mod(alignment,s):int - mod(low,s):int, s):eltType
  else
    mod(mod(low,s):int - mod(alignment, s):int, s):eltType;
  if d != 0 {
    if low < alignment then
      _low += d;
    else
      _low += s - d;
  }
}

//
// align high bound of this range to an alignment; snap down
//
def range._alignHigh(alignment: eltType) {
  var s = abs(stride):eltType;
  // See the note about this declaration in range._alignLow. It is like
  // var d = abs(alignment - high) % s; but avoids overflow problems.
  var d = if(alignment > high) then
    mod(mod(alignment,s):int - mod(high,s):int, s):eltType
  else
    mod(mod(high,s):int - mod(alignment,s):int,s):eltType;
  if d != 0 {
    if high > alignment then
      _high -= d;
    else
      _high -= s - d;
  }
}

//
// range assignment
//
def =(r1: range(stridable=?s1), r2: range(stridable=?s2)) {
  if r1.boundedType != r2.boundedType then
    compilerError("type mismatch in assignment of ranges with different boundedType parameters");
  if !s1 && s2 then
    if r2.stride != 1 then
      halt("non-stridable range assigned non-unit stride");
  r1._low = r2.low;
  r1._high = r2.high;
  r1._stride = r2.stride;
  return r1;
}

////////////////////////////////////////////////////////////////////////////////
// EXTERNAL FUNCTIONS

//
// return the intersection of this and other
//
def range.this(other: range(?eltType, ?boundedType, ?stridable)) {

  //
  // determine boundedType of result
  //
  def computeBoundedType(r1, r2) param {
    param low = r1._hasLow() || r2._hasLow();
    param high = r1._hasHigh() || r2._hasHigh();
    if low && high then
      return BoundedRangeType.bounded;
    else if low then
      return BoundedRangeType.boundedLow;
    else if high then
      return BoundedRangeType.boundedHigh;
    else
      return BoundedRangeType.boundedNone;
  }

  //
  // returns (gcd(u, v), x) where x is set such that u*x + v*y =
  // gcd(u, v) assuming u and v are non-negative
  //
  // source: Knuth Volume 2 --- Section 4.5.2
  //
  def extendedEuclid(u: int, v: int) {
    var U = (1, 0, u);
    var V = (0, 1, v);
    while V(3) != 0 {
      (U, V) = let q = U(3)/V(3) in (V, U - V * (q, q, q));
    }
    return (U(3), U(1));
  }

  var lo1 = if _hasLow() then this.low:eltType else other.low;
  var hi1 = if _hasHigh() then this.high:eltType else other.high;
  var st1 = abs(this.stride);
  var al1 = if this.stride < 0 then hi1 else lo1;

  var lo2 = if other._hasLow() then other.low else this.low:eltType;
  var hi2 = if other._hasHigh() then other.high else this.high:eltType;
  var st2 = abs(other.stride);
  var al2 = if this.stride < 0 then hi2 else lo2;

  var (g, x) = extendedEuclid(st1, st2);

  var result = new range(eltType,
                         computeBoundedType(this, other),
                         this.stridable | other.stridable,
                         max(lo1, lo2),
                         min(hi1, hi2),
                         st1 * st2 / g);

  if abs(lo1 - lo2) % g:eltType != 0 {
    // empty intersection, return degenerate result
    result._low <=> result._high;
  } else {
    // non-empty intersection

    if other.stride < 0 then
      result._stride = -result.stride;

    var al = al1 + (al2 - al1) * x:eltType * st1:eltType / g:eltType;

    result._alignLow(al);
    result._alignHigh(al);
  }

  return result;
}

//
// default iterator optimized for unit stride
//
def range.sharedInternalIterator() {
  // This is a work-around to avoid a circularity in function
  // resolution in which a serial iterator is resolved leading to the
  // resolution of the parallel iterator but that calls the serial
  // iterator.  When this is fixed, this can be the serial iterator
  // and it can be called by the follower.
  if boundedType != BoundedRangeType.bounded {
    if boundedType == BoundedRangeType.boundedNone then
      halt("iteration over a range with no bounds");
    if stridable {
      if boundedType == BoundedRangeType.boundedLow then
        if stride < 0 then
          halt("iteration over range with negative stride but no high bound");
      if boundedType == BoundedRangeType.boundedHigh then
        if stride > 0 then
          halt("iteration over range with positive stride but no low bound");
      var i = if stride > 0 then low else high;
      while true {
        yield i;
        i = i + stride:eltType;
      }
    } else {
      if boundedType == BoundedRangeType.boundedHigh then
        halt("iteration over range with positive stride but no low bound");
      var i = low;
      while true {
        yield i;
        i = i + 1;
      }
    }
  } else {
    if stridable {
      var i = if stride > 0 then low else high;
      while low <= i && i <= high {
        yield i;
        i = i + stride:eltType;
      }
    } else {
      var i = low;
      while i <= high {
        yield i;
        i = i + 1;
      }
    }
  }
}

def range.these() {
  for i in sharedInternalIterator() do
    yield i;
}

def range.these(param tag: iterator) where tag == iterator.leader {
  // want "yield 0..length-1;"
  // but compilerError in length causes a problem because leaders are
  // resolved wherever an iterator is.
  if boundedType == BoundedRangeType.boundedNone then
    halt("iteration over a range with no bounds");
  var v: eltType;
  if stride > 0 then
    v = (high - low) / stride:eltType + 1;
  else
    v = (low - high) / stride:eltType + 1;
  if v < 0 then
    v = 0;
  yield 0..v-1;
}

def range.these(param tag: iterator, follower) where tag == iterator.follower {
  if boundedType == BoundedRangeType.boundedNone then
    halt("iteration over a range with no bounds");
  if stridable {
    var r = if stride > 0 then
        low+follower.low*stride:eltType..low+follower.high*stride:eltType by stride
      else
        high+follower.high*stride:eltType..high+follower.low*stride:eltType by stride;
    for i in r.sharedInternalIterator() do
      yield i;
  } else {
    var r = low+follower;
    for i in r.sharedInternalIterator() do
      yield i;
  }
}

//
// returns the number of elements in this range
//
def range.length {
  if boundedType != BoundedRangeType.bounded then
    compilerError("unbounded range has infinite length");
  const retVal = if stride > 0
               then (high - low) / stride:eltType + 1
               else (low - high) / stride:eltType + 1;
  return if (retVal < 0) then 0 else retVal;
}

//
// returns true if i is in this range
//
def range.member(i: eltType) {
  if stridable {
    if boundedType == BoundedRangeType.bounded {
      return i >= low && i <= high && (i - low) % abs(stride):eltType == 0;
    } else if boundedType == BoundedRangeType.boundedLow {
      return i >= low && (i - low) % abs(stride):eltType == 0;
    } else if boundedType == BoundedRangeType.boundedHigh {
      return i <= high && (high - i) % abs(stride):eltType == 0;
    } else {
      return true;
    }
  } else {
    if boundedType == BoundedRangeType.bounded {
      return i >= low && i <= high;
    } else if boundedType == BoundedRangeType.boundedLow {
      return i >= low;
    } else if boundedType == BoundedRangeType.boundedHigh {
      return i <= high;
    } else {
      return true;
    }
  }
}

def range.order(i: eltType) {
  if (!member(i)) then return (-1):eltType;
  return (i-low)/abs(stride);
}

//
// 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.
//
def range.boundsCheck(other: range(?e,?b,?s)) where b == BoundedRangeType.boundedNone {
  return true;
}

def range.boundsCheck(other: range(?e,?b,?s)) where b != BoundedRangeType.boundedNone {
  var boundedOther: range(e,BoundedRangeType.bounded,s||this.stridable);
  if other._hasLow() then
    boundedOther._low = other.low;
  else
    boundedOther._low = low;
  if other._hasHigh() then
    boundedOther._high = other.high;
  else
    boundedOther._high = high;
  boundedOther._stride = other.stride;
  return (boundedOther.length == 0) || (this(boundedOther) == boundedOther);
}

//
// returns true if every i in other is in this range
//
def range.member(other: range(?))
  return this(other) == other;

//
// write implementation for ranges
//
def range.writeThis(f: Writer) {
  if _hasLow() then
    f.write(low);
  f.write("..");
  if _hasHigh() then
    f.write(high);
  if stride != 1 then
    f.write(" by ", stride);
}

//
// translate the indices in this range by i
//
def range.translate(i: eltType)
  return this + i;

//
// intended for internal use only:
//
def range.chpl__unTranslate(i: eltType) {
  return this - i;
}

//
// return an interior portion of this range
//
def range.interior(i: eltType) {
  if boundedType != BoundedRangeType.bounded then
    compilerError("interior is not supported on unbounded ranges");
  if i == 0 then
    return this;
  else if i < 0 then
    return new range(eltType, boundedType, stridable, low, low-1-i, stride);
  else
    return new range(eltType, boundedType, stridable, high+1-i, high, stride);
}

//
// return an exterior portion of this range
//
def range.exterior(i: eltType) {
  if boundedType != BoundedRangeType.bounded then
    compilerError("exterior is not supported on unbounded ranges");
  if i == 0 then
    return this;
  else if i < 0 then
    return new range(eltType, boundedType, stridable, low+i, low-1, stride);
  else
    return new range(eltType, boundedType, stridable, high+1, high+i, stride);
}

//
// returns an expanded range, or a contracted range if i < 0
//
def range.expand(i: eltType)
  return new range(eltType, boundedType, stridable, low-i, high+i, stride);

//
// range op scalar and scalar op range arithmetic
//
def +(r: range(?e,?b,?s), i: integral)
  return new range((r.low+i).type, b, s, r.low+i, r.high+i, r.stride);

def +(i:integral, r: range(?e,?b,?s))
  return new range((i+r.low).type, b, s, i+r.low, i+r.high, r.stride);

def -(r: range(?e,?b,?s), i: integral)
  return new range((r.low-i).type, b, s, r.low-i, r.high-i, r.stride);

//
// return a substring of a string with a range of indices
//
pragma "inline" def string.substring(s: range(?e,?b,?st)) {
  if s.boundedType != BoundedRangeType.bounded then
    compilerError("substring indexing undefined on unbounded ranges");
  if s.stride != 1 then
    return __primitive("string_strided_select", this, s.low, s.high, s.stride);
  else
    return __primitive("string_select", this, s.low, s.high);
}


Small fix to _data class in prelude.

Small fix to _data class in prelude.

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

class pragma "codegen data" _data { -- a c array, basically
  type t;
  var x : t; -- dummy
  pragma "rename _data_this" function this(i : integer) : t {
    return __primitive("array_index", t, i);
  }
  pragma "rename _data_set" function =this(i : integer, val : t) : t {
    return __primitive("array_set", this, i, val);
  }
  pragma "rename _data_alloc" function alloc(size, description) {  }
}

-- I/O

pragma "rename _chpl_write_boolean" function write(x : boolean) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_integer" function write(x : integer) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_float" function write(x : float) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_complex" function write(x : complex) : void {
                __primitive("write", x);
}
pragma "rename _chpl_write_string" function write(x : string) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_nil" function write(x : _nilType) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_linefeed" function writeln() : void {
         __primitive("writeln");
}
pragma "rename _chpl_read_boolean" function read(inout x : boolean) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_integer" function read(inout x : integer) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_float" function read(inout x : float) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_complex" function read(inout x : complex) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_string" function read(inout x : string) : void {
         __primitive("read", x);
}

pragma "rename _chpl_tostring_boolean"
function _tostring(x : boolean, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_integer"
function _tostring(x : integer, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_float"
function _tostring(x : float, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_complex"
function _tostring(x : complex, format : string) : string {
         return __primitive("coerce", string, x);
}

-- intrinsic type values

const false: boolean = 0;
const true: boolean = 1;

-- math

function sqrt(x: float): float {}
function abs(x: ?t): float {}  -- BLC: should be ": t"

-- boundary classes/functions

function wrap() {}

-- reductions

class reduction {
}

class sum {
}

class max {
}

class min {
}

class maxloc {
}

class minloc {
}

-- timers

class timer {
  function start();
  function stop();
  function read(): float;
}

-- exits

pragma "rename _chpl_exit" function exit(status : integer);

function halt() {
  __primitive("halt");
}

-- memory tests (These tests will be moved to a module, once we have modules.)

function _chpl_memtest_printMemTable();
function _chpl_memtest_printMemStat();
function _chpl_memtest_resetMemStat();
function _chpl_memtest_allocAndFree();
function _chpl_memtest_freedMalloc();
function _chpl_memtest_freedWithoutMalloc();
function _chpl_memtest_reallocWithoutMalloc();
function _chpl_memtest_reallocZeroSize();
function _chpl_memtest_mallocOutOfMemory();
function _chpl_memtest_reallocOutOfMemory();

function _complex_read_hack(inout x) {
  __primitive("read", x);
}

function _complex_tostring_hack(x, format : string) : string {
  return __primitive("coerce", string, x);
}

class pragma "codegen data" _data { -- a c array, basically
  type t;
  var x : t; -- dummy
  pragma "rename _data_this" function this(i : integer) : t {
    return __primitive("coerce", t, i);
  }
  pragma "rename _data_set" function =this(i : integer, val : t) : t {
    return __primitive("array_set", this, i, val);
  }
  pragma "rename _data_alloc" function alloc(size, description) {  }
}

-- I/O

pragma "rename _chpl_write_boolean" function write(x : boolean) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_integer" function write(x : integer) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_float" function write(x : float) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_complex" function write(x : complex) : void {
                __primitive("write", x);
}
pragma "rename _chpl_write_string" function write(x : string) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_nil" function write(x : _nilType) : void {
         __primitive("write", x);
}
pragma "rename _chpl_write_linefeed" function writeln() : void {
         __primitive("writeln");
}
pragma "rename _chpl_read_boolean" function read(inout x : boolean) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_integer" function read(inout x : integer) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_float" function read(inout x : float) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_complex" function read(inout x : complex) : void {
         __primitive("read", x);
}
pragma "rename _chpl_read_string" function read(inout x : string) : void {
         __primitive("read", x);
}

pragma "rename _chpl_tostring_boolean"
function _tostring(x : boolean, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_integer"
function _tostring(x : integer, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_float"
function _tostring(x : float, format : string) : string {
         return __primitive("coerce", string, x);
}

pragma "rename _chpl_tostring_complex"
function _tostring(x : complex, format : string) : string {
         return __primitive("coerce", string, x);
}

-- intrinsic type values

const false: boolean = 0;
const true: boolean = 1;

-- math

function sqrt(x: float): float {}
function abs(x: ?t): float {}  -- BLC: should be ": t"

-- boundary classes/functions

function wrap() {}

-- reductions

class reduction {
}

class sum {
}

class max {
}

class min {
}

class maxloc {
}

class minloc {
}

-- timers

class timer {
  function start();
  function stop();
  function read(): float;
}

-- exits

pragma "rename _chpl_exit" function exit(status : integer);

function halt() {
  __primitive("halt");
}

-- memory tests (These tests will be moved to a module, once we have modules.)

function _chpl_memtest_printMemTable();
function _chpl_memtest_printMemStat();
function _chpl_memtest_resetMemStat();
function _chpl_memtest_allocAndFree();
function _chpl_memtest_freedMalloc();
function _chpl_memtest_freedWithoutMalloc();
function _chpl_memtest_reallocWithoutMalloc();
function _chpl_memtest_reallocZeroSize();
function _chpl_memtest_mallocOutOfMemory();
function _chpl_memtest_reallocOutOfMemory();

function _complex_read_hack(inout x) {
  __primitive("read", x);
}

function _complex_tostring_hack(x, format : string) : string {
  return __primitive("coerce", string, x);
}


Add in a comment about double precision to the test case; really, only to re-trigger the Travis build

/*
Example usage of the FFTW module in Chapel. This particular file demonstrates the single-threaded version of
the code.

To compile this code :
   chpl testFFTW.chpl
If FFTW is not on your include/library paths, you can do
   chpl testFFTW.chpl -I$FFTW_DIR/include -L$FFTW_DIR/lib
where $FFTW_DIR points to your FFTW installation.

Note that you do not need to explicitly include the header or library files; the module uses an experimental
feature of the Chapel compiler to automatically include these.

The FFTW module uses the FFTW3 API, and currently just implements the basic, double-precision interface.
We will assume that the reader is familiar with using FFTW; more
details are at http://www.fftw.org.

The code computes a series of 1,2 and 3D transforms, exercising the complex <-> complex, and real<->complex
transforms (both in and out of place). The output of the code should be a series of small numbers ( <= 10^-13);
see testFFTW.good for example values (it is possible that your values might differ).

The data for these tests is in arr{1,2,3}d.dat. The format of these files is documented below.
*/
use FFTW;

/* Utility function to print the maximum absolute deviation between values computed by this code,
   and "truth". The true values are computed using Mathematica v10 */
proc printcmp(x, y) {
  var err = max reduce abs(x-y);
  writeln(err);
}

/* This is main test code, parametrized on the number of dimensions ndim.
  fn is the file that contains the test data.
*/
proc runtest(param ndim : int, fn : string) {
  var dims : ndim*int(32);

  /* We define a number of different domains below, corresponding to complex input/output arrays,
     real (input) -> complex (output) out-of-place arrays, and real <-> complex in-place arrays.

     The domains are :
     * D : for complex <-> complex transforms. This domain is also used for the real array in
           a real->complex out-of-place transform.
     * cD : for the complex array in a real <-> complex out-of-place transform.
     * rD : for the real array in a real <-> complex in-place transform. This includes the padding needed
            by the in-place transform. D is a sub-domain of this, and can be used to extract the real array,
            without padding.
     * reD, imD : Utility domains that access the real/complex parts of the complex array in a real<->complex in-place transform.
  */
  var D : domain(ndim);
  var rD,cD,reD,imD : domain(ndim,int,true);

  /* Read in the arrays from the file below. A,B are the arrays that will be used in the FFTW calls,
     goodA and goodB store the true values.

     Note that goodA is all real, allowing us to reuse the same array for the real<->complex tests.

     The file format is as follows (all little-endian):
        [ndim] int32 : dimensions of the array
        [narr] real64 : the real components of A (imaginary components are all zero). narr = N_1*N_2*..*N_ndim (product of dimensions)
        [narr] complex128 : the components of B (stored as real-imaginary pairs).

        The arrays are all stored in C (row-major) order.
  */
  var A,B,goodA,goodB : [D] complex(128);
  {
    var f = open(fn,iomode.r).reader(kind=iokind.little);
    // Read in dimensions
    for ii in 1..ndim {
      f.read(dims(ii));
    }
    /* The code below sets the domain D handling the different rank cases */
    select ndim {
      when 1 do D = 0.. #dims(1);
      when 2 do D = {0.. #dims(1), 0.. #dims(2)};
      when 3 do D = {0.. #dims(1), 0.. #dims(2), 0.. #dims(3)};
    }

    // Read in the arrays
    for val in goodA {
      f.read(val.re);
      val.im = 0;
    }
    for val in goodB {
      f.read(val);
    }
    f.close();
    writeln("Data read...");
  }

  /* Now set the remaining domains.

     The reader is referred to the FFTW documentation on the storage order for the in-place
     transforms (Sec 2.4 and 4.3.4).
  */
  select ndim {
    when 1 {
      var ldim = dims(1)/2 + 1;
      // Domains for real FFT
      rD = 0.. #(2*ldim); // Padding to do in place transforms
      cD = 0.. #ldim;
      // Define domains to extract the real and imaginary parts for inplace transforms
      reD = rD[0..(2*ldim-1) by 2];
      imD = rD[1..(2*ldim-1) by 2];
    }
    when 2 {
      // Domains for real FFT
      var ldim = dims(2)/2+1;
      rD = {0.. #dims(1),0.. #(2*ldim)}; // Padding to do in place transforms
      cD = {0.. #dims(1),0.. #ldim};
      // Define domains to extract the real and imaginary parts for in place transforms
      reD = rD[..,0..(2*ldim-1) by 2];
      imD = rD[..,1..(2*ldim-1) by 2];
    }
    when 3 {
      // Domains for real FFT
      var ldim = dims(3)/2+1;
      rD = {0.. #dims(1),0.. #dims(2),0.. #(2*ldim)}; // Padding to do in place transforms
      cD = {0.. #dims(1),0.. #dims(2),0.. #ldim};
      // Define domains to extract the real and imaginary parts for in place transforms
      reD = rD[..,..,0..(2*ldim-1) by 2];
      imD = rD[..,..,1..(2*ldim-1) by 2];
    }
  }

  // FFTW does not normalize inverse transform, so just compute the normalization constant.
  var norm = * reduce dims;

  /* We start the FFT tests below. The structure is the same :
      * Define plans for forward and reverse transforms.
      * Execute forward transform A -> B.
      * Compare with goodB.
      * Execute reverse transform B -> A and normalize.
      * Compare with goodA.
      * Cleanup plans
  */

  /* Complex <-> complex out-of-place transform.

     Unlike the basic FFTW interface, we do not have specific 1,2,3d planner routines.
     For the complex <-> complex case, the dimensions of the array are inferred automatically.

  */
	var fwd = plan_dft(A, B, FFTW_FORWARD, FFTW_ESTIMATE);
	var rev = plan_dft(B, A, FFTW_BACKWARD, FFTW_ESTIMATE);
	// Test forward and reverse transform
	A = goodA;
	execute(fwd);
	printcmp(B,goodB);
	execute(rev);
	A /= norm;
	printcmp(A,goodA);
	destroy_plan(fwd);
	destroy_plan(rev);

  /* Complex <-> complex in-place transform.

     This is the same calling sequence as above, with the input/output arrays the same.
  */
	fwd = plan_dft(A, A, FFTW_FORWARD, FFTW_ESTIMATE);
	rev = plan_dft(A, A, FFTW_BACKWARD, FFTW_ESTIMATE);
	// Test forward and reverse transform
	A = goodA;
	execute(fwd);
	printcmp(A,goodB);
	execute(rev);
	A /= norm; // FFTW does an unnormalized transform
	printcmp(A,goodA);
	destroy_plan(fwd);
	destroy_plan(rev);

  /* Real <-> complex out-of-place transform

     As with FFTW, these use an r2c and c2r suffix to define the direction of the transform.

     plan_dft_r2c/plan_dft_c2r are overloaded; for the out-of-place transforms, they infer the
     dimensions from the sizes of the arrays passed in.
  */
  var rA : [D] real(64); // No padding for an out-of place transform
  var cB : [cD] complex(128);
  fwd = plan_dft_r2c(rA,cB,FFTW_ESTIMATE);
  rev = plan_dft_c2r(cB,rA,FFTW_ESTIMATE);
  rA[D] = goodA.re;
  execute(fwd);
  printcmp(cB,goodB[cD]);
  execute(rev);
  rA /= norm;
  printcmp(rA[D],goodA.re);
  destroy_plan(fwd);
  destroy_plan(rev);

  /* Real <-> complex in-place transform

     In this case, the first argument to the planning routines is the domain of the *real*
     array WITHOUT padding (in both r2c and c2r cases). This breaks the ambiguity of whether the leading
     dimension of the real array is even or odd.

     This design decision was motivated by the fact that the user has likely already defined a
     domain to extract the unpadded real array from the fully padded array (or that such a domain
     is intrinsically useful).

     For both the r2c and c2r transforms, a real array is passed in.

  */
  var rA2 : [rD] real(64);
  fwd = plan_dft_r2c(D,rA2,FFTW_ESTIMATE);
  rev = plan_dft_c2r(D,rA2,FFTW_ESTIMATE);
  rA2[D] = goodA.re;
  execute(fwd);
  printcmp(rA2[reD],goodB[cD].re); // Check the real and complex parts separately.
  printcmp(rA2[imD],goodB[cD].im);
  execute(rev);
  rA2 /= norm;
  printcmp(rA2[D],goodA.re);
  destroy_plan(fwd);
  destroy_plan(rev);

}

// A helper function that calls all the tests.
proc testAllDims() {
  writeln("1D");
  runtest(1, "arr1d.dat");
  writeln("2D");
  runtest(2, "arr2d.dat");
  writeln("3D");
  runtest(3, "arr3d.dat");
}

// Do the tests and then cleanup.
proc main() {
  testAllDims();
  cleanup();
}

/*
Example usage of the FFTW module in Chapel. This particular file demonstrates the single-threaded version of
the code.

To compile this code :
   chpl testFFTW.chpl
If FFTW is not on your include/library paths, you can do
   chpl testFFTW.chpl -I$FFTW_DIR/include -L$FFTW_DIR/lib
where $FFTW_DIR points to your FFTW installation.

Note that you do not need to explicitly include the header or library files; the module uses an experimental
feature of the Chapel compiler to automatically include these.

The FFTW module uses the FFTW3 API, and currently just implements the basic interface.
We will assume that the reader is familiar with using FFTW; more
details are at http://www.fftw.org.

The code computes a series of 1,2 and 3D transforms, exercising the complex <-> complex, and real<->complex
transforms (both in and out of place). The output of the code should be a series of small numbers ( <= 10^-13);
see testFFTW.good for example values (it is possible that your values might differ).

The data for these tests is in arr{1,2,3}d.dat. The format of these files is documented below.
*/
use FFTW;

/* Utility function to print the maximum absolute deviation between values computed by this code,
   and "truth". The true values are computed using Mathematica v10 */
proc printcmp(x, y) {
  var err = max reduce abs(x-y);
  writeln(err);
}

/* This is main test code, parametrized on the number of dimensions ndim.
  fn is the file that contains the test data.
*/
proc runtest(param ndim : int, fn : string) {
  var dims : ndim*int(32);

  /* We define a number of different domains below, corresponding to complex input/output arrays,
     real (input) -> complex (output) out-of-place arrays, and real <-> complex in-place arrays.

     The domains are :
     * D : for complex <-> complex transforms. This domain is also used for the real array in
           a real->complex out-of-place transform.
     * cD : for the complex array in a real <-> complex out-of-place transform.
     * rD : for the real array in a real <-> complex in-place transform. This includes the padding needed
            by the in-place transform. D is a sub-domain of this, and can be used to extract the real array,
            without padding.
     * reD, imD : Utility domains that access the real/complex parts of the complex array in a real<->complex in-place transform.
  */
  var D : domain(ndim);
  var rD,cD,reD,imD : domain(ndim,int,true);

  /* Read in the arrays from the file below. A,B are the arrays that will be used in the FFTW calls,
     goodA and goodB store the true values.

     Note that goodA is all real, allowing us to reuse the same array for the real<->complex tests.

     The file format is as follows (all little-endian):
        [ndim] int32 : dimensions of the array
        [narr] real64 : the real components of A (imaginary components are all zero). narr = N_1*N_2*..*N_ndim (product of dimensions)
        [narr] complex128 : the components of B (stored as real-imaginary pairs).

        The arrays are all stored in C (row-major) order.
  */
  var A,B,goodA,goodB : [D] complex(128);
  {
    var f = open(fn,iomode.r).reader(kind=iokind.little);
    // Read in dimensions
    for ii in 1..ndim {
      f.read(dims(ii));
    }
    /* The code below sets the domain D handling the different rank cases */
    select ndim {
      when 1 do D = 0.. #dims(1);
      when 2 do D = {0.. #dims(1), 0.. #dims(2)};
      when 3 do D = {0.. #dims(1), 0.. #dims(2), 0.. #dims(3)};
    }

    // Read in the arrays
    for val in goodA {
      f.read(val.re);
      val.im = 0;
    }
    for val in goodB {
      f.read(val);
    }
    f.close();
    writeln("Data read...");
  }

  /* Now set the remaining domains.

     The reader is referred to the FFTW documentation on the storage order for the in-place
     transforms (Sec 2.4 and 4.3.4).
  */
  select ndim {
    when 1 {
      var ldim = dims(1)/2 + 1;
      // Domains for real FFT
      rD = 0.. #(2*ldim); // Padding to do in place transforms
      cD = 0.. #ldim;
      // Define domains to extract the real and imaginary parts for inplace transforms
      reD = rD[0..(2*ldim-1) by 2];
      imD = rD[1..(2*ldim-1) by 2];
    }
    when 2 {
      // Domains for real FFT
      var ldim = dims(2)/2+1;
      rD = {0.. #dims(1),0.. #(2*ldim)}; // Padding to do in place transforms
      cD = {0.. #dims(1),0.. #ldim};
      // Define domains to extract the real and imaginary parts for in place transforms
      reD = rD[..,0..(2*ldim-1) by 2];
      imD = rD[..,1..(2*ldim-1) by 2];
    }
    when 3 {
      // Domains for real FFT
      var ldim = dims(3)/2+1;
      rD = {0.. #dims(1),0.. #dims(2),0.. #(2*ldim)}; // Padding to do in place transforms
      cD = {0.. #dims(1),0.. #dims(2),0.. #ldim};
      // Define domains to extract the real and imaginary parts for in place transforms
      reD = rD[..,..,0..(2*ldim-1) by 2];
      imD = rD[..,..,1..(2*ldim-1) by 2];
    }
  }

  // FFTW does not normalize inverse transform, so just compute the normalization constant.
  var norm = * reduce dims;

  /* We start the FFT tests below. The structure is the same :
      * Define plans for forward and reverse transforms.
      * Execute forward transform A -> B.
      * Compare with goodB.
      * Execute reverse transform B -> A and normalize.
      * Compare with goodA.
      * Cleanup plans
  */

  /* Complex <-> complex out-of-place transform.

     Unlike the basic FFTW interface, we do not have specific 1,2,3d planner routines.
     For the complex <-> complex case, the dimensions of the array are inferred automatically.

  */
	var fwd = plan_dft(A, B, FFTW_FORWARD, FFTW_ESTIMATE);
	var rev = plan_dft(B, A, FFTW_BACKWARD, FFTW_ESTIMATE);
	// Test forward and reverse transform
	A = goodA;
	execute(fwd);
	printcmp(B,goodB);
	execute(rev);
	A /= norm;
	printcmp(A,goodA);
	destroy_plan(fwd);
	destroy_plan(rev);

  /* Complex <-> complex in-place transform.

     This is the same calling sequence as above, with the input/output arrays the same.
  */
	fwd = plan_dft(A, A, FFTW_FORWARD, FFTW_ESTIMATE);
	rev = plan_dft(A, A, FFTW_BACKWARD, FFTW_ESTIMATE);
	// Test forward and reverse transform
	A = goodA;
	execute(fwd);
	printcmp(A,goodB);
	execute(rev);
	A /= norm; // FFTW does an unnormalized transform
	printcmp(A,goodA);
	destroy_plan(fwd);
	destroy_plan(rev);

  /* Real <-> complex out-of-place transform

     As with FFTW, these use an r2c and c2r suffix to define the direction of the transform.

     plan_dft_r2c/plan_dft_c2r are overloaded; for the out-of-place transforms, they infer the
     dimensions from the sizes of the arrays passed in.
  */
  var rA : [D] real(64); // No padding for an out-of place transform
  var cB : [cD] complex(128);
  fwd = plan_dft_r2c(rA,cB,FFTW_ESTIMATE);
  rev = plan_dft_c2r(cB,rA,FFTW_ESTIMATE);
  rA[D] = goodA.re;
  execute(fwd);
  printcmp(cB,goodB[cD]);
  execute(rev);
  rA /= norm;
  printcmp(rA[D],goodA.re);
  destroy_plan(fwd);
  destroy_plan(rev);

  /* Real <-> complex in-place transform

     In this case, the first argument to the planning routines is the domain of the *real*
     array WITHOUT padding (in both r2c and c2r cases). This breaks the ambiguity of whether the leading
     dimension of the real array is even or odd.

     This design decision was motivated by the fact that the user has likely already defined a
     domain to extract the unpadded real array from the fully padded array (or that such a domain
     is intrinsically useful).

     For both the r2c and c2r transforms, a real array is passed in.

  */
  var rA2 : [rD] real(64);
  fwd = plan_dft_r2c(D,rA2,FFTW_ESTIMATE);
  rev = plan_dft_c2r(D,rA2,FFTW_ESTIMATE);
  rA2[D] = goodA.re;
  execute(fwd);
  printcmp(rA2[reD],goodB[cD].re); // Check the real and complex parts separately.
  printcmp(rA2[imD],goodB[cD].im);
  execute(rev);
  rA2 /= norm;
  printcmp(rA2[D],goodA.re);
  destroy_plan(fwd);
  destroy_plan(rev);

}

// A helper function that calls all the tests.
proc testAllDims() {
  writeln("1D");
  runtest(1, "arr1d.dat");
  writeln("2D");
  runtest(2, "arr2d.dat");
  writeln("3D");
  runtest(3, "arr3d.dat");
}

// Do the tests and then cleanup.
proc main() {
  testAllDims();
  cleanup();
}


Rewrote to pass array slices into butterfly -- and it still
works with no problems!!  (Thanks Steve!)

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

use Random;
use Timers;

// BLC: clean up complex arithmetic

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

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

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

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

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

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

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

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

  //  fillRandomVec(A);

  B = A;                       // save A for verification step

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

  A.imag = -A.imag;            // conjugate data

  var fftTimer: Timer;
  fftTimer.start();

  A = bitReverse(A);

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

  writeA(A);

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

  halt();

  A.real =  A.real / N;        // conjugate and scale data
  A.imag = -A.imag / N;

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

  var time = fftTimer.value;

  var maxerr = max reduce sqrt((B.real - A.real)**2 + (B.imag - A.imag)**2);

  maxerr = maxerr / logN / EPS;

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

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

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

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

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

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

  writeln("cft1st();");
  cft1st(A, W);

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

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

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

  const wk1r = W(1).real;

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

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

  writeln("  // computes first 8 complexes manually");

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

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

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

    k1 += 1;
  }
}

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

  writeA(A);

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

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

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

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

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

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

    k1 += 1;
  }
}

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

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

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

      k1 += 1;
    }

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

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

      k1 += 1;
    }
  }
}

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

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

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

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

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

    k1 += 1;
  }
}

def butterfly(wk1: complex, wk2: complex, wk3: complex,
              inout A:[1..4] complex) {
  var x0 = A[1] + A[2];
  var x1 = A[1] - A[2];
  var x2 = A[3] + A[4];
  var x3 = A[3] - A[4];
  writeln("    a=", A[1]:"{%g,%g}", ", b=", A[2]:"{%g,%g}", ", c=", A[3]:"{%g,%g}", ", d=", A[4]:"{%g,%g}");
  writeln("      wk1=", wk1:"%g + %gi");
  writeln("      wk2=", wk2:"%g + %gi");
  writeln("      wk3=", wk3:"%g + %gi");

  A[1] = x0 + x2;
  x0 -= x2;
  A[3] = wk2 * x0;
  x0 = (x1.real - x3.imag, x1.imag + x3.real):complex;
  A[2] = wk1 * x0;
  x0 = (x1.real + x3.imag, x1.imag - x3.real):complex;
  A[4] = wk3 * x0;
  writeln("    a=", A[1]:"{%g,%g}", ", b=", A[2]:"{%g,%g}", ", c=", A[3]:"{%g,%g}", ", d=", A[4]:"{%g,%g}\n");
}

use Random;
use Timers;

// BLC: clean up complex arithmetic

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

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

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

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

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

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

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

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

  //  fillRandomVec(A);

  B = A;                       // save A for verification step

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

  A.imag = -A.imag;            // conjugate data

  var fftTimer: Timer;
  fftTimer.start();

  A = bitReverse(A);

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

  writeA(A);

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

  halt();

  A.real =  A.real / N;        // conjugate and scale data
  A.imag = -A.imag / N;

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

  var time = fftTimer.value;

  var maxerr = max reduce sqrt((B.real - A.real)**2 + (B.imag - A.imag)**2);

  maxerr = maxerr / logN / EPS;

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

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

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

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

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

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

  writeln("cft1st();");
  cft1st(A, W);

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

  const n = AD(1).length;
  if ((l << 2) == n) {
    writeln("l << 2 == n");
    forall j in 0..l-1 {
      resetA(A);
      butterfly(1.0, 1.0, 1.0, A(j), A(j+l), A(j+2*l), A(j+3*l));
    }
  } else {
    writeln("l << 2 != n");
    forall j in 0..l-1 {
      var x0 = A(j).real;
      var x1 = A(j).imag;
      A(j).real = x0+x1;
      A(j).imag = x0-x1;
    }
  }
}

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

  const wk1r = W(1).real;

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

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

  writeln("  // computes first 8 complexes manually");

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

    resetA(A);
    butterfly(wk1, wk2, wk3, A(j), A(j+1), A(j+2), A(j+3));

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

    k1 += 1;
  }
}

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

  writeA(A);

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

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

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

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

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

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

    k1 += 1;
  }
}

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

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

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

      k1 += 1;
    }

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

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

      k1 += 1;
    }
  }
}

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

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

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

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

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

    k1 += 1;
  }
}

def butterfly(wk1: complex, wk2: complex, wk3: complex,
              inout a, inout b, inout c, inout d) {
  var x0 = a + b;
  var x1 = a - b;
  var x2 = c + d;
  var x3 = c - d;
  writeln("    a=", a:"{%g,%g}", ", b=", b:"{%g,%g}", ", c=", c:"{%g,%g}", ", d=", d:"{%g,%g}");
  writeln("      wk1=", wk1:"%g + %gi");
  writeln("      wk2=", wk2:"%g + %gi");
  writeln("      wk3=", wk3:"%g + %gi");

  a = x0 + x2;
  x0 -= x2;
  c = wk2 * x0;
  x0 = (x1.real - x3.imag, x1.imag + x3.real):complex;
  b = wk1 * x0;
  x0 = (x1.real + x3.imag, x1.imag - x3.real):complex;
  d = wk3 * x0;
  writeln("    a=", a:"{%g,%g}", ", b=", b:"{%g,%g}", ", c=", c:"{%g,%g}", ", d=", d:"{%g,%g}\n");
}


Remove extra space

Remove extra space

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

// ChapelIO.chpl
//
module ChapelIO {
  use ChapelBase; // for uint().
  use SysBasic;
  // use IO; happens below once we need it.

  proc _isNilObject(val) {
    proc helper(o: object) return o == nil;
    proc helper(o)         return false;
    return helper(val);
  }

  class Writer {
    proc writing param return true;
    // if it's binary, we don't decorate class/record fields and values
    proc binary():bool { return false; }
    // get other style elements
    proc styleElement(element:int):int { return 0; }

    proc error():syserr { return ENOERR; }
    proc setError(e:syserr) { }
    proc clearError() { }
    proc writePrimitive(x) {
      //compilerError("Generic Writer.writePrimitive called");
      halt("Generic Writer.writePrimitive called");
    }
    proc writeBytes(x, len:ssize_t) {
      halt("Generic Writer.writeBytes called");
    }
    proc writeIt(x:?t) {
      if _isIoPrimitiveTypeOrNewline(t) {
        writePrimitive(x);
      } else {
        if isClassType(t) {
          // FUTURE -- write the class name/ID?

          if x == nil {
            var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
            var iolit:ioLiteral;
            if st == QIO_AGGREGATE_FORMAT_JSON {
              iolit = new ioLiteral("null", !binary());
            } else {
              iolit = new ioLiteral("nil", !binary());
            }
            writePrimitive(iolit);
            return;
          }
        }

        x.writeThis(this);
      }
    }
    proc readwrite(x) {
      writeIt(x);
    }
    proc write(args ...?k) {
      for param i in 1..k {
        writeIt(args(i));
      }
    }
    proc writeln(args ...?k) {
      for param i in 1..k {
        writeIt(args(i));
      }
      var nl = new ioNewline();
      writeIt(nl);
    }
    proc writeln() {
      var nl = new ioNewline();
      writeIt(nl);
    }
    proc writeThisFieldsDefaultImpl(x:?t, inout first:bool) {
      param num_fields = __primitive("num fields", t);
      var isBinary = binary();

      if (isClassType(t)) {
        if t != object {
          // only write parent fields for subclasses of object
          // since object has no .super field.
          writeThisFieldsDefaultImpl(x.super, first);
        }
      }

      if !isUnionType(t) {
        // print out all fields for classes and records
        for param i in 1..num_fields {
          if !isBinary {
            var comma = new ioLiteral(", ");
            if !first then write(comma);

            var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
            var eq:ioLiteral;
            if st == QIO_AGGREGATE_FORMAT_JSON {
              eq = new ioLiteral(__primitive("field num to name", t, i) + " : ");
            } else {
              eq = new ioLiteral(__primitive("field num to name", t, i) + " = ");
            }
            write(eq);
          }

          write(__primitive("field value by num", x, i));

          first = false;
        }
      } else {
        // Handle unions.
        // print out just the set field for a union.
        var id = __primitive("get_union_id", x);
        for param i in 1..num_fields {
          if __primitive("field id by num", t, i) == id {
            if isBinary {
              // store the union ID
              write(id);
            } else {
              var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
              var eq:ioLiteral;
              if st == QIO_AGGREGATE_FORMAT_JSON {
                eq = new ioLiteral(__primitive("field num to name", t, i) + " : ");
              } else {
                eq = new ioLiteral(__primitive("field num to name", t, i) + " = ");
              }
              write(eq);
            }
            write(__primitive("field value by num", x, i));
          }
        }
      }
    }
    // Note; this is not a multi-method and so must be called
    // with the appropriate *concrete* type of x; that's what
    // happens now with buildDefaultWriteFunction
    // since it has the concrete type and then calls this method.

    // MPF: We would like to entirely write the default writeThis
    // method in Chapel, but that seems to be a bit of a challenge
    // right now and I'm having trouble with scoping/modules.
    // So I'll go back to writeThis being generated by the
    // compiler.... the writeThis generated by the compiler
    // calls writeThisDefaultImpl.
    proc writeThisDefaultImpl(x:?t) {
      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var start:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_JSON {
          start = new ioLiteral("{");
        } else if st == QIO_AGGREGATE_FORMAT_CHPL {
          start = new ioLiteral("new " + typeToString(t) + "(");
        } else {
          // the default 'braces' type
          if isClassType(t) {
            start = new ioLiteral("{");
          } else {
            start = new ioLiteral("(");
          }
        }
        write(start);
      }

      var first = true;

      writeThisFieldsDefaultImpl(x, first);

      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var end:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_JSON {
          end = new ioLiteral("}");
        } else if st == QIO_AGGREGATE_FORMAT_CHPL {
          end = new ioLiteral(")");
        } else {
          if isClassType(t) {
            end = new ioLiteral("}");
          } else {
            end = new ioLiteral(")");
          }
        }
        write(end);
      }
    }
  }

  class Reader {
    proc writing param return false;
    // if it's binary, we don't decorate class/record fields and values
    proc binary():bool { return false; }
    // get other style elements
    proc styleElement(element:int):int { return 0; }

    proc error():syserr { return ENOERR; }
    proc setError(e:syserr) { }
    proc clearError() { }

    proc readPrimitive(ref x:?t) where _isIoPrimitiveTypeOrNewline(t) {
      //compilerError("Generic Reader.readPrimitive called");
      halt("Generic Reader.readPrimitive called");
    }
    proc readBytes(x, len:ssize_t) {
      halt("Generic Reader.readBytes called");
    }
    proc readIt(x:?t) where isClassType(t) {
      // FUTURE -- write the class name/ID? or nil?
      // possibly in a different 'Reader'
      /*
      var iolit = new ioLiteral("nil", !binary());
      readPrimitive(iolit);
      if !(error()) {
        // Return nil.
        delete x;
        x = nil;
        return;
      } else {
        clearError();
      }*/
      x.readThis(this);
    }
    proc readIt(ref x:?t) where !isClassType(t) {
      if _isIoPrimitiveTypeOrNewline(t) {
        readPrimitive(x);
      } else {
        x.readThis(this);
      }
    }
    proc readwrite(ref x) {
      readIt(x);
    }
    proc read(ref args ...?k):bool {
      for param i in 1..k {
        readIt(args(i));
      }

      if error() == EEOF {
        clearError();
        return false;
      } else {
        return true;
      }
    }
    proc readln(ref args ...?k):bool {
      for param i in 1..k {
        readIt(args(i));
      }
      var nl = new ioNewline();
      readIt(nl);
      if error() == EEOF {
        clearError();
        return false;
      } else {
        return true;
      }
    }
    proc readln():bool {
      var nl = new ioNewline();
      readIt(nl);
      if error() == EEOF {
        clearError();
        return false;
      } else {
        return true;
      }
    }
    proc readThisFieldsDefaultImpl(type t, ref x, inout first:bool) {
      param num_fields = __primitive("num fields", t);
      var isBinary = binary();

      //writeln("Scanning fields for ", typeToString(t));

      if (isClassType(t)) {
        if t != object {
          // only write parent fields for subclasses of object
          // since object has no .super field.
          readThisFieldsDefaultImpl(x.super.type, x, first);
        }
      }

      if !isUnionType(t) {
        // read all fields for classes and records

        for param i in 1..num_fields {
          if !isBinary {
            var comma = new ioLiteral(",", true);
            if !first then readIt(comma);

            var fname = new ioLiteral(__primitive("field num to name", t, i), true);
            readIt(fname);

            var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
            var eq:ioLiteral;
            if st == QIO_AGGREGATE_FORMAT_JSON {
              eq = new ioLiteral(":", true);
            } else {
              eq = new ioLiteral("=", true);
            }
            readIt(eq);
          }

          readIt(__primitive("field value by num", x, i));

          first = false;
        }
      } else {
        // Handle unions.
        if isBinary {
          var id = __primitive("get_union_id", x);
          // Read the ID
          readIt(id);
          for param i in 1..num_fields {
            if __primitive("field id by num", t, i) == id {
              readIt(__primitive("field value by num", x, i));
            }
          }
        } else {
          // Read the field name = part until we get one that worked.
          for param i in 1..num_fields {
            var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
            var eq:ioLiteral;
            if st == QIO_AGGREGATE_FORMAT_JSON {
              eq = new ioLiteral(__primitive("field num to name", t, i) + " : ");
            } else {
              eq = new ioLiteral(__primitive("field num to name", t, i) + " = ");
            }

            readIt(eq);
            if error() == EFORMAT {
              clearError();
            } else {
              // We read the 'name = ', so now read the value!
              readIt(__primitive("field value by num", x, i));
            }
          }
        }
      }
    }
    // Note; this is not a multi-method and so must be called
    // with the appropriate *concrete* type of x; that's what
    // happens now with buildDefaultWriteFunction
    // since it has the concrete type and then calls this method.
    proc readThisDefaultImpl(x:?t) where isClassType(t) {
      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var start:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_CHPL {
          start = new ioLiteral("new " + typeToString(t) + "(");
        } else {
          // json and braces type
          start = new ioLiteral("{");
        }
        readIt(start);
      }

      var first = true;

      var obj = x; // make obj point to x so ref works
      readThisFieldsDefaultImpl(t, obj, first);

      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var end:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_CHPL {
          end = new ioLiteral(")");
        } else {
          // json and braces type
          end = new ioLiteral("}");
        }
        readIt(end);
      }
    }
    proc readThisDefaultImpl(ref x:?t) where !isClassType(t){
      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var start:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_CHPL {
          start = new ioLiteral("new " + typeToString(t) + "(");
        } else if st == QIO_AGGREGATE_FORMAT_JSON {
          start = new ioLiteral("{");
        } else {
          start = new ioLiteral("(");
        }
        readIt(start);
      }

      var first = true;

      readThisFieldsDefaultImpl(t, x, first);

      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var end:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_JSON {
          end = new ioLiteral("}");
        } else {
          end = new ioLiteral(")");
        }
        readIt(end);
      }
    }
  }

  inline proc <~>(w: Writer, x):Writer {
    w.readwrite(x);
    return w;
  }
  inline proc <~>(r: Reader, ref x):Reader {
    r.readwrite(x);
    return r;
  }

  use IO;

  // these are overridden to not be inout
  // since they don't change when read anyway
  // and it's much more convenient to be able to do e.g.
  //   reader & new ioLiteral("=")
  inline proc <~>(r: Reader, lit:ioLiteral):Reader {
    var litCopy = lit;
    r.readwrite(litCopy);
    return r;
  }
  inline proc <~>(r: Reader, nl:ioNewline):Reader {
    var nlCopy = nl;
    r.readwrite(nlCopy);
    return r;
  }

  inline proc Reader.readWriteLiteral(lit:string, ignoreWhiteSpace=true)
  {
    /***
    var iolit = new ioLiteral(lit.c_str(), ignoreWhiteSpace);
    this.readwrite(iolit);
    ***/
    this.readWriteLiteral(lit.c_str(), ignoreWhiteSpace);
  }
  inline proc Reader.readWriteLiteral(lit:c_string, ignoreWhiteSpace=true)
  {
    var iolit = new ioLiteral(lit, ignoreWhiteSpace);
    this.readwrite(iolit);
  }
  inline proc Writer.readWriteLiteral(lit:string, ignoreWhiteSpace=true)
  {
    /***
    var iolit = new ioLiteral(lit.c_str(), ignoreWhiteSpace);
    this.readwrite(iolit);
    ***/
    this.readWriteLiteral(lit.c_str(), ignoreWhiteSpace);
  }
  inline proc Writer.readWriteLiteral(lit:c_string, ignoreWhiteSpace=true)
  {
    var iolit = new ioLiteral(lit, ignoreWhiteSpace);
    this.readwrite(iolit);
  }
  inline proc Reader.readWriteNewline()
  {
    var ionl = new ioNewline();
    this.readwrite(ionl);
  }
  inline proc Writer.readWriteNewline()
  {
    var ionl = new ioNewline();
    this.readwrite(ionl);
  }

  proc assert(test: bool) {
    if !test then
      __primitive("chpl_error", "assert failed");
  }

  extern proc chpl_exit_any(status:int);

  proc assert(test: bool, args ...?numArgs) {
    if !test {
      var tmpstring: c_string;
      tmpstring.write((...args));
      __primitive("chpl_error", "assert failed - " + tmpstring);
    }
  }

  proc halt() {
    __primitive("chpl_error", "halt reached");
  }

  proc halt(s:string) {
    halt(s.c_str());
  }

  proc halt(s:c_string) {
    __primitive("chpl_error", "halt reached - " + s);
  }

  proc halt(args ...?numArgs) {
    var tmpstring: c_string;
    tmpstring.write((...args));
    __primitive("chpl_error", "halt reached - " + tmpstring);
  }

  proc warning(s:string) {
    warning(s.c_str());
  }

  proc warning(s:c_string) {
    __primitive("chpl_warning", s);
  }

  proc warning(args ...?numArgs) {
    var tmpstring: c_string_copy;
    tmpstring.write((...args));
    warning(tmpstring);
    chpl_free_c_string_copy(tmpstring);
  }

  proc _ddata.writeThis(f: Writer) {
    compilerWarning("printing _ddata class");
    write("<_ddata class cannot be printed>");
  }

  proc chpl_taskID_t.writeThis(f: Writer) {
    var tmp : uint(64) = this : uint(64);
    f.write(tmp);
  }
  proc chpl_taskID_t.readThis(f: Reader) {
    var tmp : uint(64);
    f.read(tmp);
    this = tmp : chpl_taskID_t;
  }

  class StringWriter: Writer {
    var s: c_string_copy; // Should be initialized to NULL.
    proc StringWriter(x:c_string) {
      this.s = __primitive("string_copy", x);
    }
    proc writePrimitive(x) {
      // TODO: Implement += so it consumes a c_string_copy LHS.
      var aug = x:c_string_copy;
      this.s += aug;      // The update frees this.s before overwriting it.
      chpl_free_c_string_copy(aug);
    }
    proc ~StringWriter() {
      chpl_free_c_string_copy(this.s);
      __primitive("=", this.s, _nullString);
    }
  }

  // Convert 'x' to a string just the way it would be written out.
  // Includes Writer.write, with modifications (for simplicity; to avoid 'on').
  proc _cast(type t, x) where t == c_string_copy {
    //proc isNilObject(o: object) return o == nil;
    //proc isNilObject(o) param return false;
    const w = new StringWriter();
    //if isNilObject(x) then "nil".writeThis(w);
    //else                   x.writeThis(w);
    w.write(x);
    const result = w.s;
    __primitive("=", w.s, _nullString);
    delete w;
    return result;
  }

  pragma "dont disable remote value forwarding"
  proc ref c_string.write(args ...?n) {
    var sc = new StringWriter(this);
    sc.write((...args));
    // We need to copy this string because the destructor call below frees it
    this = sc.s;
    // This is required to prevent double-deletion.
    __primitive("=", sc.s, _nullString);
    delete sc;
  }

  pragma "dont disable remote value forwarding"
  proc ref string.write(args ...?n) {
    var sc = new StringWriter(this.c_str());
    sc.write((...args));
    this = toString(sc.s);
    // This is required to prevent double-deletion.
    __primitive("=", sc.s, _nullString);
    delete sc;
  }

  // C can't handle overloaded declarations, so just don't prototype this one.
  pragma "no prototype"
  extern proc chpl_format(fmt: c_string, x): c_string_copy;

  proc format(fmt: c_string, x:?t) where isIntegralType(t) || isFloatType(t) {
    if fmt.substring(1) == "#" {
      var fmt2 = _getoutputformat(fmt);
      if isImagType(t) then
        return (chpl_format(fmt2, _i2r(x))+"i");
      else
        return chpl_format(fmt2, x:real);
    } else
        return chpl_format(fmt, x);
  }

  proc format(fmt: c_string, x:?t) where isComplexType(t) {
    if fmt.substring(1) == "#" {
      var fmt2 = _getoutputformat(fmt);
      return (chpl_format(fmt2, x.re)+" + "+ chpl_format(fmt2, x.im)+"i");
    } else
      return chpl_format(fmt, x);
  }

  proc format(fmt: c_string, x: ?t) {
    return chpl_format(fmt, x);
  }

  proc format(fmt: string, x: ?t) {
    return format(fmt.c_str(), x);
  }

  proc _getoutputformat(s: c_string):c_string {
    var sn = s.length;
    var afterdot = false;
    var dplaces = 0;
    for i in 1..sn {
      var ss = s.substring(i);
      if ((ss == '#') & afterdot) then dplaces += 1;
      if (ss == '.') then afterdot=true;
      chpl_free_c_string_copy(ss);
    }
    // FIX ME: leak c_string due to concatenation
    return("%" + sn + "." + dplaces + "f");
  }

  //
  // When this flag is used during compilation, calls to chpl__testPar
  // will output a message to indicate that a portion of the code has been
  // parallelized.
  //

  config param chpl__testParFlag = false;
  var chpl__testParOn = false;

  proc chpl__testParStart() {
    chpl__testParOn = true;
  }

  proc chpl__testParStop() {
    chpl__testParOn = false;
  }

  proc chpl__testPar(args...) {
    if chpl__testParFlag && chpl__testParOn {
      const file : c_string = __primitive("_get_user_file");
      const line = __primitive("_get_user_line");
      writeln("CHPL TEST PAR (", file, ":", line, "): ", (...args));
    }
  }

}