Simplify the implementation of homogeneous tuple operations

[reviewed by hilde]

Prior to this commit, we have been implementing all tuple operations (+,
-, *, etc.) on singleton tuples, pairs of tuples, and tuple-scalar pairs
using a recursive Lisp-y style of implementation approach.  While this
approach is reasonably elegant to write and very general with respect to
the tuple types, the code it generates is pretty ugly.  For example, a
tuple addition like this:

   var x: 3*real = (1.0, 2.0, 3.0);
   var y: 3*real = (4.0, 5.0, 6.0);

   var z = x + y;

ends up looking like this:

   call_tmp = (1.0 + 4.0);
   ret_to_arg_ref_tmp_ = &wrap_call_tmp;
   chpl__tupleRestHelper2(1.0, 2.0, 3.0, ret_to_arg_ref_tmp_);
   ret_to_arg_ref_tmp_2 = &wrap_call_tmp2;
   chpl__tupleRestHelper2(4.0, 5.0, 6.0, ret_to_arg_ref_tmp_2);
   call_tmp2 = *(wrap_call_tmp + INT64(0));
   call_tmp3 = *(wrap_call_tmp2 + INT64(0));
   call_tmp4 = (call_tmp2 + call_tmp3);
   call_tmp5 = *(wrap_call_tmp + INT64(0));
   call_tmp6 = *(wrap_call_tmp + INT64(1));
   ret_to_arg_ref_tmp_3 = &wrap_call_tmp3;
   chpl__tupleRestHelper(call_tmp5, call_tmp6, ret_to_arg_ref_tmp_3);
   call_tmp7 = *(wrap_call_tmp2 + INT64(0));
   call_tmp8 = *(wrap_call_tmp2 + INT64(1));
   ret_to_arg_ref_tmp_4 = &wrap_call_tmp4;
   chpl__tupleRestHelper(call_tmp7, call_tmp8, ret_to_arg_ref_tmp_4);
   call_tmp9 = *(wrap_call_tmp3 + INT64(0));
   call_tmp10 = *(wrap_call_tmp4 + INT64(0));
   call_tmp11 = (call_tmp9 + call_tmp10);
   *(z + INT64(0)) = call_tmp;
   *(z + INT64(1)) = call_tmp4;
   *(z + INT64(2)) = call_tmp11;

In wrestling through generated code idioms like this for homogeneous
tuples, I realized that there's no need to use the recursive approach
because it's straightforward to anticipate the result type required,
declare a variable for it, and fill the result using a param loop. This
results in much cleaner generated code, like this:

   call_tmp = (1.0 + 4.0);
   call_tmp2 = (2.0 + 5.0);
   call_tmp3 = (3.0 + 6.0);
   *(z + INT64(0)) = call_tmp;
   *(z + INT64(1)) = call_tmp2;
   *(z + INT64(2)) = call_tmp3;

The primary challenge to doing the similar thing for heterogeneous tuples
is that it's difficult to declare the result type using Chapel code today.
For homogeneous operations, we can say things like:

     var result: a.size*(a(1) + b(1)).type;

because we know that the type resulting from adding the 1st component will
apply to all the others as well.  But for a heterogeneous case, we can't
anticipate how many fields the tuple will have and don't have a way for
mapping or expanding type-based computations like this across tuples (at
least that I've been able to come up with so far).

So, in this commit, I provide specialized overloads of the operations for
the (common) cases when the tuple(s) are homogeneous and preserve the
original implementation for the fall-through case when one or both tuples
are heterogeneous.

Another minor change in this commit is to mark the inner function in
chpl__tupleRest() inline to make the generated code in that case
somewhat simpler.

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

// ChapelTuple.chpl
//
// tuple data implementation as a record
//
pragma "no use ChapelStandard"
module ChapelTuple {

  pragma "tuple" record _tuple {
    param size : int;
  }

  //
  // syntactic support for tuples
  //
  pragma "build tuple"
  inline proc _build_tuple(x...) {
      return x;
  }

  pragma "allow ref"
  pragma "build tuple"
  inline proc _build_tuple_always_allow_ref(x ...?size)
    return x;

  pragma "build tuple"
  inline proc _build_tuple(type t ...?size) type
    return t;

  pragma "build tuple"
  inline proc _build_tuple_always(x ...?size)
    return x;

  //
  // homogeneous tuple type syntax
  //
  proc *(param p: int, type t) type {
    var oneTuple: _build_tuple(t);
    proc _fill(param p: int, x: _tuple) {
      if x.size == p then
        return x;
      else if 2*x.size <= p then
        return _fill(p, ((...x), (...x)));
      else
        return _fill(p, ((...x), (..._fill(p-x.size, oneTuple))));
    }
    if p <= 0 then
      compilerError("tuple must have positive size");
    return _fill(p, oneTuple).type;
  }

  proc *(p: int, type t) type {
    compilerError("tuple size must be static");
  }

  // make it a tuple if it is not already
  inline proc chpl__tuplify(x) {
    if isTuple(x) then return x; else return (x,);
  }

  //
  // isTuple, isTupleType and isHomogeneousTuple param functions
  //
  proc isTuple(x: _tuple) param
    return true;

  proc isTuple(x) param
    return false;

  proc isHomogeneousTuple(x: _tuple) param
    return __primitive("is star tuple type", x);

  proc isTupleType(type t) param {
    const a: t;
    return isTuple(a);
  }

  //
  // tuple assignment
  //
  inline proc =(x: _tuple, y: _tuple) where x.size == y.size {
    for param i in 1..x.size do
      x(i) = y(i);
    return x;
  }

  //
  // homogeneous tuple accessor
  //
  proc _tuple.this(i : integral) var {
    if !isHomogeneousTuple(this) then
      compilerError("invalid access of non-homogeneous tuple by runtime value");
    if boundsChecking then
      if i < 1 || i > size then
        halt("tuple access out of bounds: ", i);
    return __primitive("get svec member", this, i);
  }

  config param CHPL_WARN_TUPLE_ITERATION = "unset";
  //
  // iterator support for tuples
  //
  iter _tuple.these() {

    if !isHomogeneousTuple(this) then
      compilerError("Cannot iterate over non-homogeneous tuples. If you intended to use zippered iteration, add the new keyword 'zip' before the tuple of iteratable expressions.");

    if CHPL_WARN_TUPLE_ITERATION == "true" then
      compilerWarning("Iterating over tuples. If you intended to use zippered iteration, add the new keyword 'zip' before the tuple of iteratable expressions.");

    for i in 1..this.size {
      yield(this(i));
    }
  }

  iter _tuple.these(param tag:iterKind)
      where tag == iterKind.leader
  {

    const numTasks = if dataParTasksPerLocale==0 then here.numCores
                     else dataParTasksPerLocale;
    const ignoreRunning = dataParIgnoreRunningTasks;
    const minIndicesPerTask = dataParMinGranularity;
    const length = this.size;
    const myRange = 1..#length;
    var (numChunks, _) = _computeChunkStuff(numTasks, ignoreRunning,
                                            minIndicesPerTask,
                                            (myRange,));

    if numChunks == 1 {
      yield myRange;
    } else {

      coforall chunk in 0..#numChunks {
        // _computeBlock assumes 0-based ranges
        const (lo,hi) = _computeBlock(length, numChunks, chunk, length-1);
        // adjust for 1-based indexing
        yield lo+1..hi+1;
      }
    }
  }

  iter _tuple.these(param tag:iterKind, followThis)
      where tag == iterKind.follower
  {
    for i in followThis do yield this(i);
  }

  //
  // tuple methods
  //
  proc _tuple.readWriteThis(f) {
    var st = f.styleElement(QIO_STYLE_ELEMENT_TUPLE);
    var start:ioLiteral;
    var comma:ioLiteral;
    var end:ioLiteral;
    var binary = f.binary();

    if st == QIO_TUPLE_FORMAT_SPACE {
      start = new ioLiteral("");
      comma = new ioLiteral(" ");
      end = new ioLiteral("");
    } else if st == QIO_TUPLE_FORMAT_JSON {
      start = new ioLiteral("[");
      comma = new ioLiteral(", ");
      end = new ioLiteral("]");
    } else {
      start = new ioLiteral("(");
      comma = new ioLiteral(", ");
      end = new ioLiteral(")");
    }

    if !binary {
      f <~> start;
    }
    if size != 0 {
      f <~> this(1);
      for param i in 2..size {
        if !binary {
          f <~> comma;
        }
        f <~> this(i);
      }
    }
    if !binary {
      f <~> end;
    }
  }

  //
  // tuple casts to complex(64) and complex(128)
  //
  inline proc _cast(type t, x: (?,?)) where t == complex(64) {
    var c: complex(64);
    c.re = x(1):real(32);
    c.im = x(2):real(32);
    return c;
  }

  inline proc _cast(type t, x: (?,?)) where t == complex(128) {
    var c: complex(128);
    c.re = x(1):real(64);
    c.im = x(2):real(64);
    return c;
  }

  //
  // helper function to return a tuple of all of the components in a
  // tuple except the first
  //
  inline proc chpl__tupleRest(t: _tuple) {
    inline proc chpl__tupleRestHelper(first, rest...)
      return rest;
    return chpl__tupleRestHelper((...t));
  }

  //
  // standard overloaded unary operators on tuples.  Each pair first
  // handles the homogenous case...
  //
  inline proc +(a: _tuple) where isHomogeneousTuple(a) {
    var result: a.type;
    for param d in 1..a.size do
      result(d) = +a(d);
    return result;
  }

  //
  // ...and then the heterogeneous case.
  //
  inline proc +(a: _tuple) {
    if a.size == 1 then
      return (+a(1), );
    else
      return (+a(1), (...+chpl__tupleRest(a)));
  }

  inline proc -(a: _tuple) where isHomogeneousTuple(a) {
    var result: a.type;
    for param d in 1..a.size do
      result(d) = -a(d);
    return result;
  }

  inline proc -(a: _tuple) {
    if a.size == 1 then
      return (-a(1), );
    else
      return (-a(1), (...-chpl__tupleRest(a)));
  }

  inline proc ~(a: _tuple) where isHomogeneousTuple(a) {
    var result: a.type;
    for param d in 1..a.size do
      result(d) = ~a(d);
    return result;
  }

  inline proc ~(a: _tuple) {
    if a.size == 1 then
      return (~a(1),);
    else
      return (~a(1), (...~chpl__tupleRest(a)));
  }

  inline proc !(a: _tuple) where isHomogeneousTuple(a) {
    var result: a.type;
    for param d in 1..a.size do
      result(d) = !a(d);
    return result;
  }

  inline proc !(a: _tuple) {
    if a.size == 1 then
      return (!a(1),);
    else
      return (!a(1), (...!chpl__tupleRest(a)));
  }

  //
  // Return a tuple of type t with all values set to the max/min for that type
  //
  proc max(type t): t where isTupleType(t) {
    var result: t;
    for param i in 1..result.size {
      result(i) = max(t(i));
    }
    return result;
  }

  proc min(type t): t where isTupleType(t) {
    var result: t;
    for param i in 1..result.size {
      result(i) = min(t(i));
    }
    return result;
  }

  proc chpl_TwoHomogTuples(t1, t2) param {
    return isHomogeneousTuple(t1) && isHomogeneousTuple(t2);
  }

  //
  // standard overloaded binary operators on tuples.  Each pair starts
  // with a case optimized for homogeneous tuples (because the result
  // type is easy to express)...
  inline proc +(a: _tuple, b: _tuple) where chpl_TwoHomogTuples(a,b) {
    if a.size != b.size then
      compilerError("tuple operands to + have different sizes");

    var result: a.size*(a(1) + b(1)).type;
    for param d in 1..a.size do
      result(d) = a(d) + b(d);

    return result;
  }

  // ...followed by a more complicated/general case for heterogeneous
  // tuples because the result type is more complex to describe.
  //
  inline proc +(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to + have different sizes");
    if a.size == 1 then
      return (a(1)+b(1),);
    else
      return (a(1)+b(1), (...chpl__tupleRest(a)+chpl__tupleRest(b)));
  }

  inline proc -(a: _tuple, b: _tuple) where chpl_TwoHomogTuples(a,b) {
    if a.size != b.size then
      compilerError("tuple operands to - have different sizes");

    var result: a.size*(a(1) - b(1)).type;
    for param d in 1..a.size do
      result(d) = a(d) - b(d);

    return result;
  }

  inline proc -(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to - have different sizes");
    if a.size == 1 then
      return (a(1)-b(1),);
    else
      return (a(1)-b(1), (...chpl__tupleRest(a)-chpl__tupleRest(b)));
  }

  inline proc *(a: _tuple, b: _tuple) where chpl_TwoHomogTuples(a,b) {
    if a.size != b.size then
      compilerError("tuple operands to * have different sizes");

    var result: a.size*(a(1) * b(1)).type;
    for param d in 1..a.size do
      result(d) = a(d) * b(d);

    return result;
  }

  inline proc *(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to * have different sizes");
    if a.size == 1 then
      return (a(1)*b(1),);
    else
      return (a(1)*b(1), (...chpl__tupleRest(a)*chpl__tupleRest(b)));
  }

  inline proc /(a: _tuple, b: _tuple) where chpl_TwoHomogTuples(a,b) {
    if a.size != b.size then
      compilerError("tuple operands to / have different sizes");

    var result: a.size*(a(1) / b(1)).type;
    for param d in 1..a.size do
      result(d) = a(d) / b(d);

    return result;
  }

  inline proc /(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to / have different sizes");
    if a.size == 1 then
      return (a(1)/b(1),);
    else
      return (a(1)/b(1), (...chpl__tupleRest(a)/chpl__tupleRest(b)));
  }

  inline proc %(a: _tuple, b: _tuple) where chpl_TwoHomogTuples(a,b) {
    if a.size != b.size then
      compilerError("tuple operands to % have different sizes");

    var result: a.size*(a(1) % b(1)).type;
    for param d in 1..a.size do
      result(d) = a(d) % b(d);

    return result;
  }

  inline proc %(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to % have different sizes");
    if a.size == 1 then
      return (a(1)%b(1),);
    else
      return (a(1)%b(1), (...chpl__tupleRest(a)%chpl__tupleRest(b)));
  }

  inline proc **(a: _tuple, b: _tuple) where chpl_TwoHomogTuples(a,b) {
    if a.size != b.size then
      compilerError("tuple operands to ** have different sizes");

    var result: a.size*(a(1) ** b(1)).type;
    for param d in 1..a.size do
      result(d) = a(d) ** b(d);

    return result;
  }

  inline proc **(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to ** have different sizes");
    if a.size == 1 then
      return (a(1)**b(1),);
    else
      return (a(1)**b(1), (...chpl__tupleRest(a)**chpl__tupleRest(b)));
  }

  inline proc &(a: _tuple, b: _tuple) where chpl_TwoHomogTuples(a,b) {
    if a.size != b.size then
      compilerError("tuple operands to & have different sizes");

    var result: a.size*(a(1) & b(1)).type;
    for param d in 1..a.size do
      result(d) = a(d) & b(d);

    return result;
  }

  inline proc &(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to & have different sizes");
    if a.size == 1 then
      return (a(1)&b(1),);
    else
      return (a(1)&b(1), (...chpl__tupleRest(a)&chpl__tupleRest(b)));
  }

  inline proc |(a: _tuple, b: _tuple) where chpl_TwoHomogTuples(a,b) {
    if a.size != b.size then
      compilerError("tuple operands to | have different sizes");

    var result: a.size*(a(1) | b(1)).type;
    for param d in 1..a.size do
      result(d) = a(d) | b(d);

    return result;
  }

  inline proc |(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to | have different sizes");
    if a.size == 1 then
      return (a(1)|b(1),);
    else
      return (a(1)|b(1), (...chpl__tupleRest(a)|chpl__tupleRest(b)));
  }

  inline proc ^(a: _tuple, b: _tuple) where chpl_TwoHomogTuples(a,b) {
    if a.size != b.size then
      compilerError("tuple operands to ^ have different sizes");

    var result: a.size*(a(1) ^ b(1)).type;
    for param d in 1..a.size do
      result(d) = a(d) ^ b(d);

    return result;
  }

  inline proc ^(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to ^ have different sizes");
    if a.size == 1 then
      return (a(1)^b(1),);
    else
      return (a(1)^b(1), (...chpl__tupleRest(a)^chpl__tupleRest(b)));
  }

  inline proc <<(a: _tuple, b: _tuple) where chpl_TwoHomogTuples(a,b) {
    if a.size != b.size then
      compilerError("tuple operands to << have different sizes");

    var result: a.size*(a(1) << b(1)).type;
    for param d in 1..a.size do
      result(d) = a(d) << b(d);

    return result;
  }

  inline proc <<(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to << have different sizes");
    if a.size == 1 then
      return (a(1)<<b(1),);
    else
      return (a(1)<<b(1), (...chpl__tupleRest(a)<<chpl__tupleRest(b)));
  }

  inline proc >>(a: _tuple, b: _tuple) where chpl_TwoHomogTuples(a,b) {
    if a.size != b.size then
      compilerError("tuple operands to >> have different sizes");

    var result: a.size*(a(1) >> b(1)).type;
    for param d in 1..a.size do
      result(d) = a(d) >> b(d);

    return result;
  }

  inline proc >>(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to >> have different sizes");
    if a.size == 1 then
      return (a(1)>>b(1),);
    else
      return (a(1)>>b(1), (...chpl__tupleRest(a)>>chpl__tupleRest(b)));
  }

  //
  // standard overloaded relational operators on tuples
  //
  inline proc >(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to > have different sizes");
    for param i in 1..a.size do
      if a(i) > b(i) then
        return true;
      else if a(i) < b(i) then
        return false;
    return false;
  }

  inline proc >=(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to >= have different sizes");
    for param i in 1..a.size do
      if a(i) > b(i) then
        return true;
      else if a(i) < b(i) then
        return false;
    return true;
  }

  inline proc <(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to < have different sizes");
    for param i in 1..a.size do
      if a(i) < b(i) then
        return true;
      else if a(i) > b(i) then
        return false;
    return false;
  }

  inline proc <=(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to <= have different sizes");
    for param i in 1..a.size do
      if a(i) < b(i) then
        return true;
      else if a(i) > b(i) then
        return false;
    return true;
  }

  inline proc ==(a: _tuple, b: _tuple) {
    if a.size != b.size then
      return false;
    for param i in 1..a.size do
      if a(i) != b(i) then
        return false;
    return true;
  }

  inline proc !=(a: _tuple, b: _tuple) {
    if a.size != b.size then
      return true;
    for param i in 1..a.size do
      if a(i) != b(i) then
        return true;
    return false;
  }

  //
  // standard overloaded binary operators on homog tuple / scalar
  // pairs.
  //
  inline proc +(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    var result: x.size * x(1).type;
    for param d in 1..x.size do
      result(d) = x(d) + y;
    return result;
  }

  inline proc +(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    var result: y.size * y(1).type;
    for param d in 1..y.size do
      result(d) = x + y(d);
    return result;
  }

  inline proc -(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    var result: x.size * x(1).type;
    for param d in 1..x.size do
      result(d) = x(d) - y;
    return result;
  }

  inline proc -(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    var result: y.size * y(1).type;
    for param d in 1..y.size do
      result(d) = x - y(d);
    return result;
  }

  inline proc *(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    var result: x.size * x(1).type;
    for param d in 1..x.size do
      result(d) = x(d) * y;
    return result;
  }

  inline proc *(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       x: (y(1).type)  {
    var result: y.size * y(1).type;
    for param d in 1..y.size do
      result(d) = x * y(d);
    return result;
  }

  inline proc /(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    var result: x.size * x(1).type;
    for param d in 1..x.size do
      result(d) = x(d) / y;
    return result;
  }

  inline proc /(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    var result: y.size * y(1).type;
    for param d in 1..y.size do
      result(d) = x / y(d);
    return result;
  }

  inline proc %(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    var result: x.size * x(1).type;
    for param d in 1..x.size do
      result(d) = x(d) % y;
    return result;
  }

  inline proc %(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    var result: y.size * y(1).type;
    for param d in 1..y.size do
      result(d) = x % y(d);
    return result;
  }

  inline proc **(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    var result: x.size * x(1).type;
    for param d in 1..x.size do
      result(d) = x(d) ** y;
    return result;
  }

  inline proc **(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    var result: y.size * y(1).type;
    for param d in 1..y.size do
      result(d) = x ** y(d);
    return result;
  }

  inline proc &(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    var result: x.size * x(1).type;
    for param d in 1..x.size do
      result(d) = x(d) & y;
    return result;
  }

  inline proc &(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    var result: y.size * y(1).type;
    for param d in 1..y.size do
      result(d) = x & y(d);
    return result;
  }

  inline proc |(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    var result: x.size * x(1).type;
    for param d in 1..x.size do
      result(d) = x(d) | y;
    return result;
  }

  inline proc |(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    var result: y.size * y(1).type;
    for param d in 1..y.size do
      result(d) = x | y(d);
    return result;
  }

  inline proc ^(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    var result: x.size * x(1).type;
    for param d in 1..x.size do
      result(d) = x(d) ^ y;
    return result;
  }

  inline proc ^(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    var result: y.size * y(1).type;
    for param d in 1..y.size do
      result(d) = x ^ y(d);
    return result;
  }

  inline proc <<(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    var result: x.size * x(1).type;
    for param d in 1..x.size do
      result(d) = x(d) << y;
    return result;
  }

  inline proc <<(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    var result: y.size * y(1).type;
    for param d in 1..y.size do
      result(d) = x << y(d);
    return result;
  }

  inline proc >>(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    var result: x.size * x(1).type;
    for param d in 1..x.size do
      result(d) = x(d) >> y;
    return result;
  }

  inline proc >>(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    var result: y.size * y(1).type;
    for param d in 1..y.size do
      result(d) = x >> y(d);
    return result;
  }

}

// ChapelTuple.chpl
//
// tuple data implementation as a record
//
pragma "no use ChapelStandard"
module ChapelTuple {

  pragma "tuple" record _tuple {
    param size : int;
  }

  //
  // syntactic support for tuples
  //
  pragma "build tuple"
  inline proc _build_tuple(x...) {
      return x;
  }

  pragma "allow ref"
  pragma "build tuple"
  inline proc _build_tuple_always_allow_ref(x ...?size)
    return x;

  pragma "build tuple"
  inline proc _build_tuple(type t ...?size) type
    return t;

  pragma "build tuple"
  inline proc _build_tuple_always(x ...?size)
    return x;

  //
  // homogeneous tuple type syntax
  //
  proc *(param p: int, type t) type {
    var oneTuple: _build_tuple(t);
    proc _fill(param p: int, x: _tuple) {
      if x.size == p then
        return x;
      else if 2*x.size <= p then
        return _fill(p, ((...x), (...x)));
      else
        return _fill(p, ((...x), (..._fill(p-x.size, oneTuple))));
    }
    if p <= 0 then
      compilerError("tuple must have positive size");
    return _fill(p, oneTuple).type;
  }

  proc *(p: int, type t) type {
    compilerError("tuple size must be static");
  }

  // make it a tuple if it is not already
  inline proc chpl__tuplify(x) {
    if isTuple(x) then return x; else return (x,);
  }

  //
  // isTuple, isTupleType and isHomogeneousTuple param functions
  //
  proc isTuple(x: _tuple) param
    return true;

  proc isTuple(x) param
    return false;

  proc isHomogeneousTuple(x: _tuple) param
    return __primitive("is star tuple type", x);

  proc isTupleType(type t) param {
    const a: t;
    return isTuple(a);
  }

  //
  // tuple assignment
  //
  inline proc =(x: _tuple, y: _tuple) where x.size == y.size {
    for param i in 1..x.size do
      x(i) = y(i);
    return x;
  }

  //
  // homogeneous tuple accessor
  //
  proc _tuple.this(i : integral) var {
    if !isHomogeneousTuple(this) then
      compilerError("invalid access of non-homogeneous tuple by runtime value");
    if boundsChecking then
      if i < 1 || i > size then
        halt("tuple access out of bounds: ", i);
    return __primitive("get svec member", this, i);
  }

  config param CHPL_WARN_TUPLE_ITERATION = "unset";
  //
  // iterator support for tuples
  //
  iter _tuple.these() {

    if !isHomogeneousTuple(this) then
      compilerError("Cannot iterate over non-homogeneous tuples. If you intended to use zippered iteration, add the new keyword 'zip' before the tuple of iteratable expressions.");

    if CHPL_WARN_TUPLE_ITERATION == "true" then
      compilerWarning("Iterating over tuples. If you intended to use zippered iteration, add the new keyword 'zip' before the tuple of iteratable expressions.");

    for i in 1..this.size {
      yield(this(i));
    }
  }

  iter _tuple.these(param tag:iterKind)
      where tag == iterKind.leader
  {

    const numTasks = if dataParTasksPerLocale==0 then here.numCores
                     else dataParTasksPerLocale;
    const ignoreRunning = dataParIgnoreRunningTasks;
    const minIndicesPerTask = dataParMinGranularity;
    const length = this.size;
    const myRange = 1..#length;
    var (numChunks, _) = _computeChunkStuff(numTasks, ignoreRunning,
                                            minIndicesPerTask,
                                            (myRange,));

    if numChunks == 1 {
      yield myRange;
    } else {

      coforall chunk in 0..#numChunks {
        // _computeBlock assumes 0-based ranges
        const (lo,hi) = _computeBlock(length, numChunks, chunk, length-1);
        // adjust for 1-based indexing
        yield lo+1..hi+1;
      }
    }
  }

  iter _tuple.these(param tag:iterKind, followThis)
      where tag == iterKind.follower
  {
    for i in followThis do yield this(i);
  }

  //
  // tuple methods
  //
  proc _tuple.readWriteThis(f) {
    var st = f.styleElement(QIO_STYLE_ELEMENT_TUPLE);
    var start:ioLiteral;
    var comma:ioLiteral;
    var end:ioLiteral;
    var binary = f.binary();

    if st == QIO_TUPLE_FORMAT_SPACE {
      start = new ioLiteral("");
      comma = new ioLiteral(" ");
      end = new ioLiteral("");
    } else if st == QIO_TUPLE_FORMAT_JSON {
      start = new ioLiteral("[");
      comma = new ioLiteral(", ");
      end = new ioLiteral("]");
    } else {
      start = new ioLiteral("(");
      comma = new ioLiteral(", ");
      end = new ioLiteral(")");
    }

    if !binary {
      f <~> start;
    }
    if size != 0 {
      f <~> this(1);
      for param i in 2..size {
        if !binary {
          f <~> comma;
        }
        f <~> this(i);
      }
    }
    if !binary {
      f <~> end;
    }
  }

  //
  // tuple casts to complex(64) and complex(128)
  //
  inline proc _cast(type t, x: (?,?)) where t == complex(64) {
    var c: complex(64);
    c.re = x(1):real(32);
    c.im = x(2):real(32);
    return c;
  }

  inline proc _cast(type t, x: (?,?)) where t == complex(128) {
    var c: complex(128);
    c.re = x(1):real(64);
    c.im = x(2):real(64);
    return c;
  }

  //
  // helper function to return a tuple of all of the components in a
  // tuple except the first
  //
  inline proc chpl__tupleRest(t: _tuple) {
    proc chpl__tupleRestHelper(first, rest...)
      return rest;
    return chpl__tupleRestHelper((...t));
  }

  //
  // standard overloaded unary operators on tuples
  //
  inline proc +(a: _tuple) {
    if a.size == 1 then
      return (+a(1), );
    else
      return (+a(1), (...+chpl__tupleRest(a)));
  }

  inline proc -(a: _tuple) {
    if a.size == 1 then
      return (-a(1),);
    else
      return (-a(1), (...-chpl__tupleRest(a)));
  }

  inline proc ~(a: _tuple) {
    if a.size == 1 then
      return (~a(1),);
    else
      return (~a(1), (...~chpl__tupleRest(a)));
  }

  inline proc !(a: _tuple) {
    if a.size == 1 then
      return (!a(1),);
    else
      return (!a(1), (...!chpl__tupleRest(a)));
  }

  //
  // Return a tuple of type t with all values set to the max/min for that type
  //
  proc max(type t): t where isTupleType(t) {
    var result: t;
    for param i in 1..result.size {
      result(i) = max(t(i));
    }
    return result;
  }

  proc min(type t): t where isTupleType(t) {
    var result: t;
    for param i in 1..result.size {
      result(i) = min(t(i));
    }
    return result;
  }

  //
  // standard overloaded binary operators on tuples
  //
  inline proc +(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to + have different sizes");
    if a.size == 1 then
      return (a(1)+b(1),);
    else
      return (a(1)+b(1), (...chpl__tupleRest(a)+chpl__tupleRest(b)));
  }

  inline proc -(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to - have different sizes");
    if a.size == 1 then
      return (a(1)-b(1),);
    else
      return (a(1)-b(1), (...chpl__tupleRest(a)-chpl__tupleRest(b)));
  }

  inline proc *(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to * have different sizes");
    if a.size == 1 then
      return (a(1)*b(1),);
    else
      return (a(1)*b(1), (...chpl__tupleRest(a)*chpl__tupleRest(b)));
  }

  inline proc /(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to / have different sizes");
    if a.size == 1 then
      return (a(1)/b(1),);
    else
      return (a(1)/b(1), (...chpl__tupleRest(a)/chpl__tupleRest(b)));
  }

  inline proc %(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to % have different sizes");
    if a.size == 1 then
      return (a(1)%b(1),);
    else
      return (a(1)%b(1), (...chpl__tupleRest(a)%chpl__tupleRest(b)));
  }

  inline proc **(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to ** have different sizes");
    if a.size == 1 then
      return (a(1)**b(1),);
    else
      return (a(1)**b(1), (...chpl__tupleRest(a)**chpl__tupleRest(b)));
  }

  inline proc &(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to & have different sizes");
    if a.size == 1 then
      return (a(1)&b(1),);
    else
      return (a(1)&b(1), (...chpl__tupleRest(a)&chpl__tupleRest(b)));
  }

  inline proc |(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to | have different sizes");
    if a.size == 1 then
      return (a(1)|b(1),);
    else
      return (a(1)|b(1), (...chpl__tupleRest(a)|chpl__tupleRest(b)));
  }

  inline proc ^(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to ^ have different sizes");
    if a.size == 1 then
      return (a(1)^b(1),);
    else
      return (a(1)^b(1), (...chpl__tupleRest(a)^chpl__tupleRest(b)));
  }

  inline proc <<(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to << have different sizes");
    if a.size == 1 then
      return (a(1)<<b(1),);
    else
      return (a(1)<<b(1), (...chpl__tupleRest(a)<<chpl__tupleRest(b)));
  }

  inline proc >>(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to >> have different sizes");
    if a.size == 1 then
      return (a(1)>>b(1),);
    else
      return (a(1)>>b(1), (...chpl__tupleRest(a)>>chpl__tupleRest(b)));
  }

  //
  // standard overloaded relational operators on tuples
  //
  inline proc >(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to > have different sizes");
    for param i in 1..a.size do
      if a(i) > b(i) then
        return true;
      else if a(i) < b(i) then
        return false;
    return false;
  }

  inline proc >=(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to >= have different sizes");
    for param i in 1..a.size do
      if a(i) > b(i) then
        return true;
      else if a(i) < b(i) then
        return false;
    return true;
  }

  inline proc <(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to < have different sizes");
    for param i in 1..a.size do
      if a(i) < b(i) then
        return true;
      else if a(i) > b(i) then
        return false;
    return false;
  }

  inline proc <=(a: _tuple, b: _tuple) {
    if a.size != b.size then
      compilerError("tuple operands to <= have different sizes");
    for param i in 1..a.size do
      if a(i) < b(i) then
        return true;
      else if a(i) > b(i) then
        return false;
    return true;
  }

  inline proc ==(a: _tuple, b: _tuple) {
    if a.size != b.size then
      return false;
    for param i in 1..a.size do
      if a(i) != b(i) then
        return false;
    return true;
  }

  inline proc !=(a: _tuple, b: _tuple) {
    if a.size != b.size then
      return true;
    for param i in 1..a.size do
      if a(i) != b(i) then
        return true;
    return false;
  }

  // standard overloaded binary operators on homog tuple / scalar pairs

  inline proc +(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    if x.size == 1 then
      return (x(1)+y,);
    else
      return (x(1)+y, (...chpl__tupleRest(x)+y));
  }

  inline proc +(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    if y.size == 1 then
      return (x+y(1),);
    else
      return (x+y(1), (...x+chpl__tupleRest(y)));
  }

  inline proc -(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    if x.size == 1 then
      return (x(1)-y,);
    else
      return (x(1)-y, (...chpl__tupleRest(x)-y));
  }

  inline proc -(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    if y.size == 1 then
      return (x-y(1),);
    else
      return (x-y(1), (...x-chpl__tupleRest(y)));
  }

  inline proc *(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    if x.size == 1 then
      return (x(1)*y,);
    else
      return (x(1)*y, (...chpl__tupleRest(x)*y));
  }

  inline proc *(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       x: (y(1).type)  {
    if y.size == 1 then
      return (x*y(1),);
    else
      return (x*y(1), (...x*chpl__tupleRest(y)));
  }

  inline proc /(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    if x.size == 1 then
      return (x(1)/y,);
    else
      return (x(1)/y, (...chpl__tupleRest(x)/y));
  }

  inline proc /(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    if y.size == 1 then
      return (x/y(1),);
    else
      return (x/y(1), (...x/chpl__tupleRest(y)));
  }

  inline proc %(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    if x.size == 1 then
      return (x(1)%y,);
    else
      return (x(1)%y, (...chpl__tupleRest(x)%y));
  }

  inline proc %(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    if y.size == 1 then
      return (x%y(1),);
    else
      return (x%y(1), (...x%chpl__tupleRest(y)));
  }

  inline proc **(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    if x.size == 1 then
      return (x(1)**y,);
    else
      return (x(1)**y, (...chpl__tupleRest(x)**y));
  }

  inline proc **(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    if y.size == 1 then
      return (x**y(1),);
    else
      return (x**y(1), (...x**chpl__tupleRest(y)));
  }

  inline proc &(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    if x.size == 1 then
      return (x(1)&y,);
    else
      return (x(1)&y, (...chpl__tupleRest(x)&y));
  }

  inline proc &(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    if y.size == 1 then
      return (x&y(1),);
    else
      return (x&y(1), (...x&chpl__tupleRest(y)));
  }

  inline proc |(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    if x.size == 1 then
      return (x(1)|y,);
    else
      return (x(1)|y, (...chpl__tupleRest(x)|y));
  }

  inline proc |(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    if y.size == 1 then
      return (x|y(1),);
    else
      return (x|y(1), (...x|chpl__tupleRest(y)));
  }

  inline proc ^(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    if x.size == 1 then
      return (x(1)^y,);
    else
      return (x(1)^y, (...chpl__tupleRest(x)^y));
  }

  inline proc ^(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    if y.size == 1 then
      return (x^y(1),);
    else
      return (x^y(1), (...x^chpl__tupleRest(y)));
  }

  inline proc <<(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    if x.size == 1 then
      return (x(1)<<y,);
    else
      return (x(1)<<y, (...chpl__tupleRest(x)<<y));
  }

  inline proc <<(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    if y.size == 1 then
      return (x<<y(1),);
    else
      return (x<<y(1), (...x<<chpl__tupleRest(y)));
  }

  inline proc >>(x: _tuple, y: x(1).type) where isHomogeneousTuple(x) {
    if x.size == 1 then
      return (x(1)>>y,);
    else
      return (x(1)>>y, (...chpl__tupleRest(x)>>y));
  }

  inline proc >>(x: ?t, y: _tuple) where isHomogeneousTuple(y) &&
                                       t: (y(1).type)  {
    if y.size == 1 then
      return (x>>y(1),);
    else
      return (x>>y(1), (...x>>chpl__tupleRest(y)));
  }

}


Applying similar formatting to this as the others

SOmehow I missed it on the first pass.

/* nbody_rangesub + explicit reductions
 *
 * The Great Computer Language Shootout
 * http://shootout.alioth.debian.org/
 *
 * contributed by Albert Sidelnik
 *
*/

config var n = 10000;
param PI = 3.141592653589793;
const solar_mass = (4 * PI * PI);
param days_per_year = 365.24;
const vecLen = 0..2;
const NBODIES = 0..4;

class Planet {
  var coord_vector : [vecLen] real; // x,y,z
  var vel_vector : [vecLen] real;   // vx,vy,vz
  var mass : real;
}

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

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

proc offset_momentum(B : [] Planet) {
  var p : [vecLen] real;
  //p = + reduce [b in B] (b.vel_vector * b.mass); <--- FAILS
  for b in B do
    p += b.vel_vector * b.mass;

  B(0).vel_vector = -p / solar_mass;
}

proc main() {
  var bodies : [NBODIES] Planet;

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

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

  for body in bodies do delete body;
}


Oops, this one snuck in with that last check-in accidentally.
Reverting.

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

var a = 0;
var b = 1;
var c = 2;
var d = 3;
var e = 4;
var f = 5;
var g = 6;
var h = 7;

if (a) then {
  writeln("took true path for a");
} else {
  writeln("took false path for a");
};
writeln();

if (b) then {
  writeln("took true path for b");
  writeln("no really, I did!");
} else {
  writeln("took false path for b");
  writeln("no really, I did");
};
writeln();

if (c) then
  writeln("took true path for c")
else
  writeln("took false path for c");
writeln();

if (d) then
  writeln("took true path for d")
else {
  writeln("took false path for d");
  writeln("no really, I did!");
};
writeln();

if (e) then {
  writeln("took true path for e");
  writeln("no really, I did!");
} else
  writeln("took false path for e");
writeln();

if (f) then
  writeln("took true path for f");
writeln();

if (g) then {
  writeln("took true path for g");
};
writeln();

if (h) then {
  writeln("took true path for h");
  writeln("no really, I did!");
};
writeln();

if (!a) then {
  writeln("took true path for !a");
} else {
  writeln("took false path for !a");
};
writeln();

if (!b) then {
  writeln("took true path for !b");
  writeln("no really, I did!");
} else {
  writeln("took false path for !b");
  writeln("no really, I did");
};
writeln();

if (!c) then
  writeln("took true path for !c")
else
  writeln("took false path for !c");
writeln();

if (!d) then
  writeln("took true path for !d")
else {
  writeln("took false path for !d");
  writeln("no really, I did!");
};
writeln();

if (!e) then {
  writeln("took true path for !e");
  writeln("no really, I did!");
} else
  writeln("took false path for !e");
writeln();

if (!f) then
  writeln("took true path for !f");
writeln();

if (!g) then {
  writeln("took true path for !g");
};
writeln();

if (!h) then {
  writeln("took true path for !h");
  writeln("no really, I did!");
};
writeln();

var a = 0;
var b = 1;
var c = 2;
var d = 3;
var e = 4;
var f = 5;
var g = 6;
var h = 7;

if (a)  {
  writeln("took true path for a");
} else {
  writeln("took false path for a");
}
writeln();

if (b)  {
  writeln("took true path for b");
  writeln("no really, I did!");
} else {
  writeln("took false path for b");
  writeln("no really, I did");
}
writeln();

if (c)
  writeln("took true path for c");
else
  writeln("took false path for c");
writeln();

if (d)
  writeln("took true path for d");
else {
  writeln("took false path for d");
  writeln("no really, I did!");
}
writeln();

if (e)  {
  writeln("took true path for e");
  writeln("no really, I did!");
} else
  writeln("took false path for e");
writeln();

if (f)
  writeln("took true path for f");
writeln();

if (g)  {
  writeln("took true path for g");
}
writeln();

if (h)  {
  writeln("took true path for h");
  writeln("no really, I did!");
}
writeln();

if (!a)  {
  writeln("took true path for !a");
} else {
  writeln("took false path for !a");
}
writeln();

if (!b)  {
  writeln("took true path for !b");
  writeln("no really, I did!");
} else {
  writeln("took false path for !b");
  writeln("no really, I did");
}
writeln();

if (!c)
  writeln("took true path for !c");
else
  writeln("took false path for !c");
writeln();

if (!d)
  writeln("took true path for !d");
else {
  writeln("took false path for !d");
  writeln("no really, I did!");
}
writeln();

if (!e)  {
  writeln("took true path for !e");
  writeln("no really, I did!");
} else
  writeln("took false path for !e");
writeln();

if (!f)
  writeln("took true path for !f");
writeln();

if (!g)  {
  writeln("took true path for !g");
}
writeln();

if (!h)  {
  writeln("took true path for !h");
  writeln("no really, I did!");
}
writeln();


This change removes some stale behavior

This change removes some stale behavior

The old version of the _defaultOf function for default-sized reals and imags
wanted a cast, because it was specifying the default size rather than just using
it automatically.  With that change, the cast is unnecessary.

/*
 * Copyright 2004-2014 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.
 */

// Types.chpl
//
// Standard type routines.
//

//
// type predicates
//
proc chpl__isType(type t) param return true;
proc chpl__isType(e) param return false;

pragma "no instantiation limit"
proc _isPrimitiveType(type t) param return
  _isBooleanType(t)  ||
  _isIntegralType(t) ||
  _isRealType(t)     ||
//To allow imag, need to define casts from primitive types into imag.
//_isImagType(t)     ||
  (t == c_string);

pragma "no instantiation limit"
proc _isSimpleScalarType(type t) param return
  _isBooleanType(t) | _isIntegralType(t) | _isFloatType(t);

pragma "no instantiation limit"
proc _isBooleanType(type t) param return
  (t == bool) | (t == bool(8)) | (t == bool(16)) | (t == bool(32)) | (t == bool(64));

pragma "no instantiation limit"
proc _isIntegralType(type t) param return
  _isSignedType(t) || _isUnsignedType(t);

pragma "no instantiation limit"
proc _isSignedType(type t) param return
  (t == int(8)) || (t == int(16)) || (t == int(32)) || (t == int(64));

pragma "no instantiation limit"
proc _isUnsignedType(type t) param return
  (t == uint(8)) || (t == uint(16)) || (t == uint(32)) || (t == uint(64));

pragma "no instantiation limit"
proc _isEnumeratedType(type t) param {
  proc isEnum(type t: enumerated) param return true;
  proc isEnum(type t) param return false;
  return isEnum(t);
}

pragma "no instantiation limit"
proc _isComplexType(type t) param return
  (t == complex(64)) | (t == complex(128));

pragma "no instantiation limit"
proc _isFloatType(type t) param return
  (t == real(32)) | (t == real(64)) |
  (t == imag(32)) | (t == imag(64));

pragma "no instantiation limit"
proc _isRealType(type t) param return
  (t == real(32)) | (t == real(64));

pragma "no instantiation limit"
proc _isImagType(type t) param return
  (t == imag(32)) | (t == imag(64));

// Returns the unsigned equivalent of the input type.
proc chpl__unsignedType(type t) type
{
  if ! _isIntegralType(t) then
    compilerError("range idxType is non-integral: ", typeToString(t));

  return uint(numBits(t));
}

// Returns the signed equivalent of the input type.
proc chpl__signedType(type t) type
{
  if ! _isIntegralType(t) then
    compilerError("range idxType is non-integral: ", typeToString(t));

  return int(numBits(t));
}

proc chpl__maxIntTypeSameSign(type t) type {
  if ! _isIntegralType(t) then
    compilerError("type t is non-integral: ", typeToString(t));

  if (_isSignedType(t)) then
    return int(64);
  else
    return uint(64);
}

//
// These procedures indicate whether or not a type t is a specific type
//
proc isRangeType(type t) param where   t: range  return true;
proc isRangeType(type t) param where !(t: range) return false;

proc isDmapType(type t) param where   t: _distribution  return true;
proc isDmapType(type t) param where !(t: _distribution) return false;

proc isDomainType(type t) param where   t: _domain  return true;
proc isDomainType(type t) param where !(t: _domain) return false;

proc isArrayType(type t) param where   t: _array  return true;
proc isArrayType(type t) param where !(t: _array) return false;

// Is 'sub' a subtype (or equal to) 'super'?
proc isSubtype(type sub, type super) param where   sub: super  return true;
proc isSubtype(type sub, type super) param where !(sub: super) return false;

// Is 'sub' a proper subtype of 'super'?
proc isProperSubtype(type sub, type super) param
  where isSubtype(sub, super) && sub != super
  return true;
proc isProperSubtype(type sub, type super) param
  return false;

// What follows are the type _defaultOf methods, used to initialize types
// Booleans
inline proc _defaultOf(type t) param where (_isBooleanType(t)) return false:t;

// ints, reals, imags, complexes
inline proc _defaultOf(type t) param where (_isIntegralType(t)) return 0:t;
// TODO: In order to make _defaultOf param for reals and imags we had to split
// the cases into their default size and a non-param case.  It is hoped that
// in the future, floating point numbers may be castable whilst param.  In that
// world, we can again shrink these calls into the size-ignorant case.
inline proc _defaultOf(type t) param where t == real return 0.0;
inline proc _defaultOf(type t) where (_isRealType(t) && t != real) return 0.0:t;
inline proc _defaultOf(type t) param where t == imag return 0.0i;
inline proc _defaultOf(type t) where (_isImagType(t) && t != imag) return 0.0i:t;
// Also, complexes cannot yet be parametized
inline proc _defaultOf(type t): t where (_isComplexType(t)) {
  var ret:t = noinit;
  param floatwidth = numBits(t)/2;
  ret.re = 0.0:real(floatwidth);
  ret.im = 0.0:real(floatwidth);
  return ret;
}

// Enums
inline proc _defaultOf(type t) param where (_isEnumeratedType(t)) {
  return chpl_enum_first(t);
}

// Classes
inline proc _defaultOf(type t) where (isClassType(t)) return nil:t;

// Various types whose default value is known
inline proc _defaultOf(type t) param where t: void return _void;
inline proc _defaultOf(type t) where t: opaque return _nullOpaque;
inline proc _defaultOf(type t) where t: chpl_taskID_t return chpl_nullTaskID;
inline proc _defaultOf(type t) where t: _sync_aux_t return _nullSyncVarAuxFields;
inline proc _defaultOf(type t) where t: _single_aux_t return _nullSingleVarAuxFields;
inline proc _defaultOf(type t) where t: _task_list return _nullTaskList;

// When I finish removing PRIM_INIT before initialization to a known value, then
// this method should work.  Until then, my stopgap will be an external function
// in the runtime.
//inline proc _defaultOf(type t) where t: memory_order return memory_order_seq_cst;
extern proc _defaultOfMemoryOrder(): memory_order;

pragma "no instantiation limit"
pragma "compiler generated"
inline proc _defaultOf(type t) {
  select t {
    when memory_order {
      return _defaultOfMemoryOrder();
    }
    otherwise {
      return nil:t;
    }
  }
}

// Returns true if it is legal to coerce t1 to t2, false otherwise.
proc chpl__legalIntCoerce(type t1, type t2) param
{
  if (_isSignedType(t2)) {
    if (_isSignedType(t1)) {
      return (numBits(t1) <= numBits(t2));
    } else {
      return (numBits(t1) < numBits(t2));
    }
  } else {
    if (_isSignedType(t1)) {
      return false;
    } else {
      return (numBits(t1) <= numBits(t2));
    }
  }
}

// Returns the type with which both s and t are compatible
// That is, both s and t can be coerced to the returned type.
proc chpl__commonType(type s, type t) type
{
  if ! _isIntegralType(s) then
    compilerError("Type ", typeToString(s) , " is non-integral: ");
  if ! _isIntegralType(t) then
    compilerError("Type ", typeToString(t) , " is non-integral: ");

  if numBits(s) > numBits(t) then return s;
  if numBits(s) < numBits(t) then return t;

  if _isSignedType(s) && ! _isSignedType(t) ||
     _isSignedType(t) && ! _isSignedType(s) then
    compilerError("Types ", typeToString(s) , " and ", typeToString(t), " are incompatible.");

  return s;
}

//
// numBits(type) -- returns the number of bits in a type
//

proc numBits(type t) param where t == bool {
  compilerError("default-width 'bool' does not have a well-defined size");
}
proc numBits(type t) param where t == bool(8) return 8;
proc numBits(type t) param where t == bool(16) return 16;
proc numBits(type t) param where t == bool(32) return 32;
proc numBits(type t) param where t == bool(64) return 64;
proc numBits(type t) param where t == int(8) return 8;
proc numBits(type t) param where t == int(16) return 16;
proc numBits(type t) param where t == int(32) return 32;
proc numBits(type t) param where t == int(64) return 64;
proc numBits(type t) param where t == uint(8) return 8;
proc numBits(type t) param where t == uint(16) return 16;
proc numBits(type t) param where t == uint(32) return 32;
proc numBits(type t) param where t == uint(64) return 64;
proc numBits(type t) param where t == real(32) return 32;
proc numBits(type t) param where t == real(64) return 64;
proc numBits(type t) param where t == imag(32) return 32;
proc numBits(type t) param where t == imag(64) return 64;
proc numBits(type t) param where t == complex(64) return 64;
proc numBits(type t) param where t == complex(128) return 128;

//
// numBytes(type) -- returns the number of bytes in a type
//

param bitsPerByte = 8;

proc numBytes(type t) param return numBits(t)/8;

//
// min(type) -- returns the minimum value a type can store
//

proc min(type t) where t == bool
  return false;

proc min(type t) where _isIntegralType(t) || _isFloatType(t)
  return __primitive( "_min", t);

proc min(type t) where _isComplexType(t) {
  var x: t;
  x.re = min(x.re.type);
  x.im = min(x.im.type);
  return x;
}

//
// max(type) -- returns the maximum value a type can store
//

proc max(type t) where t == bool
  return true;

proc max(type t) where _isIntegralType(t) || _isFloatType(t)
  return __primitive( "_max", t);

proc max(type t) where _isComplexType(t) {
  var x: t;
  x.re = max(x.re.type);
  x.im = max(x.im.type);
  return x;
}

iter chpl_enumerate(type t: enumerated) {
  const enumTuple = chpl_enum_enumerate(t);
  for i in 1..enumTuple.size do
    yield enumTuple(i);
}

proc enum_minbits(type t: enumerated) param {
  return __primitive( "enum min bits", t);
}
proc enum_issigned(type t: enumerated) param {
  return __primitive( "enum is signed", t);
}
proc enum_mintype(type t: enumerated) type {
  param minbits = enum_minbits(t);
  param signed = enum_issigned(t);
  if signed {
    return int(minbits);
  } else {
    return uint(minbits);
  }
}

proc numBits(type t: enumerated) param {
  return numBits(enum_mintype(t));
}

//
// identity functions (for reductions)
//
inline proc _prod_id(type t) return 1:t;
inline proc _land_id(type t) return true;
inline proc _lor_id(type t) return false;
inline proc _lxor_id(type t) return false;
inline proc _band_id(type t) {
  // MPF - this doesn't really make sense for floating-point types,
  // but old code had it casting MAX_UINT to the same type...
  // I just moved it from the code generator since we don't need
  // a primitive to generate constants.
  if t == bool then return true;
  if t == int(8) then return -1:t;
  if t == int(16) then return -1:t;
  if t == int(32) then return -1:t;
  if t == int(64) then return -1:t;
  if t == real(32) then return max(uint(32)):t;
  if t == real(64) then return max(uint(64)):t;
  if t == imag(32) then return max(uint(32)):t;
  if t == imag(64) then return max(uint(64)):t;
  if t == complex(64) then return (max(uint(32)):real(32), max(uint(32)):real(32)):t;
  if t == complex(128) then return (max(uint(64)):real(64), max(uint(64)):real(64)):t;
  return max(t);
}
inline proc _bor_id(type t) return 0:t;
inline proc _bxor_id(type t) return 0:t;

/*
 * Copyright 2004-2014 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.
 */

// Types.chpl
//
// Standard type routines.
//

//
// type predicates
//
proc chpl__isType(type t) param return true;
proc chpl__isType(e) param return false;

pragma "no instantiation limit"
proc _isPrimitiveType(type t) param return
  _isBooleanType(t)  ||
  _isIntegralType(t) ||
  _isRealType(t)     ||
//To allow imag, need to define casts from primitive types into imag.
//_isImagType(t)     ||
  (t == c_string);

pragma "no instantiation limit"
proc _isSimpleScalarType(type t) param return
  _isBooleanType(t) | _isIntegralType(t) | _isFloatType(t);

pragma "no instantiation limit"
proc _isBooleanType(type t) param return
  (t == bool) | (t == bool(8)) | (t == bool(16)) | (t == bool(32)) | (t == bool(64));

pragma "no instantiation limit"
proc _isIntegralType(type t) param return
  _isSignedType(t) || _isUnsignedType(t);

pragma "no instantiation limit"
proc _isSignedType(type t) param return
  (t == int(8)) || (t == int(16)) || (t == int(32)) || (t == int(64));

pragma "no instantiation limit"
proc _isUnsignedType(type t) param return
  (t == uint(8)) || (t == uint(16)) || (t == uint(32)) || (t == uint(64));

pragma "no instantiation limit"
proc _isEnumeratedType(type t) param {
  proc isEnum(type t: enumerated) param return true;
  proc isEnum(type t) param return false;
  return isEnum(t);
}

pragma "no instantiation limit"
proc _isComplexType(type t) param return
  (t == complex(64)) | (t == complex(128));

pragma "no instantiation limit"
proc _isFloatType(type t) param return
  (t == real(32)) | (t == real(64)) |
  (t == imag(32)) | (t == imag(64));

pragma "no instantiation limit"
proc _isRealType(type t) param return
  (t == real(32)) | (t == real(64));

pragma "no instantiation limit"
proc _isImagType(type t) param return
  (t == imag(32)) | (t == imag(64));

// Returns the unsigned equivalent of the input type.
proc chpl__unsignedType(type t) type
{
  if ! _isIntegralType(t) then
    compilerError("range idxType is non-integral: ", typeToString(t));

  return uint(numBits(t));
}

// Returns the signed equivalent of the input type.
proc chpl__signedType(type t) type
{
  if ! _isIntegralType(t) then
    compilerError("range idxType is non-integral: ", typeToString(t));

  return int(numBits(t));
}

proc chpl__maxIntTypeSameSign(type t) type {
  if ! _isIntegralType(t) then
    compilerError("type t is non-integral: ", typeToString(t));

  if (_isSignedType(t)) then
    return int(64);
  else
    return uint(64);
}

//
// These procedures indicate whether or not a type t is a specific type
//
proc isRangeType(type t) param where   t: range  return true;
proc isRangeType(type t) param where !(t: range) return false;

proc isDmapType(type t) param where   t: _distribution  return true;
proc isDmapType(type t) param where !(t: _distribution) return false;

proc isDomainType(type t) param where   t: _domain  return true;
proc isDomainType(type t) param where !(t: _domain) return false;

proc isArrayType(type t) param where   t: _array  return true;
proc isArrayType(type t) param where !(t: _array) return false;

// Is 'sub' a subtype (or equal to) 'super'?
proc isSubtype(type sub, type super) param where   sub: super  return true;
proc isSubtype(type sub, type super) param where !(sub: super) return false;

// Is 'sub' a proper subtype of 'super'?
proc isProperSubtype(type sub, type super) param
  where isSubtype(sub, super) && sub != super
  return true;
proc isProperSubtype(type sub, type super) param
  return false;

// What follows are the type _defaultOf methods, used to initialize types
// Booleans
inline proc _defaultOf(type t) param where (_isBooleanType(t)) return false:t;

// ints, reals, imags, complexes
inline proc _defaultOf(type t) param where (_isIntegralType(t)) return 0:t;
// TODO: In order to make _defaultOf param for reals and imags we had to split
// the cases into their default size and a non-param case.  It is hoped that
// in the future, floating point numbers may be castable whilst param.  In that
// world, we can again shrink these calls into the size-ignorant case.
inline proc _defaultOf(type t) param where t == real return 0.0:t;
inline proc _defaultOf(type t) where (_isRealType(t) && t != real) return 0.0:t;
inline proc _defaultOf(type t) param where t == imag return 0.0i:t;
inline proc _defaultOf(type t) where (_isImagType(t) && t != imag) return 0.0i:t;
// Also, complexes cannot yet be parametized
inline proc _defaultOf(type t): t where (_isComplexType(t)) {
  var ret:t = noinit;
  param floatwidth = numBits(t)/2;
  ret.re = 0.0:real(floatwidth);
  ret.im = 0.0:real(floatwidth);
  return ret;
}

// Enums
inline proc _defaultOf(type t) param where (_isEnumeratedType(t)) {
  return chpl_enum_first(t);
}

// Classes
inline proc _defaultOf(type t) where (isClassType(t)) return nil:t;

// Various types whose default value is known
inline proc _defaultOf(type t) param where t: void return _void;
inline proc _defaultOf(type t) where t: opaque return _nullOpaque;
inline proc _defaultOf(type t) where t: chpl_taskID_t return chpl_nullTaskID;
inline proc _defaultOf(type t) where t: _sync_aux_t return _nullSyncVarAuxFields;
inline proc _defaultOf(type t) where t: _single_aux_t return _nullSingleVarAuxFields;
inline proc _defaultOf(type t) where t: _task_list return _nullTaskList;

// When I finish removing PRIM_INIT before initialization to a known value, then
// this method should work.  Until then, my stopgap will be an external function
// in the runtime.
//inline proc _defaultOf(type t) where t: memory_order return memory_order_seq_cst;
extern proc _defaultOfMemoryOrder(): memory_order;

pragma "no instantiation limit"
pragma "compiler generated"
inline proc _defaultOf(type t) {
  select t {
    when memory_order {
      return _defaultOfMemoryOrder();
    }
    otherwise {
      return nil:t;
    }
  }
}

// Returns true if it is legal to coerce t1 to t2, false otherwise.
proc chpl__legalIntCoerce(type t1, type t2) param
{
  if (_isSignedType(t2)) {
    if (_isSignedType(t1)) {
      return (numBits(t1) <= numBits(t2));
    } else {
      return (numBits(t1) < numBits(t2));
    }
  } else {
    if (_isSignedType(t1)) {
      return false;
    } else {
      return (numBits(t1) <= numBits(t2));
    }
  }
}

// Returns the type with which both s and t are compatible
// That is, both s and t can be coerced to the returned type.
proc chpl__commonType(type s, type t) type
{
  if ! _isIntegralType(s) then
    compilerError("Type ", typeToString(s) , " is non-integral: ");
  if ! _isIntegralType(t) then
    compilerError("Type ", typeToString(t) , " is non-integral: ");

  if numBits(s) > numBits(t) then return s;
  if numBits(s) < numBits(t) then return t;

  if _isSignedType(s) && ! _isSignedType(t) ||
     _isSignedType(t) && ! _isSignedType(s) then
    compilerError("Types ", typeToString(s) , " and ", typeToString(t), " are incompatible.");

  return s;
}

//
// numBits(type) -- returns the number of bits in a type
//

proc numBits(type t) param where t == bool {
  compilerError("default-width 'bool' does not have a well-defined size");
}
proc numBits(type t) param where t == bool(8) return 8;
proc numBits(type t) param where t == bool(16) return 16;
proc numBits(type t) param where t == bool(32) return 32;
proc numBits(type t) param where t == bool(64) return 64;
proc numBits(type t) param where t == int(8) return 8;
proc numBits(type t) param where t == int(16) return 16;
proc numBits(type t) param where t == int(32) return 32;
proc numBits(type t) param where t == int(64) return 64;
proc numBits(type t) param where t == uint(8) return 8;
proc numBits(type t) param where t == uint(16) return 16;
proc numBits(type t) param where t == uint(32) return 32;
proc numBits(type t) param where t == uint(64) return 64;
proc numBits(type t) param where t == real(32) return 32;
proc numBits(type t) param where t == real(64) return 64;
proc numBits(type t) param where t == imag(32) return 32;
proc numBits(type t) param where t == imag(64) return 64;
proc numBits(type t) param where t == complex(64) return 64;
proc numBits(type t) param where t == complex(128) return 128;

//
// numBytes(type) -- returns the number of bytes in a type
//

param bitsPerByte = 8;

proc numBytes(type t) param return numBits(t)/8;

//
// min(type) -- returns the minimum value a type can store
//

proc min(type t) where t == bool
  return false;

proc min(type t) where _isIntegralType(t) || _isFloatType(t)
  return __primitive( "_min", t);

proc min(type t) where _isComplexType(t) {
  var x: t;
  x.re = min(x.re.type);
  x.im = min(x.im.type);
  return x;
}

//
// max(type) -- returns the maximum value a type can store
//

proc max(type t) where t == bool
  return true;

proc max(type t) where _isIntegralType(t) || _isFloatType(t)
  return __primitive( "_max", t);

proc max(type t) where _isComplexType(t) {
  var x: t;
  x.re = max(x.re.type);
  x.im = max(x.im.type);
  return x;
}

iter chpl_enumerate(type t: enumerated) {
  const enumTuple = chpl_enum_enumerate(t);
  for i in 1..enumTuple.size do
    yield enumTuple(i);
}

proc enum_minbits(type t: enumerated) param {
  return __primitive( "enum min bits", t);
}
proc enum_issigned(type t: enumerated) param {
  return __primitive( "enum is signed", t);
}
proc enum_mintype(type t: enumerated) type {
  param minbits = enum_minbits(t);
  param signed = enum_issigned(t);
  if signed {
    return int(minbits);
  } else {
    return uint(minbits);
  }
}

proc numBits(type t: enumerated) param {
  return numBits(enum_mintype(t));
}

//
// identity functions (for reductions)
//
inline proc _prod_id(type t) return 1:t;
inline proc _land_id(type t) return true;
inline proc _lor_id(type t) return false;
inline proc _lxor_id(type t) return false;
inline proc _band_id(type t) {
  // MPF - this doesn't really make sense for floating-point types,
  // but old code had it casting MAX_UINT to the same type...
  // I just moved it from the code generator since we don't need
  // a primitive to generate constants.
  if t == bool then return true;
  if t == int(8) then return -1:t;
  if t == int(16) then return -1:t;
  if t == int(32) then return -1:t;
  if t == int(64) then return -1:t;
  if t == real(32) then return max(uint(32)):t;
  if t == real(64) then return max(uint(64)):t;
  if t == imag(32) then return max(uint(32)):t;
  if t == imag(64) then return max(uint(64)):t;
  if t == complex(64) then return (max(uint(32)):real(32), max(uint(32)):real(32)):t;
  if t == complex(128) then return (max(uint(64)):real(64), max(uint(64)):real(64)):t;
  return max(t);
}
inline proc _bor_id(type t) return 0:t;
inline proc _bxor_id(type t) return 0:t;