Fixed a bug in this code in which a value was used as a type.  It is still
a .future, but this change updates it.

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

/** MRA -- MultiResolution Analysis Module

    Multiresolution representation of 1-d functions using a multiwavelet
    basis (similar to discontinuous spectral element with a hierarchal
    decomposition).

    Mad Chapel Author: James Dinan <dinan@cray.com>
                 Date: August, 2007

    This code is an adaptation of 1d Madness, originally written by Robert
    Harrison <harrisonrj@ornl.gov>, et al.
 */

use Math;

config const verbose = false;
config const debug   = false;
const PI = 3.14159265358979323846;

var None: [0..-1] real;

config const hg_inputfile = "hg_coeffs.dat";

var hg_MaxK   : int;
var hg_coeffs : [0..-1, 0..-1, 0..-1] real;
var phi_norms : [0..-1] real;
var phi_initialized = false;

class AFcn {
    def this(x: real): real {
        halt("Fn1d.f() is abstract and should not be called directly");
        return 0.0;
    }
}
record Coeff {
    var dom  : domain(1);
    var data : [dom] real;
}

// Check if we have None.
def isNone(x) {
    return x.numElements == 0;
}

class FTree {
    var order    : int;
    var coeffDom = [0..order-1];
    var idx_t    : 2*int;           // FIXME: Can't write domain(2*int)

    var indices  : domain(idx_t.type);   // Indexed by 2-tuples of integers
    var nodes    : [indices] Coeff; // Associative Mapping: (:int, :int) => Coeff

    var zeroes   : [coeffDom] real; // Return zeroes from this() when reading
                                    // something that has not yet been set.

    def initialize() {
        if order == 0 then
            halt("FTree must be initialized with an order > 0");
    }

    /** Access an element in the associative domain.  If the element
        doesn't exist it will be created.

        We have to be really careful about creating extra boxes when we don't
        mean to.  The algorithms tend to be really sensitive to the structure
        of the tree.  Scaling coefficients are used to mark the leaves in the
        sum tree, so if you accidentally create scaling coeffs somewhere in the
        middle of the tree you will short circuit a whole subtree!

     */
    def this(lvl: int, idx: int) var {
        if !indices.member((lvl, idx)) {
            if setter {
              indices += ((lvl, idx));
              nodes[(lvl, idx)] = Coeff(coeffDom);
            } else {
              // This is a getter so it shouldn't be modifying what
              // we return, should be safe to return the zero vector.
              // FIXME: Zeroes should really be a const, but can'ti
              //        return const from a var fcn.
              return zeroes;
            }
        }

        return nodes[(lvl, idx)].data;
    }

    def this((lvl, idx)) var {
        if !indices.member((lvl, idx)) {
            if setter {
              indices += ((lvl, idx));
              nodes[(lvl, idx)] = Coeff(coeffDom);
            } else {
              // This is a getter so it shouldn't be modifying what
              // we return, should be safe to return the zero vector.
              // FIXME: Zeroes should really be a const, but can'ti
              //        return const from a var fcn.
              return zeroes;
            }
        }

        return nodes[(lvl, idx)].data;
    }

    def get_children((lvl, idx)) {
        return ((lvl+1, 2*idx), (lvl+1, 2*idx+1));
    }

    def get_neighbors((lvl, idx)) {
        return ((lvl, idx-1), (lvl, idx+1));
    }

    /** Unordered iterator over all coefficients
     */
    def these() {
        for n in nodes yield n.data;
    }

    /** Check if there are coefficients in box (lvl, idx)
     */
    def has_coeffs((lvl, idx)) {
        return indices.member((lvl, idx));
    }

    /** Remove an element from the associative domain.  If the element
        does not exist, it is ignored.
     */
    def remove((lvl,idx)) {
        if indices.member((lvl, idx)) then indices.remove((lvl, idx));
    }
}

class Function {
    const k             = 5;    // use first k Legendre polynomials as the basis in each box
    const thresh        = 1e-5; // truncation threshold for small wavelet coefficients
    const f: AFcn       = nil;  // analytic f(x) to project into the numerical represntation
    const initial_level = 2;    // initial level of refinement
    const max_level     = 30;   // maximum level of refinement mostly as a sanity check
    var   autorefine    = true; // automatically refine during multiplication
    var   compressed    = false;// keep track of what basis we are in

    // Sum and Difference coefficients
    var   s = FTree(order=k);
    var   d = FTree(order=k);

    // FIXME: Ideally all of these matrices should be const as well but they
    //        can't be presently since they must be assigned in initialize()

    // Two-Scale relationship matrices
    const hgDom = [0..2*k-1, 0..2*k-1];
    var   hg    : [hgDom] real; // FIXME: hg  =  hg_getCoeffs(k);
    var   hgT   : [hgDom] real; //        hgT => transpose(hg);

    // Quadrature coefficients
    const quadDom   = [0..k-1];
    var   quad_x    : [quadDom] real; // points
    var   quad_w    : [quadDom] real; // weights

    const quad_phiDom = [0..k-1, 0..k-1];
    var   quad_phi    : [quad_phiDom] real; // phi[point,i]
    var   quad_phiT   : [quad_phiDom] real; // phi[point,i] transpose
    var   quad_phiw   : [quad_phiDom] real; // phi[point,i]*weight[point]

    // blocks of the block tridiagonal derivative operator
    const dcDom = [0..k-1, 0..k-1];
    var   rm    : [dcDom] real;
    var   r0    : [dcDom] real;
    var   rp    : [dcDom] real;

    def initialize() {
        if debug then writeln("Creating Function: k=", k, " thresh=", thresh);

        if debug then writeln("  initializing two-scale relation coefficients");
        hg  = hg_getCoeffs(k);
        transposeCopy(hgT, hg);

        if debug then writeln("  initializing quadrature coefficients");
        init_quadrature(k);

        // blocks of the block tridiagonal derivative operator
        if debug then writeln("  initializing tridiagonal derivative operator");
        make_dc_periodic();

        // initial refinement of analytic function f(x)
        if f != nil {
            if debug then writeln("  performing initial refinement of f(x)");
            for l in 0..2**initial_level-1 do
                refine((initial_level, l));
        }

        if debug then writeln("done.");
    }

    /** Initialize the quadrature coefficient matricies.
     */
    def init_quadrature(order: int) {
        quad_x   = gl_getPoints(k);
        quad_w   = gl_getWeights(k);

        for i in quad_phiDom.dim(1) {
            var p = phi(quad_x[i], k);
            quad_phi [i..i, ..] = p;            // FIXME: quad_phi [i, ..] = p;
            quad_phiw[i..i, ..] = quad_w[i] * p;//        quad_phiw[i, ..] = ...;
            quad_phiT[.., i..i] = p;
        }
    }

    /** Return the level-0 blocks rm, r0, rp of the central
        difference derivative operator with periodic boundary
        conditions on either side.
     */
    def make_dc_periodic() {
        var iphase = 1.0;
        for i in dcDom.dim(1) {
            var jphase = 1.0;

            for j in dcDom.dim(2) {
                var gammaij = sqrt((2*i+1) * (2*j+1));
                var Kij = if (i-j) > 0 && ((i-j) % 2) == 1 then
                        2.0 else 0.0;
                r0[i,j] = 0.5*(1.0 - iphase*jphase - 2.0*Kij)*gammaij;
                rm[i,j] = 0.5*jphase*gammaij;
                rp[i,j] =-0.5*iphase*gammaij;
                jphase = -jphase;
            }
            iphase = -iphase;
        }
    }

    /** Return a copy of this function's skeleton
     */
    def skeletonCopy() {
        // Omit: f, compressed, s, d
        return Function(k=k, thresh=thresh, initial_level=initial_level,
                max_level=max_level, autorefine=autorefine);
    }

    /** s[n, l] = integral(phi[n][l](x) * f(x))
        for box (n,l) project f(x) using quadrature rule
        into scaling function basis
     */
    def project(curNode: 2*int) {
        const (n, l) = curNode;
        var s     : [quadDom] real;
        var h     = 0.5 ** n;
        var scale = sqrt(h);

        for mu in quad_phiDom.dim(1) {
            var x  = (l + quad_x[mu]) * h;
            var fx = f(x);
            for i in quad_phiDom.dim(2) do
                s[i] += scale * fx * quad_phiw[mu, i];
        }

        return s;
    }

    /** Refine numerical representation of f(x) to desired tolerance
     */
    def refine(curNode: 2*int) {
        // project f(x) at next level
        const (n, _ ) = curNode;
        const child = s.get_children(curNode);
        var sc : [0..2*k-1] real;
        var s0 : [0..k-1] => sc[0..k-1];
        var s1 : [0..k-1] => sc[k..2*k-1];

        s0 = project(child(1));
        s1 = project(child(2));

        // apply the two scale relationship to get difference coeff
        // in 1d this is O(k^2) flops
        var dc = sc*hgT;

        // check to see if within tolerance
        // normf() is Frobenius norm == 2-norm for vectors
        var nf = normf(dc[k..2*k-1]);
        if((nf < thresh) || (n >= (max_level-1))) {
            s[child(1)] = s0;
            s[child(2)] = s1;
        }
        else {
            // these recursive calls on sub-trees can go in parallel
            // if the HashMap is syncronized
            refine(child(1));
            refine(child(2));
        }
    }

    /** Evaluate numerical representation of f at x.  Performed in scaling
        function basis only.
     */
    def this(x) {
        if compressed then reconstruct();
        return evaluate( (0,0), x);
    }

    /** eval f(x) using adaptively refined numerical representation of f(x)
        answer should be within tolerance of the analytical f(x)

        Descend tree looking for box (n,l) with scaling function
        coefficients containing the point x.
     */
    def evaluate(curNode = (0,0), in x): real {
        const (n,_) = curNode;
        const child = s.get_children(curNode);
        if s.has_coeffs(curNode) {
            var p = phi(x, k);
            return inner(s[curNode], p)*sqrt(2.0**n);

        } else {
            if (2*x < 1) then
                return evaluate (child(1), 2*x);
            else
                return evaluate (child(2), 2*x-1);
        }
    }

    /** change from scaling function basis to multi-wavelet basis (s -> d)
        tree is filled out with s[0][0] and d
        n is level in tree
        l is box index
     */
    def compress(curNode = (0,0)) {
        if compressed then return;
        const (n,_) = curNode;
        const child = s.get_children(curNode);

        // sub-trees can be done in parallel
        if !s.has_coeffs(child(1)) then compress(child(1));
        if !s.has_coeffs(child(2)) then compress(child(2));

        var sc: [0..2*k-1] real;
        sc[0..k-1]   = s(child(1));
        sc[k..2*k-1] = s(child(2));

        // apply the two scale relationship to get difference coeff
        // in 1d this is O(k^2) flops (in 3d this is O(k^4) flops)
        var dc = sc*hgT;

        s[curNode] = dc[0..k-1];
        d[curNode] = dc[k..2*k-1];

        s.remove(child(1));
        s.remove(child(2));

        if n==0 then compressed = true;
    }

    /** change from multi-wavelet basis to scaling function basis (d -> s)
        tree just has s at leaves
        n is level in tree
        l is box index
     */
    def reconstruct(curNode = (0,0)) {
        if !compressed then return;
        const (n, _) = curNode;
        const child = s.get_children(curNode);

        if d.has_coeffs(curNode) {
            var dc: [0..2*k-1] real;
            dc[0..k-1]   = s[curNode];
            dc[k..2*k-1] = d[curNode];
            d.remove(curNode);
            s.remove(curNode);

            // apply the two scale relationship to get difference coeff
            // in 1d this is O(k^2) flops (in 3d this is O(k^4) flops)
            var sc = dc*hg;

            s[child(1)] = sc[0..k-1];
            s[child(2)] = sc[k..2*k-1];

            // sub-trees can be done in parallel
            reconstruct(child(1));
            reconstruct(child(2));
        }

        if n == 0 then compressed = false;
    }

    /** In s are scaling coefficients for box n,l ... apply twoscale to generate
        the corresponding coefficients on level n+1 and insert the results into
        the tree of scaling function coefficients.
     */
    def recur_down(curNode: 2*int) {
        const child = s.get_children(curNode);
        if debug then writeln(" + recur_down",curNode);

        var sc : [0..2*k-1] real;
        sc[0..k-1] = s[curNode];

        var new_sc = sc*hg;
        s(child(1)) = new_sc[0..k-1];
        s(child(2)) = new_sc[k..2*k-1];
    }

    /** If the scaling coefficeints in box n,l exist, return them.
        (allow here for zero boundary conditions for boxes just off
        the ends of the domain)

        Else recur up to the next level looking for a parent.  If a
        parent exists, use two scale to recur those coefficients down
        to make n,l.  Note that this modifies the tree in place and
        you should eventually call sclean to tidy up when finished.

        Else, return None (corresponding child boxes exist at a finer scale)
     */
    def get_coeffs(curNode: 2*int) {
        if debug then writeln(" @ get_coeffs",curNode);
        const (nCur, lCur) = curNode;
        var (n,l) = curNode;

        // Walk up the tree to find scaling coeffs
        while n >= 0 {
            if l < 0 || l >= 2**n {
                var coeffs : [0..k-1] real;
                return coeffs;
            }

            if s.has_coeffs((n, l)) then break;

            n -= 1;
            l  = l/2;
        }

        // Didn't find coeffs, they must be below curNode
        if n < 0 then return None;

        // Recur down to curNode
        for i in n..nCur-1 {
            l = lCur/(2**(nCur-i));
            recur_down((i, l));
        }

        return s[curNode];
    }

    /** Differentiation (also inner and mul) may leave scaling function
        coefficients below their original level.  Recur down to the
        locally first box with scaling function coefficients.
        Delete all children below there.
     */
    def sclean(curNode = (0,0), in cleaning=false) {
        const (n, _) = curNode;
        const child = s.get_children(curNode);
        if cleaning { //then
            if debug then writeln(" + sclean deleting ", curNode);
            s.remove(curNode);
        } else
            cleaning = s.has_coeffs(curNode);

        // Sub trees can run in parallel
        if n < max_level {
            if !cleaning || s.has_coeffs(child(1)) then
                sclean(child(1), cleaning);
            if !cleaning || s.has_coeffs(child(2)) then
                sclean(child(2), cleaning);
        }
    }

    /** Differentiate the function, which corresponds to application
        of a block triadiagonal matrix.  For an adaptively refined
        target function we may need to refine boxes down until three
        boxes exist in the same scale.
     */

  def diff() {
    def diffHelper(curNode = (0,0), result) {
        const (n,l) = curNode;
        const child = s.get_children(curNode);
        if debug then writeln(" * diff",curNode);
        if !s.has_coeffs(curNode) {
            // Sub trees can run in parallel
            // Run down tree until we hit scaling function coefficients
            diffHelper(child(1), result);
            diffHelper(child(2), result);
        } else {
            // These can also go in parallel since may involve
            // recurring up & down the tree.
            const neighbor = s.get_neighbors(curNode);
            if debug then writeln(" * diff: coeffs at ",curNode);
            var sm = get_coeffs(neighbor(1));
            var sp = get_coeffs(neighbor(2));
            var s0 = s[curNode];

            // We have s0, check if we found sm and sp at this level
            if !isNone(sm) && !isNone(sp) {
                var r = rp*sm + r0*s0 + rm*sp;
                result.s[curNode] = r * 2.0**n;
            } else {
                recur_down(curNode);
                // Sub trees can run in parallel
                diffHelper(child(1), result);
                diffHelper(child(2), result);
            }
        }
    }

    if compressed then reconstruct();
    var result = skeletonCopy();

    diffHelper((0, 0), result);

    sclean();
    return result;
  }

    /** Return sqrt(integral(f(x)**2))
     */
    def norm2() {
        if compressed then reconstruct();
        return sqrt(+ reduce [i in s] normf(i)**2);
    }

    /** Evaluate the analytic and numerical functions over the given interval
        and print the error.
     */
    def evalNPT(npt) {
        for i in 0..npt {
            var (fval, Fval) = (f(i/npt:real), this(i/npt:real));
            writeln(" -- ", toString("%0.2f", i/npt:real), ":  F_numeric()=", toString("% 0.8f", Fval),
                    "  f_analytic()=", toString("% 0.8f", fval), " err=", toString("% 0.1e", Fval-fval),
                    if abs(Fval-fval) > thresh then "  > thresh" else "");
        }
    }
}

// Copy matrix B's transpose into matrix A
def transposeCopy(A: [] real, B: [] real) where A.rank == 2 && B.rank == 2 {
    forall (i, j) in A.domain do
        A[i, j] = B[j, i];
}

// Vector-Matrix transformation
def *(V: [] real, M: [] real) where V.rank == 1 && M.rank == 2 {
    var R: [M.domain.dim(2)] real = 0.0;

    if V.domain.dim(1) != M.domain.dim(1) then
        halt("*: Vector and matrix dims must match");

    for (i, j) in M.domain do
        R[i] += V[j] * M[j, i];

    return R;
}

// Matrix-Vector multiplication
def *(M: [] real, V: [] real) where V.rank == 1 && M.rank == 2 {
    var R: [M.domain.dim(1)] real = 0.0;

    if V.domain.dim(1) != M.domain.dim(2) then
        halt("*: Vector and matrix dims must match");

    for (i, j) in M.domain do
        R[i] += V[j] * M[i, j];

    return R;
}

// Frobenius Norm -- 2-norm for Vectors
def normf(A) where A.rank == 1 {
    return sqrt(+ reduce A**2);
}

// Inner product of A and B
def inner(A, B) where A.rank == 1 && B.rank == 1 {
    return + reduce A*B;
}

/** Return Gauss-Legendre points for order k.
 */
def gl_getPoints(k: int) {
    var ret: [0..k-1] real;

    select k {
        when 1 do
            ret = (0.50000000000000000);
        when 2 do
            ret = (0.78867513459481287, 0.21132486540518713);
        when 3 do
            ret = (0.88729833462074170, 0.50000000000000000, 0.11270166537925830);
        when 4 do
            ret = (0.93056815579702623, 0.66999052179242813, 0.33000947820757187, 0.06943184420297371);
        when 5 do
            ret = (0.95308992296933193, 0.76923465505284150, 0.50000000000000000, 0.23076534494715845,
                    0.04691007703066802);
        when 6 do
            ret = (0.96623475710157603, 0.83060469323313224, 0.61930959304159849, 0.38069040695840156,
                    0.16939530676686776, 0.03376524289842397);
        when 7 do
            ret = (0.97455395617137930, 0.87076559279969723, 0.70292257568869854, 0.50000000000000000,
                    0.29707742431130141, 0.12923440720030277, 0.02544604382862070);
        when 8 do
            ret = (0.98014492824876809, 0.89833323870681336, 0.76276620495816450, 0.59171732124782495,
                    0.40828267875217511, 0.23723379504183550, 0.10166676129318664, 0.01985507175123191);
        when 9 do
            ret = (0.98408011975381304, 0.91801555366331788, 0.80668571635029518, 0.66212671170190451,
                    0.50000000000000000, 0.33787328829809554, 0.19331428364970482, 0.08198444633668206,
                    0.01591988024618696);
        when 10 do
            ret = (0.98695326425858587, 0.93253168334449232, 0.83970478414951222, 0.71669769706462361,
                    0.57443716949081558, 0.42556283050918442, 0.28330230293537639, 0.16029521585048778,
                    0.06746831665550773, 0.01304673574141413);
        when 11 do
            ret = (0.98911432907302843, 0.94353129988404771, 0.86507600278702468, 0.75954806460340585,
                    0.63477157797617245, 0.50000000000000000, 0.36522842202382755, 0.24045193539659410,
                    0.13492399721297532, 0.05646870011595234, 0.01088567092697151);
        otherwise
            halt("gl_getPoints: k=", k, " is out of bounds!");
    }

    return ret;
}

/** Return Gauss-Legendre weights for order k.
 */
def gl_getWeights(k: int) {
    var ret: [0..k-1] real;

    select k {
        when 1 do
            ret = (1.00000000000000000);
        when 2 do
            ret = (0.50000000000000011, 0.50000000000000011);
        when 3 do
            ret = (0.27777777777777751, 0.44444444444444442, 0.27777777777777751);
        when 4 do
            ret = (0.17392742256872701, 0.32607257743127305, 0.32607257743127305, 0.17392742256872701);
        when 5 do
            ret = (0.11846344252809465, 0.23931433524968321, 0.28444444444444444, 0.23931433524968321,
                    0.11846344252809465);
        when 6 do
            ret = (0.08566224618958508, 0.18038078652406936, 0.23395696728634546, 0.23395696728634546,
                    0.18038078652406936, 0.08566224618958508);
        when 7 do
            ret = (0.06474248308443417, 0.13985269574463832, 0.19091502525255946, 0.20897959183673470,
                    0.19091502525255946, 0.13985269574463832, 0.06474248308443417);
        when 8 do
            ret = (0.05061426814518921, 0.11119051722668717, 0.15685332293894369, 0.18134189168918102,
                    0.18134189168918102, 0.15685332293894369, 0.11119051722668717, 0.05061426814518921);
        when 9 do
            ret = (0.04063719418078738, 0.09032408034742866, 0.13030534820146775, 0.15617353852000135,
                    0.16511967750062989, 0.15617353852000135, 0.13030534820146775, 0.09032408034742841,
                    0.04063719418078738);
        when 10 do
            ret = (0.03333567215434403, 0.07472567457529021, 0.10954318125799088, 0.13463335965499817,
                    0.14776211235737641, 0.14776211235737641, 0.13463335965499817, 0.10954318125799088,
                    0.07472567457529021, 0.03333567215434403);
        when 11 do
            ret = (0.02783428355808731, 0.06279018473245226, 0.09314510546386703, 0.11659688229599521,
                    0.13140227225512346, 0.13646254338895031, 0.13140227225512346, 0.11659688229599521,
                    0.09314510546386703, 0.06279018473245226, 0.02783428355808731);
        otherwise
            halt("gl_getWeights: k=", k, " is out of bounds!");
    }

    return ret;
}

/** Read two scale coeffs from the input file.
 */
def hg_readCoeffs(inputfile) {
    var max_k: int;
    var coeffData = file(inputfile, path='./', mode='r');

    coeffData.open();
    coeffData.read(max_k);
    hg_MaxK = max_k;

    hg_coeffs.domain = [0..max_k, 0..2*max_k-1, 0..2*max_k-1];

    // hg_coeffs[0,..,..] is not used
    for i in 1..max_k {
        for (j, k) in [0..i*2-1, 0..i*2-1] {
            var x: real;
            coeffData.read(x);
            hg_coeffs[i, j, k] = x;
        }
    }

    coeffData.close();
}

/** Return maximum k.
 */
def hg_getMaxK(): int {
    return hg_MaxK;
}

/** Return the twoscale coefficients for the multiwavelets of order k.
 */
def hg_getCoeffs(k: int) {
    var kthCoeffs: [0..2*k-1, 0..2*k-1] real;
    // FIXME: Ideally I want to slice a 2d matrix out of the 3d matrix.
    //        Current copy code is a workaround.

    if k < 0 || k > hg_MaxK then
        halt("TwoScaleCoeffs.getCoeffs(): k=", k, " is out of bounds!");

    for (i, j) in kthCoeffs.domain do
        kthCoeffs(i, j) = hg_coeffs(k, i, j);

    return kthCoeffs;
}

/** Evaluate the Legendre polynomials up to the given order at x
    defined on [-1,1]

     * x       point at which to evaluate polynomials
     * order   max order of polynomials to evaluate
     * return  [] real first k polynomials evaluated at point x
 */
def pn(x: real, order: int) {
    var p: [0..order] real;

    p[0] = 1.0;
    if order == 0 then return p;
    p[1] = x;

    for n in 1..order-1 do
        p[n+1] = n*(x*p[n] - p[n-1])/(n+1) + x*p[n];
    return p;
}

/** Evaluate the shifted normalized Legendre polynomials up to the
    given order at x defined on [0,1].

    These are also our scaling functions, phi_i(x) , i=0..k-1

    In addition to forming an orthonormal basis on [0,1] we have
    phi_j(1/2-x) = (-1)^j phi_j(1/2+x)

    (the wavelets are similar with phase (-1)^(j+k)).

     * x       point at which to evaluate polynomials
     * k       evaluate first k polynomials
     * return  double[] first k polynomials evaluated at point x
 */
def phi(x: real, k: int) {
    var p: [0..k-1] real = 0.0;
    var order = k-1;

    if (!phi_initialized) {
        phi_norms.domain = [0..100);
        for n in phi_norms.domain do
            phi_norms[n] = sqrt(2.0*n+1);
    }

    p = pn(2.0*x-1.0, order);
    for n in 1..k-1 do
        p[n] = p[n]*phi_norms[n];
    return p;
}

_extern def snprintf(buf: string, size: int, fmt: string, vals...?numvals): string;

def toString(fmt: string, x) {
    var buf: string = "12345678901234567890123456789012345678901234567890";
    snprintf(buf, 50, fmt, x);
    return buf;
}

/** Sample analytic functions
 */

/** gaussian with square normalized to 1 */
class Fn_Test1: AFcn {
    def this(x: real): real {
        var a = 500.0;
        return (2*a/PI)**0.25 * exp(-a * (x-0.5)**2.0);
    }
};

/** derivative of test1 */
class Fn_dTest1: AFcn {
    def this(x: real): real {
        var a = 500.0;
        return -2.0*a*(x-0.5) * (2*a/PI) ** 0.25 * exp(-a * (x-0.5)**2.0);
    }
};

def main() {
    var npt = 10;

    writeln("Mad Chapel -- Differentiation Test\n");

    var fcn  : [1..1] AFcn = (Fn_Test1():AFcn);
    var dfcn : [1..1] AFcn = (Fn_dTest1():AFcn);

    hg_readCoeffs(hg_inputfile);
    for i in fcn.domain {
        writeln("** Testing function ", i);
        var F = Function(k=5, thresh=1e-5, f=fcn[i]);

        writeln("F", i, ".norm2() = ", F.norm2());

        if verbose {
            writeln("Evaluating F", i, " on [0, 1]:");
            F.evalNPT(npt);
            writeln();
        }

        writeln("Compressing F", i, " ...");
        F.compress();

        writeln("Reconstructing F", i, " ...");
        F.reconstruct();
        writeln("F", i, ".norm2() = ", F.norm2());

        writeln("Evaluating F", i, " on [0, 1]:");
        F.evalNPT(npt);

        writeln("\nDifferentiating F", i, " ...");
        var dF = F.diff();
        dF.f = dfcn[i]:AFcn; // Fudge it for the sake of evalNPT()

        writeln("\nEvaluating dF", i, " on [0, 1]:");
        dF.evalNPT(npt);

        if i < fcn.domain.dim(1).high then
            writeln("\n======================================================================\n");
    }
}

/** MRA -- MultiResolution Analysis Module

    Multiresolution representation of 1-d functions using a multiwavelet
    basis (similar to discontinuous spectral element with a hierarchal
    decomposition).

    Mad Chapel Author: James Dinan <dinan@cray.com>
                 Date: August, 2007

    This code is an adaptation of 1d Madness, originally written by Robert
    Harrison <harrisonrj@ornl.gov>, et al.
 */

use Math;

config const verbose = false;
config const debug   = false;
const PI = 3.14159265358979323846;

var None: [0..-1] real;

config const hg_inputfile = "hg_coeffs.dat";

var hg_MaxK   : int;
var hg_coeffs : [0..-1, 0..-1, 0..-1] real;
var phi_norms : [0..-1] real;
var phi_initialized = false;

class AFcn {
    def this(x: real): real {
        halt("Fn1d.f() is abstract and should not be called directly");
        return 0.0;
    }
}
record Coeff {
    var dom  : domain(1);
    var data : [dom] real;
}

// Check if we have None.
def isNone(x) {
    return x.numElements == 0;
}

class FTree {
    var order    : int;
    var coeffDom = [0..order-1];
    var idx_t    : 2*int;           // FIXME: Can't write domain(2*int)

    var indices  : domain(idx_t);   // Indexed by 2-tuples of integers
    var nodes    : [indices] Coeff; // Associative Mapping: (:int, :int) => Coeff

    var zeroes   : [coeffDom] real; // Return zeroes from this() when reading
                                    // something that has not yet been set.

    def initialize() {
        if order == 0 then
            halt("FTree must be initialized with an order > 0");
    }

    /** Access an element in the associative domain.  If the element
        doesn't exist it will be created.

        We have to be really careful about creating extra boxes when we don't
        mean to.  The algorithms tend to be really sensitive to the structure
        of the tree.  Scaling coefficients are used to mark the leaves in the
        sum tree, so if you accidentally create scaling coeffs somewhere in the
        middle of the tree you will short circuit a whole subtree!

     */
    def this(lvl: int, idx: int) var {
        if !indices.member((lvl, idx)) {
            if setter {
              indices += ((lvl, idx));
              nodes[(lvl, idx)] = Coeff(coeffDom);
            } else {
              // This is a getter so it shouldn't be modifying what
              // we return, should be safe to return the zero vector.
              // FIXME: Zeroes should really be a const, but can'ti
              //        return const from a var fcn.
              return zeroes;
            }
        }

        return nodes[(lvl, idx)].data;
    }

    def this((lvl, idx)) var {
        if !indices.member((lvl, idx)) {
            if setter {
              indices += ((lvl, idx));
              nodes[(lvl, idx)] = Coeff(coeffDom);
            } else {
              // This is a getter so it shouldn't be modifying what
              // we return, should be safe to return the zero vector.
              // FIXME: Zeroes should really be a const, but can'ti
              //        return const from a var fcn.
              return zeroes;
            }
        }

        return nodes[(lvl, idx)].data;
    }

    def get_children((lvl, idx)) {
        return ((lvl+1, 2*idx), (lvl+1, 2*idx+1));
    }

    def get_neighbors((lvl, idx)) {
        return ((lvl, idx-1), (lvl, idx+1));
    }

    /** Unordered iterator over all coefficients
     */
    def these() {
        for n in nodes yield n.data;
    }

    /** Check if there are coefficients in box (lvl, idx)
     */
    def has_coeffs((lvl, idx)) {
        return indices.member((lvl, idx));
    }

    /** Remove an element from the associative domain.  If the element
        does not exist, it is ignored.
     */
    def remove((lvl,idx)) {
        if indices.member((lvl, idx)) then indices.remove((lvl, idx));
    }
}

class Function {
    const k             = 5;    // use first k Legendre polynomials as the basis in each box
    const thresh        = 1e-5; // truncation threshold for small wavelet coefficients
    const f: AFcn       = nil;  // analytic f(x) to project into the numerical represntation
    const initial_level = 2;    // initial level of refinement
    const max_level     = 30;   // maximum level of refinement mostly as a sanity check
    var   autorefine    = true; // automatically refine during multiplication
    var   compressed    = false;// keep track of what basis we are in

    // Sum and Difference coefficients
    var   s = FTree(order=k);
    var   d = FTree(order=k);

    // FIXME: Ideally all of these matrices should be const as well but they
    //        can't be presently since they must be assigned in initialize()

    // Two-Scale relationship matrices
    const hgDom = [0..2*k-1, 0..2*k-1];
    var   hg    : [hgDom] real; // FIXME: hg  =  hg_getCoeffs(k);
    var   hgT   : [hgDom] real; //        hgT => transpose(hg);

    // Quadrature coefficients
    const quadDom   = [0..k-1];
    var   quad_x    : [quadDom] real; // points
    var   quad_w    : [quadDom] real; // weights

    const quad_phiDom = [0..k-1, 0..k-1];
    var   quad_phi    : [quad_phiDom] real; // phi[point,i]
    var   quad_phiT   : [quad_phiDom] real; // phi[point,i] transpose
    var   quad_phiw   : [quad_phiDom] real; // phi[point,i]*weight[point]

    // blocks of the block tridiagonal derivative operator
    const dcDom = [0..k-1, 0..k-1];
    var   rm    : [dcDom] real;
    var   r0    : [dcDom] real;
    var   rp    : [dcDom] real;

    def initialize() {
        if debug then writeln("Creating Function: k=", k, " thresh=", thresh);

        if debug then writeln("  initializing two-scale relation coefficients");
        hg  = hg_getCoeffs(k);
        transposeCopy(hgT, hg);

        if debug then writeln("  initializing quadrature coefficients");
        init_quadrature(k);

        // blocks of the block tridiagonal derivative operator
        if debug then writeln("  initializing tridiagonal derivative operator");
        make_dc_periodic();

        // initial refinement of analytic function f(x)
        if f != nil {
            if debug then writeln("  performing initial refinement of f(x)");
            for l in 0..2**initial_level-1 do
                refine((initial_level, l));
        }

        if debug then writeln("done.");
    }

    /** Initialize the quadrature coefficient matricies.
     */
    def init_quadrature(order: int) {
        quad_x   = gl_getPoints(k);
        quad_w   = gl_getWeights(k);

        for i in quad_phiDom.dim(1) {
            var p = phi(quad_x[i], k);
            quad_phi [i..i, ..] = p;            // FIXME: quad_phi [i, ..] = p;
            quad_phiw[i..i, ..] = quad_w[i] * p;//        quad_phiw[i, ..] = ...;
            quad_phiT[.., i..i] = p;
        }
    }

    /** Return the level-0 blocks rm, r0, rp of the central
        difference derivative operator with periodic boundary
        conditions on either side.
     */
    def make_dc_periodic() {
        var iphase = 1.0;
        for i in dcDom.dim(1) {
            var jphase = 1.0;

            for j in dcDom.dim(2) {
                var gammaij = sqrt((2*i+1) * (2*j+1));
                var Kij = if (i-j) > 0 && ((i-j) % 2) == 1 then
                        2.0 else 0.0;
                r0[i,j] = 0.5*(1.0 - iphase*jphase - 2.0*Kij)*gammaij;
                rm[i,j] = 0.5*jphase*gammaij;
                rp[i,j] =-0.5*iphase*gammaij;
                jphase = -jphase;
            }
            iphase = -iphase;
        }
    }

    /** Return a copy of this function's skeleton
     */
    def skeletonCopy() {
        // Omit: f, compressed, s, d
        return Function(k=k, thresh=thresh, initial_level=initial_level,
                max_level=max_level, autorefine=autorefine);
    }

    /** s[n, l] = integral(phi[n][l](x) * f(x))
        for box (n,l) project f(x) using quadrature rule
        into scaling function basis
     */
    def project(curNode: 2*int) {
        const (n, l) = curNode;
        var s     : [quadDom] real;
        var h     = 0.5 ** n;
        var scale = sqrt(h);

        for mu in quad_phiDom.dim(1) {
            var x  = (l + quad_x[mu]) * h;
            var fx = f(x);
            for i in quad_phiDom.dim(2) do
                s[i] += scale * fx * quad_phiw[mu, i];
        }

        return s;
    }

    /** Refine numerical representation of f(x) to desired tolerance
     */
    def refine(curNode: 2*int) {
        // project f(x) at next level
        const (n, _ ) = curNode;
        const child = s.get_children(curNode);
        var sc : [0..2*k-1] real;
        var s0 : [0..k-1] => sc[0..k-1];
        var s1 : [0..k-1] => sc[k..2*k-1];

        s0 = project(child(1));
        s1 = project(child(2));

        // apply the two scale relationship to get difference coeff
        // in 1d this is O(k^2) flops
        var dc = sc*hgT;

        // check to see if within tolerance
        // normf() is Frobenius norm == 2-norm for vectors
        var nf = normf(dc[k..2*k-1]);
        if((nf < thresh) || (n >= (max_level-1))) {
            s[child(1)] = s0;
            s[child(2)] = s1;
        }
        else {
            // these recursive calls on sub-trees can go in parallel
            // if the HashMap is syncronized
            refine(child(1));
            refine(child(2));
        }
    }

    /** Evaluate numerical representation of f at x.  Performed in scaling
        function basis only.
     */
    def this(x) {
        if compressed then reconstruct();
        return evaluate( (0,0), x);
    }

    /** eval f(x) using adaptively refined numerical representation of f(x)
        answer should be within tolerance of the analytical f(x)

        Descend tree looking for box (n,l) with scaling function
        coefficients containing the point x.
     */
    def evaluate(curNode = (0,0), in x): real {
        const (n,_) = curNode;
        const child = s.get_children(curNode);
        if s.has_coeffs(curNode) {
            var p = phi(x, k);
            return inner(s[curNode], p)*sqrt(2.0**n);

        } else {
            if (2*x < 1) then
                return evaluate (child(1), 2*x);
            else
                return evaluate (child(2), 2*x-1);
        }
    }

    /** change from scaling function basis to multi-wavelet basis (s -> d)
        tree is filled out with s[0][0] and d
        n is level in tree
        l is box index
     */
    def compress(curNode = (0,0)) {
        if compressed then return;
        const (n,_) = curNode;
        const child = s.get_children(curNode);

        // sub-trees can be done in parallel
        if !s.has_coeffs(child(1)) then compress(child(1));
        if !s.has_coeffs(child(2)) then compress(child(2));

        var sc: [0..2*k-1] real;
        sc[0..k-1]   = s(child(1));
        sc[k..2*k-1] = s(child(2));

        // apply the two scale relationship to get difference coeff
        // in 1d this is O(k^2) flops (in 3d this is O(k^4) flops)
        var dc = sc*hgT;

        s[curNode] = dc[0..k-1];
        d[curNode] = dc[k..2*k-1];

        s.remove(child(1));
        s.remove(child(2));

        if n==0 then compressed = true;
    }

    /** change from multi-wavelet basis to scaling function basis (d -> s)
        tree just has s at leaves
        n is level in tree
        l is box index
     */
    def reconstruct(curNode = (0,0)) {
        if !compressed then return;
        const (n, _) = curNode;
        const child = s.get_children(curNode);

        if d.has_coeffs(curNode) {
            var dc: [0..2*k-1] real;
            dc[0..k-1]   = s[curNode];
            dc[k..2*k-1] = d[curNode];
            d.remove(curNode);
            s.remove(curNode);

            // apply the two scale relationship to get difference coeff
            // in 1d this is O(k^2) flops (in 3d this is O(k^4) flops)
            var sc = dc*hg;

            s[child(1)] = sc[0..k-1];
            s[child(2)] = sc[k..2*k-1];

            // sub-trees can be done in parallel
            reconstruct(child(1));
            reconstruct(child(2));
        }

        if n == 0 then compressed = false;
    }

    /** In s are scaling coefficients for box n,l ... apply twoscale to generate
        the corresponding coefficients on level n+1 and insert the results into
        the tree of scaling function coefficients.
     */
    def recur_down(curNode: 2*int) {
        const child = s.get_children(curNode);
        if debug then writeln(" + recur_down",curNode);

        var sc : [0..2*k-1] real;
        sc[0..k-1] = s[curNode];

        var new_sc = sc*hg;
        s(child(1)) = new_sc[0..k-1];
        s(child(2)) = new_sc[k..2*k-1];
    }

    /** If the scaling coefficeints in box n,l exist, return them.
        (allow here for zero boundary conditions for boxes just off
        the ends of the domain)

        Else recur up to the next level looking for a parent.  If a
        parent exists, use two scale to recur those coefficients down
        to make n,l.  Note that this modifies the tree in place and
        you should eventually call sclean to tidy up when finished.

        Else, return None (corresponding child boxes exist at a finer scale)
     */
    def get_coeffs(curNode: 2*int) {
        if debug then writeln(" @ get_coeffs",curNode);
        const (nCur, lCur) = curNode;
        var (n,l) = curNode;

        // Walk up the tree to find scaling coeffs
        while n >= 0 {
            if l < 0 || l >= 2**n {
                var coeffs : [0..k-1] real;
                return coeffs;
            }

            if s.has_coeffs((n, l)) then break;

            n -= 1;
            l  = l/2;
        }

        // Didn't find coeffs, they must be below curNode
        if n < 0 then return None;

        // Recur down to curNode
        for i in n..nCur-1 {
            l = lCur/(2**(nCur-i));
            recur_down((i, l));
        }

        return s[curNode];
    }

    /** Differentiation (also inner and mul) may leave scaling function
        coefficients below their original level.  Recur down to the
        locally first box with scaling function coefficients.
        Delete all children below there.
     */
    def sclean(curNode = (0,0), in cleaning=false) {
        const (n, _) = curNode;
        const child = s.get_children(curNode);
        if cleaning { //then
            if debug then writeln(" + sclean deleting ", curNode);
            s.remove(curNode);
        } else
            cleaning = s.has_coeffs(curNode);

        // Sub trees can run in parallel
        if n < max_level {
            if !cleaning || s.has_coeffs(child(1)) then
                sclean(child(1), cleaning);
            if !cleaning || s.has_coeffs(child(2)) then
                sclean(child(2), cleaning);
        }
    }

    /** Differentiate the function, which corresponds to application
        of a block triadiagonal matrix.  For an adaptively refined
        target function we may need to refine boxes down until three
        boxes exist in the same scale.
     */

  def diff() {
    def diffHelper(curNode = (0,0), result) {
        const (n,l) = curNode;
        const child = s.get_children(curNode);
        if debug then writeln(" * diff",curNode);
        if !s.has_coeffs(curNode) {
            // Sub trees can run in parallel
            // Run down tree until we hit scaling function coefficients
            diffHelper(child(1), result);
            diffHelper(child(2), result);
        } else {
            // These can also go in parallel since may involve
            // recurring up & down the tree.
            const neighbor = s.get_neighbors(curNode);
            if debug then writeln(" * diff: coeffs at ",curNode);
            var sm = get_coeffs(neighbor(1));
            var sp = get_coeffs(neighbor(2));
            var s0 = s[curNode];

            // We have s0, check if we found sm and sp at this level
            if !isNone(sm) && !isNone(sp) {
                var r = rp*sm + r0*s0 + rm*sp;
                result.s[curNode] = r * 2.0**n;
            } else {
                recur_down(curNode);
                // Sub trees can run in parallel
                diffHelper(child(1), result);
                diffHelper(child(2), result);
            }
        }
    }

    if compressed then reconstruct();
    var result = skeletonCopy();

    diffHelper((0, 0), result);

    sclean();
    return result;
  }

    /** Return sqrt(integral(f(x)**2))
     */
    def norm2() {
        if compressed then reconstruct();
        return sqrt(+ reduce [i in s] normf(i)**2);
    }

    /** Evaluate the analytic and numerical functions over the given interval
        and print the error.
     */
    def evalNPT(npt) {
        for i in 0..npt {
            var (fval, Fval) = (f(i/npt:real), this(i/npt:real));
            writeln(" -- ", toString("%0.2f", i/npt:real), ":  F_numeric()=", toString("% 0.8f", Fval),
                    "  f_analytic()=", toString("% 0.8f", fval), " err=", toString("% 0.1e", Fval-fval),
                    if abs(Fval-fval) > thresh then "  > thresh" else "");
        }
    }
}

// Copy matrix B's transpose into matrix A
def transposeCopy(A: [] real, B: [] real) where A.rank == 2 && B.rank == 2 {
    forall (i, j) in A.domain do
        A[i, j] = B[j, i];
}

// Vector-Matrix transformation
def *(V: [] real, M: [] real) where V.rank == 1 && M.rank == 2 {
    var R: [M.domain.dim(2)] real = 0.0;

    if V.domain.dim(1) != M.domain.dim(1) then
        halt("*: Vector and matrix dims must match");

    for (i, j) in M.domain do
        R[i] += V[j] * M[j, i];

    return R;
}

// Matrix-Vector multiplication
def *(M: [] real, V: [] real) where V.rank == 1 && M.rank == 2 {
    var R: [M.domain.dim(1)] real = 0.0;

    if V.domain.dim(1) != M.domain.dim(2) then
        halt("*: Vector and matrix dims must match");

    for (i, j) in M.domain do
        R[i] += V[j] * M[i, j];

    return R;
}

// Frobenius Norm -- 2-norm for Vectors
def normf(A) where A.rank == 1 {
    return sqrt(+ reduce A**2);
}

// Inner product of A and B
def inner(A, B) where A.rank == 1 && B.rank == 1 {
    return + reduce A*B;
}

/** Return Gauss-Legendre points for order k.
 */
def gl_getPoints(k: int) {
    var ret: [0..k-1] real;

    select k {
        when 1 do
            ret = (0.50000000000000000);
        when 2 do
            ret = (0.78867513459481287, 0.21132486540518713);
        when 3 do
            ret = (0.88729833462074170, 0.50000000000000000, 0.11270166537925830);
        when 4 do
            ret = (0.93056815579702623, 0.66999052179242813, 0.33000947820757187, 0.06943184420297371);
        when 5 do
            ret = (0.95308992296933193, 0.76923465505284150, 0.50000000000000000, 0.23076534494715845,
                    0.04691007703066802);
        when 6 do
            ret = (0.96623475710157603, 0.83060469323313224, 0.61930959304159849, 0.38069040695840156,
                    0.16939530676686776, 0.03376524289842397);
        when 7 do
            ret = (0.97455395617137930, 0.87076559279969723, 0.70292257568869854, 0.50000000000000000,
                    0.29707742431130141, 0.12923440720030277, 0.02544604382862070);
        when 8 do
            ret = (0.98014492824876809, 0.89833323870681336, 0.76276620495816450, 0.59171732124782495,
                    0.40828267875217511, 0.23723379504183550, 0.10166676129318664, 0.01985507175123191);
        when 9 do
            ret = (0.98408011975381304, 0.91801555366331788, 0.80668571635029518, 0.66212671170190451,
                    0.50000000000000000, 0.33787328829809554, 0.19331428364970482, 0.08198444633668206,
                    0.01591988024618696);
        when 10 do
            ret = (0.98695326425858587, 0.93253168334449232, 0.83970478414951222, 0.71669769706462361,
                    0.57443716949081558, 0.42556283050918442, 0.28330230293537639, 0.16029521585048778,
                    0.06746831665550773, 0.01304673574141413);
        when 11 do
            ret = (0.98911432907302843, 0.94353129988404771, 0.86507600278702468, 0.75954806460340585,
                    0.63477157797617245, 0.50000000000000000, 0.36522842202382755, 0.24045193539659410,
                    0.13492399721297532, 0.05646870011595234, 0.01088567092697151);
        otherwise
            halt("gl_getPoints: k=", k, " is out of bounds!");
    }

    return ret;
}

/** Return Gauss-Legendre weights for order k.
 */
def gl_getWeights(k: int) {
    var ret: [0..k-1] real;

    select k {
        when 1 do
            ret = (1.00000000000000000);
        when 2 do
            ret = (0.50000000000000011, 0.50000000000000011);
        when 3 do
            ret = (0.27777777777777751, 0.44444444444444442, 0.27777777777777751);
        when 4 do
            ret = (0.17392742256872701, 0.32607257743127305, 0.32607257743127305, 0.17392742256872701);
        when 5 do
            ret = (0.11846344252809465, 0.23931433524968321, 0.28444444444444444, 0.23931433524968321,
                    0.11846344252809465);
        when 6 do
            ret = (0.08566224618958508, 0.18038078652406936, 0.23395696728634546, 0.23395696728634546,
                    0.18038078652406936, 0.08566224618958508);
        when 7 do
            ret = (0.06474248308443417, 0.13985269574463832, 0.19091502525255946, 0.20897959183673470,
                    0.19091502525255946, 0.13985269574463832, 0.06474248308443417);
        when 8 do
            ret = (0.05061426814518921, 0.11119051722668717, 0.15685332293894369, 0.18134189168918102,
                    0.18134189168918102, 0.15685332293894369, 0.11119051722668717, 0.05061426814518921);
        when 9 do
            ret = (0.04063719418078738, 0.09032408034742866, 0.13030534820146775, 0.15617353852000135,
                    0.16511967750062989, 0.15617353852000135, 0.13030534820146775, 0.09032408034742841,
                    0.04063719418078738);
        when 10 do
            ret = (0.03333567215434403, 0.07472567457529021, 0.10954318125799088, 0.13463335965499817,
                    0.14776211235737641, 0.14776211235737641, 0.13463335965499817, 0.10954318125799088,
                    0.07472567457529021, 0.03333567215434403);
        when 11 do
            ret = (0.02783428355808731, 0.06279018473245226, 0.09314510546386703, 0.11659688229599521,
                    0.13140227225512346, 0.13646254338895031, 0.13140227225512346, 0.11659688229599521,
                    0.09314510546386703, 0.06279018473245226, 0.02783428355808731);
        otherwise
            halt("gl_getWeights: k=", k, " is out of bounds!");
    }

    return ret;
}

/** Read two scale coeffs from the input file.
 */
def hg_readCoeffs(inputfile) {
    var max_k: int;
    var coeffData = file(inputfile, path='./', mode='r');

    coeffData.open();
    coeffData.read(max_k);
    hg_MaxK = max_k;

    hg_coeffs.domain = [0..max_k, 0..2*max_k-1, 0..2*max_k-1];

    // hg_coeffs[0,..,..] is not used
    for i in 1..max_k {
        for (j, k) in [0..i*2-1, 0..i*2-1] {
            var x: real;
            coeffData.read(x);
            hg_coeffs[i, j, k] = x;
        }
    }

    coeffData.close();
}

/** Return maximum k.
 */
def hg_getMaxK(): int {
    return hg_MaxK;
}

/** Return the twoscale coefficients for the multiwavelets of order k.
 */
def hg_getCoeffs(k: int) {
    var kthCoeffs: [0..2*k-1, 0..2*k-1] real;
    // FIXME: Ideally I want to slice a 2d matrix out of the 3d matrix.
    //        Current copy code is a workaround.

    if k < 0 || k > hg_MaxK then
        halt("TwoScaleCoeffs.getCoeffs(): k=", k, " is out of bounds!");

    for (i, j) in kthCoeffs.domain do
        kthCoeffs(i, j) = hg_coeffs(k, i, j);

    return kthCoeffs;
}

/** Evaluate the Legendre polynomials up to the given order at x
    defined on [-1,1]

     * x       point at which to evaluate polynomials
     * order   max order of polynomials to evaluate
     * return  [] real first k polynomials evaluated at point x
 */
def pn(x: real, order: int) {
    var p: [0..order] real;

    p[0] = 1.0;
    if order == 0 then return p;
    p[1] = x;

    for n in 1..order-1 do
        p[n+1] = n*(x*p[n] - p[n-1])/(n+1) + x*p[n];
    return p;
}

/** Evaluate the shifted normalized Legendre polynomials up to the
    given order at x defined on [0,1].

    These are also our scaling functions, phi_i(x) , i=0..k-1

    In addition to forming an orthonormal basis on [0,1] we have
    phi_j(1/2-x) = (-1)^j phi_j(1/2+x)

    (the wavelets are similar with phase (-1)^(j+k)).

     * x       point at which to evaluate polynomials
     * k       evaluate first k polynomials
     * return  double[] first k polynomials evaluated at point x
 */
def phi(x: real, k: int) {
    var p: [0..k-1] real = 0.0;
    var order = k-1;

    if (!phi_initialized) {
        phi_norms.domain = [0..100);
        for n in phi_norms.domain do
            phi_norms[n] = sqrt(2.0*n+1);
    }

    p = pn(2.0*x-1.0, order);
    for n in 1..k-1 do
        p[n] = p[n]*phi_norms[n];
    return p;
}

_extern def snprintf(buf: string, size: int, fmt: string, vals...?numvals): string;

def toString(fmt: string, x) {
    var buf: string = "12345678901234567890123456789012345678901234567890";
    snprintf(buf, 50, fmt, x);
    return buf;
}

/** Sample analytic functions
 */

/** gaussian with square normalized to 1 */
class Fn_Test1: AFcn {
    def this(x: real): real {
        var a = 500.0;
        return (2*a/PI)**0.25 * exp(-a * (x-0.5)**2.0);
    }
};

/** derivative of test1 */
class Fn_dTest1: AFcn {
    def this(x: real): real {
        var a = 500.0;
        return -2.0*a*(x-0.5) * (2*a/PI) ** 0.25 * exp(-a * (x-0.5)**2.0);
    }
};

def main() {
    var npt = 10;

    writeln("Mad Chapel -- Differentiation Test\n");

    var fcn  : [1..1] AFcn = (Fn_Test1():AFcn);
    var dfcn : [1..1] AFcn = (Fn_dTest1():AFcn);

    hg_readCoeffs(hg_inputfile);
    for i in fcn.domain {
        writeln("** Testing function ", i);
        var F = Function(k=5, thresh=1e-5, f=fcn[i]);

        writeln("F", i, ".norm2() = ", F.norm2());

        if verbose {
            writeln("Evaluating F", i, " on [0, 1]:");
            F.evalNPT(npt);
            writeln();
        }

        writeln("Compressing F", i, " ...");
        F.compress();

        writeln("Reconstructing F", i, " ...");
        F.reconstruct();
        writeln("F", i, ".norm2() = ", F.norm2());

        writeln("Evaluating F", i, " on [0, 1]:");
        F.evalNPT(npt);

        writeln("\nDifferentiating F", i, " ...");
        var dF = F.diff();
        dF.f = dfcn[i]:AFcn; // Fudge it for the sake of evalNPT()

        writeln("\nEvaluating dF", i, " on [0, 1]:");
        dF.evalNPT(npt);

        if i < fcn.domain.dim(1).high then
            writeln("\n======================================================================\n");
    }
}


fix test so readf can halt on format error without error=

writeln("RE TESTS");
var f = openmem();
var w = f.writer();
w.write("Baz9xzz");
w.close();

var r = f.reader();
var str:string;
var ok:bool;
var error:syserr;

writeln("#1 not match");
ok = r.readf("%/[a-z]/");
writeln(r.offset(), " ", ok);
writeln("#2 passes B, should match");
ok = r.readf("%/[A-Z]/");
writeln(r.offset(), " ", ok);
writeln("#3 captures az, should match");
ok = r.readf("%/([a-z]+)/", str);
writeln(r.offset(), " ", ok, ":", str);
writeln("#4 should not match");
ok = r.readf("%/(0-9)/", str, error=error);
writeln(r.offset(), " ", ok);
writeln("#5 captures 9, should match");
ok = r.readf("%/([0-9])/", str);
writeln(r.offset(), " ", ok, ":", str);
writeln("#6 passes x, should match");
{
  var re = compile("x");
  ok = r.readf("%/*/", re);
  writeln(r.offset(), " ", ok);
}
writeln("#7 captures zz, should match");
{
  var re = compile("(z+)");
  ok = r.readf("%/*/", re, str);
  writeln(r.offset(), " ", ok, ":", str);
}

writeln("RE TESTS");
var f = openmem();
var w = f.writer();
w.write("Baz9xzz");
w.close();

var r = f.reader();
var str:string;
var ok:bool;

writeln("#1 not match");
ok = r.readf("%/[a-z]/");
writeln(r.offset(), " ", ok);
writeln("#2 passes B, should match");
ok = r.readf("%/[A-Z]/");
writeln(r.offset(), " ", ok);
writeln("#3 captures az, should match");
ok = r.readf("%/([a-z]+)/", str);
writeln(r.offset(), " ", ok, ":", str);
writeln("#4 should not match");
ok = r.readf("%/(0-9)/", str);
writeln(r.offset(), " ", ok);
writeln("#5 captures 9, should match");
ok = r.readf("%/([0-9])/", str);
writeln(r.offset(), " ", ok, ":", str);
writeln("#6 passes x, should match");
{
  var re = compile("x");
  ok = r.readf("%/*/", re);
  writeln(r.offset(), " ", ok);
}
writeln("#7 captures zz, should match");
{
  var re = compile("(z+)");
  ok = r.readf("%/*/", re, str);
  writeln(r.offset(), " ", ok, ":", str);
}


update make

update make

use Logging, Memory, IO, Partitions, Time;

config const default_lfh_size: uint = 1024 * 64;
config const max_doc_node_size = 1024 * 64;

type DocId = int(64);

class DocumentNode {

  // controls the size of this document list
  var listSize: int = 1;

  var next: DocumentNode;

  // list of documents
  var documents: [0..listSize-1] DocId;

  // number of documents in this node's list
  var documentCount: atomic int;

  // Gets the document id index to use to add a new document id.  documentCount should be incremented after using this index.
  proc documentIdIndex() {
    return documents.size - documentCount.read() - 1;
  }

  proc nextDocumentIdNodeSize() {
    if (documents.size >= max_doc_node_size) {
      return documents.size;
    } else {
      return documents.size * 2;
    }
  }
}

record TableEntry {
  var hashKey: atomic uint;
  var word: string;
  var count: atomic int;
  var docNode: DocumentNode;
}

class LockFreeHash {
  var hashSize: uint = 1024 * 64; // must be power of 2

  var array: [0..hashSize-1] TableEntry;

  proc addWord(word: string): bool {
    var hashKey: uint = genHashKey32(word);
    var idx: uint = hashKey;
    var count = 0;

    debug("word: ", word, " count: ", count);

    while (count < array.size) {
      idx &= hashSize - 1;

      debug("idx: ", idx);

      var probedKey = array[idx].hashKey.read();
      debug("probedKey: ", probedKey);
      if (probedKey != hashKey || array[idx].word != word) {
        // The entry was either free, or contains another key.
        if (probedKey != 0) {
          idx += 1;
          count += 1;
          continue; // Usually, it contains another key. Keep probing.
        }

        // The entry was free. Now let's try to take it using a CAS.
        var stored = array[idx].hashKey.compareExchange(0, hashKey);
        debug("stored: ", stored);
        if (!stored) {
          idx += 1;
          count += 1;
          continue;       // Another thread just stole it from underneath us.
        }

        // Either we just added the key, or another thread did.

        array[idx].word = word;
      }

      // Store the value in this array entry.
      // array[idx].value.write(value);
      return true;
    }

    if (count == array.size) {
      // out of capacity
      error("hash out of capacity");
    }

    return false;
  }

  proc getEntry(word: string, ref entry: TableEntry): bool {
    var count = 0;

    debug("word: ", word, "count ", count);

    var hashKey: uint = genHashKey(word);
    var idx: uint = hashKey;

    while (count < array.size) {
      idx &= hashSize - 1;

      var probedKey = array[idx].hashKey.read();
      if (probedKey == hashKey && array[idx].word == word) {
        debug("found match for hashKey");
        entry = array[idx];
        return true;
      }
      if (probedKey == 0) {
        return false;
      }

      idx += 1;
      count += 1;

      debug("probedKey: ", probedKey, " count: ", count);
    }

    debug("exhuastive search and key not found");

    return false;
  }
}

class PartitionInfo {
  var words: LockFreeHash = new LockFreeHash(default_lfh_size);
  var count: atomic int;
}

class WordIndex {
  var wordIndex: [0..Partitions.size-1] PartitionInfo;

  proc WordIndex() {
    for i in wordIndex.domain {
      on Partitions[i] {
        wordIndex[i] = new PartitionInfo();
      }
    }
  }

  proc addWord(word: string, docId: DocId) {
    var partition = partitionForWord(word);
    var info = wordIndex[partition];
    on info {
      // find word in word list
      var entry: TableEntry;
      var found = info.words.getEntry(word, entry);

      // if word is not present then add it
      if (found) {
        var added = info.words.addWord(word);
        if (!added) {
          error("could not add word ", word);
        }
        found = info.words.getEntry(word, entry);
      }

      if (found) {
        // add document to word node

        // increment counters
        entry.count.add(1);
        info.count.add(1);
      }
    }
  }
}

proc main() {
  initPartitions();

  var wordIndex = new WordIndex();

  var t: Timer;
  t.start();

  var infile = open("words.txt", iomode.r);
  var reader = infile.reader();
  var word: string;
  var docId = 0;
  while (reader.readln(word)) {
    wordIndex.addWord(word, docId);
    docId = (docId + 1) % 1000; // fake document ids
  }

  t.stop();
  timing("indexing complete in ",t.elapsed(TimeUnits.microseconds), " microseconds");
}

use Logging, Memory, IO, Partitions, Time;

config const default_lfh_size: uint(32) = 1024 * 64;
config const max_doc_node_size = 1024 * 64;

type DocId = int(64);

class DocumentNode {

  // controls the size of this document list
  var listSize: int = 1;

  var next: DocumentNode;

  // list of documents
  var documents: [0..listSize-1] DocId;

  // number of documents in this node's list
  var documentCount: atomic int;

  // Gets the document id index to use to add a new document id.  documentCount should be incremented after using this index.
  proc documentIdIndex() {
    return documents.size - documentCount.read() - 1;
  }

  proc nextDocumentIdNodeSize() {
    if (documents.size >= max_doc_node_size) {
      return documents.size;
    } else {
      return documents.size * 2;
    }
  }
}

record TableEntry {
  var hashKey: atomic uint(32);
  var word: string;
  var count: atomic int;
  var docNode: DocumentNode;
}

class LockFreeHash {
  var hashSize: uint(32) = 1024 * 64; // must be power of 2

  var array: [0..hashSize-1] TableEntry;

  proc addWord(word: string): bool {
    var hashKey: uint(32) = genHashKey32(word);
    var idx: uint(32) = hashKey;
    var count = 0;

    debug("word: ", word, " count: ", count);

    while (count < array.size) {
      idx &= hashSize - 1;

      debug("idx: ", idx);

      var probedKey = array[idx].hashKey.read();
      debug("probedKey: ", probedKey);
      if (probedKey != hashKey || array[idx].word != word) {
        // The entry was either free, or contains another key.
        if (probedKey != 0) {
          idx += 1;
          count += 1;
          continue; // Usually, it contains another key. Keep probing.
        }

        // The entry was free. Now let's try to take it using a CAS.
        var stored = array[idx].hashKey.compareExchange(0, hashKey);
        debug("stored: ", stored);
        if (!stored) {
          idx += 1;
          count += 1;
          continue;       // Another thread just stole it from underneath us.
        }

        // Either we just added the key, or another thread did.

        array[idx].word = word;
      }

      // Store the value in this array entry.
      // array[idx].value.write(value);
      return true;
    }

    if (count == array.size) {
      // out of capacity
      error("hash out of capacity");
    }

    return false;
  }

  proc getEntry(word: string, ref entry: TableEntry): bool {
    var count = 0;

    debug("word: ", word, "count ", count);

    var hashKey: uint(32) = genHashKey32(word);
    var idx: uint(32) = hashKey;

    while (count < array.size) {
      idx &= hashSize - 1;

      var probedKey = array[idx].hashKey.read();
      if (probedKey == hashKey && array[idx].word == word) {
        debug("found match for hashKey");
        entry = array[idx];
        return true;
      }
      if (probedKey == 0) {
        return false;
      }

      idx += 1;
      count += 1;

      debug("probedKey: ", probedKey, " count: ", count);
    }

    debug("exhuastive search and key not found");

    return false;
  }
}

class PartitionInfo {
  var words: LockFreeHash = new LockFreeHash(default_lfh_size);
  var count: atomic int;
}

class WordIndex {
  var wordIndex: [0..Partitions.size-1] PartitionInfo;

  proc WordIndex() {
    for i in wordIndex.domain {
      on Partitions[i] {
        wordIndex[i] = new PartitionInfo();
      }
    }
  }

  proc addWord(word: string, docId: DocId) {
    var partition = partitionForWord(word);
    var info = wordIndex[partition];
    on info {
      // find word in word list
      var entry: TableEntry;
      var found = info.words.getEntry(word, entry);

      // if word is not present then add it
      if (found) {
        var added = info.words.addWord(word);
        if (!added) {
          error("could not add word ", word);
        }
        found = info.words.getEntry(word, entry);
      }

      if (found) {
        // add document to word node

        // increment counters
        entry.count.add(1);
        info.count.add(1);
      }
    }
  }
}

proc main() {
  initPartitions();

  var wordIndex = new WordIndex();

  var t: Timer;
  t.start();

  var infile = open("words.txt", iomode.r);
  var reader = infile.reader();
  var word: string;
  var docId = 0;
  while (reader.readln(word)) {
    wordIndex.addWord(word, docId);
    docId = (docId + 1) % 1000; // fake document ids
  }

  t.stop();
  timing("indexing complete in ",t.elapsed(TimeUnits.microseconds), " microseconds");
}


Printing out a single error message instead of a overwhelming amount

config const n = 100;
config const debug = false;

var f = openmem();
var r = f.reader(kind=ionative);
var w = f.writer();

var numChars = 0;
for i in 1..n {
  for j in 1..#i do w.write(j%10);
  w.writeln();
  numChars += i + 1;
}

var data : [1..numChars] uint(8);

var total : int = 0;
for i in 1..n {
  var numRead : int;
  r.readline(data, numRead, total+1);
  total += numRead;
}

var base = 1;
var numWrong = 0;
for i in 1..n {
  for j in 1..#i do
    if data[base+j-1]-48 != (j%10) then numWrong += 1;
  if data[base+i] != 0x0A then numWrong += 1;
  base += i+1;
}
if numWrong != 0 then writeln(numWrong, " out of ", numChars, " were read incorrectly");

if total != numChars then writeln("FAILURE: read ", total, ", but expected ", numChars);
else writeln("SUCCESS");

config const n = 100;
config const debug = false;

var f = openmem();
var r = f.reader(kind=ionative);
var w = f.writer();

var numChars = 0;
for i in 1..n {
  for j in 1..#i do w.write(j%10);
  w.writeln();
  numChars += i + 1;
}

var data : [1..numChars] uint(8);

var total : int = 0;
for i in 1..n {
  var numRead : int;
  r.readline(data, numRead, total+1);
  total += numRead;
}

var base = 1;
for i in 1..n {
  for j in 1..#i do
    if data[base+j-1]-48 != (j%10) then writeln("FAILED CHAR: got ", data[base+j-1]-48, " but expected ", j%10);
  if data[base+i] != 0x0A then writeln("FAILED NEWLINE");
  base += i+1;
}

if total != numChars then writeln("FAILURE: read ", total, ", but expected ", numChars);
else writeln("SUCCESS");


Checking in a few fixes to the blockLU in MatrixOps.
Made the IterateByBlocks iterator more general so that it
works for ranges other than 1..n.  Defined a constant for
zero that is the same type as the elements of A.  This
constant is used to test for a zero pivot.

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

iterator MMIterator(D1, D2) {
  for j in D2.dim(2) do
    for (k1,k2) in (D1.dim(2),D2.dim(1)) do
      for i in D1.dim(1) do
        yield (i,j,k1,k2);
}

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);
  const zero = 0.0:A.eltType;

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

    var A1 => A[UnfactoredInds,CurrentBlockInds];
    var A2 => A[UnfactoredInds,TrailingBlockInds];
    var A21 => A[TrailingBlockInds,CurrentBlockInds];
    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) != zero) {
        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 -= A21*A12.
    for (i,j,k1,k2) in MMIterator(A21.domain,A12.domain) {
      A22(i,j) -= A21(i,k1)*A12(k2,j);
    }
  }
}

iterator IterateByBlocks(D:range,blksize) {
  var end = D.high;
  var hi: int;

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

iterator MMIterator(D1, D2) {
  for j in D2.dim(2) do
    for (k1,k2) in (D1.dim(2),D2.dim(1)) do
      for i in D1.dim(1) do
        yield (i,j,k1,k2);
}

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 A21 => A[TrailingBlockInds,CurrentBlockInds];
    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 -= A21*A12.
    for (i,j,k1,k2) in MMIterator(A21.domain,A12.domain) {
      A22(i,j) -= A21(i,k1)*A12(k2,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);
  }
}


Minor tweak, found a spelling error in a comment so I fixed it.

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

// ChapelTaskTable.chpl
//
pragma "no use ChapelStandard"
module ChapelTaskTable {

  use ChapelBase;
  use ChapelIO;
  use ChapelArray;
  use DefaultRectangular;
  use DefaultAssociative;

  /*
     This code keeps track of tasks, their state, and where they
     spawned from.

     The task information is used to generate a task report (optionally
     displayed when the user Ctrl+C's out of the program).

     The type chpl_taskID_t is a primitive type defined in the include
     files for each tasking layer.

  */

  // Define a few operations over chpl_taskID_t
  inline proc ==(a: chpl_taskID_t, b: chpl_taskID_t)
    return __primitive("==", a, b);
  inline proc _cast(type t, x: chpl_taskID_t) where _isPrimitiveType(t)
    return __primitive("cast", t, x);

  enum taskState { pending, active, suspended };
  _ensure_reference_type(taskState);

  //
  // This represents a currently running task.  The state, lineno, and
  // filename members should be obvious; tl_info is information belonging
  // to the tasking layer.
  //
  // If we included the parent in this, the print method could topologically
  // sort the tasks and indent to show the parent/child relationships, which
  // might be very nice.
  //
  record chpldev_Task {
    var state     : taskState;
    var lineno    : uint(32);
    var filename  : string;
    var tl_info   : uint(64);
  }

  class chpldev_taskTable_t {
    var dom : domain(chpl_taskID_t, parSafe=false);
    var map : [dom] chpldev_Task;
  }

  pragma "private"
  var chpldev_taskTable : chpldev_taskTable_t;

  //----------------------------------------------------------------------{
  //- Code to initialize the task table on each locale.
  //-
  proc chpldev_taskTable_init() {
    // Doing this in parallel should be safe as long as this module is
    // initialized late (after DefaultRectangular and most other
    // internal modules are already initialized)
    coforall loc in Locales ref(chpldev_taskTable) do on loc {
      chpldev_taskTable = new chpldev_taskTable_t();
    }
  }

  extern var taskreport: int(32);
  if taskreport then chpldev_taskTable_init();

  //-
  //----------------------------------------------------------------------}

  ////////////////////////////////////////////////////////////////////////{
  //
  // Exported task table code.
  //
  // In general, tasks may have been created before the task table was
  // initialized.
  // In that case, operations may be attempted on the task table using
  // taskIDs that are unknown to it.  That is why we check
  // for membership on all operations.
  //
  ////////////////////////////////////////////////////////////////////////}

  export proc chpldev_taskTable_add(taskID   : chpl_taskID_t,
                                    lineno   : uint(32),
                                    filename : string,
                                    tl_info  : uint(64))
  {
    if (chpldev_taskTable == nil) then return;

    if (!chpldev_taskTable.dom.member(taskID)) then
      // This must be serial, because if add() results in parallelism
      // (due to _resize), it may lead to deadlock (due to reentry
      // into the runtime tasking layer for task table operations).
      serial true do
        chpldev_taskTable.dom.add(taskID);

    chpldev_taskTable.map[taskID] = new chpldev_Task(taskState.pending,
                                                 lineno, filename, tl_info);
  }

  export proc chpldev_taskTable_remove(taskID : chpl_taskID_t)
  {
    if (chpldev_taskTable == nil ||
        !chpldev_taskTable.dom.member(taskID)) then return;

    // This must be serial, because if remove() results in parallelism
    // (due to _resize), it may lead to deadlock (due to reentry into
    // the runtime tasking layer for task table operations).
    serial true do
      chpldev_taskTable.dom.remove(taskID);
  }

  export proc chpldev_taskTable_set_active(taskID : chpl_taskID_t)
  {
    if (chpldev_taskTable == nil ||
        !chpldev_taskTable.dom.member(taskID)) then return;

    chpldev_taskTable.map[taskID].state = taskState.active;
  }

  export proc chpldev_taskTable_set_suspended(taskID : chpl_taskID_t)
  {
    if (chpldev_taskTable == nil ||
        !chpldev_taskTable.dom.member(taskID)) then return;

    chpldev_taskTable.map[taskID].state = taskState.suspended;
  }

  export proc chpldev_taskTable_get_tl_info(taskID : chpl_taskID_t)
  {
    if (chpldev_taskTable == nil ||
        !chpldev_taskTable.dom.member(taskID)) then return 0:uint(64);

    return chpldev_taskTable.map[taskID].tl_info;
  }

  export proc chpldev_taskTable_print()
  {
    if (chpldev_taskTable == nil) then return;

    for taskID in chpldev_taskTable.dom {
      stderr.writeln("- ", chpldev_taskTable.map[taskID].filename,
                     ":",  chpldev_taskTable.map[taskID].lineno,
                     " is ", chpldev_taskTable.map[taskID].state);
    }
  }

}

// ChapelTaskTable.chpl
//
pragma "no use ChapelStandard"
module ChapelTaskTable {

  use ChapelBase;
  use ChapelIO;
  use ChapelArray;
  use DefaultRectangular;
  use DefaultAssociative;

  /*
     This code keeps track of tasks, their state, and where they
     spawned from.

     The task information is used to generate a task report (optionally
     displayed when the user Ctrl+C's out of the program).

     The type chpl_taskID_t is a primitve type defined in the include
     files for each tasking layer.

  */

  // Define a few operations over chpl_taskID_t
  inline proc ==(a: chpl_taskID_t, b: chpl_taskID_t)
    return __primitive("==", a, b);
  inline proc _cast(type t, x: chpl_taskID_t) where _isPrimitiveType(t)
    return __primitive("cast", t, x);

  enum taskState { pending, active, suspended };
  _ensure_reference_type(taskState);

  //
  // This represents a currently running task.  The state, lineno, and
  // filename members should be obvious; tl_info is information belonging
  // to the tasking layer.
  //
  // If we included the parent in this, the print method could topologically
  // sort the tasks and indent to show the parent/child relationships, which
  // might be very nice.
  //
  record chpldev_Task {
    var state     : taskState;
    var lineno    : uint(32);
    var filename  : string;
    var tl_info   : uint(64);
  }

  class chpldev_taskTable_t {
    var dom : domain(chpl_taskID_t, parSafe=false);
    var map : [dom] chpldev_Task;
  }

  pragma "private"
  var chpldev_taskTable : chpldev_taskTable_t;

  //----------------------------------------------------------------------{
  //- Code to initialize the task table on each locale.
  //-
  proc chpldev_taskTable_init() {
    // Doing this in parallel should be safe as long as this module is
    // initialized late (after DefaultRectangular and most other
    // internal modules are already initialized)
    coforall loc in Locales ref(chpldev_taskTable) do on loc {
      chpldev_taskTable = new chpldev_taskTable_t();
    }
  }

  extern var taskreport: int(32);
  if taskreport then chpldev_taskTable_init();

  //-
  //----------------------------------------------------------------------}

  ////////////////////////////////////////////////////////////////////////{
  //
  // Exported task table code.
  //
  // In general, tasks may have been created before the task table was
  // initialized.
  // In that case, operations may be attempted on the task table using
  // taskIDs that are unknown to it.  That is why we check
  // for membership on all operations.
  //
  ////////////////////////////////////////////////////////////////////////}

  export proc chpldev_taskTable_add(taskID   : chpl_taskID_t,
                                    lineno   : uint(32),
                                    filename : string,
                                    tl_info  : uint(64))
  {
    if (chpldev_taskTable == nil) then return;

    if (!chpldev_taskTable.dom.member(taskID)) then
      // This must be serial, because if add() results in parallelism
      // (due to _resize), it may lead to deadlock (due to reentry
      // into the runtime tasking layer for task table operations).
      serial true do
        chpldev_taskTable.dom.add(taskID);

    chpldev_taskTable.map[taskID] = new chpldev_Task(taskState.pending,
                                                 lineno, filename, tl_info);
  }

  export proc chpldev_taskTable_remove(taskID : chpl_taskID_t)
  {
    if (chpldev_taskTable == nil ||
        !chpldev_taskTable.dom.member(taskID)) then return;

    // This must be serial, because if remove() results in parallelism
    // (due to _resize), it may lead to deadlock (due to reentry into
    // the runtime tasking layer for task table operations).
    serial true do
      chpldev_taskTable.dom.remove(taskID);
  }

  export proc chpldev_taskTable_set_active(taskID : chpl_taskID_t)
  {
    if (chpldev_taskTable == nil ||
        !chpldev_taskTable.dom.member(taskID)) then return;

    chpldev_taskTable.map[taskID].state = taskState.active;
  }

  export proc chpldev_taskTable_set_suspended(taskID : chpl_taskID_t)
  {
    if (chpldev_taskTable == nil ||
        !chpldev_taskTable.dom.member(taskID)) then return;

    chpldev_taskTable.map[taskID].state = taskState.suspended;
  }

  export proc chpldev_taskTable_get_tl_info(taskID : chpl_taskID_t)
  {
    if (chpldev_taskTable == nil ||
        !chpldev_taskTable.dom.member(taskID)) then return 0:uint(64);

    return chpldev_taskTable.map[taskID].tl_info;
  }

  export proc chpldev_taskTable_print()
  {
    if (chpldev_taskTable == nil) then return;

    for taskID in chpldev_taskTable.dom {
      stderr.writeln("- ", chpldev_taskTable.map[taskID].filename,
                     ":",  chpldev_taskTable.map[taskID].lineno,
                     " is ", chpldev_taskTable.map[taskID].state);
    }
  }

}


Add _defaultOf for inits, reals, and imags.

// Types.chpl
//
// Standard type routines.
//

//
// type predicates
//
proc chpl__isType(type t) param return true;
proc chpl__isType(e) param return false;

pragma "no instantiation limit"
proc _isPrimitiveType(type t) param return
  _isBooleanType(t)  ||
  _isIntegralType(t) ||
  _isRealType(t)     ||
//To allow imag, need to define casts from primitive types into imag.
//_isImagType(t)     ||
  (t == c_string);

pragma "no instantiation limit"
proc _isSimpleScalarType(type t) param return
  _isBooleanType(t) | _isIntegralType(t) | _isFloatType(t);

pragma "no instantiation limit"
proc _isBooleanType(type t) param return
  (t == bool) | (t == bool(8)) | (t == bool(16)) | (t == bool(32)) | (t == bool(64));

pragma "no instantiation limit"
proc _isIntegralType(type t) param return
  _isSignedType(t) || _isUnsignedType(t);

pragma "no instantiation limit"
proc _isSignedType(type t) param return
  (t == int(8)) || (t == int(16)) || (t == int(32)) || (t == int(64));

pragma "no instantiation limit"
proc _isUnsignedType(type t) param return
  (t == uint(8)) || (t == uint(16)) || (t == uint(32)) || (t == uint(64));

proc _isEnumeratedType(type t) param {
  proc isEnum(type t: enumerated) param return true;
  proc isEnum(type t) param return false;
  return isEnum(t);
}

pragma "no instantiation limit"
proc _isComplexType(type t) param return
  (t == complex(64)) | (t == complex(128));

pragma "no instantiation limit"
proc _isFloatType(type t) param return
  (t == real(32)) | (t == real(64)) |
  (t == imag(32)) | (t == imag(64));

pragma "no instantiation limit"
proc _isRealType(type t) param return
  (t == real(32)) | (t == real(64));

pragma "no instantiation limit"
proc _isImagType(type t) param return
  (t == imag(32)) | (t == imag(64));

// Returns the unsigned equivalent of the input type.
proc chpl__unsignedType(type t) type
{
  if ! _isIntegralType(t) then
    compilerError("range idxType is non-integral: ", typeToString(t));

  return uint(numBits(t));
}

// Returns the signed equivalent of the input type.
proc chpl__signedType(type t) type
{
  if ! _isIntegralType(t) then
    compilerError("range idxType is non-integral: ", typeToString(t));

  return int(numBits(t));
}

proc chpl__maxIntTypeSameSign(type t) type {
  if ! _isIntegralType(t) then
    compilerError("type t is non-integral: ", typeToString(t));

  if (_isSignedType(t)) then
    return int(64);
  else
    return uint(64);
}

//
// These procedures indicate whether or not a type t is a specific type
//
proc isRangeType(type t) param where   t: range  return true;
proc isRangeType(type t) param where !(t: range) return false;

proc isDmapType(type t) param where   t: _distribution  return true;
proc isDmapType(type t) param where !(t: _distribution) return false;

proc isDomainType(type t) param where   t: _domain  return true;
proc isDomainType(type t) param where !(t: _domain) return false;

proc isArrayType(type t) param where   t: _array  return true;
proc isArrayType(type t) param where !(t: _array) return false;

// Is 'sub' a subtype (or equal to) 'super'?
proc isSubtype(type sub, type super) param where   sub: super  return true;
proc isSubtype(type sub, type super) param where !(sub: super) return false;

// Is 'sub' a proper subtype of 'super'?
proc isProperSubtype(type sub, type super) param
  where isSubtype(sub, super) && sub != super
  return true;
proc isProperSubtype(type sub, type super) param
  return false;

// What follows are the type _defaultOf methods, used to initialize types
// Booleans
inline proc _defaultOf(type t) param where (_isBooleanType(t)) return false:t;

// ints, reals, imags
inline proc _defaultOf(type t) param where (_isIntegralType(t)) return 0:t;
// TODO: In order to make _defaultOf param for reals and imags we had to split
// the cases into their default size and a non-param case.  It is hoped that
// in the future, floating point numbers may be castable whilst param.  In that
// world, we can again shrink these calls into the size-ignorant case.
inline proc _defaultOf(type t) param where t == real(64) return 0.0:t;
inline proc _defaultOf(type t) where (_isRealType(t) && t != real(64)) return 0.0:t;
inline proc _defaultOf(type t) param where t == imag(64) return 0.0i:t;
inline proc _defaultOf(type t) where (_isImagType(t) && t != imag(64)) return 0.0i:t;

// Returns true if it is legal to coerce t1 to t2, false otherwise.
proc chpl__legalIntCoerce(type t1, type t2) param
{
  if (_isSignedType(t2)) {
    if (_isSignedType(t1)) {
      return (numBits(t1) <= numBits(t2));
    } else {
      return (numBits(t1) < numBits(t2));
    }
  } else {
    if (_isSignedType(t1)) {
      return false;
    } else {
      return (numBits(t1) <= numBits(t2));
    }
  }
}

// Returns the type with which both s and t are compatible
// That is, both s and t can be coerced to the returned type.
proc chpl__commonType(type s, type t) type
{
  if ! _isIntegralType(s) then
    compilerError("Type ", typeToString(s) , " is non-integral: ");
  if ! _isIntegralType(t) then
    compilerError("Type ", typeToString(t) , " is non-integral: ");

  if numBits(s) > numBits(t) then return s;
  if numBits(s) < numBits(t) then return t;

  if _isSignedType(s) && ! _isSignedType(t) ||
     _isSignedType(t) && ! _isSignedType(s) then
    compilerError("Types ", typeToString(s) , " and ", typeToString(t), " are incompatible.");

  return s;
}

//
// numBits(type) -- returns the number of bits in a type
//

proc numBits(type t) param where t == bool {
  compilerError("default-width 'bool' does not have a well-defined size");
}
proc numBits(type t) param where t == bool(8) return 8;
proc numBits(type t) param where t == bool(16) return 16;
proc numBits(type t) param where t == bool(32) return 32;
proc numBits(type t) param where t == bool(64) return 64;
proc numBits(type t) param where t == int(8) return 8;
proc numBits(type t) param where t == int(16) return 16;
proc numBits(type t) param where t == int(32) return 32;
proc numBits(type t) param where t == int(64) return 64;
proc numBits(type t) param where t == uint(8) return 8;
proc numBits(type t) param where t == uint(16) return 16;
proc numBits(type t) param where t == uint(32) return 32;
proc numBits(type t) param where t == uint(64) return 64;
proc numBits(type t) param where t == real(32) return 32;
proc numBits(type t) param where t == real(64) return 64;
proc numBits(type t) param where t == imag(32) return 32;
proc numBits(type t) param where t == imag(64) return 64;
proc numBits(type t) param where t == complex(64) return 64;
proc numBits(type t) param where t == complex(128) return 128;

//
// numBytes(type) -- returns the number of bytes in a type
//

param bitsPerByte = 8;

proc numBytes(type t) param return numBits(t)/8;

//
// min(type) -- returns the minimum value a type can store
//

proc min(type t) where t == bool
  return false;

proc min(type t) where _isIntegralType(t) || _isFloatType(t)
  return __primitive( "_min", t);

proc min(type t) where _isComplexType(t) {
  var x: t;
  x.re = min(x.re.type);
  x.im = min(x.im.type);
  return x;
}

//
// max(type) -- returns the maximum value a type can store
//

proc max(type t) where t == bool
  return true;

proc max(type t) where _isIntegralType(t) || _isFloatType(t)
  return __primitive( "_max", t);

proc max(type t) where _isComplexType(t) {
  var x: t;
  x.re = max(x.re.type);
  x.im = max(x.im.type);
  return x;
}

iter chpl_enumerate(type t: enumerated) {
  const enumTuple = _enum_enumerate(t);
  for i in 1..enumTuple.size do
    yield enumTuple(i);
}

proc enum_minbits(type t: enumerated) param {
  return __primitive( "enum min bits", t);
}
proc enum_issigned(type t: enumerated) param {
  return __primitive( "enum is signed", t);
}
proc enum_mintype(type t: enumerated) type {
  param minbits = enum_minbits(t);
  param signed = enum_issigned(t);
  if signed {
    return int(minbits);
  } else {
    return uint(minbits);
  }
}

proc numBits(type t: enumerated) param {
  return numBits(enum_mintype(t));
}

//
// identity functions (for reductions)
//
inline proc _prod_id(type t) return 1:t;
inline proc _land_id(type t) return true;
inline proc _lor_id(type t) return false;
inline proc _lxor_id(type t) return false;
inline proc _band_id(type t) {
  // MPF - this doesn't really make sense for floating-point types,
  // but old code had it casting MAX_UINT to the same type...
  // I just moved it from the code generator since we don't need
  // a primitive to generate constants.
  if t == bool then return true;
  if t == int(8) then return -1:t;
  if t == int(16) then return -1:t;
  if t == int(32) then return -1:t;
  if t == int(64) then return -1:t;
  if t == real(32) then return max(uint(32)):t;
  if t == real(64) then return max(uint(64)):t;
  if t == imag(32) then return max(uint(32)):t;
  if t == imag(64) then return max(uint(64)):t;
  if t == complex(64) then return (max(uint(32)):real(32), max(uint(32)):real(32)):t;
  if t == complex(128) then return (max(uint(64)):real(64), max(uint(64)):real(64)):t;
  return max(t);
}
inline proc _bor_id(type t) return 0:t;
inline proc _bxor_id(type t) return 0:t;

// Types.chpl
//
// Standard type routines.
//

//
// type predicates
//
proc chpl__isType(type t) param return true;
proc chpl__isType(e) param return false;

pragma "no instantiation limit"
proc _isPrimitiveType(type t) param return
  _isBooleanType(t)  ||
  _isIntegralType(t) ||
  _isRealType(t)     ||
//To allow imag, need to define casts from primitive types into imag.
//_isImagType(t)     ||
  (t == c_string);

pragma "no instantiation limit"
proc _isSimpleScalarType(type t) param return
  _isBooleanType(t) | _isIntegralType(t) | _isFloatType(t);

pragma "no instantiation limit"
proc _isBooleanType(type t) param return
  (t == bool) | (t == bool(8)) | (t == bool(16)) | (t == bool(32)) | (t == bool(64));

pragma "no instantiation limit"
proc _isIntegralType(type t) param return
  _isSignedType(t) || _isUnsignedType(t);

pragma "no instantiation limit"
proc _isSignedType(type t) param return
  (t == int(8)) || (t == int(16)) || (t == int(32)) || (t == int(64));

pragma "no instantiation limit"
proc _isUnsignedType(type t) param return
  (t == uint(8)) || (t == uint(16)) || (t == uint(32)) || (t == uint(64));

proc _isEnumeratedType(type t) param {
  proc isEnum(type t: enumerated) param return true;
  proc isEnum(type t) param return false;
  return isEnum(t);
}

pragma "no instantiation limit"
proc _isComplexType(type t) param return
  (t == complex(64)) | (t == complex(128));

pragma "no instantiation limit"
proc _isFloatType(type t) param return
  (t == real(32)) | (t == real(64)) |
  (t == imag(32)) | (t == imag(64));

pragma "no instantiation limit"
proc _isRealType(type t) param return
  (t == real(32)) | (t == real(64));

pragma "no instantiation limit"
proc _isImagType(type t) param return
  (t == imag(32)) | (t == imag(64));

// Returns the unsigned equivalent of the input type.
proc chpl__unsignedType(type t) type
{
  if ! _isIntegralType(t) then
    compilerError("range idxType is non-integral: ", typeToString(t));

  return uint(numBits(t));
}

// Returns the signed equivalent of the input type.
proc chpl__signedType(type t) type
{
  if ! _isIntegralType(t) then
    compilerError("range idxType is non-integral: ", typeToString(t));

  return int(numBits(t));
}

proc chpl__maxIntTypeSameSign(type t) type {
  if ! _isIntegralType(t) then
    compilerError("type t is non-integral: ", typeToString(t));

  if (_isSignedType(t)) then
    return int(64);
  else
    return uint(64);
}

//
// These procedures indicate whether or not a type t is a specific type
//
proc isRangeType(type t) param where   t: range  return true;
proc isRangeType(type t) param where !(t: range) return false;

proc isDmapType(type t) param where   t: _distribution  return true;
proc isDmapType(type t) param where !(t: _distribution) return false;

proc isDomainType(type t) param where   t: _domain  return true;
proc isDomainType(type t) param where !(t: _domain) return false;

proc isArrayType(type t) param where   t: _array  return true;
proc isArrayType(type t) param where !(t: _array) return false;

// Is 'sub' a subtype (or equal to) 'super'?
proc isSubtype(type sub, type super) param where   sub: super  return true;
proc isSubtype(type sub, type super) param where !(sub: super) return false;

// Is 'sub' a proper subtype of 'super'?
proc isProperSubtype(type sub, type super) param
  where isSubtype(sub, super) && sub != super
  return true;
proc isProperSubtype(type sub, type super) param
  return false;

// What follows are the type _defaultOf methods, used to initialize types
// Booleans
inline proc _defaultOf(type t) param where (_isBooleanType(t)) return false:t;

// Returns true if it is legal to coerce t1 to t2, false otherwise.
proc chpl__legalIntCoerce(type t1, type t2) param
{
  if (_isSignedType(t2)) {
    if (_isSignedType(t1)) {
      return (numBits(t1) <= numBits(t2));
    } else {
      return (numBits(t1) < numBits(t2));
    }
  } else {
    if (_isSignedType(t1)) {
      return false;
    } else {
      return (numBits(t1) <= numBits(t2));
    }
  }
}

// Returns the type with which both s and t are compatible
// That is, both s and t can be coerced to the returned type.
proc chpl__commonType(type s, type t) type
{
  if ! _isIntegralType(s) then
    compilerError("Type ", typeToString(s) , " is non-integral: ");
  if ! _isIntegralType(t) then
    compilerError("Type ", typeToString(t) , " is non-integral: ");

  if numBits(s) > numBits(t) then return s;
  if numBits(s) < numBits(t) then return t;

  if _isSignedType(s) && ! _isSignedType(t) ||
     _isSignedType(t) && ! _isSignedType(s) then
    compilerError("Types ", typeToString(s) , " and ", typeToString(t), " are incompatible.");

  return s;
}

//
// numBits(type) -- returns the number of bits in a type
//

proc numBits(type t) param where t == bool {
  compilerError("default-width 'bool' does not have a well-defined size");
}
proc numBits(type t) param where t == bool(8) return 8;
proc numBits(type t) param where t == bool(16) return 16;
proc numBits(type t) param where t == bool(32) return 32;
proc numBits(type t) param where t == bool(64) return 64;
proc numBits(type t) param where t == int(8) return 8;
proc numBits(type t) param where t == int(16) return 16;
proc numBits(type t) param where t == int(32) return 32;
proc numBits(type t) param where t == int(64) return 64;
proc numBits(type t) param where t == uint(8) return 8;
proc numBits(type t) param where t == uint(16) return 16;
proc numBits(type t) param where t == uint(32) return 32;
proc numBits(type t) param where t == uint(64) return 64;
proc numBits(type t) param where t == real(32) return 32;
proc numBits(type t) param where t == real(64) return 64;
proc numBits(type t) param where t == imag(32) return 32;
proc numBits(type t) param where t == imag(64) return 64;
proc numBits(type t) param where t == complex(64) return 64;
proc numBits(type t) param where t == complex(128) return 128;

//
// numBytes(type) -- returns the number of bytes in a type
//

param bitsPerByte = 8;

proc numBytes(type t) param return numBits(t)/8;

//
// min(type) -- returns the minimum value a type can store
//

proc min(type t) where t == bool
  return false;

proc min(type t) where _isIntegralType(t) || _isFloatType(t)
  return __primitive( "_min", t);

proc min(type t) where _isComplexType(t) {
  var x: t;
  x.re = min(x.re.type);
  x.im = min(x.im.type);
  return x;
}

//
// max(type) -- returns the maximum value a type can store
//

proc max(type t) where t == bool
  return true;

proc max(type t) where _isIntegralType(t) || _isFloatType(t)
  return __primitive( "_max", t);

proc max(type t) where _isComplexType(t) {
  var x: t;
  x.re = max(x.re.type);
  x.im = max(x.im.type);
  return x;
}

iter chpl_enumerate(type t: enumerated) {
  const enumTuple = _enum_enumerate(t);
  for i in 1..enumTuple.size do
    yield enumTuple(i);
}

proc enum_minbits(type t: enumerated) param {
  return __primitive( "enum min bits", t);
}
proc enum_issigned(type t: enumerated) param {
  return __primitive( "enum is signed", t);
}
proc enum_mintype(type t: enumerated) type {
  param minbits = enum_minbits(t);
  param signed = enum_issigned(t);
  if signed {
    return int(minbits);
  } else {
    return uint(minbits);
  }
}

proc numBits(type t: enumerated) param {
  return numBits(enum_mintype(t));
}

//
// identity functions (for reductions)
//
inline proc _prod_id(type t) return 1:t;
inline proc _land_id(type t) return true;
inline proc _lor_id(type t) return false;
inline proc _lxor_id(type t) return false;
inline proc _band_id(type t) {
  // MPF - this doesn't really make sense for floating-point types,
  // but old code had it casting MAX_UINT to the same type...
  // I just moved it from the code generator since we don't need
  // a primitive to generate constants.
  if t == bool then return true;
  if t == int(8) then return -1:t;
  if t == int(16) then return -1:t;
  if t == int(32) then return -1:t;
  if t == int(64) then return -1:t;
  if t == real(32) then return max(uint(32)):t;
  if t == real(64) then return max(uint(64)):t;
  if t == imag(32) then return max(uint(32)):t;
  if t == imag(64) then return max(uint(64)):t;
  if t == complex(64) then return (max(uint(32)):real(32), max(uint(32)):real(32)):t;
  if t == complex(128) then return (max(uint(64)):real(64), max(uint(64)):real(64)):t;
  return max(t);
}
inline proc _bor_id(type t) return 0:t;
inline proc _bxor_id(type t) return 0:t;


Removing a module (accidentally) used twice

Probably the resulted of a merge.

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