Consolidated interfaces in the Math module.

To simplify the online documentation, interfaces to math functions were consoldated where
possible.  Type selection functions are then used to supply the implementation so that the
overall behavior is unchanged.

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

/*
This module provides wrappers for <cmath> (math.h) numerical constants and
routines.  Its symbols are provided by default; an explicit 'use' statement
is not necessary.

The C Math library is part of the C Language Standard (ISO/IEC 9899), as
described in Section 7.12.  Please consult that standard for an
authoritative description of the expected properties of those constants and
routines.

In general, where the C math library provides a *double* and a *float* version
of a function, the float version has a suffix 'f'.  In the Chapel interface,
the suffix is dropped, and the type of the operand determines which version is
called -- according to the usual function overloading and resolution rules.
Normally, the result has the same precision
as the argument(s).  Please consult the C standard for specifics.

Rounding -- The rounding mode for floating-point addition (subtraction) is
implementation-defined.

Error Handling -- At present, Chapel does not provide control over error
handling in the Math module.  The default behavior is as if the macro
``math_errhandling`` is set to 0: Given erroneous input at run-time,
all math functions will return an implementation-defined value; no
exception will be generated.

*/
module Math {

  //////////////////////////////////////////////////////////////////////////
  // Helper constants and functions (not included in chpldocs).
  //
  pragma "no doc"
  extern proc chpl_macro_INFINITY():real(64);
  pragma "no doc"
  extern proc chpl_macro_NAN():real(64);

  pragma "no doc"
  extern proc chpl_macro_double_isinf(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isinf(x: real(32)): c_int;
  pragma "no doc"
  extern proc chpl_macro_double_isfinite(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isfinite(x: real(32)): c_int;
  pragma "no doc"
  extern proc chpl_macro_double_isnan(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isnan(x: real(32)): c_int;

  pragma "no doc"
  proc _logBasePow2Help(in val, baseLog2) {
    var result = -1;
    while (val != 0) {
      val >>= baseLog2;
      result += 1;
    }
    return result;
  }

  pragma "no doc"
  proc logBasePow2(in val: int(?w), baseLog2) {
    if (val < 1) {
      halt("Can't take the log() of a non-positive integer");
    }
    return _logBasePow2Help(val, baseLog2);
  }

  pragma "no doc"
  proc logBasePow2(in val: uint(?w), baseLog2) {
    if (val < 1) {
      halt("Can't take the log() of a non-positive integer");
    }
    return _logBasePow2Help(val, baseLog2);
  }
  //
  //////////////////////////////////////////////////////////////////////////

  //////////////////////////////////////////////////////////////////////////
  //
  // Public interface (included in chpldocs).
  //
  // (The entries below are alphabetized (case-insensitively) because chpldocs
  // presents them in declaration order.)
  //

  /* Returns the absolute value of the integer param argument `i`. */
  proc abs(param i : integral) param return if i < 0 then -i else i;

  /* Returns the magnitude (absolute value) of the argument `x`.

     :rtype: The type of `x`.
  */
  inline proc abs(x) where isNumericalType(x.type) {
    if isComplex(x) {
      return sqrt(x.re * x.re + x.im * -x.im);
    } else if isReal(x) {
      if numBits(x) == 64 {
        extern proc fabs(x: real(64)): real(64);
        return fabs(x);
      } else if numBits(x) == 32 {
        extern proc fabsf(x: real(32)): real(32);
        return fabsf(x);
      } else {
        compilerError("abs() -- Invalid real argument width: ", numBits(x));
      }
    } else if isImaginary(x) {
      if numBits(x) == 64 {
        extern proc fabs(x: real(64)): real(64);
        return fabs(_i2r(x));
      } else if numBits(x) == 32 {
        extern proc fabsf(x: real(32)): real(32);
        return fabsf(_i2r(x));
      } else {
        compilerError("abs() -- Invalid imaginary argument width ", numBits(x));
      }
    } else if isIntegral(x) {
      if (isSigned(x)) then
        return if i < 0 then -i else i;
      else
        return if x == 0 then 0 else i;
    } else{
      compilerError("abs() -- Invalid argument type: ", typeToString(x.type));
    }
  }

  /* Returns the arc cosine of the real argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc acos(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc acos(x: real(64)): real(64);
      return acos(x);
    } else if w == 32 {
      extern proc acosf(x: real(32)): real(32);
      return acosf(x);
    } else {
      compilerError("acos() -- Invalid argument width ", w);
    }
  }

  /* Returns the inverse hyperbolic cosine of the argument `x`.

     It is an error if `x` is less than 1.
  */
  inline proc acosh(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc acosh(x: real(64)): real(64);
      return acosh(x);
    } else if w == 32 {
      extern proc acoshf(x: real(32)): real(32);
      return acoshf(x);
    } else {
      compilerError("acosh() -- Invalid argument width ", w);
    }
  }

  /* Returns the arc sine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc asin(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc asin(x: real(64)): real(64);
      return asin(x);
    } else if w == 32 {
      extern proc asinf(x: real(32)): real(32);
      return asinf(x);
    } else {
      compilerError("asin() -- Invalid argument width ", w);
    }
  }

  /* Returns the inverse hyperbolic sine of the argument `x`. */
  inline proc asinh(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc asinh(x: real(64)): real(64);
      return asinh(x);
    } else if w == 32 {
      extern proc asinyf(x: real(32)): real(32);
      return asinhf(x);
    } else {
      compilerError("asinh() -- Invalid argument width ", w);
    }
  }

  /* Returns the arc tangent of the argument `x`. */
  inline proc atan(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc atan(x: real(64)): real(64);
      return atan(x);
    } else if w == 32 {
      extern proc atanf(x: real(32)): real(32);
      return atanf(x);
    } else {
      compilerError("atan() -- Invalid argument width ", w);
    }
  }

  /* Returns the arc tangent of the ratio of the two arguments.

     This is equivalent to
     the arc tangent of `y` / `x` except that the signs of `y`
     and `x` are used to determine the quadrant of the result.
  */
  inline proc atan2(y: real(?w), x: real(w)) : real(w) {
    if w == 64 {
      extern proc atan2(y: real(64), x: real(64)): real(64);
      return atan2(y, x);
    } else if w == 32 {
      extern proc atan2f(y: real(32), x: real(32)): real(32);
      return atan2f(y, x);
    } else {
      compilerError("atan2() -- Invalid argument width ", w);
    }
  }

  /* Returns the inverse hyperbolic tangent of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc atanh(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc atanh(x: real(64)): real(64);
      return atanh(x);
    } else if w == 32 {
      extern proc atanhf(x: real(32)): real(32);
      return atanhf(x);
    } else {
      compilerError("atanh() -- Invalid argument width ", w);
    }
  }

  /* Returns the cube root of the argument `x`. */
  inline proc cbrt(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc cbrt(x: real(64)): real(64);
      return cbrt(x);
    } else if w == 32 {
      extern proc cbrtf(x: real(32)): real(32);
      return cbrtf(x);
    } else {
      compilerError("cbrt() -- Invalid argument width ", w);
    }
  }

  /* Returns the value of the argument `x` rounded up to the nearest integer. */
  inline proc ceil(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc ceil(x: real(64)): real(64);
      return ceil(x);
    } else if w == 32 {
      extern proc ceilf(x: real(32)): real(32);
      return ceilf(x);
    } else {
      compilerError("ceil() -- Invalid argument width ", w);
    }
  }

  /* Returns the complex conjugate of the argument `x`. */
  inline proc conjg(x: complex(?w)) : complex(w) return (x.re, -x.im):complex(w);

  /* Returns the cosine of the argument `x`. */
  inline proc cos(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc cos(x: real(64)): real(64);
      return cos(x);
    } else if w == 32 {
      extern proc cosf(x: real(32)): real(32);
      return cosf(x);
    } else {
      compilerError("cos() -- Invalid argument width ", w);
    }
  }

  /* Returns the hyperbolic cosine of the argument `x`. */
  inline proc cosh(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc cosh(x: real(64)): real(64);
      return cosh(x);
    } else if w == 32 {
      extern proc coshf(x: real(32)): real(32);
      return coshf(x);
    } else {
      compilerError("cosh() -- Invalid argument width ", w);
    }
  }

  /* Returns :proc:`ceil`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded up to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divceil(m: integral, n: integral) return
    if isNonnegative(m) then
    if isNonnegative(n) then (m + n - 1) / n
      else                     m / n
        else
          if isNonnegative(n) then m / n
            else                     (m + n + 1) / n;

  /* Returns :proc:`ceil`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded up to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divceil(param m: integral, param n: integral) param return
    if isNonnegative(m) then
    if isNonnegative(n) then (m + n - 1) / n
      else                     m / n
        else
          if isNonnegative(n) then m / n
            else                     (m + n + 1) / n;

  /* Returns :proc:`floor`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded down to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divfloor(m: integral, n: integral) return
    if isNonnegative(m) then
    if isNonnegative(n) then m / n
      else                     (m - n - 1) / n
        else
          if isNonnegative(n) then (m - n + 1) / n
            else                     m / n;

  /* Returns :proc:`floor`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded down to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divfloor(param m: integral, param n: integral) param return
    if isNonnegative(m) then
    if isNonnegative(n) then m / n
      else                     (m - n - 1) / n
        else
          if isNonnegative(n) then (m - n + 1) / n
            else                     m / n;

  /* Returns the error function of the argument `x`. */
  inline proc erf(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc erf(x: real(64)): real(64);
      return erf(x);
    } else if w == 32 {
      extern proc erff(x: real(32)): real(32);
      return erff(x);
    } else {
      compilerError("erf() -- Invalid argument width ", w);
    }
  }

  /* Returns the complementary error function of the argument.
     This is equivalent to 1.0 - :proc:`erf`\(`x`).
  */
  inline proc erfc(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc erfc(x: real(64)): real(64);
      return erfc(x);
    } else if w == 32 {
      extern proc erfcf(x: real(32)): real(32);
      return erfcf(x);
    } else {
      compilerError("erfc() -- Invalid argument width ", w);
    }
  }

  /* Returns the value of the Napierien `e` raised to the power of the argument `x`. */
  inline proc exp(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc exp(x: real(64)): real(64);
      return exp(x);
    } else if w == 32 {
      extern proc expf(x: real(32)): real(32);
      return expf(x);
    } else {
      compilerError("exp() -- Invalid argument width ", w);
    }
  }

  /* Returns the value of `2` raised to the power of the argument `x`. */
  inline proc exp2(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc exp2(x: real(64)): real(64);
      return exp2(x);
    } else if w == 32 {
      extern proc exp2f(x: real(32)): real(32);
      return exp2f(x);
    } else {
      compilerError("exp2() -- Invalid argument width ", w);
    }
  }

  /* Returns one less than the value of the Napierien `e` raised to the power
     of the argument `x`.
  */
  inline proc expm1(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc expm1(x: real(64)): real(64);
      return expm1(x);
    } else if w == 32 {
      extern proc expm1f(x: real(32)): real(32);
      return expm1f(x);
    } else {
      compilerError("expm1() -- Invalid argument width ", w);
    }
  }

  /* Returns the value of the argument `x` rounded down to the nearest integer. */
  inline proc floor(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc floor(x: real(64)): real(64);
      return floor(x);
    } else if w == 32 {
      extern proc floorf(x: real(32)): real(32);
      return floorf(x);
    } else {
      compilerError("floor() -- Invalid argument width ", w);
    }
  }

  /* Returns a value for which :proc:`isinf` will return `true`. */
  inline proc INFINITY: real(64) return chpl_macro_INFINITY();

  /* Returns `true` if the argument `x` is a representation of a finite value;
     `false` otherwise.
  */
  inline proc isfinite(x: real(?w)) : real(w) {
    if w == 64 {
      return chpl_macro_double_isfinite(x);
    } else if w == 32 {
      return chpl_macro_float_isfinite(x);
    } else {
      compilerError("isfinite() -- Invalid argument width ", w);
    }
  }

  /* Returns `true` if the argument `x` is a representation of *infinity*;
     `false` otherwise. */
  inline proc isinf(x: real(?w)) : real(w) {
    if w == 64 {
      return chpl_macro_double_isinf(x);
    } else if w == 32 {
      return chpl_macro_float_isinf(x);
    } else {
      compilerError("isinf() -- Invalid argument width ", w);
    }
  }

  /* Returns `true` if the argument `x` does not represent a valid number;
     `false` otherwise. */
  inline proc isnan(x: real(?w)) : real(w) {
    if w == 64 {
      return chpl_macro_double_isnan(x);
    } else if w == 32 {
      return chpl_macro_float_isnan(x);
    } else {
      compilerError("isnan() -- Invalid argument width ", w);
    }
  }

  /* Returns the natural logarithm of the absolute value
     of the gamma function of the argument `x`.
  */
  inline proc lgamma(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc lgamma(x: real(64)): real(64);
      return lgamma(x);
    } else if w == 32 {
      extern proc lgammaf(x: real(32)): real(32);
      return lgammaf(x);
    } else {
      compilerError("lgamma() -- Invalid argument width ", w);
    }
  }

  /* Returns the natural logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc log(x: real(64)): real(64);
      return log(x);
    } else if w == 32 {
      extern proc logf(x: real(32)): real(32);
      return logf(x);
    } else {
      compilerError("log() -- Invalid argument width ", w);
    }
  }

  /* Returns the base 10 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log10(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc log10(x: real(64)): real(64);
      return log10(x);
    } else if w == 32 {
      extern proc log10f(x: real(32)): real(32);
      return log10f(x);
    } else {
      compilerError("log10() -- Invalid argument width ", w);
    }
  }

  /* Returns the natural logarithm of `x` + 1.

     It is an error if `x` is less than or equal to -1.
  */
  inline proc log1p(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc log1p(x: real(64)): real(64);
      return log1p(x);
    } else if w == 32 {
      extern proc log1pf(x: real(32)): real(32);
      return log1pf(x);
    } else {
      compilerError("log1p() -- Invalid argument width ", w);
    }
  }

  /* Returns the base 2 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log2(x) : x.type where isNumeric(x) {
    if isReal(x) {
      if w == 64 {
        extern proc log2(x: real(64)): real(64);
        return log2(x);
      } else if w == 32 {
        extern proc log2f(x: real(32)): real(32);
        return log2f(x);
      } else {
        compilerError("log2() -- Invalid real argument width ", w);
      }
    } else if isIntegral(x) {
      return logBasePow2(val, 1);
    } else {
      compilerError("log2() -- Invalid numeric argument type: ",
                    typeToString(x.type));
    }
  }

  /* Computes the mod operator on the two integer param arguments, defined as
     ``mod(x,y) = x - y * floor(x / y)``.
  */
  proc mod(param m: integral, param n: integral) param {
    param temp = m % n;

    // verbatim copy from the other 'mod', to simplify maintenance
    return
      if isNonnegative(n) then
      if isUintType(m.type)
        then temp
          else ( if temp >= 0 then temp else temp + n )
            else
              // n < 0
              ( if temp <= 0 then temp else temp + n );
  }

  /* Computes the mod operator on the two arguments, defined as
     ``mod(x,y) = x - y * floor(x / y)``.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc mod(m: integral, n: integral) {
    const temp = m % n;

    // eliminate some run-time tests if input(s) is(are) unsigned
    return
      if isNonnegative(n) then
      if isUintType(m.type)
        then temp
          else ( if temp >= 0 then temp else temp + n )
            else
              // n < 0
              ( if temp <= 0 then temp else temp + n );
  }

  /* Computes the mod operator on the two numbers, defined as
     ``mod(x,y) = x - y * floor(x / y)``.
  */
  proc mod(x: real(?w), y: real(w)): real(w) {
    // This codes up the standard definition, according to Wikipedia.
    // Is there a more efficient implementation for reals?
    return x - y*floor(x/y);
  }

  /* Returns a value for which :proc:`isnan` will return `true`. */
  inline proc NAN : real(64) return chpl_macro_NAN();

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`nearbyint` will not raise the "inexact"
     floating-point exception.
  */
  inline proc nearbyint(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc nearbyint(x: real(64)): real(64);
      return nearbyint(x);
    } else if w == 32 {
      extern proc nearbyintf(x: real(32)): real(32);
      return nearbyintf(x);
    } else {
      compilerError("nearbyint() -- Invalid argument width ", w);
    }
  }

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`rint` may raise the "inexact" floating-point
     exception.
  */
  inline proc rint(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc rint(x: real(64)): real(64);
      return rint(x);
    } else if w == 32 {
      extern proc rintf(x: real(32)): real(32);
      return rintf(x);
    } else {
      compilerError("rint() -- Invalid argument width ", w);
    }
  }

  /* Returns the rounded integral value of the argument `x`. */
  inline proc round(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc round(x: real(64)): real(64);
      return round(x);
    } else if w == 32 {
      extern proc roundf(x: real(32)): real(32);
      return roundf(x);
    } else {
      compilerError("round() -- Invalid argument width ", w);
    }
  }

  /* Returns the signum function of the integer param argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  proc sgn(param i : integral) param
    return if i > 0 then 1 else if i == 0 then 0 else -1;

  /* Returns the signum function of the integer argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(i : int(?w)): int(8)
    return ((i > 0) : int(8) - (i < 0) : int(8)) : int(8);

  /* Returns the signum function of the unsigned integer argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(i : uint(?w)): uint(8)
    return (i > 0) : uint(8);

  /* Returns the signum function of the real argument `x`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(x : real(?w)): int(8)
    return ((x > 0.0) : int(8) - (x < 0.0) : int(8)) : int(8);

  /* Returns the sine of the argument `x`. */
  inline proc sin(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc sin(x: real(64)): real(64);
      return sin(x);
    } else if w == 32 {
      extern proc sinf(x: real(32)): real(32);
      return sinf(x);
    } else {
      compilerError("sin() -- Invalid argument width ", w);
    }
  }

  /* Returns the hyperbolic sine of the argument `x`. */
  inline proc sinh(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc sinh(x: real(64)): real(64);
      return sinh(x);
    } else if w == 32 {
      extern proc sinhf(x: real(32)): real(32);
      return sinhf(x);
    } else {
      compilerError("sinh() -- Invalid argument width ", w);
    }
  }

  /* Returns the square root of the argument `x`.

     It is an error if the `x` is less than zero.
  */
  inline proc sqrt(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc sqrt(x: real(64)): real(64);
      return sqrt(x);
    } else if w == 32 {
      extern proc sqrtf(x: real(32)): real(32);
      return sqrtf(x);
    } else {
      compilerError("sqrt() -- Invalid argument width ", w);
    }
  }

  /* Returns the tangent of the argument `x`. */
  inline proc tan(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc tan(x: real(64)): real(64);
      return tan(x);
    } else if w == 32 {
      extern proc tanf(x: real(32)): real(32);
      return tanf(x);
    } else {
      compilerError("tan() -- Invalid argument width ", w);
    }
  }

  /* Returns the hyperbolic tangent of the argument `x`. */
  inline proc tanh(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc tanh(x: real(64)): real(64);
      return tanh(x);
    } else if w == 32 {
      extern proc tanhf(x: real(32)): real(32);
      return tanhf(x);
    } else {
      compilerError("tanh() -- Invalid argument width ", w);
    }
  }

  /* Returns the absolute value of the gamma function of the argument `x`. */
  inline proc tgamma(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc tgamma(x: real(64)): real(64);
      return tgamma(x);
    } else if w == 32 {
      extern proc tgammaf(x: real(32)): real(32);
      return tgammaf(x);
    } else {
      compilerError("tgamma() -- Invalid argument width ", w);
    }
  }

  /* Returns the nearest integral value to the argument `x` that is not larger
     than `x` in absolute value. */
  inline proc trunc(x: real(?w)) : real(w) {
    if w == 64 {
      extern proc trunc(x: real(64)): real(64);
      return trunc(x);
    } else if w == 32 {
      extern proc truncf(x: real(32)): real(32);
      return truncf(x);
    } else {
      compilerError("trunc() -- Invalid argument width ", w);
    }
  }

} // end of module Math

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

/*
This module provides wrappers for <cmath> (math.h) numerical constants and
routines.  Its symbols are provided by default; an explicit 'use' statement
is not necessary.

The C Math library is part of the C Language Standard (ISO/IEC 9899), as
described in Section 7.12.  Please consult that standard for an
authoritative description of the expected properties of those constants and
routines.

In general, where the C math library provides a *double* and a *float* version
of a function, the float version has a suffix 'f'.  In the Chapel interface,
the suffix is dropped, and the type of the operand determines which version is
called -- according to the usual function overloading and resolution rules.
Normally, the result has the same precision
as the argument(s).  Please consult the C standard for specifics.

Rounding -- The rounding mode for floating-point addition (subtraction) is
implementation-defined.

Error Handling -- At present, Chapel does not provide control over error
handling in the Math module.  The default behavior is as if the macro
``math_errhandling`` is set to 0: Given erroneous input at run-time,
all math functions will return an implementation-defined value; no
exception will be generated.

*/
module Math {

  //////////////////////////////////////////////////////////////////////////
  // Helper constants and functions (not included in chpldocs).
  //
  pragma "no doc"
  extern proc chpl_macro_INFINITY():real(64);
  pragma "no doc"
  extern proc chpl_macro_NAN():real(64);

  pragma "no doc"
  extern proc chpl_macro_double_isinf(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isinf(x: real(32)): c_int;
  pragma "no doc"
  extern proc chpl_macro_double_isfinite(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isfinite(x: real(32)): c_int;
  pragma "no doc"
  extern proc chpl_macro_double_isnan(x: real(64)): c_int;
  pragma "no doc"
  extern proc chpl_macro_float_isnan(x: real(32)): c_int;

  pragma "no doc"
  extern proc fabs(x: real(64)): real(64);

  pragma "no doc"
  proc _logBasePow2Help(in val, baseLog2) {
    var result = -1;
    while (val != 0) {
      val >>= baseLog2;
      result += 1;
    }
    return result;
  }

  pragma "no doc"
  proc logBasePow2(in val: int(?w), baseLog2) {
    if (val < 1) {
      halt("Can't take the log() of a non-positive integer");
    }
    return _logBasePow2Help(val, baseLog2);
  }

  pragma "no doc"
  proc logBasePow2(in val: uint(?w), baseLog2) {
    if (val < 1) {
      halt("Can't take the log() of a non-positive integer");
    }
    return _logBasePow2Help(val, baseLog2);
  }
  //
  //////////////////////////////////////////////////////////////////////////

  //////////////////////////////////////////////////////////////////////////
  //
  // Public interface (included in chpldocs).
  //
  // (The entries below are alphabetized (case-insensitively) because chpldocs
  // presents them in declaration order.)
  //

  /* Returns the absolute value of the integer argument.

     :rtype: The type of `i`.
  */
  inline proc abs(i : int(?w)) return if i < 0 then -i else i;

  /* Returns the absolute value of the unsigned integer argument.

     :rtype: The type of `i`.
  */
  inline proc abs(i : uint(?w)) return i;

  /* Returns the absolute value of the integer param argument `i`. */
  proc abs(param i : integral) param return if i < 0 then -i else i;

  /* Returns the magnitude of the real argument `r`. */
  inline proc abs(r : real(64)):real(64) return fabs(r);

  /* Returns the magnitude of the real argument `x`. */
  inline proc abs(x : real(32)): real(32) {
    extern proc fabsf(x: real(32)): real(32);
    return fabsf(x);
  }

  /* Returns the real magnitude of the imaginary argument `im`. */
  inline proc abs(im : imag(64)): real(64) return fabs(_i2r(im));

  /* Returns the real magnitude of the imaginary argument `im`. */
  inline proc abs(im: imag(32)): real(32) {
    extern proc fabsf(x: real(32)): real(32);
    return fabsf(_i2r(im));
  }

  /* Returns the real magnitude of the complex argument `x`.

     :rtype: The type of the real component of the argument (== `w`/2).
  */
  inline proc abs(x : complex(?w)) return sqrt(x.re*x.re + x.im*x.im);

  /* Returns the arc cosine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  extern proc acos(x: real(64)): real(64);

  /* Returns the arc cosine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc acos(x : real(32)): real(32) {
    extern proc acosf(x: real(32)): real(32);
    return acosf(x);
  }

  /* Returns the inverse hyperbolic cosine of the argument `x`.

     It is an error if `x` is less than 1.
  */
  extern proc acosh(x: real(64)): real(64);

  /* Returns the inverse hyperbolic cosine of the argument `x`.

     It is an error if `x` is less than 1.
  */
  inline proc acosh(x : real(32)): real(32) {
    extern proc acoshf(x: real(32)): real(32);
    return acoshf(x);
  }

  /* Returns the arc sine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  extern proc asin(x: real(64)): real(64);

  /* Returns the arc sine of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1.
  */
  inline proc asin(x : real(32)): real(32) {
    extern proc asinf(x: real(32)): real(32);
    return asinf(x);
  }

  /* Returns the inverse hyperbolic sine of the argument `x`. */
  extern proc asinh(x: real(64)): real(64);

  /* Returns the inverse hyperbolic sine of the argument `x`. */
  inline proc asinh(x : real(32)): real(32) {
    extern proc asinhf(x: real(32)): real(32);
    return asinhf(x);
  }

  /* Returns the arc tangent of the argument `x`. */
  extern proc atan(x: real(64)): real(64);

  /* Returns the arc tangent of the argument `x`. */
  inline proc atan(x : real(32)): real(32) {
    extern proc atanf(x: real(32)): real(32);
    return atanf(x);
  }

  /* Returns the arc tangent of the ratio of the two arguments.

     This is equivalent to
     the arc tangent of `y` / `x` except that the signs of `y`
     and `x` are used to determine the quadrant of the result. */
  extern proc atan2(y: real(64), x: real(64)): real(64);

  /* Returns the arc tangent of the two arguments.

     This is equivalent to
     the arc tangent of `y` / `x` except that the signs of `y`
     and `x` are used to determine the quadrant of the result. */
  inline proc atan2(y : real(32), x: real(32)): real(32) {
    extern proc atan2f(y: real(32), x: real(32)): real(32);
    return atan2f(y, x);
  }

  /* Returns the inverse hyperbolic tangent of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1. */
  extern proc atanh(x: real(64)): real(64);

  /* Returns the inverse hyperbolic tangent of the argument `x`.

     It is an error if `x` is less than -1 or greater than 1. */
  inline proc atanh(x : real(32)): real(32) {
    extern proc atanhf(x: real(32)): real(32);
    return atanhf(x);
  }

  /* Returns the cube root of the argument `x`. */
  extern proc cbrt(x: real(64)): real(64);

  /* Returns the cube root of the argument `x`. */
  inline proc cbrt(x : real(32)): real(32) {
    extern proc cbrtf(x: real(32)): real(32);
    return cbrtf(x);
  }

  /* Returns the value of the argument `x` rounded up to the nearest integer. */
  extern proc ceil(x: real(64)): real(64);

  /* Returns the value of the argument `x` rounded up to the nearest integer. */
  inline proc ceil(x : real(32)): real(32) {
    extern proc ceilf(x: real(32)): real(32);
    return ceilf(x);
  }

  /* Returns the complex conjugate of the argument `a`.

     :rtype: The type of `a`.
  */
  inline proc conjg(a: complex(?w)) : complex(w) return (a.re, -a.im):complex(w);

  /* Returns the cosine of the argument `x`. */
  extern proc cos(x: real(64)): real(64);

  /* Returns the cosine of the argument `x`. */
  inline proc cos(x : real(32)): real(32) {
    extern proc cosf(x: real(32)): real(32);
    return cosf(x);
  }

  /* Returns the hyperbolic cosine of the argument `x`. */
  extern proc cosh(x: real(64)): real(64);

  /* Returns the hyperbolic cosine of the argument `x`. */
  inline proc cosh(x : real(32)): real(32) {
    extern proc coshf(x: real(32)): real(32);
    return coshf(x);
  }

  /* Returns :proc:`ceil`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded up to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divceil(m: integral, n: integral) return
    if isNonnegative(m) then
    if isNonnegative(n) then (m + n - 1) / n
      else                     m / n
        else
          if isNonnegative(n) then m / n
            else                     (m + n + 1) / n;

  /* Returns :proc:`ceil`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded up to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divceil(param m: integral, param n: integral) param return
    if isNonnegative(m) then
    if isNonnegative(n) then (m + n - 1) / n
      else                     m / n
        else
          if isNonnegative(n) then m / n
            else                     (m + n + 1) / n;

  /* Returns :proc:`floor`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded down to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divfloor(m: integral, n: integral) return
    if isNonnegative(m) then
    if isNonnegative(n) then m / n
      else                     (m - n - 1) / n
        else
          if isNonnegative(n) then (m - n + 1) / n
            else                     m / n;

  /* Returns :proc:`floor`\(`m`/`n`),
     i.e., the fraction `m`/`n` rounded down to the nearest integer.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc divfloor(param m: integral, param n: integral) param return
    if isNonnegative(m) then
    if isNonnegative(n) then m / n
      else                     (m - n - 1) / n
        else
          if isNonnegative(n) then (m - n + 1) / n
            else                     m / n;

  /* Returns the error function of the argument `x`. */
  extern proc erf(x: real(64)): real(64);

  /* Returns the error function of the argument `x`. */
  inline proc erf(x : real(32)): real(32) {
    extern proc erff(x: real(32)): real(32);
    return erff(x);
  }

  /* Returns the complementary error function of the argument.
     This is equivalent to 1.0 - :proc:`erf`\(`x`).
  */
  extern proc erfc(x: real(64)): real(64);

  /* Returns the complementary error function of the argument.
     This is equivalent to 1.0 - :proc:`erf`\(`x`).
  */
  inline proc erfc(x : real(32)): real(32) {
    extern proc erfcf(x: real(32)): real(32);
    return erfcf(x);
  }

  /* Returns the value of the Napierien `e` raised to the power of the argument `x`. */
  extern proc exp(x: real(64)): real(64);

  /* Returns the value of the Napierien `e` raised to the power of the argument. */
  inline proc exp(x : real(32)): real(32) {
    extern proc expf(x: real(32)): real(32);
    return expf(x);
  }

  /* Returns the value of `2` raised to the power of the argument `x`. */
  extern proc exp2(x: real(64)): real(64);

  /* Returns the value of `2` raised to the power of the argument `x`. */
  inline proc exp2(x : real(32)): real(32) {
    extern proc exp2f(x: real(32)): real(32);
    return exp2f(x);
  }

  /* Returns one less than the value of the Napierien `e` raised to the power
     of the argument `x`. */
  extern proc expm1(x: real(64)): real(64);

  /* Returns one less than the value of the Napierien `e` raised to the power
     of the argument `x`. */
  inline proc expm1(x : real(32)): real(32) {
    extern proc expm1f(x: real(32)): real(32);
    return expm1f(x);
  }

  /* Returns the value of the argument `x` rounded down to the nearest integer. */
  extern proc floor(x: real(64)): real(64);

  /* Returns the value of the argument `x` rounded down to the nearest integer. */
  inline proc floor(x : real(32)): real(32) {
    extern proc floorf(x: real(32)): real(32);
    return floorf(x);
  }

  /* Returns a value for which :proc:`isinf` will return `true`. */
  inline proc INFINITY: real(64) return chpl_macro_INFINITY();

  /* Returns `true` if the argument `x` is a representation of a finite value;
     `false` otherwise. */
  inline proc isfinite(x: real(64)): bool return chpl_macro_double_isfinite(x):bool;

  /* Returns `true` if the argument `x` is a representation of a finite value;
     `false` otherwise. */
  inline proc isfinite(x: real(32)): bool return chpl_macro_float_isfinite(x):bool;

  /* Returns `true` if the argument `x` is a representation of *infinity*;
     `false` otherwise. */
  inline proc isinf(x: real(64)): bool return chpl_macro_double_isinf(x):bool;

  /* Returns `true` if the argument `x` is a representation of *infinity*;
     `false` otherwise. */
  inline proc isinf(x: real(32)): bool return chpl_macro_float_isinf(x):bool;

  /* Returns `true` if the argument `x` does not represent a valid number;
     `false` otherwise. */
  inline proc isnan(x: real(64)): bool return chpl_macro_double_isnan(x):bool;

  /* Returns `true` if the argument `x` does not represent a valid number;
     `false` otherwise. */
  inline proc isnan(x: real(32)): bool return chpl_macro_float_isnan(x):bool;

  /* Returns the natural logarithm of the absolute value
     of the gamma function of the argument `x`.
  */
  extern proc lgamma(x: real(64)): real(64);

  /* Returns the natural logarithm of the absolute value
     of the gamma function of the argument `x`.
  */
  inline proc lgamma(x : real(32)): real(32) {
    extern proc lgammaf(x: real(32)): real(32);
    return lgammaf(x);
  }

  /* Returns the natural logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log(x: real(64)): real(64);

  /* Returns the natural logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log(x : real(32)): real(32) {
    extern proc logf(x: real(32)): real(32);
    return logf(x);
  }

  /* Returns the base 10 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log10(x: real(64)): real(64);

  /* Returns the base 10 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log10(x : real(32)): real(32) {
    extern proc log10f(x: real(32)): real(32);
    return log10f(x);
  }

  /* Returns the natural logarithm of `x` + 1.

     It is an error if `x` is less than or equal to -1.
  */
  extern proc log1p(x: real(64)): real(64);

  /* Returns the natural logarithm of `x` + 1.

     It is an error if `x` is less than or equal to -1.
  */
  inline proc log1p(x : real(32)): real(32) {
    extern proc log1pf(x: real(32)): real(32);
    return log1pf(x);
  }

  /* Returns the base 2 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  extern proc log2(x: real(64)): real(64);

  /* Returns the base 2 logarithm of the argument `x`.

     It is an error if `x` is less than or equal to zero.
  */
  inline proc log2(x : real(32)): real(32) {
    extern proc log2f(x: real(32)): real(32);
    return log2f(x);
  }

  /* Returns the base 2 logarithm of the argument `x`.

     :rtype: `int(64)`

     It is an error if `x` is less than or equal to zero.
  */
  proc log2(in val: int(?w)) {
    return logBasePow2(val, 1);
  }

  /* Returns the base 2 logarithm of the argument `x`.

     :rtype: `int(64)`

     It is an error if `x` is less than or equal to zero.
  */
  proc log2(in val: uint(?w)) {
    return logBasePow2(val, 1);
  }

  /* Computes the mod operator on the two numbers, defined as
     ``mod(x,y) = x - y * floor(x / y)``.

     The return value has the same type as `x`.
  */
  proc mod(x: real(?w), y: real(w)): real(w) {
    // This codes up the standard definition, according to Wikipedia.
    // Is there a more efficient implementation for reals?
    return x - y*floor(x/y);
  }

  /* Computes the mod operator on the two arguments, defined as
     ``mod(x,y) = x - y * floor(x / y)``.

     If the arguments are of unsigned type, then
     fewer condititionals will be evaluated at run time.
  */
  proc mod(m: integral, n: integral) {
    const temp = m % n;

    // eliminate some run-time tests if input(s) is(are) unsigned
    return
      if isNonnegative(n) then
      if isUintType(m.type)
        then temp
          else ( if temp >= 0 then temp else temp + n )
            else
              // n < 0
              ( if temp <= 0 then temp else temp + n );
  }

  /* Computes the mod operator on the two arguments, defined as
     ``mod(x,y) = x - y * floor(x / y)``.
  */
  proc mod(param m: integral, param n: integral) param {
    param temp = m % n;

    // verbatim copy from the other 'mod', to simplify maintenance
    return
      if isNonnegative(n) then
      if isUintType(m.type)
        then temp
          else ( if temp >= 0 then temp else temp + n )
            else
              // n < 0
              ( if temp <= 0 then temp else temp + n );
  }

  /* Returns a value for which :proc:`isnan` will return `true`. */
  inline proc NAN : real(64) return chpl_macro_NAN();

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`nearbyint` will not raise the "inexact"
     floating-point exception.
  */
  extern proc nearbyint(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`nearbyint` will not raise the "inexact"
     floating-point exception.
  */
  inline proc nearbyint(x : real(32)): real(32) {
    extern proc nearbyintf(x: real(32)): real(32);
    return nearbyintf(x);
  }

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`rint` may raise the "inexact" floating-point
     exception.
  */
  extern proc rint(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x` determined by the
     current rounding direction.  :proc:`rint` may raise the "inexact" floating-point
     exception.
  */
  inline proc rint(x : real(32)): real(32) {
    extern proc rintf(x: real(32)): real(32);
    return rintf(x);
  }

  /* Returns the rounded integral value of the argument `x`. */
  extern proc round(x: real(64)): real(64);

  /* Returns the rounded integral value of the argument `x`. */
  inline proc round(x : real(32)): real(32) {
    extern proc roundf(x: real(32)): real(32);
    return roundf(x);
  }

  /* Returns the signum function of the integer argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(i : int(?w)): int(8)
    return ((i > 0) : int(8) - (i < 0) : int(8)) : int(8);

  /* Returns the signum function of the unsigned integer argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(i : uint(?w)): uint(8)
    return (i > 0) : uint(8);

  /* Returns the signum function of the integer param argument `i`:
     1 if positive, -1 if negative, 0 if zero.
  */
  proc sgn(param i : integral) param
    return if i > 0 then 1 else if i == 0 then 0 else -1;

  /* Returns the signum function of the real argument `x`:
     1 if positive, -1 if negative, 0 if zero.
  */
  inline proc sgn(x : real(?w)): int(8)
    return ((x > 0.0) : int(8) - (x < 0.0) : int(8)) : int(8);

  /* Returns the sine of the argument `x`. */
  extern proc sin(x: real(64)): real(64);

  /* Returns the sine of the argument `x`. */
  inline proc sin(x: real(32)): real(32) {
    extern proc sinf(x: real(32)): real(32);
    return sinf(x);
  }

  /* Returns the hyperbolic sine of the argument `x`. */
  extern proc sinh(x: real(64)): real(64);

  /* Returns the hyperbolic sine of the argument `x`. */
  inline proc sinh(x : real(32)): real(32) {
    extern proc sinhf(x: real(32)): real(32);
    return sinhf(x);
  }

  /* Returns the square root of the argument `x`.

     It is an error if the `x` is less than zero.
  */
  extern proc sqrt(x: real(64)): real(64);

  /* Returns the square root of the argument `x`.

     It is an error if  `x` is less than zero.
  */
  inline proc sqrt(x : real(32)): real(32) {
    extern proc sqrtf(x: real(32)): real(32);
    return sqrtf(x);
  }

  /* Returns the tangent of the argument `x`. */
  extern proc tan(x: real(64)): real(64);

  /* Returns the tangent of the argument `x`. */
  inline proc tan(x : real(32)): real(32) {
    extern proc tanf(x: real(32)): real(32);
    return tanf(x);
  }

  /* Returns the hyperbolic tangent of the argument `x`. */
  extern proc tanh(x: real(64)): real(64);

  /* Returns the hyperbolic tangent of the argument `x`. */
  inline proc tanh(x : real(32)): real(32) {
    extern proc tanhf(x: real(32)): real(32);
    return tanhf(x);
  }

  /* Returns the absolute value of the gamma function of the argument `x`. */
  extern proc tgamma(x: real(64)): real(64);

  /* Returns the absolute value of the gamma function of the argument `x`. */
  inline proc tgamma(x : real(32)): real(32) {
    extern proc tgammaf(x: real(32)): real(32);
    return tgammaf(x);
  }

  /* Returns the nearest integral value to the argument `x` that is not larger
     than `x` in absolute value. */
  extern proc trunc(x: real(64)): real(64);

  /* Returns the nearest integral value to the argument `x` that is not larger
     than `x` in absolute value. */
  inline proc trunc(x : real(32)): real(32) {
    extern proc truncf(x: real(32)): real(32);
    return truncf(x);
  }

} // end of module Math

// TODO: Consolidate overloaded signatures, to simplify the documentation.


Remove the pragmas from the Sort module.

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

/*
   The `Sort` module is designed to support standard sorting
   routines.  The current interface is minimal and should be expected to
   grow and evolve over time. Each of the following functions accepts an
   optional boolean argument, `reverse`, which is `false` by
   default. If `true`, then the sort function will order in reverse.

 */
module Sort {

private inline proc chpl_sort_cmp(a, b, param reverse=false, param eq=false) {
  if eq {
    if reverse then return a >= b;
    else return a <= b;
  } else {
    if reverse then return a > b;
    else return a < b;
  }
}

/*
   Sort the 1D array `Data` in-place using a sequential bubble sort algorithm.

   :arg Data: The array to be sorted
   :type Data: [] eltType
   :arg doublecheck: Verify the array is correctly sorted before returning
   :type doublecheck: bool
   :arg reverse: Sort in reverse numerical order
   :type reverse: bool

 */
proc BubbleSort(Data: [?Dom] ?elType, doublecheck=false, param reverse=false) where Dom.rank == 1 {
  const lo = Dom.dim(1).low;
  const hi = Dom.dim(1).high;
  var swapped = true;

  while (swapped) {
    swapped = false;
    for i in lo..hi-1 {
      if !chpl_sort_cmp(Data(i), Data(i+1), reverse, true) {
        Data(i) <=> Data(i+1);
        swapped = true;
      }
    }
  }

  if (doublecheck) then VerifySort(Data, "BubbleSort", reverse);
}

/*
   Sort the 1D array `Data` in-place using a sequential heap sort algorithm.

   :arg Data: The array to be sorted
   :type Data: [] elType
   :arg doublecheck: Verify the array is correctly sorted before returning
   :type doublecheck: bool
   :arg reverse: Sort in reverse numerical order
   :type reverse: bool

 */
proc HeapSort(Data: [?Dom] ?elType, doublecheck=false, param reverse=false) where Dom.rank == 1 {
  const lo = Dom.dim(1).low;
  const hi = Dom.dim(1).high;
  const len = Dom.dim(1).size;

  // heapify
  var start = (len - 2) / 2 + lo;
  while (start >= lo) {
    SiftDown(start, hi);
    start = start - 1;
  }

  // sort, moving max element to end and re-heapifying the rest
  var end = hi;
  while (end > lo) {
    Data(end) <=> Data(lo);
    end = end - 1;
    SiftDown(lo, end);
  }

  proc SiftDown(start, end) {
    var root = start;
    while (root * 2 + 1 - lo <= end) {
      const child = root * 2 + 1 - lo;
      var swap = root;
      if chpl_sort_cmp(Data(swap), Data(child), reverse) then swap = child;
      if (child + 1 <= end) && (chpl_sort_cmp(Data(swap), Data(child + 1), reverse)) then swap = child + 1;
      if swap != root {
        Data(root) <=> Data(swap);
        root = swap;
      } else {
        return;
      }
    }
  }
  if (doublecheck) then VerifySort(Data, "HeapSort", reverse);
}

/*
   Sort the 1D array `Data` in-place using a sequential insertion sort algorithm.

   :arg Data: The array to be sorted
   :type Data: [] eltType
   :arg doublecheck: Verify the array is correctly sorted before returning
   :type doublecheck: bool
   :arg reverse: Sort in reverse numerical order
   :type reverse: bool

 */
proc InsertionSort(Data: [?Dom] ?elType, doublecheck=false, param reverse=false) where Dom.rank == 1 {
  const lo = Dom.low;
  for i in Dom {
    const ithVal = Data(i);
    var inserted = false;
    for j in lo..i-1 by -1 {
      if (chpl_sort_cmp(ithVal, Data(j), reverse)) {
        Data(j+1) = Data(j);
      } else {
        Data(j+1) = ithVal;
        inserted = true;
        break;
      }
    }
    if (!inserted) {
      Data(lo) = ithVal;
    }
  }

  if (doublecheck) then VerifySort(Data, "InsertionSort", reverse);
}

/*
   Sort the 1D array `Data` in-place using a parallel merge sort algorithm.

   :arg Data: The array to be sorted
   :type Data: [] eltType
   :arg minlen: When the array size is less than `minlen` use insertion sort algorithm
   :type minlen: integral
   :arg doublecheck: Verify the array is correctly sorted before returning
   :type doublecheck: bool
   :arg reverse: Sort in reverse numerical order
   :type reverse: bool

 */
proc MergeSort(Data: [?Dom], minlen=16, doublecheck=false, param reverse=false) where Dom.rank == 1 {
  _MergeSort(Data, minlen, reverse=reverse);
  if (doublecheck) then VerifySort(Data, "MergeSort", reverse);
}

private proc _MergeSort(Data: [?Dom], minlen=16, param reverse=false) where Dom.rank == 1 {
  const lo = Dom.dim(1).low;
  const hi = Dom.dim(1).high;
  if hi-lo < minlen {
    InsertionSort(Data, reverse=reverse);
    return;
  }
  const mid = (hi-lo)/2+lo;
  var A1 = Data[lo..mid];
  var A2 = Data[mid+1..hi];
  cobegin {
    { _MergeSort(A1, minlen, reverse=reverse); }
    { _MergeSort(A2, minlen, reverse=reverse); }
  }

  for (a, _a) in zip(Data[lo..hi], _MergeIterator(A1, A2, reverse=reverse)) do a = _a;
}

private iter _MergeIterator(A1: [] ?elType, A2: [] elType, param reverse=false) {
  var a1 = A1.domain.dim(1).low;
  const a1hi = A1.domain.dim(1).high;
  var a2 = A2.domain.dim(1).low;
  const a2hi = A2.domain.dim(1).high;
  while ((a1 <= a1hi) && (a2 <= a2hi)) {
    while (chpl_sort_cmp(A1(a1) ,A2(a2), reverse, true)) {
      yield A1(a1);
      a1 += 1;
      if a1 > a1hi then break;
    }
    if a1 > a1hi then break;
    while (chpl_sort_cmp(A2(a2), A1(a1), reverse, true)) {
      yield A2(a2);
      a2 += 1;
      if a2 > a2hi then break;
    }
  }
  if a1 == a1hi then yield A1(a1);
  else if a2 == a2hi then yield A2(a2);
  if a1 < a1hi then for a in A1[a1..a1hi] do yield a;
  else if a2 < a2hi then for a in A2[a2..a2hi] do yield a;
}

/*
   Sort the 1D array `Data` in-place using a sequential quick sort algorithm.

   :arg Data: The array to be sorted
   :type Data: [] eltType
   :arg minlen: When the array size is less than `minlen` use insertion sort algorithm
   :type minlen: integral
   :arg doublecheck: Verify the array is correctly sorted before returning
   :type doublecheck: bool
   :arg reverse: Sort in reverse numerical order
   :type reverse: bool

 */
proc QuickSort(Data: [?Dom] ?elType, minlen=16, doublecheck=false, param reverse=false) where Dom.rank == 1 {
  // grab obvious indices
  const lo = Dom.low,
        hi = Dom.high,
        mid = lo + (hi-lo+1)/2;

  // base case -- use insertion sort
  if (hi - lo < minlen) {
    InsertionSort(Data, reverse=reverse);
    return;
  }

  // find pivot using median-of-3 method
  if (chpl_sort_cmp(Data(mid), Data(lo), reverse)) then Data(mid) <=> Data(lo);
  if (chpl_sort_cmp(Data(hi), Data(lo), reverse)) then Data(hi) <=> Data(lo);
  if (chpl_sort_cmp(Data(hi), Data(mid), reverse)) then Data(hi) <=> Data(mid);
  const pivotVal = Data(mid);
  Data(mid) = Data(hi-1);
  Data(hi-1) = pivotVal;
  // end median-of-3 partitioning

  var loptr = lo,
      hiptr = hi-1;
  while (loptr < hiptr) {
    do { loptr += 1; } while (chpl_sort_cmp(Data(loptr), pivotVal, reverse));
    do { hiptr -= 1; } while (chpl_sort_cmp(pivotVal, Data(hiptr), reverse));
    if (loptr < hiptr) {
      Data(loptr) <=> Data(hiptr);
    }
  }

  Data(hi-1) = Data(loptr);
  Data(loptr) = pivotVal;

  //  cobegin {
    QuickSort(Data[..loptr-1], reverse=reverse);  // could use unbounded ranges here
    QuickSort(Data[loptr+1..], reverse=reverse);
    //  }

  if (doublecheck) then VerifySort(Data, "QuickSort", reverse);
}

/*
   Sort the 1D array `Data` in-place using a sequential selection sort
   algorithm.

   :arg Data: The array to be sorted
   :type Data: [] eltType
   :arg doublecheck: Verify the array is correctly sorted before returning
   :type doublecheck: bool
   :arg reverse: Sort in reverse numerical order
   :type reverse: bool

 */
proc SelectionSort(Data: [?Dom], doublecheck=false, param reverse=false) where Dom.rank == 1 {
  const lo = Dom.dim(1).low;
  const hi = Dom.dim(1).high;
  for i in lo..hi-1 {
    var (_, loc) = if reverse then maxloc reduce zip(Data[i..hi], {i..hi})
      else minloc reduce zip(Data[i..hi], {i..hi});
    Data(i) <=> Data(loc);
  }

  if (doublecheck) then VerifySort(Data, "SelectionSort", reverse);
}

/*
   Verify that the array `Data` is in sorted order and halt if any element is
   out of order.

   :arg Data: The array to verify
   :type Data: [] eltType
   :arg str: string to print while halting if an element is out of order
   :type str: string
   :arg reverse: if true, expect the values to be sorted in reverse.
   :type reverse: bool

 */
inline proc VerifySort(Data: [?Dom] ?elType, str: string, param reverse=false) {
  for i in Dom.low..Dom.high-1 do
    if chpl_sort_cmp(Data(i+1), Data(i), reverse) then
      halt(str, " did not sort properly (", i, "): ", Data);
}

//
// This is a first draft "sorterator" which is designed to take some
// other iterator/iterable and yield its elements, in sorted order.
//
// The main limitations in the current code are (1) it should put some
// sort of constraint on 'x' to limit it to types for which this makes
// sense; and (2) there should be some generic way to say "y is an
// array of x's element type" (or to infer its element type) without
// saying a priori how big it is.  Without these mods, the result is
// that the sorterator works when it does and probably is confusing
// when it doesn't.
//
/*
   Yield the elements of argument `x` in sorted order.

   :arg x: An iterable value to be sorted and yielded element by element
   :type x: iterable

   :yields: The elements of x in sorted order
   :ytype: x's element type

 */
iter sorted(x) {
  var y = x;
  QuickSort(y);
  for i in y do
    yield i;
}
}

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

/*
   The `Sort` module is designed to support standard sorting
   routines.  The current interface is minimal and should be expected to
   grow and evolve over time. Each of the following functions accepts an
   optional boolean argument, `reverse`, which is `false` by
   default. If `true`, then the sort function will order in reverse.

 */
module Sort {

pragma "no doc"
private inline proc chpl_sort_cmp(a, b, param reverse=false, param eq=false) {
  if eq {
    if reverse then return a >= b;
    else return a <= b;
  } else {
    if reverse then return a > b;
    else return a < b;
  }
}

/*
   Sort the 1D array `Data` in-place using a sequential bubble sort algorithm.

   :arg Data: The array to be sorted
   :type Data: [] eltType
   :arg doublecheck: Verify the array is correctly sorted before returning
   :type doublecheck: bool
   :arg reverse: Sort in reverse numerical order
   :type reverse: bool

 */
proc BubbleSort(Data: [?Dom] ?elType, doublecheck=false, param reverse=false) where Dom.rank == 1 {
  const lo = Dom.dim(1).low;
  const hi = Dom.dim(1).high;
  var swapped = true;

  while (swapped) {
    swapped = false;
    for i in lo..hi-1 {
      if !chpl_sort_cmp(Data(i), Data(i+1), reverse, true) {
        Data(i) <=> Data(i+1);
        swapped = true;
      }
    }
  }

  if (doublecheck) then VerifySort(Data, "BubbleSort", reverse);
}

/*
   Sort the 1D array `Data` in-place using a sequential heap sort algorithm.

   :arg Data: The array to be sorted
   :type Data: [] elType
   :arg doublecheck: Verify the array is correctly sorted before returning
   :type doublecheck: bool
   :arg reverse: Sort in reverse numerical order
   :type reverse: bool

 */
proc HeapSort(Data: [?Dom] ?elType, doublecheck=false, param reverse=false) where Dom.rank == 1 {
  const lo = Dom.dim(1).low;
  const hi = Dom.dim(1).high;
  const len = Dom.dim(1).size;

  // heapify
  var start = (len - 2) / 2 + lo;
  while (start >= lo) {
    SiftDown(start, hi);
    start = start - 1;
  }

  // sort, moving max element to end and re-heapifying the rest
  var end = hi;
  while (end > lo) {
    Data(end) <=> Data(lo);
    end = end - 1;
    SiftDown(lo, end);
  }

  proc SiftDown(start, end) {
    var root = start;
    while (root * 2 + 1 - lo <= end) {
      const child = root * 2 + 1 - lo;
      var swap = root;
      if chpl_sort_cmp(Data(swap), Data(child), reverse) then swap = child;
      if (child + 1 <= end) && (chpl_sort_cmp(Data(swap), Data(child + 1), reverse)) then swap = child + 1;
      if swap != root {
        Data(root) <=> Data(swap);
        root = swap;
      } else {
        return;
      }
    }
  }
  if (doublecheck) then VerifySort(Data, "HeapSort", reverse);
}

/*
   Sort the 1D array `Data` in-place using a sequential insertion sort algorithm.

   :arg Data: The array to be sorted
   :type Data: [] eltType
   :arg doublecheck: Verify the array is correctly sorted before returning
   :type doublecheck: bool
   :arg reverse: Sort in reverse numerical order
   :type reverse: bool

 */
proc InsertionSort(Data: [?Dom] ?elType, doublecheck=false, param reverse=false) where Dom.rank == 1 {
  const lo = Dom.low;
  for i in Dom {
    const ithVal = Data(i);
    var inserted = false;
    for j in lo..i-1 by -1 {
      if (chpl_sort_cmp(ithVal, Data(j), reverse)) {
        Data(j+1) = Data(j);
      } else {
        Data(j+1) = ithVal;
        inserted = true;
        break;
      }
    }
    if (!inserted) {
      Data(lo) = ithVal;
    }
  }

  if (doublecheck) then VerifySort(Data, "InsertionSort", reverse);
}

/*
   Sort the 1D array `Data` in-place using a parallel merge sort algorithm.

   :arg Data: The array to be sorted
   :type Data: [] eltType
   :arg minlen: When the array size is less than `minlen` use insertion sort algorithm
   :type minlen: integral
   :arg doublecheck: Verify the array is correctly sorted before returning
   :type doublecheck: bool
   :arg reverse: Sort in reverse numerical order
   :type reverse: bool

 */
proc MergeSort(Data: [?Dom], minlen=16, doublecheck=false, param reverse=false) where Dom.rank == 1 {
  _MergeSort(Data, minlen, reverse=reverse);
  if (doublecheck) then VerifySort(Data, "MergeSort", reverse);
}

pragma "no doc"
private proc _MergeSort(Data: [?Dom], minlen=16, param reverse=false) where Dom.rank == 1 {
  const lo = Dom.dim(1).low;
  const hi = Dom.dim(1).high;
  if hi-lo < minlen {
    InsertionSort(Data, reverse=reverse);
    return;
  }
  const mid = (hi-lo)/2+lo;
  var A1 = Data[lo..mid];
  var A2 = Data[mid+1..hi];
  cobegin {
    { _MergeSort(A1, minlen, reverse=reverse); }
    { _MergeSort(A2, minlen, reverse=reverse); }
  }

  for (a, _a) in zip(Data[lo..hi], _MergeIterator(A1, A2, reverse=reverse)) do a = _a;
}

pragma "no doc"
private iter _MergeIterator(A1: [] ?elType, A2: [] elType, param reverse=false) {
  var a1 = A1.domain.dim(1).low;
  const a1hi = A1.domain.dim(1).high;
  var a2 = A2.domain.dim(1).low;
  const a2hi = A2.domain.dim(1).high;
  while ((a1 <= a1hi) && (a2 <= a2hi)) {
    while (chpl_sort_cmp(A1(a1) ,A2(a2), reverse, true)) {
      yield A1(a1);
      a1 += 1;
      if a1 > a1hi then break;
    }
    if a1 > a1hi then break;
    while (chpl_sort_cmp(A2(a2), A1(a1), reverse, true)) {
      yield A2(a2);
      a2 += 1;
      if a2 > a2hi then break;
    }
  }
  if a1 == a1hi then yield A1(a1);
  else if a2 == a2hi then yield A2(a2);
  if a1 < a1hi then for a in A1[a1..a1hi] do yield a;
  else if a2 < a2hi then for a in A2[a2..a2hi] do yield a;
}

/*
   Sort the 1D array `Data` in-place using a sequential quick sort algorithm.

   :arg Data: The array to be sorted
   :type Data: [] eltType
   :arg minlen: When the array size is less than `minlen` use insertion sort algorithm
   :type minlen: integral
   :arg doublecheck: Verify the array is correctly sorted before returning
   :type doublecheck: bool
   :arg reverse: Sort in reverse numerical order
   :type reverse: bool

 */
proc QuickSort(Data: [?Dom] ?elType, minlen=16, doublecheck=false, param reverse=false) where Dom.rank == 1 {
  // grab obvious indices
  const lo = Dom.low,
        hi = Dom.high,
        mid = lo + (hi-lo+1)/2;

  // base case -- use insertion sort
  if (hi - lo < minlen) {
    InsertionSort(Data, reverse=reverse);
    return;
  }

  // find pivot using median-of-3 method
  if (chpl_sort_cmp(Data(mid), Data(lo), reverse)) then Data(mid) <=> Data(lo);
  if (chpl_sort_cmp(Data(hi), Data(lo), reverse)) then Data(hi) <=> Data(lo);
  if (chpl_sort_cmp(Data(hi), Data(mid), reverse)) then Data(hi) <=> Data(mid);
  const pivotVal = Data(mid);
  Data(mid) = Data(hi-1);
  Data(hi-1) = pivotVal;
  // end median-of-3 partitioning

  var loptr = lo,
      hiptr = hi-1;
  while (loptr < hiptr) {
    do { loptr += 1; } while (chpl_sort_cmp(Data(loptr), pivotVal, reverse));
    do { hiptr -= 1; } while (chpl_sort_cmp(pivotVal, Data(hiptr), reverse));
    if (loptr < hiptr) {
      Data(loptr) <=> Data(hiptr);
    }
  }

  Data(hi-1) = Data(loptr);
  Data(loptr) = pivotVal;

  //  cobegin {
    QuickSort(Data[..loptr-1], reverse=reverse);  // could use unbounded ranges here
    QuickSort(Data[loptr+1..], reverse=reverse);
    //  }

  if (doublecheck) then VerifySort(Data, "QuickSort", reverse);
}

/*
   Sort the 1D array `Data` in-place using a sequential selection sort
   algorithm.

   :arg Data: The array to be sorted
   :type Data: [] eltType
   :arg doublecheck: Verify the array is correctly sorted before returning
   :type doublecheck: bool
   :arg reverse: Sort in reverse numerical order
   :type reverse: bool

 */
proc SelectionSort(Data: [?Dom], doublecheck=false, param reverse=false) where Dom.rank == 1 {
  const lo = Dom.dim(1).low;
  const hi = Dom.dim(1).high;
  for i in lo..hi-1 {
    var (_, loc) = if reverse then maxloc reduce zip(Data[i..hi], {i..hi})
      else minloc reduce zip(Data[i..hi], {i..hi});
    Data(i) <=> Data(loc);
  }

  if (doublecheck) then VerifySort(Data, "SelectionSort", reverse);
}

/*
   Verify that the array `Data` is in sorted order and halt if any element is
   out of order.

   :arg Data: The array to verify
   :type Data: [] eltType
   :arg str: string to print while halting if an element is out of order
   :type str: string
   :arg reverse: if true, expect the values to be sorted in reverse.
   :type reverse: bool

 */
inline proc VerifySort(Data: [?Dom] ?elType, str: string, param reverse=false) {
  for i in Dom.low..Dom.high-1 do
    if chpl_sort_cmp(Data(i+1), Data(i), reverse) then
      halt(str, " did not sort properly (", i, "): ", Data);
}

//
// This is a first draft "sorterator" which is designed to take some
// other iterator/iterable and yield its elements, in sorted order.
//
// The main limitations in the current code are (1) it should put some
// sort of constraint on 'x' to limit it to types for which this makes
// sense; and (2) there should be some generic way to say "y is an
// array of x's element type" (or to infer its element type) without
// saying a priori how big it is.  Without these mods, the result is
// that the sorterator works when it does and probably is confusing
// when it doesn't.
//
/*
   Yield the elements of argument `x` in sorted order.

   :arg x: An iterable value to be sorted and yielded element by element
   :type x: iterable

   :yields: The elements of x in sorted order
   :ytype: x's element type

 */
iter sorted(x) {
  var y = x;
  QuickSort(y);
  for i in y do
    yield i;
}
}