Start incorporating Nikhil and Mike's feedback.

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

  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 a 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
  {
    param rank = input.rank;

    if !noFFTWsizeChecks then
      for i in 1..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);

    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 corresponding dimension of the real aray.  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 number of elements in 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 corresponding dimension of the real aray.  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 number of elements in 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
                              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
                                  in1: [],
                                  out1: [],
                                  c_flags : c_uint) : fftw_plan;

    extern proc fftw_plan_dft_c2r(rank: c_int,
                                  n,  // BLC: having trouble being specific
                                  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 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`.

  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";

  /*
    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 a 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 rank 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
  {
    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
    :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.
    :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
    :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.
    :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
                              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
                                  in1: [],
                                  out1: [],
                                  c_flags : c_uint) : fftw_plan;

    extern proc fftw_plan_dft_c2r(rank: c_int,
                                  n,  // BLC: having trouble being specific
                                  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);
  }
}


Fixed another test that used the array alias operator on non-arrays.

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

/** FTree: The tree data structure used to store the numerical representation
    of a function.

    For 1d Madness, an FTree is a binary tree, for 2d it would
    be a quad tree, 3d an octtree, and so on.  The FTree used here uses level
    and index hashing to store the tree rather than storing connectivity
    information.  So, it is important that you do a has_coeffs() before
    indexing into the tree to be sure you don't create coeffs when you don't
    mean to.
 */
config const numLocs = 3;

// FIXME: The Coeff record works around arrays of arrays.  Ideally, nodes
//        should be a mapping from indices onto :[coeffDom] real.
record Coeff {
    var dom  : domain(1);
    var data : [dom] real;
}

// The empty vector, returned when there are no Coeffs.
var None: [0..-1] real;
const rootNode = (0,0);
const emptyNode = (-1,-1);

// Check if we have None.
def isNone(x) {
    return x.numElements == 0;
}

record LocTree {
    const coeffDom : domain(1);
    var locIndices : domain(2*int);      // Indexed by 2-tuples of integers
    var locNodes   : [locIndices] Coeff; // Associative Mapping: (:int, :int)
                                         // => Coeff

    var zeroes     : [coeffDom] real;    // Return zeroes from this() when
                                         // reading something that has not yet
                                         // been set.

    /** Access an element in the associative domain.  If the element
        doesn't exist it will be created.

        We have to be really careful about creating extra boxes when we don't
        mean to.  The algorithms tend to be really sensitive to the structure
        of the tree.  Scaling coefficients are used to mark the leaves in the
        sum tree, so if you accidentally create scaling coeffs somewhere in the
        middle of the tree you will short circuit a whole subtree!

     */
    def this(lvl: int, idx: int) var {
        if !locIndices.member((lvl, idx)) {
            if setter {
              locIndices += ((lvl, idx));
              locNodes[(lvl, idx)] = new Coeff(coeffDom);
            } else {
              // This is a getter so it shouldn't be modifying what
              // we return, should be safe to return the zero vector.
              // FIXME: Zeroes should really be a const, but can'ti
              //        return const from a var fcn.
              return zeroes;
            }
        }

        return locNodes[(lvl, idx)].data;
    }

    /** Access an element in the associative domain.  If it doesn't exist,
        return None.
     */
    def peek(lvl: int, idx: int) var {
        if has_coeffs(lvl, idx) then
            return this(lvl, idx);
        else
            return None;
    }

    /** Unordered iterator over all coefficients
     */
    def these() {
        for n in locNodes do
            yield n.data;
    }

    /** Unordered iterator over all boxes in a particular level.
        This is not a particularly fast way to do this, but for many of the
        Madness levelwise iterators that do all levels from 0..max_level this
        will be much faster when the data is not all the way down at max_level.
        A sparse array or an array of associative arrays may be more conducive
        to this type of iteration vs. the associative domain used here.
     */
    def lvl_iter(lvl: int) {
        // AGS - Why are we doing indices.member(i)?
        for i in locIndices do
            if i(1) == lvl && locIndices.member(i) then yield locNodes[i].data;
    }

    /** Check if there are coefficients in box (lvl, idx)
     */
    def has_coeffs(lvl: int, idx: int) {
        return locIndices.member((lvl, idx));
    }

    /** Remove an element from the associative domain.  If the element
        does not exist, it is ignored.
     */
    def remove(lvl: int, idx: int) {
        if locIndices.member((lvl, idx)) then locIndices.remove((lvl, idx));
    }

    def idx_iter(lvl: int) {
        for idx in locIndices do
            if idx(1) == lvl then yield idx;
    }

    def idx_iter() {
        for idx in locIndices do
            yield idx;
    }
}

class FTree {
    const order    : int;
    const coeffDom = [0..order-1];

    const locDom = [0..#numLocs];
    var nodes    : [locDom] LocTree;

    def initialize() {
        if order == 0 then
            halt("FTree must be initialized with an order > 0");

        [loc in locDom] nodes[loc] = new LocTree(coeffDom);
    }

    def mapNodeToLoc(lvl, idx) {
        return (lvl+idx)%numLocs;
    }

    def this((lvl, idx)) var {
        return nodes[mapNodeToLoc(lvl, idx)][lvl,idx];
    }

    def this(loc) {
        for data in nodes[loc] do
            yield data;
    }

    def these() {
        for n in nodes do
            for data in n do
                yield data;
    }

    // BLC: Really want to replace these with a non-zippered parallel
    // iterator
    def these(param tag: iterator) where tag == iterator.leader {
      coforall n in nodes do
        yield n;
    }

    def these(param tag: iterator, follower) where tag == iterator.follower {
      for data in follower do
        yield data;
    }

    def lvl_iter(lvl) {
        for n in nodes do
            for data in n.lvl_iter(lvl) do
                yield data;
    }

    def peek((lvl, idx)) var {
        return nodes[mapNodeToLoc(lvl, idx)].peek(lvl, idx);
    }

    def has_coeffs((lvl, idx)) {
        return nodes[mapNodeToLoc(lvl, idx)].has_coeffs(lvl, idx);
    }

    def remove((lvl, idx)) {
        nodes[mapNodeToLoc(lvl, idx)].remove(lvl, idx);
    }

    /** Return a copy of this FTree
     */
    def copy() {
        var t = new FTree(order);
        t.nodes = nodes;
        return t;
    }

    def idx_iter(lvl) {
        for n in nodes do
            for idx in n.idx_iter(lvl) do
                yield idx;
    }

    def idx_iter() {
        for n in nodes do
            for idx in n.idx_iter() do
                yield idx;
    }

    def path_upwards((lvl0, idx0), (lvl1, idx1)) {
        var l = idx0;
        for n in lvl1..lvl0 by -1 {
           yield ((n,l));
           l /= 2;
        }
    }

    def path_downwards((lvl0, idx0), (lvl1, idx1)) {
        for n in (lvl0..lvl1-1) {
          yield (n, idx1/(2**(lvl1-n)));
        }
    }

    def on_boundary((lvl, idx)) {
        return ((idx < 0 || idx >= 2**lvl));
    }

    def get_children((lvl, idx)) {
        return ((lvl+1, 2*idx), (lvl+1, 2*idx+1));
    }

    def get_neighbors((lvl, idx)) {
        return ((lvl, idx-1), (lvl, idx+1));
    }
}

def main() {
    /*
    var f = new FTree(2);

    for (i, j) in [0..2, 0..2] do f[(i, j)] = (i, j);

    for (i, j) in [1..0, 1..0] do f.remove((i, j));

    for (i, j) in [0..1, 0..1] do f[(i, j)] = (-(i:real), -(j:real));

    for (i, j) in [2..1, 2..1] do f.remove((i, j));

    for (i, j) in [1..2, 1..2] do f[(i, j)] = (-(i:real), -(j:real));

    for (i, j) in [0..2, 0..2] do
        writeln("(",i,", ",j,") = ", f.peek((i, j)));

    for i in 0..2 do
        for n in f.lvl_iter(i) do
            writeln(i, ": ", n);
    */

    var f = new FTree(2);

    for (i, j) in [1..3, 2..4] do f[(i, j)] = (i, j);

    for loc in 0..numLocs-1 {
        writeln("\n\ntree on loc ", loc, " = ");
        for data in f[loc] do
            writeln(data);
    }

    writeln("\n\nf.has_coeffs((4, 5)) = ", f.has_coeffs((4, 5)));
    writeln("f.peek((4, 5)) = ", f.peek((4, 5)));
    writeln("f[(4, 5)] = ", f[(4, 5)]);
    writeln("f.remove((4, 5))");
    f.remove((4, 5));

    writeln("\n\nf.has_coeffs((1, 2)) = ", f.has_coeffs((1, 2)));
    writeln("f.peek((1, 2)) = ", f.peek((1, 2)));
    writeln("f[(1, 2)] = ", f[(1, 2)]);
    writeln("f.remove((1, 2))");
    f.remove((1, 2));

    writeln("\n\nf.remove((3, 4))");
    f.remove((3, 4));

    for loc in 0..numLocs-1 {
        writeln("\n\ntree on loc ", loc, " = ");
        for data in f[loc] do
            writeln(data);
    }

    writeln("\n\nentire tree = ");
    for data in f do
        writeln(data);

    writeln("\n\nentire tree = ");
    writeln(f);

    var f1 = f.copy();

    writeln("\n\nf.remove((3, 2))");
    f.remove((3, 2));

    writeln("\n\nentire tree = ");
    writeln(f);

    writeln("\n\ntree copy = ");
    writeln(f1);

    for lvl in 1..3 {
        writeln("\n\ndata on lvl ", lvl, " = ");
        for data in f.lvl_iter(lvl) do
            writeln(data);
    }

    for lvl in 1..3 {
        writeln("\n\nindices on lvl ", lvl, " = ");
            for idx in f.idx_iter(lvl) do
                writeln(idx);
    }

    writeln("\n\nall tree indices = ");
    for (n, l) in f.idx_iter() do
        writeln(n,l);
}

/** FTree: The tree data structure used to store the numerical representation
    of a function.

    For 1d Madness, an FTree is a binary tree, for 2d it would
    be a quad tree, 3d an octtree, and so on.  The FTree used here uses level
    and index hashing to store the tree rather than storing connectivity
    information.  So, it is important that you do a has_coeffs() before
    indexing into the tree to be sure you don't create coeffs when you don't
    mean to.
 */
config const numLocs = 3;

// FIXME: The Coeff record works around arrays of arrays.  Ideally, nodes
//        should be a mapping from indices onto :[coeffDom] real.
record Coeff {
    var dom  : domain(1);
    var data : [dom] real;
}

// The empty vector, returned when there are no Coeffs.
var None: [0..-1] real;
const rootNode = (0,0);
const emptyNode = (-1,-1);

// Check if we have None.
def isNone(x) {
    return x.numElements == 0;
}

record LocTree {
    const coeffDom : domain(1);
    var locIndices : domain(2*int);      // Indexed by 2-tuples of integers
    var locNodes   : [locIndices] Coeff; // Associative Mapping: (:int, :int)
                                         // => Coeff

    var zeroes     : [coeffDom] real;    // Return zeroes from this() when
                                         // reading something that has not yet
                                         // been set.

    /** Access an element in the associative domain.  If the element
        doesn't exist it will be created.

        We have to be really careful about creating extra boxes when we don't
        mean to.  The algorithms tend to be really sensitive to the structure
        of the tree.  Scaling coefficients are used to mark the leaves in the
        sum tree, so if you accidentally create scaling coeffs somewhere in the
        middle of the tree you will short circuit a whole subtree!

     */
    def this(lvl: int, idx: int) var {
        if !locIndices.member((lvl, idx)) {
            if setter {
              locIndices += ((lvl, idx));
              locNodes[(lvl, idx)] = new Coeff(coeffDom);
            } else {
              // This is a getter so it shouldn't be modifying what
              // we return, should be safe to return the zero vector.
              // FIXME: Zeroes should really be a const, but can'ti
              //        return const from a var fcn.
              return zeroes;
            }
        }

        return locNodes[(lvl, idx)].data;
    }

    /** Access an element in the associative domain.  If it doesn't exist,
        return None.
     */
    def peek(lvl: int, idx: int) var {
        if has_coeffs(lvl, idx) then
            return this(lvl, idx);
        else
            return None;
    }

    /** Unordered iterator over all coefficients
     */
    def these() {
        for n in locNodes do
            yield n.data;
    }

    /** Unordered iterator over all boxes in a particular level.
        This is not a particularly fast way to do this, but for many of the
        Madness levelwise iterators that do all levels from 0..max_level this
        will be much faster when the data is not all the way down at max_level.
        A sparse array or an array of associative arrays may be more conducive
        to this type of iteration vs. the associative domain used here.
     */
    def lvl_iter(lvl: int) {
        // AGS - Why are we doing indices.member(i)?
        for i in locIndices do
            if i(1) == lvl && locIndices.member(i) then yield locNodes[i].data;
    }

    /** Check if there are coefficients in box (lvl, idx)
     */
    def has_coeffs(lvl: int, idx: int) {
        return locIndices.member((lvl, idx));
    }

    /** Remove an element from the associative domain.  If the element
        does not exist, it is ignored.
     */
    def remove(lvl: int, idx: int) {
        if locIndices.member((lvl, idx)) then locIndices.remove((lvl, idx));
    }

    def idx_iter(lvl: int) {
        for idx in locIndices do
            if idx(1) == lvl then yield idx;
    }

    def idx_iter() {
        for idx in locIndices do
            yield idx;
    }
}

class FTree {
    const order    : int;
    const coeffDom = [0..order-1];

    const locDom = [0..#numLocs];
    var nodes    : [locDom] LocTree;

    def initialize() {
        if order == 0 then
            halt("FTree must be initialized with an order > 0");

        [loc in locDom] nodes[loc] = new LocTree(coeffDom);
    }

    def mapNodeToLoc(lvl, idx) {
        return (lvl+idx)%numLocs;
    }

    def this((lvl, idx)) var {
        const n => nodes[mapNodeToLoc(lvl, idx)];
        return n[lvl, idx];
    }

    def this(loc) {
        for data in nodes[loc] do
            yield data;
    }

    def these() {
        for n in nodes do
            for data in n do
                yield data;
    }

    // BLC: Really want to replace these with a non-zippered parallel
    // iterator
    def these(param tag: iterator) where tag == iterator.leader {
      coforall n in nodes do
        yield n;
    }

    def these(param tag: iterator, follower) where tag == iterator.follower {
      for data in follower do
        yield data;
    }

    def lvl_iter(lvl) {
        for n in nodes do
            for data in n.lvl_iter(lvl) do
                yield data;
    }

    def peek((lvl, idx)) var {
        const n => nodes[mapNodeToLoc(lvl, idx)];
        return n.peek(lvl, idx);
    }

    def has_coeffs((lvl, idx)) {
        const n => nodes[mapNodeToLoc(lvl, idx)];
        return n.has_coeffs(lvl, idx);
    }

    def remove((lvl, idx)) {
        const n => nodes[mapNodeToLoc(lvl, idx)];
        n.remove(lvl, idx);
    }

    /** Return a copy of this FTree
     */
    def copy() {
        var t = new FTree(order);
        t.nodes = nodes;
        return t;
    }

    def idx_iter(lvl) {
        for n in nodes do
            for idx in n.idx_iter(lvl) do
                yield idx;
    }

    def idx_iter() {
        for n in nodes do
            for idx in n.idx_iter() do
                yield idx;
    }

    def path_upwards((lvl0, idx0), (lvl1, idx1)) {
        var l = idx0;
        for n in lvl1..lvl0 by -1 {
           yield ((n,l));
           l /= 2;
        }
    }

    def path_downwards((lvl0, idx0), (lvl1, idx1)) {
        for n in (lvl0..lvl1-1) {
          yield (n, idx1/(2**(lvl1-n)));
        }
    }

    def on_boundary((lvl, idx)) {
        return ((idx < 0 || idx >= 2**lvl));
    }

    def get_children((lvl, idx)) {
        return ((lvl+1, 2*idx), (lvl+1, 2*idx+1));
    }

    def get_neighbors((lvl, idx)) {
        return ((lvl, idx-1), (lvl, idx+1));
    }
}

def main() {
    /*
    var f = new FTree(2);

    for (i, j) in [0..2, 0..2] do f[(i, j)] = (i, j);

    for (i, j) in [1..0, 1..0] do f.remove((i, j));

    for (i, j) in [0..1, 0..1] do f[(i, j)] = (-(i:real), -(j:real));

    for (i, j) in [2..1, 2..1] do f.remove((i, j));

    for (i, j) in [1..2, 1..2] do f[(i, j)] = (-(i:real), -(j:real));

    for (i, j) in [0..2, 0..2] do
        writeln("(",i,", ",j,") = ", f.peek((i, j)));

    for i in 0..2 do
        for n in f.lvl_iter(i) do
            writeln(i, ": ", n);
    */

    var f = new FTree(2);

    for (i, j) in [1..3, 2..4] do f[(i, j)] = (i, j);

    for loc in 0..numLocs-1 {
        writeln("\n\ntree on loc ", loc, " = ");
        for data in f[loc] do
            writeln(data);
    }

    writeln("\n\nf.has_coeffs((4, 5)) = ", f.has_coeffs((4, 5)));
    writeln("f.peek((4, 5)) = ", f.peek((4, 5)));
    writeln("f[(4, 5)] = ", f[(4, 5)]);
    writeln("f.remove((4, 5))");
    f.remove((4, 5));

    writeln("\n\nf.has_coeffs((1, 2)) = ", f.has_coeffs((1, 2)));
    writeln("f.peek((1, 2)) = ", f.peek((1, 2)));
    writeln("f[(1, 2)] = ", f[(1, 2)]);
    writeln("f.remove((1, 2))");
    f.remove((1, 2));

    writeln("\n\nf.remove((3, 4))");
    f.remove((3, 4));

    for loc in 0..numLocs-1 {
        writeln("\n\ntree on loc ", loc, " = ");
        for data in f[loc] do
            writeln(data);
    }

    writeln("\n\nentire tree = ");
    for data in f do
        writeln(data);

    writeln("\n\nentire tree = ");
    writeln(f);

    var f1 = f.copy();

    writeln("\n\nf.remove((3, 2))");
    f.remove((3, 2));

    writeln("\n\nentire tree = ");
    writeln(f);

    writeln("\n\ntree copy = ");
    writeln(f1);

    for lvl in 1..3 {
        writeln("\n\ndata on lvl ", lvl, " = ");
        for data in f.lvl_iter(lvl) do
            writeln(data);
    }

    for lvl in 1..3 {
        writeln("\n\nindices on lvl ", lvl, " = ");
            for idx in f.idx_iter(lvl) do
                writeln(idx);
    }

    writeln("\n\nall tree indices = ");
    for (n, l) in f.idx_iter() do
        writeln(n,l);
}


Fix up Error documentation based on feedback

/*
 * 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 helps to handle errors. In particular, it enables routines
   to return a syserr - encoding an error state - and then contains routines
   that can be provided a syserr in order to print out a useful error message.

   This module defines the type syserr, which can encode an error code or an
   error message. This type can be returned from routines generating an error.

   The IO module uses these routines in a way that supports error inspection
   and also rapid prototyping. Most routines in the IO module have two forms.
   In one form, an error (of type syserr) is returned in an out error argument.
   In the second form, no error is returned, and instead the task will halt
   with a fatal error if an error is encountered.

 */
module Error {

use SysBasic;

// here's what we need from Sys
pragma "no doc"
extern proc sys_strerror_syserr_str(error:syserr, out err_in_strerror:err_t):c_string;

/* This function takes in a string and returns it in double-quotes,
   with internal double-quotes escaped with backslash.
   */
pragma "no doc"
proc quote_string(s:string, len:ssize_t) {
  extern const QIO_STRING_FORMAT_CHPL: uint(8);
  extern proc qio_quote_string(s:uint(8), e:uint(8), f:uint(8),
                               ptr: c_string, len:ssize_t,
                               ref ret:c_string, ti: c_void_ptr): syserr;
  extern proc qio_strdup(s: c_string): c_string;

  var ret: c_string;
  // 34 is ASCII double quote
  var err: syserr = qio_quote_string(34:uint(8), 34:uint(8),
                                    QIO_STRING_FORMAT_CHPL,
                                    s.c_str(), len, ret, c_nil);

  // This doesn't handle the case where ret==NULL as did the previous
  // version in QIO, but I'm not sure how that was used.

  if err then return qio_strdup("<error>");
  return ret;
}

/* Halt with a useful message if there was an error. Do nothing if the error
   argument does not indicate an error occured. The error message printed
   when halting will describe the error passed and msg will be appended to it.

   :arg error: the error object
   :arg msg: extra information to print after the error description
 */
proc ioerror(error:syserr, msg:string)
{
  if( error ) {
    var errstr:c_string;
    var strerror_err:err_t = ENOERR;
    errstr = sys_strerror_syserr_str(error, strerror_err);
    __primitive("chpl_error", errstr + " " + msg.c_str());
  }
}

/* Halt with a useful message if there was an error. Do nothing if the error
   argument does not indicate an error occured. The error message printed
   when halting will describe the error passed and msg will be appended to it,
   along with the path related to the error (for example, the path to a file
   which could not be opened).

   :arg error: the error object
   :arg msg: extra information to print after the error description
   :arg path: a path to print out that is related to the error
 */
proc ioerror(error:syserr, msg:string, path:string)
{
  if( error ) {
    var errstr:c_string;
    var quotedpath:c_string;
    var strerror_err:err_t = ENOERR;
    errstr = sys_strerror_syserr_str(error, strerror_err);
    quotedpath = quote_string(path, path.length:ssize_t);
    __primitive("chpl_error", errstr + " " + msg.c_str() + " with path " + quotedpath);
  }
}

/* Halt with a useful message if there was an error. Do nothing if the error
   argument does not indicate an error occured. The error message printed
   when halting will describe the error passed and msg will be appended to it,
   along with the path and file offset related to the error. For example, this
   routine might indicate a file format error at a particular location.

   :arg error: the error object
   :arg msg: extra information to print after the error description
   :arg path: a path to print out that is related to the error
   :arg offset: an offset to print out that is related to the error
 */
proc ioerror(error:syserr, msg:string, path:string, offset:int(64))
{
  if( error ) {
    var errstr:c_string;
    var quotedpath:c_string;
    var strerror_err:err_t = ENOERR;
    errstr = sys_strerror_syserr_str(error, strerror_err);
    quotedpath = quote_string(path, path.length:ssize_t);
    // TODO: Because the output of concatenation (+) is an allocated string,
    // this routine leaks like a sieve.
    __primitive("chpl_error", errstr + " " + msg.c_str() + " with path " + quotedpath + " offset " + offset:c_string_copy);
  }
}

/* Halt with a useful message. Instead of an error argument, this routine takes
   in an error string to report.
   The error message printed when halting will describe the error passed and
   msg will be appended to it, along with the path and file offset related to
   the error. For example, this routine might indicate a file format error at a
   particular location.

   This routine .

   :arg errstr: the error string
   :arg msg: extra information to print after the error description
   :arg path: a path to print out that is related to the error
   :arg offset: an offset to print out that is related to the error
 */
proc ioerror(errstr:string, msg:string, path:string, offset:int(64))
{
  var quotedpath:c_string;
  quotedpath = quote_string(path, path.length:ssize_t);
  // TODO: Because the output of concatenation (+) is an allocated string,
  // this routine leaks like a sieve.
  __primitive("chpl_error", errstr + " " + msg.c_str() + " with path " + quotedpath + " offset " + offset:c_string_copy);
}

/* Convert a syserr error code to a human-readable string describing that
   error.

   :arg errstr: the error string
   :returns: a string describing the error
 */
proc errorToString(error:syserr):string
{
  var errstr:c_string = "unknown"; // Why initialize this?
  var strerror_err:err_t = ENOERR;
  errstr = sys_strerror_syserr_str(error, strerror_err);
  return errstr;
}

}

/*
 * 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 helps to handle errors. In particular, it enables routines
   to return a syserr - encoding an error state - and then contains routines
   that can be provided a syserr in order to print out a useful error message.

   This module defines the type syserr, which can encode an error code or an
   error message. This type can be returned from routines generating an error.

   The IO module uses these routines in a way that supports error inspection
   and also rapid prototyping. Most routines in the IO module have two forms.
   In one form, an error (of type syserr) is returned in an out error argument.
   In the second form, no error is returned, an instead the task will halt
   with a fatal error if an error is encountered.

 */
module Error {

use SysBasic;

// here's what we need from Sys
pragma "no doc"
extern proc sys_strerror_syserr_str(error:syserr, out err_in_strerror:err_t):c_string;

/* This function takes in a string and returns it in double-quotes,
   with internal double-quotes escaped with backslash.
   */
pragma "no doc"
proc quote_string(s:string, len:ssize_t) {
  extern const QIO_STRING_FORMAT_CHPL: uint(8);
  extern proc qio_quote_string(s:uint(8), e:uint(8), f:uint(8),
                               ptr: c_string, len:ssize_t,
                               ref ret:c_string, ti: c_void_ptr): syserr;
  extern proc qio_strdup(s: c_string): c_string;

  var ret: c_string;
  // 34 is ASCII double quote
  var err: syserr = qio_quote_string(34:uint(8), 34:uint(8),
                                    QIO_STRING_FORMAT_CHPL,
                                    s.c_str(), len, ret, c_nil);

  // This doesn't handle the case where ret==NULL as did the previous
  // version in QIO, but I'm not sure how that was used.

  if err then return qio_strdup("<error>");
  return ret;
}

/* Halt with a useful message if there was an error. Do nothing if the error
   argument does not indicate an error occured. The error message printed
   when halting will describe the error passed and msg will be appended to it.

   :arg error: the error object
   :arg msg: extra information to print after the error description
   :returns: does not return if there was an error
 */
proc ioerror(error:syserr, msg:string)
{
  if( error ) {
    var errstr:c_string;
    var strerror_err:err_t = ENOERR;
    errstr = sys_strerror_syserr_str(error, strerror_err);
    __primitive("chpl_error", errstr + " " + msg.c_str());
  }
}

/* Halt with a useful message if there was an error. Do nothing if the error
   argument does not indicate an error occured. The error message printed
   when halting will describe the error passed and msg will be appended to it,
   along with the path related to the error (for example, the path to a file
   which could not be opened).

   :arg error: the error object
   :arg msg: extra information to print after the error description
   :arg path: a path to print out that is related to the error
   :returns: does not return if there was an error
 */
proc ioerror(error:syserr, msg:string, path:string)
{
  if( error ) {
    var errstr:c_string;
    var quotedpath:c_string;
    var strerror_err:err_t = ENOERR;
    errstr = sys_strerror_syserr_str(error, strerror_err);
    quotedpath = quote_string(path, path.length:ssize_t);
    __primitive("chpl_error", errstr + " " + msg.c_str() + " with path " + quotedpath);
  }
}

/* Halt with a useful message if there was an error. Do nothing if the error
   argument does not indicate an error occured. The error message printed
   when halting will describe the error passed and msg will be appended to it,
   along with the path and file offset related to the error. For example, this
   routine might indicate a file format error at a particular location.

   This routine .

   :arg error: the error object
   :arg msg: extra information to print after the error description
   :arg path: a path to print out that is related to the error
   :arg offset: an offset to print out that is related to the error
   :returns: does not return if there was an error
 */
proc ioerror(error:syserr, msg:string, path:string, offset:int(64))
{
  if( error ) {
    var errstr:c_string;
    var quotedpath:c_string;
    var strerror_err:err_t = ENOERR;
    errstr = sys_strerror_syserr_str(error, strerror_err);
    quotedpath = quote_string(path, path.length:ssize_t);
    // TODO: Because the output of concatenation (+) is an allocated string,
    // this routine leaks like a sieve.
    __primitive("chpl_error", errstr + " " + msg.c_str() + " with path " + quotedpath + " offset " + offset:c_string_copy);
  }
}

/* Halt with a useful message. Instead of an error argument, this routine takes
   in an error string to report.
   The error message printed when halting will describe the error passed and
   msg will be appended to it, along with the path and file offset related to
   the error. For example, this routine might indicate a file format error at a
   particular location.

   This routine .

   :arg errstr: the error string
   :arg msg: extra information to print after the error description
   :arg path: a path to print out that is related to the error
   :arg offset: an offset to print out that is related to the error
   :returns: does not return
 */
proc ioerror(errstr:string, msg:string, path:string, offset:int(64))
{
  var quotedpath:c_string;
  quotedpath = quote_string(path, path.length:ssize_t);
  // TODO: Because the output of concatenation (+) is an allocated string,
  // this routine leaks like a sieve.
  __primitive("chpl_error", errstr + " " + msg.c_str() + " with path " + quotedpath + " offset " + offset:c_string_copy);
}

/* Convert a syserr error code to a human-readable string describing that
   error.

   :arg errstr: the error string
   :returns: a string describing the error
 */
proc errorToString(error:syserr):string
{
  var errstr:c_string = "unknown"; // Why initialize this?
  var strerror_err:err_t = ENOERR;
  errstr = sys_strerror_syserr_str(error, strerror_err);
  return errstr;
}

}


Removing TODO comments from released version

(My thinking is to keep the TODOs in my studies version and work
on addressing them there, but not to expose them to the broader
release users)

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

/* The Computer Language Benchmarks Game
   http://benchmarksgame.alioth.debian.org/

   contributed by Hannah Hemmaplardh
   modified by Lydia Duncan and Brad Chamberlain
*/

//
// the following params indicate the number of bits to use when storing
// IDs in a meeting place's 'state' and the corresponding bitmask
// to use when extracting chameneos IDs, respectively.
//
config param NUM_CHAMENEOS_ID_BITS = 8;
param CHAMENEOS_ID_MASK = (0x1 << NUM_CHAMENEOS_ID_BITS) - 1;

config const n = 100,                // number of meetings to take place
             numChameneos1 = 3,      // size of population 1
             numChameneos2 = 10;     // size of population 2

if (numChameneos1 < 2 || numChameneos2 < 2) then
  halt("There must be at least 2 chameneos");

if (n < 0) then
  halt("the number of meetings must be non-negative");

//
// the colors the chameneos can take on
//
param numColors = 3;
enum Color {blue=0, red, yellow};

proc main() {
  //
  // print out the equations that govern chameneos color changes
  //
  printColorEquations();

  //
  // run two simulations for the two different population sizes
  //
  simulate(numChameneos1);
  simulate(numChameneos2);
}

//
// simulate() takes a number of chameneos as input and creates as
// population of that size, then allows them to meet in parallel.
//
proc simulate(numChameneos) {
  //
  // create the population of chameneos
  //
  const chameneos = createChameneos(numChameneos);

  //
  // print the chameneos's initial colors
  //
  for c in chameneos do
    write(" ", c.color);
  writeln();

  //
  // create a meeting place and simulate the interactions
  //
  const meetingPlace = new MeetingPlace(n);
  meetingPlace.hostMeetings(chameneos);

  //
  // print information about the population once we're done
  //
  printInfo(chameneos);
}

//
// This class represents a place for chameneos to meet
//
class MeetingPlace {
  //
  // the 'state' variable packs a chameneos ID in the bottom
  // NUM_CHAMENEOS_ID_BITS bits and the number of meetings in the
  // upper ones, permitting atomic operations to be performed on both
  // values simultaneously.
  //
  var state: atomic int;

  //
  // constructor initializes the number of meetings to take place
  //
  proc MeetingPlace(numMeetings) {
    state.write(numMeetings << NUM_CHAMENEOS_ID_BITS);
  }

  //
  // This method kicks off the execution of all the chameneos in
  // parallel and has them meet with each other in the meeting place.
  //
  proc hostMeetings(chameneos) {
    //
    // fire off a task per chameneos, and have them try to meet
    //
    coforall c in chameneos {
      //
      // each chameneos will try to have meetings with others as
      // long as meetings remain
      //
      do {
        //
        // read the current state, atomically
        //
        const currentState = state.read(memory_order_acquire);

        //
        // extract the number of meetings remaining and the index of a
        // waiting peer (if any) from the state
        //
        const (meetingsLeft, peerID) = stateToVals(currentState);

        //
        // if meetings remain, let's try to get one
        //
        if (meetingsLeft) {
          //
          // We're the first to arrive if there is no peer index in the
          // state
          //
          const firstToArrive = (peerID == 0);

          //
          // We'll try to meet by optimistically building the state
          // that would indicate we were successful in meeting.
          // We decrement the meetingsLeft if we are the second to arrive.
          // If we're the first to arrive, we store our ID; otherwise,
          // we reset the ID to zero.
          //
          const newState = valsToState(meetingsLeft - !firstToArrive,
                                       if firstToArrive then c.id else 0);

          //
          // use a compare-exchange to see if the state remains the
          // same, and to swap in the new state we've computed if it is.
          //
          if (state.compareExchangeStrong(currentState, newState,
                                          memory_order_acq_rel)) {
            //
            // We get to meet!
            //
            if (firstToArrive) {
              //
              // We were the first chameneos in, so we wait for the
              // other to complete the meeting
              //
              c.waitForMeetingToEnd();
            } else {
              //
              // We were the second chameneos in, so we run the meeting
              //
              c.meetWith(chameneos[peerID]);
            }
          }
        }
        //
        // continue looping as long as meetings remain
        //
      } while (meetingsLeft);
    }
  }

  //
  // This method computes a state value from a number of meetings and ID
  //
  inline proc valsToState(numMeetings, chameneosID) {
    return (numMeetings << NUM_CHAMENEOS_ID_BITS) | chameneosID;
  }

  //
  // This method extracts the number of meeting IDs and chameneos ID from
  // a state value
  //
  inline proc stateToVals(state) {
    return (state >> NUM_CHAMENEOS_ID_BITS, state & CHAMENEOS_ID_MASK);
  }
}

//
// a class representing a chameneos
//
class Chameneos {
  const id: int;                       // its unique ID
  var color: Color;                    // its color
  var meetings,                        // the number of meetings it's had
      meetingsWithSelf: int;           // the number of meetings with itself
  var meetingCompleted: atomic bool;   // indicates that a meeting is over

  //
  // This method says how to wait for a meeting to end and is used
  // by the first chameneos to a meeting
  //
  proc waitForMeetingToEnd() {
    //
    // wait for meeting to end
    //
    meetingCompleted.waitFor(true);
    //
    // and then reset our meetingCompleted flag for next time
    //
    meetingCompleted.write(false, memory_order_release);
  }

  //
  // This method computes the meeting between 'this' chameneos and
  // its peer and is used by the second chameneos to a meeting
  //
  proc meetWith(peer) {
    //
    // If we meet with ourself, something's wrong, so check for that
    //
    const metSelf = (peer == this);

    //
    // compute the new color that we'll share as a function of our
    // current colors
    //
    const newColor = getNewColor(color, peer.color);

    //
    // Update our peer's state: store the new color, update its
    // meetings, and then tell it that the meeting's over
    //
    //
    peer.color = newColor;
    peer.meetings += 1;
    peer.meetingsWithSelf += metSelf;
    peer.meetingCompleted.write(true, memory_order_release);

    //
    // Then update ourself similarly
    //
    color = newColor;
    meetings += 1;
    meetingsWithSelf += metSelf;
  }
}

//
// createChameneos() creates an array of chameneos of the given size.
// If the size is 10, it uses the predefined array of colors;
// otherwise, it deals out colors round-robin.
//
//
proc createChameneos(size): [1..size] Chameneos {
  const colorsFor10 = [Color.blue, Color.red, Color.yellow, Color.red,
                       Color.yellow, Color.blue, Color.red, Color.yellow,
                       Color.red, Color.blue];

  return [i in 1..size] new Chameneos(i, if (size == 10) then colorsFor10[i]
                                                         else ((i-1)%3):Color);
}

//
// getNewColor() returns the complement of two colors; if the two colors
// are the same value, the color stays the same; otherwise, it becomes the
// third color.
//
inline proc getNewColor(myColor, otherColor) {
  select myColor {
    when Color.blue {
      select otherColor {
        when Color.blue do return Color.blue;
        when Color.red  do return Color.yellow;
        otherwise          return Color.red;
      }
    }
    when Color.red {
      select otherColor {
        when Color.blue do return Color.yellow;
        when Color.red  do return Color.red;
        otherwise          return Color.blue;
      }
    }
    otherwise {
      select otherColor {
        when Color.blue do return Color.red;
        when Color.red  do return Color.blue;
        otherwise          return Color.yellow;
      }
    }
  }
}

//
// printColorEquations() prints the result of getNewColor() for all
// pairs of colors
//
proc printColorEquations() {
  const colors = [Color.blue, Color.red, Color.yellow];
  for color1 in colors {
    for color2 in colors {
      writeln(color1, " + ", color2, " -> ", getNewColor(color1, color2));
    }
  }
  writeln();
}

//
// printInfo() prints out information about the population using
// a combination of numbers and English text
//
proc printInfo(chameneos) {
  //
  // for each chameneos, print the number of meetings and spell out
  // the number of self-meetings for each chameneos
  //
  for c in chameneos {
    write(c.meetings);
    spellInt(c.meetingsWithSelf);
  }

  //
  // compute the total number of meetings and spell it out
  //
  const totalMeetings = + reduce chameneos.meetings;
  spellInt(totalMeetings);
  writeln();
}

//
// the base-10 digits
//
enum Digit {zero=0, one, two, three, four, five, six, seven, eight, nine};

//
// spellInt() takes out an integer value and prints its digits out
// in English
//
proc spellInt(n) {
  //
  // Cast n to a string in order to process its characters one by one
  //
  var s = n:string;

  for i in 1..s.length do
    write(" ", (s.substring(i):int):Digit);
  writeln();
}

/* The Computer Language Benchmarks Game
   http://benchmarksgame.alioth.debian.org/

   contributed by Hannah Hemmaplardh
   modified by Lydia Duncan and Brad Chamberlain
*/

//
// the following params indicate the number of bits to use when storing
// IDs in a meeting place's 'state' and the corresponding bitmask
// to use when extracting chameneos IDs, respectively.
//
config param NUM_CHAMENEOS_ID_BITS = 8;
param CHAMENEOS_ID_MASK = (0x1 << NUM_CHAMENEOS_ID_BITS) - 1;

config const n = 100,                // number of meetings to take place
             numChameneos1 = 3,      // size of population 1
             numChameneos2 = 10;     // size of population 2

if (numChameneos1 < 2 || numChameneos2 < 2) then
  halt("There must be at least 2 chameneos");

if (n < 0) then
  halt("the number of meetings must be non-negative");

//
// TODO: We should arguably also check that the number of bits
// devoted to chameneos IDs and meeting IDs are enough to store
// numChameneos1/2 and n, respectively.
//

//
// the colors the chameneos can take on
//
param numColors = 3;
enum Color {blue=0, red, yellow};
//
// TODO: Would be cool to support a param .size query for enums to
// avoid the whole C "declare one extra enum for the number" hack and
// then we could do param numColors = Color.size; (or, if not size,
// some other query function).
//

proc main() {
  //
  // print out the equations that govern chameneos color changes
  //
  printColorEquations();

  //
  // run two simulations for the two different population sizes
  //
  simulate(numChameneos1);
  simulate(numChameneos2);
}

//
// simulate() takes a number of chameneos as input and creates as
// population of that size, then allows them to meet in parallel.
//
proc simulate(numChameneos) {
  //
  // create the population of chameneos
  //
  const chameneos = createChameneos(numChameneos);

  //
  // print the chameneos's initial colors
  //
  for c in chameneos do
    write(" ", c.color);
  writeln();

  //
  // create a meeting place and simulate the interactions
  //
  const meetingPlace = new MeetingPlace(n);
  meetingPlace.hostMeetings(chameneos);

  //
  // print information about the population once we're done
  //
  printInfo(chameneos);
}

//
// This class represents a place for chameneos to meet
//
class MeetingPlace {
  //
  // the 'state' variable packs a chameneos ID in the bottom
  // NUM_CHAMENEOS_ID_BITS bits and the number of meetings in the
  // upper ones, permitting atomic operations to be performed on both
  // values simultaneously.
  //
  var state: atomic int;

  //
  // constructor initializes the number of meetings to take place
  //
  proc MeetingPlace(numMeetings) {
    state.write(numMeetings << NUM_CHAMENEOS_ID_BITS);
  }

  //
  // This method kicks off the execution of all the chameneos in
  // parallel and has them meet with each other in the meeting place.
  //
  proc hostMeetings(chameneos) {
    //
    // fire off a task per chameneos, and have them try to meet
    //
    coforall c in chameneos {
      //
      // each chameneos will try to have meetings with others as
      // long as meetings remain
      //
      do {
        //
        // read the current state, atomically
        //
        const currentState = state.read(memory_order_acquire);

        //
        // extract the number of meetings remaining and the index of a
        // waiting peer (if any) from the state
        //
        const (meetingsLeft, peerID) = stateToVals(currentState);

        //
        // if meetings remain, let's try to get one
        //
        if (meetingsLeft) {
          //
          // We're the first to arrive if there is no peer index in the
          // state
          //
          const firstToArrive = (peerID == 0);

          //
          // We'll try to meet by optimistically building the state
          // that would indicate we were successful in meeting.
          // We decrement the meetingsLeft if we are the second to arrive.
          // If we're the first to arrive, we store our ID; otherwise,
          // we reset the ID to zero.
          //
          const newState = valsToState(meetingsLeft - !firstToArrive,
                                       if firstToArrive then c.id else 0);

          //
          // use a compare-exchange to see if the state remains the
          // same, and to swap in the new state we've computed if it is.
          //
          if (state.compareExchangeStrong(currentState, newState,
                                          memory_order_acq_rel)) {
            //
            // We get to meet!
            //
            if (firstToArrive) {
              //
              // We were the first chameneos in, so we wait for the
              // other to complete the meeting
              //
              c.waitForMeetingToEnd();
            } else {
              //
              // We were the second chameneos in, so we run the meeting
              //
              c.meetWith(chameneos[peerID]);
            }
          }
        }
        //
        // continue looping as long as meetings remain
        //
      } while (meetingsLeft);
    }
  }

  //
  // This method computes a state value from a number of meetings and ID
  //
  inline proc valsToState(numMeetings, chameneosID) {
    return (numMeetings << NUM_CHAMENEOS_ID_BITS) | chameneosID;
  }

  //
  // This method extracts the number of meeting IDs and chameneos ID from
  // a state value
  //
  inline proc stateToVals(state) {
    return (state >> NUM_CHAMENEOS_ID_BITS, state & CHAMENEOS_ID_MASK);
  }
}

//
// a class representing a chameneos
//
class Chameneos {
  const id: int;                       // its unique ID
  var color: Color;                    // its color
  var meetings,                        // the number of meetings it's had
      meetingsWithSelf: int;           // the number of meetings with itself
  var meetingCompleted: atomic bool;   // indicates that a meeting is over

  //
  // This method says how to wait for a meeting to end and is used
  // by the first chameneos to a meeting
  //
  proc waitForMeetingToEnd() {
    //
    // wait for meeting to end
    //
    meetingCompleted.waitFor(true);
    //
    // and then reset our meetingCompleted flag for next time
    //
    meetingCompleted.write(false, memory_order_release);
  }

  //
  // This method computes the meeting between 'this' chameneos and
  // its peer and is used by the second chameneos to a meeting
  //
  proc meetWith(peer) {
    //
    // If we meet with ourself, something's wrong, so check for that
    //
    const metSelf = (peer == this);

    //
    // compute the new color that we'll share as a function of our
    // current colors
    //
    const newColor = getNewColor(color, peer.color);

    //
    // Update our peer's state: store the new color, update its
    // meetings, and then tell it that the meeting's over
    //
    //
    // TODO: abstract the following two assignments into a method to
    // avoid repetition?  Or is that more trouble than it's worth?
    //
    peer.color = newColor;
    peer.meetings += 1;
    peer.meetingsWithSelf += metSelf;
    peer.meetingCompleted.write(true, memory_order_release);

    //
    // Then update ourself similarly
    //
    color = newColor;
    meetings += 1;
    meetingsWithSelf += metSelf;
  }
}

//
// createChameneos() creates an array of chameneos of the given size.
// If the size is 10, it uses the predefined array of colors;
// otherwise, it deals out colors round-robin.
//
//
// TODO: Currently, the compiler prints out an error if we remove the
// return type from here; seems it would be nicer if it just put in
// the array temp?  (unless we think we want to return unevaluated
// iterators, which we may?  But even then, maybe in the meantime, we
// should realize it?)
//
proc createChameneos(size): [1..size] Chameneos {
  //
  // TODO: Really want support for 'use Color' for cases like this
  //
  const colorsFor10 = [Color.blue, Color.red, Color.yellow, Color.red,
                       Color.yellow, Color.blue, Color.red, Color.yellow,
                       Color.red, Color.blue];

  return [i in 1..size] new Chameneos(i, if (size == 10) then colorsFor10[i]
                                                         else ((i-1)%3):Color);
}

//
// getNewColor() returns the complement of two colors; if the two colors
// are the same value, the color stays the same; otherwise, it becomes the
// third color.
//
inline proc getNewColor(myColor, otherColor) {
  select myColor {
    when Color.blue {
      select otherColor {
        when Color.blue do return Color.blue;
        when Color.red  do return Color.yellow;
        otherwise          return Color.red;
      }
    }
    when Color.red {
      select otherColor {
        when Color.blue do return Color.yellow;
        when Color.red  do return Color.red;
        otherwise          return Color.blue;
      }
    }
    otherwise {
      select otherColor {
        when Color.blue do return Color.red;
        when Color.red  do return Color.blue;
        otherwise          return Color.yellow;
      }
    }
  }
}

//
// printColorEquations() prints the result of getNewColor() for all
// pairs of colors
//
proc printColorEquations() {
  const colors = [Color.blue, Color.red, Color.yellow];
  for color1 in colors {
    for color2 in colors {
      writeln(color1, " + ", color2, " -> ", getNewColor(color1, color2));
    }
  }
  writeln();
}

//
// printInfo() prints out information about the population using
// a combination of numbers and English text
//
proc printInfo(chameneos) {
  //
  // for each chameneos, print the number of meetings and spell out
  // the number of self-meetings for each chameneos
  //
  for c in chameneos {
    write(c.meetings);
    spellInt(c.meetingsWithSelf);
  }

  //
  // compute the total number of meetings and spell it out
  //
  const totalMeetings = + reduce chameneos.meetings;
  spellInt(totalMeetings);
  writeln();
}

//
// the base-10 digits
//
// TODO: Would be nice to be able to make this local to spellInt()
//
enum Digit {zero=0, one, two, three, four, five, six, seven, eight, nine};

//
// spellInt() takes out an integer value and prints its digits out
// in English
//
proc spellInt(n) {
  //
  // Cast n to a string so that it's easier (?!) to pick out its characters
  //
  var s = n:string;
  //
  // TODO: would be nice to replace this with a character iterator?
  //
  for i in 1..s.length do
    write(" ", (s.substring(i):int):Digit);
  writeln();
}


Adding parallel fannkuch version to release

/* The Computer Language Benchmarks Game
 * http://benchmarksgame.alioth.debian.org/
 *
 * contributed by Ben Harshbarger
 * based on Go implementation by Oleg Mazurov
 *
 */

use AdvancedIters;

config const n = 7;

assert(n >=3 && n <= 12, "n must be in 3..12");

config const nchunks = 720;
var Fact : [0..n] int;

var checks : atomic int;
var flips : atomic int;

proc main() {
  Fact[0] = 1;
  for i in 1..n do
    Fact[i] = Fact[i-1] * i;

  var chunksz = (Fact[n] + nchunks - 1) / nchunks;
  chunksz += chunksz%2;

  const work = 0 .. (Fact[n] - chunksz) by chunksz;

  forall idx in dynamic(work, 1) do fannkuch(idx, idx+chunksz);

  writeln(checks.read(), "\nPfannkuchen(", n, ") = ", flips.read());
}

proc fannkuch(idxMin:int, idxMax:int) {
  var p, pp, count : [0..#n] int;
  p = 0..#n;

  // first permutation
  var idx = idxMin;
  for i in 1..n-1 by -1 {
    const d = idx / Fact[i];
    count[i] = d;
    idx = idx % Fact[i];

    const slice = 0..#(i + 1);
    pp[slice] = p[slice];
    for j in 0..i {
      if j + d <= i then
        p[j] = pp[j+d];
      else
        p[j] = pp[j+d-i-1];
    }
  }

  var maxFlips = 1;
  var checkSum = 0;

  idx = idxMin;

  while true {
    if p[0] != 0 {
      //countFlips
      var locflips = 1;
      var first = p[0];

      if p[first] != 0 {
        pp = p;
        do {
          locflips += 1;
          var lo = 1, hi = first - 1;
          while lo < hi {
            pp[lo] <=> pp[hi];
            lo += 1;
            hi -= 1;
          }
          pp[first] <=> first;
        } while pp[first] != 0;
      }

      maxFlips = max(maxFlips, locflips);
      if idx%2 == 0 then checkSum += locflips;
      else checkSum -= locflips;
    }

    idx += 1;

    if idx == idxMax then break;

    // nextPerm
    var first = p[1];
    p[1] = p[0];
    p[0] = first;

    var i = 1;
    count[i] += 1;
    while count[i] > i {
      count[i] = 0;
      i += 1;
      const next = p[1];
      p[0] = p[1];
      for j in 1..i-1 do p[j] = p[j+1];
      p[i] = first;
      first = next;

      count[i] += 1;
    }
  }

  checks.add(checkSum);

  var curMax = flips.read();
  while curMax < maxFlips && !flips.compareExchange(curMax, maxFlips) do
    curMax = flips.read();
}

/* The Computer Language Benchmarks Game
 * http://benchmarksgame.alioth.debian.org/
 *
 * contributed by Kyle Brady and Brad Chamberlain
 * based on C implementation by Ledrug Katz
 *
 */

config const n = 7;

assert(n >= 3, "n must be in 3..");

const D = {0..n};
var s, t: [D] int;

proc main() {
  for i in D do
    s[i] = i;
  const (checksum, maxFlips) = tk();
  writeln(checksum);
  writeln("Pfannkuchen(", n, ") = ", maxFlips);
}

// Tompkin-Paige iterative permutation generation
proc tk() {
  var checksum, maxFlips = 0;
  var odd = false;
  var c: [D] int;

  var i = 0;
  while i < n {
    rotate(i);
    if c[i] >= i {
      c[i] = 0;
      i += 1;
      continue;
    }

    c[i] += 1;
    i = 1;
    odd = !odd;
    if s[0] {
      const f = if s[s[0]] then flip() else 1;
      if f > maxFlips then maxFlips = f;
      checksum += if odd then -f else f;
    }
  }

  return (checksum, maxFlips);
}

inline proc rotate(x) {
  const c = s[0];
  for i in 1..x {
    s[i-1] = s[i];
  }
  s[x] = c;
}

proc flip() {
  for i in D do
    t[i] = s[i];

  for i in 2..max(int) {
    var x = 0;
    var y = t[0];
    while x < y {
      t[x] <=> t[y];
      x += 1;
      y -= 1;
    }
    if t[t[0]] == 0 then return i;
  }
  return -1;
}


Upate to meteor-parallel-alt

Upate to meteor-parallel-alt

Replaced the direct intrinsic calls with calls into the BitOps library.
I also swapped a sync var out for a spinlock that uses atomics. This change
should probably be replaced with something from a (future) standard
library at some point.

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


Informing reader to refer to associative primer

/*
 * Domains primer
 *
 * This primer showcases Chapel domains.  For other uses of domains
 * see the Arrays primer (arrays.chpl) and the Sparse arrays primer
 * (sparse.chpl).
 *
 */

config var n = 10;
//
// A domain is a first-class representation of an index set used to
// specify iteration spaces, define arrays, and aggregate operations
// such as slicing.
//

//
// Chapel provides two base domain types: rectangular and associative.
// For more information about associative domains, see the Associative
// primer (associative.chpl).
//
// Rectangular domains are used to represent rectangular index sets.
// Each dimesion of a rectangular domain is specified by a range and
// thus can take on the shape of any range.  See the Ranges primer
// (ranges.chpl) for more information.
//
// Rectangular domains support a literal syntax that is a
// comma-separated list of range expressions enclosed in curly braces.
//
// RD is an n by n by n domain.
//
var RD: domain(3) = {1..n, 1..n, 1..n};
writeln(RD);

//
// Rectangular domains have a set of methods that enable convenient
// reuse of existing domains.
//
// The expand method returns a new domain that is expanded or
// contracted depending on the sign of the offset argument.
//
var RDbigger = RD.expand((1,1,1));
writeln(RDbigger);
var RDsmaller = RD.expand((-1,-1,-1));
writeln(RDsmaller);

//
// The exterior method returns a new domain that is the exterior
// portion of the current domain.  A positive offset specifies that
// the exterior should be taken from the high bound; a negative
// offset, the low bound.
//
var RDext_p = RD.exterior((1,1,1));
writeln(RDext_p);
var RDext_n = RD.exterior((-1,-1,-1));
writeln(RDext_n);

//
// The interior method returns a new domain that is the interior
// portion of the current domain.  The sign of the offset implies
// using the high or low bound as in the exterior case.
//
var RDint_p = RD.interior((1,1,1));
writeln(RDint_p);
var RDint_n = RD.interior((-1,-1,-1));
writeln(RDint_n);

//
// The translate method returns a new domain that is the current domain
// translated by the offset.
//
var RDtrans_p = RD.translate((1,1,1));
writeln(RDtrans_p);
var RDtrans_n = RD.translate((-1,-1,-1));
writeln(RDtrans_n);

//
// A subdomain is a domain that is declared in terms of a parent
// domain, causing it to have the same type as their parent.  A
// subdomain represents a subset of its parent domain's index set,
// though this constraint is not currently enforced by the
// implementation.

//
// Create rectangular subdomains.
//
var RSD1, RSD2 : subdomain(RD);

// A subdomain is initially empty.
writeln("RSD1:", RSD1);
writeln("RSD2:", RSD2);

// We can select parts of the original rectangular domain using slicing.
RSD1 = RD[..n/2, .., ..]; // This gives half of the domain
RSD2 = RD[n/2+1.., .., ..]; // And this the other half.

writeln("RSD1:", RSD1);
writeln("RSD2:", RSD2);

// Notes:
// - Subdomains of rectangular domains are regular unless they are explicitly
// declared to be sparse.
// - At present, range checking to ensure that a subdomain fits within its parent
// domain is unimplemented.

//
// Create a sparse subdomain of a regular domain.
//

var SSD: sparse subdomain(RD);

writeln("SSD:", SSD); // Initially empty.

// Add some indices to the sparse subdomain.

SSD += (1,2,3);
SSD += (4,5,6);
SSD += (7,8,9);
SSD += (9,10,1);

writeln("SSD:", SSD); // Now contains an unordered set of indices.

// Note: Checks to ensure that sparse subdomain indices lie within the parent domain
// have not been implemented.

/*
 * For more information on domains, see the Domains chapter of the
 * Chapel Language Spec.
 */

/*
 * Domains primer
 *
 * This primer showcases Chapel domains.  For other uses of domains
 * see the Arrays primer (arrays.chpl) and the Sparse arrays primer
 * (sparse.chpl).
 *
 */

config var n = 10;
//
// A domain is a first-class representation of an index set used to
// specify iteration spaces, define arrays, and aggregate operations
// such as slicing.
//

//
// Chapel provides two base domain types: rectangular and associative.
//
// Rectangular domains are used to represent rectangular index sets.
// Each dimesion of a rectangular domain is specified by a range and
// thus can take on the shape of any range.  See the Ranges primer
// (ranges.chpl) for more information.
//
// Rectangular domains support a literal syntax that is a
// comma-separated list of range expressions enclosed in curly braces.
//
// RD is an n by n by n domain.
//
var RD: domain(3) = {1..n, 1..n, 1..n};
writeln(RD);

//
// Rectangular domains have a set of methods that enable convenient
// reuse of existing domains.
//
// The expand method returns a new domain that is expanded or
// contracted depending on the sign of the offset argument.
//
var RDbigger = RD.expand((1,1,1));
writeln(RDbigger);
var RDsmaller = RD.expand((-1,-1,-1));
writeln(RDsmaller);

//
// The exterior method returns a new domain that is the exterior
// portion of the current domain.  A positive offset specifies that
// the exterior should be taken from the high bound; a negative
// offset, the low bound.
//
var RDext_p = RD.exterior((1,1,1));
writeln(RDext_p);
var RDext_n = RD.exterior((-1,-1,-1));
writeln(RDext_n);

//
// The interior method returns a new domain that is the interior
// portion of the current domain.  The sign of the offset implies
// using the high or low bound as in the exterior case.
//
var RDint_p = RD.interior((1,1,1));
writeln(RDint_p);
var RDint_n = RD.interior((-1,-1,-1));
writeln(RDint_n);

//
// The translate method returns a new domain that is the current domain
// translated by the offset.
//
var RDtrans_p = RD.translate((1,1,1));
writeln(RDtrans_p);
var RDtrans_n = RD.translate((-1,-1,-1));
writeln(RDtrans_n);

//
// A subdomain is a domain that is declared in terms of a parent
// domain, causing it to have the same type as their parent.  A
// subdomain represents a subset of its parent domain's index set,
// though this constraint is not currently enforced by the
// implementation.

//
// Create rectangular subdomains.
//
var RSD1, RSD2 : subdomain(RD);

// A subdomain is initially empty.
writeln("RSD1:", RSD1);
writeln("RSD2:", RSD2);

// We can select parts of the original rectangular domain using slicing.
RSD1 = RD[..n/2, .., ..]; // This gives half of the domain
RSD2 = RD[n/2+1.., .., ..]; // And this the other half.

writeln("RSD1:", RSD1);
writeln("RSD2:", RSD2);

// Notes:
// - Subdomains of rectangular domains are regular unless they are explicitly
// declared to be sparse.
// - At present, range checking to ensure that a subdomain fits within its parent
// domain is unimplemented.

//
// Create a sparse subdomain of a regular domain.
//

var SSD: sparse subdomain(RD);

writeln("SSD:", SSD); // Initially empty.

// Add some indices to the sparse subdomain.

SSD += (1,2,3);
SSD += (4,5,6);
SSD += (7,8,9);
SSD += (9,10,1);

writeln("SSD:", SSD); // Now contains an unordered set of indices.

// Note: Checks to ensure that sparse subdomain indices lie within the parent domain
// have not been implemented.

/*
 * For more information on domains, see the Domains chapter of the
 * Chapel Language Spec.
 */


Better header about other sources of information for domain types

/*
 * Domains primer
 *
 * This primer showcases Chapel domains as abstract concepts, primarily
 * within the context of rectangular domains.  For other uses of domains
 * see the following primers:
 *  - Arrays primer (arrays.chpl)
 *  - Sparse arrays primer (sparse.chpl)
 *  - Opaque arrays primer (opaque.chpl)
 *  - Associative arrays primer (associative.chpl)
 *
 */

config var n = 10;
//
// A domain is a first-class representation of an index set used to
// specify iteration spaces, define arrays, and aggregate operations
// such as slicing.
//

//
// Rectangular domains are used to represent rectangular index sets.
// Each dimesion of a rectangular domain is specified by a range and
// thus can take on the shape of any range.  See the Ranges primer
// (ranges.chpl) for more information.
//
// Rectangular domains support a literal syntax that is a
// comma-separated list of range expressions enclosed in curly braces.
//
// RD is an n by n by n domain.
//
var RD: domain(3) = {1..n, 1..n, 1..n};
writeln(RD);

//
// Rectangular domains have a set of methods that enable convenient
// reuse of existing domains.
//
// The expand method returns a new domain that is expanded or
// contracted depending on the sign of the offset argument.
//
var RDbigger = RD.expand((1,1,1));
writeln(RDbigger);
var RDsmaller = RD.expand((-1,-1,-1));
writeln(RDsmaller);

//
// The exterior method returns a new domain that is the exterior
// portion of the current domain.  A positive offset specifies that
// the exterior should be taken from the high bound; a negative
// offset, the low bound.
//
var RDext_p = RD.exterior((1,1,1));
writeln(RDext_p);
var RDext_n = RD.exterior((-1,-1,-1));
writeln(RDext_n);

//
// The interior method returns a new domain that is the interior
// portion of the current domain.  The sign of the offset implies
// using the high or low bound as in the exterior case.
//
var RDint_p = RD.interior((1,1,1));
writeln(RDint_p);
var RDint_n = RD.interior((-1,-1,-1));
writeln(RDint_n);

//
// The translate method returns a new domain that is the current domain
// translated by the offset.
//
var RDtrans_p = RD.translate((1,1,1));
writeln(RDtrans_p);
var RDtrans_n = RD.translate((-1,-1,-1));
writeln(RDtrans_n);

//
// A subdomain is a domain that is declared in terms of a parent
// domain, causing it to have the same type as their parent.  A
// subdomain represents a subset of its parent domain's index set,
// though this constraint is not currently enforced by the
// implementation.

//
// Create rectangular subdomains.
//
var RSD1, RSD2 : subdomain(RD);

// A subdomain is initially empty.
writeln("RSD1:", RSD1);
writeln("RSD2:", RSD2);

// We can select parts of the original rectangular domain using slicing.
RSD1 = RD[..n/2, .., ..]; // This gives half of the domain
RSD2 = RD[n/2+1.., .., ..]; // And this the other half.

writeln("RSD1:", RSD1);
writeln("RSD2:", RSD2);

// Notes:
// - Subdomains of rectangular domains are regular unless they are explicitly
// declared to be sparse.
// - At present, range checking to ensure that a subdomain fits within its parent
// domain is unimplemented.

//
// Create a sparse subdomain of a regular domain.
//

var SSD: sparse subdomain(RD);

writeln("SSD:", SSD); // Initially empty.

// Add some indices to the sparse subdomain.

SSD += (1,2,3);
SSD += (4,5,6);
SSD += (7,8,9);
SSD += (9,10,1);

writeln("SSD:", SSD); // Now contains an unordered set of indices.

// Note: Checks to ensure that sparse subdomain indices lie within the parent domain
// have not been implemented.

/*
 * For more information on domains, see the Domains chapter of the
 * Chapel Language Spec.
 */

/*
 * Domains primer
 *
 * This primer showcases Chapel domains.  For other uses of domains
 * see the Arrays primer (arrays.chpl) and the Sparse arrays primer
 * (sparse.chpl).
 *
 */

config var n = 10;
//
// A domain is a first-class representation of an index set used to
// specify iteration spaces, define arrays, and aggregate operations
// such as slicing.
//

//
// Chapel provides two base domain types: rectangular and associative.
// For more information about associative domains, see the Associative
// primer (associative.chpl).
//
// Rectangular domains are used to represent rectangular index sets.
// Each dimesion of a rectangular domain is specified by a range and
// thus can take on the shape of any range.  See the Ranges primer
// (ranges.chpl) for more information.
//
// Rectangular domains support a literal syntax that is a
// comma-separated list of range expressions enclosed in curly braces.
//
// RD is an n by n by n domain.
//
var RD: domain(3) = {1..n, 1..n, 1..n};
writeln(RD);

//
// Rectangular domains have a set of methods that enable convenient
// reuse of existing domains.
//
// The expand method returns a new domain that is expanded or
// contracted depending on the sign of the offset argument.
//
var RDbigger = RD.expand((1,1,1));
writeln(RDbigger);
var RDsmaller = RD.expand((-1,-1,-1));
writeln(RDsmaller);

//
// The exterior method returns a new domain that is the exterior
// portion of the current domain.  A positive offset specifies that
// the exterior should be taken from the high bound; a negative
// offset, the low bound.
//
var RDext_p = RD.exterior((1,1,1));
writeln(RDext_p);
var RDext_n = RD.exterior((-1,-1,-1));
writeln(RDext_n);

//
// The interior method returns a new domain that is the interior
// portion of the current domain.  The sign of the offset implies
// using the high or low bound as in the exterior case.
//
var RDint_p = RD.interior((1,1,1));
writeln(RDint_p);
var RDint_n = RD.interior((-1,-1,-1));
writeln(RDint_n);

//
// The translate method returns a new domain that is the current domain
// translated by the offset.
//
var RDtrans_p = RD.translate((1,1,1));
writeln(RDtrans_p);
var RDtrans_n = RD.translate((-1,-1,-1));
writeln(RDtrans_n);

//
// A subdomain is a domain that is declared in terms of a parent
// domain, causing it to have the same type as their parent.  A
// subdomain represents a subset of its parent domain's index set,
// though this constraint is not currently enforced by the
// implementation.

//
// Create rectangular subdomains.
//
var RSD1, RSD2 : subdomain(RD);

// A subdomain is initially empty.
writeln("RSD1:", RSD1);
writeln("RSD2:", RSD2);

// We can select parts of the original rectangular domain using slicing.
RSD1 = RD[..n/2, .., ..]; // This gives half of the domain
RSD2 = RD[n/2+1.., .., ..]; // And this the other half.

writeln("RSD1:", RSD1);
writeln("RSD2:", RSD2);

// Notes:
// - Subdomains of rectangular domains are regular unless they are explicitly
// declared to be sparse.
// - At present, range checking to ensure that a subdomain fits within its parent
// domain is unimplemented.

//
// Create a sparse subdomain of a regular domain.
//

var SSD: sparse subdomain(RD);

writeln("SSD:", SSD); // Initially empty.

// Add some indices to the sparse subdomain.

SSD += (1,2,3);
SSD += (4,5,6);
SSD += (7,8,9);
SSD += (9,10,1);

writeln("SSD:", SSD); // Now contains an unordered set of indices.

// Note: Checks to ensure that sparse subdomain indices lie within the parent domain
// have not been implemented.

/*
 * For more information on domains, see the Domains chapter of the
 * Chapel Language Spec.
 */