Change level sets to be associative arrays.

Changed the level sets to be associative arrays rather than sparse so
that we could remove the explicit locking from the kernel 4 code.
This also required that we change the local sum for validation into a
sync since it is no longer protected by the lock.  We do not enable
validation when timing so it should not affect the performance
results.

Kristi and I agreed to do this for now to clean up the kernel 4 code,
though there may be a time in the future when we change this to
something else (possibly 1-d array).

It will be interesting to see if there are performance implications.

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@18920 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.  |
//  |  The equivalent of "ifdef" is provided by conditionals that are          |
//  |  evaluated at compile time.  Dead code is eliminated by the compiler.    |
//  +==========================================================================+

//  +==========================================================================+
//  |  Parallelism note -- March 2010                                          |
//  |                                                                          |
//  |  A common motif in all three kernels is a pair of loops of the form      |
//  |      forall vertices in some_set do                                      |
//  |         forall neighbors of each vertex do ....                          |
//  |  Even when this appears inside an enclosing embarrassingly parallel      |
//  |  outer loop, it will be important to parallelize this pair of loops.     |
//  |  In the most important cases, the size of the set of vertices varies     |
//  |  considerably during the execution of the kernel and there can be wide   |
//  |  variation in the number of neighbors.  So parallelization should        |
//  |  consider both loops together.                                           |
//  |                                                                          |
//  |  That said, currently Chapel cannot parallelize the innermost loops,     |
//  |  even when the innermost loop is a reduction.  Some or all of the        |
//  |  iterators that appear in this inner loop do not have parallel forms     |
//  |  at present; they use sparse or associative domains.  So the inner loops |
//  |  all appear in this code as "for" rather than "forall".  They are all    |
//  |  parallelizable and should become parallel loops eventually.             |
//  +==========================================================================+
{
  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 ();
      var heaviest_edge_weight$ : sync int = 0;

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

      //       heaviest_edge_weight = max reduce [ s in G.vertices ]
      //        	                         [ w in G.edge_weight (s) ] w;

      forall s in G.vertices do
        forall w in G.edge_weight (s) do
	  heaviest_edge_weight$ = max ( w, heaviest_edge_weight$ );

      // ---------------------------------------------
      // 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.Neighbors (s), G.edge_weight (s) ) do

	  // should be forall, requires a custom parallel iterator in the
	  // random graph case and zippering for associative domains may
	  // also present a problem

	  if w == heaviest_edge_weight$.readXX () 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$ . readFF ());
	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.Neighbors (s), G.edge_weight (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] sync int = -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 ).writeFF (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 { // eventually, will be forall

	      if min_distance$ (w).readXX () < 0 then {

		if min_distance$ (w).readFE () < 0 then {
		  Next_Level.add (w);
		  Heavy_Edge_Subgraph ( (x, y) ).nodes.add (w);
		  min_distance$ (w).writeEF (path_length);
		}
		else
		  min_distance$ (w).writeEF (path_length);
	      }

	      // min_distance$ must have been set by some thread by now

	      if min_distance$ (w).readFF () == 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

  // ============================================================
  // generic class structure must be defined outside of
  // generic procedure.  used by Betweenness Centrality 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);
  }

  // ==================================================================
  //                              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;

      // Use an associative domain to represent the sparse vertex list

      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;

      // ------------------------------------------------------
      // 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 {

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

	// --------------------------------------------------
	// all locally declared variables become private data
	// for each instance of the parallel for loop
	// --------------------------------------------------

  	var min_distance$  : [vertex_domain] sync int       = -1;
	var path_count$    : [vertex_domain] sync real (64) = 0.0;
	var depend         : [vertex_domain] real           = 0.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.

	var Active_Level = new Level_Set (Sparse_Vertex_List);
	var Next_Level   = new Level_Set (Sparse_Vertex_List);

	var current_distance : int = 0;

	// establish the initial level sets for the
	// breadth-first traversal from s

	Active_Level.Members.add ( s );
	Next_Level.Members.clear ();

	min_distance$ (s) . writeFF (0);
	Active_Level.previous = nil;
	Next_Level.previous   = Active_Level;

	path_count$ (s) . writeFF (1);

	while Active_Level.Members.numIndices > 0 do {

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

	    current_distance += 1;

	    forall u in Active_Level.Members do { // sparse

              forall (v, w) in ( G.Neighbors (u), G.edge_weight (u) ) do {

		// should be forall, requires a custom parallel iterator in the
		// random graph case and zippering for associative domains

		// --------------------------------------------
		// add any unmarked neighbors to the next level
		// --------------------------------------------

		if  ( FILTERING &&  w % 8 != 0 ) || !FILTERING  then
		  if  min_distance$ (v) . readXX () < 0  then
		    {
		      if  min_distance$ (v) . readFE () < 0  then
			{
			  min_distance$ (v).writeEF (current_distance);
			  Next_Level.Members.add (v);
			  if VALIDATE_BC then
			    Lcl_Sum_Min_Dist += current_distance;
			}
		      else
                        // could min_distance$(v) be < current_distance?
			min_distance$ (v) . writeEF (current_distance);
		    }

		// ------------------------------------------------
		// only neighbors of  u  that are in the next level
		// are on shortest paths from s through v.  Some
		// thread 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  min_distance$ (v).readFF () == current_distance
		  then
		    path_count$ (v) += path_count$ (u).readFF ();
	      }
	    };

	    Active_Level = Next_Level;
	    Next_Level   = new Level_Set (Sparse_Vertex_List);

	    Next_Level.Members.clear ();
	    Next_Level.previous = Active_Level;

	  };  // end forward pass

	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)
	// -------------------------------------------------------------

	var graph_diameter = current_distance - 1;

	if DEBUG_KERNEL4 then
	  writeln ( " graph diameter from starting node ", s,
		    "  is ", graph_diameter );

	delete Next_Level;	               // it's empty
	Next_Level   = Active_Level.previous;  // back up to last level
	delete Active_Level;
	Active_Level = Next_Level;

	for current_distance in 2 .. graph_diameter by -1 do {

	  Next_Level   = Active_Level.previous;
	  delete Active_Level;
	  Active_Level = Next_Level;

	  // inner reduction should parallelize eventually; compiler
	  // serializes it today (and warns us that it did)

	  forall u in Active_Level.Members do
	    {
	      depend (u) = + reduce
		[ (v, w)  in ( G.Neighbors (u), G.edge_weight (u) ) ]
		if ( min_distance$ (v).readFF () == current_distance ) &&
		( ( FILTERING && w % 8 != 0 || !FILTERING ) )
		then
		  ( path_count$ (u) . readFF () /
		    path_count$ (v) . readFF () )      *
		    ( 1.0 + depend (v) );

	      // do not need conditional u != s

	      Between_Cent$ (u) += depend (u);
	    }
	};
	delete Active_Level;

      }; // 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 n0            = + reduce [v in vertex_domain] (G.n_Neighbors (v)== 0);
	var n_edges       = + reduce [v in vertex_domain] G.n_Neighbors (v);
	var N_VERTICES    = vertex_domain.numIndices;
	var TEPS          = 7.0 * N_VERTICES * (N_VERTICES - n0) / K4_time;
	var Adjusted_TEPS = n_edges * (N_VERTICES - n0) / 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$;

    } // end of Brandes' betweenness centrality calculation

}

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.  |
//  |  The equivalent of "ifdef" is provided by conditionals that are          |
//  |  evaluated at compile time.  Dead code is eliminated by the compiler.    |
//  +==========================================================================+

//  +==========================================================================+
//  |  Parallelism note -- March 2010                                          |
//  |                                                                          |
//  |  A common motif in all three kernels is a pair of loops of the form      |
//  |      forall vertices in some_set do                                      |
//  |         forall neighbors of each vertex do ....                          |
//  |  Even when this appears inside an enclosing embarrassingly parallel      |
//  |  outer loop, it will be important to parallelize this pair of loops.     |
//  |  In the most important cases, the size of the set of vertices varies     |
//  |  considerably during the execution of the kernel and there can be wide   |
//  |  variation in the number of neighbors.  So parallelization should        |
//  |  consider both loops together.                                           |
//  |                                                                          |
//  |  That said, currently Chapel cannot parallelize the innermost loops,     |
//  |  even when the innermost loop is a reduction.  Some or all of the        |
//  |  iterators that appear in this inner loop do not have parallel forms     |
//  |  at present; they use sparse or associative domains.  So the inner loops |
//  |  all appear in this code as "for" rather than "forall".  They are all    |
//  |  parallelizable and should become parallel loops eventually.             |
//  +==========================================================================+
{
  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 ();
      var heaviest_edge_weight$ : sync int = 0;

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

      //       heaviest_edge_weight = max reduce [ s in G.vertices ]
      //        	                         [ w in G.edge_weight (s) ] w;

      forall s in G.vertices do
        forall w in G.edge_weight (s) do
	  heaviest_edge_weight$ = max ( w, heaviest_edge_weight$ );

      // ---------------------------------------------
      // 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.Neighbors (s), G.edge_weight (s) ) do

	  // should be forall, requires a custom parallel iterator in the
	  // random graph case and zippering for associative domains may
	  // also present a problem

	  if w == heaviest_edge_weight$.readXX () 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$ . readFF ());
	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.Neighbors (s), G.edge_weight (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] sync int = -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 ).writeFF (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 { // eventually, will be forall

	      if min_distance$ (w).readXX () < 0 then {

		if min_distance$ (w).readFE () < 0 then {
		  Next_Level.add (w);
		  Heavy_Edge_Subgraph ( (x, y) ).nodes.add (w);
		  min_distance$ (w).writeEF (path_length);
		}
		else
		  min_distance$ (w).writeEF (path_length);
	      }

	      // min_distance$ must have been set by some thread by now

	      if min_distance$ (w).readFF () == 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

  // ============================================================
  // generic class structure must be defined outside of
  // generic procedure.  used by Betweenness Centrality 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);
  }

  // ==================================================================
  //                              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;

      // Had to change declaration below
      //    type Sparse_Vertex_List = sparse subdomain ( G.vertices );
      // to accommodate block distribution of G.vertices

      type Sparse_Vertex_List = sparse subdomain ( [(...vertex_domain.dims())] );

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

      // ------------------------------------------------------
      // 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 {

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

	// --------------------------------------------------
	// all locally declared variables become private data
	// for each instance of the parallel for loop
	// --------------------------------------------------

  	var min_distance$  : [vertex_domain] sync int       = -1;
	var path_count$    : [vertex_domain] sync real (64) = 0.0;
	var depend         : [vertex_domain] real           = 0.0;
	var Lcl_Sum_Min_Dist                             = 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.

	var Active_Level = new Level_Set (Sparse_Vertex_List);
	var Next_Level   = new Level_Set (Sparse_Vertex_List);

	var current_distance : int = 0;

	// lock needed only because sparse domain add is not threadsafe
	var node_add_lock$ : sync bool = true;

	// establish the initial level sets for the
	// breadth-first traversal from s

	Active_Level.Members.add ( s );
	Next_Level.Members.clear ();

	min_distance$ (s) . writeFF (0);
	Active_Level.previous = nil;
	Next_Level.previous   = Active_Level;

	path_count$ (s) . writeFF (1);

	while Active_Level.Members.numIndices > 0 do {

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

	    current_distance += 1;

	    forall u in Active_Level.Members do { // sparse

              forall (v, w) in ( G.Neighbors (u), G.edge_weight (u) ) do {

		// should be forall, requires a custom parallel iterator in the
		// random graph case and zippering for associative domains

		// --------------------------------------------
		// add any unmarked neighbors to the next level
		// --------------------------------------------

		if  ( FILTERING &&  w % 8 != 0 ) || !FILTERING  then
		  if  min_distance$ (v) . readXX () < 0  then
		    {
		      if  min_distance$ (v) . readFE () < 0  then
			{
			  min_distance$ (v).writeEF (current_distance);
                          node_add_lock$.readFE ();
			  Next_Level.Members.add (v);
			  if VALIDATE_BC then
			    Lcl_Sum_Min_Dist += current_distance;
                          node_add_lock$.writeEF ( true );
			}
		      else
                        // could min_distance$(v) be < current_distance?
			min_distance$ (v) . writeEF (current_distance);
		    }

		// ------------------------------------------------
		// only neighbors of  u  that are in the next level
		// are on shortest paths from s through v.  Some
		// thread 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  min_distance$ (v).readFF () == current_distance
		  then
		    path_count$ (v) += path_count$ (u).readFF ();
	      }
	    };

	    Active_Level = Next_Level;
	    Next_Level   = new Level_Set (Sparse_Vertex_List);

	    Next_Level.Members.clear ();
	    Next_Level.previous = Active_Level;

	  };  // end forward pass

	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)
	// -------------------------------------------------------------

	var graph_diameter = current_distance - 1;

	if DEBUG_KERNEL4 then
	  writeln ( " graph diameter from starting node ", s,
		    "  is ", graph_diameter );

	delete Next_Level;	               // it's empty
	Next_Level   = Active_Level.previous;  // back up to last level
	delete Active_Level;
	Active_Level = Next_Level;

	for current_distance in 2 .. graph_diameter by -1 do {

	  Next_Level   = Active_Level.previous;
	  delete Active_Level;
	  Active_Level = Next_Level;

	  // inner reduction should parallelize eventually; compiler
	  // serializes it today (and warns us that it did)

	  forall u in Active_Level.Members do
	    {
	      depend (u) = + reduce
		[ (v, w)  in ( G.Neighbors (u), G.edge_weight (u) ) ]
		if ( min_distance$ (v).readFF () == current_distance ) &&
		( ( FILTERING && w % 8 != 0 || !FILTERING ) )
		then
		  ( path_count$ (u) . readFF () /
		    path_count$ (v) . readFF () )      *
		    ( 1.0 + depend (v) );

	      // do not need conditional u != s

	      Between_Cent$ (u) += depend (u);
	    }
	};
	delete Active_Level;

      }; // 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 n0            = + reduce [v in vertex_domain] (G.n_Neighbors (v)== 0);
	var n_edges       = + reduce [v in vertex_domain] G.n_Neighbors (v);
	var N_VERTICES    = vertex_domain.numIndices;
	var TEPS          = 7.0 * N_VERTICES * (N_VERTICES - n0) / K4_time;
	var Adjusted_TEPS = n_edges * (N_VERTICES - n0) / 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$;

    } // end of Brandes' betweenness centrality calculation

}


Removed "NULL" from internal prelude since we now
have "nil" instead.

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

const NULL: integer = 0;  -- this needs to precede any class definitions

class Index {
}

pragma "omit for noanalysis" class Array {
  function this(i) {
    return __primitive("array_index", this, i);
  }
  function this(i, j) {
    return __primitive("array_index", this, i, j);
  }
  function this(i, j, k) {
    return __primitive("array_index", this, i, j, k);
  }
}

class Domain {
}

class Tuple {
  function this(pragma "clone_for_constants" i) {
    return __primitive("index_object", this, i);
  }
}

pragma "builtin" function +(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function -(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function *(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function /(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function &(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function |(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function ^(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function ==(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function !=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function <=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function >=(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function <(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function >(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function and(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function or(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }
pragma "builtin" function **(a : Array, b : Array) { return __primitive("array_pointwise_op", a, b); }

pragma "builtin" function +(a : numeric, b : numeric) { return __primitive(a, "+", b); }
pragma "builtin" function -(a : numeric, b : numeric) { return __primitive(a, "-", b); }
pragma "builtin" function *(a : numeric, b : numeric) { return __primitive(a, "*", b); }
pragma "builtin" function /(a : numeric, b : numeric) { return __primitive(a, "/", b); }
pragma "builtin" function mod(a : numeric, b : numeric) { return __primitive(a, "%", b); }
pragma "builtin" function ==(a : numeric, b : numeric) { return __primitive(a, "==", b); }
pragma "builtin" function !=(a : numeric, b : numeric) { return __primitive(a, "!=", b); }
pragma "builtin" function <=(a : numeric, b : numeric) { return __primitive(a, "<=", b); }
pragma "builtin" function >=(a : numeric, b : numeric) { return __primitive(a, ">=", b); }
pragma "builtin" function <(a : numeric, b : numeric) { return __primitive(a, "<", b); }
pragma "builtin" function >(a : numeric, b : numeric) { return __primitive(a, ">", b); }
pragma "builtin" function &(a : numeric, b : numeric) { return __primitive(a, "&", b); }
pragma "builtin" function |(a : numeric, b : numeric) { return __primitive(a, "|", b); }
pragma "builtin" function ^(a : numeric, b : numeric) { return __primitive(a, "^", b); }
pragma "builtin" function and(a : numeric, b : numeric) { return __primitive(a, "&&", b); }
pragma "builtin" function or(a : numeric, b : numeric) { return __primitive(a, "||", b); }
pragma "builtin" function **(a : numeric, b : numeric) { return __primitive(a, "**", b); }
pragma "builtin" function by(a : numeric, b : numeric) { return __primitive(a, "by", b); }
pragma "builtin" function ==(a : object, b : object) { return __primitive("ptr_eq", a, b); }
pragma "builtin" function !=(a : object, b : object) { return __primitive("ptr_neq", a, b); }

function _chpl_malloc(number, size, description: string);
function _chpl_calloc(number, size, description: string);
function _chpl_free(memory);
function _chpl_realloc(memory, number, size, description: string);

function _init_string(inout str1_call : string, str1 : string, str2 : string);

function _UNION_CHECK(u, tag, filename, lineno);
function _UNION_SET(u, tag);
function _UNION_CHECK_QUIET(u, tag): boolean;

function _INIT_CONFIG(v, v_type, chapel_name, module_name);
function _INIT_ARRAY(rank, arr, dom, elt_type);
function _INIT_DOMAIN_DIM(dom, dim, lo, hi, str);

function _SEQ_APPEND(s, t, type_name);
function _SEQ_INIT_NIL(s);

pragma "omit for noanalysis" class _seq {
  type elementType;

  class _node {
    var element : elementType;
    var next : _node;
  }

  var length : integer;
  var first : _node;
  var last : _node;

  function append(e : elementType) : _seq {
    var new : _node;
    new = _node();
    new.element = e;
    if length > 0 {
      last.next = new;
      last = new;
    } else {
      first = new;
      last = new;
    }
    length += 1;
  }

  function prepend(e : elementType) : _seq {
    var new : _node;
    new = _node();
    new.element = e;
    if length > 0 {
      new.next = first;
      first = new;
    } else {
      first = new;
      last = new;
    }
    length += 1;
    return this;
  }

  function append_sequence(s : _seq) : _seq {
    last.next = s.first;
    length += s.length;
    return this;
  }

  function copy() : _seq {
    var new : _seq = _seq();
    for e in this {
      new.append(e);
    }
    return new;
  }

}

pragma "omit for noanalysis" function _seq_append(s, e) {
  s.append(e);
}
/*
pragma "omit for noanalysis" function _seq_pound(e, s) {
  s.prepend(e);
}

pragma "omit for noanalysis" function _seq_pound(s1, s2) {
  s1.append_sequence(s2);
}
*/


initial draft for dynamic

initial draft for dynamic

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

/*
For more information, see "User-Defined Parallel Zippered iterators
in Chapel". Bradford L. Chamberlain, Sung-Eun Choi, Steven J. Deitz,
Angeles Navarro. PGAS 2011: Fifth Conference on Partitioned Global
Address Space Programming Models, October 2011.
*/

/*
   An atomic test-and-set lock.
*/
record vlock {
  var l: atomic bool;
  proc lock() {
    on this do while l.testAndSet() != false do chpl_task_yield();
  }
  proc unlock() {
    l.write(false);
  }
}

/*
   A config param to control debugging output.
*/
config param debugAdvancedIters:bool=false;

//************************* Dynamic iterator

/*
   The serial version of the dynamic iterator.
   Essentially identical to the default range iterator.
*/
iter dynamic(c:range(?), chunkSize:int, numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial dynamic Iterator. Working with range ", c);

  for i in c do yield i;
}

// Parallel iterator

/*
   The parallel leader for the dynamic iterator.

   :arg c: The range to iterate over. The length of the range must be greater than zero.

   :arg chunkSize: The size of chunks to be yielded to each thread. Must be greater than zero.
   :type chunkSize: int

   :arg numTasks: The number of tasks to use. Must be >= zero.
   :type numTasks: int

   If this iterator cannot make use of more than one task, no tasks are created.

   Otherwise, this iterator will yield chunks of the specified size to each
   thread until all indices in the range have been yielded.
*/
iter dynamic(param tag:iterKind, c:range(?), chunkSize:int, numTasks:int=0)
where tag == iterKind.leader
{
  assert(chunkSize > 0); // caller's responsibility

  use UtilMath;
  // # of tasks the range can fill. (fast) ceil so all work is represented
  const chunkTasks = divceilpos(c.length, chunkSize): int;

  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks = min(chunkTasks, defaultNumTasks(numTasks));

  type rType=c.type;

  // We're going to have to densify at some point, might as well
  // do it early and make range slicing easier.
  const remain:rType=densify(c,c);

  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Dynamic Iterator: serial execution because there is not enough work");
    yield (remain,);
  } else {
    var moreWork : bool =true;
    var curIndex : atomic remain.low.type;
    curIndex.write(remain.low);

    coforall tid in 0..#nTasks with (ref remain, ref moreWork, ref curIndex) do {
      while moreWork do {
        // There is local work in remain
        const low = curIndex.fetchAdd(chunkSize);
        var high = low + chunkSize-1;

        if low > remain.high {
          break;
        } else if high > remain.high {
          high = remain.high;
          moreWork = false;
        }

        const current:rType = remain(low .. high);

        if high >= low then {
          if debugAdvancedIters then
            writeln("Parallel dynamic Iterator. Working at tid ", tid, " with range ", unDensify(current,c), " yielded as ", current);
          yield (current,);
        }
      }
    }
  }
}

// Follower
pragma "no doc"
iter dynamic(param tag:iterKind, c:range(?), chunkSize:int, numTasks:int, followThis)
where tag == iterKind.follower
{
  type rType=c.type;
  const current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Guided iterator

//Serial iterator
iter guided(c:range(?), numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial guided Iterator. Working with range ", c);

  for i in c do yield i;
}

// Parallel iterator

// Leader iterator
iter guided(param tag:iterKind, c:range(?), numTasks:int=0)
where tag == iterKind.leader
{
  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=min(c.length, defaultNumTasks(numTasks));
  type rType=c.type;
  var remain:rType = densify(c,c);
  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Guided Iterator: serial execution because there is not enoguh work");
    yield (remain,);
  }

  else {
    var undone=true;
    const factor=nTasks;
    var lock : vlock;

    coforall tid in 0..#nTasks with (ref remain, ref undone, ref lock) do {
      while undone do {
        // There is local work in remain(tid)
        const current:rType=adaptSplit(remain, factor, undone, lock);
        if current.length !=0 then {
          if debugAdvancedIters then
            writeln("Parallel guided Iterator. Working at tid ", tid, " with range ", unDensify(current,c), " yielded as ", current);
          yield (current,);
        }
      }
    }
  }
}

// Follower
iter guided(param tag:iterKind, c:range(?), numTasks:int, followThis)
where tag == iterKind.follower

{
  type rType=c.type;
  const current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Adaptive work-stealing iterator
//Serial iterator
iter adaptive(c:range(?), numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial adaptive work-stealing Iterator. Working with range ", c);

  for i in c do yield i;

}

// Parallel iterator

enum Method {
  Whole = 0,            // Steal until range is exhausted
  RoundRobin = 1,       // Steal from a different victim every time
  WholeTail = 2         // Steal from the tail until range is exhausted
};

config param methodStealing = Method.Whole;

// Leader iterator
iter adaptive(param tag:iterKind, c:range(?), numTasks:int=0)
where tag == iterKind.leader

{
  /*if (methodStealing != Method.Whole || methodStealing != Method.WholeTail) then
    compilerError("methodStealing value must be between 0 and 2");*/

  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=min(c.length, defaultNumTasks(numTasks));
  type rType=c.type;

  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Adaptive work-stealing Iterator: serial execution because there is not enough work");
    yield (densify(c,c),);

  }
  else {
    const r:rType=densify(c,c);
    const SpaceThreads:domain(1)=0..#nTasks;
    var localWork:[SpaceThreads] rType; // The remaining range to split on each Thread
    var moreLocalWork:[SpaceThreads] bool=true; // bool var to signal there is still work on each local range
    var locks:[SpaceThreads] vlock; // sync var to control the splitting on each Thread
    const factor:int=2;

    const factorSteal:int=2;
    var moreWork:bool=true; // A global var to control the termination

    // Variables to put a barrier to ensure the initial range is computed on each Thread
    var barrier : atomic int;

    // Start the parallel work
    coforall tid in 0..#nTasks with (ref localWork, ref moreLocalWork, ref moreWork, ref r) do {

      // Step 1: Initial range per Thread/Task

      // Initial Local range in localWork[tid]
      const chunkSize = c.length/nTasks;
      localWork[tid]=
      if tid==nTasks-1 then
        r#(chunkSize*(nTasks-1)-r.length)
      else
        (r+tid*chunkSize)#chunkSize;
      barrier.add(1);

      if debugAdvancedIters then
        writeln("Parallel adaptive work-stealing Iterator. Working at tid ", tid, " with initial range ", localWork[tid]);

      // A barrier waiting for each thread to finish the initial assignment
      barrier.waitFor(nTasks);

      // Step 2: While there is work at tid, do splitting

      while moreLocalWork[tid] do {
        // There is local work
        // The current range we get after splitting locally
        const zeroBasedIters:rType=adaptSplit(localWork[tid], factorSteal, moreLocalWork[tid], locks[tid]);
        if zeroBasedIters.length !=0 then {
          if debugAdvancedIters then
            writeln("Parallel adaptive Iterator. Working locally at tid ", tid, " with range yielded as ", zeroBasedIters);
          yield (zeroBasedIters,);
        }
      }

      // Step3: Task tid finished its work, so it will try to steal from a neighbor

      var nVisitedVictims:int=0;
      var victim=(tid+1) % nTasks;
      var stealFailed:bool=false;

      while moreWork do {
        if debugAdvancedIters then
          writeln("Entering at Stealing phase in tid ", tid," with victim ", victim, " using method of Stealing ", methodStealing);

        // Perform the spliting at the victim remaining range

        if methodStealing == Method.RoundRobin {
          if moreLocalWork[victim] then {
            // There is work in victim
            const zeroBasedIters2:rType=adaptSplit(localWork[victim], factorSteal, moreLocalWork[victim], locks[victim]);
            if zeroBasedIters2.length !=0 then {
              if debugAdvancedIters then
                writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
              yield (zeroBasedIters2,);
            }
          } else {
            stealFailed=true;
          }
        } else {
          while moreLocalWork[victim] do {
            // There is work in victim
            const zeroBasedIters2:rType=adaptSplit(localWork[victim], factorSteal, moreLocalWork[victim], locks[victim], methodStealing==Method.WholeTail);
                                          //after splitting from a victim range
            if zeroBasedIters2.length !=0 then {
              if debugAdvancedIters then
                writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
              yield (zeroBasedIters2,);
            }
          }
        }

        // If here, then it can have failed the stealing intent at the victim (method 1),
        // or we have exhausted the victim range (methods 0, 2)

        if (methodStealing==Method.Whole || methodStealing==Method.WholeTail || (methodStealing==Method.RoundRobin && stealFailed)) then {
          nVisitedVictims += 1; // Signal that there is no more work in victim
          stealFailed=false;
          if debugAdvancedIters then
            writeln("Failed Stealing intent at tid ", tid," with victim ", victim, " and total no. of visited victims ", nVisitedVictims);
        }
        // Check if there is no more work
        if nVisitedVictims >= nTasks-1 then
          moreWork=false; // Signal that there is no more work in any victim
        else {  // There can be still work in other victim
          victim=(victim+1) % nTasks; // New victim to steal
          if methodStealing==Method.RoundRobin && victim==tid then
            victim=(victim+1) % nTasks;
        }
      }
    }
  }
}

// Follower
iter adaptive(param tag:iterKind, c:range(?), numTasks:int, followThis)
where tag == iterKind.follower
{
  type rType=c.type;
  var current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Helper functions
proc defaultNumTasks(nTasks:int)
{
  var dnTasks=nTasks;
  if nTasks==0 then {
    if dataParTasksPerLocale==0 then dnTasks=here.maxTaskPar;
      else dnTasks=dataParTasksPerLocale;
  } else if nTasks<0 then {
    halt("'numTasks' is negative");
  }
  return dnTasks;
}

proc adaptSplit(ref rangeToSplit:range(?), splitFactor:int, ref itLeft:bool, ref lock : vlock, splitTail:bool=false)
{
  type rType=rangeToSplit.type;
  type lenType=rangeToSplit.length.type;
  var totLen, size:lenType;
  const profThreshold=1;

  lock.lock();
  totLen=rangeToSplit.length;
  if totLen > profThreshold then
    size=max(totLen/splitFactor, profThreshold);
  else {
    size=totLen;
    itLeft=false;}
  const direction = if splitTail then -1 else 1;
  const firstRange:rType=rangeToSplit#(direction*size);
  rangeToSplit=rangeToSplit#(direction*(size-totLen));
  lock.unlock();
  return firstRange;
}

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

/*
For more information, see "User-Defined Parallel Zippered iterators
in Chapel". Bradford L. Chamberlain, Sung-Eun Choi, Steven J. Deitz,
Angeles Navarro. PGAS 2011: Fifth Conference on Partitioned Global
Address Space Programming Models, October 2011.
*/

record vlock {
  var l: atomic bool;
  proc lock() {
    on this do while l.testAndSet() != false do chpl_task_yield();
  }
  proc unlock() {
    l.write(false);
  }
}

config param debugAdvancedIters:bool=false;

//************************* Dynamic iterator

// Serial iterator

iter dynamic(c:range(?), chunkSize:int, numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial dynamic Iterator. Working with range ", c);

  for i in c do yield i;
}

// Parallel iterator

// Leader iterator

iter dynamic(param tag:iterKind, c:range(?), chunkSize:int, numTasks:int=0)
where tag == iterKind.leader
{
  assert(chunkSize > 0); // caller's responsibility

  use UtilMath;
  // # of tasks the range can fill. (fast) ceil so all work is represented
  const chunkTasks = divceilpos(c.length, chunkSize): int;

  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks = min(chunkTasks, defaultNumTasks(numTasks));

  type rType=c.type;

  // We're going to have to densify at some point, might as well
  // do it early and make range slicing easier.
  const remain:rType=densify(c,c);

  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Dynamic Iterator: serial execution because there is not enough work");
    yield (remain,);
  } else {
    var moreWork : bool =true;
    var curIndex : atomic remain.low.type;
    curIndex.write(remain.low);

    coforall tid in 0..#nTasks with (ref remain, ref moreWork, ref curIndex) do {
      while moreWork do {
        // There is local work in remain
        const low = curIndex.fetchAdd(chunkSize);
        var high = low + chunkSize-1;

        if low > remain.high {
          break;
        } else if high > remain.high {
          high = remain.high;
          moreWork = false;
        }

        const current:rType = remain(low .. high);

        if high >= low then {
          if debugAdvancedIters then
            writeln("Parallel dynamic Iterator. Working at tid ", tid, " with range ", unDensify(current,c), " yielded as ", current);
          yield (current,);
        }
      }
    }
  }
}

// Follower
iter dynamic(param tag:iterKind, c:range(?), chunkSize:int, numTasks:int, followThis)
where tag == iterKind.follower
{
  type rType=c.type;
  const current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Guided iterator
//Serial iterator
iter guided(c:range(?), numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial guided Iterator. Working with range ", c);

  for i in c do yield i;
}

// Parallel iterator

// Leader iterator
iter guided(param tag:iterKind, c:range(?), numTasks:int=0)
where tag == iterKind.leader
{
  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=min(c.length, defaultNumTasks(numTasks));
  type rType=c.type;
  var remain:rType = densify(c,c);
  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Guided Iterator: serial execution because there is not enoguh work");
    yield (remain,);
  }

  else {
    var undone=true;
    const factor=nTasks;
    var lock : vlock;

    coforall tid in 0..#nTasks with (ref remain, ref undone, ref lock) do {
      while undone do {
        // There is local work in remain(tid)
        const current:rType=adaptSplit(remain, factor, undone, lock);
        if current.length !=0 then {
          if debugAdvancedIters then
            writeln("Parallel guided Iterator. Working at tid ", tid, " with range ", unDensify(current,c), " yielded as ", current);
          yield (current,);
        }
      }
    }
  }
}

// Follower
iter guided(param tag:iterKind, c:range(?), numTasks:int, followThis)
where tag == iterKind.follower

{
  type rType=c.type;
  const current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Adaptive work-stealing iterator
//Serial iterator
iter adaptive(c:range(?), numTasks:int=0) {

  if debugAdvancedIters then
    writeln("Serial adaptive work-stealing Iterator. Working with range ", c);

  for i in c do yield i;

}

// Parallel iterator

enum Method {
  Whole = 0,            // Steal until range is exhausted
  RoundRobin = 1,       // Steal from a different victim every time
  WholeTail = 2         // Steal from the tail until range is exhausted
};

config param methodStealing = Method.Whole;

// Leader iterator
iter adaptive(param tag:iterKind, c:range(?), numTasks:int=0)
where tag == iterKind.leader

{
  /*if (methodStealing != Method.Whole || methodStealing != Method.WholeTail) then
    compilerError("methodStealing value must be between 0 and 2");*/

  // Check if the number of tasks is 0, in that case it returns a default value
  const nTasks=min(c.length, defaultNumTasks(numTasks));
  type rType=c.type;

  // If the number of tasks is insufficient, yield in serial
  if c.length == 0 then halt("The range is empty");
  if nTasks == 1 then {
    if debugAdvancedIters then
      writeln("Adaptive work-stealing Iterator: serial execution because there is not enough work");
    yield (densify(c,c),);

  }
  else {
    const r:rType=densify(c,c);
    const SpaceThreads:domain(1)=0..#nTasks;
    var localWork:[SpaceThreads] rType; // The remaining range to split on each Thread
    var moreLocalWork:[SpaceThreads] bool=true; // bool var to signal there is still work on each local range
    var locks:[SpaceThreads] vlock; // sync var to control the splitting on each Thread
    const factor:int=2;

    const factorSteal:int=2;
    var moreWork:bool=true; // A global var to control the termination

    // Variables to put a barrier to ensure the initial range is computed on each Thread
    var barrier : atomic int;

    // Start the parallel work
    coforall tid in 0..#nTasks with (ref localWork, ref moreLocalWork, ref moreWork, ref r) do {

      // Step 1: Initial range per Thread/Task

      // Initial Local range in localWork[tid]
      const chunkSize = c.length/nTasks;
      localWork[tid]=
      if tid==nTasks-1 then
        r#(chunkSize*(nTasks-1)-r.length)
      else
        (r+tid*chunkSize)#chunkSize;
      barrier.add(1);

      if debugAdvancedIters then
        writeln("Parallel adaptive work-stealing Iterator. Working at tid ", tid, " with initial range ", localWork[tid]);

      // A barrier waiting for each thread to finish the initial assignment
      barrier.waitFor(nTasks);

      // Step 2: While there is work at tid, do splitting

      while moreLocalWork[tid] do {
        // There is local work
        // The current range we get after splitting locally
        const zeroBasedIters:rType=adaptSplit(localWork[tid], factorSteal, moreLocalWork[tid], locks[tid]);
        if zeroBasedIters.length !=0 then {
          if debugAdvancedIters then
            writeln("Parallel adaptive Iterator. Working locally at tid ", tid, " with range yielded as ", zeroBasedIters);
          yield (zeroBasedIters,);
        }
      }

      // Step3: Task tid finished its work, so it will try to steal from a neighbor

      var nVisitedVictims:int=0;
      var victim=(tid+1) % nTasks;
      var stealFailed:bool=false;

      while moreWork do {
        if debugAdvancedIters then
          writeln("Entering at Stealing phase in tid ", tid," with victim ", victim, " using method of Stealing ", methodStealing);

        // Perform the spliting at the victim remaining range

        if methodStealing == Method.RoundRobin {
          if moreLocalWork[victim] then {
            // There is work in victim
            const zeroBasedIters2:rType=adaptSplit(localWork[victim], factorSteal, moreLocalWork[victim], locks[victim]);
            if zeroBasedIters2.length !=0 then {
              if debugAdvancedIters then
                writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
              yield (zeroBasedIters2,);
            }
          } else {
            stealFailed=true;
          }
        } else {
          while moreLocalWork[victim] do {
            // There is work in victim
            const zeroBasedIters2:rType=adaptSplit(localWork[victim], factorSteal, moreLocalWork[victim], locks[victim], methodStealing==Method.WholeTail);
                                          //after splitting from a victim range
            if zeroBasedIters2.length !=0 then {
              if debugAdvancedIters then
                writeln("Range stealed at victim ", victim," yielded as ", zeroBasedIters2," by tid ", tid);
              yield (zeroBasedIters2,);
            }
          }
        }

        // If here, then it can have failed the stealing intent at the victim (method 1),
        // or we have exhausted the victim range (methods 0, 2)

        if (methodStealing==Method.Whole || methodStealing==Method.WholeTail || (methodStealing==Method.RoundRobin && stealFailed)) then {
          nVisitedVictims += 1; // Signal that there is no more work in victim
          stealFailed=false;
          if debugAdvancedIters then
            writeln("Failed Stealing intent at tid ", tid," with victim ", victim, " and total no. of visited victims ", nVisitedVictims);
        }
        // Check if there is no more work
        if nVisitedVictims >= nTasks-1 then
          moreWork=false; // Signal that there is no more work in any victim
        else {  // There can be still work in other victim
          victim=(victim+1) % nTasks; // New victim to steal
          if methodStealing==Method.RoundRobin && victim==tid then
            victim=(victim+1) % nTasks;
        }
      }
    }
  }
}

// Follower
iter adaptive(param tag:iterKind, c:range(?), numTasks:int, followThis)
where tag == iterKind.follower
{
  type rType=c.type;
  var current:rType=unDensify(followThis(1),c);
  if debugAdvancedIters then
    writeln("Follower received range ", followThis, " ; shifting to ", current);
  for i in current do {
    yield i;
  }
}

//************************* Helper functions
proc defaultNumTasks(nTasks:int)
{
  var dnTasks=nTasks;
  if nTasks==0 then {
    if dataParTasksPerLocale==0 then dnTasks=here.maxTaskPar;
      else dnTasks=dataParTasksPerLocale;
  } else if nTasks<0 then {
    halt("'numTasks' is negative");
  }
  return dnTasks;
}

proc adaptSplit(ref rangeToSplit:range(?), splitFactor:int, ref itLeft:bool, ref lock : vlock, splitTail:bool=false)
{
  type rType=rangeToSplit.type;
  type lenType=rangeToSplit.length.type;
  var totLen, size:lenType;
  const profThreshold=1;

  lock.lock();
  totLen=rangeToSplit.length;
  if totLen > profThreshold then
    size=max(totLen/splitFactor, profThreshold);
  else {
    size=totLen;
    itLeft=false;}
  const direction = if splitTail then -1 else 1;
  const firstRange:rType=rangeToSplit#(direction*size);
  rangeToSplit=rangeToSplit#(direction*(size-totLen));
  lock.unlock();
  return firstRange;
}