Fix reduction clean up.

Fix reduction clean up.

Now that syncs can be free'd, eductions need to delete the syncs they hold.
This resolves the memory discrepancy I was seeing with
test/memory/sungeun/refCount/domainMaps.chpl.

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

// ChapelReduce.chpl
//
module ChapelReduce {

  iter chpl__scanIteratorZip(op, data) {
    for e in zip((...data)) {
      op.accumulate(e);
      yield op.generate();
    }
    delete op;
  }

  iter chpl__scanIterator(op, data) {
    for e in data {
      op.accumulate(e);
      yield op.generate();
    }
    delete op;
  }

  proc chpl__reduceCombine(globalOp, localOp) {
    on globalOp {
      globalOp.lock();
      globalOp.combine(localOp);
      globalOp.unlock();
    }
  }

  inline proc chpl__cleanupLocalOp(globalOp, localOp) {
    // should this be part of chpl__reduceCombine ?
    delete localOp;
  }

  proc chpl__sumType(type eltType) type {
    var x: eltType;
    return (x + x).type;
  }

  pragma "ReduceScanOp"
  class ReduceScanOp {
    var lock$: sync bool;
    proc lock() {
      lock$.writeEF(true);
    }
    proc unlock() {
      lock$.readFE();
    }

    proc ~ReduceScanOp() {
      delete lock$;
    }
  }

  class SumReduceScanOp: ReduceScanOp {
    type eltType;
    var value: chpl__sumType(eltType);

    // Rely on the default value of the desired type.
    // Todo: is this efficnent when that is an array?
    proc identity {
      var x: chpl__sumType(eltType); return x;
    }
    proc accumulate(x) {
      value = value + x;
    }
    proc combine(x) {
      value = value + x.value;
    }
    proc generate() return value;
    proc clone() return new SumReduceScanOp(eltType=eltType);
  }

  class ProductReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _prod_id(eltType);
    proc accumulate(x) {
      value = value * x;
    }
    proc combine(x) {
      value = value * x.value;
    }
    proc generate() return value;
    proc clone() return new ProductReduceScanOp(eltType=eltType);
  }

  class MaxReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return min(eltType);
    proc accumulate(x) {
      value = max(x, value);
    }
    proc combine(x) {
      value = max(value, x.value);
    }
    proc generate() return value;
    proc clone() return new MaxReduceScanOp(eltType=eltType);
  }

  class MinReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return max(eltType);
    proc accumulate(x) {
      value = min(x, value);
    }
    proc combine(x) {
      value = min(value, x.value);
    }
    proc generate() return value;
    proc clone() return new MinReduceScanOp(eltType=eltType);
  }

  class LogicalAndReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _land_id(eltType);
    proc accumulate(x) {
      value = value && x;
    }
    proc combine(x) {
      value = value && x.value;
    }
    proc generate() return value;
    proc clone() return new LogicalAndReduceScanOp(eltType=eltType);
  }

  class LogicalOrReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _lor_id(eltType);
    proc accumulate(x) {
      value = value || x;
    }
    proc combine(x) {
      value = value || x.value;
    }
    proc generate() return value;
    proc clone() return new LogicalOrReduceScanOp(eltType=eltType);
  }

  class BitwiseAndReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _band_id(eltType);
    proc accumulate(x) {
      value = value & x;
    }
    proc combine(x) {
      value = value & x.value;
    }
    proc generate() return value;
    proc clone() return new BitwiseAndReduceScanOp(eltType=eltType);
  }

  class BitwiseOrReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _bor_id(eltType);
    proc accumulate(x) {
      value = value | x;
    }
    proc combine(x) {
      value = value | x.value;
    }
    proc generate() return value;
    proc clone() return new BitwiseOrReduceScanOp(eltType=eltType);
  }

  class BitwiseXorReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _bxor_id(eltType);
    proc accumulate(x) {
      value = value ^ x;
    }
    proc combine(x) {
      value = value ^ x.value;
    }
    proc generate() return value;
    proc clone() return new BitwiseXorReduceScanOp(eltType=eltType);
  }

  class maxloc: ReduceScanOp {
    type eltType;
    var value = identity;
    var uninitialized = true;

    proc identity return min(eltType);
    proc accumulate(x) {
      if uninitialized || (x(1) > value(1)) ||
        ((x(1) == value(1)) && (x(2) < value(2))) then
        value = x;
      uninitialized = false;
    }
    proc combine(x) {
      if uninitialized || (x.value(1) > value(1)) ||
        ((x.value(1) == value(1)) && (x.value(2) < value(2))) {
        if !x.uninitialized {
          value = x.value;
          uninitialized = false;
        }
      }
    }
    proc generate() return value;
    proc clone() return new maxloc(eltType=eltType);
  }

  class minloc: ReduceScanOp {
    type eltType;
    var value = identity;
    var uninitialized = true;

    proc identity return max(eltType);
    proc accumulate(x) {
      if uninitialized || (x(1) < value(1)) ||
        ((x(1) == value(1)) && (x(2) < value(2))) then
        value = x;
      uninitialized = false;
    }
    proc combine(x) {
      if uninitialized || (x.value(1) < value(1)) ||
        ((x.value(1) == value(1)) && (x.value(2) < value(2))) {
        if !x.uninitialized {
          value = x.value;
          uninitialized = false;
        }
      }
    }
    proc generate() return value;
    proc clone() return new minloc(eltType=eltType);
  }

}

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

// ChapelReduce.chpl
//
module ChapelReduce {

  iter chpl__scanIteratorZip(op, data) {
    for e in zip((...data)) {
      op.accumulate(e);
      yield op.generate();
    }
    delete op;
  }

  iter chpl__scanIterator(op, data) {
    for e in data {
      op.accumulate(e);
      yield op.generate();
    }
    delete op;
  }

  proc chpl__reduceCombine(globalOp, localOp) {
    on globalOp {
      globalOp.lock();
      globalOp.combine(localOp);
      globalOp.unlock();
    }
  }

  inline proc chpl__cleanupLocalOp(globalOp, localOp) {
    // should this be part of chpl__reduceCombine ?
    delete localOp;
  }

  proc chpl__sumType(type eltType) type {
    var x: eltType;
    return (x + x).type;
  }

  pragma "ReduceScanOp"
  class ReduceScanOp {
    var lock$: sync bool;
    proc lock() {
      lock$.writeEF(true);
    }
    proc unlock() {
      lock$.readFE();
    }
  }

  class SumReduceScanOp: ReduceScanOp {
    type eltType;
    var value: chpl__sumType(eltType);

    // Rely on the default value of the desired type.
    // Todo: is this efficnent when that is an array?
    proc identity {
      var x: chpl__sumType(eltType); return x;
    }
    proc accumulate(x) {
      value = value + x;
    }
    proc combine(x) {
      value = value + x.value;
    }
    proc generate() return value;
    proc clone() return new SumReduceScanOp(eltType=eltType);
  }

  class ProductReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _prod_id(eltType);
    proc accumulate(x) {
      value = value * x;
    }
    proc combine(x) {
      value = value * x.value;
    }
    proc generate() return value;
    proc clone() return new ProductReduceScanOp(eltType=eltType);
  }

  class MaxReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return min(eltType);
    proc accumulate(x) {
      value = max(x, value);
    }
    proc combine(x) {
      value = max(value, x.value);
    }
    proc generate() return value;
    proc clone() return new MaxReduceScanOp(eltType=eltType);
  }

  class MinReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return max(eltType);
    proc accumulate(x) {
      value = min(x, value);
    }
    proc combine(x) {
      value = min(value, x.value);
    }
    proc generate() return value;
    proc clone() return new MinReduceScanOp(eltType=eltType);
  }

  class LogicalAndReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _land_id(eltType);
    proc accumulate(x) {
      value = value && x;
    }
    proc combine(x) {
      value = value && x.value;
    }
    proc generate() return value;
    proc clone() return new LogicalAndReduceScanOp(eltType=eltType);
  }

  class LogicalOrReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _lor_id(eltType);
    proc accumulate(x) {
      value = value || x;
    }
    proc combine(x) {
      value = value || x.value;
    }
    proc generate() return value;
    proc clone() return new LogicalOrReduceScanOp(eltType=eltType);
  }

  class BitwiseAndReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _band_id(eltType);
    proc accumulate(x) {
      value = value & x;
    }
    proc combine(x) {
      value = value & x.value;
    }
    proc generate() return value;
    proc clone() return new BitwiseAndReduceScanOp(eltType=eltType);
  }

  class BitwiseOrReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _bor_id(eltType);
    proc accumulate(x) {
      value = value | x;
    }
    proc combine(x) {
      value = value | x.value;
    }
    proc generate() return value;
    proc clone() return new BitwiseOrReduceScanOp(eltType=eltType);
  }

  class BitwiseXorReduceScanOp: ReduceScanOp {
    type eltType;
    var value = identity;

    proc identity return _bxor_id(eltType);
    proc accumulate(x) {
      value = value ^ x;
    }
    proc combine(x) {
      value = value ^ x.value;
    }
    proc generate() return value;
    proc clone() return new BitwiseXorReduceScanOp(eltType=eltType);
  }

  class maxloc: ReduceScanOp {
    type eltType;
    var value = identity;
    var uninitialized = true;

    proc identity return min(eltType);
    proc accumulate(x) {
      if uninitialized || (x(1) > value(1)) ||
        ((x(1) == value(1)) && (x(2) < value(2))) then
        value = x;
      uninitialized = false;
    }
    proc combine(x) {
      if uninitialized || (x.value(1) > value(1)) ||
        ((x.value(1) == value(1)) && (x.value(2) < value(2))) {
        if !x.uninitialized {
          value = x.value;
          uninitialized = false;
        }
      }
    }
    proc generate() return value;
    proc clone() return new maxloc(eltType=eltType);
  }

  class minloc: ReduceScanOp {
    type eltType;
    var value = identity;
    var uninitialized = true;

    proc identity return max(eltType);
    proc accumulate(x) {
      if uninitialized || (x(1) < value(1)) ||
        ((x(1) == value(1)) && (x(2) < value(2))) then
        value = x;
      uninitialized = false;
    }
    proc combine(x) {
      if uninitialized || (x.value(1) < value(1)) ||
        ((x.value(1) == value(1)) && (x.value(2) < value(2))) {
        if !x.uninitialized {
          value = x.value;
          uninitialized = false;
        }
      }
    }
    proc generate() return value;
    proc clone() return new minloc(eltType=eltType);
  }

}


Add some docs cleanups for HDFSiterator

Add some docs cleanups for HDFSiterator

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

/*
   Iterators that can iterate over distributed data in an HDFS filesystem
   in a distributed manner. See :mod:`HDFS`.
 */
module HDFSiterator {

use HDFS, UtilReplicatedVar, RecordParser;

/* Iterate through an HDFS file (available in the default configured
   HDFS server) and yield records matching a regular expression.

   Serial and leader-follower versions of this iterator are available.

   :arg path: the path to the file within the HDFS server
   :arg rec: the type of theh records to return
   :arg regexp: a regular expression with the same number of captures as
                the number of fields in the record type ``rec``

   */
iter HDFSiter(path: string, type rec, regex: string) {

  var hdfs = hdfs_chapel_connect("default", 0);
  var fl = hdfs.hdfs_chapel_open(path, iomode.r);

  var rr = fl.reader();
  var N  = new RecordReader(rec, rr, regex);
  // Make this migrate around to various locales based upon where the blocks reside
  // Reason we haven't done this is because we can't have a yield inside an on clause in a
  // serial iterator
  for n in N.stream() {
    yield n;

  }

  fl.close();
  hdfs.hdfs_chapel_disconnect();
}

// Lame use of a L/F, so it won't support zippering (so we would really like
// to have a standalone parallel iterator for this).
// Parallel IO and zippering will probably not play nice with each, due to not
// having a priori knowledge of how records map to positions in the file.
pragma "no doc"
iter HDFSiter(param tag: iterKind, path: string, type rec, regex: string)
  where tag == iterKind.leader {

    // Represents (offset_in_file, length_of_block)
    type hdfsInfo = 2*int(64);

    // Create a work queue for each locale
    // Not actually a FIFO. (could be an unordered set)
    var workQueue: [LocaleSpace] domain(hdfsInfo);

    // ----- Create a file  and filesystem pointer per locale ----
    var hdfs = hdfsChapelConnect("default", 0);
    var globalFile   = hdfs.hdfsOpen(path, iomode.r);

    // -------- Get locales for blocks ------
    // Get the local file
    var localFile = globalFile.getLocal();

    // Get the mapping of host for blocks for this file along
    // with how many blocks  there are
    var (hosts, numBlocksForFile) = getHosts(localFile);

    // Populate the work queue with work
    for block in 0..numBlocksForFile-1 {
      var h = getLocaleBytes(hosts, block);
      var r: hdfsInfo;
      r(1) = h.start_byte;
      r(2) = h.len;
      workQueue[h.locale_id] += r;
    }

    // NOTE: Second component on HDFs tuples are all the same except for the last
    // block. We could code around this to make it more compact (by specializing for
    // the last block).
    coforall loc in Locales {
      on loc {
        // Rip though the work in parallel on that locale
        forall byteRange in workQueue[loc.id] {
          var rr = globalFile.hdfsReader(start=byteRange(1));
          var N  = new RecordReader(rec, rr, regex);
          // Dont have a L/F for this so we yield serially.
          for n in N.stream_num(byteRange(1), byteRange(2)) {
            yield n;
          }
        }
      }
    }

    globalFile.hdfsClose();
    hdfs.hdfsChapelDisconnect();
  }

pragma "no doc"
iter HDFSiter(param tag: iterKind, path: string, type rec, regex: string, followThis)
  where tag == iterKind.follower {
    yield followThis;
  }

/* How hdfsOpen (and hdfsChapelConnect) works:

        +-----------------------+
        | hdfsOpen (globalFile) |
        +-----------------------+
                 /|\
                / | \
               /  |  \
              /   |   \
             /    |    \
     +--------+-------+------
     | File 1 | File2 | ...       File numLocales
     +--------+-------+------
   */

} /* end of module */

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

/*
   HDFS Iterator Support Module
 */
module HDFSiterator {

use HDFS, UtilReplicatedVar, RecordParser;

iter HDFSiter(path: string, type rec, regex: string) {

  var hdfs = hdfs_chapel_connect("default", 0);
  var fl = hdfs.hdfs_chapel_open(path, iomode.r);

  var rr = fl.reader();
  var N  = new RecordReader(rec, rr, regex);
  // Make this migrate around to various locales based upon where the blocks reside
  // Reason we haven't done this is because we can't have a yield inside an on clause in a
  // serial iterator
  for n in N.stream() {
    yield n;

  }

  fl.close();
  hdfs.hdfs_chapel_disconnect();
}

// Lame use of a L/F, so it won't support zippering (so we would really like to have
// a standalone parallel iterator for this).

// Parallel IO and zippering will probably not play nice with each, due to nt having
// a priori knowledge of how records map to positions in the file.

iter HDFSiter(param tag: iterKind, path: string, type rec, regex: string)
  where tag == iterKind.leader {

    // Represents (offset_in_file, length_of_block)
    type hdfsInfo = 2*int(64);

    // Create a work queue for each locale
    // Not actually a FIFO. (could be an unordered set)
    var workQueue: [LocaleSpace] domain(hdfsInfo);

    // ----- Create a file  and filesystem pointer per locale ----
    var hdfs = hdfsChapelConnect("default", 0);
    var globalFile   = hdfs.hdfsOpen(path, iomode.r);

    // -------- Get locales for blocks ------
    // Get the local file
    var localFile = globalFile.getLocal();

    // Get the mapping of host for blocks for this file along
    // with how many blocks  there are
    var (hosts, numBlocksForFile) = getHosts(localFile);

    // Populate the work queue with work
    for block in 0..numBlocksForFile-1 {
      var h = getLocaleBytes(hosts, block);
      var r: hdfsInfo;
      r(1) = h.start_byte;
      r(2) = h.len;
      workQueue[h.locale_id] += r;
    }

    // NOTE: Second component on HDFs tuples are all the same except for the last
    // block. We could code around this to make it more compact (by specializing for
    // the last block).
    coforall loc in Locales {
      on loc {
        // Rip though the work in parallel on that locale
        forall byteRange in workQueue[loc.id] {
          var rr = globalFile.hdfsReader(start=byteRange(1));
          var N  = new RecordReader(rec, rr, regex);
          // Dont have a L/F for this so we yield serially.
          for n in N.stream_num(byteRange(1), byteRange(2)) {
            yield n;
          }
        }
      }
    }

    globalFile.hdfsClose();
    hdfs.hdfsChapelDisconnect();
  }

iter HDFSiter(param tag: iterKind, path: string, type rec, regex: string, followThis)
  where tag == iterKind.follower {
    yield followThis;
  }

/* How hdfsOpen (and hdfsChapelConnect) works:

        +-----------------------+
        | hdfsOpen (globalFile) |
        +-----------------------+
                 /|\
                / | \
               /  |  \
              /   |   \
             /    |    \
     +--------+-------+------
     | File 1 | File2 | ...       File numLocales
     +--------+-------+------
   */

} /* end of module */


Noticed a comment was wrong in release/examples/primers/syncsingle.chpl.  The
description of readFE said that it waits until the state is full, reads the
value, then sets the state to full.  I figured that last "full" should have been
"empty".

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

//
// Sync and Single Variables Primer
//
// This primer illustrates Chapel's sync and single variables.
//
config const n = 7;

// Sync and single are type qualifiers that can be applied to all
// Chapel primitive types except strings, complex, and record.
//

// Sync and single variables have an associated state that is either
// 'full' or 'empty'.  Single variables are sync variables that can
// only be written once.  If a sync or single variable is declared
// with an initializing expression, its state is set to full and its
// value is that of the expression.  Without an initializing
// expression, a sync or single variable's state is set to empty and
// its value is the default value for the base type.
//
var sy$: sync int=1;  // state = full, value = 1
var si$: single bool; // state = empty, value = false

// By convention, sync and single variable names end in a $ to
// add a visual cue indicating that reads and writes are possibly
// expensive operations and can potentially block the task.
//

// For both sync and single variables, the state must be empty before
// the value can be written.  When the write has completed, the state
// is set to full.
//
si$ = true; // state = full, value = true

// For both sync and single variables, the state must be full before the
// value can be read.  When the read has completed, the state of a
// sync variable is set to empty, and the state of a single variable
// remains full.
//
var sy = sy$; // sy$: state = empty
var si = si$; // si$: state = full

// If a sync or single variable is not in the correct state for reading
// (full) or writing (empty), the current task blocks.
//
// The following creates a new task via a begin statement and declares
// a variable sy that is initialized to sy$.  The initialization statement
// will block until sy$ is full.  The last statement in the begin
// block sets the done$ to full.
//
var done$: sync bool;
writeln("Launching new task");
begin {
  var sy = sy$; // This statement will block until sy$ is full
  writeln("New task unblocked, sy=", sy);
  done$ = true;
}

// Recall that execution proceeds immediately following the begin
// statement after task creation.
//
writeln("After launching new task");
// When sy$ is written, its state will be set to full and the blocked
// task above will continue.
//
sy$ = n;
// This next statement blocks until last statement in the above begin
// completes.
//
done$;

//
// Example: simple split-phase barrier for tasks
//
var count$: sync int = n;  // counter which also serves as a lock
var release$: single bool; // barrier release

coforall t in 1..n {
  var myc = count$;   // read the count, grab the lock (state = empty)
  if myc!=1 {         // still waiting for others
    write(".");
    count$ = myc-1;   // update the count, release the lock (state = full)
                      // we could do some work while waiting
    release$;         // wait for everyone
  } else {            // last one here
    release$ = true;  // release everyone first (state = full)
    writeln("done");
  }
}

//
// There are a number of methods defined for sync and single variables.
//

// The reset() method, defined for sync variables, sets the value of
// the variable to the default value for the type and the state to
// empty.
//
sy$.reset();  // value = 0, state = full

// The isFull method returns true if the sync or single variable is
// in the full state, false otherwise.
//
writeln(sy$.isFull);
writeln(si$.isFull);

// The writeEF() method, defined for sync and single variables,
// blocks until the state is empty and then assigns the value argument
// to the variable and then sets the state to full.  Assignment of
// sync and single variables are performed using writeEF().
//
sy$.writeEF(2*n); // equivalent to: sy$ = 2*n;

// The readFE() method, defined for sync variables, blocks until the
// state is full and then reads the value of the variable, sets the
// state to empty, and then returns the value.  Normal reads of sync
// variables are performed using readFE().
//
var sy2 = sy$.readFE(); // equivalent to: var sy2 = sy$;
writeln(sy2);

// The readFF() method, defined for sync and single variables, blocks
// until the state is full and then reads the value of the variable
// and returns the value.  The state remains full.  Normal reads of
// single variables are performed using readFF().
//
var si2 = si$.readFF();
writeln(si2);

// The writeXF() method, defined for sync variables, assigns the
// value argument to the variable and then sets the state to full.
// This method does not block.
//
sy$.writeXF(3*n);

// The readXX() method, defined for sync and single variables, returns
// the value of the variable regardless of the state.  This method
// does not block and the state is unchanged.
//
var sy3 = sy$.readXX();
var si3 = si$.readXX();
writeln(sy3);
writeln(si3);

// The writeFF() method, defined for sync variables, blocks until the
// state is full and then and then assigns the value argument to the
// variable.  The state is unchanged.
//
sy$.writeFF(4*n);

sy$.reset();
// Sync and single arguments are passed by reference.  As a result,
// the state of the variable does not change.
//
writeln(sy$.isFull);
f_withSyncIntFormal(sy$);
writeln(si$.isFull);
f_withSingleBoolFormal(si$);

sy$ = 4*n;
// When a sync or single variable is passed as an argument to a
// function that expects the base type of the variable, the value is
// read before being passed to the function.  Therefore, the task will
// block until the state of the variable is full.
//
f_withIntFormal(sy$);
f_withBoolFormal(si$);

sy$ = 5*n;
// Similarly, when a sync or single variable is passed as an argument
// to a generic function such as writeln(), the value is read before
// being passed to the function.  The generic formal argument is set
// to be the base type of the actual.
//
writeln(sy$);
writeln(si$);

proc f_withSyncIntFormal(x: sync int) {
  writeln(x.isFull);
}

proc f_withSingleBoolFormal(x: single bool) {
  writeln(x.isFull);
}

proc f_withIntFormal(x: int) {
  writeln(x);
}

proc f_withBoolFormal(x: bool) {
  writeln(x);
}

//
// Sync and Single Variables Primer
//
// This primer illustrates Chapel's sync and single variables.
//
config const n = 7;

// Sync and single are type qualifiers that can be applied to all
// Chapel primitive types except strings, complex, and record.
//

// Sync and single variables have an associated state that is either
// 'full' or 'empty'.  Single variables are sync variables that can
// only be written once.  If a sync or single variable is declared
// with an initializing expression, its state is set to full and its
// value is that of the expression.  Without an initializing
// expression, a sync or single variable's state is set to empty and
// its value is the default value for the base type.
//
var sy$: sync int=1;  // state = full, value = 1
var si$: single bool; // state = empty, value = false

// By convention, sync and single variable names end in a $ to
// add a visual cue indicating that reads and writes are possibly
// expensive operations and can potentially block the task.
//

// For both sync and single variables, the state must be empty before
// the value can be written.  When the write has completed, the state
// is set to full.
//
si$ = true; // state = full, value = true

// For both sync and single variables, the state must be full before the
// value can be read.  When the read has completed, the state of a
// sync variable is set to empty, and the state of a single variable
// remains full.
//
var sy = sy$; // sy$: state = empty
var si = si$; // si$: state = full

// If a sync or single variable is not in the correct state for reading
// (full) or writing (empty), the current task blocks.
//
// The following creates a new task via a begin statement and declares
// a variable sy that is initialized to sy$.  The initialization statement
// will block until sy$ is full.  The last statement in the begin
// block sets the done$ to full.
//
var done$: sync bool;
writeln("Launching new task");
begin {
  var sy = sy$; // This statement will block until sy$ is full
  writeln("New task unblocked, sy=", sy);
  done$ = true;
}

// Recall that execution proceeds immediately following the begin
// statement after task creation.
//
writeln("After launching new task");
// When sy$ is written, its state will be set to full and the blocked
// task above will continue.
//
sy$ = n;
// This next statement blocks until last statement in the above begin
// completes.
//
done$;

//
// Example: simple split-phase barrier for tasks
//
var count$: sync int = n;  // counter which also serves as a lock
var release$: single bool; // barrier release

coforall t in 1..n {
  var myc = count$;   // read the count, grab the lock (state = empty)
  if myc!=1 {         // still waiting for others
    write(".");
    count$ = myc-1;   // update the count, release the lock (state = full)
                      // we could do some work while waiting
    release$;         // wait for everyone
  } else {            // last one here
    release$ = true;  // release everyone first (state = full)
    writeln("done");
  }
}

//
// There are a number of methods defined for sync and single variables.
//

// The reset() method, defined for sync variables, sets the value of
// the variable to the default value for the type and the state to
// empty.
//
sy$.reset();  // value = 0, state = full

// The isFull method returns true if the sync or single variable is
// in the full state, false otherwise.
//
writeln(sy$.isFull);
writeln(si$.isFull);

// The writeEF() method, defined for sync and single variables,
// blocks until the state is empty and then assigns the value argument
// to the variable and then sets the state to full.  Assignment of
// sync and single variables are performed using writeEF().
//
sy$.writeEF(2*n); // equivalent to: sy$ = 2*n;

// The readFE() method, defined for sync variables, blocks until the
// state is full and then reads the value of the variable, sets the
// state to full, and then returns the value.  Normal reads of sync
// variables are performed using readFE().
//
var sy2 = sy$.readFE(); // equivalent to: var sy2 = sy$;
writeln(sy2);

// The readFF() method, defined for sync and single variables, blocks
// until the state is full and then reads the value of the variable
// and returns the value.  The state remains full.  Normal reads of
// single variables are performed using readFF().
//
var si2 = si$.readFF();
writeln(si2);

// The writeXF() method, defined for sync variables, assigns the
// value argument to the variable and then sets the state to full.
// This method does not block.
//
sy$.writeXF(3*n);

// The readXX() method, defined for sync and single variables, returns
// the value of the variable regardless of the state.  This method
// does not block and the state is unchanged.
//
var sy3 = sy$.readXX();
var si3 = si$.readXX();
writeln(sy3);
writeln(si3);

// The writeFF() method, defined for sync variables, blocks until the
// state is full and then and then assigns the value argument to the
// variable.  The state is unchanged.
//
sy$.writeFF(4*n);

sy$.reset();
// Sync and single arguments are passed by reference.  As a result,
// the state of the variable does not change.
//
writeln(sy$.isFull);
f_withSyncIntFormal(sy$);
writeln(si$.isFull);
f_withSingleBoolFormal(si$);

sy$ = 4*n;
// When a sync or single variable is passed as an argument to a
// function that expects the base type of the variable, the value is
// read before being passed to the function.  Therefore, the task will
// block until the state of the variable is full.
//
f_withIntFormal(sy$);
f_withBoolFormal(si$);

sy$ = 5*n;
// Similarly, when a sync or single variable is passed as an argument
// to a generic function such as writeln(), the value is read before
// being passed to the function.  The generic formal argument is set
// to be the base type of the actual.
//
writeln(sy$);
writeln(si$);

proc f_withSyncIntFormal(x: sync int) {
  writeln(x.isFull);
}

proc f_withSingleBoolFormal(x: single bool) {
  writeln(x.isFull);
}

proc f_withIntFormal(x: int) {
  writeln(x);
}

proc f_withBoolFormal(x: bool) {
  writeln(x);
}


Minor touch-ups to schurComplement with Block and Dimensional.

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

//use BlockCycDist; //MBC - not using for now
use BlockDist;  //MBD
use d; //DIM
use r; //BD (with DIM)
//use f; //BC (with DIM)
use UtilMath, Time, Random;

config param reproducible = false;
config var verbose = true;

proc vwln(args...) { if verbose then writeln((...args)); }
vwln("reproducible=", reproducible, "  verbose=", verbose, "\n");

// indexType can be int or int(64), elemType can be real or complex
// for schurComplement, elemType can be any numeric type, really
type indexType = int,
     elemType = int(64);

// tla - targetLocales array, tl1 * tl2 locales
//
config const tl1 = 2,
             tl2 = 2;
var tla: [0..#tl1, 0..#tl2] locale;
var tld: bool;  // whether our targetLocales are all distinct

setupTargetLocales();

config const useRandomSeed = true,
             seed = if useRandomSeed then SeedGenerator.currentTime else 31415;

//
// Configuration constants indicating the problem size (n) and the
// block size (blkSize)
//
config const n = 62,
             blkSize = 8;

// The bounding box for our Block distributions.
// We arbitrarily choose to round up, rather than down.
const nbb1 = divceilpos(n, blkSize * tl1) * blkSize * tl1, //BD
      nbb2 = divceilpos(n, blkSize * tl2) * blkSize * tl2; //BD

// non-distributed version
const MatVectSpace = [1..n, 1..n+1];

const
  bdim1 =
    new sdist(tl1, 1, nbb1), //BD
  rdim1 = new vdist(tl1),

  bdim2 =
    new sdist(tl2, 1, nbb2), //BD
  rdim2 = new vdist(tl2);

const AbD: domain(2, indexType)
  // dmapped BlockCyclic(startIdx=(1,1), (blkSize,blkSize), targetLocales=tla)//MBC
   dmapped Block(boundingBox=[1..nbb1, 1..nbb2], targetLocales=tla) //MBD
  //   dmapped DimensionalDist(tla, bdim1, bdim2, "dim") //DIM
  = MatVectSpace;

var Ab: [AbD] elemType;  // the matrix A and vector b

// for the reference implementation
config const verify = true;
var Abref: [MatVectSpace] elemType;
var refsuccess = true;

// the domains for the arrays used for replication
const
  replAD = [1..n, 1..blkSize] dmapped
    DimensionalDist(tla, bdim1, rdim2, "distBR"), //DIM
  replBD = [1..blkSize, 1..n+1] dmapped
    DimensionalDist(tla, rdim1, bdim2, "distRB"); //DIM

var replA: [replAD] elemType,
    replB: [replBD] elemType;

writeln("n = ", n, "\n", "blkSize = ", blkSize, "\n", "AbD = ", AbD, "\n",
        "bounding box = ", [1..nbb1, 1..nbb2], "\n");

const startTime = getCurrentTime();     // capture the start time

LUFactorize();

const execTime = getCurrentTime() - startTime;  // store the elapsed time

write("DONE ", if verify then "with" else "without", " verification");
if reproducible {
  writeln();
} else {
  writeln("  time = ", execTime);
}
if !refsuccess then writeln("verification FAILED");

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

proc LUFactorize() {

  initABref();
  Ab = Abref;
  doverify(0);

  for blk in 1..n by blkSize {

    // AD is bottom-left; BD is top-right; Rest is bottom-right.
    //
    schurComplement(AD   = AbD[blk+blkSize.., blk..#blkSize],
                    BD   = AbD[blk..#blkSize, blk+blkSize..],
                    Rest = AbD[blk+blkSize.., blk+blkSize..]);

    doverify(blk);
  }
}

proc schurComplement(AD, BD, Rest) {
writeln("schurComplement(", BD.dim(1).low, ",", AD.dim(2).low, ")",
        //"  [2] ", Rest.low, "\n", "  AD ", AD, "  BD ", BD,
        if BD.dim(1).low < 10 then "  " else "",
        "  Rest ", Rest);

// If Rest is empty, panelSolve and updateBlockRow are still meaningful?
// Otherwise don't invoke schurComplement at all.
if Rest.numIndices == 0 {
  writeln("  Rest is empty");
  return;
}

writeln("  replA", replA.domain, " = Ab", AD, "  ", [1..n, AD.dim(2)]);
writeln("  replB", replB.domain, " = Ab", BD, "  ", [BD.dim(1), 1..n+1]);

  // TODO later: only assign from Ab[AD] and Ab[BD], resp.
  // Note: AD.dim(2)  and BD.dim(1) are always blkSize wide;
  // AD.dim(1)==Rest.dim(1) and BD.dim(2)==Rest.dim(2) are not necessarily
  // a multiple of blkSize (but are always non-empty if Rest is non-empty).

  // replicating into replA, replB
  coforall dest in tla[tla.domain.dim(1).high, tla.domain.dim(2)] do
    on dest do
      { writeln("copying to replA on ", here.id);
      replA = Ab[1..n, AD.dim(2)];
      }
  coforall dest in tla[tla.domain.dim(1), tla.domain.dim(2).high] do
    on dest do
      { writeln("copying to replB on ", here.id);
      replB = Ab[BD.dim(1), 1..n+1];
      }

  forall (row,col) in Rest by (blkSize, blkSize) {

writeln("  dgemm(", (Rest.dim(1))(row..#blkSize), ",",
                    (Rest.dim(2))(col..#blkSize), ")  on ", here.id);

    // This might be an implementation bug, as 'Rest' supports privatization.
    const RestLcl = Rest;

    local {
      for a in (RestLcl.dim(1))(row..#blkSize) do
        for w in 1..blkSize do
          for b in (RestLcl.dim(2))(col..#blkSize) do
            Ab[a,b] -= replA[a,w] * replB[w,b];
    }
  }
}

proc setupTargetLocales() {
  writeln("setting up for ", tl1, "*", tl2, " locales");
  tld = numLocales >= tla.numElements;
  if tld {
    var i = 0;
    for l in tla { l = Locales[i]; i += 1; }
  } else {
    writeln("oversubscribing Locales(0)");
    tla = Locales(0);
  }
  writeln("target locales =\n", tla, "\n");
}

// random initialization
proc initAB(Ab: [] elemType) {
  fillRandom(Ab, seed);
  Ab = Ab * 2.0 - 1.0;
}

proc initABref() {
  if !useRandomSeed || !reproducible then
    writeln("initABref seed = ", seed);
  else if useRandomSeed then
    writeln("initABref is using a random seed");

  if _isIntegralType(elemType) {

    var Abtemp: [MatVectSpace] real;
    fillRandom(Abtemp, seed);
    for (r,t) in (Abref,Abtemp) do
      r = (t * 2000 - 1000):elemType;

  } else {
    initAB(Abref);
  }
}

proc doverify(blk) {
  if !verify then return;

  if blk != 0 then
    schurComplementRefWrapper(blk);

  const OK = && reduce (Ab == Abref);
  if !OK then refsuccess = false;
  writeln("verification for blk=", blk,
          if OK then " succeeded" else " FAILED", "\n");
}

proc schurComplementRefWrapper(blk:int):void {
    const AbD = MatVectSpace;
    const tl = AbD[blk..#blkSize, blk..#blkSize],
          tr = AbD[blk..#blkSize, blk+blkSize..],
          bl = AbD[blk+blkSize.., blk..#blkSize],
          br = AbD[blk+blkSize.., blk+blkSize..],
          l  = AbD[blk.., blk..#blkSize];

    schurComplementRef(Abref, bl, tr, br);
    // throw it off: Abref[Abref.domain.low] = 0;
}

proc schurComplementRef(Ab: [?AbD] elemType, AD: domain, BD: domain, Rest: domain) {
  const replAD: domain(2, indexType) = AD,
        replBD: domain(2, indexType) = BD;

  const replA : [replAD] elemType = Ab[replAD],
        replB : [replBD] elemType = Ab[replBD];

  //  writeln("Rest = ", Rest);
  //  writeln("Rest by blkSize = ", Rest by (blkSize, blkSize));
  // do local matrix-multiply on a block-by-block basis
  forall (row,col) in Rest by (blkSize, blkSize) {
    //
    // At this point, the dgemms should all be local once we have
    // replication correct, so we'll want to assert that fact
    //
    //    local {
      const aBlkD = replAD[row..#blkSize, ..],
            bBlkD = replBD[.., col..#blkSize],
            cBlkD = AbD[row..#blkSize, col..#blkSize];

      dgemmNativeInds(replA[aBlkD], replB[bBlkD], Ab[cBlkD]);
      //    }
  }
}

//
// calculate C = C - A * B.
//
proc dgemmNativeInds(A: [] elemType,
                    B: [] elemType,
                    C: [] elemType) {
  for (iA, iC) in (A.domain.dim(1), C.domain.dim(1)) do
    for (jA, iB) in (A.domain.dim(2), B.domain.dim(1)) do
      for (jB, jC) in (B.domain.dim(2), C.domain.dim(2)) do
        C[iC,jC] -= A[iA, jA] * B[iB, jB];
}

//use BlockCycDist; //BC
use BlockDist;  //BD
use d, r; //DIM
use Time, Random;

config param reproducible = false;
config var verbose = true;

proc vwln(args...) { if verbose then writeln((...args)); }
vwln("reproducible=", reproducible, "  verbose=", verbose, "\n");

// indexType can be int or int(64), elemType can be real or complex
// for schurComplement, elemType can be any numeric type, really
type indexType = int,
     elemType = int(64);

// tla - targetLocales array, tl1 * tl2 locales
//
config const tl1 = 2,
             tl2 = 2;
var tla: [0..#tl1, 0..#tl2] locale;
var tld: bool;  // whether our targetLocales are all distinct

setupTargetLocales();

config const useRandomSeed = true,
             seed = if useRandomSeed then SeedGenerator.currentTime else 31415;

//
// Configuration constants indicating the problem size (n) and the
// block size (blkSize)
//
config const n = 62,
             blkSize = 8;

// The bounding box for our Block distributions.
// We arbitrarily choose to round up, rather than down.
const nbb1 = ceil(n, blkSize * tl1) * blkSize * tl1, //BD
      nbb2 = ceil(n, blkSize * tl2) * blkSize * tl2; //BD

// non-distributed version
const MatVectSpace = [1..n, 1..n+1];

const AbD: domain(2, indexType)
  // dmapped BlockCyclic(startIdx=(1,1), (blkSize,blkSize), targetLocales=tla)//BC
     dmapped Block(boundingBox=[1..nbb1, 1..nbb2], targetLocales=tla) //BD
  = MatVectSpace;

var Ab: [AbD] elemType;  // the matrix A and vector b

// for the reference implementation
config const verify = true;
var Abref: [MatVectSpace] elemType;
var refsuccess = true;

// the domains for the arrays used for replication
const replAD = [1..n, 1..blkSize]  dmapped DimensionalDist(tla, new sdist(tl1, 1, nbb1), new vdist(tl2), "distBR"),
      replBD = [1..blkSize, 1..n+1] dmapped DimensionalDist(tla, new vdist(tl1), new sdist(tl2, 1, nbb2), "distRB");

var replA: [replAD] elemType,
    replB: [replBD] elemType;

writeln("n = ", n, "\n", "blkSize = ", blkSize, "\n", "AbD = ", AbD, "\n",
        "bounding box = ", [1..nbb1, 1..nbb2], "\n");

const startTime = getCurrentTime();     // capture the start time

LUFactorize();

const execTime = getCurrentTime() - startTime;  // store the elapsed time

write("DONE ", if verify then "with" else "without", " verification");
if reproducible {
  writeln();
} else {
  writeln("  time = ", execTime);
}
if !refsuccess then writeln("verification FAILED");

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

proc LUFactorize() {

  initABref();
  Ab = Abref;
  doverify(0);

  for blk in 1..n by blkSize {

    // AD is bottom-left; BD is top-right; Rest is bottom-right.
    //
    schurComplement(AD   = AbD[blk+blkSize.., blk..#blkSize],
                    BD   = AbD[blk..#blkSize, blk+blkSize..],
                    Rest = AbD[blk+blkSize.., blk+blkSize..]);

    doverify(blk);
  }
}

proc schurComplement(AD, BD, Rest) {
writeln("schurComplement(", BD.dim(1).low, ",", AD.dim(2).low, ")",
        //"  [2] ", Rest.low, "\n", "  AD ", AD, "  BD ", BD,
        if BD.dim(1).low < 10 then "  " else "",
        "  Rest ", Rest);

// If Rest is empty, panelSolve and updateBlockRow are still meaningful?
// Otherwise don't invoke schurComplement at all.
if Rest.numIndices == 0 {
  writeln("  Rest is empty");
  return;
}

writeln("  replA", replA.domain, " = Ab", AD, "  ", [1..n, AD.dim(2)]);
writeln("  replB", replB.domain, " = Ab", BD, "  ", [BD.dim(1), 1..n+1]);

  // TODO later: only assign from Ab[AD] and Ab[BD], resp.
  // Note: AD.dim(2)  and BD.dim(1) are always blkSize wide;
  // AD.dim(1)==Rest.dim(1) and BD.dim(2)==Rest.dim(2) are not necessarily
  // a multiple of blkSize (but are always non-empty if Rest is non-empty).

  // replicating into replA, replB
  coforall dest in tla[tla.domain.dim(1).high, tla.domain.dim(2)] do
    on dest do
      { writeln("copying to replA on ", here.id);
      replA = Ab[1..n, AD.dim(2)];
      }
  coforall dest in tla[tla.domain.dim(1), tla.domain.dim(2).high] do
    on dest do
      { writeln("copying to replB on ", here.id);
      replB = Ab[BD.dim(1), 1..n+1];
      }

  forall (row,col) in Rest by (blkSize, blkSize) {

writeln("  dgemm(", (Rest.dim(1))(row..#blkSize), ",",
                    (Rest.dim(2))(col..#blkSize), ")  on ", here.id);

    // This might be an implementation bug, as 'Rest' supports privatization.
    const RestLcl = Rest;

    local {
      for a in (RestLcl.dim(1))(row..#blkSize) do
        for w in 1..blkSize do
          for b in (RestLcl.dim(2))(col..#blkSize) do
            Ab[a,b] -= replA[a,w] * replB[w,b];
    }
  }
}

// should be in Math: ceiling of x/y.  Assume for now x,y are positive.
proc ceil(x:int, y:int):int return (x + y - 1) / y;

proc setupTargetLocales() {
  writeln("setting up for ", tl1, "*", tl2, " locales");
  tld = numLocales >= tla.numElements;
  if tld {
    var i = 0;
    for l in tla { l = Locales[i]; i += 1; }
  } else {
    writeln("oversubscribing Locales(0)");
    tla = Locales(0);
  }
  writeln("target locales =\n", tla, "\n");
}

// random initialization
proc initAB(Ab: [] elemType) {
  fillRandom(Ab, seed);
  Ab = Ab * 2.0 - 1.0;
}

proc initABref() {
  if !useRandomSeed || !reproducible then
    writeln("initABref seed = ", seed);
  else if useRandomSeed then
    writeln("initABref is using a random seed");

  if _isIntegralType(elemType) {

    var Abtemp: [MatVectSpace] real;
    fillRandom(Abtemp, seed);
    for (r,t) in (Abref,Abtemp) do
      r = (t * 2000 - 1000):elemType;

  } else {
    initAB(Abref);
  }
}

proc doverify(blk) {
  if !verify then return;

  if blk != 0 then
    schurComplementRefWrapper(blk);

  const OK = && reduce (Ab == Abref);
  if !OK then refsuccess = false;
  writeln("verification for blk=", blk,
          if OK then " succeeded" else " FAILED", "\n");
}

proc schurComplementRefWrapper(blk:int):void {
    const AbD = MatVectSpace;
    const tl = AbD[blk..#blkSize, blk..#blkSize],
          tr = AbD[blk..#blkSize, blk+blkSize..],
          bl = AbD[blk+blkSize.., blk..#blkSize],
          br = AbD[blk+blkSize.., blk+blkSize..],
          l  = AbD[blk.., blk..#blkSize];

    schurComplementRef(Abref, bl, tr, br);
    // throw it off: Abref[Abref.domain.low] = 0;
}

proc schurComplementRef(Ab: [?AbD] elemType, AD: domain, BD: domain, Rest: domain) {
  const replAD: domain(2, indexType) = AD,
        replBD: domain(2, indexType) = BD;

  const replA : [replAD] elemType = Ab[replAD],
        replB : [replBD] elemType = Ab[replBD];

  //  writeln("Rest = ", Rest);
  //  writeln("Rest by blkSize = ", Rest by (blkSize, blkSize));
  // do local matrix-multiply on a block-by-block basis
  forall (row,col) in Rest by (blkSize, blkSize) {
    //
    // At this point, the dgemms should all be local once we have
    // replication correct, so we'll want to assert that fact
    //
    //    local {
      const aBlkD = replAD[row..#blkSize, ..],
            bBlkD = replBD[.., col..#blkSize],
            cBlkD = AbD[row..#blkSize, col..#blkSize];

      dgemmNativeInds(replA[aBlkD], replB[bBlkD], Ab[cBlkD]);
      //    }
  }
}

//
// calculate C = C - A * B.
//
proc dgemmNativeInds(A: [] elemType,
                    B: [] elemType,
                    C: [] elemType) {
  for (iA, iC) in (A.domain.dim(1), C.domain.dim(1)) do
    for (jA, iB) in (A.domain.dim(2), B.domain.dim(1)) do
      for (jB, jC) in (B.domain.dim(2), C.domain.dim(2)) do
        C[iC,jC] -= A[iA, jA] * B[iB, jB];
}


Undo some Filerator doc changes now that more sophisticated algorithm is used.

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

use Sort;

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

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

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

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

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

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

    return chpl_rt_direntptr_getname(this);
  }

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

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

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

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

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

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

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

  if (topdown) then
    yield path;

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

  if (!topdown) then
    yield path;
}

/* iter wordexp(pattern="*")

   wordexp() gives a glob-like capability, implemented with C's wordexp()
   (which is, itself a routine that provides a glob-like capability :)

     * pattern: the glob pattern to match against

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

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

  var glb : wordexp_t;

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

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

  wordfree(glb);
}

/* iter glob(pattern="*")

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

     * pattern: the glob pattern to match against

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

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

  var glb : glob_t;

  const err = chpl_glob(pattern:c_string, 0, glb);
  const num = chpl_glob_num(glb);
  if (num) then
    for i in 0..num-1 do
      yield chpl_glob_index(glb, i): string;

  globfree(glb);
}

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

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

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

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