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

Import(fftx.platforms.cuda);
Import(fftx.codegen);
Import(simt);

Class(WarpXCUDADeviceOpts, FFTXCUDADeviceOpts, rec(
#    tags := [ASIMTKernelFlag(ASIMTGridDimY), ASIMTBlockDimX, ASIMTLoopDim() ],
#    tags := [ASIMTGridDimX, ASIMTBlockDimX, ASIMTKernelFlag(ASIMTLoopDim()) ],
#    tags := [ASIMTBlockDimZ, ASIMTKernelFlag(ASIMTBlockDimX), ASIMTKernelFlag(ASIMTBlockDimY) ],
    tags := [ASIMTKernelFlag(ASIMTGridDimY), ASIMTGridDimX, ASIMTBlockDimZ],

    operations := rec(Print := s -> Print("<FFTX WarpX CUDA Device options record>"))
));

warpXCUDADeviceOpts := function(arg) # specific to WarpX size 80 and 100... # the magic list [20, 80, 100] needs to be exposed from the API level
    local opts, rfs;

    rfs := Copy(RulesFuncSimp);
    Unbind(rfs.rules.TensorIdId);
    Unbind(rfs.rules.Const_fbase);

    opts := Copy(WarpXCUDADeviceOpts);
    opts.breakdownRules.Circulant := [Circulant_PRDFT_FDataNT];
    opts.breakdownRules.PRDFT := List([PRDFT1_Base1, PRDFT1_Base2, CopyFields(PRDFT1_CT,
            rec(allChildren := P ->Filtered(PRDFT1_CT.allChildren(P), i->When(P[1] in [20, 80, 100], Cols(i[1]) = 4, true)))),
        PRDFT_PD], _noT);
    opts.breakdownRules.IPRDFT := List([ IPRDFT1_Base1, IPRDFT1_Base2, CopyFields(IPRDFT1_CT,
            rec(allChildren := P ->Filtered(IPRDFT1_CT.allChildren(P), i->When(P[1] in [20, 80, 100], Cols(i[2]) = 4, true)))),
        IPRDFT_PD], _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.DFT := [ DFT_Base,
        CopyFields(DFT_CT, rec(children := nt ->Filtered(DFT_CT.children(nt), i->When(nt.params[1] in [20, 80, 100], Cols(i[1]) = 4, true)))),
        DFT_PD ];

    opts.breakdownRules.TTensorInd := [TTensorInd_SIMT];
    opts.breakdownRules.TL := [L_SIMT];
    opts.breakdownRules.TIterHStack := [TIterHStack_SIMT];
    opts.breakdownRules.TIterVStack := [TIterVStack_SIMT];
    opts.breakdownRules.MDPRDFT := [MDPRDFT_3D_SIMT];
    opts.breakdownRules.IMDPRDFT := [IMDPRDFT_3D_SIMT];
    opts.breakdownRules.TRC := [TRC_SIMT];
    opts.breakdownRules.MDDFT := [ MDDFT_Base, CopyFields(MDDFT_tSPL_RowCol, rec(switch := true)), MDDFT_RowCol];
    opts.breakdownRules.TTensor := [ AxI_IxB, IxB_AxI ];
    opts.breakdownRules.TTensorI := [ IxA_SIMT,  AxI_SIMT ];
    opts.breakdownRules.TSparseMat := [CopyFields(TSparseMat_base, rec(max_rows := 1)), TSparseMat_VStack];

    opts.globalUnrolling := 12; #23; ## 12 for size 80, 23 for size 100--needs to be exposed at the API level
    opts.codegen.GathPtr := fftx.codegen.MultiPtrCodegenMixin.GathPtr;
    opts.codegen.ScatPtr := fftx.codegen.MultiPtrCodegenMixin.ScatPtr;
    opts.codegen.OO := (self, o, y, x, opts) >> skip();

    opts.sumsgen.IterHStack := MultiPtrSumsgenMixin.IterHStack;
    opts.preProcess := t -> ApplyStrategy(t,
                    [ RulesFFTXPromoteWarpX1,
                      MergedRuleSet(rfs, RulesSums, RulesFFTXPromoteWarpX2),
                      RulesFFTXPromoteNT,
                      MergedRuleSet(rfs, RulesSums, RulesFFTXPromoteWarpX3) ],
        BUA, opts);

    opts.postProcessSums := (s, opts) -> let(s1 := ApplyStrategy(s, [ MergedRuleSet(rfs, RulesSums, RulesSIMTFission) ], BUA, opts),
        FixUpCUDASigmaSPL(s1, opts));

#    opts.useDeref := false;
    # for debugging...
#    opts.generateInitFunc := false;
#    opts.codegen := DefaultCodegen;
#    opts.arrayBufModifier := "";
#    opts.arrayDataModifier := "static const";

    # lets see if that gets all the temps into device memory
    opts.max_shmem_size := 16384;
    opts.use_shmem := false;
    opts.max_threads := 1024;
    opts.fixUpZ := true;

    return opts;
end;

confWarpXCUDADevice := rec(
    defaultName := "confWarpXCUDADevice",
    defaultOpts := (arg) >> rec(useWarpXCUDADevice := true),
    confHandler := warpXCUDADeviceOpts
);

fftx.FFTXGlobals.registerConf(confWarpXCUDADevice);


############################################################################
##
##  loading.gi                    IRREDSOL                  Burkhard Höfling
##
##  Copyright © 2003–2016 Burkhard Höfling
##

############################################################################
##
#F  IsAvailableAbsolutelyIrreducibleSolubleGroupData(<n>, <q>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(IsAvailableAbsolutelyIrreducibleSolubleGroupData,
    function(n, q)

        if not IsPosInt(n) or not IsPosInt(q) or not IsPPowerInt(q)  then
            Error("n and q must be positive integers and q must be a prime power");
        fi;
        return TryLoadAbsolutelyIrreducibleSolubleGroupData(n, q);
    end);

############################################################################
##
#F  TryLoadAbsolutelyIrreducibleSolubleGroupData(<n>, <q>)
##
InstallGlobalFunction(TryLoadAbsolutelyIrreducibleSolubleGroupData,
    function(n, q)

        local filename, pathname, dirs, dir, inds, desc, guardianData, guardianDesc, data,
            i, j, p, d, e, orders, divs, t, info, q0, m, G, H, hom, inv,
            pos, gdPos, maxes, cpcgscode, pcgs;

        if not IsPosInt(n) or not IsPosInt(q) or not IsPPowerInt(q)  then
            Error("n and q must be positive integers and q must be a prime power");
        fi;

        if not IsBound(IRREDSOL_DATA.GAL_PERM[n]) then
            IRREDSOL_DATA.GAL_PERM[n] := [];
        fi;
        if not IsBound(IRREDSOL_DATA.GUARDIANS[n]) then
            IRREDSOL_DATA.GUARDIANS[n] := [];
        fi;

        if n = 1 then
            if not IsBound(IRREDSOL_DATA.GROUPS_DIM1[q]) then
                Info(InfoIrredsol, 2, "Computing irreducible soluble group data for ",
                  "GL(", n, ", ", q, ")");
                p := SmallestRootInt(q);
                e := LogInt(q, p);
                orders := ShallowCopy(DivisorsInt(q-1));
                # remove groups which are over a proper subfield
                if e > 1 then
                  for d in Set(Factors(e)) do
                     SubtractSet(orders, DivisorsInt(p^(e/d) - 1));
                  od;
                fi;

                if p < q then
                  divs := Reversed(Difference(DivisorsInt(e), [1]));
                  info := List(orders, o -> [o, []]);
                  for j in [1..Length(divs)] do
                     d := divs[j];
                     q0 := p^(e/d);

                     for i in info do

                        for t in DivisorsInt(GcdInt(i[1], d)) do
                            m := d/t;
                            if (q0^m -1) mod (i[1]/t) = 0 then
                              i[2][j] := m;
                            fi;
                        od;
                     od;
                  od;
                else
                  info := List(orders, o -> [o]);
                fi;

                IRREDSOL_DATA.GUARDIANS[1][q] := [CyclicGroup(IsPcGroup, q-1)];
                IRREDSOL_DATA.GROUPS_DIM1[q] := info;
                IRREDSOL_DATA.GAL_PERM[1][q] := ();
            fi;
            return true;
        fi;

       if not IsBound(IRREDSOL_DATA.GROUPS[n]) then
            IRREDSOL_DATA.GROUPS[n] := [];
        fi;
        if not IsBound(IRREDSOL_DATA.MAX[n]) then
            IRREDSOL_DATA.MAX[n] := [];
        fi;
        if not IsBound(IRREDSOL_DATA.GROUPS_LOADED[n]) then
            IRREDSOL_DATA.GROUPS_LOADED[n] := [];
        fi;

        if not IsBound(IRREDSOL_DATA.GUARDIANS[n][q]) or not IsBound(IRREDSOL_DATA.GROUPS[n][q])
                or not IsBound(IRREDSOL_DATA.MAX[n][q]) or not IsBound(IRREDSOL_DATA.GAL_PERM[n][q])
                or not IsBound(IRREDSOL_DATA.GROUPS_LOADED[n][q]) then

            Unbind(IRREDSOL_DATA.GROUPS_LOADED[n][q]); # if anything fails during loading
                # we won't have inconsistencies

            pathname := Concatenation("data/gl_", String(n), "_",String(q),".grp");

            Info(InfoIrredsol, 2, "Reading data file ", pathname);
            if not ReadPackage("irredsol", pathname) then
                return false;
            fi;

            if not IsBound(IRREDSOL_DATA.GUARDIANS[n][q]) or not IsBound(IRREDSOL_DATA.GROUPS[n][q])
                    or not IsBound(IRREDSOL_DATA.GAL_PERM[n][q]) then
                Error("Panic: reading data file didn't define required data");
            fi;

            # convert guardian data

            guardianData := IRREDSOL_DATA.GUARDIANS[n][q];
            maxes := [];

            for gdPos in [1..Length(guardianData)]  do
                guardianDesc := guardianData[gdPos];
                guardianDesc[1] := List(guardianDesc[1], m -> FFMatrixByNumber(m, n, q));

                G := PcGroupCode(guardianDesc[3], guardianDesc[2]);
                H := Group(guardianDesc[1]);
                SetSize(H, Size(G));
                hom := GroupGeneralMappingByImagesNC(G, H, FamilyPcgs(G), guardianDesc[1]);
                SetIsGroupHomomorphism(hom, true);
                SetIsBijective(hom, true);
                guardianDesc[3] := hom;
                if TestFlag(guardianDesc[5], 0) then
                    cpcgscode := 2^Length(FamilyPcgs(G)) - 1;
                    pos := PositionProperty(IRREDSOL_DATA.GROUPS[n][q],
                        desc -> desc[2] = cpcgscode and desc[1] = gdPos);
                    if pos = fail then
                        Error("panic: did not find guardian in list of groups");
                    fi;
                    AddSet(maxes, pos);
                fi;
            od;

            # compupte group orders

            data := IRREDSOL_DATA.GROUPS[n][q];
            for d in data do
                pcgs := FamilyPcgs(Source(guardianData[d[1]][3])); # get pcgs of guardian
                d[4] := OrderGroupByCanonicalPcgsByNumber(pcgs, d[2]);
            od;

            IRREDSOL_DATA.GUARDIANS[n][q] := guardianData; # now attach converted data
            IRREDSOL_DATA.MAX[n][q] := maxes;
            MakeImmutable(IRREDSOL_DATA.GUARDIANS[n][q]);
            MakeImmutable(IRREDSOL_DATA.GROUPS[n][q]);
            MakeImmutable(IRREDSOL_DATA.MAX[n][q]);
            IRREDSOL_DATA.GROUPS_LOADED[n][q] := true;
            Info(InfoIrredsol, 2, "irreducible soluble group data for GL(", n, ", ", q, ") loaded");
        fi;
        return true;
    end);

###########################################################################
##
#F  LoadAbsolutelyIrreducibleSolubleGroupData(<n>, <q>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(LoadAbsolutelyIrreducibleSolubleGroupData,
    function(n, q)

        if not IsPosInt(n) or not IsPosInt(q) or not IsPPowerInt(q)  then
            Error("n and q must be positive integers and q must be a prime power");
        fi;

        if not TryLoadAbsolutelyIrreducibleSolubleGroupData(n, q) then
            Error("Panic: missing data file for GL(",n,", ", q, ")");
        fi;
    end);

############################################################################
##
#F  LoadedAbsolutelyIrreducibleSolubleGroupData()
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(LoadedAbsolutelyIrreducibleSolubleGroupData,
    function()

        local n, p, data, fields;

        data := [];
        for n in [1..Length(IRREDSOL_DATA.GROUPS)] do
            if IsBound(IRREDSOL_DATA.GROUPS[n]) then
                fields := [];
                for p in [1..Length(IRREDSOL_DATA.GROUPS[n])] do
                    if IsBound(IRREDSOL_DATA.GROUPS[n][p]) then
                        Add(fields, p);
                    fi;
                od;
                if not IsEmpty(fields) then
                    Add(data, [n, fields]);
                fi;
            fi;
        od;
        return data;
    end);

############################################################################
##
#F  UnloadAbsolutelyIrreducibleSolubleGroupData([<n>[, <q>]])
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(UnloadAbsolutelyIrreducibleSolubleGroupData,
    function(arg)

        local UnbindIfBound;

        UnbindIfBound := function(arg)
            local data, i;

            data := arg[1];
            i := 2;
            while i < Length(arg)  do
                if not IsBound(data[arg[i]]) then
                    return false;
                fi;
                data := data[arg[i]];
                i := i + 1;
            od;
            if IsBound(data[arg[i]]) then
                Unbind(data[arg[i]]);
                return true;
            else
                return false;
            fi;
        end;

        if Length(arg) = 0 then
            IRREDSOL_DATA.GUARDIANS := [];
            IRREDSOL_DATA.GROUPS := [];
            IRREDSOL_DATA.GROUPS_LOADED := [];
            IRREDSOL_DATA.GAL_PERM := [];
            IRREDSOL_DATA.MAX := [];
            IRREDSOL_DATA.GROUPS_DIM1 := [];
            IRREDSOL_DATA.PRIM_GUARDIANS := [];
        elif IsPosInt(arg[1]) and Length(arg) = 1 then
            UnbindIfBound(IRREDSOL_DATA.GAL_PERM, arg[1]);
            UnbindIfBound(IRREDSOL_DATA.GUARDIANS, arg[1]);
            UnbindIfBound(IRREDSOL_DATA.PRIM_GUARDIANS, arg[1]);
            if arg[1] = 1 then
                UnbindGlobal("IRREDSOL_DATA.GROUPS_DIM1");
                BindGlobal("IRREDSOL_DATA.GROUPS_DIM1", []);
            else
                UnbindIfBound(IRREDSOL_DATA.GROUPS, arg[1]);
                UnbindIfBound(IRREDSOL_DATA.MAX, arg[1]);
            fi;
        elif Length(arg) = 2 and IsPosInt(arg[1]) and IsPPowerInt(arg[2]) then
            UnbindIfBound(IRREDSOL_DATA.GUARDIANS, arg[1], arg[2]);
            UnbindIfBound(IRREDSOL_DATA.PRIM_GUARDIANS, arg[1], arg[2]);
            UnbindIfBound(IRREDSOL_DATA.GAL_PERM, arg[1], arg[2]);
            if arg[1] = 1 then
                UnbindIfBound(IRREDSOL_DATA.GROUPS_DIM1, arg[2]);
            else
                UnbindIfBound(IRREDSOL_DATA.GROUPS, arg[1], arg[2]);
                UnbindIfBound(IRREDSOL_DATA.MAX, arg[1], arg[2]);
            fi;
        else
            Error("Usage: `UnloadAbsolutelyIrreducibleSolubleGroupData( [n [, q]] )'");
        fi;
    end);

############################################################################
##
#F  IsAvailableIrreducibleSolubleGroupData(<n>, <q>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(IsAvailableIrreducibleSolubleGroupData,
    function(n, q)

        local d;

        if not IsPosInt(n) or not IsPosInt(q) or not IsPPowerInt(q)  then
            Error("n and q must be positive integers and q must be a prime power");
        fi;
        for d in DivisorsInt(n) do
            if not IsAvailableAbsolutelyIrreducibleSolubleGroupData(n/d, q^d) then
                return false;
            fi;
        od;
        return true;
    end);

############################################################################
##
#E
##


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

#Concatenation(Conf("spiral_dir"), Conf("path_sep"), "libgen", Conf("path_sep"),

#F InitLibgen(<opts>)
#F  opts must have a .libgen field.
#F  Example: opts := InitLibgen(LibgenDefaults);
#F
InitLibgen := function(opts)
    local base_opts, bench;
    opts := Copy(opts);

    base_opts := CopyFields(opts, rec(
            globalUnrolling := opts.libgen.basesUnrolling,
            breakdownRules  := opts.libgen.basesBreakdowns,
            hashFile        := opts.libgen.basesHashFile,
            benchTransforms := opts.libgen.bases));

    bench:= CopyFields(DPBench(rec(bases := base_opts), rec(verbosity:=0)),
                       rec(generateCfiles := false, generateSums := true, matrixVerify := false));
    bench.resumeAll();

    opts.libgen.baseBench := bench;
    opts.baseHashes := Concatenation(opts.baseHashes, [ CreateRecursBaseHash(bench.exp.bases.hashTable) ]);
    return opts;
end;

_bases := function(max)
   local t, facs, sizesTwoPower, sizesGeneral;
   sizesTwoPower := List([1..Log2Int(max)], x->2^x);
   facs := [2, 3, 5, 7, 11];
   sizesGeneral := Filtered([2 .. max], i -> ForAll(FactorsInt(i), f -> f in (facs)));
   t := [];
   Append(t, List(sizesTwoPower, PRDFT3));
   Append(t, List(sizesTwoPower, n -> PRDFT3(n, -1).transpose()));
   Append(t, List(sizesTwoPower, n -> DFT(n, -1 mod n)));
#  Append(t, List(sizesTwoPower, URDFT));
   Append(t, List(sizesGeneral, PRDFT));
   Append(t, List(sizesGeneral, DFT));
   return t;
end;

LibgenDefaultsMixin := rec(
    codegen := RecCodegen,
    verbosity := 1,
    hashTable := HashTableDP(),

    formulaStrategies := rec(
	sigmaSpl    := [ StandardSumsRules, HfuncSumsRules ],
	preRC       := [],
	rc          := [ StandardSumsRules, HfuncSumsRules ],
        postProcess := [
	    (s, opts) -> BlockSums(opts.globalUnrolling, s),
	    (s, opts) -> Process_fPrecompute(s, opts),
            RecursStepTerm
        ]
    ),

    libgen := rec(
	codeletTab := CreateCodeletHashTable(),
	terminateStrategy := [ HfuncSumsRules ], # used in SumsCodelet

	bases := _bases(34),
	basesUnrolling := 2^16,
        basesHashFile := let(p:=Conf("path_sep"),
            Concat(Conf("spiral_dir"), p, "spiral", p, "libgen", p, "realbases.hash")),
	basesBreakdowns := rec(
	    DFT    := [DFT_Base, DFT_CT, DFT_GoodThomas, DFT_PD, DFT_Rader],
	    PRDFT  := [PRDFT1_Base2, PRDFT1_CT, PRDFT1_PF, PRDFT_Rader, PRDFT_PD],
	    PRDFT3 := [PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT, PRDFT3_OddToPRDFT1])
    )
);

LibgenDefaults := CopyFields(SpiralDefaults, LibgenDefaultsMixin, rec(
    globalUnrolling := 66,
    breakdownRules := rec(
	DFT    := [DFT_Base, DFT_CT],
	PRDFT  := [PRDFT1_Base2, PRDFT1_CT],
	PRDFT3 := [PRDFT3_Base2, PRDFT3_CT],
	PDCT4  := [PDCT4_Base2, PDCT4_CT],
	PDST4  := [PDST4_Base2, PDST4_CT],
	InfoNt := [Info_Base]),
    libgen := Copy(LibgenDefaultsMixin.libgen)
));

CplxLibgenDefaults := CopyFields(CplxSpiralDefaults, LibgenDefaultsMixin, rec(
    globalUnrolling := 34,
    breakdownRules := rec(
	DFT    := [DFT_Base, DFT_CT],
	PRDFT  := [PRDFT1_Base2, PRDFT1_CT],
	PRDFT3 := [PRDFT3_Base2, PRDFT3_CT],
	InfoNt := [Info_Base]),
    libgen := CopyFields(Copy(LibgenDefaultsMixin.libgen), rec(
	bases := List([1..5], x->DFT(2^x)),
        basesHashFile := let(p:=Conf("path_sep"),
            Concat(Conf("spiral_dir"), p, "spiral", p, "libgen", p, "cplxbases.hash")),
	basesBreakdowns := rec(
	    DFT    := [DFT_Base, DFT_PRDFT],
	    PRDFT  := [PRDFT1_Base1, PRDFT1_Base2, PRDFT1_CT, PRDFT1_PF, PRDFT_PD, PRDFT_Rader],
	    PRDFT3 := [PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT, PRDFT3_OddToPRDFT1])
    ))
));


#############################################################################
##
##  Functions.gi        JConvex package
##                      Martin Bies
##
##  Copyright 2021      University of Pennsylvania
##
##  A Gap package to do convex geometry by Polymake
##
## Chapter: Functionality
##
#############################################################################

#############################################################################
## Availability of required software
#############################################################################

##
InstallMethod( PolymakeAvailable, [  ],
  function( )
    # Check if Polymake and the gap-julia interface are available
    if IsPackageMarkedForLoading( "JuliaInterface", ">= 0.5.2" ) then
        if IsBoundGlobal("_Polymake_jl") and IsJuliaObject(ValueGlobal("_Polymake_jl")) then
            return true;
        fi;
    fi;
    return false;
end );

##
InstallMethod( CddInterfaceAvailable, [  ],
  function( )
    return IsPackageMarkedForLoading( "CddInterface", ">= 2020.06.24" );
end );

##
InstallMethod( NormalizInterfaceAvailable, [  ],
  function( )
    return IsPackageMarkedForLoading( "NormalizInterface", ">= 1.2.0" );
end );


Read("SchreierSims.gi");

#######################################################################
# Description: The deterministic verification, parallelized w.r.t.    #
#              base points, described as method 1 in section 5.1.     #
# Input: - BSGS data structure returned by RandomSchreierSims         #
# Output: - boolean, true if BSGS is correct, else false              #
#######################################################################

Method1 := function(BSGS)
    local l, tasks, results;

    Print("Start verification.\n");
    Print("Apply parallel computing method w.r.t. base points.\n");

    tasks := [1..Length(BSGS[1])];  results := [1..Length(BSGS[1])];

    for l in [1..Length(BSGS[1])] do
        tasks[l] := RunTask(SimpleVerify, BSGS, l);
    od;
    for l in [1..Length(BSGS[1])] do
        results[l] := TaskResult(tasks[l]);
    od;

    Print("\nVerification done.");

    if false in results then
        Print("\nBSGS is wrong!\n");
    else
        Print("\nCorrectness of BSGS verified!\n");
    fi;
    Print("*********************************************************\n");
end;

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

#######################################################################
# Description: The deterministic verification, parallelized w.r.t.    #
#              orbit points, described as method 2 in section 5.1.    #
# Input: - BSGS data structure returned by RandomSchreierSims         #
# Output: - boolean, true if BSGS is correct, else false              #
#######################################################################

Method2 := function(BSGS)
    local l, tasks, results;

    Print("Start verification.\n");
    Print("Apply parallel computing method w.r.t. orbit points.\n");

    tasks := [1..Length(BSGS[1])];  results := [1..Length(BSGS[1])];

    for l in Reversed([1..Length(BSGS[1])]) do
        results[l] := ParallelVerify(BSGS, l);
        if false in results then
            break;
        fi;
    od;

    Print("\nVerification done.");

    if false in results then
        Print("\nBSGS is wrong!\n");
    else
        Print("\nCorrectness of BSGS verified!\n");
    fi;
    Print("*********************************************************\n");
end;


Load(graph);
Import(graph);
conf := SparseDefaultConf;
opts := conf.getOpts(V(1));
opts.vec := true;
i := Ind(3);
front := var.fresh_t("frontier",TArray(TSemiring_MinTimes(TInt), opts.symbol[1]));
fdos := FDataOfs(front, opts.symbol[1], i);
rv := RowVec(fdos);
spmv := IterVStack(i, opts.symbol[1], rv);
rt := RandomRuleTree(last, opts);
srt := SumsRuleTree(rt, opts);
cs := CodeSums(BFSKernel(PullBFSKernel(srt)), opts);
PrintCode("spmv", cs, opts);

# c -> MarkDefUse(c), c -> FixValueTypes(c), c -> Compile.declareVars(c),
#    (c, opts) -> HashConsts(c, opts)


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

Class(RulesSIMTFission, RuleSet);

RewriteRules(RulesSIMTFission, rec(
    FissionSIMTISum := Rule([@(1, SIMTISum), @(2, Compose, e->ForAll(e.children(), c->ObjId(c) = SIMTISum))],
        e-> let(gath := Gath(fTensor(fBase(@(1).val.var), fId(Cols(@(2).val.child(1))))),
                scat := Scat(fTensor(fBase(@(1).val.var), fId(Cols(@(2).val.child(1))))),
                c1 := @(2).val.child(1) * gath,
                cn := scat * Last(@(2).val.children()),
                cms := List(DropLast(Drop(@(2).val.children(), 1), 1), c->scat * c *gath),
                Compose(List([c1]::cms::[cn], c -> SIMTISum(@(1).val.simt_dim, @(1).val.var, @(1).val.domain, c))))),
));

RewriteRules(RulesSums, rec(
    OO_Gath := Rule([@(1, Compose), OO, Gath],
        e -> ApplyFunc(OO, @(1).val.dims())),
    Gath_OO := Rule([@(1, Compose), Scat, OO],
        e -> ApplyFunc(OO, @(1).val.dims())),
    Scat_OO_Gath := Rule([@(1, Compose), Scat, OO, Gath],
        e -> ApplyFunc(OO, @(1).val.dims())),
));

SIMT_NextLoop := (s, simtidx) ->
    SubstBottomUp(s, [@(1, SIMTISum), @(2, Compose, e->ForAll(e.children(), c->ObjId(c) in [ISum, SUM]))],
        e->let(sx1c := @(2).val.children(),
            doms := List(sx1c, c->When(ObjId(c) = ISum, c.domain, Length(c.children()))),
            mdom := Maximum(doms),
            ranges := List(List(sx1c, c->[0, When(ObjId(c) = ISum, c.domain, Length(c.children()))-1])),
            newc := List([1..Length(sx1c)],
                i-> When(ObjId(sx1c[i]) = ISum,
                        SIMTISum(simtidx(mdom, ranges[i]), sx1c[i].var, sx1c[i].domain, sx1c[i].child(1)),
                        SIMTSUM(simtidx(mdom, ranges[i]), sx1c[i].children()))),
            SIMTISum(@(1).val.simt_dim, @(1).val.var, @(1).val.domain, Compose(newc))
        )
    );

_fBaseVar := function(s, i, v)
    local cands;

    cands := Collect(s, @(0, fBase, e->e.params[1]=i.range and IsInt(e.params[2]) and e.params[2] = v));
    if cands = [] then return s; fi;

    s := SubstTopDown(s, @(0, fBase, e->e.params[1]=i.range and IsInt(e.params[2]) and e.params[2] = v),
        e->fBase(i));
    return s;
end;

FixUpCUDASigmaSPL := function(s, opts)
    local srt, kernels, i, _s, newv;

    if IsBound(s.ruletree) then srt := s.ruletree; fi;

    s := SIMT_NextLoop(s, ASIMTBlockDimY);
    s := SIMT_NextLoop(s, ASIMTBlockDimX);

    s:= SubstTopDown(s, @(1, SIMTSUM),
        e->let(
            its := @(1).val.simt_dim.params[1],
            ii := Ind(its),
            ch := @(1).val.children(),
            nch := Length(ch),
            SIMTISum(@(1).val.simt_dim, ii, nch, SUM(List([0..nch-1],
               i->COND(eq(ii, V(i)), _fBaseVar(ch[i+1], ii, i), ApplyFunc(OO, ch[i+1].dims()))))))
    );

    if Length(Collect(s,  @(1, SIMTISum, e->ObjId(e.simt_dim) = ASIMTBlockDimX))) > 0 then
        s := SubstTopDown(s, [@@(1, SIMTISum, (e,cx)->ObjId(e.simt_dim) = ASIMTBlockDimY), @(2, [BB, SUM])],
            (e,cx)->let(xdimcds := Collect(Filtered(cx.SIMTISum, s->ObjId(s.simt_dim) = ASIMTKernelFlag), @(0, SIMTISum, (e)->ObjId(e.simt_dim) = ASIMTBlockDimX)),
                xdim := When(xdimcds <> [], xdimcds[1].domain, @@(1).val.domain),
                SIMTISum(@@(1).val.simt_dim, @@(1).val.var, @@(1).val.domain,
                    SIMTISum(ASIMTBlockDimX(xdim,[0,0]), Ind(1), 1, @@(1).val.child(1))))
        );

        s := ApplyStrategy(s, [RulesSIMTFission, RulesSums], BUA, opts);
#        s := RulesSums(RulesSIMTFission(s));

        s := SubstTopDown(s, @@(1, SIMTSUM, (e,cx)->ObjId(e.simt_dim) = ASIMTBlockDimY and ForAll(e.children(), c->not ObjId(c) in [SIMTISum, SIMTSUM])),
            (e,cx)->let(xdimcds := Collect(Filtered(cx.SIMTISum, s->ObjId(s.simt_dim) = ASIMTBlockDimZ), @(0, SIMTISum, (e)->ObjId(e.simt_dim) = ASIMTBlockDimX)),
                xdim := When(xdimcds <> [], xdimcds[1].domain, When(IsBound(@@(1).val.domain), @@(1).val.domain, 1)),
                SIMTSUM(@@(1).val.simt_dim,
                    List(@@(1).val.children(), c->SIMTISum(ASIMTBlockDimX(xdim, [0,0]), Ind(1), 1, c))))
        );

        s := SubstTopDown(s, [@(1, SIMTISum, e->ObjId(e.simt_dim) = ASIMTBlockDimX and Set(Flat(e.simt_dim.simt_all_ranges())) = [0]), @(2, ISum)],
            e -> SIMTISum(ASIMTBlockDimX(@(2).val.domain), @(2).val.var, @(2).val.domain, @(2).val.child(1))
        );

        if ObjId(s) = Compose then
            kernels := s.children();

            for i in [1..Length(kernels)] do
                _s := kernels[i];
                if Length(Collect(_s,  @(1, SIMTISum, e->ObjId(e.simt_dim) = ASIMTBlockDimX))) > 0 then
                    newv := Maximum(List(List(Collect(_s, @(1, [SIMTSUM, SIMTISum], e->ObjId(e.simt_dim) = ASIMTBlockDimX)), e-> e.simt_dim), i->i.params[1]));
                    _s := SubstTopDown(_s, @(1, SIMTISum, e->ObjId(e.simt_dim) = ASIMTBlockDimX),
                        e->SIMTISum(ApplyFunc(ASIMTBlockDimX, [newv]::Drop(@(1).val.simt_dim.params, 1)), @(1).val.var, @(1).val.domain, @(1).val.child(1))
                    );

                    _s := SubstTopDown(_s, @(1, SIMTSUM, e->ObjId(e.simt_dim) = ASIMTBlockDimX),
                        e->SIMTSUM(ApplyFunc(ASIMTBlockDimX, [newv]::Drop(@(1).val.simt_dim.params, 1)), @(1).val.children())
                    );
                fi;
                kernels[i] := _s;
            od;
            s := Compose(kernels);
        fi;

        s := SubstTopDown(s, [@(1, SIMTSUM, e->ObjId(e.simt_dim) = ASIMTBlockDimX), @(2,BB), @(3, ISum)],
            e->SIMTSUM(ApplyFunc(ObjId(@(1).val.simt_dim),  [@(1).val.simt_dim.params[1], [0, @(3).val.domain-1], [@(3).val.domain,@(3).val.domain]]),
                SIMTISum(ApplyFunc(ObjId(@(1).val.simt_dim),  [@(1).val.simt_dim.params[1], [0, @(3).val.domain-1]]), @(3).val.var, @(3).val.domain, @(3).val.child(1)),
                @(2).val)
        );
    fi;
    # somehow SIMTSUM by itself does not create the necessary loop dimension (?)
    s := SubstBottomUp(s, [@(1,SIMTISum, e->ObjId(e.simt_dim) = ASIMTBlockDimZ), [BB, @(2,SUM)], ...],
        e->let(ch := @(2).val.children(), nch := Length(ch),
            ii := Ind(nch),
            SIMTISum(@(1).val.simt_dim, @(1).val.var, @(1).val.domain,
                SIMTISum(ASIMTBlockDimY(nch), ii, nch, SUM(List([0..nch-1], i->COND(eq(ii, V(i)), BB(_fBaseVar(ch[i+1], ii, i)), ApplyFunc(OO, ch[i+1].dims())))))))
    );

    s := SubstTopDown(s, @(1, Grp), e->e.child(1));

    s := SubstBottomUp(s, @(1, SIMTISum, e->ObjId(e.simt_dim) = ASIMTBlockDimZ),
        e->let(SIMTISum(ASIMTGridDimZ(@(1).val.simt_dim.params[1]), @(1).val.var, @(1).val.domain, @(1).val.child(1)))
    );

    if IsBound(opts.fixUpZ) and opts.fixUpZ then
        s := SubstBottomUp(s, @(1, SIMTISum, e->ObjId(e.simt_dim) = ASIMTGridDimZ),
            e -> let(
                orig_zdim := @(1).val.domain,
                xdim := Maximum([1]::List(Collect(@(1).val.child(1), @(2, [SIMTSUM, SIMTISum], e->ObjId(e.simt_dim) = ASIMTBlockDimX)), i->i.simt_dim.params[1])),
                ydim := Maximum([1]::List(Collect(@(1).val.child(1), @(2, [SIMTSUM, SIMTISum], e->ObjId(e.simt_dim) = ASIMTBlockDimY)), i->i.simt_dim.params[1])),
                zdim_inner := Maximum([1]::Filtered(DivisorsInt(orig_zdim), i -> i * xdim * ydim <= (opts.max_threads))),
                zdim_outer := orig_zdim / zdim_inner,
                io := Ind(zdim_outer),
                sdo := ASIMTGridDimZ(zdim_outer),
                ii := Ind(zdim_inner),
                sdi := ASIMTBlockDimZ(zdim_inner),
                krn := SubstVars(Copy(@(1).val.child(1)), rec((@(1).val.var.id) := (io * zdim_inner + ii))),
                SIMTISum(sdo, io, zdim_outer,
                    SIMTISum(sdi, ii, zdim_inner, krn))
            )
        );
    fi;

    if IsBound(s.ruletree) then s.ruletree := srt; fi;

    return s;
end;

FixUpCUDASigmaSPL_3Stage := function(ss, opts)
    local kernels, _s, newv;

    # drop grp
    ss := SubstTopDown(ss, @(1, Grp), e->e.child(1));

    # parallelize and flatten loop
    ss:= let(simtidx := ASIMTBlockDimX,
        SubstBottomUp(ss, [@(1, SIMTISum), @(2, Compose, e->ForAll(e.children(), c->ObjId(c) = ISum))],
            e->let(sx1c := @(2).val.children(),
                    doms := List(sx1c, c->c.domain),
                    mdom := Maximum(doms),
                    ranges := List(List(sx1c, c->[0, c.domain-1])),
                    newc := List([1..Length(sx1c)],
                        i-> SIMTISum(@(1).val.simt_dim, @(1).val.var, @(1).val.domain, SIMTISum(simtidx(mdom, ranges[i]), sx1c[i].var, sx1c[i].domain, sx1c[i].child(1)))),
                ApplyFunc(Compose, newc)
            ))
    );

    #ll := Collect(ss, [@(1, SIMTISum, e->ObjId(e.simt_dim) = ASIMTBlockDimX), [@(2, SIMTISum, e->ObjId(e.simt_dim) = ASIMTBlockDimX), BB]]);
    #
    #s1 := ll[1];
    #i1 := s1.var;
    #i2 := s1.child(1).var;
    #
    #rng := i1.range * i2.range;
    #ii := Ind(rng);
    #sr := rec(
    #    (i1.id) := idiv(ii, i2.range),
    #    (i2.id) := imod(ii, i2.range)
    #);
    #
    #sdim := ASIMTBlockDimX(rng);
    #
    #ss2 := SIMTISum(sdim, ii, ii.range, SubstVars(s1.child(1).child(1), sr));

    # normalize loop
    ss := SubstTopDown(ss,
        [@(1, SIMTISum, e->ObjId(e.simt_dim) = ASIMTBlockDimX), [@(2, SIMTISum, e->ObjId(e.simt_dim) = ASIMTBlockDimX), BB]],
        e->let(s1 := @(1).val,
            i1 := s1.var,
            i2 := s1.child(1).var,
            rng := i1.range * i2.range,
            ii := Ind(rng),
            sr := rec(
                (i1.id) := idiv(ii, i2.range),
                (i2.id) := imod(ii, i2.range)
            ),
            sdim := ASIMTBlockDimX(rng),
            SIMTISum(sdim, ii, ii.range, SubstVars(s1.child(1).child(1), sr))
        )
    );

    # fix loop iterations
    if ObjId(ss) = Compose then
        kernels := ss.children();

        for i in [1..Length(kernels)] do
            _s := kernels[i];
            if Length(Collect(_s,  @(1, SIMTISum, e->ObjId(e.simt_dim) = ASIMTBlockDimX))) > 0 then
                newv := Maximum(List(List(Collect(_s, @(1, [SIMTSUM, SIMTISum], e->ObjId(e.simt_dim) = ASIMTBlockDimX)), e-> e.simt_dim), i->i.params[1]));
                _s := SubstTopDown(_s, @(1, SIMTISum, e->ObjId(e.simt_dim) = ASIMTBlockDimX),
                    e->SIMTISum(ApplyFunc(ASIMTBlockDimX, [newv]::Drop(@(1).val.simt_dim.params, 1)), @(1).val.var, @(1).val.domain, @(1).val.child(1))
                );

                _s := SubstTopDown(_s, @(1, SIMTSUM, e->ObjId(e.simt_dim) = ASIMTBlockDimX),
                    e->SIMTSUM(ApplyFunc(ASIMTBlockDimX, [newv]::Drop(@(1).val.simt_dim.params, 1)), @(1).val.children())
                );
            fi;
            kernels[i] := _s;
        od;
        ss := Compose(kernels);
    fi;

    return ss;
end;


############################################################################
##
##  loadfp.gi                     IRREDSOL                  Burkhard Höfling
##
##  Copyright © 2003–2016 Burkhard Höfling
##

IRREDSOL_DATA.FP := [];
IRREDSOL_DATA.FP_INDEX := [];
IRREDSOL_DATA.FP_LOADED := [];

############################################################################
##
#F  IsAvailableAbsolutelyIrreducibleSolubleGroupFingerprintIndex(<n>, <q>)
##
InstallGlobalFunction(IsAvailableAbsolutelyIrreducibleSolubleGroupFingerprintIndex,
    function(n, q)

        if not IsPosInt(n) or not IsPosInt(q) or not IsPPowerInt(q)  then
            Error("n and q must be positive integers and q must be a prime power");
        fi;

        return TryLoadAbsolutelyIrreducibleSolubleGroupFingerprintIndex(n, q);

    end);

############################################################################
##
#F  TryLoadAbsolutelyIrreducibleSolubleGroupFingerprintIndex(<n>, <q>)
##
InstallGlobalFunction(TryLoadAbsolutelyIrreducibleSolubleGroupFingerprintIndex,
    function(n, q)

        local pathname;

        if not IsPosInt(n) or not IsPosInt(q) or not IsPPowerInt(q)  then
            Error("n and q must be positive integers and q must be a prime power");
        fi;

        if n = 1 then
            return true;
        fi;

        if not IsBound(IRREDSOL_DATA.FP_INDEX[n]) then
            IRREDSOL_DATA.FP_INDEX[n] := [];
        fi;

        if not IsBound(IRREDSOL_DATA.FP_INDEX[n][q]) then
            pathname := Concatenation("fp/gl_", String(n), "_",String(q),".idx");

            Info(InfoIrredsol, 2, "Reading data file ", pathname);

            if not ReadPackage("irredsol", pathname) then
                return false;
            fi;

            if not IsBound(IRREDSOL_DATA.FP_INDEX[n][q]) then
                Error("Panic: reading data file didn't define required data");
            fi;
            MakeImmutable(IRREDSOL_DATA.FP_INDEX[n][q]);

        fi;
        return true;
    end);

###########################################################################
##
#F  LoadAbsolutelyIrreducibleSolubleGroupFingerprintIndex(<n>, <q>)
##
InstallGlobalFunction(LoadAbsolutelyIrreducibleSolubleGroupFingerprintIndex,
    function(n, q)

        if not IsPosInt(n) or not IsPosInt(q) or not IsPPowerInt(q)  then
            Error("n and q must be positive integers and q must be a prime power");
        fi;

        if not TryLoadAbsolutelyIrreducibleSolubleGroupFingerprintIndex(n, q) then
            Error("Panic: missing fingerprint index file for GL(",n,", ", q, ")");
        fi;
    end);

############################################################################
##
#F  IsAvailableAbsolutelyIrreducibleSolubleGroupFingerprintData(<n>, <q>, <index>)
##
InstallGlobalFunction(IsAvailableAbsolutelyIrreducibleSolubleGroupFingerprintData,

    function(n, q, index)
        if not IsPosInt(n) or not IsPosInt(q) or not IsPPowerInt(q)
            or not IsPosInt(index) then
                Error("n, q, and index must be positive integers",
                    ", and q must be a prime power");
        fi;

        return TryLoadAbsolutelyIrreducibleSolubleGroupFingerprintData(n, q, index);
    end);

###########################################################################
##
#F  TryLoadAbsolutelyIrreducibleSolubleGroupFingerprintData(<n>, <q>, <index>)
##
InstallGlobalFunction(TryLoadAbsolutelyIrreducibleSolubleGroupFingerprintData,
    function(n, q, index)

        local pathname, i;

        if not IsPosInt(n) or not IsPosInt(q) or not IsPPowerInt(q) or not IsPosInt(index) then
            Error("n and q must be positive integers, q must be a prime power, and pos must be a positive integer");
        fi;

        if n = 1 then
            return; # group is unique, up to conjugacy - no information stored
        fi;

        if not IsBound(IRREDSOL_DATA.FP[n]) then
            IRREDSOL_DATA.FP[n] := [];
        fi;

        if not IsBound(IRREDSOL_DATA.FP[n][q]) then
            IRREDSOL_DATA.FP[n][q] := [];
        fi;

        if not IsBound(IRREDSOL_DATA.FP_LOADED[n]) then
            IRREDSOL_DATA.FP_LOADED[n] := [];
        fi;

        if not IsBound(IRREDSOL_DATA.FP_LOADED[n][q]) then
            IRREDSOL_DATA.FP_LOADED[n][q] := [];
        fi;

        if not IsBound(IRREDSOL_DATA.FP_LOADED[n][q][index]) then

            Unbind(IRREDSOL_DATA.FP_LOADED[n][q][index]); # if anything fails during loading
                # we won't have inconsistencies

            pathname := Concatenation("fp/gl_", String(n), "_",String(q),"_", String(index),".fp");

            Info(InfoIrredsol, 2, "Reading fingerprint file ", pathname);
            if not ReadPackage("irredsol", pathname) then
                return false;
            fi;

            for i in [1..Length(IRREDSOL_DATA.FP_INDEX[n][q][2])] do
                if IRREDSOL_DATA.FP_INDEX[n][q][2][i] = index then
                    MakeImmutable(IRREDSOL_DATA.FP[n][q][i]);
                fi;
            od;
            IRREDSOL_DATA.FP_LOADED[n][q][index] := true;

        fi;
        return true;
    end);

###########################################################################
##
#F  LoadAbsolutelyIrreducibleSolubleGroupFingerprintData(<n>, <q>, <index>)
##
InstallGlobalFunction(LoadAbsolutelyIrreducibleSolubleGroupFingerprintData,
    function(n, q, index)

        if not IsPosInt(n) or not IsPosInt(q) or not IsPPowerInt(q) or not IsPosInt(index) then
            Error("n and q must be positive integers, q must be a prime power, and pos must be a positive integer");
        fi;
        if not TryLoadAbsolutelyIrreducibleSolubleGroupFingerprintData(n, q, index) then
            Error("Panic: ", index, "-th fingerprint file for GL(",n,", ", q, ") is missing");
        fi;
    end);

###########################################################################
##
#F  LoadAbsolutelyIrreducibleSolubleGroupFingerprints(<n>, <q>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(LoadAbsolutelyIrreducibleSolubleGroupFingerprints,
    function(n, q)

        local i;

        if not IsPosInt(n) or not IsPosInt(q) or not IsPPowerInt(q) then
            Error("n and q must be positive integers, and q must be a prime power");
        fi;

        LoadAbsolutelyIrreducibleSolubleGroupFingerprintIndex(n, q);
        for i in Set(IRREDSOL_DATA.FP_INDEX[n][q][2]) do
            LoadAbsolutelyIrreducibleSolubleGroupFingerprintData(n, q, i);
        od;
    end);

###########################################################################
##
#F  UnloadAbsolutelyIrreducibleSolubleGroupFingerprints(<arg>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(UnloadAbsolutelyIrreducibleSolubleGroupFingerprints,
    function(arg)

        local UnbindIfBound;

        UnbindIfBound := function(arg)
            local data, i;

            data := arg[1];
            i := 2;
            while i < Length(arg)  do
                if not IsBound(data[arg[i]]) then
                    return false;
                fi;
                data := data[arg[i]];
                i := i + 1;
            od;
            if IsBound(data[arg[i]]) then
                Unbind(data[arg[i]]);
                return true;
            else
                return false;
            fi;
        end;

        if Length(arg) = 0 then
            IRREDSOL_DATA.FP := [];
            IRREDSOL_DATA.FP_INDEX := [];
            IRREDSOL_DATA.FP_LOADED := [];
        elif IsPosInt(arg[1]) and Length(arg) = 1 then
            if arg[1] > 1 then
                UnbindIfBound(IRREDSOL_DATA.FP, arg[1]);
                UnbindIfBound(IRREDSOL_DATA.FP_INDEX, arg[1]);
                UnbindIfBound(IRREDSOL_DATA.FP_LOADED, arg[1]);
            fi;
        elif Length(arg) = 2 and IsPosInt(arg[1]) and IsPPowerInt(arg[2]) and arg[2] <> 1 then
            if arg[1] > 1 then
                UnbindIfBound(IRREDSOL_DATA.FP, arg[1], arg[2]);
                UnbindIfBound(IRREDSOL_DATA.FP_INDEX, arg[1], arg[2]);
                UnbindIfBound(IRREDSOL_DATA.FP_LOADED, arg[1], arg[2]);
            fi;
        else
            Error("Usage: `UnloadAbsolutelyIrreducibleSolubleGroupFingerprints( [n [, q]] )'");
        fi;
    end);

############################################################################
##
#F  LoadedAbsolutelyIrreducibleSolubleGroupFingerprints()
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(LoadedAbsolutelyIrreducibleSolubleGroupFingerprints,
    function()

        local n, p, data, fields;

        data := [];
        for n in [1..Length(IRREDSOL_DATA.FP)] do
            if IsBound(IRREDSOL_DATA.FP[n]) then
                fields := [];
                for p in [1..Length(IRREDSOL_DATA.FP[n])] do
                    if IsBound(IRREDSOL_DATA.FP[n][p]) then
                        Add(fields, p);
                    fi;
                od;
                if not IsEmpty(fields) then
                    Add(data, [n, fields]);
                fi;
            fi;
        od;
        return data;
    end);

###########################################################################
##
#E
##


local reps,tori,labels,I,II,ords,mizuno,blocks;

mizuno:=[[1,2,3,4,5,6,7,
          9,10,11,12,
          13,14,16,17,
          19,18,20,21,
          23,24,25,27,
          26,28,30,31,
          32,33,35,34,
          37,38,39,40,
          41,44,45,46,
          48,49,51,52,
          53,55,57,58,
          59,61,63,64,
          66,69,70,71,
          75,76,80,82,
          85,89,93,97],
         [8,
          15,22,29,36,
          43,42,47,50,
          54,56,60,62,
          65,67,68,72,
          73,74,77,78,
          79,81,83,84,
          86,87,88,90,
          91,92,94,95,
          96,98,99,100,
          101,102,103,104,
          105,106,107,108,
          109,110,111,112,
          114,113,115,116,
          117,118,119,120]];

reps:=[[[1,1],[2,1],[3,1],[4,1],[5,1],[6,1],[7,1],[101,1]],          # E_8
       [[1,1],[2,1],[9,1],[10,1],[5,1],[6,1],[7,1],[101,1]],         # E_8(a_1)
       [[1,1],[3,1],[2,1],[9,1],[11,1],[12,1],[13,1],[101,1]],       # E_8(a_2)
       [[8,1],[9,1],[10,1],[11,1],[16,1],[12,1],[7,1],[101,1]],      # E_7+A_1
       [[1,1],[15,1],[16,1],[17,1],[6,1],[7,1],[101,1]],             # E_7
       [[8,1],[9,1],[10,1],[11,1],[16,1],[12,1],[13,1],[102,1]],     # D_8
       [[8,1],[15,1],[16,1],[17,1],[18,1],[19,1],[7,1],[101,1]],     # E_7(a_1)+A_1
       [[1,1],[15,1],[16,1],[17,1],[24,1],[13,1],[101,1]],           # E_7(a_1)
       [[1,1],[15,1],[16,1],[17,1],[18,1],[24,1],[13,1],[102,1]],    # D_8(a_1)       ?
       [[1,1],[15,1],[16,1],[17,1],[18,1],[19,1],[103,1]],           # D_7
       [[14,1],[15,1],[21,1],[17,1],[18,1],[29,1],[19,1],[101,1]],   # E_7(a_2)+A_1
       [[20,1],[21,1],[17,1],[23,1],[24,1],[7,1],[101,1]],           # E_7(a_2)
       [[14,1],[20,1],[21,1],[22,1],[18,1],[33,1],[13,1],[102,1]],   # A_8
       [[20,1],[21,1],[28,1],[23,1],[24,1],[7,1],[101,1]],           # E_6+A_1
       [[14,1],[22,1],[23,1],[24,1],[19,1],[25,1],[35,1],[102,1]],   # D_7(a_1)
#       [[14,1],[22,1],[23,1],[24,1],[19,1],[25,1],[102,1]],          # (D_7(a_1))_2
       [[20,1],[21,1],[23,1],[24,1],[7,1],[101,1]],                  # E_6
       [[20,1],[21,1],[22,1],[23,1],[24,1],[25,1],[102,1],[103,1]],  # D_8(a_2)
       [[8,1],[28,1],[23,1],[24,1],[25,1],[30,1],[102,1]],           # D_6+A_1
       [[20,1],[21,1],[28,1],[23,1],[24,1],[10,1],[40,1],[103,1]],   # A_7
       [[20,1],[21,1],[28,1],[23,1],[24,1],[19,1],[103,1]],          # (A_7)_3
       [[20,1],[21,1],[28,1],[23,1],[31,1],[101,1],[102,1]],         # E_6(a_1)+A_1
       [[1,1],[28,1],[29,1],[30,1],[31,1],[101,1]],                  # D_6
       [[20,1],[21,1],[28,1],[29,1],[25,1],[31,1],[103,1]],          # D_7(a_2)
       [[20,1],[21,1],[23,1],[31,1],[101,1],[102,1]],                # E_6(a_1)
       [[26,1],[28,1],[27,1],[29,1],[30,1],[31,1],[102,1],[103,1]],  # D_5+A_2
#       [[26,1],[28,1],[27,1],[29,1],[30,1],[31,1],[102,1]],          # (D_5+A_2)_2
       [[20,1],[21,1],[28,1],[29,1],[30,1],[31,1],[105,1]],          # A_6+A_1
       [[28,1],[27,1],[29,1],[30,1],[31,1],[39,1],[102,1]],          # D_6(a_1)+A_1
       [[28,1],[29,1],[33,1],[31,1],[34,1],[101,1]],                 # D_6(a_1)
       [[29,1],[21,1],[20,1],[30,1],[31,1],[105,1]],                 # A_6
#       [[32,1],[33,1],[30,1],[32,1],[40,1],[101,1]],                 # D_5+A_1        ??? two times 32
       [[26,1],[29,1],[35,1],[38,1],[30,1],[44,1],[47,1],[105,1]],   # 2A_4           ? 26
       [[32,1],[37,1],[29,1],[31,1],[34,1],[105,1],[107,1]],         # A_5+A_2
       [[32,1],[37,1],[27,1],[33,1],[40,1],[36,1],[105,1]],          # A_5+2A_1
       [[32,1],[29,1],[31,1],[34,1],[106,1],[108,1]],                # D_6(a_2)
       [[30,1],[31,1],[32,1],[33,1],[101,1]],                        # D_5
       [[37,1],[33,1],[40,1],[34,1],[36,1],[41,1],[105,1]],          # D_5(a_1)+A_2   ? 26/20
       [[26,1],[27,1],[40,1],[41,1],[106,1],[107,1]],                # (A_5+A_1)'
       [[32,1],[27,1],[37,1],[33,1],[36,1],[105,1]],                 # (A_5+A_1)''
       [[37,1],[38,1],[40,1],[49,1],[41,1],[104,1],[108,1]],         # D_4+A_2
 #      [[37,1],[38,1],[40,1],[49,1],[41,1],[104,1]],                 # (D_4+A_2)_2
       [[37,1],[38,1],[40,1],[34,1],[36,1],[106,1],[107,1]],         # A_4+A_3
       [[20,1],[21,1],[49,1],[106,1],[107,1]],                       # A_5
       [[37,1],[42,1],[43,1],[44,1],[45,1],[103,1]],                 # D_5(a_1)+A_1
       [[37,1],[38,1],[39,1],[40,1],[41,1],[108,1],[109,1]],         # A_4+A_2+A_1

       [[38,1],[40,1],[39,1],[41,1],[108,1],[109,1]],       # A_4+A_2
       [[42,1],[43,1],[48,1],[49,1],[102,1]],               # D_5(a_1)
       [[47,1],[48,1],[49,1],[53,1],[101,1]],               # D_4+A_1
       [[42,1],[43,1],[44,1],[45,1],[107,1],[108,1]],       # A_4+2A_1
       [[47,1],[48,1],[49,1],[101,1]],                      # D_4
       [[42,1],[48,1],[49,1],[106,1],[107,1]],              # A_4+A_1
       [[37,1],[38,1],[39,1],[49,1],[108,1],[113,1]],       # 2A_3
       [[42,1],[48,1],[106,1],[107,1]],                     # A_4
       [[42,1],[44,1],[48,1],[49,1],[110,1],[113,1]],       # D_4(a_1)+A_2
       [[46,1],[47,1],[48,1],[49,1],[112,1],[113,1]],       # A_3+A_2+A_1
       [[46,1],[47,1],[48,1],[112,1],[116,1],[119,1]],      # A_3+A_2
#       [[46,1],[47,1],[48,1],[112,1],[116,1]],              # (A_3+A_2)_2
       [[53,1],[47,1],[48,1],[115,1],[116,1]],              # D_4(a_1)+A_1
       [[53,1],[54,1],[55,1],[112,1],[113,1]],              # A_3+2A_1
       [[47,1],[48,1],[115,1],[116,1]],                     # D_4(a_1)
       [[53,1],[54,1],[55,1],[117,1],[118,1],[119,1]],      # 2A_2+2A_1
       [[55,1],[56,1],[112,1],[113,1]],                     # A_3+A_1
       [[56,1],[57,1],[117,1],[118,1],[119,1]],             # 2A_2+A_1
       [[63,1],[106,1],[107,1]],                            # A_3
       [[56,1],[57,1],[117,1],[118,1]],                     # 2A_2
       [[60,1],[126,1],[127,1],[128,1]],                    # A_2+2A_1
       [[58,1],[59,1],[123,1],[124,1],[125,1]],             # A_2+3A_1
       [[63,1],[128,1],[129,1]],                            # A_2+A_1
       [[127,1],[130,1]],                                   # A_2
       [[63,1],[135,1],[136,1],[137,1]],                    # 4A_1
       [[141,1],[142,1],[143,1]],                           # 3A_1
       [[150,1],[151,1]],                                   # 2A_1
       [[157,1]]                                            # A_1
       ];

labels:=["E_8",
         "E_8(a_1)",
         "E_8(a_2)",
         "E_7+A_1",
         "E_7",
         "D_8",
         "E_7(a_1)+A_1",
         "E_7(a_1)",
         "D_8(a_1)",
         "D_7",
         "E_7(a_2)+A_1",
         "E_7(a_2)",
         "A_8",
         "E_6+A_1",
         "D_7(a_1)",
#         "(D_7(a_1))_2",
         "E_6",
         "D_8(a_2)",
         "D_6+A_1",
         "A_7",
         "(A_7)_3",
         "E_6(a_1)+A_1",
         "D_6",
         "D_7(a_2)",
         "E_6(a_1)",
         "D_5+A_2",
#         "(D_5+A_2)_2",
         "A_6+A_1",
         "D_6(a_1)+A_1",
         "D_6(a_1)",
         "A_6",
#         "D_5+A_1",
         "2A_4",
         "A_5+A_2",
         "A_5+2A_1",
         "D_6(a_2)",
         "D_5",
         "D_5(a_1)+A_2",
         "(A_5+A_1)'",
         "(A_5+A_1)''",
         "D_4+A_2",
#         "(D_4+A_2)_2",
         "A_4+A_3",
         "A_5",
         "D_5(a_1)+A_1",
         "A_4+A_2+A_1",

         "A_4+A_2",
         "D_5(a_1)",
         "D_4+A_1",
         "A_4+2A_1",
         "D_4",
         "A_4+A_1",
         "2A_3",
         "A_4",
         "D_4(a_1)+A_2",
         "A_3+A_2+A_1",
         "A_3+A_2",
#         "(A_3+A_2)_2",
         "D_4(a_1)+A_1",
         "A_3+2A_1",
         "D_4(a_1)",
         "2A_2+2A_1",
         "A_3+A_1",
         "2A_2+A_1",
         "A_3",
         "2A_2",
         "A_2+2A_1",
         "A_2+3A_1",
         "A_2+A_1",
         "A_2",
         "4A_1",
         "3A_1",
         "2A_1",
         "A_1",
         ];

I:=[ [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ] ];#, [  ], [  ], [  ], [  ], [  ] ];

II:=[ [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ] ];#, [  ], [  ], [  ], [  ], [  ] ];

tori:=[ [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ] ];#, [  ], [  ], [  ], [  ], [  ] ];

#blocks:=[];
blocks:=[[[55, 1], [45, 1], [39, 1], [27, 3], [19, 1], [9, 1]], [[27, 8], [25, 1], [7, 1]], [[27, 6], [25, 1], [21, 1], [19, 1], [9, 2], [3, 1]], [[27, 4], [25, 1], [19, 1], [18, 2], [15, 1], [12, 2], [9, 2], [3, 1]], [[27, 3], [26, 2], [19, 1], [18, 2], [15, 1], [12, 2], [9, 2], [1, 3]], [[27, 2], [25, 1], [21, 2], [18, 2], [15, 2], [12, 2], [9, 3], [7, 1], [3, 1]], [[27, 1], [21, 1], [19, 2], [18, 4], [15, 1], [9, 8], [3, 1]], [[27, 1], [20, 2], [19, 1], [18, 4], [15, 1], [9, 8], [1, 3]], [[19, 1], [15, 8], [9, 9], [3, 8], [2, 2]], [[23, 1], [22, 2], [19, 1], [16, 2], [15, 1], [13, 3], [12, 2], [11, 1], [10, 2], [7, 1], [4, 2], [3, 1], [1, 3]], [[19, 1], [18, 4], [15, 1], [12, 2], [9, 12], [7, 1], [3, 1]], [[19, 1], [18, 4], [15, 1], [12, 2], [9, 11], [8, 2], [1, 3]], [[19, 1], [18, 2], [15, 3], [13, 3], [9, 9], [7, 1], [6, 2], [3, 3]], [[19, 1], [15, 8], [9, 9], [3, 8], [2, 2]], [[19, 1], [17, 2], [15, 3], [12, 2], [11, 4], [9, 5], [6, 4], [3, 4], [1, 1]], [[19, 1], [15, 8], [9, 9], [3, 7], [1, 7]], [[9, 25], [8, 2], [2, 2], [1, 3]], [[19, 1], [17, 1], [16, 2], [15, 2], [12, 2], [11, 2], [10, 4], [9, 3], [6, 4], [3, 2], [2, 2], [1, 3]], [[9, 3], [7, 5], [6, 16], [5, 3], [3, 24], [1, 3]], [[9, 25], [8, 2], [2, 2], [1, 3]], [[9, 26], [7, 1], [3, 1], [2, 2]], [[19, 1], [16, 4], [15, 1], [11, 5], [10, 4], [9, 2], [6, 4], [3, 1], [1, 10]], [[9, 23], [7, 1], [6, 2], [5, 2], [4, 2], [3, 1], [1, 1]], [[9, 26], [7, 1], [1, 7]], [[9, 21], [7, 2], [6, 4], [3, 7]], [[9, 19], [8, 2], [7, 4], [6, 2], [3, 6], [1, 3]], [[9, 20], [8, 2], [7, 1], [6, 4], [3, 6], [1, 3]], [[9, 19], [8, 4], [6, 4], [3, 5], [1, 6]], [[9, 19], [7, 8], [3, 5], [1, 6]], [[9, 14], [7, 2], [6, 8], [5, 6], [3, 10]], [[9, 13], [8, 2], [7, 1], [6, 8], [5, 3], [4, 6], [3, 6], [1, 3]], [[9, 10], [7, 1], [6, 16], [3, 17], [2, 2]], [[9, 13], [7, 5], [6, 4], [5, 5], [4, 8], [3, 3], [1, 6]], [[9, 19], [7, 8], [1, 21]], [[9, 9], [8, 2], [6, 16], [3, 17], [2, 2]], [[9, 9], [8, 2], [6, 16], [3, 16], [2, 2], [1, 3]], [[9, 10], [7, 1], [6, 16], [3, 16], [1, 7]], [[9, 3], [8, 8], [7, 6], [6, 10], [3, 8], [2, 8], [1, 15]], [[9, 7], [8, 2], [7, 6], [6, 6], [5, 6], [4, 6], [3, 10], [2, 2], [1, 3]], [[9, 9], [8, 2], [6, 16], [3, 15], [1, 10]], [[9, 5], [8, 6], [7, 4], [6, 12], [3, 11], [2, 8], [1, 6]], [[9, 3], [8, 2], [7, 1], [6, 18], [5, 3], [3, 25]], [[9, 3], [7, 5], [6, 16], [5, 3], [3, 24], [1, 3]], [[9, 3], [8, 8], [7, 6], [6, 10], [3, 8], [2, 8], [1, 15]], [[9, 2], [8, 6], [7, 13], [6, 6], [3, 2], [2, 14], [1, 21]], [[9, 1], [8, 4], [7, 3], [6, 12], [5, 7], [4, 4], [3, 17], [2, 4], [1, 4]], [[9, 2], [7, 25], [3, 1], [1, 52]], [[9, 1], [8, 2], [7, 7], [6, 8], [5, 9], [4, 6], [3, 12], [2, 6], [1, 9]], [[8, 4], [7, 6], [6, 4], [5, 10], [4, 16], [3, 6], [2, 4], [1, 10]], [[9, 1], [7, 11], [5, 21], [3, 11], [1, 24]], [[7, 1], [6, 14], [5, 6], [3, 42], [1, 1]], [[7, 1], [6, 14], [5, 3], [4, 6], [3, 37], [2, 2], [1, 3]], [[7, 1], [6, 12], [5, 5], [4, 8], [3, 34], [1, 10]], [[7, 1], [6, 8], [5, 12], [4, 6], [3, 28], [2, 8], [1, 9]], [[7, 1], [6, 6], [5, 11], [4, 14], [3, 19], [2, 12], [1, 13]], [[7, 1], [6, 2], [5, 24], [3, 27], [1, 28]], [[3, 80], [2, 4]], [[7, 1], [6, 2], [5, 15], [4, 18], [3, 10], [2, 14], [1, 24]], [[3, 79], [2, 2], [1, 7]], [[7, 1], [5, 11], [4, 32], [3, 1], [1, 55]], [[3, 78], [1, 14]], [[3, 65], [2, 16], [1, 21]], [[3, 70], [2, 14], [1, 10]], [[3, 58], [2, 20], [1, 34]], [[3, 57], [1, 77]], [[3, 44], [2, 40], [1, 36]], [[3, 31], [2, 50], [1, 55]], [[3, 14], [2, 64], [1, 78]], [[3, 1], [2, 56], [1, 133]]];

#ords:=[];
ords:=[ 81, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 9, 27, 9, 9, 9, 27, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 9, 3, 9, 3, 3, 3, 3, 3, 3, 3, 3, 3 ];

return [reps,tori,labels,I,II,ords,blocks,mizuno];


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

same_params := (pat1, targ, pat2) -> pat1.target(targ).cond(e->e.params = pat2.val.params);
one_by_one := x -> x.range() = 1 and x.domain() = 1;

# does not work with .cond (!!!) NOTE
Enum(100, x->@(x), @z, @n, @m, @k, @l, @j, @g, @phi, @r, @s, @ss, @b, @bb);
Enum(200, x->@(x), @M, @N, @R, @S, @W, @F, @G, @D);

IsIndexMapping := x -> IsBound(x._perm) and x._perm;

# L^mn_n
ltensor_flip := function(match, mn, n)
    local m, i, pos, dom, ldom, lran, ll, rr, res, ldom;
    dom := Product(match, x->x.domain());
    ldom := 1; lran := 1; pos := 1;
    while lran<>n do
        lran:=lran*range(match[pos]);
        ldom:=ldom*domain(match[pos]);
	pos:=pos+1;
    od;
    ll := match{[1..pos-1]};
    rr := match{[pos..Length(match)]};
    res := fTensor(Concatenation(rr, ll));

    if ldom=1 or ldom=dom then
    return res;
    else
    return fCompose(res, L(dom, ldom));
    fi;
end;

# for given diagDirsum looking for child which relative domain start <= offset and relative domain end >= (offset + domain)
# returns [child index, offset relative to child]
_findDirsumChild := function( dirsum, offset, domain)
    local i, ch, d;
    ch := dirsum.children();
    d := 0;
    for i in [1..Length(ch)] do
        if offset >= d then
            d := d + ch[i].domain();
            if offset + domain <= d then
                return [i, offset - d + ch[i].domain()];
            fi;
        else
            return [0, 0];
        fi;
    od;
    return [0, 0];
end;

# *******************************************************************
Class(RulesFuncSimp, RuleSet);
RewriteRules(RulesFuncSimp, rec(
 # ===================================================================
 # Operator flattening and identity
 # ===================================================================
 FlattenTensor  := ARule(fTensor,  [@(1, fTensor) ], e -> @(1).val.children()),
 FlattenCompose := ARule(fCompose, [@(1, fCompose)], e -> @(1).val.children()),

 ComposeId1 := ARule(fCompose, [@(1), fId ], e -> [@(1).val]),
 ComposeId2 := ARule(fCompose, [fId,  @(1)], e -> [@(1).val]),

 fBase_1x1 := Rule(@(1, fBase, one_by_one), e->fId(1)),

 fId_drop_Value := Rule([@(1, fId), @(2, Value)], e->fId(@(2).val.v)),

 Const_fbase := ARule(fCompose, [@(1), @(2, fBase, e -> IsInt(e.params[2]))],
     e -> [ When(IsInt(@(1).val.range()),
                 fBase(@(1).val.range(), @(1).val.at(@(2).val.params[2])),
                 fConst(@(1).val.range(), 1, @(1).val.at(@(2).val.params[2]))) ]),

 Compose1x1_1 := ARule(fCompose, [@(1).cond(one_by_one), @(2)],  e -> [@(2).val]),
 Compose1x1_2 := ARule(fCompose, [@(2), @(1).cond(one_by_one) ], e -> [@(2).val]),

 TensorId1 := ARule(fTensor, [@(1), [@(2,[fId,J]), 1]], e -> [@(1).val]),
 TensorId2 := ARule(fTensor, [[@(2,[fId,J]), 1], @(1)], e -> [@(1).val]),

 TensorId1V := ARule(fTensor, [@(1), [@(2,[fId,J]), @(3, Value, e->e.v=1)]], e -> [@(1).val]),
 TensorId2V := ARule(fTensor, [[@(2,[fId,J]), @(3, Value, e->e.v=1)], @(1)], e -> [@(1).val]),

 diagTensorId1  := ARule(diagTensor, [@(1), [fConst, @(2), 1, 1]], e -> [@(1).val]),
 diagTensorIdV1 := ARule(diagTensor, [@(1), [fConst, @(2), 1, _1]], e -> [@(1).val]),
 diagTensorId2  := ARule(diagTensor, [[fConst, @(2), 1, 1], @(1)], e -> [@(1).val]),
 diagTensorIdV2 := ARule(diagTensor, [[fConst, @(2), 1, _1], @(1)], e -> [@(1).val]),

 diagTensorZero1  := ARule(diagTensor, [@(1), [fConst, @(2), 1, 0]], e -> [fConst(@(1).val.domain(), 0)]),
 diagTensorZeroV1 := ARule(diagTensor, [@(1), [fConst, @(2), 1, _0]], e -> [fConst(@(1).val.domain(), 0)]),
 diagTensorZero2  := ARule(diagTensor, [[fConst, @(2), 1, 0], @(1)], e -> [fConst(@(1).val.domain(), 0)]),
 diagTensorZeroV2 := ARule(diagTensor, [[fConst, @(2), 1, _0], @(1)], e -> [fConst(@(1).val.domain(), 0)]),

 DropL := Rule(@(1, [L,OS], e -> e.params[2] = 1 or e.params[2] = e.params[1]), e -> fId(@1.val.params[1])),
 DropTr := Rule(@(1, Tr, e -> e.params[1] = 1 or e.params[2] = 1), e -> fId(@1.val.domain())),

 IP_toI  := Rule([IP, @(2), fId], e -> fId(@(2).val)),
 J_1   := Rule([J, 1], e->fId(1)),
 OS_2  := Rule([OS, 2, @], e->fId(2)),

 OS_fAdd := ARule(fCompose, [ [OS, @(1), @(2).cond(e -> e in [@(1).val-1, -1])],
                              [fAdd, @(3), @(4).cond(e -> e = @(3).val - 1), 1] ],
     e -> [ fAdd(@(3).val, @(4).val, 1), J(@(4).val) ]),

 Lfold := ARule(fCompose, [@(1,L), @(2,L),e->let(
             prod := @(1).val.params[2] * @(2).val.params[2],
             a:=@(1).val.params[1],
             When(prod < a, prod in FactorsInt(a), (prod / a) in FactorsInt(a)))],
     e -> let(
         prod := @(1).val.params[2] * @(2).val.params[2], a:=@(1).val.params[1],
         [ L(a, When(prod < a, prod, prod / a)) ])),

 Hfold :=  ARule(fCompose, [@(1,H), @(2,H)],
     e-> [H(@(1).val.params[1],
             @(2).val.params[2],
             @(1).val.params[3]+@(2).val.params[3]*@(1).val.params[4],
             @(1).val.params[4]*@(2).val.params[4])]),

 # ===================================================================
 # Diagonal Functions
 # ===================================================================
 ComposePrecompute := Rule([fCompose, ..., [fPrecompute, @(1)], ...],
     e -> fPrecompute(ApplyFunc(fCompose, List(e.children(),
         x->When(ObjId(x)=fPrecompute, x.child(1), x))))),

 PrecomputePrecompute := Rule([fPrecompute, [fPrecompute, @(1)]], e->fPrecompute(@(1).val)),

 # drop diagDirsum when H refers to only one its child
 drop_diagDirsum_H := ARule( fCompose, [ @(1, diagDirsum), @(2, H, x -> x.params[4] = 1 and _findDirsumChild(@(1).val, x.params[3], x.params[2])[1]>0)],
     e -> let( f := _findDirsumChild(@(1).val, @(2).val.params[3], @(2).val.params[2]),
               obj := @(1).val.children()[f[1]],
               [ obj, H(obj.domain(), @(2).val.params[2], f[2], 1) ] )),

 RCData_fCompose_TReal := Rule([RCData, [@(1,fCompose), @(2).cond(e->e.range = TReal), ...]],
     e -> fCompose(RCData(@(2).val), diagTensor(fCompose(Drop(@(1).val.children(),1)), fId(2)))),

 RCData_fCompose_TInt := Rule([RCData, [@(1,fCompose), @(2).cond(e->e.range = TInt), ...]],
     e -> fCompose(RCData(@(2).val), fTensor(fCompose(Drop(@(1).val.children(),1)), fId(2)))),

# RCData_fCompose := Rule([RCData, [@(1,fCompose), @(2), ...]],
#     e -> fCompose(RCData(@(2).val), fTensor(fCompose(Drop(@(1).val.children(),1)), fId(2)))),

 RCData_Precompute := Rule([RCData, [fPrecompute, @(1)]], e->fPrecompute(RCData(@(1).val))),
 RCData_CRData     := Rule([RCData, [CRData, @(1)]], e -> @(1).val),
 CRData_RCData     := Rule([CRData, [RCData, @(1)]], e -> @(1).val),

 FConj_Precompute := Rule([@(0,[FConj,FRConj]), [fPrecompute, @(1)]], e->fPrecompute(ObjId(@(0).val)(@(1).val))),

 ComposeConstX := ARule(fCompose, [@(1,fConst), @(2)],
     e -> [fConst(@(1).val.params[1], @(2).val.domain(), @(1).val.params[3])]),

 fAdd0 := Rule([fAdd, @(1), @(2).cond(e->e=@(1).val), 0], e->fId(@(1).val)),

 fAddPair := ARule(fCompose, [@(1, fAdd), @(2, fAdd)],
     e -> [ fAdd(@(1).val.range(), @(2).val.domain(),
             @(1).val.params[3] + @(2).val.params[3]) ]),

 fTensor_fAdd_H := ARule(fTensor, [ [@(1, fAdd),@, _1, @], @(2, H)],
     e -> [ H(@(1).val.params[1] * @(2).val.params[1],
              @(2).val.params[2],
              @(2).val.params[1] * @(1).val.params[3] + @(2).val.params[3],
              @(2).val.params[4]) ]),

 # ===================================================================
 # fTensor
 # ===================================================================
 # fId(m) (X) fId(n) -> fId(m*n)
  TensorIdId := ARule(fTensor, [@(1,fId), @(2,fId)],
    e -> [ fId(@(1).val.params[1] * @(2).val.params[1]) ]),

  TensorId1 := ARule(fTensor, [@(1, fId, x->x.params[1]=1)],
    e -> []),

 # L(mn,m) o (fBase(m,j) (X) f) -> f (X) fBase(j,m)
 LTensorFlip := ARule(fCompose,
      [ @(1,L), [ @(3,fTensor), @(2).cond(e->range(e) = @(1).val.params[2] and domain(e)=1), ...] ],
 	e -> [ fTensor(Copy(Drop(@(3).val.children(), 1)), Copy(@(2).val)) ] ),

 # L(mn,n) o f (X) fBase(j,m) -> (fBase(m,j) (X) f)
 LTensorFlip1 := ARule(fCompose,
      [ @(1,L), [ @(3,fTensor), ...,
             @(2, fBase, e->range(e) = @(1).val.params[1]/@(1).val.params[2]) ]],
    e -> [fTensor(Copy(Last(@(3).val.children())), Copy(DropLast(@(3).val.children(), 1)))] ),

 L_H := ARule(fCompose, [ @(1, L), [ @(2, fTensor), @(3, fBase), @(4, fId, e->IsInt(@(1).val.params[1]/(@(1).val.params[2] * e.params[1])))] ],
    e-> [ H(@(1).val.params[1], @(4).val.params[1],
            @(4).val.params[1] * @(1).val.params[2] * imod(@(3).val.params[2], @(1).val.params[1] / (@(4).val.params[1] * @(1).val.params[2])) +
            idiv(@(3).val.params[2], @(1).val.params[1] / (@(4).val.params[1] * @(1).val.params[2])),
            @(1).val.params[2]) ]),

  Refl0_u_H0 := ARule(fCompose, [@(1, Refl0_u), @(2, H, e -> e.params[3]=0 and e.params[4]=1)], e -> [ let(
     k := @(1).val.params[1],
     H(@(1).val.range(), @(2).val.domain(), 0, k)) ]),

  Refl0_u_Hrest := ARule(fCompose, [
          @(1, Refl0_u),
          @(2, H, e -> e.params[3]=@(1).val.params[2] and e.params[4]=1),
          [fTensor, @(3,fBase), @(4, fId, e->e.params[1]=@(1).val.params[2])]],
      e -> [ let(k := @(1).val.params[1],
              BH(@(1).val.range(), 2*@(1).val.range(), @(4).val.domain(), 1+@(3).val.params[2], 2*k)) ]),

  Refl0_u_Hrest_1it := ARule(fCompose, [
          @(1, Refl0_u),
          @(2, H, e -> e.params[3]=@(1).val.params[2] and e.params[4]=1 and e.params[3]=e.params[2]) ],
      e -> [ let(k := @(1).val.params[1],
              BH(@(1).val.range(), 2*@(1).val.range(), @(2).val.domain(), 1, 2*k)) ]),

  Refl1_H := ARule(fCompose, [@(1, Refl1), [fTensor, @(2,fBase), @(3, fId, e->e.params[1]=@(1).val.params[2])]],
      e -> let(
          k := @(1).val.params[1],
          [ BH(@(1).val.range(), 2*@(1).val.range() - 1, @(3).val.domain(), @(2).val.params[2], 2*k) ])),

  fTensor_X_fId_H := ARule(fCompose, [[@(1, fTensor), ..., [fId, @(2)]], # NOTE: assumes d|base
        [@(3, H), @(4).cond(e->_divides(@(2).val,e)), @(5).cond(e->_divides(@(2).val,e)),
                  @(6).cond(e->_divides(@(2).val,e)), _1]], e ->
       let(p := @(3).val.params, d := @(2).val, base := p[3],
           [ @(1).val, fTensor(H(p[1]/d, p[2]/d, base/d, 1), fId(d)) ])),

 TrTensor := ARule(fCompose, [@(1, Tr), [ fTensor, @(2), @(3).cond(e->e.range()=@(1).val.params[1]) ]],
     e -> [ fCompose(fTensor(@(3).val, @(2).val), Tr(@(3).val.domain(), @(2).val.domain())) ]
 ),

 LTensorGeneral := ARule(
fCompose,
[@(1,[L,Tr]),
 @(2,fTensor,
 e -> let(
    p := @(1).val.params,
    a := When(ObjId(@(1).val)=Tr, p[1], p[1]/p[2]),
    b := p[2],
    ForAll(e.children(), x->AnySyms(x.domain(), x.range()) or x.domain()>1 and x.range()>1) and # workaround old fId(1) bug
    full_merge_tensor_chains(@(3), [b, a], e.children(), (x,y)->y,
 Product, fTensor,
                             fId, x->x, x->x, range) <> false))],
     e -> [ ltensor_flip(@(3).val, @(1).val.params[1], @(1).val.params[2]) ]
 ),

 # fTensor o fTensor -> fTensor( ..o.., ..o.. , ...)
 TensorMerge := ARule(fCompose,
      [ @(1,fTensor), @(2,fTensor,e->full_merge_tensor_chains(
          @(3), @(1).val.children(), e.children(),
                fCompose, fTensor, fTensor, x->x, x->x, domain, range) <> false) ],
 e -> [ fTensor(@(3).val) ]
 ),

 TensorMerge_fIdInt := ARule(fCompose,
      [ @(1,fTensor,e->let(l1:=Last(e.children()), ObjId(l1)=fId and IsInt(l1.domain()))),
        @(2,fTensor, e->let(l1:=Last(@(1).val.children()), l2 := Last(e.children()), IsInt(l2.domain()) and ObjId(l2)=fId and Gcd(l1.domain(), l2.domain())>1))],
        e -> let(l1 := Last(@(1).val.children()).domain(), l2 := Last(@(2).val.children()).domain(), gcd := Gcd(l1, l2),
            [ fTensor(fCompose(fTensor(DropLast(@(1).val.children(), 1), fId(l1/gcd)), fTensor(DropLast(@(2).val.children(), 1), fId(l2/gcd))), fId(gcd)) ])
    ),

 # diagTensor o fTensor -> diagTensor( ..o.., ..o.. , ...)
 diagTensorMerge := ARule(fCompose,
      [ @(1,diagTensor), @(2,fTensor,e->full_merge_tensor_chains(
          @(3), @(1).val.children(), e.children(),
                fCompose, diagTensor, fTensor, x->x, x->fConst(range(x), 1), domain, range) <> false) ],
 e -> [ diagTensor(@(3).val) ]
 ),

 # fTensor(..., Y, ...) o X -> fTensor(..., Y o X, ...)
 TensorComposeMergeRight := ARule(fCompose,
      [ @(1,fTensor), @(2).cond(e -> compat_tensor_chains(
                                @(1).val.children(), [e], domain, range)) ],
 e -> [ fTensor(merge_tensor_chains(
         @(1).val.children(), [@(2).val], fCompose, x->x, x->x, domain, range)) ]
 ),

 # X o fTensor(..., Y, ...) -> fTensor(..., X o Y, ...)
 TensorComposeMergeLeft := ARule(fCompose,
      [ @(1), @(2,fTensor,e-> IsInt(@(1).val.range()) and compat_tensor_chains(  # NOTE: BAD HACK!!! Cannot do that with diag functions...
                             [@(1).val], e.children(), domain, range)) ],
 e -> [ fTensor(merge_tensor_chains(
         [@(1).val], @(2).val.children(), fCompose, x->x, x->x, domain, range)) ]
 ),

 # [fBase,fId] X (fB o fAny) -> fB2 o (fI X fAny)
 TensorB := ARule(fTensor, [
        @(1, [fBase, fId], e -> Is2Power(e.range())),
        @(2, fCompose, e -> ObjId(e.child(1)) = fB)
    ],
    e -> [fCompose(
        let(i := @(1).val,
            b := @(2).val.child(1),
            fB(i.range() * b.range(), List(b.params[3], e -> Log2Int(i.range()) + e))
        ),
        fTensor(
            @(1).val,
            @(2).val.child(2)
        )
    )]
 ),

 # ===================================================================
 # Other
 # ===================================================================

 # primitive constant folding for functions
 Compose_FList_const := ARule(fCompose, [@(1, FList), @(2).cond(x->x.free()=[])],
     e -> let(
	 lst := @(1).val,  idx := List(@(2).val.tolist(), EvalScalar),
	 [ FList(lst.t, lst.list{1+idx}) ])),

 # fCond o f  (note: fCond o fCond should only be handled by Compose_fCond_lft)
 Compose_fCond_rt := ARule(fCompose, [[fCond, @(1), @(2), @(3)], @(4).cond(e->ObjId(e)<>fCond)],
     e -> [ fCond(fCompose(@(1).val, @(4).val), fCompose(@(2).val, @(4).val), fCompose(@(3).val, @(4).val)) ]),

 Compose_fCond_lft := ARule(fCompose, [@(4), [fCond, @(1), @(2), @(3)]],
     e -> [ fCond(@(1).val, fCompose(@(4).val, @(2).val), fCompose(@(4).val, @(3).val)) ]),

 fCond_fold0  := Rule([fCond, [fConst, @, @,  0], @(2), @(3)], e -> @(3).val),
 fCond_foldV0 := Rule([fCond, [fConst, @, @, _0], @(2), @(3)], e -> @(3).val),

 fCond_fold1  := Rule([fCond, [fConst, @, @,  1], @(2), @(3)], e -> @(2).val),
 fCond_foldV1 := Rule([fCond, [fConst, @, @, _1], @(2), @(3)], e -> @(2).val),

 # B2 o fTensor

    fCompose_B2_fTensor := ARule(fCompose, [@(1,B2), @(2,fTensor)],
        e -> [fB2(@(1).val.getES(), @(2).val.children())]
    ),

 # L(abc,b) o L(abc,c) -> L(abc,bc)
 fCompose_Tr := ARule( fCompose, [ [@(1, [Tr, L]), @, @(2)], [@(3, [Tr, L]), @, @(4).cond( x -> let( abc := @(1).val.range(), @(3).val.domain() = abc and (abc mod (@(2).val*x) = 0)))]],
     e -> let( abc := @(1).val.range(), bc := @(2).val*@(4).val,
         When( ObjId(@(1).val) = L, [L(abc, bc)], [Tr(abc/bc, bc)] ))),

 fDirsum_fIds := ARule( fDirsum, [@(1, fId), @(2, fId)], e -> [fId(@(1).val.range()+@(2).val.range())]),

));


# Copyright 2018-2019, Carnegie Mellon University
# See LICENSE for details

Class(SIMDchain, chain);

update_opts_params:= function(opts, new_param)
   opts.params := opts.params::[new_param];
end;

update_opts_includes:= function(opts, new_param)
   opts.includes := opts.includes::[new_param];
end;

Class(HCOLFuncGen, rec(
    generate := (self, ss, opts) >>  let(
          err_chk := When(opts.errorCheck,
            let( x:= var.fresh_t("x", T_Real(32)), j := Ind(1),
                 ch := List(Filtered(opts.params, v->v.t in [T_Real(32), T_Real(64)]),
                                        vv-> PointWise(1, Lambda([x, j], cond(isinf(vv), 1, cond(isnan(vv), 2, 0))))),
                 n := Length(ch),
                 t :=
                 OLCompose(
                    VStack(
                        Reduction(n, (a, b)->add(a, b), V(0), False),
                        I(n)
                    ),
                    VStack(    ch )
                 ),
                 tt := Rewrite(SumsSPL(t, opts), [RulesSumsHCOL, RulesTerminateReductionHCOL, RulesSumsHCOL], opts),
                 rtn_var := var("err", TPtr(TBool)), rtn := var("err_rtn", TBool),
                 update_opts_params(opts, rtn_var),
                 update_opts_includes(opts, "<math.h>"),
                 decl([rtn],
                    chain(
                      SubstBottomUp(opts.codegen.OLCompose(tt, rtn_var, self.getX(opts), opts),
                                    [nth, @(4, var, e->e.id = rtn_var.id), @(5, Value, e->e.v=0)], e->rtn),
                      creturnCond(neq(rtn, 0), -2)
                 ))),
            chain([])),

          code := opts.codegen.(ss.name)(ss, self.getY(opts), self.getX(opts), opts),

          finalCode := When(opts.useCReturn,
                let( w:= var.fresh_t("w", self.getRetType(opts)),
                     decl([w],
                        chain(
                            When(opts.errorCheck, err_chk, chain([])),
                            SIMDchain(
                                SubstBottomUp(code,
                                    [nth, @(2, var, e->e.id = self.getY(opts).id),
                                          @(3, Value, e->e.v=0)], e->w),
                               creturn(w))))),
             SIMDchain(err_chk, code)),

        func(self.getRetType(opts), "transform", self.getParams(finalCode, opts), finalCode)) ,

        getParams := (self, fc, opts) >> let(

            y := self.getY(opts), x := self.getX(opts),
            usedX := Length(Collect(fc, @(1, var, e->e.id=x.id)))>0,
            Cond(
                opts.useCReturn and not usedX,       opts.params,
                not opts.useCReturn and not usedX,   [y]::opts.params,
                opts.useCReturn and usedX,           [x]::opts.params,
                not opts.useCReturn and usedX,       [y, x]::opts.params
        )
    ),
    getRetType := (self, opts) >> When(opts.useCReturn, opts.YType.t, TVoid),
    getX :=  (self, opts) >> CopyFields(X, rec(t:=opts.XType)),
    getY :=  (self, opts) >> CopyFields(Y, rec(t:=opts.YType))
));