Updated test/studies/ssca2/vass to match release/examples/benchmarks/ssca2, as of r20245.

Setting up for some edits in test/studies/ssca2/vass.

test/studies/ssca2/vass remains NOTEST.

git-svn-id: 88467cb1fb04b8a755be7e1ee1026be4190196ef@20251 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          = + 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$;

      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);
      forall l in localePrivate do {
        l = new localePrivateData(vertex_domain);
        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.children_list[v].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 depend => lp.get_depend(tid);
        var min_distance  => lp.get_min_distance(tid);
        var path_count$   => lp.get_path_count(tid);
        var children_list => lp.get_children_list(tid);
        pragma "dont disable remote value forwarding"
          inline proc f1(path_count$, v) {
          path_count$[v].writeXF(0.0);
        }
        forall v in vertex_domain do {
          depend[v] = 0.0;
          min_distance[v].write(-1);
          // path_count$[v].writeXF(0.0);
          f1(path_count$, v);
          children_list[v].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(path_count$, s) {
          path_count$[s].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);
            min_distance[s].write(0);
            // path_count$[s].writeXF(1);
            f2(path_count$, 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(path_count$, v, u) {
              path_count$[v] += path_count$[u].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  min_distance[v].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 min_distance[v].read() == current_distance_c {
                    // path_count$[v] += path_count$[u].readFF();
                    f3(path_count$, v, u);
                    children_list(u).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(depend, children_list, path_count$, Between_Cent$, u) {
            depend (u) = + reduce [v in children_list(u).Row_Children[1..children_list(u).child_count.read()]]
              ( path_count$[u].readFF() /
                path_count$[v].readFF() )      *
              ( 1.0 + depend (v) );
            Between_Cent$ (u) += depend (u);
          }

          // 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(depend, children_list, path_count$, Between_Cent$, u);
                /*
              depend (u) = + reduce [v in children_list(u).Row_Children[1..children_list(u).child_count.read()]]
                ( path_count$[u].readFF() /
                  path_count$[v].readFF() )      *
                ( 1.0 + depend (v) );
              Between_Cent$ (u) += depend (u);
                */
            }

            barrier.barrier();
          }
        }

      }; // 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$;

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

  //
  // Implementation of task-private variables for kernel 4
  //
  class taskPrivateData {
    type Sparse_Vertex_List;
    const vertex_domain;
    // It would be nice to use an atomic for the tid, but
    // chpl_taskID_t is an opaque type.  Might be able to make some
    // assumptions about it.
    var tid$           : sync chpl_taskID_t = chpl_nullTaskID;
    var min_distance   : [vertex_domain] atomic int;
    var path_count$    : [vertex_domain] sync real(64);
    var depend         : [vertex_domain] real;
    var children_list  : [vertex_domain] child_struct(index(vertex_domain));
    var Active_Level   : [PrivateSpace] Level_Set (Sparse_Vertex_List);
  };
  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() {
      // This code assumes that chpl_taskID_t is an integral type
      extern proc chpl_task_getId(): chpl_taskID_t;
      var mytid = chpl_task_getId();
      var slot = (mytid:uint % (numTasks:uint)):int;
      var tid: chpl_taskID_t = temps[slot].tid$; // lock
      while ((tid != chpl_nullTaskID) && (tid != mytid)) {
        temps[slot].tid$ = tid;                  // unlock
        slot = (slot+1)%numTasks;
        tid = temps[slot].tid$;                  // lock
      }
      temps[slot].tid$ = mytid;                  // unlock
      return slot;
    }
    inline proc get_min_distance(tid=get_tid()) return temps[tid].min_distance;
    inline proc get_path_count(tid=get_tid()) return temps[tid].path_count$;
    inline proc get_depend(tid=get_tid()) return temps[tid].depend;
    inline proc get_children_list(tid=get_tid()) return temps[tid].children_list;
    inline proc get_Active_Level(tid=get_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();
    }
  }

}


Output *everything* to stdout in time-write.chpl.

This test historically printed newlines to stdout - this is what it is designed to measure - while printing informational output, such as the problem sizes and timings to stderr.

This has caused issues under perf.xc.no-local.gnu (through April 2015) and perf.xc.local.pgi (recently) where stdout and stderr merge randomly, causing verification to fail under nightly testing.

PR #1907 aka 04b5937 resolved it for perf.xc.no-local.gnu, apparently not for perf.xc.local.pgi. So this time I am just printing everything to stdout, see if this makes the issue go away.

The old behavior can be obtained using the 'useStderr' config.

/*
This is a test of Chapel's write() of a string vs. C's printf()
of the same string, which has no formatting in it.

The test exposes Chapel's overhead on top of the actual work
of displaying the string.

To make the timing meaningful, the test performs write()/printf()
multiple times. To reduce the output volume, we use a short string.
This has the (unintentional) effect of emphasizing the overhead.

Since we expect the output to be redirected, due to its high volume,
there may be various startup effects.
To mitigate them, we rotate the variants 'tries' times,
starting with the one we expect to be the fastest.
However, the initial measurements did not support this concern.

Test variations - in C:
* Use printf() or puts().
* For C, wrap printf() in a loop in C or in Chapel.
* Pass "\n" to printf() from Chapel as a Chapel 'string' or 'c_string'.
* For the previous one, make it a global constant or a local constant.
* We could also do the above variations for puts() - skip that for now,
  to reduce the amount of info to deal with, and perhaps puts() is
  less interesting.

Test variations - in Chapel:
* since stdout is blocking, we also try a variant using a workaround of
  creating a non-blocking version of it - see stdoutNB.

Michael's remarks on performance:

+ Chapel's write() or stdout.write()
actually call printf so that Chapel programs and C
programs can intermix their standard output. They
are also both line buffered which reduces performance.
  Chapel's stdout is using the C stdout FILE*,
and calling fwrite. That means that any data
sent to Chapel's stdout is buffered twice in
the application:
 - once in the QIO channel
 - once in the FILE* buffer
I would expect this to reduce performance.

+ We could revisit that design decision and make
write use file descriptor 1 if we no longer wanted
it to work this way. It would go faster but possibly
result in unexpected intermixings of stdout.

+ The performance lag of Chapel with openfd(1)
is worth investigating regardless of the above.

+ I also think that it's important to compare
locking=false with printf_unlocked.
[See "man unlocked_stdio" - basically it is the C version of printf
that does not lock the FILE* so it's only safe to use in a serial context.]
*/

use Time;

config const n = 3;
config const tries = 2;
config const fmt = "%7.3dr";
config const compareTimes = false;
config const useStderr = false;
const info = if useStderr then stderr else stdout;

// Each trial() function writes a newline 'n' times.

//////////////////////////////////////////////////////////////////

extern proc cf_trial(n: int);
extern proc cs_trial(n: int);

proc lstr_trial() {
  extern proc printf(format: c_string, arg...);
  for 1..n do
    printf("%s", "\n".c_str());
}

proc lcs_trial() {
  extern proc printf(format: c_string, arg...);
  const c_newline_local: c_string = "\n";
  for 1..n do
    printf("%s", c_newline_local);
}

const str_newline_global = "\n";
proc gstr_trial() {
  extern proc printf(format: c_string, arg...);
  for 1..n do
    printf("%s", str_newline_global.c_str());
}

const c_newline_global: c_string = "\n";
proc gcs_trial() {
  extern proc printf(format: c_string, arg...);
  for 1..n do
    printf("%s", c_newline_global);
}

// could do the same with puts() - would be too much, skip it for now

//////////////////////////////////////////////////////////////////

// write() a newline to stdout (non-blocking), 'n' times
const outfd = openfd(1);
const stdoutNB = outfd.writer(locking=false);
proc nb_trial() {
  for 1..n do
    stdoutNB.write("\n");
}

// write() a newline to stdout (blocking), 'n' times
proc sto_trial() {
  for 1..n do
    write("\n");
}

//////////////////////////////////////////////////////////////////

var tSave, tDummy, tcf, tcs, tlstr, tlcs, tgstr, tgcs, tnb, tsto: real;

inline proc addTime(ref t: real) {
  const tCurr = getCurrentTime();
  t += tCurr - tSave;
  tSave = tCurr;

}

const reportFormat = "%-24s " + fmt + "\n";
inline proc reportTime(title: string, time: real) {
  info.writef(reportFormat, title, time);
}

info.writef("n      %i\n", n);
info.writef("tries  %i\n", tries);

for t in 1..tries {
  info.writef("starting try %i\n", t);
  addTime(tDummy);

  cf_trial(n);   addTime(tcf);
  cs_trial(n);   addTime(tcs);
  lstr_trial();  addTime(tlstr);
  lcs_trial();   addTime(tlcs);
  gstr_trial();  addTime(tgstr);
  gcs_trial();   addTime(tgcs);

  nb_trial();     addTime(tnb);
  sto_trial();   addTime(tsto);
}

info.writef("done tries\n");
//info.writef("n      %i\n", n);
//info.writef("tries  %i\n", tries);

if compareTimes {
  reportTime("C printf", tcf);
  reportTime("C puts", tcs);
  reportTime("C/chpl string literal",  tlstr);
  reportTime("C/chpl c_string local",  tlcs);
  reportTime("C/chpl string global",   tgstr);
  reportTime("C/chpl c_string global", tgcs);
  reportTime("chpl non-blocking", tnb);
  reportTime("chpl stdout", tsto);
}

/*
This is a test of Chapel's write() of a string vs. C's printf()
of the same string, which has no formatting in it.

The test exposes Chapel's overhead on top of the actual work
of displaying the string.

To make the timing meaningful, the test performs write()/printf()
multiple times. To reduce the output volume, we use a short string.
This has the (unintentional) effect of emphasizing the overhead.

Since we expect the output to be redirected, due to its high volume,
there may be various startup effects.
To mitigate them, we rotate the variants 'tries' times,
starting with the one we expect to be the fastest.
However, the initial measurements did not support this concern.

Test variations - in C:
* Use printf() or puts().
* For C, wrap printf() in a loop in C or in Chapel.
* Pass "\n" to printf() from Chapel as a Chapel 'string' or 'c_string'.
* For the previous one, make it a global constant or a local constant.
* We could also do the above variations for puts() - skip that for now,
  to reduce the amount of info to deal with, and perhaps puts() is
  less interesting.

Test variations - in Chapel:
* since stdout is blocking, we also try a variant using a workaround of
  creating a non-blocking version of it - see stdoutNB.

Michael's remarks on performance:

+ Chapel's write() or stdout.write()
actually call printf so that Chapel programs and C
programs can intermix their standard output. They
are also both line buffered which reduces performance.
  Chapel's stdout is using the C stdout FILE*,
and calling fwrite. That means that any data
sent to Chapel's stdout is buffered twice in
the application:
 - once in the QIO channel
 - once in the FILE* buffer
I would expect this to reduce performance.

+ We could revisit that design decision and make
write use file descriptor 1 if we no longer wanted
it to work this way. It would go faster but possibly
result in unexpected intermixings of stdout.

+ The performance lag of Chapel with openfd(1)
is worth investigating regardless of the above.

+ I also think that it's important to compare
locking=false with printf_unlocked.
[See "man unlocked_stdio" - basically it is the C version of printf
that does not lock the FILE* so it's only safe to use in a serial context.]
*/

use Time;

config const n = 3;
config const tries = 2;
config const fmt = "%7.3dr";
config const compareTimes = false;

// Each trial() function writes a newline 'n' times.

//////////////////////////////////////////////////////////////////

extern proc cf_trial(n: int);
extern proc cs_trial(n: int);

proc lstr_trial() {
  extern proc printf(format: c_string, arg...);
  for 1..n do
    printf("%s", "\n".c_str());
}

proc lcs_trial() {
  extern proc printf(format: c_string, arg...);
  const c_newline_local: c_string = "\n";
  for 1..n do
    printf("%s", c_newline_local);
}

const str_newline_global = "\n";
proc gstr_trial() {
  extern proc printf(format: c_string, arg...);
  for 1..n do
    printf("%s", str_newline_global.c_str());
}

const c_newline_global: c_string = "\n";
proc gcs_trial() {
  extern proc printf(format: c_string, arg...);
  for 1..n do
    printf("%s", c_newline_global);
}

// could do the same with puts() - would be too much, skip it for now

//////////////////////////////////////////////////////////////////

// write() a newline to stdout (non-blocking), 'n' times
const outfd = openfd(1);
const stdoutNB = outfd.writer(locking=false);
proc nb_trial() {
  for 1..n do
    stdoutNB.write("\n");
}

// write() a newline to stdout (blocking), 'n' times
proc sto_trial() {
  for 1..n do
    write("\n");
}

//////////////////////////////////////////////////////////////////

var tSave, tDummy, tcf, tcs, tlstr, tlcs, tgstr, tgcs, tnb, tsto: real;

inline proc addTime(ref t: real) {
  const tCurr = getCurrentTime();
  t += tCurr - tSave;
  tSave = tCurr;

}

const reportFormat = "%-24s " + fmt + "\n";
inline proc reportTime(title: string, time: real) {
  stderr.writef(reportFormat, title, time);
}

stderr.writef("n      %i\n", n);
stderr.writef("tries  %i\n", tries);

for t in 1..tries {
  stderr.writef("starting try %i\n", t);
  addTime(tDummy);

  cf_trial(n);   addTime(tcf);
  cs_trial(n);   addTime(tcs);
  lstr_trial();  addTime(tlstr);
  lcs_trial();   addTime(tlcs);
  gstr_trial();  addTime(tgstr);
  gcs_trial();   addTime(tgcs);

  nb_trial();     addTime(tnb);
  sto_trial();   addTime(tsto);
}

stderr.writef("done tries\n");
//stderr.writef("n      %i\n", n);
//stderr.writef("tries  %i\n", tries);

if compareTimes {
  reportTime("C printf", tcf);
  reportTime("C puts", tcs);
  reportTime("C/chpl string literal",  tlstr);
  reportTime("C/chpl c_string local",  tlcs);
  reportTime("C/chpl string global",   tgstr);
  reportTime("C/chpl c_string global", tgcs);
  reportTime("chpl non-blocking", tnb);
  reportTime("chpl stdout", tsto);
}


Simplified arithmetic sequence implementation in an obvious way.

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

//
// Arrays and domains
//

// this is the class that all array classes are derived from
class _abase {
  def reallocate(d: _domain) {
    halt("reallocation not implemented for this array");
  }
}

// this is a wrapper class for all arrays
pragma "array"
class _array {
  type _array_type;
  type elt_type;
  param rank : int;
  var _value : _array_type;
  var dom : _domain;

  def this(d : _domain)
    return _value.slice(d._value);

  def =this(d : _domain, val: elt_type) {
    for i in d do
      this(i) = val;
  }

  def this(i...?k)
    return _value((...i));

  def =this(i...?k, val: elt_type) {
    _value((...i)) = val;
  }

  def getHeadCursor()
    return _value.getHeadCursor();

  def getNextCursor(c)
    return _value.getNextCursor(c);

  def getValue(c)
    return _value.getValue(c);

  def isValidCursor?(c)
    return _value.isValidCursor?(c);

  iterator this() : elt_type {
    forall x in _value
      yield x;
  }

  def view(d: _domain)
    return _value.view(d._value);
}

def =(a: _array, b: _array) {
  a._value.assign(b._value);
  return a;
}

def =(a: _array, b: _domain) {
  a._value.assign(b._value);
  return a;
}

def =(a: _array, b: seq) {
  a._value.assign(b);
  return a;
}

def =(a: _array, b: _aseq) {
  a._value.assign(b);
  return a;
}

def =(a: _array, b: a.elt_type) {
  a._value.assign(b);
  return a;
}

def _copy(a: _array) {
  var b : [a.dom] a.elt_type;
  b = a;
  return b;
}

def _init(a: _array) {
  var b : [a.dom] a.elt_type;
  return b;
}

def fwrite(f : file, a: _array) {
  fwrite(f, a._value);
}

pragma "domain"
class _domain {
  type _domain_type;
  type _index_type;
  param rank : int;
  var _value : _domain_type;
  var _arrs: seq(_abase);

  def getHeadCursor()
    return _value.getHeadCursor();

  def getNextCursor(c)
    return _value.getNextCursor(c);

  def getValue(c)
    return _value.getValue(c);

  def isValidCursor?(c)
    return _value.isValidCursor?(c);

  iterator this() : _index_type {
    forall x in _value
      yield x;
  }

  def this(dim : int)
    return _value(dim);

  def _build_array(type elt_type) {
    var x = _value._build_array(elt_type);
    _arrs #= x;
    return _array(x.type, elt_type, rank, x, this);
  }

  def _build_sparse_domain() {
    var x = _value._build_sparse_domain();
    return _domain(x.type, _index_type, rank, x);
  }

  def add(i) {
    _value.add(i);
  }

  def remove(i) {
    _value.remove(i);
  }

  def member?(i) {
    return _value.member?(i);
  }

  def expand(i...?k) {
    var x = _value.expand((...i));
    return _domain(x.type, _index_type, rank, x);
  }

  def exterior(i...?k) {
    var x = _value.exterior((...i));
    return _domain(x.type, _index_type, rank, x);
  }

  def interior(i...?k) {
    var x = _value.interior((...i));
    return _domain(x.type, _index_type, rank, x);
  }

  def translate(i...?k) {
    var x = _value.translate((...i));
    return _domain(x.type, _index_type, rank, x);
  }
}

def =(a: _domain, b: _domain) {
  for e in a._arrs do
    e.reallocate(b);
  a._value = b._value;
  return a;
}

def fwrite(f : file, a: _domain) {
  fwrite(f, a._value);
}

def by(a: _domain, b) {
  var x = a._value by b;
  return _domain(x.type, a._index_type, a.rank, x);
}

////////////////////////////////////////////////////

def _build_domain(x)
  return x;

def _build_domain(ranges : _aseq(int) ...?rank) {
  var x = _adomain(rank, ranges);
  return _domain(x.type, x.getValue(x.getHeadCursor()).type, rank, x);
}

def _build_domain_type(param rank : int) {
  var x = _adomain(rank);
  return _domain(x.type, x.getValue(x.getHeadCursor()).type, rank, x);
}

def _build_domain_type(type ind_type) {
  var x = _idomain(ind_type);
  return _domain(x.type, ind_type, 1, x);
}

def _build_sparse_domain_type(dom)
  return dom._build_sparse_domain();

def _build_array_type(dom, type elt_type)
  return dom._build_array(elt_type);

def _build_index_type(param i: int) where i > 1 {
  var x : i*int;
  return x;
}

def _build_index_type(param i: int) where i == 1 {
  var x : int;
  return x;
}

def _build_index_type(dom) {
  var x: dom._index_type;
  return x;
}

///////////////

def _aseq._translate(i : int) {
  return _low+i.._high+i by _stride;
}

def _aseq._interior(i : int) {
  var x = _low.._high by _stride;
  if (i < 0) {
    x = _low.._low-1-i by _stride;
  } else if (i > 0) {
    x = _high+1-i.._high by _stride;
  }
  return x;
}

def _aseq._exterior(i : int) {
  var x = _low.._high by _stride;
  if (i < 0) {
    x = _low+i.._low-1 by _stride;
  } else if (i > 0) {
    x = _high+1.._high+i by _stride;
  }
  return x;
}

def _aseq._expand(i : int) {
  return _low-i.._high+i by _stride;
}

class _adomain {
  param rank : int;
  var ranges : rank*_aseq(int);

  def getHeadCursor() {
    var c : rank*int;
    for param i in 1..rank do
      c(i) = ranges(i).getHeadCursor();
    return c;
  }

  def getNextCursor(c) {
    for param i in 1..rank {
      c(rank-i+1) = ranges(rank-i+1).getNextCursor(c(rank-i+1));
      if ranges(rank-i+1).isValidCursor?(c(rank-i+1)) then
        return c;
      else
        c(rank-i+1) = ranges(rank-i+1).getHeadCursor();
    }
    c(1) = ranges(1)._high+1;
    return c;
  }

  def getValue(c) {
    if rank == 1 then
      return c(1);
    else
      return c;
  }

  def isValidCursor?(c) {
    return c(1) != ranges(1)._high+1;
  }

  def this(dim : int)
    return ranges(dim);

  def _build_array(type elt_type)
    return _aarray(elt_type, rank, dom=this);

  def _build_sparse_domain()
    return _sdomain(rank, adomain=this);

  def translate(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do
      x.ranges(i) = this(i)._translate(dim(i));
    return x;
  }

  def translate(dim : int ...?numDims) {
    return translate(dim);
  }

  def interior(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do {
      if ((dim(i) > 0) && (this(i)._high+1-dim(i) < this(i)._low) ||
          (dim(i) < 0) && (this(i)._low-1-dim(i) > this(i)._high)) {
        halt("***Error: Argument to 'interior' function out of range in dimension ", i, "***");
      }
      x.ranges(i) = this(i)._interior(dim(i));
    }
    return x;
  }

  def interior(dim : int ...?numDims) {
    return interior(dim);
  }

  def exterior(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do
      x.ranges(i) = this(i)._exterior(dim(i));
    return x;
  }

  def exterior(dim : int ...?numDims) {
    return exterior(dim);
  }

  def expand(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do {
      x.ranges(i) = ranges(i)._expand(dim(i));
      if (x.ranges(i)._low > x.ranges(i)._high) {
        halt("***Error: Degenerate dimension created in dimension ", i, "***");
      }
    }
    return x;
  }

  def expand(dim : int ...?numDims) {
    var x = _adomain(rank);
    if (rank == numDims) {
      -- NOTE: would probably like to get rid of this assignment
      -- since domain assignment is/will eventually be nontrivial
      -- in cost;  yet returning expand(dim) currently causes
      -- problems as captured in trivial/shannon/condReturn3.chpl
      x = expand(dim);
    } else if (numDims == 1) {
      for i in 1..rank do
        x.ranges(i) = ranges(i)._expand(dim(1));
    } else {
      halt("***Error: Rank mismatch between domain and expand() arguments (", rank, " != ", numDims, ")***");
    }
    return x;
  }
}

def by(dom : _adomain, dim : dom.rank*int) {
  var x = _adomain(dom.rank);
  for i in 1..dom.rank do
    x.ranges(i) = dom.ranges(i) by dim(i);
  return x;
}

def by(dom : _adomain, dim : int) {
  var x = _adomain(dom.rank);
  for i in 1..dom.rank do
    x.ranges(i) = dom.ranges(i) by dim;
  return x;
}

class _aarray: _abase {
  type elt_type;
  param rank : int;

  var dom : _adomain(rank);
  var info : rank*4*int;
  var size : int;
  var data : _ddata(elt_type);
  var noinit: bool = false;

  def getHeadCursor()
    return dom.getHeadCursor();

  def getNextCursor(c)
    return dom.getNextCursor(c);

  def getValue(c)
    return this(dom.getValue(c));

  def isValidCursor?(c)
    return dom.isValidCursor?(c);

  def off(dim : int) var
    return info(dim)(1);

  def blk(dim : int) var
    return info(dim)(2);

  def str(dim : int) var
    return info(dim)(3);

  def orig(dim : int) var
    return info(dim)(4);

  def initialize() {
    if noinit == true then return;
    for param dim in 1..rank {
      off(dim) = dom(dim)._low;
      str(dim) = dom(dim)._stride;
      orig(dim) = 0;
    }
    blk(rank) = 1;
    for dim in 1..rank-1 by -1 do
      blk(dim) = blk(dim+1) * dom(dim+1).length;
    size = blk(1) * dom(1).length;
    data = _ddata(elt_type, size);
    data.init();
  }

  def this(d : _adomain) {
    var a : [d] elt_type;
    for i in d do
      a(i) = this(i);
    return a;
  }

  def =this(d : _adomain, v) {
    for i in d do
      this(i) = v;
  }

  def this(ind : rank*int) var {
    if boundsChecking
      for param i in 1..rank do
        if !_in(dom(i), ind(i)) then
          halt("array index out of bounds: ", ind);
    var sum : int;
    for param i in 1..rank do
      sum = sum + (ind(i) - off(i)) * blk(i) / str(i) - orig(i);
//    write(" [", ind, " = ", sum, "] ");
    return data(sum);
  }

  def this(ind : int ...rank) var
    return this(ind);

  def this(ind: _aseq(int) ...rank) var {
    var d = [(...ind)];
    return slice(d._value);
  }

  def view(d: _adomain) {
    if rank != d.rank then
      halt("array rank change not supported");
    for param i in 1..rank do
      if d(i).length != dom(i).length then
        halt("extent in dimension ", i, " does not match actual");
    var alias = _aarray(elt_type, rank, d, noinit=true);
    alias.data = data;
    alias.size = size;
    for param i in 1..rank {
      alias.off(i) = d(i)._low;
      alias.blk(i) = blk(i) * (dom(i)._stride / str(i));
      alias.str(i) = d(i)._stride;
      alias.orig(i) = orig(i) + (off(i) - dom(i)._low) * blk(i);
    }
    return _array(alias.type, elt_type, rank, alias, _domain(d.type, d.getValue(d.getHeadCursor()).type, rank, d));
  }

  def slice(d: _adomain) {
    if rank != d.rank then
      halt("array rank change not supported");
    for param i in 1..rank {
      if !_in(dom(i), d(i)) then
        halt("array slice out of bounds in dimension ", i, ": ", d);
      if d(i)._stride % dom(i)._stride != 0 then
        halt("stride of array slice is not multiple of stride in dimension ", i);
    }
    var alias = _aarray(elt_type, rank, d, noinit=true);
    alias.data = data;
    alias.size = size;
    for param i in 1..rank {
      alias.off(i) = off(i);
      alias.blk(i) = blk(i);
      alias.str(i) = str(i);
      alias.orig(i) = orig(i);
    }
    return _array(alias.type, elt_type, rank, alias, _domain(d.type, d.getValue(d.getHeadCursor()).type, rank, d));
  }

  def reallocate(d: _domain) {
    if (d.rank == rank) {
      var new = _aarray(elt_type, rank, d._value);
      for i in _intersect(d._value, dom) do
        new(i) = this(i);
      dom = new.dom;
      info = new.info;
      size = new.size;
      data = new.data;
    }
  }

  def assign(y : _aarray) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y : _adomain) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y : seq) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y: _aseq) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y: elt_type) {
    for i in dom do
      this(i) = y;
  }
}

def fwrite(f : file, x : _adomain) {
  fwrite(f, "[", x(1));
  for i in 2..x.rank do
    fwrite(f, ", ", x(i));
  fwrite(f, "]");
}

def fwrite(f : file, x : _aarray) {
  var i : x.rank*int;
  for dim in 1..x.rank do
    i(dim) = x.dom(dim)._low;
  label next while true {
    fwrite(f, x(i));
    if i(x.rank) <= (x.dom(x.rank)._high - x.dom(x.rank)._stride) {
      fwrite(f, " ");
      i(x.rank) += x.dom(x.rank)._stride;
    } else {
      for dim in 1..x.rank-1 by -1 {
        if i(dim) <= (x.dom(dim)._high - x.dom(dim)._stride) {
          i(dim) += x.dom(dim)._stride;
          for dim2 in dim+1..x.rank {
            fwrite(f, "\n");
            i(dim2) = x.dom(dim2)._low;
          }
          continue next;
        }
      }
      break;
    }
  }
}

def _intersect(a: _aseq, b: _aseq) {
  var g, x: int;
  (g, x) = _extended_euclid(a._stride, b._stride);
  if abs(a._low - b._low) % g != 0 then
    return 1..0;
  var low = max(a._low, b._low);
  var high = min(a._high, b._high);
  var stride = a._stride * b._stride / g;
  var alignment = a._low + (b._low - a._low) * x * a._stride / g;
  if alignment == 0 then
    alignment = stride;
  low = low + low % alignment;
  return low..high by stride;
}

def _intersect(a: _adomain, b: _adomain) {
  var c = _adomain(a.rank);
  for param i in 1..a.rank do
    c.ranges(i) = _intersect(a(i), b(i));
  return c;
}

// for when we start supporting strides
// Extended-Euclid (Knuth Volume 2 --- Section 4.5.2)
// given two non-negative integers u and v
// returns (gcd(u, v), x) where x is set such that u*x + v*y = gcd(u, v)
def _extended_euclid(u: int, v: int) {
  var u1 = 1;
  var u2 = 0;
  var u3 = u;
  var v1 = 0;
  var v2 = 1;
  var v3 = v;
  while v3 != 0 {
    var q = u3 / v3;
    var t1 = u1 - v1 * q;
    var t2 = u2 - v2 * q;
    var t3 = u3 - v3 * q;
    u1 = v1;
    u2 = v2;
    u3 = v3;
    v1 = t1;
    v2 = t2;
    v3 = t3;
  }
  return (u3, u1);
}

-- Arithmetic sequence

def _build_aseq(low: int, high: int) return _aseq(int, low, high);
def _build_aseq(low: uint, high: uint) return _aseq(uint, low, high);
def _build_aseq(low: int(64), high: int(64)) return _aseq(int(64), low, high);
def _build_aseq(low: uint(64), high: uint(64)) return _aseq(uint(64), low, high);

def _build_aseq(low, high) {
  compilerError("arithmetic sequence bounds are not of integral type");
}

record _aseq {
  type elt_type;
  var _low : elt_type;
  var _high : elt_type;
  var _stride : int = 1;

  iterator this() : elt_type {
    forall x in this
      yield x;
  }

  def getHeadCursor()
    if _stride > 0 then
      return _low;
    else
      return _high;

  def getNextCursor(c)
    return c + _stride:elt_type;

  def getValue(c)
    return c;

  def isValidCursor?(c)
    return _low <= c && c <= _high;

  def length
    return
      (if _stride > 0
        then (_high - _low + _stride:elt_type) / _stride:elt_type
        else (_low - _high + _stride:elt_type) / _stride:elt_type);
}

def by(s : _aseq, i : int)
  return _aseq(s.elt_type, s._low, s._high, s._stride * i);

def _in(s : _aseq, i : s.elt_type)
  return i >= s._low && i <= s._high && (i - s._low) % s._stride == 0;

// really slow --- REWRITE
def _in(s1: _aseq, s2: _aseq) {
  for i in s2 do
    if !_in(s1, i) then
      return false;
  return true;
}

def fwrite(f : file, s : _aseq) {
  fwrite(f, s._low, "..", s._high);
  if (s._stride > 1) then
    fwrite(f, " by ", s._stride);
}

pragma "inline" def string.substring(s: _aseq)
  if s._stride != 1 then
    return __primitive("string_strided_select", this, s._low, s._high, s._stride);
  else
    return __primitive("string_select", this, s._low, s._high);

//
// Arrays and domains
//

// this is the class that all array classes are derived from
class _abase {
  def reallocate(d: _domain) {
    halt("reallocation not implemented for this array");
  }
}

// this is a wrapper class for all arrays
pragma "array"
class _array {
  type _array_type;
  type elt_type;
  param rank : int;
  var _value : _array_type;
  var dom : _domain;

  def this(d : _domain)
    return _value.slice(d._value);

  def =this(d : _domain, val: elt_type) {
    for i in d do
      this(i) = val;
  }

  def this(i...?k)
    return _value((...i));

  def =this(i...?k, val: elt_type) {
    _value((...i)) = val;
  }

  def getHeadCursor()
    return _value.getHeadCursor();

  def getNextCursor(c)
    return _value.getNextCursor(c);

  def getValue(c)
    return _value.getValue(c);

  def isValidCursor?(c)
    return _value.isValidCursor?(c);

  iterator this() : elt_type {
    forall x in _value
      yield x;
  }

  def view(d: _domain)
    return _value.view(d._value);
}

def =(a: _array, b: _array) {
  a._value.assign(b._value);
  return a;
}

def =(a: _array, b: _domain) {
  a._value.assign(b._value);
  return a;
}

def =(a: _array, b: seq) {
  a._value.assign(b);
  return a;
}

def =(a: _array, b: _aseq) {
  a._value.assign(b);
  return a;
}

def =(a: _array, b: a.elt_type) {
  a._value.assign(b);
  return a;
}

def _copy(a: _array) {
  var b : [a.dom] a.elt_type;
  b = a;
  return b;
}

def _init(a: _array) {
  var b : [a.dom] a.elt_type;
  return b;
}

def fwrite(f : file, a: _array) {
  fwrite(f, a._value);
}

pragma "domain"
class _domain {
  type _domain_type;
  type _index_type;
  param rank : int;
  var _value : _domain_type;
  var _arrs: seq(_abase);

  def getHeadCursor()
    return _value.getHeadCursor();

  def getNextCursor(c)
    return _value.getNextCursor(c);

  def getValue(c)
    return _value.getValue(c);

  def isValidCursor?(c)
    return _value.isValidCursor?(c);

  iterator this() : _index_type {
    forall x in _value
      yield x;
  }

  def this(dim : int)
    return _value(dim);

  def _build_array(type elt_type) {
    var x = _value._build_array(elt_type);
    _arrs #= x;
    return _array(x.type, elt_type, rank, x, this);
  }

  def _build_sparse_domain() {
    var x = _value._build_sparse_domain();
    return _domain(x.type, _index_type, rank, x);
  }

  def add(i) {
    _value.add(i);
  }

  def remove(i) {
    _value.remove(i);
  }

  def member?(i) {
    return _value.member?(i);
  }

  def expand(i...?k) {
    var x = _value.expand((...i));
    return _domain(x.type, _index_type, rank, x);
  }

  def exterior(i...?k) {
    var x = _value.exterior((...i));
    return _domain(x.type, _index_type, rank, x);
  }

  def interior(i...?k) {
    var x = _value.interior((...i));
    return _domain(x.type, _index_type, rank, x);
  }

  def translate(i...?k) {
    var x = _value.translate((...i));
    return _domain(x.type, _index_type, rank, x);
  }
}

def =(a: _domain, b: _domain) {
  for e in a._arrs do
    e.reallocate(b);
  a._value = b._value;
  return a;
}

def fwrite(f : file, a: _domain) {
  fwrite(f, a._value);
}

def by(a: _domain, b) {
  var x = a._value by b;
  return _domain(x.type, a._index_type, a.rank, x);
}

////////////////////////////////////////////////////

def _build_domain(x)
  return x;

def _build_domain(ranges : _aseq(int) ...?rank) {
  var x = _adomain(rank, ranges);
  return _domain(x.type, x.getValue(x.getHeadCursor()).type, rank, x);
}

def _build_domain_type(param rank : int) {
  var x = _adomain(rank);
  return _domain(x.type, x.getValue(x.getHeadCursor()).type, rank, x);
}

def _build_domain_type(type ind_type) {
  var x = _idomain(ind_type);
  return _domain(x.type, ind_type, 1, x);
}

def _build_sparse_domain_type(dom)
  return dom._build_sparse_domain();

def _build_array_type(dom, type elt_type)
  return dom._build_array(elt_type);

def _build_index_type(param i: int) where i > 1 {
  var x : i*int;
  return x;
}

def _build_index_type(param i: int) where i == 1 {
  var x : int;
  return x;
}

def _build_index_type(dom) {
  var x: dom._index_type;
  return x;
}

///////////////

def _aseq._translate(i : int) {
  return _low+i.._high+i by _stride;
}

def _aseq._interior(i : int) {
  var x = _low.._high by _stride;
  if (i < 0) {
    x = _low.._low-1-i by _stride;
  } else if (i > 0) {
    x = _high+1-i.._high by _stride;
  }
  return x;
}

def _aseq._exterior(i : int) {
  var x = _low.._high by _stride;
  if (i < 0) {
    x = _low+i.._low-1 by _stride;
  } else if (i > 0) {
    x = _high+1.._high+i by _stride;
  }
  return x;
}

def _aseq._expand(i : int) {
  return _low-i.._high+i by _stride;
}

class _adomain {
  param rank : int;
  var ranges : rank*_aseq(int);

  def getHeadCursor() {
    var c : rank*int;
    for param i in 1..rank do
      c(i) = ranges(i).getHeadCursor();
    return c;
  }

  def getNextCursor(c) {
    for param i in 1..rank {
      c(rank-i+1) = ranges(rank-i+1).getNextCursor(c(rank-i+1));
      if ranges(rank-i+1).isValidCursor?(c(rank-i+1)) then
        return c;
      else
        c(rank-i+1) = ranges(rank-i+1).getHeadCursor();
    }
    c(1) = ranges(1)._high+1;
    return c;
  }

  def getValue(c) {
    if rank == 1 then
      return c(1);
    else
      return c;
  }

  def isValidCursor?(c) {
    return c(1) != ranges(1)._high+1;
  }

  def this(dim : int)
    return ranges(dim);

  def _build_array(type elt_type)
    return _aarray(elt_type, rank, dom=this);

  def _build_sparse_domain()
    return _sdomain(rank, adomain=this);

  def translate(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do
      x.ranges(i) = this(i)._translate(dim(i));
    return x;
  }

  def translate(dim : int ...?numDims) {
    return translate(dim);
  }

  def interior(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do {
      if ((dim(i) > 0) && (this(i)._high+1-dim(i) < this(i)._low) ||
          (dim(i) < 0) && (this(i)._low-1-dim(i) > this(i)._high)) {
        halt("***Error: Argument to 'interior' function out of range in dimension ", i, "***");
      }
      x.ranges(i) = this(i)._interior(dim(i));
    }
    return x;
  }

  def interior(dim : int ...?numDims) {
    return interior(dim);
  }

  def exterior(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do
      x.ranges(i) = this(i)._exterior(dim(i));
    return x;
  }

  def exterior(dim : int ...?numDims) {
    return exterior(dim);
  }

  def expand(dim : rank*int) {
    var x = _adomain(rank);
    for i in 1..rank do {
      x.ranges(i) = ranges(i)._expand(dim(i));
      if (x.ranges(i)._low > x.ranges(i)._high) {
        halt("***Error: Degenerate dimension created in dimension ", i, "***");
      }
    }
    return x;
  }

  def expand(dim : int ...?numDims) {
    var x = _adomain(rank);
    if (rank == numDims) {
      -- NOTE: would probably like to get rid of this assignment
      -- since domain assignment is/will eventually be nontrivial
      -- in cost;  yet returning expand(dim) currently causes
      -- problems as captured in trivial/shannon/condReturn3.chpl
      x = expand(dim);
    } else if (numDims == 1) {
      for i in 1..rank do
        x.ranges(i) = ranges(i)._expand(dim(1));
    } else {
      halt("***Error: Rank mismatch between domain and expand() arguments (", rank, " != ", numDims, ")***");
    }
    return x;
  }
}

def by(dom : _adomain, dim : dom.rank*int) {
  var x = _adomain(dom.rank);
  for i in 1..dom.rank do
    x.ranges(i) = dom.ranges(i) by dim(i);
  return x;
}

def by(dom : _adomain, dim : int) {
  var x = _adomain(dom.rank);
  for i in 1..dom.rank do
    x.ranges(i) = dom.ranges(i) by dim;
  return x;
}

class _aarray: _abase {
  type elt_type;
  param rank : int;

  var dom : _adomain(rank);
  var info : rank*4*int;
  var size : int;
  var data : _ddata(elt_type);
  var noinit: bool = false;

  def getHeadCursor()
    return dom.getHeadCursor();

  def getNextCursor(c)
    return dom.getNextCursor(c);

  def getValue(c)
    return this(dom.getValue(c));

  def isValidCursor?(c)
    return dom.isValidCursor?(c);

  def off(dim : int) var
    return info(dim)(1);

  def blk(dim : int) var
    return info(dim)(2);

  def str(dim : int) var
    return info(dim)(3);

  def orig(dim : int) var
    return info(dim)(4);

  def initialize() {
    if noinit == true then return;
    for param dim in 1..rank {
      off(dim) = dom(dim)._low;
      str(dim) = dom(dim)._stride;
      orig(dim) = 0;
    }
    blk(rank) = 1;
    for dim in 1..rank-1 by -1 do
      blk(dim) = blk(dim+1) * dom(dim+1).length;
    size = blk(1) * dom(1).length;
    data = _ddata(elt_type, size);
    data.init();
  }

  def this(d : _adomain) {
    var a : [d] elt_type;
    for i in d do
      a(i) = this(i);
    return a;
  }

  def =this(d : _adomain, v) {
    for i in d do
      this(i) = v;
  }

  def this(ind : rank*int) var {
    if boundsChecking
      for param i in 1..rank do
        if !_in(dom(i), ind(i)) then
          halt("array index out of bounds: ", ind);
    var sum : int;
    for param i in 1..rank do
      sum = sum + (ind(i) - off(i)) * blk(i) / str(i) - orig(i);
//    write(" [", ind, " = ", sum, "] ");
    return data(sum);
  }

  def this(ind : int ...rank) var
    return this(ind);

  def this(ind: _aseq(int) ...rank) var {
    var d = [(...ind)];
    return slice(d._value);
  }

  def view(d: _adomain) {
    if rank != d.rank then
      halt("array rank change not supported");
    for param i in 1..rank do
      if d(i).length != dom(i).length then
        halt("extent in dimension ", i, " does not match actual");
    var alias = _aarray(elt_type, rank, d, noinit=true);
    alias.data = data;
    alias.size = size;
    for param i in 1..rank {
      alias.off(i) = d(i)._low;
      alias.blk(i) = blk(i) * (dom(i)._stride / str(i));
      alias.str(i) = d(i)._stride;
      alias.orig(i) = orig(i) + (off(i) - dom(i)._low) * blk(i);
    }
    return _array(alias.type, elt_type, rank, alias, _domain(d.type, d.getValue(d.getHeadCursor()).type, rank, d));
  }

  def slice(d: _adomain) {
    if rank != d.rank then
      halt("array rank change not supported");
    for param i in 1..rank {
      if !_in(dom(i), d(i)) then
        halt("array slice out of bounds in dimension ", i, ": ", d);
      if d(i)._stride % dom(i)._stride != 0 then
        halt("stride of array slice is not multiple of stride in dimension ", i);
    }
    var alias = _aarray(elt_type, rank, d, noinit=true);
    alias.data = data;
    alias.size = size;
    for param i in 1..rank {
      alias.off(i) = off(i);
      alias.blk(i) = blk(i);
      alias.str(i) = str(i);
      alias.orig(i) = orig(i);
    }
    return _array(alias.type, elt_type, rank, alias, _domain(d.type, d.getValue(d.getHeadCursor()).type, rank, d));
  }

  def reallocate(d: _domain) {
    if (d.rank == rank) {
      var new = _aarray(elt_type, rank, d._value);
      for i in _intersect(d._value, dom) do
        new(i) = this(i);
      dom = new.dom;
      info = new.info;
      size = new.size;
      data = new.data;
    }
  }

  def assign(y : _aarray) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y : _adomain) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y : seq) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y: _aseq) {
    for i,e in dom,y do
      this(i) = e;
  }

  def assign(y: elt_type) {
    for i in dom do
      this(i) = y;
  }
}

def fwrite(f : file, x : _adomain) {
  fwrite(f, "[", x(1));
  for i in 2..x.rank do
    fwrite(f, ", ", x(i));
  fwrite(f, "]");
}

def fwrite(f : file, x : _aarray) {
  var i : x.rank*int;
  for dim in 1..x.rank do
    i(dim) = x.dom(dim)._low;
  label next while true {
    fwrite(f, x(i));
    if i(x.rank) <= (x.dom(x.rank)._high - x.dom(x.rank)._stride) {
      fwrite(f, " ");
      i(x.rank) += x.dom(x.rank)._stride;
    } else {
      for dim in 1..x.rank-1 by -1 {
        if i(dim) <= (x.dom(dim)._high - x.dom(dim)._stride) {
          i(dim) += x.dom(dim)._stride;
          for dim2 in dim+1..x.rank {
            fwrite(f, "\n");
            i(dim2) = x.dom(dim2)._low;
          }
          continue next;
        }
      }
      break;
    }
  }
}

def _intersect(a: _aseq, b: _aseq) {
  var g, x: int;
  (g, x) = _extended_euclid(a._stride, b._stride);
  if abs(a._low - b._low) % g != 0 then
    return 1..0;
  var low = max(a._low, b._low);
  var high = min(a._high, b._high);
  var stride = a._stride * b._stride / g;
  var alignment = a._low + (b._low - a._low) * x * a._stride / g;
  if alignment == 0 then
    alignment = stride;
  low = low + low % alignment;
  return low..high by stride;
}

def _intersect(a: _adomain, b: _adomain) {
  var c = _adomain(a.rank);
  for param i in 1..a.rank do
    c.ranges(i) = _intersect(a(i), b(i));
  return c;
}

// for when we start supporting strides
// Extended-Euclid (Knuth Volume 2 --- Section 4.5.2)
// given two non-negative integers u and v
// returns (gcd(u, v), x) where x is set such that u*x + v*y = gcd(u, v)
def _extended_euclid(u: int, v: int) {
  var u1 = 1;
  var u2 = 0;
  var u3 = u;
  var v1 = 0;
  var v2 = 1;
  var v3 = v;
  while v3 != 0 {
    var q = u3 / v3;
    var t1 = u1 - v1 * q;
    var t2 = u2 - v2 * q;
    var t3 = u3 - v3 * q;
    u1 = v1;
    u2 = v2;
    u3 = v3;
    v1 = t1;
    v2 = t2;
    v3 = t3;
  }
  return (u3, u1);
}

-- Arithmetic sequence

def _build_aseq(low: int, high: int) return _aseq(int, low, high);
def _build_aseq(low: uint, high: uint) return _aseq(uint, low, high);
def _build_aseq(low: int(64), high: int(64)) return _aseq(int(64), low, high);
def _build_aseq(low: uint(64), high: uint(64)) return _aseq(uint(64), low, high);

def _build_aseq(low, high) {
  compilerError("arithmetic sequence bounds are not of integral type");
}

record _aseq {
  type elt_type;
  var _low : elt_type;
  var _high : elt_type;
  var _stride : int = 1;

  iterator this() : elt_type {
    forall x in this
      yield x;
  }

  def getHeadCursor()
    if _stride > 0 then
      return _low;
    else
      return _high;

  def getNextCursor(c)
    if _stride > 0 then
      return c + _stride:elt_type;
    else
      return c - (-_stride):elt_type;

  def getValue(c)
    return c;

  def isValidCursor?(c)
    return _low <= c && c <= _high;

  def length
    return
      (if _stride > 0
        then (_high - _low + _stride:elt_type) / _stride:elt_type
        else -(_low - _high - (-_stride):elt_type) / (-_stride):elt_type);
}

def by(s : _aseq, i : int)
  return _aseq(s.elt_type, s._low, s._high, s._stride * i);

def _in(s : _aseq, i : s.elt_type)
  return i >= s._low && i <= s._high && (i - s._low) % s._stride == 0;

// really slow --- REWRITE
def _in(s1: _aseq, s2: _aseq) {
  for i in s2 do
    if !_in(s1, i) then
      return false;
  return true;
}

def fwrite(f : file, s : _aseq) {
  fwrite(f, s._low, "..", s._high);
  if (s._stride > 1) then
    fwrite(f, " by ", s._stride);
}

pragma "inline" def string.substring(s: _aseq)
  if s._stride != 1 then
    return __primitive("string_strided_select", this, s._low, s._high, s._stride);
  else
    return __primitive("string_select", this, s._low, s._high);