Bug fix - compile error in convenience functions

[trivial and not reviewed]

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

extern type qio_regexp_t;

extern record qio_regexp_options_t {
  var utf8:bool;
  var posix:bool;
  var literal:bool;
  var nocapture:bool;
  // These ones can be set inside the regexp
  var ignorecase:bool; // (?i)
  var multiline:bool; // (?m)
  var dotnl:bool; // (?s)
  var nongreedy:bool; // (?U)
}

extern proc qio_regexp_null():qio_regexp_t;
extern proc qio_regexp_init_default_options(ref options:qio_regexp_options_t);
extern proc qio_regexp_create_compile(str:string, strlen:int(64), ref options:qio_regexp_options_t, ref compiled:qio_regexp_t);
extern proc qio_regexp_create_compile_flags(str:string, strlen:int(64), flags:string, flagslen:int(64), isUtf8:bool, ref compiled:qio_regexp_t);
extern proc qio_regexp_create_compile_flags_2(str:c_ptr, strlen:int(64), flags:c_ptr, flagslen:int(64), isUtf8:bool, ref compiled:qio_regexp_t);
extern proc qio_regexp_retain(ref compiled:qio_regexp_t);
extern proc qio_regexp_release(ref compiled:qio_regexp_t);

extern proc qio_regexp_get_options(ref regexp:qio_regexp_t, ref options: qio_regexp_options_t);
extern proc qio_regexp_get_pattern(ref regexp:qio_regexp_t, ref pattern: string);
extern proc qio_regexp_get_ncaptures(ref regexp:qio_regexp_t):int(64);
extern proc qio_regexp_ok(ref regexp:qio_regexp_t):bool;
extern proc qio_regexp_error(ref regexp:qio_regexp_t):string;

extern const QIO_REGEXP_ANCHOR_UNANCHORED:c_int;
extern const QIO_REGEXP_ANCHOR_START:c_int;
extern const QIO_REGEXP_ANCHOR_BOTH:c_int;

extern record qio_regexp_string_piece_t {
  var offset:int(64); // counting from 0, -1 means "NULL"
  var len:int(64);
}

extern proc qio_regexp_string_piece_isnull(ref sp:qio_regexp_string_piece_t):bool;

extern proc qio_regexp_match(ref re:qio_regexp_t, text:string, textlen:int(64), startpos:int(64), endpos:int(64), anchor:c_int, submatch:_ddata(qio_regexp_string_piece_t), nsubmatch:int(64)):bool;
extern proc qio_regexp_replace(ref re:qio_regexp_t, repl:string, repllen:int(64), text:string, textlen:int(64), startpos:int(64), endpos:int(64), global:bool, ref replaced):int(64);

// These two could be folded together if we had a way
// to check if a default argument was supplied
// (or any way to use 'nil' in pass-by-ref)
/** Compile a regular expression. This routine will halt if compilation failed
 */
proc compile(pattern: string, utf8=true, posix=false, literal=false, nocapture=false, /*i*/ ignorecase=false, /*m*/ multiline=false, /*s*/ dotnl=false, /*U*/ nongreedy=false):regexp {
  var opts:qio_regexp_options_t;
  qio_regexp_init_default_options(opts);
  opts.utf8 = utf8;
  opts.posix = posix;
  opts.literal = literal;
  opts.nocapture = nocapture;
  opts.ignorecase = ignorecase;
  opts.multiline = multiline;
  opts.dotnl = dotnl;
  opts.nongreedy = nongreedy;

  var ret:regexp;
  qio_regexp_create_compile(pattern, pattern.size, opts, ret._regexp);
  if ! qio_regexp_ok(ret._regexp) {
    var err_str = qio_regexp_error(ret._regexp);
    __primitive("chpl_error", "Error " + err_str + " when compiling regexp '" + pattern + "'");
  }
  return ret;
}

/** Compile a regular expression and retrieve an error code if compilation
    failed.
 */
proc compile(pattern: string, out error:syserr, utf8=true, posix=false, literal=false, nocapture=false, /*i*/ ignorecase=false, /*m*/ multiline=false, /*s*/ dotnl=false, /*U*/ nongreedy=false):regexp {
  var opts:qio_regexp_options_t;
  qio_regexp_init_default_options(opts);
  opts.utf8 = utf8;
  opts.posix = posix;
  opts.literal = literal;
  opts.nocapture = nocapture;
  opts.ignorecase = ignorecase;
  opts.multiline = multiline;
  opts.dotnl = dotnl;
  opts.nongreedy = nongreedy;

  var ret:regexp;
  qio_regexp_create_compile(pattern, pattern.size, opts, ret._regexp);

  if qio_regexp_ok(ret._regexp) {
    error = ENOERR;
  } else {
    error = qio_format_error_bad_regexp();
  }
  return ret;
}

/** Regular expression search routines also can work with
    a stringPart, which refers to a substring within another
    string.
 */
record stringPart {
  var offset:int;
  var length:int;
  var from:string;
}

/** The reMatch record records a regular expression search match
    or a capture group.
    Regular expression search routines normally return one of these.
    Also, this type can be passed as a capture group argument.
    Lastly, something of type reMatch can be checked for a match
    in a simple if statement, as in:
      var m:reMatch = ....;
      if m then do_something_if_matched();
      if !m then do_something_if_not_matched();

 */
record reMatch {
  var matched:bool;
  var offset:int; // 0-based, -1 if matched==false
  var length:int; // 0 if matched==false
}

proc _to_reMatch(ref p:qio_regexp_string_piece_t):reMatch {
  if qio_regexp_string_piece_isnull(p) {
    return new reMatch(false, -1, 0);
  } else {
    return new reMatch(true, p.offset, p.len);
  }
}

inline proc !(m: reMatch) return !m.matched;
inline proc _cond_test(m: reMatch) return m.matched;

/** Use someString.substring(anReMatch) to extract the part
    of a string matching a regular expression or capture group.
 */
proc string.substring(m:reMatch) {
  if m.matched then return this.substring(m.offset+1..#m.length);
  else return "";
}

/** This class represents a compiled regular expression. Regular expressions
    are cached on a per-thread basis and are reference counted.
    To create a compiled regular expression, use the compile function.
  */
record regexp {
  var home: locale = here;
  var _regexp:qio_regexp_t = qio_regexp_null();

  proc ok:bool {
    return qio_regexp_ok(_regexp);
  }
  proc error():string {
    return qio_regexp_error(_regexp);
  }

  // note - more = overloads are below.
  proc ~regexp() {
    qio_regexp_release(_regexp);
    _regexp = qio_regexp_null();
  }

  proc _handle_captures(text: string, matches:_ddata(qio_regexp_string_piece_t), nmatches:int, ref captures) {
    assert(nmatches >= captures.size);
    for param i in 1..captures.size {
      var m = _to_reMatch(matches[i]);
      if captures[i].type == reMatch {
        captures[i] = m;
      } else {
        if m.matched {
          captures[i] = text.substring(m):captures[i].type;
        } else {
          var empty:captures[i].type;
          captures[i] = empty;
        }
      }
    }
  }

  // Note - we would only need one version of these routines
  // if we had args ...?k supporting 0 args, or if tuples support zero length
  /** Search within the passed text (which must be a string or a stringPart)
      for the first match at any offset to this regular expression. Returns a
      match object. This routine will try matching the regular expression at
      different offsets until a match is found. If you want to only match at
      the beginning of the pattern, you can start your pattern with ^ or
      use regexp.match. The capture group arguments here can be strings
      or any type that can reasonably cast from string. If a capture group
      was not matched, the corresponding argument will get the default value
      for its type.
    */
  proc search(text: ?t, ref captures ...?k):reMatch
    where t == string || t == stringPart
  {
    var ret:reMatch;
    on this.home {
      var pos:int;
      var endpos:int;
      if t == stringPart {
        pos = text.offset;
        endpos = pos + text.length;
      } else {
        pos = 0;
        endpos = text.size;
      }
      var matches:_ddata(qio_regexp_string_piece_t);
      var nmatches = 1 + captures.size;
      matches = _ddata_allocate(qio_regexp_string_piece_t, nmatches);
      var got:bool;
      if t == stringPart {
       got = qio_regexp_match(_regexp, text.from, text.from.size, pos, endpos, QIO_REGEXP_ANCHOR_UNANCHORED, matches, nmatches);
      } else {
       got = qio_regexp_match(_regexp, text, text.size, pos, endpos, QIO_REGEXP_ANCHOR_UNANCHORED, matches, nmatches);
      }
      // Now try to coerce the read strings into the captures.
      _handle_captures(text, matches, nmatches, captures);
      // Now return where we matched.
      ret = new reMatch(got, matches[0].offset, matches[0].len);
      _ddata_free(matches);
    }
    return ret;
  }
  /** Search for the first match at any offset without returning any capture
      groups.
    */
  proc search(text: ?t):reMatch
    where t == string || t == stringPart
  {
    var ret:reMatch;
    on this.home {
      var pos:int;
      var endpos:int;
      if t == stringPart {
        pos = text.offset;
        endpos = pos + text.length;
      } else {
        pos = 0;
        endpos = text.size;
      }
      var matches:_ddata(qio_regexp_string_piece_t);
      var nmatches = 1;
      matches = _ddata_allocate(qio_regexp_string_piece_t, nmatches);
      var got:bool;
      if t == stringPart {
       got = qio_regexp_match(_regexp, text.from, text.from.size, pos, endpos, QIO_REGEXP_ANCHOR_UNANCHORED, matches, nmatches);
      } else {
       got = qio_regexp_match(_regexp, text, text.size, pos, endpos, QIO_REGEXP_ANCHOR_UNANCHORED, matches, nmatches);
      }
      // Now return where we matched.
      ret = new reMatch(got, matches[0].offset, matches[0].len);
      _ddata_free(matches);
    }
    return ret;
  }

  /** Check for a match to this regular expression at the start of the
      passed text. As with regexp.search, the capture group arguments
      here can be strings or any type that can reasonably cast from string. If
      a capture group was not matched, the corresponding argument will get the
      default value for its type.

      You can do
       if myregexp.match("some string") {
         ... do something if matched;
       }
   */
  proc match(text: ?t, ref captures ...?k):reMatch
    where t == string || t == stringPart
  {
    var ret:reMatch;
    on this.home {
      var pos:int;
      var endpos:int;
      if t == stringPart {
        pos = text.offset;
        endpos = pos + text.length;
      } else {
        pos = 0;
        endpos = text.size;
      }
      var matches:_ddata(qio_regexp_string_piece_t);
      var nmatches = 1 + captures.size;
      matches = _ddata_allocate(qio_regexp_string_piece_t, nmatches);
      var got:bool;
      if t == stringPart {
       got = qio_regexp_match(_regexp, text.from, text.from.size, pos, endpos, QIO_REGEXP_ANCHOR_START, matches, nmatches);
      } else {
       got = qio_regexp_match(_regexp, text, text.size, pos, endpos, QIO_REGEXP_ANCHOR_START, matches, nmatches);
      }
      // Now try to coerce the read strings into the captures.
      _handle_captures(text, matches, nmatches, captures);
      // Now return where we matched.
      ret = new reMatch(got, matches[0].offset, matches[0].len);
      _ddata_free(matches);
    }
    return ret;
  }
  proc match(text: ?t):reMatch
    where t == string || t == stringPart
  {
    var ret:reMatch;
    on this.home {
      var pos:int;
      var endpos:int;
      if t == stringPart {
        pos = text.offset;
        endpos = pos + text.length;
      } else {
        pos = 0;
        endpos = text.size;
      }
      var matches:_ddata(qio_regexp_string_piece_t);
      var nmatches = 1;
      matches = _ddata_allocate(qio_regexp_string_piece_t, nmatches);
      var got:bool;
      if t == stringPart {
       got = qio_regexp_match(_regexp, text.from, text.from.size, pos, endpos, QIO_REGEXP_ANCHOR_START, matches, nmatches);
      } else {
       got = qio_regexp_match(_regexp, text, text.size, pos, endpos, QIO_REGEXP_ANCHOR_START, matches, nmatches);
      }
      // Now return where we matched.
      ret = new reMatch(got, matches[0].offset, matches[0].len);
      _ddata_free(matches);
    }
    return ret;
  }

  /** Split the text by occurrences of this regular expression.
     If capturing parentheses are used in pattern, then the text of all
     groups in the pattern are also returned as part of the resulting array.
     If maxsplit is nonzero, at most maxsplit splits occur, and the
     remaining text is returned as the last element.
   */
  iter split(text: ?t, maxsplit: int = 0)
    where t == string || t == stringPart
  {
    var matches:_ddata(qio_regexp_string_piece_t);
    var ncaptures = qio_regexp_get_ncaptures(_regexp);
    var nmatches = 1 + ncaptures;
    var pos:int;
    var endpos:int;

    on this.home {
      matches = _ddata_allocate(qio_regexp_string_piece_t, nmatches);
    }

    if t == stringPart {
      pos = text.offset;
      endpos = pos + text.length;
    } else {
      pos = 0;
      endpos = text.size;
    }
    var splits = 0;
    var maxsplits = maxsplit;
    if maxsplit == 0 then maxsplits = max(int);

    while true {
      var splitstart = 0;
      var splitend = 0;
      var got:bool;
      on this.home {
        got = qio_regexp_match(_regexp, text, text.size, pos, endpos, QIO_REGEXP_ANCHOR_UNANCHORED, matches, nmatches);
      }

      splits += 1;
      if got && splits <= maxsplits {
        splitstart = matches[0].offset;
        splitend = matches[0].offset + matches[0].len;
      } else {
        splitstart = endpos;
        splitend = endpos;
      }

      if pos < endpos {
        // Yield splitted value
        yield text.substring(pos+1..splitstart);
      } else {
        yield "";
      }

      if got {
        // Yield capture groups
        for i in 1..ncaptures {
          yield text.substring(new reMatch(
                !qio_regexp_string_piece_isnull(matches[i]),
                matches[i].offset,
                matches[i].len));
        }
      }

      // Advance to splitend.
      pos = splitend;

      if splits > maxsplits || !got then break;
    }
    on this.home {
      _ddata_free(matches);
    }
  }
  /* Enumerates matches in the string as well as capture groups.
     Returns tuples of reMatch objects, the 1st is always
      the match for the whole pattern and the rest are the capture groups.
   */
  iter matches(text: ?t, param captures=0, maxmatches: int = max(int))
    where t == string || t == stringPart
  {
    var matches:_ddata(qio_regexp_string_piece_t);
    var nmatches = 1 + captures;
    var pos:int;
    var endpos:int;
    on this.home {
      matches = _ddata_allocate(qio_regexp_string_piece_t, nmatches);
    }
    if t == stringPart {
      pos = text.offset;
      endpos = pos + text.length;
    } else {
      pos = 0;
      endpos = text.size;
    }
    var nfound = 0;
    var cur = pos;
    while nfound < maxmatches && cur < endpos {
      var got:bool;
      on this.home {
       got = qio_regexp_match(_regexp, text, text.size, cur, endpos, QIO_REGEXP_ANCHOR_UNANCHORED, matches, nmatches);
      }
      if !got then break;
      param nret = captures+1;
      var ret:nret*reMatch;
      for i in 0..captures {
        ret[i+1] = new reMatch(got, matches[i].offset, matches[i].len);
      }
      yield ret;
      cur = matches[0].offset + matches[0].len;
    }
    on this.home {
      _ddata_free(matches);
    }
  }
  proc subn(repl:string, text: ?t, global = true ):(string, int)
    where t == string || t == stringPart
  {
    var pos:int;
    var endpos:int;
    if t == stringPart {
      pos = text.offset;
      endpos = pos + text.length;
    } else {
      pos = 0;
      endpos = text.size;
    }
    var replaced:string;
    var nreplaced:int;
    if t == stringPart {
      nreplaced = qio_regexp_replace(_regexp, repl, repl.size, text.from, text.from.size, pos, endpos, global, replaced);
    } else {
      nreplaced = qio_regexp_replace(_regexp, repl, repl.size, text, text.size, pos, endpos, global, replaced);
    }
    return (replaced, nreplaced);
  }
  proc sub(repl:string, text: ?t, global = true )
    where t == string || t == stringPart
  {
    var (str, count) = subn(repl, text, global);
    return str;
  }
  proc writeThis(f: Writer) {
    var pattern:string;
    on this.home {
      qio_regexp_get_pattern(this._regexp, pattern);
    }
    // Note -- this is wrong because we didn't quote
    // and there's no way to get the flags
    f.write("new regexp(\"", pattern, "\")");
  }
  proc readThis(f: Reader) {
    var pattern:string;
    // Note -- this is wrong because we didn't quote
    // and there's no way to get the flags
    var litOne = new ioLiteral("new regexp(\"");
    var litTwo = new ioLiteral("\")");
    if(f.read(litOne, pattern, litTwo)) {
      on this.home {
        var opts:qio_regexp_options_t;
        qio_regexp_init_default_options(opts);
        qio_regexp_create_compile(pattern, pattern.size, opts, this._regexp);
      }
    }
  }
}

proc =(ref ret:regexp, x:regexp)
{
  // retain -- release
  if x.home == ret.home {
    on x.home {
      qio_regexp_retain(x._regexp);
      qio_regexp_release(ret._regexp);
    }
    ret._regexp = x._regexp;
  } else {
    var pattern:string;
    var options:qio_regexp_options_t;

    on ret.home {
      qio_regexp_release(ret._regexp);
    }
    on x.home {
      qio_regexp_get_pattern(x._regexp, pattern);
      qio_regexp_get_options(x._regexp, options);
    }

    qio_regexp_create_compile(pattern, pattern.size, options, ret._regexp);
  }
  return ret;
}

// TODO -- shouldn't have to write this this way!
pragma "init copy fn"
proc chpl__initCopy(x: regexp) {
  on x.home {
    qio_regexp_retain(x._regexp);
  }
  return x;
}

// Cast regexp to string.
inline proc _cast(type t, x: regexp) where t == string {
  var pattern:string;
  on x.home {
    qio_regexp_get_pattern(x._regexp, pattern);
  }
  return pattern;
}
// Cast string to regexp
inline proc _cast(type t, x: string) where t == regexp {
  return compile(x);
}

// string methods for searching
proc string.search(needle: string, ignorecase=false):reMatch
{
  // Create a regexp matching the literal for needle
  var re = compile(needle, literal=true, nocapture=true, ignorecase=ignorecase);
  return re.search(this);
}
proc string.search(needle: regexp):reMatch
{
  return needle.search(this);
}
proc string.search(needle: regexp, ref captures ...?k):reMatch
{
  return needle.search(this, (...captures));
}
proc string.match(pattern: regexp):reMatch
{
  return pattern.match(this);
}
proc string.match(pattern: regexp, ref captures ...?k):reMatch
{
  return pattern.match(this, (...captures));
}

iter string.spit(pattern: regexp, maxsplit: int = 0)
{
  for v in pattern.split(this, maxsplit) {
    yield v;
  }
}

iter string.matches(pattern:regexp, param captures=0, maxmatches:int=max(int))
{
  for v in pattern.matches(this, captures, maxmatches) {
    yield v;
  }
}

extern type qio_regexp_t;

extern record qio_regexp_options_t {
  var utf8:bool;
  var posix:bool;
  var literal:bool;
  var nocapture:bool;
  // These ones can be set inside the regexp
  var ignorecase:bool; // (?i)
  var multiline:bool; // (?m)
  var dotnl:bool; // (?s)
  var nongreedy:bool; // (?U)
}

extern proc qio_regexp_null():qio_regexp_t;
extern proc qio_regexp_init_default_options(ref options:qio_regexp_options_t);
extern proc qio_regexp_create_compile(str:string, strlen:int(64), ref options:qio_regexp_options_t, ref compiled:qio_regexp_t);
extern proc qio_regexp_create_compile_flags(str:string, strlen:int(64), flags:string, flagslen:int(64), isUtf8:bool, ref compiled:qio_regexp_t);
extern proc qio_regexp_create_compile_flags_2(str:c_ptr, strlen:int(64), flags:c_ptr, flagslen:int(64), isUtf8:bool, ref compiled:qio_regexp_t);
extern proc qio_regexp_retain(ref compiled:qio_regexp_t);
extern proc qio_regexp_release(ref compiled:qio_regexp_t);

extern proc qio_regexp_get_options(ref regexp:qio_regexp_t, ref options: qio_regexp_options_t);
extern proc qio_regexp_get_pattern(ref regexp:qio_regexp_t, ref pattern: string);
extern proc qio_regexp_get_ncaptures(ref regexp:qio_regexp_t):int(64);
extern proc qio_regexp_ok(ref regexp:qio_regexp_t):bool;
extern proc qio_regexp_error(ref regexp:qio_regexp_t):string;

extern const QIO_REGEXP_ANCHOR_UNANCHORED:c_int;
extern const QIO_REGEXP_ANCHOR_START:c_int;
extern const QIO_REGEXP_ANCHOR_BOTH:c_int;

extern record qio_regexp_string_piece_t {
  var offset:int(64); // counting from 0, -1 means "NULL"
  var len:int(64);
}

extern proc qio_regexp_string_piece_isnull(ref sp:qio_regexp_string_piece_t):bool;

extern proc qio_regexp_match(ref re:qio_regexp_t, text:string, textlen:int(64), startpos:int(64), endpos:int(64), anchor:c_int, submatch:_ddata(qio_regexp_string_piece_t), nsubmatch:int(64)):bool;
extern proc qio_regexp_replace(ref re:qio_regexp_t, repl:string, repllen:int(64), text:string, textlen:int(64), startpos:int(64), endpos:int(64), global:bool, ref replaced):int(64);

// These two could be folded together if we had a way
// to check if a default argument was supplied
// (or any way to use 'nil' in pass-by-ref)
/** Compile a regular expression. This routine will halt if compilation failed
 */
proc compile(pattern: string, utf8=true, posix=false, literal=false, nocapture=false, /*i*/ ignorecase=false, /*m*/ multiline=false, /*s*/ dotnl=false, /*U*/ nongreedy=false):regexp {
  var opts:qio_regexp_options_t;
  qio_regexp_init_default_options(opts);
  opts.utf8 = utf8;
  opts.posix = posix;
  opts.literal = literal;
  opts.nocapture = nocapture;
  opts.ignorecase = ignorecase;
  opts.multiline = multiline;
  opts.dotnl = dotnl;
  opts.nongreedy = nongreedy;

  var ret:regexp;
  qio_regexp_create_compile(pattern, pattern.size, opts, ret._regexp);
  if ! qio_regexp_ok(ret._regexp) {
    var err_str = qio_regexp_error(ret._regexp);
    __primitive("chpl_error", "Error " + err_str + " when compiling regexp '" + pattern + "'");
  }
  return ret;
}

/** Compile a regular expression and retrieve an error code if compilation
    failed.
 */
proc compile(pattern: string, out error:syserr, utf8=true, posix=false, literal=false, nocapture=false, /*i*/ ignorecase=false, /*m*/ multiline=false, /*s*/ dotnl=false, /*U*/ nongreedy=false):regexp {
  var opts:qio_regexp_options_t;
  qio_regexp_init_default_options(opts);
  opts.utf8 = utf8;
  opts.posix = posix;
  opts.literal = literal;
  opts.nocapture = nocapture;
  opts.ignorecase = ignorecase;
  opts.multiline = multiline;
  opts.dotnl = dotnl;
  opts.nongreedy = nongreedy;

  var ret:regexp;
  qio_regexp_create_compile(pattern, pattern.size, opts, ret._regexp);

  if qio_regexp_ok(ret._regexp) {
    error = ENOERR;
  } else {
    error = qio_format_error_bad_regexp();
  }
  return ret;
}

/** Regular expression search routines also can work with
    a stringPart, which refers to a substring within another
    string.
 */
record stringPart {
  var offset:int;
  var length:int;
  var from:string;
}

/** The reMatch record records a regular expression search match
    or a capture group.
    Regular expression search routines normally return one of these.
    Also, this type can be passed as a capture group argument.
    Lastly, something of type reMatch can be checked for a match
    in a simple if statement, as in:
      var m:reMatch = ....;
      if m then do_something_if_matched();
      if !m then do_something_if_not_matched();

 */
record reMatch {
  var matched:bool;
  var offset:int; // 0-based, -1 if matched==false
  var length:int; // 0 if matched==false
}

proc _to_reMatch(ref p:qio_regexp_string_piece_t):reMatch {
  if qio_regexp_string_piece_isnull(p) {
    return new reMatch(false, -1, 0);
  } else {
    return new reMatch(true, p.offset, p.len);
  }
}

inline proc !(m: reMatch) return !m.matched;
inline proc _cond_test(m: reMatch) return m.matched;

/** Use someString.substring(anReMatch) to extract the part
    of a string matching a regular expression or capture group.
 */
proc string.substring(m:reMatch) {
  if m.matched then return this.substring(m.offset+1..#m.length);
  else return "";
}

/** This class represents a compiled regular expression. Regular expressions
    are cached on a per-thread basis and are reference counted.
    To create a compiled regular expression, use the compile function.
  */
record regexp {
  var home: locale = here;
  var _regexp:qio_regexp_t = qio_regexp_null();

  proc ok:bool {
    return qio_regexp_ok(_regexp);
  }
  proc error():string {
    return qio_regexp_error(_regexp);
  }

  // note - more = overloads are below.
  proc ~regexp() {
    qio_regexp_release(_regexp);
    _regexp = qio_regexp_null();
  }

  proc _handle_captures(text: string, matches:_ddata(qio_regexp_string_piece_t), nmatches:int, ref captures) {
    assert(nmatches >= captures.size);
    for param i in 1..captures.size {
      var m = _to_reMatch(matches[i]);
      if captures[i].type == reMatch {
        captures[i] = m;
      } else {
        if m.matched {
          captures[i] = text.substring(m):captures[i].type;
        } else {
          var empty:captures[i].type;
          captures[i] = empty;
        }
      }
    }
  }

  // Note - we would only need one version of these routines
  // if we had args ...?k supporting 0 args, or if tuples support zero length
  /** Search within the passed text (which must be a string or a stringPart)
      for the first match at any offset to this regular expression. Returns a
      match object. This routine will try matching the regular expression at
      different offsets until a match is found. If you want to only match at
      the beginning of the pattern, you can start your pattern with ^ or
      use regexp.match. The capture group arguments here can be strings
      or any type that can reasonably cast from string. If a capture group
      was not matched, the corresponding argument will get the default value
      for its type.
    */
  proc search(text: ?t, ref captures ...?k):reMatch
    where t == string || t == stringPart
  {
    var ret:reMatch;
    on this.home {
      var pos:int;
      var endpos:int;
      if t == stringPart {
        pos = text.offset;
        endpos = pos + text.length;
      } else {
        pos = 0;
        endpos = text.size;
      }
      var matches:_ddata(qio_regexp_string_piece_t);
      var nmatches = 1 + captures.size;
      matches = _ddata_allocate(qio_regexp_string_piece_t, nmatches);
      var got:bool;
      if t == stringPart {
       got = qio_regexp_match(_regexp, text.from, text.from.size, pos, endpos, QIO_REGEXP_ANCHOR_UNANCHORED, matches, nmatches);
      } else {
       got = qio_regexp_match(_regexp, text, text.size, pos, endpos, QIO_REGEXP_ANCHOR_UNANCHORED, matches, nmatches);
      }
      // Now try to coerce the read strings into the captures.
      _handle_captures(text, matches, nmatches, captures);
      // Now return where we matched.
      ret = new reMatch(got, matches[0].offset, matches[0].len);
      _ddata_free(matches);
    }
    return ret;
  }
  /** Search for the first match at any offset without returning any capture
      groups.
    */
  proc search(text: ?t):reMatch
    where t == string || t == stringPart
  {
    var ret:reMatch;
    on this.home {
      var pos:int;
      var endpos:int;
      if t == stringPart {
        pos = text.offset;
        endpos = pos + text.length;
      } else {
        pos = 0;
        endpos = text.size;
      }
      var matches:_ddata(qio_regexp_string_piece_t);
      var nmatches = 1;
      matches = _ddata_allocate(qio_regexp_string_piece_t, nmatches);
      var got:bool;
      if t == stringPart {
       got = qio_regexp_match(_regexp, text.from, text.from.size, pos, endpos, QIO_REGEXP_ANCHOR_UNANCHORED, matches, nmatches);
      } else {
       got = qio_regexp_match(_regexp, text, text.size, pos, endpos, QIO_REGEXP_ANCHOR_UNANCHORED, matches, nmatches);
      }
      // Now return where we matched.
      ret = new reMatch(got, matches[0].offset, matches[0].len);
      _ddata_free(matches);
    }
    return ret;
  }

  /** Check for a match to this regular expression at the start of the
      passed text. As with regexp.search, the capture group arguments
      here can be strings or any type that can reasonably cast from string. If
      a capture group was not matched, the corresponding argument will get the
      default value for its type.

      You can do
       if myregexp.match("some string") {
         ... do something if matched;
       }
   */
  proc match(text: ?t, ref captures ...?k):reMatch
    where t == string || t == stringPart
  {
    var ret:reMatch;
    on this.home {
      var pos:int;
      var endpos:int;
      if t == stringPart {
        pos = text.offset;
        endpos = pos + text.length;
      } else {
        pos = 0;
        endpos = text.size;
      }
      var matches:_ddata(qio_regexp_string_piece_t);
      var nmatches = 1 + captures.size;
      matches = _ddata_allocate(qio_regexp_string_piece_t, nmatches);
      var got:bool;
      if t == stringPart {
       got = qio_regexp_match(_regexp, text.from, text.from.size, pos, endpos, QIO_REGEXP_ANCHOR_START, matches, nmatches);
      } else {
       got = qio_regexp_match(_regexp, text, text.size, pos, endpos, QIO_REGEXP_ANCHOR_START, matches, nmatches);
      }
      // Now try to coerce the read strings into the captures.
      _handle_captures(text, matches, nmatches, captures);
      // Now return where we matched.
      ret = new reMatch(got, matches[0].offset, matches[0].len);
      _ddata_free(matches);
    }
    return ret;
  }
  proc match(text: ?t):reMatch
    where t == string || t == stringPart
  {
    var ret:reMatch;
    on this.home {
      var pos:int;
      var endpos:int;
      if t == stringPart {
        pos = text.offset;
        endpos = pos + text.length;
      } else {
        pos = 0;
        endpos = text.size;
      }
      var matches:_ddata(qio_regexp_string_piece_t);
      var nmatches = 1;
      matches = _ddata_allocate(qio_regexp_string_piece_t, nmatches);
      var got:bool;
      if t == stringPart {
       got = qio_regexp_match(_regexp, text.from, text.from.size, pos, endpos, QIO_REGEXP_ANCHOR_START, matches, nmatches);
      } else {
       got = qio_regexp_match(_regexp, text, text.size, pos, endpos, QIO_REGEXP_ANCHOR_START, matches, nmatches);
      }
      // Now return where we matched.
      ret = new reMatch(got, matches[0].offset, matches[0].len);
      _ddata_free(matches);
    }
    return ret;
  }

  /** Split the text by occurrences of this regular expression.
     If capturing parentheses are used in pattern, then the text of all
     groups in the pattern are also returned as part of the resulting array.
     If maxsplit is nonzero, at most maxsplit splits occur, and the
     remaining text is returned as the last element.
   */
  iter split(text: ?t, maxsplit: int = 0)
    where t == string || t == stringPart
  {
    var matches:_ddata(qio_regexp_string_piece_t);
    var ncaptures = qio_regexp_get_ncaptures(_regexp);
    var nmatches = 1 + ncaptures;
    var pos:int;
    var endpos:int;

    on this.home {
      matches = _ddata_allocate(qio_regexp_string_piece_t, nmatches);
    }

    if t == stringPart {
      pos = text.offset;
      endpos = pos + text.length;
    } else {
      pos = 0;
      endpos = text.size;
    }
    var splits = 0;
    var maxsplits = maxsplit;
    if maxsplit == 0 then maxsplits = max(int);

    while true {
      var splitstart = 0;
      var splitend = 0;
      var got:bool;
      on this.home {
        got = qio_regexp_match(_regexp, text, text.size, pos, endpos, QIO_REGEXP_ANCHOR_UNANCHORED, matches, nmatches);
      }

      splits += 1;
      if got && splits <= maxsplits {
        splitstart = matches[0].offset;
        splitend = matches[0].offset + matches[0].len;
      } else {
        splitstart = endpos;
        splitend = endpos;
      }

      if pos < endpos {
        // Yield splitted value
        yield text.substring(pos+1..splitstart);
      } else {
        yield "";
      }

      if got {
        // Yield capture groups
        for i in 1..ncaptures {
          yield text.substring(new reMatch(
                !qio_regexp_string_piece_isnull(matches[i]),
                matches[i].offset,
                matches[i].len));
        }
      }

      // Advance to splitend.
      pos = splitend;

      if splits > maxsplits || !got then break;
    }
    on this.home {
      _ddata_free(matches);
    }
  }
  /* Enumerates matches in the string as well as capture groups.
     Returns tuples of reMatch objects, the 1st is always
      the match for the whole pattern and the rest are the capture groups.
   */
  iter matches(text: ?t, param captures=0, maxmatches: int = max(int))
    where t == string || t == stringPart
  {
    var matches:_ddata(qio_regexp_string_piece_t);
    var nmatches = 1 + captures;
    var pos:int;
    var endpos:int;
    on this.home {
      matches = _ddata_allocate(qio_regexp_string_piece_t, nmatches);
    }
    if t == stringPart {
      pos = text.offset;
      endpos = pos + text.length;
    } else {
      pos = 0;
      endpos = text.size;
    }
    var nfound = 0;
    var cur = pos;
    while nfound < maxmatches && cur < endpos {
      var got:bool;
      on this.home {
       got = qio_regexp_match(_regexp, text, text.size, cur, endpos, QIO_REGEXP_ANCHOR_UNANCHORED, matches, nmatches);
      }
      if !got then break;
      param nret = captures+1;
      var ret:nret*reMatch;
      for i in 0..captures {
        ret[i+1] = new reMatch(got, matches[i].offset, matches[i].len);
      }
      yield ret;
      cur = matches[0].offset + matches[0].len;
    }
    on this.home {
      _ddata_free(matches);
    }
  }
  proc subn(repl:string, text: ?t, global = true ):(string, int)
    where t == string || t == stringPart
  {
    var pos:int;
    var endpos:int;
    if t == stringPart {
      pos = text.offset;
      endpos = pos + text.length;
    } else {
      pos = 0;
      endpos = text.size;
    }
    var replaced:string;
    var nreplaced:int;
    if t == stringPart {
      nreplaced = qio_regexp_replace(_regexp, repl, repl.size, text.from, text.from.size, pos, endpos, global, replaced);
    } else {
      nreplaced = qio_regexp_replace(_regexp, repl, repl.size, text, text.size, pos, endpos, global, replaced);
    }
    return (replaced, nreplaced);
  }
  proc sub(repl:string, text: ?t, global = true )
    where t == string || t == stringPart
  {
    var (str, count) = subn(repl, text, global);
    return str;
  }
  proc writeThis(f: Writer) {
    var pattern:string;
    on this.home {
      qio_regexp_get_pattern(this._regexp, pattern);
    }
    // Note -- this is wrong because we didn't quote
    // and there's no way to get the flags
    f.write("new regexp(\"", pattern, "\")");
  }
  proc readThis(f: Reader) {
    var pattern:string;
    // Note -- this is wrong because we didn't quote
    // and there's no way to get the flags
    var litOne = new ioLiteral("new regexp(\"");
    var litTwo = new ioLiteral("\")");
    if(f.read(litOne, pattern, litTwo)) {
      on this.home {
        var opts:qio_regexp_options_t;
        qio_regexp_init_default_options(opts);
        qio_regexp_create_compile(pattern, pattern.size, opts, this._regexp);
      }
    }
  }
}

proc =(ref ret:regexp, x:regexp)
{
  // retain -- release
  if x.home == ret.home {
    on x.home {
      qio_regexp_retain(x._regexp);
      qio_regexp_release(ret._regexp);
    }
    ret._regexp = x._regexp;
  } else {
    var pattern:string;
    var options:qio_regexp_options_t;

    on ret.home {
      qio_regexp_release(ret._regexp);
    }
    on x.home {
      qio_regexp_get_pattern(x._regexp, pattern);
      qio_regexp_get_options(x._regexp, options);
    }

    qio_regexp_create_compile(pattern, pattern.size, options, ret._regexp);
  }
  return ret;
}

// TODO -- shouldn't have to write this this way!
pragma "init copy fn"
proc chpl__initCopy(x: regexp) {
  on x.home {
    qio_regexp_retain(x._regexp);
  }
  return x;
}

// Cast regexp to string.
inline proc _cast(type t, x: regexp) where t == string {
  var pattern:string;
  on x.home {
    qio_regexp_get_pattern(x._regexp, pattern);
  }
  return pattern;
}
// Cast string to regexp
inline proc _cast(type t, x: string) where t == regexp {
  return compile(x);
}

// string methods for searching
proc string.search(needle: string, ignorecase=false):reMatch
{
  // Create a regexp matching the literal for needle
  var re = compile(needle, literal=true, nocapture=true, ignorecase=ignorecase);
  return re.search(this);
}
proc string.search(needle: regexp):reMatch
{
  return re.search(this);
}
proc string.search(needle: regexp, ref captures ...?k):reMatch
{
  return re.search(this, (...captures));
}
proc string.match(pattern: regexp):reMatch
{
  return re.match(this);
}
proc string.match(pattern: regexp, ref captures ...?k):reMatch
{
  return re.match(this, (...captures));
}

iter string.spit(pattern: regexp, maxsplit: int = 0)
{
  for v in pattern.split(this, maxsplit) {
    yield v;
  }
}

iter string.matches(pattern:regexp, param captures=0, maxmatches:int=max(int))
{
  for v in pattern.matches(this, captures, maxmatches) {
    yield v;
  }
}


Updated comments in jacobi a bit and switched to
tuple-style indexing (you're off the hook David :)

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

/*
 *  Jacobi Method Example
 *
 *  This program computes the solution of a Laplace equation using
 *  the Jacobi method.
 *
 */

// Configuration variables for program:
config var n = 5,                       // size of n x n grid
           epsilon = 0.00001,           // convergence tolerance
           verbose = false;             // printing control

def main() {
  const ProblemSpace = [1..n, 1..n],    // domain for grid points
        BigDomain = [0..n+1, 0..n+1];   // domain including boundary points

  var X, XNew: [BigDomain] real = 0.0;  // declare arrays:
                                        //   X stores approximate solution
                                        //   XNew stores the next solution

  X[n+1, 1..n] = 1.0;            // Set south boundary values to 1.0

  if (verbose) {
    writeln("Initial configuration:");
    writeln(X, "\n");
  }

  var iteration = 0,                    // iteration counter
      delta: real;                      // measure of convergence

  const north = (-1,0), south = (1,0), east = (0,1), west = (0,-1);

  do {
    // compute next approximation using Jacobi method and store in XNew
    forall ij in ProblemSpace do
      XNew(ij) = (X(ij+north) + X(ij+south) + X(ij+east) + X(ij+west)) / 4.0;

    // compute difference between next and current approximations
    delta = max reduce abs(XNew[ProblemSpace] - X[ProblemSpace]);

    // update X with next approximation
    X[ProblemSpace] = XNew[ProblemSpace];

    // advance iteration counter
    iteration += 1;

    if (verbose) {
      writeln("iteration: ", iteration);
      writeln(X);
      writeln("delta: ", delta, "\n");
    }
  } while (delta > epsilon);

  writeln("Jacobi computation complete.");
  writeln("Delta is ", delta, " (< epsilon = ", epsilon, ")");
  writeln("# of iterations: ", iteration);
}

/*
 *  Jacobi Method Example
 *
 *  This program computes the solution of a Laplace equation using
 *  the Jacobi method.
 *
 */

// Configuration variables for program:
config var n = 5,                       // size of nxn grid
           epsilon = 0.00001,           // convergence tolerance
           verbose = false;             // printing control

def main() {
  const ProblemSpace = [1..n, 1..n],    // domain for interior grid points
        BigDomain = [0..n+1, 0..n+1];   // domain with boundary points

  var X, XNew: [BigDomain] real = 0.0;  // X stores approximate solution
                                        // XNew is work array
  X[n+1..n+1, 1..n] = 1.0;

  if (verbose) {
    writeln("Initial configuration:");
    writeln(X, "\n");
  }

  var iteration = 0,                    // iteration counter
      delta: real;                      // measure of convergence

  do {
    // compute next approximation using Jacobi method and store in XNew
    forall (i,j) in ProblemSpace do
      XNew(i,j) = (X(i-1,j) + X(i+1,j) + X(i,j-1) + X(i,j+1)) / 4.0;

    // compute difference between next and current approximations
    delta = max reduce abs(XNew[ProblemSpace] - X[ProblemSpace]);

    // update X with next approximation
    X[ProblemSpace] = XNew[ProblemSpace];

    // advance iteration counter
    iteration += 1;

    if (verbose) {
      writeln("iteration: ", iteration);
      writeln(X);
      writeln("delta: ", delta, "\n");
    }
  } while (delta > epsilon);

  writeln("Jacobi computation complete.");
  writeln("Delta is ", delta, " (< epsilon = ", epsilon, ")");
  writeln("# of iterations: ", iteration);
}


Small typo fixed in a scalapack demo code that I put
together some time ago for John Lewis.

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

var D: domain(2) distributed (Scalapack(10)) = [1..m, 1..n];
var A: [D] real;

var SubD: subdomain(D) = D;

var (ipiv, info) = pdgetrf(A, SubD);

var D: domain(2) = [1..m, 1..n];
var A: [D] real;

var SubD: subdomain(D) = D;

var (ippiv, info) = pdgetrf(A, SubD);


Update definitions of abs() to use subtraction rather than multiplication

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

// ChapelBase.chpl
//

module ChapelBase
{
  //
  // Assignment operators
  //
  inline proc =  (ref a : bool, b : bool) : void { __primitive("=", a, b); }
  inline proc =  (ref a : int,  b : int ) : void { __primitive("=", a, b); }
  inline proc =  (ref a : real, b : real) : void { __primitive("=", a, b); }

  //
  // Basic unary arithmetic operators
  //

  inline proc + (a : int ) : int  return a;
  inline proc + (a : real) : real return a;

  inline proc - (a : int ) : int  return __primitive("u-", a);
  inline proc - (a : real) : real return __primitive("u-", a);

  //
  // Basic binary arithmetic operators
  //
  inline proc +  (    a : int,  b : int ) : int  return __primitive("+",  a, b);
  inline proc -  (    a : int,  b : int ) : int  return __primitive("-",  a, b);
  inline proc *  (    a : int,  b : int ) : int  return __primitive("*",  a, b);
  inline proc /  (    a : int,  b : int ) : int  return __primitive("/",  a, b);

  inline proc +  (    a : real, b : real) : real return __primitive("+",  a, b);
  inline proc -  (    a : real, b : real) : real return __primitive("-",  a, b);
  inline proc *  (    a : real, b : real) : real return __primitive("*",  a, b);
  inline proc /  (    a : real, b : real) : real return __primitive("/",  a, b);

  //
  // Equality comparison on primitive types
  //
  inline proc == (    a : bool, b : bool) : bool return __primitive("==", a, b);
  inline proc == (    a : int,  b : int ) : bool return __primitive("==", a, b);
  inline proc == (    a : real, b : real) : bool return __primitive("==", a, b);

  inline proc != (    a : bool, b : bool) : bool return __primitive("!=", a, b);
  inline proc != (    a : int,  b : int ) : bool return __primitive("!=", a, b);
  inline proc != (    a : real, b : real) : bool return __primitive("!=", a, b);

  //
  // Ordered comparison on primitive types
  //
  inline proc <  (    a : int,  b : int ) : bool return __primitive("<",  a, b);
  inline proc <  (    a : real, b : real) : bool return __primitive("<",  a, b);

  inline proc >  (    a : int,  b : int ) : bool return __primitive(">",  a, b);
  inline proc >  (    a : real, b : real) : bool return __primitive(">",  a, b);

  inline proc <= (    a : int,  b : int ) : bool return __primitive("<=", a, b);
  inline proc <= (    a : real, b : real) : bool return __primitive("<=", a, b);

  inline proc >= (    a : int,  b : int ) : bool return __primitive(">=", a, b);
  inline proc >= (    a : real, b : real) : bool return __primitive(">=", a, b);

  //
  // Absolute value
  //

  proc abs(a : int) : int
  {
    var retval : int = a;

    if (a < 0) then
      retval = 0 - a;

    return retval;
  }

  proc abs(a : real) : real
  {
    var retval : real = a;

    if (a < 0.0) then
      retval = 0.0 - a;

    return retval;
  }

  //
  // Support for implicit boolean conversion for conditional expressions
  //
  inline proc _cond_test(x : bool) : bool return x;
  inline proc _cond_test(x : int ) : bool return x != 0;

  //
  // These are implemented within the interpreter
  //

  extern proc print (x : bool)                    : void;
  extern proc print (x : int)                     : void;
  extern proc print (x : real)                    : void;
  extern proc print (x : c_string)                : void;

  extern proc print2(format : c_string, x : bool) : void;
  extern proc print2(format : c_string, x : int)  : void;
  extern proc print2(format : c_string, x : real) : void;
  extern proc print2(format : c_string)           : void;
}

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

// ChapelBase.chpl
//

module ChapelBase
{
  //
  // Assignment operators
  //
  inline proc =  (ref a : bool, b : bool) : void { __primitive("=", a, b); }
  inline proc =  (ref a : int,  b : int ) : void { __primitive("=", a, b); }
  inline proc =  (ref a : real, b : real) : void { __primitive("=", a, b); }

  //
  // Basic unary arithmetic operators
  //

  inline proc + (a : int ) : int  return a;
  inline proc + (a : real) : real return a;

  inline proc - (a : int ) : int  return __primitive("u-", a);
  inline proc - (a : real) : real return __primitive("u-", a);

  //
  // Basic binary arithmetic operators
  //
  inline proc +  (    a : int,  b : int ) : int  return __primitive("+",  a, b);
  inline proc -  (    a : int,  b : int ) : int  return __primitive("-",  a, b);
  inline proc *  (    a : int,  b : int ) : int  return __primitive("*",  a, b);
  inline proc /  (    a : int,  b : int ) : int  return __primitive("/",  a, b);

  inline proc +  (    a : real, b : real) : real return __primitive("+",  a, b);
  inline proc -  (    a : real, b : real) : real return __primitive("-",  a, b);
  inline proc *  (    a : real, b : real) : real return __primitive("*",  a, b);
  inline proc /  (    a : real, b : real) : real return __primitive("/",  a, b);

  //
  // Equality comparison on primitive types
  //
  inline proc == (    a : bool, b : bool) : bool return __primitive("==", a, b);
  inline proc == (    a : int,  b : int ) : bool return __primitive("==", a, b);
  inline proc == (    a : real, b : real) : bool return __primitive("==", a, b);

  inline proc != (    a : bool, b : bool) : bool return __primitive("!=", a, b);
  inline proc != (    a : int,  b : int ) : bool return __primitive("!=", a, b);
  inline proc != (    a : real, b : real) : bool return __primitive("!=", a, b);

  //
  // Ordered comparison on primitive types
  //
  inline proc <  (    a : int,  b : int ) : bool return __primitive("<",  a, b);
  inline proc <  (    a : real, b : real) : bool return __primitive("<",  a, b);

  inline proc >  (    a : int,  b : int ) : bool return __primitive(">",  a, b);
  inline proc >  (    a : real, b : real) : bool return __primitive(">",  a, b);

  inline proc <= (    a : int,  b : int ) : bool return __primitive("<=", a, b);
  inline proc <= (    a : real, b : real) : bool return __primitive("<=", a, b);

  inline proc >= (    a : int,  b : int ) : bool return __primitive(">=", a, b);
  inline proc >= (    a : real, b : real) : bool return __primitive(">=", a, b);

  //
  // Absolute value
  //

  proc abs(a : int) : int
  {
    var retval : int = a;

    if (a < 0) then
      retval = a * -1;

    return retval;
  }

  proc abs(a : real) : real
  {
    var retval : real = a;

    if (a < 0.0) then
      retval = a * -1.0;

    return retval;
  }

  //
  // Support for implicit boolean conversion for conditional expressions
  //
  inline proc _cond_test(x : bool) : bool return x;
  inline proc _cond_test(x : int ) : bool return x != 0;

  //
  // These are implemented within the interpreter
  //

  extern proc print (x : bool)                    : void;
  extern proc print (x : int)                     : void;
  extern proc print (x : real)                    : void;
  extern proc print (x : c_string)                : void;

  extern proc print2(format : c_string, x : bool) : void;
  extern proc print2(format : c_string, x : int)  : void;
  extern proc print2(format : c_string, x : real) : void;
  extern proc print2(format : c_string)           : void;
}


Simple cleanup -- remove original listdir()

The original listdir() was well past its point of usefulness, so
removed it now that findfiles() replaced its functionality and
renamed listdir2() to listdir().

This also meant that the code put into the Filerator help module
(originally because it was in two separate places) was now only
used in one, so removed the helper module (which never worked
anyway) and moved its contents into listdir().

config const debug = false;

use Sort;

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

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

    return chpl_rt_direntptr_getname(this);
  }
  // End inlining

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

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

  if (topdown) then
    yield path;

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

  if (!topdown) then
    yield path;
}

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

config const debug = false;

use Sort;

module FileratorHelp {
  extern type DIRptr;
  extern type direntptr;
  extern proc opendir(name: c_string): DIRptr;
  extern proc readdir(dirp: DIRptr): direntptr;
  extern proc closedir(dirp: DIRptr): c_int;
  extern proc chpl_rt_isDir(pathname: c_string): c_int;

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

    return chpl_rt_direntptr_getname(this);
  }

  /* Not portable (for example to Debian)
  proc direntptr.isDir() {
    extern proc chpl_rt_direntptr_isDir(d: direntptr): bool;

    return chpl_rt_direntptr_isDir(this);
  }
  */
}

iter listdir(path: string, recur = false, dotfiles=false, nosvn=true): string {
  // This does not work:
  //  use FileratorHelp;

  //
  // So inline its contents directly instead:
  //
  extern type DIRptr;
  extern type direntptr;
  extern proc opendir(name: c_string): DIRptr;
  extern proc readdir(dirp: DIRptr): direntptr;
  extern proc closedir(dirp: DIRptr): c_int;
  extern proc chpl_rt_isDir(pathname: c_string): c_int;

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

    return chpl_rt_direntptr_getname(this);
  }
  // End inlining

  var dir: DIRptr;
  var ent: direntptr;
  //  writeln("***Trying ", path);
  dir = opendir(path:c_string);
  if (!is_c_nil(dir)) {
    ent = readdir(dir);
    while (!is_c_nil(ent)) {
      const filename = ent.d_name();
      if (dotfiles || filename.substring(1) != '.') {
        if (!nosvn || filename != '.svn') {
          const fullpath = path + "/" + filename;
          if (!chpl_rt_isDir(fullpath:c_string)) {
            yield fullpath;
          } else {
            //        writeln("^^^ it's a directory!");
            if recur && filename != "." && filename != ".." {
              //
              // feature request: This is a nice place for a yieldall concept
              //
              for filename in listdir(fullpath, recur, dotfiles) do
                yield filename;
            }
          }
        }
      }
      ent = readdir(dir);
    }
    closedir(dir);
  } else {
    extern proc perror(s: c_string);
    perror("error in listdir(): ");
  }
}

iter listdir2(path: string, dotfiles=false, dirs=true, files=false): string {
  // This does not work:
  //  use FileratorHelp;

  //  writeln("listdir2() called with ", path);

  //
  // So inline its contents directly instead:
  //
  extern type DIRptr;
  extern type direntptr;
  extern proc opendir(name: c_string): DIRptr;
  extern proc readdir(dirp: DIRptr): direntptr;
  extern proc closedir(dirp: DIRptr): c_int;
  extern proc chpl_rt_isDir(pathname: c_string): c_int;

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

    return chpl_rt_direntptr_getname(this);
  }
  // End inlining

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

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

  if (topdown) then
    yield path;

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

  if (!topdown) then
    yield path;
}

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


Made changes to blockLU to use domain slicing.  Also, changed
equality test comparing D.dim(1) to D.dim(2).  Now, it is a
simple equality test where it used to be an explicit comparison
of the .low and .high values of D.dim(1) and D.dim(2).

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

def *(A:[?D1],B:[?D2]) {
  var x = A(D1.low)*B(D2.low);
  var C:[D1.dim(1),D2.dim(2)] x.type;

  if (D1.dim(2).length != D2.dim(1).length) then
    halt("Matrix multiplication with incompatible matrices");

  for i in D1.dim(1) {
    for j in D2.dim(2) {
      for (k1,k2) in (D1.dim(2),D2.dim(1)) {
        C(i,j) += A(i,k1)*B(k2,j);
      }
    }
  }
  return C;
}

def maxIndex(A:[?D]) {
   var (_,ind) = maxloc reduce (A,D);
   return ind;
}

def amaxIndex(A:[?D]) {
   var (_,ind) = maxloc reduce (abs(A),D);
   return ind;
}

def blockLU(x: [?D], piv, blk) where (D.rank != 2) {
// This routine will give a compiler error if blockLU
// is called with an array that is not two dimensional.

  compilerError("blockLU factors a matrix.  The first
input parameter to blockLU must be a two-dimensional array.");
}

def blockLU(A: [?D], piv: [D.dim(1)], blk) where (D.rank == 2){
// Block LU with pivoting.
// In this version, A1D is a range, not a 1D domain.  The iterator,
// IterateByBlocks returns ranges, not subdomains of A1D.  Temporary
// ranges, slice1 and slice2 are used to define what should be
// subdomains sliced by indefinite ranges.

  if (D.dim(1) != D.dim(2)) then
    halt("error: blockLU requires square matrix with same dimensions");

  var A1D = D.dim(1);
  var ind: index(D);

  for (UnfactoredInds,CurrentBlockInds,TrailingBlockInds)
    in IterateByBlocks(A1D,blk) {

    var A1 => A[UnfactoredInds,CurrentBlockInds];
    var A2 => A[UnfactoredInds,TrailingBlockInds];
    var A12 => A[CurrentBlockInds,TrailingBlockInds];
    var A22 => A[TrailingBlockInds,TrailingBlockInds];

// LU factorization of A1
    for k in CurrentBlockInds {

      ind = amaxIndex(A(UnfactoredInds(k..),k..k));

      if (ind(1) != k) {
        piv(k) <=> piv(ind(1));
        A(k..k,..) <=> A(ind(1)..ind(1),..);
      }

      if (A1(k,k) != 0.0) {
        forall i in UnfactoredInds(k+1..) {
          A1(i,k) = A1(i,k)/A1(k,k);
        }
        forall (i,j) in [UnfactoredInds(k+1..),CurrentBlockInds(k+1..)] {
          A1(i,j) -= A1(i,k)*A1(k,j);
        }
      }
      else halt("zero pivot encountered");
    }

// Update of A12.
    forall j in TrailingBlockInds {
      for k in CurrentBlockInds {
        forall i in CurrentBlockInds(k+1..) {
          A12(i,j) -= A1(i,k)*A12(k,j);
        }
      }
    }
// Update of A22 -= A12*A21.
    forall (i,j) in [TrailingBlockInds, TrailingBlockInds] {
      for k in CurrentBlockInds {
        A22(i,j) -= A1(i,k)*A12(k,j);
      }
    }
  }
}

iterator IterateByBlocks(D:range,blksize) {
  var n = D.length;
  var lo,hi: int;

  for i in D by blksize {
    lo = i;
    hi = min(i + blksize-1,n);
    yield (lo..n,i..hi,hi+1..n);
  }
}

def *(A:[?D1],B:[?D2]) {
  var x = A(D1.low)*B(D2.low);
  var C:[D1.dim(1),D2.dim(2)] x.type;

  if (D1.dim(2).length != D2.dim(1).length) then
    halt("Matrix multiplication with incompatible matrices");

  for i in D1.dim(1) {
    for j in D2.dim(2) {
      for (k1,k2) in (D1.dim(2),D2.dim(1)) {
        C(i,j) += A(i,k1)*B(k2,j);
      }
    }
  }
  return C;
}

def maxIndex(A:[?D]) {
   var (_,ind) = maxloc reduce (A,D);
   return ind;
}

def amaxIndex(A:[?D]) {
   var (_,ind) = maxloc reduce (abs(A),D);
   return ind;
}

def blockLU(x: [?D], piv, blk) where (D.rank != 2) {
  compilerError("blockLU factors a matrix.  The first
input parameter to blockLU must be a two-dimensional array.");
}

def blockLU(A: [?D], piv: [D.dim(1)], blk) where (D.rank == 2){
  var slice0, slice1, slice2: range;
  var ind: index(D);

  if ((D.dim(1).low != D.dim(2).low) | (D.dim(1).high != D.dim(2).high)) then
    halt("error: blockLU requires square matrix with same dimensions");

  var A1D = D.dim(1);
  for (UnfactoredInds,CurrentBlockInds,TrailingBlockInds)
    in IterateByBlocks(A1D,blk) {

    var A1 => A[UnfactoredInds,CurrentBlockInds];
    var A2 => A[UnfactoredInds,TrailingBlockInds];
    var A12 => A[CurrentBlockInds,TrailingBlockInds];
    var A22 => A[TrailingBlockInds,TrailingBlockInds];

// LU factorization of A1
    for k in CurrentBlockInds {
//    temporaries used instead of subdomains with indefinite ranges.
      slice0 = k..UnfactoredInds.high;
      slice1 = k+1..UnfactoredInds.high;
      slice2 = k+1..CurrentBlockInds.high;

      ind = amaxIndex(A(slice0,k..k));

      if (ind(1) != k) {
        piv(k) <=> piv(ind(1));
        A(k..k,A1D) <=> A(ind(1)..ind(1),A1D);
      }

      if (A1(k,k) != 0.0) {
        forall i in slice1 {
          A1(i,k) = A1(i,k)/A1(k,k);
        }
        forall (i,j) in [slice1,slice2] {
          A1(i,j) -= A1(i,k)*A1(k,j);
        }
      }
      else halt("zero pivot encountered");
    }

// Update of A12.
    forall j in TrailingBlockInds {
      for k in CurrentBlockInds {
//    temporary range used instead of subdomain with indefinite range
        slice2 = k+1..CurrentBlockInds.high;
        forall i in slice2 {
          A12(i,j) -= A1(i,k)*A12(k,j);
        }
      }
    }
// Update of A22 -= A12*A21.
    forall (i,j) in [TrailingBlockInds, TrailingBlockInds] {
      for k in CurrentBlockInds {
        A22(i,j) -= A1(i,k)*A12(k,j);
      }
    }
  }
}

iterator IterateByBlocks(D:range,blksize) {
  var n = D.length;
  var lo,hi: int;

  for i in D by blksize {
    lo = i;
    hi = min(i + blksize-1,n);
    yield (lo..n,i..hi,hi+1..n);
  }
}


Fix pidigits-hilde to work on 32-bit platforms.

/* The Computer Language Benchmarks Game
  http://shootout.alioth.debian.org/

  contributed by Paolo Bonzini & Sean Bartlett
  modified by Michael Mellor
*/
// Translated to Chapel by Tom Hildebrandt (hilde@cray.com)

extern proc printf(s:c_string, args ...);
extern proc putchar(c:int);

use GMP;
use Time;

config const n: uint = 50;	// Compute 50 digits of Pi, usually.
config param perfTest = false;

var numer, accum, denom, tmp1, tmp2: mpz_t;

proc main
{
  var t: Timer;

  if perfTest then t.start();
  // Produce the number of digits of Pi specified in n.
  pidigits;
  if perfTest then t.stop();

  if perfTest then
    writeln("Elapsed time = ", t.elapsed(TimeUnits.seconds));
}

proc pidigits
{
  var k, i, m: uint;
  var d: int;

  mpz_init(tmp1);
  mpz_init(tmp2);
  mpz_init_set_ui(numer, 1);
  mpz_init_set_ui(accum, 0);
  mpz_init_set_ui(denom, 1);

  // extract and print digits until done.
  while (true)
  {
    // Get the next valid digit and print it.
    do {
      k += 1;
      next_term(k);
      d = extract_digit;
    } while (d == -1);

    putchar(d:int + 48);

    // Do some format control.
    i += 1;
    m = i % 10;
    if m == 0 then writeln("\t:", i);
    if i >= n then break;
    eliminate_digit(d:uint);
  }

  mpz_clear(denom);
  mpz_clear(accum);
  mpz_clear(numer);
  mpz_clear(tmp2);
  mpz_clear(tmp1);
}

proc next_term(k:uint)
{
  var y2_tmp:uint = 2 * k + 1,
    y2 = safe_cast(c_ulong, y2_tmp),
    ck = safe_cast(c_ulong, k);

  mpz_mul_2exp(tmp1, numer, 1:c_ulong);
  mpz_add(accum, accum, tmp1);		// accum <- accum + numer * 2
  mpz_mul_ui(accum, accum, y2);		// accum <- accum * (2k+1)
  mpz_mul_ui(numer, numer, ck);		// numer <- numer * k
  mpz_mul_ui(denom, denom, y2);		// denom <- denom * (2k+1)
}

proc extract_digit : int
{
  if mpz_cmp(numer, accum) > 0 then return -1;	// No digits yet.

  // Compute (numer * 3 + accum)
  mpz_mul_2exp(tmp1, numer, 1);
  mpz_add(tmp1, tmp1, numer);
  mpz_add(tmp1, tmp1, accum);

  // tmp1 <- tmp1 / denom; tmp2 <- tmp1 % denom
  mpz_fdiv_qr(tmp1, tmp2, tmp1, denom);

  // Now, if (numer * 3 + accum) % denom + numer
  // == (numer * 4 + accum) % denom
  mpz_add(tmp2, tmp2, numer);
  if mpz_cmp(tmp2, denom) >= 0 then return -1;

  return mpz_get_ui(tmp1) : int;
}

proc eliminate_digit(d: uint)
{
  mpz_submul_ui(accum, denom, safe_cast(c_ulong, d));
  mpz_mul_ui(accum, accum, 10);
  mpz_mul_ui(numer, numer, 10);
}

/* The Computer Language Benchmarks Game
  http://shootout.alioth.debian.org/

  contributed by Paolo Bonzini & Sean Bartlett
  modified by Michael Mellor
*/
// Translated to Chapel by Tom Hildebrandt (hilde@cray.com)

extern proc printf(s:c_string, args ...);
extern proc putchar(c:int);

use GMP;
use Time;

config const n: uint = 50;	// Compute 50 digits of Pi, usually.
config param perfTest = false;

var numer, accum, denom, tmp1, tmp2: mpz_t;

proc main
{
  var t: Timer;

  if perfTest then t.start();
  // Produce the number of digits of Pi specified in n.
  pidigits;
  if perfTest then t.stop();

  if perfTest then
    writeln("Elapsed time = ", t.elapsed(TimeUnits.seconds));
}

proc pidigits
{
  var k, i, m: uint;
  var d: int;

  mpz_init(tmp1);
  mpz_init(tmp2);
  mpz_init_set_ui(numer, 1);
  mpz_init_set_ui(accum, 0);
  mpz_init_set_ui(denom, 1);

  // extract and print digits until done.
  while (true)
  {
    // Get the next valid digit and print it.
    do {
      k += 1;
      next_term(k);
      d = extract_digit;
    } while (d == -1);

    putchar(d:int + 48);

    // Do some format control.
    i += 1;
    m = i % 10;
    if m == 0 then writeln("\t:", i);
    if i >= n then break;
    eliminate_digit(d:uint);
  }

  mpz_clear(denom);
  mpz_clear(accum);
  mpz_clear(numer);
  mpz_clear(tmp2);
  mpz_clear(tmp1);
}

proc next_term(k:uint)
{
  var y2:uint = 2 * k + 1;

  mpz_mul_2exp(tmp1, numer, 1:c_ulong);
  mpz_add(accum, accum, tmp1);		// accum <- accum + numer * 2
  mpz_mul_ui(accum, accum, y2);		// accum <- accum * (2k+1)
  mpz_mul_ui(numer, numer, k);		// numer <- numer * k
  mpz_mul_ui(denom, denom, y2);		// denom <- denom * (2k+1)
}

proc extract_digit : int
{
  if mpz_cmp(numer, accum) > 0 then return -1;	// No digits yet.

  // Compute (numer * 3 + accum)
  mpz_mul_2exp(tmp1, numer, 1);
  mpz_add(tmp1, tmp1, numer);
  mpz_add(tmp1, tmp1, accum);

  // tmp1 <- tmp1 / denom; tmp2 <- tmp1 % denom
  mpz_fdiv_qr(tmp1, tmp2, tmp1, denom);

  // Now, if (numer * 3 + accum) % denom + numer
  // == (numer * 4 + accum) % denom
  mpz_add(tmp2, tmp2, numer);
  if mpz_cmp(tmp2, denom) >= 0 then return -1;

  return mpz_get_ui(tmp1) : int;
}

proc eliminate_digit(d: uint)
{
  mpz_submul_ui(accum, denom, d);
  mpz_mul_ui(accum, accum, 10);
  mpz_mul_ui(numer, numer, 10);
}