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

# ================================================================
# Integer Strength Reduction Rules
# ================================================================

Class(RulesStrengthReduce, RuleSet);

#F SReduceSimple(<c>) -- applies strength reduction rules to any object <c>
#F                       disables <opts> sensitive rules
SReduceSimple  := c -> ApplyStrategy(c, [RulesStrengthReduce], BUA, rec());

#F SReduce(<c>, <opts>) - applies strength reduction rules to any object <c>
#F
SReduce  := (c,opts) -> ApplyStrategy(c, [RulesStrengthReduce], BUA, opts);

#@1:=@(1);
#@2:=@(2);

@1int := @(1).cond(e -> IsValue(e) and IsInt(e.v));
@2int := @(2).cond(e -> IsValue(e) and IsInt(e.v));
@2ge_var := than@ -> @(2).cond(
    e -> IsValue(e) and IsBound(than@.val.range) and than@.val.range <= e.v);

isNegV := o -> o.v<0;
isNonZero := o -> o <> 0;

@negVal := @.target(Value).cond(isNegV);

@2Teq1 := @(2).cond( x -> x.t = @(1).val.t );

_0noneOrZero := (t) -> When(ObjId(@(0).val)=noneExp, noneExp(t), t.zero());
_sameTasOp := (opname, func) -> @@(0, [Value, noneExp]).cond((e, cx) ->
    let( op := Last(cx.(opname)),
        func(e) and ForAny(op.args, (a) -> not Same(a, e) and a.t=op.t)
    )
);

v0:=V(0);
v1:=V(1);

@vpos  := (n) -> @(n, Value, e -> IsPosInt(e.v));
@vpos0 := (n) -> @(n, Value, e -> IsPosInt0(e.v));

RewriteRules(RulesStrengthReduce, rec(

 # FF: SAR-specific rule. Not sure if they should be turned on by default.
 # YSV: below rule is invalid, because idiv(a+b, c) <> idiv(a) + idiv(b)
 #      example: idiv(2+3, 4) == 1
 #               idiv(2,4) + idiv(3,4) == 0
 # div_sar := Rule([@(1,idiv), @(2, add), @(3,Value) ], e -> ApplyFunc(add, List(@(2).val.args, i->idiv(i, @(3).val)))),

 ################
 # leq
 # ===========
 leq_single := Rule([leq, @(1)], e-> V_true),
 leq_eq := Rule([leq, @(1), @(2), @(3).cond(e->e=@(1).val)], e -> eq(@(1).val, @(2).val)),

 leq_val_mulindex     := Rule( [leq, @vpos0(1), [mul, @vpos0(2), @(3, [var, param], IsLoopIndex)]],
     e -> leq(idiv(@(1).val + @(2).val - 1, @(2).val), @(3).val)),

 leq_val_mulindex_val := Rule( [leq, @vpos0(1), [mul, @vpos(2), @(3, [var, param], IsLoopIndex)], @vpos0(4)],
     e -> leq(idiv(@(1).val + @(2).val - 1, @(2).val), @(3).val, idiv(@(4).val, @(2).val))),

 leq_mulindex_val     := Rule( [leq, [mul, @vpos0(2), @(3, [var, param], IsLoopIndex)], @vpos0(4)],
     e -> leq(@(3).val, idiv(@(4).val, @(2).val))),

 leq_index_neg := Rule([leq, @(2,var,IsLoopIndex), @(3, Value, x->x.v<0), ...], e -> V_false),
 leq_index_big := ARule(leq, [@(2,var,x->IsLoopIndex(x) and IsInt(x.range)), @(3, Value, x->x.v >= @(2).val.range-1)],
     e -> [@(2).val]),

 leq_neg_mul_index := Rule([leq, [mul, @(2, Value, x->x.v>0), @(3,var,IsLoopIndex)], @(4, Value, x->x.v<0), ...],
     e -> V_false),

 leq_index_0 := Rule([leq, @(2,var,IsLoopIndex), @(3, Value, x->x.v=0)], e -> eq(@(2).val, @(3).val)),
 leq_mul_index_0 := Rule([leq, [mul, @(2, Value, x->x.v<>0), @(3,var,IsLoopIndex)], @(4, Value, x->x.v=0)],
     e -> eq(@(3).val, @(4).val)),

 leq_neg_index_A := ARule(leq, [@(1, Value, x->x.v<=0), @(2,var,IsLoopIndex)], e -> [@(2).val]),
 leq_neg_mul_index_A := ARule(leq, [@(1, Value, x->x.v<=0), [@(0,mul), @(2, Value, x->x.v>0), @(3,var,IsLoopIndex)]],
     e -> [@(0).val]),

 leq_val_val_l := Rule([leq, @(1, Value), @(2, Value, x->@(1).val<=x), @, ...],
     e -> ApplyFunc(leq, Drop(e.args, 1))),
 leq_val_val_r := Rule([leq, ..., @, @(1, Value), @(2, Value, x->@(1).val<=x)],
     e -> ApplyFunc(leq, DropLast(e.args, 1))),

 ################
 # add/sub/mul 0
 # =============
 subzr := Rule([sub, @1, _sameTasOp("sub", _is0none)], e -> @1.val),
 subzl := Rule([sub, _sameTasOp("sub", _is0none), @1], e -> neg(@1.val)),

 div0 := Rule([@(1, [div, idiv, fdiv]), _0none, @], e->_0noneOrZero(e.t)),
 div1 := Rule([@(1, [div, idiv, fdiv]), @, @@(0).cond((e, cx) -> let( op := Last(cx.(ObjId(@(1).val).__name__)),
     Cond(IsValue(e), isValueOne(e), e=1) and ForAny(op.args, (a) -> not Same(a, e) and a.t=op.t)))],
     e -> @.val),

 add_assoc  := ARule(add, [ @(1,add) ], e -> @1.val.args),
 add_zero   := ARule(add, [_sameTasOp("add", _is0none)], e -> [ ]),
 add_single := Rule([add, @1],          e -> @1.val),

 add_cfold := Rule(@(1,add,e->Length(e.args)>2 and Length(Filtered(e.args, IsValue)) >= 2),
     e -> let(s := SplitBy(e.args, IsValue), values := s[1], exps := s[2],
          ApplyFunc(add, Concatenation([ApplyFunc(add,values)], exps)))),

 sub_sub := Rule( [@(1, sub), @(2), [sub, @(3), @(4)]], e -> sub(add(@(2).val, @(4).val), @(3).val)),

 ################
 # logic and/or
 # ============
 logic_single := Rule([@(1, [logic_and, logic_or]), @1], e->@1.val),
 logic_empty := Rule([@(1, [logic_and, logic_or])], e->V_true),

 logic_and_assoc := ARule(logic_and, [ @(1,logic_and) ], e -> @1.val.args),
 logic_and_false := Rule([logic_and, ..., _vfalse, ...],  e -> V_false),
 logic_and_true := ARule(logic_and, [_vtrue],  e -> [ ]),

 logic_or_assoc := ARule(logic_or, [ @(1,logic_or) ], e -> @1.val.args),
 logic_or_true := Rule([logic_or, ..., _vtrue, ...],  e -> V_true),
 logic_or_false := ARule(logic_or, [_vfalse],  e -> [ ]),

 logic_neg_neg := Rule([logic_neg, [logic_neg, @(1)]], e -> @(1).val),
 logic_neg_eq := Rule([logic_neg, [eq, @(1), @(2)]], e -> neq(@(1).val, @(2).val)),

 # 'maybe' is a "magic" boolean function that behaves as 'true' inside 'and'/'or' operators,
 # but also satisfies the uncertainty rule logic_not(maybe()) = maybe()
 #
 logic_neg_maybe := Rule([logic_neg, @(1, maybe)], e -> @(1).val),
 logic_and_maybe := ARule(logic_and, [maybe], e -> [ ]),
 logic_or_maybe := ARule(logic_or, [maybe], e -> [ ]),

 eq_logic_true := Rule( [eq, @(1), _vtrue], e -> @(1).val ),

 ################
 # mul
 # ===

 # mul_assoc is slow, and we enable it in RulesExpensiveStrength reduce
 #   mul_assoc := ARule(mul, [ @(1,mul) ], e -> @1.val.args),
 mul_one := ARule(mul, [ _sameTasOp("mul", _is1) ],  e -> [ ]),

 mul_single := Rule([mul, @1], e->@1.val),
 mul_zero := Rule([mul, ..., _v0none, ...], e -> _0noneOrZero(e.t)),  # must be @(0).val so that none*x -> none
 mul_mul := Rule([mul, @(1,Value), [mul, @(2,Value), @(3)]], e -> let(
     t := UnifyPair(@(1).val.t, @(2).val.t),
     val := t.value(t.product(@(1).val.v, @(2).val.v)),
     mul(val, @(3).val))),

 # apply distributivity a * (b+c) -> a*b + a*c, only if inside nth()
 mul_add_nth := Rule([@@(0,mul,(e,cx)->IsBound(cx.nth) and cx.nth<>[]), @(1), @(2,add)],
     e -> ApplyFunc(add, List(@(2).val.args, a->@(1).val * a))),

 # FF: NOTE: Need to guard this rule in the SAR case. Not sure how to properly do this.
 # Guard against nth indexing integer tables. This is at the moment only used in SAR.
 # NB: Without guard, there is an infinite loop with sar_sub rule
 mul_sub_nth := Rule([@@(0, mul, (e,cx) -> cx.isInside(nth) and cx.nth[1].loc.t.t <> TInt), @(1), @(2,sub)],
     e -> ApplyFunc(sub, List(@(2).val.args, a->@(1).val * a))),  # Above guard to prevent inf loop with sar_sub

 # NB: Below rule became obsolete due to change in segment length computation
 # sar_sub := Rule([sub, @(1,Value,e->e.t=TInt), [mul, @(2, Value, e->e.t=TInt and IsInt(@(1).val.v/e.v)), @(3)]],
 #    e->mul(@(2).val, sub(@(1).val/@(2).val, @(3).val))),

 # Value * (Value * a +/- Value * b) -> Value * a +/- Value * b
 mul_add_mul := Rule([mul, @(1, Value), [@(0,[add,sub]), [mul, @(2, Value), @(3)], [mul, @(4, Value), @(5)]]],
     e -> let(t1 := UnifyPair(@(1).val.t, @(2).val.t),
              t2 := UnifyPair(@(1).val.t, @(4).val.t),
              op := ObjId(@(0).val),
              op(t1.value(t1.product(@(1).val.v, @(2).val.v)) * @(3).val,
                 t2.value(t2.product(@(1).val.v, @(4).val.v)) * @(5).val))),

 #  mul_cfold := Rule(@(1,mul,e->Length(e.args)>2 and Length(Filtered(e.args, IsValue)) >= 2),
 #   e -> let(s := SplitBy(e.args, IsValue), values := s[1], vars := s[2],
 #            ApplyFunc(mul, Concatenation( [Product(values,v->v.v)], vars)))),

 fpmul_2power := Rule([fpmul, @(1, Value), @(2, Value, e->Is2Power(e.v)), @(3)], e ->
    let(sh := Log2Int(@(2).val.v),
        Cond(sh = @(1).val.v, @(3).val,
             sh > @(1).val.v, arith_shl(@(3).val, sh - @(1).val.v),
             sh < @(1).val.v, arith_shr(@(3).val, @(1).val.v - sh)))),

 # mul_add_expand := Rule([mul, @(1,Value,e->e.t=TInt), @(2,add)],
 #    e -> ApplyFunc(add, List(@2.val.args, a->mul(@1.val, a).eval()))),
 #
 # mul_sub_expand := Rule([mul, @(1,Value,e->e.t=TInt), @(2,sub)],
 #    e -> ApplyFunc(sub, List(@2.val.args, a->mul(@1.val, a).eval()))),

 ##############
 # neg
 # =====
 mul_negone := Rule([mul, _neg1, @2], e -> neg(@2.val)),
 neg_neg := Rule([neg, [neg, @1]], e -> @1.val), # -(-1) -> 1
 neg_sub := Rule([neg, [sub, @1, @2]], e -> sub(@2.val, @1.val)), # -(1-2) -> 2-1
 neg_zero := Rule([neg, _v0none], e -> e.args[1]),

 sub_neg1 := Rule([sub, @1, [neg, @2]], e -> add(@1.val, @2.val)),  # 1-(-2) -> 1+2
 sub_neg2 := Rule([sub, [neg, @1], @2], e -> neg(add(@1.val, @2.val))), # (-1)-2 -> -(1+2)
 add_neg1 := Rule([add, @1, [neg, @2]], e -> sub(@1.val, @2.val)), # 1+(-2) -> 1-2
 add_neg2 := Rule([add, [neg, @1], @2], e -> sub(@2.val, @1.val)), # (-1)+2 -> 2-1

 mul_neg1 := Rule([mul, @1, [neg, @2]], e -> neg(mul(@1.val, @2.val))), # 1*(-2) -> -(1*2)
 mul_neg2 := Rule([mul, [neg, @1], @2], e -> neg(mul(@1.val, @2.val))), # (-1)*2 -> -(1*2)
 mul_negc1 := Rule([mul, @1, @(2,Value,isNegV)], e -> neg(mul(Value.new(@2.val.t, -@2.val.v), @1.val))),
 mul_negc2 := Rule([mul, @(1,Value,isNegV), @2], e -> neg(mul(Value.new(@1.val.t, -@1.val.v), @2.val))),

 #################################
 # general constant folding
 # ==========================

 # The rules below can be used instead of generic cfold to speed up this ruleset
 # cfold_add  := Rule([add, Value,Value], e->Value.new(e.args[1].t, e.args[1].v + e.args[2].v)),
 # cfold_mul  := Rule([mul, Value,Value], e->Value.new(e.args[1].t, e.args[1].v * e.args[2].v)),
 # cfold_sub  := Rule([sub, Value,Value], e->Value.new(e.args[1].t, e.args[1].v - e.args[2].v)),
 # cfold_imod := Rule([imod, Value,Value], e->Value.new(e.args[1].t, e.args[1].v mod e.args[2].v)),
 # cfold_idiv := Rule([idiv, Value,Value], e->Value.new(e.args[1].t, QuoInt(e.args[1].v, e.args[2].v))),
 # cfold_nth  := Rule([nth, @(1,var,e->IsBound(e.value)), Value], e->e.loc.value.v[e.idx.v+1]),
 # cfold_nthv := Rule([nth, Value,Value],                         e->e.loc.v[e.idx.v+1]),
 # cfold_re   := Rule([re, Value], e->Value.new(TDouble, ReComplex(Complex(e.args[1].v)))),
 # cfold_im   := Rule([im, Value], e->Value.new(TDouble, ImComplex(Complex(e.args[1].v)))),
 # cfold_neg  := Rule([neg, Value], e->Value.new(e.args[1].t, -e.args[1].v)),

 # cfold_arith := Rule([@(1,[add,mul,sub]), Value,Value], e->e.eval()),
 # cfold_divmod := Rule([@(1,[imod,idiv]), Value,Value], e->e.eval()),
 # cfold_unary := Rule([@(1,[re,im,neg]), Value], e->e.eval()),
 # cfold_nth := Rule([nth, @(1,var,e->IsBound(e.value)), Value], e->e.eval()),
 # cfold_nthv := Rule([nth, Value, Value], e->e.eval()),

 cfold := Rule(@(1).cond(e -> IsExp(e) and e.can_fold()), e -> e.eval()),

 # In below rules @(1) is a type, and if t is a type,
 # t.value creates a value of this type, and thus performs the typecast
 tcast_varvalue := Rule([tcast, @(1), @(2,var,e->IsBound(e.value))],
     e -> Cond(IsPtrT(@(1).val), @(2).val, @(1).val.value(@(2).val.v))), # NOTE: IsPtrT branch is unsafe, and relies on correct
                                                                         #        scalarization/non-scalarization
# tcast_value    := Rule([tcast, @(1), @(2,Value)], e -> Cond(
#     # if an array value is typecast to a pointer of same type, just drop the typecast
#     IsPtrT(@(1).val) and IsArrayT(@(2).val.t) and @(1).val.t = @(2).val.t.t, @(2).val,
#     @(1).val.value(@(2).val.v))),

 # only applies to pointers, otherwise is not valid -- for example (double)((int)3.2) is not (double)3.2
 tcast_tcast := Rule([tcast, @(1).cond(t->IsPtrT(t)), [tcast, @(2).cond(t->IsPtrT(t)), @(3)]],
     e -> tcast(@(1).val, @(3).val)),

 # allow adding zero to ptrs.
 tptr_addzero := ARule(add, [@@(0, Value).cond( (e, cx) ->
    let( op := Last(cx.("add")),
        _is0none(e) and ObjId(op.t) = TPtr
    ))],
    ee -> []
 ),

 # cfold_vref := Rule(@(1).cond(e -> IsRec(e) and IsBound(e.isVref) and e.isVref and e.canScalarize() and not IsBound(e.didEval)),
 #     e -> e.eval()),

 # cfold_vref := Rule(@(1).cond(e -> IsRec(e) and IsBound(e.isVref) and e.isVref and e.canScalarize() and not IsBound(e.didEval)),
 #     e -> e.eval()),

 ##################
 # cond rules
 # ============
 cond_rid := Rule([cond, @(1), @(2), @(3).cond(e->e=@(2).val)], e -> @(2).val),

 cond_fold := Rule([cond, @(1,Value), @2, ...], e -> Cond(
         @1.val.v = false or @1.val.v = 0,
             When(Length(e.args) = 3, e.args[3], ApplyFunc(cond, Drop(e.args, 2))),
         @1.val.v = true or IsInt(@1.val.v),
             (@2.val),
         Error("non boolean condition"))),

 IF_fold := Rule([IF, @(1,Value), @(2), @(3)], e -> Cond(
         @(1).val.v = false or @1.val.v = 0,
             @(3).val,
         @(1).val.v = true or IsInt(@1.val.v),
             @(2).val,
         Error("non boolean condition"))),

 IF_skip := Rule([IF, @(1), skip, skip], e -> skip()),

 multi_if2 := Rule([multi_if, @(1), @(2)], e -> IF(@(1).val, @(2).val, skip())),
 multi_if3 := Rule([multi_if, @(1), @(2), @(3)], e -> IF(@(1).val, @(2).val, @(3).val)),
 multi_if_skip := Rule([multi_if, skip], e->skip()),
 multi_if_skip_skip := Rule([@(1, multi_if), @(2, e->ObjId(Last(@(1).val.rChildren()))=skip), skip, ...],
     e -> ApplyFunc(multi_if, Drop(@(1).val.rChildren(), 2))),
 #NOTE: code in autolib's _genPlan messing with 'args' directly, have to drop empty multi_if even though it could fold automatically
 multi_if_drop := ARule( chain, [[multi_if]], e -> [] ),

 ###################
 # chain rules
 # =============
 chain_empty := Rule([chain], e-> skip()),

 chain_skip := Rule([chain, skip], e-> skip()),

 ##########################
 # rules for functions
 # =====================
 frotate_rank1 := Rule([frotate, @(1).cond(e->e.rank()<=1)], e -> @(1).val),
 fcall_fexp  := Rule(
     [@(0,fcall),
	 @(1,[fcurry,flift,fsplit,frotate,Lambda], e -> e.rank()+2=Length(@(0).val.args)),
	 ...],
     e -> e.eval()),

 fexp_Lambda := Rule(
     [@(1,[fcurry,flift,fsplit,frotate]),
	 Lambda,
	 ...],
     e -> e.eval()),

 fcurry_void := Rule(
     [fcurry,
	 @(1),
	 @(2).cond(x -> IsValue(x) and ObjId(@(1).val.t)=TFunc and @(1).val.t.params[x.v] in [TVoid, TDummy]),
         @(3).cond(x -> x<>0)],
     x -> fcurry(@(1).val, @(2).val, 0)),

 fcall_void := Rule(
     [@(0,fcall),
	 @(1).cond(x -> ObjId(x.t)=TFunc and
	                let(pos := Position(x.t.params, TDummy),
			    pos <> false and
			    Length(@(0).val.args) >= 1+pos and
			    not IsValue(@(0).val.args[1+pos]))),
	 ...],
     e -> let(types := e.args[1].t.params,
	      len := Length(e.args),
	      ApplyFunc(fcall, [e.args[1]] :: List([2..len], i -> Cond(types[i-1]=TDummy, 0, e.args[i]))))),

 # if lambdaWrap(Lambda(..)) has Lambda of the form x -> exp, where exp does not depend on x, then eliminate the Lambda
 #lambdaWrap_dummyLambda := Rule([lambdaWrap, @(1, Lambda, x->x.t.params[1]=TDummy and Length(x.t.params)=2)], e -> @(1).val.at(0)),

 #lambdaWrap_rank0 := Rule([lambdaWrap, @(1).cond(x->x.rank()=0)], e -> fcall(@(1).val, 0)),

 ###############
 # omega
 # =======
 re_omega := Rule([re, [omega, @(1), @(2)]], e -> cospi(fdiv(2*@(2).val, @(1).val))),
 im_omega := Rule([im, [omega, @(1), @(2)]], e -> sinpi(fdiv(2*@(2).val, @(1).val))),

 re_omegapi := Rule([re, [omegapi, @(1)]], e -> cospi(@(1).val)),
 im_omegapi := Rule([im, [omegapi, @(1)]], e -> sinpi(@(1).val)),

 re_conj_omega := Rule([re, [conj, [omega, @(1), @(2)]]], e -> cospi(fdiv(2*@(2).val, @(1).val))),
 im_conj_omega := Rule([im, [conj, [omega, @(1), @(2)]]], e -> -sinpi(fdiv(2*@(2).val, @(1).val))),

 ######################
 # complex arith
 # ===============
 conj_conj := Rule([conj, [conj, @(1)]], e->@(1).val),
 re_conj := Rule([re, [conj, @(1)]], x->re(@(1).val)),
 im_conj := Rule([im, [conj, @(1)]], x->-im(@(1).val)),

 # the re_cond/im_cond rules prevent cond from having different types in different branches (ie TReal vs TComplex)
 #
 re_cond := Rule([re, @(1,cond)], x -> ApplyFunc(cond,
	 List(@(1).val.args, x->Cond(x.t=TBool, x, re(x))))),
 im_cond := Rule([im, @(1,cond)], x -> ApplyFunc(cond,
	 List(@(1).val.args, x->Cond(x.t=TBool, x, im(x))))),

 re_real := Rule([re, @.cond(e->e.t=TReal or ObjId(e.t)=T_Real)], e -> e.args[1]),
 im_real := Rule([im, @.cond(e->e.t=TReal or ObjId(e.t)=T_Real)], e -> e.t.zero()),

 re_mul := Rule([re, [@(1, mul), @(2).cond(e->e.t=TReal), ...]], e -> @(2).val * re(ApplyFunc(mul, Drop(@(1).val.args, 1)))),
 im_mul := Rule([im, [@(1, mul), @(2).cond(e->e.t=TReal), ...]], e -> @(2).val * im(ApplyFunc(mul, Drop(@(1).val.args, 1)))),

 re_cxpack := Rule([re, [cxpack, @(1), @]], e -> @(1).val),
 im_cxpack := Rule([im, [cxpack, @, @(1)]], e -> @(1).val),

 re_vdup := Rule([re, [vdup, @(1), @(2)]], e -> vdup(re(@(1).val), @(2).val)),
 im_vdup := Rule([im, [vdup, @(1), @(2)]], e -> vdup(im(@(1).val), @(2).val)),

 mul_cxpack := ARule( mul, [[cxpack, @(1), @(2)], [cxpack, @(3), @(4)]],
     e -> [cxpack( @(1).val*@(3).val - @(2).val*@(4).val,
                   @(1).val*@(4).val + @(2).val*@(3).val )]),

 add_cxpack := ARule( add, [[cxpack, @(1), @(2)], [cxpack, @(3), @(4)]],
     e -> [cxpack( add(@(1).val, @(3).val), add(@(2).val, @(4).val) )]),

 sub_cxpack := Rule( [sub, [cxpack, @(1), @(2)], [cxpack, @(3), @(4)]],
     e -> [cxpack( sub(@(1).val, @(3).val), sub(@(2).val, @(4).val) )]),

 # re( (a + i*b) * (a - i*b) ) -> a*a + b*b
 re_cxmulconj := Rule( [re, [mul, [cxpack, @(1), @(2)], [conj, [cxpack, @(3).cond(x->x=@(1).val), @(4).cond(x->x=@(2).val)]]]],
     e -> add(mul(@(1).val, @(1).val), mul(@(2).val, @(2).val))),
 # im( (a + i*b) * (a - i*b) ) -> 0
 im_cxmulconj := Rule( [im, [mul, [cxpack, @(1), @(2)], [conj, [cxpack, @(3).cond(x->x=@(1).val), @(4).cond(x->x=@(2).val)]]]],
     e -> e.t.zero() ),

 #############
 # imod
 # ======
 imod_by_one := Rule([imod, @1, _1], e -> v0),
 imod_zero := Rule([imod, _0none, @], e -> @(0).val),
 imod_one := Rule([imod, _1, @], e -> v1),

 imod_imod := Rule([imod, [imod, @(1,Value), @(2)], @(3,Value, e->@(2).val.v <= e.v )],
     e -> imod(@(1).val, @(2).val)),

 imod_small := Rule([imod, @(1,var,e->IsBound(e.range) and not IsSymbolic(e.range)),  @(2,Value,e->e.v >= @(1).val.range)],
     e -> @(1).val),

 # this is a less general version of imod_mul_reduce_const, commented out below
 # v1*exp mod v3 -> ((v1 mod v3)*exp) mod v3
 imod_mul := Rule([imod, [@(2, mul), @(1,Value), ...], @(3,Value, e->@(1).val.v >= e.v)],
     e -> imod(ApplyFunc(mul, [@(1).val.v mod @(3).val.v] :: Drop(@(2).val.args, 1)), @(3).val)),

 # (v1*exp + exp4) mod v3 -> ((v1 mod v3)*exp + exp4) mod v3
 imod_addmul_l := Rule([imod, [add, [@(2,mul), @(1,Value), ...], @(4)], @(3,Value, e->@(1).val.v >= e.v)],
     e -> imod(ApplyFunc(mul, [@(1).val.v mod @(3).val.v] :: Drop(@(2).val.args, 1)) + @(4).val, @(3).val)),
 imod_addmul_r := Rule([imod, [add, @(4), [@(2,mul), @(1,Value), ...]], @(3,Value, e->@(1).val.v >= e.v)],
     e -> imod(ApplyFunc(mul, [@(1).val.v mod @(3).val.v] :: Drop(@(2).val.args, 1)) + @(4).val, @(3).val)),

 no_mod_imod := Rule([no_mod, [imod, @1, @2]], e -> @1.val),
 no_mod_small_mod := Rule([no_mod, [small_mod, @1, @2]], e -> @1.val),

 # imod_mul_reduce_const := Rule( [imod, @(1,mul),
 #        @(2,Value, e -> Filtered(@1.val.args, a->IsValue(a) and a.v >= e.v) <>[]) ],
 #    e -> imod(
 #      ApplyFunc(mul, List(@1.val.args, a->Cond(IsValue(a), V(a.v mod @2.val.v), a))),
 #      @2.val)),

 # NOTE: These rules are very general but lead to an infinite loop.
 #
 # imod_mul := Rule([imod, @(1, mul, NOT_ALL_ARGS_ARE(imod)), @(2)],
 #     e -> imod(ApplyFunc(mul, List(@(1).val.args, a -> imod(a, @(2).val))), @(2).val)),
 #
 # imod_add := Rule([imod, @(1, [add,sub], NOT_ALL_ARGS_ARE(imod)), @(2)],
 #     e -> imod(ApplyFunc(ObjId(@(1).val), List(@(1).val.args, a -> imod(a, @(2).val))), @(2).val)),

 #############
 # idiv
 # ======
 idiv_small := Rule([idiv, @(1, var, e -> IsBound(e.range) and not IsSymbolic(e.range)), @(2, Value, e-> e.v >= @(1).val.range)],
     e -> V(0)),

 # exp / value ->  (1/value) * exp,  for floating-point types.  NOTE: use .t.isFloat()
 div_byV_tomul := Rule([@(0, [div, fdiv]), @(1), @(2, Value, x->x.t in [TReal, TComplex])],
     e -> div(@(2).val.t.one(), @(2).val) * @(1).val),

 # (v1*exp2 + exp3)/v4 -> v1/v4*exp2 + exp3/v4; v4 | v1;
 # NOTE: these rules are invalid if sign(exp2)<>sign(exp4) !!!

 #idiv_addmul_l := Rule([idiv, [add,  [mul, @(1, Value), @(2)], @(3)], @(4, Value, x -> _divides(x, @(1).val))],
 #    e -> add(mul(div(@(1).val, @(4).val), @(2).val), idiv(@(3).val, @(4).val))),

 #idiv_addmul_r := Rule([idiv, [add,  @(3), [mul, @(1, Value), @(2)]], @(4, Value, x -> _divides(x, @(1).val))],
 #    e -> add(mul(div(@(1).val, @(4).val), @(2).val), idiv(@(3).val, @(4).val))),

 # (v1*loop_idx + v2)/v3 -> v1/v3*loop_idx + v2/v3;  when  (v3 | v1) & (v2 >= 0) & (v1 >= 0);
 # assumption: loop index cannot be negative
 idiv_addmul_pos_l := Rule([idiv, [add,  [mul, @vpos0(1), @(2).cond(IsLoopIndex)], @vpos0(3)], @(4, Value, x -> _divides(x, @(1).val))],
     e -> add(mul(idiv(@(1).val, @(4).val), @(2).val), idiv(@(3).val, @(4).val))),

 idiv_addmul_pos_r := Rule([idiv, [add,  @vpos0(3), [mul, @vpos0(1), @(2).cond(IsLoopIndex)]], @(4, Value, x -> _divides(x, @(1).val))],
     e -> add(mul(idiv(@(1).val, @(4).val), @(2).val), idiv(@(3).val, @(4).val))),

 ############
 # pow, sqrt, rsqrt
 # =====
 pow_zero := Rule([pow, @1, _0none], e->v1),

 powmod_mul_const := Rule([powmod, @, Value, @(1,mul,e->ForAny(e.args,IsValue)), @],
    e -> let(split := SplitBy(@1.val.args, IsValue),
         value := Product(split[1], x->x.v),
         vars := split[2],
         powmod( e.args[1],
            (e.args[2].v ^ value) mod e.args[4].v,
                 ApplyFunc(mul, vars),
             e.args[4]))),

 powmod_cfold := Rule([powmod, @1, Value, Value, Value],
    e -> imod(((e.args[2].v ^ e.args[3].v) mod e.args[4].v)*e.args[1], e.args[4].v)),

 sqrt_pow2 := Rule( [sqrt, [pow, @(1), _2]], e -> abs(@(1).val) ),
 pow2_sqrt := Rule( [pow, [sqrt, @(1)], _2], e -> @(1).val ),

 rsqrt_pow2 := Rule( [rsqrt, [pow, @(1), _2]], e -> fdiv(e.t.one(), abs(@(1).val)) ),
 pow2_rsqrt := Rule( [pow, [rsqrt, @(1)], _2], e -> fdiv(e.t.one(), @(1).val) ),

 #############
 # bin
 # ====

 bin_xor_zero      := Rule([bin_xor, ..., _0none, ...], e -> When(@(0).val = e.args[2], e.args[1], e.args[2])),
 bin_and_zero      := Rule([bin_and, ..., _0none, ...], e -> @(0).val),

 bin_shr_zero      := Rule([bin_shr, _0none,      @], e -> e.args[1]),
 bin_shr_zeroshift := Rule([bin_shr,      @, _0none], e -> e.args[1]),
 bin_shl_zero      := Rule([bin_shl, _0none,      @], e -> e.args[1]),
 bin_shl_zeroshift := Rule([bin_shl,      @, _0none], e -> e.args[1]),

 absdiff2_to_abssub := Rule([@(0, absdiff2, x -> not IsOrdT(x.t.base_t())), @(1), @(2)],
     e -> Cond( IsValue(@(1).val) and isValueZero(@(1).val),
                    @(2).val,
                IsValue(@(1).val) and Length(Set(Flat([@(1).val.v])))=1,
                    sub(@(1).val, @(2).val),
                # else
                    abs(sub(@(1).val, @(2).val)))),

 # Memory allocation
 allocate_0 := Rule([allocate, @(1), [TArray, @(2), _0]], e -> assign(@(1).val, null())),
 deallocate_0 := Rule([deallocate, @(1), [TArray, @(2), _0]], e -> skip()),

 # funcExp rule

 expr_funcExp := Rule( [@(0, [mul, add, sub, div, idiv, imod]), ..., @(1, funcExp), ...],
     e -> @(1).val ),

 expr_cond_funcExp := Rule( [@(1, [mul, add]), ..., [@(2, cond), ..., funcExp, ...], ...],
     e -> let( args := RemoveList(e.args, @(2).val),
         _map_cond(@(2).val, p -> p, exp -> ApplyFunc(ObjId(e), args :: [exp])))),

 divmod_cond_funcExp := Rule( [@(1, [div, idiv, imod]), [@(2, cond), ..., funcExp, ...], @(3)],
     e -> _map_cond(@(2).val, p -> p, exp -> ObjId(e)(exp, @(3).val))),

 # always pull cond() from nth() for nth(funcExp) annihilation.
 nth_cond := Rule( [nth, @(1), @(2, cond)],
     e -> _map_cond(@(2).val, p->p, exp->nth(@(1).val, exp))),

 #############
 vdup_noneExp := Rule([vdup, [noneExp, @(1)], @(2)], e -> vdup(@(1).val.zero(), @(2).val) ),

 vdup_vdup := Rule([vdup, [vdup, @(1), @(2)], @(3)], e -> vdup(@(1).val, @(2).val * @(3).val)),

 vdup_vpack := Rule([vdup, @(1, vpack), @(3)], e -> ApplyFunc(vpack, ConcatList(@(1).val.args, x -> [x,x])))
));

Class(stickyNeg, neg, rec(doPeel := false, unparse := "neg"));

Class(RulesExpensiveStrengthReduce, RuleSet);

__groupSummands := function(lst, is_full)
    local e, grp, non, grpid, id, mult, i, one, ptrs;
    [grp, grpid, non] := [rec(), Set([]), []];
    [ptrs, lst] := SplitBy(lst, e -> IsPtrT(e.t) or IsArrayT(e.t));
    for e in lst do
        one := e.t.one();
        if ObjId(e) in [var, param] then
	    if not IsBound(grp.(e.id)) then  grp.(e.id) := [one, e];
	    else 		             grp.(e.id)[1] := grp.(e.id)[1] + one;
	    fi;
	    AddSet(grpid, e.id);
        elif ObjId(e) in [neg, stickyNeg] and ObjId(e.args[1]) in [var, param] then
	    id := e.args[1].id;
	    if not IsBound(grp.(id)) then  grp.(id) := [-one, e.args[1]];
	    else 		           grp.(id)[1] := grp.(id)[1] - one;
	    fi;
	    AddSet(grpid, id);
        elif ObjId(e)=mul and Length(e.args)=2 and ObjId(e.args[1])=Value and ObjId(e.args[2]) in [var, param] then
	    id := e.args[2].id;
	    if not IsBound(grp.(id)) then  grp.(id) := [e.args[1], e.args[2]];
	    else 		           grp.(id)[1] := grp.(id)[1] + e.args[1];
	    fi;
	    AddSet(grpid, id);
	elif ObjId(e) in [ neg, stickyNeg ] and ObjId(e.args[1]) = mul and Length(e.args[1].args) = 2
               and ObjId(e.args[1].args[1]) = Value and ObjId(e.args[1].args[2]) in [ var, param ]  then
            id := e.args[1].args[2].id;
            if not IsBound(grp.(id))  then grp.(id) := [ -e.args[1].args[1], e.args[1].args[2] ];
            else                           grp.(id)[1] := grp.(id)[1] - e.args[1].args[1];
            fi;
            AddSet(grpid, id);
        elif not is_full then
	    Add(non, [one, e]);
	else
	    mult := one;
	    if ObjId(e) in [neg, stickyNeg] then mult := -mult; e := e.args[1]; fi;
	    if ObjId(e) = mul and IsValue(e.args[1]) then mult := mult*e.args[1]; e := ApplyFunc(mul, Drop(e.args, 1)); fi;
	    if ObjId(e) in [neg, stickyNeg] then mult := -mult; e := e.args[1]; fi;

	    i := PositionProperty(non, x->x[2]=e);
	    if i=false then Add(non, [mult, e]);
	    else
		non[i][1] := non[i][1] + mult;
	    fi;
	fi;
    od;
    return ApplyFunc(add, ptrs :: List(grpid, id -> grp.(id)[1] * grp.(id)[2]) :: List(non, x->x[1]*x[2]));
end;

#F __groupSummandsVar(<lst>) is similar to __groupSummands but pulls out
#F variables. This helps to implement rolling pointers in Autolib
#F because grouping this way helps to get stride expression for a loop index variable.
#F

__groupSummandsVar := function(lst)
    local e, grp, non, grpid, id, mult, i, one, ptrs;
    [grp, grpid, non] := [rec(), Set([]), []];
    [ptrs, lst] := SplitBy(lst, e -> IsPtrT(e.t) or IsArrayT(e.t));
    for e in lst do
        one := e.t.one();
        if ObjId(e) in [var, param] then
	    if not IsBound(grp.(e.id)) then  grp.(e.id) := [one, e];
	    else 		             grp.(e.id)[1] := grp.(e.id)[1] + one;
	    fi;
	    AddSet(grpid, e.id);
        elif ObjId(e) in [neg, stickyNeg] and ObjId(e.args[1]) in [var, param] then
	    id := e.args[1].id;
	    if not IsBound(grp.(id)) then  grp.(id) := [-one, e.args[1]];
	    else 		           grp.(id)[1] := grp.(id)[1] - one;
	    fi;
	    AddSet(grpid, id);
        elif ObjId(e)=mul and ObjId(Last(e.args))=var then
	    id := Last(e.args).id;
	    if not IsBound(grp.(id)) then  grp.(id) := [ApplyFunc(mul, DropLast(e.args, 1)), Last(e.args)];
	    else 		           grp.(id)[1] := grp.(id)[1] + ApplyFunc(mul, DropLast(e.args, 1));
	    fi;
	    AddSet(grpid, id);
	elif ObjId(e) in [ neg, stickyNeg ] and ObjId(e.args[1]) = mul
               and ObjId(Last(e.args[1].args)) = var then
            id := Last(e.args[1].args).id;
            if not IsBound(grp.(id))  then grp.(id) := [ -ApplyFunc(mul, DropLast(e.args[1].args, 1)), Last(e.args[1].args) ];
            else                           grp.(id)[1] := grp.(id)[1] - ApplyFunc(mul, DropLast(e.args[1].args, 1));
            fi;
            AddSet(grpid, id);
        else
	    Add(non, [one, e]);
	fi;
    od;
    return ApplyFunc(add, ptrs :: List(grpid, id -> grp.(id)[1] * grp.(id)[2]) :: List(non, x->x[1]*x[2]));
end;

_groupSummands := lst -> __groupSummands(lst, true);
_groupSummandsSimple := lst -> __groupSummands(lst, false);

RewriteRules(RulesExpensiveStrengthReduce, rec(
  mul_add := Rule([mul, @(1,Value), [add, @(2, Value), @(3)]], e -> @(1).val*@(2).val + @(1).val*@(3).val),

  mul_assoc := ARule(mul, [ @(1,mul) ], e -> @1.val.args),

  mul_cfold := Rule(@(1,mul,e->Length(e.args)>2 and Length(Filtered(e.args, IsValue)) >= 2),
   e -> let(s := SplitBy(e.args, IsValue), values := s[1], exps := s[2],
            ApplyFunc(mul, Concatenation( [Product(values,v->v.v)], exps)))),

  add_assoc := Rule([add, ..., @(1,add), ... ], e -> let(
	  args := ConcatList(e.args, x->Cond(ObjId(x)=add, x.args, [x])),
	  #args)),
	  _groupSummands(args))),

  add_cfold := Rule(@(1,add,e->Length(e.args)>2 and Length(Filtered(e.args, IsValue)) >= 2),
        e -> let(s := SplitBy(e.args, IsValue), values := s[1], exps := _groupSummands(s[2]),
            ApplyFunc(add, Concatenation([Sum(values,v->v.v)], [exps])))),

  add_sub_val := Rule( [add, ..., [@(1, sub), @(2), @(3, Value)], ...],
      e -> ApplyFunc(add, [@(2).val, neg(@(3).val)] :: Filtered(e.args, x -> not Same(x, @(1).val)))),
  sub_add_val := Rule( [@(1, sub), @(2, add), @(3, Value)],
      e -> ApplyFunc(add, [neg(@(3).val)] :: @(2).val.args)),

  # super ugly:  ((a+b+c)-b) -> a+c
  # group summands could do this
  sub_add_same_exp := Rule( [sub, @(1, add), @(2).cond(x -> x in @(1).val.args)],
      e -> let( a := SplitBy(@(1).val.args, x -> x=@(2).val),
                ApplyFunc(add, a[2] :: Drop(a[1], 1) :: [a[1][1].t.zero()]))),
  add_sub_same_exp := Rule( [@(1, add), ..., [@(2, sub), @(3), @(4).cond(x -> x in @(1).val.args)], ...],
      e -> let( a := SplitBy(@(1).val.args, x -> x=@(4).val),
                b := SplitBy(a[2], x -> x=@(2).val),
                ApplyFunc(add, b[2] :: Drop(a[1], 1) :: Drop(b[1], 1) :: [@(3).val, a[1][1].t.zero()]))),

# fold the constants in an xor expression with >2 arguments of which >=2 arguments are constants
  xor_cfold := Rule(@(1,xor,e -> Length(e.args)>2 and Length(Filtered(e.args, IsValue))>=2),
    e -> let(
      s := SplitBy(e.args, IsValue),
      values := s[1],
      vars := s[2],

      ApplyFunc(xor, Concatenation( [Xor(values, v -> v.v)], vars ) )
    )
  ),

  xor_zero := ARule(xor, [_0none], e -> []),

  xor_one := Rule(@(1,xor, e -> Length(e.args) = 1),
    e -> e.args[1]
  ),

# NOTE: removed <idiv> since the rule is invalid for non-divisible numbers
#        can one create a new rule for idiv?

   mul_div := Rule([mul, ..., @(1, div), ...], e ->
       let(facs := e.args, divkind := ObjId(@(1).val), dd := Filtered(facs, f->ObjId(f)=divkind),
       divkind(Product(List(facs, f->When(ObjId(f)=divkind, f.args[1], f))),
           Product(List(dd, d->d.args[2]))))),

   imod_imod := Rule([imod, [imod, @(1), @(2, Value)], @(3, Value, e->@(2).val.v mod e.v = 0)],
       e -> imod(@(1).val, @(3).val)),

   imod_addmul := Rule([imod,[@(1,add),...,[@(2,mul),...,@(3,Value),...],...],@(4,Value,e->Mod(@(3).val.v,e.v)=0)],
       e->let(p1:=FirstPosition(@1.val.rChildren(),e->e=@(2).val),a:=ApplyFunc(add,ListWithout(@(1).val.rChildren(),p1)),imod(a,@(4).val))),

   imod_sub := Rule([imod,  [@(0,sub), @(1), @(2)],  @(3).cond(x -> _divides(x, @(1).val) or _divides(x, @(2).val))],
       e -> When(_divides(@(3).val, @(2).val), imod(@(1).val, @(3).val), imod(-@(2).val, @(3).val))),

   imod_add := Rule([@(1, imod), [ add, ..., @(2).cond(x -> _divides(@(1).val.args[2], x)), ... ], @],
       e -> imod(ApplyFunc(add, Filtered(e.args[1].args, x -> not _divides(e.args[2], x))), e.args[2])),

   imod_divides := Rule( [imod, @(1), @(2).cond( x -> _divides(x, @(1).val) )],
       e -> e.t.zero() ),

   # NOTE: idiv rule disabled, because its invalid if summands have different signs (a+2)/2 != a/2 + 1, if a<0
   #        can this be overcome?
   #idiv_addmul  := Rule([idiv,[@(1,add),...,[@(2,mul),...,@(3,Value),...],...],@(4,Value,e->Mod(@(3).val.v,e.v)=0)],
   #    e->let(p1:=FirstPosition(@1.val.rChildren(),e->e=@(2).val),a:=ApplyFunc(add,ListWithout(@(1).val.rChildren(),p1)),add(idiv(a,@(4).val),idiv(@(2).val,@(4).val)))),

   # NOTE: idiv rule disabled, because its invalid if summands have different signs (a+2)/2 != a/2 + 1, if a<0
   #        can this be overcome?
   divs_addmul2 := Rule([@(1, [div, fdiv]), [ add, ..., [ @(2, mul), ..., @(3).cond(x -> x = @(1).val.args[2]), ...], ... ], @],
       e -> add( ApplyFunc(mul, DropCond(@(2).val.args, x -> x=e.args[2], 1)),
                 ObjId(e)(ApplyFunc(add, DropCond(e.args[1].args, x -> x = @(2).val, 1)), e.args[2]))),

   # NOTE: idiv rule disabled, because its invalid if summands have different signs (a+2)/2 != a/2 + 1, if a<0
   #        can this be overcome?
   divs_addmul3 := Rule([@(1, [div, fdiv]), [ add, ..., @(2).cond(x -> x = @(1).val.args[2]), ...], @],
       e -> add( e.t.one(), ObjId(e)(ApplyFunc(add, DropCond(e.args[1].args, x -> x = @(2).val, 1)), e.args[2]))),

   div_div1 := Rule([div, @(1), [div, @(2), @(3)]], e -> div(@(1).val*@(3).val, @(2).val)),
   div_div2 := Rule([div, [div, @(1), @(2)], @(3)], e -> div(@(1).val, @(2).val*@(3).val)),

# NOTE: removed <idiv> since the rule is invalid for non-divisible numbers
#        can one create a new rule for idiv?
#   idiv_idiv1 := Rule([idiv, @(1), [idiv, @(2), @(3)]], e -> idiv(@(1).val*@(3).val, @(2).val)),
#   idiv_idiv2 := Rule([idiv, [idiv, @(1), @(2)], @(3)], e -> idiv(@(1).val, @(2).val*@(3).val)),

   fdiv_fdiv1 := Rule([fdiv, @(1), [fdiv, @(2), @(3)]], e -> fdiv(@(1).val*@(3).val, @(2).val)),
   fdiv_fdiv2 := Rule([fdiv, [fdiv, @(1), @(2)], @(3)], e -> fdiv(@(1).val, @(2).val*@(3).val)),

   mul_middleValue := Rule(@(1,mul,e -> PositionProperty(e.args, IsValue) > 1 and
                                    Length(Filtered(e.args, IsValue))=1),
       e -> let(i := PositionProperty(e.args, IsValue),
       Product(Permuted(e.args, (1,i))))),

   add_Value_1st := Rule(@(1,add,e->ForAny(e.args, IsValue) and not IsValue(e.args[1])),
    e -> let(s := SplitBy(e.args, IsValue), values := s[1], vars := s[2],
        ApplyFunc(add, [ApplyFunc(add, values)] :: vars))),

# NOTE: removed <idiv> since the rule is invalid for non-divisible numbers
#        can one create a new rule for idiv?

   div_add_Values := Rule([@(0,[div,fdiv]), [@(1,add), @(2, Value), ...],
                                             @(3, Value, e->IsInt(@(2).val.v) and (@(2).val.v mod e.v = 0))],
       e -> add(@(2).val.v / @(3).val.v,
            ObjId(@(0).val)(ApplyFunc(add, Drop(@(1).val.args, 1)), @(3).val))),

   # NOTE: this rule ignores the 3rd parameter of bin_shl (!!), which is 'bits'
   div_add_shl := Rule([@(0,[div,fdiv]), [@(1,add), ..., @(2, arith_shl)],
                                             @(3, Value, e->IsInt(@(2).val.args[2].v)
                                                 and Is2Power(e.v)
                                                 and Log2Int(e.v)<=@(2).val.args[2].v)],
       e -> add(
              arith_shl(@(2).val.args[1],@(2).val.args[2].v - Log2Int(@(3).val.v)),
            ObjId(@(0).val)(ApplyFunc(add, DropLast(@(1).val.args, 1)), @(3).val))),

   div_mul_mul_cfold1 := Rule([@(0,[idiv,div,fdiv]),
       [@(1,mul), @(2,Value), ...],
       [@(3,mul), @(4,Value,
           e -> (@(2).val.t = TInt and e.t=TInt and (@(2).val.v mod e.v)=0)), ...]],
   e -> ObjId(@(0).val)(ApplyFunc(mul, Concatenation([@(2).val.v/@(4).val.v], Drop(@(1).val.args, 1))),
                        ApplyFunc(mul, Drop(@(3).val.args, 1)))),

   div_mul_mul_cfold2 := Rule([@(0,[idiv,div,fdiv]),
       [@(1,mul), @(2,Value), ...],
       [@(3,mul), @(4,Value,
           e -> (@(2).val.t = TInt and e.t=TInt and (e.v mod @(2).val.v)=0)), ...]],
   e -> ObjId(@(0).val)(ApplyFunc(mul, Drop(@(1).val.args, 1)),
                        ApplyFunc(mul, Concatenation([@(4).val.v/@(2).val.v], Drop(@(3).val.args, 1))))),

   div_mul_Value_cfold1 := Rule([@(0,[div, idiv, fdiv]),
       [@(1,mul), @(2,Value), ...],
       @(4,Value, e->(@(2).val.t = TInt and e.t=TInt and (@(2).val.v mod e.v)=0))],
   e -> ApplyFunc(mul, Concatenation([@(2).val.v/@(4).val.v], Drop(@(1).val.args, 1)))),

   div_mul_Value_cfold2 := Rule([@(0,[div,idiv, fdiv]),
       [@(1,mul), @(2,Value), ...],
       @(4,Value, e->(@(2).val.t = TInt and e.t=TInt and (e.v mod @(2).val.v)=0))],
   e -> ObjId(@(0).val)(Product(Drop(@(1).val.args, 1)),
                        @(4).val.v/@(2).val.v)),

   div_mulmul_cfold_vars1 := Rule([@(0,[div,idiv,fdiv]),
       @(1, mul, e->Length(Filtered(e.args, IsLoc)) >= 1),
       @(2, mul, e->let(vv:=Filtered(e.args, IsLoc), Length(vv) >= 1 and Intersection(vv, @(1).val.args)<>[]))],
   e -> let(s1 := SplitBy(@(1).val.args, IsLoc), vars1 := s1[1], nonvars1 := s1[2],
            s2 := SplitBy(@(2).val.args, IsLoc), vars2 := s2[1], nonvars2 := s2[2],
            ObjId(@(0).val)(
                Product(nonvars1) * Product(ListDifference(vars1, vars2)),
                Product(nonvars2) * Product(ListDifference(vars2, vars1))))),

   div_mulmul_cfold_vars2 := Rule([@(0,[div,idiv,fdiv]),
       @(1, mul, e->Length(Filtered(e.args, IsLoc)) >= 1),
       @(2).cond(e->IsLoc(e) and e in @(1).val.args) ],
   e -> let(a := @(1).val.args, ApplyFunc(mul, ListWithout(a, Position(a, @(2).val))))),

   div_mulmul_cfold_vars3 := Rule([@(0,[div,idiv,fdiv]),
       @(1).cond(IsLoc),
       @(2, mul, e->@(1).val in e.args) ],
   e -> let(a := @(2).val.args, ObjId(@(0).val)(1, ApplyFunc(mul, ListWithout(a, Position(a, @(1).val)))))),

   div_cfold_vars4 := Rule([@(0,[div, idiv, fdiv]),
       @(1).cond(IsLoc),
       @(2).cond(x->IsLoc(x) and x=@(1).val)],
   e -> e.t.one()),

   pdiv_param := Rule([pdiv, @(0, param), @(1, Value)], e -> div(@(0).val, @(1).val)),

   pdiv_add := Rule([pdiv, @(0, add), @(1, Value)], e -> ApplyFunc(add, List(@(0).val.rChildren(), x->pdiv(x, @(1).val)))),

   #idiv is a trick to avoid inversion of this rule by mul_div
   pdiv_mul := Rule([pdiv, [mul, @(1, param), @(2)], @(3, Value)], e -> mul(idiv(@(1).val, @(3).val), @(2).val)),

   pdiv_const := Rule([pdiv, [mul, @(1, Value), @(2)], @(3, Value, e->Mod(@(1).val.v, e.v)=0)],
       e -> mul(div(@(1).val, @(3).val), @(2).val)),

   merge_logic_and := Rule([ logic_and, ..., logic_and, ... ],
       x -> ApplyFunc(logic_and, ConcatList(x.args, e->When(ObjId(e)=logic_and, e.args, [e]) )))
));

RulesMergedStrengthReduce := MergedRuleSet(RulesStrengthReduce, RulesExpensiveStrengthReduce);

ESReduce := (c, opts) -> ApplyStrategy(c, [RulesMergedStrengthReduce], BUA, opts);

Class(NormalizeLinearExp, RuleSet);
RewriteRules(NormalizeLinearExp, rec(
    # Normalization
    mul_zero := Rule([mul, _0none, @], e -> @(0).val),
    mul_one := Rule([mul, _1, @], e -> @.val),
    mul_assoc := ARule(mul, [ @(1,mul) ], e -> @1.val.args),

    mul_Value_Value := Rule([mul, @(1,Value), @(2,Value)], # UnifyTypes([@(1).val.t, @(2).val.t]).value
    e -> V(@(1).val.v * @(2).val.v)),

    mul_add_rt := Rule([mul, ..., @(2,add)],
        e -> ApplyFunc(add, List(@(2).val.args,
                a -> ApplyFunc(mul, Concatenation(Copy(DropLast(e.args, 1)),[a]))))), #Copy prevents aliasing
    mul_add_lft := Rule([mul, @(2,add), ...],
        e -> ApplyFunc(add, List(@(2).val.args,
                a -> ApplyFunc(mul, Concatenation([a], Copy(Drop(e.args, 1))))))), #Copy prevents aliasing

    mul_mul := Rule([mul, @(1,Value), [mul, @(2,Value), @(3)]], e -> mul(@(1).val.v * @(2).val.v, @(3).val)),

    sub_to_add := Rule([sub, @(1), @(2)], e -> add(@(1).val, stickyNeg(@(2).val))),

    add_assoc := Rule([add, ..., @(1,add), ... ], e -> let(
	  args := ConcatList(e.args, x->Cond(ObjId(x)=add, x.args, [x])),
	  #args)),
          _groupSummandsSimple(args))),

    add_zero := ARule(add, [_0none],  e -> [ ]),
    add_single := Rule([add, @(1)], e -> @(1).val),
    add_none := Rule([add], e -> V(0)),

    # Constant folding
    cfold := RulesStrengthReduce.rules.cfold,

    mul_cfold := RulesExpensiveStrengthReduce.rules.mul_cfold,
    add_cfold := RulesExpensiveStrengthReduce.rules.add_cfold,
    # put constants first
    mul_middleValue := RulesExpensiveStrengthReduce.rules.mul_middleValue,

    # negation
    neg        := Rule(neg, e -> stickyNeg(e.args[1])),
    mul_negone := Rule([mul, _neg1, @2], e -> stickyNeg(@2.val)),
    neg_neg := Rule([stickyNeg, [stickyNeg, @1]], e -> @1.val), # -(-1) -> 1

    mul_neg := Rule([mul, ..., @(1, [stickyNeg, Value], e->When(ObjId(e)=Value, isNegV(e), true)), ...],
        e -> let(cnt := Counter(0),
                 count := List(e.args, x -> When(ObjId(x)=stickyNeg or (ObjId(x)=Value and isNegV(x)), cnt.next(), 0)),
                 newargs := List(e.args, x -> Cond(
                         ObjId(x)=stickyNeg, x.args[1],
                         ObjId(x)=Value and isNegV(x), Value.new(x.t, -x.v),
                         x)),
                 res := ApplyFunc(mul, newargs),
                 When(IsOddInt(cnt.n), stickyNeg(res), res))),
    sink_stickyNeg_add := Rule([stickyNeg, @(1, add)], e -> ApplyFunc(add, List(@(1).val.args, stickyNeg))),

    # This rule is in conflict with mul_div rule from ESReduce but it simplifies index computations.
    # div implies divisibility but loop index takes different values from .range field -> other
    # arguments must be divisible by @(3)
    div_pull_out_idx := Rule([div, [@(1, mul), ..., @.cond(IsLoopIndex), ...], @(3, Value)],
        e -> let( m := SplitBy(@(1).val.args, IsLoopIndex),
                  ApplyFunc(mul, [div(ApplyFunc(mul, m[2]), @(3).val)] :: m[1]) )),
));

GroupSummandsExp := s -> NormalizeLinearExp(SubstBottomUp(NormalizeLinearExp(s), add, e->_groupSummands(e.args)));


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

#
# NB: Contents of this file should be moved to a directory local to the
#     particular Spiral Extension
#

Class(f2DTr, Tr, rec(
    advdomain := self >> [[self.params[2], self.params[1]]],
    advrange := self >> [[self.params[1], self.params[2]]]
));

Class(f2DTrExplicitL, f2DTr);
Class(f2DTrExplicitR, f2DTr);

Class(f4DHalfFlip, PermClass, rec(
    def := (a1,a2,b1,b2) -> rec(size := a1*a2*b1*b2),
    lambda := self >> let(
        a1 := self.params[1], a2 := self.params[2],
        b1 := self.params[3], b2 := self.params[4],
        fTensor(Tr(a1, a2), Tr(b1, b2)).lambda()
        ),
    domain := self >> self.params[1] * self.params[2] * self.params[3] * self.params[4],
    range := self >> self.params[1] * self.params[2] * self.params[3] * self.params[4],

    dims := self >> [self.range(), self.domain()],

    transpose := self >> Error("not supported"),

    advdomain := self >> [[self.params[4], self.params[3], self.params[2], self.params[1]]],
    advrange := self >> [[self.params[3], self.params[4], self.params[1], self.params[2]]]
));

Class(f4DMacroFlip, PermClass, rec(
    def := (a1,a2,b1,b2) -> rec(size := a1*a2*b1*b2),
    lambda := self >> let(
        a1 := self.params[1], a2 := self.params[2],
        b1 := self.params[3], b2 := self.params[4],
        Tr(a1*a2, b1*b2).lambda()),
#         i := Ind(a1*a2*b1*b2),
#         k := a1*a2, str := b1*b2,
#         Lambda(i, add(mul(b2, idiv(idiv(i, k), b2)), imod(idiv(i, k), b2))
#             + str * add(mul(a2, idiv(imod(i, k), a2)), imod(imod(i, k), a2)))),

    domain := self >> self.params[1] * self.params[2] * self.params[3] * self.params[4],
    range := self >> self.params[1] * self.params[2] * self.params[3] * self.params[4],

    dims := self >> [self.range(), self.domain()],

    transpose := self >> Error("not supported"),

    advdomain := self >> [[self.params[3], self.params[4], self.params[1], self.params[2]]],
    advrange := self >> [[self.params[1], self.params[2], self.params[3], self.params[4]]]
));

Class(f4DFullFlip, PermClass, rec(
    def := (a1,a2,b1,b2) -> rec(size := a1*a2*b1*b2),
    lambda := self >> let(
        a1 := self.params[1], a2 := self.params[2],
        b1 := self.params[3], b2 := self.params[4],
        i := Ind(a1*a2*b1*b2),
        Lambda(i, imod(i,b2) * a1 * a2 * b1
            + imod(idiv(i,b2),b1)*a1*a2
            + imod(idiv(i, b2*b1),a2) * a1
            + imod(idiv(i, b2*b1*a2), a1))),
    domain := self >> self.params[1] * self.params[2] * self.params[3] * self.params[4],
    range := self >> self.params[1] * self.params[2] * self.params[3] * self.params[4],

    dims := self >> [self.range(), self.domain()],

    transpose := self >> Error("not supported"),

    advdomain := self >> [[self.params[4], self.params[3], self.params[2], self.params[1]]],
    advrange := self >> [[self.params[1], self.params[2], self.params[3], self.params[4]]]
));

#F
#F Multi-dimensional fTensor's for OL
#F

Class(f2DTensor, fTensor, rec(
    advdomain := self >> [List(self._children, x->x.domain())],
    advrange := self >> [List(self._children, x->x.range())]
));

Class(f4DTensor, fTensor, rec(
    advdomain := self >> [List(self._children, x->x.domain())],
    advrange := self >> [List(self._children, x->x.range())]
));


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

Import(simt);

_isSIMTTag := tag -> IsBound(tag.isSIMTTag) and tag.isSIMTTag;
_toSIMTDim := (tags, n) -> Cond(
    ObjId(tags[1]) = ASIMTLoopDim, tags[1],
    IsBound(tags[1].params[1]) and not IsInt(tags[1].params[1]), ApplyFunc(ObjId(tags[1]), [tags[1].params[1](n)]),
    tags[1](n));

NewRulesFor(TIterHStack, rec(
    TIterHStack_SIMT := rec(
        applicable := nt->nt.hasTags() and _isSIMTTag(nt.firstTag()),
        forTransposition := false,
        children := nt -> [[ nt.params[1].withTags(Drop(nt.getTags(), 1)), InfoNt(nt.params[2]) ]],
        apply := (nt, c, cnt) -> SIMTIterHStack1(_toSIMTDim(nt.getTags(), cnt[2].params[1].range), cnt[2].params[1], cnt[2].params[1].range, c[1])
    )
));

NewRulesFor(TIterVStack, rec(
    TIterVStack_SIMT := rec(
        applicable := nt->nt.hasTags() and _isSIMTTag(nt.firstTag()),
        forTransposition := false,
        children := nt -> [[ nt.params[1].withTags(Drop(nt.getTags(), 1)), InfoNt(nt.params[2]) ]],
        apply := (nt, c, cnt) -> SIMTIterVStack(_toSIMTDim(nt.getTags(), cnt[2].params[1].range), cnt[2].params[1], cnt[2].params[1].range, c[1])
    )
));

NewRulesFor(MDDFT, rec(
    MDDFT_RowCol_3D_SIMT := rec(
        info :="MDDFT(n_1,n_2,...,n_t) = (RC(MDDFT(n_1,n_2,...,n_{t-1}) x I(.))) (I(n_1*n_2*...*n_{t-1}) x PRDFT1(n_t))",
        applicable := nt->nt.hasTags() and Length(nt.getTags()) = 2 and ForAll(nt.getTags(), _isSIMTTag) and Length(nt.params[1]) = 3,
        children  := nt -> let(a_lengths := nt.params[1],
                               a_exp := nt.params[2],
                               tags := nt.getTags(),
                               taglen := Length(tags),
                               rtags1 := tags{[2]},
                               [[ MDDFT(DropLast(a_lengths, 1), a_exp).withTags(rtags1),
                                  DFT(Last(a_lengths), a_exp) ]]),

        apply := (nt, C, cnt) -> let(
            a := nt.params[1],
            n1 := a[1],
            n2 := a[2],
            n3 := a[3],
            SIMTTensor(_toSIMTDim(nt.getTags(){[1]}, n3), C[1], I(n3)) *
                                     SIMTTensor(_toSIMTDim(nt.getTags(){[1]}, n1), I(n1),
                                         SIMTTensor(_toSIMTDim(nt.getTags(){[2]}, n2), I(n2),
                                             C[2])))
    ),
    MDDFT_tSPL_RowCol_SIMT := rec(
        info :="MDDFT(n_1,n_2,...,n_t) = (RC(MDDFT(n_1,n_2,...,n_{t-1}) x I(.))) (I(n_1*n_2*...*n_{t-1}) x PRDFT1(n_t))",
        applicable := nt->nt.hasTags() and ForAll(nt.getTags(), _isSIMTTag) and Length(nt.params[1]) > 1,
        children  := nt -> let(a_lengths := nt.params[1],
                               a_exp := nt.params[2],
                               tags := nt.getTags(),
                               [[ TTensorI(MDDFT(DropLast(a_lengths, 1), a_exp), Last(a_lengths), AVec, AVec).withTags(tags),
                                  FoldR(DropLast(a_lengths, 1), (a,b)->TTensorI(a, b, APar, APar), DFT(Last(a_lengths), a_exp)).withTags(tags) ]]),
        apply := (nt, C, cnt) -> C[1] * C[2]
    ),
    MDDFT_tSPL_Pease_SIMT := rec(
        applicable := nt->nt.hasTags() and ForAll(nt.getTags(), _isSIMTTag) and Length(nt.params[1]) > 1,
        children  := nt -> let(a_lengths := nt.params[1],
                               a_exp := nt.params[2],
                               tags := nt.getTags(),
                               [ [TCompose(List(nt.params[1], i->TTensorI(DFT(i, a_exp), Product(nt.params[1])/i, AVec, APar))).withTags(tags) ]]),
        apply := (nt, C, cnt) -> C[1]
    )
));

NewRulesFor(MDPRDFT, rec(
    MDPRDFT_3D_SIMT := rec(
        info :="MDDFT(n_1,n_2,...,n_t) = (RC(MDDFT(n_1,n_2,...,n_{t-1}) x I(.))) (I(n_1*n_2*...*n_{t-1}) x PRDFT1(n_t))",
        applicable := nt->nt.hasTags() and Length(nt.getTags()) = 2 and ForAll(nt.getTags(), _isSIMTTag) and Length(nt.a_lengths()) = 3,
        # Generally, children is list of ordered lists of all possible children.
        # 2 children, both with same parameter a_exp():
        # [1] MDDFT on all but last dimension;
        # [2] PRDFT1 on last dimension, the fastest varying dimension.
        children  := nt -> let(a_lengths := nt.a_lengths(),
                               a_exp := nt.a_exp(),
                               tags := nt.getTags(),
                               taglen := Length(tags),
                               rtags1 := tags{[2]},
                               [[ MDDFT(DropLast(a_lengths, 1), a_exp).withTags(rtags1),
                                  PRDFT1(Last(a_lengths), a_exp) ]]),

        # nonterminal, children, children non-terminals
        # NOT YET CORRECT
        apply := (nt, C, cnt) -> let(a_lengths := nt.a_lengths(),
                                     Clast := C[2],
                                     Crest := C[1],
                                     Nlastcomplex := Clast.dims()[1]/2,
                                     Nrest := DropLast(a_lengths, 1),
                                     Nallbutlast := Product(Nrest),
                                     # Apply Clast on last dimension,
                                     # then Crest on all dimensions but last.
                                     RC(SIMTTensor(_toSIMTDim(nt.getTags(){[1]}, Nlastcomplex), Crest, I(Nlastcomplex))) *
                                     SIMTTensor(_toSIMTDim(nt.getTags(){[1]}, Nrest[1]), I(Nrest[1]),
                                         SIMTTensor(_toSIMTDim(nt.getTags(){[2]}, Nrest[2]), I(Nrest[2]),
                                             Clast)))
    ),
    MDPRDFT_tSPL_RowCol_SIMT := rec(
        info :="MDDFT(n_1,n_2,...,n_t) = (RC(MDDFT(n_1,n_2,...,n_{t-1}) x I(.))) (I(n_1*n_2*...*n_{t-1}) x PRDFT1(n_t))",
        applicable := nt->nt.hasTags() and ForAll(nt.getTags(), _isSIMTTag) and Length(nt.params[1]) > 1,
        children  := nt -> let(a_lengths := nt.params[1],
                               a_exp := nt.params[2],
                               tags := nt.getTags(),
                               mddft := MDDFT(DropLast(a_lengths, 1), a_exp),
                               prdft := PRDFT1(Last(a_lengths), a_exp),
                               [[ TTensorI(mddft, prdft.dims()[1]/2, AVec, AVec).withTags(tags),
                                  FoldR(DropLast(a_lengths, 1), (a,b)->TTensorI(a, b, APar, APar), prdft).withTags(tags) ]]),
        apply := (nt, C, cnt) -> RC(C[1]) * C[2]
    ),
    MDPRDFT_tSPL_Pease_SIMT := rec(
        applicable := nt->nt.hasTags() and ForAll(nt.getTags(), _isSIMTTag) and Length(nt.params[1]) > 1,
        children  := nt -> let(a_lengths := nt.params[1],
                               a_exp := nt.params[2],
                               tags := nt.getTags(),
                               prdft := PRDFT1(Last(a_lengths), a_exp),
                               rcdim := Rows(prdft),
                               [ [ TCompose(List(DropLast(nt.params[1], 1), i->TRC(TTensorI(DFT(i, a_exp), rcdim * Product(DropLast(nt.params[1], 1))/(2*i), AVec, APar)))::
                                           [ TGrp(TCompose([TL(rcdim * Product(DropLast(nt.params[1], 1)) / 2, rcdim / 2, 1, 2),
                                             TTensorI(PRDFT1(Last(a_lengths), a_exp), Product(DropLast(nt.params[1], 1)), APar, APar)])) ]).withTags(tags) ]] ),
        apply := (nt, C, cnt) -> C[1]
    )

));

NewRulesFor(IMDPRDFT, rec(
    IMDPRDFT_3D_SIMT := rec(
        info :="IMDDFT(n_1,n_2,...,n_t) = (RC(IMDDFT(n_1,n_2,...,n_{t-1}) x I(.))) (I(n_1*n_2*...*n_{t-1}) x PRDFT1(-n_t))",
        applicable := nt->nt.hasTags() and Length(nt.getTags()) = 2 and ForAll(nt.getTags(), _isSIMTTag) and Length(nt.a_lengths()) = 3,
        # Generally, children is list of ordered lists of all possible children.
        # 2 children, both with same parameter a_exp():
        # [1] IMDDFT on all but last dimension;
        # [2] IPRDFT1 on last dimension, the fastest varying dimension.
        children  := nt -> let(a_lengths := nt.a_lengths(),
                               a_exp := nt.a_exp(),
                               tags := nt.getTags(),
                               taglen := Length(tags),
                               rtags1 := tags{[2]},
                               [[ MDDFT(DropLast(a_lengths, 1), a_exp).withTags(rtags1),
                                  IPRDFT1(Last(a_lengths), a_exp) ]]),

        # nonterminal, children, children non-terminals
        # NOT YET CORRECT
        apply := (nt, C, cnt) -> let(a_lengths := nt.a_lengths(),
                                     Clast := C[2],
                                     Crest := C[1],
                                     Nlastcomplex := Clast.dims()[2]/2,
                                     Nrest := DropLast(a_lengths, 1),
                                     Nallbutlast := Product(Nrest),
                                     # Apply Crest on all dimensions but last,
                                     # then Clast on last dimension.
                                     SIMTTensor(_toSIMTDim(nt.getTags(){[1]}, Nrest[1]), I(Nrest[1]),
                                         SIMTTensor(_toSIMTDim(nt.getTags(){[2]}, Nrest[2]), I(Nrest[2]),
                                             Clast)) *
                                     RC(SIMTTensor(_toSIMTDim(nt.getTags(){[1]}, Nlastcomplex), Crest, I(Nlastcomplex))))
    ),
    IMDPRDFT_tSPL_RowCol_SIMT := rec(
        info :="IMDDFT(n_1,n_2,...,n_t) = (RC(IMDDFT(n_1,n_2,...,n_{t-1}) x I(.))) (I(n_1*n_2*...*n_{t-1}) x PRDFT1(-n_t))",
        applicable := nt->nt.hasTags() and ForAll(nt.getTags(), _isSIMTTag) and Length(nt.params[1]) > 1,
        children  := nt -> let(a_lengths := nt.params[1],
                               a_exp := nt.params[2],
                               tags := nt.getTags(),
                               mddft := MDDFT(DropLast(a_lengths, 1), a_exp),
                               iprdft := IPRDFT1(Last(a_lengths), a_exp),
                               [[ FoldR(DropLast(a_lengths, 1), (a,b)->TTensorI(a, b, APar, APar), iprdft).withTags(tags),
                                   TTensorI(mddft, iprdft.dims()[2]/2, AVec, AVec).withTags(tags) ]]),
        apply := (nt, C, cnt) -> C[1] * RC(C[2])
    ),
    IMDPRDFT_tSPL_Pease_SIMT := rec(
        applicable := nt->nt.hasTags() and ForAll(nt.getTags(), _isSIMTTag) and Length(nt.params[1]) > 1,
        children  := nt -> let(a_lengths := nt.params[1],
                               a_exp := nt.params[2],
                               tags := nt.getTags(),
                               iprdft := IPRDFT1(Last(a_lengths), a_exp),
                               rdim := Rows(iprdft),
                               cdim := Cols(iprdft),
                               [ [ TCompose([ TGrp(TCompose([
                                             TTensorI(IPRDFT1(Last(a_lengths), a_exp), Product(DropLast(a_lengths, 1)), APar, APar),
                                             TL(cdim * Product(DropLast(a_lengths, 1)) / 2, Product(DropLast(a_lengths, 1)), 1, 2),
                                       ])) ] ::
                                       Reversed(List(DropLast(a_lengths, 1), i->TRC(TTensorI(DFT(i, a_exp), cdim * Product(DropLast(a_lengths, 1))/(2*i), APar, AVec))))
                                    ).withTags(tags) ]] ),
        apply := (nt, C, cnt) -> C[1]
    )

));

NewRulesFor(TRC, rec(
    TRC_SIMT := rec(
        forTransposition := false,
        applicable := nt->nt.hasTags() and _isSIMTTag(nt.firstTag()),
        children := nt -> [[ nt.params[1].withTags(nt.getTags()) ]],
        apply := (nt, c, cnt) -> RC(c[1])
    )
));

NewRulesFor(TL, rec(
#   TL(N,n,l,r,[]) -> I_l x L(N,n) x I_r
    L_SIMT := rec(
        forTransposition := false,
        applicable := nt->nt.hasTags() and _isSIMTTag(nt.firstTag()),
        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))
        )
    )
));

NewRulesFor(TTensorInd, rec(
#   base cases
#   I x A
    TTensorInd_SIMT := rec(
        info := "IxA base",
        forTransposition := false,
        applicable := nt -> nt.hasTags() and _isSIMTTag(nt.firstTag()) and IsParPar(nt.params),
        children := nt -> [[ nt.params[1].withTags(Drop(nt.getTags(), 1)), InfoNt(nt.params[2]) ]],
        apply := (nt, c, cnt) -> SIMTIDirSum(_toSIMTDim(nt.getTags(), cnt[2].params[1].range), cnt[2].params[1], cnt[2].params[1].range, c[1])
    )
));

NewRulesFor(TTensorI, rec(
#   base cases
#   I x A
    IxA_SIMT := rec(
        info := "IxA base",
        forTransposition := false,
        applicable := nt -> nt.hasTags() and _isSIMTTag(nt.firstTag()) and  IsParPar(nt.params) and nt.params[2] > 1,
        children := nt -> [[ nt.params[1].withTags(Drop(nt.getTags(), 1)) ]],
        apply := (nt, c, cnt) -> #When(nt.params[2] > 1,
            SIMTTensor(_toSIMTDim(nt.getTags(), nt.params[2]), I(nt.params[2]), c[1])#,
            #c[1])
    ),
#   A x I
    AxI_SIMT := rec(
        info := "AxI base",
        forTransposition := false,
        applicable := nt -> nt.hasTags() and _isSIMTTag(nt.firstTag()) and IsVecVec(nt.params) and nt.params[2] > 1,
        children := nt -> [[ nt.params[1].withTags(Drop(nt.getTags(), 1)) ]],
        apply := (nt, c, cnt) -> #When(nt.params[2] > 1,
            SIMTTensor(_toSIMTDim(nt.getTags(), nt.params[2]), c[1], I(nt.params[2]))#,
            #c[1])
    ),
#   A x I
    trivialLoop := rec(
        info := "AxI base",
        forTransposition := false,
        applicable := nt -> nt.hasTags() and _isSIMTTag(nt.firstTag()) and nt.params[2] = 1,
        children := nt -> [[ nt.params[1].withTags(DropLast(nt.getTags(), 1)) ]],
        apply := (nt, c, cnt) -> c[1]
    ),
#   L (I x A)
    L_IxA_SIMT := rec(
        forTransposition := false,

        # these config parameters need to be moved into the opts...
        mem := 1024*96,
        mem_per_pt := 2*8*2,
        max_threads := 2048,
        max_kernel := 18 * 18,
        _peelof := (self,n,m) >> Maximum(Filtered(self.mem_per_pt * Filtered(n*DivisorsInt(m), e-> e<self.max_threads),
            f -> f < When(n >= self.max_kernel, self.mem/2, self.mem)))/(self.mem_per_pt*n),

        applicable := nt -> nt.hasTags() and _isSIMTTag(nt.firstTag()) and IsVecPar(nt.params) and nt.params[2] > 1,
        children := (self, nt) >> let(n := Rows(nt.params[1]), m:= nt.params[2], peelof := self._peelof(n,m), remainder := m/peelof,
            [[ TCompose([TL(Rows(nt)/peelof, n, 1, peelof),
                TTensorI(
                    TCompose([TL(Rows(nt.params[1]) * peelof, Rows(nt.params[1])), TTensorI(nt.params[1], peelof, APar, APar)]),
                    remainder, APar, APar)]).withTags(nt.getTags()) ]]),
        apply := (nt, c, cnt) -> c[1]
    ),
#   (I x A) L
    IxA_L_SIMT := rec(
        forTransposition := false,

        # these config parameters need to be moved into the opts...
        mem := 1024*96,
        mem_per_pt := 2*8*2,
        max_threads := 2048,
        max_kernel := 18 * 18,
        _peelof := (self,n,m) >> Maximum(Filtered(self.mem_per_pt * Filtered(n*DivisorsInt(m), e-> e<self.max_threads),
            f -> f < When(n >= self.max_kernel, self.mem/2, self.mem)))/(self.mem_per_pt*n),

        applicable := nt -> nt.hasTags() and _isSIMTTag(nt.firstTag()) and IsParVec(nt.params) and nt.params[2] > 1,
        children := (self, nt) >> let(n := Rows(nt.params[1]), m:= nt.params[2], peelof := self._peelof(n,m), remainder := m/peelof,
            [[ TCompose([
                TTensorI(
                    TCompose([TTensorI(nt.params[1], peelof, APar, APar), TL(Rows(nt.params[1]) * peelof, peelof)]), remainder, APar, APar),
                TL(Rows(nt)/peelof, (Rows(nt)/peelof)/n, 1, peelof),
                ]).withTags(nt.getTags()) ]]),
        apply := (nt, c, cnt) -> c[1]
    )

));


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

Class(Drawer, rec(
    __call__ := meth(self,n)
        return WithBases(self,rec(n:=n,instances:=[]));
    end,

    add := meth(self,instance)
        if (not IsList(instance)) or (Length(instance)<>self.n) then
            Error("Trying to add a non regular instance");
        fi;
        Add(self.instances,instance);
    end,

    getNormalTransfo := meth(self)
       local result,l,m,s;
       result:=[];
       for l in Transposed(self.instances) do
          m:=Mean(l);
          s:=Try(StdDev(l));
          if not s[1] then s:=0; else s:=s[2]; fi;
          Add(result,[m,s]);
       od;
       return result;
    end,

    normalize := meth(self,transfo)
       local t,n,l;
       t:=[];
       n:=1;
       for l in Transposed(self.instances) do
          if (transfo[n][2]<>0) then
              Add(t,List(l,x->(x-transfo[n][1])/transfo[n][2]));
          else
              Add(t,List(l,x->(x-transfo[n][1])));
          fi;
          n:=n+1;
       od;
       self.instances:=Transposed(t);
    end,

    checkCredibility := meth(self,testing, transfo)
        local j;
        for j in [1..Length(self.instances)] do
            for i in [1..Length(testing.instances[1])] do
               if transfo[i][2]=0 and transfo[i][1]<>testing.instances[j][i] then
                   self.instances[j]:=[2^16,1,2^32];
               fi;
            od;
        od;
    end,

    denormalize := meth(self,transfo)
       local t,n,l;
       t:=[];
       n:=1;
       for l in Transposed(self.instances) do
          if (transfo[n][2]<>0) then
              Add(t,List(l,x->x*transfo[n][2] + transfo[n][1]));
          else
              Add(t,List(l,x->x + transfo[n][1]));
          fi;
          n:=n+1;
       od;
       self.instances:=Transposed(t);
    end,

    print := meth(self,filename)
       local l,a;
       PrintTo(filename,"");
       for l in self.instances do
          for a in l do
             AppendTo(filename,a," ");
          od;
          AppendTo(filename,"\n");
       od;
    end,

));

Class(GaussianPredictor, rec(

    __call__ := meth(self)
        return WithBases(self);
    end,

    predict := meth(self, hash, objid, testCases, tags)
      local n,a,i,transfo,training,testing,predict,index,sol,t;
      n:=DimensionsMat(testCases)[2];
      training:=Drawer(n+1);
      for a in Flat(hash.entries) do
          if ObjId(a.key)=objid and a.key.params[n+1]=tags and Length(a.data)>0 and IsBound(a.data[1].mflopslibgen) then
              training.add(Concat(a.key.params{[1..n]},
                      [a.data[1].mflopslibgen]));
          fi;
      od;

      transfo:=training.getNormalTransfo();
      a:=Copy(training);
      a.normalize(transfo);
      a.print("trainingset");

      testing:=Drawer(n);
      testing.instances:=testCases;
      a:=Copy(testing);
      a.normalize(DropLast(transfo,1));
      a.print("testingset");

      IntExec("rm -f rlog.gp");
      IntExec(Concat("gp-spec rlog.gp ",String(n),
              " 1 10 / 0.05:0.4 0.05:0.4"));
      IntExec("model-spec rlog.gp real 0.05:0.4");
      IntExec(Concat("data-spec rlog.gp ",String(n)," 1 / trainingset ."));
      IntExec("gp-gen rlog.gp fix 0.5 0.1");
      IntExec("mc-spec rlog.gp heatbath hybrid 18:3 0.5");
      IntExec("gp-mc rlog.gp 100");
      IntExec("gp-pred nqb rlog.gp 51: / testingset >myoutput");
      IntExec("awk 'BEGIN {print \"[\"} {print \"[\",$1,\", \",$2,\", \",$3,\"], \"} END{print\"];\"}' myoutput >myrealoutput");

      a:=ReadVal("myrealoutput");

      predict:=Drawer(3);
      predict.instances:=a;
      predict.denormalize(Replicate(3,Last(transfo)));

      for a in [1..Length(testing.instances)] do
          t:=ApplyFunc(objid,Concat(testing.instances[a],[tags]));
          i:=HashLookup(hash,t);
          if (i<>false) and IsBound(i[1].mflopslibgen) then
              predict.instances[a]:=Replicate(3,i[1].mflopslibgen);
          fi;
      od;

      return predict.instances;
   end,

    predict2 := meth(self, hash, objid, testCases, tags)
      local n,a,i,transfo,training,testing,predict,index,sol,t,tmp;
      n:=DimensionsMat(testCases)[2];
      training:=Drawer(n+1);
      for a in Flat(hash.entries) do
          if ObjId(a.key)=objid and a.key.params[n+1]=tags and Length(a.data)>0 and
              IsBound(a.data[1].measured)  then
              training.add(Concat(a.key.params{[1..n]},
                      [_compute_mflops(When(IsBound(a.key.normalizedArithCost),
                                  a.key.normalizedArithCost(), 0), a.data[1].measured)]));
          fi;
      od;
      Print("Estimating ",Length(testCases)," points (with ",Length(training.instances),"): ",
          objid," (",tags,")\n");

      if Length(training.instances)=0 then
          return Replicate(Length(testCases),[2^16,0,2^32]);
      fi;
      transfo:=training.getNormalTransfo();
      a:=Copy(training);
      a.normalize(transfo);
      a.print("trainingset");

      testing:=Drawer(n);
      testing.instances:=testCases;
      a:=Copy(testing);
      a.normalize(DropLast(transfo,1));
      a.print("testingset");

      IntExec("rm -f rlog.gp");
      IntExec(Concat("gp-spec rlog.gp ",String(n),
              " 1 10 / 0.05:0.4 0.05:0.4"));
      IntExec("model-spec rlog.gp real 0.05:0.4");
      IntExec(Concat("data-spec rlog.gp ",String(n)," 1 / trainingset . 2>/dev/null"));
      IntExec("gp-gen rlog.gp fix 0.5 0.1");
      IntExec("mc-spec rlog.gp heatbath hybrid 18:3 0.5");
      IntExec("gp-mc rlog.gp 100");
      IntExec("gp-pred nqb rlog.gp 51: / testingset >myoutput");
      IntExec("awk 'BEGIN {print \"[\"} {print \"[\",$1,\", \",$2,\", \",$3,\"], \"} END{print\"];\"}' myoutput >myrealoutput");

      a:=ReadVal("myrealoutput");

      predict:=Drawer(3);
      predict.instances:=a;
      predict.denormalize(Replicate(3,Last(transfo)));

      predict.checkCredibility(testing, transfo);

      for a in [1..Length(testing.instances)] do
          t:=ApplyFunc(objid,Concat(testing.instances[a],[tags]));
          i:=HashLookup(hash,t);
          if (i<>false) and IsBound(i[1].measured) then
              predict.instances[a]:=Replicate(3,i[1].measured);
          else
              predict.instances[a]:=List(predict.instances[a],x->
                  _compute_cycles_from_mflops(When(IsBound(t.normalizedArithCost),
                                  t.normalizedArithCost(), 0),x));
              #invert max and min because min flops is max runtime
              tmp:=predict.instances[a][2];
              predict.instances[a][2]:=predict.instances[a][3];
              predict.instances[a][3]:=When(tmp<0,2^64,tmp);
          fi;
      od;

      return predict.instances;
   end,

   countTraining:=meth(self, dpbench, objid, n, tags)
      local r,hash,a;
      hash:=dpbench.exp.bases.hashTable;
      r:=0;
      for a in Flat(hash.entries) do
          if ObjId(a.key)=objid and a.key.params[n+1]=tags and Length(a.data)>0 then
              r:=r+1;
          fi;
       od;
      return r;
   end,

   findMax:=meth(self, base_bench, libgen_bench, base_objid, libgen_objid, testing, tags,flopsfactor)
       local over,sol,secured,estimate,a,s, unscaledsol;
       base_bench.verbosity:=0;
       if (g.countTraining(base_bench,base_objid,DimensionsMat(testing)[2],tags)<2) then
           base_bench.exp.bases.benchTransforms:=[ApplyFunc(base_objid,Concat(First(testing,x->true),[tags])),[ApplyFunc(base_objid,Concat(Last(testing),[tags]))]];
           base_bench.resumeAll();
       fi;

       over:=false;
       while(not over) do
           unscaledsol:=self.predict(base_bench.exp.bases.hashTable,base_objid,testing,tags);
           sol:=List([1..Length(testing)],x->List(unscaledsol[x],y->flopsfactor(testing[x],y)));
           secured:=[testing[1],sol[1]];
           estimate:=[testing[1],sol[1]];
           for a in [1..Length(testing)] do
              s:=[testing[a],sol[a]];
              if (s[2][1]=s[2][2] and s[2][1]=s[2][3] and s[2][1]>secured[2][1]) then
                  secured:=s;
              fi;
              if (s[2][3]>estimate[2][3]) then
                  estimate:=s;
              fi;
           od;

           Print("Current Maximum is ",Red(StringDouble("%.3f",secured[2][1]/1000))," [Gf/s] achieved by ",ApplyFunc(base_objid,Concat(secured[1],[tags])),"\n" );
           if (estimate[2][3]<=secured[2][1]) then
               over:=true;
           else
               Print("Best Hope is ",ApplyFunc(base_objid, Concat(estimate[1],[tags]))," with ",StringDouble("%.3f",estimate[2][1]/1000)," [Gf/s] (",StringDouble("%.3f",estimate[2][2]/1000)," < x < ",StringDouble("%.3f",estimate[2][3]/1000),")\n" );
               base_bench.exp.bases.benchTransforms:=[ApplyFunc(base_objid,Concat(estimate[1],[tags]))];
               base_bench.resumeAll();
               libgen_bench.runExhaust([ApplyFunc(libgen_objid,Concat(estimate[1]*2,[ApplyFunc(base_objid,Concat(estimate[1],[tags]))]))]);
               base_bench.exp.bases.benchTransforms:=[];
               base_bench.resumeAll(); #Fire Callbacks
           fi;
       od;
       return ApplyFunc(base_objid,Concat(secured[1],[tags]));
    end,
));


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

Import(approx);

SubMat := (mat, ri, ci, rsize, csize) -> let(
    d := DimensionsMat(mat),
    nrows := d[1],
    ncols := d[2],
    List(mat{[ri .. Min2(ri+rsize-1, nrows)]},
	row -> row{[ci .. Min2(ci+csize-1, ncols)]})
);

GetBlocksMat := (mat, rblk, cblk) -> Checked(IsPosInt(rblk), IsPosInt(cblk), let(
    d := DimensionsMat(mat),
    nrows := d[1],
    ncols := d[2],
    List([0 .. CeilingRat(nrows/rblk)-1], rb ->
	List([0 .. CeilingRat(ncols/cblk)-1], cb ->
	    SubMat(mat, 1+rb*rblk, 1+cb*cblk, rblk, cblk)))
));

# Cyclic diagonal vectorization:
VectorizedZMatSPL := ( isa, spl ) -> Checked( Rows(spl)=Cols(spl) and isa.v = Rows(spl), let(
    mat := Cond(IsMat(spl), spl, MatSPL(spl)),
    VBlk( [List( [0 .. isa.v-1], j -> isa.t.value(
                List( [0 .. isa.v-1], i -> mat[1 + i][1 + (i-j) mod isa.v])
         ))],
         isa.v)
));

# Straight diagonal vectorization:
VectorizedDMatSPL := ( isa, spl ) -> Checked(Rows(spl) <= isa.v, let(
    mat   := Cond(IsMat(spl), spl, MatSPL(spl)),
    r     := Rows(mat),
    c     := Cols(mat),
    padd  := (offs, l) -> Replicate(offs, 0) :: l :: Replicate(isa.v - offs - Length(l), 0),
    VBlk( [ List( [0 .. r-2], i -> isa.t.value(padd(r-i-1, List( [0 .. _unwrap(min(i,c-1))], j -> mat[r-i+j][j+1] )))) ::
            List( [0 .. c-1], i -> isa.t.value(padd(    0, List( [0 .. When(i+r<=c, r-1, c-i-1)], j -> mat[j+1][i+j+1] )))) ],
         isa.v)
));

# Zero pad both dimensions:
ZeroPadMat := (mat, v) -> let(
    r   := Rows(mat),
    c   := Cols(mat),
    dr  := CeilingRat(r/v)*v - r,
    dc  := CeilingRat(c/v)*v - c,
    List( mat, row -> row :: Replicate(dc, 0) ) :: Replicate(dr, Replicate(c+dc, 0))
);

# Zero pad matrix by adding zero rows:
ZeroPadMatV := (mat, v) -> let(
    r   := Rows(mat),
    c   := Cols(mat),
    dr  := CeilingRat(r/v)*v - r,
    mat :: Replicate(dr, Replicate(c, 0))
);

NewRulesFor(TMat, rec(
    TMat_Base := rec(
	applicable := (self, t) >> not t.hasTags(),
        apply := (self, t, C, Nonterms) >> Mat(t.params[1])
    ),

    TMat_Vec := rec(
	forTransposition := false,
	maxSize := 128,
	applicable := (self, t) >> t.hasTags() and t.isTag(1, AVecReg) and
	    (self.maxSize<0 or (Rows(t) <= self.maxSize and Cols(t) <= self.maxSize)),

        apply := (self, t, C, Nonterms) >> let(
	    isa := t.getTag(AVecReg, 1).isa,
	    VectorizedMatSPL(isa, t)
        )
    ),

    # vectorization of square matrix with dimensions equal to vector width using cyclic shifts
    TMat_VecZ := rec(
        forTransposition := false,
	applicable := (self, t) >> t.hasTags() and t.isTag(1, AVecReg) and
	    Rows(t) = Cols(t) and Rows(t)=t.getTag(AVecReg).v,

        apply := (self, t, C, Nonterms) >> let( isa := t.getTag(AVecReg).isa, i := Ind(isa.v),
	    VectorizedZMatSPL(isa, t)
	     * ISum(i, VScat(fBase(isa.v, i), isa.v) * VPerm(Z(isa.v,-i), isa.rotate_left(i), isa.v, 1))
	     * VGath(fId(1), isa.v)
        )
    ),

    # Vectorization of non square matrix by diagonals
    TMat_VecD := rec(
        forTransposition := false,
        maxSize := 256,
	applicable := (self, t) >> t.hasTags() and t.isTag(1, AVecReg) and
	    Rows(t) <= t.getTag(AVecReg).v and (self.maxSize<0 or Cols(t) <= self.maxSize),

        apply := (self, t, C, Nonterms) >> let(
            isa := t.getTag(AVecReg).isa,
            v   := isa.v,
            r   := Rows(t),
            c   := Cols(t),
            ru  := _roundup(c + v-1, v),
            i   := Ind(r-1),
            j   := Ind(c),
            VScat_pc( r, r, 0, v) *
            VectorizedDMatSPL(isa, t) *
            SUM(
                When(r>1,
                [ ISum(i,
                    VScat(fBase(r+c-1,     i), v) * VPerm(Z(v,v-r+i+1), isa.rotate_left(r-i-1), v, 1)
                     * VGath_pc(c, min(c, v), 0, v))], []) ::
                [ISum(j,
                    VScat(fBase(r+c-1, j+r-1), v)
                     * VGath_pc(c, min(v, c-j), j, v)).unrolledChildren()]
            )
        )
    ),

    TMat_UnrolledBlkH := rec(
        forTransposition := false,
	applicable := (self, t) >> t.hasTags() and t.isTag(1, AVecReg) and
	    Rows(t) > t.getTag(AVecReg).v,

        freedoms := (self, t) >> [[t.getTag(AVecReg).v]],

	child := (self, t, fr) >> Flat(MapMat(GetBlocksMat(ZeroPadMatV(t.params[1], t.getTag(AVecReg).v), fr[1], Cols(t)), e -> TMat(e).withTags(t.getTags()))),

        apply := (self, t, C, Nonterms) >> let(
            isa := t.getTag(AVecReg).isa,
            v   := isa.v,
            c   := Cols(t),
            r   := Rows(t),
            VScat_pc(r, r, 0, v) * SUM(
                List( [1..Length(C)], i -> VScat(fAdd(Length(C), 1, i-1), v) * C[i] ))
        )
    ),

    TMat_UnrolledBlkV := rec(
        forTransposition := false,
	applicable := (self, t) >> t.hasTags() and t.isTag(1, AVecReg) and
	    Cols(t) > t.getTag(AVecReg).v,

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

	child := (self, t, fr) >> let(
	    v := t.getTag(AVecReg).v,
	    m := ZeroPadMat(t.params[1], v),
	    Flat(MapMat(GetBlocksMat(m, Rows(m), v), e -> TMat(e).withTags(t.getTags())))
	),

        apply := (self, t, C, Nonterms) >> let(
            isa := t.getTag(AVecReg).isa,
            v   := isa.v,
            c   := Cols(t),
            r   := Rows(t),
            h   := CeilingRat(r/v),
            VScat_pc(r, r, 0, v) *
            VBlk( MapMat(TensorProductMat( [Replicate( CeilingRat(c/v), 1)], IdentityMat(h) ), e -> When(e=0, isa.t.zero(), isa.t.one())), v)*
            SUM(
                List( [1..Length(C)], i -> VScat(fAdd(Length(C)*h, h, (i-1)*h), v) * C[i] * VGath(fAdd(Length(C), 1, i-1), v) ))*
            #HStack(C) *
            VGath_pc(c, c, 0, v)
        )
    ),

    TMat_Blk := rec(
    	forTransposition := false,

    	applicable := (self, t) >> t.hasTags() and t.isTag(1, AVecReg)
	    and (Rows(t) > self.rblk or Cols(t) > self.cblk),

	# Matrix partition
	# N - normal block (rblk x cblk), T - tall blocks, S - short blocks, C - corner bock
	#
	# N ... N T
	# . \   . T
	# .   \ . T
	# N ... N T
        # S S S S S
	#
	_NTSC_Split := meth(self, mat, rblk, cblk)
	    local r, c, nr, nc, N, T, S, C;
	    [ r,  c] := Dimensions(mat);
	    [nr, nc] := [r - r mod rblk,  c - c mod cblk];
	    N := mat{[1..nr]}{[1..nc]};
	    T := mat{[1..nr]}{[nc+1..c]};
	    S := mat{[nr+1..r]}{[1..nc]};
	    C := mat{[nr+1..r]}{[nc+1..c]};
	    return [N, T, S, C];
	end,

        apply := meth(self, t, C, Nonterms)
	    local isa, N, T, S, C, blks, dat, dvar, i, j;

    	    isa := t.getTag(AVecReg, 1).isa;

	    [N, T, S, C] := self._NTSC_Split(t.params[1], self.rblk, self.cblk);
	    blks := rec(
		N := MapMat(GetBlocksMat(N, self.rblk, self.cblk), x -> VectorizedMatSPL(isa, x)),
		T := MapMat(GetBlocksMat(T, self.rblk, self.cblk), x -> VectorizedMatSPL(isa, x)),
		S := MapMat(GetBlocksMat(S, self.rblk, self.cblk), x -> VectorizedMatSPL(isa, x))
	    );
	    dat := rec(
		N := V(List(Collect(blks.N, VBlk), x->x.element)),
		T := V(List(Collect(blks.T, VBlk), x->x.element)),
		S := V(List(Collect(blks.S, VBlk), x->x.element))
	    );
	    dvar := rec(
		N := var.fresh_t("DN", dat.N.t),
		T := var.fresh_t("DT", dat.T.t),
		S := var.fresh_t("DS", dat.S.t)
	    );

	    [i, j] := [Ind(Rows(blks.N)), Ind(Cols(blks.N))];

	    return
	    Data(dvar.N, dat.N,
	    Data(dvar.T, dat.T,
	    Data(dvar.S, dat.S,
		VStack(
		    IterVStack(i,
			HStack(
			    IterHStack(j,
				BB(SubstTopDownNR(blks.N[1][1], VBlk, x->VBlk(nth(dvar.N, i*Cols(blks.N)+j), isa.v)))
			    ),
			    BB(SubstTopDownNR(blks.T[1][1], VBlk, x->VBlk(nth(dvar.T, i), isa.v)))
			)
		    ),
		    HStack(
			IterHStack(j,
			    BB(SubstTopDownNR(blks.S[1][1], VBlk, x->VBlk(nth(dvar.S, j), isa.v)))
			),
			VectorizedMatSPL(isa, C)
		    )
		)
	    )));
	end
    )
));


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

EPS:=1E-14;
RoundEPS:=(v)->Cond((v>-EPS) and (v<EPS),0,v);
IsVal:=(x,v)->((x>(v-EPS)) and (x<(v+EPS)));
IsZero:=(x)->IsVal(x,0);
IsOne:=(x)->IsVal(x,1);
IsMinusOne:=(x)->IsVal(x,-1);

# Printing to C

Declare(CGen);

ISum.cprint := meth(self,i,is)
    Print("for( ", self.var.cprint(), " = ", self.domain, ") { \n");
    self.expr.cprint(i+is,i);
    Print(Blanks(i), "}\n");
end;

Compose.cprint := meth(self,i,is)
    local c;
    for c in self.children() do
	    Print(Blanks(i+is));
        c.cprint(i+is, is);
        Print(";\n");
    od;
    Print("\n");
end;

# -------------------
# TYPES
# -------------------

re.cprint := self >> Print(self.args[1].cprint(), ".r");
im.cprint := self >> Print(self.args[1].cprint(), ".i");

TComplex.ctype := "struct{double r,i;}";
TDouble.ctype  := "double";
TInt.ctype     := "int";

Typ.cdecl := (self, var) >> When(IsList(var),
    Print(self.ctype, " ", PrintCS(List(var, v->v.id))),
    Print(self.ctype, " ", var.id));

TArray.cdecl  := meth(self,var)
    local dims, elemtype;
    if IsList(var) then
	    DoForAll(var, v->Print(v.t.cdecl(v), "; "));
    elif not IsArray(self.t) then
        Print(self.t.ctype, Print(" ", var.id, "[", self.size, "]"));
    else
        dims := [];
        elemtype := self;
        while IsArray(elemtype) do
            Add(dims, elemtype.size);
            elemtype := elemtype.t;
        od;
        Print(elemtype.ctype, " ", var.id);
        DoForAll(dims, d->Print("[",d,"]"));
    fi;
end;

# -------------------
# EXPRESSIONS
# -------------------

_cprintcs := function ( lst )
    local  i;
    if Length(lst) = 0 then
	    return;
	fi;
    lst[1].cprint();
    for i  in [ 2 .. Length(lst) ]  do
        Print(", ", lst[i].cprint());
    od;
end;

ccprint := (v,t) -> v;

Command.cprint := (self,i,is) >> self.print(i,is);
Exp.cprint := self >> self.print();
Loc.cprint := self >> self.print();

Value.idx_cprint := self >> Print(self.v);

Value.cprint := self >> Cond(
    self.t = TComplex, let(c:=Complex(self.v),
        Print("{", ReComplex(c), ",", ImComplex(c), "}")),
    self.t = TDouble and IsCyc(self.v),
        Print("(", ccprint(ReComplex(Complex(self.v)), self.t), ")"),
    IsArray(self.t),
        Print("{",
		(self.v), "}"),
    self.v < 0,
        Print("(", ccprint(self.v, self.t), ")"),
    Print(ccprint(self.v, self.t)));

infix_print := function(lst, sep)
    local first, c;
    first := true;
    for c in lst do
        if first then
		    first := false;
        else
		    Print(sep);
        fi;
        c.cprint();
    od;
    return "";
end;

pinfix_print := function(lst, sep)
    local first, c;
    first := true;
    for c in lst do
        if first then
		    first := false;
        else
		    Print(sep);
        fi;
        if not IsBound(c.rChildren) or c.rChildren()=[] then
		    c.cprint();
        else
		    Print("(",c.cprint(), ")");
		fi;
    od;
    return "";
end;

add.idx_cprint := self >> Print( "(", infix_print(self.args, " + "), ")");
sub.idx_cprint := self >> Print( "(", infix_print(self.args, " - "), ")");
mul.idx_cprint := self >> Print( "", infix_print(self.args, "*"), "");
neg.idx_cprint := self >> Print("-(", self.args[1].cprint(), ")");

ExpCommand.cprint := (self,i,is) >>
    Print(Blanks(i), self.name, "(", infix_print(self.args, ", "), ");\n");

nth.cprint := self >> Print(self.loc.cprint(), "[", self.idx.cprint(), "]");
Exp.cprint := self >> Print(self.name, "(", infix_print(self.args, ", "), ")");
add.cprint := self >> Print( "(", infix_print(self.args, " + "), ")");
sub.cprint := self >> Print( "(", infix_print(self.args, " - "), ")");
mul.cprint := self >> Print( "", infix_print(self.args, "*"), "");
neg.cprint := self >> Print("-(", self.args[1].cprint(), ")");

div.cprint := self >> Print( "", pinfix_print(self.args, "/"), "");
idiv.cprint := self >> Print( "(", pinfix_print(self.args, "/"), ")");
imod.cprint := self >> Print( "(", pinfix_print(self.args, "%"), ")");
no_mod.cprint := self >> self.args[1].cprint();

cond.cprint := self >> Checked(Length(self.args)=3,
    Print("((", self.args[1].cprint(), ") ? (",
            self.args[2].cprint(), ") : (",
        self.args[3].cprint(), "))"));

leq.cprint := self >> Chain(
        Print("(1"),
        FoldL1(self.args, (a,b) ->
        Chain(Print(" && ", "(", a.cprint(), " <= ", b.cprint(), ")"), b)),
        Print(")"));

# -------------------
# COMMANDS
# -------------------

assign.cprint := meth(self, i, is)
    Print(Blanks(i), self.loc.cprint(), " = ", self.exp.cprint(), ";\n");
end;

chain.cprint := meth(self,i,is)
    local c, vars;
    Print(Blanks(i), "{", Blanks(is-1));
    vars := Set(
    List(Collect(self, [assign, @.target(var), @(1)]),
		e->e.loc));
    if false and Length(vars) > 0 then
	    Print("double ");
	    PrintCS(vars);
	    Print(";\n");
    else
	    Print("\n");
    fi;
    for c in self.cmds do
	    c.cprint(i+is, is);
    od;
    Print(Blanks(i), "}\n");
end;

data.cprint := meth(self,i,is)
    Print(Blanks(i), "{", Blanks(is-1), When(IsArray(self.value.t), "static ", ""),
        self.value.t.cdecl(self.var), " = ", self.value.cprint(), ";");
    Print("\n");
    self.cmd.cprint(i+is, is);
    Print(Blanks(i), "}\n");
end;

decl.cprint := meth(self,i,is)
    local v, first, types;
    Print(Blanks(i), "{", Blanks(is-1));
    if Length(self.vars) > 1 and Length(Set(List(self.vars, v->v.t)))=1 then
        # all types are the same
        self.vars[1].t.cdecl(self.vars);
        Print(";\n");
    else
        first := self.vars[1];
        if IsArray(first.t) then
		    Print("static ");
		fi;
        first.t.cdecl(first);
		Print(";\n");
        for v in Drop(self.vars, 1) do
            Print(Blanks(i+is));
            if IsArray(v.t) then
			    Print("static ");
			fi;
            v.t.cdecl(v);
            Print(";\n");
        od;
    fi;
    self.cmd.cprint(i+is, is);
    Print(Blanks(i), "}\n");
end;

loop.cprint_c99 := meth(self,i,is)
       local v, lo, hi;
       Constraint(IsRange(self.range));
       v := self.var;
	   lo := self.range[1];
	   hi := Last(self.range);
       Print(Blanks(i));
       Print("for(int ", v, " = ", lo, "; ", v, " <= ", hi, "; ", v, "++) \n");
       self.cmd.cprint(i+is, is);
end;

loop.cprint := meth(self,i,is)
       local v, lo, hi;
       Constraint(IsRange(self.range));
       v := self.var;
	   lo := self.range[1];
	   hi := Last(self.range);
       Print(Blanks(i));
       Print("{int ",v,"; for(", v, " = ", lo, "; ", v, " <= ", hi, "; ", v, "++) \n");
       self.cmd.cprint(i+is, is);
       Print("}");
end;

IF.cprint := meth(self,i,is)
       local v, lo, hi;
       Print(Blanks(i));
       Print("if(", self.cond.cprint(), ") {\n");
       self.then_cmd.cprint(i+is, is);
       Print(Blanks(i), "} else {\n");
       self.else_cmd.cprint(i+is, is);
       Print(Blanks(i), "}\n");
end;

CGenScalarANSI_C := function(subname, code)
   Constraint(IsCommand(code));
   Print(
    "extern void init_",subname," ();\n",
    "extern void ",subname," (",TDouble.ctype , " *, ",TDouble.ctype , " *);\n"
   );
   Print("void ", subname, "(", TDouble.ctype, " *Y, ", TDouble.ctype, " *X) {\n");
   code.cprint(4,2);
   Print("}\n");

   Print("void init_", subname, "() { }\n");
end;

CGenScalarIntel_C := function(subname, code)
   Constraint(IsCommand(code));
   Print(
    "extern void init_",subname," ();\n",
    "extern void ",subname," (",TDouble.ctype , " *, ",TDouble.ctype , " *);\n"
   );
   Print("void ", subname, "(", TDouble.ctype, " *restrict Y, ", TDouble.ctype, " *restrict X) {\n",
   "    __assume_aligned(X, 16)\n",
   "    __assume_aligned(Y, 16)\n");
   code.cprint(4,4);
   Print("}\n");

   Print("void init_", subname, "() { }\n");
end;

CGenScalarVectorC := function(subname, code)
   Constraint(IsCommand(code));
   Print(
    "extern void init_",subname," ();\n",
    "extern void ",subname," (",TDouble.ctype , " *, ",TDouble.ctype , " *);\n"
   );
   Print("void ", subname, "(__declspec(alignedvalue(16)) ", TDouble.ctype, " *restrict Y, __declspec(alignedvalue(16)) ", TDouble.ctype, " *restrict X) {\n");
   code.cprint(4,4);
   Print("}\n");

   Print("void init_", subname, "() { }\n");
end;

CGenScalarCPP := function(subname, code)
   Constraint(IsCommand(code));
   Print(
    "#ifdef __cplusplus\n",
    "extern \"C\" {\n",
    "#endif\n",
    "extern void init_",subname," ();\n",
    "extern void ",subname," (",TDouble.ctype , " *, ",TDouble.ctype , " *);\n",
    "#ifdef __cplusplus\n",
    "}\n",
    "#endif\n"
   );
   Print("void ", subname, "(", TDouble.ctype, " *Y, ", TDouble.ctype, " *X) {\n");
   code.cprint(4,4);
   Print("}\n");

   Print("void init_", subname, "() { }\n");
end;

CGen:=CGenScalarANSI_C;

# CGenDMP is set to a dummy-value here.
# Will be set to DMPUnparser.gen as soon as this is defined
# CGenDMP:=CGenScalarANSI_C;

CRuntimeTest := function ( testFunc, cmd, opts )
    local prog, result, cgenFunc;
    opts := Copy(opts);
    Constraint(IsCommand(cmd));
    Constraint(IsRec(opts));
    if not IsBound(opts.dataType) then
	    opts.dataType := "real";
	fi;
    opts := DeriveSPLOptions(cmd, opts);
    prog := ProgSPL(cmd, opts);
    prog.type := ProgInputType.TargetSource;

    cgenFunc := When(IsBound(opts.unparser), (f, cmd) -> opts.unparser.gen(f, cmd, opts), CGen);
    PrintTo(prog.file, cgenFunc(prog.sub_name, cmd));
    result := testFunc(cmd, opts, prog);

    if IsBool(result) and result=false then
        Error("Compiled code execution failed, offending program kept in '", prog.file, "'");
    else
        return result;
    fi;
end;

Declare(CodeRuleTreeOpts);
CVerifyRT := function(rt, opts)
    local c, m1,m2,nt;
    nt:=rt.node;
    c := CodeRuleTreeOpts(rt, opts);
    m1 := MatSPL(nt);
    m2 := CMatrix(c, opts);
    return Maximum(Flat(MapMat(m1-m2, i->AbsComplex(ComplexAny(i)))));
end;

CVerifyMMM:=(c,opts,t)->opts.profile.verify(c,opts,t);


# Creating a random source
rs := RandomSource(IsMersenneTwister);

# Generate a random number between 1 and 10
Random(rs, 1, 10);

# Same with default random source
Random(1, 10);


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

# Symbolic Scalars
# ================

#F Scalars
#F =======
#F

#F The class "Scalar" represents a symbolic scalar, that is not
#F evaluated. The main motivation is to
#F deal with trigonometric expressions (e.g., cosines) efficiently.
#F The usual numbers provided by gap will be called numbers.
#F
#F A Scalar is a GAP record with the following fields mandatory
#F for all types
#F
#F   isScalar    (=true)
#F   operations  (=ScalarOps)
#F   domain      (=Scalars)
#F   val
#F
#F where val is the actual symbolic expression represented as the delayed
#F evaluation object constructed with Delay() function.
#F

#F CanBeScalar( <obj> )
#F    This functions returns true if an object can become a Scalar record.
#F    Integers and rationals can't become a Scalar record, although they
#F    are considered to be part of Scalars field. This implies that this
#F    function is *misleading*. (NOTE: function def + description)
CanBeScalar :=  obj ->
    IsFloat(obj) or IsComplex(obj) or obj in FieldElements;

Declare(ScalarsOps, IsScalar);

_abs := x->Cond(IsComplex(x), AbsComplex(x),
                IsCyc(x), AbsComplex(Complex(x)),
        AbsFloat(x));

inf_norm := mat ->
    Maximum(List(mat, r -> Sum(r, x -> Cond(IsExp(x),   _abs(x.ev()),
                                    IsValue(x), _abs(x.v), _abs(x)))));
evmat := mat ->
    List(mat, r -> List(r, x -> Cond(IsExp(x), x.ev(), IsValue(x), x.v, x)));
absmat := mat ->
    List(mat, r -> List(r, x -> Cond(IsExp(x), _abs(x.ev()), IsValue(x), _abs(x.v), _abs(x))));
remat := mat -> MapMat(mat, x->ReComplex(Complex(x)));

col := (mat, c) -> List(mat, row->[row[c]]);

InfinityNormMat := inf_norm;

RealMatComplexMat := function(mat)
    local res, row, row1, row2, r, i, e, ee;
    res := []; # list of rows
    for row in mat do
        row1 := []; row2 := [];
    for e in row do
       ee := When(IsExp(e), e.eval(), e); r := re(ee).eval(); i := im(ee).eval();
       Append(row1, [r, -i]);
       Append(row2, [Copy(i), Copy(r)]);
    od;
    Add(res, row1); Add(res, row2);
    od;
    return res;
end;

RealVMatComplexVMat := function(vmat)
    local res, row, row1, row2, r, i, e, ee, el;
    res := []; # list of rows
    for row in vmat do
        row1 := []; row2 := [];
        for el in row do
            if IsRec(el) and IsBound(el.t) and IsArrayT(el.t) then el := el.v; fi;
            if IsList(el) then
                r := [];
                i := [];
                for e in el do
                    ee := When(IsExp(e), e.eval(), e);
                    Append(r, [re(ee).eval()]);
                    Append(i, [im(ee).eval()]);
                od;
            else
                Constraint((IsExp(el) or IsValue(el)) and IsVecT(el.t) and el.t.t<>TComplex);
                r := el;
                i := el.t.value(0);
            fi;
            Append(row1, [r, -i]);
            Append(row2, [Copy(i), Copy(r)]);
        od;
        Add(res, row1); Add(res, row2);
    od;
    return res;
end;

RCMat := RealMatComplexMat;

RCMatCyc := function ( mat )
    local  res, row, row1, row2, r, i, e, ee;
    res := [];
    for row  in mat  do
        row1 := []; row2 := [];
        for e  in row  do
            ee := When(IsExp(e), e.ev(), e);
            r := Re(ee); i := Im(ee);
            Append(row1, [ r, -i ]);
            Append(row2, [ i, r ]);
        od;
        Add(res, row1); Add(res, row2);
    od;
    return res;
end;

getReIm := function(c)
    local r, i;
    if IsCyc(c) then c:=ComplexCyc(c); fi;
    if IsInt(c) or IsFloat (c) then r:=c; i:=0;
    else if IsComplex(c) then r:=ReComplex(c); i:=ImComplex(c);
    else Error("bad matrix entry type");
    fi; fi;
    return [r,i];
end;

#############################################################################
#V  Scalars  . . . . . . . . . . . . . . . . . . . . . . field of all scalars
#V  ScalarsOps  . . . . . . . . . . . . . .  operations record for the domain
##
Class(Scalars, rec(
    isDomain   := true,
    isField    := true,
    #generators := [ ]
    zero       := V(0),
    one        := V(1),
    size       := "infinity",
    char       := 0,
    field      := 0,
    isFinite   := false,
));

Scalars.operations := Class(ScalarsOps, OpsOps, rec(
    \in := ( x, Scalars ) -> IsScalar(x) or IsRat(x) or IsCyc(x) or CanBeScalar(x),
    Field  := elms -> Scalars,
    DefaultField := elms ->Scalars
));

#F IsScalar( <obj> )
#F   tests whether <obj> is a scalar and returns true in the affirmative
#F   case. Else, false is returned.
#F
IsScalar := s -> IsRec(s) and (IsExp(s) or IsValue(s) or IsLoc(s));

#F IsScalarOrNum( <obj> )
#F
IsScalarOrNum := x -> IsScalar(x) or CanBeScalar(x);

#F Scalar( <d> )
#F   adds fields common to all scalars to a record to form a scalar
#F   from the delayed evaluation object <d>
#F
Scalar := d -> When(not IsDelay(d) and IsList(d),
    List(d, Scalar),
    toExpArg(d));

# Construction macro (allows to skip D())
SS := UnevalArgs( x -> Scalar(x) );

# we use lower case function names for optical convenience in SPLs
normPi := function(r)
    # move r into the interval [0,2)
    r := 2 * (r/2 - Int(r/2));
    if r < 0 then
    r := r + 2;
    fi;
    return r;
end;

ExportBagSPL := x->x;

TranslateGapFuncToSPL := rec(
    CosPi := cc -> Print("cos(", ExportBagSPL(cc[2]), "*pi)"),
    SinPi := cc -> Print("sin(", ExportBagSPL(cc[2]), "*pi)"),
    Sqrt  := cc -> Print("sqrt(", ExportBagSPL(cc[2]), ")")
);

ExportBagSPL := function(o)
    local t, cc;
    t := BagType(o);
    cc := Children(o);
    cc := cc{[2..Length(cc)]};

    Cond(t = T_PROD, Print("(", ExportBagSPL(cc[1]), " * ", ExportBagSPL(cc[2]), ")"),
     t = T_QUO,  Print("(", ExportBagSPL(cc[1]), " / ", ExportBagSPL(cc[2]), ")"),
     t = T_SUM,  Print("(", ExportBagSPL(cc[1]), " + ", ExportBagSPL(cc[2]), ")"),
     t = T_DIFF, Print("(", ExportBagSPL(cc[1]), " - ", ExportBagSPL(cc[2]), ")"),
     t = T_FUNCCALL, When(BagType(cc[1]) = T_VAR,
                       let(f  := NameOf(cc[1]),
			   tr := TranslateGapFuncToSPL,
                          When(IsBound(tr.(f)), tr.(f)(cc),
                   Error("Don't know how to translate '", f, "' to SPL")) ),
               Error("Can't translate unnamed function to SPL")),

     t = T_CYC,  let(c := ComplexCyc(o),
                     Print("(", String(ReComplex(c)), ",", String(ImComplex(c)), ")")),
     Print(o));
    return "";
end;

# PrintScalarToSPLNC ( <scalar> )
#   prints <scalar> in spl syntax. Used for exporting (spl.g).
#
PrintScalarToSPLNC := s -> s.printSPL();

Value.printSPL := self >> spiral.spl.PrintNumberToSPLNC(self.v);
Exp.printSPL := self >> Print(self.name, "(",
    DoForAllButLast(self.args, a->Chain(a.printSPL(), Print(", "))),
    Last(self.args).printSPL(), ")");

Loc.printSPL := self >> self.print();

fdiv.printSPL := self >> Print("(", self.args[1].printSPL(), "/", self.args[2].printSPL(), ")");
mul.printSPL := self >> Print("(", self.args[1].printSPL(), "*", self.args[2].printSPL(), ")");
add.printSPL := self >> Print("(", self.args[1].printSPL(), "+", self.args[2].printSPL(), ")");
sub.printSPL := self >> Print("(", self.args[1].printSPL(), "-", self.args[2].printSPL(), ")");
neg.printSPL := self >> Print("(-", self.args[1].printSPL(), ")");

cospi.printSPL := self >> Print("cos(", self.args[1].printSPL(), "*pi)");
sinpi.printSPL := self >> Print("sin(", self.args[1].printSPL(), "*pi)");
ScalarIsCos := x -> ObjId(x) = cospi;
ScalarIsSin := x -> ObjId(x) = sinpi;
ScalarCosArg := x -> x.args[1];

#F Functions for Scalars
#F ---------------------
#F

#F EvalScalar ( <scalar>/<number> )
#F   returns the number represented by <scalar>. If a <number>
#F   is given, then <number> is returned.
#F
EvalScalar := s -> _unwrap(
    Cond(s _is funcExp,
	    s.eval(),
	 IsScalar(s) and IsBound(s.ev),
	    s.ev(),
	 Eval(s)));

#F <s1> = <s2>
#F   returns true if both <s1> and <s2> are scalars, not of
#F   type "float" or "complex", and represent the same number.
#F
#Ops.\= := function ( s1, s2 )
#    return IsScalar(s1) and IsScalar(s2) and
#           s1.ev() = s2.ev();
#end;

#Exp.domain := Scalars;
#Value.domain := Scalars;
#Loc.domain := Scalars;