Fixing bug in SingleLocaleAssociative these() iterator in
which deleted items could be yielded.

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

use List;

param _MIN_SIZE = 0;
param _MAX_SIZE = 26;

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

param _EMPTY   = -1;
param _DELETED = -2;
param _NOPLACE = -3;

record _ind_data_t {
  type itype;
  var  data: itype;
  var  valid: bool;
}

class SingleLocaleAssociativeDomain: BaseDomain {
  type ind_type;
  var _arrs2: list(BaseArray);    // WAW: unfortunately redundant list
  var num_inds: int;
  var size: int = 0;
  var table: _ddata(int);
  var inds: _ddata(_ind_data_t(ind_type));
  var free_inds: _stack(int);

  def getIndices()
    return this; // stopgap measure given old implementation

  def setIndices(b: SingleLocaleAssociativeDomain) {
    this = oldAssignHelper(this, b);
  }

  def buildEmptyDomain()
    return SingleLocaleAssociativeDomain(ind_type=ind_type);

  // compiler-internal routines

  def initialize() {
    table  = _ddata(int, _ps(size));
    table.init( _EMPTY);
    inds =  _ddata(_ind_data_t(ind_type), _ps(size)/2);
    inds.init();
    free_inds = _stack(int);
  }

  def these() {
    var i = 0;
    var numFound = 0;
    while numFound < num_inds {
      if (inds(i).valid) {
        numFound += 1;
        yield inds(i).data;
      }
      i += 1;
    }
  }

  // internal routines

  def _half() {
    if (size > _MIN_SIZE) {
      var new_len = _ps(size-1);

      var new_table = _ddata(int, new_len);
      new_table.init(_EMPTY);

      var new_inds = _ddata(_ind_data_t(ind_type), new_len/2);
      new_inds.init();
      var old_map: _ddata(int);
      old_map = _ddata( int, num_inds);
      old_map.init();
      var inds_count = 0;
      var inds_pos = 0;
      while inds_count<num_inds {
        var ind = inds(inds_pos);
        if (ind.valid) {
          old_map(inds_count) = table( _map(ind.data));
          new_inds(inds_count) = ind;
          new_table( _map(ind.data, new_table, new_inds)) = inds_count;
          inds_count += 1;
        }
        inds_pos += 1;
      }

      for ia in _arrs2 {
        ia._resize( new_len/2, old_map);
      }

      table = new_table;
      inds = new_inds;
      size -= 1;
      free_inds.empty();
    }
  }

  def _double() {
    if (size < _MAX_SIZE) {
      var new_len = _ps(size+1);

      var new_table = _ddata( int, new_len);
      new_table.init( _EMPTY);
      var new_inds = _ddata( _ind_data_t(ind_type), new_len/2);
      new_inds.init();
      var old_map: _ddata(int);
      old_map = _ddata( int, inds.size);
      old_map.init();
      for inds_pos in 0..inds.size-1 {
        var ind = inds(inds_pos);
        if (ind.valid) {                 // should be dense
          old_map(inds_pos) = table( _map(ind.data));
          new_inds(inds_pos) = ind;
          new_table( _map( ind.data, new_table, new_inds)) = inds_pos;
        } else {
          halt( "doubling without being full");
        }
      }

      for ia in _arrs2 {
        ia._resize( new_len/2, old_map);
      }

      table = new_table;
      inds = new_inds;
      size += 1;
      free_inds.empty();
    } else {
      halt( "cannot double indefinite domain");
    }
  }

  def _map(ind: ind_type,
           itable: _ddata(int) = table,
           iinds: _ddata(_ind_data_t(ind_type)) = inds,
           deletedOK: bool = false): int {
    param debug = false;
    if debug then writeln("itable.size = ", itable.size);
    const base = _indefinite_hash(ind);
    for probe in 0..itable.size {
      var i = ((base + probe**2) % itable.size):int(32);
      if debug then writeln("Trying i = ", i);
      var table_i = itable(i);
      if debug then writeln("table_i = ", table_i);
      select (table_i) {
        when _EMPTY {
          if debug then writeln("EMPTY");
          return i;
        }
        when _DELETED {
          if debug then writeln("DELETED");
          if deletedOK then
            return i;
          if debug then writeln("...but not OK");
        }
        otherwise {
          if debug then writeln("iinds(table_i).data = ", iinds(table_i).data);
          if iinds(table_i).data==ind then
            return i;
        }
      }
    }
    return _NOPLACE;
  }

  def _get_index(ind : ind_type) {
    var i = _map(ind);
    if (i >= 0) then
      return table(i);
    else
      halt( "index not found: ", ind);
    // will never get here, but to avoid compiler warnings:
    return 0;
  }

  def buildArray(type eltType) {
    var ia = SingleLocaleAssociativeArray(eltType, ind_type, dom=this);
    _arrs2.append(ia);
    return ia;
  }

  // public routines

  def add(ind : ind_type) {
    var hash = _map(ind, deletedOK = true);
    var ind_pos = table(hash);
    if (ind_pos==_EMPTY || ind_pos==_DELETED) {

      if (free_inds.length > 0) {      // recycle
        ind_pos = free_inds.pop();
      } else {
        if (num_inds == inds.size) {
          _double();
        }
        ind_pos = num_inds;
        hash = _map(ind, deletedOK = true);
      }
      table(hash) = ind_pos;
      inds(ind_pos).data = ind;
      inds(ind_pos).valid = true;
      num_inds += 1;
    } // else, already in domain
  }

  def remove( ind: ind_type) {
    var ind_pos = _map(ind);
    if (ind_pos >= 0) {
    var table_i = table(ind_pos);
    if (table_i >= 0) {
      inds(table_i).valid = false;
      num_inds -= 1;
      free_inds.push( table_i);
      table(ind_pos) = _DELETED;

      for ia in _arrs2 do
        ia.purge( table_i);
    }
    }

    if (size > _MIN_SIZE) then
      if (num_inds < _ps(size-1)/2) {  // downsize?
        _half();
      }
  }

  def member( ind: ind_type) {
    var ind_pos = table(_map(ind));
    return (ind_pos >= 0);
  }

  def numIndices {
    return num_inds;
  }
}

def oldAssignHelper(a: SingleLocaleAssociativeDomain, b: SingleLocaleAssociativeDomain) {
  var indices: list(a.ind_type);
  var inds_count = 0;
  var inds_pos = 0;
  var total_inds = a.num_inds;
  while inds_count<total_inds {
    var ind = a.inds( inds_pos);
    if (ind.valid) {
      indices.append(ind.data);
      inds_count += 1;
    }
    inds_pos += 1;
  }

  for ind in indices {
    if (!b.member(ind)) {
      a.remove( ind);
    }
  }

  inds_count = 0;
  inds_pos = 0;
  total_inds = b.num_inds;
  while inds_count<total_inds {
    var ind = b.inds( inds_pos);
    if (ind.valid) {
      if (!a.member(ind.data)) {
        a.add( ind.data);
      }
      inds_count += 1;
    }
    inds_pos += 1;
  }
  return a;  // WAW: YAH, "a" instead of "b" because we want to match keys, not do a deep copy (e.g., _arrs2)
}

def SingleLocaleAssociativeDomain.writeThis(f: Writer) {
  f.write("[");
  var inds_count = 0;
  var inds_pos = 0;
  while inds_count<num_inds {
    var ind = inds( inds_pos);
    if (ind.valid) {
      f.write(ind.data);
      inds_count += 1;
      if (inds_count<num_inds) then f.write(", ");
    }
    inds_pos += 1;
  }
  f.write("]");
}

class SingleLocaleAssociativeArray: BaseArray {
  type eltType;
  type ind_type;
  var dom : SingleLocaleAssociativeDomain(ind_type=ind_type);
  var data : _ddata(eltType);

  def initialize() {
    data = _ddata( eltType, _ps(0)/2);
    data.init();
  }

  def purge( ind: int) {
    var d: eltType;
    data( ind) = d;
  }

  def _resize( length: int, old_map: _ddata(int)) {
    var new_data: _ddata(eltType) = _ddata( eltType, length);
    new_data.init();
    for i in 0..old_map.size-1 {
      new_data(i) = data(old_map(i));
    }
    data = new_data;
  }

  def this(ind : ind_type) var : eltType
    return data(dom._get_index(ind));

  def these() var {
    for i in 0..dom.num_inds-1 do
      yield data(i);
  }

  // WAW: hack due to domain-array interface. The array is not reallocated
  // here. Values of indices not in the new domain are reset. The
  // domain assignment will perform the reallocation of each array that
  // maps to it.
  def reallocate(d: _domain) {
    if (d._value.type == dom.type) {
      var td = d._value;
      var inds_count = 0;
      var inds_pos = 0;
      while (inds_pos < dom.num_inds) && (inds_count < dom.inds.size) {
	var ind = dom.inds(inds_count);
	if ind.valid {
	  var i = td._map( ind.data);
	  if (i < 0) then {
	    purge( dom.table(dom._map( ind.data)));
	  }
	  inds_pos += 1;
	}
	inds_count += 1;
      }
    }
  }

  def numElements {
    return dom.numIndices;
  }
}

def SingleLocaleAssociativeArray.writeThis(f: Writer) {
  var inds_count = 0;
  var inds_pos = 0;
  while inds_count<dom.num_inds {
    var ind = dom.inds(inds_pos);
    if (ind.valid) {
      f.write(data(inds_pos));
      inds_count += 1;
      if (inds_count < dom.num_inds) then f.write(" ");
    }
    inds_pos += 1;
  }
}

// Thomas Wang's 64b mix function from http://www.concentric.net/~Ttwang/tech/inthash.htm
def _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 & 0x7fffffffffffffff;  // YAH, make non-negative
}

pragma "inline"
def _indefinite_hash(b: bool): int(64) {
  if (b)
    return 17;
  else
    return 31;
}

pragma "inline"
def _indefinite_hash(i: int(64)): int(64) {
  return _gen_key(i);
}

pragma "inline"
def _indefinite_hash(u: uint(64)): int(64) {
  return _gen_key(u:int(64));
}

pragma "inline"
def _indefinite_hash(f: real): int(64) {
  return _gen_key(__primitive( "real2int", f));
}

pragma "inline"
def _indefinite_hash(c: complex): int(64) {
  return _gen_key(c.re:int ^ c.im:int);
}

// Use djb2 (Dan Bernstein in comp.lang.c.
pragma "inline"
def _indefinite_hash(x : string): int(64) {
  var hash: int(64) = 0;
  for c in 1..length(x) {
    hash = ((hash << 5) + hash) ^ ascii(x.substring(c));
  }
  return _gen_key(hash);
}

pragma "inline"
def _indefinite_hash(o: object): int(64) {
  return _gen_key(__primitive( "object2int", o));
}

use List;

param _MIN_SIZE = 0;
param _MAX_SIZE = 26;

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

param _EMPTY   = -1;
param _DELETED = -2;
param _NOPLACE = -3;

record _ind_data_t {
  type itype;
  var  data: itype;
  var  valid: bool;
}

class SingleLocaleAssociativeDomain: BaseDomain {
  type ind_type;
  var _arrs2: list(BaseArray);    // WAW: unfortunately redundant list
  var num_inds: int;
  var size: int = 0;
  var table: _ddata(int);
  var inds: _ddata(_ind_data_t(ind_type));
  var free_inds: _stack(int);

  def getIndices()
    return this; // stopgap measure given old implementation

  def setIndices(b: SingleLocaleAssociativeDomain) {
    this = oldAssignHelper(this, b);
  }

  def buildEmptyDomain()
    return SingleLocaleAssociativeDomain(ind_type=ind_type);

  // compiler-internal routines

  def initialize() {
    table  = _ddata(int, _ps(size));
    table.init( _EMPTY);
    inds =  _ddata(_ind_data_t(ind_type), _ps(size)/2);
    inds.init();
    free_inds = _stack(int);
  }

  def these() {
    for i in 0..num_inds-1 do
      yield inds(i).data;
  }

  // internal routines

  def _half() {
    if (size > _MIN_SIZE) {
      var new_len = _ps(size-1);

      var new_table = _ddata(int, new_len);
      new_table.init(_EMPTY);

      var new_inds = _ddata(_ind_data_t(ind_type), new_len/2);
      new_inds.init();
      var old_map: _ddata(int);
      old_map = _ddata( int, num_inds);
      old_map.init();
      var inds_count = 0;
      var inds_pos = 0;
      while inds_count<num_inds {
        var ind = inds(inds_pos);
        if (ind.valid) {
          old_map(inds_count) = table( _map(ind.data));
          new_inds(inds_count) = ind;
          new_table( _map(ind.data, new_table, new_inds)) = inds_count;
          inds_count += 1;
        }
        inds_pos += 1;
      }

      for ia in _arrs2 {
        ia._resize( new_len/2, old_map);
      }

      table = new_table;
      inds = new_inds;
      size -= 1;
      free_inds.empty();
    }
  }

  def _double() {
    if (size < _MAX_SIZE) {
      var new_len = _ps(size+1);

      var new_table = _ddata( int, new_len);
      new_table.init( _EMPTY);
      var new_inds = _ddata( _ind_data_t(ind_type), new_len/2);
      new_inds.init();
      var old_map: _ddata(int);
      old_map = _ddata( int, inds.size);
      old_map.init();
      for inds_pos in 0..inds.size-1 {
        var ind = inds(inds_pos);
        if (ind.valid) {                 // should be dense
          old_map(inds_pos) = table( _map(ind.data));
          new_inds(inds_pos) = ind;
          new_table( _map( ind.data, new_table, new_inds)) = inds_pos;
        } else {
          halt( "doubling without being full");
        }
      }

      for ia in _arrs2 {
        ia._resize( new_len/2, old_map);
      }

      table = new_table;
      inds = new_inds;
      size += 1;
      free_inds.empty();
    } else {
      halt( "cannot double indefinite domain");
    }
  }

  def _map(ind: ind_type,
           itable: _ddata(int) = table,
           iinds: _ddata(_ind_data_t(ind_type)) = inds,
           deletedOK: bool = false): int {
    param debug = false;
    if debug then writeln("itable.size = ", itable.size);
    const base = _indefinite_hash(ind);
    for probe in 0..itable.size {
      var i = ((base + probe**2) % itable.size):int(32);
      if debug then writeln("Trying i = ", i);
      var table_i = itable(i);
      if debug then writeln("table_i = ", table_i);
      select (table_i) {
        when _EMPTY {
          if debug then writeln("EMPTY");
          return i;
        }
        when _DELETED {
          if debug then writeln("DELETED");
          if deletedOK then
            return i;
          if debug then writeln("...but not OK");
        }
        otherwise {
          if debug then writeln("iinds(table_i).data = ", iinds(table_i).data);
          if iinds(table_i).data==ind then
            return i;
        }
      }
    }
    return _NOPLACE;
  }

  def _get_index(ind : ind_type) {
    var i = _map(ind);
    if (i >= 0) then
      return table(i);
    else
      halt( "index not found: ", ind);
    // will never get here, but to avoid compiler warnings:
    return 0;
  }

  def buildArray(type eltType) {
    var ia = SingleLocaleAssociativeArray(eltType, ind_type, dom=this);
    _arrs2.append(ia);
    return ia;
  }

  // public routines

  def add(ind : ind_type) {
    var hash = _map(ind, deletedOK = true);
    var ind_pos = table(hash);
    if (ind_pos==_EMPTY || ind_pos==_DELETED) {

      if (free_inds.length > 0) {      // recycle
        ind_pos = free_inds.pop();
      } else {
        if (num_inds == inds.size) {
          _double();
        }
        ind_pos = num_inds;
        hash = _map(ind, deletedOK = true);
      }
      table(hash) = ind_pos;
      inds(ind_pos).data = ind;
      inds(ind_pos).valid = true;
      num_inds += 1;
    } // else, already in domain
  }

  def remove( ind: ind_type) {
    var ind_pos = _map(ind);
    if (ind_pos >= 0) {
    var table_i = table(ind_pos);
    if (table_i >= 0) {
      inds(table_i).valid = false;
      num_inds -= 1;
      free_inds.push( table_i);
      table(ind_pos) = _DELETED;

      for ia in _arrs2 do
        ia.purge( table_i);
    }
    }

    if (size > _MIN_SIZE) then
      if (num_inds < _ps(size-1)/2) {  // downsize?
        _half();
      }
  }

  def member( ind: ind_type) {
    var ind_pos = table(_map(ind));
    return (ind_pos >= 0);
  }

  def numIndices {
    return num_inds;
  }
}

def oldAssignHelper(a: SingleLocaleAssociativeDomain, b: SingleLocaleAssociativeDomain) {
  var indices: list(a.ind_type);
  var inds_count = 0;
  var inds_pos = 0;
  var total_inds = a.num_inds;
  while inds_count<total_inds {
    var ind = a.inds( inds_pos);
    if (ind.valid) {
      indices.append(ind.data);
      inds_count += 1;
    }
    inds_pos += 1;
  }

  for ind in indices {
    if (!b.member(ind)) {
      a.remove( ind);
    }
  }

  inds_count = 0;
  inds_pos = 0;
  total_inds = b.num_inds;
  while inds_count<total_inds {
    var ind = b.inds( inds_pos);
    if (ind.valid) {
      if (!a.member(ind.data)) {
        a.add( ind.data);
      }
      inds_count += 1;
    }
    inds_pos += 1;
  }
  return a;  // WAW: YAH, "a" instead of "b" because we want to match keys, not do a deep copy (e.g., _arrs2)
}

def SingleLocaleAssociativeDomain.writeThis(f: Writer) {
  f.write("[");
  var inds_count = 0;
  var inds_pos = 0;
  while inds_count<num_inds {
    var ind = inds( inds_pos);
    if (ind.valid) {
      f.write(ind.data);
      inds_count += 1;
      if (inds_count<num_inds) then f.write(", ");
    }
    inds_pos += 1;
  }
  f.write("]");
}

class SingleLocaleAssociativeArray: BaseArray {
  type eltType;
  type ind_type;
  var dom : SingleLocaleAssociativeDomain(ind_type=ind_type);
  var data : _ddata(eltType);

  def initialize() {
    data = _ddata( eltType, _ps(0)/2);
    data.init();
  }

  def purge( ind: int) {
    var d: eltType;
    data( ind) = d;
  }

  def _resize( length: int, old_map: _ddata(int)) {
    var new_data: _ddata(eltType) = _ddata( eltType, length);
    new_data.init();
    for i in 0..old_map.size-1 {
      new_data(i) = data(old_map(i));
    }
    data = new_data;
  }

  def this(ind : ind_type) var : eltType
    return data(dom._get_index(ind));

  def these() var {
    for i in 0..dom.num_inds-1 do
      yield data(i);
  }

  // WAW: hack due to domain-array interface. The array is not reallocated
  // here. Values of indices not in the new domain are reset. The
  // domain assignment will perform the reallocation of each array that
  // maps to it.
  def reallocate(d: _domain) {
    if (d._value.type == dom.type) {
      var td = d._value;
      var inds_count = 0;
      var inds_pos = 0;
      while (inds_pos < dom.num_inds) && (inds_count < dom.inds.size) {
	var ind = dom.inds(inds_count);
	if ind.valid {
	  var i = td._map( ind.data);
	  if (i < 0) then {
	    purge( dom.table(dom._map( ind.data)));
	  }
	  inds_pos += 1;
	}
	inds_count += 1;
      }
    }
  }

  def numElements {
    return dom.numIndices;
  }
}

def SingleLocaleAssociativeArray.writeThis(f: Writer) {
  var inds_count = 0;
  var inds_pos = 0;
  while inds_count<dom.num_inds {
    var ind = dom.inds(inds_pos);
    if (ind.valid) {
      f.write(data(inds_pos));
      inds_count += 1;
      if (inds_count < dom.num_inds) then f.write(" ");
    }
    inds_pos += 1;
  }
}

// Thomas Wang's 64b mix function from http://www.concentric.net/~Ttwang/tech/inthash.htm
def _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 & 0x7fffffffffffffff;  // YAH, make non-negative
}

pragma "inline"
def _indefinite_hash(b: bool): int(64) {
  if (b)
    return 17;
  else
    return 31;
}

pragma "inline"
def _indefinite_hash(i: int(64)): int(64) {
  return _gen_key(i);
}

pragma "inline"
def _indefinite_hash(u: uint(64)): int(64) {
  return _gen_key(u:int(64));
}

pragma "inline"
def _indefinite_hash(f: real): int(64) {
  return _gen_key(__primitive( "real2int", f));
}

pragma "inline"
def _indefinite_hash(c: complex): int(64) {
  return _gen_key(c.re:int ^ c.im:int);
}

// Use djb2 (Dan Bernstein in comp.lang.c.
pragma "inline"
def _indefinite_hash(x : string): int(64) {
  var hash: int(64) = 0;
  for c in 1..length(x) {
    hash = ((hash << 5) + hash) ^ ascii(x.substring(c));
  }
  return _gen_key(hash);
}

pragma "inline"
def _indefinite_hash(o: object): int(64) {
  return _gen_key(__primitive( "object2int", o));
}


Formatting updates to 99 bottles of beer code

I just noticed that the Chapel Wikipedia entry links to our 99 bottles
of beer entry (on the official site) and thought it needed some
modernizing/cleanup, so did the cleanup in this commit with the
intention of submitting an update.

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

/***********************************************************************
 * Chapel implementation of "99 bottles of beer"
 *
 * by Brad Chamberlain and Steve Deitz
 *
 * Original version written 07/13/2006 in Knoxville airport while
 * waiting for flight home from HPLS workshop.  Updated since then to
 * reflect syntax changes and language improvements.
 *
 * For more information, see http://chapel.cray.com
 *
 * Notes:
 * o as in all good parallel computations, boundary conditions
 *   constitute the vast bulk of complexity in this code
 * o uses type inference for most variables, arguments
 * o uses named argument passing for documentation purposes
 ***********************************************************************/

//
// Support executable command-line specification of number of bottles
// (e.g., ./beer --numBottles=999999)
//
config const numBottles = 99;

//
// Global constants and variables
//
const numVerses = numBottles+1;       // the number of verses to compute

const LyricsSpace  = {1..numVerses};  // the index set for the lyrics
var Lyrics: [LyricsSpace] string;     // array of lyrics

//
// compute the array of lyrics in parallel using a forall loop
//
forall verse in LyricsSpace do
  Lyrics[verse] = computeLyrics(verse);

//
// print the lyrics out to the console
//
writeln(Lyrics);

// ------------ Helper functions -------------

//
// Compute the lyrics for the verse #verseNum
//
proc computeLyrics(verseNum) {
  const bottleNum = numBottles - verseNum + 1,               // what are we on?
        nextBottle = (bottleNum + numVerses - 1)%numVerses;  // what's next?

  return "\n"
        + describeBottles(bottleNum, startOfVerse=true) + " on the wall, "
        + describeBottles(bottleNum) + ".\n"
        + computeAction(bottleNum)
        + describeBottles(nextBottle) + " on the wall.\n";
}

//
// Given a bottle number and whether or not we're at the start of the
// verse, generate the string "# bottles of beer on the wall" where
// # should result in "[N/n]o more" for zero bottles.
//
proc describeBottles(bottleNum, startOfVerse = false) {
  return (if (bottleNum) then bottleNum:string
                         else (if startOfVerse then "N"
                                               else "n") + "o more")
          + " bottle" + (if (bottleNum != 1) then "s" else "")
          + " of beer";
}

//
// Compute whether we'll go to the store or take another one down
//
proc computeAction(bottleNum) {
  return if (bottleNum == 0) then "Go to the store and buy some more, "
                             else "Take one down and pass it around, ";
}

/***********************************************************************
 * Chapel implementation of "99 bottles of beer"
 *
 * by Brad Chamberlain and Steve Deitz
 *
 * Original version written 07/13/2006 in Knoxville airport while
 * waiting for flight home from HPLS workshop.
 *
 * For more information, contact: chapel_info@cray.com
 *
 * modified 08/02/2006 to remove a workaround in the original version
 * modified 08/16/2006 to update syntax (fun -> def)
 * modified 06/12/2007 to clean up for June 2007 release: added main()
 *                     and some comments
 *
 * Notes:
 * o as in all good parallel computations, boundary conditions
 *   constitute the vast bulk of complexity in this code (invite Brad to
 *   tell you about his zany boundary condition simplification scheme)
 * o uses type inference for variables, arguments
 * o relies on integer->string coercions
 * o uses named argument passing (for documentation purposes only)
 ***********************************************************************/

// allow executable command-line specification of number of bottles
// (e.g., ./a.out -snumBottles=999999)
config const numBottles = 99;

// the program's entry point
proc main {
  // the number of verses to compute
  const numVerses = numBottles+1;

  // a domain to describe the space of lyrics
  var LyricsSpace: domain(1) = {1..numVerses};

  // array of lyrics
  var Lyrics: [LyricsSpace] string;

  // parallel computation of lyrics array using a forall expression
  //   "forall verse in LyricsSpace, Lyrics(verse) = ..."
  [verse in LyricsSpace] Lyrics(verse) = computeLyric(verse, numVerses);

  // as in any good parallel language, I/O to stdout is serialized.  ;)
  // (Note that I/O to a file could be parallelized using a parallel
  // prefix computation on the verse strings' lengths with file seeking)
  writeln(Lyrics);
}

// HELPER FUNCTIONS:

proc computeLyric(verseNum, numVerses) {
  var bottleNum = numBottles - (verseNum - 1);
  var nextBottle = (bottleNum + numVerses - 1)%numVerses;
  return "\n" // disguise space used to separate elements in array I/O
       + describeBottles(bottleNum, startOfVerse=true) + " on the wall, "
       + describeBottles(bottleNum) + ".\n"
       + computeAction(bottleNum)
       + describeBottles(nextBottle) + " on the wall.\n";
}

proc describeBottles(bottleNum, startOfVerse = false) {
  var bottleDescription = if (bottleNum) then bottleNum:string
                                         else (if startOfVerse then "N"
                                                               else "n")
                                              + "o more";
  return bottleDescription
       + " bottle" + (if (bottleNum == 1) then "" else "s")
       + " of beer";
}

proc computeAction(bottleNum) {
  return if (bottleNum == 0) then "Go to the store and buy some more, "
                             else "Take one down and pass it around, ";
}


Apply private to symbols in Time module with pragma "no doc" attached

These functions all seemed to be intended for module internal use, so I added
the private keyword to them.  Once chpldoc can recognize private, these
functions will no longer need the pragma.

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

/*
   This module provides support for querying wall time in the local
   timezone and implements a record :record:`~Timer` that provides basic
   stopwatch behavior.  The stopwatch has the potential for microsecond
   resolution and is intended to be useful for performance testing.
 */

module Time {

pragma "no doc"
// Returns the number of seconds since midnight.  Has the potential for
// microsecond resolution if supported by the runtime platform
private extern proc chpl_now_time():real;

pragma "no doc"
// This is comparable to a Posix struct timeval
extern type _timevalue;

pragma "no doc"
private extern proc chpl_null_timevalue(): _timevalue;

pragma "no doc"
// The number of seconds/microseconds since Jan 1, 1970 in UTC
private extern proc chpl_now_timevalue():  _timevalue;

pragma "no doc"
// The components of time in the local time zone
private extern proc chpl_timevalue_parts(t:           _timevalue,

                                         out seconds: int(32),
                                         out minutes: int(32),
                                         out hours:   int(32),
                                         out mday:    int(32),
                                         out month:   int(32),
                                         out year:    int(32),
                                         out wday:    int(32),
                                         out yday:    int(32),
                                         out isdst:   int(32));

/* Specifies the units to be used when certain functions return a time */
enum TimeUnits { microseconds, milliseconds, seconds, minutes, hours }

/* Specifies the day of the week */
enum Day       { sunday=0, monday, tuesday, wednesday, thursday, friday, saturday }

/*
   :arg  unit: The units for the returned value
   :type unit: TimeUnits

   :returns: The elapsed time since midnight, local time, in the units specified
   :rtype:   real(64)
 */
proc getCurrentTime(unit: TimeUnits = TimeUnits.seconds) : real(64)
  return _convert_microseconds(unit, chpl_now_time());

/*
   :returns:  (year, month, day) as a tuple of 3 ints

   The month is in the range 1 to 12.
   The day   is in the range 1 to 31
*/
proc getCurrentDate() {
  var now = chpl_now_timevalue();

  var seconds, minutes, hours, mday, month, year, wday, yday, isdst:int(32);

  chpl_timevalue_parts(now, seconds, minutes, hours, mday, month, year, wday, yday, isdst);

  return (year + 1900, month + 1, mday);
}

/*
   :returns: The current day of the week
   :rtype:   Day
 */
proc getCurrentDayOfWeek() : Day {
  var now = chpl_now_timevalue();

  var seconds, minutes, hours, mday, month, year, wday, yday, isdst:int(32);

  chpl_timevalue_parts(now, seconds, minutes, hours, mday, month, year, wday, yday, isdst);

  return wday : Day;
}

/* Delay a task for t seconds */
inline proc sleep(t: uint) : void {
  extern proc chpl_task_sleep(t:uint) : void;

  chpl_task_sleep(t);
}

/*
   Implements basic stopwatch behavior with a potential resolution of
   microseconds if supported by the runtime platform.

   The :record:`!Timer` can be started, stopped, and cleared.
   A :record:`!Timer` is either running or stopped.
*/

record Timer {
  pragma "no doc"
  var time:        _timevalue = chpl_null_timevalue();

  pragma "no doc"
  var accumulated: real       = 0.0;

  pragma "no doc"
  var running:     bool       = false;

  pragma "no doc"
  proc initialize() {
    // does nothing.
  }

  /*
     Clears the elapsed time. If the timer is running then it is restarted
     otherwise it remains in the stopped state.
  */
  proc clear() : void {
    accumulated = 0.0;

    if running {
      time = chpl_now_timevalue();
    }
  }

  /* Starts the timer. It is an error to start a timer that is already running. */
  proc start() : void {
    if !running {
      running = true;
      time    = chpl_now_timevalue();
    } else {
      halt("start called on a timer that has not been stopped");
    }
  }

  /* Stops the timer. It is an error to stop a timer that is not running. */
  proc stop() : void {
    if running {
      var time2: _timevalue = chpl_now_timevalue();

      accumulated += _diff_time(time2, time);
      running      = false;
    } else {
      halt("stop called on a timer that has not been started");
    }
  }

  /*
     Returns the cumulative elapsed time, in the units specified, between
     all pairs of calls to :proc:`~!Timer.start` and :proc:`~!Timer.stop`
     since the timer was created or the last call to :proc:`~!Timer.clear`.
     If the timer is running, the elapsed time since the last call to
     :proc:`~!Timer.start` is added to the return value.

     :arg  unit: The units for the returned value
     :type unit: TimeUnits

     :returns: The elapsed time in the units specified
     :rtype:   real(64)
  */
  proc elapsed(unit: TimeUnits = TimeUnits.seconds) : real {
    if running {
      var time2: _timevalue = chpl_now_timevalue();

      return _convert_microseconds(unit, accumulated + _diff_time(time2, time));
    } else {
      return _convert_microseconds(unit, accumulated);
    }
  }
}

// returns diff of two time values in microseconds
pragma "no doc"
private inline proc _diff_time(t1: _timevalue, t2: _timevalue) {
  extern proc chpl_timevalue_seconds(t:_timevalue):      int(64);
  extern proc chpl_timevalue_microseconds(t:_timevalue): int(64);

  var s1  = chpl_timevalue_seconds(t1);
  var us1 = chpl_timevalue_microseconds(t1);

  var s2  = chpl_timevalue_seconds(t2);
  var us2 = chpl_timevalue_microseconds(t2);

  return (s1 * 1.0e+6 + us1) - (s2 * 1.0e+6 + us2);
}

// converts microseconds to another unit
pragma "no doc"
private proc _convert_microseconds(unit: TimeUnits, us: real) {
  select unit {
    when TimeUnits.microseconds do return us;
    when TimeUnits.milliseconds do return us /    1.0e+3;
    when TimeUnits.seconds      do return us /    1.0e+6;
    when TimeUnits.minutes      do return us /   60.0e+6;
    when TimeUnits.hours        do return us / 3600.0e+6;
  }

  halt("internal error in module Time");

  // will never get here, but to avoid warnings:
  return -1.0;
}

}

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

/*
   This module provides support for querying wall time in the local
   timezone and implements a record :record:`~Timer` that provides basic
   stopwatch behavior.  The stopwatch has the potential for microsecond
   resolution and is intended to be useful for performance testing.
 */

module Time {

pragma "no doc"
// Returns the number of seconds since midnight.  Has the potential for
// microsecond resolution if supported by the runtime platform
extern proc chpl_now_time():real;

pragma "no doc"
// This is comparable to a Posix struct timeval
extern type _timevalue;

pragma "no doc"
extern proc chpl_null_timevalue(): _timevalue;

pragma "no doc"
// The number of seconds/microseconds since Jan 1, 1970 in UTC
extern proc chpl_now_timevalue():  _timevalue;

pragma "no doc"
// The components of time in the local time zone
extern proc chpl_timevalue_parts(t:           _timevalue,

                                 out seconds: int(32),
                                 out minutes: int(32),
                                 out hours:   int(32),
                                 out mday:    int(32),
                                 out month:   int(32),
                                 out year:    int(32),
                                 out wday:    int(32),
                                 out yday:    int(32),
                                 out isdst:   int(32));

/* Specifies the units to be used when certain functions return a time */
enum TimeUnits { microseconds, milliseconds, seconds, minutes, hours }

/* Specifies the day of the week */
enum Day       { sunday=0, monday, tuesday, wednesday, thursday, friday, saturday }

/*
   :arg  unit: The units for the returned value
   :type unit: TimeUnits

   :returns: The elapsed time since midnight, local time, in the units specified
   :rtype:   real(64)
 */
proc getCurrentTime(unit: TimeUnits = TimeUnits.seconds) : real(64)
  return _convert_microseconds(unit, chpl_now_time());

/*
   :returns:  (year, month, day) as a tuple of 3 ints

   The month is in the range 1 to 12.
   The day   is in the range 1 to 31
*/
proc getCurrentDate() {
  var now = chpl_now_timevalue();

  var seconds, minutes, hours, mday, month, year, wday, yday, isdst:int(32);

  chpl_timevalue_parts(now, seconds, minutes, hours, mday, month, year, wday, yday, isdst);

  return (year + 1900, month + 1, mday);
}

/*
   :returns: The current day of the week
   :rtype:   Day
 */
proc getCurrentDayOfWeek() : Day {
  var now = chpl_now_timevalue();

  var seconds, minutes, hours, mday, month, year, wday, yday, isdst:int(32);

  chpl_timevalue_parts(now, seconds, minutes, hours, mday, month, year, wday, yday, isdst);

  return wday : Day;
}

/* Delay a task for t seconds */
inline proc sleep(t: uint) : void {
  extern proc chpl_task_sleep(t:uint) : void;

  chpl_task_sleep(t);
}

/*
   Implements basic stopwatch behavior with a potential resolution of
   microseconds if supported by the runtime platform.

   The :record:`!Timer` can be started, stopped, and cleared.
   A :record:`!Timer` is either running or stopped.
*/

record Timer {
  pragma "no doc"
  var time:        _timevalue = chpl_null_timevalue();

  pragma "no doc"
  var accumulated: real       = 0.0;

  pragma "no doc"
  var running:     bool       = false;

  pragma "no doc"
  proc initialize() {
    // does nothing.
  }

  /*
     Clears the elapsed time. If the timer is running then it is restarted
     otherwise it remains in the stopped state.
  */
  proc clear() : void {
    accumulated = 0.0;

    if running {
      time = chpl_now_timevalue();
    }
  }

  /* Starts the timer. It is an error to start a timer that is already running. */
  proc start() : void {
    if !running {
      running = true;
      time    = chpl_now_timevalue();
    } else {
      halt("start called on a timer that has not been stopped");
    }
  }

  /* Stops the timer. It is an error to stop a timer that is not running. */
  proc stop() : void {
    if running {
      var time2: _timevalue = chpl_now_timevalue();

      accumulated += _diff_time(time2, time);
      running      = false;
    } else {
      halt("stop called on a timer that has not been started");
    }
  }

  /*
     Returns the cumulative elapsed time, in the units specified, between
     all pairs of calls to :proc:`~!Timer.start` and :proc:`~!Timer.stop`
     since the timer was created or the last call to :proc:`~!Timer.clear`.
     If the timer is running, the elapsed time since the last call to
     :proc:`~!Timer.start` is added to the return value.

     :arg  unit: The units for the returned value
     :type unit: TimeUnits

     :returns: The elapsed time in the units specified
     :rtype:   real(64)
  */
  proc elapsed(unit: TimeUnits = TimeUnits.seconds) : real {
    if running {
      var time2: _timevalue = chpl_now_timevalue();

      return _convert_microseconds(unit, accumulated + _diff_time(time2, time));
    } else {
      return _convert_microseconds(unit, accumulated);
    }
  }
}

// returns diff of two time values in microseconds
pragma "no doc"
inline proc _diff_time(t1: _timevalue, t2: _timevalue) {
  extern proc chpl_timevalue_seconds(t:_timevalue):      int(64);
  extern proc chpl_timevalue_microseconds(t:_timevalue): int(64);

  var s1  = chpl_timevalue_seconds(t1);
  var us1 = chpl_timevalue_microseconds(t1);

  var s2  = chpl_timevalue_seconds(t2);
  var us2 = chpl_timevalue_microseconds(t2);

  return (s1 * 1.0e+6 + us1) - (s2 * 1.0e+6 + us2);
}

// converts microseconds to another unit
pragma "no doc"
proc _convert_microseconds(unit: TimeUnits, us: real) {
  select unit {
    when TimeUnits.microseconds do return us;
    when TimeUnits.milliseconds do return us /    1.0e+3;
    when TimeUnits.seconds      do return us /    1.0e+6;
    when TimeUnits.minutes      do return us /   60.0e+6;
    when TimeUnits.hours        do return us / 3600.0e+6;
  }

  halt("internal error in module Time");

  // will never get here, but to avoid warnings:
  return -1.0;
}

}


fix race in test forall-begin-private-indices.chpl

I think there is a race in this test between finishing all the begin blocks and
writing out the array.  There is no synchronization after the  begins have
finished.  This is a good place to use the new end construct.  That seems to
fix the test.

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

config const sourceText = "<ii>end</ii><none />";
const AllIndices: domain(1) = [1..length(sourceText)];
const AllPairs: domain(2) = [1..length(sourceText),
                             1..length(sourceText)];
var StartIndices: sparse subdomain(AllIndices);
var EndIndices: sparse subdomain(AllIndices);

def main {
  forall z in AllIndices do {
    if sourceText.substring[z] == '<' then {
      StartIndices += z;
      if z > 1 && sourceText.substring[z-1] != ">" then
      EndIndices += z-1;
    }
    else if sourceText.substring[z] == '>' then {
      EndIndices += z;
      if z < length(sourceText) &&
      sourceText.substring[z+1] != "<"  then StartIndices +=
      z+1;
    }
  }

  var A: [AllPairs] real;
  end {
    for (x,y) in [StartIndices, EndIndices] {
      begin {
        if (x <= y) {
          A[x, y] = x + y/10.0;
        }
      }
    }
  }
  writeln("A is:\n", A);
  return;
}

config const sourceText = "<ii>end</ii><none />";
const AllIndices: domain(1) = [1..length(sourceText)];
const AllPairs: domain(2) = [1..length(sourceText),
                             1..length(sourceText)];
var StartIndices: sparse subdomain(AllIndices);
var EndIndices: sparse subdomain(AllIndices);

def main {
  forall z in AllIndices do {
    if sourceText.substring[z] == '<' then {
      StartIndices += z;
      if z > 1 && sourceText.substring[z-1] != ">" then
      EndIndices += z-1;
    }
    else if sourceText.substring[z] == '>' then {
      EndIndices += z;
      if z < length(sourceText) &&
      sourceText.substring[z+1] != "<"  then StartIndices +=
      z+1;
    }
  }

  var A: [AllPairs] real;
  for (x,y) in [StartIndices, EndIndices] {
    begin {
      if (x <= y) {
         A[x, y] = x + y/10.0;
      }
    }
  }
  writeln("A is:\n", A);
  return;
}