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

Class(VPRDFT, PRDFT);

PRF12_VCT_Children := (vlen, N,k,PRFt,DFTt,PRFtp,PRF1) -> let(m:=vlen, n:=N/vlen,
	[[ PRFt(m,k), DFTt(m,k), PRF1(n,k), PRFtp(m,k) ]]
);

Class(CompileBarrier, Buf);
CompileBarrier.code := (self, y, x) >> chain(skip(), compiler._CodeSums(self.child(1), y, x), skip());

PRF12_VCT_Rule := (N,k,C,Conj,Tw) -> let(m:=Cols(C[1]), n:=Cols(C[3]), Nf:=Int(N/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    (SUM(
	RC(Scat(H(Nf+1,mf+1,0,n))) * C[1] * Gath(H(2*(nf+1)*m, m, 0, 1)), #2*(nf+1))),

	When(nc=1, [],
	ISum(j,
	     RC(Scat(BH(Nf+1,N,m,j+1,n))) *
	     Conj * RC(C[2]) * Tw(j) * L(2*m, m) *
	     RC(Gath(H((nf+1)*m, m, (j+1)*m, 1))))),  #j+1, nf+1

	When(IsOddInt(n), [],
	RC(Scat(H(Nf+1,mc,nf,n))) * C[4] * Gath(H(2*(nf+1)*m, m, 2*m*nf, 1)))#2*nf, 2*(nf+1))))
    )) *
    #L(Rows(C[3])*m,m)) *
    CompileBarrier((transforms.VTensor(C[3], m)))
);

RulesFor(VPRDFT, rec(
    #F PRDFT1_CT: projection of DFT_CT
    VPRDFT_VCT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	vlen := 4,
	allChildren  := (self, P) >> PRF12_VCT_Children(self.vlen, P[1], P[2], PRDFT1, DFT1, PRDFT3, PRDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Cols(C[1]),
	    PRF12_VCT_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1)))))))
));

# opts := CopyFields(PRDFTDefaults, rec(globalUnrolling:=0, unparser:=CMacroUnparser, includes:=["<include/real_sse.h>"], compflags:="-O1 -msse -fomit-frame-pointer"));
# c:=CodeRuleTreeOpts(RandomRuleTree(VPRDFT(16)), opts);
# PrintCode("sub1", c, opts);
# PropagateTypes(c);
# CMacroUnparser(c, 4, 4);

# r := RandomRuleTree(VPRDFT(64));
# s := RecurseOpts(r, PRDFTDefaults);
# s1 := Collect(s, RecursStep)[2];
Import(search);

VPRDFT_example_gcc := function(n)
    SwitchRulesByName(PRDFT, [PRDFT1_Base1, PRDFT1_Base2, PRDFT1_CT, PRDFT_Rader, PRDFT_PD, PRDFT1_PF]);
    SwitchRulesByName(PRDFT3, [PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT, PRDFT3_OddToPRDFT1]);

    Local.opts := CopyFields(spiral.PRDFTDefaults,
	rec(globalUnrolling:=34,
	    unparser:=compiler.CMacroUnparser,
	    includes:=["<include/real_sse.h>"], compflags:="-O3 -msse2 -fomit-frame-pointer -ffast-math"));
    if not IsBound(Local.hash) then Local.hash := HashTableDP(); fi;

    return DP(VPRDFT(n), rec(hashTable := Local.hash), Local.opts);
end;

VPRDFT_example := function(n)
    SwitchRulesByName(PRDFT, [PRDFT1_Base1, PRDFT1_Base2, PRDFT1_CT, PRDFT_Rader, PRDFT_PD, PRDFT1_PF]);
    SwitchRulesByName(PRDFT3, [PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT, PRDFT3_OddToPRDFT1]);

    Local.opts := CopyFields(spiral.PRDFTDefaults,
	rec(globalUnrolling:=34,
	    unparser:=compiler.CMacroUnparser,
	    includes:=["<include/real_sse.h>"], compflags:="-O3"));
    if not IsBound(Local.hash) then Local.hash := HashTableDP(); fi;

    return DP(VPRDFT(n), rec(hashTable := Local.hash), Local.opts);
end;


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

#
# example:
#
#   d := DataInd(T_Int(8), [0..1]);
#   SMAP(Lambda([d], (2.0 * imod(d, 2) - 1.0)))
#

Class(SMAP, SumsBase, Sym, rec(
    abbrevs := [
        (lambda)  -> Checked(IsLambda(lambda) and Length(Set(List(lambda.vars, e->e.t)))=1, [lambda])
    ],
    def := (lambda) -> Gath(fBase(Length(lambda.vars), 0)),
    dmn := self >> [ TArray(self.params[1].vars[1].t, Length(self.params[1].vars)) ],
    rng := self >> [ TArray(self.params[1].range(),   1) ],
    at  := (arg) >> arg[1].params[1].at(StripList(Drop(arg, 1))),
));


#############################################################################
##
#W  treehomsg.gi             automgrp package                  Yevgen Muntyan
#W                                                             Dmytro Savchuk
##
#Y  Copyright (C) 2003 - 2018 Yevgen Muntyan, Dmytro Savchuk
##

BindGlobal("AG_SemigroupIterator",
function(arg)
  local next_iterator, is_done_iterator, shallow_copy,
        create_iter_rec, G, max_len;

  max_len := infinity;
  G := arg[1];
  if Length(arg) > 1 then
    max_len := arg[2];
    if not IsMonoid(G) and IsInt(max_len) then
      max_len := max_len - 1;
    fi;
  fi;

  create_iter_rec := function(G)
    local record, gens;

    record := rec(
      NextIterator := next_iterator,
      IsDoneIterator := is_done_iterator,
      ShallowCopy := shallow_copy,

      group := G,
      done := false,
      max_len := max_len,

      gens_ptr := [1, 1],

      ptr := 1,
    );

    if IsGroup(G) then
      # GAP is smart, it knows that a semigroup generated by group
      # generators of a finite group is in fact the whole group
      gens := GeneratorsOfGroup(G);
      record.gens := Difference(Concatenation(gens, List(gens, g->g^-1)), [One(G)]);
      record.elms := Concatenation([One(G)], record.gens);
      record.levels := [[1], [2..1+Length(record.gens)], []];
    elif IsMonoid(G) then
      record.gens := Difference(GeneratorsOfSemigroup(G), [One(G)]);
      record.elms := Concatenation([One(G)], record.gens);
      record.levels := [[1], [2..1+Length(record.gens)], []];
    else
      record.gens := ShallowCopy(GeneratorsOfSemigroup(G));
      record.elms := ShallowCopy(record.gens);
      record.levels := [[1..Length(record.gens)], []];
    fi;
    record.n_gens := Length(record.gens);

    if record.n_gens = 0 then
      record.is_list := true;
    elif IsMonoid(G) then
      if max_len = 0 then
        record.is_list := true;
        record.elms := [One(G)];
      else
        record.is_list := max_len = 1;
      fi;
    else
      if max_len = -1 then
        record.is_list := true;
        record.elms := [];
      else
        record.is_list := max_len = 0;
      fi;
    fi;

    return record;
  end;

  next_iterator := function(iter)
    local elm;

    if is_done_iterator(iter) then
      Error("<iter> is exhausted");
    fi;

    elm := iter!.elms[iter!.ptr];
    iter!.ptr := iter!.ptr + 1;

    return elm;
  end;

  is_done_iterator := function(iter)
    local gens_ptr, gens, elm, elm_list, levels, n_levels, added;

    if iter!.done then
      return true;
    fi;

    if iter!.ptr <= Length(iter!.elms) then
      return false;
    fi;

    if iter!.is_list then
      iter!.done := true;
      return true;
    fi;

    gens_ptr := iter!.gens_ptr;
    gens := iter!.gens;
    elm_list := iter!.elms;
    levels := iter!.levels;
    n_levels := Length(levels);
    added := false;

    while not added do
      if gens_ptr[1] > Length(levels[n_levels-1]) then
        if IsEmpty(levels[n_levels]) then
          iter!.done := true;
          SetIsFinite(iter!.group, true);
          SetSize(iter!.group, Length(elm_list));
          break;
        elif n_levels > iter!.max_len then
          iter!.done := true;
          break;
        fi;

        Add(levels, []);
        n_levels := n_levels + 1;
        gens_ptr[1] := 1;
      fi;

      elm := elm_list[levels[n_levels-1][gens_ptr[1]]] * gens[gens_ptr[2]];

      if IsGroup(iter!.group) then
        if not elm in elm_list{levels[n_levels-2]} and
           not elm in elm_list{levels[n_levels-1]} and
           not elm in elm_list{levels[n_levels]}
        then
          if elm in elm_list then
            Print("elm: ", elm, "\n");
            Print("elm_list: ", elm_list, "\n");
            Print("levels: ", levels, "\n");
            Print("n_levels: ", n_levels, "\n");
            Error("WTF");
          fi;
          Add(elm_list, elm);
          Add(levels[n_levels], Length(elm_list));
          added := true;
        fi;
      elif not elm in elm_list then
        Add(elm_list, elm);
        Add(levels[n_levels], Length(elm_list));
        added := true;
      fi;

      gens_ptr[2] := gens_ptr[2] + 1;
      if gens_ptr[2] > Length(gens) then
        gens_ptr[2] := 1;
        gens_ptr[1] := gens_ptr[1] + 1;
      fi;
    od;

    return iter!.done;
  end;

  shallow_copy := function(iter)
    return create_iter_rec(iter!.group);
  end;

  return IteratorByFunctions(create_iter_rec(G));
end);

################################################################################
##
#M  Iterator( <G>[, <max_len>] )
##
##  Provides a possibility to loop over elements of a group (semigroup, monoid)
##  generated by automata. If <max_len>  is given stops after enumerating all elements
##  of length up to <max_len>.
##  \beginexample
##  gap> Grigorchuk_Group := AutomatonGroup("a=(1,1)(1,2),b=(a,c),c=(a,d),d=(1,b)");
##  < a, b, c, d >
##  gap> iter := Iterator(Grigorchuk_Group,5);
##  <iterator>
##  gap> l := [];;
##  gap> for g in iter do
##  >      if Order(g) = 16 then Add(l,g); fi;
##  >    od;
##  gap> l;
##  [ b*a, a*b, d*a*c, c*a*d, d*a*c*a, d*a*b*a, c*a*d*a, b*a*d*a, a*d*a*c,
##    a*d*a*b, a*c*a*d, a*b*a*d, c*a*c*a*b, c*a*b*a*b, b*a*c*a*c, b*a*b*a*c,
##    a*d*a*c*a, a*c*a*d*a ]
##  \endexample
##

InstallMethod(Iterator, "for [IsTreeHomomorphismSemigroup]", [IsTreeHomomorphismSemigroup],
function(G)
  if IsGroup(G) and HasIsFinite(G) and IsFinite(G) then
    TryNextMethod();
  else
    return AG_SemigroupIterator(G, infinity);
  fi;
end);

InstallOtherMethod(Iterator, [IsTreeHomomorphismSemigroup, IsCyclotomic],
function(G, max_len)
  return AG_SemigroupIterator(G, max_len);
end);

###############################################################################
##
#M  TransformationSemigroupOnLevelOp (<G>, <k>)
##
InstallMethod(TransformationSemigroupOnLevelOp, "for [IsTreeHomomorphismSemigroup, IsPosInt]",
              [IsTreeHomomorphismSemigroup, IsPosInt],
function(G, k)
  local pgens, psemigroup, i;
  pgens := List(GeneratorsOfSemigroup(G), g -> TransformationOnLevel(g, k));

  # if there are Permutations and transformations convert all to transformations
  if Position(List(pgens,IsPerm),false) <> fail and Position(List(pgens,IsPerm),true) <> fail then
    for i in [1..Length(pgens)] do
      if IsPerm(pgens[i]) then pgens[i]:=AsTransformation(pgens[i]); fi;
    od;
  fi;

  psemigroup := SemigroupByGenerators(pgens);
  return psemigroup;
end);

###############################################################################
##
#M  MarkovOperator(<G>, <lev>, <weights>)
##
InstallMethod(MarkovOperator, "for [IsTreeHomomorphismSemigroup, IsCyclotomic, IsList]",
              [IsTreeHomomorphismSemigroup, IsCyclotomic, IsList],
function(G, n, weights)
  local gens,R,indet;
  gens := ShallowCopy(GeneratorsOfSemigroup(G));
  if Length(weights)<>Length(gens) then Error("The number of weights must match the number of generators"); fi;
  if IsString(weights[1]) then
    R:=PolynomialRing(Integers,weights);
    indet:=IndeterminatesOfPolynomialRing(R);
    return Sum(List([1..Length(gens)], x -> indet[x]*TransformationOnLevelAsMatrix(gens[x], n)));
  else
    return Sum(List([1..Length(gens)], x -> weights[x]*TransformationOnLevelAsMatrix(gens[x], n)));
  fi;
end);

###############################################################################
##
#M  MarkovOperator(<G>, <lev>)
##
InstallMethod(MarkovOperator, "for [IsTreeHomomorphismSemigroup, IsCyclotomic]",
              [IsTreeHomomorphismSemigroup, IsCyclotomic],
function(G, n)
  return MarkovOperator(G,n,List([1..Length(GeneratorsOfSemigroup(G))],x->1/(Length(GeneratorsOfSemigroup(G)))));
end);

###############################################################################
##
#M  Section(<G>, <v>)
##
InstallMethod(Section, "for [IsTreeHomomorphismSemigroup, IsList]",
              [IsTreeHomomorphismSemigroup, IsList],
function(G, v)
  local gens, g, sec_gens;
  gens:=GeneratorsOfSemigroup(G);
  for g in gens do
    if v^g<>v then
      Error("Section([IsTreeHomomorphismSemigroup, IsList]): <G> does not fix <v>");
      return fail;
    fi;
  od;

  if not IsAutomSemigroup(G) then
    return Semigroup(List(gens,x->Section(x,v)));
  else
    sec_gens:=[];
    for g in List(gens,x->Section(x,v)) do
      if not IsOne(g) and not g in sec_gens then
        Add(sec_gens, g);
      fi;
    od;
    if Length(sec_gens)>0 then
      return Semigroup(sec_gens);
    else
      return Semigroup([One(FamilyObj(Section(gens[1],v)))]);
    fi;
  fi;
end);

###############################################################################
##
#M  Section(<G>, <n>)
##
InstallMethod(Section, "for [IsTreeHomomorphismSemigroup, IsPosInt]",
              [IsTreeHomomorphismSemigroup, IsPosInt],
function(G, n)
  return Section(G,[n]);
end);

#E


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

RandInput := () -> Complex(
    RandomList([1..2^27])/(1.0*2^27),
    RandomList([1..2^27])/(1.0*2^27));

RandValExp := function(exp)
    local e, rargs;
    if IsBound(exp.randVal) then
	return exp.randVal;

    elif IsValue(exp) then
	exp.randVal := exp.v;
	return exp.randVal;

    elif IsLoc(exp) then
	exp.randVal := RandInput();
	#Print("RandInput : ", exp, " = ", exp.randVal, "\n");
	return exp.randVal;
    else
	rargs := List(exp.args, RandValExp);
	e := ApplyFunc(ObjId(exp), rargs);
	e := e.ev();
	Constraint(not IsExp(e) and not IsLoc(e));
	exp.randVal := e;
	return exp.randVal;
    fi;
end;

RandValAssign := function(cmd)
    local r;
    if IsBound(cmd.loc.randVal) then return cmd.loc.randVal;
    elif IsBound(cmd.exp.randVal) then
	cmd.loc.randVal := cmd.exp.randVal;
	return cmd.loc.randVal;
    else
	r := RandValExp(cmd.exp);
	cmd.exp.randVal := r;
	cmd.loc.randVal := r;
	return r;
    fi;
end;

Class(RCSE, rec(
    cseLookup := (self, randVal) >> HashLookup(self.csetab, V(randVal)),

    cseAdd := meth(self, cmd)
        local op, ent, v;
	if not IsBound(cmd.exp.isExpComposite) then return; fi;
	HashAdd(self.csetab, V(cmd.loc.randVal), cmd.loc);
	HashAdd(self.csetab, V(-cmd.loc.randVal), neg(cmd.loc));
    end,

    cseCmd := meth(self, cmd)
        local lkup;
	RandValAssign(cmd);
	lkup := self.cseLookup(cmd.loc.randVal);
	if lkup <> false then
	    cmd.exp := lkup;
	else
	    self.cseAdd(cmd);
	fi;
    end,

    remove_node := (self, exp) >> Chain(
	HashDelete(self.csetab, V(exp.randVal)),
	HashDelete(self.csetab, V(-exp.randVal))),

    node := meth(self, t, exp)
        local lkup, v;
	if IsValue(exp) or IsLoc(exp) then
	    RandValExp(exp);
	    return exp;
	fi;

	exp := ApplyFunc(ObjId(exp), List(exp.args, a->self.node(t, a)));
	RandValExp(exp);

	lkup := self.cseLookup(exp.randVal);
	if lkup <> false then
	    return lkup;
	else
	    v := var.fresh_t("t", t);
	    v.randVal := exp.randVal;
	    v.def := assign(v, exp);
	    self.cseAdd(v.def);
	    return v;
	fi;
    end,

    flush := meth(self)
        self.csetab := HashTable( (val,size) -> val.t.hash(val.v, size) );
    end,

    __call__ := meth(self, code)
        self.csetab := HashTable( (val,size) -> val.t.hash(val.v, size) );
	DoForAll(Collect(code, assign), cmd -> self.cseCmd(cmd));
	return code;
    end
));


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

Class(Rules_fAdd, RuleSet);
RewriteRules(Rules_fAdd, rec(
    fTensor := Rule([@(1, fTensor), @(2, fAdd, e->ForAll(e.params, i->IsInt(i) or IsValue(i))), @(3, fId, e-> IsInt(e.params[1]) or IsValue(e.params[1]))],
        e-> let(fadd := @(2).val, fid := @(3).val.domain(), fAdd(fadd.params[1]*fid, fadd.params[2]*fid, fadd.params[3]*fid))),

    fTensorVScatVGath :=ARule(fTensor, [ @@(2, fAdd, (e,cx)->(IsBound(cx.VScat) and Length(cx.VScat)>=1) or (IsBound(cx.VGath) and Length(cx.VGath)>=1)), @(3, fId) ],
        e-> let(fadd := @@(2).val, fid := @(3).val.domain(), [ fAdd(fadd.params[1]*fid, fadd.params[2]*fid, fadd.params[3]*fid) ] )),

    fAddFBase := ARule(fCompose, [@@(2, fAdd, (e,cx)->(IsBound(cx.VScat) and Length(cx.VScat)>=1) or (IsBound(cx.VGath) and Length(cx.VGath)>=1)), @(3, fBase)],
        e-> let(fadd := @(2).val, fbase := @(3).val, [ fAdd(fadd.params[1], 1, fadd.params[3]+fbase.params[2]) ] ))

));


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

Class(LinearModel, rec(
    __call__ := (self, k, d) >> CopyFields(self, rec(k := k, d := d)),
    d := 0,
    k := 1,
    eval := (self, x) >> self.d + self.k * x
));

Class(ExpModel, rec(
    __call__ := (self, alpha, tau) >> CopyFields(self, rec(alpha := alpha, tau := tau)),
    alpha := 0.1,
    tau := 5,
    eval := (self, x) >> (self.alpha + (1 - d_exp(-self.tau * x))) / (1+self.alpha)
));

Class(ScratchModel, rec(
    config := rec(
        loadModel := (numPkts, pktSize) -> numPkts * pktSize / (0.2 * ExpModel(0.1, 0.2).eval(pktSize)),
        storeModel := (numPkts, pktSize) -> 1.1 * numPkts * pktSize / (0.2 * ExpModel(0.1, 0.2).eval(pktSize)),
        computeModel := x->LinearModel(1.1, 5).eval(x)
    ),
    getKernels := (self, spl) >>  List(Collect(self.updateInfo(spl), LSKernel), i->i.info),
    updateInfo := (self, spl) >>  SubstTopDown(spl, [@(1, Compose), @(2, DMAScat), @(3, LSKernel), @(4, DMAGath)],
        (e,cx) -> @(2).val *
            LSKernel(@(3).val.child(1), rec(
                opcount := @(3).val.info.opcount,
                loadFunc := @(4).val.func,
                storeFunc := @(2).val.func,
                free := When(IsBound(cx.ISum), Set(Concat(List(cx.ISum, i->i.var))), Set([])))) *
            @(4).val),

    getPacketData := meth(self, func)
        local domain, pktSize, numPkts;

        domain := func.domain();
        pktSize := 1;
        if ObjId(func) = fTensor and ObjId(Last(func.children())) = fId then
            pktSize := Last(func.children()).domain();
        fi;
        numPkts := domain / pktSize;

        return [pktSize, numPkts];
    end,

    modelStat := meth(self, spl)
        local kernels, stat, numPkts, pktSize, kernel, iter, func, n,
            flops, bw, loadcycles, storecycles, cpucycles, cycles;

        kernels := self.getKernels(spl);
        stat := [];

        for kernel in kernels do
            flops := kernel.opcount;
            cpucycles := self.config.computeModel(flops);

            n := kernel.loadFunc.domain();
            [pktSize, numPkts] := self.getPacketData(kernel.loadFunc);
            loadcycles := self.config.loadModel(numPkts, pktSize);
            [pktSize, numPkts] := self.getPacketData(kernel.storeFunc);
            storecycles := self.config.storeModel(numPkts, pktSize);
            iter := Product(List(kernel.free, i->i.range));
            Add(stat, rec(
                iter := iter,
                kernelcycles := Maximum(loadcycles, storecycles, cpucycles),
                loadcycles := loadcycles,
                storecycles := storecycles,
                cpucycles := cpucycles,
                balance := cpucycles / Maximum(loadcycles, storecycles)
            ));

        od;
        return stat;
    end,

    modelRuntime := meth(self, spl)
        local stat, s, runtime, cycles;

        runtime := 0;
        stat := self.modelStat(spl);

        for s in stat do
            cycles := s.loadcycles + s.storecycles + s.iter * s.kernelcycles;
            runtime := runtime + cycles;
        od;
        return When(IsInt(runtime), runtime, IntDouble(runtime));
    end,

    measureFunction := (rt, opts) -> let(s := SumsRuleTree(rt, opts),  paradigms.scratchpad.ScratchModel.modelRuntime(s))
));


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

Class(fma, Exp, rec(
    computeType := self >> UnifyTypesL(self.args),
    toMul := self >> self.args[1] + self.args[2] * self.args[3],
    ev := self >> self.args[1].ev() + self.args[2].ev() * self.args[3].ev()));

Class(fms, Exp, rec(
    computeType := self >> UnifyTypesL(self.args),
    toMul := self >> self.args[1] - self.args[2] * self.args[3],
    ev := self >> self.args[1].ev() - self.args[2].ev() * self.args[3].ev()));

Class(nfma, Exp, rec(
    computeType := self >> UnifyTypesL(self.args),
    toMul := self >> -self.args[1] -+self.args[2] * self.args[3],
    ev := self >> -self.args[1].ev() + self.args[2].ev() * self.args[3].ev()));

RewriteRules(RulesStrengthReduce, rec(
   fma_Xab := Rule([@(0,[fma,fms,nfma]), _vtrivial, @, @], e -> e.toMul()),
   fma_aXb := Rule([@(0,[fma,fms,nfma]), @, _vtrivial, @], e -> e.toMul()),
   fma_abX := Rule([@(0,[fma,fms,nfma]), @, @, _vtrivial], e -> e.toMul()),
));

notMul := e -> ObjId(e)<>mul;

#NOTE - shouldn't have to handle arrays here
_IsAVector  := (var) >> (IsVecT(var.t) or IsArray(var.t));

_isNonZero  := i -> i.ev() <> 0;

_isDivOk    := e -> When(_IsAVector(e), ForAll(e.v, i -> _isNonZero(i)), _isNonZero(e));

_isNotEqual := function(a, b)
   # Why did we check for vectors?
   #if _IsAVector(a) or _IsAVector(b) then
   #   return true;
   #fi;
   return (a<>b);
end;

_divide := function(numerator, denominator)
# Both are scalars
   local type, vLength, nVal, dVal;
   if not (_IsAVector(numerator) or _IsAVector(denominator)) then
      return numerator/denominator;
   fi;

   if _IsAVector(numerator) and not _IsAVector(denominator) then
      type     := numerator.t;
      vLength  := numerator.t.size;
      nVal     := numerator.v;
      return(Value(type, List([1..vLength], i->nVal[i]/denominator.v)));
   fi;

   if not _IsAVector(numerator) and _IsAVector(denominator) then
      type     := denominator.t;
      vLength  := denominator.t.size;
      dVal     := denominator.v;
      return(Value(type, List([1..vLength], i->numerator.v/dVal[i])));
   fi;

# Both are vectors. Assume lengths are same.
   type     := numerator.t;
   vLength  := numerator.t.size;
   nVal     := numerator.v;
   dVal     := denominator.v;
   return(Value(type, List([1..vLength], i->nVal[i]/dVal[i])));
end;

_def := function(list, t, exp)
    local cmd;
    cmd := assign(var.fresh_t("s",t), exp);
    cmd.loc.def := cmd;
    Add(list, cmd);
    return cmd.loc;
end;

FMA := function(code)
    local c, cmds, dd, exp, res, supp, ch;
    res := [];

    cmds := code.cmds;

    for c in cmds do
        # NOTE: needs to check for our FP datatype, not 'uncheck' for TPtr, TInt etc.
        # NOTE: determine how pointer arithmetic works with FMAs on various archs.
        #       For now, avoid FMA'ing index computations.
        if IsBound(c.loc) and not IsPtrT(c.loc.t) and not IsIntT(c.loc.t) then
            dd := DefCollect(c,2); # definition, depth=2

            # ch is like children of DefCollect(c,1)
            if IsBound(c.exp.args) then ch := c.exp.args; else ch := []; fi;
            supp := [];

            exp := MatchSubst(dd, [
                [ [mul, @(1,Value), [mul, @(2,Value), @(3)]],
                    e -> mul(@(1).val*@(2).val, @(3).val), "mul mul" ],

                [ [add, [mul, @(1, Value), @(2)],
                        [mul, @(3, Value, e->_isDivOk(e) or _isDivOk(@1.val)), @(4)]],
                #NOTE: Determine small/large if scalar (we now only determine
                #       zero/nonzero if vector)
                    e -> let(
                        sm := When(_isDivOk(@(1).val), @(1).val, @(3).val),
                        lg := When(_isDivOk(@(1).val), @(3).val, @(1).val),
                        Cond(_isNotEqual(@(1).val, @(3).val),
                            Cond(sm.v=@(1).val.v,
                                # propagate (divide by) the smaller value
                                sm * _def(supp, c.loc.t, fma(@(2).val,
                                    _divide(@(3).val, @(1).val), @(4).val)),
                                sm * _def(supp, c.loc.t, fma(@(4).val,
                                    _divide(@(1).val, @(3).val), @(2).val))
                            ),
                            sm * _def(supp, c.loc.t, add(@(2).val, @(4).val))
                        )),
                    "fma:ab+cd"],

                [ [sub, [mul, @(1, Value), @(2)],
                        [mul, @(3, Value, e->_isDivOk(e) or _isDivOk(@1.val)), @(4)]],
                # NOTE: Determine small/large if scalar (we now only determine
                #        zero/nonzero if vector)
                    e -> let(
                        sm := When(_isDivOk(@(1).val), @(1).val, @(3).val),
                        lg := When(_isDivOk(@(1).val), @(3).val, @(1).val),
                        Cond(_isNotEqual(@(1).val, @(3).val),
                            Cond(sm.v=@(1).val.v,
                                sm * _def(supp, c.loc.t, fms(@(2).val,
                                    _divide(@(3).val, @(1).val), @(4).val)),
                                sm * _def(supp, c.loc.t, nfma(@(4).val,
                                    _divide(@(1).val, @(3).val), @(2).val))
                            ),
                            sm * _def(supp, c.loc.t, sub(@(2).val, @(4).val))
                        )),
                    "fma:ab-cd"],

                [ [add, [mul, @(1), @(2)], @(3)],
                    e -> fma(ch[2], @(1).val, @(2).val), "fma"],
                [ [add, @(3), [mul, @(1), @(2)]],
                    e -> fma(ch[1], @(1).val, @(2).val), "fma2"],

                [ [sub, [mul, @(1), @(2)], @(3)],
                    e -> nfma(ch[2], @(1).val, @(2).val), "nfma" ],
                [ [sub, @(3), [mul, @(1), @(2)]],
                    e -> fms(ch[1], @(1).val, @(2).val), "fms" ],

            ]);

            if not Same(dd, exp) then
                #Print("-----------------------------------------------------\n");
                #Print("c:    ", c  ,  "\n-----\n"); Print("dd:   ", dd ,  "\n-----\n");
                #Print("exp:  ", exp,  "\n-----\n"); Print("supp: ", supp, "\n-----\n");
                #Print("-----------------------------------------------------\n");
                c.exp := exp;
                c.loc.pred := ArgsExp(exp);
                Append(res, supp);
                Add(res, c);
            else
                Add(res, c);
            fi;
        else
            Add(res, c);
        fi;
    od;

    return chain(res);
end;

DoFMA := function(code)
   code := BinSplit(code);
   MarkDefUse(code);
   code := FMA(code);
   MarkDefUse(code);
   #return CopyPropagate(code); # Do this in the compileStrategy
   return(code);
end;


#!/usr/bin/gap

# time gap -o 8g hierarchy.gap

# Build clifford groups, up to 3 qubits, and
# search for T operators defined by field extensions......

Print("running hierarchy.gap\n");;

# See:
# https://www.mathstat.dal.ca/~selinger/papers/clifford.pdf

r2 := Sqrt(2);;
ir2 := 1/r2;;

i := [[1, 0], [0, 1]];;
w := [[E(4), 0], [0, E(4)]];;
x := [[0, 1], [1, 0]];;
z := [[1, 0], [0, -1]];;
s := [[1, 0], [0, E(4)]];;
h := [[ir2, ir2], [ir2, -ir2]];;

Cliff1 := Group(w, s, h);; # Order 192
Pauli1 := Group(w, x, z);; # Order 32

for U in Cliff1 do
    found := false;;
    #Udag := Inverse(U);
    #Print("found? ");
    for g in Pauli1 do
        if (U*g*Inverse(U)*Inverse(g) in Pauli1)  then found:=true; break; fi;
    od;
    if not found then Print("Not found\n"); fi;
od;

xi := KroneckerProduct(x, i);;
ix := KroneckerProduct(i, x);;
zi := KroneckerProduct(z, i);;
iz := KroneckerProduct(i, z);;
si := KroneckerProduct(s, i);;
is := KroneckerProduct(i, s);;
hi := KroneckerProduct(h, i);;
ih := KroneckerProduct(i, h);;
wi := KroneckerProduct(w, i);;

cz := [
    [1, 0, 0, 0],
    [0, 1, 0, 0],
    [0, 0, 1, 0],
    [0, 0, 0, -1]];;

Cliff2 := Group(si, is, hi, ih, wi, cz);; # Order 92160
Order(Cliff2);
#for g in Cliff2 do Print(g, "\n"); od;
Phase2 := Group(wi);;
Pauli2 := Group(wi, xi, ix, zi, iz);;

# Works:
for U in Cliff2 do
    found := false;;
    #Udag := Inverse(U);
    #Print("found? ");
    for g in Pauli2 do
        if (U*g*Inverse(U)*Inverse(g) in Pauli2)  then found:=true; break; fi;
    od;
    if not found then Print("Not found\n"); fi;
od;

Hadamard4 := (1/2)*[
    [0, 1, 0, 1],
    [2, 0, 2, 0],
    [0, 1, 0, -1],
    [2, 0, -2, 0]];
#Print(Hadamard4*Hadamard4, "\n");
#Print(Hadamard4, " in Cliff2 ", Hadamard4 in Cliff2, "\n");

a := [
    [0, 1, 0, 0],
    [0, 0, 1, 0],
    [0, 0, 0, 1],
    [-1, 0, 0, 0]];;

# Print(a in Cliff2, "\n"); # true

#hom:=EpimorphismFromFreeGroup(Cliff2:names:=["si", "is", "hi", "ih", "wi", "cz"]);
#Print(PreImagesRepresentative(hom, a), "\n"); # si^3*is^3*hi*si^2*ih*is^2*ih*cz*hi*si
#Print(PreImagesRepresentative(hom, a*a), "\n"); # (si^2*hi)^2
#Print(PreImagesRepresentative(hom, a*a*a), "\n"); # si^2*is^3*hi*(si^2*hi*si)^2*si*ih*is^2*ih*cz*hi*si

cls := ConjugacyClass(Cliff2, a);;
#Print(a,               a in cls, "\n");               # true
#Print(a*a,             a*a in cls, "\n");             # false
#Print(a*a*a,           a*a*a in cls, "\n");           # true
#Print(a*a*a*a,         a*a*a*a in cls, "\n");         # false
#Print(a*a*a*a*a,       a*a*a*a*a in cls, "\n");       # true
#Print(a*a*a*a*a*a,     a*a*a*a*a*a in cls, "\n");     # false
#Print(a*a*a*a*a*a*a,   a*a*a*a*a*a*a in cls, "\n");   # true
#Print(a*a*a*a*a*a*a*a, a*a*a*a*a*a*a*a in cls, "\n"); # false
#Print(cz, cz in cls, "\n"); # false

#b := [
#    [1, 0, 0, 0],
#    [0, 1, 0, 0],
#    [0, 0, 0, 1],
#    [0, 0, -1, 0]];;
#Print(cz, cz in ConjugacyClass(Cliff2, b), "\n"); # false
#for b in ConjugacyClass(Cliff2, cz) do Print(b, "\n"); od;

#a1 := [
#    [0, 0, 1, 0],
#    [0, 0, 0, 1],
#    [0, 1, 0, 0],
#    [-1, 0, 0, 0]];;
#Print(a1 in Pauli2, "\n"); # false
#Print(a1 in Cliff2, "\n"); # true
#Print(a1 in cls, "\n");    # true

#Print(Eigenvalues(Cyclotomics, b), "\n"); # fail

#Print(a*a, "\n");
#Print(a*a*a, "\n");
#Print(a*a*a*a, "\n");

# Print(Order(G2));

Hadamard8 := (1/2)*[
    [ 0, 1, 0,-1, 0, 1, 0,-1],
    [ 1, 0, 1, 0, 1, 0, 1, 0],
    [ 0, 1, 0, 1, 0, 1, 0, 1],
    [-1, 0, 1, 0,-1, 0, 1, 0],
    [ 0, 1, 0,-1, 0,-1, 0, 1],
    [ 1, 0, 1, 0,-1, 0,-1, 0],
    [ 0, 1, 0, 1, 0,-1, 0,-1],
    [-1, 0, 1, 0, 1, 0,-1, 0]];

#Print(Hadamard8, "\n");
#Print(Hadamard8*Hadamard8, "\n"); # = identity

U2 := [
    [1, 0, 0, 0],
    [0, 1, 0, 0],
    [0, 0, 1, 0],
    [0, 0, 0, 1]];

in_third_level_2 := function(U2)
    # Is U2 in the third level of the clifford hierarchy ?
    local A;
    for g in Pauli2 do
        A := U2*g*Inverse(U2)*Inverse(g);
        if A in Cliff2 then continue; fi;
        return false; # no
    od;
    return true; # yes
end;;

in_fourth_level_2 := function(U2)
    # Is U2 in the fourth level of the clifford hierarchy ?
    local A;
    for g in Pauli2 do
        A := U2*g*Inverse(U2)*Inverse(g);
        if in_third_level_2(U2) then continue; fi;
        return false; # no
    od;
    return true; # yes
end;;

in_fifth_level_2 := function(U2)
    # Is U2 in the fifth level of the clifford hierarchy ?
    local A;
    for g in Pauli2 do
        A := U2*g*Inverse(U2)*Inverse(g);
        if in_fourth_level_2(U2) then continue; fi;
        return false; # no
    od;
    return true; # yes
end;;

get_level_2 := function(U2)
    if U2 in Phase2 then return "0\c"; fi;
    if U2 in Pauli2 then return "1\c"; fi;
    if U2 in Cliff2 then return "2\c"; fi;
    if in_third_level_2(U2) then return "3\c"; fi;
    if in_fourth_level_2(U2) then return "4\c"; fi;
    if in_fifth_level_2(U2) then return "5\c"; fi;
    return ".\c";
end;;

if true then
    Print("# Where do control 1-qubit Pauli gates live ?\n");
    for g in Pauli1 do
        #Print(g, "\n");
        U2{[3,4]}{[3,4]} := g;
        Print(get_level_2(U2));
    od;
    Print("\n");

    Print("# Where do control 1-qubit clifford gates live ?\n");
    for g in Cliff1 do
        #Print(g, "\n");
        U2{[3,4]}{[3,4]} := g;
        Print(get_level_2(U2));
    od;
    Print("\n");
fi;

# ---------------------------------------------------
#
# 3 qubit gates
#

xii := KroneckerProduct(xi, i);;
ixi := KroneckerProduct(i, xi);;
iix := KroneckerProduct(i, ix);;

zii := KroneckerProduct(zi, i);;
izi := KroneckerProduct(i, zi);;
iiz := KroneckerProduct(i, iz);;

sii := KroneckerProduct(si, i);;
isi := KroneckerProduct(i, si);;
iis := KroneckerProduct(i, is);;

hii := KroneckerProduct(hi, i);;
ihi := KroneckerProduct(i, hi);;
iih := KroneckerProduct(i, ih);;

wii := KroneckerProduct(wi, i);;

icz := KroneckerProduct(i, cz);;
czi := KroneckerProduct(cz, i);;

ca := [
    [1, 0, 0, 0, 0, 0, 0, 0],
    [0, 1, 0, 0, 0, 0, 0, 0],
    [0, 0, 1, 0, 0, 0, 0, 0],
    [0, 0, 0, 1, 0, 0, 0, 0],
    [0, 0, 0, 0, 0, 1, 0, 0],
    [0, 0, 0, 0, 0, 0, 1, 0],
    [0, 0, 0, 0, 0, 0, 0, 1],
    [0, 0, 0, 0, -1, 0, 0, 0]];;

d := [
    [0, 1, 0, 0, 0, 0, 0, 0],
    [0, 0, 1, 0, 0, 0, 0, 0],
    [0, 0, 0, 1, 0, 0, 0, 0],
    [0, 0, 0, 0, 1, 0, 0, 0],
    [0, 0, 0, 0, 0, 1, 0, 0],
    [0, 0, 0, 0, 0, 0, 1, 0],
    [0, 0, 0, 0, 0, 0, 0, 1],
    [-1, 0, 0, 0, 0, 0, 0, 0]];;

ca1 := [
    [1, 0, 0, 0, 0, 0, 0, 0],
    [0, 1, 0, 0, 0, 0, 0, 0],
    [0, 0, 1, 0, 0, 0, 0, 0],
    [0, 0, 0, 1, 0, 0, 0, 0],
    [0, 0, 0, 0, 0, 0, 1, 0],
    [0, 0, 0, 0, 0, 0, 0, 1],
    [0, 0, 0, 0, 0, 1, 0, 0],
    [0, 0, 0, 0, -1, 0, 0, 0]];;

cb := [
    [1, 0, 0, 0, 0, 0, 0, 0],
    [0, 1, 0, 0, 0, 0, 0, 0],
    [0, 0, 1, 0, 0, 0, 0, 0],
    [0, 0, 0, 1, 0, 0, 0, 0],
    [0, 0, 0, 0, 0, 0, 1, 0],
    [0, 0, 0, 0, 0, 0, 0, 1],
    [0, 0, 0, 0, -1, 0, 0, 0],
    [0, 0, 0, 0, 0, -1, 0, 0]];;

cc := [
    [1, 0, 0, 0, 0, 0, 0, 0],
    [0, 1, 0, 0, 0, 0, 0, 0],
    [0, 0, 1, 0, 0, 0, 0, 0],
    [0, 0, 0, 1, 0, 0, 0, 0],
    [0, 0, 0, 0, 0, 0, 0, 1],
    [0, 0, 0, 0, -1, 0, 0, 0],
    [0, 0, 0, 0, 0, -1, 0, 0],
    [0, 0, 0, 0, 0, 0, -1, 0]];;

Tofolli := [
    [1, 0, 0, 0, 0, 0, 0, 0],
    [0, 1, 0, 0, 0, 0, 0, 0],
    [0, 0, 1, 0, 0, 0, 0, 0],
    [0, 0, 0, 1, 0, 0, 0, 0],
    [0, 0, 0, 0, 1, 0, 0, 0],
    [0, 0, 0, 0, 0, 1, 0, 0],
    [0, 0, 0, 0, 0, 0, 0, 1],
    [0, 0, 0, 0, 0, 0, 1, 0]];;

Cliff3 := Group(sii, isi, iis, hii, ihi, iih, wii, icz, czi);; # Order 743178240
Pauli3 := Group(wii, xii, ixi, iix, zii, izi, iiz);; # Order 256

# Print(Order(Pauli3), "\n");;

# ca in Cliff3 = false
# ca in third level of clifford hierarchy = true

Cliff3_12 := Group(sii, isi, hii, ihi, wii, czi);;
Cliff3_13 := Group(sii, iis, hii, iih, wii);; # cz on 1&3 ??
Cliff3_23 := Group(isi, iis, ihi, iih, wii, icz);;

#SmCliff3 := Group(sii, isi, iis, hii, ihi, iih, icz, czi);; # Order 743178240

Print("warming up...\n");
Order(Cliff3);; # need this line otherwise membership test eats all memory...!
Print("Ok\n");

#Print("Hadamard8 in Cliff3 ", Hadamard8 in Cliff3, "\n"); # true

in_first_level := function(U3)
    return U3 in Pauli3;
end;;

in_second_level := function(U3)
    if U3 in Cliff3_12 then return true; fi;
    if U3 in Cliff3_13 then return true; fi;
    if U3 in Cliff3_23 then return true; fi;
    if U3 in Cliff3 then return true; fi;
    return false;
end;;

#in_second_level := function(U3)
#    # Is U3 in the second level of the clifford hierarchy ?
#    local A;
#    for g in Pauli3 do
#        A := U3*g*Inverse(U3)*Inverse(g);
#        if in_first_level(A) then continue; fi;
#        return false; # no
#    od;
#    return true; # yes
#end;;

in_third_level := function(U3)
    # Is U3 in the third level of the clifford hierarchy ?
    local A;
    for g in Pauli3 do
        A := U3*g*Inverse(U3)*Inverse(g);
        if in_second_level(A) then continue; fi;
        return false; # no
    od;
    return true; # yes
end;;

#Print(in_third_level(ca1), "\n"); # true
#quit;

in_fourth_level := function(U3)
    # Is U3 in the fourth level of the clifford hierarchy ?
    local A;
    for g in Pauli3 do
        A := U3*g*Inverse(U3)*Inverse(g);
        if in_third_level(A) then continue; fi;
        return false; # no
    od;
    return true; # yes
end;;

in_fifth_level := function(U3)
    # Is U3 in the fifth level of the clifford hierarchy ?
    local A;
    for g in Pauli3 do
        A := U3*g*Inverse(U3)*Inverse(g);
        if in_fourth_level(A) then continue; fi;
        return false; # no
    od;
    return true; # yes
end;;

get_level := function(U3)
    if U3 in Pauli3 then return "1\c"; fi;
    if in_second_level(U3) then return "2\c"; fi;
    if in_third_level(U3) then return "3\c"; fi;
    if in_fourth_level(U3) then return "4\c"; fi;
    if in_first_level(U3) then return "5\c"; fi;
    return ".\c";
end;;

#Print("in_third_level(d):", in_third_level(cc), "\n"); # true
#Print("in_third_level(ca):", in_third_level(ca), "\n"); # true
#Print("in_third_level(cb):", in_third_level(cb), "\n"); # true
#Print("in_third_level(cc):", in_third_level(cc), "\n"); # true
#Print("in_third_level(Tofolli):", in_third_level(Tofolli), "\n"); # true
#Print("in_third_level(Tofolli*ca):", in_third_level(Tofolli*ca), "\n"); # false

U3 := [
    [1, 0, 0, 0, 0, 0, 0, 0],
    [0, 1, 0, 0, 0, 0, 0, 0],
    [0, 0, 1, 0, 0, 0, 0, 0],
    [0, 0, 0, 1, 0, 0, 0, 0],
    [0, 0, 0, 0, 1, 0, 0, 0],
    [0, 0, 0, 0, 0, 1, 0, 0],
    [0, 0, 0, 0, 0, 0, 1, 0],
    [0, 0, 0, 0, 0, 0, 0, 1]];

Print("# Where do control control 1-qubit Pauli gates live ?\n");
for g in Pauli1 do
    #Print(g, "\n");
    U3{[7,8]}{[7,8]} := g;
    Print(get_level(U3));
od;
Print("\n");

Print("# Where do control control 1-qubit clifford gates live ?\n");
for g in Cliff1 do
    #Print(g, "\n");
    U3{[7,8]}{[7,8]} := g;
    Print(get_level(U3));
od;
Print("\n");

Print("# Where do control 2-qubit Pauli gates live ?\n");
for g in Pauli2 do
    #Print(g, "\n");
    U3{[5,6,7,8]}{[5,6,7,8]} := g;
    Print(get_level(U3));
od;
Print("\n");

Print("# Where do control 2-qubit clifford gates live ?\n");
for g in Cliff2 do
    #Print(g, "\n");
    U3{[5,6,7,8]}{[5,6,7,8]} := g;
    Print(get_level(U3));
od;

Print("\n");

Print("Done.\n");


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

#
# Functions
#
IsASPFreqBasis := x -> IsRec(x) and IsBound(x.isASPFreqBasis) and x.isASPFreqBasis;
IsASPTimeBasis := x -> IsRec(x) and IsBound(x.isASPTimeBasis) and x.isASPTimeBasis;

Class(BasisOps, PrintOps, rec(
    \= := (b1, b2) -> Cond(
        not IsASPFreqBasis(b1) or not IsASPFreqBasis(b2), false,
        ObjId(b1)=ObjId(b2) and b1.rChildren() = b2.rChildren())
));

#
# Base classes
#
Class(ASPTimeBasis, rec(
    isAtomic := true, # NOTE: these probably should not be atomic, maybe use TimeComp(Freq_E) for composed bases
    isASPTimeBasis := true,
    doNormalize := false,
    operations := PrintOps,
    print := self >> Print(self.__name__, When(self.doNormalize, ".norm()")),
    norm := self >> CopyFields(self, rec(doNormalize:=true)),
    rChildren := self >> [],
    from_rChildren := (self, rch) >> self,
    unparse := "ConstClass",
));

Class(ASPComposedTimeBasis, ASPTimeBasis, rec(
    composedFrom := self >> Error("must be defined in the subclass"),
    toX := (self, alg) >> Checked(ObjId(alg) = XN_skew, IsEvenInt(alg.n),
        let(C := When(self.doNormalize, self.composedFrom().norm(),
                                        self.composedFrom()),
            Tensor(C.to1X(XN_skew(2, alg.a, alg.rot)), I(alg.n/2))))
));

Class(ASPFreqBasis, rec(
    doNormalize := false,
    isASPFreqBasis := true,
    dim := self >> Error("must be defined in the subclass"),
    from_rChildren := (self, rch) >> ApplyFunc(ObjId(self), rch),
    unparse := "RewritableObjectExp",
));

Class(ASPFreqBasis1d,  ASPFreqBasis, rec(
    __call__ := (self, scale1d) >> WithBases(self, rec(
            scale1d := scale1d, operations := BasisOps
    )),
    rChildren := self >> [self.scale1d],
    rSetChild := rSetChildFields("scale1d"),
    print := self >> Print(self.name, "(", self.scale1d, ")", When(self.doNormalize, ".norm()")),
    dim := self >> 1,
    hashAs := self >> ObjId(self)(1)
));

Class(ASPFreqBasis1d2d,  ASPFreqBasis, rec(
    __call__ := (self, scale1d, scale2d) >> WithBases(self, rec(
            scale1d := scale1d, scale2d := scale2d, operations := BasisOps
    )),
    rChildren := self >> [self.scale1d, self.scale2d],
    rSetChild := rSetChildFields("scale1d", "scale2d"),
    print := self >> Print(self.name, "(", self.scale1d, ", ", self.scale2d, ")",
        When(self.doNormalize, ".norm()")),

    norm := self >> CopyFields(self, rec(doNormalize:=true)),

    dim := self >> 2,
    hashAs := self >> ObjId(self)(1, 1),

    to1X_2d0 := (self, rot) >> I(2),
    to1X_2d := (self, a, rot) >> Error("Must be implemented in a subclass"),
    to1X := (self, alg) >> let(t := ObjId(alg), s1 := self.scale1d, s2 := self.scale2d, Cond(
        alg.n=1, 1/s1 * I(1),

        alg.n=2 and (t in [XN_min_1, XN_min_1U]),
            1/s2 * self.to1X_2d0(alg.rot),

        alg.n=2 and (t in [XN_skew, XN_plus_1]), let(
            a := alg.a, #EvalScalar(alg.a),
            aa := Cond(self.doNormalize, cond(gt(a, 0.5), 1-a, a), a), #Cond(self.doNormalize and a > 1/2, 1-a, a),
            1/s2 * self.to1X_2d(aa, alg.rot)),

        Error("Algebra <alg> must have dimension of 1 or 2"))),

    from1X_2d0 := (self, rot) >> I(2),
    from1X_2d := (self, a, rot) >> Mat(MatSPL(self.to1X_2d(a, rot))^-1),
    from1X := (self, alg) >> let(t := ObjId(alg), s1 := self.scale1d, s2 := self.scale2d, Cond(
        alg.n=1, s1 * I(1),

        alg.n=2 and (t in [XN_min_1, XN_min_1U]),
            s2 * self.from1X_2d0(alg.rot),

        alg.n=2 and (t in [XN_skew, XN_plus_1]), let(
            a := alg.a, #EvalScalar(alg.a),
            aa := Cond(self.doNormalize, cond(gt(a, 0.5), 1-a, a), a),
            s2 * self.from1X_2d(aa, alg.rot)),

        Error("Algebra <alg> must have dimension of 1 or 2"))),
));

#
# TIME BASIS Classes
#
Declare(Freq_1, Freq_1H, Freq_T, Freq_S, Freq_TH, Freq_THU,  Freq_E, Freq_EH,  Freq_H, Freq_HH);

Declare(Time_TX, Time_SX, Time_THX, Time_THUX,  Time_EX, Time_EHX,  Time_HX, Time_HHX);

# ASP time basis: standard "time" basis (1, x, ..., x^{n-1})
Class(Time_TX,  ASPTimeBasis, rec(
    toX := (self, alg) >> I(alg.n)
));

# ASP time basis: symmetric "time" basis (-x^{n/2}, ..., 1, x, ..., x^{n/2-1})
Class(Time_SX,  ASPTimeBasis, rec(
    toX := (self, alg) >> let(t := ObjId(alg), hf := Int(alg.n/2),
        Cond(t in [XN_min_1, XN_min_1U],
                Z(alg.n, hf),
             t = XN_plus_1 or (t = XN_skew and alg.a = 1/4),
                 DirectSum(I(Int((alg.n+1)/2)), -I(hf)) * Z(alg.n, hf),
             t = XN_skew,
                 Tensor(Freq_S(1,1).to1X(XN_skew(2, alg.a, alg.rot)), I(alg.n/2)),
             Error("Unrecognized algebra <alg>")))
));

Class(Time_THX,  ASPComposedTimeBasis, rec(composedFrom := self >> Freq_TH(1,1)));
Class(Time_THUX, ASPComposedTimeBasis, rec(composedFrom := self >> Freq_THU(1,1)));
Class(Time_EX,   ASPComposedTimeBasis, rec(composedFrom := self >> Freq_E(1,1))); # e_a(x^n) (*) t_n
Class(Time_EHX,  ASPComposedTimeBasis, rec(composedFrom := self >> Freq_EH(1,1)));
Class(Time_HX,   ASPComposedTimeBasis, rec(composedFrom := self >> Freq_H(1,1))); # h_a(x^n) (*) t_n
Class(Time_HHX,  ASPComposedTimeBasis, rec(composedFrom := self >> Freq_HH(1,1)));

#
# FREQUENCY BASIS Classes
#

# ASP frequency basis: (1)
Class(Freq_1,  ASPFreqBasis1d, rec(
    timeBasis := self >> Time_TX
));

Class(Freq_1H,  ASPFreqBasis1d, rec(
    timeBasis := self >> Error("not implemented"),
    to1X := (self, alg) >> Error("not implemented"),
));

# ASP frequency basis: (1, x), also implies 2d spectral components, ie real DFT
Class(Freq_T, ASPFreqBasis1d2d, rec(
    timeBasis := self >> Time_TX,
    to1X := (self, alg) >>  let(t := ObjId(alg), s1 := self.scale1d, s2 := self.scale2d, Cond(
        alg.n = 2, 1/s2 * I(2),
        alg.n = 1, 1/s1 * I(1),
        Error("Algebra <alg> must have dimension of 1 or 2"))),
    from1X := (self, alg) >>  let(t := ObjId(alg), s1 := self.scale1d, s2 := self.scale2d, Cond(
        alg.n = 2, s2 * I(2),
        alg.n = 1, s1 * I(1),
        Error("Algebra <alg> must have dimension of 1 or 2"))),
));

# ASP frequency basis: (x^-1, 1), also implies 2d spectral components, ie real DFT
Class(Freq_S, ASPFreqBasis1d2d, rec(
    timeBasis := self >> Time_SX,
    to1X_2d0 := (self, rot) >> J(2),
    to1X_2d := (self, a, rot) >> Mat(_stripval([[ 2*cospi(2*a*rot), 1],
                                                [             -1  , 0]])),
));

# ASP frequency basis: (x^1/2, x^3/2) for type 2--4 transforms, also implies 2d spectral components, ie real DFT
Class(Freq_TH, ASPFreqBasis1d2d, rec(
    timeBasis := self >> Time_THX,
    to1X_2d := (self, a, rot) >> let(c := cospi(2*a*rot), q := 1/(2*cospi(a*rot)),
        Mat(_stripval(q * [[1+2*c, 1],
                           [-1,    1]])))
));

Class(Freq_THU, ASPFreqBasis1d2d, rec(
    timeBasis := self >> Time_THUX,
    to1X_2d := (self, a, rot) >> let(c := cospi(2*a*rot), q := 1/(2*cospi(a * rot)),
        Mat(_stripval(q^2 * [[1+2*c, 1],
                             [-1,    1]])))
));

# ASP frequency basis: (1, (x-cos(a)) / sin(a)), also implies 2d spectral components, ie real DFT
Class(Freq_E,  ASPFreqBasis1d2d, rec(
    timeBasis := self >> Time_EX,
    to1X_2d := (self, a, rot) >> let(c := cospi(2*rot*a), s := sinpi(2*rot*a),
        Mat(_stripval([[1, -c/s],
                       [0,  1/s]]))),
    from1X_2d := (self, a, rot) >> let(c := cospi(2*rot*a), s := sinpi(2*rot*a),
        Mat(_stripval([[1,  c],
                       [0,  s]])))
));

Class(Freq_EH,  ASPFreqBasis1d2d, rec(
    timeBasis := self >> Time_EX,
    to1X_2d := (self, a, rot) >> let(c := r->cospi(r*2*rot*a), s := r->sinpi(r*2*rot*a),
        Mat(_stripval(1/s(1) * [[ s(3/2), -c(3/2)],
                                [-s(1/2),  c(1/2)]])))
));

# ASP frequency basis: (1 + (x-cos(a)) / sin(a), 1 - (x-cos(a))/sin(a)), ie Hartley transform
Class(Freq_H,  ASPFreqBasis1d2d, rec(
    timeBasis := self >> Time_HX,
    to1X_2d := (self, a, rot) >> let(c := cospi(2*rot*a), s := sinpi(2*rot*a),
        Mat(_stripval(1/2 * [[1-c/s, 1+c/s],
                             [  1/s,  -1/s]])))
));

Class(Freq_HH,  ASPFreqBasis1d2d, rec(
    timeBasis := self >> Time_EX,
    to1X_2d := (self, a, rot) >> let(s := sinpi(2*rot*a),
        cas := r -> cospi(r*2*rot*a)+sinpi(r*2*rot*a), cms := r -> cospi(r*2*rot*a)-sinpi(r*2*rot*a),
        Mat(_stripval(1/(2*s) * [[-cms(3/2), -cas(3/2)],
                                 [ cms(1/2),  cas(1/2)]])))
));


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

AVX_4x64f.setRules(rec(
  binrules := [ rec(
          perm := rec(
              spl := Tensor(
                  L(4, 2),
                  I(2)
                ),
              l := 1,
              N := 4,
              n := 2,
              r := 2 ),
          instr := [ rec(
                  instr := vpermf128_4x64f,
                  p := [ 1, 3 ] ), rec(
                  instr := vpermf128_4x64f,
                  p := [ 2, 4 ] ) ],
          v := 4,
          vperm := VPerm(Tensor(
                L(4, 2),
                I(2)
              ), (y, x) -> chain(assign(vref(y, 0, 4), vpermf128_4x64f(vref(x, 0, 4), vref(x, 4, 4), [ 1, 3 ])), assign(vref(y, 4, 4), vpermf128_4x64f(vref(x, 0, 4), vref(x, 4, 4), [ 2, 4 ]))), 4, 2) ), rec(
          perm := rec(
              spl := L(8, 4),
              l := 1,
              N := 8,
              n := 4,
              r := 1 ),
          instr := [ rec(
                  instr := vunpacklo_4x64f,
                  p := [  ] ), rec(
                  instr := vunpackhi_4x64f,
                  p := [  ] ) ],
          v := 4,
          vperm := VPerm(Tensor(
                L(4, 2),
                I(2)
              ), (y, x) -> chain(assign(vref(y, 0, 4), vpermf128_4x64f(vref(x, 0, 4), vref(x, 4, 4), [ 1, 3 ])), assign(vref(y, 4, 4), vpermf128_4x64f(vref(x, 0, 4), vref(x, 4, 4), [ 2, 4 ]))), 4, 2) *
            VPerm(Tensor(
                L(4, 2),
                I(2)
              ) *
              L(8, 4), (y, x) -> chain(assign(vref(y, 0, 4), vunpacklo_4x64f(vref(x, 0, 4), vref(x, 4, 4), [  ])), assign(vref(y, 4, 4), vunpackhi_4x64f(vref(x, 0, 4), vref(x, 4, 4), [  ]))), 4, 4.2000000000000002) *
            VTensor(I(2), 4) ), rec(
          perm := rec(
              spl := L(8, 2),
              l := 1,
              N := 8,
              n := 2,
              r := 1 ),
          instr := [ rec(
                  instr := vunpacklo_4x64f,
                  p := [  ] ), rec(
                  instr := vunpackhi_4x64f,
                  p := [  ] ) ],
          v := 4,
          vperm := VTensor(I(2), 4) *
            VPerm(L(8, 2) *
              Tensor(
                L(4, 2),
                I(2)
              ), (y, x) -> chain(assign(vref(y, 0, 4), vunpacklo_4x64f(vref(x, 0, 4), vref(x, 4, 4), [  ])), assign(vref(y, 4, 4), vunpackhi_4x64f(vref(x, 0, 4), vref(x, 4, 4), [  ]))), 4, 4.2000000000000002) *
            VPerm(Tensor(
                L(4, 2),
                I(2)
              ), (y, x) -> chain(assign(vref(y, 0, 4), vpermf128_4x64f(vref(x, 0, 4), vref(x, 4, 4), [ 1, 3 ])), assign(vref(y, 4, 4), vpermf128_4x64f(vref(x, 0, 4), vref(x, 4, 4), [ 2, 4 ]))), 4, 2) ) ],
  unrules := [  ],
  x_I_vby2 := [ [ rec(
              instr := vpermf128_4x64f,
              p := [ 1, 3 ] ), rec(
              instr := vperm2_4x64f,
              p := [ 1, 2, 3, 4 ] ) ], [ rec(
              instr := vpermf128_4x64f,
              p := [ 2, 3 ] ), rec(
              instr := vpermf128_4x64f,
              p := [ 2, 4 ] ) ] ] ));
AVX_8x32f.setRules(rec(
  binrules := [ rec(
          perm := rec(
              spl := Tensor(
                  L(4, 2),
                  I(4)
                ),
              l := 1,
              N := 4,
              n := 2,
              r := 4 ),
          instr := [ rec(
                  instr := vpermf128_8x32f,
                  p := [ 1, 3 ] ), rec(
                  instr := vpermf128_8x32f,
                  p := [ 2, 4 ] ) ],
          v := 8,
          vperm := VPerm(Tensor(
                L(4, 2),
                I(4)
              ), (y, x) -> chain(assign(vref(y, 0, 8), vpermf128_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 1, 3 ])), assign(vref(y, 8, 8), vpermf128_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 2, 4 ]))), 8, 2) ), rec(
          perm := rec(
              spl := L(16, 8),
              l := 1,
              N := 16,
              n := 8,
              r := 1 ),
          instr := [ rec(
                  instr := vunpacklo_8x32f,
                  p := [  ] ), rec(
                  instr := vunpackhi_8x32f,
                  p := [  ] ) ],
          v := 8,
          vperm := VPerm(Tensor(
                L(4, 2),
                I(4)
              ), (y, x) -> chain(assign(vref(y, 0, 8), vpermf128_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 1, 3 ])), assign(vref(y, 8, 8), vpermf128_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 2, 4 ]))), 8, 2) *
            VPerm(Tensor(
                L(4, 2),
                I(4)
              ) *
              L(16, 8), (y, x) -> chain(assign(vref(y, 0, 8), vunpacklo_8x32f(vref(x, 0, 8), vref(x, 8, 8), [  ])), assign(vref(y, 8, 8), vunpackhi_8x32f(vref(x, 0, 8), vref(x, 8, 8), [  ]))), 8, 4.2000000000000002) *
            VTensor(I(2), 8) ), rec(
          perm := rec(
              spl := Tensor(
                  L(8, 4),
                  I(2)
                ),
              l := 1,
              N := 8,
              n := 4,
              r := 2 ),
          instr := [ rec(
                  instr := vshuffle_8x32f,
                  p := [ 1, 2, 1, 2 ] ), rec(
                  instr := vshuffle_8x32f,
                  p := [ 3, 4, 3, 4 ] ) ],
          v := 8,
          vperm := VPerm(Tensor(
                L(4, 2),
                I(4)
              ), (y, x) -> chain(assign(vref(y, 0, 8), vpermf128_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 1, 3 ])), assign(vref(y, 8, 8), vpermf128_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 2, 4 ]))), 8, 2) *
            VPerm(Tensor(
                L(4, 2),
                I(4)
              ) *
              Tensor(
                L(8, 4),
                I(2)
              ), (y, x) -> chain(assign(vref(y, 0, 8), vshuffle_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 1, 2, 1, 2 ])), assign(vref(y, 8, 8), vshuffle_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 3, 4, 3, 4 ]))), 8, 4.2000000000000002) *
            VTensor(I(2), 8) ), rec(
          perm := rec(
              spl := Tensor(
                  L(8, 2),
                  I(2)
                ),
              l := 1,
              N := 8,
              n := 2,
              r := 2 ),
          instr := [ rec(
                  instr := vshuffle_8x32f,
                  p := [ 1, 2, 1, 2 ] ), rec(
                  instr := vshuffle_8x32f,
                  p := [ 3, 4, 3, 4 ] ) ],
          v := 8,
          vperm := VTensor(I(2), 8) *
            VPerm(Tensor(
                L(8, 2),
                I(2)
              ) *
              Tensor(
                L(4, 2),
                I(4)
              ), (y, x) -> chain(assign(vref(y, 0, 8), vshuffle_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 1, 2, 1, 2 ])), assign(vref(y, 8, 8), vshuffle_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 3, 4, 3, 4 ]))), 8, 4.2000000000000002) *
            VPerm(Tensor(
                L(4, 2),
                I(4)
              ), (y, x) -> chain(assign(vref(y, 0, 8), vpermf128_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 1, 3 ])), assign(vref(y, 8, 8), vpermf128_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 2, 4 ]))), 8, 2) ), rec(
          perm := rec(
              spl := L(16, 2),
              l := 1,
              N := 16,
              n := 2,
              r := 1 ),
          instr := [ rec(
                  instr := vshuffle_8x32f,
                  p := [ 1, 3, 1, 3 ] ), rec(
                  instr := vshuffle_8x32f,
                  p := [ 2, 4, 2, 4 ] ) ],
          v := 8,
          vperm := VTensor(I(2), 8) *
            VPerm(L(16, 2) *
              Tensor(
                L(4, 2),
                I(4)
              ), (y, x) -> chain(assign(vref(y, 0, 8), vshuffle_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 1, 3, 1, 3 ])), assign(vref(y, 8, 8), vshuffle_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 2, 4, 2, 4 ]))), 8, 4.2000000000000002) *
            VPerm(Tensor(
                L(4, 2),
                I(4)
              ), (y, x) -> chain(assign(vref(y, 0, 8), vpermf128_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 1, 3 ])), assign(vref(y, 8, 8), vpermf128_8x32f(vref(x, 0, 8), vref(x, 8, 8), [ 2, 4 ]))), 8, 2) ) ],
  unrules := [ rec(
          perm := rec(
              spl := Tensor(
                  I(2),
                  L(4, 2)
                ),
              l := 2,
              N := 4,
              n := 2,
              r := 1 ),
          instr := rec(
              instr := vperm_8x32f,
              p := [ 1, 3, 2, 4 ] ),
          v := 8,
          vperm := VPerm(Tensor(
                I(2),
                L(4, 2)
              ), (y, x) -> assign(vref(y, 0, 8), vperm_8x32f(vref(x, 0, 8), [ 1, 3, 2, 4 ])), 8, 0.90000000000000002) ), rec(
          perm := rec(
              spl := Tensor(
                  L(4, 2),
                  I(2)
                ),
              l := 1,
              N := 4,
              n := 2,
              r := 2 ),
          instr := rec(
              instr := vcxtr_8x32f,
              p := [  ] ),
          v := 8,
          vperm := VPerm(Tensor(
                L(4, 2),
                I(2)
              ), (y, x) -> assign(vref(y, 0, 8), vcxtr_8x32f(vref(x, 0, 8), [  ])), 8, 4.5) ) ],
  x_I_vby2 := [ [ rec(
              instr := vpermf128_8x32f,
              p := [ 1, 3 ] ), rec(
              instr := vpermf128_8x32f,
              p := [ 1, 4 ] ) ], [ rec(
              instr := vpermf128_8x32f,
              p := [ 2, 3 ] ), rec(
              instr := vpermf128_8x32f,
              p := [ 2, 4 ] ) ] ] ));


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

# ==========================================================================
# BaseIterative - base class for iterative SPL operators
#
# Subclasses must provide
#    unroll := self >> ...unrolled (non-iterative) spl...
#    dims := self >> ...compute dimensions..
#    transpose := self >> ...transposed spl...
#
# if default implementation below is not applicable, subclasses must redefine
#   arithmeticCost := (self, costMul, costAddMul) >> ...
#
# ==========================================================================

IsIterative := x -> IsRec(x) and IsBound(x.isIterative) and x.isIterative;

Class(BaseIterative, BaseOperation, rec(

    isIterative := true,
    #-----------------------------------------------------------------------
    # Subclasses must provide
    unroll := self >> Error("This method must be provided by the subclass of BaseIterative"),
    dims := self >> Error("This method must be provided by the subclass of BaseIterative"),
    transpose := self >> Error("This method must be provided by the subclass of BaseIterative"),

    free := self >>
        Difference(Union(List(self.children(), x->x.free())), [self.var]),

    from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),

    # if default implementation below is not applicable, subclasses must redefine
    # arithmeticCost := (self, costMul, costAddMul) >> ...
    #
    #-----------------------------------------------------------------------
    abbrevs := [ (v, expr) -> [v, v.range, expr] ],

    new := meth(self, var, domain, expr)
        local res;
        Constraint(IsSPL(expr));
        # if domain is an integer (not symbolic) it must be positive
        Constraint(not IsInt(domain) or domain >= 0);
        var.isLoopIndex := true;
        res := SPL(WithBases(self, rec(_children := [expr], var := var, domain := domain)));
        res.dimensions := res.dims();
        return res;
    end,
    #-----------------------------------------------------------------------
    unrolledChildren := self >> List(listRange(EvalScalar(self.domain)), u -> self.at(TInt.value(u))),

    at := (self, u) >> SubstVars(Copy(self._children[1]), rec((self.var.id):=u)),

    #-----------------------------------------------------------------------
    # .split(m), splits the original loop into two nested loops with m
    #            iterations in the inner loop
    # This operations works with any kind of iterative operator, like ISum,
    # and IDirSum. It requres the operator class to provide .directOper, which
    # is the non-iterative version of the same operator (e.g. SUM for ISum)
    #
    split := (self, m) >> Cond(
	m=1,
	    self,
	let(
            N  := self.domain,      _It := ObjId(self),  _Ch := self.directOper,
            j1 := Ind(idiv(N, m)),  j2  := Ind(m),       j3  := Ind(imod(N, m)),

            is := _It(j1, j1.range, _It(j2, j2.range, self.at(j1*m + j2))),
            When(j3.range = 0, is,
		_Ch(is, _It(j3, j3.range, self.at(m * j1.range + j3)))))
    ),
    #-----------------------------------------------------------------------
    print := (self, i, is) >> Print(
        self.name, "(", self.var, ", ", self.domain, ",\n",
        Blanks(i+is), self._children[1].print(i+is, is), "\n",
        Blanks(i), ")", self.printA(),
        When(IsBound(self._setDims), Print(".overrideDims(", self._setDims, ")"), Print(""))
    ),
    #-----------------------------------------------------------------------
    arithmeticCost := (self, costMul, costAddMul) >>
        self.domain * self._children[1].arithmeticCost(costMul, costAddMul),
    #-----------------------------------------------------------------------
    isPermutation := False,
    isReal := self >> self._children[1].isReal(),
    toAMat := self >> self.unroll().toAMat()
));


# Copyright (c) 2018-2020, Carnegie Mellon University
# See LICENSE for details
#
# Wrapper object for qCirc that explores global reordering of qubits by
# permuting the input adjacency matrix
#

##
#F GenStages( <arch>, <circ>) Object
##
#F Given a circuit object and an architecture topology matrix,
#F for every reordering of the physical qubits
#F generate a top-level circuit with that topology
GenStages := function(arch, circ)
    local child, idcs, n, i, ar, c;
    n := Length(arch);
    idcs := [0..n-1];
    idcs := Arrangements(idcs, Length(idcs));
    child := [];
    for i in idcs do
        ar := PruneArch(arch, i);
        c := circ.recursive_def(ar);
        Add(child, [c, ar]);
    od;
    return child;
end;

##
#F BestCircuitReorder( <arch>, <t>, <opts>) Object
##
#F Finds the Best Circuit, but also explores all global reorderings of the
#F Adjacency matrix, skipping duplicate reorderings.
#F TODO: This is non-optimal because the hashtable is discarded across
#F DP calls, ideally we can feed the hashtable from the previous search into the next DP search
#F For research code that is bottlenecked by other reasons, this is acceptable for now
BestCircuitReorder := function(arch, t, opts)
    local gs, child, g, child_cnots, idx, min, c, same, a, arches_checked, i, j, row, bit, already;
    gs := GenStages(arch, t);
    child := [];
    arches_checked := [];
    for g in gs do
        Print("\n Compiling arch: \n");
        Print(g[2]);
        Print("\n\n");
        already := 0;
        for a in arches_checked do
            i := 1;
            same := 1;
            for row in a do
                j := 1;
                for bit in row do
                    if bit <> g[2][i][j] then
                        same := 0;
                    fi;
                    j := j + 1;
                od;
                i := i + 1;
            od;
            if same = 1 then
                already := 1;
            fi;
        od;
        if already = 1 then
            Print("\n already checked architecture! \n");
        fi;
        if already <> 1 then
            Add(child, BestCircuit(g[1], opts));
            Add(arches_checked, g[2]);
        fi;
    od;
    child_cnots := Map(child, i -> Length(Collect(i, @(1,CNOT))));
    min := Minimum(child_cnots);
    idx := 1;
    for c in child_cnots do
        if c = min then
            return child[idx];
        fi;
        idx := idx + 1;
    od;
    return null;
end;


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

DataTypes := rec(
    f64re := rec(
    isFixedPoint := false,
    bits := 64,
    customDataType := "double",
    XType := TPtr(TReal),
    YType := TPtr(TReal),
    TRealCtype := "double",
    includes := [ "<include/omega64.h>" ]
    ),

    f64c := rec(
    isFixedPoint := false,
    bits := 128,
    customDataType := "double_cplx",
    XType := TPtr(TComplex),
    YType := TPtr(TComplex),
    TRealCtype := "double",
    TComplexCtype := "_Complex double",
    includes := [ "<include/omega64c.h>" ]
    ),

    f32re := rec(
    isFixedPoint := false,
    bits := 32,
    customDataType := "float",
    XType := TPtr(TReal),
    YType := TPtr(TReal),
    TRealCtype := "float",
    includes := [ "<include/omega32.h>" ],
    valuePostfix := "f"
    ),

    f32c := rec(
    isFixedPoint := false,
    bits := 64,
    customDataType := "float_cplx",
    XType := TPtr(TComplex),
    YType := TPtr(TComplex),
    TRealCtype := "float",
    TComplexCtype := "_Complex float",
    includes := [ "<include/omega32c.h>" ],
    valuePostfix := "f"
    ),

    i32re := rec(
    isFixedPoint := true,
    bits := 32,
    fracbits := 14,
    customDataType := "int_fp14",
    XType := TPtr(TInt),
    YType := TPtr(TInt),
    TIntCtype := "int",
    TRealCtype := "int",
    includes := [ "<include/omega32i.h>" ]
    ),

    i16re := rec(
    isFixedPoint := true,
    bits := 16,
    fracbits := 7,
    customDataType := "short_fp7",
    XType := TPtr(TInt),
    YType := TPtr(TInt),
    TIntCtype := "signed short",
    TRealCtype := "signed short",
    includes := [ "<include/omega16i.h>" ]
    ),

    i8re := rec(
    isFixedPoint := true,
    bits := 8,
    fracbits := 4,
    customDataType := "char_fp4",
    XType := TPtr(TInt),
    YType := TPtr(TInt),
    TIntCtype := "signed char",
    TRealCtype := "signed char",
    includes := [ "<include/omega8i.h>" ]
    )
);

#F InitDataType(<opts>, <data_type>)
#F   Changes the active data type in <opts> and configures the rest of the
#F   system to generate code with that data type.
#F
#F   data_type = "f64re" | "f32re" | "i32re" | "i16re" | "i8re"
#F
#F   Note: currently this only works correctly with CUnparser, and therefore
#F         best config to use is the one produced by InitIter
#F
#F   Example: opts := InitIter(false);
#F            opts := InitDataType(opts, "i16re");
##
InitDataType := function(opts, data_type)
    local dt;
    Constraint(IsString(data_type));
    dt := DataTypes.(data_type);
    opts := CopyFields(opts, dt);
#    if dt.isFixedPoint then
#   opts.compileStrategy := Concatenation(opts.compileStrategy,
#       [ c -> FixedPointCode(c, dt.bits, dt.fracbits) ]);
#    fi;
    return opts;
end;


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

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

        o.ptr.setType();
        if IsBound(o.func.rlambda) then
            rfunc := o.func.rlambda();
            ix := var.fresh_t("ix", TInt);
            return decl(ix, chain(
                    assign(ix, func.at(0)),
                    assign(nth(y, 0), nth(o.ptr, ix)),
                    loop(i, o.func.domain()-1,
                        chain(assign(ix, rfunc.at(ix)),
                            assign(nth(y, i+1), nth(o.ptr, ix))))));
        else
            return loop(i, o.func.domain(), assign(nth(y,i), nth(o.ptr, func.at(i))));
        fi;
    end,

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

        if IsBound(o.func.rlambda) then
            rfunc := o.func.rlambda();
            ix := var.fresh_t("ix", TInt);
            return decl(ix, chain(
                    assign(ix, func.at(0)),
                    assign(nth(o.ptr, ix), nth(x, 0)),
                    loop(i, o.func.domain()-1,
                        chain(assign(ix, rfunc.at(ix)),
                            assign(nth(o.ptr, ix), nth(x, i+1))))));
        else
            return loop(i, o.func.domain(), assign(nth(o.ptr, func.at(i)), nth(x, i)));
        fi;
    end
));


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

#F ==========================================================================
#F Diag(<diag-func>)
#F ==========================================================================
Class(Diag, BaseMat, rec(
    _short_print := true,
    abbrevs := [ arg -> When(Length(arg)=1,
                         When(IsFunction(arg[1]) or IsFuncExp(arg[1]) or (IsRec(arg[1]) and not IsScalar(arg[1])) or IsList(arg[1]), [arg[1]], [[arg[1]]]),
                 [Flat(arg)]) ],

    new := meth(self, L)
        if IsList(L) then
            L := List(L, toExpArg);
            L := FList(UnifyTypes(List(L, x->x.t)), L);
        elif not IsRec(L) or not IsBound(L.lambda) then
            Error("List of numbers or LambdaList expected");
        fi;
        return SPL(WithBases(self, rec(element := L, TType := L.range()))).setDims();
    end,
    #-----------------------------------------------------------------------
    dims := self >> Replicate(2, self.element.domain()),
    #-----------------------------------------------------------------------
    isPermutation := self >> false,
    #-----------------------------------------------------------------------
    isReal := self >> let(
	t := self.element.range(),
        tt := Cond(IsVecT(t), t.t, t),
	tt <> TComplex and ObjId(tt)<>T_Complex),
    #-----------------------------------------------------------------------
    toAMat := self >> DiagonalAMat(List(EvalScalar(self.element.tolist()), EvalScalar)),
    #-----------------------------------------------------------------------
    transpose := self >> self,
    conjTranspose := self >> Diag(FConj(self.element)),
    inverse := self >> Diag(FInv(self.element)),
    #-----------------------------------------------------------------------
    normalizedArithCost := self >> 0,
    #-----------------------------------------------------------------------
    arithmeticCost := (self, costMul, costAddMul) >> Sum(self.element.tolist(), costMul),
    #-----------------------------------------------------------------------
    toloop := (self, bksize) >> let(
	j := Ind(self.element.domain()),
	ISum(j,
	    Scat(fTensor(fBase(j), fId(1))) *
	    Diag(fCompose(self.element, fTensor(fBase(j), fId(1)))) *
	    Gath(fTensor(fBase(j), fId(1)))
	).split(bksize)
    )

));

#F ==========================================================================
#F DiagCpxSplit(<diag-func>) - complex diagonal specified in split format
#F NOTE: maybe this should be somehow replaced by VRCDiag (?)
#F  this object is helpful for complex code, because it improves performance
#   when using SSE
#F ==========================================================================
Class(DiagCpxSplit, Diag, rec(
    #-----------------------------------------------------------------------
    dims := self >> Replicate(2, div(self.element.domain(), 2)),
    #-----------------------------------------------------------------------
    isReal := self >> false,
    #-----------------------------------------------------------------------
    toAMat := meth(self)
        local lst, i, cpxlst;
        lst := List(EvalScalar(self.element.tolist()), EvalScalar);
        cpxlst := [];
        for i in [0..Length(lst)/2-1] do
            Add(cpxlst, lst[2*i+1]+E(4)*lst[2*i+2]);
        od;
        return DiagonalAMat(cpxlst);
    end,
    #-----------------------------------------------------------------------
    transpose := self >> self,
    conjTranspose := self >> ObjId(self)(FRConj(self.element)),
    #-----------------------------------------------------------------------
    normalizedArithCost := self >> 0,
    #-----------------------------------------------------------------------
    #arithmeticCost := (self, costMul, costAddMul) >> Sum(self.element.tolist(), costMul)
));

Declare(RowVec, ColVec);

Class(RowVec, Diag, rec(
    dims := self >> [1, self.element.domain()],
    toAMat := self >> AMatMat([List(self.element.tolist(), EvalScalar)]),
    transpose := self >> ColVec(self.element),
    conjTranspose := self >> ColVec(FConj(self.element)),
    arithmeticCost := (self, costMul, costAddMul) >> Sum(self.element.tolist(), costAddMul),

    toBlk := self >> Checked(not IsSymbolic(self.element.domain()), Blk([self.element.tolist()])),
    toDiagBlk := self >> Checked(not IsSymbolic(self.element.domain()),
	Blk([Replicate(EvalScalar(self.element.domain()), 1)]) * Diag(self.element)),
));

Class(ColVec, Diag, rec(
    dims := self >> [self.element.domain(), 1],
    toAMat := self >> AMatMat(TransposedMat([List(self.element.tolist(), EvalScalar)])),
    transpose := self >> RowVec(self.element),
    conjTranspose := self >> RowVec(FConj(self.element)),

    toBlk := self >> self.transpose().toBlk().transpose(),
    toDiagBlk := self >> self.transpose().toDiagBlk().transpose(),
));

Declare(RCDiag);

#F RCDiagonalAMat(<elts>, <post>)
#F
#F Works similarly to RCDiag, but creates an AMat object instead of SPL.
#F See Doc(RCDiag).
#F
#F <elts> must be a list of size 2*n, which consists of interleaved real/imaginary data.
#F (not a symbolic function as in RCDiag)
#F
#F <post> must be an <amat>, and not spl
#F
RCDiagonalAMat := (elts, post) ->
    DirectSumAMat(List([1..Length(elts)/2], x ->
            let(r := EvalScalar(elts[2*x-1]), i := EvalScalar(elts[2*x]),
                post * AMatMat([[r,-i],[i,r]]))));

#F RCDiag(<diagfunc>)
#F RCDiag(<diagfunc>, <2x2 spl>)
#F
#F  Complex diagonal operating on real data in (r,i) format.
#F  Represents a block diagonal with 2x2 blocks (complex rotations),
#F  with post-processing matrix <post-spl> applied to each block.
#F
#F  For n complex numbers, <diagfunc> must be a diagonal function of size 2*n,
#F  which consists of interleaved real/imaginary data.
#F
#F  Example: RCDiag(RCData(Tw1(8,4,1))              normal twiddle diagonal
#F           RCDiag(RCData(Tw1(8,4,1)), 1/2*F(2))   twiddles for Hartley transform
#F
Class(RCDiag, BaseMat, rec(
    dims := self >> Replicate(2, self.element.domain()),
    area := self >> 2*self.element.domain(),
    transpose := self >> RCDiag(FRConj(self.element), self.post),

    conjTranspose := self >> Cond(self.element.range()=TComplex,
        RCDiag(FRConj(FConj(self.element)), self.post),
        RCDiag(FRConj(self.element), self.post)),

    toAMat := self >> let(elts := self.element.tolist(), # r,i,r,i,...
        Checked(Length(elts) mod 2 = 0,
            DirectSumAMat(List([1..Length(elts)/2], x ->
                    let(r := EvalScalar(elts[2*x-1]), i := EvalScalar(elts[2*x]),
                        self.post.toAMat() * AMatMat([[r,-i],[i,r]])))))),

    toloop := self >> let(
        func := self.element, # r,i,r,i,...
        j    := Ind(idiv(func.domain(),2)),
        re   := func.at(2*j),
        im   := func.at(2*j+1),
        IDirSum(j, j.range,
                self.post * Mat([[re, -im],
                                 [im,  re]]))),

    abbrevs := [
        () -> Error("Usage: \n  RCDiag(<diagfunc>, <2x2 spl>)\n",
                    "  RCDiag(<diagfunc>)\n",
                    "  RCDiag(<e0>, <e1>, ...)\n"),
        (L)    -> Checked(IsList(L) or IsFunction(L), [L, I(2)]),
        (L, P) -> Checked(IsList(L) or IsFunction(L), IsSPL(P), [L, P])
    ],

    new := meth(self, L, P)
        local inline, res;
        if IsList(L) then L := FList(L);
        elif not IsRec(L) or not IsBound(L.lambda) then
            Error("List of numbers or LambdaList expected");
        fi;
        res := SPL(WithBases(self, rec(element := L, post := P, TType := L.range())));
        res.dimensions := res.dims();
        return res;
    end,

    isReal := self >> self.element.range() <> TComplex and self.post.isReal(),
    rChildren := self >> [self.element, self.post],
    rSetChild := rSetChildFields("element", "post"),

    normalizedArithCost := self >> 0,
));

# Won't work for now because divisions by zero need to be handled.
# Declare(RCDiagLiftingSteps);
#
# #F RCDiagLiftingSteps(<diagfunc>)
# #F RCDiagLiftingSteps(<diagfunc>, <2x2 spl>)
# #F
# #F  Complex diagonal operating on real data in (r,i) format.
# #F  Represents a block diagonal with 2x2 blocks (complex rotations),
# #F  with post-processing matrix <post-spl> applied to each block.
# #F
# #F  Example: RCDiagLiftingSteps(T(8,4))   normal twiddle diagonal
# #F           RCDiagLiftingSteps(T(8,4), 1/2*F(2))   twiddles for Hartley transform
# #F
#
# Class(RCDiagLiftingSteps, BaseMat, rec(
#     dims := self >> Replicate(2, self.element.domain()),
#
#     transpose := self >> RCDiagLiftingSteps(FRConj(self.element), self.post),
#     conjTranspose := self >> self.transpose(),
#
#     toAMat := self >> let(elts := self.element.tolist(), # r,i,r,i,...
#   Checked(Length(elts) mod 2 = 0,
#       DirectSumAMat(List([1..Length(elts)/2],
#       x -> let(r := EvalScalar(elts[2*x-1]), i := EvalScalar(elts[2*x]),
#           self.post.toAMat() * AMatMat([[r,-i],[i,r]])))))),
#
#     abbrevs := [
#   () -> Error("Usage: \n  RCDiagLiftingSteps(<diagfunc>, <2x2 spl>)\n",
#          "  RCDiagLiftingSteps(<diagfunc>)\n",
#          "  RCDiagLiftingSteps(<e0>, <e1>, ...)\n"),
#   (L)    -> Checked(IsList(L) or IsFunction(L), [L, I(2)]),
#   (L, P) -> Checked(IsList(L) or IsFunction(L), IsSPL(P), [L, P])
#     ],
#
#     new := meth(self, L, P)
#         local inline, res;
#         if IsList(L) then L := FList(L);
#   elif not IsRec(L) or not IsBound(L.lambda) then
#       Error("List of numbers or LambdaList expected");
#   fi;
#   inline := IsBound(L.inline) and L.inline;
#         res := SPL(WithBases(self, rec(element := L, post := P, inline := inline)));
#   res.dimensions := res.dims();
#   return res;
#     end,
#
#     isReal := True,
#     rChildren := self >> [self.element, self.post],
#     rSetChild := rSetChildFields("element", "post"),
#     print := (self, i, is) >> Print(self.name, "(", self.element,
#         When(ObjId(self.post)<>I, Print(", ", self.post)), ")")
# ));


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

# FFTX Baseline options

_noT := r -> CopyFields(r, rec(forTransposition := false));

Declare(ParseOpts);

Class(FFTXDefaultConf, LocalConfig, rec(
    getOpts := (self, t) >> ParseOpts(self, t),
    operations := rec(Print := s -> Print("<FFTX Default Configuration>")),
));

Class(FFTXOpts, SpiralDefaults, FFTXGenMixin, rec(
    tags := [],
    operations := rec(Print := s -> Print("<FFTX options record>")),
    breakdownRules := Copy(SpiralDefaults.breakdownRules),
    codegen := Copy(SpiralDefaults.codegen),
    tagIt := (self, t) >> t.withTags(self.tags)
));

FFTXOpts.codegen.GathPtr := fftx.codegen.MultiPtrCodegenMixin.GathPtr;
FFTXOpts.codegen.ScatPtr := fftx.codegen.MultiPtrCodegenMixin.ScatPtr;
FFTXOpts.codegen.OO := (self, o, y, x, opts) >> skip();
FFTXOpts.sumsgen.IterHStack := MultiPtrSumsgenMixin.IterHStack;

Class(FFTXConvOpts, FFTXOpts, rec(
    tags := [],
    operations := rec(Print := s -> Print("<FFTX Conv options record>")),
    breakdownRules := Copy(SpiralDefaults.breakdownRules),
    codegen := CopyFields(MultiPtrCodegenMixin, SpiralDefaults.codegen)
));

Class(FFTXGlobals, rec(
    registerConf := meth(arg)
        local self, key;
        self := arg[1];
        self.(arg[2].defaultName) := arg[2].defaultOpts;
        key := Filtered(RecFields(arg[2].defaultOpts()), i -> not IsSystemRecField(i));
        self.supportedConfs.(key[1]) := arg[2].confHandler;
    end,
    supportedConfs := rec(
        mdRConv :=
            function(arg)
                local opts;
                opts := Copy(FFTXConvOpts);
                opts.useDeref := false;
                opts.breakdownRules.PRDFT := List([ PRDFT1_Base2, PRDFT1_CT, PRDFT_PD], _noT);
                opts.breakdownRules.IPRDFT := List([ IPRDFT1_Base1, IPRDFT1_Base2, IPRDFT1_CT, IPRDFT_PD], _noT);
                opts.breakdownRules.IPRDFT2 := List([ IPRDFT2_Base1, IPRDFT2_Base2, IPRDFT2_CT], _noT);
                opts.breakdownRules.PRDFT3 := List([ PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT, PRDFT3_OddToPRDFT1], _noT);
                opts.breakdownRules.URDFT := List([ URDFT1_Base1, URDFT1_Base2, URDFT1_Base4, URDFT1_CT ], _noT);
                opts.breakdownRules.DFT := [DFT_Base, DFT_PD, DFT_CT];
                opts.breakdownRules.IOPrunedMDRConv := [IOPrunedMDRConv_3D_2trip_zyx_freqdata];
                opts.breakdownRules.MDDFT := [ MDDFT_Base, MDDFT_RowCol ];
                opts.breakdownRules.GT := [ GT_NthLoop ];
                opts.breakdownRules.DFT := [ DFT_Base, DFT_CT, DFT_Rader, CopyFields(DFT_GoodThomas, rec(maxSize := 15)), DFT_PD ];
                opts.topTransforms := [DFT, MDDFT, PrunedDFT, PrunedIDFT, IOPrunedConv, PrunedPRDFT, PrunedIPRDFT, TTensorI, IOPrunedMDRConv,
                    PRDFT, IPRDFT, PRDFT1, IPRDFT1, PRDFT2, IPRDFT2, PRDFT3, IPRDFT3, TTensorI ];
                opts.breakdownRules.MDRConv := [ MDRConv_3D_2trip_zyx_freqdata ]; # [MDRConv_Base]
                return opts;
            end,
    ),
    defaultConf := (arg) >> FFTXDefaultConf,
    mdRConv := (arg) >> rec(mdRConv := true),
    getOpts :=
        meth(arg)
            local opts, rfields;
            if Length(arg) >= 2 then
                rfields := Filtered(RecFields(arg[2]), i -> not IsSystemRecField(i));
                if Length(rfields) >= 1 and IsBound(arg[1].supportedConfs.(rfields[1])) then
                    return ApplyFunc(arg[1].supportedConfs.(rfields[1]), Drop(arg, 1));
                fi;
            fi;
            opts := Copy(FFTXOpts);
            opts.breakdownRules.Circulant := [Circulant_PRDFT_FDataNT];
            opts.breakdownRules.PRDFT := List([PRDFT1_Base1, PRDFT1_Base2, PRDFT1_CT, PRDFT1_PF, PRDFT_PD, PRDFT_Rader], _noT);
            opts.breakdownRules.IPRDFT := List([ IPRDFT1_Base1, IPRDFT1_Base2, IPRDFT1_CT, IPRDFT_PD, IPRDFT_Rader ], _noT);
            opts.breakdownRules.IPRDFT2 := List([ IPRDFT2_Base1, IPRDFT2_Base2, IPRDFT2_CT], _noT);
            opts.breakdownRules.PRDFT3 := List([ PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT ], _noT);
            opts.breakdownRules.MDDFT := [ MDDFT_Base, MDDFT_RowCol ];
            opts.breakdownRules.DFT := [ DFT_Base, DFT_CT, DFT_Rader, CopyFields(DFT_GoodThomas, rec(maxSize := 15)), DFT_PD ];
            opts.breakdownRules.GT := [ GT_NthLoop ];
            opts.breakdownRules.MDRConv := [ MDRConv_3D_2trip_zyx_freqdata ]; # [MDRConv_Base]
            return opts;
        end
));

_promote1 := t >> let(t1 := RulesFFTXPromoteNT(Copy(t)), RulesFFTXPromoteNT_Cleanup(t1));

# this is a first experimental opts-deriving logic. This needs to be done extensible and properly
ParseOpts := function(conf, t)
    local tt, _tt, _conf, _opts;

    if conf = FFTXDefaultConf then
        # promote with default conf rules
        tt := _promote1(Copy(t));

        if ObjId(tt) = TFCall then
            _tt := tt.params[1];
            # check for convolution
            if (ObjId(_tt) = MDRConv) or ((ObjId(_tt) = TTensorI) and (ObjId(_tt.params[1]) = MDRConv)) then
                _conf := FFTXGlobals.mdRConv();
                _opts := FFTXGlobals.getOpts(_conf);
                return _opts;
            fi;
            # check for Hockney. This is for N=128
            if ObjId(_tt) = IOPrunedMDRConv then
                _conf := FFTXGlobals.defaultHockneyConf(rec(globalUnrolling := 16, prunedBasemaxSize := 7));
                _opts := FFTXGlobals.getOpts(_conf);
                return _opts;
            fi;
        fi;

        # check for WarpX
        _conf := FFTXGlobals.defaultWarpXConf();
        _opts := FFTXGlobals.getOpts(_conf);
        tt := _opts.preProcess(Copy(t));
        if ObjId(tt) = TFCall and ObjId(tt.params[1]) = TCompose then
            _tt := tt.params[1].params[1];
            # detect promoted WarpX
            if IsList(_tt) and Length(_tt) = 3 and List(_tt, ObjId) = [ TNoDiagPullinRight, TRC, TNoDiagPullinLeft ] then
                return _opts;
            fi;
        fi;
        # we are doing nothing special
        return FFTXGlobals.getOpts();
    fi;

    # Here we have to handle GPU configs
    Error("Don't know how to derive opts!\n");
end;


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

#F HashIndex and HashEqual Functions
#F ---------------------------------
#F

#F HashLookup( hashTable, key )
#F    returns the data associated with key in hashTable.
#F    returns false if key is not found in hashTable.
#F
HashLookup := function( hashTable, key )
   local index, entry, pos, chash, temp;

   if not IsHashTable( hashTable ) then
      Error( "<hashTable> is not a valid HashTable" );
   fi;

   index := hashTable.indexFun( key, hashTable.size );

   if not ( index > 0 and index <= hashTable.size ) then
      Error( "Did not obtain a valid hash index for key" );
   fi;

   if IsBound( hashTable.entries[index] ) then
      entry := hashTable.entries[index];
      pos := PositionProperty( entry, a -> hashTable.equalFun(a.key, key) );

      if pos = false then
	  return false;
      else
 #      # catch the case of hash-identical but not identical spls
#       elif IsSPL(key) and not IsIdenticalSPL(entry[pos].key, key) then
#             chash := Copy(entry[pos].data);
#             if(IsList(chash)) then
#                for index in [1..Length(chash)] do
#                   chash[index].ruletree :=
# 		  # NOTE:
#                   spiral.formgen.ApplyRuleTreeSPL(entry[pos].data[index].ruletree, key);
#                od;
#             else
# 		# NOTE:
#                chash.ruletree :=
#                spiral.formgen.ApplyRuleTreeSPL(entry[pos].data.ruletree, key);
#             fi;
#             return chash;
#       else
      return entry[pos].data;
      fi;
   else
      return false;
   fi;
end;

MultiHashLookup := function(hashes, key)
    local h, lkup;
    for h in hashes do
        lkup := HashLookup(h, key);
	if lkup<>false then return lkup; fi;
    od;
    return false;
end;

Declare(HashIndexSPLRec);

HashIndexParams := function(param, index)
     local p;
     # hash symbolic Value(type, val) simply as <val>
     if IsValue(param) then param := param.v; fi;

     if IsFFE(param) then
     index := index + 1 + When(param <> GF(2).zero, 0, 1);
     elif IsInt(param) then
	 index := index * (param+1);
     elif IsString(param) then
	 index := index * (Length(param)+1);

     elif IsFloat(param) then
	 index := index + 1;
     elif IsRat(param) then
	 index := index + 1;
     elif IsFloat(param) then
	 index := index + 1;
      ## NOTE: How to handle bools???
     elif IsBool(param) then
	 index := index * When(param, 2,3);

     elif IsCyc(param) then
	 index := index + 1;
     elif IsList(param) then
	 for p in param do
	     index := HashIndexParams(p, index);
	 od;
     elif IsMat(param) then
	 index := index * Product(DimensionsMat(param));
     elif IsPolynomial(param) then
	 index := index * LaurentDegree(param);

      # MP: now we have transforms as parameter and thus need to handle this case
      # by calling the function recursively
     elif IsSPL(param) then
	 index := index + HashIndexSPLRec(param);

     elif IsClass(ObjId(param)) then
         index := index + BagAddr(ObjId(param));
     fi;
     return index;
end;

#F HashIndexSPLRec( <spl> )
#F   Does the actual dirty work for HashIndexSPL recursively
#F   Do not call directly
#F

HashIndexSPLRec := function( spl )
   local type, index, param, params;

   if not IsSPL(spl) then
      Error( "<spl> must be a valid SPL" );
   fi;

   if IsNonTerminal(spl) and IsBound(spl.params) then
      index := BagAddr(ObjId(spl));
      params := When(IsBound(spl.HashId), spl.HashId(), spl.params);
      if IsInt( params ) then
	  index := index * (params+1);
      else
	  params := When(not IsList(params), [params], params);
	  for param in params do
	      index := HashIndexParams(param, index);
	  od;
      fi;
   elif IsBound(spl.children) then
       index := Product( spl.children(), a->HashIndexSPLRec(a) );
   elif IsBound(spl.element) and IsList(spl.element) then
       index := Length(spl.element);
   else
       index := BagAddr(ObjId(spl));
   fi;

   return index;
end;

#F HashIndexSPL( <spl>, <hashSize> )
#F    one possible method of returning a hash index (probably not that good).
#F    takes a SPL and returns a hash index.
#F
HashIndexSPL := function( spl, hashSize )
   if not IsSPL(spl) then
      Error( "<spl> must be a valid SPL" );
   fi;

   if IsBound(spl.hashIndex) then
      return ( (spl.hashIndex mod hashSize) + 1 );
   fi;

   spl.hashIndex := HashIndexSPLRec(spl);
   return ( (spl.hashIndex mod hashSize) + 1 );
end;

#F HashIndexRuleTree( <ruletree>, <hashSize> )
#F    one possible method of returning a hash index (probably not that good).
#F    takes a RuleTree and returns a hash index.
#F

HashIndexRuleTree := function( tree, hashSize )
   local index,
         child;

   index := BagAddr(tree.rule);
   if tree.transposed then
      index := index*3;
   else
      index := index*7;
   fi;
   if IsBound(tree.splOptions) and tree.splOptions="unrolled" then
      index := index*11;
   else
      index := index*13;
   fi;
   index := ((index+1) * (HashIndexSPL(tree.node, hashSize)+1))
            mod hashSize;
   for child in tree.children do
      index := ((index+1) * (HashIndexRuleTree(child, hashSize)+1))
               mod hashSize;
   od;
   return index+1;
end;

#F HashTableSPL() - create hashtable with SPLs as keys
HashTableSPL := function()
   return HashTable( HashIndexSPL, IsHashIdenticalSPL, "HashTableSPL()" );
end;


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

LRB_16x32f.setRules(rec(
  binrules := [ rec(
          perm := rec(
              spl := L(32, 16),
              l := 1,
              N := 32,
              n := 16,
              r := 1 ),
          instr := [ rec(
                  instr := vunpacklo_16x32f,
                  p := [  ] ), rec(
                  instr := vunpackhi_16x32f,
                  p := [  ] ) ],
          v := 16,
          vperm := VPerm(L(32, 16), (y, x) -> chain(assign(vref(y, 0, 16), vunpacklo_16x32f(vref(x, 0, 16), vref(x, 16, 16), [  ])), assign(vref(y, 16, 16), vunpackhi_16x32f(vref(x, 0, 16), vref(x, 16, 16), [  ]))), 16, 2) ), rec(
          perm := rec(
              spl := Tensor(
                  L(16, 8),
                  I(2)
                ),
              l := 1,
              N := 16,
              n := 8,
              r := 2 ),
          instr := [ rec(
                  instr := vunpacklo2_16x32f,
                  p := [  ] ), rec(
                  instr := vunpackhi2_16x32f,
                  p := [  ] ) ],
          v := 16,
          vperm := VPerm(Tensor(
                L(16, 8),
                I(2)
              ), (y, x) -> chain(assign(vref(y, 0, 16), vunpacklo2_16x32f(vref(x, 0, 16), vref(x, 16, 16), [  ])), assign(vref(y, 16, 16), vunpackhi2_16x32f(vref(x, 0, 16), vref(x, 16, 16), [  ]))), 16, 2) ) ],
  unrules := [  ],
  x_I_vby2 := [ [ [  ], [  ] ], [ [  ], [  ] ] ] ));


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

#F FreeVars(<o>)
#F   list of free (unbound) variables in an object
#F   Expects a .free() method in <o>.
FreeVars := o -> Cond(
    IsRec(o) and IsBound(o.free), o.free(),
    IsList(o), Set(Union(List(o, FreeVars))),
    Set([])
);


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

scriptWHT := function(val1, val2, val3, val4, val5, val6)
       local opts, t, rt, srt, cs, namec, nametxt, a;

       ImportAll(paradigms.scratchpad);

       opts := ScratchX86Globals.getOpts(val1, val2, val3, val4, val5, val6);

       t := WHT(opts.size).withTags(opts.tags);

       rt := RandomRuleTree(t,opts);

       srt := SumsRuleTree(rt,opts);

       cs := CodeSums(srt,opts);

       namec := ConcatenationString("whtfile",String(val1),String(val4),String(val5),".c");
       nametxt := ConcatenationString("whtfile",String(val1),String(val4),String(val5),".txt");
       PrintTo(namec,PrintCode("sub",cs,opts));

       a := CMatrix(cs,opts);

       PrintTo(nametxt, a);
end;

scriptDFT := function(val1, val2, val3, val4, val5, val6)
       local opts, t, rt, srt, cs, namec, nametxt, a;

       ImportAll(paradigms.scratchpad);

       opts := ScratchX86Globals.getOpts(val1, val2, val3, val4, val5, val6);

       t := DFT(opts.size).withTags(opts.tags);

       rt := RandomRuleTree(t,opts);

       srt := SumsRuleTree(rt,opts);

       cs := CodeSums(srt,opts);

       namec := ConcatenationString("dftfile",String(val1),String(val4),String(val5),".c");
       nametxt := ConcatenationString("dftfile",String(val1),String(val4),String(val5),".txt");
       PrintTo(namec,PrintCode("sub",cs,opts));

       a := CMatrix(cs,opts);

       PrintTo(nametxt, a);
end;

scriptRunWHT := function(wht_size, name)
             local opts, t, rt;

             ImportAll(paradigms.scratchpad);

             i := 2;

             while (2^i) <= (2^(wht_size+1)) do
                   opts := ScratchX86Globals.getOpts(2^i,1,1,wht_size,'R',true);
                   AppendTo(name,PrintLine("--------------------"));
                   t := WHT(opts.size).withTags(opts.tags);
                   AppendTo(name,PrintLine(t));
                   rt := AllRuleTrees(t,opts);
                   L := Length(rt);
                   AppendTo(name,PrintLine(ConcatenationString("Has ", String(L), " decomposition trees")));
                   AppendTo(name,PrintLine("--------------------"));

                   i := i + 1;
             od;
end;

scriptRunDFT := function(dft_size, name)
             local opts, t, rt;

             ImportAll(paradigms.scratchpad);

             i := 2;

             while (2^i) <= (2*dft_size) do
                   opts := ScratchX86Globals.getOpts(2^i,1,1,dft_size,'C',true);
                   AppendTo(name,PrintLine("--------------------"));
                   t := DFT(opts.size).withTags(opts.tags);
                   AppendTo(name,PrintLine(t));
                   rt := AllRuleTrees(t,opts);
                   L := Length(rt);
                   AppendTo(name,PrintLine(ConcatenationString("Has ", String(L), " decomposition trees")));
                   AppendTo(name,PrintLine("--------------------"));

                   i := i + 1;
             od;
end;

scriptRun := function()
          local wht_size, dft_size, wht_file_name, dft_file_name;

          wht_file_name := "wht.txt";
          dft_file_name := "dft.txt";

          wht_size := 2;

          while wht_size <= 13 do
                scriptRunWHT(wht_size, wht_file_name);
                wht_size := wht_size + 1;
          od;

          dft_size := 4;

          while dft_size <= 8192 do
                scriptRunDFT(dft_size, dft_file_name);
                dft_size := dft_size * 2;
          od;
end;