# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Class(SKLR_Vx1i, SIMD_ISA, rec(

    includes     := () -> ["<stdlib.h>"] :: _MM_MALLOC(),
    active       := true,
    ctype        := "char",
    instr        := [],
    bits         := 1,
    isFloat      := false,
    isFixedPoint := false,
    splopts      := rec(),
    alignment    := 8,

    autolib := rec(
        includes := () -> ["<include/sp_bits.h>"],
        includesTimer := () -> [],
    ),

    _op_load_u  := abstract(),
    _op_bcast   := abstract(),
    _op_store_u := abstract(),

    dupload  := (self, y, x) >> Checked(ObjId(x)=nth, # NOTE: is there a better way?
	let(base := x.loc,
	    ofs  := x.idx,
	    v    := self.v,
	    xvec := Cond(IsUnalignedPtrT(base.t), self._op_load_u(base, idiv(ofs,v)*v, v),
		         vtref(self.t, base, idiv(ofs, v))),
	    assign(y, self._op_bcast(xvec, imod(ofs, v))))),

    svload := [ [ ], # load using subvecs of len 1
                [ ], # load using subvecs of len 2
                [ ], # load using subvecs of len 4
    ],

    svstore := [ [ ], # store using subvecs of len 1
                 [ ], # store using subvecs of len 2
                 [ ], # store using subvecs of len 4
    ],

    # keep the n lower scalars and zero the other ones
    mask_l := (self, c, n) >> Cond( n = self.v, c,
        bin_and(c, self.val(Replicate(n, 1) :: Replicate(self.v - n, 0)))),
    mask_h := (self, c, n) >> Cond( n = self.v, c,
        bin_and(c, self.val(Replicate(n, 0) :: Replicate(self.v - n, 1)))),

    loadCont := (self, n, y, yofs, x, xofs, xofs_align, opts) >> let(
	a  := _unwrap(xofs_align),
	nn := _unwrap(n),
	yy := vtref(self.t, y, yofs),
	m  := x -> self.mask_l(x, nn),
	Cond(a = 0 and not IsUnalignedPtrT(x.t),
	         assign(yy, m(vtref(self.t, x, xofs/self.v))),

	     # known alignment, sv is small, so that we only need 1 aligned load + 1 shift + mask
	     ((IsInt(a) and (nn <= self.v - a)) or nn=1) and not IsUnalignedPtrT(x.t),
		 let(v1 := vtref(self.t, x, idiv(xofs, self.v)),
		     assign(yy, m(bin_shr(v1, a)))),

	     # known alignment, sv covers 2 vectors, 2 aligned loads + 2 shifts + mask
	     # NB: no masking is needed because shifts will do the job
	     IsInt(a) and not IsUnalignedPtrT(x.t),
		 let(v1 := vtref(self.t, x, (xofs - a)/self.v),
		     v2 := vtref(self.t, x, (xofs - a)/self.v + 1),
		     assign(yy, m(bin_or(bin_shr(v1, a), bin_shl(v2, self.v - a))))),
             # else, unknown alignment, use unaligned load
             assign(yy, self._op_load_u(x, xofs, nn))
        )
    ),

    storeCont := (self, n, y, yofs, yofs_align, x, xofs, opts) >> let(
	a  := _unwrap(yofs_align),
	nn := _unwrap(n),
	xx := vtref(self.t, x, xofs),
	yy := vtref(self.t, y, yofs/self.v),
	Cond(nn = self.v and a = 0 and not IsUnalignedPtrT(y.t),
	        assign(yy, xx),
	     #else
	        self._op_store_u(y, yofs, xx, nn))),

    rotate_left := (self, shift) >> ((y, x) -> assign(vtref(self.t, y, 0), rCyclicShift(vtref(self.t, x, 0), shift, self.v))),

    kswap := (self, y, x, k, mask) >> let( u := var.fresh_t("U", self.t),
                                         chain(assign( u, bin_and(bin_xor(x, bin_shr(x, 2^(k-1))), self.t.value(mask))),
                                               assign( y, bin_xor(bin_xor(x, u), bin_shl(u, 2^(k-1)))))),

    kexch := (self, y1, y2, x1, x2, mask) >> let( u := var.fresh_t("U", self.t),
                                         chain(assign(  u, bin_and(bin_xor(x1, x2), self.t.value(mask))),
                                               assign( y1, bin_xor(x1, u)),
                                               assign( y2, bin_xor(x2, u)))),
));

Class(SKLR_16x1i, SKLR_Vx1i, rec(
    # countrec below is invalid
    countrec := rec(
        ops := [
            [add, sub],
	    [mul],
            [sklr_bcast_16x1i], # shuffles
            [sklr_loadu_16x1i, sklr_storeu_16x1i],
            [deref],
            Value      # Value without [] is a keyword in countOps !!
        ],
        printstrings := ["[adds]", "[mults]", "[vperms]", "[svldst]", "[vldst]", "[vval]"],
        type := "TVect",
        arithcost := (self, opcount) >> opcount[1]+opcount[2]
    ),

    info     := "Scalar 16 x 1-bit",
    v        := 16,
    t        := BitVector(16),

    v_ones   := BitVector(16).one(),
    v_zeros  := BitVector(16).zero(),
    val      := bits -> BitVector(16).value(bits),

    _op_load_u  := (self, ptr, offs, elts)      >> sklr_loadu_16x1i(ptr, offs, elts),
    _op_bcast   := (self, loc, elt_num)         >> sklr_bcast_16x1i(loc, elt_num),
    _op_store_u := (self, ptr, offs, src, elts) >> sklr_storeu_16x1i(ptr, offs, src, elts),
));

Class(SKLR_32x1i, SKLR_Vx1i, rec(
    # countrec below is invalid
    countrec := rec(
        ops := [
            [add, sub],
	    [mul],
            [sklr_bcast_32x1i], # shuffles
            [sklr_loadu_32x1i, sklr_storeu_32x1i],
            [deref],
            Value      # Value without [] is a keyword in countOps !!
        ],
        printstrings := ["[adds]", "[mults]", "[vperms]", "[svldst]", "[vldst]", "[vval]"],
        type := "TVect",
        arithcost := (self, opcount) >> opcount[1]+opcount[2]
    ),

    info     := "Scalar 32 x 1-bit",
    v        := 32,
    t        := BitVector(32),

    v_ones   := BitVector(32).one(),
    v_zeros  := BitVector(32).zero(),
    val      := bits -> BitVector(32).value(bits),

    _op_load_u  := (self, ptr, offs, elts)      >> sklr_loadu_32x1i(ptr, offs, elts),
    _op_bcast   := (self, loc, elt_num)         >> sklr_bcast_32x1i(loc, elt_num),
    _op_store_u := (self, ptr, offs, src, elts) >> sklr_storeu_32x1i(ptr, offs, src, elts),

));

Class(SKLR_64x1i, SKLR_Vx1i, rec(
    # countrec below is invalid
    countrec := rec(
        ops := [
            [add, sub],
	    [mul],
            [sklr_bcast_64x1i], # shuffles
            [sklr_loadu_64x1i, sklr_storeu_64x1i],
            [deref],
            Value      # Value without [] is a keyword in countOps !!
        ],
        printstrings := ["[adds]", "[mults]", "[vperms]", "[svldst]", "[vldst]", "[vval]"],
        type := "TVect",
        arithcost := (self, opcount) >> opcount[1]+opcount[2]
    ),

    info     := "Scalar 64 x 1-bit",
    v        := 64,
    t        := BitVector(64),

    v_ones   := BitVector(64).one(),
    v_zeros  := BitVector(64).zero(),
    val      := bits -> BitVector(64).value(bits),

    _op_load_u  := (self, ptr, offs, elts)      >> sklr_loadu_64x1i(ptr, offs, elts),
    _op_bcast   := (self, loc, elt_num)         >> sklr_bcast_64x1i(loc, elt_num),
    _op_store_u := (self, ptr, offs, src, elts) >> sklr_storeu_64x1i(ptr, offs, src, elts),
));

RewriteRules(RulesStrengthReduce, rec(
    aligned_loadu_32x1 := Rule( @(1, sklr_loadu_32x1i, x -> IsInt(_unwrap(x.args[2] mod 32)) and not IsUnalignedPtrT(x.args[1])),
                             e -> let(
                                     offs := imod(e.args[2], 32),
                                     xx0  := vtref(e.t, e.args[1], idiv(e.args[2], 32)),
                                     xx1  := vtref(e.t, e.args[1], idiv(e.args[2], 32)+1),
                                     nn   := _unwrap(e.args[3]),
                                     bin_and( When(offs + nn <= 32,
                                             bin_shr(xx0, offs),
                                             bin_or(bin_shr(xx0, offs), bin_shl(xx1, 32 - offs))),
                                         e.t.value(Replicate(nn, 1) :: Replicate(32 - nn, 0)))
                                     )),
    aligned_loadu_64x1 := Rule( @(1, sklr_loadu_64x1i, x -> IsInt(_unwrap(x.args[2] mod 64)) and not IsUnalignedPtrT(x.args[1])),
                             e -> let(
                                     offs := imod(e.args[2], 64),
                                     xx0  := vtref(e.t, e.args[1], idiv(e.args[2], 64)),
                                     xx1  := vtref(e.t, e.args[1], idiv(e.args[2], 64)+1),
                                     nn   := _unwrap(e.args[3]),
                                     bin_and( When(offs + nn <= 64,
                                             bin_shr(xx0, offs),
                                             bin_or(bin_shr(xx0, offs), bin_shl(xx1, 64 - offs))),
                                         e.t.value(Replicate(nn, 1) :: Replicate(64 - nn, 0)))
                                     )),

));

Class(SKLR_32x1i_to_SSE_16x8i, ISA_Bridge, rec(
    isa_from    := SKLR_32x1i,
    isa_to      := SSE_16x8i(T_Int(8)),

    code        := (self, y, x, opts) >> let(
                    xx := (offs) -> vtref(self.isa_from.t, x, offs),
                    yy := (offs) -> vtref(self.isa_to.t,   y, offs),
                    a  := var.fresh_t("U", T_UInt(32)),
                    b0 := var.fresh_t("U", T_UInt(32)),
                    b1 := var.fresh_t("U", T_UInt(32)),
                    b2 := var.fresh_t("U", T_UInt(32)),
                    b3 := var.fresh_t("U", T_UInt(32)),
                    mask := T_UInt(32).value(1 + 256 + 65536 + 16777216),
                    decl([a,b0,b1,b2,b3], chain(
                        assign( a, tcast(a.t, xx(0)) ),
                        assign( b0, bin_and(            a, mask)),
                        assign( b1, bin_and(bin_shr(a, 1), mask)),
                        assign( b2, bin_and(bin_shr(a, 2), mask)),
                        assign( b3, bin_and(bin_shr(a, 3), mask)),
                        assign( yy(0), tcast(self.isa_to.t, vpack(b0, b1, b2, b3))),
                        assign( b0, bin_and(bin_shr(a, 4), mask)),
                        assign( b1, bin_and(bin_shr(a, 5), mask)),
                        assign( b2, bin_and(bin_shr(a, 6), mask)),
                        assign( b3, bin_and(bin_shr(a, 7), mask)),
                        assign( yy(1), tcast(self.isa_to.t, vpack(b0, b1, b2, b3)))
                    ))),

    toAMat := self >> L(self.isa_from.v, 8).toAMat(),
    toSpl  := self >> Cvt(self)*TL(self.isa_from.v, div(self.isa_from.v, 8)).withTags([AVecReg(self.isa_from)])
));

Class(SKLR_64x1i_to_SSE_16x8i, SKLR_32x1i_to_SSE_16x8i, rec(
    isa_from := SKLR_64x1i,
    isa_to   := SSE_16x8i(T_Int(8)),

    code     := (self, y, x, opts) >> let(
                    xx := (offs) -> vtref(self.isa_from.t, x, offs),
                    yy := (offs) -> vtref(self.isa_to.t,   y, offs),
                    a  := var.fresh_t("U", T_UInt(64)),
                    b0 := var.fresh_t("U", T_UInt(64)),
                    b1 := var.fresh_t("U", T_UInt(64)),
                    mask := T_UInt(64).value(1 + 2^8 + 2^16 + 2^24 + 2^32 + 2^40 + 2^48 + 2^56),
                    decl([a,b0,b1], chain(
                        assign( a, tcast(a.t, xx(0)) ),
                        assign( b0, bin_and(            a, mask)),
                        assign( b1, bin_and(bin_shr(a, 1), mask)),
                        assign( yy(0), tcast(self.isa_to.t, vpack(b0, b1))),
                        assign( b0, bin_and(bin_shr(a, 2), mask)),
                        assign( b1, bin_and(bin_shr(a, 3), mask)),
                        assign( yy(1), tcast(self.isa_to.t, vpack(b0, b1))),
                        assign( b0, bin_and(bin_shr(a, 4), mask)),
                        assign( b1, bin_and(bin_shr(a, 5), mask)),
                        assign( yy(2), tcast(self.isa_to.t, vpack(b0, b1))),
                        assign( b0, bin_and(bin_shr(a, 6), mask)),
                        assign( b1, bin_and(bin_shr(a, 7), mask)),
                        assign( yy(3), tcast(self.isa_to.t, vpack(b0, b1)))
                    )))
));

Class(SKLR_32x1i_to_SSE_4x32f_f32, SKLR_32x1i_to_SSE_16x8i, rec(
    isa_from := SKLR_32x1i,
    isa_to   := SSE_4x32f(T_Real(32)),

    code     := (self, y, x, opts) >> let(
                    xx := (offs) -> vtref(self.isa_from.t, x, offs),
                    yy := (offs) -> vtref(self.isa_to.t,   y, offs),
                    ti := TVect(T_Int(32), 4),
                    tf := TVect(T_Real(32), 4),
                    a  := var.fresh_t("U", T_UInt(32)),
                    b  := var.fresh_t("U", ti),
                    decl( [a, b], chain(
                        assign( a, tcast(a.t, xx(0)) ),
                        assign( b, vpack(a, bin_shr(a, 8), bin_shr(a, 16), bin_shr(a, 24)) ),
                        assign(yy(0), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b, 31), 31) ))),
                        assign(yy(1), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b, 30), 31) ))),
                        assign(yy(2), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b, 29), 31) ))),
                        assign(yy(3), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b, 28), 31) ))),
                        assign(yy(4), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b, 27), 31) ))),
                        assign(yy(5), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b, 26), 31) ))),
                        assign(yy(6), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b, 25), 31) ))),
                        assign(yy(7), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b, 24), 31) )))
                    ))
                )
));

Class(SKLR_64x1i_to_SSE_4x32f_f32, SKLR_32x1i_to_SSE_16x8i, rec(
    isa_from := SKLR_64x1i,
    isa_to   := SSE_4x32f(T_Real(32)),

    code     := (self, y, x, opts) >> let(
                    xx := (offs) -> vtref(self.isa_from.t, x, offs),
                    yy := (offs) -> vtref(self.isa_to.t,   y, offs),
                    ti := TVect(T_Int(32), 4),
                    tf := TVect(T_Real(32), 4),
                    a  := var.fresh_t("U", T_UInt(64)),
                    b0 := var.fresh_t("U", ti),
                    b1 := var.fresh_t("U", ti),
                    shift := (t, n) -> tcast(T_Int(32), bin_shr(t, n)),
                    decl( [a, b0, b1], chain(
                        assign( a, tcast(a.t, xx(0)) ),
                        assign( b0, vpack(shift(a,  0), shift(a,  8), shift(a, 16), shift(a, 24)) ),
                        assign( b1, vpack(shift(a, 32), shift(a, 40), shift(a, 48), shift(a, 56)) ),
                        assign(yy( 0), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b0, 31), 31) ))),
                        assign(yy( 1), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b1, 31), 31) ))),
                        assign(yy( 2), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b0, 30), 31) ))),
                        assign(yy( 3), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b1, 30), 31) ))),
                        assign(yy( 4), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b0, 29), 31) ))),
                        assign(yy( 5), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b1, 29), 31) ))),
                        assign(yy( 6), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b0, 28), 31) ))),
                        assign(yy( 7), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b1, 28), 31) ))),
                        assign(yy( 8), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b0, 27), 31) ))),
                        assign(yy( 9), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b1, 27), 31) ))),
                        assign(yy(10), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b0, 26), 31) ))),
                        assign(yy(11), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b1, 26), 31) ))),
                        assign(yy(12), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b0, 25), 31) ))),
                        assign(yy(13), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b1, 25), 31) ))),
                        assign(yy(14), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b0, 24), 31) ))),
                        assign(yy(15), tcast(tf, bin_and( tf.one(), arith_shr(bin_shl(b1, 24), 31) )))
                    ))
                )
));

# NOTE: assumption that most significant bit is set for non zero numbers:
#
# SSE_16x8i_i8_to_SKLR_32x1i can be implemented as
#    neg(vmovemask_16x8i(eq(self.isa_from.t.zero(), xx(2*i))))
# and later simplified if xx(2*i) comes from comparision, yet we cannot match this situation
# because it's unlikely that we will have comparision propagated into this expression.
# Another way is to make T_Bool and simplify expression above by looking at data type.

ISA_Bridge.add(Class(CVT_SKLR_16x1i_SSE_16x8i, ISA_Bridge_I, rec(
    isa_from    := SSE_16x8i(T_Int(8)),
    isa_to      := SKLR_16x1i,
    props       := ["saturation"],
    code := (self, y, x, opts) >> assign(self._y(y,0), vmovemask_16x8i(self._x(x,0))),
)));

ISA_Bridge.add(Class(CVT_SKLR_16x1i_SSE_16x8ui, CVT_SKLR_16x1i_SSE_16x8i, rec(
    isa_from := SSE_16x8i(T_UInt(8)),
)));

Class(SKLR_32f_to_SKLR_32x1i, ISA_Bridge_I, rec(
    isa_from    := SKLR(T_Real(32)),
    isa_to      := SKLR_32x1i,
    granularity := self >> self.isa_to.v,

    code := (self, y, x, opts) >> let(
                j  := Ind(self.isa_to.v),
                xt := self.isa_from.t,
                yt := T_UInt(self.isa_to.v),
                yy := (offs) -> vtref(self.isa_to.t, y, offs),
                a  := var.fresh_t("U", yt),
                decl([a], chain(
                    assign(a, a.t.zero()),
                    loop(j, j.range,
                        assign(a, bin_or(a, cond(eq(nth(x, j), xt.zero()), yt.zero(), bin_shl(yt.one(), j))))),
                    assign(yy(0), a)
                ))
            ),
));

Class(SKLR_32f_to_SKLR_64x1i, SKLR_32f_to_SKLR_32x1i, rec(
    isa_from := SKLR(T_Real(32)),
    isa_to   := SKLR_64x1i
));

Class(SKLR_64x1i_to_SKLR_32f, ISA_Bridge_I, rec(
    isa_from    := SKLR_64x1i,
    isa_to      := SKLR(T_Real(32)),
    granularity := self >> self.isa_from.v,

    code := (self, y, x, opts) >> let(
                j  := Ind(self.isa_from.v),
                xx := (offs) -> vtref(self.isa_from.t, x, offs),
                ti := T_UInt(self.isa_from.v),
                tf := self.isa_to.t,
                a  := var.fresh_t("U", ti),
                decl( [a], chain(
                    assign( a, tcast(a.t, xx(0)) ),
                    loop(j, j.range,
                        assign( nth(y, j), tcvt( tf, bin_and(bin_shr(a, j), a.t.one())))
                    ).unroll()
                ))
            ),
));

Class(SKLR_32x1i_to_SKLR_32f, SKLR_64x1i_to_SKLR_32f, rec(
    isa_from := SKLR_32x1i,
    isa_to   := SKLR(T_Real(32))
));

Class(SKLR_64x1i_to_SKLR_8i, SKLR_64x1i_to_SKLR_32f, rec(
    isa_from := SKLR_64x1i,
    isa_to   := SKLR(T_Int(8))
));

Class(SKLR_32x1i_to_SKLR_8i, SKLR_64x1i_to_SKLR_32f, rec(
    isa_from := SKLR_32x1i,
    isa_to   := SKLR(T_Int(8))
));

ISA_Bridge.add(Class(CVT_SKLR_32x1i_SKLR_16x1i, ISA_Bridge_I, rec(
    isa_from    := SKLR_16x1i,
    isa_to      := SKLR_32x1i,
    code := (self, y, x, opts) >>
        assign(self._y(y,0), bin_or(tcvt(T_UInt(32), self._x(x,0)), bin_shl(tcvt(T_UInt(32), self._x(x,1)), 16)) ),
)));

ISA_Bridge.add(Class(CVT_SKLR_64x1i_SKLR_16x1i, ISA_Bridge_I, rec(
    isa_from    := SKLR_16x1i,
    isa_to      := SKLR_64x1i,
    code := (self, y, x, opts) >>
        assign(self._y(y,0), bin_or(
                     tcvt(T_UInt(64), self._x(x,0)),
             bin_shl(tcvt(T_UInt(64), self._x(x,1)), 16),
             bin_shl(tcvt(T_UInt(64), self._x(x,2)), 32),
             bin_shl(tcvt(T_UInt(64), self._x(x,3)), 48)
        )),
)));


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Class(CellCodegen, VectorCodegen, rec(
    Formula := meth(self, o, y, x, opts)
        local icode, datas, prog, params, sub, initsub, io;
        if IsBound(opts.XType) and not IsList(x) then
            x.t := TPtr(opts.XType);
            if IsBound(opts.useRestrict) and opts.useRestrict then
                x.t := x.t.restrict();
            fi;
        fi;
        if IsBound(opts.YType) and not IsList(y) then
            y.t := TPtr(opts.YType);
            if IsBound(opts.useRestrict) and opts.useRestrict then
                y.t := y.t.restrict();
            fi;
        fi;

        o := o.child(1);
        params := Set(Collect(o, param));

        datas := Collect(o, FDataOfs);
        o := BlockSums(opts.globalUnrolling, o);
        icode := ESReduce(self(o, y, x, opts),opts);
        icode := RemoveAssignAcc(icode);
        #Error("BP");
        icode := BlockUnroll(icode, opts);
        # icode := PowerOpt(icode);
        icode := DeclareHidden(icode);
        if IsBound(opts.isFixedPoint) and opts.isFixedPoint then
            icode := FixedPointCode(icode, opts.bits, opts.fracbits);
        fi;

        # Insert sw pipelining here
        icode := MarkPreds(icode);
        icode := MarkDefUse(icode);
        #SubstTopDown(icode, loop, e->MarkSWPLoops(e));
        #SubstTopDown(icode, loop_sw, e->SoftwarePipeline(e));

        io := When(x=y, [x], [y, x]);
        sub := Cond(IsBound(opts.subName), opts.subName, "transform");
        initsub := Cond(IsBound(opts.subName), Concat("init_", opts.subName), "init");
        icode := func(TVoid, sub, Concatenation(io, params), icode);

        if IsBound(opts.generateInitFunc) and opts.generateInitFunc then
            prog := program(
                decl(List(datas, x->x.var),
                    chain(
                        func(TVoid, initsub, params, chain(List(datas, x -> SReduce(x.var.init, opts)))),
                        icode
                    )));
        else
            prog := program( func(TVoid, initsub, params, chain()), icode);
        fi;
        prog.dimensions := o.dims();
        return prog;
    end,

));


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Declare(TestBench);

#F TestBench("name", <transforms> <opts>, <searchopts>)
#F
#F d := TestBench("default", [DFT(2), DFT(4)], SpiralDefaults, rec())
#F
#F TestBench Interface:
#F
#F     .build(transforms, opts, bopts, name, searchopts),
#F
#F     .generateCfiles := [true, false],  default = true
#F     .matrixVerify   := [true, false],  default = false
#F     .fftwVerify     := [true, false],  default = false
#F
#F     .fileTransform(t, opts),    .c filenames:   override in a subclass
#F     .funcTransform(t, opts),    function names: override in a subclass
#F     .txtFileName(runMethod),    timing file name
#F
#F     .run()              run DP
#F     .runExhaustive()    run exhaustive search
#F     .runRandom()        run 1 random tree, do not generate hash
#F     .runRandomSave()    run 1 random tree, generate and save hash
#F     .runRandom10()      run 10 random trees, do not generate hash
#F     .runRandomSave10()  run 10 random trees, generate and save hash
#F     .pickRandom()       generate random trees and save hash, do not run
#F
#F     .generateCode()
#F     .generateProductionCode()   same as .generateCode() but will use opts.production()
#F
#F     .entries()
#F     .times()
#F     .mflops()
#F
Class(TestBench, rec(
    ##
    ## Configuration
    ##
    generateCfiles    := true,
    matrixVerify      := false,
    fftwVerify        := false,
    outputExhaustive  := false,
    outputDir         := ".",
    fileTransform     := (self, t, opts) >> self.outputDir :: Conf("path_sep") :: self.name :: "_"
                                                   :: Drop(CodeletName(CodeletShape(t)), 1) :: ".c",
    funcTransform     := (self, t, opts) >> "sub1",
    prodFileTransform := (self, t, opts) >> self.fileTransform(t, opts), # used in generateProductionCode
    prodFuncTransform := (self, t, opts) >> self.funcTransform(t, opts),
    txtFileName       := (self, runMethod) >> self.outputDir :: Conf("path_sep") :: self.name :: "."
                                                  :: SubString(runMethod, 5) :: ".txt",
    ##
    ## Public methods
    ##

    # TestBench(<name>, <transforms>, <opts>, <search_opts>)
    __call__ := meth(self, name, transforms, opts, searchopts)
        local o;
	o := CopyFields(opts);
	if not IsBound(o.hashTable) then o.hashTable := HashTableDP(); fi;
	if not IsBound(o.hashFile)  then o.hashFile := Concat(self.outputDir, Conf("path_sep"), name, ".hash"); fi;
        return WithBases(self,
            rec(searchopts:=searchopts, opts:=o, transforms:=transforms, name:=name, verbosity:=1, callbacks:=[]));
    end,

    # TestBench.build(<transforms>, [<opts>], [<bench_opts>], [<bench_name>], [<search_opts>])
    #    Alternative constructor that supports default argument values if not provided
    #
    build := function(arg)
        local transforms, opts, bopts, name, dpr;

        transforms := When(IsList(arg[1]), arg[1], [arg[1]]);
        opts := When(Length(arg) >= 2, arg[2], SpiralDefaults);
        bopts := When(Length(arg) >= 3, arg[3], rec());
        name := When(Length(arg) >= 4, arg[4], "spiral");
        dpr := When(Length(arg) >= 5, arg[5], rec(verbosity := 0, timeBaseCases:=true));

        return CopyFields(TestBench(name, transforms, opts, dpr), bopts);
    end,

    generateCode           := self >> self._generateCode(self.transforms, self.opts),

    generateProductionCode := self >> self._generateCode(self.transforms, self.opts.production()),

    entries := self >> List(self.transforms, t -> self.entry(t)),

    entry := (self, t) >> let(l := self._rawentry(t),
	When(l=false, false, CopyFields(l, rec(ruletree := ApplyRuleTreeSPL(l.ruletree, t, self.opts))))),

    times   := self >> List(self.entries(), e -> e.measured),

    mflops  := self >> List(self.entries(), e -> self.acost(e) * LocalConfig.cpuinfo.freq / e.measured),

    # Use NonTerminal.normalizedArithCost() if it is there, otherwise return 0
    acost := (self, entry) >> self._rtflops(entry.ruletree),

    run            := arg >> arg[1]._run([],Drop(arg, 1), "_runDP",         true),
    runDP          := ~.run,
    runExhaustive  := arg >> arg[1]._run([], Drop(arg, 1), "_runExhaustive", true),
    runRandom      := arg >> arg[1]._run([arg[2]], Drop(arg, 2), "_runRandom",     false),
    runRandomSave  := arg >> arg[1]._run([arg[2]], Drop(arg, 2), "_runRandomSave", true),
    pickRandomSave := arg >> arg[1]._run([], Drop(arg, 1), "_pickRandomSave",true),

    ##
    ## Private methods
    ##

    _rtflops := rtree -> let(t:=rtree.node, When(IsBound(t.normalizedArithCost), EvalScalar(t.normalizedArithCost()), 0)),

    _verify := (self, opts, ruletree) >> VerifyMatrixRuleTree(ruletree, opts),

    # NOTE: Slightly hacked in. Check for opts.profile being bound etc. Look at VerifyMatrixRuleTree.
    _verifyfftw := (self, opts, code) >> opts.profile.verifyfftw(code, opts),

    _startHashFile := (self, hfile, d) >> PrintTo(hfile,
        "<# DPBench experiment '", self.name, "'\n",
        " # Started ", d[2], " ", d[3], " ", d[1], "  ", d[4], ":", d[5], "\n",
        " # Transforms: ", self.transforms, "#> \n\n",
        "ImportAll(spiral); Import(paradigms.common, paradigms.smp, platforms.sse, paradigms.vector); \n",
        "ImportAll(paradigms.vector); \n\n",
        "hash := HashTableDP(); \n"
    ),

    _loadHash := meth(self, hfile)
        local ns, result;
        ns := tab();
        result := READ(hfile, ns);
        if result = false or not IsBound(ns.hash) then return false;
        else return ns.hash;
        fi;
    end,

    _saveHash := meth(self, hfile, date, hash)
        local bucket, e;
        var.print := var.printFull;
        self._startHashFile(hfile, date);
        for bucket in hash.entries do
            for e in bucket do
                if e.data<>[] then
                    AppendTo(hfile, "HashAdd(hash, ", e.key, ", [", e.data[1], "]);\n");
                fi;
            od;
        od;
        var.print := var.printShort;
    end,

    reloadHash := meth(self)
       local hash, e;
       hash := self._loadHash(self.opts.hashFile);
       if (self.verbosity>0) then
	   PrintLine(When(hash=false, "Could not load ", "Loaded "), self.name, " (", self.opts.hashFile, ")");
       fi;
       if hash <> false then
	   self.opts.hashTable := hash;
       fi;
    end,

    _generateCode := meth(self, transforms, opts)
         local entries, e, c, t;
         for t in transforms do
             e := self.entry(t);
             if e = false then Error("Transform ", t, " not found in hashTable"); fi;
             c := CodeRuleTree(e.ruletree, opts);
             PrintLine(t, " -> ", self.prodFileTransform(t, opts));
             PrintTo(self.prodFileTransform(t, opts), PrintCode(self.prodFuncTransform(t, opts), c, opts));
         od;
    end,

    _showStats := meth(self, runMethod, t, ruletree, c, cycles, searchTime)
        local acc;
        # NOTE: slightly hacked in. Clean up to get both matrix and fftw verification to use already generated c.
	if self.matrixVerify or self.fftwVerify then
	    if self.matrixVerify then acc := self._verify(self.opts, ruletree);
	    else                      acc := self._verifyfftw(self.opts, c); fi;
	    _seqPerfStatsGflopsAcc(self.txtFileName(runMethod), t, self._rtflops(ruletree), cycles, searchTime, acc);
	else
	    When(self.opts.verbosity>-1,
		 _seqPerfStatsGflops(self.txtFileName(runMethod), t, LocalConfig.cpuinfo.freq, self._rtflops(ruletree), cycles, searchTime));
	fi;
    end,

    _rawentry := (self, t) >> let(
	lookup := MultiHashLookup(Concatenation([self.opts.hashTable], self.opts.baseHashes), HashAsSPL(t)),
	When(lookup=false or lookup=[], false, lookup[1])),

    #
    # Run methods
    #

    _runDP         := (self, t, opts) >> TimedAction(DP(t, self.searchopts, opts)),

    # Find best using an exhaustive search
    _runExhaustive := meth(self, t, opts)
       local r, searchTime, mincycles, mintree, rt, c, compiletime, cm, measuretime;

       r := AllRuleTrees(t, opts);
       searchTime := 0;
       mincycles := 10^100;

       for rt in r do
          [c,  compiletime] := TimedAction(CodeRuleTreeOpts(rt, opts));
          [cm, measuretime] := TimedAction(CMeasure(c, opts));
          if self.outputExhaustive then _seqPerfStatsGflops(
		  self.txtFileName("_runExhaustive-all"), t, LocalConfig.cpuinfo.freq, self._rtflops(rt), cm, compiletime+measuretime); fi;
          if (cm < mincycles) then
              mincycles := cm; mintree := Copy(rt);
          fi;
          searchTime:=searchTime+compiletime+measuretime;
       od;
       HashDelete(opts.hashTable,t);
       HashAdd(opts.hashTable, t, [rec(ruletree:=mintree, measured:=mincycles)]);

       return([mintree, searchTime]);
    end,

    # Run a <num> random ruletrees. Useful for quick, dirty, non-comprehensive tests.
    _runRandomNum := meth(self, num, t, opts)
       local r, c, start, cycles, i, res;
       start := TimeInSecs();
       res := [];
       for i in [1..num] do
           r := RandomRuleTree(t, opts);
           c := CodeRuleTree(r, opts);
           cycles := CMeasure(c, opts);
           Add(res, [r, cycles]);
       od;
       Sort(res, (a, b) -> a[2] < b[2]);
       return [res[1][1], res[1][2], TimeInSecs()-start];
     end,

    # Run random search and save result in hash.
    _runRandomSave := meth(self, num, t, opts)
       local r, srchTime, cycles;
       [r, cycles, srchTime] := self._runRandomNum(num, t, opts);
       HashDelete(opts.hashTable, t);
       HashAdd(opts.hashTable, t, [rec(ruletree:=r, measured:=cycles)]);
       return [r, srchTime];
    end,

    _runRandom := (self, num, t, opts) >> self._runRandomNum(num, t, opts){[1,3]},

    # Pick random and save result in hash (NOT measured).
    _pickRandomSave := meth(self, e, t, opts)
       local r, searchtime;
       [r, searchtime] := TimedAction(RandomRuleTree(t, opts));
       HashDelete(opts.hashTable,t);
       HashAdd(opts.hashTable,t,[rec(ruletree:=r)]);
       return [r, searchtime];
    end,

    _resume := self >> When(ForAny(self.entries(), e->e=false), self.reloadHash()),

    _run := meth(self, runArgs, transforms, runMethod, useHash)
        local t, outf, res, nopts, opts, c, cycles, hentry,  date, i, searchTime, acc, f, ruletree;
        MakeDir(self.outputDir);
        transforms := Flat(transforms);
        if transforms=[] then transforms := self.transforms; fi; # equivalent of runAll() in DPBench
        Constraint(ForAll(transforms, IsSPL));
        self._resume();
        for f in self.callbacks do f(self); od;
	opts := self.opts;
	date := Date();

	for t in transforms do
            # For run methods that use hash tables
	    if useHash then
		hentry := self._rawentry(t);
		if hentry = false then
		    res := ApplyFunc(self.(runMethod), runArgs :: [t, opts]);
		    if res[1] = [] then Error(runMethod, " did not find any ruletrees for <t> (", t, ")"); fi;
		    self._saveHash(opts.hashFile, date, opts.hashTable);
		    hentry := self._rawentry(t);
		    hentry.searchTime := res[2];
		    searchTime := res[2];
		else
		    searchTime := -1;
		fi;
		hentry.spectree := ApplyRuleTreeSPL(hentry.ruletree, t, opts);
                #NOTE: exhaustive search will not update cycles
		cycles := When(IsBound(hentry.measured), hentry.measured, 0);
		ruletree := hentry.spectree;
            # For run methods that don't use hash tables
	    else
		[ruletree, searchTime] := ApplyFunc(self.(runMethod), runArgs :: [t, opts]);
		cycles := 0;
	    fi;

            # HACK: It's a pain to do this in a cleaner way
	    if runMethod = "_pickRandomSave" then return; fi;

	    if self.generateCfiles then
                #NOTE: Shouldn't have to generate code or run this whole thing again.
		c := CodeRuleTree(ruletree, opts);
		cycles := CMeasure(c, opts);
		if useHash then hentry.measured := cycles; fi;

		nopts := CopyFields(opts, rec(fileinfo := rec(
			    cycles  := cycles,
			    flops   := self._rtflops(ruletree),
			    file    := self.fileTransform(t,opts),
			    algorithm := ruletree)));
		PrintTo(self.fileTransform(t,opts), PrintCode(self.funcTransform(t,opts), c, nopts));
            else
                c := skip();
	    fi;

	    self._showStats(runMethod, t, ruletree, c, cycles, searchTime);
        od;
    end,
));


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

#F AllocBuffersSMP(pfx, code, map, opts)
#F
#F Returns [newbuffers, allocation_code, code]
#F and fills the <map> with the remapping from original array-typed variables
#F to the new dynamically allocated pointer-typed variables.
#F
#F if opts.zeroallocate is true, the buffers are zeroed out
#F if opts.buffPrefixExtra is set, it's appended to pfx
AllocBuffersSMP := function(pfx, code, map, opts)
    local nameprefix, newbuffers, buffers, b, bufmap, v, nthreads, tid, newv, alloc_code;
    ## Pull out the buffer declarations
    [buffers, code] := PullBuffersSMP(code, IsArrayT);
    alloc_code := [];
    newbuffers := [];
	if IsBound(opts.buffPrefixExtra) then
		nameprefix := Concat(pfx, String(opts.buffPrefixExtra));
	else
		nameprefix := pfx;
	fi;
    for b in buffers do
        [v, nthreads, tid] := b;
        if nthreads = 1 then
            newv := var.fresh_t(nameprefix, TPtr(v.t.t));
        else
            newv := var.fresh_t(Concat("thr", nameprefix), TPtr(v.t.t));
        fi;
        if IsBound(v.value) then
            newv.value := v.value;
        fi;
        Add(newbuffers, newv);
        if IsBound(opts.zeroallocate) and opts.zeroallocate then
            Add(alloc_code, zallocate(newv, TArray(v.t.t, v.t.size*nthreads)));
        else
            Add(alloc_code, allocate(newv, TArray(v.t.t, v.t.size*nthreads)));
        fi;
        map.(v.id) := When(nthreads=1, newv, newv + tid*v.t.size);
    od;
    return [newbuffers, alloc_code, code];
end;

#F UnifyBuffersSMP(pfx, code, map, ubuf)
#F
#F Returns [ubuf_size, ptr_init_code, code]
#F and fills the <map> with the remapping from original array-typed variables
#F to the new dynamically allocated pointer-typed variables.
#F
#F ptr_init_code initializes the pointer-typed variables as pointers to
#F sections of <ubuf>
#F
UnifyBuffersSMP := function(pfx, code, map, ubuf, opts)
    local map, vars, alloc, ofs, usize, ptr_init_code;
    [vars, alloc, code] := AllocBuffersSMP(pfx, code, map,opts);
    ofs   := ScanL(alloc, (prev, c) -> prev + c.exp.size * sizeof(c.exp.t), 0);
    usize := Sum(alloc, a -> a.exp.size * sizeof(a.exp.t));

    ptr_init_code := List([1..Length(vars)], i -> assign(vars[i], tcast(vars[i].t, (ubuf + ofs[i]))));
    return [ usize, ptr_init_code, code ];
end;

Class(RecCodegen, RecCodegenMixin, SMPCodegenMixin, DefaultCodegen, rec(
    Formula := meth(self, o, y, x, opts)
        local code, datas, prog, params, init_code, destroy_code, codelet_codes, codelet_recs,
          datvars, dalloc, bufvars, bufalloc, map, ignore, num_threads, smp, io, _data, v;

        [x, y] := self.initXY(x, y, opts);
    o := o.child(1);
    params := Set(Collect(o, param));
    datas := Collect(o, @(1, var, e->IsBound(e.init)));
    smp := Collect(o, SMPSum);
    num_threads := When(smp=[], 1, smp[1].nthreads);
#    if not ForAll(smp, x->x.nthreads=num_threads) then Error("Non-uniform num_threads in SMPSum's"); fi;
    io := When(x=y, [x], [y, x]);

    ## Generating code : codelets
    codelet_recs := CompileCodelets(o, opts);
    codelet_codes := List(codelet_recs, clrec ->
        func(TVoid, clrec.name, Concatenation([Y, X], clrec.params), clrec.code));

    map := tab();
    ## Generating code : main body
    code := SReduce(self(o, y, x, opts), opts);
    code := BlockUnroll(code, opts);
    code := DeclareHidden(code); # NOTE: do I need this?
    code := func(TVoid, "transform", Concatenation(
        When(IsBound(opts.subParams), opts.subParams, []), params, io),
                When(num_threads=1, code,
                                    smp_fork(num_threads, code)));

    [bufvars, bufalloc, code] := AllocBuffersSMP("buf", code, map, opts);

    ## Generating code : initialization
    [datvars, dalloc, ignore] := AllocBuffersSMP("dat", decl(datas, skip()), map, opts);
    init_code := func(TVoid, "init", [],
        chain(bufalloc, dalloc, List(datas, x -> SReduce(x.init, opts))));
	destroy_code := func(TVoid, "destroy", [], skip());

    for v in bufvars do Add(v.t.qualifiers, "static"); od;
    for v in datvars do Add(v.t.qualifiers, "static"); od;
    _data := When(not IsBound(opts.smp) or (IsBound(opts.smp) and IsBound(opts.smp.OmpMode) and opts.smp.OmpMode = "for"), (i,j,k)->k, (i,j,k)->data(i, j, k));

    prog := program(
        codelet_codes,
        decl(Concatenation(datvars, bufvars),
        _data(var("NUM_THREADS", TInt), V(num_threads),
            SubstVars(chain(init_code, code, destroy_code), map))));
    prog.dimensions := o.dimensions;
    return prog;
    end,
));


#############################################################################
##
##                             equivalent mappings
##  stack.gi
##                                                          Sergio Siccha
##
##  Copyright 2017 by the authors.
##  This file is free software, see license file.
##
##  Implementation of MyStack
##
#############################################################################

###############################
# Operation StackCreate
# Input:
#   length -
# Filters:
#   IsInt
#
# Output:
#   stack;
###############################
InstallMethod( StackCreate, "Initialize empty stack of given length.",
[ IsInt ],
function( length )
  local stack;
  stack := rec( elements := [], last := 0 );
  stack.elements[ length+1 ] := fail; ## force allocation of storage
  Objectify( StackType, stack );
  return stack;
end );

###############################
# Operation StackPush
# Input:
#   obj -
# Filters:
#   IsObject
#
# Output:
#   none
###############################
InstallMethod( StackPush, "Push obj to stack.",
[ IsMyStack, IsObject ],
function( stack, obj )
  stack!.last := stack!.last + 1;
  stack!.elements[ stack!.last ] := obj;
end );

###############################
# Operation StackPop
# Input:
#   stack -
# Filters:
#   IsMyStack
#
# Output:
#   last element of stack
###############################
InstallMethod( StackPop, "Pop the last object that was added to stack",
[ IsMyStack ],
function( stack )
  stack!.last := stack!.last - 1;
  return stack!.elements[ stack!.last + 1 ];
end );

###############################
# Operation StackPopAll
# Input:
#   stack -
# Filters:
#   IsMyStack
#
# Output:
#   all elements of stack
###############################
InstallMethod( StackPopAll, "Pop all objects of stack.",
[ IsMyStack ],
function( stack )
  local last;
  stack!.last := 0;
  return stack!.elements{ [ 1 .. last ] };
end );

###############################
# Operation StackPeek
# Input:
#   stack -
# Filters:
#   IsMyStack
#
# Output:
#   last element of stack
###############################
InstallMethod( StackPeek, "Peek the last object that was added to stack",
[ IsMyStack ],
function( stack )
  return stack!.elements[ stack!.last ];
end );

###############################
# Operation StackIsEmpty
# Input:
#   stack -
# Filters:
#   IsMyStack
#
# Output:
#   stack!.last = 0;
###############################
InstallMethod( StackIsEmpty, "Checks whether stack is empty.",
[ IsMyStack ],
function( stack )
  return stack!.last = 0;
end );


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

# NOTE: find a better place for these! What about a single standard drop tag rule?
NewRulesFor(TRC, rec(
    TRC_tag := rec(
        forTransposition := false,
        applicable := (self, nt) >>
            (nt.isTag(1, spiral.paradigms.smp.AParSMP) or not nt.hasTags())
            # AVecReg is taken from a namespace that is NOT YET LOADED
	    # hence the fully qualified name
            and not nt.hasTag(spiral.paradigms.vector.AVecReg)
            and not nt.hasTag(spiral.paradigms.vector.AVecRegCx),

        children := nt -> [[ nt.params[1].withTags(nt.getTags()) ]],
        apply := (nt, c, cnt) -> RC(c[1])
    )
));

NewRulesFor(TDiag, rec(
    TDiag_tag := rec(
        forTransposition := false,

	# YSV: Below limits applicability to the cases where diag size is divisible by vlen
	#      which is a safe thing to do. Because VectorCodegen, can't  generated code
	#      for VDiags of size non-divisible by vlen. HOWEVER, if VDiag is propagate
	#      past any kind of VGath, this problem goes away. So having no restriction,
	#      will work MOST of the time, but not all the time.
        #
	# applicable := (self, nt) >> let(
	#     vtags := [spiral.paradigms.vector.AVecReg, spiral.paradigms.vector.AVecRegCx],
	#     dom   := nt.params[1].domain(),
	#     not nt.hasAnyTag(vtags) or (dom mod nt.getAnyTag(vtags).v) = 0
	# ),

        apply := (t, C, Nonterms) -> let(
	    vtags := [spiral.paradigms.vector.AVecReg, spiral.paradigms.vector.AVecRegCx],
	    Cond(t.hasAnyTag(vtags),
		 spiral.paradigms.vector.sigmaspl.VDiag(t.params[1], t.getAnyTag(vtags).v),
		 Diag(t.params[1])
	    )
	)
    )
));

RulesFor(TRCDiag, rec(
    TRCDiag_tag := rec(
        forTransposition := false,
        applicable := (self, nt) >> not nt.transposed,
        rule := (P, C) -> RC(Diag(P[1])))
));

RulesFor(TId, rec(
    TId_tag := rec(
        forTransposition := false,
        switch := false,
        rule := (P, C) -> P[1])
));

NewRulesFor(TRaderMid, rec(
    TRaderMid_tag := rec(
        forTransposition := false,
        apply := (t, C, Nonterms) -> t.raderMid(t.params[1], t.params[2], t.params[3])
    )
));

NewRulesFor(TRDiag, rec(
    TRDiag_RT_Diag := rec(
        forTransposition := true,
        apply := (t, C, Nonterms) -> t.terminate()
    )
));

NewRulesFor(TCompose, rec(
    TCompose_tag := rec(
        forTransposition := false,
        applicable := (self, nt) >> true,
        children := nt -> [ List(nt.params[1], e -> e.withTags(nt.getTags())) ],
        apply := (nt, c, nt) -> Grp(Compose(c))
    )
));

NewRulesFor(TCond, rec(
    TCond_tag := rec(
        forTransposition := false,
        applicable := (self, nt) >> true,
        children := nt -> [[
	    nt.params[2].withTags(nt.getTags()), nt.params[3].withTags(nt.getTags()) ]],
        apply := (t, C, Nonterms) -> COND(t.params[1], C[1], C[2])
    )
));

NewRulesFor(TGrp, rec(
    TGrp_tag := rec(
        forTransposition := false,
        children := nt -> [[ nt.params[1].withTags(nt.getTags()) ]],
        apply := (nt, c, cnt) -> Grp(c[1])
    )
));

NewRulesFor(TInplace, rec(
    TInplace_tag := rec(
        forTransposition := false,
        children := nt -> [[ nt.params[1].withTags(nt.getTags()) ]],
        apply := (nt, c, cnt) -> Inplace(c[1])
    )
));

NewRulesFor(TICompose, rec(
    TICompose_tag := rec(
        forTransposition := false,
        children := nt -> [[ nt.params[3].withTags(nt.getTags()) ]],
        apply := (nt, c, cnt) -> ICompose(nt.params[1], nt.params[2], c[1])
    )
));

########################################################################
#   (A + B) rules
NewRulesFor(TDirectSum, rec(
#   (A + B) terminate
    A_dirsum_B := rec(
        forTransposition := false,
        children := (self, t) >> let( tags := t.getTags(),
            [[ t.params[1].withTags(tags), t.params[2].setTags(tags) ]]
        ),
        apply := (t, C, Nonterms) -> DirectSum(C)

#D        children := (self, t) >> let (tags:=GetTags(t),
#D            [[ AddTag(t.params[1], tags), SetTag(t.params[2], tags) ]]),
    )
));

########################################################################
#   (A x B) rules
NewRulesFor(TTensor, rec(
#   (A x B) -> (A x I)(I x B)
    AxI_IxB := rec(
        info := "(A x B) -> (A x I)(I x B)",
        forTransposition := false,
        applicable := nt -> true,
        inplace := false,
        children := (self, nt) >> let(inp := When(self.inplace, TInplace, x->x),
            [[ TCompose([
                inp(TTensorI(nt.params[1], nt.params[2].dims()[1], AVec, AVec)),
                TTensorI(nt.params[2], nt.params[1].dims()[2], APar, APar)
            ]).withTags(nt.getTags()) ]]),
        apply := (nt, c, cnt) -> c[1],
#D        isApplicable := P -> true,
#D        allChildren := P -> [[TCompose([TTensorI(P[1], P[2].dims()[1], AVec, AVec), TTensorI(P[2], P[1].dims()[2], APar, APar)], P[3])]],
#D        rule := (P, C) -> C[1]
    ),
#   (A x B) -> (I x B)(A x I)
    IxB_AxI := rec(
        info := "(A x B) -> (I x B)(A x I)",
        forTransposition := false,
        applicable := nt -> true,
        inplace := false,
        children := (self, nt) >> let(inp := When(self.inplace, TInplace, x->x),
            [[ TCompose([
                inp(TTensorI(nt.params[2], nt.params[1].dims()[1], APar, APar)),
                TTensorI(nt.params[1], nt.params[2].dims()[2], AVec, AVec)
            ]).withTags(nt.getTags()) ]]),
        apply := (nt, c, cnt) -> c[1]

#D        isApplicable := P -> true,
#D        allChildren := P -> [[TCompose([TTensorI(P[2], P[1].dims()[1], APar, APar), TTensorI(P[1], P[2].dims()[2], AVec, AVec)], P[3])]],
#D        rule := (P, C) -> C[1]
    ),
#   (A x B) -> (L(B x I))(L(A x I))
    L_BxI__L_AxI := rec(
        info := "(A x B) -> (L(B x I))(L(A x I))",
        forTransposition := false,
        applicable := nt -> true,
        children := nt -> [[ TCompose([
            TTensorI(nt.params[2], nt.params[1].dims()[1], APar, AVec),
            TTensorI(nt.params[1], nt.params[2].dims()[2], APar, AVec)
        ]).withTags(nt.getTags()) ]],
        apply := (nt, c, cnt) -> c[1]

#D        isApplicable := P -> true,
#D        allChildren := P -> [[TCompose([TTensorI(P[2], P[1].dims()[1], APar, AVec), TTensorI(P[1], P[2].dims()[2], APar, AVec)], P[3])]],
#D        rule := (P, C) -> C[1]
    ),
#   (A x B) -> ((A x I)L)((B x I)L)
    AxI_L__BxI_L := rec(
        info := "(A x B) -> ((A x I)L)((B x I)L)",
        forTransposition := false,
        applicable := nt -> true,
        children := nt -> [[ TCompose([
            TTensorI(nt.params[1], nt.params[2].dims()[1], AVec, APar),
            TTensorI(nt.params[2], nt.params[1].dims()[2], AVec, APar)
        ]).withTags(nt.getTags()) ]],
        apply := (nt, c, cnt) -> c[1],

#D        isApplicable := P -> true,
#D        allChildren := P -> [[TCompose([TTensorI(P[1], P[2].dims()[1], AVec, APar), TTensorI(P[2], P[1].dims()[2], AVec, APar)], P[3])]],
#D        rule := (P, C) -> C[1]
    ),
));

########################################################################
#   rules for A x I, I x A, (A x I)L, (I x A)L
NewRulesFor(TTensorI, rec(
    TTensorI_toGT := rec(
        applicable := t -> true,
        freedoms := t -> [], # no degrees of freedom
        child := (t, fr) -> [ GT_TTensorI(t) ], # fr will be an empty list
        apply := (t, C, Nonterms) -> C[1]
    )
));

NewRulesFor(TTensorI, rec(
#   base cases
#   I x A
    IxA_base := rec(
        info := "IxA base",
        forTransposition := false,
        applicable := nt -> (not nt.hasTags() or nt.firstTag() = ANoTag) and IsParPar(nt.params),
        children := nt -> [[ nt.params[1].withTags(nt.getTags()) ]],
        apply := (nt, c, cnt) -> When(nt.params[2] > 1,
            Tensor(I(nt.params[2]), c[1]),
            c[1]
        )
#D        isApplicable := (self, P) >> PUntagged(self.nonTerminal, P) and IsParPar(P),
#D        allChildren := P -> [[P[1]]],
#D        rule := (P, C) -> When(P[2]>1,Tensor(I(P[2]),C[1]),C[1])
    ),
#   A x I
    AxI_base := rec(
        info := "AxI base",
        forTransposition := false,
        applicable := nt -> (not nt.hasTags() or nt.firstTag() = ANoTag) and IsVecVec(nt.params),
        children := nt -> [[ nt.params[1].withTags(nt.getTags()) ]],
        apply := (nt, c, cnt) -> When( nt.params[2] > 1,
            Tensor(c[1], I(nt.params[2])),
            c[1]
        ),
#D        isApplicable := (self, P) >> PUntagged(self.nonTerminal, P) and IsVecVec(P),
#D        allChildren := P -> [[P[1]]],
#D        rule := (P, C) -> When(P[2]>1,Tensor(C[1], I(P[2])),C[1])
    ),
#   (I x A)L
    IxA_L_base := rec(
        info := "(IxA)L base",
        forTransposition := false,
        applicable := nt -> (not nt.hasTags() or nt.firstTag() = ANoTag) and IsParVec(nt.params),
        children := nt -> [[ nt.params[1].withTags(nt.getTags()) ]],
        apply := (nt, c, cnt) -> Tensor(I(nt.params[2]), c[1]) * L(c[1].dims()[2] * nt.params[2], nt.params[2]),

#D        isApplicable := (self, P) >> PUntagged(self.nonTerminal, P) and IsParVec(P),
#D        allChildren := P -> [[P[1]]],
#D        rule := (P, C) -> Tensor(I(P[2]), C[1])*L(C[1].dims()[2]*P[2], P[2])
    ),
#   L(I x A)
    L_IxA_base := rec(
        info := "L(IxA) base",
        forTransposition := false,
        applicable := nt -> (not nt.hasTags() or nt.firstTag() = ANoTag) and IsVecPar(nt.params),
        children := nt -> [[ nt.params[1].withTags(nt.getTags()) ]],
        apply := (nt, c, cnt) -> L(c[1].dims()[1] * nt.params[2], c[1].dims()[1]) * Tensor(I(nt.params[2]), c[1])

#D        isApplicable := (self, P) >> PUntagged(self.nonTerminal, P) and IsVecPar(P),
#D        allChildren := P -> [[P[1]]],
#D        rule := (P, C) -> L(C[1].dims()[1]*P[2], C[1].dims()[1]) * Tensor(I(P[2]), C[1])
    ),
#   splitting rules ##############################################################
#   (A _m x I_n)L_mn_m
    AxI_L_split := rec(
        info := "split (A_m x I_n) L^mn_m --> (L_mn/u_m x I_u) * (I_n/u x (A_m x I_u) * L_mu_m )",
        forTransposition := false,
        applicable := nt -> (nt.firstTag().kind() = AGenericTag) and IsVecPar(nt.params),
        children := nt -> let(t := nt.getTags(), p := nt.params, d  := p[1].dims(), mu := t[1].params[1], [
            TTensorI(TL(d[1] * p[2]/mu, d[1],1,1), mu, AVec, AVec).withTags(t),
            TTensorI(p[1], mu, AVec, APar).withTags(t)
        ]),
        apply := (nt, c, cnt) -> let(t := nt.getTags(), n := nt.params[2], mu := t[1].params[1],
            c[1] * Tensor(I(n/mu), c[2])
        ),

        # Example
        # =======
        # t:=TTensorI(DFT(4, 1), 4, AVec, APar).withTags([ AGenericTag(2) ]);
        # c:=AxI_L_split.children(t);
        # res := AxI_L_split.apply(t,c,false);

        switch:=false
    ),

#   (I_n x A_rxs) L^ns_n
    IxA_L_split := rec(
        info := "split (I_n x A_rxs) L^ns_n",
        forTransposition := false,
        applicable := nt -> IsParVec(nt.params),
        children := nt -> let(t := nt.getTags(), p := nt.params, d := p[1].dims(), [[
            TTensorI(p[1], p[2], APar, APar).withTags(t),
            TL(d[2]*p[2], p[2], 1, 1).withTags(t)
        ]]),
        apply := (nt, c, cnt) -> c[1] * c[2],

#D        isApplicable := P -> P[3].isPar and P[4].isVec,
#D        allChildren := P -> let(pv:=P[5], d:=P[1].dims(), [[TTensorI(P[1], P[2], APar, APar, pv), TL(d[2]*P[2], P[2], 1, 1, pv)]]),
#D        rule := (P, C) -> C[1] * C[2],
        switch := false
    ),
#   L^nr_n (A_rxs x I_n)
    L_AxI_split := rec(
        info := "split L^nr_n (A_rxs x I_n) ",
        forTransposition := false,
        applicable := nt -> IsParVec(nt.params),
        children := nt -> let( t := nt.getTags(), p := nt.params, d := p[1].dims(), [[
            TL(d[1] * p[2], p[2], 1, 1).withTags(t),
            TTensorI(p[1], p[2], AVec, AVec).withTags(t)
        ]]),
        apply := (nt, c, cnt) -> c[1] * c[2],
        switch := false
#D        isApplicable := P -> P[3].isPar and P[4].isVec,
#D        allChildren := P -> let(pv:=P[5], d:=P[1].dims(), [[ TL(d[1]*P[2], P[2], 1, 1, pv), TTensorI(P[1], P[2], AVec, AVec, pv) ]]),
#D        rule := (P, C) -> C[1] * C[2],
    ),
#   L^nr_r (I_n x A_rxs)
    L_IxA_split := rec(
        info := "split L^nr_r (I_n x A_rxs)",
        forTransposition := false,
        applicable := nt -> IsVecPar(nt.params),
        children := nt -> let( t := nt.getTags(), p := nt.params, d := p[1].dims(), [[
            TL(d[1]*p[2], d[1], 1, 1).withTags(t),
            TTensorI(p[1], p[2], APar, APar).withTags(t)
        ]]),
        apply := (nt, c, cnt) -> c[1] * c[2],

#D        isApplicable := P -> P[3].isVec and P[4].isPar,
#D        allChildren := P -> let(pv:=P[5], d:=P[1].dims(), [[TL(d[1]*P[2], d[1], 1, 1, pv), TTensorI(P[1], P[2], APar, APar, pv)]]),
#D        rule := (P, C) -> C[1] * C[2],
        switch := false
    ),
#   (A_rxs x I_n) L^nr_s
    AxI_L_split := rec(
        info := "split (A_rxs x I_n) L^nr_s ",
        forTransposition := false,
        applicable := nt -> IsVecPar(nt.params),
        children := nt -> let( t := nt.getTags(), p := nt.params, d := p[1].dims(), [[
            TTensorI(p[1], p[2], APar, APar).withTags(t),
            TL(d[2]*p[2], d[2], 1, 1).withTags(t)
        ]]),
        apply := (nt, c, cnt) -> c[1] * c[2],
#D        isApplicable := P -> P[3].isVec and P[4].isPar,
#D        allChildren := P -> let(pv:=P[5], d:=P[1].dims(), [[ TTensorI(P[1], P[2], APar, APar, pv), TL(d[2]*P[2], d[2], 1, 1, pv)]]),
#D        rule := (P, C) -> C[1] * C[2],
        switch := false
    ),
##   vector recursion #############################################################
#   (I x (I x A)L)L
    IxA_L_vecrec := rec(
        info := "(I x (I x A)L)L vector recursion",
        forTransposition := false,
        applicable := nt -> ObjId(nt.params[1]) = TTensorI and IsParVec(nt.params) and IsParVec(nt.params[1].params),
        children := nt -> let(k := nt.params[2], m := nt.params[1].params[2], n := nt.params[1].params[1].dims(), [[
            TL(k*m, k, 1, n[1]).withTags(nt.getTags()),
            TTensorI(nt.params[1].params[1], nt.params[2], APar, AVec).withTags(nt.getTags()),
            TL(m*n[2], m, 1, k).withTags(nt.getTags())
        ]]),
        apply := (nt, c, cnt) -> let(m := nt.params[1].params[2],
            c[1] * Tensor(I(m), c[2]) * c[3]
        ),
#D        isApplicable := P -> P[1].name = "TTensorI" and P[3].isPar and P[4].isVec and P[1].params[3].isPar and P[1].params[4].isVec,
#D        allChildren := P -> let(k:=P[2], m:=P[1].params[2], n:=P[1].params[1].dims(),
#D                [[ TL(k*m, k, 1, n[1], P[5]), TTensorI(P[1].params[1], P[2], APar, AVec, P[5]),  TL(m*n[2], m, 1, k, P[5])]]),
#D        rule := (P, C) -> let(k:=P[2], m:=P[1].params[2], n:=P[1].params[1].dims(),
#D                C[1] * Tensor(I(m), C[2]) * C[3]
#D            ),
        switch := false
    ),
#   L(I x L(I x A))
    L_IxA_vecrec := rec(
        info := "L(I x L(I x A)) vector recursion",
        forTransposition := false,
        applicable := nt -> ObjId(nt.params[1]) = TTensorI and IsVecPar(nt.params) and IsVecPar(nt.params[1].params),
        children := nt -> let( k := nt.params[2], m := nt.params[1].params[2], n := nt.params[1].params[1].dims(), [[
            TL(m*n[1], n[1], 1, k).withTags(nt.getTags()),
            TTensorI(nt.params[1].params[1], nt.params[2], AVec, APar).withTags(nt.getTags()),
            TL(k*m, m, 1, n[2]).withTags(nt.getTags())
        ]]),
        apply := (nt, c, cnt) -> let(m := nt.params[1].params[2],
            c[1] * Tensor(I(m), c[2]) * c[3]
        ),
#D        isApplicable := P -> P[1].name = "TTensorI" and P[3].isVec and P[4].isPar and P[1].params[3].isVec and P[1].params[4].isPar,
#D        allChildren := P -> let(k:=P[2], m:=P[1].params[2], n:=P[1].params[1].dims(),
#D                [[ TL(m*n[1], n[1], 1, k, P[5]), TTensorI(P[1].params[1], P[2], AVec, APar, P[5]),  TL(k*m, m, 1, n[2], P[5])]]),
#D        rule := (P, C) -> let(k:=P[2], m:=P[1].params[2], n:=P[1].params[1].dims(),
#D                C[1] * Tensor(I(m), C[2]) * C[3]
#D            ),
        switch := false
    )
));

########################################################################
#   rules for L

#D isVec := P->Length(P[5]) > 0 and P[5][1].isVec;

NewRulesFor(TL, rec(
#   TL(N,n,l,r,[]) -> I_l x L(N,n) x I_r
    L_base := rec(
        forTransposition := false,
        applicable := nt -> nt.isTag(1, spiral.paradigms.smp.AParSMP) or not nt.hasTags(),
        apply := (nt, c, cnt) -> let(
            c1 := When(nt.params[3]=1, [], [I(nt.params[3])]),
            c2 := When(nt.params[4]=1, [], [I(nt.params[4])]),
            Tensor(Concat(c1, [ L(nt.params[1], nt.params[2]) ], c2))
        )
    ),
#   TL(N,n,l,r,[]) -> I_l x L(N,n) x I_r
    L_func := rec(
        forTransposition := false,
        applicable := nt -> nt.isTag(1, spiral.paradigms.smp.AParSMP) or not nt.hasTags(),
        apply := (nt, c, cnt) -> let(
            c1 := When(nt.params[3]=1, [], [fId(nt.params[3])]),
            c2 := When(nt.params[4]=1, [], [fId(nt.params[4])]),
            Prm(fTensor(Concat(c1, [ L(nt.params[1], nt.params[2]) ], c2)))
        )
    ),
#   recursion rules
    IxLxI_kmn_n := rec (
        info             := "I(l) x L(kmn, n) x I(r) -> (I_l x L(kn,n) x I(mr))(I(kl) x L(mn, n) x I(r))",
        forTransposition := false,
        applicable := nt -> Length(DivisorsIntDrop(nt.params[1]/nt.params[2])) > 0,
        children := nt -> let(
            N := nt.params[1], n := nt.params[2],
            km := N/n, ml := DivisorsIntDrop(km),
            l := nt.params[3], r := nt.params[4],
            List(ml, m -> let( k := km/m, [
                TL(k*n, n, l, r*m).withTags(nt.getTags()),
                TL(m*n, n, k*l, r).withTags(nt.getTags())
            ]))
        ),
        apply := (nt, c, cnt) -> let(
            spl := c[1] * c[2],
            When(nt.params[1] = nt.params[2]^2,
                SymSPL(spl),
                spl
            )
        ),

#D        isApplicable     := P -> #isVec(P) and let(v:=P[5][1].v, (P[1]*P[2] >= v or P[1]*P[3] >= v) and
#D                                Length(DivisorsIntDrop(P[1]/P[2])) > 0,
#D        allChildren := P -> let(N:=P[1], n:=P[2], km:=N/n, ml:=DivisorsIntDrop(km), l:=P[3], r:=P[4], vp:=P[5],
#D            List(ml, m->let(k:=km/m, [TL(k*n, n, l, r*m, vp), TL(m*n,n, k*l, r, vp)])) ),
#D        rule := (P, C) -> let(spl := C[1]*C[2], When(P[1]=P[2]^2, SymSPL(spl), spl)),
        switch := false
    ),
    IxLxI_kmn_km := rec (
        info             := "I(l) x L(kmn, km) x I(r) -> (I(kl) x L(mn,m) x I(r))(I(l) x L(kn, k) x I(r))",
        forTransposition := false,
        applicable := nt -> Length(DivisorsIntDrop(nt.params[2])) > 0,
        children := nt -> let(
            N := nt.params[1], km := nt.params[2],
            n := N/km, ml := DivisorsIntDrop(km),
            l := nt.params[3], r := nt.params[4],
            List(ml, m->let(
                k := km/m,
                [
                    TL(m*n, m, k*l, r).withTags(nt.getTags()),
                    TL(k*n,k, l, m*r).withTags(nt.getTags())
                ]
            ))
        ),
        apply := (nt, C, cnt) -> let(P := nt.params, spl := C[1]*C[2], When(P[1]=P[2]^2, SymSPL(spl), spl)),
#D        isApplicable     := P -> #isVec(P) and let(v:=P[5][1].v, (P[1]*P[2] >= v or P[1]*P[3] >= v) and
#D                                Length(DivisorsIntDrop(P[2])) > 0,
#D        allChildren := P -> let(N:=P[1], km:=P[2], n:=N/km, ml:=DivisorsIntDrop(km), l:=P[3], r:=P[4], vp:=P[5],
#D            List(ml, m->let(k:=km/m, [TL(m*n, m, k*l, r, vp), TL(k*n,k, l, m*r, vp)])) ),
#D        rule := (P, C) -> let(spl := C[1]*C[2], When(P[1]=P[2]^2, SymSPL(spl), spl)),
        switch := false
    ),
    IxLxI_IxLxI_up := rec (
        info             := "I(l) x L(kmn, km) x I(r) -> (I(l) x L(kmn, k) x I(r))(I(l) x L(kmn, m) x I(r))",
        forTransposition := false,
        applicable       := nt -> Length(DivisorPairs(nt.params[2])) > 0,
        children := nt -> let(
            N := nt.params[1], km := DivisorPairs(nt.params[2]),
            l := nt.params[3], r := nt.params[4], t := nt.getTags(),
            List(km, i->[TL(N, i[1], l, r).withTags(t), TL(N, i[2], l, r).withTags(t)])
        ),
        apply := (nt, c, nt) -> c[1] * c[2],

#D        isApplicable     := P -> Length(DivisorPairs(P[2])) > 0,
#D        allChildren := P -> let(N:=P[1], km:=DivisorPairs(P[2]), l:=P[3], r:=P[4], vp:=P[5],
#D            List(km, i->[TL(N, i[1], l, r, vp), TL(N, i[2], l, r, vp)])),
#D        rule := (P, C) -> C[1]*C[2],
        switch := false
    ),
    IxLxI_IxLxI_down := rec (
        info             := "I(l) x L(kmn, k) x I(r) -> (I(l) x L(kmn, km) x I(r))(I(l) x L(kmn, kn) x I(r))",
        forTransposition := false,
        applicable       := nt -> Length(DivisorPairs(nt.params[1]/nt.params[2])) > 0,
        children         := nt -> let(
            N := nt.params[1], km := DivisorPairs(nt.params[1]/nt.params[2]),
            l := nt.params[3], r := nt.params[4], t := nt.getTags(),
            List(km, i->[TL(N, N/i[1], l, r).withTags(t), TL(N, N/i[2], l, r).withTags(t)])
        ),
        apply := (nt, c, cnt) -> c[1] * c[2],

#D        isApplicable     := P -> Length(DivisorPairs(P[1]/P[2])) > 0,
#D        allChildren := P -> let(N:=P[1], km:=DivisorPairs(P[1]/P[2]), l:=P[3], r:=P[4], vp:=P[5],
#D            List(km, i->[TL(N, N/i[1], l, r, vp), TL(N, N/i[2], l, r, vp)])),
#D        rule := (P, C) -> C[1]*C[2],
        switch := false
    ),
    IxLxI_loop1 := rec(
        info := "I x L x I loop1",
        forTransposition := false,
        applicable := nt -> not nt.hasTags(),
        apply := (nt, c, cnt) -> let(
            m := nt.params[2], n := nt.params[1]/nt.params[2], j:=Ind(m), fid := fId(n), fbase := fBase(m,j),
            gath := Gath(fTensor(fid, fbase)), scat := Scat(fTensor(fbase, fid)),
            c0 := [ISum(j, m, scat*gath)],
            c1 := When(nt.params[3]=1, [], [I(nt.params[3])]),
            c2 := When(nt.params[4]=1, [], [I(nt.params[4])]),
            Tensor(Concat(c1,c0,c2))
        ),

#D        isApplicable := P -> Length(P[5]) = 0,
#D        rule := (P, C) -> let(m:=P[2], n:=P[1]/P[2], j:=Ind(m), fid := fId(n), fbase := fBase(m,j),
#D                gath := Gath(fTensor(fid, fbase)), scat := Scat(fTensor(fbase, fid)),
#D                C0 := [ISum(j, m, scat*gath)], C1:=When(P[3]=1, [], [I(P[3])]), C2:=When(P[4]=1, [], [I(P[4])]), Tensor(Concat(C1, C0, C2))),
        switch := false
    ),
    IxLxI_loop2 := rec(
        info := "I x L x I loop2",
        forTransposition := false,
        applicable := nt -> not nt.hasTags(),
        apply := (nt, c, cnt) -> let(
            m := nt.params[2], n := nt.params[1]/nt.params[2], j:=Ind(m), fid := fId(n), fbase := fBase(m,j),
            gath := Gath(fTensor(fbase, fid)), scat := Scat(fTensor(fid, fbase)),
            c0 := [ISum(j, m, scat*gath)],
            c1 := When(nt.params[3]=1, [], [I(nt.params[3])]),
            c2 := When(nt.params[4]=1, [], [I(nt.params[4])]),
            Tensor(Concat(c1,c0,c2))
        ),

#D        isApplicable := P -> Length(P[5]) = 0,
#D        rule := (P, C) -> let(m:=P[2], n:=P[1]/P[2], j:=Ind(n), fid := fId(m), fbase := fBase(n,j),
#D                gath := Gath(fTensor(fbase, fid)), scat := Scat(fTensor(fid, fbase)),
#D                C0 := [ISum(j, n, scat*gath)], C1:=When(P[3]=1, [], [I(P[3])]), C2:=When(P[4]=1, [], [I(P[4])]), Tensor(Concat(C1, C0, C2))),
        switch := false
    )
));

###################################################################
NewRulesFor(TICompose, rec(
    TICompose_unroll := rec(
        forTransposition := false,
        applicable := nt -> true,
        children := nt -> [[
            TCompose(
                List([0..nt.params[2]-1], i -> RulesStrengthReduce(SubstBottomUp(Copy(nt.params[3]), nt.params[1], e -> V(i))))
            ).withTags(nt.getTags())
        ]],
        apply := (nt, c, cnt) -> c[1]
    )
));

NewRulesFor(TDR, rec(
    TDR_base := rec(
        forTransposition := false,
        applicable := nt -> true,
        apply := (nt, c, cnt) -> DR(nt.params[1], nt.params[2])
#D        isApplicable := True,
#D        rule := (P, C) -> DR(P[1], P[2])
    )
));

NewRulesFor(TGath, rec(
    TGath_base := rec(
        applicable := True,
        apply := (t, C, nt) -> t.terminate()
    )
));

NewRulesFor(TScat, rec(
    TScat_base := rec(
        applicable := True,
        apply := (t, C, nt) -> t.terminate()
    )
));

NewRulesFor(TConj, rec(
    TConj_tag := rec(
        applicable := True,
        children := t -> [[ t.params[1].withTags(t.getTags()) ]],
        apply := (t, C, nt) -> ConjLR(C[1], t.params[2], t.params[3])
    ),

    TConj_perm := rec(
        applicable := True,

	_cvtPerm := (t,p, use_tl) -> Cond(
	    ObjId(p) = fId,
	        I(p.params[1]),
	    ObjId(p) = L and use_tl,
	        TL(p.params[1], p.params[2], 1, 1).withTags(t.getTags()),
	    # else
		FormatPrm(p)
	),

	# one degree of freedom -- use TL (true) or use FormatPrm(L) (false)
	freedoms := (self, t) >> [[ true, false ]],

        child := (self, t, fr) >> [
	    self._cvtPerm(t, t.params[2], fr[1]),
	    t.params[1].withTags(t.getTags()),
	    self._cvtPerm(t, t.params[3], fr[1])
	],

	apply := (self, t, C, Nonterms) >> C[1]*C[2]*C[3]
    ),

    TConj_cplx := rec(
        applicable := t -> t.params[1] _is TRC,

	_cvtPerm := (t, p) -> Cond(
	    ObjId(p) = fId,
	        I(p.params[1]),
	    ObjId(p) = L,
	        TL(p.params[1], p.params[2], 1, 1).withTags(t.getTags()),
	    # else
		FormatPrm(p)
	),

	freedoms := (self, t) >> [],

        child := (self, t, fr) >> [
	    self._cvtPerm(t, t.params[2]),
	    t.params[1].withTags(List(t.getTags(), t->Cond(t.kind()=spiral.paradigms.vector.AVecReg, spiral.paradigms.vector.AVecRegCx(t.isa.cplx()), t))),
	    self._cvtPerm(t, t.params[3])
	],

	apply := (self, t, C, Nonterms) >> C[1]*C[2]*C[3]
    ),

));

#########################################################################

NewRulesFor(TTensorInd, rec(
#   base cases
#   I x A
    dsA_base := rec(
        info := "IxA base",
        forTransposition := false,
        applicable := nt -> not nt.hasTags() and IsParPar(nt.params),
        children := nt -> [[ nt.params[1], InfoNt(nt.params[2]) ]],
        apply := (nt, c, cnt) -> IDirSum(cnt[2].params[1], c[1])
    ),
#   A x I
    L_dsA_L_base := rec(
        info := "AxI base",
        forTransposition := false,
        applicable := nt -> not nt.hasTags() and IsVecVec(nt.params),
        children := nt -> [[ nt.params[1], InfoNt(nt.params[2]) ]],
        apply := (nt, c, cnt) ->
            L(c[1].dims()[1] * nt.params[2].range, c[1].dims()[1]) *
            IDirSum(cnt[2].params[1], c[1]) *
            L(c[1].dims()[2] * nt.params[2].range, nt.params[2].range)
    ),
#   (I x A)L
    dsA_L_base := rec(
        info := "(IxA)L base",
        forTransposition := false,
        applicable := nt -> not nt.hasTags() and IsParVec(nt.params),
        children := nt -> [[ nt.params[1], InfoNt(nt.params[2]) ]],
        apply := (nt, c, cnt) ->
            IDirSum(cnt[2].params[1], c[1]) *
            L(c[1].dims()[2] * nt.params[2].range, nt.params[2].range),
    ),
#   L(I x A)
    L_dsA_base := rec(
        info := "L(IxA) base",
        forTransposition := false,
        applicable := nt -> not nt.hasTags() and IsVecPar(nt.params),
        children := nt -> [[ nt.params[1], InfoNt(nt.params[2]) ]],
        apply := (nt, c, cnt) ->
            L(c[1].dims()[1] * nt.params[2].range, c[1].dims()[1]) *
            IDirSum(cnt[2].params[1], c[1])
    )
));


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

# Option Records
# ==============
# MP, BS, from 01/25/01, GAPv3.4.4

# general default search options
SEARCH_DEFAULTS :=
    rec(
		timeLimit          := false,
		globalUnrolling    := false,
		globalUnrollingMin := 8,
		globalUnrollingMax := 64,
		timeBaseCases      := true
    );

# default DP search options
DP_DEFAULTS :=
    rec(
        nBest     := 1,
        optimize  := "minimize",
        verbosity := 3,
	    DPVec     := false,
	    DPVecVlen := 4
    );

#F Search Options Record
#F ---------------------

#F Search options records keep search options that are not specific to any
#F particular search algorithm.  These are options that cause the search
#F algorithms to search over different implementations instead of just how
#F the search algorithm progresses.
#F
#F These options get incorporated into a search algorithm's options record.
#F

#F PrintSpecSearchOptionsRecord()
#F   prints the specification for the general search options
#F   only to be called by specific search algorithm's PrintSpec
#F

PrintSpecSearchOptionsRecord := function()
   Print("  timeLimit := false | <minutes>,\n");
   Print("  globalUnrolling := true | false,\n");
   Print("  globalUnrollingMin := <positive int>,\n");
   Print("  globalUnrollingMax := <positive int>,\n");
end;

#F CheckSearchOptionsRecord( <search-options-record> )
#F   checks whether <search-options-record> is a valid search options record
#F

CheckSearchOptionsRecord := function( R )
   local r;

   if not IsRec(R) then
    Error("<R> must be an search options record");
  fi;

  # check fields
  for r in RecFields(R) do
     if r = "timeLimit" then
        if not ( R.(r) = false or ( IsInt(R.(r)) and R.(r) > 0 ) ) then
       Error( "timeLimit must be either false or a positive integer" );
    fi;

     elif r = "globalUnrolling" then
        if not IsBool(R.(r)) then
       Error( "Search option globalUnrolling must be true or false" );
    fi;
     elif r = "globalUnrollingMin" then
        if not IsInt(R.(r)) then
       Error( "globalUnrollingMin is not an integer" );
    fi;
     elif r = "globalUnrollingMax" then
        if not IsInt(R.(r)) then
       Error( "globalUnrollingMax is not an integer" );
    fi;
     elif r = "timeBaseCases" then
        if not IsBool(R.(r)) then
       Error( "Search option timeBaseCases must be true or false" );
    fi;
     fi;
  od;

  return true;
end;

#F MergeSearchOptionsRecord( <search-options-record> )
#F   merges <search-options-record> with the default values
#F

MergeSearchOptionsRecord := function( R )
   local OR, r;

   CheckSearchOptionsRecord(R);

   OR := ShallowCopy(R);
   for r in RecFields(SEARCH_DEFAULTS) do
      if not IsBound( OR.(r) ) then
         OR.(r) := SEARCH_DEFAULTS.(r);
      fi;
   od;

   if OR.globalUnrolling = true and
      OR.globalUnrollingMin > OR.globalUnrollingMax then
      Error( "globalUnrollingMin > globalUnrollingMax" );
   fi;

   return OR;
end;

#F DP Options Record
#F -----------------

#F The DP Options Records maintain options for the Dynamic Programming search
#F algorithm.  This is a combination of both search options specific to DP
#F as well as general search options.

#F PrintSpecDPOptionsRecord()
#F   prints the specification for the DP search options
#F

PrintSpecDPOptionsRecord := function()
   Print("rec(\n");
   PrintSpecSearchOptionsRecord();
   Print("  nBest := <positive integer>,\n");
   Print("  optimize := \"minimize\" | \"maximize\",\n");
   Print("  hashTable := <hashTable>,\n");
   Print("  verbosity := <non-negative integer>\n");
   Print(");\n");
end;

#F CheckDPOptionsRecord( <DP-options-record> )
#F   checks to see if DP-options-record is valid
#F

CheckDPOptionsRecord := function( R )
   local r;

   CheckSearchOptionsRecord(R);
   for r in RecFields(R) do
      if r = "nBest" then
         if not ( IsInt(R.(r)) and R.(r) > 0 ) then
        Error( "nBest must be a positive integer" );
     fi;
      elif r = "verbosity" then
         if not ( IsInt(R.(r)) and R.(r) >= 0 ) then
        Error( "verbosity must be a non-negative integer" );
     fi;
      elif r = "optimize" then
         if not R.(r) in ["minimize","maximize"] then
        Error( "optimize must be to minimize or maximize" );
     fi;
      elif r = "hashTable" then
         if not IsHashTable( R.(r) ) then
        Error( "hashTable must be a valid hashTable" );
         fi;
      elif r = "hashTableBases" then
         if not IsHashTable( R.(r) ) then
        Error( "hashTableBases must be a valid hashTable" );
         fi;
      elif r = "breakdownRules" then
         if not IsRec( R.(r) ) then
        Error( "breakdownRules must be a record" );
         fi;
      elif not r in RecFields(SEARCH_DEFAULTS) and  r <> "DPVec" and r <> "measureFunction" and r <> "wrap"
      and not IsSystemRecField(r) then
         Error( "Unknown DPOptionsRecord field <r>" );
      fi;
   od;
end;

#F MergeDPOptionsRecord( <DP-options-record> )
#F   merges <DP-options-record> with the defaults
#F

MergeDPOptionsRecord := function( R )
   local OR, r;

   CheckDPOptionsRecord(R);
   OR := MergeSearchOptionsRecord(R);
   for r in RecFields(DP_DEFAULTS) do
      if not IsBound( OR.(r) ) then
         OR.(r) := DP_DEFAULTS.(r);
      fi;
   od;

   return OR;
end;

# Implement Options Record
# ------------------------

#F The Implement Options Records maintain options for timed search.
#F

# Utility for Search algorithms to check dataType in SPLOpts
# ----------------------------------------------------------

#F SearchCheckDataType( <spl>, <SPL-options-record> )
#F   Checks to see that the dataType is set properly for the given spl.
#F   Sets it if no default was given.
#F

SearchCheckDataType := function( spl, SPLOpts )
   if not IsBound( SPLOpts.dataType ) then
      Error( "SPLOpts.dataType not bound" );
   fi;

   if SPLOpts.dataType = "no default" then
      if IsRealSPL(spl) then
         SPLOpts.dataType := "real";
      else
         SPLOpts.dataType := "complex";
      fi;
   elif SPLOpts.dataType in ["real","complex"] then
       ;
      # YEVGEN: This should not be too ambitious with error checking
      # we currently use real datatype for complex transforms (RC operator is applied
      # to get a real formula).

      #if (not IsRealSPL(spl)) and SPLOpts.dataType = "real" then
      #   Error("Real data type specified but spl is complex");
      #fi;
   else
      Error("SPLOpts.dataType is not \"real\" or \"complex\"");
   fi;
end;


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Class(SMP_UnparseMixin, rec(
    includes := ["<include/threads.h>", "<include/smp2.h>"],

    # nothing to do here, threads must be started outside
    smp_fork := (self, o, i, is) >> Print(
        Blanks(i), "/* region must be executed concurrently by ", o.nthreads, " threads */ \n",
        Blanks(i), "{\n",
        self(o.cmd, i+is, is),
        Blanks(i), "}\n"
    ),

    smp_loop := meth(self, o, i, is)
        local v, lo, hi;
        v := o.var;
        lo := 0;
        hi := o.range-1;
        Print(Blanks(i), "{ /* begin parallel loop */\n");
        Print(Blanks(i+is), self.printf("int $1 = $2; \n", [o.tidvar, o.tidexp]));
        Print(Blanks(i+is), self.printf("for(int $1 = $2; $1 <= $3; $1 += $4) {\n", [v, o.tidvar + lo, hi, o.nthreads]));
        self(o.cmd,i+is+is,is);
        Print(Blanks(i+is), "}\n");
        Print(Blanks(i), "} /* end parallel loop */\n");
    end,

    threadId := (self, o, i, is) >> Print("tid")   # Error ??
));

Class(OpenMP_UnparseMixin, SMP_UnparseMixin, rec(
    includes := ["<omp.h>"],

    # start threads using 'omp parallel' pragma
    smp_fork := (self, o, i, is) >> Print(
        Blanks(i), "#pragma omp parallel num_threads(", o.nthreads, ")\n",
        Blanks(i), "{\n",
        self(o.cmd, i+is, is),
        Blanks(i), "}\n"
    ),

    threadId := (self,o,i,is) >> Print("omp_get_thread_num()"),
    barrier := (self,o,i, is) >> Print("#pragma omp barrier\n")
));

Class(OpenMP_UnparseMixin_ParFor, SMP_UnparseMixin, rec(
    includes := ["<omp.h>"],

    # start threads using 'omp parallel' pragma
    smp_fork := (self, o, i, is) >>
        Print(Blanks(i), "/* SMP fork */\n",
        Blanks(i), "{\n",
#   NOTE: why do I need to do that??
        self.opts.unparser(o.cmd,i+is,is),
#        self(o.cmd, i+is, is),
        Blanks(i), "}\n"
    ),

    threadId := (self,o,i,is) >> Print("omp_get_thread_num()"),
    barrier := (self,o,i, is) >> Print(Blanks(i), "/* SMP barrier */\n"),

    smp_loop := (self,o,i,is) >> let(v := o.var, lo := 0, hi := o.range,
            Print(Blanks(i), "#pragma omp parallel for schedule(static, ", Int((hi+1)/2), ")\n",
            Blanks(i), "for(int ", v, " = ", lo, "; ", v, " < ", hi, "; ", v, "++) {\n",
                Blanks(i + is), "int ", o.tidvar, " = ", v, ";\n",
#   NOTE: why do I need to do that??
                self.opts.unparser(o.cmd,i+is,is),
#                self(o.cmd,i+is,is),
                Blanks(i), "}\n")),
));


if <condition> then
    <statements>
elif <condition> then
    <statements>
else
    <statements>
fi;


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Class(assign_cmd, ExpCommand, rec(
    op_in := self >> Set( List(Drop(self.args,1), ArgsExp)),
    op_out := self >> Set([self.args[1]]),
    op_inout := self >> Set([]),
    unparse := "assign_cmd",
));

Class(neg_cmd, assign_cmd);

Class(fma_cmd,  assign_cmd, rec(exp_op := fma));
Class(fms_cmd,  assign_cmd, rec(exp_op := fms));
Class(nfma_cmd, assign_cmd, rec(exp_op := nfma));

# Examples:
#   assign(t1, add(t1, t2)) == assign_add(t1, t2),
#   assign(t1, add(t2, t3)) == chain(assign(t1, t2), assign_add(t2, t3)).
#

_threeop_bintab := WeakRef(tab());
_threeop_binlist := [];

ThreeOpFromBinOp := function(arg)
    local op;
    for op in arg do
        _threeop_bintab.(op.exp_op.__name__) := op;
        Add(_threeop_binlist, op.exp_op);
    od;
end;

ThreeOpFromBinOp(
   Class(add_cmd, assign_cmd, rec( exp_op := add )),
   Class(mul_cmd, assign_cmd, rec( exp_op := mul )),
   Class(sub_cmd, assign_cmd, rec( exp_op := sub ))
);

Class(ThreeOpRuleSet, RuleSet);
RewriteRules(ThreeOpRuleSet, rec(
    neg := Rule([assign, @(1), [neg, @(2)]], e -> neg_cmd(@(1).val, @(2).val)),

    fma  := Rule([assign, @(1), [ fma, @(2), @(3), @(4)]], e ->  fma_cmd(@(1).val, @(2).val, @(3).val, @(4).val)),
    fms  := Rule([assign, @(1), [ fms, @(2), @(3), @(4)]], e ->  fms_cmd(@(1).val, @(2).val, @(3).val, @(4).val)),
    nfma := Rule([assign, @(1), [nfma, @(2), @(3), @(4)]], e -> nfma_cmd(@(1).val, @(2).val, @(3).val, @(4).val)),

    binop := Rule([assign, @(1), [@(0,_threeop_binlist) , @(2), @(3)]], e -> _threeop_bintab.(@(0).val.__name__)(@(1).val, @(2).val, @(3).val)),
));

ThreeOpMacroUnparser_Mixin := rec(

    add_cmd := (self,o,i,is) >> Print(Blanks(i), self.prefixTTT("ADD", o.args[1].t, o.args[2].t, o.args[3].t, o.args), ";\n"),
    sub_cmd := (self,o,i,is) >> Print(Blanks(i), self.prefixTTT("SUB", o.args[1].t, o.args[2].t, o.args[3].t, o.args), ";\n"),
    mul_cmd := (self,o,i,is) >> Print(Blanks(i), self.prefixTTT("MUL", o.args[1].t, o.args[2].t, o.args[3].t, o.args), ";\n"),
    neg_cmd := (self,o,i,is) >> Print(Blanks(i), self.prefixTT( "NEG", o.args[1].t, o.args[2].t, o.args), ";\n"),

    fma_cmd  := (self,o,i,is) >> Print(Blanks(i), self.prefixTTTT("FMA", o.args[1].t, o.args[2].t, o.args[3].t, o.args[4].t, o.args), ";\n"),
    fms_cmd  := (self,o,i,is) >> Print(Blanks(i), self.prefixTTTT("FMS", o.args[1].t, o.args[2].t, o.args[3].t, o.args[4].t, o.args), ";\n"),
    nfma_cmd := (self,o,i,is) >> Print(Blanks(i), self.prefixTTTT("NFMA", o.args[1].t, o.args[2].t, o.args[3].t, o.args[4].t, o.args), ";\n"),

);

DoThreeOp := function(c, opts)
    c := MarkDefUse(c);
    c := BinSplit(c);
    c := ThreeOpRuleSet(c);
    return c;
end;

ThreeOp_CS := Concatenation(BaseIndicesCS, [
    MarkDefUse, #
    (c, opts) -> CopyPropagate(c, CopyFields(opts, rec(autoinline := true))),
    MarkDefUse, #
    (c, opts) -> CopyPropagate(c, CopyFields(opts, rec(autoinline := true))),
    DoThreeOp,
    Compile.declareVars
]);

Class(ThreeOpUnparser, CMacroUnparserProg, rec(
    add_cmd := (self,o,i,is) >> self.prefixTTT("ADD", o.args[1].t, o.args[2].t, o.args[3], o.args),

    sub_cmd := (self,o,i,is) >> self.prefixTTT("SUB", o.args[1].t, o.args[2].t, o.args[3], o.args),

    neg_cmd := (self,o,i,is) >> self.prefixT("NEG", o.t, o.args),

    # first argument of mul_cmd is the result, 2nd and 3rd are operands
    mul_cmd := (self,o,i,is) >> When(Length(o.args)=3,
            let(
            # check if constant ended up in slot #3
            a := When(IsValue(o.args[3]), o.args[3], o.args[2]),
            b := When(IsValue(o.args[3]), o.args[2], o.args[3]),
            When(not (IsValue(a) or (IsVar(a) and IsBound(a.value))),
                # <a> is not a constant
                self.prefixTTT("MUL", o.args[1], a, b, [o.args[1],a,b]),
                #self.prefix(Concat("MUL_", self._pfx(a.t), "_", self._pfx(b.t)), [o.args[1],a,b]),
                # <a> is a constant
                let(fmt := self._const( When(IsValue(a), a, a.value) ),
                    self.prefix(Concat("MUL_", o.args[1]._pfx(o.args[1].t), "CNST", "_", self._pfx(b.t)), [o.args[1], GetExponent(a.value), GetMantissa(a.value), b]))))),
#                   self.prefix(Concat("MUL_", o.args[1]._pfx(o.args[1].t), fmt[1], "_", self._pfx(b.t)), [o.args[1], a, b]))))),
#                        # check if constant is special, and does not go into MUL args
#                        # for example fmt[1]="I" denotes sqrt(-1), one such constant
#                        #When(fmt[2]=[], [b], [a, b])))))),

#    add_cmd := (self, o, i, is) >> Print(Blanks(i), self.prefix(self, i, is), ";\n"),
#    sub_cmd := ~.add_cmd

    prefixT := (self, funcname, t, args) >>
        self.prefix(Concat(funcname, "_", self._pfx(t)), args),

    prefixTT := (self, funcname, t1, t2, args) >>
        self.prefix(Concat(funcname, "_", self._pfx(t1), "_", self._pfx(t2)), args),

    prefixTTT := (self, funcname, t1, t2, t3, args) >>
        self.prefix(Concat(funcname, "_", self._pfx(t1), "_", self._pfx(t2), "_", self._pfx(t3)), args),

    _pfx := (self, t) >> Cond(
        ObjId(t) = T_Complex, "CPX",
        ObjId(t) = T_Real,    "FLT",
        t = TComplex, "CPX",
        t = TReal,    "FLT",
        t = TInt or ObjId(t) in [TArray, TPtr], "INT",
        t = TUnknown, "UNK",
        ObjId(t) = TSym, "SYM",
        IsVecT(t), Cond(
            t.t = TReal, Concat("FV",StringInt(t.size)),
            t.t = TComplex, Concat("FC",StringInt(t.size)),
            t.t = TInt, Concat("IV",StringInt(t.size)),
            Error("Can't handle type ", t)
        ),
        Error("Can't handle type ", t)),

    # returns a tuple [suffix, args], where suffix is used for MUL_XXX or C_XXX,
    # and args are additional parameters into C_XXX
    _const := (self,o) >> Cond(
        o.t = TReal and IsCyc(o.v),        ["FLT", [ReComplex(Complex(o.v))]],
        o.t = TReal,                       ["FLT", [o.v]],
        o.t = TInt,                        ["INT", [o.v]],
        o.t = TUnknown,                    ["INT", [o.v]], # NOTE: there is a bug that creates V(0) with TUnknown
        o.t = TString,                     ["STR", [o.v]],
        o.t = TBool,                       ["INT", [When(o.v in [true, 1], 1, 0)]],
        Error("Don't know how to handle constant of type ", o.t)
    ),
));

EncodeFloat := function(f)
    local a, exp, mant, tmp, flag;

    #shift by max exponent, which is +/- 127 in IEEE floating point
    if (IntDouble(f)=0) then
        exp := Log2Int(IntDouble(f*2^127))-127;
    else
        exp := Log2Int(IntDouble(f));
    fi;

    tmp := f/(2^exp);
    mant := tmp - IntDouble(tmp);
    mant := IntDouble(mant * 2^23);

        a:= rec(exp:= exp+127, mant:=mant);

    return a;
end;

DecodeToFloat := function(exp, mant)
    local f;

    if (mant<0) then
        mant := -mant;
        f := mant / (2^23);
        f := f + 1;
        f:= f * (2^(exp-127));
        f:= -f;
    else
        f := mant / (2^23);
        f := f + 1;
        f:= f * (2^(exp-127));
    fi;

    return f;
end;

GetExponent := function(f)
    local exp;

    #shift by max exponent, which is +/- 127 in IEEE floating point
    if (IntDouble(f)=0) then
        exp := Log2Int(IntDouble(f*2^127))-127;
    else
        exp := Log2Int(IntDouble(f));
    fi;

    return exp + 127;
end;

GetMantissa := function(f)
    local a, exp, mant, tmp, flag;

    #shift by max exponent, which is +/- 127 in IEEE floating point
    if (IntDouble(f)=0) then
        exp := Log2Int(IntDouble(f*2^127))-127;
    else
        exp := Log2Int(IntDouble(f));
    fi;

    tmp := f/(2^exp);
    mant := tmp - IntDouble(tmp);
    mant := IntDouble(mant * 2^23);

    return mant;
end;


ZapGremlins := function(s)
  local upper, lower, c, i, n, t;
  upper := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
  lower := "abcdefghijklmnopqrstuvwxyz";
  t := [ ];
  i := 1;
  for c in s do
    n := Position(upper, c);
    if n <> fail then
      t[i] := lower[n];
      i := i + 1;
    else
      n := Position(lower, c);
      if n <> fail then
        t[i] := c;
        i := i + 1;
      fi;
    fi;
  od;
  return t;
end;

IsPalindrome := function(s)
  local t;
  t := ZapGremlins(s);
  return t = Reversed(t);
end;


# Copyright (c) 2018-2020, Carnegie Mellon University
# See LICENSE for details

ObjLookup := arg -> ApplyFunc(ObjHash.objLookup, arg);
ObjAdd    := arg -> ApplyFunc(ObjHash.objAdd, arg);
MemClass  := arg -> ApplyFunc(ObjHash.memClass, arg);
MemClassFunc  := arg -> ApplyFunc(ObjHash.memClassFunc, arg);
SingletonAdd  := arg -> ApplyFunc(ObjHash.singletonAdd, arg);

objs := x -> Filtered(Collect(x, @), IsRec);
uids := x -> List(objs(x), o->o.uid);
### init
SingletonAdd(TInt);
SingletonAdd(TComplex);
SingletonAdd(TUnknown);
SingletonAdd(TReal);

MemClass(TArray);
MemClass(TArrayBase);
MemClass(TVect);

#ClassSPL.hash := ObjHash;
#Function.hash := ObjHash;

########
MemClass(Exp);
MemClass(ListableExp);
MemClass(Lambda);
MemClass(FList);
MemClass(FData);
MemClass(nth);
MemClass(Value);

MemClassFunc(Value, "new", "new_no_memo");
MemClassFunc(Value, "newbase", "newbase_no_memo");


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

## Hackity.
#Class(fcall_addr, fcall, rec(
#        computeType := self >> self.args[3].t
#));

# A dist_loop is a parallel loop with domain=#spus

Class(dist_loop, loop_base, rec(
   __call__ := meth(self, P, loopvar, range, cmd)
       local result;
       Constraint(IsVar(loopvar));
       Constraint(IsCommand(cmd));
       range := toRange(range);

       loopvar.setRange(range);
       #loopvar.isLoopIndex := true;
       return WithBases(self, rec(
           operations := CmdOps,
           P := P,
           var := loopvar,
           cmd := cmd,
           range := listRange(range)
       ));
   end,

   rChildren := self >> [self.P, self.var, self.range, self.cmd],
   rSetChild := rSetChildFields("P", "var", "range", "cmd"),

   #rChildren := self >> [self.P, self.var, self.cmd],
   #rSetChild := rSetChildFields("P", "var", "cmd", "range"),
   #from_rChildren := (self, rch) >> ApplyFunc(ObjId(self), [rch[1], rch[2], self.range, rch[3]]),

   print := (self, i, is) >> Print(self.name, "(", self.P, ", ", self.var, ", ",
       Blanks(i+is),
       self.cmd.print(i+is, is),
       Print("\n", Blanks(i), ")")),

   #NOTE: This should go in loop_bases, which should free self.vars only if it's bound.
   free := meth(self) local c;
       c := self.cmd.free();
       return c;
   end

));

Class(DistCodegen, VectorCodegen, rec(
    # Wed 16 Jul 2008 07:17:33 PM EDT
    #NOTE: commenting this out! Check to see if this is now equivalent to DefaultCodegen.Formula.
    # This had BlockSums() commented out. Why?

    #NOTE: Need to find a way (hack?) to callback DefaultCodegen's formula with one extra stage, etc.
    #Formula := meth(self, o, y, x, opts)
    #    local icode, datas, prog, params, sub, initsub, io;
    #    if IsBound(opts.XType) then x.t := TPtr(opts.XType); fi;
    #    if IsBound(opts.YType) then y.t := TPtr(opts.YType); fi;

    #    o := o.child(1);
    #    params := Set(Collect(o, param));

    #    datas := Collect(o, FDataOfs);
    #    #o := BlockSums(opts.globalUnrolling, o);
    #    icode := self(o, y, x, opts);
    #    icode := RemoveAssignAcc(icode);
    #    icode := BlockUnroll(icode, opts);
    #    # icode := PowerOpt(icode);
    #    icode := DeclareHidden(icode);
    #    # icode := InsertBarriers(icode);
    #    if IsBound(opts.isFixedPoint) and opts.isFixedPoint then
    #        icode := FixedPointCode(icode, opts.bits, opts.fracbits);
    #    fi;

    #    io := When(X=Y, [X], [Y, X]);
    #    #io := When(IsBound(opts.multibuffer_its) and opts.multibuffer_its > 1,
    #    #                Concatenation(io, [Yprev, Xnext]),
    #    #                io);
    #    sub := Cond(IsBound(opts.subName), opts.subName, "transform");
    #    initsub := Cond(IsBound(opts.subName), Concat("init_", opts.subName), "init");
    #    icode := func(TVoid, sub, Concatenation(io, params), icode);

    #    if IsBound(opts.generateInitFunc) and opts.generateInitFunc then
    #        prog := program(
    #            decl(List(datas, x->x.var),
    #                chain(
    #                    func(TVoid, initsub, params, chain(List(datas, x -> SReduce(x.var.init, opts)))),
    #                    icode
    #                )));
    #    else
    #        prog := program( func(TVoid, initsub, params, chain()), icode);
    #    fi;
    #    prog.dimensions := o.dimensions;
    #    return prog;
    #end,

    # ---------------
    # Container
    # ---------------

#    DContainer := meth(self, o, y, x, opts)
#         local spuid;
#         spuid := var.fresh_t("spuid", TInt);
#         return( decl(
#             spuid,
#             self(o.child(1), y, x, opts)
#             ));
#      end,

    DContainer := (self, o, y, x, opts) >> self(o.child(1), y, x, opts),

    # ---------------
    # Gather
    # ---------------

    #GathDist := (self, o, y, x, opts) >> self(Gath(fId( (o.N/o.P)*o.pkSize )), y, x, opts),
    GathDist := (self, o, y, x, opts) >> call(var("// GathDist"), y, x),

    # Pass the base pointer of the data to be transferred as a param to the DMA_GET

    GathRecv := meth(self, o, y, x, opts)
        local i, func, rfunc, ix;
        i := Ind(); func := o.func.lambda();

        # Standard Gather
        #return loop(i, o.func.domain()/o.P, assign(nth(y, i), nth(x, func.at(i))));

        # We shouldn't use func.at(i), since we've done ScatSend-side normalizing already
        #return chain(
        #    #dist_barrier(),
        #    # Moving dist_barrier to scatsend for now
        #    call(var("// BLOCK_ON_READ")),
        #    loop(i, o.pkSize*o.func.domain()/o.P, assign(nth(y, i), nth(x, i)))
        #);

        return call(var("// Gath_Recv"), y, x);
    end,

    # ---------------
    # Scatter
    # ---------------

    #ScatDist := (self, o, y, x, opts) >> self(Scat(fId( (o.N/o.P)*o.pkSize )), y, x, opts),
    ScatDist := (self, o, y, x, opts) >> call(var("// ScatDist"), y, x),

    #NOTE: Assuming that Length(Y) is the full size of the transform.

                   #idiv(func.at( (i*pkSize)+(chunkSize*o.i) ), chunkSize), # This is the SPU#
    ScatSend := meth(self, o, y, x, opts)
        local i, func, rfunc, ix, pkSize, numPktsPerSPU;
        func          := o.func.lambda();
        pkSize        := o.pkSize;
        numPktsPerSPU := o.func.domain()/o.P;
        i             := Ind(numPktsPerSPU);

        return chain(loop(i, numPktsPerSPU, chain(                            # Loop over number of packets
           call(var("SCATSEND_PUT"),
               x,                                                       # Base address of X
               i*pkSize,                                                # Offset of X in elements
               fcall(var("ADDR", TFunc(TInt, TInt, TULongLong)),
                   idiv(func.at((numPktsPerSPU*o.i)+i), numPktsPerSPU), # This is the SPU#
                   y                                                    # Base address of Y
               ),
               mul(
                imod(func.at((numPktsPerSPU*o.i)+i), numPktsPerSPU),    # Offset of Y in elements
                pkSize),
               pkSize                                                   # Size of DMA transfer in elements
           )
        )),
        dist_barrier());

        # Standard Scatter

        # return loop(i, numPktsPerSPU,                                    # Loop over number of packets * pkSize
        #     assign(nth(y, func.at(i)), nth(x, i))
        # );
    end,

    # ---------------
    # Sum
    # ---------------

    # For now, assume loop range = # of spus

    DistSum := (self, o, y, x, opts) >> let(
        dist_loop(o.P, o.var, o.domain, self(o.child(1), y, x, opts))
        ),

    DistSumLoop := (self, o, y, x, opts) >> chain(
        dist_loop(o.P, o.var, o.domain, self(o.child(1), y, x, opts)),
        dist_barrier()
        ),

# Doesn't work for unrolled code.
#   DistSum := (self, o, y, x, opts) >> let(
#       Constraint(o.domain = opts.spus),
#       # If we're GathRecv'ing inside, we must sync before getting into the loop.
#       When(o._children[1]._children[Length(o._children[1]._children)].name = "GathRecv",
#         chain(dist_barrier(), dist_loop(o.P, o.var, o.domain, self(o.child(1), y, x, opts))),
#         dist_loop(o.P, o.var, o.domain, self(o.child(1), y, x, opts))
#       )
#    )

    # PTensor and Comm_Cell are used by ParCellDMP only.
    PTensor := (self, o, y, x, opts) >> self(o.L, y, x, opts),

    # Looped version (NOTE: works, except since we'll never do more than 8 SPUs for now, we always want a fully unrolled version

    Comm_Cell := meth(self, o, y, x, opts)
        local i;
        i := Ind(o.P);

        return(chain(loop(i, o.P,             # Loop over P
            call(var("SCATSEND_PUT"),
                x,                      # Base address of X
                i*o.pkSize,             # Offset of X in elements
                fcall(var("ADDR"),
                    i,                  # This is the SPU#
                    y                   # Base address of Y
                ),
                fcall(var("SPUID_TIMES"), o.pkSize),             # Offset of Y in elements (MUST BE spuid*pkSize!)
                o.pkSize                # Size of DMA transfer in elements
                )
        ),
        dist_barrier()
        ));
    end

));


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

#
# keys.gi -- define string constants used as keys in scriptgen package
#

# transforms

SGKEY_FFT		:= "FFT";
SGKEY_FFT_2D	:= "FFT2D";
SGKEY_FFT_3D	:= "FFT3D";
SGKEY_IFFT		:= "IFFT";
SGKEY_IFFT_2D	:= "IFFT2D";
SGKEY_IFFT_3D	:= "IFFT3D";
SGKEY_WHT		:= "WHT";

# data types

SGKEY_DPCX		:= "DPCX";
SGKEY_SPCX		:= "SPCX";

# ScriptGen settings

SGKEY_DATATYPE		:= "datatype";
SGKEY_FILENAME		:= "filename";
SGKEY_FUNCNAME		:= "funcname";
SGKEY_SIZE			:= "size";
SGKEY_TRANSFORM		:= "transform";

# ScriptGen settings details

SGKEY_DISPLAYNAME		:= "displayname";
SGKEY_MULTIPLEVALUES	:= "multipleValues";
SGKEY_NAME				:= "name";
SGKEY_TYPE				:= "type";

# Special keys

SGKEY_DEFAULT	:= "default";

# String constants

SGSTR_STDOUT	:= "*stdout*";

SGSTR_ALL			:= "all";
SGSTR_CONSTRUCTOR	:= "constructor";
SGSTR_RUNRANDOMALL	:= "runRandomAll";
SGSTR_RUNALL		:= "runAll";

# Settings types

SGTYPE_INT		:= "i";
SGTYPE_BOOL		:= "b";
SGTYPE_STRING	:= "s";

# display names associated with keys

_SG_displayNames := rec(
	(SGKEY_FFT)			:= "Fast Fourier Transform",
	(SGKEY_FFT_2D)		:= "2D Fast Fourier Transform",
	(SGKEY_FFT_3D)		:= "3D Fast Fourier Transform",
	(SGKEY_IFFT)		:= "Inverse Fast Fourier Transform",
	(SGKEY_IFFT_2D)		:= "2D Inverse Fast Fourier Transform",
	(SGKEY_IFFT_3D)		:= "2D Inverse Fast Fourier Transform",
	(SGKEY_WHT)			:= "Walsh-Hadamard Transform",

	(SGKEY_DPCX)		:= "Double-Precision Complex",
	(SGKEY_SPCX)		:= "Single-Precision Complex",

	(SGKEY_DATATYPE)	:= "Data Type",
	(SGKEY_FILENAME)	:= "File Name",
	(SGKEY_FUNCNAME)	:= "Function Name",
	(SGKEY_SIZE)		:= "Size",
	(SGKEY_TRANSFORM)	:= "Transform",

	(SGSTR_RUNRANDOMALL) := "Generate Code (quick search)",
	(SGSTR_RUNALL)		 := "Generate Code (in-depth search)",
);

GetScriptGenDisplayName := function(key)
	if IsString(key) and IsBound(_SG_displayNames.(key)) then
		return _SG_displayNames.(key);
	elif (not IsString(key)) and IsList(key) and (Length(key) = 2) then
		if ForAll(key, IsInt) then
			return StringPrint(key[1], " x ", key[2]);
		fi;
	fi;

	return StringPrint(key);
end;

SetScriptGenDisplayName := function(key, string)
	if not ( IsString(key) and IsString(string) ) then
		Error("usage: SetScriptGenDisplayName(key, string)\n  both <key> and <string> must be strings");
	fi;

	_SG_displayNames.(key) := string;
end;

# documentation associated with keys

_SG_docunmentationForKeys := rec(
);

GetScriptGenDocumentation := function(key)
	if IsString(key) and IsBound(_SG_docunmentationForKeys.(key)) then
		return _SG_docunmentationForKeys.(key);
	fi;

	return "";
end;

SetScriptGenDocumentation := function(key, string)
	if not ( IsString(key) and IsString(string) ) then
		Error("usage: SetScriptGenDocumentation(key, string)\n  both <key> and <string> must be strings");
	fi;

	_SG_docunmentationForKeys.(key) := string;
end;


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Class(AStream, rec(
#D Class(AStream, ATag, rec(
#D    isStream := true,
    __call__ := (self, bs) >> WithBases(self, rec(bs:=bs)),
    print := (self) >> Print(self.name, "(", self.bs, ")"),
    operations := Inherit(PrintOps, rec(\= := (self, other) >> ObjId(other) = ObjId(self) and self.bs = other.bs)),
    #?? legal_kernel := (self,p) >> self.bs <= 2^p

    # If we have a block size of 1, allow a radix 2 kernel so we can fold further.
    legal_kernel := (self, p) >> Cond(self.bs=1, p=2, p <= self.bs),

    # BWD: Somehow this becomes a tag, so we need .kind
    kind := self >> ObjId(self)
));