Fixing a race condition between dsiAccess and dsiAdd

// DefaultAssociative.chpl
//
pragma "no use ChapelStandard"
module DefaultAssociative {

  use DSIUtil;
  config param debugDefaultAssoc = false;
  config param debugAssocDataPar = false;

  use Sort /* only QuickSort */;

  // TODO: make the domain parameterized by this?
  type chpl_table_index_type = int;

  /* These declarations could/should both be nested within
     DefaultAssociativeDom? */
  enum chpl__hash_status { empty, full, deleted };

  record chpl_TableEntry {
    type idxType;
    var status: chpl__hash_status = chpl__hash_status.empty;
    var idx: idxType;
  }

  proc chpl__primes return (23, 53, 97, 193, 389, 769, 1543,
                           3079, 6151, 12289, 24593, 49157, 98317, 196613,
                           393241, 786433, 1572869, 3145739, 6291469, 12582917, 25165843,
                           50331653, 100663319, 201326611, 402653189, 805306457, 1610612741);

  class DefaultAssociativeDom: BaseAssociativeDom {
    type idxType;
    param parSafe: bool;

    var dist: DefaultDist;

    // The guts of the associative domain

    // We explicitly use processor atomics here since this is not
    // by design a distributed data structure
    var numEntries: atomic_int64;
    var tableLock: atomicflag; // do not access directly, use function below
    var tableSizeNum = 1;
    var tableSize = chpl__primes(tableSizeNum);
    var tableDom = {0..tableSize-1};
    var table: [tableDom] chpl_TableEntry(idxType);

    inline proc lockTable() {
      while tableLock.testAndSet() do chpl_task_yield();
    }

    inline proc unlockTable() {
      tableLock.clear();
    }

    // TODO: An ugly [0..-1] domain appears several times in the code --
    //       replace with a named constant/param?
    var postponeResize = false;

    proc linksDistribution() param return false;
    proc dsiLinksDistribution()     return false;

    proc DefaultAssociativeDom(type idxType,
                               param parSafe: bool,
                               dist: DefaultDist) {
      if !chpl__validDefaultAssocDomIdxType(idxType) then
        compilerError("Default Associative domains with idxType=",
                      typeToString(idxType), " are not allowed", 2);
      this.dist = dist;
    }

    //
    // Standard Internal Domain Interface
    //
    proc dsiBuildArray(type eltType) {
      return new DefaultAssociativeArr(eltType=eltType, idxType=idxType,
                                       parSafeDom=parSafe, dom=this);
    }

    proc dsiSerialReadWrite(f /*: Reader or Writer*/) {
      var first = true;
      f <~> new ioLiteral("{");
      for idx in this {
        if first then
          first = false;
        else
          f <~> new ioLiteral(", ");
        f <~> idx;
      }
      f <~> new ioLiteral("}");
    }
    proc dsiSerialWrite(f: Writer) { this.dsiSerialReadWrite(f); }
    proc dsiSerialRead(f: Reader) { this.dsiSerialReadWrite(f); }

    //
    // Standard user domain interface
    //

    inline proc dsiNumIndices {
      return numEntries.read();
    }

    iter dsiIndsIterSafeForRemoving() {
      postponeResize = true;
      for i in this.these() do
        yield i;
      on this {
        postponeResize = false;
        if (numEntries.read()*8 < tableSize && tableSizeNum > 1) {
          if parSafe then lockTable();
          if (numEntries.read()*8 < tableSize && tableSizeNum > 1) {
            _resize(grow=false);
          }
          if parSafe then unlockTable();
        }
      }
    }

    iter these() {
      if !_isEnumeratedType(idxType) {
        for slot in _fullSlots() {
          yield table[slot].idx;
        }
      } else {
        for val in chpl_enumerate(idxType) {
          var (match, slot) = _findFilledSlot(val);
          if match then
            yield table[slot].idx;
        }
      }
    }

    iter these(param tag: iterKind) where tag == iterKind.leader {
      if debugDefaultAssoc then
        writeln("*** In domain leader code:");
      const numTasks = if dataParTasksPerLocale==0 then here.numCores
                       else dataParTasksPerLocale;
      const ignoreRunning = dataParIgnoreRunningTasks;
      const minIndicesPerTask = dataParMinGranularity;
      // We are simply slicing up the table here.  Trying to do something
      //  more intelligent (like evenly dividing up the full slots, led
      //  to poor speed ups.
      // This requires that the zipppered domains match.
      const numIndices = tableSize;

      if debugAssocDataPar {
        writeln("### numTasks = ", numTasks);
        writeln("### ignoreRunning = ", ignoreRunning);
        writeln("### minIndicesPerTask = ", minIndicesPerTask);
      }

      if debugDefaultAssoc then
        writeln("    numTasks=", numTasks, " (", ignoreRunning,
                "), minIndicesPerTask=", minIndicesPerTask);

      var numChunks = _computeNumChunks(numTasks, ignoreRunning,
                                        minIndicesPerTask,
                                        numIndices);
      if debugDefaultAssoc then
        writeln("    numChunks=", numChunks, "length=", numIndices);

      if debugAssocDataPar then writeln("### numChunks=", numChunks);

      if numChunks == 1 {
        yield (0..numIndices-1, this);
      } else {
        coforall chunk in 0..#numChunks {
          const (lo, hi) = _computeBlock(numIndices, numChunks,
                                         chunk, numIndices-1);
          if debugDefaultAssoc then
            writeln("*** DI[", chunk, "]: tuple = ", (lo..hi,));
          yield (lo..hi, this);
        }
      }
    }

    iter these(param tag: iterKind, followThis) where tag == iterKind.follower {
      var (chunk, followThisDom) = followThis;
      if followThisDom != this {
        // check to see if domains match
        var followThisTab = followThisDom.table;
        var myTab = table;
        var mismatch = false;
        // could use a reduction
        for slot in chunk.low..chunk.high do
          if followThisTab[slot].status != myTab[slot].status {
            mismatch = true;
            break;
          }
        if mismatch then
          halt("zippered associative domains do not match");
      }

      if debugDefaultAssoc then
        writeln("In domain follower code: Following ", chunk);

      for slot in chunk.low..chunk.high do
        if table[slot].status == chpl__hash_status.full then
          yield table[slot].idx;
    }

    //
    // Associative Domain Interface
    //
    proc dsiClear() {
      on this {
        if parSafe then lockTable();
        for slot in tableDom {
          table[slot].status = chpl__hash_status.empty;
        }
        numEntries.write(0);
        if parSafe then unlockTable();
      }
    }

    proc dsiMember(idx: idxType): bool {
      return _findFilledSlot(idx)(1);
    }

    proc dsiAdd(idx: idxType, in slotNum : index(tableDom) = -1, haveLock = !parSafe): index(tableDom) {
      on this {
        const shouldLock = !haveLock && parSafe;
        if shouldLock then lockTable();
        var findAgain = shouldLock;
        if ((numEntries.read()+1)*2 > tableSize) {
          _resize(grow=true);
          findAgain = true;
        }
        if findAgain then slotNum = -1;
        slotNum = _add(idx, slotNum);
        if shouldLock then unlockTable();
      }
      return slotNum;
    }

    // This routine adds new indices without checking the table size and
    //  is thus appropriate for use by routines like _resize().
    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    proc _add(idx: idxType, in slotNum : index(tableDom) = -1): index(tableDom) {
      var foundSlot : bool = (slotNum != -1);
      if !foundSlot then
        (foundSlot, slotNum) = _findEmptySlot(idx);
      if foundSlot {
        table[slotNum].status = chpl__hash_status.full;
        table[slotNum].idx = idx;
        numEntries.add(1);
      } else {
        if (slotNum < 0) {
          halt("couldn't add ", idx, " -- ", numEntries.read(), " / ", tableSize, " taken");
          return -1;
        }
        // otherwise, re-adding an index that's already in there
      }
      return slotNum;
    }

    proc dsiRemove(idx: idxType) {
      on this {
        if parSafe then lockTable();
        const (foundSlot, slotNum) = _findFilledSlot(idx, haveLock=parSafe);
        if (foundSlot) {
          table[slotNum].status = chpl__hash_status.deleted;
          numEntries.sub(1);
        } else {
          halt("index not in domain: ", idx);
        }
        if (numEntries.read()*8 < tableSize && tableSizeNum > 1) {
          _resize(grow=false);
        }
        if parSafe then unlockTable();
      }
    }

    proc dsiRequestCapacity(numKeys:int) {
      var entries = numEntries.read();

      if entries < numKeys {

        //Find the first suitable prime
        var threshhold = (numKeys + 1) * 2;
        var prime = 0;
        var primeLoc = 0;
        for i in 1..chpl__primes.size {
            if chpl__primes(i) > threshhold {
              prime = chpl__primes(i);
              primeLoc = i;
              break;
            }
        }

        //No suitable prime found
        if prime == 0 {
          halt("Requested capacity (", numKeys, ") exceeds maximum size");
        }

        //Changing underlying strucure, time for locking
        if parSafe then lockTable();
        if entries > 0 {
          // Slow path: back up required
          _backupArrays();

          // copy the table (TODO: could use swap between two versions)
          var copyDom = tableDom;
          var copyTable: [copyDom] chpl_TableEntry(idxType) = table;

          tableSizeNum=primeLoc;
          tableSize=prime;
          tableDom = {0..tableSize-1};

          //numEntries will be reconstructed as keys are readded
          numEntries.write(0);

          // insert old data into newly resized table
          for slot in _fullSlots(copyTable) {
            const newslot = _add(copyTable[slot].idx);
            _preserveArrayElements(oldslot=slot, newslot=newslot);
          }

          _removeArrayBackups();
        } else {
          //Fast path, nothing to backup
          tableSizeNum=primeLoc;
          tableSize=prime;
          tableDom = {0..tableSize-1};
        }

        //Unlock the table
        if parSafe then unlockTable();
      } else if entries > numKeys {
        warning("Requested capacity (" + numKeys + ") " +
                "is less than current size (" + entries + ")");
      }
    }

    iter dsiSorted() {
      var tableCopy: [0..#numEntries.read()] idxType;

      for (tmp, slot) in zip(tableCopy.domain, _fullSlots()) do
        tableCopy(tmp) = table[slot].idx;

      QuickSort(tableCopy);

      for ind in tableCopy do
        yield ind;
    }

    //
    // Internal interface (private)
    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    proc _resize(grow:bool) {
      if postponeResize then return;
      // back up the arrays
      _backupArrays();

      // copy the table (TODO: could use swap between two versions)
      var copyDom = tableDom;
      var copyTable: [copyDom] chpl_TableEntry(idxType) = table;

      // grow original table
      tableDom = {0..(-1:chpl_table_index_type)}; // non-preserving resize
      numEntries.write(0); // reset, because the adds below will re-set this
      tableSizeNum += if grow then 1 else -1;
      if tableSizeNum > chpl__primes.size then halt("associative array exceeds maximum size");
      tableSize = chpl__primes(tableSizeNum);
      tableDom = {0..tableSize-1};

      // insert old data into newly resized table
      for slot in _fullSlots(copyTable) {
        const newslot = _add(copyTable[slot].idx);
        _preserveArrayElements(oldslot=slot, newslot=newslot);
      }

      _removeArrayBackups();
    }

    // Searches for 'idx' in a filled slot.
    //
    // Returns true if found, along with the first open slot that may be
    // re-used for faster addition to the domain
    proc _findFilledSlot(idx: idxType, param haveLock = false) : (bool, index(tableDom)) {
      if parSafe && !haveLock then lockTable();
      var firstOpen = -1;
      for slotNum in _lookForSlots(idx, table.domain.high+1) {
        const slotStatus = table[slotNum].status;
        // if we encounter a slot that's empty, our element could not
        // be found past this point.
        if (slotStatus == chpl__hash_status.empty) {
          if firstOpen == -1 then firstOpen = slotNum;
          if parSafe && !haveLock then unlockTable();
          return (false, firstOpen);
        } else if (slotStatus == chpl__hash_status.full) {
          if (table[slotNum].idx == idx) {
            if parSafe && !haveLock then unlockTable();
            return (true, slotNum);
          }
        } else { // this entry was removed, but is the first slot we could use
          if firstOpen == -1 then firstOpen = slotNum;
        }
      }
      if parSafe && !haveLock then unlockTable();
      return (false, -1);
    }

    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    proc _findEmptySlot(idx: idxType, haveLock = false): (bool, index(tableDom)) {
      for slotNum in _lookForSlots(idx) {
        const slotStatus = table[slotNum].status;
        if (slotStatus == chpl__hash_status.empty ||
            slotStatus == chpl__hash_status.deleted) {
          return (true, slotNum);
        } else if (table[slotNum].idx == idx) {
          return (false, slotNum);
        }
      }
      return (false, -1);
    }

    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    iter _lookForSlots(idx: idxType, numSlots = tableSize) {
      const baseSlot = chpl__defaultHashWrapper(idx);
      for probe in 0..numSlots/2 {
        yield (baseSlot + probe**2)%numSlots;
      }
    }

    iter _fullSlots(tab = table) {
      for slot in tab.domain {
        if tab[slot].status == chpl__hash_status.full then
          yield slot;
      }
    }
  }

  class DefaultAssociativeArr: BaseArr {
    type eltType;
    type idxType;
    param parSafeDom: bool;
    var dom : DefaultAssociativeDom(idxType, parSafe=parSafeDom);

    var data : [dom.tableDom] eltType;

    var tmpDom = {0..(-1:chpl_table_index_type)};
    var tmpTable: [tmpDom] eltType;

    //
    // Standard internal array interface
    //

    proc dsiGetBaseDom() return dom;

    proc clearEntry(idx: idxType) {
      const initval: eltType;
      dsiAccess(idx) = initval;
    }

    proc dsiAccess(idx : idxType) var : eltType {
      if dom.parSafe then dom.lockTable();
      var (found, slotNum) = dom._findFilledSlot(idx, haveLock=true);
      if found {
        if dom.parSafe then dom.unlockTable();
        return data(slotNum);
      }
      else if setter && slotNum != -1 { // do an insert using the slot we found
        if dom._arrs.length != 1 {
          halt("cannot implicitly add to an array's domain when the domain is used by more than one array: ", idx);
          return data(0);
        } else {
          const newSlot = dom.dsiAdd(idx, slotNum, haveLock=true);
          if dom.parSafe then dom.unlockTable();
          return data(newSlot);
        }
      } else {
        halt("array index out of bounds: ", idx);
        return data(0);
      }
    }

    iter these() var {
      for slot in dom {
        yield dsiAccess(slot);
      }
    }

    iter these(param tag: iterKind) where tag == iterKind.leader {
      for followThis in dom.these(tag) do
        yield followThis;
    }

    iter these(param tag: iterKind, followThis) var where tag == iterKind.follower {
      var (chunk, followThisDom) = followThis;
      if followThisDom != dom {
        // check to see if domains match
        var followThisTab = followThisDom.table;
        var myTab = dom.table;
        var mismatch = false;
        // could use a reduction
        for slot in chunk.low..chunk.high do
          if followThisTab[slot].status != myTab[slot].status {
            mismatch = true;
            break;
          }
        if mismatch then
          halt("zippered associative array does not match the iterated domain");
      }
      if debugDefaultAssoc then
        writeln("In array follower code: Following ", chunk);
      var tab = dom.table;  // cache table for performance
      for slot in chunk.low..chunk.high do
        if tab[slot].status == chpl__hash_status.full then
          yield data(slot);
    }

    proc dsiSerialReadWrite(f /*: Reader or Writer*/) {
      var first = true;
      for val in this {
        if (first) then
          first = false;
        else
          f <~> new ioLiteral(" ");
        f <~> val;
      }
    }
    proc dsiSerialWrite(f: Writer) { this.dsiSerialReadWrite(f); }
    proc dsiSerialRead(f: Reader) { this.dsiSerialReadWrite(f); }

    //
    // Associative array interface
    //

    iter dsiSorted() {
      var tableCopy: [0..dom.dsiNumIndices-1] eltType;
      for (copy, slot) in zip(tableCopy.domain, dom._fullSlots()) do
        tableCopy(copy) = data(slot);

      QuickSort(tableCopy);

      for elem in tableCopy do
        yield elem;
    }

    //
    // Internal associative array interface
    //

    proc _backupArray() {
      tmpDom = dom.tableDom;
      tmpTable = data;
    }

    proc _removeArrayBackup() {
      tmpDom = {0..(-1:chpl_table_index_type)};
    }

    proc _preserveArrayElement(oldslot, newslot) {
      data(newslot) = tmpTable[oldslot];
    }

    proc dsiTargetLocDom() {
      compilerError("targetLocDom is unsupported by associative domains");
    }

    proc dsiTargetLocales() {
      compilerError("targetLocales is unsupported by associative domains");
    }

    proc dsiOneLocalSubdomain() param return true;

    proc dsiGetLocalSubdomain() {
      return _newDomain(dom);
    }
  }

  proc chpl__defaultHashWrapper(x): chpl_table_index_type {
    const hash = chpl__defaultHash(x);
    return (hash & max(chpl_table_index_type)): chpl_table_index_type;
  }

  // Thomas Wang's 64b mix function from http://www.concentric.net/~Ttwang/tech/inthash.htm
  proc _gen_key(i: int(64)): int(64) {
    var key = i;
    key += ~(key << 32);
    key = key ^ (key >> 22);
    key += ~(key << 13);
    key = key ^ (key >> 8);
    key += (key << 3);
    key = key ^ (key >> 15);
    key += ~(key << 27);
    key = key ^ (key >> 31);
    return (key & max(int(64))): int(64);  // YAH, make non-negative
  }

  inline proc chpl__defaultHash(b: bool): int(64) {
    if (b) then
      return 0;
    else
      return 1;
  }

  inline proc chpl__defaultHash(i: int(64)): int(64) {
    return _gen_key(i);
  }

  inline proc chpl__defaultHash(u: uint(64)): int(64) {
    return _gen_key(u:int(64));
  }

  inline proc chpl__defaultHash(f: real): int(64) {
    return _gen_key(__primitive( "real2int", f));
  }

  inline proc chpl__defaultHash(c: complex): int(64) {
    return _gen_key(__primitive("real2int", c.re) ^ __primitive("real2int", c.im));
  }

  inline proc chpl__defaultHash(a: imag): int(64) {
    return _gen_key(__primitive( "real2int", _i2r(a)));
  }

  inline proc chpl__defaultHash(u: chpl_taskID_t): int(64) {
    return _gen_key(u:int(64));
  }

  // Use djb2 (Dan Bernstein in comp.lang.c)
  inline proc chpl__defaultHash(x : string): int(64) {
    return chpl__defaultHash(x.c_str());
  }

  inline proc chpl__defaultHash(x : c_string): int(64) {
    var hash: int(64) = 0;
    for c in 1..(x.length) {
      hash = ((hash << 5) + hash) ^ ascii(x.substring(c));
    }
    return _gen_key(hash);
  }

  inline proc chpl__defaultHash(l : []) {
      var hash : int(64) = 0;
      for obj in l {
          hash = (31 * hash) + chpl__defaultHash(obj);
      }

      return _gen_key(hash);
  }

  inline proc chpl__defaultHash(o: object): int(64) {
    return _gen_key(__primitive( "object2int", o));
  }

  // Is 'idxType' legal to create a default associative domain with?
  // Currently based on the availability of chpl__defaultHash().
  // Enumerated, opaque, and sparse domains are handled separately.
  // Tuples and records also work, somehow.
  proc chpl__validDefaultAssocDomIdxType(type idxType) param return false;

  proc chpl__validDefaultAssocDomIdxType(type idxType) param where
      // one check per an implementation of chpl__defaultHash() above
      _isBooleanType(idxType)     ||
      _isSignedType(idxType)      ||
      _isUnsignedType(idxType)    ||
      _isRealType(idxType)        ||
      _isComplexType(idxType)     ||
      _isImagType(idxType)        ||
      idxType == chpl_taskID_t    ||
      idxType == string           ||
      idxType == c_string         ||
      isClassType(idxType)        ||
      // these are handled differently
      _isEnumeratedType(idxType)  ||
      isTupleType(idxType)        ||
      isRecordType(idxType)
  {
    return true;
  }

}

// DefaultAssociative.chpl
//
pragma "no use ChapelStandard"
module DefaultAssociative {

  use DSIUtil;
  config param debugDefaultAssoc = false;
  config param debugAssocDataPar = false;

  use Sort /* only QuickSort */;

  // TODO: make the domain parameterized by this?
  type chpl_table_index_type = int;

  /* These declarations could/should both be nested within
     DefaultAssociativeDom? */
  enum chpl__hash_status { empty, full, deleted };

  record chpl_TableEntry {
    type idxType;
    var status: chpl__hash_status = chpl__hash_status.empty;
    var idx: idxType;
  }

  proc chpl__primes return (23, 53, 97, 193, 389, 769, 1543,
                           3079, 6151, 12289, 24593, 49157, 98317, 196613,
                           393241, 786433, 1572869, 3145739, 6291469, 12582917, 25165843,
                           50331653, 100663319, 201326611, 402653189, 805306457, 1610612741);

  class DefaultAssociativeDom: BaseAssociativeDom {
    type idxType;
    param parSafe: bool;

    var dist: DefaultDist;

    // The guts of the associative domain

    // We explicitly use processor atomics here since this is not
    // by design a distributed data structure
    var numEntries: atomic_int64;
    var tableLock: atomicflag; // do not access directly, use function below
    var tableSizeNum = 1;
    var tableSize = chpl__primes(tableSizeNum);
    var tableDom = {0..tableSize-1};
    var table: [tableDom] chpl_TableEntry(idxType);

    inline proc lockTable() {
      while tableLock.testAndSet() do chpl_task_yield();
    }

    inline proc unlockTable() {
      tableLock.clear();
    }

    // TODO: An ugly [0..-1] domain appears several times in the code --
    //       replace with a named constant/param?
    var postponeResize = false;

    proc linksDistribution() param return false;
    proc dsiLinksDistribution()     return false;

    proc DefaultAssociativeDom(type idxType,
                               param parSafe: bool,
                               dist: DefaultDist) {
      if !chpl__validDefaultAssocDomIdxType(idxType) then
        compilerError("Default Associative domains with idxType=",
                      typeToString(idxType), " are not allowed", 2);
      this.dist = dist;
    }

    //
    // Standard Internal Domain Interface
    //
    proc dsiBuildArray(type eltType) {
      return new DefaultAssociativeArr(eltType=eltType, idxType=idxType,
                                       parSafeDom=parSafe, dom=this);
    }

    proc dsiSerialReadWrite(f /*: Reader or Writer*/) {
      var first = true;
      f <~> new ioLiteral("{");
      for idx in this {
        if first then
          first = false;
        else
          f <~> new ioLiteral(", ");
        f <~> idx;
      }
      f <~> new ioLiteral("}");
    }
    proc dsiSerialWrite(f: Writer) { this.dsiSerialReadWrite(f); }
    proc dsiSerialRead(f: Reader) { this.dsiSerialReadWrite(f); }

    //
    // Standard user domain interface
    //

    inline proc dsiNumIndices {
      return numEntries.read();
    }

    iter dsiIndsIterSafeForRemoving() {
      postponeResize = true;
      for i in this.these() do
        yield i;
      on this {
        postponeResize = false;
        if (numEntries.read()*8 < tableSize && tableSizeNum > 1) {
          if parSafe then lockTable();
          if (numEntries.read()*8 < tableSize && tableSizeNum > 1) {
            _resize(grow=false);
          }
          if parSafe then unlockTable();
        }
      }
    }

    iter these() {
      if !_isEnumeratedType(idxType) {
        for slot in _fullSlots() {
          yield table[slot].idx;
        }
      } else {
        for val in chpl_enumerate(idxType) {
          var (match, slot) = _findFilledSlot(val);
          if match then
            yield table[slot].idx;
        }
      }
    }

    iter these(param tag: iterKind) where tag == iterKind.leader {
      if debugDefaultAssoc then
        writeln("*** In domain leader code:");
      const numTasks = if dataParTasksPerLocale==0 then here.numCores
                       else dataParTasksPerLocale;
      const ignoreRunning = dataParIgnoreRunningTasks;
      const minIndicesPerTask = dataParMinGranularity;
      // We are simply slicing up the table here.  Trying to do something
      //  more intelligent (like evenly dividing up the full slots, led
      //  to poor speed ups.
      // This requires that the zipppered domains match.
      const numIndices = tableSize;

      if debugAssocDataPar {
        writeln("### numTasks = ", numTasks);
        writeln("### ignoreRunning = ", ignoreRunning);
        writeln("### minIndicesPerTask = ", minIndicesPerTask);
      }

      if debugDefaultAssoc then
        writeln("    numTasks=", numTasks, " (", ignoreRunning,
                "), minIndicesPerTask=", minIndicesPerTask);

      var numChunks = _computeNumChunks(numTasks, ignoreRunning,
                                        minIndicesPerTask,
                                        numIndices);
      if debugDefaultAssoc then
        writeln("    numChunks=", numChunks, "length=", numIndices);

      if debugAssocDataPar then writeln("### numChunks=", numChunks);

      if numChunks == 1 {
        yield (0..numIndices-1, this);
      } else {
        coforall chunk in 0..#numChunks {
          const (lo, hi) = _computeBlock(numIndices, numChunks,
                                         chunk, numIndices-1);
          if debugDefaultAssoc then
            writeln("*** DI[", chunk, "]: tuple = ", (lo..hi,));
          yield (lo..hi, this);
        }
      }
    }

    iter these(param tag: iterKind, followThis) where tag == iterKind.follower {
      var (chunk, followThisDom) = followThis;
      if followThisDom != this {
        // check to see if domains match
        var followThisTab = followThisDom.table;
        var myTab = table;
        var mismatch = false;
        // could use a reduction
        for slot in chunk.low..chunk.high do
          if followThisTab[slot].status != myTab[slot].status {
            mismatch = true;
            break;
          }
        if mismatch then
          halt("zippered associative domains do not match");
      }

      if debugDefaultAssoc then
        writeln("In domain follower code: Following ", chunk);

      for slot in chunk.low..chunk.high do
        if table[slot].status == chpl__hash_status.full then
          yield table[slot].idx;
    }

    //
    // Associative Domain Interface
    //
    proc dsiClear() {
      on this {
        if parSafe then lockTable();
        for slot in tableDom {
          table[slot].status = chpl__hash_status.empty;
        }
        numEntries.write(0);
        if parSafe then unlockTable();
      }
    }

    proc dsiMember(idx: idxType): bool {
      return _findFilledSlot(idx)(1);
    }

    proc dsiAdd(idx: idxType, in slotNum : index(tableDom) = -1): index(tableDom) {
      on this {
        if parSafe then lockTable();
        var findAgain = parSafe;
        if ((numEntries.read()+1)*2 > tableSize) {
          _resize(grow=true);
          findAgain = true;
        }
        if findAgain then slotNum = -1;
        slotNum = _add(idx, slotNum);
        if parSafe then unlockTable();
      }
      return slotNum;
    }

    // This routine adds new indices without checking the table size and
    //  is thus appropriate for use by routines like _resize().
    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    proc _add(idx: idxType, in slotNum : index(tableDom) = -1): index(tableDom) {
      var foundSlot : bool = (slotNum != -1);
      if !foundSlot then
        (foundSlot, slotNum) = _findEmptySlot(idx);
      if foundSlot {
        table[slotNum].status = chpl__hash_status.full;
        table[slotNum].idx = idx;
        numEntries.add(1);
      } else {
        if (slotNum < 0) {
          halt("couldn't add ", idx, " -- ", numEntries.read(), " / ", tableSize, " taken");
          return -1;
        }
        // otherwise, re-adding an index that's already in there
      }
      return slotNum;
    }

    proc dsiRemove(idx: idxType) {
      on this {
        if parSafe then lockTable();
        const (foundSlot, slotNum) = _findFilledSlot(idx, haveLock=parSafe);
        if (foundSlot) {
          for a in _arrs do
            a.clearEntry(idx);
          table[slotNum].status = chpl__hash_status.deleted;
          numEntries.sub(1);
        } else {
          halt("index not in domain: ", idx);
        }
        if (numEntries.read()*8 < tableSize && tableSizeNum > 1) {
          _resize(grow=false);
        }
        if parSafe then unlockTable();
      }
    }

    proc dsiRequestCapacity(numKeys:int) {
      var entries = numEntries.read();

      if entries < numKeys {

        //Find the first suitable prime
        var threshhold = (numKeys + 1) * 2;
        var prime = 0;
        var primeLoc = 0;
        for i in 1..chpl__primes.size {
            if chpl__primes(i) > threshhold {
              prime = chpl__primes(i);
              primeLoc = i;
              break;
            }
        }

        //No suitable prime found
        if prime == 0 {
          halt("Requested capacity (", numKeys, ") exceeds maximum size");
        }

        //Changing underlying strucure, time for locking
        if parSafe then lockTable();
        if entries > 0 {
          // Slow path: back up required
          _backupArrays();

          // copy the table (TODO: could use swap between two versions)
          var copyDom = tableDom;
          var copyTable: [copyDom] chpl_TableEntry(idxType) = table;

          tableSizeNum=primeLoc;
          tableSize=prime;
          tableDom = {0..tableSize-1};

          //numEntries will be reconstructed as keys are readded
          numEntries.write(0);

          // insert old data into newly resized table
          for slot in _fullSlots(copyTable) {
            const newslot = _add(copyTable[slot].idx);
            _preserveArrayElements(oldslot=slot, newslot=newslot);
          }

          _removeArrayBackups();
        } else {
          //Fast path, nothing to backup
          tableSizeNum=primeLoc;
          tableSize=prime;
          tableDom = {0..tableSize-1};
        }

        //Unlock the table
        if parSafe then unlockTable();
      } else if entries > numKeys {
        warning("Requested capacity (" + numKeys + ") " +
                "is less than current size (" + entries + ")");
      }
    }

    iter dsiSorted() {
      var tableCopy: [0..#numEntries.read()] idxType;

      for (tmp, slot) in zip(tableCopy.domain, _fullSlots()) do
        tableCopy(tmp) = table[slot].idx;

      QuickSort(tableCopy);

      for ind in tableCopy do
        yield ind;
    }

    //
    // Internal interface (private)
    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    proc _resize(grow:bool) {
      if postponeResize then return;
      // back up the arrays
      _backupArrays();

      // copy the table (TODO: could use swap between two versions)
      var copyDom = tableDom;
      var copyTable: [copyDom] chpl_TableEntry(idxType) = table;

      // grow original table
      tableDom = {0..(-1:chpl_table_index_type)}; // non-preserving resize
      numEntries.write(0); // reset, because the adds below will re-set this
      tableSizeNum += if grow then 1 else -1;
      if tableSizeNum > chpl__primes.size then halt("associative array exceeds maximum size");
      tableSize = chpl__primes(tableSizeNum);
      tableDom = {0..tableSize-1};

      // insert old data into newly resized table
      for slot in _fullSlots(copyTable) {
        const newslot = _add(copyTable[slot].idx);
        _preserveArrayElements(oldslot=slot, newslot=newslot);
      }

      _removeArrayBackups();
    }

    // Searches for 'idx' in a filled slot.
    //
    // Returns true if found, along with the first open slot that may be
    // re-used for faster addition to the domain
    proc _findFilledSlot(idx: idxType, param haveLock = false) : (bool, index(tableDom)) {
      if parSafe && !haveLock then lockTable();
      var firstOpen = -1;
      for slotNum in _lookForSlots(idx, table.domain.high+1) {
        const slotStatus = table[slotNum].status;
        // if we encounter a slot that's empty, our element could not
        // be found past this point.
        if (slotStatus == chpl__hash_status.empty) {
          if firstOpen == -1 then firstOpen = slotNum;
          if parSafe && !haveLock then unlockTable();
          return (false, firstOpen);
        } else if (slotStatus == chpl__hash_status.full) {
          if (table[slotNum].idx == idx) {
            if parSafe && !haveLock then unlockTable();
            return (true, slotNum);
          }
        } else { // this entry was removed, but is the first slot we could use
          if firstOpen == -1 then firstOpen = slotNum;
        }
      }
      if parSafe && !haveLock then unlockTable();
      return (false, -1);
    }

    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    proc _findEmptySlot(idx: idxType, haveLock = false): (bool, index(tableDom)) {
      for slotNum in _lookForSlots(idx) {
        const slotStatus = table[slotNum].status;
        if (slotStatus == chpl__hash_status.empty ||
            slotStatus == chpl__hash_status.deleted) {
          return (true, slotNum);
        } else if (table[slotNum].idx == idx) {
          return (false, slotNum);
        }
      }
      return (false, -1);
    }

    //
    // NOTE: Calls to this routine assume that the tableLock has been acquired.
    //
    iter _lookForSlots(idx: idxType, numSlots = tableSize) {
      const baseSlot = chpl__defaultHashWrapper(idx);
      for probe in 0..numSlots/2 {
        yield (baseSlot + probe**2)%numSlots;
      }
    }

    iter _fullSlots(tab = table) {
      for slot in tab.domain {
        if tab[slot].status == chpl__hash_status.full then
          yield slot;
      }
    }
  }

  class DefaultAssociativeArr: BaseArr {
    type eltType;
    type idxType;
    param parSafeDom: bool;
    var dom : DefaultAssociativeDom(idxType, parSafe=parSafeDom);

    var data : [dom.tableDom] eltType;

    var tmpDom = {0..(-1:chpl_table_index_type)};
    var tmpTable: [tmpDom] eltType;

    //
    // Standard internal array interface
    //

    proc dsiGetBaseDom() return dom;

    proc clearEntry(idx: idxType) {
      const initval: eltType;
      dsiAccess(idx) = initval;
    }

    proc dsiAccess(idx : idxType) var : eltType {
      var (found, slotNum) = dom._findFilledSlot(idx, haveLock=true);
      const numArrs = dom._arrs.length;
      if found then
        return data(slotNum);
      else if setter && slotNum != -1 { // do an insert using the slot we found
        if numArrs != 1 {
          halt("cannot implicitly add to an array's domain when the domain is used by more than one array: ", idx);
          return data(0);
        } else return data(dom.dsiAdd(idx, slotNum));
      } else {
        halt("array index out of bounds: ", idx);
        return data(0);
      }
    }

    iter these() var {
      for slot in dom {
        yield dsiAccess(slot);
      }
    }

    iter these(param tag: iterKind) where tag == iterKind.leader {
      for followThis in dom.these(tag) do
        yield followThis;
    }

    iter these(param tag: iterKind, followThis) var where tag == iterKind.follower {
      var (chunk, followThisDom) = followThis;
      if followThisDom != dom {
        // check to see if domains match
        var followThisTab = followThisDom.table;
        var myTab = dom.table;
        var mismatch = false;
        // could use a reduction
        for slot in chunk.low..chunk.high do
          if followThisTab[slot].status != myTab[slot].status {
            mismatch = true;
            break;
          }
        if mismatch then
          halt("zippered associative array does not match the iterated domain");
      }
      if debugDefaultAssoc then
        writeln("In array follower code: Following ", chunk);
      var tab = dom.table;  // cache table for performance
      for slot in chunk.low..chunk.high do
        if tab[slot].status == chpl__hash_status.full then
          yield data(slot);
    }

    proc dsiSerialReadWrite(f /*: Reader or Writer*/) {
      var first = true;
      for val in this {
        if (first) then
          first = false;
        else
          f <~> new ioLiteral(" ");
        f <~> val;
      }
    }
    proc dsiSerialWrite(f: Writer) { this.dsiSerialReadWrite(f); }
    proc dsiSerialRead(f: Reader) { this.dsiSerialReadWrite(f); }

    //
    // Associative array interface
    //

    iter dsiSorted() {
      var tableCopy: [0..dom.dsiNumIndices-1] eltType;
      for (copy, slot) in zip(tableCopy.domain, dom._fullSlots()) do
        tableCopy(copy) = data(slot);

      QuickSort(tableCopy);

      for elem in tableCopy do
        yield elem;
    }

    //
    // Internal associative array interface
    //

    proc _backupArray() {
      tmpDom = dom.tableDom;
      tmpTable = data;
    }

    proc _removeArrayBackup() {
      tmpDom = {0..(-1:chpl_table_index_type)};
    }

    proc _preserveArrayElement(oldslot, newslot) {
      data(newslot) = tmpTable[oldslot];
    }

    proc dsiTargetLocDom() {
      compilerError("targetLocDom is unsupported by associative domains");
    }

    proc dsiTargetLocales() {
      compilerError("targetLocales is unsupported by associative domains");
    }

    proc dsiOneLocalSubdomain() param return true;

    proc dsiGetLocalSubdomain() {
      return _newDomain(dom);
    }
  }

  proc chpl__defaultHashWrapper(x): chpl_table_index_type {
    const hash = chpl__defaultHash(x);
    return (hash & max(chpl_table_index_type)): chpl_table_index_type;
  }

  // Thomas Wang's 64b mix function from http://www.concentric.net/~Ttwang/tech/inthash.htm
  proc _gen_key(i: int(64)): int(64) {
    var key = i;
    key += ~(key << 32);
    key = key ^ (key >> 22);
    key += ~(key << 13);
    key = key ^ (key >> 8);
    key += (key << 3);
    key = key ^ (key >> 15);
    key += ~(key << 27);
    key = key ^ (key >> 31);
    return (key & max(int(64))): int(64);  // YAH, make non-negative
  }

  inline proc chpl__defaultHash(b: bool): int(64) {
    if (b) then
      return 0;
    else
      return 1;
  }

  inline proc chpl__defaultHash(i: int(64)): int(64) {
    return _gen_key(i);
  }

  inline proc chpl__defaultHash(u: uint(64)): int(64) {
    return _gen_key(u:int(64));
  }

  inline proc chpl__defaultHash(f: real): int(64) {
    return _gen_key(__primitive( "real2int", f));
  }

  inline proc chpl__defaultHash(c: complex): int(64) {
    return _gen_key(__primitive("real2int", c.re) ^ __primitive("real2int", c.im));
  }

  inline proc chpl__defaultHash(a: imag): int(64) {
    return _gen_key(__primitive( "real2int", _i2r(a)));
  }

  inline proc chpl__defaultHash(u: chpl_taskID_t): int(64) {
    return _gen_key(u:int(64));
  }

  // Use djb2 (Dan Bernstein in comp.lang.c)
  inline proc chpl__defaultHash(x : string): int(64) {
    return chpl__defaultHash(x.c_str());
  }

  inline proc chpl__defaultHash(x : c_string): int(64) {
    var hash: int(64) = 0;
    for c in 1..(x.length) {
      hash = ((hash << 5) + hash) ^ ascii(x.substring(c));
    }
    return _gen_key(hash);
  }

  inline proc chpl__defaultHash(l : []) {
      var hash : int(64) = 0;
      for obj in l {
          hash = (31 * hash) + chpl__defaultHash(obj);
      }

      return _gen_key(hash);
  }

  inline proc chpl__defaultHash(o: object): int(64) {
    return _gen_key(__primitive( "object2int", o));
  }

  // Is 'idxType' legal to create a default associative domain with?
  // Currently based on the availability of chpl__defaultHash().
  // Enumerated, opaque, and sparse domains are handled separately.
  // Tuples and records also work, somehow.
  proc chpl__validDefaultAssocDomIdxType(type idxType) param return false;

  proc chpl__validDefaultAssocDomIdxType(type idxType) param where
      // one check per an implementation of chpl__defaultHash() above
      _isBooleanType(idxType)     ||
      _isSignedType(idxType)      ||
      _isUnsignedType(idxType)    ||
      _isRealType(idxType)        ||
      _isComplexType(idxType)     ||
      _isImagType(idxType)        ||
      idxType == chpl_taskID_t    ||
      idxType == string           ||
      idxType == c_string         ||
      isClassType(idxType)        ||
      // these are handled differently
      _isEnumeratedType(idxType)  ||
      isTupleType(idxType)        ||
      isRecordType(idxType)
  {
    return true;
  }

}


Conforming to new readline signature

Conforming to new readline signature

use IO;
use AdvancedIters;

extern proc memcpy(x : [], b, len:int);

config const tableSize = 1 << 16;
config const lineSize = 61;

var tonum : [1..128] int;
tonum[0x41] = 0; // A
tonum[0x43] = 1; // C
tonum[0x54] = 2; // T
tonum[0x47] = 3; // G

var tochar : [0..3] string;
tochar[0] = "A";
tochar[1] = "C";
tochar[2] = "T";
tochar[3] = "G";

class Node {
  var data : uint;
  var count : int;
  var next : Node;
}

class Table {
  var table : [0..tableSize-1] Node;
  var size : int;

  proc this(d : uint) var {
    const slot :int = (d & (tableSize-1)):int;
    refvar head = table[slot];
    var n = head;
    if n == nil {
      n = new Node(d, 0, nil);
      size += 1;
      head = n;
      return n.count;
    }

    while n != nil {
      if n.data == d then return n.count;
      n = n.next;
    }
    n = new Node(d, 0, head);
    size += 1;
    head = n;
    return n.count;
  }

  iter these() {
    for t in table {
      var n : Node = t;
      while n != nil {
        yield (n.data, n.count);
        n = n.next;
      }
    }
  }
}

inline proc hash(str : [] uint(8), beg:int, sizeRange:range(?) ) {
  var data : uint = 0;
  for i in sizeRange {
    data <<= 2;
    data |= tonum[str[beg+i]];
  }
  return data;
}

proc decode(data : uint, size : int) {
  var ret : string;
  var d = data;
  for i in 1..size {
    ret = tochar[(d & 3) : uint(8)] + ret;
    d >>= 2;
  }
  return ret;
}

proc calculate(data : [] uint(8), size : int) {
  var freqs = new Table();

  const ntasks = defaultNumTasks(0);
  var lock : sync bool;
  lock = true;
  const sizeRange = 0..size-1;
  coforall tid in 1..ntasks {
    var curArr = new Table();
    for i in tid .. data.size-size by ntasks {
      curArr[hash(data, i, sizeRange)] += 1;
    }
    lock;
    for (k,v) in curArr do freqs[k] += v;
    lock = true;
  }

  return freqs;
}

proc write_frequencies(data : [] uint(8), size : int) {
  var sum = data.size  - size;
  var freqs = calculate(data, size);

  // sort by frequencies
  var arr : [1..freqs.size] (int, uint);
  for (a, (k,v)) in zip(arr, freqs) do
    a = (-v,k); // '-' for descending order
  QuickSort(arr);

  for (c, e) in arr {
    writef("%s %.3dr\n", decode(e, size), (100.0 * -c) / sum);
  }
}

proc write_count(data : [] uint(8), str : string) {
  var freqs = calculate(data, str.length);
  var d = hash(str.toBytes(), 1, 0..str.length-1);
  writeln(freqs[d], "\t", decode(d, str.length));
}

proc string.toBytes() var {
   var b : [1..this.length] uint(8);
   memcpy(b, this, this.length);
   return b;
}

inline proc startsWithThree(data : []) {
  return data[1] == 0x3E && data[2] == 0x54 && data[3] == 0x48;
}

proc main() {
  // Open stdin and a binary reader channel
  const inFile = openfd(0);
  const fileLen = inFile.length();
  var myin = inFile.reader(kind=ionative,locking=false);

  // Read line-by-line until we see a line beginning with '>TH'
  var tempdata : [1..lineSize] uint(8);
  var numRead = 0;
  var total = 0;
  while myin.readline(tempdata, numRead) && !startsWithThree(tempdata) { total += numRead; }

  // Read in the rest of the file
  var dataDom = {1..fileLen-total};
  var data : [dataDom] uint(8);
  var idx = 1;
  while myin.readline(data, numRead, idx, inclusive=false) { idx += numRead; }

  // Resize our array to the amount actually read
  dataDom = {1..idx};

  // Make everything uppercase
  forall d in data do d ^= 0x20;

  write_frequencies(data, 1);
  writeln();
  write_frequencies(data, 2);
  writeln();
  write_count(data, "GGT");
  write_count(data, "GGTA");
  write_count(data, "GGTATT");
  write_count(data, "GGTATTTTAATT");
  write_count(data, "GGTATTTTAATTTATAGT");
}

use IO;
use AdvancedIters;

extern proc memcpy(x : [], b, len:int);

config const tableSize = 1 << 16;
config const lineSize = 61;

var tonum : [1..128] int;
tonum[0x41] = 0; // A
tonum[0x43] = 1; // C
tonum[0x54] = 2; // T
tonum[0x47] = 3; // G

var tochar : [0..3] string;
tochar[0] = "A";
tochar[1] = "C";
tochar[2] = "T";
tochar[3] = "G";

class Node {
  var data : uint;
  var count : int;
  var next : Node;
}

class Table {
  var table : [0..tableSize-1] Node;
  var size : int;

  proc this(d : uint) var {
    const slot :int = (d & (tableSize-1)):int;
    refvar head = table[slot];
    var n = head;
    if n == nil {
      n = new Node(d, 0, nil);
      size += 1;
      head = n;
      return n.count;
    }

    while n != nil {
      if n.data == d then return n.count;
      n = n.next;
    }
    n = new Node(d, 0, head);
    size += 1;
    head = n;
    return n.count;
  }

  iter these() {
    for t in table {
      var n : Node = t;
      while n != nil {
        yield (n.data, n.count);
        n = n.next;
      }
    }
  }
}

inline proc hash(str : [] uint(8), beg:int, sizeRange:range(?) ) {
  var data : uint = 0;
  for i in sizeRange {
    data <<= 2;
    data |= tonum[str[beg+i]];
  }
  return data;
}

proc decode(data : uint, size : int) {
  var ret : string;
  var d = data;
  for i in 1..size {
    ret = tochar[(d & 3) : uint(8)] + ret;
    d >>= 2;
  }
  return ret;
}

proc calculate(data : [] uint(8), size : int) {
  var freqs = new Table();

  const ntasks = defaultNumTasks(0);
  var lock : sync bool;
  lock = true;
  const sizeRange = 0..size-1;
  coforall tid in 1..ntasks {
    var curArr = new Table();
    for i in tid .. data.size-size by ntasks {
      curArr[hash(data, i, sizeRange)] += 1;
    }
    lock;
    for (k,v) in curArr do freqs[k] += v;
    lock = true;
  }

  return freqs;
}

proc write_frequencies(data : [] uint(8), size : int) {
  var sum = data.size  - size;
  var freqs = calculate(data, size);

  // sort by frequencies
  var arr : [1..freqs.size] (int, uint);
  for (a, (k,v)) in zip(arr, freqs) do
    a = (-v,k); // '-' for descending order
  QuickSort(arr);

  for (c, e) in arr {
    writef("%s %.3dr\n", decode(e, size), (100.0 * -c) / sum);
  }
}

proc write_count(data : [] uint(8), str : string) {
  var freqs = calculate(data, str.length);
  var d = hash(str.toBytes(), 1, 0..str.length-1);
  writeln(freqs[d], "\t", decode(d, str.length));
}

proc string.toBytes() var {
   var b : [1..this.length] uint(8);
   memcpy(b, this, this.length);
   return b;
}

inline proc startsWithThree(data : []) {
  return data[1] == 0x3E && data[2] == 0x54 && data[3] == 0x48;
}

proc main() {
  // Open stdin and a binary reader channel
  const inFile = openfd(0);
  const fileLen = inFile.length();
  var myin = inFile.reader(kind=ionative,locking=false);

  // Read line-by-line until we see a line beginning with '>TH'
  var tempdata : [1..lineSize] uint(8);
  var numRead = 0;
  var total = 0;
  while myin.readline(tempdata, numRead) && !startsWithThree(tempdata) { total += numRead; }

  // Read in the rest of the file
  var dataDom = {1..fileLen-total};
  var data : [dataDom] uint(8);
  var idx = 1;
  while myin.readline(data, numRead, idx, false) { idx += numRead; }

  // Resize our array to the amount actually read
  dataDom = {1..idx};

  // Make everything uppercase
  forall d in data do d ^= 0x20;

  write_frequencies(data, 1);
  writeln();
  write_frequencies(data, 2);
  writeln();
  write_count(data, "GGT");
  write_count(data, "GGTA");
  write_count(data, "GGTATT");
  write_count(data, "GGTATTTTAATT");
  write_count(data, "GGTATTTTAATTTATAGT");
}


minor corrections from review

minor corrections from review

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

/*

A general purpose record reader/parser for channels. Uses a regular expression
to capture portions of the input, and then assigns each capture to each
record field.

This module makes the following assumptions:

1. The file has been opened for reading and a reader channel has been created

2. The programmer has created a record (NOT a class) in which all fields
   can be cast from strings (i.e no subrecords, arrays etc).

3. The number of captures in the regex string provided MUST match the number
   of fields in the record.

4. The order in which the fields in the record appear must be in the same order
   as the record being parsed.

Example 1
---------

.. code-block:: chapel

  use RecordParser;

  record Bar {
    var beer: string;
    var Name: string;
  }

  var f = open("input1.txt", iomode.rw);
  var fr = f.reader();

  var M = new RecordReader(Bar, fr);

  var c = M.get();
  writeln("The first record read is ", c);

  writeln("The rest of the records are:");
  for r in M.stream() do
    writeln(r);

Example 2
---------

.. code-block:: chapel

  use RecordParser;

  record Beer {
    var name:  string;
    var beerId: int;
    var brewerId: int;
    var ABV: real;
    var style: string;
    var appearance: real;
    var aroma: real;
    var palate: real;
    var taste: real;
    var overall: real;
    var time:  int;
    var profileName:  string;
    var text: string;
  }

  var strt = "\\s*beer/name: (.*)\\s*beer/beerId: (.*)\\s*beer/brewerId: (.*)\\s*beer/ABV: (.*)\\s*beer/style: (.*)\\s*review/appearance: (.*)\\s*review/aroma: (.*)\\s*review/palate: (.*)\\s*review/taste: (.*)\\s*review/overall: (.*)\\s*review/time: (.*)\\s*review/profileName: (.*)\\s*review/text: (.*)";

  var N = new RecordReader(Beer, ffr, strt);
  writeln("========== test of stream() ==============");
  for r in N.stream() do
    writeln(r);

RecordParser Types and Functions
--------------------------------

 */
module RecordParser {

use IO, Regexp;

/* A class providing the ability to read records matching a regular expression.
 */
//   Future work is to make this be able to take in a class type as opposed to a
//   record type.  Right now we cant take in a class type due to the future filed
//   in test/types/typedefs/tzakian/classConstructorsFromTypes.chpl
class RecordReader {
  /* The record type to populate */
  type t;
  /* The channel to read from */
  var myReader;
  /* The regular expression to read (using match on the channel) */
  var matchRegexp: regexp;
  pragma "no doc"
  param num_fields = __primitive("num fields", t); // Number of fields in record

  /* Create a RecordReader to match an auto-generated regular expression
     for a record created by the :proc:`createRegexp` routine.

     :arg t: the record type to read
     :arg myReader: the channel to read from
   */
  proc RecordReader(type t, myReader) {
    matchRegexp = compile(createRegexp());
  }

  /* Create a RecordReader to read using a passed regular expression.

     :arg t: the record type to read
     :arg myReader: the channel to read from
     :arg mRegexp: the regular expression to read. This argument
                   currently must be a string, but in the future might be a
                   compiled regular expression.
   */
  proc RecordReader(type t, myReader, mRegexp) {
    matchRegexp = compile(mRegexp);
  }

  /* Create a string regular expression for the record type :type:`t` attached to
     this RecordReader.

     The created regular expression will search for
     ``<fieldName1> <spaces> <vieldValue1> <spaces>``
  */
  proc createRegexp() {
    // This is a VERY loose regex, and therefore could lead to errors unless the
    // data is very nice... (but hey, the programmer wasn't willing to give us a
    // regex..)
    var accum: string = "\\s*";
    for param n in 1..num_fields {
      accum = accum + __primitive("field num to name", t, n) + "\\s*(.*?)" + "\\s*";
    }
    return accum;
  }

  /* Yield records for the range offst..offst+len, but assumes that the
     channel is already at offst.

     :arg offst: the current position of the channel
     :arg len: the number of bytes to read
   */
  iter stream_num(offst: int(64), len: int(64)) {
    do {
      var (rec, once) = _get_internal(offst, len);
      if (once == true) {
        if (myReader.offset() >= offst+len) { // rec.end >= start + len
          // So yield and break
          yield rec;
          break;
        }
        yield rec;
      }
    } while(once);

  }

  /* Read the next record */
  proc get() {
    var (rec, once) = _get_internal();
    if(!once) // We havent gotten everything that we should have.
      then halt("EOF reached -- record not populated");
    return rec;
  }

  /* Yield the records read */
  iter stream() {
    do {
      var (rec, once) = _get_internal();
      if (once == true) // Populated
        then yield rec;
    } while(once);
  }

  /*

     An internal function that we use with all our user visible code.  When
     called with no arguments it does no checking about block boundaries.

     HDFS specific when offst and len are given. Checks for block boundaries
     for parallel file IO

   */
  pragma "no doc"
  proc _get_internal(offst: int(64) = 0, len: int(64) = -1) {
    var rec: t; // create record
    var once = false; // We havent populated yet
    // This will only loop through  at most one time before returning
    // FEATURE REQUEST: Make this so we don't need a for loop here
    for m in myReader.matches(matchRegexp, num_fields, 1) {
      if (((m(1).offset) >= offst+len) && len != -1) { // rec.start >= start + len
        // Then break and dont return any record
        return (rec, false);
      }
      for param n in 1..num_fields {
        var tmp = __primitive("field value by num", rec, n);
        var s: string;
        myReader.extractMatch(m(n + 1), s);
        if(s == "")
          then __primitive("field value by num", rec, n) = tmp;
        else __primitive("field value by num", rec, n) = s:tmp.type;
        once = true;
      }
    }
    return (rec, once);
  }

}

}

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

/*

A general purpose record reader/parser for channels. Uses a regular expression
to capture portions of the input, and then assigns each capture to each
record field.

This module makes the following assumptions:

1. The file has been opened for reading and a reader channel has been created

2. The programmer has created a record (NOT a class) that can have an arbitrary
   number of fields that can be cast from strings (i.e no subrecords, arrays
   etc).

3. The number of captures in the regex string provided, MUST match the number
   of fields in the record.

4. The order in which the fields in the record appear must be in the same order
   as the record being parsed.

Example 1
---------

.. code-block:: chapel

  use RecordParser;

  record Bar {
    var beer: string;
    var Name: string;
  }

  var f = open("input1.txt", iomode.rw);
  var fr = f.reader();

  var M = new RecordReader(Bar, fr);

  var c = M.get();
  writeln("The first record read is ", c);

  writeln("The rest of the records are:");
  for r in M.stream() do
    writeln(r);

Example 2
---------

.. code-block:: chapel

  use RecordParser;

  record Beer {
    var name:  string;
    var beerId: int;
    var brewerId: int;
    var ABV: real;
    var style: string;
    var appearance: real;
    var aroma: real;
    var palate: real;
    var taste: real;
    var overall: real;
    var time:  int;
    var profileName:  string;
    var text: string;
  }

  var strt = "\\s*beer/name: (.*)\\s*beer/beerId: (.*)\\s*beer/brewerId: (.*)\\s*beer/ABV: (.*)\\s*beer/style: (.*)\\s*review/appearance: (.*)\\s*review/aroma: (.*)\\s*review/palate: (.*)\\s*review/taste: (.*)\\s*review/overall: (.*)\\s*review/time: (.*)\\s*review/profileName: (.*)\\s*review/text: (.*)";

  var N = new RecordReader(Beer, ffr, strt);
  writeln("========== test of stream() ==============");
  for r in N.stream() do
    writeln(r);

 */
module RecordParser {

use IO, Regexp;

/* A class providing the ability to read records matching a regular expression.
 */
//   Future work is to make this be able to take in a class type as opposed to a
//   record type.  Right now we cant take in a class type due to the future filed
//   in test/types/typedefs/tzakian/classConstructorsFromTypes.chpl
class RecordReader {
  /* The record type to populate */
  type t;
  /* The channel to read from */
  var myReader;
  /* The regular expression to read (using match on the channel) */
  var matchRegexp: regexp;
  pragma "no doc"
  param num_fields = __primitive("num fields", t); // Number of fields in record

  /* Create a RecordReader to match an auto-generated regular expression
     for a record created by the :proc:`createRegexp` routine.

     :arg t: the record type to read
     :arg myReader: the channel to read from
   */
  proc RecordReader(type t, myReader) {
    matchRegexp = compile(createRegexp());
  }

  /* Create a RecordReader to read using a passed regular expression.

     :arg t: the record type to read
     :arg myReader: the channel to read from
     :arg mRegexp: the regular expression to read. This argument
                   currently must be a string, but in the future might be a
                   compiled regular expression.
   */
  proc RecordReader(type t, myReader, mRegexp) {
    matchRegexp = compile(mRegexp);
  }

  /* Create a string regular expression for the record type :type:`t` attached to
     this RecordReader.

     The created regular expression will search for
     ``<fieldName1> <spaces> <vieldValue1> <spaces>``
  */
  proc createRegexp() {
    // This is a VERY loose regex, and therefore could lead to errors unless the
    // data is very nice... (but hey, the programmer wasnt willing to give us a
    // regex..)
    var accum: string = "\\s*";
    for param n in 1..num_fields {
      accum = accum + __primitive("field num to name", t, n) + "\\s*(.*?)" + "\\s*";
    }
    return accum;
  }

  /* Yield records for the range offst..offst+len, but assumes that the
     channel is already at offst.

     :arg offst: the current position of the channel
     :arg len: the number of bytes to read
   */
  iter stream_num(offst: int(64), len: int(64)) {
    do {
      var (rec, once) = _get_internal(offst, len);
      if (once == true) {
        if (myReader.offset() >= offst+len) { // rec.end >= start + len
          // So yield and break
          yield rec;
          break;
        }
        yield rec;
      }
    } while(once);

  }

  /* Read the next record */
  proc get() {
    var (rec, once) = _get_internal();
    if(!once) // We havent gotten everything that we should have.
      then halt("EOF reached -- record not populated");
    return rec;
  }

  /* Yield the records read */
  iter stream() {
    do {
      var (rec, once) = _get_internal();
      if (once == true) // Populated
        then yield rec;
    } while(once);
  }

  /*
     An internal function that we use all our user visible code.  When called
     with no arguments it does no checking abut block boundaries.

     HDFS specific when offst and len are given. Checks for block boundaries
     for parallel file IO

   */
  pragma "no doc"
  proc _get_internal(offst: int(64) = 0, len: int(64) = -1) {
    var rec: t; // create record
    var once = false; // We havent populated yet
    // This will only loop through  at most one time before returning
    // FEATURE REQUEST: Make this so we don't need a for loop here
    for m in myReader.matches(matchRegexp, num_fields, 1) {
      if (((m(1).offset) >= offst+len) && len != -1) { // rec.start >= start + len
        // Then break and dont return any record
        return (rec, false);
      }
      for param n in 1..num_fields {
        var tmp = __primitive("field value by num", rec, n);
        var s: string;
        myReader.extractMatch(m(n + 1), s);
        if(s == "")
          then __primitive("field value by num", rec, n) = tmp;
        else __primitive("field value by num", rec, n) = s:tmp.type;
        once = true;
      }
    }
    return (rec, once);
  }

}

}