Don't clear EOF errors in Reader/Writer

Don't clear EOF errors in Reader/Writer

Since the first QIO commits, a Reader or Writer was
set up to clear EOF errors. That seems to be a bug,
since it prevents code like this:
 var rec:MyRecord;
 while(read(rec)) { ... }

because the read always returns true.

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

// ChapelIO.chpl
//
module ChapelIO {
  use ChapelBase; // for uint().
  use SysBasic;
  // use IO; happens below once we need it.

  proc _isNilObject(val) {
    proc helper(o: object) return o == nil;
    proc helper(o)         return false;
    return helper(val);
  }

  class Writer {
    proc writing param return true;
    // if it's binary, we don't decorate class/record fields and values
    proc binary():bool { return false; }
    // get other style elements
    proc styleElement(element:int):int { return 0; }

    proc error():syserr { return ENOERR; }
    proc setError(e:syserr) { }
    proc clearError() { }
    proc writePrimitive(x) {
      //compilerError("Generic Writer.writePrimitive called");
      halt("Generic Writer.writePrimitive called");
    }
    proc writeBytes(x, len:ssize_t) {
      halt("Generic Writer.writeBytes called");
    }
    proc writeIt(x:?t) {
      if _isIoPrimitiveTypeOrNewline(t) {
        writePrimitive(x);
      } else {
        if isClassType(t) || chpl_isDdata(t) {
          // FUTURE -- write the class name/ID?

          if x == nil {
            var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
            var iolit:ioLiteral;
            if st == QIO_AGGREGATE_FORMAT_JSON {
              iolit = new ioLiteral("null", !binary());
            } else {
              iolit = new ioLiteral("nil", !binary());
            }
            writePrimitive(iolit);
            return;
          }
        }

        x.writeThis(this);
      }
    }
    proc readwrite(x) {
      writeIt(x);
    }
    proc write(args ...?k) {
      for param i in 1..k {
        writeIt(args(i));
      }
    }
    proc writeln(args ...?k) {
      for param i in 1..k {
        writeIt(args(i));
      }
      var nl = new ioNewline();
      writeIt(nl);
    }
    proc writeln() {
      var nl = new ioNewline();
      writeIt(nl);
    }
    proc writeThisFieldsDefaultImpl(x:?t, inout first:bool) {
      param num_fields = __primitive("num fields", t);
      var isBinary = binary();

      if (isClassType(t)) {
        if t != object {
          // only write parent fields for subclasses of object
          // since object has no .super field.
          writeThisFieldsDefaultImpl(x.super, first);
        }
      }

      if !isUnionType(t) {
        // print out all fields for classes and records
        for param i in 1..num_fields {
          if !isBinary {
            var comma = new ioLiteral(", ");
            if !first then write(comma);

            var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
            var eq:ioLiteral;
            if st == QIO_AGGREGATE_FORMAT_JSON {
              eq = new ioLiteral(__primitive("field num to name", t, i) + " : ");
            } else {
              eq = new ioLiteral(__primitive("field num to name", t, i) + " = ");
            }
            write(eq);
          }

          write(__primitive("field value by num", x, i));

          first = false;
        }
      } else {
        // Handle unions.
        // print out just the set field for a union.
        var id = __primitive("get_union_id", x);
        for param i in 1..num_fields {
          if __primitive("field id by num", t, i) == id {
            if isBinary {
              // store the union ID
              write(id);
            } else {
              var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
              var eq:ioLiteral;
              if st == QIO_AGGREGATE_FORMAT_JSON {
                eq = new ioLiteral(__primitive("field num to name", t, i) + " : ");
              } else {
                eq = new ioLiteral(__primitive("field num to name", t, i) + " = ");
              }
              write(eq);
            }
            write(__primitive("field value by num", x, i));
          }
        }
      }
    }
    // Note; this is not a multi-method and so must be called
    // with the appropriate *concrete* type of x; that's what
    // happens now with buildDefaultWriteFunction
    // since it has the concrete type and then calls this method.

    // MPF: We would like to entirely write the default writeThis
    // method in Chapel, but that seems to be a bit of a challenge
    // right now and I'm having trouble with scoping/modules.
    // So I'll go back to writeThis being generated by the
    // compiler.... the writeThis generated by the compiler
    // calls writeThisDefaultImpl.
    proc writeThisDefaultImpl(x:?t) {
      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var start:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_JSON {
          start = new ioLiteral("{");
        } else if st == QIO_AGGREGATE_FORMAT_CHPL {
          start = new ioLiteral("new " + typeToString(t) + "(");
        } else {
          // the default 'braces' type
          if isClassType(t) {
            start = new ioLiteral("{");
          } else {
            start = new ioLiteral("(");
          }
        }
        write(start);
      }

      var first = true;

      writeThisFieldsDefaultImpl(x, first);

      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var end:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_JSON {
          end = new ioLiteral("}");
        } else if st == QIO_AGGREGATE_FORMAT_CHPL {
          end = new ioLiteral(")");
        } else {
          if isClassType(t) {
            end = new ioLiteral("}");
          } else {
            end = new ioLiteral(")");
          }
        }
        write(end);
      }
    }
  }

  class Reader {
    proc writing param return false;
    // if it's binary, we don't decorate class/record fields and values
    proc binary():bool { return false; }
    // get other style elements
    proc styleElement(element:int):int { return 0; }

    proc error():syserr { return ENOERR; }
    proc setError(e:syserr) { }
    proc clearError() { }

    proc readPrimitive(ref x:?t) where _isIoPrimitiveTypeOrNewline(t) {
      //compilerError("Generic Reader.readPrimitive called");
      halt("Generic Reader.readPrimitive called");
    }
    proc readBytes(x, len:ssize_t) {
      halt("Generic Reader.readBytes called");
    }
    proc readIt(x:?t) where isClassType(t) {
      // FUTURE -- write the class name/ID? or nil?
      // possibly in a different 'Reader'
      /*
      var iolit = new ioLiteral("nil", !binary());
      readPrimitive(iolit);
      if !(error()) {
        // Return nil.
        delete x;
        x = nil;
        return;
      } else {
        clearError();
      }*/
      x.readThis(this);
    }
    proc readIt(ref x:?t) where !isClassType(t) {
      if _isIoPrimitiveTypeOrNewline(t) {
        readPrimitive(x);
      } else {
        x.readThis(this);
      }
    }
    proc readwrite(ref x) {
      readIt(x);
    }
    proc read(ref args ...?k):bool {
      for param i in 1..k {
        readIt(args(i));
      }

      if error() {
        return false;
      } else {
        return true;
      }
    }
    proc readln(ref args ...?k):bool {
      for param i in 1..k {
        readIt(args(i));
      }
      var nl = new ioNewline();
      readIt(nl);
      if error() {
        return false;
      } else {
        return true;
      }
    }
    proc readln():bool {
      var nl = new ioNewline();
      readIt(nl);
      if error()  {
        return false;
      } else {
        return true;
      }
    }
    proc readThisFieldsDefaultImpl(type t, ref x, inout first:bool) {
      param num_fields = __primitive("num fields", t);
      var isBinary = binary();

      //writeln("Scanning fields for ", typeToString(t));

      if (isClassType(t)) {
        if t != object {
          // only write parent fields for subclasses of object
          // since object has no .super field.
          readThisFieldsDefaultImpl(x.super.type, x, first);
        }
      }

      if !isUnionType(t) {
        // read all fields for classes and records

        for param i in 1..num_fields {
          if !isBinary {
            var comma = new ioLiteral(",", true);
            if !first then readIt(comma);

            var fname = new ioLiteral(__primitive("field num to name", t, i), true);
            readIt(fname);

            var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
            var eq:ioLiteral;
            if st == QIO_AGGREGATE_FORMAT_JSON {
              eq = new ioLiteral(":", true);
            } else {
              eq = new ioLiteral("=", true);
            }
            readIt(eq);
          }

          readIt(__primitive("field value by num", x, i));

          first = false;
        }
      } else {
        // Handle unions.
        if isBinary {
          var id = __primitive("get_union_id", x);
          // Read the ID
          readIt(id);
          for param i in 1..num_fields {
            if __primitive("field id by num", t, i) == id {
              readIt(__primitive("field value by num", x, i));
            }
          }
        } else {
          // Read the field name = part until we get one that worked.
          for param i in 1..num_fields {
            var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
            var eq:ioLiteral;
            if st == QIO_AGGREGATE_FORMAT_JSON {
              eq = new ioLiteral(__primitive("field num to name", t, i) + " : ");
            } else {
              eq = new ioLiteral(__primitive("field num to name", t, i) + " = ");
            }

            readIt(eq);
            if error() == EFORMAT {
              clearError();
            } else {
              // We read the 'name = ', so now read the value!
              readIt(__primitive("field value by num", x, i));
            }
          }
        }
      }
    }
    // Note; this is not a multi-method and so must be called
    // with the appropriate *concrete* type of x; that's what
    // happens now with buildDefaultWriteFunction
    // since it has the concrete type and then calls this method.
    proc readThisDefaultImpl(x:?t) where isClassType(t) {
      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var start:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_CHPL {
          start = new ioLiteral("new " + typeToString(t) + "(");
        } else {
          // json and braces type
          start = new ioLiteral("{");
        }
        readIt(start);
      }

      var first = true;

      var obj = x; // make obj point to x so ref works
      readThisFieldsDefaultImpl(t, obj, first);

      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var end:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_CHPL {
          end = new ioLiteral(")");
        } else {
          // json and braces type
          end = new ioLiteral("}");
        }
        readIt(end);
      }
    }
    proc readThisDefaultImpl(ref x:?t) where !isClassType(t){
      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var start:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_CHPL {
          start = new ioLiteral("new " + typeToString(t) + "(");
        } else if st == QIO_AGGREGATE_FORMAT_JSON {
          start = new ioLiteral("{");
        } else {
          start = new ioLiteral("(");
        }
        readIt(start);
      }

      var first = true;

      readThisFieldsDefaultImpl(t, x, first);

      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var end:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_JSON {
          end = new ioLiteral("}");
        } else {
          end = new ioLiteral(")");
        }
        readIt(end);
      }
    }
  }

  inline proc <~>(w: Writer, x):Writer {
    w.readwrite(x);
    return w;
  }
  inline proc <~>(r: Reader, ref x):Reader {
    r.readwrite(x);
    return r;
  }

  use IO;

  // these are overridden to not be inout
  // since they don't change when read anyway
  // and it's much more convenient to be able to do e.g.
  //   reader & new ioLiteral("=")
  inline proc <~>(r: Reader, lit:ioLiteral):Reader {
    var litCopy = lit;
    r.readwrite(litCopy);
    return r;
  }
  inline proc <~>(r: Reader, nl:ioNewline):Reader {
    var nlCopy = nl;
    r.readwrite(nlCopy);
    return r;
  }

  inline proc Reader.readWriteLiteral(lit:string, ignoreWhiteSpace=true)
  {
    /***
    var iolit = new ioLiteral(lit.c_str(), ignoreWhiteSpace);
    this.readwrite(iolit);
    ***/
    this.readWriteLiteral(lit.c_str(), ignoreWhiteSpace);
  }
  inline proc Reader.readWriteLiteral(lit:c_string, ignoreWhiteSpace=true)
  {
    var iolit = new ioLiteral(lit, ignoreWhiteSpace);
    this.readwrite(iolit);
  }
  inline proc Writer.readWriteLiteral(lit:string, ignoreWhiteSpace=true)
  {
    /***
    var iolit = new ioLiteral(lit.c_str(), ignoreWhiteSpace);
    this.readwrite(iolit);
    ***/
    this.readWriteLiteral(lit.c_str(), ignoreWhiteSpace);
  }
  inline proc Writer.readWriteLiteral(lit:c_string, ignoreWhiteSpace=true)
  {
    var iolit = new ioLiteral(lit, ignoreWhiteSpace);
    this.readwrite(iolit);
  }
  inline proc Reader.readWriteNewline()
  {
    var ionl = new ioNewline();
    this.readwrite(ionl);
  }
  inline proc Writer.readWriteNewline()
  {
    var ionl = new ioNewline();
    this.readwrite(ionl);
  }

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

  proc halt(s:string) {
    halt(s.c_str());
  }

  proc halt(s:c_string) {
    __primitive("chpl_error", "halt reached - " + s);
  }

  proc halt(args ...?numArgs) {
    var tmpstring: c_string;
    tmpstring.write((...args));
    __primitive("chpl_error", "halt reached - " + tmpstring);
  }

  proc warning(s:string) {
    warning(s.c_str());
  }

  proc warning(s:c_string) {
    __primitive("chpl_warning", s);
  }

  proc warning(args ...?numArgs) {
    var tmpstring: c_string_copy;
    tmpstring.write((...args));
    warning(tmpstring);
    chpl_free_c_string_copy(tmpstring);
  }

  proc _ddata.writeThis(f: Writer) {
    compilerWarning("printing _ddata class");
    f.write("<_ddata class cannot be printed>");
  }

  proc chpl_taskID_t.writeThis(f: Writer) {
    var tmp : uint(64) = this : uint(64);
    f.write(tmp);
  }
  proc chpl_taskID_t.readThis(f: Reader) {
    var tmp : uint(64);
    f.read(tmp);
    this = tmp : chpl_taskID_t;
  }

  class StringWriter: Writer {
    var s: c_string_copy; // Should be initialized to NULL.
    proc StringWriter(x:c_string) {
      this.s = __primitive("string_copy", x);
    }
    proc writePrimitive(x) {
      // TODO: Implement += so it consumes a c_string_copy LHS.
      var aug = x:c_string_copy;
      this.s += aug;      // The update frees this.s before overwriting it.
      chpl_free_c_string_copy(aug);
    }
    proc ~StringWriter() {
      chpl_free_c_string_copy(this.s);
      __primitive("=", this.s, _nullString);
    }
  }

  // Convert 'x' to a string just the way it would be written out.
  // Includes Writer.write, with modifications (for simplicity; to avoid 'on').
  proc _cast(type t, x) where t == c_string_copy {
    //proc isNilObject(o: object) return o == nil;
    //proc isNilObject(o) param return false;
    const w = new StringWriter();
    //if isNilObject(x) then "nil".writeThis(w);
    //else                   x.writeThis(w);
    w.write(x);
    const result = w.s;
    __primitive("=", w.s, _nullString);
    delete w;
    return result;
  }

  pragma "dont disable remote value forwarding"
  proc ref c_string.write(args ...?n) {
    var sc = new StringWriter(this);
    sc.write((...args));
    // We need to copy this string because the destructor call below frees it
    this = sc.s;
    // This is required to prevent double-deletion.
    __primitive("=", sc.s, _nullString);
    delete sc;
  }

  pragma "dont disable remote value forwarding"
  proc ref string.write(args ...?n) {
    var sc = new StringWriter(this.c_str());
    sc.write((...args));
    this = toString(sc.s);
    // This is required to prevent double-deletion.
    __primitive("=", sc.s, _nullString);
    delete sc;
  }

  proc _getoutputformat(s: c_string):c_string {
    var sn = s.length;
    var afterdot = false;
    var dplaces = 0;
    for i in 1..sn {
      var ss = s.substring(i);
      if ((ss == '#') & afterdot) then dplaces += 1;
      if (ss == '.') then afterdot=true;
      chpl_free_c_string_copy(ss);
    }
    // FIX ME: leak c_string due to concatenation
    return("%" + sn + "." + dplaces + "f");
  }

  //
  // When this flag is used during compilation, calls to chpl__testPar
  // will output a message to indicate that a portion of the code has been
  // parallelized.
  //

  config param chpl__testParFlag = false;
  var chpl__testParOn = false;

  proc chpl__testParStart() {
    chpl__testParOn = true;
  }

  proc chpl__testParStop() {
    chpl__testParOn = false;
  }

  proc chpl__testPar(args...) {
    if chpl__testParFlag && chpl__testParOn {
      const file : c_string = __primitive("_get_user_file");
      const line = __primitive("_get_user_line");
      writeln("CHPL TEST PAR (", file, ":", line, "): ", (...args));
    }
  }

}

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

// ChapelIO.chpl
//
module ChapelIO {
  use ChapelBase; // for uint().
  use SysBasic;
  // use IO; happens below once we need it.

  proc _isNilObject(val) {
    proc helper(o: object) return o == nil;
    proc helper(o)         return false;
    return helper(val);
  }

  class Writer {
    proc writing param return true;
    // if it's binary, we don't decorate class/record fields and values
    proc binary():bool { return false; }
    // get other style elements
    proc styleElement(element:int):int { return 0; }

    proc error():syserr { return ENOERR; }
    proc setError(e:syserr) { }
    proc clearError() { }
    proc writePrimitive(x) {
      //compilerError("Generic Writer.writePrimitive called");
      halt("Generic Writer.writePrimitive called");
    }
    proc writeBytes(x, len:ssize_t) {
      halt("Generic Writer.writeBytes called");
    }
    proc writeIt(x:?t) {
      if _isIoPrimitiveTypeOrNewline(t) {
        writePrimitive(x);
      } else {
        if isClassType(t) || chpl_isDdata(t) {
          // FUTURE -- write the class name/ID?

          if x == nil {
            var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
            var iolit:ioLiteral;
            if st == QIO_AGGREGATE_FORMAT_JSON {
              iolit = new ioLiteral("null", !binary());
            } else {
              iolit = new ioLiteral("nil", !binary());
            }
            writePrimitive(iolit);
            return;
          }
        }

        x.writeThis(this);
      }
    }
    proc readwrite(x) {
      writeIt(x);
    }
    proc write(args ...?k) {
      for param i in 1..k {
        writeIt(args(i));
      }
    }
    proc writeln(args ...?k) {
      for param i in 1..k {
        writeIt(args(i));
      }
      var nl = new ioNewline();
      writeIt(nl);
    }
    proc writeln() {
      var nl = new ioNewline();
      writeIt(nl);
    }
    proc writeThisFieldsDefaultImpl(x:?t, inout first:bool) {
      param num_fields = __primitive("num fields", t);
      var isBinary = binary();

      if (isClassType(t)) {
        if t != object {
          // only write parent fields for subclasses of object
          // since object has no .super field.
          writeThisFieldsDefaultImpl(x.super, first);
        }
      }

      if !isUnionType(t) {
        // print out all fields for classes and records
        for param i in 1..num_fields {
          if !isBinary {
            var comma = new ioLiteral(", ");
            if !first then write(comma);

            var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
            var eq:ioLiteral;
            if st == QIO_AGGREGATE_FORMAT_JSON {
              eq = new ioLiteral(__primitive("field num to name", t, i) + " : ");
            } else {
              eq = new ioLiteral(__primitive("field num to name", t, i) + " = ");
            }
            write(eq);
          }

          write(__primitive("field value by num", x, i));

          first = false;
        }
      } else {
        // Handle unions.
        // print out just the set field for a union.
        var id = __primitive("get_union_id", x);
        for param i in 1..num_fields {
          if __primitive("field id by num", t, i) == id {
            if isBinary {
              // store the union ID
              write(id);
            } else {
              var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
              var eq:ioLiteral;
              if st == QIO_AGGREGATE_FORMAT_JSON {
                eq = new ioLiteral(__primitive("field num to name", t, i) + " : ");
              } else {
                eq = new ioLiteral(__primitive("field num to name", t, i) + " = ");
              }
              write(eq);
            }
            write(__primitive("field value by num", x, i));
          }
        }
      }
    }
    // Note; this is not a multi-method and so must be called
    // with the appropriate *concrete* type of x; that's what
    // happens now with buildDefaultWriteFunction
    // since it has the concrete type and then calls this method.

    // MPF: We would like to entirely write the default writeThis
    // method in Chapel, but that seems to be a bit of a challenge
    // right now and I'm having trouble with scoping/modules.
    // So I'll go back to writeThis being generated by the
    // compiler.... the writeThis generated by the compiler
    // calls writeThisDefaultImpl.
    proc writeThisDefaultImpl(x:?t) {
      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var start:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_JSON {
          start = new ioLiteral("{");
        } else if st == QIO_AGGREGATE_FORMAT_CHPL {
          start = new ioLiteral("new " + typeToString(t) + "(");
        } else {
          // the default 'braces' type
          if isClassType(t) {
            start = new ioLiteral("{");
          } else {
            start = new ioLiteral("(");
          }
        }
        write(start);
      }

      var first = true;

      writeThisFieldsDefaultImpl(x, first);

      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var end:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_JSON {
          end = new ioLiteral("}");
        } else if st == QIO_AGGREGATE_FORMAT_CHPL {
          end = new ioLiteral(")");
        } else {
          if isClassType(t) {
            end = new ioLiteral("}");
          } else {
            end = new ioLiteral(")");
          }
        }
        write(end);
      }
    }
  }

  class Reader {
    proc writing param return false;
    // if it's binary, we don't decorate class/record fields and values
    proc binary():bool { return false; }
    // get other style elements
    proc styleElement(element:int):int { return 0; }

    proc error():syserr { return ENOERR; }
    proc setError(e:syserr) { }
    proc clearError() { }

    proc readPrimitive(ref x:?t) where _isIoPrimitiveTypeOrNewline(t) {
      //compilerError("Generic Reader.readPrimitive called");
      halt("Generic Reader.readPrimitive called");
    }
    proc readBytes(x, len:ssize_t) {
      halt("Generic Reader.readBytes called");
    }
    proc readIt(x:?t) where isClassType(t) {
      // FUTURE -- write the class name/ID? or nil?
      // possibly in a different 'Reader'
      /*
      var iolit = new ioLiteral("nil", !binary());
      readPrimitive(iolit);
      if !(error()) {
        // Return nil.
        delete x;
        x = nil;
        return;
      } else {
        clearError();
      }*/
      x.readThis(this);
    }
    proc readIt(ref x:?t) where !isClassType(t) {
      if _isIoPrimitiveTypeOrNewline(t) {
        readPrimitive(x);
      } else {
        x.readThis(this);
      }
    }
    proc readwrite(ref x) {
      readIt(x);
    }
    proc read(ref args ...?k):bool {
      for param i in 1..k {
        readIt(args(i));
      }

      if error() == EEOF {
        clearError();
        return false;
      } else {
        return true;
      }
    }
    proc readln(ref args ...?k):bool {
      for param i in 1..k {
        readIt(args(i));
      }
      var nl = new ioNewline();
      readIt(nl);
      if error() == EEOF {
        clearError();
        return false;
      } else {
        return true;
      }
    }
    proc readln():bool {
      var nl = new ioNewline();
      readIt(nl);
      if error() == EEOF {
        clearError();
        return false;
      } else {
        return true;
      }
    }
    proc readThisFieldsDefaultImpl(type t, ref x, inout first:bool) {
      param num_fields = __primitive("num fields", t);
      var isBinary = binary();

      //writeln("Scanning fields for ", typeToString(t));

      if (isClassType(t)) {
        if t != object {
          // only write parent fields for subclasses of object
          // since object has no .super field.
          readThisFieldsDefaultImpl(x.super.type, x, first);
        }
      }

      if !isUnionType(t) {
        // read all fields for classes and records

        for param i in 1..num_fields {
          if !isBinary {
            var comma = new ioLiteral(",", true);
            if !first then readIt(comma);

            var fname = new ioLiteral(__primitive("field num to name", t, i), true);
            readIt(fname);

            var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
            var eq:ioLiteral;
            if st == QIO_AGGREGATE_FORMAT_JSON {
              eq = new ioLiteral(":", true);
            } else {
              eq = new ioLiteral("=", true);
            }
            readIt(eq);
          }

          readIt(__primitive("field value by num", x, i));

          first = false;
        }
      } else {
        // Handle unions.
        if isBinary {
          var id = __primitive("get_union_id", x);
          // Read the ID
          readIt(id);
          for param i in 1..num_fields {
            if __primitive("field id by num", t, i) == id {
              readIt(__primitive("field value by num", x, i));
            }
          }
        } else {
          // Read the field name = part until we get one that worked.
          for param i in 1..num_fields {
            var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
            var eq:ioLiteral;
            if st == QIO_AGGREGATE_FORMAT_JSON {
              eq = new ioLiteral(__primitive("field num to name", t, i) + " : ");
            } else {
              eq = new ioLiteral(__primitive("field num to name", t, i) + " = ");
            }

            readIt(eq);
            if error() == EFORMAT {
              clearError();
            } else {
              // We read the 'name = ', so now read the value!
              readIt(__primitive("field value by num", x, i));
            }
          }
        }
      }
    }
    // Note; this is not a multi-method and so must be called
    // with the appropriate *concrete* type of x; that's what
    // happens now with buildDefaultWriteFunction
    // since it has the concrete type and then calls this method.
    proc readThisDefaultImpl(x:?t) where isClassType(t) {
      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var start:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_CHPL {
          start = new ioLiteral("new " + typeToString(t) + "(");
        } else {
          // json and braces type
          start = new ioLiteral("{");
        }
        readIt(start);
      }

      var first = true;

      var obj = x; // make obj point to x so ref works
      readThisFieldsDefaultImpl(t, obj, first);

      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var end:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_CHPL {
          end = new ioLiteral(")");
        } else {
          // json and braces type
          end = new ioLiteral("}");
        }
        readIt(end);
      }
    }
    proc readThisDefaultImpl(ref x:?t) where !isClassType(t){
      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var start:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_CHPL {
          start = new ioLiteral("new " + typeToString(t) + "(");
        } else if st == QIO_AGGREGATE_FORMAT_JSON {
          start = new ioLiteral("{");
        } else {
          start = new ioLiteral("(");
        }
        readIt(start);
      }

      var first = true;

      readThisFieldsDefaultImpl(t, x, first);

      if !binary() {
        var st = styleElement(QIO_STYLE_ELEMENT_AGGREGATE);
        var end:ioLiteral;
        if st == QIO_AGGREGATE_FORMAT_JSON {
          end = new ioLiteral("}");
        } else {
          end = new ioLiteral(")");
        }
        readIt(end);
      }
    }
  }

  inline proc <~>(w: Writer, x):Writer {
    w.readwrite(x);
    return w;
  }
  inline proc <~>(r: Reader, ref x):Reader {
    r.readwrite(x);
    return r;
  }

  use IO;

  // these are overridden to not be inout
  // since they don't change when read anyway
  // and it's much more convenient to be able to do e.g.
  //   reader & new ioLiteral("=")
  inline proc <~>(r: Reader, lit:ioLiteral):Reader {
    var litCopy = lit;
    r.readwrite(litCopy);
    return r;
  }
  inline proc <~>(r: Reader, nl:ioNewline):Reader {
    var nlCopy = nl;
    r.readwrite(nlCopy);
    return r;
  }

  inline proc Reader.readWriteLiteral(lit:string, ignoreWhiteSpace=true)
  {
    /***
    var iolit = new ioLiteral(lit.c_str(), ignoreWhiteSpace);
    this.readwrite(iolit);
    ***/
    this.readWriteLiteral(lit.c_str(), ignoreWhiteSpace);
  }
  inline proc Reader.readWriteLiteral(lit:c_string, ignoreWhiteSpace=true)
  {
    var iolit = new ioLiteral(lit, ignoreWhiteSpace);
    this.readwrite(iolit);
  }
  inline proc Writer.readWriteLiteral(lit:string, ignoreWhiteSpace=true)
  {
    /***
    var iolit = new ioLiteral(lit.c_str(), ignoreWhiteSpace);
    this.readwrite(iolit);
    ***/
    this.readWriteLiteral(lit.c_str(), ignoreWhiteSpace);
  }
  inline proc Writer.readWriteLiteral(lit:c_string, ignoreWhiteSpace=true)
  {
    var iolit = new ioLiteral(lit, ignoreWhiteSpace);
    this.readwrite(iolit);
  }
  inline proc Reader.readWriteNewline()
  {
    var ionl = new ioNewline();
    this.readwrite(ionl);
  }
  inline proc Writer.readWriteNewline()
  {
    var ionl = new ioNewline();
    this.readwrite(ionl);
  }

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

  proc halt(s:string) {
    halt(s.c_str());
  }

  proc halt(s:c_string) {
    __primitive("chpl_error", "halt reached - " + s);
  }

  proc halt(args ...?numArgs) {
    var tmpstring: c_string;
    tmpstring.write((...args));
    __primitive("chpl_error", "halt reached - " + tmpstring);
  }

  proc warning(s:string) {
    warning(s.c_str());
  }

  proc warning(s:c_string) {
    __primitive("chpl_warning", s);
  }

  proc warning(args ...?numArgs) {
    var tmpstring: c_string_copy;
    tmpstring.write((...args));
    warning(tmpstring);
    chpl_free_c_string_copy(tmpstring);
  }

  proc _ddata.writeThis(f: Writer) {
    compilerWarning("printing _ddata class");
    f.write("<_ddata class cannot be printed>");
  }

  proc chpl_taskID_t.writeThis(f: Writer) {
    var tmp : uint(64) = this : uint(64);
    f.write(tmp);
  }
  proc chpl_taskID_t.readThis(f: Reader) {
    var tmp : uint(64);
    f.read(tmp);
    this = tmp : chpl_taskID_t;
  }

  class StringWriter: Writer {
    var s: c_string_copy; // Should be initialized to NULL.
    proc StringWriter(x:c_string) {
      this.s = __primitive("string_copy", x);
    }
    proc writePrimitive(x) {
      // TODO: Implement += so it consumes a c_string_copy LHS.
      var aug = x:c_string_copy;
      this.s += aug;      // The update frees this.s before overwriting it.
      chpl_free_c_string_copy(aug);
    }
    proc ~StringWriter() {
      chpl_free_c_string_copy(this.s);
      __primitive("=", this.s, _nullString);
    }
  }

  // Convert 'x' to a string just the way it would be written out.
  // Includes Writer.write, with modifications (for simplicity; to avoid 'on').
  proc _cast(type t, x) where t == c_string_copy {
    //proc isNilObject(o: object) return o == nil;
    //proc isNilObject(o) param return false;
    const w = new StringWriter();
    //if isNilObject(x) then "nil".writeThis(w);
    //else                   x.writeThis(w);
    w.write(x);
    const result = w.s;
    __primitive("=", w.s, _nullString);
    delete w;
    return result;
  }

  pragma "dont disable remote value forwarding"
  proc ref c_string.write(args ...?n) {
    var sc = new StringWriter(this);
    sc.write((...args));
    // We need to copy this string because the destructor call below frees it
    this = sc.s;
    // This is required to prevent double-deletion.
    __primitive("=", sc.s, _nullString);
    delete sc;
  }

  pragma "dont disable remote value forwarding"
  proc ref string.write(args ...?n) {
    var sc = new StringWriter(this.c_str());
    sc.write((...args));
    this = toString(sc.s);
    // This is required to prevent double-deletion.
    __primitive("=", sc.s, _nullString);
    delete sc;
  }

  proc _getoutputformat(s: c_string):c_string {
    var sn = s.length;
    var afterdot = false;
    var dplaces = 0;
    for i in 1..sn {
      var ss = s.substring(i);
      if ((ss == '#') & afterdot) then dplaces += 1;
      if (ss == '.') then afterdot=true;
      chpl_free_c_string_copy(ss);
    }
    // FIX ME: leak c_string due to concatenation
    return("%" + sn + "." + dplaces + "f");
  }

  //
  // When this flag is used during compilation, calls to chpl__testPar
  // will output a message to indicate that a portion of the code has been
  // parallelized.
  //

  config param chpl__testParFlag = false;
  var chpl__testParOn = false;

  proc chpl__testParStart() {
    chpl__testParOn = true;
  }

  proc chpl__testParStop() {
    chpl__testParOn = false;
  }

  proc chpl__testPar(args...) {
    if chpl__testParFlag && chpl__testParOn {
      const file : c_string = __primitive("_get_user_file");
      const line = __primitive("_get_user_line");
      writeln("CHPL TEST PAR (", file, ":", line, "): ", (...args));
    }
  }

}


Stopping point for today.

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

// BLC: For certain inputs, not having a complex/real
// function can result in numerical instability.

// BLC: clean up complex arithmetic

// BLC: insert problem size computation based on memory size?

use Random;
use Time;

// problem size configs
config const logN = 5;

// pseudo-random input configs
config const deterministic = false,
             seed = 314159265.0,
             arand = 1220703125.0;

// verification configs
config const epsilon = 2.0 ** -51.0,
             threshold = 16.0;

// boolean configs
config const printTiming = true;

// BLC: control printing out of error value to avoid portability issues

def main() {
  // compute problem size
  const N = 1 << logN;

  // twiddle domain and arrays
  const TwiddleDom = [0..N/4);
  var Twiddles: [TwiddleDom] complex;

  computeTwiddles(Twiddles);
  Twiddles = bitReverseShuffle(Twiddles);

  // problem domain and arrays
  const ProblemDom = [0..N);
  var Z, z: [ProblemDom] complex;

  // generate pseudo-random input
  if deterministic then
    fillRandom(z, seed=seed, arand=arand);
  else
    fillRandom(z);

  // conjugate input, storing result to work array
  Z = conjg(z);

  // TIMED SECTION
  var startTime = getCurrentTime();

  Z = bitReverseShuffle(Z);
  dfft(Z, Twiddles);

  var execTime = getCurrentTime() - startTime;

  verifyResults(z, Z, execTime, Twiddles);
}

def computeTwiddles(W) {
  const n = W.numElements;
  const delta = 2.0 * atan(1.0) / n;

  W(0) = 1.0;
  W(n/2) = let cosDeltaN = cos(delta * n/2)
            in (cosDeltaN, cosDeltaN):complex;
  forall i in [1..n/2) {
    const x = cos(delta*i);
    const y = sin(delta*i);
    W(i)     = (x, y):complex;
    W(n - i) = (y, x):complex;
  }
}

// Check what the NSA supports for bit reversal
// rename this?
def bitReverseShuffle(W: [?WD]) {
  const n = WD.numIndices;
  const reverse = lg(n);
  var V: [WD] W.elt_type;  // BLC: rename this field?
  /* BLC: could we do this as a permutation instead?
  var P: [i in WD] index(WD) = i;
  bitReverse(P);
  V(P) = W;
  */
  forall i in WD {  // BLC: could this be a uint domain?
    // BLC: what does this bitReverse function do with high-order bits?
    // BLC: could this be rewritten as one line?
    var ndx = bitReverse(i:uint(64), numBits=reverse);
    V(ndx:int) = W(i); // BLC: unfortunate cast
  }
  // BLC: W = V would be preferable
  return V;
}

def dfft(A: [?AD] complex, W) {

  cft1st(A, W);

  var l = 4;
  var lasti = 2;
  for i in 4..logN/2 by 2 {
    cftmd1(l, A, W);
    l *= 4;
    lasti = i;
  }
  //  writeln("lasti+2 = ", lasti+2, " logN-1 = ", logN-1);
  for i in [lasti+2..logN) by 2 {
    cftmd2(l, A, W);
    l *= 4;
  }

  const n = AD(1).length;
  if ((l << 2) == n) {
    forall j in [0..l) {
      butterfly(1.0, 1.0, 1.0, A[j..j+3*l by l]);
    }
  } else {
    forall j in [0..l) {
      var a = A(j);
      var b = A(j+l);
      A(j) = a + b;
      A(j+l) = a - b;
    }
  }
}

def verifyResults(z, Z, execTime, Twiddles) {
  const N = Z.numElements;

  // BLC: This line wants /(complex,real) to be implemented directly:
  Z = conjg(Z) / N;

  Z = bitReverseShuffle(Z);
  dfft(Z, Twiddles);

  // BLC: need to check this against written spec
  var maxerr = max reduce sqrt((z.real - Z.real)**2 + (z.imag - Z.imag)**2);

  maxerr = maxerr / logN / epsilon;

  write(if (maxerr < threshold) then "SUCCESS" else "FAILURE");
  writeln(", error = ", maxerr);
  writeln();
  writeln("N      = ", N);
  if (printTiming) {
    writeln("Time   = ", execTime);
    const gflop = 5.0 * N * logN / 1000000000.0;
    writeln("GFlops = ", gflop / execTime);
  }
}

def cft1st(A, W) {
  const n = A.domain(1).length;
  var x0 = A(0) + A(1);
  var x1 = A(0) - A(1);
  var x2 = A(2) + A(3);
  var x3 = A(2) - A(3);

  const wk1r = W(1).real;

  A(0) = x0 + x2;
  A(2) = x0 - x2;
  A(1) = (x1.real - x3.imag, x1.imag + x3.real):complex;
  A(3) = (x1.real + x3.imag, x1.imag - x3.real):complex;

  x0 = A(4) + A(5);
  x1 = A(4) - A(5);
  x2 = A(6) + A(7);
  x3 = A(6) - A(7);
  A(4) = x0 + x2;
  A(6) = (x2.imag - x0.imag, x0.real - x2.real):complex;
  x0 = (x1.real - x3.imag, x1.imag + x3.real):complex;
  A(5) = wk1r * (x0.real - x0.imag, x0.real + x0.imag):complex;
  x0 = (x3.imag + x1.real, x3.real - x1.imag):complex;
  A(7) = wk1r * (x0.imag - x0.real, x0.imag + x0.real):complex;

  var k1 = 1;
  forall j in [8..n) by 8 {
    var wk2 = W(k1);
    var wk1 = W(2*k1);
    var wk3 = (wk1.real - 2* wk2.imag * wk1.imag,
               2 * wk2.imag * wk1.real - wk1.imag):complex;

    butterfly(wk1, wk2, wk3, A[j..j+3]);

    //    writeln("accessing: ", 2*k1+1);
    wk1 = W(2*k1+1);
    wk3 = (wk1.real - 2*wk2.real * wk1.imag,
           2*wk2.real * wk1.real - wk1.imag):complex;
    wk2 = (-wk2.imag, wk2.real): complex;
    butterfly(wk1, wk2, wk3, A[j+4..j+7]);

    k1 += 1;
  }
}

def cftmd0(l, A, W) {
  var wk1r = W(1).real;
  const m = l << 2;

  forall j in [0..l) {
    butterfly(1.0, 1.0, 1.0, A[j..j+3*l by l]);
  }

  forall j in [m..m+l) {
    butterfly((wk1r, wk1r):complex, 1.0i, (-wk1r, wk1r):complex,
              A[j..j+3*l by l]);
  }
}

def cftmd1(l, A, W) {
  const m = l << 2;
  const m2 = 2*m;
  const n = A.domain(1).length;

  cftmd0(l, A, W);
  var k1 = 1;
  forall k in [m2..n) by m2 {
    var wk2 = W[k1];
    var wk1 = W[2*k1];
    var wk3 = (wk1.real - 2 * wk2.imag * wk1.imag,
               2 * wk2.imag * wk1.real - wk1.imag):complex;
    for j in [k..k+l) {
      butterfly(wk1, wk2, wk3, A[j..j+3*l by l]);
    }

    wk1 = W[2*k1+1];
    wk3 = (wk1.real - 2 * wk2.real * wk1.imag,
           2 * wk2.real * wk1.real - wk1.imag):complex;

    for j in [k+m..k+m+l) {
      butterfly(wk1, (-wk2.imag, wk2.real):complex, wk3, A[j..j+3*l by l]);
    }

    k1 += 1;
  }
}

def cftmd2(l, A, W) {
  var m = l << 2;
  var m2 = 2*m;
  const n = A.domain(1).length;

  cftmd0(l, A, W);
  if (m2 >= n) return;
  if (m2 >= n / 8) {
    cftmd21(l, A, W);
    return;
  }

  forall j in [0..l) {
    var k1 = 1;  // BLC: zip this in
    forall k in [m2..n) by m2 {
      var wk2 = W[k1];
      var wk1 = W[k1 + k1];
      var wk3 = (wk1.real - 2*wk2.imag * wk1.imag,
                 2 * wk2.imag * wk1.real - wk1.imag): complex;
      butterfly(wk1, wk2, wk3, A[j+k..j+k+3*l by l]);

      k1 += 1;
    }

    k1 = 1;  // BLC: zip this in
    forall k in [m2..n) by m2 {
      var wk2 = W[k1];
      var wk1 = W[2*k1 + 1];
      var wk3 = (wk1.real - 2*wk2.real * wk1.imag,
                 2*wk2.real * wk1.real - wk1.imag): complex;
      wk2 = (-wk2.imag, wk2.real): complex;

      butterfly(wk1, wk2, wk3, A[j+k+m..j+k+m+3*l by l]);

      k1 += 1;
    }
  }
}

def cftmd21(l, A, W) {
  const n = A.domain(1).length;
  var m = l << 2;
  var m2 = 2*m;
  var m3 = 3*m;

  var k1 = 1;
  for k in [m2..n) by m2 {
    var wk2 = W[k1];
    var wk1 = W[2*k1];
    var wk3 = (wk1.real - 2*wk2.imag * wk1.imag,
               2* wk2.imag * wk1.real - wk1.imag): complex;

    forall j in [k..k+l) {
      butterfly(wk1, wk2, wk3, A[j..j+3*l by l]);
    }

    wk1 = W[2*k1 + 1];
    wk3 = (wk1.real - 2*wk2.real * wk1.imag,
           2*wk2.real * wk1.real - wk1.imag): complex;
    wk2 = (-wk2.imag, wk2.real): complex;

    forall j in [k+m..k+m+l) {
      butterfly(wk1, wk2, wk3, A[j..j+3*l by l]);
    }

    k1 += 1;
  }
}

def butterfly(wk1: complex, wk2: complex, wk3: complex,
              inout A:[1..4] complex) {
  var x0 = A[1] + A[2];
  var x1 = A[1] - A[2];
  var x2 = A[3] + A[4];
  var x3 = A[3] - A[4];

  A[1] = x0 + x2;
  x0 -= x2;
  A[3] = wk2 * x0;
  x0 = (x1.real - x3.imag, x1.imag + x3.real):complex;
  A[2] = wk1 * x0;
  x0 = (x1.real + x3.imag, x1.imag - x3.real):complex;
  A[4] = wk3 * x0;
}

// BLC: For certain inputs, not having a complex/real
// function can result in numerical instability.

// BLC: clean up complex arithmetic

// BLC: insert problem size computation based on memory size?

use Random;
use Time;

config const logN = 5;

config const printTiming = true;

config const epsilon = 2.0 ** -51.0,
             threshold = 16.0;

def main() {
  // compute problem size
  const N = 1 << logN;

  // twiddle domain and arrays
  const TwiddleDom = [0..N/4);
  var Twiddles: [TwiddleDom] complex;

  computeTwiddles(Twiddles);
  Twiddles = bitReverseShuffle(Twiddles);

  // problem domain and arrays
  const ProblemDom = [0..N);
  var Z, z: [ProblemDom] complex;

  fillRandomVec(z);            // fill input with pseudo-random values

  Z = conjg(z);                // conjugate input, copying to working array

  // TIMED SECTION
  var startTime = getCurrentTime();

  Z = bitReverseShuffle(Z);
  dfft(Z, Twiddles);

  var execTime = getCurrentTime() - startTime;

  // BLC: This line wants /(complex,real) to be implemented correctly:
  Z = conjg(Z) / N;

  Z = bitReverseShuffle(Z);
  dfft(Z, Twiddles);

  // BLC: need to check this against written spec
  var maxerr = max reduce sqrt((z.real - Z.real)**2 + (z.imag - Z.imag)**2);

  maxerr = maxerr / logN / epsilon;

  var status = if (maxerr < threshold) then "SUCCESS" else "FAILURE";
  writeln(status, ", error = ", maxerr);
  writeln("\n");

  writeln("N      = ", N);
  if (printTiming) {
    writeln("Time   = ", execTime);
    const gflop = 5.0 * N * logN / 1000000000.0;
    writeln("GFlops = ", gflop / execTime);
  }
}

def computeTwiddles(W: [?WD] complex) {
  const n = WD(1).length;
  const delta = 2.0 * atan(1.0) / n;

  W(0) = 1.0;
  W(n/2) = let cosDeltaN = cos(delta * n/2)
            in (cosDeltaN, cosDeltaN):complex;
  forall i in [1..n/2) {
    const x = cos(delta*i);
    const y = sin(delta*i);
    W(i)     = (x, y):complex;
    W(n - i) = (y, x):complex;
  }
}

// Check what the NSA supports for bit reversal
// rename this?
def bitReverseShuffle(W: [?WD] complex) {  // BLC: would be nice to drop complex?
  const n = WD(1).length;
  const reverse = lg(n);
  var V: [WD] complex;
  /* BLC: could we do this as a permutation instead?
  var P: [i in WD] index(WD) = i;
  bitReverse(P);
  V(P) = W;
  */
  forall i in WD {  // BLC: could this be a uint domain?
    // BLC: what does this bitReverse function do with high-order bits?
    // BLC: could this be rewritten as one line?
    var ndx = bitReverse(i:uint(64), numBits=reverse);
    V(ndx:int) = W(i); // BLC: unfortunate cast
  }
  // BLC: W = V would be preferable
  return V;
}

def dfft(A: [?AD] complex, W) {

  cft1st(A, W);

  var l = 4;
  var lasti = 2;
  for i in 4..logN/2 by 2 {
    cftmd1(l, A, W);
    l *= 4;
    lasti = i;
  }
  //  writeln("lasti+2 = ", lasti+2, " logN-1 = ", logN-1);
  for i in [lasti+2..logN) by 2 {
    cftmd2(l, A, W);
    l *= 4;
  }

  const n = AD(1).length;
  if ((l << 2) == n) {
    forall j in [0..l) {
      butterfly(1.0, 1.0, 1.0, A[j..j+3*l by l]);
    }
  } else {
    forall j in [0..l) {
      var a = A(j);
      var b = A(j+l);
      A(j) = a + b;
      A(j+l) = a - b;
    }
  }
}

def cft1st(A, W) {
  const n = A.domain(1).length;
  var x0 = A(0) + A(1);
  var x1 = A(0) - A(1);
  var x2 = A(2) + A(3);
  var x3 = A(2) - A(3);

  const wk1r = W(1).real;

  A(0) = x0 + x2;
  A(2) = x0 - x2;
  A(1) = (x1.real - x3.imag, x1.imag + x3.real):complex;
  A(3) = (x1.real + x3.imag, x1.imag - x3.real):complex;

  x0 = A(4) + A(5);
  x1 = A(4) - A(5);
  x2 = A(6) + A(7);
  x3 = A(6) - A(7);
  A(4) = x0 + x2;
  A(6) = (x2.imag - x0.imag, x0.real - x2.real):complex;
  x0 = (x1.real - x3.imag, x1.imag + x3.real):complex;
  A(5) = wk1r * (x0.real - x0.imag, x0.real + x0.imag):complex;
  x0 = (x3.imag + x1.real, x3.real - x1.imag):complex;
  A(7) = wk1r * (x0.imag - x0.real, x0.imag + x0.real):complex;

  var k1 = 1;
  forall j in [8..n) by 8 {
    var wk2 = W(k1);
    var wk1 = W(2*k1);
    var wk3 = (wk1.real - 2* wk2.imag * wk1.imag,
               2 * wk2.imag * wk1.real - wk1.imag):complex;

    butterfly(wk1, wk2, wk3, A[j..j+3]);

    //    writeln("accessing: ", 2*k1+1);
    wk1 = W(2*k1+1);
    wk3 = (wk1.real - 2*wk2.real * wk1.imag,
           2*wk2.real * wk1.real - wk1.imag):complex;
    wk2 = (-wk2.imag, wk2.real): complex;
    butterfly(wk1, wk2, wk3, A[j+4..j+7]);

    k1 += 1;
  }
}

def cftmd0(l, A, W) {
  var wk1r = W(1).real;
  const m = l << 2;

  forall j in [0..l) {
    butterfly(1.0, 1.0, 1.0, A[j..j+3*l by l]);
  }

  forall j in [m..m+l) {
    butterfly((wk1r, wk1r):complex, 1.0i, (-wk1r, wk1r):complex,
              A[j..j+3*l by l]);
  }
}

def cftmd1(l, A, W) {
  const m = l << 2;
  const m2 = 2*m;
  const n = A.domain(1).length;

  cftmd0(l, A, W);
  var k1 = 1;
  forall k in [m2..n) by m2 {
    var wk2 = W[k1];
    var wk1 = W[2*k1];
    var wk3 = (wk1.real - 2 * wk2.imag * wk1.imag,
               2 * wk2.imag * wk1.real - wk1.imag):complex;
    for j in [k..k+l) {
      butterfly(wk1, wk2, wk3, A[j..j+3*l by l]);
    }

    wk1 = W[2*k1+1];
    wk3 = (wk1.real - 2 * wk2.real * wk1.imag,
           2 * wk2.real * wk1.real - wk1.imag):complex;

    for j in [k+m..k+m+l) {
      butterfly(wk1, (-wk2.imag, wk2.real):complex, wk3, A[j..j+3*l by l]);
    }

    k1 += 1;
  }
}

def cftmd2(l, A, W) {
  var m = l << 2;
  var m2 = 2*m;
  const n = A.domain(1).length;

  cftmd0(l, A, W);
  if (m2 >= n) return;
  if (m2 >= n / 8) {
    cftmd21(l, A, W);
    return;
  }

  forall j in [0..l) {
    var k1 = 1;  // BLC: zip this in
    forall k in [m2..n) by m2 {
      var wk2 = W[k1];
      var wk1 = W[k1 + k1];
      var wk3 = (wk1.real - 2*wk2.imag * wk1.imag,
                 2 * wk2.imag * wk1.real - wk1.imag): complex;
      butterfly(wk1, wk2, wk3, A[j+k..j+k+3*l by l]);

      k1 += 1;
    }

    k1 = 1;  // BLC: zip this in
    forall k in [m2..n) by m2 {
      var wk2 = W[k1];
      var wk1 = W[2*k1 + 1];
      var wk3 = (wk1.real - 2*wk2.real * wk1.imag,
                 2*wk2.real * wk1.real - wk1.imag): complex;
      wk2 = (-wk2.imag, wk2.real): complex;

      butterfly(wk1, wk2, wk3, A[j+k+m..j+k+m+3*l by l]);

      k1 += 1;
    }
  }
}

def cftmd21(l, A, W) {
  const n = A.domain(1).length;
  var m = l << 2;
  var m2 = 2*m;
  var m3 = 3*m;

  var k1 = 1;
  for k in [m2..n) by m2 {
    var wk2 = W[k1];
    var wk1 = W[2*k1];
    var wk3 = (wk1.real - 2*wk2.imag * wk1.imag,
               2* wk2.imag * wk1.real - wk1.imag): complex;

    forall j in [k..k+l) {
      butterfly(wk1, wk2, wk3, A[j..j+3*l by l]);
    }

    wk1 = W[2*k1 + 1];
    wk3 = (wk1.real - 2*wk2.real * wk1.imag,
           2*wk2.real * wk1.real - wk1.imag): complex;
    wk2 = (-wk2.imag, wk2.real): complex;

    forall j in [k+m..k+m+l) {
      butterfly(wk1, wk2, wk3, A[j..j+3*l by l]);
    }

    k1 += 1;
  }
}

def butterfly(wk1: complex, wk2: complex, wk3: complex,
              inout A:[1..4] complex) {
  var x0 = A[1] + A[2];
  var x1 = A[1] - A[2];
  var x2 = A[3] + A[4];
  var x3 = A[3] - A[4];

  A[1] = x0 + x2;
  x0 -= x2;
  A[3] = wk2 * x0;
  x0 = (x1.real - x3.imag, x1.imag + x3.real):complex;
  A[2] = wk1 * x0;
  x0 = (x1.real + x3.imag, x1.imag - x3.real):complex;
  A[4] = wk3 * x0;
}


extrema for matrices

extrema for matrices

use LinearAlgebra,
    LinearAlgebra.Sparse,
    NumSuch,
    Random;

config param batchsize = 10000;

/*
 A matrix of data with named rows and columns.
 */
class NamedMatrix {
  var D: domain(2),
      SD = CSRDomain(D),
      X: [SD] real,  // the actual data
      rows: BiMap = new BiMap(),
      cols: BiMap = new BiMap();

   proc init() {
     this.initDone(); // NAMEDMATRIX DOESNT EXPLICITLY INHERIT ANYTHING SO IS THIS NECESSARY??
   }

   proc init(X) {
     this.D = {X.domain.dim(1), X.domain.dim(2)};
     this.initDone();
     this.loadX(X);
   }

   proc init(X, names: [] string) {
     this.init(X);
     try! this.setRowNames(names);
     try! this.setColNames(names);
   }

   proc init(X, rownames: [] string, colnames: [] string) {
     this.init(X);
     try! this.setRowNames(rownames);
     try! this.setColNames(colnames);
   }

   proc init(rownames: [] string, colnames: [] string) {
     this.D = {1..rownames.size, 1..colnames.size};
     this.initDone();
     try! this.setRowNames(rownames);
     try! this.setColNames(colnames);
   }

   proc init(N: NamedMatrix) {
     this.init(N.X);
     this.rows = N.rows;
     this.cols = N.cols;
   }

   proc init(X, rows: BiMap, cols: BiMap) {
     this.init(X);
     this.rows = rows;
     this.cols = cols;
   }
}

/*
Returns the number of rows in the matrix frame
 */
proc NamedMatrix.nrows() {
  return X.domain.dim(1).size;
}

/*
Returns the number of columns in the matrix frame
 */
proc NamedMatrix.ncols() {
  return X.domain.dim(2).size;
}

/*
Loads the data from X into the internal array, also called X.  We call them all X to keep it clear.

:arg real[]: Array representing the matrix
 */
proc NamedMatrix.loadX(X:[], shape: 2*int =(-1,-1)) {
  if shape(1) > 0 && shape(2) > 0 {
    this.D = {1..shape(1), 1..shape(2)};
  }
  for (i,j) in X.domain {
    this.SD += (i,j);
    this.X(i,j) = X(i,j);
  }
}

/*
Sets the row names for the matrix X
 */
proc NamedMatrix.setRowNames(rn:[]): string throws {
  //if (X.domain.dim(1).size > 0) && (rn.size != X.domain.dim(1).size) {
  //if (1 > 0) && (rn.size != X.domain.dim(1).size) {
  if rn.size != X.domain.dim(1).size {
    const err = new DimensionMatchError(expected = X.domain.dim(1).size, actual=rn.size);
    throw err;
    return "";
  } else {
    for i in 1..rn.size {
      this.rows.add(rn[i]);
    }
    return this.rows;
  }
}

/*
Sets the column names for the matrix X
*/
proc NamedMatrix.setColNames(cn:[]): string throws {
  if cn.size != X.domain.dim(2).size then throw new Error();
  for i in 1..cn.size {
    this.cols.add(cn[i]);
  }
  return this.cols;
}

/*
 Gets the value of the (i,j) entry of the matrix X in the NamedMatrix
 */
proc NamedMatrix.get(i: int, j: int) {
   return this.X(i,j);
 }

 /*
 Get the values using the named rows and columns
  */
proc NamedMatrix.get(f: string, t: string) {
    return this.X(rows.get(f), cols.get(t));
 }

/*
 Set the value of this.X(i,j) by index row
 */
proc NamedMatrix.set(i: int, j: int, w: real) {
    if this.SD.member((i,j)) {
      this.X(i,j) = w;
    } else {
      this.SD += (i,j);
      this.X(i,j) = w;
    }
    return w;
}

/*
Set the values using the row and column names
*/
proc NamedMatrix.set(f: string, t: string, w: real) {
  return this.set(rows.get(f), cols.get(t), w);
}

/*
Update the value in X(i,j) with `w`
 */
proc NamedMatrix.update(i: int, j: int, w: real) {
  const x = this.get(i,j);
  return this.set(i,j, x + w);
}

/*
Update the value in X(i,j) with `w` using the row column names
 */
proc NamedMatrix.update(f: string, t: string, w: real) {
  const x = this.get(rows.get(f),cols.get(t));
  return this.set(rows.get(f),cols.get(t), x + w);
}

/*
Find the number of non-zeroes in the matrix
 */
proc NamedMatrix.nnz() {
  var i: int = 0;
  for ij in this.X.domain {
    i += 1;
  }
  return i;
}

/*
Calculates the sparsity of the matrix: Number of entries / frame size
 */
proc NamedMatrix.sparsity() {
  const d = this.X.shape[1]:real * this.X.shape[2]: real;
  return this.nnz():real / d;
}

/*
 Multiplies the current NamedMatrix `X` against the argument `Y`, but first it aligns
 the names of `X.cols` with `Y.rows`.  Returns an appropriately named NamedMatrix
 :arg NamedMatrix Y:
 */

proc NamedMatrix.ndot(N: NamedMatrix) {
  var C: NamedMatrix = new NamedMatrix(X = dot(this.X,N.X), this.rows, N.cols);
  return C;
}

proc NamedMatrix.alignAndMultiply(Y: NamedMatrix) {
    var rcOverlap: domain(string) = this.cols.keys & Y.rows.keys;

    var xSD: sparse subdomain(this.D) dmapped CS(),
        ySD: sparse subdomain(Y.D) dmapped CS(),
        xX: [xSD] real,  // the actual data
        yX: [ySD] real,  // the actual data
        xrows: BiMap = new BiMap(),
        yrows: BiMap = new BiMap(),
        xcols: BiMap = new BiMap(),
        ycols: BiMap = new BiMap();

    for (left_row, right_col) in zip(this.D.dim(2), Y.D.dim(1)) {
      for rc in rcOverlap {
        const j = this.cols.get(rc);
        if this.SD.member(left_row, j) {
          xSD += (left_row, j);
          xX[left_row, j] = this.X[left_row, j];
        }
        if Y.SD.member(j, right_col) {
          ySD += (j, right_col);
          yX[j, right_col] = Y.X[j, right_col];
        }
      }
    }
    const z = xX.dot(yX);
    var n = new NamedMatrix(X=z);
    n.rows = this.rows;
    n.cols = Y.cols;
    return n;
}

proc maxima(axis:int, id:int , X:[]) {
  var idm: (int,int),
      maximum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) > maximum {
        maximum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) > maximum {
        maximum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) > maximum {
        maximum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return maximum;
}

proc maxiLoc(axis:int, id:int , X:[]) {
  var idm: (int,int),
      maximum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) > maximum {
        maximum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) > maximum {
        maximum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) > maximum {
        maximum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return idm;
}

proc minima(axis:int, id:int , X:[]) {
  var idm: (int,int),
      minimum: real = 1000000;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) < minimum {
        minimum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) < minimum {
        minimum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) < minimum {
        minimum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return minimum;
}

proc miniLoc(axis:int, id:int , X:[]) {
  var idm: (int,int),
      minimum: real = 1000000;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) < minimum {
        minimum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) < minimum {
        minimum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) < minimum {
        minimum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return idm;
}

proc rowMax_(id: int, X) {
  return maxima(axis = 2, id, X);
}

proc rowMax_(X) {
  return maxima(axis = 0, id = 0, X);
}

proc colMax_(id: int, X) {
  return maxima(axis = 1, id, X);
}

proc colMax_(X) {
  return maxima(axis = 0, id = 0, X);
}

proc argRowMax_(id: int, X) {
  return maxiLoc(axis = 2, id, X);
}

proc argRowMax_(X) {
  return maxiLoc(axis = 0, id = 0, X);
}

proc argColMax_(id: int, X) {
  return maxiLoc(axis = 1, id, X);
}

proc argColMax_(X) {
  return maxiLoc(axis = 0, id = 0, X);
}

proc tropic(A:[],B:[]) { // UNDER CONSTRUCTION
  writeln("Calculating Tropic Product");
  writeln("A is");
  writeln(A);
  writeln("With domain");
  writeln(A.domain);
  var dom: domain(2) = {A.domain.dim(1),B.domain.dim(2)};
  var sps = CSRDomain(dom);
  var BT = transpose(B);
  writeln("BT is");
  writeln(BT);
  writeln("With domain");
  writeln(BT.domain);
  writeln("Tropic will have entries in");
  writeln(dom);
  var T: [sps] real;
  for (i,j) in dom {
    var mini = 100000000: real;
    var wdom: domain(1);
    var wids: [wdom] int;
    for w in A.domain.dimIter(2,i) {
      wids.push_back(w);
      writeln("Witness in A from %n to %n".format(i,w));
    }
    writeln(wids);
    for w in BT.domain.dimIter(2,j) {
      wids.push_back(w);
      writeln("Witness in B from %n to %n".format(w,j));
    }
    writeln(wids);
    var wDom: domain(1);
    var witness: [wDom] real;
    for w in wids {
      if A(i,w) + BT(j,w) > 0 {
        witness.push_back(A(i,w) + BT(j,w));
      }
    }
    writeln("Witnesses are");
    writeln(witness);
    mini = min reduce witness;
    writeln("Minimum among witnesses is");
    writeln(mini);
    if mini < 1000000000 {
      T(i,j) = mini;
    }
  }
  return T;
}

/*
 Build a random sparse matrix.  Good for testing;
 */
proc generateRandomSparseMatrix(size: int, sparsity: real) {
  const D: domain(2) = {1..size, 1..size};
  var SD: sparse subdomain(D) dmapped CS();
  var R: [SD] real;
  var da: domain(1) = {1..size};
  var array: [da] int = 1..size;
  var dom: domain(1) = {1..0};
  var indices: [dom] 2*int;
  var N = floor(size*(1-sparsity)): int;
  forall i in array {
    forall j in array {
      indices.push_back((i,j));
    }
  }
  shuffle(indices);
  var sparseids = indices[1..N];
  SD.bulkAdd(sparseids);
  forall (i,j) in sparseids {
    R(i,j) = 1;
  }
  //ndices = zip(array1, array2)
  return R;
}

proc sparsity(X) {
  const d = X.shape[1]:real * X.shape[2]: real;
  var i: real = 0.0;
  for ij in X.domain {
    i += 1.0;
  }
  return i / d;
}

class NumSuchError : Error {
  proc init() {
    super.init();
    this.initDone();
  }
  proc message() {
    return "Generic NumSuch Error";
  }
}

class DimensionMatchError : NumSuchError {
  var expected: int,
      actual: int;

  proc init(expected: int, actual:int) {
    super.init();
    this.initDone();
    this.expected = expected;
    this.actual = actual;
  }

  proc message() {
    return "Error matching dimensions.  Expected: " + this.expected + " Actual: " + this.actual;
  }
}

use LinearAlgebra,
    LinearAlgebra.Sparse,
    NumSuch,
    Random;

config param batchsize = 10000;

/*
 A matrix of data with named rows and columns.
 */
class NamedMatrix {
  var D: domain(2),
      SD = CSRDomain(D),
      X: [SD] real,  // the actual data
      rows: BiMap = new BiMap(),
      cols: BiMap = new BiMap();

   proc init() {
     this.initDone(); // NAMEDMATRIX DOESNT EXPLICITLY INHERIT ANYTHING SO IS THIS NECESSARY??
   }

   proc init(X) {
     this.D = {X.domain.dim(1), X.domain.dim(2)};
     this.initDone();
     this.loadX(X);
   }

   proc init(X, names: [] string) {
     this.init(X);
     try! this.setRowNames(names);
     try! this.setColNames(names);
   }

   proc init(X, rownames: [] string, colnames: [] string) {
     this.init(X);
     try! this.setRowNames(rownames);
     try! this.setColNames(colnames);
   }

   proc init(rownames: [] string, colnames: [] string) {
     this.D = {1..rownames.size, 1..colnames.size};
     this.initDone();
     try! this.setRowNames(rownames);
     try! this.setColNames(colnames);
   }

   proc init(N: NamedMatrix) {
     this.init(N.X);
     this.rows = N.rows;
     this.cols = N.cols;
   }

   proc init(X, rows: BiMap, cols: BiMap) {
     this.init(X);
     this.rows = rows;
     this.cols = cols;
   }
}

/*
Returns the number of rows in the matrix frame
 */
proc NamedMatrix.nrows() {
  return X.domain.dim(1).size;
}

/*
Returns the number of columns in the matrix frame
 */
proc NamedMatrix.ncols() {
  return X.domain.dim(2).size;
}

/*
Loads the data from X into the internal array, also called X.  We call them all X to keep it clear.

:arg real[]: Array representing the matrix
 */
proc NamedMatrix.loadX(X:[], shape: 2*int =(-1,-1)) {
  if shape(1) > 0 && shape(2) > 0 {
    this.D = {1..shape(1), 1..shape(2)};
  }
  for (i,j) in X.domain {
    this.SD += (i,j);
    this.X(i,j) = X(i,j);
  }
}

/*
Sets the row names for the matrix X
 */
proc NamedMatrix.setRowNames(rn:[]): string throws {
  //if (X.domain.dim(1).size > 0) && (rn.size != X.domain.dim(1).size) {
  //if (1 > 0) && (rn.size != X.domain.dim(1).size) {
  if rn.size != X.domain.dim(1).size {
    const err = new DimensionMatchError(expected = X.domain.dim(1).size, actual=rn.size);
    throw err;
    return "";
  } else {
    for i in 1..rn.size {
      this.rows.add(rn[i]);
    }
    return this.rows;
  }
}

/*
Sets the column names for the matrix X
*/
proc NamedMatrix.setColNames(cn:[]): string throws {
  if cn.size != X.domain.dim(2).size then throw new Error();
  for i in 1..cn.size {
    this.cols.add(cn[i]);
  }
  return this.cols;
}

/*
 Gets the value of the (i,j) entry of the matrix X in the NamedMatrix
 */
proc NamedMatrix.get(i: int, j: int) {
   return this.X(i,j);
 }

 /*
 Get the values using the named rows and columns
  */
proc NamedMatrix.get(f: string, t: string) {
    return this.X(rows.get(f), cols.get(t));
 }

/*
 Set the value of this.X(i,j) by index row
 */
proc NamedMatrix.set(i: int, j: int, w: real) {
    if this.SD.member((i,j)) {
      this.X(i,j) = w;
    } else {
      this.SD += (i,j);
      this.X(i,j) = w;
    }
    return w;
}

/*
Set the values using the row and column names
*/
proc NamedMatrix.set(f: string, t: string, w: real) {
  return this.set(rows.get(f), cols.get(t), w);
}

/*
Update the value in X(i,j) with `w`
 */
proc NamedMatrix.update(i: int, j: int, w: real) {
  const x = this.get(i,j);
  return this.set(i,j, x + w);
}

/*
Update the value in X(i,j) with `w` using the row column names
 */
proc NamedMatrix.update(f: string, t: string, w: real) {
  const x = this.get(rows.get(f),cols.get(t));
  return this.set(rows.get(f),cols.get(t), x + w);
}

/*
Find the number of non-zeroes in the matrix
 */
proc NamedMatrix.nnz() {
  var i: int = 0;
  for ij in this.X.domain {
    i += 1;
  }
  return i;
}

/*
Calculates the sparsity of the matrix: Number of entries / frame size
 */
proc NamedMatrix.sparsity() {
  const d = this.X.shape[1]:real * this.X.shape[2]: real;
  return this.nnz():real / d;
}

/*
 Multiplies the current NamedMatrix `X` against the argument `Y`, but first it aligns
 the names of `X.cols` with `Y.rows`.  Returns an appropriately named NamedMatrix
 :arg NamedMatrix Y:
 */

proc NamedMatrix.ndot(N: NamedMatrix) {
  var C: NamedMatrix = new NamedMatrix(X = dot(this.X,N.X), this.rows, N.cols);
  return C;
}

proc NamedMatrix.alignAndMultiply(Y: NamedMatrix) {
    var rcOverlap: domain(string) = this.cols.keys & Y.rows.keys;

    var xSD: sparse subdomain(this.D) dmapped CS(),
        ySD: sparse subdomain(Y.D) dmapped CS(),
        xX: [xSD] real,  // the actual data
        yX: [ySD] real,  // the actual data
        xrows: BiMap = new BiMap(),
        yrows: BiMap = new BiMap(),
        xcols: BiMap = new BiMap(),
        ycols: BiMap = new BiMap();

    for (left_row, right_col) in zip(this.D.dim(2), Y.D.dim(1)) {
      for rc in rcOverlap {
        const j = this.cols.get(rc);
        if this.SD.member(left_row, j) {
          xSD += (left_row, j);
          xX[left_row, j] = this.X[left_row, j];
        }
        if Y.SD.member(j, right_col) {
          ySD += (j, right_col);
          yX[j, right_col] = Y.X[j, right_col];
        }
      }
    }
    const z = xX.dot(yX);
    var n = new NamedMatrix(X=z);
    n.rows = this.rows;
    n.cols = Y.cols;
    return n;
}

proc argmaxi(axis:int, id:int , X:[]) {
  var idm: (int,int),
      maximum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) > maximum {
        maximum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) > maximum {
        maximum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) > maximum {
        maximum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return maximum;
}

proc maxiloc(axis:int, id:int , X:[]) {
  var idm: (int,int),
      maximum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) > maximum {
        maximum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) > maximum {
        maximum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) > maximum {
        maximum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return idm;
}

proc argmini(axis:int, id:int , X:[]) {
  var idm: (int,int),
      minimum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) < minimum {
        minimum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) < minimum {
        minimum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) < minimum {
        minimum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return minimum;
}

proc miniloc(axis:int, id:int , X:[]) {
  var idm: (int,int),
      minimum: real = 0;
  if axis == 0 {
    for (i,j) in X.domain {
      if X(i,j) < minimum {
        minimum = X(i,j);
        idm = (i,j);
      }
    }
  }
  if axis == 1 {
    for a in transpose(X).domain.dimIter(2, id) {
      if X(a,id) < minimum {
        minimum = X(a,id);
        idm = (a,id);
      }
    }
  }
  if axis == 2 {
    for a in X.domain.dimIter(2, id) {
      if X(id,a) < minimum {
        minimum = X(id,a);
        idm = (id,a);
      }
    }
  }
  return idm;
}

proc tropic(A:[],B:[]) { // UNDER CONSTRUCTION
  writeln("Calculating Tropic Product");
  writeln("A is");
  writeln(A);
  writeln("With domain");
  writeln(A.domain);
  var dom: domain(2) = {A.domain.dim(1),B.domain.dim(2)};
  var sps = CSRDomain(dom);
  var BT = transpose(B);
  writeln("BT is");
  writeln(BT);
  writeln("With domain");
  writeln(BT.domain);
  writeln("Tropic will have entries in");
  writeln(dom);
  var T: [sps] real;
  for (i,j) in dom {
    var mini = 100000000: real;
    var wdom: domain(1);
    var wids: [wdom] int;
    for w in A.domain.dimIter(2,i) {
      wids.push_back(w);
      writeln("Witness in A from %n to %n".format(i,w));
    }
    writeln(wids);
    for w in BT.domain.dimIter(2,j) {
      wids.push_back(w);
      writeln("Witness in B from %n to %n".format(w,j));
    }
    writeln(wids);
    var wDom: domain(1);
    var witness: [wDom] real;
    for w in wids {
      if A(i,w) + BT(j,w) > 0 {
        witness.push_back(A(i,w) + BT(j,w));
      }
    }
    writeln("Witnesses are");
    writeln(witness);
    mini = min reduce witness;
    writeln("Minimum among witnesses is");
    writeln(mini);
    if mini < 1000000000 {
      T(i,j) = mini;
    }
  }
  return T;
}

/*
 Build a random sparse matrix.  Good for testing;
 */
proc generateRandomSparseMatrix(size: int, sparsity: real) {
  const D: domain(2) = {1..size, 1..size};
  var SD: sparse subdomain(D) dmapped CS();
  var R: [SD] real;
  var da: domain(1) = {1..size};
  var array: [da] int = 1..size;
  var dom: domain(1) = {1..0};
  var indices: [dom] 2*int;
  var N = floor(size*(1-sparsity)): int;
  forall i in array {
    forall j in array {
      indices.push_back((i,j));
    }
  }
  shuffle(indices);
  var sparseids = indices[1..N];
  SD.bulkAdd(sparseids);
  forall (i,j) in sparseids {
    R(i,j) = 1;
  }
  //ndices = zip(array1, array2)
  return R;
}

proc sparsity(X) {
  const d = X.shape[1]:real * X.shape[2]: real;
  var i: real = 0.0;
  for ij in X.domain {
    i += 1.0;
  }
  return i / d;
}

class NumSuchError : Error {
  proc init() {
    super.init();
    this.initDone();
  }
  proc message() {
    return "Generic NumSuch Error";
  }
}

class DimensionMatchError : NumSuchError {
  var expected: int,
      actual: int;

  proc init(expected: int, actual:int) {
    super.init();
    this.initDone();
    this.expected = expected;
    this.actual = actual;
  }

  proc message() {
    return "Error matching dimensions.  Expected: " + this.expected + " Actual: " + this.actual;
  }
}