Add pragma "no use ChapelStandard" to module CString in modules/internal/String.chpl

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

// Chapel Strings
pragma "no use ChapelStandard"

module String {
  use CString;

  pragma "default string value" extern var defaultStringValue: string = noinit;

  // The following method is called by the compiler to determine the default
  // value of a given type.  For strings, this should return the value
  // defined above.
  // strings will be records, so param is not possible for them
  inline proc _defaultOf(type t) where t: string return defaultStringValue;

  // String concatenation
  inline proc +(s: string, x: string) {
    var cs = __primitive("string_concat", s.c_str(), x.c_str());
    const ret = toString(cs);
    // toString steals the c_string_copy, so no need to free it here.
    return ret;
  }

  inline proc +(s: c_string, x: string) {
    var cs = __primitive("string_concat", s, x.c_str());
    const ret = toString(cs);
    // toString steals the c_string_copy, so no need to free it here.
    return ret;
  }

  inline proc +(s: string, x: c_string) {
    var cs = __primitive("string_concat", s.c_str(), x);
    const ret = toString(cs);
    // toString steals the c_string_copy, so no need to free it here.
    return ret;
  }

  inline proc +(s: string, x: numeric)
    return s + x:string;

  inline proc +(x: numeric, s: string)
    return x:string + s;

  inline proc +(s: string, x: enumerated)
    return s + x:string;

  inline proc +(x: enumerated, s: string)
    return x:string + s;

  inline proc +(s: string, x: bool)
    return s + x:string;

  inline proc +(x: bool, s: string)
    return x:string + s;

  proc typeToString(type t) param {
    return __primitive("typeToString", t);
  }

  proc typeToString(x) param {
    compilerError("typeToString()'s argument must be a type, not a value");
  }

  // This implies that the *representation* of strings is shared.
  // If strings are reimplemented as classes or records, a less trivial
  // implementation for assignment will become necessary.
  inline proc =(ref a: string, b: string) { __primitive("move", a, b); }

  inline proc ==(a: string, b: string) return (__primitive("string_compare", a.c_str(), b.c_str()) == 0);
  inline proc !=(a: string, b: string) return (__primitive("string_compare", a.c_str(), b.c_str()) != 0);

  inline proc <=(a: string, b: string) return a.c_str()<=b.c_str();
  inline proc >=(a: string, b: string) return a.c_str()>=b.c_str();
  inline proc <(a: string, b: string) return a.c_str()<b.c_str();
  inline proc >(a: string, b: string) return a.c_str()>b.c_str();

  //
  // primitive string functions and methods
  //
  inline proc ascii(a: string) return ascii(a.c_str());
  inline proc string.length return this.c_str().length;
  inline proc string.size return this.length;
  inline proc string.substring(i: int) {
    var cs = this.c_str().substring(i);
    const ret = toString(cs);
    // toString steals the returned c_string_copy, so no need to free it.
    return ret;
  }
  inline proc string.substring(r: range(?)) {
    var cs = this.c_str().substring(r);
    const ret = toString(cs);
    // toString steals the returned c_string_copy, so no need to free it.
    return ret;
  }

  inline proc _string_contains(a: string, b: string)
    return _string_contains(a.c_str(), b.c_str());

  /* args: any number of strings
     return: Returns true if this starts with one of the strings specified in args
   */
  inline proc string.startsWith(args ...?k):bool {
    for param i in 1..k {
      if (this.substring(0..args(i).length) == args(i))
        then return true;
    }
    return false;
  }

  /* 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 string.indexOf(substring:string):int
    return this.c_str().indexOf(substring.c_str());
  inline proc string.indexOf(substring:c_string):int
    return this.c_str().indexOf(substring);

  // cast to and from Chapel strings use c_string
  pragma "compiler generated"
  inline proc _cast(type t, x) where t == string {
    var cs = _cast(c_string_copy, x);
    // Note, this uses a non-allocating toString(), and steals cs (no need to free).
    const ret = toString(cs);
    return ret;
  }

  // The "compiler generated" flag is used, because this cast has to be weaker
  // than the c_string-to-enum cast generated in buildDefaultFunctions().
  // The circularity is caused by the built-in c_string-to-string coercion.
  // TODO: If string literals were all actually chpl_strings, then I think the
  // coercion (and this cruft) could be removed.
  pragma "compiler generated"
  inline proc _cast(type t, x: string) where isEnumType(t)
    return _cast(t, x.c_str());

  inline proc _cast(type t, x: string) where isBoolType(t) || isNumericType(t)
    return _cast(t, x.c_str());

  //
  // casts from c_string to bool types
  //
  inline proc _cast(type t, x:c_string) where isBoolType(t)
  {
    pragma "insert line file info"
    extern proc c_string_to_chpl_bool(x:c_string) : bool;
    return c_string_to_chpl_bool(x) : t;
  }

  //
  // casts from c_string to integer types
  //
  pragma "insert line file info"
  extern proc c_string_to_int8_t  (x:c_string) : int(8);
  pragma "insert line file info"
  extern proc c_string_to_int16_t (x:c_string) : int(16);
  pragma "insert line file info"
  extern proc c_string_to_int32_t (x:c_string) : int(32);
  pragma "insert line file info"
  extern proc c_string_to_int64_t (x:c_string) : int(64);
  pragma "insert line file info"
  extern proc c_string_to_uint8_t (x:c_string) : uint(8);
  pragma "insert line file info"
  extern proc c_string_to_uint16_t(x:c_string) : uint(16);
  pragma "insert line file info"
  extern proc c_string_to_uint32_t(x:c_string) : uint(32);
  pragma "insert line file info"
  extern proc c_string_to_uint64_t(x:c_string) : uint(64);

  inline proc _cast(type t, x:c_string) where t == int(8)
    return c_string_to_int8_t(x);
  inline proc _cast(type t, x:c_string) where t == int(16)
    return c_string_to_int16_t(x);
  inline proc _cast(type t, x:c_string) where t == int(32)
    return c_string_to_int32_t(x);
  inline proc _cast(type t, x:c_string) where t == int(64)
    return c_string_to_int64_t(x);
  inline proc _cast(type t, x:c_string) where t == uint(8)
    return c_string_to_uint8_t(x);
  inline proc _cast(type t, x:c_string) where t == uint(16)
    return c_string_to_uint16_t(x);
  inline proc _cast(type t, x:c_string) where t == uint(32)
    return c_string_to_uint32_t(x);
  inline proc _cast(type t, x:c_string) where t == uint(64)
    return c_string_to_uint64_t(x);

  //
  // casts from c_string to real/imag types
  //
  pragma "insert line file info"
  extern proc c_string_to_real32(x:c_string) : real(32);
  pragma "insert line file info"
  extern proc c_string_to_real64(x:c_string) : real(64);
  pragma "insert line file info"
  extern proc c_string_to_imag32(x:c_string) : imag(32);
  pragma "insert line file info"
  extern proc c_string_to_imag64(x:c_string) : imag(64);

  inline proc _cast(type t, x:c_string) where t == real(32)
    return c_string_to_real32(x);
  inline proc _cast(type t, x:c_string) where t == real(64)
    return c_string_to_real64(x);
  inline proc _cast(type t, x:c_string) where t == imag(32)
    return c_string_to_imag32(x);
  inline proc _cast(type t, x:c_string) where t == imag(64)
    return c_string_to_imag64(x);

  //
  // casts from c_string to complex types
  //
  pragma "insert line file info"
  extern proc c_string_to_complex64(x:c_string) : complex(64);
  pragma "insert line file info"
  extern proc c_string_to_complex128(x:c_string) : complex(128);

  inline proc _cast(type t, x:c_string) where t == complex(64)
    return c_string_to_complex64(x);
  inline proc _cast(type t, x:c_string) where t == complex(128)
    return c_string_to_complex128(x);

  //
  // casts from complex
  //
  inline proc _cast(type t, x: complex(?w)) where t == c_string_copy {
    if isnan(x.re) || isnan(x.im) then
      return __primitive("string_copy", "nan");
    var re = (x.re):c_string_copy;
    var im: c_string_copy;
    var op: c_string;
    if x.im < 0 {
      im = (-x.im):c_string_copy;
      op = " - ";
    } else if im == "-0.0" {
      im = "0.0":c_string_copy;
      op = " - ";
    } else {
      im = (x.im):c_string_copy;
      op = " + ";
    }
    // TODO: Add versions of the concatenation operator that consume their
    // c_string_copy arg or args.
    var ts0 = re + op;
    chpl_free_c_string_copy(re);
    var ts1 = ts0 + im;
    chpl_free_c_string_copy(ts0);
    chpl_free_c_string_copy(im);
    const ret = ts1 + "i";
    chpl_free_c_string_copy(ts1);
    return ret;
  }
  // TODO: This is only in place to support test code in types/string/sungeun.
  // Nor user nor module code should use this cast, because it strips ownership
  // from the c_string_copy returned by the above cast without first arranging
  // for its disposal.
  inline proc _cast(type t, x:complex(?w)) where t == c_string
    return _cast(c_string_copy, x);

  pragma "compiler generated"
  pragma "init copy fn"
  inline proc chpl__initCopy(a) {
    // Currently, string representations are shared.
    // (See note on proc =(a:string, b:string) above.)
      return a;
  }

  proc chpldev_refToString(ref arg) {

    //
    // print out the address of class references as well
    //
    proc chpldev_classToString(x: object)
      return " (class = " + __primitive("ref to string", x) + ")";
    proc chpldev_classToString(x) return "";

    return __primitive("ref to string", arg) + chpldev_classToString(arg);
  }

}

// C strings
// extern type c_string; is a built-in primitive type
//
// In terms of how they are used, c_strings are a "close to the metal"
// representation, being in essence the common NUL-terminated C string.
//
// C string copies
// extern type c_string_copy is also a built-in primitive type.
// It is the same as a c_string, but in its case represents "owned" data.
// Low-level routines that allocate string data off the heap and return a deep
// copy (including string_copy, string_concat, string_index and string_select)
// have the return type of c_string_copy to denote that ownership.
//
// The difference is ignored by the C compiler, but Chapel treats them as
// different types.  This difference allows us to have two versions of
// toString: one makes a copy of its c_string argument, the other simply
// pointer-copies its c_string_copy argument.  Both effectively return an
// "owned" C string, which is how the internal chpl_string type is currently
// interpreted.  (The new record-based string implementation has different
// rules, but still makes use of the distinction between unowned c_strings and
// owned c_string_copies.
pragma "no use ChapelStandard"

module CString {

  // The following method is called by the compiler to determine the default
  // value of a given type.
  inline proc _defaultOf(type t) param where t: c_string return "":c_string;
  inline proc _defaultOf(type t) where t == c_string_copy return _nullString;

  inline proc toString(cstr:c_string):string {
    return __primitive("string_from_c_string", cstr, 0, 0);
  }
  inline proc toString(cstr:c_string, len:int):string {
    return __primitive("string_from_c_string", cstr, 1, len);
  }

  // These routines consume the c_string_copy argument.  In terms of MM, this
  // is the same as if the caller had called chpl_free_string_copy()
  extern proc string_from_c_string_copy(ref cstrc:c_string_copy,
                                        hasLen:bool, len:int) : string;
  inline proc toString(ref cstrc:c_string_copy) : string {
    return string_from_c_string_copy(cstrc, false, 0);
  }
  inline proc toString(ref cstrc:c_string_copy, len:int) : string {
    return string_from_c_string_copy(cstrc, true, len);
  }

  // WARNING: The bytes pointed to by the c_string return value are still owned
  // by the "this" operand.  The returned c_string should not be freed!
  inline proc string.c_str():c_string {
    return __primitive("c_string_from_string", this);
  }

  inline proc ==(param s0: c_string, param s1: c_string) param {
    return __primitive("string_compare", s0, s1) == 0;
  }

  inline proc ==(s0: c_string, s1: c_string) {
    return __primitive("string_compare", s0, s1) == 0;
  }

  inline proc ==(s0: string, s1: c_string) {
    return __primitive("string_compare", s0.c_str(), s1) == 0;
  }

  inline proc ==(s0: c_string, s1: string) {
    return __primitive("string_compare", s0, s1.c_str()) == 0;
  }

  inline proc !=(param s0: c_string, param s1: c_string) param {
    return __primitive("string_compare", s0, s1) != 0;
  }

  inline proc !=(s0: c_string, s1: c_string) {
    return __primitive("string_compare", s0, s1) != 0;
  }

  inline proc !=(s0: string, s1: c_string) {
    return __primitive("string_compare", s0.c_str(), s1) != 0;
  }

  inline proc !=(s0: c_string, s1: string) {
    return __primitive("string_compare", s0, s1.c_str()) != 0;
  }

  inline proc <=(a: c_string, b: c_string) {
    return (__primitive("string_compare", a, b) <= 0);
  }

  inline proc <=(param a: c_string, param b: c_string) param {
    return (__primitive("string_compare", a, b) <= 0);
  }

  inline proc >=(a: c_string, b: c_string) {
    return (__primitive("string_compare", a, b) >= 0);
  }

  inline proc >=(param a: c_string, param b: c_string) param {
    return (__primitive("string_compare", a, b) >= 0);
  }

  inline proc <(a: c_string, b: c_string) {
    return (__primitive("string_compare", a, b) < 0);
  }

  inline proc <(param a: c_string, param b: c_string) param {
    return (__primitive("string_compare", a, b) < 0);
  }

  inline proc >(a: c_string, b: c_string) {
    return (__primitive("string_compare", a, b) > 0);
  }

  inline proc >(param a: c_string, param b: c_string) param {
    return (__primitive("string_compare", a, b) > 0);
  }

  inline proc =(ref a: c_string, b: c_string) {
    __primitive("=", a, b);
  }

  inline proc =(ref a: c_string, b: string) {
    __primitive("=", a, b.c_str());
  }

  inline proc =(ref a: string, b: c_string) {
    __primitive("=", a, toString(b));
  }

  // Create a fresh copy of the RHS string, first releasing the LHS.
  inline proc =(ref a: c_string_copy, b: c_string) {
    chpl_free_c_string_copy(a);
    var c = __primitive("string_copy", b);
    __primitive("=", a, c);
  }
  // Assume ownership of data brought by the RHS, first releasing the LHS.
  inline proc =(ref a: c_string_copy, b: c_string_copy) {
    chpl_free_c_string_copy(a);
    __primitive("=", a, b);
  }

  inline proc _cast(type t, x: c_string) where t == string {
    return toString(x);
  }

  inline proc _cast(type t, ref x: c_string_copy) where t == string {
    return toString(x);
  }

  inline proc _cast(type t, x: string) where t == c_string {
    return x.c_str();
  }

  inline proc _cast(type t, x: string) where t == c_string_copy {
    return __primitive("string_copy", x);
  }

  // A c_string_copy can always be used as a c_string.
  inline proc _cast(type t, x: c_string_copy) where t == c_string {
    return __primitive("cast", t, x);
  }

  extern proc chpl_bool_to_c_string(x:bool) : c_string;
  inline proc _cast(type t, x: bool(?w)) where t == c_string {
    return chpl_bool_to_c_string(x:bool);
  }
  inline proc _cast(type t, x: bool(?w)) where t == c_string_copy {
    return __primitive("string_copy", chpl_bool_to_c_string(x:bool));
  }

  inline proc _cast(type t, x:enumerated) where t == c_string_copy {
    // Use the compiler-generated enum to c_string conversion.
    var cs = _cast(c_string, x);
    return __primitive("string_copy", cs);
  }

  inline proc _cast(type t, x:integral) where t == c_string_copy {
    extern proc integral_to_c_string_copy(x:int(64), size:uint(32), isSigned: bool) : c_string_copy ;
    return integral_to_c_string_copy(x:int(64), numBytes(x.type), isIntType(x.type));
  }

  extern proc real_to_c_string_copy(x:real(64), isImag: bool) : c_string_copy ;
  //
  // casts from real
  //
  inline proc _cast(type t, x:real(?w)) where t == c_string_copy {
    return real_to_c_string_copy(x:real(64), false);
  }
  // TODO: This is only in place to support test code in types/string/sungeun.
  // Nor user nor module code should use this cast, because it strips ownership
  // from the c_string_copy returned by the above cast without first arranging
  // for its disposal.
  inline proc _cast(type t, x:real(?w)) where t == c_string
    return _cast(c_string_copy, x);

  //
  // casts from imag
  //
  inline proc _cast(type t, x:imag(?w)) where t == c_string_copy {
    // The Chapel version of the imag --> real cast smashes it flat rather than
    // just stripping off the "i".  See ChapelBase:965.
    var r = __primitive("cast", real(64), x);
    return real_to_c_string_copy(r, true);
  }
  // TODO: This is only in place to support test code in types/string/sungeun.
  // Nor user nor module code should use this cast, because it strips ownership
  // from the c_string_copy returned by the above cast without first arranging
  // for its disposal.
  inline proc _cast(type t, x:imag(?w)) where t == c_string
    return _cast(c_string_copy, x);

  // Only support param c_string concatenation (for now)
  inline proc +(param a: c_string, param b: c_string) param
    return __primitive("string_concat", a, b);

  inline proc +(param s: c_string, param x: integral) param
    return __primitive("string_concat", s, x:c_string);

  inline proc +(param x: integral, param s: c_string) param
    return __primitive("string_concat", x:c_string, s);

  inline proc +(param s: c_string, param x: enumerated) param
    return __primitive("string_concat", s, x:c_string);

  inline proc +(param x: enumerated, param s: c_string) param
    return __primitive("string_concat", x:c_string, s);

  inline proc +(param s: c_string, param x: bool) param
    return __primitive("string_concat", s, x:c_string);

  inline proc +(param x: bool, param s: c_string) param
    return __primitive("string_concat", x:c_string, s);

  inline proc +(a: c_string, b: c_string)
    return __primitive("string_concat", a, b);

  proc c_string.writeThis(x: Writer) {
    x.write(this);
  }
  // The c_string_copy version is required, since apparently coercions are not
  // applied to "this".
  proc c_string_copy.writeThis(x: Writer) {
    x.write(this:c_string);
  }

  //
  // primitive c_string functions and methods
  //
  inline proc ascii(param a: c_string) param return __primitive("ascii", a);
  inline proc ascii(a: c_string) return __primitive("ascii", a);
  inline proc c_string.length return __primitive("string_length", this);
  inline proc c_string.size return this.length;
  inline proc c_string.substring(i: int)
    return __primitive("string_index", this, i);
  inline proc c_string.substring(r: range(?)) {
    var r2 = r[1..this.length];  // This may warn about ambiguously aligned ranges.
    var lo:int = r2.alignedLow, hi:int = r2.alignedHigh;
    return __primitive("string_select", this, lo, hi, r2.stride);
  }

  inline proc _string_contains(a: string, b: string)
    return __primitive("string_contains", a, b);

  inline proc param c_string.length param
    return __primitive("string_length", this);
  inline proc _string_contains(param a: c_string, param b: c_string) param
    return __primitive("string_contains", a, b);

  /* 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 c_string.indexOf(substring:c_string):int
    return string_index_of(this, substring);
  extern proc string_index_of(haystack:c_string, needle:c_string):int;

  // Use with care.  Not for the weak.
  inline proc chpl_free_c_string_copy(ref cs: c_string_copy) {
    pragma "insert line file info"
    extern proc chpl_rt_free_c_string(ref cs: c_string_copy);
    if (cs != _nullString) then chpl_rt_free_c_string(cs);
    // cs = _nullString;
  }

}

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

pragma "no use ChapelStandard"

// Chapel Strings
module String {
  use CString;

  pragma "default string value" extern var defaultStringValue: string = noinit;

  // The following method is called by the compiler to determine the default
  // value of a given type.  For strings, this should return the value
  // defined above.
  // strings will be records, so param is not possible for them
  inline proc _defaultOf(type t) where t: string return defaultStringValue;

  // String concatenation
  inline proc +(s: string, x: string) {
    var cs = __primitive("string_concat", s.c_str(), x.c_str());
    const ret = toString(cs);
    // toString steals the c_string_copy, so no need to free it here.
    return ret;
  }

  inline proc +(s: c_string, x: string) {
    var cs = __primitive("string_concat", s, x.c_str());
    const ret = toString(cs);
    // toString steals the c_string_copy, so no need to free it here.
    return ret;
  }

  inline proc +(s: string, x: c_string) {
    var cs = __primitive("string_concat", s.c_str(), x);
    const ret = toString(cs);
    // toString steals the c_string_copy, so no need to free it here.
    return ret;
  }

  inline proc +(s: string, x: numeric)
    return s + x:string;

  inline proc +(x: numeric, s: string)
    return x:string + s;

  inline proc +(s: string, x: enumerated)
    return s + x:string;

  inline proc +(x: enumerated, s: string)
    return x:string + s;

  inline proc +(s: string, x: bool)
    return s + x:string;

  inline proc +(x: bool, s: string)
    return x:string + s;

  proc typeToString(type t) param {
    return __primitive("typeToString", t);
  }

  proc typeToString(x) param {
    compilerError("typeToString()'s argument must be a type, not a value");
  }

  // This implies that the *representation* of strings is shared.
  // If strings are reimplemented as classes or records, a less trivial
  // implementation for assignment will become necessary.
  inline proc =(ref a: string, b: string) { __primitive("move", a, b); }

  inline proc ==(a: string, b: string) return (__primitive("string_compare", a.c_str(), b.c_str()) == 0);
  inline proc !=(a: string, b: string) return (__primitive("string_compare", a.c_str(), b.c_str()) != 0);

  inline proc <=(a: string, b: string) return a.c_str()<=b.c_str();
  inline proc >=(a: string, b: string) return a.c_str()>=b.c_str();
  inline proc <(a: string, b: string) return a.c_str()<b.c_str();
  inline proc >(a: string, b: string) return a.c_str()>b.c_str();

  //
  // primitive string functions and methods
  //
  inline proc ascii(a: string) return ascii(a.c_str());
  inline proc string.length return this.c_str().length;
  inline proc string.size return this.length;
  inline proc string.substring(i: int) {
    var cs = this.c_str().substring(i);
    const ret = toString(cs);
    // toString steals the returned c_string_copy, so no need to free it.
    return ret;
  }
  inline proc string.substring(r: range(?)) {
    var cs = this.c_str().substring(r);
    const ret = toString(cs);
    // toString steals the returned c_string_copy, so no need to free it.
    return ret;
  }

  inline proc _string_contains(a: string, b: string)
    return _string_contains(a.c_str(), b.c_str());

  /* args: any number of strings
     return: Returns true if this starts with one of the strings specified in args
   */
  inline proc string.startsWith(args ...?k):bool {
    for param i in 1..k {
      if (this.substring(0..args(i).length) == args(i))
        then return true;
    }
    return false;
  }

  /* 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 string.indexOf(substring:string):int
    return this.c_str().indexOf(substring.c_str());
  inline proc string.indexOf(substring:c_string):int
    return this.c_str().indexOf(substring);

  // cast to and from Chapel strings use c_string
  pragma "compiler generated"
  inline proc _cast(type t, x) where t == string {
    var cs = _cast(c_string_copy, x);
    // Note, this uses a non-allocating toString(), and steals cs (no need to free).
    const ret = toString(cs);
    return ret;
  }

  // The "compiler generated" flag is used, because this cast has to be weaker
  // than the c_string-to-enum cast generated in buildDefaultFunctions().
  // The circularity is caused by the built-in c_string-to-string coercion.
  // TODO: If string literals were all actually chpl_strings, then I think the
  // coercion (and this cruft) could be removed.
  pragma "compiler generated"
  inline proc _cast(type t, x: string) where isEnumType(t)
    return _cast(t, x.c_str());

  inline proc _cast(type t, x: string) where isBoolType(t) || isNumericType(t)
    return _cast(t, x.c_str());

  //
  // casts from c_string to bool types
  //
  inline proc _cast(type t, x:c_string) where isBoolType(t)
  {
    pragma "insert line file info"
    extern proc c_string_to_chpl_bool(x:c_string) : bool;
    return c_string_to_chpl_bool(x) : t;
  }

  //
  // casts from c_string to integer types
  //
  pragma "insert line file info"
  extern proc c_string_to_int8_t  (x:c_string) : int(8);
  pragma "insert line file info"
  extern proc c_string_to_int16_t (x:c_string) : int(16);
  pragma "insert line file info"
  extern proc c_string_to_int32_t (x:c_string) : int(32);
  pragma "insert line file info"
  extern proc c_string_to_int64_t (x:c_string) : int(64);
  pragma "insert line file info"
  extern proc c_string_to_uint8_t (x:c_string) : uint(8);
  pragma "insert line file info"
  extern proc c_string_to_uint16_t(x:c_string) : uint(16);
  pragma "insert line file info"
  extern proc c_string_to_uint32_t(x:c_string) : uint(32);
  pragma "insert line file info"
  extern proc c_string_to_uint64_t(x:c_string) : uint(64);

  inline proc _cast(type t, x:c_string) where t == int(8)
    return c_string_to_int8_t(x);
  inline proc _cast(type t, x:c_string) where t == int(16)
    return c_string_to_int16_t(x);
  inline proc _cast(type t, x:c_string) where t == int(32)
    return c_string_to_int32_t(x);
  inline proc _cast(type t, x:c_string) where t == int(64)
    return c_string_to_int64_t(x);
  inline proc _cast(type t, x:c_string) where t == uint(8)
    return c_string_to_uint8_t(x);
  inline proc _cast(type t, x:c_string) where t == uint(16)
    return c_string_to_uint16_t(x);
  inline proc _cast(type t, x:c_string) where t == uint(32)
    return c_string_to_uint32_t(x);
  inline proc _cast(type t, x:c_string) where t == uint(64)
    return c_string_to_uint64_t(x);

  //
  // casts from c_string to real/imag types
  //
  pragma "insert line file info"
  extern proc c_string_to_real32(x:c_string) : real(32);
  pragma "insert line file info"
  extern proc c_string_to_real64(x:c_string) : real(64);
  pragma "insert line file info"
  extern proc c_string_to_imag32(x:c_string) : imag(32);
  pragma "insert line file info"
  extern proc c_string_to_imag64(x:c_string) : imag(64);

  inline proc _cast(type t, x:c_string) where t == real(32)
    return c_string_to_real32(x);
  inline proc _cast(type t, x:c_string) where t == real(64)
    return c_string_to_real64(x);
  inline proc _cast(type t, x:c_string) where t == imag(32)
    return c_string_to_imag32(x);
  inline proc _cast(type t, x:c_string) where t == imag(64)
    return c_string_to_imag64(x);

  //
  // casts from c_string to complex types
  //
  pragma "insert line file info"
  extern proc c_string_to_complex64(x:c_string) : complex(64);
  pragma "insert line file info"
  extern proc c_string_to_complex128(x:c_string) : complex(128);

  inline proc _cast(type t, x:c_string) where t == complex(64)
    return c_string_to_complex64(x);
  inline proc _cast(type t, x:c_string) where t == complex(128)
    return c_string_to_complex128(x);

  //
  // casts from complex
  //
  inline proc _cast(type t, x: complex(?w)) where t == c_string_copy {
    if isnan(x.re) || isnan(x.im) then
      return __primitive("string_copy", "nan");
    var re = (x.re):c_string_copy;
    var im: c_string_copy;
    var op: c_string;
    if x.im < 0 {
      im = (-x.im):c_string_copy;
      op = " - ";
    } else if im == "-0.0" {
      im = "0.0":c_string_copy;
      op = " - ";
    } else {
      im = (x.im):c_string_copy;
      op = " + ";
    }
    // TODO: Add versions of the concatenation operator that consume their
    // c_string_copy arg or args.
    var ts0 = re + op;
    chpl_free_c_string_copy(re);
    var ts1 = ts0 + im;
    chpl_free_c_string_copy(ts0);
    chpl_free_c_string_copy(im);
    const ret = ts1 + "i";
    chpl_free_c_string_copy(ts1);
    return ret;
  }
  // TODO: This is only in place to support test code in types/string/sungeun.
  // Nor user nor module code should use this cast, because it strips ownership
  // from the c_string_copy returned by the above cast without first arranging
  // for its disposal.
  inline proc _cast(type t, x:complex(?w)) where t == c_string
    return _cast(c_string_copy, x);

  pragma "compiler generated"
  pragma "init copy fn"
  inline proc chpl__initCopy(a) {
    // Currently, string representations are shared.
    // (See note on proc =(a:string, b:string) above.)
      return a;
  }

  proc chpldev_refToString(ref arg) {

    //
    // print out the address of class references as well
    //
    proc chpldev_classToString(x: object)
      return " (class = " + __primitive("ref to string", x) + ")";
    proc chpldev_classToString(x) return "";

    return __primitive("ref to string", arg) + chpldev_classToString(arg);
  }

}

// C strings
// extern type c_string; is a built-in primitive type
//
// In terms of how they are used, c_strings are a "close to the metal"
// representation, being in essence the common NUL-terminated C string.
//
// C string copies
// extern type c_string_copy is also a built-in primitive type.
// It is the same as a c_string, but in its case represents "owned" data.
// Low-level routines that allocate string data off the heap and return a deep
// copy (including string_copy, string_concat, string_index and string_select)
// have the return type of c_string_copy to denote that ownership.
//
// The difference is ignored by the C compiler, but Chapel treats them as
// different types.  This difference allows us to have two versions of
// toString: one makes a copy of its c_string argument, the other simply
// pointer-copies its c_string_copy argument.  Both effectively return an
// "owned" C string, which is how the internal chpl_string type is currently
// interpreted.  (The new record-based string implementation has different
// rules, but still makes use of the distinction between unowned c_strings and
// owned c_string_copies.
module CString {

  // The following method is called by the compiler to determine the default
  // value of a given type.
  inline proc _defaultOf(type t) param where t: c_string return "":c_string;
  inline proc _defaultOf(type t) where t == c_string_copy return _nullString;

  inline proc toString(cstr:c_string):string {
    return __primitive("string_from_c_string", cstr, 0, 0);
  }
  inline proc toString(cstr:c_string, len:int):string {
    return __primitive("string_from_c_string", cstr, 1, len);
  }

  // These routines consume the c_string_copy argument.  In terms of MM, this
  // is the same as if the caller had called chpl_free_string_copy()
  extern proc string_from_c_string_copy(ref cstrc:c_string_copy,
                                        hasLen:bool, len:int) : string;
  inline proc toString(ref cstrc:c_string_copy) : string {
    return string_from_c_string_copy(cstrc, false, 0);
  }
  inline proc toString(ref cstrc:c_string_copy, len:int) : string {
    return string_from_c_string_copy(cstrc, true, len);
  }

  // WARNING: The bytes pointed to by the c_string return value are still owned
  // by the "this" operand.  The returned c_string should not be freed!
  inline proc string.c_str():c_string {
    return __primitive("c_string_from_string", this);
  }

  inline proc ==(param s0: c_string, param s1: c_string) param {
    return __primitive("string_compare", s0, s1) == 0;
  }

  inline proc ==(s0: c_string, s1: c_string) {
    return __primitive("string_compare", s0, s1) == 0;
  }

  inline proc ==(s0: string, s1: c_string) {
    return __primitive("string_compare", s0.c_str(), s1) == 0;
  }

  inline proc ==(s0: c_string, s1: string) {
    return __primitive("string_compare", s0, s1.c_str()) == 0;
  }

  inline proc !=(param s0: c_string, param s1: c_string) param {
    return __primitive("string_compare", s0, s1) != 0;
  }

  inline proc !=(s0: c_string, s1: c_string) {
    return __primitive("string_compare", s0, s1) != 0;
  }

  inline proc !=(s0: string, s1: c_string) {
    return __primitive("string_compare", s0.c_str(), s1) != 0;
  }

  inline proc !=(s0: c_string, s1: string) {
    return __primitive("string_compare", s0, s1.c_str()) != 0;
  }

  inline proc <=(a: c_string, b: c_string) {
    return (__primitive("string_compare", a, b) <= 0);
  }

  inline proc <=(param a: c_string, param b: c_string) param {
    return (__primitive("string_compare", a, b) <= 0);
  }

  inline proc >=(a: c_string, b: c_string) {
    return (__primitive("string_compare", a, b) >= 0);
  }

  inline proc >=(param a: c_string, param b: c_string) param {
    return (__primitive("string_compare", a, b) >= 0);
  }

  inline proc <(a: c_string, b: c_string) {
    return (__primitive("string_compare", a, b) < 0);
  }

  inline proc <(param a: c_string, param b: c_string) param {
    return (__primitive("string_compare", a, b) < 0);
  }

  inline proc >(a: c_string, b: c_string) {
    return (__primitive("string_compare", a, b) > 0);
  }

  inline proc >(param a: c_string, param b: c_string) param {
    return (__primitive("string_compare", a, b) > 0);
  }

  inline proc =(ref a: c_string, b: c_string) {
    __primitive("=", a, b);
  }

  inline proc =(ref a: c_string, b: string) {
    __primitive("=", a, b.c_str());
  }

  inline proc =(ref a: string, b: c_string) {
    __primitive("=", a, toString(b));
  }

  // Create a fresh copy of the RHS string, first releasing the LHS.
  inline proc =(ref a: c_string_copy, b: c_string) {
    chpl_free_c_string_copy(a);
    var c = __primitive("string_copy", b);
    __primitive("=", a, c);
  }
  // Assume ownership of data brought by the RHS, first releasing the LHS.
  inline proc =(ref a: c_string_copy, b: c_string_copy) {
    chpl_free_c_string_copy(a);
    __primitive("=", a, b);
  }

  inline proc _cast(type t, x: c_string) where t == string {
    return toString(x);
  }

  inline proc _cast(type t, ref x: c_string_copy) where t == string {
    return toString(x);
  }

  inline proc _cast(type t, x: string) where t == c_string {
    return x.c_str();
  }

  inline proc _cast(type t, x: string) where t == c_string_copy {
    return __primitive("string_copy", x);
  }

  // A c_string_copy can always be used as a c_string.
  inline proc _cast(type t, x: c_string_copy) where t == c_string {
    return __primitive("cast", t, x);
  }

  extern proc chpl_bool_to_c_string(x:bool) : c_string;
  inline proc _cast(type t, x: bool(?w)) where t == c_string {
    return chpl_bool_to_c_string(x:bool);
  }
  inline proc _cast(type t, x: bool(?w)) where t == c_string_copy {
    return __primitive("string_copy", chpl_bool_to_c_string(x:bool));
  }

  inline proc _cast(type t, x:enumerated) where t == c_string_copy {
    // Use the compiler-generated enum to c_string conversion.
    var cs = _cast(c_string, x);
    return __primitive("string_copy", cs);
  }

  inline proc _cast(type t, x:integral) where t == c_string_copy {
    extern proc integral_to_c_string_copy(x:int(64), size:uint(32), isSigned: bool) : c_string_copy ;
    return integral_to_c_string_copy(x:int(64), numBytes(x.type), isIntType(x.type));
  }

  extern proc real_to_c_string_copy(x:real(64), isImag: bool) : c_string_copy ;
  //
  // casts from real
  //
  inline proc _cast(type t, x:real(?w)) where t == c_string_copy {
    return real_to_c_string_copy(x:real(64), false);
  }
  // TODO: This is only in place to support test code in types/string/sungeun.
  // Nor user nor module code should use this cast, because it strips ownership
  // from the c_string_copy returned by the above cast without first arranging
  // for its disposal.
  inline proc _cast(type t, x:real(?w)) where t == c_string
    return _cast(c_string_copy, x);

  //
  // casts from imag
  //
  inline proc _cast(type t, x:imag(?w)) where t == c_string_copy {
    // The Chapel version of the imag --> real cast smashes it flat rather than
    // just stripping off the "i".  See ChapelBase:965.
    var r = __primitive("cast", real(64), x);
    return real_to_c_string_copy(r, true);
  }
  // TODO: This is only in place to support test code in types/string/sungeun.
  // Nor user nor module code should use this cast, because it strips ownership
  // from the c_string_copy returned by the above cast without first arranging
  // for its disposal.
  inline proc _cast(type t, x:imag(?w)) where t == c_string
    return _cast(c_string_copy, x);

  // Only support param c_string concatenation (for now)
  inline proc +(param a: c_string, param b: c_string) param
    return __primitive("string_concat", a, b);

  inline proc +(param s: c_string, param x: integral) param
    return __primitive("string_concat", s, x:c_string);

  inline proc +(param x: integral, param s: c_string) param
    return __primitive("string_concat", x:c_string, s);

  inline proc +(param s: c_string, param x: enumerated) param
    return __primitive("string_concat", s, x:c_string);

  inline proc +(param x: enumerated, param s: c_string) param
    return __primitive("string_concat", x:c_string, s);

  inline proc +(param s: c_string, param x: bool) param
    return __primitive("string_concat", s, x:c_string);

  inline proc +(param x: bool, param s: c_string) param
    return __primitive("string_concat", x:c_string, s);

  inline proc +(a: c_string, b: c_string)
    return __primitive("string_concat", a, b);

  proc c_string.writeThis(x: Writer) {
    x.write(this);
  }
  // The c_string_copy version is required, since apparently coercions are not
  // applied to "this".
  proc c_string_copy.writeThis(x: Writer) {
    x.write(this:c_string);
  }

  //
  // primitive c_string functions and methods
  //
  inline proc ascii(param a: c_string) param return __primitive("ascii", a);
  inline proc ascii(a: c_string) return __primitive("ascii", a);
  inline proc c_string.length return __primitive("string_length", this);
  inline proc c_string.size return this.length;
  inline proc c_string.substring(i: int)
    return __primitive("string_index", this, i);
  inline proc c_string.substring(r: range(?)) {
    var r2 = r[1..this.length];  // This may warn about ambiguously aligned ranges.
    var lo:int = r2.alignedLow, hi:int = r2.alignedHigh;
    return __primitive("string_select", this, lo, hi, r2.stride);
  }

  inline proc _string_contains(a: string, b: string)
    return __primitive("string_contains", a, b);

  inline proc param c_string.length param
    return __primitive("string_length", this);
  inline proc _string_contains(param a: c_string, param b: c_string) param
    return __primitive("string_contains", a, b);

  /* 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 c_string.indexOf(substring:c_string):int
    return string_index_of(this, substring);
  extern proc string_index_of(haystack:c_string, needle:c_string):int;

  // Use with care.  Not for the weak.
  inline proc chpl_free_c_string_copy(ref cs: c_string_copy) {
    pragma "insert line file info"
    extern proc chpl_rt_free_c_string(ref cs: c_string_copy);
    if (cs != _nullString) then chpl_rt_free_c_string(cs);
    // cs = _nullString;
  }

}


First stab at documentation for the Random module

What's here is a good start.  I've noted bug fixes and feature
requests in comments labeled with CHPLDOC.  I also noted some
opportunities for improving the interface in the (non-doc) comments.

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

/*
   Support for pseudorandom number generation

   This module defines an abstraction for a stream of pseudorandom
   numbers, :chpl:class:`RandomStream`.  It also provides a
   convenience function, :chpl:proc:`fillRandom` that can be used to
   fill an array with random numbers in parallel.

   The current pseudorandom number generator (PRNG) used by the
   abstraction uses the algorithm used by the NAS Parallel Benchmarks
   (NPB, available at: http://www.nas.nasa.gov/publications/npb.html).
   The longer-term intention is to add knobs to select between a menu
   of PNRGs, such as the Mersenne twister.

   Paraphrasing the comments from the NPB reference implementation:

     This generator returns uniform pseudorandom real values in the
     range (0, 1) by using the linear congruential generator

       x_{k+1} = a x_k  (mod 2**46)

     where 0 < x_k < 2**46 and 0 < a < 2**46.  This scheme generates
     2**44 numbers before repeating.  The generated values are
     normalized to be between 0 and 1, i.e., 2**(-46) * x_k.

     This generator should produce the same results on any computer
     with at least 48 mantissa bits for `real(64)` data.

   Here is a list of currently open issues (TODOs) for this module:

   1. This module is currently restricted to generating `real(64)`,
   `imag(64)`, and `complex(128)` complex values.  We would like to
   extend this support to include other primitive types as well.

   2. We plan to support general serial and parallel iterators on the
   RandomStream class; however, providing the full suite of iterators
   is not possible with our current parallel iterator framework.
   Specifically, if :chpl:class:RandomStream: is a follower in a
   zippered iteration context, there is no way for it to update the
   total number of random numbers generated in a safe/sane/coordinated
   way.  We are exploring a revised leader-follower iterator framework
   that would support this idiom (and other cursor-based ones).

   3. If no seed is provided by the user, one is chosen based on the
   current time in microseconds, allowing for some degree of
   pseudorandomness in seed selection.  The intent of the
   SeedGenerator record is to provide a menu of other options for
   initializing the random stream seed, but only one option is
   implemented at present.

   4. As noted above, we plan to add support for additional PRNG
   algorithms over time.

*/
module Random {

  /*
     Note for developers on "private" symbols:

     It is the intent that once Chapel supports a notion of 'private'
     symbols, everything prefixed with RandomPrivate will be made
     private to this module and everything prefixed with
     'RandomStreamPrivate_' will be made private to the RandomStream
     class.
  */

  /* Internal TODOs for developers:

     - is the parSafe on each of the three main calls overkill?

     - should RandomStream be paramterized by the type to return?
       it seems odd that currently getNext() and getNth() return
       reals always...
  */

// CHPLDOC FIXME: The following doesn't show up in the documentation

/*
   An instance of :chpl:record:`SeedGenerators` that provides a
   convenient means of generating seeds when the user does not wish to
   specify one manually.
*/
const SeedGenerator: SeedGenerators;

// CHPLDOC FIXME: Respect ordering of things in the file

/*
  Provides methods to help generate seeds when the user doesn't want
  to create one.  It currently only supports one such method, but the
  intention is to add more over time.

  (Note: once Chapel supports static class methods,
  :chpl:const:`SeedGenerator` and :chpl:record:`SeedGenerators` should
  be combined into a single record type with static methods).
*/

record SeedGenerators {
  /*
    Generate a seed based on the current time in microseconds as
    reported by :chpl:proc:`Time.getCurrentTime`, ensuring that it
    meets the PRNG's requirements.
  */
  proc currentTime {
    use Time;
    const seed: int(64) = getCurrentTime(unit=TimeUnits.microseconds):int(64);
    return (if seed % 2 == 0 then seed + 1 else seed) % (1:int(64) << 46);
  }
};

// CHPLDOC FEEDBACK: If easy, I'd suggest either deprecating the
// :arg <type> <name>: form or else switching the order to
// :arg <name> <type>: as it's an easy trap to simply type the same
// argument as in the function's signature.

// CHPLDOC FIXME: int(64) prints out as int(64)(64)

// CHPLDOC FIXME: if the first line below is shifted one character to the
// left, it ends up being rendered like a method

// CHPLDOC FIXME: if the first line below is shifted one character to the
// right, it ends up causing a warning (promoted to error) in the .rst
// file.  It'd be preferable to have it declare the issue in terms of
// the .chpl line numbers.

/*
  Fill an array of real(64), imag(64), or complex(128) elements with
  pseudorandom values in parallel using a new
  :chpl:class:`RandomStream`.  The parallelization strategy is
  determined by the array.

  :arg arr: The array to be filled, where T is real(64), imag(64), or complex(128).
  :type arr: [] T

  :arg seed: The seed to use for the PRNG.  Defaults to :chpl:const:`SeedGenerator`.currentTime.
  :type seed: int
*/

proc fillRandom(arr: [], seed: int(64) = SeedGenerator.currentTime)
  where (x.eltType == real || x.eltType == imag || x.eltType == complex) {
  var randNums = new RandomStream(seed, parSafe=false);
  randNums.fillRandom(arr);
  delete randNums;
}

pragma "no doc"
proc fillRandom(arr: [], seed: int(64) = SeedGenerator.currentTime) {
  compilerError("Random.fillRandom is only defined for real(64), imag(64), and complex(128) arrays");
}

/*
  Models a stream of pseudorandom numbers.  See the module-level
  notes for :chpl:mod:`Random` for details on the PRNG used.
*/

class RandomStream {
  //
  // CHPLDOC FIXME: We should print the type and default value for parSafe
  //
  /*
    Indicates whether or not the RandomStream needs to be
    parallel-safe by default.  If multiple tasks interact with it in
    an uncoordinated fashion, this must be set to `true`.  If it will
    only be called from a single task, or if only one task will call
    into it at a time, setting to `false` will reduce overhead related
    to ensuring mutual exclusion.
  */
  param parSafe: bool = true;
  /*
    The seed value for the PRNG.  It must be an odd integer in the
    range (1, 2**46).
  */
  const seed: int(64);

  /*
    Constructs a new stream of random numbers using the specified seed
    and parallel safety.  Ensures that the seed value meets the PRNG's
    constraints.

    :arg seed: The seed to use for the PRNG.  Defaults to :chpl:const:`SeedGenerator`.currentTime.
    :type seed: int

    :arg parSafe: The parallel safety setting.  Defaults to `true`.
    :type parSafe: bool
  */
  proc RandomStream(seed: int(64) = SeedGenerator.currentTime,
                   param parSafe: bool = true) {
    if seed % 2 == 0 || seed < 1 || seed > 1:int(64)<<46 then
      halt("RandomStream seed must be an odd integer between 0 and 2**46");
    RandomStreamPrivate_init(seed);
  }

  //
  // CHPL FIXME: the type of parSafe below is printed out as _unknown
  //

  //
  // CHPL FIXME: the real(64) below gets rendered as real(64)(64)

  /*
    Returns the next value in the random stream as a `real(64)`

    :arg parSafe: Permits :chpl:param:`RandomStream.parSafe` to be overridden for this call.  Defaults to this.parSafe.
    :type parSafe: bool

    :returns: The next value in the random stream as a `real(64)`.
   */
  proc getNext(param parSafe = this.parSafe): real(64) {
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    RandomStreamPrivate_count += 1;
    const result = RandomPrivate_randlc(RandomStreamPrivate_cursor);
    if parSafe then
      RandomStreamPrivate_lock$;
    return result;
  }

  /*
    Skips to an arbitrary value in the random stream.

    :arg n: The position in the stream to skip to.  Must be non-negative.
    :type n: integral

    :arg parSafe: Permits :chpl:param:`RandomStream.parSafe` to be overridden for this call.  Defaults to this.parSafe.
    :type parSafe: bool
   */

  proc skipToNth(n: integral, param parSafe = this.parSafe) {
    if n <= 0 then
      halt("RandomStream.skipToNth(n) called with non-positive 'n' value", n);
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    RandomStreamPrivate_count = n;
    RandomStreamPrivate_cursor = RandomPrivate_randlc_skipto(seed, n);
    if parSafe then
      RandomStreamPrivate_lock$;
  }

  /*
    Skip to an arbitrary value in the random stream and return it.
    This is equivalent to :chpl:proc:`skipToNth()` followed by
    :chpl:proc:`getNext()`.

    :arg n: The position in the stream to skip to.  Must be non-negative.
    :type n: integral

    :arg parSafe: Permits :chpl:param:`RandomStream.parSafe` to be overridden for this call.  Defaults to this.parSafe.
    :type parSafe: bool

    :returns: The `n`th value in the random stream as a `real(64)`.
  */

  proc getNth(n: integral, param parSafe = this.parSafe) {
    if (n <= 0) then
      halt("RandomStream.getNth(n) called with non-positive 'n' value", n);
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    skipToNth(n, parSafe=false);
    const result = getNext(parSafe=false);
    if parSafe then
      RandomStreamPrivate_lock$;
    return result;
  }

  pragma "no doc"
  proc fillRandom(arr: [], param parSafe = this.parSafe) {
    if X.eltType != complex && X.eltType != real && X.eltType != imag then
      compilerError("RandomStream.fillRandom is only defined for real(64), imag(64), and complex(128) arrays");
    forall (x, r) in zip(X, iterate(X.domain, X.eltType, parSafe)) do
      x = r;
  }

  pragma "no doc"
  proc iterate(D: domain, type resultType=real, param parSafe = this.parSafe) {
    if resultType != complex && resultType != real && resultType != imag then
      compilerError("RandomStream.iterate is only defined for real(64), imag(64), and complex(128) result types");
    param cplxMultiplier = if resultType == complex then 2 else 1;
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    const start = RandomStreamPrivate_count;
    // NOTE: Not bothering to check to see if D.numIndices can fit into int(64)
    RandomStreamPrivate_count += cplxMultiplier * D.numIndices:int(64);
    skipToNth(RandomStreamPrivate_count, parSafe=false);
    if parSafe then
      RandomStreamPrivate_lock$;
    return RandomPrivate_iterate(resultType, D, seed, start);
  }

  pragma "no doc"
  proc writeThis(f: Writer) {
    f <~> "RandomStream(parSafe=";
    f <~> parSafe;
    f <~> ", seed = ";
    f <~> seed;
    f <~> ")";
  }

  ///////////////////////////////////////////////////////////// CLASS PRIVATE //
  //
  // It is the intent that once Chapel supports the notion of
  // 'private', everything in this class declared below this line will
  // be made private to this class.
  //

  pragma "no doc"
  var RandomStreamPrivate_lock$: sync bool;
  pragma "no doc"
  var RandomStreamPrivate_cursor: real;
  pragma "no doc"
  var RandomStreamPrivate_count: int(64);

  pragma "no doc"
  proc RandomStreamPrivate_init(seed: int(64)) {
    this.seed = seed;
    RandomStreamPrivate_cursor = seed;
    RandomStreamPrivate_count = 1;
  }
}

// CHPLDOC FIXME: Prints "inherited from object" at the bottom which
// seems out of place.

////////////////////////////////////////////////////////////// MODULE PRIVATE //
//
// It is the intent that once Chapel supports the notion of 'private',
// everything declared below this line will be made private to this
// module.
//

//
// NPB-defined constants for linear congruential generator
//
const RandomPrivate_r23   = 0.5**23,
      RandomPrivate_t23   = 2.0**23,
      RandomPrivate_r46   = 0.5**46,
      RandomPrivate_t46   = 2.0**46,
      RandomPrivate_arand = 1220703125.0; // TODO: Is arand something that a
                                          // user might want to set on a
                                          // case-by-case basis?

//
// NPB-defined randlc routine
//
pragma "no doc"
proc RandomPrivate_randlc(inout x: real, a: real = RandomPrivate_arand) {
  var t1 = RandomPrivate_r23 * a;
  const a1 = floor(t1),
    a2 = a - RandomPrivate_t23 * a1;
  t1 = RandomPrivate_r23 * x;
  const x1 = floor(t1),
    x2 = x - RandomPrivate_t23 * x1;
  t1 = a1 * x2 + a2 * x1;
  const t2 = floor(RandomPrivate_r23 * t1),
    z  = t1 - RandomPrivate_t23 * t2,
    t3 = RandomPrivate_t23 * z + a2 * x2,
    t4 = floor(RandomPrivate_r46 * t3),
    x3 = t3 - RandomPrivate_t46 * t4;
  x = x3;
  return RandomPrivate_r46 * x3;
}

// Wrapper that takes a result type (two calls for complex types)
pragma "no doc"
proc RandomPrivate_randlc(type resultType, inout x: real) {
  if resultType == complex then
    return (RandomPrivate_randlc(x), RandomPrivate_randlc(x)):complex;
  else
    return RandomPrivate_randlc(x):resultType;
}

//
// Return a value for the cursor so that the next call to randlc will
// return the same value as the nth call to randlc
//
pragma "no doc"
proc RandomPrivate_randlc_skipto(seed: int(64), in n: integral): real {
  var cursor = seed:real;
  n -= 1;
  var t = RandomPrivate_arand;
  RandomPrivate_arand;
  while (n != 0) {
    const i = n / 2;
    if (2 * i != n) then
      RandomPrivate_randlc(cursor, t);
    if i == 0 then
      break;
    else
      n = i;
    RandomPrivate_randlc(t, t);
    n = i;
  }
  return cursor;
}

//
// iterate over outer ranges in tuple of ranges
//
pragma "no doc"
iter RandomPrivate_outer(ranges, param dim: int = 1) {
  if dim + 1 == ranges.size {
    for i in ranges(dim) do
      yield (i,);
  } else if dim + 1 < ranges.size {
    for i in ranges(dim) do
      for j in RandomPrivate_outer(ranges, dim+1) do
        yield (i, (...j));
  } else {
    yield 0; // 1D case is a noop
  }
}

//
// RandomStream iterator implementation
//
pragma "no doc"
iter RandomPrivate_iterate(type resultType, D: domain, seed: int(64),
                          start: int(64)) {
  var cursor = RandomPrivate_randlc_skipto(seed, start);
  for i in D do
    yield RandomPrivate_randlc(resultType, cursor);
}

pragma "no doc"
iter RandomPrivate_iterate(type resultType, D: domain, seed: int(64),
                          start: int(64), param tag: iterKind)
      where tag == iterKind.leader {
  for block in D._value.these(tag=iterKind.leader) do
    yield block;
}

pragma "no doc"
iter RandomPrivate_iterate(type resultType, D: domain, seed: int(64),
                          start: int(64), param tag: iterKind, followThis)
      where tag == iterKind.follower {
  param multiplier = if resultType == complex then 2 else 1;
  const ZD = computeZeroBasedDomain(D);
  const innerRange = followThis(ZD.rank);
  var cursor: real;
  for outer in RandomPrivate_outer(followThis) {
    var myStart = start;
    // NOTE: Not bothering to check to see if this can fit into int(64)
    if ZD.rank > 1 then
      myStart += multiplier * ZD.indexOrder(((...outer), innerRange.low)):int(64);
    else
      myStart += multiplier * ZD.indexOrder(innerRange.low):int(64);
    if !innerRange.stridable {
      cursor = RandomPrivate_randlc_skipto(seed, myStart);
      for i in innerRange do
        yield RandomPrivate_randlc(resultType, cursor);
    } else {
      // NOTE: Not bothering to check to see if this can fit into int(64)
      myStart -= innerRange.low:int(64);
      for i in innerRange {
        cursor = RandomPrivate_randlc_skipto(seed, myStart + i:int(64) * multiplier);
        yield RandomPrivate_randlc(resultType, cursor);
      }
    }
  }
}

} // close module Random

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

/*
   Support for pseudorandom number generation

   This module defines an abstraction for a stream of pseudorandom
   numbers, :chpl:class:`RandomStream`.  It also provides a helper
   function, :chpl:proc:`fillRandom` that can be used to fill an array
   with random numbers in parallel.

   The current implementation is based on the one that is used in the
   NAS Parallel Benchmarks (NPB, available at:
   http://www.nas.nasa.gov/publications/npb.html).  The longer-term
   intention is to add knobs permitting users to select other
   pseudorandom number generation (PNRG) algorithms, such as the
   Mersenne twister.

   Paraphrasing the comments from the NPB reference implementation:

     This generator returns uniform pseudorandom real values in the
     range (0, 1) by using the linear congruential generator

       x_{k+1} = a x_k  (mod 2**46)

     where 0 < x_k < 2**46 and 0 < a < 2**46.  This scheme generates
     2**44 numbers before repeating.  The seed value must be an odd
     64-bit integer in the range (1, 2^46).  The generated values are
     normalized to be between 0 and 1, i.e., 2**(-46) * x_k.

     This generator should produce the same results on any computer
     with at least 48 mantissa bits for real(64) data.

   Here is a list of currently open issues (TODOs) for this module:

   1. We plan to support general serial and parallel iterators on the
   RandomStream class; however, providing the full suite of iterators
   is not possible with our current parallel iterator framework.
   Specifically, if :chpl:class:RandomStream: is a follower in a
   zippered iteration context, there is no way for it to update the
   total number of random numbers generated in a safe/sane/coordinated
   way.  We are exploring a revised leader-follower iterator framework
   that would support this idiom (and other cursor-based ones).

   2. This module is currently restricted to generating real(64),
   imag(64), and complex(128) complex values.  We would like to extend
   this support to include other primitive types as well.

   3. If no seed is provided by the user, one is chosen based on the
   current time in microseconds, allowing for some degree of
   pseudorandomness in seed selection.  The intent of the
   SeedGenerator record is to provide a menu of other options for
   initializing the random stream seed, but only one option is
   implemented at present.

*/
module Random {

  /* Note to developers on "private" symbols:

     It is the intent that once Chapel supports a notion of 'private'
     symbols, everything prefixed with RandomPrivate will be made
     private to this module and everything prefixed with
     'RandomStreamPrivate_' will be made private to the RandomStream
     class.
  */

// CHPLDOC BUG: No documentation created for the following

/*
   SeedGenerator is a built-in value of type
   :chpl:record:`SeedGenerators` that is designed to provide a
   convenient means of generating seeds when the user does not wish to
   specify one manually.
*/
const SeedGenerator: SeedGenerators;

/*
  SeedGenerators is a record type that is designed to provide methods
  for generating seeds when the user needs help creating one.  It
  currently only supports one, but the intention is to add more over
  time.
*/

record SeedGenerators {
  proc currentTime {
    use Time;
    const seed: int(64) = getCurrentTime(unit=TimeUnits.microseconds):int(64);
    return (if seed % 2 == 0 then seed + 1 else seed) % (1:int(64) << 46);
  }
};

/*
  fillRandom() is a convenience function that fills an array of
   real(64), imag(64), or complex(128) elements with pseudorandom
   values from a new RandomStream in parallel.  The parallelization
   strategy is determined by the array's domain map.

   :arg arr: The array to be filled, where T is real(64), imag(64), or complex(128)
   :type arr: [] T

   :arg int seed: the seed to use for the PNRG (defaults to SeedGenerator.currentTime)

*/

proc fillRandom(arr: [], seed: int(64) = SeedGenerator.currentTime)
  where (x.eltType == real || x.eltType == imag || x.eltType == complex) {
  var randNums = new RandomStream(seed, parSafe=false);
  randNums.fillRandom(arr);
  delete randNums;
}

pragma "no doc"
proc fillRandom(arr: [], seed: int(64) = SeedGenerator.currentTime) {
  compilerError("Random.fillRandom is only defined for real(64), imag(64), and complex(128) arrays");
}

class RandomStream {
  param parSafe: bool = true;
  const seed: int(64);

  proc RandomStream(seed: int(64) = SeedGenerator.currentTime,
                   param parSafe: bool = true) {
    if seed % 2 == 0 || seed < 1 || seed > 1:int(64)<<46 then
      halt("RandomStream seed must be an odd integer between 0 and 2**46");
    RandomStreamPrivate_init(seed);
  }

  proc getNext(param parSafe = this.parSafe) {
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    RandomStreamPrivate_count += 1;
    const result = RandomPrivate_randlc(RandomStreamPrivate_cursor);
    if parSafe then
      RandomStreamPrivate_lock$;
    return result;
  }

  proc skipToNth(n: integral, param parSafe = this.parSafe) {
    if n <= 0 then
      halt("RandomStream.skipToNth(n) called with non-positive 'n' value", n);
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    RandomStreamPrivate_count = n;
    RandomStreamPrivate_cursor = RandomPrivate_randlc_skipto(seed, n);
    if parSafe then
      RandomStreamPrivate_lock$;
  }

  proc getNth(n: integral, param parSafe = this.parSafe) {
    if (n <= 0) then
      halt("RandomStream.getNth(n) called with non-positive 'n' value", n);
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    skipToNth(n, parSafe=false);
    const result = getNext(parSafe=false);
    if parSafe then
      RandomStreamPrivate_lock$;
    return result;
  }

  proc fillRandom(arr: [], param parSafe = this.parSafe) {
    if X.eltType != complex && X.eltType != real && X.eltType != imag then
      compilerError("RandomStream.fillRandom is only defined for real(64), imag(64), and complex(128) arrays");
    forall (x, r) in zip(X, iterate(X.domain, X.eltType, parSafe)) do
      x = r;
  }

  proc iterate(D: domain, type resultType=real, param parSafe = this.parSafe) {
    if resultType != complex && resultType != real && resultType != imag then
      compilerError("RandomStream.iterate is only defined for real(64), imag(64), and complex(128) result types");
    param cplxMultiplier = if resultType == complex then 2 else 1;
    if parSafe then
      RandomStreamPrivate_lock$ = true;
    const start = RandomStreamPrivate_count;
    // NOTE: Not bothering to check to see if D.numIndices can fit into int(64)
    RandomStreamPrivate_count += cplxMultiplier * D.numIndices:int(64);
    skipToNth(RandomStreamPrivate_count, parSafe=false);
    if parSafe then
      RandomStreamPrivate_lock$;
    return RandomPrivate_iterate(resultType, D, seed, start);
  }

  proc writeThis(f: Writer) {
    f <~> "RandomStream(parSafe=";
    f <~> parSafe;
    f <~> ", seed = ";
    f <~> seed;
    f <~> ")";
  }

  ///////////////////////////////////////////////////////////// CLASS PRIVATE //
  //
  // It is the intent that once Chapel supports the notion of
  // 'private', everything in this class declared below this line will
  // be made private to this class.
  //

  var RandomStreamPrivate_lock$: sync bool;
  var RandomStreamPrivate_cursor: real;
  var RandomStreamPrivate_count: int(64);

  proc RandomStreamPrivate_init(seed: int(64)) {
    this.seed = seed;
    RandomStreamPrivate_cursor = seed;
    RandomStreamPrivate_count = 1;
  }
}

////////////////////////////////////////////////////////////// MODULE PRIVATE //
//
// It is the intent that once Chapel supports the notion of 'private',
// everything declared below this line will be made private to this
// module.
//

//
// NPB-defined constants for linear congruential generator
//
const RandomPrivate_r23   = 0.5**23,
      RandomPrivate_t23   = 2.0**23,
      RandomPrivate_r46   = 0.5**46,
      RandomPrivate_t46   = 2.0**46,
      RandomPrivate_arand = 1220703125.0; // TODO: Is arand something that a
                                          // user might want to set on a
                                          // case-by-case basis?

//
// NPB-defined randlc routine
//
pragma "no doc"
proc RandomPrivate_randlc(inout x: real, a: real = RandomPrivate_arand) {
  var t1 = RandomPrivate_r23 * a;
  const a1 = floor(t1),
    a2 = a - RandomPrivate_t23 * a1;
  t1 = RandomPrivate_r23 * x;
  const x1 = floor(t1),
    x2 = x - RandomPrivate_t23 * x1;
  t1 = a1 * x2 + a2 * x1;
  const t2 = floor(RandomPrivate_r23 * t1),
    z  = t1 - RandomPrivate_t23 * t2,
    t3 = RandomPrivate_t23 * z + a2 * x2,
    t4 = floor(RandomPrivate_r46 * t3),
    x3 = t3 - RandomPrivate_t46 * t4;
  x = x3;
  return RandomPrivate_r46 * x3;
}

// Wrapper that takes a result type (two calls for complex types)
pragma "no doc"
proc RandomPrivate_randlc(type resultType, inout x: real) {
  if resultType == complex then
    return (RandomPrivate_randlc(x), RandomPrivate_randlc(x)):complex;
  else
    return RandomPrivate_randlc(x):resultType;
}

//
// Return a value for the cursor so that the next call to randlc will
// return the same value as the nth call to randlc
//
pragma "no doc"
proc RandomPrivate_randlc_skipto(seed: int(64), in n: integral): real {
  var cursor = seed:real;
  n -= 1;
  var t = RandomPrivate_arand;
  RandomPrivate_arand;
  while (n != 0) {
    const i = n / 2;
    if (2 * i != n) then
      RandomPrivate_randlc(cursor, t);
    if i == 0 then
      break;
    else
      n = i;
    RandomPrivate_randlc(t, t);
    n = i;
  }
  return cursor;
}

//
// iterate over outer ranges in tuple of ranges
//
pragma "no doc"
iter RandomPrivate_outer(ranges, param dim: int = 1) {
  if dim + 1 == ranges.size {
    for i in ranges(dim) do
      yield (i,);
  } else if dim + 1 < ranges.size {
    for i in ranges(dim) do
      for j in RandomPrivate_outer(ranges, dim+1) do
        yield (i, (...j));
  } else {
    yield 0; // 1D case is a noop
  }
}

//
// RandomStream iterator implementation
//
pragma "no doc"
iter RandomPrivate_iterate(type resultType, D: domain, seed: int(64),
                          start: int(64)) {
  var cursor = RandomPrivate_randlc_skipto(seed, start);
  for i in D do
    yield RandomPrivate_randlc(resultType, cursor);
}

pragma "no doc"
iter RandomPrivate_iterate(type resultType, D: domain, seed: int(64),
                          start: int(64), param tag: iterKind)
      where tag == iterKind.leader {
  for block in D._value.these(tag=iterKind.leader) do
    yield block;
}

pragma "no doc"
iter RandomPrivate_iterate(type resultType, D: domain, seed: int(64),
                          start: int(64), param tag: iterKind, followThis)
      where tag == iterKind.follower {
  param multiplier = if resultType == complex then 2 else 1;
  const ZD = computeZeroBasedDomain(D);
  const innerRange = followThis(ZD.rank);
  var cursor: real;
  for outer in RandomPrivate_outer(followThis) {
    var myStart = start;
    // NOTE: Not bothering to check to see if this can fit into int(64)
    if ZD.rank > 1 then
      myStart += multiplier * ZD.indexOrder(((...outer), innerRange.low)):int(64);
    else
      myStart += multiplier * ZD.indexOrder(innerRange.low):int(64);
    if !innerRange.stridable {
      cursor = RandomPrivate_randlc_skipto(seed, myStart);
      for i in innerRange do
        yield RandomPrivate_randlc(resultType, cursor);
    } else {
      // NOTE: Not bothering to check to see if this can fit into int(64)
      myStart -= innerRange.low:int(64);
      for i in innerRange {
        cursor = RandomPrivate_randlc_skipto(seed, myStart + i:int(64) * multiplier);
        yield RandomPrivate_randlc(resultType, cursor);
      }
    }
  }
}

} // close module Random


Decrease input size of spectralnorm_2 in order for it to not timeout valgrind tests.

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

/*
 * The Computer Language Benchmarks Game
 * http://shootout.alioth.debian.org/
 *
 * Original C contributed by Sebastien Loisel
 * Conversion to Chapel by Albert Sidelnik
 */

use Time, MultiBlockDist;
config const timer : bool = false;
var t : Timer;
config const NUM = 500 : int(64);

/* Return: 1.0 / (i + j) * (i + j +1) / 2 + i + 1; */
def eval_A(i,j) : real
{
	/*
	 * 1.0 / (i + j) * (i + j +1) / 2 + i + 1;
	 * n * (n+1) is even number. Therefore, just (>> 1) for (/2)
	 */
	var d = (((i + j) * (i + j + 1)) >> 1) + i + 1;
	return 1.0 / d;
}

def eval_A_times_u(U : [] real, inRange, Au : [] real)
{
	forall (au,i) in (Au, [0..#inRange]) do
		au = + reduce [j in 0..#inRange] (U(j) * eval_A(i,j));

}

def eval_At_times_u(U : [] real, inRange, Au : [] real)
{
	forall (au,i) in (Au, [0..#inRange]) do
		au = + reduce [j in 0..#inRange] (U(j) * eval_A(j,i));
}

def eval_AtA_times_u(u,AtAu,v : [] real, inRange)
{
	   eval_A_times_u(u, inRange, v);
	   eval_At_times_u(v, inRange, AtAu);
}

def spectral_game(N) : real
{
	var Dist = new Block(rank=1, bbox=[0..#N], tasksPerLocale=here.numCores);
	var Dom : domain(1, int(64)) distributed Dist = [0..#N];

	var tmp, U, V : [Dom] real;

	U = 1.0;

	for 1..10 do {
		eval_AtA_times_u(U,V,tmp,N);
		eval_AtA_times_u(V,U,tmp,N);
	}

	var vv = + reduce [v in V] (v * v);
	var vBv = + reduce [(u,v) in (U,V)] (u * v);

	return sqrt(vBv/vv);
}

def main() {
	if timer then
		t.start();
	writeln(spectral_game(NUM));
	if timer then {
		t.stop();
		writeln("Time elapsed : ", t.elapsed(), " seconds");
	}
}

/*
 * The Computer Language Benchmarks Game
 * http://shootout.alioth.debian.org/
 *
 * Original C contributed by Sebastien Loisel
 * Conversion to Chapel by Albert Sidelnik
 */

use Time, MultiBlockDist;
config const timer : bool = false;
var t : Timer;
config const NUM = 2000 : int(64);

/* Return: 1.0 / (i + j) * (i + j +1) / 2 + i + 1; */
def eval_A(i,j) : real
{
	/*
	 * 1.0 / (i + j) * (i + j +1) / 2 + i + 1;
	 * n * (n+1) is even number. Therefore, just (>> 1) for (/2)
	 */
	var d = (((i + j) * (i + j + 1)) >> 1) + i + 1;
	return 1.0 / d;
}

def eval_A_times_u(U : [] real, inRange, Au : [] real)
{
	forall (au,i) in (Au, [0..#inRange]) do
		au = + reduce [j in 0..#inRange] (U(j) * eval_A(i,j));

}

def eval_At_times_u(U : [] real, inRange, Au : [] real)
{
	forall (au,i) in (Au, [0..#inRange]) do
		au = + reduce [j in 0..#inRange] (U(j) * eval_A(j,i));
}

def eval_AtA_times_u(u,AtAu,v : [] real, inRange)
{
	   eval_A_times_u(u, inRange, v);
	   eval_At_times_u(v, inRange, AtAu);
}

def spectral_game(N) : real
{
	var Dist = new Block(rank=1, bbox=[0..#N], tasksPerLocale=here.numCores);
	var Dom : domain(1, int(64)) distributed Dist = [0..#N];

	var tmp, U, V : [Dom] real;

	U = 1.0;

	for 1..10 do {
		eval_AtA_times_u(U,V,tmp,N);
		eval_AtA_times_u(V,U,tmp,N);
	}

	var vv = + reduce [v in V] (v * v);
	var vBv = + reduce [(u,v) in (U,V)] (u * v);

	return sqrt(vBv/vv);
}

def main() {
	if timer then
		t.start();
	writeln(spectral_game(NUM));
	if timer then {
		t.stop();
		writeln("Time elapsed : ", t.elapsed(), " seconds");
	}
}


Fix bug with indefinite domains:

Fix bug with indefinite domains:

  the _idomain._double() function was making the "inds" member
  always a _ddata of integers, which resulted in mixed primitives type
  errors.

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

var _ps : _ddata(integer) = _ddata(integer, 27);
_ps.init();

_ps(0) = 23;
_ps(1) = 53;
_ps(2) = 97;
_ps(3) = 193;
_ps(4) = 389;
_ps(5) = 769;
_ps(6) = 1543;
_ps(7) = 3079;
_ps(8) = 6151;
_ps(9) = 12289;
_ps(10) = 24593;
_ps(11) = 49157;
_ps(12) = 98317;
_ps(13) = 196613;
_ps(14) = 393241;
_ps(15) = 786433;
_ps(16) = 1572869;
_ps(17) = 3145739;
_ps(18) = 6291469;
_ps(19) = 12582917;
_ps(20) = 25165843;
_ps(21) = 50331653;
_ps(22) = 100663319;
_ps(23) = 201326611;
_ps(24) = 402653189;
_ps(25) = 805306457;
_ps(26) = 1610612741;

class _idomain : _domain {
  type ind_type;
  var num_inds : integer;
  var size : integer = 0;
  var table : _ddata(integer) = _ddata(integer, _ps(size));
  var inds : _ddata(ind_type) = _ddata(ind_type, _ps(size)/2);

  function initialize() {
    table.init();
    inds.init();
  }

  iterator _forall() : ind_type {
    forall i in 0..num_inds-1 do
      yield inds(i);
  }

  function _double() {
    size += 1;
    var inds_copy = _ddata(ind_type, _ps(size)/2);
    inds_copy.init();
    for i in 0.._ps(size-1)/2-1 do
      inds_copy(i) = inds(i);
    inds = inds_copy;

    table = _ddata(integer, _ps(size));
    table.init();
    for i in 0.._ps(size-1)-1 do
      table(_map(inds(i))) = i+1;
  }

  function _map(ind : ind_type) : integer {
    var probe = 0;
    while true {
      var i = (_indefinite_hash(ind) + probe**2) mod _ps(size);
      if table(i) == 0 then
        return i;
      if inds(table(i)-1) == ind then
        return i;
      probe += 1;
    }
    return -1;
  }

  function _get_index(ind : ind_type)
    return table(_map(ind)) - 1;

  function add(ind : ind_type) {
    if (table(_map(ind)) == 0) {
      num_inds += 1;
      if num_inds == _ps(size)/2 then
        _double();
      table(_map(ind)) = num_inds;
      inds(num_inds-1) = ind;

    }
  }

  function _build_array(type elt_type)
    return _iarray(elt_type, ind_type, dom=this);
}

class _iarray : value {
  type elt_type;
  type ind_type;
  var dom : _idomain(ind_type);
  var data : _ddata(elt_type) = _ddata(elt_type, 128);

  function initialize() {
    data.init();
  }

  function this(ind : ind_type) var : elt_type
    return data(dom._get_index(ind));
}

function fwrite(f : file, x : _idomain) {
  fwrite(f, "[", x.inds(0));
  for i in 1..x.num_inds-1 do
    fwrite(f, ", ", x.inds(i));
  fwrite(f, "]");
}

function fwrite(f : file, x : _iarray) {
  fwrite(f, x.data(0));
  for i in 1..x.dom.num_inds-1 do
    fwrite(f, " ", x.data(i));
}

function _indefinite_hash(x : integer)
  return x;

function _indefinite_hash(x : string)
  return 1;

var _ps : _ddata(integer) = _ddata(integer, 27);
_ps.init();

_ps(0) = 23;
_ps(1) = 53;
_ps(2) = 97;
_ps(3) = 193;
_ps(4) = 389;
_ps(5) = 769;
_ps(6) = 1543;
_ps(7) = 3079;
_ps(8) = 6151;
_ps(9) = 12289;
_ps(10) = 24593;
_ps(11) = 49157;
_ps(12) = 98317;
_ps(13) = 196613;
_ps(14) = 393241;
_ps(15) = 786433;
_ps(16) = 1572869;
_ps(17) = 3145739;
_ps(18) = 6291469;
_ps(19) = 12582917;
_ps(20) = 25165843;
_ps(21) = 50331653;
_ps(22) = 100663319;
_ps(23) = 201326611;
_ps(24) = 402653189;
_ps(25) = 805306457;
_ps(26) = 1610612741;

class _idomain : _domain {
  type ind_type;
  var num_inds : integer;
  var size : integer = 0;
  var table : _ddata(integer) = _ddata(integer, _ps(size));
  var inds : _ddata(ind_type) = _ddata(ind_type, _ps(size)/2);

  function initialize() {
    table.init();
    inds.init();
  }

  iterator _forall() : ind_type {
    forall i in 0..num_inds-1 do
      yield inds(i);
  }

  function _double() {
    size += 1;
    var inds_copy = _ddata(integer, _ps(size)/2);
    inds_copy.init();
    for i in 0.._ps(size-1)/2-1 do
      inds_copy(i) = inds(i);
    inds = inds_copy;

    table = _ddata(integer, _ps(size));
    table.init();
    for i in 0.._ps(size-1)-1 do
      table(_map(inds(i))) = i+1;
  }

  function _map(ind : ind_type) : integer {
    var probe = 0;
    while true {
      var i = (_indefinite_hash(ind) + probe**2) mod _ps(size);
      if table(i) == 0 then
        return i;
      if inds(table(i)-1) == ind then
        return i;
      probe += 1;
    }
    return -1;
  }

  function _get_index(ind : ind_type)
    return table(_map(ind)) - 1;

  function add(ind : ind_type) {
    if (table(_map(ind)) == 0) {
      num_inds += 1;
      if num_inds == _ps(size)/2 then
        _double();
      table(_map(ind)) = num_inds;
      inds(num_inds-1) = ind;

    }
  }

  function _build_array(type elt_type)
    return _iarray(elt_type, ind_type, dom=this);
}

class _iarray : value {
  type elt_type;
  type ind_type;
  var dom : _idomain(ind_type);
  var data : _ddata(elt_type) = _ddata(elt_type, 128);

  function initialize() {
    data.init();
  }

  function this(ind : ind_type) var : elt_type
    return data(dom._get_index(ind));
}

function fwrite(f : file, x : _idomain) {
  fwrite(f, "[", x.inds(0));
  for i in 1..x.num_inds-1 do
    fwrite(f, ", ", x.inds(i));
  fwrite(f, "]");
}

function fwrite(f : file, x : _iarray) {
  fwrite(f, x.data(0));
  for i in 1..x.dom.num_inds-1 do
    fwrite(f, " ", x.data(i));
}

function _indefinite_hash(x : integer)
  return x;

function _indefinite_hash(x : string)
  return 1;


remove unnecessary cast for histoSerial

remove unnecessary cast for histoSerial

config var numIterations = 1;
config const printTimers = 0;

proc main(args: [] string) {
  use Time;
  var inputFilename: string;
  var outputFilename: string;
  var inputTime, outputTime, computeTime, totalTime: Timer;
  if args.numElements == 4 {
    inputFilename = args[1];
    outputFilename = args[2];
    numIterations = args[3]:int;
  } else {
    writeln("num args: ", args.numElements);
    writeln(args);
    halt("Expected 4 args: a.out infile, outfile, numIterations");
  }

  var imgWidth, imgHeight, histoWidth, histoHeight: uint(32);
  totalTime.start();
  inputTime.start();
  var f = open(inputFilename, iomode.r);
  var r = f.reader(kind=ionative);

  r.read(imgWidth);
  r.read(imgHeight);
  r.read(histoWidth);
  r.read(histoHeight);

  var img: [0..#imgWidth*imgHeight] uint(32);
  var histo: [0..#histoWidth*histoHeight] uint(8);

  r.read(img);
  r.close();
  f.close();
  inputTime.stop();

  computeTime.start();
  for it in 0..#numIterations {
    histo = 0;
    const maxUint8 = max(uint(8));
    for val in img {
      if histo[val] < maxUint8 then histo[val] += 1;
    }
  }
  computeTime.stop();

  outputTime.start();
  dumpHisto(histo, histoHeight, histoWidth, outputFilename);
  outputTime.stop();
  totalTime.stop();
  if printTimers >= 3 {
    writeln("IO: ", inputTime.elapsed() + outputTime.elapsed());
    writeln(" -Input: ", inputTime.elapsed());
    writeln(" -Output: ", outputTime.elapsed());
  }
  if printTimers >= 2 then writeln("Compute: ", computeTime.elapsed());
  if printTimers >= 1 then writeln("Timer Wall Time: ", totalTime.elapsed());
}

record RGB {
  var B, G, R: uint(8);
}

proc HSVtoRGB(h: real, s: real, v: real) {
  var value: RGB;

  if s == 0 {
    return value;
  }

  var hh = h / 60;
  var i:int = floor(hh):int;
  var f = hh - i;
  var p = v*(1-s);
  var q = v*(1-s*f);
  var t = v*(1-s*(1-f));
  var r,g,b: real;
  select i {
    when 0 { r = v; g = t; b = p; }
    when 1 { r = q; g = v; b = p; }
    when 2 { r = p; g = v; b = t; }
    when 3 { r = p; g = q; b = v; }
    when 4 { r = t; g = p; b = v; }
    otherwise { r = v; g = p; b = q; }
  }
  value.R = (r*255):uint(8);
  value.G = (g*255):uint(8);
  value.B = (b*255):uint(8);

  return value;
}

proc dumpHisto(histo: [] uint(8), height: uint(32), width: uint(32), outFilename: string) {
  var pixMap: [0..#height*width] RGB;
  for y in 0..#height {
    for x in 0..#width {
      const pos = y*width + x;
      var value = histo[pos];
      if value == 0 then
        (pixMap[pos].R, pixMap[pos].G, pixMap[pos].B) = (0:uint(8),0:uint(8),0:uint(8));
      else
        pixMap[pos] = HSVtoRGB(0.0, 1.0, cbrt(1+63.0*value/max(uint(8)))/4);
    }
  }
  createBMP(pixMap, height, width, outFilename);
}

record bmpFileHeader {
  var filesz: uint(32);
  var creator1: uint(16);
  var creator2: uint(16);
  var bmpOffset: uint(32);
}

record bmpDibHeader {
  var headerSz: uint(32);
  var width: uint(32);
  var height: uint(32);
  var nplanes: uint(16);
  var bitspp: uint(16);
  var compressType: uint(32);
  var bmpByteSz: uint(32);
  var hres: uint(32);
  var vres: uint(32);
  var ncolors: uint(32);
  var nimpcolors: uint(32);
}

record bmpImage {
  var magic: 2*uint(8);
  var fileHeader: bmpFileHeader;
  var dibHeader: bmpDibHeader;
}

extern proc sizeof(type T): uint(32);

proc createBMP(bitmap:[] RGB, height: uint(32), width: uint(32), filename: string) {
  var image: bmpImage;
  var paddedWidth = 4*(((width*24)+31)/32) - width*sizeof(RGB);
  var pad: [0..#paddedWidth] uint(8);

  image.magic(1) = ascii('B');
  image.magic(2) = ascii('M');

  image.fileHeader.filesz = 2 + sizeof(bmpFileHeader) + sizeof(bmpDibHeader) + height*width*sizeof(RGB);
  image.fileHeader.creator1 = 0;
  image.fileHeader.creator2 = 0;
  image.fileHeader.bmpOffset = 2 + sizeof(bmpFileHeader) + sizeof(bmpDibHeader);

  image.dibHeader.headerSz = sizeof(bmpDibHeader);
  image.dibHeader.width = width;
  image.dibHeader.height = height;
  image.dibHeader.nplanes = 1;
  image.dibHeader.bitspp = 24;
  image.dibHeader.compressType = 0;
  image.dibHeader.bmpByteSz = width*height*sizeof(RGB);
  image.dibHeader.hres = 0;
  image.dibHeader.vres = 0;
  image.dibHeader.ncolors = 0;
  image.dibHeader.nimpcolors = 0;

  var f = open(filename, iomode.cw);
  var w = f.writer(kind=ionative);

  w.write(image.magic(1));
  w.write(image.magic(2));
  w.write(image.fileHeader);
  w.write(image.dibHeader);

  for h in 0..(height-1):int by -1 {
    w.write(bitmap[h*width..#width]);
    w.write(pad);
  }

  w.close();
  f.close();
}

config var numIterations = 1;
config const printTimers = 0;

proc main(args: [] string) {
  use Time;
  var inputFilename: string;
  var outputFilename: string;
  var inputTime, outputTime, computeTime, totalTime: Timer;
  if args.numElements == 4 {
    inputFilename = args[1];
    outputFilename = args[2];
    numIterations = args[3]:int;
  } else {
    writeln("num args: ", args.numElements);
    writeln(args);
    halt("Expected 4 args: a.out infile, outfile, numIterations");
  }

  var imgWidth, imgHeight, histoWidth, histoHeight: uint(32);
  totalTime.start();
  inputTime.start();
  var f = open(inputFilename, iomode.r);
  var r = f.reader(kind=ionative);

  r.read(imgWidth);
  r.read(imgHeight);
  r.read(histoWidth);
  r.read(histoHeight);

  var img: [0..#imgWidth*imgHeight] uint(32);
  var histo: [0..#histoWidth*histoHeight] uint(8);

  r.read(img);
  r.close();
  f.close();
  inputTime.stop();

  computeTime.start();
  for it in 0..#numIterations {
    histo = 0;
    const maxUint8 = max(uint(8));
    for val in img {
      if histo[val] < maxUint8 then histo[val] += 1;
    }
  }
  computeTime.stop();

  outputTime.start();
  dumpHisto(histo, histoHeight, histoWidth, outputFilename);
  outputTime.stop();
  totalTime.stop();
  if printTimers >= 3 {
    writeln("IO: ", inputTime.elapsed() + outputTime.elapsed());
    writeln(" -Input: ", inputTime.elapsed());
    writeln(" -Output: ", outputTime.elapsed());
  }
  if printTimers >= 2 then writeln("Compute: ", computeTime.elapsed());
  if printTimers >= 1 then writeln("Timer Wall Time: ", totalTime.elapsed());
}

record RGB {
  var B, G, R: uint(8);
}

proc HSVtoRGB(h: real, s: real, v: real) {
  var value: RGB;

  if s == 0 {
    return value;
  }

  var hh = h / 60;
  var i:int = floor(hh):int;
  var f = hh - i;
  var p = v*(1-s);
  var q = v*(1-s*f);
  var t = v*(1-s*(1-f));
  var r,g,b: real;
  select i {
    when 0 { r = v; g = t; b = p; }
    when 1 { r = q; g = v; b = p; }
    when 2 { r = p; g = v; b = t; }
    when 3 { r = p; g = q; b = v; }
    when 4 { r = t; g = p; b = v; }
    otherwise { r = v; g = p; b = q; }
  }
  value.R = (r*255):uint(8);
  value.G = (g*255):uint(8);
  value.B = (b*255):uint(8);

  return value;
}

proc dumpHisto(histo: [] uint(8), height: uint(32), width: uint(32), outFilename: string) {
  var pixMap: [0..#height*width] RGB;
  for y in 0..#height {
    for x in 0..#width {
      const pos = y*width + x;
      var value = histo[pos];
      if value == 0 then
        (pixMap[pos].R, pixMap[pos].G, pixMap[pos].B) = (0:uint(8),0:uint(8),0:uint(8));
      else
        pixMap[pos] = HSVtoRGB(0.0, 1.0, cbrt(1+63.0*value/max(uint(8)))/4);
    }
  }
  createBMP(pixMap, height, width, outFilename);
}

record bmpFileHeader {
  var filesz: uint(32);
  var creator1: uint(16);
  var creator2: uint(16);
  var bmpOffset: uint(32);
}

record bmpDibHeader {
  var headerSz: uint(32);
  var width: uint(32);
  var height: uint(32);
  var nplanes: uint(16);
  var bitspp: uint(16);
  var compressType: uint(32);
  var bmpByteSz: uint(32);
  var hres: uint(32);
  var vres: uint(32);
  var ncolors: uint(32);
  var nimpcolors: uint(32);
}

record bmpImage {
  var magic: 2*uint(8);
  var fileHeader: bmpFileHeader;
  var dibHeader: bmpDibHeader;
}

extern proc sizeof(type T): uint(32);

proc createBMP(bitmap:[] RGB, height: uint(32), width: uint(32), filename: string) {
  var image: bmpImage;
  var paddedWidth = 4*(((width*24)+31)/32) - width*sizeof(RGB);
  var pad: [0..#paddedWidth] uint(8);

  image.magic(1) = ascii('B');
  image.magic(2) = ascii('M');

  image.fileHeader.filesz = 2 + sizeof(bmpFileHeader) + sizeof(bmpDibHeader) + height*width*sizeof(RGB);
  image.fileHeader.creator1 = 0;
  image.fileHeader.creator2 = 0;
  image.fileHeader.bmpOffset = 2 + sizeof(bmpFileHeader) + sizeof(bmpDibHeader);

  image.dibHeader.headerSz = sizeof(bmpDibHeader);
  image.dibHeader.width = width;
  image.dibHeader.height = height;
  image.dibHeader.nplanes = 1;
  image.dibHeader.bitspp = 24;
  image.dibHeader.compressType = 0;
  image.dibHeader.bmpByteSz = width*height*sizeof(RGB);
  image.dibHeader.hres = 0;
  image.dibHeader.vres = 0;
  image.dibHeader.ncolors = 0;
  image.dibHeader.nimpcolors = 0;

  var f = open(filename, iomode.cw);
  var w = f.writer(kind=ionative);

  w.write(image.magic(1));
  w.write(image.magic(2));
  w.write(image.fileHeader);
  w.write(image.dibHeader);

  for h in 0:int..(height-1):int by -1 {
    w.write(bitmap[h*width..#width]);
    w.write(pad);
  }

  w.close();
  f.close();
}


removed new keyword that does not belong in future

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

class NilClass { }

def Nil(): NilClass
  return nil;

def isNil(x): bool {
  if x.type == NilClass then
    return true;
  else
    return false;
}

def car(x: (?T1, ?T2)) var: T1 {
  return x(1);
}

def cdr(x: (?T1, ?T2)) var: T2 {
  return x(2);
}

def cons(x: ?T1, y: ?T2): (T1, T2) {
  return (x, y);
}

if isNil(cdr(cons(5, Nil()))) then
  writeln("isNil() test1 ok");
if !isNil(cdr(cons(Nil(), 5))) then
  writeln("isNil() test2 ok");
if !isNil(nil) then
  writeln("isNil() test3 ok");

var x = cons("Hello", " ");
var y = cons("World", "!");

writeln(car(x), cdr(x), car(y), cdr(y));

writeln(x, y);

writeln(cons("Hello", cons("World!", Nil())));

class NilClass { }

def Nil(): NilClass
  return nil;

def isNil(x): bool {
  if x.type == new NilClass then
    return true;
  else
    return false;
}

def car(x: (?T1, ?T2)) var: T1 {
  return x(1);
}

def cdr(x: (?T1, ?T2)) var: T2 {
  return x(2);
}

def cons(x: ?T1, y: ?T2): (T1, T2) {
  return (x, y);
}

if isNil(cdr(cons(5, Nil()))) then
  writeln("isNil() test1 ok");
if !isNil(cdr(cons(Nil(), 5))) then
  writeln("isNil() test2 ok");
if !isNil(nil) then
  writeln("isNil() test3 ok");

var x = cons("Hello", " ");
var y = cons("World", "!");

writeln(car(x), cdr(x), car(y), cdr(y));

writeln(x, y);

writeln(cons("Hello", cons("World!", Nil())));


Fixed problem with HPL driver routine by creating copy of the matrix A so that the
original, not factored matrix, is used when computing the residual error.

This version is now running correctly.

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

use Init;
use FactorSolve;

config var inputfile = "HPL.dat";

def main() {
  var paramList = HPLparams(inFileName="HPL.dat");

  for n in paramList.N {
    for nb in paramList.NB {
       var ADom = [1..n, 1..n];
       var xDom = [1..n];
       var piv: [1..n] int;
       var A: [ADom] real;
       var x: [xDom] real;
       var b: [xDom] real;
       var errNorm: real;

       init(A,b);
       var LU = A;
       rightBlockLU(LU, nb, piv);
       LUSolve(LU, x, b, piv);
       testSolution(A, x, b, errNorm);
       writeln("Solving system of size n = ", n);
       writeln("Blocksize = ", nb);
       writeln("Computed residual error = ", errNorm);
    }
  }
}

def testSolution(A: [?ADom], x: [?xDom], b: [xDom], out errNorm) {

  var bHat: [xDom] real;

  for (i1, i2) in (ADom.dim(1), xDom) {
    for (j1, j2) in (ADom.dim(2), xDom) {
       bHat(i1) += A(i1,j1)*x(j2);
    }
  }
  errNorm = max reduce (abs(bHat - b));
}

use Init;
use FactorSolve;

config var inputfile = "HPL.dat";

def main() {
  var paramList = HPLparams(inFileName="HPL.dat");

  for n in paramList.N {
    for nb in paramList.NB {
       var ADom = [1..n, 1..n];
       var xDom = [1..n];
       var piv: [1..n] int;
       var A: [ADom] real;
       var x: [xDom] real;
       var b: [xDom] real;
       init(A,b);
       rightBlockLU(A, nb, piv);
       x = 1;
       LUSolve(A, x, b, piv);
       writeln("x = ", x);
       testSolution(A, x, b, paramList.Thresh);
    }
  }
}

def testSolution(A: [?ADom], x: [?xDom], b: [xDom], thresh) {

  var bHat: [xDom] real;

  for (i1, i2) in (ADom.dim(1), xDom) {
    for (j1, j2) in (ADom.dim(2), xDom) {
       bHat(i1) += A(i1,j1)*x(j2);
    }
  }

  writeln('A*x = ', bHat);
  writeln('b = ', b);
  var errNorm = max reduce (abs(bHat - b));

  writeln("Computed residual error = ", errNorm);

}