Pragma "compiler generated" is required so object.name does not dominate.

class A {
  var name: string = "A";
  proc ddName() { return name; }
}

class B:A {
  var name: string = "B";
  proc ddName() { return name; }
}

class C:B {
  var name: string = "C";
  proc ddName() { return name; }
}

class C2:C {
  var name: string = "C2";
  proc ddName() { return name; }
}

class D:C {
  var name: string = "D";
  proc ddName() { return name; }
}

class E:C {
  var name: string = "E";
  proc ddName() { return name; }
}

class F {
  var name: string = "F";
  proc ddName() { return name; }
}

// Because the getters are compiler-generated, we have to add the flag here to
// put this pseudo-getter on equal footing.  Otherwise, it always wins, which
// is not what the test is supposed to show.
pragma "compiler generated"
proc object.name: string return "object";
proc object.ddName(): string { return "object"; }

//
// Begin interesting code
//

proc get_cdr(type car, type cdr...?k) type {
  return cdr;
}

proc isSubType(type sub, type sup) param {
  proc isSubTypeHelp(v:sub = nil) param {
    proc ist(v:sup) param {
      return true;
    }
    proc ist(v) param {
      return false;
    }
    return ist(v);
  }
  return isSubTypeHelp();
}

proc getSuperType(type t) type {
  proc st(v:t = nil) type {
    if (t == object) then
      return t;
    else
      return v.super.type;
  }
  return st();
}

proc nearestMutualParentClass(type t1, type t2) type {
  if t1 == t2 then
    return t1;
  else if isSubType(t1, t2) then
    return t2;
  else if isSubType(t2, t1) then
    return t1;
  else
    return nearestMutualParentClass(getSuperType(t1), getSuperType(t2));
}

proc nearestMutualParentClass(type car, type cdr...?k) type where k != 1 {
  type first = nearestMutualParentClass(car, cdr(1));
  return nearestMutualParentClass(first, (...get_cdr((...cdr))));
}

proc main {
  var c: nearestMutualParentClass(E, D, C, C2, F) = new E();
  var d: nearestMutualParentClass(E, D, C) = new E();
  writeln(c.name);
  writeln(c.ddName());
  writeln(d.name);
  writeln(d.ddName());
}

class A {
  var name: string = "A";
  proc ddName() { return name; }
}

class B:A {
  var name: string = "B";
  proc ddName() { return name; }
}

class C:B {
  var name: string = "C";
  proc ddName() { return name; }
}

class C2:C {
  var name: string = "C2";
  proc ddName() { return name; }
}

class D:C {
  var name: string = "D";
  proc ddName() { return name; }
}

class E:C {
  var name: string = "E";
  proc ddName() { return name; }
}

class F {
  var name: string = "F";
  proc ddName() { return name; }
}

proc object.name: string return "object";
proc object.ddName(): string { return "object"; }

//
// Begin interesting code
//

proc get_cdr(type car, type cdr...?k) type {
  return cdr;
}

proc isSubType(type sub, type sup) param {
  proc isSubTypeHelp(v:sub = nil) param {
    proc ist(v:sup) param {
      return true;
    }
    proc ist(v) param {
      return false;
    }
    return ist(v);
  }
  return isSubTypeHelp();
}

proc getSuperType(type t) type {
  proc st(v:t = nil) type {
    if (t == object) then
      return t;
    else
      return v.super.type;
  }
  return st();
}

proc nearestMutualParentClass(type t1, type t2) type {
  if t1 == t2 then
    return t1;
  else if isSubType(t1, t2) then
    return t2;
  else if isSubType(t2, t1) then
    return t1;
  else
    return nearestMutualParentClass(getSuperType(t1), getSuperType(t2));
}

proc nearestMutualParentClass(type car, type cdr...?k) type where k != 1 {
  type first = nearestMutualParentClass(car, cdr(1));
  return nearestMutualParentClass(first, (...get_cdr((...cdr))));
}

proc main {
  var c: nearestMutualParentClass(E, D, C, C2, F) = new E();
  var d: nearestMutualParentClass(E, D, C) = new E();
  writeln(c.name);
  writeln(c.ddName());
  writeln(d.name);
  writeln(d.ddName());
}


Remove "no doc" pragma from private symbols in Time module

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

/*
   This module provides support for querying wall time in the local
   timezone and implements a record :record:`~Timer` that provides basic
   stopwatch behavior.  The stopwatch has the potential for microsecond
   resolution and is intended to be useful for performance testing.
 */

module Time {

// Returns the number of seconds since midnight.  Has the potential for
// microsecond resolution if supported by the runtime platform
private extern proc chpl_now_time():real;

pragma "no doc"
// This is comparable to a Posix struct timeval
extern type _timevalue;

private extern proc chpl_null_timevalue(): _timevalue;

// The number of seconds/microseconds since Jan 1, 1970 in UTC
private extern proc chpl_now_timevalue():  _timevalue;

// The components of time in the local time zone
private extern proc chpl_timevalue_parts(t:           _timevalue,

                                         out seconds: int(32),
                                         out minutes: int(32),
                                         out hours:   int(32),
                                         out mday:    int(32),
                                         out month:   int(32),
                                         out year:    int(32),
                                         out wday:    int(32),
                                         out yday:    int(32),
                                         out isdst:   int(32));

/* Specifies the units to be used when certain functions return a time */
enum TimeUnits { microseconds, milliseconds, seconds, minutes, hours }

/* Specifies the day of the week */
enum Day       { sunday=0, monday, tuesday, wednesday, thursday, friday, saturday }

/*
   :arg  unit: The units for the returned value
   :type unit: TimeUnits

   :returns: The elapsed time since midnight, local time, in the units specified
   :rtype:   real(64)
 */
proc getCurrentTime(unit: TimeUnits = TimeUnits.seconds) : real(64)
  return _convert_microseconds(unit, chpl_now_time());

/*
   :returns:  (year, month, day) as a tuple of 3 ints

   The month is in the range 1 to 12.
   The day   is in the range 1 to 31
*/
proc getCurrentDate() {
  var now = chpl_now_timevalue();

  var seconds, minutes, hours, mday, month, year, wday, yday, isdst:int(32);

  chpl_timevalue_parts(now, seconds, minutes, hours, mday, month, year, wday, yday, isdst);

  return (year + 1900, month + 1, mday);
}

/*
   :returns: The current day of the week
   :rtype:   Day
 */
proc getCurrentDayOfWeek() : Day {
  var now = chpl_now_timevalue();

  var seconds, minutes, hours, mday, month, year, wday, yday, isdst:int(32);

  chpl_timevalue_parts(now, seconds, minutes, hours, mday, month, year, wday, yday, isdst);

  return wday : Day;
}

/* Delay a task for t seconds */
inline proc sleep(t: uint) : void {
  extern proc chpl_task_sleep(t:uint) : void;

  chpl_task_sleep(t);
}

/*
   Implements basic stopwatch behavior with a potential resolution of
   microseconds if supported by the runtime platform.

   The :record:`!Timer` can be started, stopped, and cleared.
   A :record:`!Timer` is either running or stopped.
*/

record Timer {
  pragma "no doc"
  var time:        _timevalue = chpl_null_timevalue();

  pragma "no doc"
  var accumulated: real       = 0.0;

  pragma "no doc"
  var running:     bool       = false;

  pragma "no doc"
  proc initialize() {
    // does nothing.
  }

  /*
     Clears the elapsed time. If the timer is running then it is restarted
     otherwise it remains in the stopped state.
  */
  proc clear() : void {
    accumulated = 0.0;

    if running {
      time = chpl_now_timevalue();
    }
  }

  /* Starts the timer. It is an error to start a timer that is already running. */
  proc start() : void {
    if !running {
      running = true;
      time    = chpl_now_timevalue();
    } else {
      halt("start called on a timer that has not been stopped");
    }
  }

  /* Stops the timer. It is an error to stop a timer that is not running. */
  proc stop() : void {
    if running {
      var time2: _timevalue = chpl_now_timevalue();

      accumulated += _diff_time(time2, time);
      running      = false;
    } else {
      halt("stop called on a timer that has not been started");
    }
  }

  /*
     Returns the cumulative elapsed time, in the units specified, between
     all pairs of calls to :proc:`~!Timer.start` and :proc:`~!Timer.stop`
     since the timer was created or the last call to :proc:`~!Timer.clear`.
     If the timer is running, the elapsed time since the last call to
     :proc:`~!Timer.start` is added to the return value.

     :arg  unit: The units for the returned value
     :type unit: TimeUnits

     :returns: The elapsed time in the units specified
     :rtype:   real(64)
  */
  proc elapsed(unit: TimeUnits = TimeUnits.seconds) : real {
    if running {
      var time2: _timevalue = chpl_now_timevalue();

      return _convert_microseconds(unit, accumulated + _diff_time(time2, time));
    } else {
      return _convert_microseconds(unit, accumulated);
    }
  }
}

// returns diff of two time values in microseconds
private inline proc _diff_time(t1: _timevalue, t2: _timevalue) {
  extern proc chpl_timevalue_seconds(t:_timevalue):      int(64);
  extern proc chpl_timevalue_microseconds(t:_timevalue): int(64);

  var s1  = chpl_timevalue_seconds(t1);
  var us1 = chpl_timevalue_microseconds(t1);

  var s2  = chpl_timevalue_seconds(t2);
  var us2 = chpl_timevalue_microseconds(t2);

  return (s1 * 1.0e+6 + us1) - (s2 * 1.0e+6 + us2);
}

// converts microseconds to another unit
private proc _convert_microseconds(unit: TimeUnits, us: real) {
  select unit {
    when TimeUnits.microseconds do return us;
    when TimeUnits.milliseconds do return us /    1.0e+3;
    when TimeUnits.seconds      do return us /    1.0e+6;
    when TimeUnits.minutes      do return us /   60.0e+6;
    when TimeUnits.hours        do return us / 3600.0e+6;
  }

  halt("internal error in module Time");

  // will never get here, but to avoid warnings:
  return -1.0;
}

}

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

/*
   This module provides support for querying wall time in the local
   timezone and implements a record :record:`~Timer` that provides basic
   stopwatch behavior.  The stopwatch has the potential for microsecond
   resolution and is intended to be useful for performance testing.
 */

module Time {

pragma "no doc"
// Returns the number of seconds since midnight.  Has the potential for
// microsecond resolution if supported by the runtime platform
private extern proc chpl_now_time():real;

pragma "no doc"
// This is comparable to a Posix struct timeval
extern type _timevalue;

pragma "no doc"
private extern proc chpl_null_timevalue(): _timevalue;

pragma "no doc"
// The number of seconds/microseconds since Jan 1, 1970 in UTC
private extern proc chpl_now_timevalue():  _timevalue;

pragma "no doc"
// The components of time in the local time zone
private extern proc chpl_timevalue_parts(t:           _timevalue,

                                         out seconds: int(32),
                                         out minutes: int(32),
                                         out hours:   int(32),
                                         out mday:    int(32),
                                         out month:   int(32),
                                         out year:    int(32),
                                         out wday:    int(32),
                                         out yday:    int(32),
                                         out isdst:   int(32));

/* Specifies the units to be used when certain functions return a time */
enum TimeUnits { microseconds, milliseconds, seconds, minutes, hours }

/* Specifies the day of the week */
enum Day       { sunday=0, monday, tuesday, wednesday, thursday, friday, saturday }

/*
   :arg  unit: The units for the returned value
   :type unit: TimeUnits

   :returns: The elapsed time since midnight, local time, in the units specified
   :rtype:   real(64)
 */
proc getCurrentTime(unit: TimeUnits = TimeUnits.seconds) : real(64)
  return _convert_microseconds(unit, chpl_now_time());

/*
   :returns:  (year, month, day) as a tuple of 3 ints

   The month is in the range 1 to 12.
   The day   is in the range 1 to 31
*/
proc getCurrentDate() {
  var now = chpl_now_timevalue();

  var seconds, minutes, hours, mday, month, year, wday, yday, isdst:int(32);

  chpl_timevalue_parts(now, seconds, minutes, hours, mday, month, year, wday, yday, isdst);

  return (year + 1900, month + 1, mday);
}

/*
   :returns: The current day of the week
   :rtype:   Day
 */
proc getCurrentDayOfWeek() : Day {
  var now = chpl_now_timevalue();

  var seconds, minutes, hours, mday, month, year, wday, yday, isdst:int(32);

  chpl_timevalue_parts(now, seconds, minutes, hours, mday, month, year, wday, yday, isdst);

  return wday : Day;
}

/* Delay a task for t seconds */
inline proc sleep(t: uint) : void {
  extern proc chpl_task_sleep(t:uint) : void;

  chpl_task_sleep(t);
}

/*
   Implements basic stopwatch behavior with a potential resolution of
   microseconds if supported by the runtime platform.

   The :record:`!Timer` can be started, stopped, and cleared.
   A :record:`!Timer` is either running or stopped.
*/

record Timer {
  pragma "no doc"
  var time:        _timevalue = chpl_null_timevalue();

  pragma "no doc"
  var accumulated: real       = 0.0;

  pragma "no doc"
  var running:     bool       = false;

  pragma "no doc"
  proc initialize() {
    // does nothing.
  }

  /*
     Clears the elapsed time. If the timer is running then it is restarted
     otherwise it remains in the stopped state.
  */
  proc clear() : void {
    accumulated = 0.0;

    if running {
      time = chpl_now_timevalue();
    }
  }

  /* Starts the timer. It is an error to start a timer that is already running. */
  proc start() : void {
    if !running {
      running = true;
      time    = chpl_now_timevalue();
    } else {
      halt("start called on a timer that has not been stopped");
    }
  }

  /* Stops the timer. It is an error to stop a timer that is not running. */
  proc stop() : void {
    if running {
      var time2: _timevalue = chpl_now_timevalue();

      accumulated += _diff_time(time2, time);
      running      = false;
    } else {
      halt("stop called on a timer that has not been started");
    }
  }

  /*
     Returns the cumulative elapsed time, in the units specified, between
     all pairs of calls to :proc:`~!Timer.start` and :proc:`~!Timer.stop`
     since the timer was created or the last call to :proc:`~!Timer.clear`.
     If the timer is running, the elapsed time since the last call to
     :proc:`~!Timer.start` is added to the return value.

     :arg  unit: The units for the returned value
     :type unit: TimeUnits

     :returns: The elapsed time in the units specified
     :rtype:   real(64)
  */
  proc elapsed(unit: TimeUnits = TimeUnits.seconds) : real {
    if running {
      var time2: _timevalue = chpl_now_timevalue();

      return _convert_microseconds(unit, accumulated + _diff_time(time2, time));
    } else {
      return _convert_microseconds(unit, accumulated);
    }
  }
}

// returns diff of two time values in microseconds
pragma "no doc"
private inline proc _diff_time(t1: _timevalue, t2: _timevalue) {
  extern proc chpl_timevalue_seconds(t:_timevalue):      int(64);
  extern proc chpl_timevalue_microseconds(t:_timevalue): int(64);

  var s1  = chpl_timevalue_seconds(t1);
  var us1 = chpl_timevalue_microseconds(t1);

  var s2  = chpl_timevalue_seconds(t2);
  var us2 = chpl_timevalue_microseconds(t2);

  return (s1 * 1.0e+6 + us1) - (s2 * 1.0e+6 + us2);
}

// converts microseconds to another unit
pragma "no doc"
private proc _convert_microseconds(unit: TimeUnits, us: real) {
  select unit {
    when TimeUnits.microseconds do return us;
    when TimeUnits.milliseconds do return us /    1.0e+3;
    when TimeUnits.seconds      do return us /    1.0e+6;
    when TimeUnits.minutes      do return us /   60.0e+6;
    when TimeUnits.hours        do return us / 3600.0e+6;
  }

  halt("internal error in module Time");

  // will never get here, but to avoid warnings:
  return -1.0;
}

}


Add TODOs about size checks in other plan_dft() routines

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

// Wrapper for FFTW version 3.

/*
  FFT computations via key routines from FFTW (version 3)

  This module defines Chapel wrappers for key 64-bit routines from
  FFTW (http://www.fftw.org), version 3.  Over time, the intention is
  to expand this module to support additional routines, prioritizing
  based on requests and feedback from users.  Also, see the
  :mod:`FFTW_MT` module which provides support for calls to the
  multi-threaded FFTW implementation.

  To use this module:

  1. Ensure that FFTW (version 3) is installed on your system and that
     the header and library files (e.g., fftw3.h, libfftw3.*) are
     either installed in a standard system location or that your C
     compiler's environment variables are set up to find them.

  2. Add ``use FFTW;`` to your Chapel code.

  3. Compile and run your Chapel program as usual.

  As in standard FFTW usage, the flow is to:

  1. Create plan(s) using the :proc:`plan_dft* <plan_dft>` routines.

  2. Execute the plan(s) one or more times using :proc:`execute`.

  3. Destroy the plan(s) using :proc:`destroy_plan`.

  4. Call :proc:`cleanup`.

  Note that each of the Chapel :proc:`plan_dft* <plan_dft>` routines
  support both `in-place` and `out-of-place` versions of the
  transforms, where the former versions use a single array for both
  input and output, and the latter use two distinct arrays.

  In future versions of this interface, we anticipate replacing
  C-oriented arguments in the `plan_dft*()` routines (like `flags`)
  with more precise arguments that take advantage of Chapel's support
  for default argument values and keyword-based argument passing.
*/

//
// - How do we feel about FFTW_ALLCAPS names given that the routines
//   themselves don't have fftw_ prefixes, that they're defined as
//   c_int's, and that they're all-caps?
//
// - Related question about fftw_ types taking type c_int, though
//   maybe we don't care that much (as compared to other interfaces)
//   since symbolic values are taken in? (i.e., we won't run into
//   32- vs. 64-bit issues...)
//

module FFTW {

  use SysCTypes;
  use "fftw3.h", "-lfftw3";

  /*
    Disable execution-time array size checks in the FFTW
    :proc:`plan_dft` routine.
   */
  config param noFFTWsizeChecks = false;

  /*
    An opaque type used to store and reuse FFTW plans across multiple
    routines.
  */
  extern type fftw_plan; // opaque type

  // Planner functions
  // Complex : 4.3.1
  // NOTE : We pass in arrays using ref

  // TODO: Can we have the plan_dft() routine below take in native
  // Chapel types without changing the external C constants from
  // type c_int?  Probably given that Chapel's int will be >=
  // C's int for the forseeable future.  See also the TODO above
  // about whether we'd want to represent those constants using
  // more native Chapel types anyway.

  /*
    Creates a plan for an out-of-place complex-to-complex DFT.

    :arg input: The input array, which can be of any rank
    :type input: [] `complex(128)`

    :arg output: The output array, whose size and shape must match the input array's
    :type output: [] `complex(128)`

    :arg sign: :const:`FFTW_FORWARD` or :const:`FFTW_BACKWARD`
    :type sign: c_int

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft(input: [] complex(128), output: [] complex(128),
                 sign: c_int, flags: c_uint) : fftw_plan
  {
    if !noFFTWsizeChecks then
      for i in 1..input.rank do
        if (input.domain.dim(i).size != output.domain.dim(i).size) then
          halt("In plan_dft(), input and output arrays don't have same size in dimension ", i);

    return plan_dft_help(input, output, sign, flags);
  }

  /*
    Creates a plan for an in-place complex-to-complex DFT.

    :arg arr: The array to use as the in-place input/output array.
    :type arr: [] `complex(128)`

    :arg sign: :const:`FFTW_FORWARD` or :const:`FFTW_BACKWARD`
    :type sign: c_int

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft(arr: [] complex(128), sign: c_int, flags: c_uint): fftw_plan {
    return plan_dft_help(arr, arr, sign, flags);
  }

  //
  // Though not strictly necessary, this helper routine is to avoid
  // doing the size check for the in-place case.  This is the kind
  // of thing we'd like to mark as "private" once we have that
  // capability.  I could move it into a sub-module for the time
  // being, but want to keep the diff with the previous version of
  // the code minimal.  -BLC
  //
  pragma "no doc"
  proc plan_dft_help(input: [] complex(128), output: [] complex(128),
                 sign: c_int, flags: c_uint) : fftw_plan
  {
    param rank = input.rank;

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = input.domain.dim(i).size.safeCast(c_int);

    return C_FFTW.fftw_plan_dft(rank.safeCast(c_int), dims, input,
                                     output, sign, flags);
  }

  // Real-to-complex and complex-to-real planning routines There are
  // two cases that we treat independently here : in-place and
  // out-of-place transforms

  /*
    Create a plan for a real-to-complex, out-of-place DFT.

    :arg input: The input array, which can be of any rank
    :type input: [] `real(64)`

    :arg output: The output array, whose rank must match the input array's.  The leading dimension of this array should be n/2 + 1, where n is the size of the real array's corresponding dimension.  See the `FFTW documentation <http://www.fftw.org/fftw2_doc/fftw_2.html#SEC6>`_ for more information.
    :type output: [] `complex(128)`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft_r2c(input : [] real(64), output : [] complex(128), flags :c_uint) : fftw_plan
  {
    param rank = input.rank: c_int;

    //
    // TODO: Need runtime size checks
    //

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = input.domain.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_r2c(rank, dims, input, output, flags);
  }

  // In-place routines, note that these take in the true leading dimension
  // TODO : We should put in checks to see that the sizes are consistent
  // TODO : We should check on types...
  /*
    Create a plan for a real-to-complex, in-place DFT.

    :arg realDom: Describes the indices of the 'real' view of the array
    :type realDom: `domain`

    :arg arr: The array to be used as the in-place input/output array.  If passing in an array of `real` elements, the leading dimension of the array must be padded to store 2(n/2)+1 elements, where `n` is the size of the corresponding dimension of `realDom`.  If passing in an array of `complex` elements, the leading dimension should be (n/2 + 1).  See the `FFTW documentation <http://www.fftw.org/fftw2_doc/fftw_2.html#SEC6>`_ for more information.
    :type arr: [] `T` where `T` is of type `real` or `complex`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
   */
  proc plan_dft_r2c(realDom : domain, arr : [] ?t, flags : c_uint) : fftw_plan
  {
    param rank = realDom.rank: c_int;

    //
    // TODO: Need runtime size checks
    //

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = realDom.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_r2c(rank, dims, arr, arr, flags);
  }

  /*
    Create a plan for a complex-to-real, out-of-place DFT.

    :arg input: The input array, which can be of any rank
    :type input: [] `complex(128)`

    :arg output: The output array, whose rank must match the input array's.  The leading dimension of this array should be n/2 + 1, where n is the size of the real array's corresponding dimension.  See the `FFTW documentation <http://www.fftw.org/fftw2_doc/fftw_2.html#SEC6>`_ for more information.
    :type output: [] `real(64)`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft_c2r(input : [] complex(128), output : [] real(64), flags :c_uint) : fftw_plan
  {
    param rank = output.rank: c_int; // The dimensions are that of the real array

    //
    // TODO: Need runtime size checks
    //

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = output.domain.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_c2r(rank, dims, input, output, flags);
  }

  /*
    Create a plan for a complex-to-real, in-place DFT.

    :arg realDom: Describes the indices of the 'real' view of the array
    :type realDom: `domain`

    :arg arr: The array to be used as the in-place input/output array.  If passing in an array of `real` elements, the leading dimension of the array must be padded to store 2(n/2)+1 elements, where `n` is the size of the corresponding dimension of `realDom`.  If passing in an array of `complex` elements, the leading dimension should be (n/2 + 1).  See the `FFTW documentation <http://www.fftw.org/fftw2_doc/fftw_2.html#SEC6>`_ for more information.
    :type arr: [] `T` where `T` is of type `real` or `complex`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
   */
  proc plan_dft_c2r(realDom : domain, arr: [] ?t, flags : c_uint) : fftw_plan
  {
    param rank = realDom.rank: c_int;

    //
    // TODO: Need runtime size checks
    //

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = realDom.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_c2r(rank, dims, arr, arr, flags);
  }

  // Using plans

  /*
    Execute an FFTW plan.

    :arg plan: The plan to execute, as computed by a `plan_dft*()` routine.
    :type plan: fftw_plan
  */
  proc execute(const plan: fftw_plan) {
   C_FFTW.fftw_execute(plan);
  }

  /*
    Destroy an FFTW plan.

    :arg plan: The plan to destroy
    :type plan: fftw_plan
  */
  proc destroy_plan(plan: fftw_plan) {
    C_FFTW.fftw_destroy_plan(plan);
  }

  /*
    Clean up FFTW overall.
  */
  proc cleanup() {
    C_FFTW.fftw_cleanup();
  }

  // Define the various planner flags
  // See Sec. 4.3.2 of FFTW manual "Planner Flags"

  //
  // TODO: Is it weird that we use FFTW_ names here, but not in
  // the routines?  Should we wrap the external flags so that
  // they can be ints or enums and avoid the all-caps C scheme
  // or is the familiarity better?
  //

  // Direction flags

  /* Request a forward transform (i.e., use a negative exponent in the tranform). */
  extern const FFTW_FORWARD : c_int;
  /* Request a backward transform (i.e., use a positive exponent in the transofmr). */
  extern const FFTW_BACKWARD : c_int;

  // Planning-rigor flags

  /* Specify that a simple heuristic should be used to pick a plan
     quickly.  This will prevent the input/output arrays from being
     overwritten during planning. */
  extern const FFTW_ESTIMATE : c_uint;

  /* Specify that FFTW should try and find an optimized plan by
     computing several FFTs and measuring their execution time.
     This can consume some time.
  */
  // TODO: If/when we support defaults, might say something like: This
  // is the default planning option.
  extern const FFTW_MEASURE : c_uint;

  /* Specify that FFTW should expend a greater effort finding an
     optimized plan. */
  extern const FFTW_PATIENT : c_uint;

  /* Specify that FFTW should expend an even greater effort finding an
     optimized plan. */
  extern const FFTW_EXHAUSTIVE : c_uint;

  /* This is a special planning mode that is useful for querying
     whether wisdom is available.  When using it, the plan is only
     created when wisdom is available for the given problem; otherwise
     a `null plan` is returned.  This can be combined with other flags
     to create a plan if the wisdom available was created in that mode
     (e.g., ``FFTW_WISDOM_ONLY | FFW_PATIENT``).  For more details on
     this flag and the previous four, refer to `Section 4.3.2
     <http://www.fftw.org/doc/Planner-Flags.html>`_ of the FFTW manual
  */
  extern const FFTW_WISDOM_ONLY : c_uint;

  // Algorithm-restriction flags

  /* Specify that an out-of-place transform is permitted to overwrite
     its input array with arbitrary data.  This permits more efficient
     algorithms to be used in some cases. */
  // TODO: When we're ready to mention defaults, add: "This is the default for
  // :proc:`plan_dft_c2r`. // NOTE: ...and hc2r once supported...
  extern const FFTW_DESTROY_INPUT : c_uint;

  /* Specify that an out-of-place transform cannot change its input
     array. */
  // TODO: When we're ready to mention defaults, add: This is the
  // default for :proc:`plan_dft` and :proc:`plan_dft_r2c`. */
  extern const FFTW_PRESERVE_INPUT : c_uint;

  /* Specify that the algorithm may not impose any unusual alignment
     requirements on the input/output arrays.  This flag should not be
     necessary for current Chapel use since the planner will
     automatically detect such cases.  For more details on this flag
     and the previous two, refer to `Section 4.3.2
     <http://www.fftw.org/doc/Planner-Flags.html>`_ of the FFTW manual.
  */  // NOTE: But it will be if/when the new-array execute interface is supported
  extern const FFTW_UNALIGNED : c_uint;

  pragma "no doc"
  module C_FFTW {
    extern proc fftw_plan_dft(rank: c_int,
                              n,  // BLC: having trouble being specific
                                  // This is a const int* in C
                              in1: [] complex(128),
                              out1: [] complex(128),
                              sign : c_int, c_flags : c_uint) : fftw_plan;

    extern proc fftw_plan_dft_r2c(rank: c_int,
                                  n,  // BLC: having trouble being specific
                                      // This is a const int* in C
                                  in1: [],
                                  out1: [],
                                  c_flags : c_uint) : fftw_plan;

    extern proc fftw_plan_dft_c2r(rank: c_int,
                                  n,  // BLC: having trouble being specific
                                      // This is a const int* in C
                                  in1: [],
                                  out1: [],
                                  c_flags : c_uint) : fftw_plan;

    extern proc fftw_execute(const plan : fftw_plan);

    extern proc fftw_destroy_plan(plan : fftw_plan);

    extern proc fftw_cleanup();

    extern proc fftw_init_threads() : c_int;

    extern proc fftw_cleanup_threads();

    extern proc fftw_plan_with_nthreads(n : c_int);
  }
}

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

// Wrapper for FFTW version 3.

/*
  FFT computations via key routines from FFTW (version 3)

  This module defines Chapel wrappers for key 64-bit routines from
  FFTW (http://www.fftw.org), version 3.  Over time, the intention is
  to expand this module to support additional routines, prioritizing
  based on requests and feedback from users.  Also, see the
  :mod:`FFTW_MT` module which provides support for calls to the
  multi-threaded FFTW implementation.

  To use this module:

  1. Ensure that FFTW (version 3) is installed on your system and that
     the header and library files (e.g., fftw3.h, libfftw3.*) are
     either installed in a standard system location or that your C
     compiler's environment variables are set up to find them.

  2. Add ``use FFTW;`` to your Chapel code.

  3. Compile and run your Chapel program as usual.

  As in standard FFTW usage, the flow is to:

  1. Create plan(s) using the :proc:`plan_dft* <plan_dft>` routines.

  2. Execute the plan(s) one or more times using :proc:`execute`.

  3. Destroy the plan(s) using :proc:`destroy_plan`.

  4. Call :proc:`cleanup`.

  Note that each of the Chapel :proc:`plan_dft* <plan_dft>` routines
  support both `in-place` and `out-of-place` versions of the
  transforms, where the former versions use a single array for both
  input and output, and the latter use two distinct arrays.

  In future versions of this interface, we anticipate replacing
  C-oriented arguments in the `plan_dft*()` routines (like `flags`)
  with more precise arguments that take advantage of Chapel's support
  for default argument values and keyword-based argument passing.
*/

//
// - How do we feel about FFTW_ALLCAPS names given that the routines
//   themselves don't have fftw_ prefixes, that they're defined as
//   c_int's, and that they're all-caps?
//
// - Related question about fftw_ types taking type c_int, though
//   maybe we don't care that much (as compared to other interfaces)
//   since symbolic values are taken in? (i.e., we won't run into
//   32- vs. 64-bit issues...)
//

module FFTW {

  use SysCTypes;
  use "fftw3.h", "-lfftw3";

  /*
    Disable execution-time array size checks in the FFTW
    :proc:`plan_dft` routine.
   */
  config param noFFTWsizeChecks = false;

  /*
    An opaque type used to store and reuse FFTW plans across multiple
    routines.
  */
  extern type fftw_plan; // opaque type

  // Planner functions
  // Complex : 4.3.1
  // NOTE : We pass in arrays using ref

  // TODO: Can we have the plan_dft() routine below take in native
  // Chapel types without changing the external C constants from
  // type c_int?  Probably given that Chapel's int will be >=
  // C's int for the forseeable future.  See also the TODO above
  // about whether we'd want to represent those constants using
  // more native Chapel types anyway.

  /*
    Creates a plan for an out-of-place complex-to-complex DFT.

    :arg input: The input array, which can be of any rank
    :type input: [] `complex(128)`

    :arg output: The output array, whose size and shape must match the input array's
    :type output: [] `complex(128)`

    :arg sign: :const:`FFTW_FORWARD` or :const:`FFTW_BACKWARD`
    :type sign: c_int

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft(input: [] complex(128), output: [] complex(128),
                 sign: c_int, flags: c_uint) : fftw_plan
  {
    if !noFFTWsizeChecks then
      for i in 1..input.rank do
        if (input.domain.dim(i).size != output.domain.dim(i).size) then
          halt("In plan_dft(), input and output arrays don't have same size in dimension ", i);

    return plan_dft_help(input, output, sign, flags);
  }

  /*
    Creates a plan for an in-place complex-to-complex DFT.

    :arg arr: The array to use as the in-place input/output array.
    :type arr: [] `complex(128)`

    :arg sign: :const:`FFTW_FORWARD` or :const:`FFTW_BACKWARD`
    :type sign: c_int

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft(arr: [] complex(128), sign: c_int, flags: c_uint): fftw_plan {
    return plan_dft_help(arr, arr, sign, flags);
  }

  //
  // Though not strictly necessary, this helper routine is to avoid
  // doing the size check for the in-place case.  This is the kind
  // of thing we'd like to mark as "private" once we have that
  // capability.  I could move it into a sub-module for the time
  // being, but want to keep the diff with the previous version of
  // the code minimal.  -BLC
  //
  pragma "no doc"
  proc plan_dft_help(input: [] complex(128), output: [] complex(128),
                 sign: c_int, flags: c_uint) : fftw_plan
  {
    param rank = input.rank;

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = input.domain.dim(i).size.safeCast(c_int);

    return C_FFTW.fftw_plan_dft(rank.safeCast(c_int), dims, input,
                                     output, sign, flags);
  }

  // Real-to-complex and complex-to-real planning routines There are
  // two cases that we treat independently here : in-place and
  // out-of-place transforms

  /*
    Create a plan for a real-to-complex, out-of-place DFT.

    :arg input: The input array, which can be of any rank
    :type input: [] `real(64)`

    :arg output: The output array, whose rank must match the input array's.  The leading dimension of this array should be n/2 + 1, where n is the size of the real array's corresponding dimension.  See the `FFTW documentation <http://www.fftw.org/fftw2_doc/fftw_2.html#SEC6>`_ for more information.
    :type output: [] `complex(128)`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft_r2c(input : [] real(64), output : [] complex(128), flags :c_uint) : fftw_plan
  {
    param rank = input.rank: c_int;

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = input.domain.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_r2c(rank, dims, input, output, flags);
  }

  // In-place routines, note that these take in the true leading dimension
  // TODO : We should put in checks to see that the sizes are consistent
  // TODO : We should check on types...
  /*
    Create a plan for a real-to-complex, in-place DFT.

    :arg realDom: Describes the indices of the 'real' view of the array
    :type realDom: `domain`

    :arg arr: The array to be used as the in-place input/output array.  If passing in an array of `real` elements, the leading dimension of the array must be padded to store 2(n/2)+1 elements, where `n` is the size of the corresponding dimension of `realDom`.  If passing in an array of `complex` elements, the leading dimension should be (n/2 + 1).  See the `FFTW documentation <http://www.fftw.org/fftw2_doc/fftw_2.html#SEC6>`_ for more information.
    :type arr: [] `T` where `T` is of type `real` or `complex`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
   */
  proc plan_dft_r2c(realDom : domain, arr : [] ?t, flags : c_uint) : fftw_plan
  {
    param rank = realDom.rank: c_int;

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = realDom.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_r2c(rank, dims, arr, arr, flags);
  }

  /*
    Create a plan for a complex-to-real, out-of-place DFT.

    :arg input: The input array, which can be of any rank
    :type input: [] `complex(128)`

    :arg output: The output array, whose rank must match the input array's.  The leading dimension of this array should be n/2 + 1, where n is the size of the real array's corresponding dimension.  See the `FFTW documentation <http://www.fftw.org/fftw2_doc/fftw_2.html#SEC6>`_ for more information.
    :type output: [] `real(64)`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft_c2r(input : [] complex(128), output : [] real(64), flags :c_uint) : fftw_plan
  {
    param rank = output.rank: c_int; // The dimensions are that of the real array

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = output.domain.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_c2r(rank, dims, input, output, flags);
  }

  /*
    Create a plan for a complex-to-real, in-place DFT.

    :arg realDom: Describes the indices of the 'real' view of the array
    :type realDom: `domain`

    :arg arr: The array to be used as the in-place input/output array.  If passing in an array of `real` elements, the leading dimension of the array must be padded to store 2(n/2)+1 elements, where `n` is the size of the corresponding dimension of `realDom`.  If passing in an array of `complex` elements, the leading dimension should be (n/2 + 1).  See the `FFTW documentation <http://www.fftw.org/fftw2_doc/fftw_2.html#SEC6>`_ for more information.
    :type arr: [] `T` where `T` is of type `real` or `complex`

    :arg flags: the bitwise-or of any planning-rigor or algorithm-restriction flags that should be used in creating the plan (e.g., :const:`FFTW_MEASURE` ``|`` :const:`FFTW_PRESERVE_INPUT`)
    :type flags: c_int

    :returns: The :type:`fftw_plan` representing the resulting plan
   */
  proc plan_dft_c2r(realDom : domain, arr: [] ?t, flags : c_uint) : fftw_plan
  {
    param rank = realDom.rank: c_int;

    var dims: rank*c_int;
    for param i in 1..rank do
      dims(i) = realDom.dim(i).size: c_int;

    return C_FFTW.fftw_plan_dft_c2r(rank, dims, arr, arr, flags);
  }

  // Using plans

  /*
    Execute an FFTW plan.

    :arg plan: The plan to execute, as computed by a `plan_dft*()` routine.
    :type plan: fftw_plan
  */
  proc execute(const plan: fftw_plan) {
   C_FFTW.fftw_execute(plan);
  }

  /*
    Destroy an FFTW plan.

    :arg plan: The plan to destroy
    :type plan: fftw_plan
  */
  proc destroy_plan(plan: fftw_plan) {
    C_FFTW.fftw_destroy_plan(plan);
  }

  /*
    Clean up FFTW overall.
  */
  proc cleanup() {
    C_FFTW.fftw_cleanup();
  }

  // Define the various planner flags
  // See Sec. 4.3.2 of FFTW manual "Planner Flags"

  //
  // TODO: Is it weird that we use FFTW_ names here, but not in
  // the routines?  Should we wrap the external flags so that
  // they can be ints or enums and avoid the all-caps C scheme
  // or is the familiarity better?
  //

  // Direction flags

  /* Request a forward transform (i.e., use a negative exponent in the tranform). */
  extern const FFTW_FORWARD : c_int;
  /* Request a backward transform (i.e., use a positive exponent in the transofmr). */
  extern const FFTW_BACKWARD : c_int;

  // Planning-rigor flags

  /* Specify that a simple heuristic should be used to pick a plan
     quickly.  This will prevent the input/output arrays from being
     overwritten during planning. */
  extern const FFTW_ESTIMATE : c_uint;

  /* Specify that FFTW should try and find an optimized plan by
     computing several FFTs and measuring their execution time.
     This can consume some time.
  */
  // TODO: If/when we support defaults, might say something like: This
  // is the default planning option.
  extern const FFTW_MEASURE : c_uint;

  /* Specify that FFTW should expend a greater effort finding an
     optimized plan. */
  extern const FFTW_PATIENT : c_uint;

  /* Specify that FFTW should expend an even greater effort finding an
     optimized plan. */
  extern const FFTW_EXHAUSTIVE : c_uint;

  /* This is a special planning mode that is useful for querying
     whether wisdom is available.  When using it, the plan is only
     created when wisdom is available for the given problem; otherwise
     a `null plan` is returned.  This can be combined with other flags
     to create a plan if the wisdom available was created in that mode
     (e.g., ``FFTW_WISDOM_ONLY | FFW_PATIENT``).  For more details on
     this flag and the previous four, refer to `Section 4.3.2
     <http://www.fftw.org/doc/Planner-Flags.html>`_ of the FFTW manual
  */
  extern const FFTW_WISDOM_ONLY : c_uint;

  // Algorithm-restriction flags

  /* Specify that an out-of-place transform is permitted to overwrite
     its input array with arbitrary data.  This permits more efficient
     algorithms to be used in some cases. */
  // TODO: When we're ready to mention defaults, add: "This is the default for
  // :proc:`plan_dft_c2r`. // NOTE: ...and hc2r once supported...
  extern const FFTW_DESTROY_INPUT : c_uint;

  /* Specify that an out-of-place transform cannot change its input
     array. */
  // TODO: When we're ready to mention defaults, add: This is the
  // default for :proc:`plan_dft` and :proc:`plan_dft_r2c`. */
  extern const FFTW_PRESERVE_INPUT : c_uint;

  /* Specify that the algorithm may not impose any unusual alignment
     requirements on the input/output arrays.  This flag should not be
     necessary for current Chapel use since the planner will
     automatically detect such cases.  For more details on this flag
     and the previous two, refer to `Section 4.3.2
     <http://www.fftw.org/doc/Planner-Flags.html>`_ of the FFTW manual.
  */  // NOTE: But it will be if/when the new-array execute interface is supported
  extern const FFTW_UNALIGNED : c_uint;

  pragma "no doc"
  module C_FFTW {
    extern proc fftw_plan_dft(rank: c_int,
                              n,  // BLC: having trouble being specific
                                  // This is a const int* in C
                              in1: [] complex(128),
                              out1: [] complex(128),
                              sign : c_int, c_flags : c_uint) : fftw_plan;

    extern proc fftw_plan_dft_r2c(rank: c_int,
                                  n,  // BLC: having trouble being specific
                                      // This is a const int* in C
                                  in1: [],
                                  out1: [],
                                  c_flags : c_uint) : fftw_plan;

    extern proc fftw_plan_dft_c2r(rank: c_int,
                                  n,  // BLC: having trouble being specific
                                      // This is a const int* in C
                                  in1: [],
                                  out1: [],
                                  c_flags : c_uint) : fftw_plan;

    extern proc fftw_execute(const plan : fftw_plan);

    extern proc fftw_destroy_plan(plan : fftw_plan);

    extern proc fftw_cleanup();

    extern proc fftw_init_threads() : c_int;

    extern proc fftw_cleanup_threads();

    extern proc fftw_plan_with_nthreads(n : c_int);
  }
}


Made hand-blocked stream take advantage of Steve's bug fix

Removed the workaround I was using to get around conditional
expressions in initialize() functions thanks to Steve's quick
fix.  Also, added a config param to generate some debugging
output that I had previously commented out.

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

// TODO: Make these into an official distribution?

// TODO: Fold in leader/follower iterator ideas

// TODO: Would using nested classes allow me to avoid so much
// passing around of globIndexType and locIndexType?

config param debugBradsBlock1D = false;

//
// The distribution class
//
class Block1DDist {
  //
  // The distribution's index type and domain's global index type
  //
  type glbIdxType = int(64);

  //
  // The bounding box that defines the block distribution
  //
  const bbox: domain(1, glbIdxType);

  //
  // the set of target locales to which the indices are mapped
  //
  const targetLocs = Locales; // TODO: would like to assert that this is a 1D
                              // array of locales and maybe remove the default
                              // initializer

  //
  // an associative domain over the set of target locales
  //
  // TODO: Try to write this a different way without using
  // associative domains/arrays of locales
  //
  const targetLocDom: domain(locale) = targetLocs;

  //
  // an associative array of local distribution class descriptors --
  // set up in initialize() below
  //
  // TODO: would like this to be const and initialize in-place,
  // removing the initialize method
  //
  var locDist: [targetLocDom] LocBlock1DDist(glbIdxType, index(targetLocs.domain));

  def initialize() {
    for (loc, locid) in (targetLocs, 0..) do
      on loc do
        locDist(loc) = new LocBlock1DDist(glbIdxType, locid, this);
  }

  //
  // Create a new domain over this distribution with the given index
  // set (inds) and the given global and local index type (idxType,
  // locIdxType)
  //
  def newDomain(inds, type idxType = glbIdxType, type locIdxType = idxType) {
    // Note that I'm fixing the global and local index types to be the
    // same, but making this a generic function would fix this
    return new Block1DDom(idxType, locIdxType, this, inds);
  }

  //
  // compute what chunk of inds is owned by a given locale -- assumes
  // it's being called on the locale in question
  //
  def getChunk(inds) {
    // use domain slicing to get the intersection between what the
    // locale owns and the domain's index set
    return locDist(here).myChunk[inds.low..inds.high];
  }

  //
  // Determine which locale owns a particular index
  //
  def ind2loc(ind: glbIdxType) {
    return targetLocs((((ind-bbox.low)*targetLocs.numElements)/bbox.numIndices):index(targetLocs.domain));
  }
}

//
// A per-locale local distribution class
//
class LocBlock1DDist {
  //
  // The distribution's index type and domain's global index type
  //
  type glbIdxType;

  //
  // The following members store (a) the locale ID as a 0-based
  // integer; (b) a reference to the global distribution
  //
  // TODO: don't really want to store these here; should be able to
  // make the things it wants access to arguments to a user-defined
  // constructor instead (but we don't support those for generic
  // classes well yet).
  //
  const locid;
  const dist: Block1DDist(glbIdxType);

  //
  // This stores the piece of the global bounding box owned by
  // the locale.  Note that my original guess that we'd want
  // to use lclIdxType here is wrong since we're talking about
  // the section of the global index space owned by the locale.
  //
  const myChunk: domain(1, glbIdxType);

  //
  // a helper function for mapping processors to indices
  //
  def procToData(x, lo)
    return (lo + (x: lo.type) + (x:real != x:int:real));

  //
  // Compute what chunk of index(1) is owned by the current locale
  //
  def initialize() {
    const lo = dist.bbox.low;
    const hi = dist.bbox.high;
    const numelems = hi - lo + 1;
    const numlocs = dist.targetLocs.numElements;
    const blo = if (locid == 0) then min(glbIdxType)
                else procToData((numelems: real * locid) / numlocs, lo);
    const bhi = if (locid == numlocs - 1) then max(glbIdxType)
                else procToData((numelems: real * (locid+1)) / numlocs, lo) - 1;
    myChunk = [blo..bhi];
    if debugBradsBlock1D then
      writeln("locale ", locid, " owns ", myChunk);
  }
}

//
// The global domain class
//
class Block1DDom {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // a pointer to the parent distribution
  //
  const dist: Block1DDist(glbIdxType);

  //
  // a domain describing the complete domain
  //
  const whole: domain(1, glbIdxType);

  //
  // an associative array of local domain class descriptors -- set up
  // in initialize() below
  //
  // TODO: would like this to be const and initialize in-place,
  // removing the initialize method
  //
  var locDom: [dist.targetLocDom] LocBlock1DDom(glbIdxType, lclIdxType);

  def initialize() {
    for loc in dist.targetLocs do
      on loc do
        locDom(loc) = new LocBlock1DDom(glbIdxType, lclIdxType, this, dist.getChunk(whole));
    if debugBradsBlock1D then
      [loc in dist.targetLocs] writeln(loc, " owns ", locDom(loc));
  }

  //
  // the iterator for the domain -- currently sequential
  //
  def these() {
    for blk in locDom do
      // May want to do something like:
      // on blk do
      // But can't currently have yields in on clauses
        for ind in blk do
          yield ind;
  }

  //
  // the print method for the domain
  //
  def writeThis(x:Writer) {
    x.write(whole);
  }

  //
  // how to allocate a new array over this domain
  //
  def newArray(type elemType) {
    return new Block1DArr(glbIdxType, lclIdxType, elemType, this);
  }

  //
  // queries for the number of indices, low, and high bounds
  //
  def numIndices {
    return whole.numIndices;
  }

  def low {
    return whole.low;
  }

  def high {
    return whole.high;
  }
}

//
// the local domain class
//
class LocBlock1DDom {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // a reference to the parent global domain class
  //
  const wholeDom: Block1DDom(glbIdxType, lclIdxType);

  //
  // a local domain describing the indices owned by this locale
  //
  var myBlock: domain(1, lclIdxType);

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

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

  //
  // queries for this locale's number of indices, low, and high bounds
  //
  def numIndices {
    return myBlock.numIndices;
  }

  def low {
    return myBlock.low;
  }

  def high {
    return myBlock.high;
  }
}

//
// the global array class
//
class Block1DArr {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

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

  //
  // the global domain descriptor for this array
  //
  var dom: Block1DDom(glbIdxType, lclIdxType);

  //
  // an associative array of local array classes, indexed by locale
  //
  // TODO: would like this to be const and initialize in-place,
  // removing the initialize method
  //
  var locArr: [dom.dist.targetLocDom] LocBlock1DArr(glbIdxType, lclIdxType, elemType);

  def initialize() {
    for loc in dom.dist.targetLocs do
      on loc do
        locArr(loc) = new LocBlock1DArr(glbIdxType, lclIdxType, elemType, dom.locDom(loc));
  }

  //
  // the global accessor for the array
  //
  def this(i: glbIdxType) var {
    return locArr(dom.dist.ind2loc(i))(i);
  }

  //
  // the iterator over the array's elements, currently sequential
  //
  def these() var {
    for loc in dom.dist.targetLocs {
      // May want to do something like:
      // on this do
      // But can't currently have yields in on clauses
      for elem in locArr(loc) {
        yield elem;
      }
    }
  }

  //
  // how to print out the whole array, sequentially
  //
  def writeThis(x: Writer) {
    var first = true;
    for loc in dom.dist.targetLocs {
      // May want to do something like the following:
      //      on loc {
      // but it causes deadlock -- see writeThisUsingOn.chpl
        if (locArr(loc).numElements >= 1) {
          if (first) {
            first = false;
          } else {
            x.write(" ");
          }
          x.write(locArr(loc));
        }
        //    }
      stdout.flush();
    }
  }

  //
  // a query for the number of elements in the array
  //
  def numElements {
    return dom.numIndices;
  }
}

//
// the local array class
//
class LocBlock1DArr {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // the element type
  //
  type elemType;

  //
  // a reference to the local domain class for this array and locale
  //
  const locDom: LocBlock1DDom(glbIdxType, lclIdxType);

  //
  // the block of local array data
  //
  var myElems: [locDom.myBlock] elemType;

  //
  // the accessor for the local array -- assumes the index is local
  //
  def this(i: lclIdxType) var {
    return myElems(i);
  }

  //
  // iterator over the elements owned by this locale
  //
  def these() var {
    for elem in myElems {
      yield elem;
    }
  }

  //
  // prints out this locale's piece of the array
  //
  def writeThis(x: Writer) {
    // May want to do something like the following:
    //      on loc {
    // but it causes deadlock -- see writeThisUsingOn.chpl
    x.write(myElems);
  }

  //
  // query for the number of local array elements
  //
  def numElements {
    return myElems.numElements;
  }
}

// TODO: Would using nested classes allow me to avoid so much
// passing around of globIndexType and locIndexType?

//
// The distribution class
//
class Block1DDist {
  //
  // The distribution's index type and domain's global index type
  //
  type glbIdxType = int(64);

  //
  // The bounding box that defines the block distribution
  //
  const bbox: domain(1, glbIdxType);

  //
  // the set of target locales to which the indices are mapped
  //
  const targetLocs = Locales; // TODO: would like to assert that this is a 1D
                              // array of locales and maybe remove the default
                              // initializer

  //
  // an associative domain over the set of target locales
  //
  // TODO: Try to write this a different way without using
  // associative domains/arrays of locales
  //
  const targetLocDom: domain(locale) = targetLocs;

  //
  // an associative array of local distribution class descriptors --
  // set up in initialize() below
  //
  // TODO: would like this to be const and initialize in-place,
  // removing the initialize method
  //
  var locDist: [targetLocDom] LocBlock1DDist(glbIdxType, index(targetLocs.domain));

  def initialize() {
    for (loc, locid) in (targetLocs, 0..) do
      on loc do
        locDist(loc) = new LocBlock1DDist(glbIdxType, locid, this);
  }

  //
  // Create a new domain over this distribution with the given index
  // set (inds) and the given global and local index type (idxType,
  // locIdxType)
  //
  def newDomain(inds, type idxType = glbIdxType, type locIdxType = idxType) {
    // Note that I'm fixing the global and local index types to be the
    // same, but making this a generic function would fix this
    return new Block1DDom(idxType, locIdxType, this, inds);
  }

  //
  // compute what chunk of inds is owned by a given locale -- assumes
  // it's being called on the locale in question
  //
  def getChunk(inds) {
    // use domain slicing to get the intersection between what the
    // locale owns and the domain's index set
    return locDist(here).myChunk[inds.low..inds.high];
  }

  //
  // Determine which locale owns a particular index
  //
  def ind2loc(ind: glbIdxType) {
    return targetLocs((((ind-bbox.low)*targetLocs.numElements)/bbox.numIndices):index(targetLocs.domain));
  }
}

//
// A per-locale local distribution class
//
class LocBlock1DDist {
  //
  // The distribution's index type and domain's global index type
  //
  type glbIdxType;

  //
  // The following members store (a) the locale ID as a 0-based
  // integer; (b) a reference to the global distribution
  //
  // TODO: don't really want to store these here; should be able to
  // make the things it wants access to arguments to a user-defined
  // constructor instead (but we don't support those for generic
  // classes well yet).
  //
  const locid;
  const dist: Block1DDist(glbIdxType);

  //
  // This stores the piece of the global bounding box owned by
  // the locale.  Note that my original guess that we'd want
  // to use lclIdxType here is wrong since we're talking about
  // the section of the global index space owned by the locale.
  //
  const myChunk: domain(1, glbIdxType);

  //
  // a helper function for mapping processors to indices
  //
  def procToData(x, lo)
    return (lo + (x: lo.type) + (x:real != x:int:real));

  //
  // Compute what chunk of index(1) is owned by the current locale
  //
  def initialize() {
    const lo = dist.bbox.low;
    const hi = dist.bbox.high;
    const numelems = hi - lo + 1;
    const numlocs = dist.targetLocs.numElements;
    var blo = procToData((numelems: real * locid) / numlocs, lo);
    var bhi = procToData((numelems: real * (locid+1)) / numlocs, lo) - 1;
    if (locid == 0) then blo = min(glbIdxType);
    if (locid == numlocs-1) then bhi = max(glbIdxType);
  /* TODO: Why don't these work instead of the above?
    const blo = if (locid == 0) then min(glbIdxType)
                else procToData((numelems: real * locid) / numlocs, lo);
    const bhi = if (locid == numlocs - 1) then max(glbIdxType)
                else procToData((numelems: real * (locid+1)) / numlocs, lo) - 1;
  */
    myChunk = [blo..bhi];
    //    writeln("locale ", locid, " owns ", myChunk);
  }
}

//
// The global domain class
//
class Block1DDom {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // a pointer to the parent distribution
  //
  const dist: Block1DDist(glbIdxType);

  //
  // a domain describing the complete domain
  //
  const whole: domain(1, glbIdxType);

  //
  // an associative array of local domain class descriptors -- set up
  // in initialize() below
  //
  // TODO: would like this to be const and initialize in-place,
  // removing the initialize method
  //
  var locDom: [dist.targetLocDom] LocBlock1DDom(glbIdxType, lclIdxType);

  def initialize() {
    for loc in dist.targetLocs do
      on loc do
        locDom(loc) = new LocBlock1DDom(glbIdxType, lclIdxType, this, dist.getChunk(whole));
    //    [loc in dist.targetLocs] writeln(loc, " owns ", locDom(loc));
  }

  //
  // the iterator for the domain -- currently sequential
  //
  def these() {
    for blk in locDom do
      // May want to do something like:
      // on blk do
      // But can't currently have yields in on clauses
        for ind in blk do
          yield ind;
  }

  //
  // the print method for the domain
  //
  def writeThis(x:Writer) {
    x.write(whole);
  }

  //
  // how to allocate a new array over this domain
  //
  def newArray(type elemType) {
    return new Block1DArr(glbIdxType, lclIdxType, elemType, this);
  }

  //
  // queries for the number of indices, low, and high bounds
  //
  def numIndices {
    return whole.numIndices;
  }

  def low {
    return whole.low;
  }

  def high {
    return whole.high;
  }
}

//
// the local domain class
//
class LocBlock1DDom {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // a reference to the parent global domain class
  //
  const wholeDom: Block1DDom(glbIdxType, lclIdxType);

  //
  // a local domain describing the indices owned by this locale
  //
  var myBlock: domain(1, lclIdxType);

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

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

  //
  // queries for this locale's number of indices, low, and high bounds
  //
  def numIndices {
    return myBlock.numIndices;
  }

  def low {
    return myBlock.low;
  }

  def high {
    return myBlock.high;
  }
}

//
// the global array class
//
class Block1DArr {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

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

  //
  // the global domain descriptor for this array
  //
  var dom: Block1DDom(glbIdxType, lclIdxType);

  //
  // an associative array of local array classes, indexed by locale
  //
  // TODO: would like this to be const and initialize in-place,
  // removing the initialize method
  //
  var locArr: [dom.dist.targetLocDom] LocBlock1DArr(glbIdxType, lclIdxType, elemType);

  def initialize() {
    for loc in dom.dist.targetLocs do
      on loc do
        locArr(loc) = new LocBlock1DArr(glbIdxType, lclIdxType, elemType, dom.locDom(loc));
  }

  //
  // the global accessor for the array
  //
  def this(i: glbIdxType) var {
    return locArr(dom.dist.ind2loc(i))(i);
  }

  //
  // the iterator over the array's elements, currently sequential
  //
  def these() var {
    for loc in dom.dist.targetLocs {
      // May want to do something like:
      // on this do
      // But can't currently have yields in on clauses
      for elem in locArr(loc) {
        yield elem;
      }
    }
  }

  //
  // how to print out the whole array, sequentially
  //
  def writeThis(x: Writer) {
    var first = true;
    for loc in dom.dist.targetLocs {
      // May want to do something like the following:
      //      on loc {
      // but it causes deadlock -- see writeThisUsingOn.chpl
        if (locArr(loc).numElements >= 1) {
          if (first) {
            first = false;
          } else {
            x.write(" ");
          }
          x.write(locArr(loc));
        }
        //    }
      stdout.flush();
    }
  }

  //
  // a query for the number of elements in the array
  //
  def numElements {
    return dom.numIndices;
  }
}

//
// the local array class
//
class LocBlock1DArr {
  //
  // The index types of the global and local domain portions
  //
  type glbIdxType;
  type lclIdxType;

  //
  // the element type
  //
  type elemType;

  //
  // a reference to the local domain class for this array and locale
  //
  const locDom: LocBlock1DDom(glbIdxType, lclIdxType);

  //
  // the block of local array data
  //
  var myElems: [locDom.myBlock] elemType;

  //
  // the accessor for the local array -- assumes the index is local
  //
  def this(i: lclIdxType) var {
    return myElems(i);
  }

  //
  // iterator over the elements owned by this locale
  //
  def these() var {
    for elem in myElems {
      yield elem;
    }
  }

  //
  // prints out this locale's piece of the array
  //
  def writeThis(x: Writer) {
    // May want to do something like the following:
    //      on loc {
    // but it causes deadlock -- see writeThisUsingOn.chpl
    x.write(myElems);
  }

  //
  // query for the number of local array elements
  //
  def numElements {
    return myElems.numElements;
  }
}


Fixed a bug in which a write could execute unatomically if two writes
from remote locales are executed by threads that have the same thread
ID.  Made it so the on-statement wraps the code that grabs the lock,
instead of the other way around.

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

// class file
//
//  chapel-level implementations of read, write, writeln
//  chapel-level implementations of assert, halt

enum FileAccessMode { read, write };

//
// functions on _file primitive type, the C file pointer type
//
pragma "inline" def =(a: _file, b: _file) return b;
pragma "inline" def ==(a: _file, b: _file) return __primitive("==", a, b);
pragma "inline" def !=(a: _file, b: _file) return __primitive("!=", a, b);

pragma "inline" def _readLitChar(fp: _file, val: string, ignoreWhiteSpace: bool)
  return __primitive("_fscan_literal", fp, val, ignoreWhiteSpace);

const stdin  = new file("stdin", FileAccessMode.read, "/dev", __primitive("get_stdin"));
const stdout = new file("stdout", FileAccessMode.write, "/dev", __primitive("get_stdout"));
const stderr = new file("stderr", FileAccessMode.write, "/dev", __primitive("get_stderr"));

class file: Writer {
  var filename : string = "";
  var mode : FileAccessMode = FileAccessMode.read;
  var path : string = ".";
  var _fp : _file;
  var _lock : sync uint(64);    // for serializing output

  def open() {
    on this {
      if this == stdin || this == stdout || this == stderr then
        halt("***Error: It is not necessary to open \"", filename, "\"***");

      var fullFilename = path + "/" + filename;

      var modestring: string;
      select mode {
        when FileAccessMode.read  do modestring = "r";
        when FileAccessMode.write do modestring = "w";
      }
      _fp = __primitive("fopen", filename, modestring);

      if _fp == __primitive("get_nullfile") then
        halt("***Error: Unable to open \"", fullFilename, "\": ", __primitive("get_errno"), "***");
    }
  }

  def _checkFileStateChangeLegality(state) {
    if (isOpen) {
      halt("Cannot change ", state, " of file ", path, "/", filename,
           " while it is open");
    }
  }

  def filename var : string {
    if setter then
      _checkFileStateChangeLegality("filename");
    return filename;
  }

  def path var : string {
    if setter then
      _checkFileStateChangeLegality("path");
    return path;
  }

  def mode var {
    if setter then
      _checkFileStateChangeLegality("mode");
    return mode;
  }

  def isOpen: bool {
    var openStatus: bool = false;
    if (_fp != __primitive("get_nullfile")) {
      openStatus = true;
    }
    return openStatus;
  }

  def close() {
    on this {
      if (this == stdin || this == stdout || this == stderr) {
        halt("***Error: You may not close \"", filename, "\"***");
      }
      if (_fp == __primitive("get_nullfile")) {
        var fullFilename = path + "/" + filename;
        halt("***Error: Trying to close \"", fullFilename,
             "\" which isn't open***");
      }
      var returnVal: int = __primitive("fclose", _fp);
      if (returnVal < 0) {
        var fullFilename = path + "/" + filename;
        halt("***Error: The close of \"", fullFilename, "\" failed: ",
             __primitive("get_errno"), "***");
      }
      _fp = __primitive("get_nullfile");
    }
  }
}

def file.writeThis(f: Writer) {
  f.write("(filename = ",this.filename);
  f.write(", path = ",this.path);
  f.write(", mode = ",this.mode);
  f.write(")");
}

def file.flush() {
  on this do __primitive("fflush", _fp);
}

def _checkOpen(f: file, isRead: bool) {
  if !f.isOpen {
    var fullFilename:string = f.path + "/" + f.filename;
    if isRead {
      halt("***Error: You must open \"", fullFilename,
           "\" before trying to read from it***");
    } else {
      halt("***Error: You must open \"", fullFilename,
           "\" before trying to write to it***");
    }
  }
}

def file.readln() {
  on this {
    if !isOpen then
      _checkOpen(this, isRead=true);
    __primitive("_readToEndOfLine",_fp);
  }
}

def file.readln(inout list ...?n) {
  read((...list));
  on this {
    __primitive("_readToEndOfLine",_fp);
  }
}

def file.readln(type t) {
  var val: t;
  this.readln(val);
  return val;
}

def file.read(inout first, inout rest ...?n) {
  read(first);
  for param i in 1..n do
    read(rest(i));
}

def file.read(inout val: int) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: int;
  on this {
    x = __primitive("_fscan_int32", _fp);
  }
  val = x;
}

def file.read(inout val: uint) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: uint;
  on this {
    x = __primitive("_fscan_uint32", _fp);
  }
  val = x;
}

def file.read(inout val: real) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: real;
  on this {
    x = __primitive("_fscan_real64", _fp);
  }
  val = x;
}

def file.read(inout val: complex) {
  var realPart: real;
  var imagPart: real;
  var imagI: string;
  var matchingCharWasRead: int;
  var isNeg: bool;

  read(realPart);
  on this {
    matchingCharWasRead = _readLitChar(_fp, "+", true);
  }
  if (matchingCharWasRead != 1) {
    on this {
      matchingCharWasRead = _readLitChar(_fp, "-", true);
    }
    if (matchingCharWasRead != 1) {
      halt("***Error: Incorrect format for complex numbers***");
    }
    isNeg = true;
  }

  read(imagPart);
  on this {
    matchingCharWasRead = _readLitChar(_fp, "i", false);
  }
  if (matchingCharWasRead != 1) {
    halt("***Error: Incorrect format for complex numbers***");
  }

  val.re = realPart;
  if (isNeg) {
    val.im = -imagPart;
  } else {
    val.im = imagPart;
  }
}

def file.read(inout val: string) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: string;
  on this {
    x = __primitive("_fscan_string", _fp);
  }
  val = x;
}

def file.read(inout val: bool) {
  var s: string;
  this.read(s);
  if (s == "true") {
    val = true;
  } else if (s == "false") {
    val = false;
  } else {
    halt("read of bool value that is neither true nor false");
  }
}

def file.read(type t) {
  var val: t;
  this.read(val);
  return val;
}

def string.writeThis(f: Writer) {
  f.writeIt(this);
}

def file.writeIt(s: string) {
  if !isOpen then
    _checkOpen(this, isRead = false);
  if mode != FileAccessMode.write then
    halt("***Error: ", path, "/", filename, " not open for writing***");
  var status = __primitive("fprintf", _fp, "%s", s);
  if status < 0 then
    halt("***Error: Write failed: ", __primitive("get_errno"), "***");
}

class StringClass: Writer {
  var s: string;
  def writeIt(s: string) { this.s += s; }
}

pragma "ref this"
def string.write(args ...?n) {
  var sc = new StringClass(this);
  sc.write((...args));
  this = sc.s;
}

def file.lockWrite() {
  var me: uint(64) = __primitive("thread_id");
  if _lock.isFull then
    if _lock.readXX() == me then
      return false;
  _lock = me;
  return true;
}

def file.unlockWrite() {
  _lock.reset();
}

class Writer {
  def writeIt(s: string) { }
  def lockWrite() return false;
  def unlockWrite() { }
  def write(args ...?n) {
    on this {
      var need_release: bool;
      need_release = lockWrite();
      for param i in 1..n do
        args(i).writeThis(this);
      if need_release then
        unlockWrite();
    }
  }
  def writeln(args ...?n) {
    write((...args), "\n");
  }
  def writeln() {
    write("\n");
  }
}

def write(args ...?n) {
  stdout.write((...args));
}

def writeln(args ...?n) {
  stdout.writeln((...args));
}

def writeln() {
  stdout.writeln();
}

def read(inout args ...?n) {
  stdin.read((...args));
}

def readln(inout args ...?n) {
  stdin.readln((...args));
}

def readln() {
  stdin.readln();
}

def readln(type t) {
  return stdin.readln(t);
}

def read(type t)
  return stdin.read(t);

def file.readln(type t ...?numTypes) where numTypes > 1 {
  var tupleVal: t;
  for param i in 1..numTypes-1 do
    tupleVal(i) = this.read(t(i));
  tupleVal(numTypes) = this.readln(t(numTypes));
  return tupleVal;
}

def file.read(type t ...?numTypes) where numTypes > 1 {
  var tupleVal: t;
  for param i in 1..numTypes do
    tupleVal(i) = this.read(t(i));
  return tupleVal;
}

def readln(type t ...?numTypes) where numTypes > 1
  return stdin.readln((...t));

def read(type t ...?numTypes) where numTypes > 1
  return stdin.read((...t));

def _tuple2string(t) {
  var s: string;
  for param i in 1..t.size do
    s.write(t(i));
  return s;
}

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

def assert(test: bool, args ...?numArgs) {
  if !test then
    __primitive("chpl_error", "assert failed - "+_tuple2string(args));
}

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

def halt(args ...?numArgs) {
  __primitive("chpl_error", "halt reached - "+_tuple2string(args));
}

def _debugWrite(args: string ...?n) {
  for param i in 1..n {
    var status = __primitive("fprintf", __primitive("get_stdout"), "%s", args(i));
    if status < 0 then
      halt("_debugWrite failed with status ", __primitive("get_errno"));
  }
  __primitive("fflush", __primitive("get_stdout"));
}

def _debugWriteln(args: string ...?n) {
  _debugWrite((...args), "\n");
}

def _debugWriteln() {
  _debugWrite("\n");
}

def _ddata.writeThis(f: Writer) {
  for i in 0..size-2 do
    f.write(this(i), " ");
  f.write(this(size-1));
}

def format(fmt: string, x:?t) where _isIntegralType(t) || _isFloatType(t) {
  if fmt.substring(1) == "#" {
    var fmt2 = _getoutputformat(fmt);
    if _isImagType(t) then
      return (__primitive("_format", fmt2, _i2r(x))+"i");
    else
      return __primitive("_format", fmt2, x:real);
  } else
    return __primitive("_format", fmt, x);
}

def format(fmt: string, x:?t) where _isComplexType(t) {
  if fmt.substring(1) == "#" {
    var fmt2 = _getoutputformat(fmt);
    return (__primitive("_format", fmt2, x.re)+" + "+ __primitive("_format", fmt2, x.im)+"i");
  } else
    return __primitive("_format", fmt, x);
}

def format(fmt: string, x: ?t) where !(_isIntegralType(t) || _isFloatType(t) || _isComplexType(t)) {
  return __primitive("_format", fmt, x);
}

def _getoutputformat(s: string):string {
  var sn = length(s);
  var afterdot = false;
  var dplaces = 0;
  for i in 1..sn {
    if ((s.substring(i) == '#') & afterdot) then dplaces += 1;
    if (s.substring(i) == '.') then afterdot=true;
  }

  return("%" + sn + "." + dplaces + "f");
}

// class file
//
//  chapel-level implementations of read, write, writeln
//  chapel-level implementations of assert, halt

enum FileAccessMode { read, write };

//
// functions on _file primitive type, the C file pointer type
//
pragma "inline" def =(a: _file, b: _file) return b;
pragma "inline" def ==(a: _file, b: _file) return __primitive("==", a, b);
pragma "inline" def !=(a: _file, b: _file) return __primitive("!=", a, b);

pragma "inline" def _readLitChar(fp: _file, val: string, ignoreWhiteSpace: bool)
  return __primitive("_fscan_literal", fp, val, ignoreWhiteSpace);

const stdin  = new file("stdin", FileAccessMode.read, "/dev", __primitive("get_stdin"));
const stdout = new file("stdout", FileAccessMode.write, "/dev", __primitive("get_stdout"));
const stderr = new file("stderr", FileAccessMode.write, "/dev", __primitive("get_stderr"));

class file: Writer {
  var filename : string = "";
  var mode : FileAccessMode = FileAccessMode.read;
  var path : string = ".";
  var _fp : _file;
  var _lock : sync uint(64);    // for serializing output

  def open() {
    on this {
      if this == stdin || this == stdout || this == stderr then
        halt("***Error: It is not necessary to open \"", filename, "\"***");

      var fullFilename = path + "/" + filename;

      var modestring: string;
      select mode {
        when FileAccessMode.read  do modestring = "r";
        when FileAccessMode.write do modestring = "w";
      }
      _fp = __primitive("fopen", filename, modestring);

      if _fp == __primitive("get_nullfile") then
        halt("***Error: Unable to open \"", fullFilename, "\": ", __primitive("get_errno"), "***");
    }
  }

  def _checkFileStateChangeLegality(state) {
    if (isOpen) {
      halt("Cannot change ", state, " of file ", path, "/", filename,
           " while it is open");
    }
  }

  def filename var : string {
    if setter then
      _checkFileStateChangeLegality("filename");
    return filename;
  }

  def path var : string {
    if setter then
      _checkFileStateChangeLegality("path");
    return path;
  }

  def mode var {
    if setter then
      _checkFileStateChangeLegality("mode");
    return mode;
  }

  def isOpen: bool {
    var openStatus: bool = false;
    if (_fp != __primitive("get_nullfile")) {
      openStatus = true;
    }
    return openStatus;
  }

  def close() {
    on this {
      if (this == stdin || this == stdout || this == stderr) {
        halt("***Error: You may not close \"", filename, "\"***");
      }
      if (_fp == __primitive("get_nullfile")) {
        var fullFilename = path + "/" + filename;
        halt("***Error: Trying to close \"", fullFilename,
             "\" which isn't open***");
      }
      var returnVal: int = __primitive("fclose", _fp);
      if (returnVal < 0) {
        var fullFilename = path + "/" + filename;
        halt("***Error: The close of \"", fullFilename, "\" failed: ",
             __primitive("get_errno"), "***");
      }
      _fp = __primitive("get_nullfile");
    }
  }
}

def file.writeThis(f: Writer) {
  f.write("(filename = ",this.filename);
  f.write(", path = ",this.path);
  f.write(", mode = ",this.mode);
  f.write(")");
}

def file.flush() {
  on this do __primitive("fflush", _fp);
}

def _checkOpen(f: file, isRead: bool) {
  if !f.isOpen {
    var fullFilename:string = f.path + "/" + f.filename;
    if isRead {
      halt("***Error: You must open \"", fullFilename,
           "\" before trying to read from it***");
    } else {
      halt("***Error: You must open \"", fullFilename,
           "\" before trying to write to it***");
    }
  }
}

def file.readln() {
  on this {
    if !isOpen then
      _checkOpen(this, isRead=true);
    __primitive("_readToEndOfLine",_fp);
  }
}

def file.readln(inout list ...?n) {
  read((...list));
  on this {
    __primitive("_readToEndOfLine",_fp);
  }
}

def file.readln(type t) {
  var val: t;
  this.readln(val);
  return val;
}

def file.read(inout first, inout rest ...?n) {
  read(first);
  for param i in 1..n do
    read(rest(i));
}

def file.read(inout val: int) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: int;
  on this {
    x = __primitive("_fscan_int32", _fp);
  }
  val = x;
}

def file.read(inout val: uint) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: uint;
  on this {
    x = __primitive("_fscan_uint32", _fp);
  }
  val = x;
}

def file.read(inout val: real) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: real;
  on this {
    x = __primitive("_fscan_real64", _fp);
  }
  val = x;
}

def file.read(inout val: complex) {
  var realPart: real;
  var imagPart: real;
  var imagI: string;
  var matchingCharWasRead: int;
  var isNeg: bool;

  read(realPart);
  on this {
    matchingCharWasRead = _readLitChar(_fp, "+", true);
  }
  if (matchingCharWasRead != 1) {
    on this {
      matchingCharWasRead = _readLitChar(_fp, "-", true);
    }
    if (matchingCharWasRead != 1) {
      halt("***Error: Incorrect format for complex numbers***");
    }
    isNeg = true;
  }

  read(imagPart);
  on this {
    matchingCharWasRead = _readLitChar(_fp, "i", false);
  }
  if (matchingCharWasRead != 1) {
    halt("***Error: Incorrect format for complex numbers***");
  }

  val.re = realPart;
  if (isNeg) {
    val.im = -imagPart;
  } else {
    val.im = imagPart;
  }
}

def file.read(inout val: string) {
  if !isOpen then
    _checkOpen(this, isRead=true);
  var x: string;
  on this {
    x = __primitive("_fscan_string", _fp);
  }
  val = x;
}

def file.read(inout val: bool) {
  var s: string;
  this.read(s);
  if (s == "true") {
    val = true;
  } else if (s == "false") {
    val = false;
  } else {
    halt("read of bool value that is neither true nor false");
  }
}

def file.read(type t) {
  var val: t;
  this.read(val);
  return val;
}

def string.writeThis(f: Writer) {
  f.writeIt(this);
}

def file.writeIt(s: string) {
  on this {
    if !isOpen then
      _checkOpen(this, isRead = false);
    if mode != FileAccessMode.write then
      halt("***Error: ", path, "/", filename, " not open for writing***");
    var status = __primitive("fprintf", _fp, "%s", s);
    if status < 0 then
      halt("***Error: Write failed: ", __primitive("get_errno"), "***");
  }
}

class StringClass: Writer {
  var s: string;
  def writeIt(s: string) { this.s += s; }
}

pragma "ref this"
def string.write(args ...?n) {
  var sc = new StringClass(this);
  sc.write((...args));
  this = sc.s;
}

def file.lockWrite() {
  var me: uint(64) = __primitive("thread_id");
  if _lock.isFull then
    if _lock.readXX() == me then
      return false;
  _lock = me;
  return true;
}

def file.unlockWrite() {
  _lock.reset();
}

class Writer {
  def writeIt(s: string) { }
  def lockWrite() return false;
  def unlockWrite() { }
  def write(args ...?n) {
    var need_release: bool;
    need_release = lockWrite();
    for param i in 1..n do
      args(i).writeThis(this);
    if need_release then
      unlockWrite();
  }
  def writeln(args ...?n) {
    write((...args), "\n");
  }
  def writeln() {
    write("\n");
  }
}

def write(args ...?n) {
  stdout.write((...args));
}

def writeln(args ...?n) {
  stdout.writeln((...args));
}

def writeln() {
  stdout.writeln();
}

def read(inout args ...?n) {
  stdin.read((...args));
}

def readln(inout args ...?n) {
  stdin.readln((...args));
}

def readln() {
  stdin.readln();
}

def readln(type t) {
  return stdin.readln(t);
}

def read(type t)
  return stdin.read(t);

def file.readln(type t ...?numTypes) where numTypes > 1 {
  var tupleVal: t;
  for param i in 1..numTypes-1 do
    tupleVal(i) = this.read(t(i));
  tupleVal(numTypes) = this.readln(t(numTypes));
  return tupleVal;
}

def file.read(type t ...?numTypes) where numTypes > 1 {
  var tupleVal: t;
  for param i in 1..numTypes do
    tupleVal(i) = this.read(t(i));
  return tupleVal;
}

def readln(type t ...?numTypes) where numTypes > 1
  return stdin.readln((...t));

def read(type t ...?numTypes) where numTypes > 1
  return stdin.read((...t));

def _tuple2string(t) {
  var s: string;
  for param i in 1..t.size do
    s.write(t(i));
  return s;
}

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

def assert(test: bool, args ...?numArgs) {
  if !test then
    __primitive("chpl_error", "assert failed - "+_tuple2string(args));
}

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

def halt(args ...?numArgs) {
  __primitive("chpl_error", "halt reached - "+_tuple2string(args));
}

def _debugWrite(args: string ...?n) {
  for param i in 1..n {
    var status = __primitive("fprintf", __primitive("get_stdout"), "%s", args(i));
    if status < 0 then
      halt("_debugWrite failed with status ", __primitive("get_errno"));
  }
  __primitive("fflush", __primitive("get_stdout"));
}

def _debugWriteln(args: string ...?n) {
  _debugWrite((...args), "\n");
}

def _debugWriteln() {
  _debugWrite("\n");
}

def _ddata.writeThis(f: Writer) {
  for i in 0..size-2 do
    f.write(this(i), " ");
  f.write(this(size-1));
}

def format(fmt: string, x:?t) where _isIntegralType(t) || _isFloatType(t) {
  if fmt.substring(1) == "#" {
    var fmt2 = _getoutputformat(fmt);
    if _isImagType(t) then
      return (__primitive("_format", fmt2, _i2r(x))+"i");
    else
      return __primitive("_format", fmt2, x:real);
  } else
    return __primitive("_format", fmt, x);
}

def format(fmt: string, x:?t) where _isComplexType(t) {
  if fmt.substring(1) == "#" {
    var fmt2 = _getoutputformat(fmt);
    return (__primitive("_format", fmt2, x.re)+" + "+ __primitive("_format", fmt2, x.im)+"i");
  } else
    return __primitive("_format", fmt, x);
}

def format(fmt: string, x: ?t) where !(_isIntegralType(t) || _isFloatType(t) || _isComplexType(t)) {
  return __primitive("_format", fmt, x);
}

def _getoutputformat(s: string):string {
  var sn = length(s);
  var afterdot = false;
  var dplaces = 0;
  for i in 1..sn {
    if ((s.substring(i) == '#') & afterdot) then dplaces += 1;
    if (s.substring(i) == '.') then afterdot=true;
  }

  return("%" + sn + "." + dplaces + "f");
}