More cleanup

More cleanup

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

// Wrapper for FFTW version 3.

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

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

  To use this module:

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

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

  3. Compile and run your Chapel program as usual.

  As in standard FFTW usage, the flow is to:

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

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

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

  4. Call :proc:`cleanup`.

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

  In future versions of this module, we anticipate improving the
  plan_dft*() interfaces to make better use of Chapel features and
  move further away from C-isms (like the overloaded role of `flags`
  and the use of C-based types).  Such features are expected to take
  advantage of Chapel's support for default argument values and
  keyword-based argument passing.  We are also thinking about changing
  the interface for the in-place routines to use array slicing rather
  than separate arguments for the array and domain.
*/

// Possible TODOs:
//
// - 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?  What if we were to replace
//   these with bool/enum arguments representing the separate planning
//   aspects that are overloaded into 'flags'?  This would also allow
//   us to move away from c_ints (which could be done in other ways
//   as well, such as safe-casting and providing our own versions of
//   the C variables).
//
// - It seems that rather than passing in a domain and an array for
//   the in-place cases, we could probably pass in an array slice
//   where the array's allocating domain reflected the padding and
//   the slicing domain reflected the area over which the FFT should
//   be performed.  Would this be cleaner?  Would the overhead be
//   significant?
//

module FFTW {

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

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

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

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

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

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

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

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

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

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

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft(input: [?Din] complex(128), output: [?Dout] complex(128),
                 sign: c_int, flags: c_uint) : fftw_plan
  {
    if !noFFTWsizeChecks {
      var error = false;

      for i in 1..input.rank do
        error |= Private_FFTW.checkDimMismatch(Din, Dout, i, "plan_dft()");

      if error then
        halt("Incorrect array sizes in plan_dft()");
    }

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

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

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

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

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

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

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

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

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

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

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

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

    :arg output: The output array, whose size and shape must match the input array's, except for the leading dimension which should be n/2 + 1, where n is the size of the input array's leading dimension.  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ 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 : [?Din] real(64), output : [?Dout] complex(128),
                    flags :c_uint) : fftw_plan
  {
    param rank = input.rank: c_int;

    if !noFFTWsizeChecks {
      var error = false;

      for i in 1..rank-1 do
        error |= Private_FFTW.checkDimMismatch(Din, Dout, i, "plan_dft_r2c()");

      error |= Private_FFTW.checkRealCplxDimMismatch(Din, Dout, "plan_dft_r2c()", "output ");

      if (error) then
        halt("Incorrect array sizes in plan_dft_r2c()");
    }

    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
  /*
    Create a plan for a real-to-complex, in-place DFT.

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

    :arg arr: The array to be used as the in-place input/output array.  If passing in an array of `real` elements, the leading dimension of the array must be padded to store 2(n/2 + 1) elements, where `n` is the size of the corresponding dimension of `realDom`.  If passing in an array of `complex` elements, the leading dimension should be (n/2 + 1).  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type arr: [] `T` where `T` is of type `real(640` or `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(realDom : domain, arr : [?D] ?t, flags : c_uint) : fftw_plan
    where t == real || t == complex
  {
    if !noFFTWsizeChecks then
      if Private_FFTW.checkInPlaceDimMismatch(realDom, D, "plan_dft_r2c()", t == real) then
        halt("Incorrect array sizes in plan_dft_r2c()");

    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);
  }

  //
  // Error overload
  //
  pragma "no doc"
  proc plan_dft_r2c(realDom : domain, arr: [] ?t, flags : c_uint) : fftw_plan {
    compilerError("plan_dft_r2c() is only supported for arrays of type real(64) and complex(128)");
  }

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

    :arg input: The input array, whose size and shape must match the output array's, except for the leading dimension which should be n/2 + 1, where n is the size of the output array's leading dimension.  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type input: [] `complex(128)`

    :arg output: The output array
    :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 : [?Din] complex(128), output : [?Dout] real(64),
                    flags :c_uint) : fftw_plan
  {
    param rank = output.rank: c_int; // The dimensions are that of the real array

    if !noFFTWsizeChecks {
      var error = false;

      for i in 1..rank-1 do
        error |= Private_FFTW.checkDimMismatch(Din, Dout, i, "plan_dft_c2r()");

      error |= Private_FFTW.checkRealCplxDimMismatch(Dout, Din, "plan_dft_c2r()", "input ");

      if (error) then
        halt("Incorrect array sizes in plan_dft_c2r()");
    }

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

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

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

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

    :arg arr: The array to be used as the in-place input/output array.  If passing in an array of `real` elements, the leading dimension of the array must be padded to store 2(n/2 + 1) elements, where `n` is the size of the corresponding dimension of `realDom`.  If passing in an array of `complex` elements, the leading dimension should be (n/2 + 1).  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type arr: [] `T` where `T` is of type `real(64)` or `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_c2r(realDom : domain, arr: [?D] ?t, flags : c_uint) : fftw_plan
    where t == real || t == complex
  {
    if !noFFTWsizeChecks then
      if Private_FFTW.checkInPlaceDimMismatch(realDom, D, "plan_dft_c2r()", t == real) then
        halt("Incorrect array sizes in plan_dft_c2r()");

    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);
  }

  pragma "no doc"
  proc plan_dft_c2r(realDom : domain, arr: [] ?t, flags : c_uint) : fftw_plan {
    compilerError("plan_dft_c2r() is only supported for arrays of type real(64) and complex(128)");
  }

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

  //
  // This is a helper module to give us a "private" notion.  Once we
  // have a private keyword, these could be hoisted to module scope
  // and labeled private.
  //
  pragma "no doc"
  module Private_FFTW {
    //
    // Check for a mismatch in size between two domain dimensions,
    // print an error if they don't, and return whether or not a
    // mismatch occurred.  Note that the 'inplace' argument is used to
    // customize the error message for in-place and out-of-place
    // cases.
    //
    proc checkDimMismatch(inDom, outDom, dim, fnname, inplace=false) {
      const inputDim = inDom.dim(dim).size;
      const outputDim = outDom.dim(dim).size;
      if (inputDim == outputDim) then
        return false;

      const first = if inplace then "domain" else "input";
      const second = if inplace then "array" else "output";

      writeln("Error: In ", fnname, ", the ", first, " and ", second,
              if !inplace then " arrays" else "",
              " don't have same size in dimension ", dim,
              " (", first, " = ", inputDim, ", ", second, " = ", outputDim,
              ")");
      return true;
    }

    //
    // Check for mismatches in the dimensions for an in-place
    // transform between the logical domain for a DFT and the
    // physical domain over which the array is allocated.
    //
    proc checkInPlaceDimMismatch(logDom, physDom, fnname, realElems) {
      var error = false;

      for i in 1..logDom.rank-1 do
        error |= checkDimMismatch(logDom, physDom, i, fnname, inplace=true);

      if realElems {
        error |= Private_FFTW.checkRealInPlaceDimMismatch(logDom, physDom, fnname);
      } else {
        error |= Private_FFTW.checkRealCplxDimMismatch(logDom, physDom, fnname);
      }
      return error;
    }

    //
    // Check for a mismatch in the proper size relationship between
    // two domain dimensions where the first describes a real array
    // and the second a complex array.  The 'cplxarrdesc' is used
    // to customize the error message for the role of the complex
    // domain.
    //
    proc checkRealCplxDimMismatch(Dreal, Dcomplex, fnname, cplxarrdesc="") {
      const dim = Dreal.rank;
      const realDim = Dreal.dim(dim).size/2+1;
      const complexDim = Dcomplex.dim(dim).size;

      if (realDim == complexDim) then
        return false;

      writeln("Error: In ", fnname, ", the ", cplxarrdesc,
              "array's leading dimension is not the proper size (expected ", realDim,
              ", got ", complexDim, ")");
      return true;
    }

    //
    // Check for a mismatch in the proper size relationship between two
    // domain dimensions for an in-place transform on reals, where the
    // first describes the logical computation coordinates and the
    // second describes the domain describing the padded array allocation.
    //
    proc checkRealInPlaceDimMismatch(Dreal, Darr, fnname) {
      const dim = Dreal.rank;
      const arrDim = Darr.dim(dim).size;
      const domDim = 2*(Dreal.dim(dim).size/2+1);
      if (arrDim == domDim) then
        return false;

      writeln("Error: In ", fnname,
              ", the array's leading dimension is not the proper size (expected ", domDim,
              ", got ", arrDim, ")");
      return true;
    }
  }

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

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

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

    extern proc fftw_execute(const plan : fftw_plan);

    extern proc fftw_destroy_plan(plan : fftw_plan);

    extern proc fftw_cleanup();

    extern proc fftw_init_threads() : c_int;

    extern proc fftw_cleanup_threads();

    extern proc fftw_plan_with_nthreads(n : c_int);
  }
}

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

// Wrapper for FFTW version 3.

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

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

  To use this module:

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

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

  3. Compile and run your Chapel program as usual.

  As in standard FFTW usage, the flow is to:

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

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

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

  4. Call :proc:`cleanup`.

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

  In future versions of this module, we anticipate improving the
  plan_dft*() interfaces to make better use of Chapel features and
  move further away from C-isms (like the overloaded role of `flags`
  and the use of C-based types).  Such features are expected to take
  advantage of Chapel's support for default argument values and
  keyword-based argument passing.  We are also thinking about changing
  the interface for the in-place routines to use array slicing rather
  than separate arguments for the array and domain.
*/

// Possible TODOs:
//
// - 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?  What if we were to replace
//   these with bool/enum arguments representing the separate planning
//   aspects that are overloaded into 'flags'?  This would also allow
//   us to move away from c_ints (which could be done in other ways
//   as well, such as safe-casting and providing our own versions of
//   the C variables).
//
// - It seems that rather than passing in a domain and an array for
//   the in-place cases, we could probably pass in an array slice
//   where the array's allocating domain reflected the padding and
//   the slicing domain reflected the area over which the FFT should
//   be performed.  Would this be cleaner?  Would the overhead be
//   significant?
//

module FFTW {

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

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

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

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

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

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

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

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

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

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

    :returns: The :type:`fftw_plan` representing the resulting plan
  */
  proc plan_dft(input: [?Din] complex(128), output: [?Dout] complex(128),
                 sign: c_int, flags: c_uint) : fftw_plan
  {
    if !noFFTWsizeChecks {
      var error = false;

      for i in 1..input.rank do
        error |= Private_FFTW.checkDimMismatch(Din, Dout, i, "plan_dft()");

      if error then
        halt("Incorrect array sizes in plan_dft()");
    }

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

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

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

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

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

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

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

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

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

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

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

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

    :arg output: The output array, whose size and shape must match the input array's, except for the leading dimension which should be n/2 + 1, where n is the size of the input array's leading dimension.  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ 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 : [?Din] real(64), output : [?Dout] complex(128),
                    flags :c_uint) : fftw_plan
  {
    param rank = input.rank: c_int;

    if !noFFTWsizeChecks {
      var error = false;

      for i in 1..rank-1 do
        error |= Private_FFTW.checkDimMismatch(Din, Dout, i, "plan_dft_r2c()");

      error |= Private_FFTW.checkRealCplxDimMismatch(Din, Dout, "plan_dft_r2c()", "output ");

      if (error) then
        halt("Incorrect array sizes in plan_dft_r2c()");
    }

    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
  /*
    Create a plan for a real-to-complex, in-place DFT.

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

    :arg arr: The array to be used as the in-place input/output array.  If passing in an array of `real` elements, the leading dimension of the array must be padded to store 2(n/2 + 1) elements, where `n` is the size of the corresponding dimension of `realDom`.  If passing in an array of `complex` elements, the leading dimension should be (n/2 + 1).  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type arr: [] `T` where `T` is of type `real(640` or `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(realDom : domain, arr : [?D] ?t, flags : c_uint) : fftw_plan
    where t == real || t == complex
  {
    param rank = realDom.rank: c_int;

    if !noFFTWsizeChecks {
      var error = false;

      error = Private_FFTW.checkInPlaceDimMismatch(realDom, D, "plan_dft_r2c()", t == real);
      /*
      for i in 1..rank-1 do
        error |= Private_FFTW.checkDimMismatch(realDom, D, i, "plan_dft_r2c()",
                                               inplace=true);

      if t == real {
        error |= Private_FFTW.checkRealInPlaceDimMismatch(realDom, D, "plan_dft_r2c()");
      } else {
        error |= Private_FFTW.checkRealCplxDimMismatch(realDom, D, "plan_dft_r2c()");
      }
      */
      if (error) then
        halt("Incorrect array sizes in plan_dft_r2c()");
    }

    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);
  }

  //
  // Error overload
  //
  pragma "no doc"
  proc plan_dft_r2c(realDom : domain, arr: [] ?t, flags : c_uint) : fftw_plan {
    compilerError("plan_dft_r2c() is only supported for arrays of type real(64) and complex(128)");
  }

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

    :arg input: The input array, whose size and shape must match the output array's, except for the leading dimension which should be n/2 + 1, where n is the size of the output array's leading dimension.  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type input: [] `complex(128)`

    :arg output: The output array
    :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 : [?Din] complex(128), output : [?Dout] real(64),
                    flags :c_uint) : fftw_plan
  {
    param rank = output.rank: c_int; // The dimensions are that of the real array

    if !noFFTWsizeChecks {
      var error = false;

      for i in 1..rank-1 do
        error |= Private_FFTW.checkDimMismatch(Din, Dout, i, "plan_dft_c2r()");

      error |= Private_FFTW.checkRealCplxDimMismatch(Dout, Din, "plan_dft_c2r()", "input ");

      if (error) then
        halt("Incorrect array sizes in plan_dft_c2r()");
    }

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

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

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

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

    :arg arr: The array to be used as the in-place input/output array.  If passing in an array of `real` elements, the leading dimension of the array must be padded to store 2(n/2 + 1) elements, where `n` is the size of the corresponding dimension of `realDom`.  If passing in an array of `complex` elements, the leading dimension should be (n/2 + 1).  See the `FFTW documentation <http://www.fftw.org/fftw3_doc/Multi_002dDimensional-DFTs-of-Real-Data.html#Multi_002dDimensional-DFTs-of-Real-Data>`_ for more information.
    :type arr: [] `T` where `T` is of type `real(64)` or `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_c2r(realDom : domain, arr: [?D] ?t, flags : c_uint) : fftw_plan
    where t == real || t == complex
  {
    param rank = realDom.rank: c_int;

    if !noFFTWsizeChecks {
      var error = false;

      error = Private_FFTW.checkInPlaceDimMismatch(realDom, D, "plan_dft_c2r()", t == real);
      /*
      for i in 1..rank-1 do
        error |= Private_FFTW.checkDimMismatch(realDom, D, i, "plan_dft_c2r()",
                                               inplace=true);

      if t == real {
        error |= Private_FFTW.checkRealInPlaceDimMismatch(realDom, D, "plan_dft_c2r()");
      } else {
        error |= Private_FFTW.checkRealCplxDimMismatch(realDom, D, "plan_dft_c2r()");
      }
      */
      if (error) then
        halt("Incorrect array sizes in plan_dft_c2r()");
    }

    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);
  }

  pragma "no doc"
  proc plan_dft_c2r(realDom : domain, arr: [] ?t, flags : c_uint) : fftw_plan {
    compilerError("plan_dft_c2r() is only supported for arrays of type real(64) and complex(128)");
  }

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

  //
  // This is a helper module to give us a "private" notion.  Once we
  // have a private keyword, these could be hoisted to module scope
  // and labeled private.
  //
  pragma "no doc"
  module Private_FFTW {
    //
    // Check for a mismatch in size between two domain dimensions,
    // print an error if they don't, and return whether or not a
    // mismatch occurred.  Note that the 'inplace' argument is used to
    // customize the error message for in-place and out-of-place
    // cases.
    //
    proc checkDimMismatch(inDom, outDom, dim, fnname, inplace=false) {
      const inputDim = inDom.dim(dim).size;
      const outputDim = outDom.dim(dim).size;
      if (inputDim == outputDim) then
        return false;

      const first = if inplace then "domain" else "input";
      const second = if inplace then "array" else "output";

      writeln("Error: In ", fnname, ", the ", first, " and ", second,
              if !inplace then " arrays" else "",
              " don't have same size in dimension ", dim,
              " (", first, " = ", inputDim, ", ", second, " = ", outputDim,
              ")");
      return true;
    }

    //
    // Check for mismatches in the dimensions for an in-place
    // transform between the logical domain for a DFT and the
    // physical domain over which the array is allocated.
    //
    proc checkInPlaceDimMismatch(logDom, physDom, fnname, realElems) {
      var error = false;

      for i in 1..logDom.rank-1 do
        error |= checkDimMismatch(logDom, physDom, i, fnname, inplace=true);

      if realElems {
        error |= Private_FFTW.checkRealInPlaceDimMismatch(logDom, physDom, fnname);
      } else {
        error |= Private_FFTW.checkRealCplxDimMismatch(logDom, physDom, fnname);
      }
      return error;
    }

    //
    // Check for a mismatch in the proper size relationship between
    // two domain dimensions where the first describes a real array
    // and the second a complex array.  The 'cplxarrdesc' is used
    // to customize the error message for the role of the complex
    // domain.
    //
    proc checkRealCplxDimMismatch(Dreal, Dcomplex, fnname, cplxarrdesc="") {
      const dim = Dreal.rank;
      const realDim = Dreal.dim(dim).size/2+1;
      const complexDim = Dcomplex.dim(dim).size;

      if (realDim == complexDim) then
        return false;

      writeln("Error: In ", fnname, ", the ", cplxarrdesc,
              "array's leading dimension is not the proper size (expected ", realDim,
              ", got ", complexDim, ")");
      return true;
    }

    //
    // Check for a mismatch in the proper size relationship between two
    // domain dimensions for an in-place transform on reals, where the
    // first describes the logical computation coordinates and the
    // second describes the domain describing the padded array allocation.
    //
    proc checkRealInPlaceDimMismatch(Dreal, Darr, fnname) {
      const dim = Dreal.rank;
      const arrDim = Darr.dim(dim).size;
      const domDim = 2*(Dreal.dim(dim).size/2+1);
      if (arrDim == domDim) then
        return false;

      writeln("Error: In ", fnname,
              ", the array's leading dimension is not the proper size (expected ", domDim,
              ", got ", arrDim, ")");
      return true;
    }
  }

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

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

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

    extern proc fftw_execute(const plan : fftw_plan);

    extern proc fftw_destroy_plan(plan : fftw_plan);

    extern proc fftw_cleanup();

    extern proc fftw_init_threads() : c_int;

    extern proc fftw_cleanup_threads();

    extern proc fftw_plan_with_nthreads(n : c_int);
  }
}


Revert "Resolve time-write.chpl regression (jira issue 25)"

/*
This is a test of Chapel's write() of a string vs. C's printf()
of the same string, which has no formatting in it.

The test exposes Chapel's overhead on top of the actual work
of displaying the string.

To make the timing meaningful, the test performs write()/printf()
multiple times. To reduce the output volume, we use a short string.
This has the (unintentional) effect of emphasizing the overhead.

Since we expect the output to be redirected, due to its high volume,
there may be various startup effects.
To mitigate them, we rotate the variants 'tries' times,
starting with the one we expect to be the fastest.
However, the initial measurements did not support this concern.

Test variations - in C:
* Use printf() or puts().
* For C, wrap printf() in a loop in C or in Chapel.
* Pass "\n" to printf() from Chapel as a Chapel 'string' or 'c_string'.
* For the previous one, make it a global constant or a local constant.
* We could also do the above variations for puts() - skip that for now,
  to reduce the amount of info to deal with, and perhaps puts() is
  less interesting.

Test variations - in Chapel:
* since stdout is blocking, we also try a variant using a workaround of
  creating a non-blocking version of it - see stdoutNB.

Michael's remarks on performance:

+ Chapel's write() or stdout.write()
actually call printf so that Chapel programs and C
programs can intermix their standard output. They
are also both line buffered which reduces performance.
  Chapel's stdout is using the C stdout FILE*,
and calling fwrite. That means that any data
sent to Chapel's stdout is buffered twice in
the application:
 - once in the QIO channel
 - once in the FILE* buffer
I would expect this to reduce performance.

+ We could revisit that design decision and make
write use file descriptor 1 if we no longer wanted
it to work this way. It would go faster but possibly
result in unexpected intermixings of stdout.

+ The performance lag of Chapel with openfd(1)
is worth investigating regardless of the above.

+ I also think that it's important to compare
locking=false with printf_unlocked.
[See "man unlocked_stdio" - basically it is the C version of printf
that does not lock the FILE* so it's only safe to use in a serial context.]
*/

use Time;

config const n = 3;
config const tries = 2;
config const fmt = "%7.3dr";
config const compareTimes = false;

// Each trial() function writes a newline 'n' times.

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

extern proc cf_trial(n: int);
extern proc cs_trial(n: int);

proc lstr_trial() {
  extern proc printf(format: c_string, arg...);
  for 1..n do
    printf("%s", "\n".c_str());
}

proc lcs_trial() {
  extern proc printf(format: c_string, arg...);
  const c_newline_local: c_string = "\n";
  for 1..n do
    printf("%s", c_newline_local);
}

const str_newline_global = "\n";
proc gstr_trial() {
  extern proc printf(format: c_string, arg...);
  for 1..n do
    printf("%s", str_newline_global.c_str());
}

const c_newline_global: c_string = "\n";
proc gcs_trial() {
  extern proc printf(format: c_string, arg...);
  for 1..n do
    printf("%s", c_newline_global);
}

// could do the same with puts() - would be too much, skip it for now

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

// write() a newline to stdout (non-blocking), 'n' times
const outfd = openfd(1);
const stdoutNB = outfd.writer(locking=false);
proc nb_trial() {
  for 1..n do
    stdoutNB.write("\n");
}

// write() a newline to stdout (blocking), 'n' times
proc sto_trial() {
  for 1..n do
    write("\n");
}

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

var tSave, tDummy, tcf, tcs, tlstr, tlcs, tgstr, tgcs, tnb, tsto: real;

inline proc addTime(ref t: real) {
  const tCurr = getCurrentTime();
  t += tCurr - tSave;
  tSave = tCurr;

}

const reportFormat = "%-24s " + fmt + "\n";
inline proc reportTime(title: string, time: real) {
  stderr.writef(reportFormat, title, time);
}

stderr.writef("n      %i\n", n);
stderr.writef("tries  %i\n", tries);

for t in 1..tries {
  stderr.writef("starting try %i\n", t);
  addTime(tDummy);

  cf_trial(n);   addTime(tcf);
  cs_trial(n);   addTime(tcs);
  lstr_trial();  addTime(tlstr);
  lcs_trial();   addTime(tlcs);
  gstr_trial();  addTime(tgstr);
  gcs_trial();   addTime(tgcs);

  nb_trial();     addTime(tnb);
  sto_trial();   addTime(tsto);
}

stderr.writef("done tries\n");
//stderr.writef("n      %i\n", n);
//stderr.writef("tries  %i\n", tries);

if compareTimes {
  reportTime("C printf", tcf);
  reportTime("C puts", tcs);
  reportTime("C/chpl string literal",  tlstr);
  reportTime("C/chpl c_string local",  tlcs);
  reportTime("C/chpl string global",   tgstr);
  reportTime("C/chpl c_string global", tgcs);
  reportTime("chpl non-blocking", tnb);
  reportTime("chpl stdout", tsto);
}

/*
This is a test of Chapel's write() of a string vs. C's printf()
of the same string, which has no formatting in it.

The test exposes Chapel's overhead on top of the actual work
of displaying the string.

To make the timing meaningful, the test performs write()/printf()
multiple times. To reduce the output volume, we use a short string.
This has the (unintentional) effect of emphasizing the overhead.

Since we expect the output to be redirected, due to its high volume,
there may be various startup effects.
To mitigate them, we rotate the variants 'tries' times,
starting with the one we expect to be the fastest.
However, the initial measurements did not support this concern.

Test variations - in C:
* Use printf() or puts().
* For C, wrap printf() in a loop in C or in Chapel.
* Pass "\n" to printf() from Chapel as a Chapel 'string' or 'c_string'.
* For the previous one, make it a global constant or a local constant.
* We could also do the above variations for puts() - skip that for now,
  to reduce the amount of info to deal with, and perhaps puts() is
  less interesting.

Test variations - in Chapel:
* since stdout is blocking, we also try a variant using a workaround of
  creating a non-blocking version of it - see stdoutNB.

Michael's remarks on performance:

+ Chapel's write() or stdout.write()
actually call printf so that Chapel programs and C
programs can intermix their standard output. They
are also both line buffered which reduces performance.
  Chapel's stdout is using the C stdout FILE*,
and calling fwrite. That means that any data
sent to Chapel's stdout is buffered twice in
the application:
 - once in the QIO channel
 - once in the FILE* buffer
I would expect this to reduce performance.

+ We could revisit that design decision and make
write use file descriptor 1 if we no longer wanted
it to work this way. It would go faster but possibly
result in unexpected intermixings of stdout.

+ The performance lag of Chapel with openfd(1)
is worth investigating regardless of the above.

+ I also think that it's important to compare
locking=false with printf_unlocked.
[See "man unlocked_stdio" - basically it is the C version of printf
that does not lock the FILE* so it's only safe to use in a serial context.]
*/

use Time;

config const n = 3;
config const tries = 2;
config const fmt = "%7.3dr";
config const compareTimes = false;

// Each trial() function writes a newline 'n' times.

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

extern proc cf_trial(n: int);
extern proc cs_trial(n: int);

proc lstr_trial() {
  extern proc printf(format: c_string, arg...);
  for 1..n do
    printf("%s", "\n".c_str());
}

proc lcs_trial() {
  extern proc printf(format: c_string, arg...);
  const c_newline_local: c_string = "\n";
  for 1..n do
    printf("%s", c_newline_local);
}

const str_newline_global = "\n";
proc gstr_trial() {
  extern proc printf(format: c_string, arg...);
  for 1..n do
    printf("%s", str_newline_global.c_str());
}

const c_newline_global: c_string = "\n";
proc gcs_trial() {
  extern proc printf(format: c_string, arg...);
  for 1..n do
    printf("%s", c_newline_global);
}

// could do the same with puts() - would be too much, skip it for now

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

// write() a newline to stdout (non-blocking), 'n' times
const outfd = openfd(1);
const stdoutNB = outfd.writer(locking=false);
proc nb_trial() {
  for 1..n do
    stdoutNB.write("\n");
}

// write() a newline to stdout (blocking), 'n' times
proc sto_trial() {
  for 1..n do
    write("\n");
}

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

var tSave, tDummy, tcf, tcs, tlstr, tlcs, tgstr, tgcs, tnb, tsto: real;

inline proc addTime(ref t: real) {
  const tCurr = getCurrentTime();
  t += tCurr - tSave;
  tSave = tCurr;

}

const reportFormat = "%-24s " + fmt + "\n";
inline proc reportTime(title: string, time: real) {
  stderr.writef(reportFormat, title, time);
}

stderr.writef("n      %i\n", n);
stderr.writef("tries  %i\n", tries);

for t in 1..tries {
  stderr.writef("starting try %i\n", t);
  stderr.flush();

  addTime(tDummy);

  cf_trial(n);   addTime(tcf);
  cs_trial(n);   addTime(tcs);
  lstr_trial();  addTime(tlstr);
  lcs_trial();   addTime(tlcs);
  gstr_trial();  addTime(tgstr);
  gcs_trial();   addTime(tgcs);

  nb_trial();     addTime(tnb);
  sto_trial();   addTime(tsto);

  // flush any buffered newlines
  stdout.flush();
}

stderr.writef("done tries\n");
//stderr.writef("n      %i\n", n);
//stderr.writef("tries  %i\n", tries);

if compareTimes {
  reportTime("C printf", tcf);
  reportTime("C puts", tcs);
  reportTime("C/chpl string literal",  tlstr);
  reportTime("C/chpl c_string local",  tlcs);
  reportTime("C/chpl string global",   tgstr);
  reportTime("C/chpl c_string global", tgcs);
  reportTime("chpl non-blocking", tnb);
  reportTime("chpl stdout", tsto);
}


Converted one more file to the new names.

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

// Uncommented when this becomes the default string implementation
// pragma "no use ChapelStandard"

/*
 * NOTES:
 *
 * - An empty string is represented by the default baseType value
 *   which is always considered to be a string literal.  It will never
 *   be freed or reference counted.  Another option would be to use a
 *   special NULL extern symbol.  Unfortunately, since _defaultOf()
 *   currently does not work for types with "ignore noinit", we'd
 *   still have to handle the default baseType value, so it would not
 *   be worth it to use NULL.  If the situation changes, it might be
 *   worth reconsidering (also taking into consideration the runtime
 *   functions that back this).
 *
 * - Not all operations support interaction with the baseType, e.g.,
 *   relational operations.  I chose to implement the ones I thought
 *   were commonly used like concatenation and assignment.  When this
 *   becomes the default, the compiler should automatically coerce the
 *   rest.
 *
 * - It is assumed the the baseType is a local-only type, so we never
 *   make a remote copy of one passed in by the user, though remote
 *   copies are made of internal baseType variables.
 *
 * - The base field is reference counted in the following manner.
 *   Every string has a ref count object and an alias ref count
 *   object.  If base is aliased, the the alias ref count object
 *   points to the ref count object of the base being aliased.
 *   Otherwise, the alias ref count object is equal to the ref count
 *   object.  There are set of ref counting support routines that
 *   update the "right" ref count, but can also bypassed if the alias
 *   check has already been performed.  I'm sure it's possible to
 *   implement this using a single ref count object, but this was
 *   easier to debug.
 *
 * TODOS:
 *
 * - When this becomes the default string implementation, the compiler
 *   may need to know of the string implementation as it does for
 *   array, etc.  Consider adding a pragma on the record.
 *
 * - Consider storing max size in the string record to enable more
 *   control of buffer reuse.
 *
 * - Consider changing primitives like string_copy and string_concat
 *   to take optional (or maybe required) length arguments to avoid
 *   extra calls to strlen().
 *
 */

module BaseStringType {
  use CString;
  // This type must support the c_string interface
  type baseType = c_string;
  param baseTypeString = "c_string":c_string;
  inline proc free_baseType(s) { chpl_free_c_string(s); }

  pragma "insert line file info"
  extern proc stringMove(dest: c_string, src: c_string, len: int): c_string;
  pragma "insert line file info"
  extern proc remoteStringCopy(src_loc: int, src_addr: c_string, len: int): c_string;

  config const debugStrings = false;
}

// Chapel Strings
module NewString {
  use BaseStringType;

  class string_refcnt {
    var val: atomic_refcnt;
    inline proc inc(cnt=1) { val.inc(); }
    inline proc dec(cnt=1) return val.dec();
    inline proc read(cnt=1) return val._cnt.read();
  }

  // pragma "string record"
  pragma "ignore noinit"
  pragma "no default functions"
  record string_rec {
    var base: baseType;
    var len: int;
    var home: locale; // this does not change through assignment
    var refCnt: string_refcnt;
    var aliasRefCnt: string_refcnt;

    proc string_rec() {
      if debugStrings then writeln("in string()");
      this.home = here;
      this.refCnt = new string_refcnt();
      this.aliasRefCnt = this.refCnt;
      if debugStrings then writeln("leaving string()");
    }

    proc ref ~string_rec() {
      if debugStrings then writeln("in ~string()");
      if this.isEmptyString() {
        delete this.refCnt;
      } else {
        const refs =  decRefCnt();
        if refs < 0 then halt("string reference count is negative!");
        if refs == 0 then {
          if debugStrings then writeln("  freeing base: ", this.base);
          on this.home {
            free_baseType(this.base);
            freeRefCnt();
          }
        } else {
          if debugStrings then writeln("  not freeing base: ", this.base);
          if isAlias then delete this.refCnt;
        }
      }
      if debugStrings then writeln("leaving ~string()");
    }

    // This is assumed to be called from this.home
    proc ref reinitString(s: baseType, slen:int =-1) {
      assert(s.locale.id == here.id);
      assert(this.home.id == here.id);
      if debugStrings then writeln("in string.reinitString()");
      if this.isEmptyString() {
        if slen==0 || s==_defaultOf(baseType) then return; // nothing to do
        else this.incRefCntNoAlias(); // update my own ref count
      }
      const new_len = if slen == -1 then s.length else slen;
      // If the this.base is longer than s, then reuse the buffer
      if new_len != 0 {
        if new_len < this.len {
          // reuse the buffer
          this.base = stringMove(this.base, s, new_len);
        } else {
          // free the old buffer
          if this.len != 0 then
            on home do free_baseType(this.base);
          // allocate a new buffer
          this.base = stringMove(_defaultOf(baseType), s, new_len);
        }
      } else {
        // free the old buffer
        if this.len != 0 then free_baseType(this.base);
        this.base = _defaultOf(baseType); // empty string are always literals
      }
      this.len = new_len;
      if debugStrings then writeln("leaving string.reinitString()");
    }

    inline proc c_str() {
      if debugStrings then writeln("in .c_str()");
      if this.home.id != here.id then
        halt("Cannot call .c_str() on a remote string");
      if debugStrings then writeln("leaving .c_str()");
      return this.base;
    }

    inline proc length return len;
    inline proc size return len;

    // Returns a string containing the character at the given index of
    // the string, or an empty string if the index is out of bounds.
    inline proc substring(i: int) {
      var ret: string_rec;
      if !this.isEmptyString() && i>0 {
        const sremote = this.home.id != here.id;
        const sbase = if sremote
                      then remoteStringCopy(this.home.id, this.base, this.len)
                      else this.base;
        const cs = sbase.substring(i);
        if cs != _defaultOf(baseType) {
          ret.base = cs;
          ret.len = 1;
          ret.incRefCntNoAlias();
        }
        if sremote then free_baseType(sbase);
      }
      return ret;
    }

    // Returns a string containing the string sliced by the given
    // range, or an empty string if the range does not overlap.
    inline proc substring(r: range) {
      var ret: string_rec;
      if !this.isEmptyString() && r.size>0 {
        const sremote = this.home.id != here.id;
        const sbase = if sremote
                      then remoteStringCopy(this.home.id, this.base, this.len)
                      else this.base;
        const cs = sbase.substring(r);
        if cs != _defaultOf(baseType) {
          ret.base = cs;
          ret.len = cs.length;
          ret.incRefCntNoAlias();
        }
        if sremote then free_baseType(sbase);
      }
      return ret;
    }

    // Returns the index of the first occurrence of a substring within a
    // string or 0 if the substring is not in the string.
    inline proc find(s: string_rec):int {
      var ret: int;
      if this.isEmptyString() then return 0;
      if s.isEmptyString() then return 0;
      // Assume s.base is shorter than this.base, so go to the home locale
      on this.home {
        const sremote = s.home.id != here.id;
        const sbase = if sremote
                      then remoteStringCopy(s.home.id, s.base, s.len)
                      else s.base;
        ret = this.base.indexOf(sbase);
        if sremote then free_baseType(sbase);
      }
      return ret;
    }

    inline proc find(s: baseType):int {
      if s.locale.id != here.id then
        halt("Cannot search a string with a remote "+baseTypeString);
      if this.isEmptyString() then return 0;
      if s==_defaultOf(baseType) then return 0;
      // We don't support remote c_string, so for this version, copy this.base
      const sremote = this.home.id != here.id;
      const sbase = if sremote
                    then remoteStringCopy(this.home.id, this.base, this.len)
                    else this.base;
      const ret = sbase.indexOf(s);
      if sremote then free_baseType(sbase);
      return ret;
    }

    // ref count functions
    inline proc isAlias return this.refCnt != this.aliasRefCnt;

    inline proc incRefCnt() {
      if !this.isAlias then this.refCnt.inc();
                       else this.aliasRefCnt.inc();
    }

    inline proc incRefCntNoAlias() {
      this.refCnt.inc();
    }

    inline proc decRefCnt() {
      if !this.isAlias then return this.refCnt.dec();
                       else return this.aliasRefCnt.dec();
    }

    inline proc decRefCntNoAlias() {
      return this.refCnt.dec();
    }

    inline proc freeRefCnt() {
      delete this.refCnt;
      if this.isAlias then delete this.aliasRefCnt;
    }

    inline proc isEmptyString() {
      if this.isAlias then return false;
      else return this.len==0; // this should be enough of a check
    }

    proc writeThis(f: Writer) {
      if !this.isEmptyString() {
        if (this.home.id != here.id) {
          const tcs = remoteStringCopy(this.home.id, this.base, this.len);
          f.write(tcs);
          free_baseType(tcs);
        } else {
          f.write(this.base);
        }
      }
    }
  }

  pragma "donor fn"
  pragma "auto copy fn"
    // We'd like this to be by ref, but doing so leads to an internal
    // compiler error.  See
    // $CHPL_HOME/test/types/records/sungeun/recordWithRefCopyFns.future
    /*inline*/ proc chpl__autoCopy(/*ref*/ s: string_rec) {
    if debugStrings then writeln("in autoCopy()");
    pragma "no auto destroy"
    var ret: string_rec;
    if !s.isEmptyString() {
      ret.home = s.home;
      ret.base = s.base;
      ret.len = s.len;
      if !s.isAlias then ret.aliasRefCnt = s.refCnt;
                    else ret.aliasRefCnt = s.aliasRefCnt;
      ret.incRefCnt();
    }
    if debugStrings then writeln("leaving autoCopy()");
    return ret;
  }

  /*
   * NOTES: Just a word on memory allocation in the generated code.
   * Any function that returns a string copies the returned value
   * including the c_string via a call to chpl__initCopy().  The
   * copied value is returned, and the original is destroyed on the
   * way out.  I'd really like to figure out a way to pass back the
   * original string without copying it.  I think I might be able to
   * do it by putting some sort of flag in the string record that is
   * used by initCopy().
   */
  pragma "init copy fn"
  inline proc chpl__initCopy(ref s: string_rec) {
    if debugStrings then writeln("in initCopy()");
    var ret: string_rec;
    if !s.isEmptyString() {
      const slen = s.len; // cache the remote copy of len
      if s.home.id == here.id {
        if debugStrings then writeln("  local initCopy");
        ret.base = stringMove(_defaultOf(baseType), s.base, slen);
      } else {
        if debugStrings then writeln("  remote initCopy: ", s.home.id);
        ret.base = remoteStringCopy(s.home.id, s.base, slen);
      }
      ret.len = slen;
      ret.incRefCntNoAlias();
    }
    if debugStrings then writeln("leaving initCopy()");
    return ret;
  }

  //
  // Assignment functions
  //
  proc =(ref lhs: string_rec, rhs: string_rec) {
    if debugStrings then writeln("in proc =()");
    inline proc helpMe(ref lhs: string_rec, rhs: string_rec) {
      if rhs.home.id == here.id {
        if debugStrings then writeln("  rhs local");
        lhs.reinitString(rhs.base, rhs.len);
      } else {
        if debugStrings then writeln("  rhs remote: ", rhs.home.id);
        const len = rhs.len; // cache the remote copy of len
        // TODO: reuse the base from remoteStringCopy()
        const rs = if len!=0 then remoteStringCopy(rhs.home.id, rhs.base, len)
                   else _defaultOf(baseType);
        lhs.reinitString(rs, len);
        if len!=0 then free_baseType(rs);
      }
    }
    if lhs.home.id == here.id then {
      if debugStrings then writeln("  lhs local");
      helpMe(lhs, rhs);
    }
    else {
      if debugStrings then writeln("  lhs remote: ", lhs.home.id);
      on lhs do helpMe(lhs, rhs);
    }
    if debugStrings then writeln("leaving proc =()");
  }

  proc =(ref lhs: string_rec, rhs_c: baseType) {
    if debugStrings then writeln("in proc =() "+baseTypeString);
    const hereId = here.id;
    // Make this some sort of local check once we have local types/vars
    if (rhs_c.locale.id != hereId) || (lhs.home.id != hereId) then
      halt("Cannot assign a remote "+baseTypeString+" to a string.");
    const len = rhs_c.length;
    lhs.reinitString(rhs_c, len);
    if debugStrings then writeln("leaving proc =() "+baseTypeString);
  }

  //
  // Concatenation
  //
  proc +(s0: string_rec, s1: string_rec) {
    if debugStrings then writeln("in proc +()");
    if s0.isEmptyString() then return s1;
    if s1.isEmptyString() then return s0;
    var ret: string_rec;
    const s0len = s0.len;
    const s1len = s1.len;
    ret.len = s0len + s1len;
    const s0remote = s0.home.id != here.id;
    const s0base = if s0remote
                   then remoteStringCopy(s0.home.id, s0.base, s0len)
                   else s0.base;
    const s1remote = s1.home.id != here.id;
    const s1base = if s1remote
                   then remoteStringCopy(s1.home.id, s1.base, s1len)
                   else s1.base;
    ret.base = s0base+s1base;
    ret.incRefCntNoAlias();
    if s0remote then free_baseType(s0base);
    if s1remote then free_baseType(s1base);
    if debugStrings then writeln("leaving proc +()");
    return ret;
  }

  proc +(s: string_rec, cs: baseType) {
    if cs.locale.id != here.id then
      halt("Cannot concatenate a remote "+baseTypeString+".");
    if debugStrings then writeln("in proc +() string+"+baseTypeString);
    if cs == _defaultOf(baseType) then return s;
    if s.isEmptyString() then return cs:string_rec;
    var ret: string_rec;
    const slen = s.len;
    ret.len = slen + cs.length;
    const sremote = s.home.id != here.id;
    const sbase = if sremote
                  then remoteStringCopy(s.home.id, s.base, slen)
                  else s.base;
    ret.base = sbase+cs;
    ret.incRefCntNoAlias();
    if sremote then free_baseType(sbase);
    if debugStrings then writeln("leaving proc +() string+"+baseTypeString);
    return ret;
  }

  proc +(cs: baseType, s: string_rec) {
    if cs.locale.id != here.id then
      halt("Cannot concatenate a remote "+baseTypeString+".");
    if debugStrings then writeln("in proc +() "+baseTypeString+"+string");
    if cs == _defaultOf(baseType) then return s;
    if s.isEmptyString() then return cs:string_rec;
    var ret: string_rec;
    const slen = s.len;
    ret.len = cs.length + slen;
    const sremote = s.home.id != here.id;
    const sbase = if sremote
                  then remoteStringCopy(s.home.id, s.base, slen)
                  else s.base;
    ret.base = cs+sbase;
    ret.incRefCntNoAlias();
    if sremote then free_baseType(sbase);
    if debugStrings then writeln("leaving proc +() "+baseTypeString+"+string");
    return ret;
  }

  //
  // Concatenation with other types is done by casting to the baseType
  //
  inline proc concatHelp(s: string_rec, x:?t) where t != string_rec {
    const cs = x:baseType;
    const ret = s + cs;
    if !isBoolType(x.type) && !isEnumType(x.type) then
      free_baseType(cs);
    return ret;
  }

  inline proc concatHelp(x:?t, s: string_rec) where t != string_rec  {
    const cs = x:baseType;
    const ret = cs + s;
    if !isBoolType(x.type) && !isEnumType(x.type) then
      free_baseType(cs);
    return ret;
  }

  inline proc +(s: string_rec, x: numeric) return concatHelp(s, x);
  inline proc +(x: numeric, s: string_rec) return concatHelp(x, s);
  inline proc +(s: string_rec, x: enumerated) return concatHelp(s, x);
  inline proc +(x: enumerated, s: string_rec) return concatHelp(x, s);
  inline proc +(s: string_rec, x: bool) return concatHelp(s, x);
  inline proc +(x: bool, s: string_rec) return concatHelp(x, s);

  //
  // Relational operators
  //
  // Poor man's substitute for first class function support
  enum relType {eq=1, neq, lt, lte, gt, gte};
  inline proc relationalHelp(a: string_rec, b: string_rec,
                             param op: relType) {
    inline proc doOp(a: baseType, b: baseType, param op: relType) {
      select op {
        when relType.eq do return a==b;
        when relType.neq do return a!=b;
        when relType.lt do return a<b;
        when relType.lte do return a<=b;
        when relType.gt do return a>b;
        when relType.gte do return a>=b;
        otherwise compilerError("op not supported (", op:baseType, ")");
      }
    }
    var ret: bool;
    if a.home.id == b.home.id {
      on a.home do ret = doOp(a.base, b.base, op);
    } else {
      // Copy the a if it is remote and not the empty string
      var abase: baseType;
      const alen = a.len;
      const aIsEmpty = a.isEmptyString();
      const aremote = (a.home.id!=here.id) && !aIsEmpty;
      if aremote then abase = remoteStringCopy(a.home.id, a.base, alen);
      else if !aIsEmpty then abase = a.base;
      else abase = _defaultOf(baseType);
      // Ditto for b
      var bbase: baseType;
      const blen = b.len;
      const bIsEmpty = b.isEmptyString();
      const bremote = (b.home.id!=here.id) && !bIsEmpty;
      if bremote then bbase = remoteStringCopy(b.home.id, b.base, blen);
      else if !bIsEmpty then bbase = b.base;
      else bbase = _defaultOf(baseType);

      ret = doOp(abase, bbase, op);

      if aremote then free_baseType(abase);
      if bremote then free_baseType(bbase);
    }
    return ret;
  }

  inline proc ==(a: string_rec, b: string_rec)
    return relationalHelp(a, b, relType.eq);
  inline proc !=(a: string_rec, b: string_rec)
    return relationalHelp(a, b, relType.neq);
  inline proc <(a: string_rec, b: string_rec)
    return relationalHelp(a, b, relType.lt);
  inline proc <=(a: string_rec, b: string_rec)
    return relationalHelp(a, b, relType.lte);
  inline proc >(a: string_rec, b: string_rec)
    return relationalHelp(a, b, relType.gt);
  inline proc >=(a: string_rec, b: string_rec)
    return relationalHelp(a, b, relType.gte);

  //
  // Primitive string functions and methods
  //
  inline proc ascii(s: string_rec) {
    var ret: int(32); // return type of ascii primitive
    on s.home do ret = ascii(s.base);
    return ret;
  }

  //
  // Casts
  //

  // Cast from baseType to string
  inline proc _cast(type t, cs: baseType) where t==string_rec {
    if debugStrings then writeln("in _cast() "+baseTypeString+"-string");
    if cs.locale.id != here.id then
      halt("Cannot cast a remote "+baseTypeString+" to string.");
    var ret: string_rec;
    ret.len = cs.length;
    if ret.len != 0 then ret.base = __primitive("string_copy", cs);
    ret.incRefCntNoAlias();
    if debugStrings then writeln("leaving _cast() "+baseTypeString+"-string");
    return ret;
  }

  // Other casts to strings use the baseType
  inline proc _cast(type t, x) where t==string_rec && x.type != baseType {
    if debugStrings then writeln("in _cast() ", typeToString(t), "-string");
    const cs = x:baseType;
    var ret: string_rec;
    ret.len = cs.length;
    assert(ret.len != 0);
    if isBoolType(x.type) || isEnumType(x.type) then
      // These are returned as string literals so copy the string
      ret.base = stringMove(_defaultOf(baseType), cs, ret.len);
    else
      ret.base = cs;
    ret.incRefCntNoAlias();
    if debugStrings then writeln("leaving _cast() ", typeToString(t),
                                 "-string");
    return ret;
  }

  // Cast from string to the baseType
  // This currently does not allocate a new baseType string
  // It is exactly the same as string.c_str()
  inline proc _cast(type t, s: string_rec) where t==baseType {
    if debugStrings then writeln("in _cast() string-c_"+baseTypeString);
    if s.home.id != here.id then
      halt("Cannot cast a remote string to "+baseTypeString);
    if debugStrings then writeln("leaving _cast() string-"+baseTypeString);
    return s.base;
  }

  // Other casts from strings use the baseType
  inline proc _cast(type t, s: string_rec) where t!=baseType {
    if debugStrings then writeln("in _cast() string-", typeToString(t));
    const sremote = s.home.id != here.id;
    const sbase = if sremote
                  then remoteStringCopy(s.home.id, s.base, s.len)
                  else s.base;
    // Note that any error checking on the string is done in the runtime
    const ret = sbase:t;
    if sremote then free_baseType(sbase);
    if debugStrings then writeln("leaving _cast() string-", typeToString(t));
    return ret;
  }

  // Functions that are no longer supported:
  // - toString()
  // - _string_contains()

}

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

// Uncommented when this becomes the default string implementation
// pragma "no use ChapelStandard"

/*
 * NOTES:
 *
 * - An empty string is represented by the default baseType value
 *   which is always considered to be a string literal.  It will never
 *   be freed or reference counted.  Another option would be to use a
 *   special NULL extern symbol.  Unfortunately, since _defaultOf()
 *   currently does not work for types with "ignore noinit", we'd
 *   still have to handle the default baseType value, so it would not
 *   be worth it to use NULL.  If the situation changes, it might be
 *   worth reconsidering (also taking into consideration the runtime
 *   functions that back this).
 *
 * - Not all operations support interaction with the baseType, e.g.,
 *   relational operations.  I chose to implement the ones I thought
 *   were commonly used like concatenation and assignment.  When this
 *   becomes the default, the compiler should automatically coerce the
 *   rest.
 *
 * - It is assumed the the baseType is a local-only type, so we never
 *   make a remote copy of one passed in by the user, though remote
 *   copies are made of internal baseType variables.
 *
 * - The base field is reference counted in the following manner.
 *   Every string has a ref count object and an alias ref count
 *   object.  If base is aliased, the the alias ref count object
 *   points to the ref count object of the base being aliased.
 *   Otherwise, the alias ref count object is equal to the ref count
 *   object.  There are set of ref counting support routines that
 *   update the "right" ref count, but can also bypassed if the alias
 *   check has already been performed.  I'm sure it's possible to
 *   implement this using a single ref count object, but this was
 *   easier to debug.
 *
 * TODOS:
 *
 * - When this becomes the default string implementation, the compiler
 *   may need to know of the string implementation as it does for
 *   array, etc.  Consider adding a pragma on the record.
 *
 * - Consider storing max size in the string record to enable more
 *   control of buffer reuse.
 *
 * - Consider changing primitives like string_copy and string_concat
 *   to take optional (or maybe required) length arguments to avoid
 *   extra calls to strlen().
 *
 */

module BaseStringType {
  use CString;
  // This type must support the c_string interface
  type baseType = c_string;
  param baseTypeString = "c_string":c_string;
  inline proc free_baseType(s) { chpl_free_c_string(s); }

  pragma "insert line file info"
  extern proc stringMove(dest: c_string, src: c_string, len: int): c_string;
  pragma "insert line file info"
  extern proc remoteStringCopy(src_loc: int, src_addr: c_string, len: int): c_string;

  config const debugStrings = false;
}

// Chapel Strings
module NewString {
  use BaseStringType;

  class string_refcnt {
    var val: atomic_refcnt;
    inline proc inc(cnt=1) { val.inc(); }
    inline proc dec(cnt=1) return val.dec();
    inline proc read(cnt=1) return val._cnt.read();
  }

  // pragma "string record"
  pragma "ignore noinit"
  pragma "no default functions"
  record string_rec {
    var base: baseType;
    var len: int;
    var home: locale; // this does not change through assignment
    var refCnt: string_refcnt;
    var aliasRefCnt: string_refcnt;

    proc string_rec() {
      if debugStrings then writeln("in string()");
      this.home = here;
      this.refCnt = new string_refcnt();
      this.aliasRefCnt = this.refCnt;
      if debugStrings then writeln("leaving string()");
    }

    proc ref ~string_rec() {
      if debugStrings then writeln("in ~string()");
      if this.isEmptyString() {
        delete this.refCnt;
      } else {
        const refs =  decRefCnt();
        if refs < 0 then halt("string reference count is negative!");
        if refs == 0 then {
          if debugStrings then writeln("  freeing base: ", this.base);
          on this.home {
            free_baseType(this.base);
            freeRefCnt();
          }
        } else {
          if debugStrings then writeln("  not freeing base: ", this.base);
          if isAlias then delete this.refCnt;
        }
      }
      if debugStrings then writeln("leaving ~string()");
    }

    // This is assumed to be called from this.home
    proc ref reinitString(s: baseType, slen:int =-1) {
      assert(s.locale.id == here.id);
      assert(this.home.id == here.id);
      if debugStrings then writeln("in string.reinitString()");
      if this.isEmptyString() {
        if slen==0 || s==_defaultOf(baseType) then return; // nothing to do
        else this.incRefCntNoAlias(); // update my own ref count
      }
      const new_len = if slen == -1 then s.length else slen;
      // If the this.base is longer than s, then reuse the buffer
      if new_len != 0 {
        if new_len < this.len {
          // reuse the buffer
          this.base = stringMove(this.base, s, new_len);
        } else {
          // free the old buffer
          if this.len != 0 then
            on home do free_baseType(this.base);
          // allocate a new buffer
          this.base = stringMove(_defaultOf(baseType), s, new_len);
        }
      } else {
        // free the old buffer
        if this.len != 0 then free_baseType(this.base);
        this.base = _defaultOf(baseType); // empty string are always literals
      }
      this.len = new_len;
      if debugStrings then writeln("leaving string.reinitString()");
    }

    inline proc c_str() {
      if debugStrings then writeln("in .c_str()");
      if this.home.id != here.id then
        halt("Cannot call .c_str() on a remote string");
      if debugStrings then writeln("leaving .c_str()");
      return this.base;
    }

    inline proc length return len;
    inline proc size return len;

    // Returns a string containing the character at the given index of
    // the string, or an empty string if the index is out of bounds.
    inline proc substring(i: int) {
      var ret: string_rec;
      if !this.isEmptyString() && i>0 {
        const sremote = this.home.id != here.id;
        const sbase = if sremote
                      then remoteStringCopy(this.home.id, this.base, this.len)
                      else this.base;
        const cs = sbase.substring(i);
        if cs != _defaultOf(baseType) {
          ret.base = cs;
          ret.len = 1;
          ret.incRefCntNoAlias();
        }
        if sremote then free_baseType(sbase);
      }
      return ret;
    }

    // Returns a string containing the string sliced by the given
    // range, or an empty string if the range does not overlap.
    inline proc substring(r: range) {
      var ret: string_rec;
      if !this.isEmptyString() && r.size>0 {
        const sremote = this.home.id != here.id;
        const sbase = if sremote
                      then remoteStringCopy(this.home.id, this.base, this.len)
                      else this.base;
        const cs = sbase.substring(r);
        if cs != _defaultOf(baseType) {
          ret.base = cs;
          ret.len = cs.length;
          ret.incRefCntNoAlias();
        }
        if sremote then free_baseType(sbase);
      }
      return ret;
    }

    // Returns the index of the first occurrence of a substring within a
    // string or 0 if the substring is not in the string.
    inline proc find(s: string_rec):int {
      var ret: int;
      if this.isEmptyString() then return 0;
      if s.isEmptyString() then return 0;
      // Assume s.base is shorter than this.base, so go to the home locale
      on this.home {
        const sremote = s.home.id != here.id;
        const sbase = if sremote
                      then remoteStringCopy(s.home.id, s.base, s.len)
                      else s.base;
        ret = this.base.indexOf(sbase);
        if sremote then free_baseType(sbase);
      }
      return ret;
    }

    inline proc find(s: baseType):int {
      if s.locale.id != here.id then
        halt("Cannot search a string with a remote "+baseTypeString);
      if this.isEmptyString() then return 0;
      if s==_defaultOf(baseType) then return 0;
      // We don't support remote c_string, so for this version, copy this.base
      const sremote = this.home.id != here.id;
      const sbase = if sremote
                    then remoteStringCopy(this.home.id, this.base, this.len)
                    else this.base;
      const ret = sbase.indexOf(s);
      if sremote then free_baseType(sbase);
      return ret;
    }

    // ref count functions
    inline proc isAlias return this.refCnt != this.aliasRefCnt;

    inline proc incRefCnt() {
      if !this.isAlias then this.refCnt.inc();
                       else this.aliasRefCnt.inc();
    }

    inline proc incRefCntNoAlias() {
      this.refCnt.inc();
    }

    inline proc decRefCnt() {
      if !this.isAlias then return this.refCnt.dec();
                       else return this.aliasRefCnt.dec();
    }

    inline proc decRefCntNoAlias() {
      return this.refCnt.dec();
    }

    inline proc freeRefCnt() {
      delete this.refCnt;
      if this.isAlias then delete this.aliasRefCnt;
    }

    inline proc isEmptyString() {
      if this.isAlias then return false;
      else return this.len==0; // this should be enough of a check
    }

    proc writeThis(f: Writer) {
      if !this.isEmptyString() {
        if (this.home.id != here.id) {
          const tcs = remoteStringCopy(this.home.id, this.base, this.len);
          f.write(tcs);
          free_baseType(tcs);
        } else {
          f.write(this.base);
        }
      }
    }
  }

  pragma "donor fn"
  pragma "auto copy fn"
    // We'd like this to be by ref, but doing so leads to an internal
    // compiler error.  See
    // $CHPL_HOME/test/types/records/sungeun/recordWithRefCopyFns.future
    /*inline*/ proc chpl__autoCopy(/*ref*/ s: string_rec) {
    if debugStrings then writeln("in autoCopy()");
    pragma "no auto destroy"
    var ret: string_rec;
    if !s.isEmptyString() {
      ret.home = s.home;
      ret.base = s.base;
      ret.len = s.len;
      if !s.isAlias then ret.aliasRefCnt = s.refCnt;
                    else ret.aliasRefCnt = s.aliasRefCnt;
      ret.incRefCnt();
    }
    if debugStrings then writeln("leaving autoCopy()");
    return ret;
  }

  /*
   * NOTES: Just a word on memory allocation in the generated code.
   * Any function that returns a string copies the returned value
   * including the c_string via a call to chpl__initCopy().  The
   * copied value is returned, and the original is destroyed on the
   * way out.  I'd really like to figure out a way to pass back the
   * original string without copying it.  I think I might be able to
   * do it by putting some sort of flag in the string record that is
   * used by initCopy().
   */
  pragma "init copy fn"
  inline proc chpl__initCopy(ref s: string_rec) {
    if debugStrings then writeln("in initCopy()");
    var ret: string_rec;
    if !s.isEmptyString() {
      const slen = s.len; // cache the remote copy of len
      if s.home.id == here.id {
        if debugStrings then writeln("  local initCopy");
        ret.base = stringMove(_defaultOf(baseType), s.base, slen);
      } else {
        if debugStrings then writeln("  remote initCopy: ", s.home.id);
        ret.base = remoteStringCopy(s.home.id, s.base, slen);
      }
      ret.len = slen;
      ret.incRefCntNoAlias();
    }
    if debugStrings then writeln("leaving initCopy()");
    return ret;
  }

  //
  // Assignment functions
  //
  proc =(ref lhs: string_rec, rhs: string_rec) {
    if debugStrings then writeln("in proc =()");
    inline proc helpMe(ref lhs: string_rec, rhs: string_rec) {
      if rhs.home.id == here.id {
        if debugStrings then writeln("  rhs local");
        lhs.reinitString(rhs.base, rhs.len);
      } else {
        if debugStrings then writeln("  rhs remote: ", rhs.home.id);
        const len = rhs.len; // cache the remote copy of len
        // TODO: reuse the base from remoteStringCopy()
        const rs = if len!=0 then remoteStringCopy(rhs.home.id, rhs.base, len)
                   else _defaultOf(baseType);
        lhs.reinitString(rs, len);
        if len!=0 then free_baseType(rs);
      }
    }
    if lhs.home.id == here.id then {
      if debugStrings then writeln("  lhs local");
      helpMe(lhs, rhs);
    }
    else {
      if debugStrings then writeln("  lhs remote: ", lhs.home.id);
      on lhs do helpMe(lhs, rhs);
    }
    if debugStrings then writeln("leaving proc =()");
  }

  proc =(ref lhs: string_rec, rhs_c: baseType) {
    if debugStrings then writeln("in proc =() "+baseTypeString);
    const hereId = here.id;
    // Make this some sort of local check once we have local types/vars
    if (rhs_c.locale.id != hereId) || (lhs.home.id != hereId) then
      halt("Cannot assign a remote "+baseTypeString+" to a string.");
    const len = rhs_c.length;
    lhs.reinitString(rhs_c, len);
    if debugStrings then writeln("leaving proc =() "+baseTypeString);
  }

  //
  // Concatenation
  //
  proc +(s0: string_rec, s1: string_rec) {
    if debugStrings then writeln("in proc +()");
    if s0.isEmptyString() then return s1;
    if s1.isEmptyString() then return s0;
    var ret: string_rec;
    const s0len = s0.len;
    const s1len = s1.len;
    ret.len = s0len + s1len;
    const s0remote = s0.home.id != here.id;
    const s0base = if s0remote
                   then remoteStringCopy(s0.home.id, s0.base, s0len)
                   else s0.base;
    const s1remote = s1.home.id != here.id;
    const s1base = if s1remote
                   then remoteStringCopy(s1.home.id, s1.base, s1len)
                   else s1.base;
    ret.base = s0base+s1base;
    ret.incRefCntNoAlias();
    if s0remote then free_baseType(s0base);
    if s1remote then free_baseType(s1base);
    if debugStrings then writeln("leaving proc +()");
    return ret;
  }

  proc +(s: string_rec, cs: baseType) {
    if cs.locale.id != here.id then
      halt("Cannot concatenate a remote "+baseTypeString+".");
    if debugStrings then writeln("in proc +() string+"+baseTypeString);
    if cs == _defaultOf(baseType) then return s;
    if s.isEmptyString() then return cs:string_rec;
    var ret: string_rec;
    const slen = s.len;
    ret.len = slen + cs.length;
    const sremote = s.home.id != here.id;
    const sbase = if sremote
                  then remoteStringCopy(s.home.id, s.base, slen)
                  else s.base;
    ret.base = sbase+cs;
    ret.incRefCntNoAlias();
    if sremote then free_baseType(sbase);
    if debugStrings then writeln("leaving proc +() string+"+baseTypeString);
    return ret;
  }

  proc +(cs: baseType, s: string_rec) {
    if cs.locale.id != here.id then
      halt("Cannot concatenate a remote "+baseTypeString+".");
    if debugStrings then writeln("in proc +() "+baseTypeString+"+string");
    if cs == _defaultOf(baseType) then return s;
    if s.isEmptyString() then return cs:string_rec;
    var ret: string_rec;
    const slen = s.len;
    ret.len = cs.length + slen;
    const sremote = s.home.id != here.id;
    const sbase = if sremote
                  then remoteStringCopy(s.home.id, s.base, slen)
                  else s.base;
    ret.base = cs+sbase;
    ret.incRefCntNoAlias();
    if sremote then free_baseType(sbase);
    if debugStrings then writeln("leaving proc +() "+baseTypeString+"+string");
    return ret;
  }

  //
  // Concatenation with other types is done by casting to the baseType
  //
  inline proc concatHelp(s: string_rec, x:?t) where t != string_rec {
    const cs = x:baseType;
    const ret = s + cs;
    if !_isBooleanType(x.type) && !_isEnumeratedType(x.type) then
      free_baseType(cs);
    return ret;
  }

  inline proc concatHelp(x:?t, s: string_rec) where t != string_rec  {
    const cs = x:baseType;
    const ret = cs + s;
    if !_isBooleanType(x.type) && !_isEnumeratedType(x.type) then
      free_baseType(cs);
    return ret;
  }

  inline proc +(s: string_rec, x: numeric) return concatHelp(s, x);
  inline proc +(x: numeric, s: string_rec) return concatHelp(x, s);
  inline proc +(s: string_rec, x: enumerated) return concatHelp(s, x);
  inline proc +(x: enumerated, s: string_rec) return concatHelp(x, s);
  inline proc +(s: string_rec, x: bool) return concatHelp(s, x);
  inline proc +(x: bool, s: string_rec) return concatHelp(x, s);

  //
  // Relational operators
  //
  // Poor man's substitute for first class function support
  enum relType {eq=1, neq, lt, lte, gt, gte};
  inline proc relationalHelp(a: string_rec, b: string_rec,
                             param op: relType) {
    inline proc doOp(a: baseType, b: baseType, param op: relType) {
      select op {
        when relType.eq do return a==b;
        when relType.neq do return a!=b;
        when relType.lt do return a<b;
        when relType.lte do return a<=b;
        when relType.gt do return a>b;
        when relType.gte do return a>=b;
        otherwise compilerError("op not supported (", op:baseType, ")");
      }
    }
    var ret: bool;
    if a.home.id == b.home.id {
      on a.home do ret = doOp(a.base, b.base, op);
    } else {
      // Copy the a if it is remote and not the empty string
      var abase: baseType;
      const alen = a.len;
      const aIsEmpty = a.isEmptyString();
      const aremote = (a.home.id!=here.id) && !aIsEmpty;
      if aremote then abase = remoteStringCopy(a.home.id, a.base, alen);
      else if !aIsEmpty then abase = a.base;
      else abase = _defaultOf(baseType);
      // Ditto for b
      var bbase: baseType;
      const blen = b.len;
      const bIsEmpty = b.isEmptyString();
      const bremote = (b.home.id!=here.id) && !bIsEmpty;
      if bremote then bbase = remoteStringCopy(b.home.id, b.base, blen);
      else if !bIsEmpty then bbase = b.base;
      else bbase = _defaultOf(baseType);

      ret = doOp(abase, bbase, op);

      if aremote then free_baseType(abase);
      if bremote then free_baseType(bbase);
    }
    return ret;
  }

  inline proc ==(a: string_rec, b: string_rec)
    return relationalHelp(a, b, relType.eq);
  inline proc !=(a: string_rec, b: string_rec)
    return relationalHelp(a, b, relType.neq);
  inline proc <(a: string_rec, b: string_rec)
    return relationalHelp(a, b, relType.lt);
  inline proc <=(a: string_rec, b: string_rec)
    return relationalHelp(a, b, relType.lte);
  inline proc >(a: string_rec, b: string_rec)
    return relationalHelp(a, b, relType.gt);
  inline proc >=(a: string_rec, b: string_rec)
    return relationalHelp(a, b, relType.gte);

  //
  // Primitive string functions and methods
  //
  inline proc ascii(s: string_rec) {
    var ret: int(32); // return type of ascii primitive
    on s.home do ret = ascii(s.base);
    return ret;
  }

  //
  // Casts
  //

  // Cast from baseType to string
  inline proc _cast(type t, cs: baseType) where t==string_rec {
    if debugStrings then writeln("in _cast() "+baseTypeString+"-string");
    if cs.locale.id != here.id then
      halt("Cannot cast a remote "+baseTypeString+" to string.");
    var ret: string_rec;
    ret.len = cs.length;
    if ret.len != 0 then ret.base = __primitive("string_copy", cs);
    ret.incRefCntNoAlias();
    if debugStrings then writeln("leaving _cast() "+baseTypeString+"-string");
    return ret;
  }

  // Other casts to strings use the baseType
  inline proc _cast(type t, x) where t==string_rec && x.type != baseType {
    if debugStrings then writeln("in _cast() ", typeToString(t), "-string");
    const cs = x:baseType;
    var ret: string_rec;
    ret.len = cs.length;
    assert(ret.len != 0);
    if _isBooleanType(x.type) || _isEnumeratedType(x.type) then
      // These are returned as string literals so copy the string
      ret.base = stringMove(_defaultOf(baseType), cs, ret.len);
    else
      ret.base = cs;
    ret.incRefCntNoAlias();
    if debugStrings then writeln("leaving _cast() ", typeToString(t),
                                 "-string");
    return ret;
  }

  // Cast from string to the baseType
  // This currently does not allocate a new baseType string
  // It is exactly the same as string.c_str()
  inline proc _cast(type t, s: string_rec) where t==baseType {
    if debugStrings then writeln("in _cast() string-c_"+baseTypeString);
    if s.home.id != here.id then
      halt("Cannot cast a remote string to "+baseTypeString);
    if debugStrings then writeln("leaving _cast() string-"+baseTypeString);
    return s.base;
  }

  // Other casts from strings use the baseType
  inline proc _cast(type t, s: string_rec) where t!=baseType {
    if debugStrings then writeln("in _cast() string-", typeToString(t));
    const sremote = s.home.id != here.id;
    const sbase = if sremote
                  then remoteStringCopy(s.home.id, s.base, s.len)
                  else s.base;
    // Note that any error checking on the string is done in the runtime
    const ret = sbase:t;
    if sremote then free_baseType(sbase);
    if debugStrings then writeln("leaving _cast() string-", typeToString(t));
    return ret;
  }

  // Functions that are no longer supported:
  // - toString()
  // - _string_contains()

}