Update prime iters to work when only one prime is requested.

Previously, they would both enter infinite loop when single prime requested.

/*
 * Math helper functions.
 */

use Containers;

// requires CHPL_GMP=gmp or system
use GMP;

// factorial(n) / (factorial(k) * factorial(n - k));
proc choose(n: int, k: int): BigInt {
  var result = factorial(n);
  result.div_q(Round.ZERO, result, factorial(k));
  result.div_q(Round.ZERO, result, factorial(n - k));
  return result;
}

// Yields proper divisors of n. Proper divisors of n are numbers less than n
// which divide evenly into n.
iter divisors(n) {
  var current = 1;

  while current <= n / 2 {
    yield current;

    do {
      current += 1;
    } while n % current != 0;
  }
}

// n!
proc factorial(n: int): BigInt {
  if n < 0 {
    halt("Error! non-positive factorial!?");
  } else if n == 0 {
    return new BigInt(1);
  } else {
    var result = factorial(n - 1);
    result.mul_ui(result, n: c_ulong);
    return result;
  }
}

// Print the Fibonacci number less than and equal to 4 million.
iter fibonacci(): BigInt {
  var current = new BigInt(1),
    next = new BigInt(1),
    tmp: BigInt;
  while true {
    yield current;

    current.add(current, next);
    current <=> next;
  }
}

// This is a fairly optimized version of calculating if a number is prime or
// not.
// See: http://stackoverflow.com/a/15285588
proc isPrime(number) {
  if number == 2 || number == 3 {
    return true;
  } else if number < 2 || number % 2 == 0 {
    return false;
  } else if number < 9 {
    return true;
  } else if number % 3 == 0 {
    return false;
  }

  var r = (number ** 0.5): uint,
    f: uint = 5;
  while (f <= r) {
    if number % f == 0 {
      return false;
    } else if number % (f + 2) == 0 {
      return false;
    }
    f += 6;
  }
  return true;
}

// Sieve of Eratosthenes
// Generates first k prime numbers.
//
// Inspired by: http://stackoverflow.com/a/568618
// And:         http://code.activestate.com/recipes/117119/#c4
iter primes(k: uint, param debug=false): uint {
  if k >= 1 then
    yield 2;

  // If only one prime requested, stop here.
  if k == 1 then
    return;

  var i: uint = 1,
    q: uint = 3;
  var D: domain(uint),
    A: [D] uint;

  while true {
    if ! D.member(q) {
      if debug then
        assert(isPrime(q));

      yield q;

      i += 1;
      if i == k then
        break;

      A[q * q] = 2 * q;
    } else {
      const p = A[q];
      var pq = p + q;
      while D.member(pq) do
        pq += p;
      A[pq] = p;
      D -= q;
    }
    q += 2;
  }
}

// Sieve of Eratosthenes up to max value.
// Generates prime numbers less than or equal to `m`.
iter primesUpTo(m: uint, param debug=false): uint {
  if m < 2 then
    halt("no primes less than 2");

  if m >= 2 then
    yield 2;

  if m == 2 then
    return;

  var q: uint = 3,
    D: domain(uint),
    A: [D] uint;

  while q <= m {
    if ! D.member(q) {
      if debug then
        assert(isPrime(q));

      yield q;

      A[q * q] = 2 * q;
    } else {
      const p = A[q];
      var pq = p + q;
      while D.member(pq) do
        pq += p;
      A[pq] = p;
      D -= q;
    }
    q += 2;
  }
}

/* // Yield the first `k` prime numbers as BigInts. */
/* iter bigPrimes(k: int(64)): BigInt { */
/*   var i = 0, */
/*     q = new BigInt(2); */
/*   var D: domain(BigInt); */
/*   var A: [D] domain(BigInt); */

/*   while true { */
/*     if ! D.member(q) { */
/*       yield q; */
/*       i += 1; */
/*       var qSquared = new BigInt(); */
/*       qSquared.mul(q, q); */
/*       D += qSquared; */
/*       A[qSquared] += q; */
/*     } else { */
/*       for p in A[q] { */
/*         var pq = new BigInt(); */
/*         pq.add(p, q); */
/*         D += pq; */
/*         A[pq] = p; */
/*       } */
/*       D.remove(q); */
/*     } */
/*     if i == k { */
/*       break; */
/*     } */
/*     q += 1; */
/*   } */
/* } */

// Returns sum of individual digits of n. n is serialized as string, then each
// character is cast to an int, and added together.
proc sumDigits(n) {
  var nStr = n: string,
    result = 0;
  for i in 1..nStr.length {
    result += nStr.substring(i): int;
  }
  return result;
}

// Returns sum of all divisors of n.
proc sumDivisors(n) {
  var sum = 0;
  for i in divisors(n) {
    sum += i;
  }
  return sum;
}

/*
 * Math helper functions.
 */

use Containers;

// requires CHPL_GMP=gmp or system
use GMP;

// factorial(n) / (factorial(k) * factorial(n - k));
proc choose(n: int, k: int): BigInt {
  var result = factorial(n);
  result.div_q(Round.ZERO, result, factorial(k));
  result.div_q(Round.ZERO, result, factorial(n - k));
  return result;
}

// Yields proper divisors of n. Proper divisors of n are numbers less than n
// which divide evenly into n.
iter divisors(n) {
  var current = 1;

  while current <= n / 2 {
    yield current;

    do {
      current += 1;
    } while n % current != 0;
  }
}

// n!
proc factorial(n: int): BigInt {
  if n < 0 {
    halt("Error! non-positive factorial!?");
  } else if n == 0 {
    return new BigInt(1);
  } else {
    var result = factorial(n - 1);
    result.mul_ui(result, n: c_ulong);
    return result;
  }
}

// Print the Fibonacci number less than and equal to 4 million.
iter fibonacci(): BigInt {
  var current = new BigInt(1),
    next = new BigInt(1),
    tmp: BigInt;
  while true {
    yield current;

    current.add(current, next);
    current <=> next;
  }
}

// This is a fairly optimized version of calculating if a number is prime or
// not.
// See: http://stackoverflow.com/a/15285588
proc isPrime(number) {
  if number == 2 || number == 3 {
    return true;
  } else if number < 2 || number % 2 == 0 {
    return false;
  } else if number < 9 {
    return true;
  } else if number % 3 == 0 {
    return false;
  }

  var r = (number ** 0.5): uint,
    f: uint = 5;
  while (f <= r) {
    if number % f == 0 {
      return false;
    } else if number % (f + 2) == 0 {
      return false;
    }
    f += 6;
  }
  return true;
}

// Sieve of Eratosthenes
// Generates first k prime numbers.
//
// Inspired by: http://stackoverflow.com/a/568618
// And:         http://code.activestate.com/recipes/117119/#c4
iter primes(k: uint, param debug=false): uint {
  if k >= 1 then
    yield 2;

  var i: uint = 1,
    q: uint = 3;
  var D: domain(uint),
    A: [D] uint;

  while true {
    if ! D.member(q) {
      if debug then
        assert(isPrime(q));

      yield q;

      i += 1;
      if i == k then
        break;

      A[q * q] = 2 * q;
    } else {
      const p = A[q];
      var pq = p + q;
      while D.member(pq) do
        pq += p;
      A[pq] = p;
      D -= q;
    }
    q += 2;
  }
}

// Sieve of Eratosthenes up to max value.
// Generates prime numbers less than or equal to `m`.
iter primesUpTo(m: uint, param debug=false): uint {
  if m < 2 then
    halt("no primes less than 2");

  if m >= 2 then
    yield 2;

  var q: uint = 3,
    D: domain(uint),
    A: [D] uint;

  while q <= m {
    if ! D.member(q) {
      if debug then
        assert(isPrime(q));

      yield q;

      A[q * q] = 2 * q;
    } else {
      const p = A[q];
      var pq = p + q;
      while D.member(pq) do
        pq += p;
      A[pq] = p;
      D -= q;
    }
    q += 2;
  }
}

/* // Yield the first `k` prime numbers as BigInts. */
/* iter bigPrimes(k: int(64)): BigInt { */
/*   var i = 0, */
/*     q = new BigInt(2); */
/*   var D: domain(BigInt); */
/*   var A: [D] domain(BigInt); */

/*   while true { */
/*     if ! D.member(q) { */
/*       yield q; */
/*       i += 1; */
/*       var qSquared = new BigInt(); */
/*       qSquared.mul(q, q); */
/*       D += qSquared; */
/*       A[qSquared] += q; */
/*     } else { */
/*       for p in A[q] { */
/*         var pq = new BigInt(); */
/*         pq.add(p, q); */
/*         D += pq; */
/*         A[pq] = p; */
/*       } */
/*       D.remove(q); */
/*     } */
/*     if i == k { */
/*       break; */
/*     } */
/*     q += 1; */
/*   } */
/* } */

// Returns sum of individual digits of n. n is serialized as string, then each
// character is cast to an int, and added together.
proc sumDigits(n) {
  var nStr = n: string,
    result = 0;
  for i in 1..nStr.length {
    result += nStr.substring(i): int;
  }
  return result;
}

// Returns sum of all divisors of n.
proc sumDivisors(n) {
  var sum = 0;
  for i in divisors(n) {
    sum += i;
  }
  return sum;
}


Update to r20327

Update to r20327

Forgot to commit SSCA2_kernels.chpl in r20327 (add num_edges).

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

module SSCA2_kernels

//  +==========================================================================+
//  |  Polymorphic Implementation of SSCA #2, Kernels 2-4                      |
//  |                                                                          |
//  |  Each kernel takes a graph argument which provides for each vertex       |
//  |  1.  an iterator for its set of neighbors                                |
//  |  2.  a parallel integer array of edge weights, which can be zipper       |
//  |      iterated with the set of neighbors                                  |
//  |  3.  the number of neighbors                                             |
//  |                                                                          |
//  |  These are the only requirements on the representation of the graph.     |
//  |                                                                          |
//  |  Filtering in Kernel 4 is turned on or off by a compilation time param.  |
//  +==========================================================================+

{
  use SSCA2_compilation_config_params, Time;

  var stopwatch : Timer;

  // ========================================================
  //                           KERNEL 2:
  // ========================================================
  // Find the edges with the largest edges.  Return a list of
  // edges, all of which have the largest weight.
  // ========================================================

  proc largest_edges ( G, heavy_edge_list :domain )

    // edge_weights can be either an array over an associative
    // domain or over a sparse domain.  the output  heavy_edge_list
    // can either kind of domain or something else purpose-built
    // for this task.
    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      // ---------------------------------------------------------
      // find heaviest edge weight in a single pass over all edges
      // ---------------------------------------------------------

      proc maxweight(s) {
	var mymax = 0;
	for w in G.edge_weight[s] do
	  if w > mymax then mymax = w;
	return mymax;
      }

      const heaviest_edge_weight = max reduce [s in G.vertices] maxweight(s);

      // ---------------------------------------------
      // in a second pass over all edges, extract list
      // of all edges  matching the heaviest weight
      // ---------------------------------------------

      forall s in G.vertices do
        forall (t, w) in G.NeighborPairs (s) do

	  if w == heaviest_edge_weight then {
	    heavy_edge_list.add ( (s,t) );
	  };

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 2: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }

      // ------------------------------------------------
      // should be able to write a user-defined "maxlocs"
      // reduction more efficiently than this scheme
      // ------------------------------------------------

      if DEBUG_KERNEL2 then {
	writeln ();
	writeln ( "Heaviest weight      : ", heaviest_edge_weight);
	writeln ( "Number of heavy edges:", heavy_edge_list.numIndices );
	writeln ();
	writeln ( "Edges with largest weight and other neighbors:" );
	for (s,t) in heavy_edge_list do {
	  writeln ("edge   ", (s,t));
	  for (v,w) in G.NeighborPairs (s) do
	    writeln ("      ", v, " ", w);}
      }
    };

  // ===================================================================
  //                              KERNEL 3:
  // ===================================================================
  // For each root (heavy) edge, find the subgraph (vertices and edges)
  // defined by directed paths of length no greater than max_path_length
  // in which the first edge traversed is the root edge
  // ===================================================================

  proc rooted_heavy_subgraphs ( G,
                                Heavy_Edge_List     : domain,
                                Heavy_Edge_Subgraph : [],
                                in max_path_length  : int )

    // -------------------------------------------------------------------------
    // there is a classic space versus time tradeoff.  if the subgraphs expanded
    // by breadth first search are small, it would make sense to use a hash
    // table or an associative domain to represent the search.  If the subgraphs
    // are large, using a full length vector to represent the search is more
    // appropriate.  We expect small diameters for power law graphs, so we
    // expect large subgraphs.
    // -------------------------------------------------------------------------

    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      const vertex_domain = G.vertices;

      forall ( x, y ) in Heavy_Edge_List do {
	var Active_Level, Next_Level : domain ( index (vertex_domain) );
	var min_distance             : [vertex_domain] atomic int;
        forall m in min_distance do m.write(-1);

	if DEBUG_KERNEL3 then
	  writeln ( " Building heavy edge subgraph from pair:", (x,y) );
	Active_Level.add ( y );
	Next_Level.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).nodes.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).edges.clear ();
	min_distance ( y ).write(0);

	Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (x, y) );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( x );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( y );

	for path_length in 1 .. max_path_length do {

	  forall v in Active_Level do {

	    forall w in G.Neighbors (v) do {

              if min_distance(w).compareExchangeStrong(-1, path_length) then {
                Next_Level.add (w);
                Heavy_Edge_Subgraph ( (x, y) ).nodes.add (w);
	      }

	      if min_distance(w).read() == path_length then {
		Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (v, w) );
	      }
	    }
	  }

	  if path_length < max_path_length then {
	    Active_Level = Next_Level;
	    Next_Level.clear ();
	  }
	}
      }

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 3: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }
    } // end of rooted_heavy_subgraphs

  use BlockDist;
  // Would be nice to use PriavteDist, but aliasing is not supported (yet)
  const PrivateSpace = {LocaleSpace} dmapped Block(boundingBox={LocaleSpace});

  // ==================================================================
  //                              KERNEL 4
  // ==================================================================
  // Calculate Betweenness Centrality for simple unweighted directed or
  // undirected graphs, using Madduri, et.al.'s modification of
  // Brandes's 2001 algorithm
  // ==================================================================

  proc approximate_betweenness_centrality ( G, starting_vertices,
                                            Between_Cent : [] real,
                                            out Sum_Min_Dist : real )

    // -----------------------------------------------------------------------
    // The betweenness centrality metric for a given node  v  is defined
    // as the double sum over s not equal to v and  t not equal to
    // either s or v of the ratio of the number of shortest paths from s to t
    // passing through v to the number of shortest paths from s to t.
    //
    // Brandes's algorithm decomposes the computation of this metric into,
    // first, separate sums for each vertex s, which can be computed
    // independently in parallel, and
    // two, a recursive, tree-based, calculation of the path counts for
    // any particular s.
    // The complexity of this algorithm is O ( |V||E| ) time for an unweighted
    // graph.  The algorithm requires O ( |V| ) temporary space for each
    // process that executes instances of the outermost loop.
    // -----------------------------------------------------------------------
    {
      const vertex_domain = G.vertices;

      // Considering using a dense 1-d array instead.  This would
      // complicate the Level_Set implementation a little, but would
      // probably be more efficient.
      type Sparse_Vertex_List = domain(index(vertex_domain));

      var Between_Cent$ : [vertex_domain] sync real = 0.0;
      var Sum_Min_Dist$ : sync real = 0.0;

      //
      // Throughout kernel 4, we use distributed arrays that are
      // private to each iteration of the outer loop.  Because set-up
      // and clean-up of such variables is very expensive, it is
      // desirable to do it at most only once per task versus once
      // per iteration, as a task executes multiple iterations of a
      // forall loop.
      //
      // To avoid this per-iteration overhead, we have implemented
      // an optimization that make certain variables private to each
      // task.  These variables are reinitialized each iteration of
      // the loop, but not reallocated, reprivatized, etc.
      //
      // Note that the Chapel group and collaborators are currently in
      // the process of bringing the idea of task private variable to
      // the language.
      //

      // Initialize task private data
      var localePrivate: [PrivateSpace] localePrivateData(vertex_domain.type);
      coforall l in localePrivate do on l {
        l = new localePrivateData(vertex_domain);
        // put in initialize()
        for t in l.temps { // this might be bad for first-touch
          t = new taskPrivateData(domain(index(vertex_domain)), vertex_domain);
          forall v in vertex_domain do
            t.BCaux[v].children_list.nd = {1..G.n_Neighbors[v]};
          for loc in Locales do on loc {
              t.Active_Level[here.id] = new Level_Set (Sparse_Vertex_List);
              t.Active_Level[here.id].previous = nil;
              t.Active_Level[here.id].next = new Level_Set (Sparse_Vertex_List);;
              t.Active_Level[here.id].next.previous = t.Active_Level[here.id];
              t.Active_Level[here.id].next.next = nil;
          }
        }
      }

      // ------------------------------------------------------
      // Each iteration of the outer loop of Brandes's algorithm
      // computes the contribution (the "dependency" metric) for
      // one particular vertex  (s)  independently.
      // ------------------------------------------------------

      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      forall s in starting_vertices do on vertex_domain.dist.idxToLocale(s) {

        const shere = here.id;

	if DEBUG_KERNEL4 then writeln ( "expanding from starting node ", s );

        // Initialize task private variables
        const lp = localePrivate[here.id];
        const tid = lp.get_tid();
        var BCaux => lp.get_BCaux(tid);
        pragma "dont disable remote value forwarding"
          inline proc f1(BCaux, v) {
          BCaux[v].path_count$.writeXF(0.0);
        }
        forall v in vertex_domain do {
          BCaux[v].depend = 0.0;
          BCaux[v].min_distance.write(-1);
          // BCaux[v].path_count$.writeXF(0.0);
          f1(BCaux, v);
          BCaux[v].children_list.child_count.write(0);
        }
	var Lcl_Sum_Min_Dist: sync real = 0.0;

	// The structure of the algorithm depends on a breadth-first
	// traversal. Each vertex will be marked by the length of
	// the shortest path (min_distance) from s to it. The array
	// path_count$ will hold a count of the number of shortest
	// paths from s to this node.  The number of paths in moderate
	// sized tori exceeds 2**64.

        //
        // Used to check termination of the forward pass
        //
        // We could use a task-private reduction variable here.  This
        // is yet another concept that the Chapel group is planning to
        // implement.
        //

        var remaining = true;

        //
        // Each locale will have its own level sets.  A locale's level set
        // will only contain nodes that are physically allocated on that
        // particular locale.
        //
        var Active_Level => lp.get_Active_Level(tid);
        pragma "dont disable remote value forwarding"
          inline proc f2(BCaux, s) {
          BCaux[s].path_count$.writeXF(1);
        }

        var barrier = new Barrier(numLocales);

        coforall loc in Locales do on loc {
          Active_Level[here.id].Members.clear();
          Active_Level[here.id].next.Members.clear();
          if vertex_domain.dist.idxToLocale(s) == here {
            // Establish the initial level sets for the breadth-first
            // traversal from s
            Active_Level[here.id].Members.add(s);
            BCaux[s].min_distance.write(0);
            // BCaux[s].path_count$.writeXF(1);
            f2(BCaux, s);
          }
          barrier.barrier();

          var current_distance : int = 0;

          while remaining do {
	    // ------------------------------------------------
	    // expand the neighbor sets for all vertices at the
	    // current distance from the starting vertex  s
	    // ------------------------------------------------

	    current_distance += 1;

            // The Chapel compiler is still a bit conservative when it
            // comes to forwarding read-only variables to remote
            // locales, so we make a const copy here to insure it is
            // forwarded to the remote locale in the following
            // coforall loop.
            const current_distance_c = current_distance;
            pragma "dont disable remote value forwarding"
              inline proc f3(BCaux, v, u) {
              BCaux[v].path_count$ += BCaux[u].path_count$.readFF();
            }

            forall u in Active_Level[here.id].Members do {
              forall v in G.FilteredNeighbors(u) do
                on vertex_domain.dist.idxToLocale(v) {
                  // --------------------------------------------
                  // add any unmarked neighbors to the next level
                  // --------------------------------------------

                  if  BCaux[v].min_distance.compareExchangeStrong(-1, current_distance_c) {
                    Active_Level[here.id].next.Members.add (v);
                    if VALIDATE_BC then
                      Lcl_Sum_Min_Dist += current_distance_c;
                  }

                  // ------------------------------------------------
                  // only neighbors of  u  that are in the next level
                  // are on shortest paths from s through v.  Some
                  // task will have set  min_distance (v) by the
                  // time this code is reached, whether  v  lies in
                  // the previous, the current or the next level.
                  // ------------------------------------------------

                  if BCaux[v].min_distance.read() == current_distance_c {
                    // BCaux[v].path_count$ += BCaux[u].path_count$.readFF();
                    f3(BCaux, v, u);
                    BCaux[u].children_list.add_child (v);
                  }

                }
            };

            // This barrier is needed to insure all updates to the next
            // level are completed before updating to use the next level

            // do some work while we wait
            // barrier.notify(); // This is expensive without network atomics
            //  for now, just do a normal barrier

            if Active_Level[here.id].next.next == nil {
              Active_Level[here.id].next.next = new Level_Set (Sparse_Vertex_List);
              Active_Level[here.id].next.next.previous = Active_Level[here.id].next;
              Active_Level[here.id].next.next.next = nil;
            } else {
              Active_Level[here.id].next.next.Members.clear();
            }
            // barrier.wait(); // ditto
            barrier.barrier();
            if here.id==shere {
              remaining = false;
            }

            barrier.barrier();
            Active_Level[here.id] = Active_Level[here.id].next;
            if Active_Level[here.id].Members.numIndices:bool then
              remaining = true;

            barrier.barrier();

          };  // end forward pass

          if here.id==0 {
            if VALIDATE_BC then
              Sum_Min_Dist$ += Lcl_Sum_Min_Dist;
          }

          // -------------------------------------------------------------
          // compute the dependencies recursively, traversing the vertices
          // of the graph in non-increasing order of distance (reverse
          // ordering from the initial traversal)
          // -------------------------------------------------------------

          const graph_diameter = current_distance - 1;

          if here.id==0 {
            if DEBUG_KERNEL4 then
              writeln ( " graph diameter from starting node ", s,
                        "  is ", graph_diameter );
          }

          pragma "dont disable remote value forwarding"
            inline proc f4(BCaux, Between_Cent$, u) {
            BCaux[u].depend = + reduce [v in BCaux[u].children_list.Row_Children[1..BCaux[u].children_list.child_count.read()]]
              ( BCaux[u].path_count$.readFF() /
                BCaux[v].path_count$.readFF() )      *
              ( 1.0 + BCaux[v].depend );
            Between_Cent$ (u) += BCaux[u].depend;
          }

          // back up to last level
          var curr_Level =  Active_Level[here.id].previous;

          for current_distance in 2 .. graph_diameter by -1 {
            curr_Level = curr_Level.previous;

            for u in curr_Level.Members do on vertex_domain.dist.idxToLocale(u) {
                f4(BCaux, Between_Cent$, u);
                /*
              BCaux[u].depend = + reduce [v in BCaux[u].children_list.Row_Children[1..BCaux[u].children_list.child_count.read()]]
                ( BCaux[u].path_count$.readFF() /
                  BCaux[v].path_count$.readFF() )      *
                ( 1.0 + BCaux[v].depend );
              Between_Cent$ (u) += BCaux[u].depend;
                */
            }

            barrier.barrier();
          }
        }

        lp.release_tid(tid);

      }; // closure of outer embarassingly parallel forall

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	var K4_time = stopwatch.elapsed ();
	stopwatch.clear ();
	writeln ( "Elapsed time for Kernel 4: ", K4_time, " seconds");

	var n_edges          = G.num_edges;
	var N_VERTICES       = vertex_domain.numIndices;
	var N_START_VERTICES = if starting_vertices == G.vertices
			       then N_VERTICES
				    - + reduce [v in vertex_domain]
					       (G.n_Neighbors (v) == 0)
			       else starting_vertices.numIndices;
	var TEPS             = 7.0 * N_VERTICES * N_START_VERTICES / K4_time;
	var Adjusted_TEPS    = n_edges * N_START_VERTICES / K4_time;

	writeln ( "                     TEPS: ", TEPS );
	writeln ( " edge count adjusted TEPS: ", Adjusted_TEPS );
      }

      if VALIDATE_BC then
	Sum_Min_Dist = Sum_Min_Dist$;

      Between_Cent = Between_Cent$;

      if DELETE_KERNEL4_DS {
        forall l in localePrivate do on l {
            for i in l.r {
              var al  => l.temps[i].Active_Level;
              coforall loc in Locales do on loc {
                  var level = al[here.id];
                  while level != nil {
                      var l2 = level.next;
                      delete level;
                      level = l2;
                    }
                }
              delete l.temps[i];
            }
            delete l;
          }
      }

    } // end of Brandes' betweenness centrality calculation

  //
  // Addition support data structures for kernel 4
  //

  // ------------------------------------------------------------
  // The set of vertices at a particular distance from s form a
  // level set.  The class allows the full set of vertices to be
  // partitioned into a linked list of level sets.  Each instance
  // of the outer loop in kernel 4 creates such a partitioning.
  // ============================================================

  class Level_Set {
    type Sparse_Vertex_List;
    var Members  : Sparse_Vertex_List;
    var previous : Level_Set (Sparse_Vertex_List);
    var next : Level_Set (Sparse_Vertex_List);
  }

  //
  // Data structure to save Children lists between the forward
  //  and backwards passes
  //
  record child_struct {
    type vertex;
    var nd: domain(1);
    var Row_Children: [nd] vertex;
    var child_count: atomic int;

    // This function should only be called using unique vertices
    proc add_child ( new_child: vertex ) {
      var c = child_count.fetchAdd(1)+1;
      Row_Children[c] = new_child;
    }
  }

  record taskPrivateArrayData {
    type vertex;
    var min_distance  : atomic int;
    var path_count$   : sync real(64);
    var depend        : real;
    var children_list : child_struct(vertex);
  }

  //
  // Implementation of task-private variables for kernel 4
  //
  class taskPrivateData {
    type Sparse_Vertex_List;
    const vertex_domain;
    // This code assumes that chpl_taskID_t is an integral type
    var tid   : atomic int;
    var BCaux : [vertex_domain] taskPrivateArrayData(index(vertex_domain));
    var Active_Level : [PrivateSpace] Level_Set (Sparse_Vertex_List);
    proc initialize() {
      tid.write(chpl_nullTaskID:int);
    }
  };
  inline proc =(a: chpl_taskID_t, b: chpl_taskID_t) return b;
  inline proc !=(a: chpl_taskID_t, b: chpl_taskID_t) return __primitive("!=", a, b);
  class localePrivateData {
    const vertex_domain;
    const numTasks = if dataParTasksPerLocale==0 then here.numCores
      else dataParTasksPerLocale;
    var r = {0..#numTasks};
    var temps: [r] taskPrivateData(domain(index(vertex_domain)),
                                   vertex_domain.type);
    proc get_tid() {
      extern proc chpl_task_getId(): chpl_taskID_t;
      const mytid = chpl_task_getId():int;
      var slot = mytid % numTasks;
      while !temps[slot].tid.compareExchangeWeak(chpl_nullTaskID:int, mytid) {
        slot = (slot+1)%numTasks;
      }
      return slot;
    }
    proc release_tid(slot) {
      extern proc chpl_task_getId(): chpl_taskID_t;
      const mytid = chpl_task_getId():int;
      assert(temps[slot].tid.compareExchangeStrong(mytid, chpl_nullTaskID:int));
    }
    inline proc get_BCaux(tid) return temps[tid].BCaux;
    inline proc get_Active_Level(tid) return temps[tid].Active_Level;
  }

  //
  // reusable barrier implementation
  //
  record Barrier {
    param reusable = true;
    var n: int;
    var count: atomic int;
    var done: atomic bool;

    proc Barrier(_n: int) {
      reset(_n);
    }

    inline proc reset(_n: int) {
      on this {
        n = _n;
        count.write(n);
        done.write(false);
      }
    }

    inline proc barrier() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to barrier()");
          if reusable {
            count.waitFor(n-1);
            count.add(1);
            done.clear();
          }
        } else {
          done.waitFor(true);
          if reusable {
            count.add(1);
            done.waitFor(false);
          }
        }
      }
    }

    inline proc notify() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to notify()");
        }
      }
    }

    inline proc wait() {
      on this {
        done.waitFor(true);
        if reusable {
          const myc = count.fetchAdd(1);
          if myc == n-1 then
            done.clear();
          done.waitFor(false);
        }
      }
    }

    inline proc try() {
      return done.read();
    }
  }

}

module SSCA2_kernels

//  +==========================================================================+
//  |  Polymorphic Implementation of SSCA #2, Kernels 2-4                      |
//  |                                                                          |
//  |  Each kernel takes a graph argument which provides for each vertex       |
//  |  1.  an iterator for its set of neighbors                                |
//  |  2.  a parallel integer array of edge weights, which can be zipper       |
//  |      iterated with the set of neighbors                                  |
//  |  3.  the number of neighbors                                             |
//  |                                                                          |
//  |  These are the only requirements on the representation of the graph.     |
//  |                                                                          |
//  |  Filtering in Kernel 4 is turned on or off by a compilation time param.  |
//  +==========================================================================+

{
  use SSCA2_compilation_config_params, Time;

  var stopwatch : Timer;

  // ========================================================
  //                           KERNEL 2:
  // ========================================================
  // Find the edges with the largest edges.  Return a list of
  // edges, all of which have the largest weight.
  // ========================================================

  proc largest_edges ( G, heavy_edge_list :domain )

    // edge_weights can be either an array over an associative
    // domain or over a sparse domain.  the output  heavy_edge_list
    // can either kind of domain or something else purpose-built
    // for this task.
    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      // ---------------------------------------------------------
      // find heaviest edge weight in a single pass over all edges
      // ---------------------------------------------------------

      proc maxweight(s) {
	var mymax = 0;
	for w in G.edge_weight[s] do
	  if w > mymax then mymax = w;
	return mymax;
      }

      const heaviest_edge_weight = max reduce [s in G.vertices] maxweight(s);

      // ---------------------------------------------
      // in a second pass over all edges, extract list
      // of all edges  matching the heaviest weight
      // ---------------------------------------------

      forall s in G.vertices do
        forall (t, w) in G.NeighborPairs (s) do

	  if w == heaviest_edge_weight then {
	    heavy_edge_list.add ( (s,t) );
	  };

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 2: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }

      // ------------------------------------------------
      // should be able to write a user-defined "maxlocs"
      // reduction more efficiently than this scheme
      // ------------------------------------------------

      if DEBUG_KERNEL2 then {
	writeln ();
	writeln ( "Heaviest weight      : ", heaviest_edge_weight);
	writeln ( "Number of heavy edges:", heavy_edge_list.numIndices );
	writeln ();
	writeln ( "Edges with largest weight and other neighbors:" );
	for (s,t) in heavy_edge_list do {
	  writeln ("edge   ", (s,t));
	  for (v,w) in G.NeighborPairs (s) do
	    writeln ("      ", v, " ", w);}
      }
    };

  // ===================================================================
  //                              KERNEL 3:
  // ===================================================================
  // For each root (heavy) edge, find the subgraph (vertices and edges)
  // defined by directed paths of length no greater than max_path_length
  // in which the first edge traversed is the root edge
  // ===================================================================

  proc rooted_heavy_subgraphs ( G,
                                Heavy_Edge_List     : domain,
                                Heavy_Edge_Subgraph : [],
                                in max_path_length  : int )

    // -------------------------------------------------------------------------
    // there is a classic space versus time tradeoff.  if the subgraphs expanded
    // by breadth first search are small, it would make sense to use a hash
    // table or an associative domain to represent the search.  If the subgraphs
    // are large, using a full length vector to represent the search is more
    // appropriate.  We expect small diameters for power law graphs, so we
    // expect large subgraphs.
    // -------------------------------------------------------------------------

    {
      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      const vertex_domain = G.vertices;

      forall ( x, y ) in Heavy_Edge_List do {
	var Active_Level, Next_Level : domain ( index (vertex_domain) );
	var min_distance             : [vertex_domain] atomic int;
        forall m in min_distance do m.write(-1);

	if DEBUG_KERNEL3 then
	  writeln ( " Building heavy edge subgraph from pair:", (x,y) );
	Active_Level.add ( y );
	Next_Level.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).nodes.clear ();
	Heavy_Edge_Subgraph ( (x, y) ).edges.clear ();
	min_distance ( y ).write(0);

	Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (x, y) );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( x );
	Heavy_Edge_Subgraph ( (x, y) ).nodes.add ( y );

	for path_length in 1 .. max_path_length do {

	  forall v in Active_Level do {

	    forall w in G.Neighbors (v) do {

              if min_distance(w).compareExchangeStrong(-1, path_length) then {
                Next_Level.add (w);
                Heavy_Edge_Subgraph ( (x, y) ).nodes.add (w);
	      }

	      if min_distance(w).read() == path_length then {
		Heavy_Edge_Subgraph ( (x, y) ).edges.add ( (v, w) );
	      }
	    }
	  }

	  if path_length < max_path_length then {
	    Active_Level = Next_Level;
	    Next_Level.clear ();
	  }
	}
      }

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	writeln ( "Elapsed time for Kernel 3: ", stopwatch.elapsed (),
		  " seconds");
	stopwatch.clear ();
      }
    } // end of rooted_heavy_subgraphs

  use BlockDist;
  // Would be nice to use PriavteDist, but aliasing is not supported (yet)
  const PrivateSpace = {LocaleSpace} dmapped Block(boundingBox={LocaleSpace});

  // ==================================================================
  //                              KERNEL 4
  // ==================================================================
  // Calculate Betweenness Centrality for simple unweighted directed or
  // undirected graphs, using Madduri, et.al.'s modification of
  // Brandes's 2001 algorithm
  // ==================================================================

  proc approximate_betweenness_centrality ( G, starting_vertices,
                                            Between_Cent : [] real,
                                            out Sum_Min_Dist : real )

    // -----------------------------------------------------------------------
    // The betweenness centrality metric for a given node  v  is defined
    // as the double sum over s not equal to v and  t not equal to
    // either s or v of the ratio of the number of shortest paths from s to t
    // passing through v to the number of shortest paths from s to t.
    //
    // Brandes's algorithm decomposes the computation of this metric into,
    // first, separate sums for each vertex s, which can be computed
    // independently in parallel, and
    // two, a recursive, tree-based, calculation of the path counts for
    // any particular s.
    // The complexity of this algorithm is O ( |V||E| ) time for an unweighted
    // graph.  The algorithm requires O ( |V| ) temporary space for each
    // process that executes instances of the outermost loop.
    // -----------------------------------------------------------------------
    {
      const vertex_domain = G.vertices;

      // Considering using a dense 1-d array instead.  This would
      // complicate the Level_Set implementation a little, but would
      // probably be more efficient.
      type Sparse_Vertex_List = domain(index(vertex_domain));

      var Between_Cent$ : [vertex_domain] sync real = 0.0;
      var Sum_Min_Dist$ : sync real = 0.0;

      //
      // Throughout kernel 4, we use distributed arrays that are
      // private to each iteration of the outer loop.  Because set-up
      // and clean-up of such variables is very expensive, it is
      // desirable to do it at most only once per task versus once
      // per iteration, as a task executes multiple iterations of a
      // forall loop.
      //
      // To avoid this per-iteration overhead, we have implemented
      // an optimization that make certain variables private to each
      // task.  These variables are reinitialized each iteration of
      // the loop, but not reallocated, reprivatized, etc.
      //
      // Note that the Chapel group and collaborators are currently in
      // the process of bringing the idea of task private variable to
      // the language.
      //

      // Initialize task private data
      var localePrivate: [PrivateSpace] localePrivateData(vertex_domain.type);
      coforall l in localePrivate do on l {
        l = new localePrivateData(vertex_domain);
        // put in initialize()
        for t in l.temps { // this might be bad for first-touch
          t = new taskPrivateData(domain(index(vertex_domain)), vertex_domain);
          forall v in vertex_domain do
            t.BCaux[v].children_list.nd = {1..G.n_Neighbors[v]};
          for loc in Locales do on loc {
              t.Active_Level[here.id] = new Level_Set (Sparse_Vertex_List);
              t.Active_Level[here.id].previous = nil;
              t.Active_Level[here.id].next = new Level_Set (Sparse_Vertex_List);;
              t.Active_Level[here.id].next.previous = t.Active_Level[here.id];
              t.Active_Level[here.id].next.next = nil;
          }
        }
      }

      // ------------------------------------------------------
      // Each iteration of the outer loop of Brandes's algorithm
      // computes the contribution (the "dependency" metric) for
      // one particular vertex  (s)  independently.
      // ------------------------------------------------------

      if PRINT_TIMING_STATISTICS then stopwatch.start ();

      forall s in starting_vertices do on vertex_domain.dist.idxToLocale(s) {

        const shere = here.id;

	if DEBUG_KERNEL4 then writeln ( "expanding from starting node ", s );

        // Initialize task private variables
        const lp = localePrivate[here.id];
        const tid = lp.get_tid();
        var BCaux => lp.get_BCaux(tid);
        pragma "dont disable remote value forwarding"
          inline proc f1(BCaux, v) {
          BCaux[v].path_count$.writeXF(0.0);
        }
        forall v in vertex_domain do {
          BCaux[v].depend = 0.0;
          BCaux[v].min_distance.write(-1);
          // BCaux[v].path_count$.writeXF(0.0);
          f1(BCaux, v);
          BCaux[v].children_list.child_count.write(0);
        }
	var Lcl_Sum_Min_Dist: sync real = 0.0;

	// The structure of the algorithm depends on a breadth-first
	// traversal. Each vertex will be marked by the length of
	// the shortest path (min_distance) from s to it. The array
	// path_count$ will hold a count of the number of shortest
	// paths from s to this node.  The number of paths in moderate
	// sized tori exceeds 2**64.

        //
        // Used to check termination of the forward pass
        //
        // We could use a task-private reduction variable here.  This
        // is yet another concept that the Chapel group is planning to
        // implement.
        //

        var remaining = true;

        //
        // Each locale will have its own level sets.  A locale's level set
        // will only contain nodes that are physically allocated on that
        // particular locale.
        //
        var Active_Level => lp.get_Active_Level(tid);
        pragma "dont disable remote value forwarding"
          inline proc f2(BCaux, s) {
          BCaux[s].path_count$.writeXF(1);
        }

        var barrier = new Barrier(numLocales);

        coforall loc in Locales do on loc {
          Active_Level[here.id].Members.clear();
          Active_Level[here.id].next.Members.clear();
          if vertex_domain.dist.idxToLocale(s) == here {
            // Establish the initial level sets for the breadth-first
            // traversal from s
            Active_Level[here.id].Members.add(s);
            BCaux[s].min_distance.write(0);
            // BCaux[s].path_count$.writeXF(1);
            f2(BCaux, s);
          }
          barrier.barrier();

          var current_distance : int = 0;

          while remaining do {
	    // ------------------------------------------------
	    // expand the neighbor sets for all vertices at the
	    // current distance from the starting vertex  s
	    // ------------------------------------------------

	    current_distance += 1;

            // The Chapel compiler is still a bit conservative when it
            // comes to forwarding read-only variables to remote
            // locales, so we make a const copy here to insure it is
            // forwarded to the remote locale in the following
            // coforall loop.
            const current_distance_c = current_distance;
            pragma "dont disable remote value forwarding"
              inline proc f3(BCaux, v, u) {
              BCaux[v].path_count$ += BCaux[u].path_count$.readFF();
            }

            forall u in Active_Level[here.id].Members do {
              forall v in G.FilteredNeighbors(u) do
                on vertex_domain.dist.idxToLocale(v) {
                  // --------------------------------------------
                  // add any unmarked neighbors to the next level
                  // --------------------------------------------

                  if  BCaux[v].min_distance.compareExchangeStrong(-1, current_distance_c) {
                    Active_Level[here.id].next.Members.add (v);
                    if VALIDATE_BC then
                      Lcl_Sum_Min_Dist += current_distance_c;
                  }

                  // ------------------------------------------------
                  // only neighbors of  u  that are in the next level
                  // are on shortest paths from s through v.  Some
                  // task will have set  min_distance (v) by the
                  // time this code is reached, whether  v  lies in
                  // the previous, the current or the next level.
                  // ------------------------------------------------

                  if BCaux[v].min_distance.read() == current_distance_c {
                    // BCaux[v].path_count$ += BCaux[u].path_count$.readFF();
                    f3(BCaux, v, u);
                    BCaux[u].children_list.add_child (v);
                  }

                }
            };

            // This barrier is needed to insure all updates to the next
            // level are completed before updating to use the next level

            // do some work while we wait
            // barrier.notify(); // This is expensive without network atomics
            //  for now, just do a normal barrier

            if Active_Level[here.id].next.next == nil {
              Active_Level[here.id].next.next = new Level_Set (Sparse_Vertex_List);
              Active_Level[here.id].next.next.previous = Active_Level[here.id].next;
              Active_Level[here.id].next.next.next = nil;
            } else {
              Active_Level[here.id].next.next.Members.clear();
            }
            // barrier.wait(); // ditto
            barrier.barrier();
            if here.id==shere {
              remaining = false;
            }

            barrier.barrier();
            Active_Level[here.id] = Active_Level[here.id].next;
            if Active_Level[here.id].Members.numIndices:bool then
              remaining = true;

            barrier.barrier();

          };  // end forward pass

          if here.id==0 {
            if VALIDATE_BC then
              Sum_Min_Dist$ += Lcl_Sum_Min_Dist;
          }

          // -------------------------------------------------------------
          // compute the dependencies recursively, traversing the vertices
          // of the graph in non-increasing order of distance (reverse
          // ordering from the initial traversal)
          // -------------------------------------------------------------

          const graph_diameter = current_distance - 1;

          if here.id==0 {
            if DEBUG_KERNEL4 then
              writeln ( " graph diameter from starting node ", s,
                        "  is ", graph_diameter );
          }

          pragma "dont disable remote value forwarding"
            inline proc f4(BCaux, Between_Cent$, u) {
            BCaux[u].depend = + reduce [v in BCaux[u].children_list.Row_Children[1..BCaux[u].children_list.child_count.read()]]
              ( BCaux[u].path_count$.readFF() /
                BCaux[v].path_count$.readFF() )      *
              ( 1.0 + BCaux[v].depend );
            Between_Cent$ (u) += BCaux[u].depend;
          }

          // back up to last level
          var curr_Level =  Active_Level[here.id].previous;

          for current_distance in 2 .. graph_diameter by -1 {
            curr_Level = curr_Level.previous;

            for u in curr_Level.Members do on vertex_domain.dist.idxToLocale(u) {
                f4(BCaux, Between_Cent$, u);
                /*
              BCaux[u].depend = + reduce [v in BCaux[u].children_list.Row_Children[1..BCaux[u].children_list.child_count.read()]]
                ( BCaux[u].path_count$.readFF() /
                  BCaux[v].path_count$.readFF() )      *
                ( 1.0 + BCaux[v].depend );
              Between_Cent$ (u) += BCaux[u].depend;
                */
            }

            barrier.barrier();
          }
        }

        lp.release_tid(tid);

      }; // closure of outer embarassingly parallel forall

      if PRINT_TIMING_STATISTICS then {
	stopwatch.stop ();
	var K4_time = stopwatch.elapsed ();
	stopwatch.clear ();
	writeln ( "Elapsed time for Kernel 4: ", K4_time, " seconds");

	var n_edges          = + reduce [v in vertex_domain] G.n_Neighbors (v);
	var N_VERTICES       = vertex_domain.numIndices;
	var N_START_VERTICES = if starting_vertices == G.vertices
			       then N_VERTICES
				    - + reduce [v in vertex_domain]
					       (G.n_Neighbors (v) == 0)
			       else starting_vertices.numIndices;
	var TEPS             = 7.0 * N_VERTICES * N_START_VERTICES / K4_time;
	var Adjusted_TEPS    = n_edges * N_START_VERTICES / K4_time;

	writeln ( "                     TEPS: ", TEPS );
	writeln ( " edge count adjusted TEPS: ", Adjusted_TEPS );
      }

      if VALIDATE_BC then
	Sum_Min_Dist = Sum_Min_Dist$;

      Between_Cent = Between_Cent$;

      if DELETE_KERNEL4_DS {
        forall l in localePrivate do on l {
            for i in l.r {
              var al  => l.temps[i].Active_Level;
              coforall loc in Locales do on loc {
                  var level = al[here.id];
                  while level != nil {
                      var l2 = level.next;
                      delete level;
                      level = l2;
                    }
                }
              delete l.temps[i];
            }
            delete l;
          }
      }

    } // end of Brandes' betweenness centrality calculation

  //
  // Addition support data structures for kernel 4
  //

  // ------------------------------------------------------------
  // The set of vertices at a particular distance from s form a
  // level set.  The class allows the full set of vertices to be
  // partitioned into a linked list of level sets.  Each instance
  // of the outer loop in kernel 4 creates such a partitioning.
  // ============================================================

  class Level_Set {
    type Sparse_Vertex_List;
    var Members  : Sparse_Vertex_List;
    var previous : Level_Set (Sparse_Vertex_List);
    var next : Level_Set (Sparse_Vertex_List);
  }

  //
  // Data structure to save Children lists between the forward
  //  and backwards passes
  //
  record child_struct {
    type vertex;
    var nd: domain(1);
    var Row_Children: [nd] vertex;
    var child_count: atomic int;

    // This function should only be called using unique vertices
    proc add_child ( new_child: vertex ) {
      var c = child_count.fetchAdd(1)+1;
      Row_Children[c] = new_child;
    }
  }

  record taskPrivateArrayData {
    type vertex;
    var min_distance  : atomic int;
    var path_count$   : sync real(64);
    var depend        : real;
    var children_list : child_struct(vertex);
  }

  //
  // Implementation of task-private variables for kernel 4
  //
  class taskPrivateData {
    type Sparse_Vertex_List;
    const vertex_domain;
    // This code assumes that chpl_taskID_t is an integral type
    var tid   : atomic int;
    var BCaux : [vertex_domain] taskPrivateArrayData(index(vertex_domain));
    var Active_Level : [PrivateSpace] Level_Set (Sparse_Vertex_List);
    proc initialize() {
      tid.write(chpl_nullTaskID:int);
    }
  };
  inline proc =(a: chpl_taskID_t, b: chpl_taskID_t) return b;
  inline proc !=(a: chpl_taskID_t, b: chpl_taskID_t) return __primitive("!=", a, b);
  class localePrivateData {
    const vertex_domain;
    const numTasks = if dataParTasksPerLocale==0 then here.numCores
      else dataParTasksPerLocale;
    var r = {0..#numTasks};
    var temps: [r] taskPrivateData(domain(index(vertex_domain)),
                                   vertex_domain.type);
    proc get_tid() {
      extern proc chpl_task_getId(): chpl_taskID_t;
      const mytid = chpl_task_getId():int;
      var slot = mytid % numTasks;
      while !temps[slot].tid.compareExchangeWeak(chpl_nullTaskID:int, mytid) {
        slot = (slot+1)%numTasks;
      }
      return slot;
    }
    proc release_tid(slot) {
      extern proc chpl_task_getId(): chpl_taskID_t;
      const mytid = chpl_task_getId():int;
      assert(temps[slot].tid.compareExchangeStrong(mytid, chpl_nullTaskID:int));
    }
    inline proc get_BCaux(tid) return temps[tid].BCaux;
    inline proc get_Active_Level(tid) return temps[tid].Active_Level;
  }

  //
  // reusable barrier implementation
  //
  record Barrier {
    param reusable = true;
    var n: int;
    var count: atomic int;
    var done: atomic bool;

    proc Barrier(_n: int) {
      reset(_n);
    }

    inline proc reset(_n: int) {
      on this {
        n = _n;
        count.write(n);
        done.write(false);
      }
    }

    inline proc barrier() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to barrier()");
          if reusable {
            count.waitFor(n-1);
            count.add(1);
            done.clear();
          }
        } else {
          done.waitFor(true);
          if reusable {
            count.add(1);
            done.waitFor(false);
          }
        }
      }
    }

    inline proc notify() {
      on this {
        const myc = count.fetchSub(1);
        if myc<=1 {
          if done.testAndSet() then
            halt("Too many callers to notify()");
        }
      }
    }

    inline proc wait() {
      on this {
        done.waitFor(true);
        if reusable {
          const myc = count.fetchAdd(1);
          if myc == n-1 then
            done.clear();
          done.waitFor(false);
        }
      }
    }

    inline proc try() {
      return done.read();
    }
  }

}


Fix syntax change refvar->ref

Fix syntax change refvar->ref

/* nbody_reductions + triangle_iterator
 *
 * The Great Computer Language Shootout
 * http://shootout.alioth.debian.org/
 *
 * contributed by Albert Sidelnik
 *
*/

config var n = 10000;
param PI = 3.141592653589793;
const solar_mass = (4 * PI * PI);
param days_per_year = 365.24;
const vecLen = {0..2};
const numBodies = 4;
const NBODIES = 0..numBodies;

class Planet {
  var coord_vector : [vecLen] real; // x,y,z
  var vel_vector : [vecLen] real;   // vx,vy,vz
  var mass : real;
}

iter TriangleIter(B: [] Planet) {
  for i in NBODIES {
    ref b1 = B[i];
    for j in i+1..numBodies {
      yield (b1,B[j]);
    }
  }
}

proc advance(B: [] Planet, dt: real) {
  for (b1,b2) in TriangleIter(B) {
    var d : [vecLen] real = b1.coord_vector - b2.coord_vector;
    var distance = sqrt(+ reduce d**2);
    var mag = dt / (distance**3);
    b1.vel_vector -= d * b2.mass * mag;
    b2.vel_vector += d * b1.mass * mag;
  }
  for b in B {
    b.coord_vector += dt * b.vel_vector;
  }
}

proc energy(B : [] Planet) : real {
  var e : real;
  for (b1,i) in zip(B,NBODIES) {
    e += 0.5 * b1.mass * (+ reduce b1.vel_vector**2);
    for b2 in B[i+1..] {
      var d : [vecLen] real = b1.coord_vector - b2.coord_vector;
      var distance = sqrt(+ reduce d**2);
      e -= (b1.mass * b2.mass) / distance;
    }
  }
  return e;
}

proc offset_momentum(B : [] Planet) {
  var p : [vecLen] real;
  for b in B do
    p += b.vel_vector * b.mass;
  B(0).vel_vector = -p / solar_mass;
}

proc main() {
  var bodies : [NBODIES] Planet;

  var p0,v0 : [vecLen] real = (0,0,0);
  bodies(0) = new Planet(p0,v0, solar_mass);
  var p1 : [vecLen] real = (4.84143144246472090e+00,
                            -1.16032004402742839e+00,
                            -1.03622044471123109e-01);
  var v1 : [vecLen] real = (1.66007664274403694e-03 * days_per_year,
                            7.69901118419740425e-03 * days_per_year,
                            -6.90460016972063023e-05 * days_per_year);
  bodies(1) = new Planet(p1, v1, 9.54791938424326609e-04 * solar_mass);
  var p2 : [vecLen] real = (8.34336671824457987e+00,
                            4.12479856412430479e+00,
                            -4.03523417114321381e-01);
  var v2 : [vecLen] real = (-2.76742510726862411e-03 * days_per_year,
                            4.99852801234917238e-03 * days_per_year,
                            2.30417297573763929e-05 * days_per_year);
  bodies(2) = new Planet(p2, v2, 2.85885980666130812e-04 * solar_mass);
  var p3 : [vecLen] real = (1.28943695621391310e+01,
                            -1.51111514016986312e+01,
                            -2.23307578892655734e-01);
  var v3 : [vecLen] real = (2.96460137564761618e-03 * days_per_year,
                            2.37847173959480950e-03 * days_per_year,
                            -2.96589568540237556e-05 * days_per_year);
  bodies(3) = new Planet(p3,v3, 4.36624404335156298e-05 * solar_mass);
  var p4 : [vecLen] real = (1.53796971148509165e+01,
                            -2.59193146099879641e+01,
                            1.79258772950371181e-01);
  var v4 : [vecLen] real = (2.68067772490389322e-03 * days_per_year,
                            1.62824170038242295e-03 * days_per_year,
                            -9.51592254519715870e-05 * days_per_year);
  bodies(4) = new Planet(p4,v4, 5.15138902046611451e-05 * solar_mass);

  offset_momentum(bodies);
  writeln(format("#.#########", energy(bodies)));
  for 1..n {
    advance(bodies, 0.01);
  }
  writeln(format("#.#########", energy(bodies)));

  for body in bodies do delete body;
}

/* nbody_reductions + triangle_iterator
 *
 * The Great Computer Language Shootout
 * http://shootout.alioth.debian.org/
 *
 * contributed by Albert Sidelnik
 *
*/

config var n = 10000;
param PI = 3.141592653589793;
const solar_mass = (4 * PI * PI);
param days_per_year = 365.24;
const vecLen = {0..2};
const numBodies = 4;
const NBODIES = 0..numBodies;

class Planet {
  var coord_vector : [vecLen] real; // x,y,z
  var vel_vector : [vecLen] real;   // vx,vy,vz
  var mass : real;
}

iter TriangleIter(B: [] Planet) {
  for i in NBODIES {
    refvar b1 = B[i];
    for j in i+1..numBodies {
      yield (b1,B[j]);
    }
  }
}

proc advance(B: [] Planet, dt: real) {
  for (b1,b2) in TriangleIter(B) {
    var d : [vecLen] real = b1.coord_vector - b2.coord_vector;
    var distance = sqrt(+ reduce d**2);
    var mag = dt / (distance**3);
    b1.vel_vector -= d * b2.mass * mag;
    b2.vel_vector += d * b1.mass * mag;
  }
  for b in B {
    b.coord_vector += dt * b.vel_vector;
  }
}

proc energy(B : [] Planet) : real {
  var e : real;
  for (b1,i) in zip(B,NBODIES) {
    e += 0.5 * b1.mass * (+ reduce b1.vel_vector**2);
    for b2 in B[i+1..] {
      var d : [vecLen] real = b1.coord_vector - b2.coord_vector;
      var distance = sqrt(+ reduce d**2);
      e -= (b1.mass * b2.mass) / distance;
    }
  }
  return e;
}

proc offset_momentum(B : [] Planet) {
  var p : [vecLen] real;
  for b in B do
    p += b.vel_vector * b.mass;
  B(0).vel_vector = -p / solar_mass;
}

proc main() {
  var bodies : [NBODIES] Planet;

  var p0,v0 : [vecLen] real = (0,0,0);
  bodies(0) = new Planet(p0,v0, solar_mass);
  var p1 : [vecLen] real = (4.84143144246472090e+00,
                            -1.16032004402742839e+00,
                            -1.03622044471123109e-01);
  var v1 : [vecLen] real = (1.66007664274403694e-03 * days_per_year,
                            7.69901118419740425e-03 * days_per_year,
                            -6.90460016972063023e-05 * days_per_year);
  bodies(1) = new Planet(p1, v1, 9.54791938424326609e-04 * solar_mass);
  var p2 : [vecLen] real = (8.34336671824457987e+00,
                            4.12479856412430479e+00,
                            -4.03523417114321381e-01);
  var v2 : [vecLen] real = (-2.76742510726862411e-03 * days_per_year,
                            4.99852801234917238e-03 * days_per_year,
                            2.30417297573763929e-05 * days_per_year);
  bodies(2) = new Planet(p2, v2, 2.85885980666130812e-04 * solar_mass);
  var p3 : [vecLen] real = (1.28943695621391310e+01,
                            -1.51111514016986312e+01,
                            -2.23307578892655734e-01);
  var v3 : [vecLen] real = (2.96460137564761618e-03 * days_per_year,
                            2.37847173959480950e-03 * days_per_year,
                            -2.96589568540237556e-05 * days_per_year);
  bodies(3) = new Planet(p3,v3, 4.36624404335156298e-05 * solar_mass);
  var p4 : [vecLen] real = (1.53796971148509165e+01,
                            -2.59193146099879641e+01,
                            1.79258772950371181e-01);
  var v4 : [vecLen] real = (2.68067772490389322e-03 * days_per_year,
                            1.62824170038242295e-03 * days_per_year,
                            -9.51592254519715870e-05 * days_per_year);
  bodies(4) = new Planet(p4,v4, 5.15138902046611451e-05 * solar_mass);

  offset_momentum(bodies);
  writeln(format("#.#########", energy(bodies)));
  for 1..n {
    advance(bodies, 0.01);
  }
  writeln(format("#.#########", energy(bodies)));

  for body in bodies do delete body;
}


A start at originally-proposed routine

A start at originally-proposed routine

Didn't get it working right, primarily w.r.t. files/dirs.
Also segfaulted.

config const debug = false;

use Sort;

iter listdir(path: string, dotfiles=false, dirs=true, files=false): string {
  extern type DIRptr;
  extern type direntptr;
  extern proc opendir(name: c_string): DIRptr;
  extern proc readdir(dirp: DIRptr): direntptr;
  extern proc closedir(dirp: DIRptr): c_int;
  extern proc chpl_rt_isDir(pathname: c_string): c_int;

  proc direntptr.d_name(): c_string {
    extern proc chpl_rt_direntptr_getname(d: direntptr): c_string;

    return chpl_rt_direntptr_getname(this);
  }
  // End inlining

  var dir: DIRptr;
  var ent: direntptr;
  //  writeln("***Trying ", path);
  dir = opendir(path:c_string);
  if (!is_c_nil(dir)) {
    ent = readdir(dir);
    while (!is_c_nil(ent)) {
      const filename = ent.d_name();
      if (dotfiles || filename.substring(1) != '.') {
        if (filename != "." && filename != "..") {
          const fullpath = path + "/" + filename;
          if (chpl_rt_isDir(fullpath:c_string)) {
            if (dirs) then
              yield filename;
          } else {
            if (files) then
              yield filename;
          }
        }
      }
      ent = readdir(dir);
    }
    closedir(dir);
  } else {
    extern proc perror(s: c_string);
    perror("error in listdir(): ");
  }
}

iter walkdirs(path: string=".", topdown=true, depth=max(int), dotfiles=false, followlinks=false, sort = false): string {
  //  writeln("topdown = ", topdown);
  //  writeln("walkdirs() called with ", path, " depth=",depth);

  if (topdown) then
    yield path;

  if (depth) {
    var subdirs = listdir(path, dotfiles=dotfiles, dirs=true);
    if (sort) then
      QuickSort(subdirs);
    for subdir in subdirs {
      const fullpath = path + "/" + subdir;
      //      yield fullpath;
      //      writeln("Calling walkdirs with ", fullpath);
      for subdir in walkdirs(fullpath, topdown, depth-1, dotfiles, followlinks) do
        yield subdir;
    }
  }

  if (!topdown) then
    yield path;
}

iter wordexp(pattern="*") {
  extern type wordexp_t;
  //  extern proc chpl_wordexp(pattern:c_string, flags:c_int, ref ret_glob:wordexp_t):c_int;
  extern proc wordexp(pattern:c_string, ref ret_glob: wordexp_t, flags_c_int): c_int;
  extern proc chpl_wordexp_num(x:wordexp_t): size_t;
  extern proc chpl_wordexp_index(x:wordexp_t, idx:size_t): c_string;
  extern proc wordfree(ref glb:wordexp_t);

  var glb : wordexp_t;

  const err = wordexp(pattern:c_string, glb, 0);

  for i in 0..chpl_wordexp_num(glb)-1 {
    yield chpl_wordexp_index(glb, i): string;
  }

  wordfree(glb);
}

iter glob(pattern="*") {
  extern type glob_t;
  //  extern proc chpl_glob(pattern:c_string, flags:c_int, ref ret_glob:glob_t):c_int;
  extern proc glob(pattern:c_string, flags: c_int, errfunc:c_void_ptr, ref ret_glob:glob_t):c_int;
  extern proc chpl_glob_num(x:glob_t): size_t;
  extern proc chpl_glob_index(x:glob_t, idx:size_t): c_string;
  extern proc globfree(ref glb:glob_t);

  var glb : glob_t;

  const err = glob(pattern:c_string, 0, c_nil, glb);

  for i in 0..chpl_glob_num(glb) - 1 do
    yield chpl_glob_index(glb, i): string;

  globfree(glb);
}

iter findfiles(startdir = ".", recur=false, dotfiles=false) {
  if (recur) then
    for subdir in walkdirs(startdir, dotfiles=dotfiles) do
      for file in listdir(subdir, dotfiles=dotfiles, dirs=false, files=true) do
        yield subdir+"/"+file;
  else
    for file in listdir(startdir, dotfiles=dotfiles, dirs=false, files=true) do
      yield startdir+"/"+file;
}

/* An incomplete start at putting together the routine in the proposal
 *
iter findfiles(pattern="*",
               startdir=".",
               depth=max(int),
               files=true,
               dirs=false,
               dotfiles=false,
               sorted=false,
               expand=false) {
  if (expand) then
    halt("not yet implemented: findfiles(..., expand=true)");
  if (pattern.substring(1) == "/") then
    for file in glob(pattern) do
      yield file;
  else
    for subdir in walkdirs(startdir, true, depth, dotfiles, false, sorted) {
      const subdirslash = subdir + "/";
      if (dirs) then
        yield subdirslash;
      for file in glob(subdirslash + pattern) do
        yield file;
    }
}
*/


Using new readline

Using new readline

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";

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 freqDom : domain(uint);
  var freqs : [freqDom] int;

  const ntasks = defaultNumTasks(0);
  var lock : sync bool;
  lock = true;
  const sizeRange = 0..size-1;
  coforall tid in 1..ntasks {
    var curDom : domain(uint);
    var curArr : [curDom] int;
    for i in tid .. data.size-size by ntasks {
      curArr[hash(data, i, sizeRange)] += 1;
    }
    lock;
    for (k,v) in zip(curDom, 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.domain, 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");
}

use IO;
use AdvancedIters;

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

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

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";

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 freqDom : domain(uint);
  var freqs : [freqDom] int;

  const ntasks = defaultNumTasks(0);
  var lock : sync bool;
  lock = true;
  const sizeRange = 0..size-1;
  coforall tid in 1..ntasks {
    var curDom : domain(uint);
    var curArr : [curDom] int;
    for i in tid .. data.size-size by ntasks {
      curArr[hash(data, i, sizeRange)] += 1;
    }
    lock;
    for (k,v) in zip(curDom, 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.domain, 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;
  while myin.readline(tempdata, numRead) && !startsWithThree(tempdata) {}

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

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

  // 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");
}


Switch to slightly more straightforward 1-de-tupling on Elliot's suggestion

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

use Sort;

//
// This module defines several iterators that are designed to help
// support reasoning about directory and file contents.  At present,
// all are serial and single-locale, though the ultimate intention
// is to also support parallel and multi-locale options.
//
// These interfaces should be considered experimental and subject to
// change for the 1.10 release.  For that reason, send in feedback if
// you would like to see changes or additional arguments/features.
// And, as always, send in bug reports if you think we got something
// wrong.
//

/* iter listdir(path: string, hidden=false, dirs=true, files=true,
                listlinks=true): string

    listdir() lists the contents of a directory, similar to 'ls'
      * path: the directory whose contents should be listed
      * hidden: should hidden files/directories be listed?
      * dirs: should dirs be listed?
      * files: should files be listed?
      * listlinks: should symbolic links be listed?

   By default this routine lists all files and directories in the
   current directory, including symbolic links, as long as they don't
   start with '.'
*/

iter listdir(path: string, hidden=false, dirs=true, files=true,
             listlinks=true): string {
  extern type DIRptr;
  extern type direntptr;
  extern proc opendir(name: c_string): DIRptr;
  extern proc readdir(dirp: DIRptr): direntptr;
  extern proc closedir(dirp: DIRptr): c_int;

  proc direntptr.d_name(): c_string {
    extern proc chpl_rt_direntptr_getname(d: direntptr): c_string;

    return chpl_rt_direntptr_getname(this);
  }

  var dir: DIRptr;
  var ent: direntptr;
  dir = opendir(path:c_string);
  if (!is_c_nil(dir)) {
    ent = readdir(dir);
    while (!is_c_nil(ent)) {
      const filename = ent.d_name();
      if (hidden || filename.substring(1) != '.') {
        if (filename != "." && filename != "..") {
          //
          // use FileSystem;  // Doesn't work, see comment below
          //
          const fullpath = path + "/" + filename;
          {
            //
            // The use of this compound statement to restrict the
            // impact of the 'use' of FileSystem is unfortunate
            // (compared to placing it in the more logical place
            // above), yet seemingly required at present; otherwise
            // the 'path' argument gets shadowed by a
            // (compiler-introduced?) method coming from one of the
            // standard or internal modules.  See
            // test/modules/bradc/useFileSystemShadowsPath.chpl for
            // a smaller standalone test exhibiting the issue (or
            // uncomment the 'use' above to see it here).
            //
            use FileSystem;

            if (listlinks || !isLink(fullpath)) {
              if (dirs && isDir(fullpath)) then
                yield filename;
              else if (files && isFile(fullpath)) then
                yield filename;
            }
          }
        }
      }
      ent = readdir(dir);
    }
    closedir(dir);
  } else {
    extern proc perror(s: c_string);
    perror("error in listdir(): ");
  }
}

/* iter walkdirs(path: string=".", topdown=true, depth=max(int),
                 hidden=false, followlinks=false, sort=false): string

   walkdirs() recursively walks a directory structure, yielding
   directory names.  The strings that are generated will be rooted
   from 'path'.

     * path: the directory to start from
     * topdown: indicates whether to yield the directories using a
       preorder (vs. postorder) traversal
     * depth: indicates the maximal depth of recursion to use
     * hidden: indicates whether to enter hidden directories
     * followlinks: indicates whether to follow symbolic links or not
     * sort: indicates whether to consider subdirectories in sorted
       order or not

   by default, walkdirs() will start in the current directory, process
   directories in preorder; recursively traverse subdirectories; and
   neither follow dotfile directories nor symbolic links.  It will not
   sort the directories by default.
*/

iter walkdirs(path: string=".", topdown=true, depth=max(int), hidden=false,
              followlinks=false, sort=false): string {

  if (topdown) then
    yield path;

  if (depth) {
    var subdirs = listdir(path, hidden=hidden, files=false, listlinks=followlinks);
    if (sort) then
      QuickSort(subdirs);
    for subdir in subdirs {
      const fullpath = path + "/" + subdir;
      for subdir in walkdirs(fullpath, topdown, depth-1, hidden,
                             followlinks, sort) do
        yield subdir;
    }
  }

  if (!topdown) then
    yield path;
}

//
// Here's a parallel version
//
iter walkdirs(path: string=".", topdown=true, depth=max(int), hidden=false,
              followlinks=false, sort=false, param tag: iterKind): string
       where tag == iterKind.standalone {

  if (sort) then
    warning("sorting has no effect for parallel invocations of walkdirs()");

  if (topdown) then
    yield path;

  if (depth) {
    var subdirs = listdir(path, hidden=hidden, files=false, listlinks=followlinks);
    forall subdir in subdirs {
      const fullpath = path + "/" + subdir;
      //
      // Call standalone walkdirs() iterator recursively; set sort=false since it is
      // not useful and we've already printed the warning
      //
      for subdir in walkdirs(fullpath, topdown, depth-1, hidden, followlinks, sort=false, iterKind.standalone) do
        yield subdir;
    }
  }

  if (!topdown) then
    yield path;
}

/* iter glob(pattern="*")

   glob() gives glob() capabilities and is implemented using C's glob()

     * pattern: the glob pattern to match against

   By default, it will list all files/directories in the current directory
*/

module Chpl_rt_glob {
  extern type glob_t;

  extern const GLOB_NOMATCH: c_int;

  extern proc chpl_glob(pattern:c_string, flags: c_int,
                        ref ret_glob:glob_t):c_int;
  extern proc chpl_glob_num(x:glob_t): size_t;
  extern proc chpl_glob_index(x:glob_t, idx:size_t): c_string;
  extern proc globfree(ref glb:glob_t);
}

iter glob(pattern="*") {
  var glb : Chpl_rt_glob.glob_t;

  const err = Chpl_rt_glob.chpl_glob(pattern:c_string, 0, glb);
  // TODO: Handle error cases better
  if (err != 0 && err != Chpl_rt_glob.GLOB_NOMATCH) then
    __primitive("chpl_error", "unhandled error in glob()");
  const num = Chpl_rt_glob.chpl_glob_num(glb);
  if (num) then
    for i in 0..num-1 do
      yield Chpl_rt_glob.chpl_glob_index(glb, i): string;

  Chpl_rt_glob.globfree(glb);
}

iter glob(pattern:string="*", param tag: iterKind)
       where tag == iterKind.standalone {
  var glb : Chpl_rt_glob.glob_t;

  const err = Chpl_rt_glob.chpl_glob(pattern:c_string, 0, glb);
  // TODO: Handle error cases better
  if (err != 0 && err != Chpl_rt_glob.GLOB_NOMATCH) then
    __primitive("chpl_error", "unhandled error in glob()");
  const num = Chpl_rt_glob.chpl_glob_num(glb);
  if (num) then
    forall i in 0..num-1 do
      yield Chpl_rt_glob.chpl_glob_index(glb, i): string;

  Chpl_rt_glob.globfree(glb);
}

//
// TODO: The following leader/follower iterator assumes that
// the file system state won't change between calls because
// it calls the glob routines twice and assumes the same
// result will come back.  In leader-follower 2.0, we would
// like to store such state between calls in which case this
// should be rewritten to do so (and would require freeing
// the state at the end of the call).
//
iter glob(pattern:string="*", param tag: iterKind)
       where tag == iterKind.leader {
  var glb : Chpl_rt_glob.glob_t;

  const err = Chpl_rt_glob.chpl_glob(pattern:c_string, 0, glb);
  // TODO: Handle error cases better
  if (err != 0 && err != Chpl_rt_glob.GLOB_NOMATCH) then
    __primitive("chpl_error", "unhandled error in glob()");
  //
  // cast is used here to ensure we create an int-based leader
  //
  const num = Chpl_rt_glob.chpl_glob_num(glb).safeCast(int);
  if (num) {
    Chpl_rt_glob.globfree(glb);

    //
    // Forward to the range type's leader
    //
    for followThis in (0..num-1).these(tag) do
      yield followThis;
  }
}

iter glob(pattern:string="*", followThis, param tag: iterKind)
       where tag == iterKind.follower {
  var glb : Chpl_rt_glob.glob_t;
  if (followThis.size != 1) then
    compilerError("glob() iterator can only be zipped with 1D iterators");
  var r = followThis(1);

  const err = Chpl_rt_glob.chpl_glob(pattern:c_string, 0, glb);
  // TODO: Handle error cases better
  if (err != 0 && err != Chpl_rt_glob.GLOB_NOMATCH) then
    __primitive("chpl_error", "unhandled error in glob()");
  const num = Chpl_rt_glob.chpl_glob_num(glb);
  if (r.high > num.safeCast(int)) then
    halt("glob() iterator zipped with something too big");
  if (num) then
    for i in r do
      //
      // safe cast is used here to turn an int into a size_t
      //
      yield Chpl_rt_glob.chpl_glob_index(glb, i.safeCast(size_t)): string;

  Chpl_rt_glob.globfree(glb);
}

/* iter findfiles(startdir = ".", recursive=false, hidden=false)

   findfiles() is a simple find-like utility implemented using the
   above routines

     * startdir: where to start when looking for files
     * recursive: tells whether or not to descend recurisvely
     * hidden: tells whether or not to yield hidden
*/

iter findfiles(startdir = ".", recursive=false, hidden=false) {
  if (recursive) then
    for subdir in walkdirs(startdir, hidden=hidden) do
      for file in listdir(subdir, hidden=hidden, dirs=false, files=true, listlinks=true) do
        yield subdir+"/"+file;
  else
    for file in listdir(startdir, hidden=hidden, dirs=false, files=true, listlinks=false) do
      yield startdir+"/"+file;
}

iter findfiles(startdir = ".", recursive=false, hidden=false, param tag: iterKind) where tag == iterKind.standalone {
  if (recursive) then
    forall subdir in walkdirs(startdir, hidden=hidden) do
      for file in listdir(subdir, hidden=hidden, dirs=false, files=true, listlinks=true) do
        yield subdir+"/"+file;
  else
    for file in listdir(startdir, hidden=hidden, dirs=false, files=true, listlinks=false) do
      yield startdir+"/"+file;
}

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

use Sort;

//
// This module defines several iterators that are designed to help
// support reasoning about directory and file contents.  At present,
// all are serial and single-locale, though the ultimate intention
// is to also support parallel and multi-locale options.
//
// These interfaces should be considered experimental and subject to
// change for the 1.10 release.  For that reason, send in feedback if
// you would like to see changes or additional arguments/features.
// And, as always, send in bug reports if you think we got something
// wrong.
//

/* iter listdir(path: string, hidden=false, dirs=true, files=true,
                listlinks=true): string

    listdir() lists the contents of a directory, similar to 'ls'
      * path: the directory whose contents should be listed
      * hidden: should hidden files/directories be listed?
      * dirs: should dirs be listed?
      * files: should files be listed?
      * listlinks: should symbolic links be listed?

   By default this routine lists all files and directories in the
   current directory, including symbolic links, as long as they don't
   start with '.'
*/

iter listdir(path: string, hidden=false, dirs=true, files=true,
             listlinks=true): string {
  extern type DIRptr;
  extern type direntptr;
  extern proc opendir(name: c_string): DIRptr;
  extern proc readdir(dirp: DIRptr): direntptr;
  extern proc closedir(dirp: DIRptr): c_int;

  proc direntptr.d_name(): c_string {
    extern proc chpl_rt_direntptr_getname(d: direntptr): c_string;

    return chpl_rt_direntptr_getname(this);
  }

  var dir: DIRptr;
  var ent: direntptr;
  dir = opendir(path:c_string);
  if (!is_c_nil(dir)) {
    ent = readdir(dir);
    while (!is_c_nil(ent)) {
      const filename = ent.d_name();
      if (hidden || filename.substring(1) != '.') {
        if (filename != "." && filename != "..") {
          //
          // use FileSystem;  // Doesn't work, see comment below
          //
          const fullpath = path + "/" + filename;
          {
            //
            // The use of this compound statement to restrict the
            // impact of the 'use' of FileSystem is unfortunate
            // (compared to placing it in the more logical place
            // above), yet seemingly required at present; otherwise
            // the 'path' argument gets shadowed by a
            // (compiler-introduced?) method coming from one of the
            // standard or internal modules.  See
            // test/modules/bradc/useFileSystemShadowsPath.chpl for
            // a smaller standalone test exhibiting the issue (or
            // uncomment the 'use' above to see it here).
            //
            use FileSystem;

            if (listlinks || !isLink(fullpath)) {
              if (dirs && isDir(fullpath)) then
                yield filename;
              else if (files && isFile(fullpath)) then
                yield filename;
            }
          }
        }
      }
      ent = readdir(dir);
    }
    closedir(dir);
  } else {
    extern proc perror(s: c_string);
    perror("error in listdir(): ");
  }
}

/* iter walkdirs(path: string=".", topdown=true, depth=max(int),
                 hidden=false, followlinks=false, sort=false): string

   walkdirs() recursively walks a directory structure, yielding
   directory names.  The strings that are generated will be rooted
   from 'path'.

     * path: the directory to start from
     * topdown: indicates whether to yield the directories using a
       preorder (vs. postorder) traversal
     * depth: indicates the maximal depth of recursion to use
     * hidden: indicates whether to enter hidden directories
     * followlinks: indicates whether to follow symbolic links or not
     * sort: indicates whether to consider subdirectories in sorted
       order or not

   by default, walkdirs() will start in the current directory, process
   directories in preorder; recursively traverse subdirectories; and
   neither follow dotfile directories nor symbolic links.  It will not
   sort the directories by default.
*/

iter walkdirs(path: string=".", topdown=true, depth=max(int), hidden=false,
              followlinks=false, sort=false): string {

  if (topdown) then
    yield path;

  if (depth) {
    var subdirs = listdir(path, hidden=hidden, files=false, listlinks=followlinks);
    if (sort) then
      QuickSort(subdirs);
    for subdir in subdirs {
      const fullpath = path + "/" + subdir;
      for subdir in walkdirs(fullpath, topdown, depth-1, hidden,
                             followlinks, sort) do
        yield subdir;
    }
  }

  if (!topdown) then
    yield path;
}

//
// Here's a parallel version
//
iter walkdirs(path: string=".", topdown=true, depth=max(int), hidden=false,
              followlinks=false, sort=false, param tag: iterKind): string
       where tag == iterKind.standalone {

  if (sort) then
    warning("sorting has no effect for parallel invocations of walkdirs()");

  if (topdown) then
    yield path;

  if (depth) {
    var subdirs = listdir(path, hidden=hidden, files=false, listlinks=followlinks);
    forall subdir in subdirs {
      const fullpath = path + "/" + subdir;
      //
      // Call standalone walkdirs() iterator recursively; set sort=false since it is
      // not useful and we've already printed the warning
      //
      for subdir in walkdirs(fullpath, topdown, depth-1, hidden, followlinks, sort=false, iterKind.standalone) do
        yield subdir;
    }
  }

  if (!topdown) then
    yield path;
}

/* iter glob(pattern="*")

   glob() gives glob() capabilities and is implemented using C's glob()

     * pattern: the glob pattern to match against

   By default, it will list all files/directories in the current directory
*/

module Chpl_rt_glob {
  extern type glob_t;

  extern const GLOB_NOMATCH: c_int;

  extern proc chpl_glob(pattern:c_string, flags: c_int,
                        ref ret_glob:glob_t):c_int;
  extern proc chpl_glob_num(x:glob_t): size_t;
  extern proc chpl_glob_index(x:glob_t, idx:size_t): c_string;
  extern proc globfree(ref glb:glob_t);
}

iter glob(pattern="*") {
  var glb : Chpl_rt_glob.glob_t;

  const err = Chpl_rt_glob.chpl_glob(pattern:c_string, 0, glb);
  // TODO: Handle error cases better
  if (err != 0 && err != Chpl_rt_glob.GLOB_NOMATCH) then
    __primitive("chpl_error", "unhandled error in glob()");
  const num = Chpl_rt_glob.chpl_glob_num(glb);
  if (num) then
    for i in 0..num-1 do
      yield Chpl_rt_glob.chpl_glob_index(glb, i): string;

  Chpl_rt_glob.globfree(glb);
}

iter glob(pattern:string="*", param tag: iterKind)
       where tag == iterKind.standalone {
  var glb : Chpl_rt_glob.glob_t;

  const err = Chpl_rt_glob.chpl_glob(pattern:c_string, 0, glb);
  // TODO: Handle error cases better
  if (err != 0 && err != Chpl_rt_glob.GLOB_NOMATCH) then
    __primitive("chpl_error", "unhandled error in glob()");
  const num = Chpl_rt_glob.chpl_glob_num(glb);
  if (num) then
    forall i in 0..num-1 do
      yield Chpl_rt_glob.chpl_glob_index(glb, i): string;

  Chpl_rt_glob.globfree(glb);
}

//
// TODO: The following leader/follower iterator assumes that
// the file system state won't change between calls because
// it calls the glob routines twice and assumes the same
// result will come back.  In leader-follower 2.0, we would
// like to store such state between calls in which case this
// should be rewritten to do so (and would require freeing
// the state at the end of the call).
//
iter glob(pattern:string="*", param tag: iterKind)
       where tag == iterKind.leader {
  var glb : Chpl_rt_glob.glob_t;

  const err = Chpl_rt_glob.chpl_glob(pattern:c_string, 0, glb);
  // TODO: Handle error cases better
  if (err != 0 && err != Chpl_rt_glob.GLOB_NOMATCH) then
    __primitive("chpl_error", "unhandled error in glob()");
  //
  // cast is used here to ensure we create an int-based leader
  //
  const num = Chpl_rt_glob.chpl_glob_num(glb).safeCast(int);
  if (num) {
    Chpl_rt_glob.globfree(glb);

    //
    // Forward to the range type's leader
    //
    for followThis in (0..num-1).these(tag) do
      yield followThis;
  }
}

iter glob(pattern:string="*", followThis, param tag: iterKind)
       where tag == iterKind.follower {
  var glb : Chpl_rt_glob.glob_t;
  if (followThis.size != 1) then
    compilerError("glob() iterator can only be zipped with 1D iterators");
  var (r,) = followThis;

  const err = Chpl_rt_glob.chpl_glob(pattern:c_string, 0, glb);
  // TODO: Handle error cases better
  if (err != 0 && err != Chpl_rt_glob.GLOB_NOMATCH) then
    __primitive("chpl_error", "unhandled error in glob()");
  const num = Chpl_rt_glob.chpl_glob_num(glb);
  if (r.high > num.safeCast(int)) then
    halt("glob() iterator zipped with something too big");
  if (num) then
    for i in r do
      //
      // safe cast is used here to turn an int into a size_t
      //
      yield Chpl_rt_glob.chpl_glob_index(glb, i.safeCast(size_t)): string;

  Chpl_rt_glob.globfree(glb);
}

/* iter findfiles(startdir = ".", recursive=false, hidden=false)

   findfiles() is a simple find-like utility implemented using the
   above routines

     * startdir: where to start when looking for files
     * recursive: tells whether or not to descend recurisvely
     * hidden: tells whether or not to yield hidden
*/

iter findfiles(startdir = ".", recursive=false, hidden=false) {
  if (recursive) then
    for subdir in walkdirs(startdir, hidden=hidden) do
      for file in listdir(subdir, hidden=hidden, dirs=false, files=true, listlinks=true) do
        yield subdir+"/"+file;
  else
    for file in listdir(startdir, hidden=hidden, dirs=false, files=true, listlinks=false) do
      yield startdir+"/"+file;
}

iter findfiles(startdir = ".", recursive=false, hidden=false, param tag: iterKind) where tag == iterKind.standalone {
  if (recursive) then
    forall subdir in walkdirs(startdir, hidden=hidden) do
      for file in listdir(subdir, hidden=hidden, dirs=false, files=true, listlinks=true) do
        yield subdir+"/"+file;
  else
    for file in listdir(startdir, hidden=hidden, dirs=false, files=true, listlinks=false) do
      yield startdir+"/"+file;
}


Need user-defined initCopy to keep copy initialization 2 from freeing managed data prematurely.

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

class RefCount {
  var count:int;
  proc RefCount() {
    writeln("Initializing a RefCount");
    count = 1;
  }
  proc ~RefCount() {
    writeln("Destroying a RefCount");
  }
}

record R {
  var refcnt = new RefCount();
  proc retain() {
    refcnt.count += 1;
  }
  proc release() {
    refcnt.count -= 1;
    if refcnt.count == 0 {
      delete refcnt;
      refcnt = nil;
    }
  }
  proc ~R() {
    writeln("In ~R() ", refcnt.count);
    this.release();
  }

}

pragma "init copy fn"
proc chpl__initCopy(x: R) {
  writeln("In R initCopy ", x.refcnt);
  x.retain();
  return x;
}
/*
proc chpl__autoCopy(x: R) {
  writeln("In R autoCopy ", x.refcnt);
  x.retain();
  return x;
}
*/

proc =(ret:R, x:R) {
  // retain then release.
  writeln("Starting R assign ", ret.refcnt, x.refcnt);
  x.retain();
  ret.release();
  ret.refcnt = x.refcnt;
  writeln("Done R assign ", ret.refcnt);
  return ret;
}

proc R.routine() {
  writeln("In R.routine ", refcnt);
}

writeln("Making global");
var globalR:R;
writeln("Done making global");

proc test_two(x:R, setglobal:bool) {
  writeln("In test_two ", x.refcnt);
  if setglobal then globalR = x;
}

proc test_one(x:R, setglobal:bool) {
  writeln("Starting test_one ", x.refcnt);
  x.routine();
  test_two(x, setglobal);
  writeln("Done test_one ", x.refcnt);
}

writeln("Before scope");
{
  var r:R;

  test_one(r, false);
}
writeln("After scope");

writeln("Before scope (copy initialization)");
{
  var r:R;
  var x:R = r;

  test_one(x, false);
}
writeln("After scope (copy initialization)");

writeln("Before scope (copy initialization 2)");
{
  var r:R;
  var x = r;

  test_one(x, false);
}
writeln("After scope (copy initialization 2)");

writeln("Before scope (setting global)");
{
  var r:R;

  test_one(r, true);
}
writeln("After scope (setting global)");

writeln("Before scope (begin)");
sync {
  var r:R;
  begin {
    test_one(r, false);
  }
}
writeln("After scope (begin)");

writeln("Finishing");

class RefCount {
  var count:int;
  proc RefCount() {
    writeln("Initializing a RefCount");
    count = 1;
  }
  proc ~RefCount() {
    writeln("Destroying a RefCount");
  }
}

record R {
  var refcnt = new RefCount();
  proc retain() {
    refcnt.count += 1;
  }
  proc release() {
    refcnt.count -= 1;
    if refcnt.count == 0 {
      delete refcnt;
      refcnt = nil;
    }
  }
  proc ~R() {
    writeln("In ~R() ", refcnt.count);
    this.release();
  }

}

/*
proc chpl__initCopy(x: R) {
  writeln("In R initCopy ", x.refcnt);
  x.retain();
  return x;
}
proc chpl__autoCopy(x: R) {
  writeln("In R autoCopy ", x.refcnt);
  x.retain();
  return x;
}
*/

proc =(ret:R, x:R) {
  // retain then release.
  writeln("Starting R assign ", ret.refcnt, x.refcnt);
  x.retain();
  ret.release();
  ret.refcnt = x.refcnt;
  writeln("Done R assign ", ret.refcnt);
  return ret;
}

proc R.routine() {
  writeln("In R.routine ", refcnt);
}

writeln("Making global");
var globalR:R;
writeln("Done making global");

proc test_two(x:R, setglobal:bool) {
  writeln("In test_two ", x.refcnt);
  if setglobal then globalR = x;
}

proc test_one(x:R, setglobal:bool) {
  writeln("Starting test_one ", x.refcnt);
  x.routine();
  test_two(x, setglobal);
  writeln("Done test_one ", x.refcnt);
}

writeln("Before scope");
{
  var r:R;

  test_one(r, false);
}
writeln("After scope");

writeln("Before scope (copy initialization)");
{
  var r:R;
  var x:R = r;

  test_one(x, false);
}
writeln("After scope (copy initialization)");

writeln("Before scope (copy initialization 2)");
{
  var r:R;
  var x = r;

  test_one(x, false);
}
writeln("After scope (copy initialization 2)");

writeln("Before scope (setting global)");
{
  var r:R;

  test_one(r, true);
}
writeln("After scope (setting global)");

writeln("Before scope (begin)");
sync {
  var r:R;
  begin {
    test_one(r, false);
  }
}
writeln("After scope (begin)");

writeln("Finishing");