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

Declare(ICompose, ISum, fTensor, fBase, fId, fCompose);
Declare(RC);

# ===========================================================================
# SPL Sums Notation
# ===========================================================================
# Blk - block
# Blk1 - 1x1 block
# Data(var, value, expr) - data
# ISum - iterative sum
# SUM - sum
#
# Gath(N,n,func) - gather matrix
# Scat(N,n,func) - scatter matrix
# Prm(N, read_func, write_func) - read: output->input, write: input->output
# Conj, ConjL, ConjR, ConjLR - generalized conjugation (arbitrary/no matrix to left and right)
# ConjDiag to conjugate block diagonals
# ===========================================================================

Class(SumsBase, rec(
    isSums := true,
    area := self >> Sum(self.children(), x->x.area()),
    sums := meth(self)
       local children, i, res;
       res := Copy(self);
       children := Map(res.rChildren(), c -> Cond(IsSPL(c), c.sums(), c));
       for i in [1..Length(children)] do
           res.rSetChild(i, children[i]);
       od;
       return res;
    end
));

Compose.area   := self >> Sum(self.children(), x->x.area());
Diag.area      := self >> Rows(self);
Scale.area     := self >> 0;
IsSumsSPL := o -> IsRec(o) and
                ((IsBound(o.isSums) and o.isSums) or
                 (Same(ObjId(o), Compose) and ForAll(o.children(), IsSumsSPL)));

# ==========================================================================
# TCast(<n>, <to_type>, <from_type>) - type conversion on <n> elements
# ==========================================================================
Class(TCast, SumsBase, Sym, rec(
    abbrevs := [
        (n, to_type)            -> Checked(IsPosInt0Sym(n), IsType(to_type), [n, to_type, TUnknown]),
        (n, to_type, from_type) -> Checked(IsPosInt0Sym(n), IsType(to_type), [n, to_type, from_type])
    ],
    def := (n, to_type, from_type) -> Perm((), n),
    dmn := self >> [ TArray(self.params[3], self.params[1]) ],
    rng := self >> [ TArray(self.params[2], self.params[1]) ],

    transpose := self >> self,
    conjTranspose := self >> self,
    inverse := self >> self,
    isSymmetric := True,
    isPermutation := False,
));

# ==========================================================================
# BB(<spl>) - basic block container, serves as barrier for rule application
# ==========================================================================
Class(BB, SumsBase, BaseContainer, rec(isBlock:=true,
    rng := meth(self) return self._children[1].rng(); end,
    dmn := meth(self) return self._children[1].dmn(); end,
));

Class(Buf, SumsBase, BaseContainer, rec(
    rng := meth(self) return self._children[1].rng(); end,
    dmn := meth(self) return self._children[1].dmn(); end
));

Declare(PushL, PushR, PushLR, NoPullLeft, NoPullRight);

# Forces propagation into *left* construct (e.g. ISum, RecursStep, BB, etc)
# Also .sums() conversion always returns same object, ie conversion of
# child is not forced. This is done to avoid Sigma-SPLizing constructs
# that we want to pull in .
Class(PushL, Buf, rec(
    sums := self >> self,
    transpose := self >> PushR(self.child(1).transpose()),
    normalizedArithCost := self >> self.child(1).normalizedArithCost(),
));

# Forces propagation into *right* construct (e.g. ISum, RecursStep, BB, etc)
# Also .sums() conversion always returns same object, ie conversion of
# child is not forced. This is done to avoid Sigma-SPLizing constructs
# that we want to pull in .
Class(PushR, Buf, rec(
    sums := self >> self,
    transpose := self >> PushL(self.child(1).transpose()),
    normalizedArithCost := self >> self.child(1).normalizedArithCost(),
));

# Allows propagation into either right or left construct (e.g. ISum, RecursStep, BB, etc)
# Also .sums() conversion always returns same object, ie conversion of
# child is not forced. This is done to avoid Sigma-SPLizing constructs
# that we want to pull in .
Class(PushLR, Buf, rec(sums := self >> self));

# Prevents propagation into constructs on both sides (e.g. ISum, RecursStep, BB, etc)
Class(NoPull, Buf);

# Prevents pull-in. Used for distributed stuff.
Class(NoPull_Dist, Buf);

# Prevents propagation pulling in of diags
Declare(NoDiagPullinRight);
Class(NoDiagPullin, Buf);
Class(NoDiagPullinLeft, Buf, rec(
    transpose := self >> NoDiagPullinRight(self.child(1).transpose())
));
Class(NoDiagPullinRight, Buf, rec(
    transpose := self >> NoDiagPullinLeft(self.child(1).transpose())
));

# Prevents propagation into left construct (e.g. ISum, RecursStep, BB, etc)
Class(NoPullLeft, Buf, rec(transpose := self >> NoPullRight(self.child(1).transpose())));

# Prevents propagation into right construct (e.g. ISum, RecursStep, BB, etc)
Class(NoPullRight, Buf, rec(transpose := self >> NoPullLeft(self.child(1).transpose())));

# Top level wrapper for Sigma-SPL formulas
Class(Formula, BaseContainer, SumsBase);

#F RecursStep(<expr>)
#F RecursStep(<yofs>, <xofs>, <expr>) - with implicit
#F     fAdd on Gath (xofs) and Scat (yofs) side
#F
Class(RecursStep, SumsBase, BaseContainer, rec(
    abbrevs := [ ch -> [0,0,ch],
                 (yofs,xofs,ch) -> [yofs, xofs, ch] ],
    new := (self, yofs, xofs, ch) >> SPL(WithBases(self,
    rec(yofs:=yofs, xofs:=xofs, _children := [ch], dimensions := ch.dims()))),
    rChildren := self >> [self.yofs, self.xofs, self._children[1]],
    rSetChild := meth(self, n, what)
        if n=1 then self.yofs := what;
        elif n=2 then self.xofs := what;
        elif n=3 then self._children[1] := what;
        else Error("<n> must be in [1..3]");
        fi;
    end,
));

Class(Inplace, SumsBase, BaseContainer, rec(
  rng:=self>>self._children[1].rng(),
  dmn:=self>>self._children[1].dmn(),
  numops:=self >>0, # YSV: what is this? pls remove or document
  toNonInplace := self >> self._children[1],
  isInplace := self >> true,
  normalizedArithCost := self >> self._children[1].normalizedArithCost(),
));

Class(LStep, SumsBase, BaseContainer, rec(
    toAMat := self >> AMatMat(Sum([I(Rows(self)), self.child(1)], MatSPL))
));

Declare(RTWrap); # to avoid complaints in .transpose

Class(RTWrap, SumsBase, BaseContainer, rec(
    new := (self, rt) >> Checked(Global.formgen.IsRuleTree(rt),
    SPL(WithBases(self, rec(
        rt   := rt,
        root := rt.node))).setDims()),

    area := self >> Rows(self) * Cols(self),
    children := self >> [self.rt],
    child := (self, n) >> When(n=1, self.rt, Error("<n> must be 1")),
    setChild := rSetChildFields("rt"),
    rSetChild := ~.setChild,
    rChildren := ~.children,

    dims          := self >> self.rt.dims(),
    isPermutation := self >> self.rt.node.isPermutation(),
    isReal        := self >> self.rt.node.isReal(),
    toAMat        := self >> self.rt.node.toAMat(),

    transpose     := self >> RTWrap(self.rt.transpose()),
    conjTranspose := self >> InertConjTranspose(self),
    isInertConjTranspose := True,
));

# ==========================================================================
# COND(<spl>) - This is a 'switch' statement for SPLs
# ==========================================================================
Class(COND, SumsBase, BaseContainer, rec(
    abbrevs := [ arg -> let(f:=Flat(arg), [f[1], Drop(f, 1)]) ],
    new := (self, cond, spls) >> SPL(WithBases(self, rec(
        _children := spls,
        dimensions := spls[1].dimensions,
        cond := cond))),

    toAMat := self >> When(self.cond.ev()=V(true) or self.cond.ev()=1,
        self.child(1).toAMat(),
        self.child(2).toAMat()),

    rChildren := self >> Concatenation([self.cond], self._children),
    rSetChild := meth(self, n, newC)
        if n = 1 then self.cond := newC;
        else self.setChild(n-1, newC);
        fi;
    end,

    area := self >> Maximum(List(self.children(), x->x.area())),

    sums := self >> CopyFields(self, rec(_children := List(self._children, x->x.sums()))),
    transpose := self >> CopyFields(self, rec(_children := List(self._children, x->x.transpose()))),
));

Class(RC, SumsBase, BaseContainer, rec(
    dims := self >> let(d:=self.child(1).dims(), [2*d[1], 2*d[2]]),
    isReal := self >> true,

    # when RC(M) is transposed with M - complex, not only M is transposed, but also
    # each complex element of M as a 2x2 matrix is transposed == complex conjugation
    transpose := self >> CopyFields(self, rec(_children := [self.child(1).conjTranspose()],
        dimensions := [self.dimensions[2], self.dimensions[1]])),

    # RC(.) is real, conjTranspose is just a regular transpose
    conjTranspose := self >> self.transpose(),
    inverse := self >> CopyFields(self, rec(_children := [self.child(1).inverse()],
        dimensions := [self.dimensions[2], self.dimensions[1]])),

    sums := self >> CopyFields(self, rec(_children := [self.child(1).sums()])),
    area := self >> 2*self.child(1).area(),
    toAMat := self >> AMatMat(RealMatComplexMat(MatSPL(self.child(1)))),
    createCode := self >> Cond(IsBound(self.child(1).createCode), RC(self.child(1).createCode()), self),

    # assume that normalizedArithCost() always returns cost in real ops
    normalizedArithCost := self >> self.child(1).normalizedArithCost(),

));

# This takes a real matrix that can be seen as RC(A) and returns A as complex matrix
Class(CR, SumsBase, BaseContainer, rec(
    dims := self >> List(self.child(1).dimensions, e -> _unwrap(div(e,2))),

    # the derived matrix is real, but over the complex field
    isReal := self >> false,

    transpose := self >> CopyFields(self, rec(
	_children := [self.child(1).transpose()],
        dimensions := [self.dimensions[2], self.dimensions[1]])),

    # CR(.) is complex, but all entries are real, conjTranspose is just a regular transpose
    conjTranspose := self >> self.transpose(),

    inverse := self >> CopyFields(self, rec(_children := [self.child(1).inverse()],
        dimensions := [self.dimensions[2], self.dimensions[1]])),

    sums := self >> CopyFields(self, rec(_children := [self.child(1).sums()])),

    area := self >> 1/2*self.child(1).area(),

    toAMat := self >> let(mat := MatSPL(self.child(1)),
        rmat := List(mat{2*[1..Length(mat)/2]}, m -> m{2*[1..Length(m)/2]}),
        AMatMat(rmat)
        ),

    # assume that normalizedArithCost() always returns cost in real ops
    normalizedArithCost := self >> self.child(1).normalizedArithCost(),
    vcost := self >> self.child(1).vcost()

));

# ==========================================================================
# Blk(<mat>) - matrix block
# ==========================================================================
# Note: Blk should not check for M being a matrix,
#   otherwise cant reuse Blk for vector code
Class(Blk, SumsBase, Mat, rec(
    new := (self, M) >> SPL(WithBases(self, rec(
            element := M,
            TType   := Cond( # NOTE: add checks to M
                            IsList(M),     UnifyTypes(List(Flat(M), InferType)),
                            IsValue(M),    M.t.t,
			    IsSymbolic(M), M.t.t),
			))).setDims(),
    area := self >> Length(Filtered(Flat(self.element), k -> k<>0)),
    new  := (self, M) >> SPL(WithBases(self, rec(element := M))).setDims(),
    dims := self >> Dimensions(self.element)
));

# ==========================================================================
# Blk1(<val>) - 1x1 block
# ==========================================================================
Class(Blk1, SumsBase, BaseMat, rec(
    # Compare mathematically Blks disregarding differences in way to express code-level elements.
#    new := (self, val) >> SPL(WithBases(self, rec(dimensions:=[1,1], element:=val))),
#    toAMat := self >> AMatMat([[EvalScalar(Eval(self.element))]]),
    new := (self, val) >> SPL(WithBases(self, rec(dimensions:=[1,1], element:=EvalScalar(Eval(val))))),
    toAMat := self >> AMatMat([[self.element]]),
    transpose := self >> self,
    conjTranspose := self >> CopyFields(self, rec(element := Global.Conjugate(self.element))),
    inverse := self >> CopyFields(self, rec(element := 1 / self.element)),
    area := self >> 1,
    dims := self >> [1,1],
));

# ==========================================================================
# BlkConj() - pseudo 1x1 matrix when multiplied w/ complex number conjugates it
# ==========================================================================
Class(BlkConj, SumsBase, BaseMat, rec(
    rChildren := self >> [],
    rSetChild := (self, n, what) >> Error("no children"),
    new := (self) >> SPL(WithBases(self, rec(dimensions:=[1,1]))),
    toAMat := self >> AMatMat([[1]]),
    transpose := self >> self,
    conjTranspose := self >> self,
    inverse := self >> self,
    area := self >> 1
));

# ==========================================================================
# Data(<var>, <value>, <spl>) - introduces a data constant bound in <spl>
# ==========================================================================
Class(Data, SumsBase, BaseContainer, rec(
    new := (self, var, value, spl) >> Checked(IsVar(var), IsSPL(spl),
	SPL(WithBases(self, rec(
	    var := var, value := value, _children := [spl],
            dimensions := spl.dims())))),
    #-----------------------------------------------------------------------
    area := self >> self.child(1).area(),
    #-----------------------------------------------------------------------
    eval := meth(self)
        local d, c;
        if IsBound(self._evaluated) then return self._evaluated;
        else
            d := Cond(
                IsValue(self.value) or IsSymbolic(self.value), self.value,
                IsBound(self.value.tolist), V(self.value.tolist()),
                IsSPL(self.value), V(MatSPL(self.value)),
                self.value);
            c := Copy(self._children[1]);
            self._evaluated := SubstBottomUp(c, @(1, var, e->Same(e,self.var)), e -> d);
            return self._evaluated;
        fi;
    end,

    rChildren := self >> [self.var, self.value, self.child(1)],
    rSetChild := meth(self, n, newC)
        if n=1 then self.var := newC;
        elif n=2 then self.value := newC;
        elif n=3 then self._children[1] := newC;
        else Error("<n> must be between [1..3]");
        fi;
    end,
    from_rChildren := (self, rch) >> CopyFields(self, rec(
        var := rch[1], value := rch[2], _children := [rch[3]])),
    #-----------------------------------------------------------------------
    uneval := meth(self) Unbind(self._evaluated); return self; end,
    #-----------------------------------------------------------------------
    transpose := self >> CopyFields(self, rec(
        _children := [self.child(1).transpose()])).uneval(),
    #-----------------------------------------------------------------------
    toAMat := self >> self.eval().toAMat(),
    #-----------------------------------------------------------------------
    sums := self >> CopyFields(self, rec(_children := [self.child(1).sums()])),
));

Declare(Scat);

#F ==========================================================================
#F Gath(<func>) - gather (read) matrix
#F NOTE: implements affine transformations via funcExp hack.

#F as of Dec '2010, <func> can contain fInsert/fPad, which will create
#F funcExp(..) in the code. This is used for simulating affine (rather
#F than linear) transformation.
#F
#F Affine transformations can only be experessed using matrices, if we
#F use homogeneous coordinates, i.e., instead of [x_1, ..., x_n] use
#F always [x_1, ..., x_n, 1], for input/output vectors
#F
#F Gath.toAMat and everything else does NOT use homogeneous
#F coordinates, and thus we can't represent affine "gathers" with a
#F proper matrix, the only special case is when funcExp(0) is used to
#F insert 0s (this preserves linearity).
#F
#F Currently, we use the following semantics (to implement affine transf. using a hack)
#F
#F  nth(X, i)          == X[i]
#F  nth(X, funcExp(i)) == i
#F
#F The proper way of doing this would be instead (using h. coords, X[len(x)] = 1)
#F nth(X, funcExp(i)) -> i * nth(X, len(X)) = i * X[len(X)] = i
#F
#F See http://en.wikipedia.org/wiki/Transformation_matrix#Affine_transformations
# ==========================================================================
Class(Gath, SumsBase, BaseMat, rec(
    #-----------------------------------------------------------------------
    rChildren := self >> [self.func],
    rSetChild := rSetChildFields("func"),
    #-----------------------------------------------------------------------
    new := (self, func) >> SPL(WithBases(self, rec(
      	func := Checked(IsFunction(func) or IsFuncExp(func), func)))).setDims(),
    #-----------------------------------------------------------------------
    dims := self >> [self.func.domain(), self.func.range()],
    sums := self >> self,
    area := self >> Sum(Flat([self.func.domain()])),
    isReal := self >> true,
    transpose := self >> Scat(self.func),
    conjTranspose := self >> self.transpose(),
    inverse := self >> self.transpose(),
    #-----------------------------------------------------------------------
    toAMat := self >> let(
	n := EvalScalar(self.func.domain()),
        N := EvalScalar(self.func.range()),
        func := self.func.lambda(),
        AMatMat(List([0..n-1], row -> let(
            idx := EvalScalar(func.at(row)),
	    Cond(idx _is funcExp,
		     When(idx.args[1]=0, Replicate(N, 0),
			 Error("<self> is an affine (non-linear) transformation ",
			       "and can't be represented as a matrix")),
		 BasisVec(N, idx)))))
    ),
    #-----------------------------------------------------------------------
    toloop := (self, bksize) >> let(
	i := Ind(self.func.domain()),
	ISum(i,
            Scat(fTensor(fBase(i), fId(1))) *
            Gath(fCompose(self.func, fTensor(fBase(i), fId(1))))
	).split(bksize)
    ),
    #-----------------------------------------------------------------------
    normalizedArithCost := self >> 0,
    #-----------------------------------------------------------------------
    isIdentity := self >> IsIdentity(func),
));

#F ==========================================================================
#F Prm(<func>) - permutation, semantically same as Gath(<func>), but square
#F
#F NB: Prm should not be used with fPad/fInsert, which lead to affine
#F     transformations when used with Gath.
#F
#F Prm(f).transpose() = Prm(f.transpose())
#F
#F ==========================================================================
Class(Prm, Gath, rec(
    transpose := self >> CopyFields(self, rec(func:=self.func.transpose())),
    toAMat := self >> Perm(PermList(List(self.func.lambda().tolist(), e->e.v)+1),
                           self.func.domain()).toAMat(),
    #-----------------------------------------------------------------------
    normalizedArithCost := self >> 0
));

#   special perm to be gotten rid of in rewriting
Class(DelayedPrm, Prm);
Class(FormatPrm, Prm);

#F ==========================================================================
#F Scat(<func>) - scatter (write) matrix,  Scat(f) = Gath(f).transpose()
#F
#F NOTE: implements affine transformations via funcExp workaround.
#F        See Doc(Gath) for explanation
#F ==========================================================================
Class(Scat, SumsBase, BaseMat, rec(
    #-----------------------------------------------------------------------
    rChildren := self >> [self.func],
    rSetChild := rSetChildFields("func"),
    #-----------------------------------------------------------------------
    new := (self, func) >> SPL(WithBases(self, rec(
	func := Checked(IsFunction(func) or IsFuncExp(func), func)))).setDims(),
    #-----------------------------------------------------------------------
    dims := self >> [self.func.range(), self.func.domain()],
    sums := self >> self,
    area := self >> Sum(Flat([self.func.domain()])),
    isReal := self >> true,
    transpose := self >> Gath(self.func),
    conjTranspose := self >> self.transpose(),
    inverse := self >> self.transpose(),
    #-----------------------------------------------------------------------
    toAMat := self >> TransposedAMat(Gath(self.func).toAMat()),
    #-----------------------------------------------------------------------
    toloop := (self, bksize) >> Gath(self.func).toloop(bksize).transpose(),
    #-----------------------------------------------------------------------
    normalizedArithCost := self >> 0,
    #-----------------------------------------------------------------------
    isIdentity := self >> IsIdentity(self.func),
));

Class(ScatAcc, Scat, rec(
    codeletName:="SA",
    toloop := (self, bksize) >> Error("Not implemented")
));

Declare(ScatGath);

# ==========================================================================
# ScatGath(<sfunc>, <gfunc>)
# ==========================================================================
Class(ScatGath, SumsBase, BaseMat, rec(
    rChildren := self >> [self.sfunc, self.gfunc],
    rSetChild := rSetChildFields("sfunc", "gfunc"),
    #-----------------------------------------------------------------------
    new := (self, sfunc, gfunc) >> SPL(WithBases(self,
        rec(dimensions := [sfunc.range(), gfunc.range()],
	    sfunc := Checked(IsFunction(sfunc) or IsFuncExp(sfunc), sfunc),
	    gfunc := Checked(IsFunction(gfunc) or IsFuncExp(gfunc), gfunc)))),
    #-----------------------------------------------------------------------
    dims := self >> [self.sfunc.range(), self.gfunc.range()],
    area := self >> self.sfunc.domain(),
    isReal := self >> true,
    transpose := self >> ScatGath(self.gfunc, self.sfunc),
    conjTranspose := self >> self.transpose(),
    inverse := self >> self.transpose(),
    #-----------------------------------------------------------------------
    toAMat := meth(self)
        local s, gfunc, g, sdomain, gdomain, idx;
        # NOTE: FF: this is a temporary solution to work around Lamda
	#        problems with symbolic domains and variable substitution
        s := Scat(self.sfunc);
        sdomain := EvalScalar(self.sfunc.domain());
        gdomain := spiral.code.RulesStrengthReduce(self.gfunc.domain());
        if ObjId(self.gfunc) = Lambda and IsExp(gdomain) then
            idx := Ind(sdomain);
            gfunc := Lambda(idx, self.gfunc.at(idx)).setRange(self.gfunc.range());
        else
            gfunc := self.gfunc;
        fi;
        g :=Gath (gfunc);
        return s.toAMat() * g.toAMat();
    end,
       # Correct semantics: Scat(self.sfunc).toAMat() * Gath(self.gfunc).toAMat(),
    #-----------------------------------------------------------------------
    sums := self >> self, #self.toloop(self.maxBkSize()),
    #-----------------------------------------------------------------------
    maxBkSize := meth(self)
        local exp, l, d;
        exp := self.gfunc.domain();

        if IsValue(exp) or IsInt(exp) then return exp; fi;

        if IsExp(exp) and ObjId(exp)=mul and IsValue(exp.args[1]) then
            return exp.args[1];
        fi;

        if IsInt(exp.eval()) or IsValue(exp.eval()) then return EvalScalar(exp); fi;
        l := Lambda(Filtered(exp.free(), IsLoopIndex), exp);
        if Length(l.vars) > 1 then return 1; fi;
        d := List(spiral.sigma.GenerateData(l).tolist(), EvalScalar);
        return Gcd(d);
    end,
    #-----------------------------------------------------------------------
    toloop := (self, bksize) >> let(
	i := Ind(self.gfunc.domain()),
        ISum(i,
            Scat(fCompose(self.sfunc, fTensor(fBase(i), fId(1)))) *
            Gath(fCompose(self.gfunc, fTensor(fBase(i), fId(1))))
        ).split(bksize)
    )
));

# ==========================================================================
# SUM(<spl1>, <spl2>, ...) - non-overlapping matrix sum
# ==========================================================================
Declare(SUM, SUMAcc);
Class(SUM, SumsBase, BaseOperation, rec(
    area := self >> Sum(self.children(), x->x.area()),
    abbrevs := [ arg ->
    [ Flat(List(Flat(arg),
        s -> When(IsSPL(s) and Same(ObjId(s), SUM), s.children(), s))) ] ],
    #-----------------------------------------------------------------------
    new := meth(self, L)
        local dims;
        Constraint(Length(L) >= 1); Constraint(ForAll(L, IsSPL));
        if Length(L) = 1 then return L[1]; fi;
        dims := L[1].dims();
        if not (IsSymbolic(dims[1]) or IsSymbolic(dims[2])) and
           not ForAll(Drop(L, 1), x -> let(d:=x.dims(),
                   IsSymbolic(d[1]) or IsSymbolic(d[2]) or d = dims))
            then Error("Dimensions of summands do not match"); fi;
        return SPL(WithBases(self, rec( _children := L, dimensions := dims)));
    end,
    #-----------------------------------------------------------------------
    rng := self >> self.child(1).rng(),
    #-----------------------------------------------------------------------
    dmn := self >> self.child(1).dmn(),

    advdims := self >> self._children[1].advdims(),
    #-----------------------------------------------------------------------
#    dims := self >> self.child(1).dimensions,
    #-----------------------------------------------------------------------
    toAMat := self >> AMatMat(Sum(self._children, MatSPL)),
    #-----------------------------------------------------------------------
    isPermutation := self >> false,
    #-----------------------------------------------------------------------
    transpose := self >>   # we use CopyFields to copy all fields of self
        CopyFields(self, rec(
           _children := List(self._children, x->x.transpose()),
           dimensions := Reversed(self.dimensions))),
    inverse := self >>   # we use CopyFields to copy all fields of self
        CopyFields(self, rec(
           _children := List(self._children, x->x.inverse()),
           dimensions := Reversed(self.dimensions))),
    conjTranspose := self >>   # we use CopyFields to copy all fields of self
        CopyFields(self, rec(
           _children := List(self._children, x->x.conjTranspose()),
           dimensions := Reversed(self.dimensions)))
));

# ==========================================================================
# SUMAcc(<spl1>, <spl2>, ...) - overlapping matrix sum
# ==========================================================================
Class(SUMAcc, SUM, rec(
   abbrevs := [ arg ->
    [ Flat(List(Flat(arg),
        s -> When(IsSPL(s) and Same(ObjId(s), SUMAcc), s.children(), s))) ] ]
 ));

# ==========================================================================
# ISum(<var>, <domain>, <spl>) - non-overlapping iterative matrix sum
# ==========================================================================
Class(ISum, SumsBase, BaseIterative, rec(
    needInterleavedLeft := self >> self.child(1).needInterleavedLeft(),
    needInterleavedRight := self >> self.child(1).needInterleavedRight(),
    cannotChangeDataFormat := self >> self.child(1).cannotChangeDataFormat(),
    totallyCannotChangeDataFormat := self >> self.child(1).totallyCannotChangeDataFormat(),

    directOper := SUM,
    area := self >> let(ac:=self._children[1].area(), ac * self.domain),
    #-----------------------------------------------------------------------
    rng := self >> self._children[1].rng(),
    dmn := self >> self._children[1].dmn(),
    dims := self >> [StripList(List(self.rng(),l->l.size)),StripList(List(self.dmn(),l->l.size))],

    advdims := self >> self._children[1].advdims(),

    #-----------------------------------------------------------------------
    transpose := self >> CopyFields(self, rec(
           _children := [self._children[1].transpose()],
           dimensions := Reversed(self.dimensions))),
    conjTranspose := self >> CopyFields(self, rec(
           _children := [self._children[1].conjTranspose()],
           dimensions := Reversed(self.dimensions))),
    inverse := self >> CopyFields(self, rec(
           _children := [self._children[1].inverse()],
           dimensions := Reversed(self.dimensions))),
    #-----------------------------------------------------------------------
    unroll := self >> SUM(self.unrolledChildren()),
    #-----------------------------------------------------------------------
    sums := self >> CopyFields(self, rec(
        _children := [self._children[1].sums()]))
));

Class(ISumLS, ISum);
Class(JamISum, ISum, rec(isBlockTransitive := true));
Class(Grp, Buf);

# ==========================================================================
# ICompose(<var>, <domain>, <spl>) - iterative matrix product
# ==========================================================================
Class(ICompose, SumsBase, BaseIterative, rec(
    area := self >> self._children[1].area() * self.domain,
    #-----------------------------------------------------------------------
    dims := self >> self._children[1].dimensions,
    #-----------------------------------------------------------------------
    unroll := self >> Compose(self.unrolledChildren()),
    #-----------------------------------------------------------------------
    transpose := self >> ICompose(self.var, self.domain,
        SubstVars(Copy(self._children[1].transpose()),
	          tab((self.var.id) := self.domain-1-self.var))),

    createCode := self >> Cond(IsBound(self._children[1].createCode),
        ICompose(self.var, self.domain, self._children[1].createCode()), self),

    prods := self >> let(base := self.__bases__[1],
        base(self.var, self.domain, self._children[1].prods())),

#    rChildren := self >> [self.var, self.domain, self._children[1]],
#
#    from_rChildren := (self, rch) >> ApplyFunc(ObjId(self), rch),
#
#    rSetChild := meth(self, n, newChild)
#        if n=1 then self.var := newChild;
#        elif n=2 then self.domain := newChild;
#        elif n=3 then self._children := [newChild];
#        else Error("<n> must be in [1..3]");
#        fi;
#    end
));

# ==========================================================================
# ISumAcc(<var>, <domain>, <spl>) - overlapping iterative matrix sum
# ==========================================================================
Class(ISumAcc, ISum);

# ==========================================================================
# IParSeq(<var>, <domain>, <fb>, <spl>)
# ==========================================================================
Declare(ParSeq);
Class(IParSeq, SumsBase, BaseIterative, rec(
    abbrevs := [ (v, fb_cnt, expr) -> [v, v.range, fb_cnt, expr]  ],
    new := meth(self, v, domain, fb_cnt, expr)
        local obj;
        #NOTE: check dimensions
        obj := Inherited(v, domain, expr);
        obj.fb_cnt := fb_cnt;
        return obj;
    end,

    dims := self >> self._children[1].dims(),
    unroll := self >> ParSeq( self.fb_cnt, Reversed(self.unrolledChildren())),

    filtCompL := (self, lst) >> lst{[1..self.fb_cnt]},
    filtCompR := (self, lst) >> lst{[1..self.fb_cnt]},
    filtSUML  := (self, lst) >> lst{[self.fb_cnt+1..Length(lst)]},
    filtSUMR  := (self, lst) >> lst{[self.fb_cnt+1..Length(lst)]},

    # area doesn take into account that we have composition and sum
    area := self >> self._children[1].area() * self.domain,

    print := (self, i, is) >> Print(
        self.name, "(", self.var, ", ", self.domain, ", ", self.fb_cnt, ",\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(""))
    ),
));

##############################################################################
Declare(Conj, ConjL, ConjR, ConjLR, ConjDiag);

Class(Conj, SumsBase, BaseOperation, rec(
    new    := (self, spl) >> SPL(WithBases(self, rec(_children:=[spl], dimensions := spl.dimensions))),
    dims   := self >> self._children[1].dims(),
    toAMat := self >> self.child(1).toAMat(),
    sums   := self >> self,
    transpose := self >> Conj(self.child(1).transpose())
));

Class(ConjL, Conj, rec(
    new    := (self, spl, lprm) >> SPL(WithBases(self, rec(_children:=[spl, lprm]))).setDims(),
    dims   := self >> [self.child(2).dims()[1], self.child(1).dims()[2]],
    toAMat := self >> self.child(2).toAMat() * self.child(1).toAMat(),
    sums   := self >> ConjL(self.child(1).sums(), self.child(2)),
    transpose := self >> ConjR(self.child(1).transpose(), self.child(2).transpose()),
));

Class(ConjR, Conj, rec(
    new    := (self, spl, rprm) >> SPL(WithBases(self, rec(_children:=[spl, rprm]))).setDims(),
    dims   := self >> [self._children[1].dims()[1], self._children[2].dims()[2]],
    toAMat := self >> self.child(1).toAMat() * self.child(2).toAMat(),
    sums   := self >> ConjR(self.child(1).sums(), self.child(2)),
    transpose := self >> ConjL(self.child(1).transpose(), self.child(2).transpose()),
));

Class(ConjLR, Conj, rec(
    new    := (self, spl, lprm, rprm) >> SPL(WithBases(self, rec(_children:=[spl, lprm, rprm]))).setDims(),
    dims   := self >> [ self.child(2).dims()[1], self.child(3).dims()[2] ],
    toAMat := self >> self.child(2).toAMat() * self.child(1).toAMat() * self.child(3).toAMat(),
    sums   := self >> ConjLR(self.child(1).sums(), self.child(2), self.child(3)),
    transpose := self >> ConjLR(self.child(1).transpose(), self.child(3).transpose(), self.child(2).transpose()),
));

Class(ConjDiag, Conj, rec(
    new    := (self, spl, lprm, rprm) >> SPL(WithBases(self, rec(_children:=[spl, lprm, rprm]))).setDims(),
    dims   := self >> [Rows(self.child(2)), Cols(self.child(3))],
    toAMat := self >> self.child(2).toAMat() * self.child(1).toAMat() * self.child(3).toAMat(),
    sums   := self >> ConjDiag(self.child(1).sums(), self.child(2), self.child(3)),
    transpose := self >> ConjDiag(self.child(1).transpose(), self.child(3).transpose(), self.child(2).transpose()),
));

Class(NeedInterleavedComplex, BaseContainer, rec(
    needInterleavedLeft := True,
    needInterleavedRight := True,
    sums := self >> self,
    area:= self >> self.child(1).area()
));


#############################################################################
####
##
#W  general.gi                 ACE Package                   Alexander Hulpke
#W                                                                Greg Gamble
##
##  This file installs mainly non-interactive ACE  variables  and  functions.
##  Though Alexander will barely recognise it,  some  of his ideas are  still
##  present.
##
#Y  Copyright (C) 2000  Centre for Discrete Mathematics and Computing
#Y                      Department of Information Technology & Electrical Eng.
#Y                      University of Queensland, Australia.
##

#############################################################################
####
##
#V  ACETCENUM . . . . . . . .  The ACE version of the coset enumerator TCENUM
##  . . . .  CosetTableFromGensAndRels is set to ACECosetTableFromGensAndRels
##
InstallValue(ACETCENUM, rec(
  name := "ACE (Advanced Coset Enumerator)",
  CosetTableFromGensAndRels := ACECosetTableFromGensAndRels
));

#############################################################################
####
##
#F  InfoACELevel . . . . . . . . . . . . . . .  Get the InfoLevel for InfoACE
##
##
InstallGlobalFunction(InfoACELevel, function()
  return InfoLevel(InfoACE);
end);

#############################################################################
####
##
#F  SetInfoACELevel . . . . . . . . . . . . . . Set the InfoLevel for InfoACE
##
##
InstallGlobalFunction(SetInfoACELevel, function(arg)
  if IsEmpty(arg) then
    SetInfoLevel(InfoACE, 1);     # Set to default level
  else
    SetInfoLevel(InfoACE, arg[1]);
  fi;
end);

#############################################################################
####
##
#F  ACEPackageVersion()
##
##  returns the version number of the current ACE package.
##
InstallGlobalFunction(ACEPackageVersion, function()

  return GAPInfo.PackagesInfo.ace[1].Version;
end);

#############################################################################
####
##
#F  CALL_ACE . . . . . . . . . Called by ACECosetTable, ACEStats and ACEStart
##
##
InstallGlobalFunction(CALL_ACE, function(ACEfname, fgens, rels, sgens)
local optnames, echo, errmsg, onbreakmsg, infile, datarec, ToACE, gens,
      standard, ignored;

  if ValueOption("aceexampleoptions") = true and
     IsBound(ACEData.aceexampleoptions) then
    SANITISE_ACE_OPTIONS(OptionsStack[ Length(OptionsStack) ],
                         ACEData.aceexampleoptions);
    PushOptions(ACEData.aceexampleoptions);
    Unbind(ACEData.aceexampleoptions);
    ACEData.options := OptionsStack[ Length(OptionsStack) ];
    PopOptions();
    OptionsStack[ Length(OptionsStack) ] := ACEData.options;
    Unbind(ACEData.options);
  fi;
  optnames := ACE_OPT_NAMES();
  # We have hijacked ACE's echo option ... we don't actually pass it to ACE
  echo := ACE_VALUE_ECHO(optnames);

  ECHO_ACE_ARGS( echo, ACEfname, rec(fgens := fgens,
                                     rels  := rels,
                                     sgens := sgens) );
  # Check arguments are valid
  while IsEmpty(fgens) do
    errmsg :=
        ["fgens (arg[1]) must be a non-empty list of group generators ..."];
    onbreakmsg :=
        ["Type: 'quit;' to quit to outer loop, or",
         "type: 'fgens := <val>; return;' to assign <val> to fgens to continue."
        ];
    Error(ACE_ERROR(errmsg, onbreakmsg), "\n");
  od;
  fgens := ACE_FGENS_ARG_CHK(fgens);
  rels  := ACE_WORDS_ARG_CHK(fgens, rels, "relators");
  sgens := ACE_WORDS_ARG_CHK(fgens, sgens, "subgp gen'rs");

  infile  := VALUE_ACE_OPTION(optnames, fail, "aceinfile");
  if ACEfname = "ACECosetTableFromGensAndRels" and infile <> fail then
    datarec := rec(
        infile  := infile,
        outfile := VALUE_ACE_OPTION(optnames, ACEData.outfile, "aceoutfile"),
        stream  := OutputTextFile(infile, false) );
    ToACE := function(list) WRITE_LIST_TO_ACE_STREAM(datarec.stream, list); end;
  else
    datarec := rec(
        stream := InputOutputLocalProcess(ACEData.tmpdir, ACEData.binary, []) );
    if datarec.stream = fail then
      Error("sorry! Run out of pseudo-ttys. Can't initiate stream\n");
    fi;
    if ACEfname <> ACEStart then
      datarec.procId := 0;
      ACEData.ni := datarec;
    fi;
    FLUSH_ACE_STREAM_UNTIL(datarec.stream, 3, 3, ACE_READ_NEXT_LINE,
                           line -> IsMatchingSublist(line, "name", 3));
    ToACE := function(list)
                 INTERACT_TO_ACE_WITH_ERRCHK(datarec, list);
             end;
  fi;
  datarec.args    := rec(fgens := fgens, rels := rels, sgens := sgens);
  datarec.options := ACE_OPTIONS();
  standard := ACE_COSET_TABLE_STANDARD( datarec.options );

  # Define the group generators ACE will use
  gens := TO_ACE_GENS(fgens);
  ToACE([ "Group Generators: ", gens.toace, ";"]);
  datarec.acegens := gens.acegens;

  # Define the group relators ACE will use
  datarec.enforceAsis :=
      (ACEfname <> "ACEStats") and (standard = "lenlex") and
      not IsACEGeneratorsInPreferredOrder(fgens, rels, "noargchk");
  ToACE([ "Group Relators: ",
          ACE_RELS(rels, fgens, datarec.acegens, datarec.enforceAsis), ";" ]);

  # Define the subgroup generators ACE will use
  ToACE([ "Subgroup Generators: ",
          ACE_WORDS(sgens, fgens, datarec.acegens), ";" ]);

  if ACEfname  = "ACECosetTableFromGensAndRels" then
    ignored := [ ];
  else
    ignored := [ "aceinfile" ];
  fi;
  if ACEfname  = "ACEStart" then
    Add(ignored, "aceoutfile");
  fi;
  if datarec.enforceAsis then
    Add(ignored, "asis");
    ToACE([ "Asis: 1;" ]);
  fi;

  PROCESS_ACE_OPTIONS(
      ACEfname, optnames, optnames, echo, datarec,
      rec(group      := ACE_ERRORS.argnotopt, # disallowed options
          generators := ACE_ERRORS.argnotopt,
          relators   := ACE_ERRORS.argnotopt),
      ignored
      );

  if not IsInputOutputStream(datarec.stream) then
    if VALUE_ACE_OPTION(optnames, fail, ["start", "aep", "rep"]) = fail then
      # if the user hasn't issued there own enumeration initiation directive
      # ... initiate the enumeration
      ToACE([ "Start;" ]);
    fi;
    if ACEfname = "ACECosetTableFromGensAndRels" then
      if standard = "lenlex" then
        ToACE([ "Standard;" ]);
      fi;
      ToACE([ "Print Table;" ]);
    fi;
    CloseStream(datarec.stream);
  elif ACEfname <> "ACEStart" then
    if VALUE_ACE_OPTION(optnames, fail, ["start", "aep", "rep"]) = fail then
      ACE_MODE( "Start", datarec );
    fi;
    if ACEfname = "ACECosetTableFromGensAndRels" and standard = "lenlex" then
      ToACE([ "Standard;" ]);
    fi;
  fi;

  if ACEfname = "ACEStart" then
    datarec.procId := Length(ACEData.io) + 1;
    Add(ACEData.io, datarec);
    return Length(ACEData.io);
  elif ACEfname = "ACECosetTableFromGensAndRels" then
    datarec.silent := VALUE_ACE_OPTION(optnames, false, "silent");
  fi;
  return datarec;
end);

#############################################################################
####
##
#F  ACECosetTableFromGensAndRels . . . . . . .  Non-interactive ACECosetTable
##
##
InstallGlobalFunction(ACECosetTableFromGensAndRels, function(fgens, rels, sgens)
  # Use ACECosetTable non-interactively
  return ACECosetTable(fgens, rels, sgens);
end);

#############################################################################
####
##
#F  IsACEStandardCosetTable . . . . . . Returns true if table is standardised
##  . . . . . . . . . . . . . . . . . . according to GAP's default scheme  or
##  . . . . . . . . . . . . . . . . . . with the lenlex option, according  to
##  . . . . . . . . . . . . . . . . . . . . the lenlex standardisation scheme
##
InstallGlobalFunction(IsACEStandardCosetTable, function(table)
local standard, geninvIndices, index, next, j, i;

  standard := ACE_COSET_TABLE_STANDARD( ACE_OPTIONS() );
  if standard in ["lenlex", "GAPlenlex"] then
    geninvIndices := [1 .. Length(table)];
  elif standard in ["semilenlex", "GAPsemilenlex"] then
    geninvIndices := [1, 3 .. Length(table) - 1];
  else
    return IsStandardized(table); # Should only get here with GAP 4.3+
                                  # ... by which time `IsStandardized'
                                  # will hopefully have been generalised
                                  # to cope with any other standardisation
                                  # schemes
  fi;

  index := Length( table[1] );
  next := 2;
  for j in [1 .. index - 1] do
    for i in geninvIndices do
      if table[i][j] >= next then
        if table[i][j] > next then
          return false;
        fi;
        next := next + 1;
      fi;
    od;
  od;
  return true;
end);

#############################################################################
####
##
#F  IsACEGeneratorsInPreferredOrder . . . . . Returns true if the  generators
##  . . . . . . . . . . . . . . . . . . . . . gens are already in  the  order
##  . . . . . . . . . . . . . . . . . . . . . . . . . . . .  preferred by ACE
##
##  For a presentation with more than one generator, the first  generator  of
##  which is an involution and the second is not, ACE prefers to  switch  the
##  first two generators. IsACEGeneratorsInPreferredOrder returns true if the
##  order of the generators gens would not  be  changed  by  ACE  and  false,
##  otherwise. When necessary, the argument rels (the  relators)  is  scanned
##  for relators that determine  whether  or  not  gens[1]  and  gens[2]  are
##  involutions.
##
##  If IsACEGeneratorsInPreferredOrder would return false, it is possible  to
##  enforce a user's order of the generators within ACE, by  enforcing  ACE's
##  `asis' option and passing the relator,  that  determines  gens[1]  is  an
##  involution,  explicitly  to  ACE   as:   gens[1]*gens[1]   (rather   than
##  gens[1]^2).
##
InstallGlobalFunction(IsACEGeneratorsInPreferredOrder, function(arg)
local ioIndex, gens, rels;

  if Length(arg) < 2 then
    ioIndex := CallFuncList(ACEProcessIndex, arg);
    gens := ACEGroupGenerators(ioIndex);
    rels := ACERelators(ioIndex);
  elif Length(arg) = 2 then
    gens := ACE_FGENS_ARG_CHK(arg[1]);
    rels := ACE_WORDS_ARG_CHK(gens, arg[2], "relators");
  elif Length(arg) = 3 and arg[3] = "noargchk" then
    # This scenario only intended for use internally
    gens := arg[1];
    rels := arg[2];
  else
    Error("expected at most 2 arguments, not ", Length(arg), " arguments.\n");
  fi;

  if Length(gens) = 1 or not ForAny(rels, rel -> rel = gens[1]^2) then
    return true;
  else
    return ForAny(rels, rel -> rel = gens[2]^2);
  fi;
end);

#############################################################################
####
##
#F  ACE_READ_AS_FUNC  . . . . . . . . . . . . . . . Variant of ReadAsFunction
##  . . . . . . . . . . . .  that allows the passing of the function argument
##  . . . . . . . . . . . . . . . . . . . . ACEfunc to ReadAsFunction(file)()
##
##
InstallGlobalFunction(ACE_READ_AS_FUNC, function(file, ACEfunc)
local line, instream, rest;

  instream := InputTextFile(file);
  # We don't want the user to see this ... so we flush at InfoACE level 10.
  line := FLUSH_ACE_STREAM_UNTIL( instream, 10, 10, ReadLine,
                                  line -> IsMatchingSublist(line, "local") );
  rest := ReadAll(instream);
  CloseStream(instream);
  return ReadAsFunction(
             InputTextString(
                 Concatenation([ ReplacedString(line, ";", ", ACEfunc;"),
                                 "ACEfunc := ", NameFunction(ACEfunc), ";",
                                 rest ]) ) )();
end);

#############################################################################
####
##
#F  ACEExample( )
#F  ACEExample( <file>[, <ACEfunc>] )
##
##  With no arguments, or with single argument "index", or a string  that  is
##  not a filename  in  the  `examples'  directory,  an  index  of  available
##  examples is displayed.
##
##  With argument <file> that is a filename in the `examples' directory other
##  than "index" the example is displayed as it would  be  when  called  with
##  <ACEfunc> (or `ACEStats', if  the  2nd  argument  is  omitted)  and  then
##  executed via a call to `ReadAsFunction' and a little internal  ``magic''.
##  <ACEfunc>    must    be    one    of    `ACEStats'     (the     default),
##  `ACECosetTableFromGensAndRels'  (or  equivalently   `ACECosetTable',   or
##  `ACEStart'.
##
InstallGlobalFunction(ACEExample, function(arg)
local name, file, instream, line, ACEfunc,
      EnquoteIfString, optnames, lastoptname, optname;

  if IsEmpty(arg) then
    name := "index";
  else
    name := arg[1];
    if Length(arg) > 1 then
      ACEfunc := arg[2];
    else
      ACEfunc := ACEStats;
    fi;
    if not IsEmpty(OptionsStack) then
      ACEData.aceexampleoptions := OptionsStack[ Length(OptionsStack) ];
      PopOptions();
      PushOptions( rec(aceexampleoptions := true) );
    fi;
  fi;
  file := Filename( DirectoriesPackageLibrary( "ace", "examples"), name );
  if file = fail then
    Info(InfoACE + InfoWarning, 1,
         "Sorry! There is no ACE example file with name `", name, "'");
    name := "index";
    file := Filename( DirectoriesPackageLibrary("ace", "examples"), name );
  fi;
  # Display file ... after a few minor modifications
  instream := InputTextFile(file);
  if name <> "index" then
    line := FLUSH_ACE_STREAM_UNTIL( instream, 1, 10, ReadLine,
                                    line -> IsMatchingSublist(line, "local") );
    Info(InfoACE, 1,
         "#", line{[Position(line, ' ')..Position(line, ';') - 1]},
         " are local to ACEExample");
    line := FLUSH_ACE_STREAM_UNTIL( instream, 1, 10, ReadLine,
                                    line -> IsMatchingSublist(line, "return") );
    Info(InfoACE, 1,
         Chomp(ReplacedString(line, "return ACEfunc", NameFunction(ACEfunc)))
         );
    if IsBound(ACEData.aceexampleoptions) then
      line := FLUSH_ACE_STREAM_UNTIL(
                  instream, 1, 10, ReadLine,
                  line -> PositionSublist(line, ");") <> fail );
      Info(InfoACE, 1, Chomp(ReplacedString(line, ");", ", ")));
      Info(InfoACE, 1, "    # User Options");
      optnames := ShallowCopy( RecNames(ACEData.aceexampleoptions) );
      lastoptname := optnames[ Length(optnames) ];
      Unbind(optnames[ Length(optnames) ]);

      EnquoteIfString := function(optval)
      # Puts quotes around optval if it's a string
        if IsString(optval) then
          return Concatenation(["\"", optval, "\""]);
        else
          return optval;
        fi;
      end;

      for optname in optnames do
        Info(InfoACE, 1, "      ", optname, " := ",
                         EnquoteIfString(
                             ACEData.aceexampleoptions.(optname) ), ",");
      od;
      Info(InfoACE, 1, "      ", lastoptname, " := ",
                       EnquoteIfString(
                           ACEData.aceexampleoptions.(lastoptname) ), ");");
    fi;
  fi;
  FLUSH_ACE_STREAM_UNTIL( instream, 1, 10, ReadLine, line -> line = fail );
  CloseStream(instream);
  if name <> "index" then
    return ACE_READ_AS_FUNC(file, ACEfunc);
  fi;
end);

#############################################################################
####
##
#F  ACEReadResearchExample  . . . . . . . .  Read  an  ACE  research  example
##  . . . . . . . . . . . . . . . . . . . .  from the res-examples directory.
##
##  Currently,  all  examples  in  the  res-examples  directory   depend   on
##  pgrelfind.g, which with Info text doubles as an index. This  function  is
##  essentially equivalent to doing a Read of its argument or  "pgrelfind.g",
##  if there is no argument.
##
InstallGlobalFunction(ACEReadResearchExample, function(arg)
local name, file;

  if IsEmpty(arg) then
    name := "pgrelfind.g"; # If there is ever more than one key research
                           # example, we should replace this with an index
  else
    name := arg[1];
  fi;
  file := Filename( DirectoriesPackageLibrary( "ace", "res-examples"), name );
  if file = fail then
    Error("ACEReadResearchExample: Sorry! There is no ACE research example\n",
          "file with name \"", name, "\"\n");
  else
    Read(file);
  fi;
end);

#############################################################################
####
##
#F  ACEPrintResearchExample . . . . . . . . Print  an  ACE  research  example
##  . . . . . . . . . . . . . . . . . . . . from the  res-examples  directory
##  . . . . . . . . . . . . . . . . . . . . to the terminal  or  to  a  file,
##  . . . . . . . . . . . . . . . . . . . . . . . minus header and Info text.
##
##  ACEPrintResearchExample(examplefile)
##      prints examplefile in res-examples directory to the terminal
##
##  ACEPrintResearchExample(examplefile, outfile)
##      prints examplefile in res-examples directory to outfile
##
InstallGlobalFunction(ACEPrintResearchExample, function(arg)
local outstream, print, file, instream, line;

  if IsEmpty(arg) then
    Error("expected 1 or 2 arguments\n");
  fi;

  file := Filename( DirectoriesPackageLibrary( "ace", "res-examples"), arg[1] );
  if file = fail then
    Error("ACEPrintResearchExample: Sorry! There is no ACE research example ",
          "file with name `", arg[1], "'\n");
  fi;

  if Length(arg) > 1 then
    outstream := OutputTextFile(arg[2], false);
    print := function(line) WriteAll(outstream, line); end;
  else
    print := Print;
  fi;

  instream := InputTextFile(file);
  repeat
    line := ReadLine(instream);
  until IsMatchingSublist(line, "## Begin");
  line := ReadLine(instream);
  while not IsMatchingSublist(line, "## End") do
    print(line);
    line := ReadLine(instream);
  od;
  CloseStream(instream);

  if print <> Print then
    CloseStream(outstream);
  fi;
end);

#############################################################################
####
##
#F  ACEDirectoryTemporary( <dir> )
##
##  calls the UNIX command `mkdir' to create <dir>, which must be  a  string,
##  and if successful a directory  object  for  <dir>  is  both  assigned  to
##  `ACEData.tmpdir'  and   returned.   The   fields   `ACEData.infile'   and
##  `ACEData.outfile' are also set to be files in  `ACEData.tmpdir',  and  on
##  exit from {\GAP} <dir> is removed.
##
InstallGlobalFunction(ACEDirectoryTemporary, function(dir)
local created;

  # check arguments
  if not IsString(dir) then
    Error("usage: ACEDirectoryTemporary( <dir> ) : <dir> must be a string.\n");
  fi;

  # create temporary directory
  created := Process(DirectoryCurrent(),
                     Filename( DirectoriesSystemPrograms(), "sh" ),
                     InputTextUser(),
                     OutputTextUser(),
                     [ "-c", Concatenation("mkdir ", dir) ]);
  if created = fail then
    return fail;
  fi;

  Add( GAPInfo.DirectoriesTemporary, dir );
  ACEData.tmpdir := Directory(dir);
  ACEData.infile := Filename(ACEData.tmpdir, "in");
  ACEData.outfile := Filename(ACEData.tmpdir, "out");
  return ACEData.tmpdir;
end);

#############################################################################
####
##
#F  ACE_ERROR(<errmsg>, <onbreakmsg>)
##
##  sets `OnBreakMessage' to  print  <onbreakmsg>  in  order  to  generate  a
##  one-off user-friendly message of how the user may recover from the error,
##  and returns an error message formed from <errmsg> to be used by Error.
##
##  <errmsg> and <onbreakmsg> should be lists of strings;  <onbreakmsg>  must
##  be non-empty and its first member must not be a null string.
##
InstallGlobalFunction(ACE_ERROR, function(errmsg, onbreakmsg)
local NormalOnBreak, NormalOnBreakMessage;

  errmsg := JoinStringsWithSeparator(errmsg, "\n ");
  NormalOnBreakMessage := OnBreakMessage;
  onbreakmsg[1]{[1]} := LowercaseString( onbreakmsg[1]{[1]} );
  OnBreakMessage := function()
    local s;

    for s in onbreakmsg do
      Print(" ", s, "\n");
    od;
    OnBreakMessage := NormalOnBreakMessage;
  end;

  return errmsg;
end);

#############################################################################
####
##
#F  CallACE . . . . . . . . . . . . . . . . . . . . . . . . . . .  deprecated
##
InstallGlobalFunction(CallACE, function(arg)

  Error("CallACE is deprecated: Use `ACECosetTableFromGensAndRels' or\n",
        "`ACECosetTable'.\n");
end);

#E  general.gi  . . . . . . . . . . . . . . . . . . . . . . . . . . ends here


dimX := 0;
dimY := 1;
dimZ := 2;
dimW := 3;

dimXYZ := [dimX, dimY, dimZ];


InstallGlobalFunction(MitM_XMLToOMRec,
function(str)
    local tree;
    tree := ParseTreeXMLString(str);

    # Strip out unnecessary contents recursively
    tree := MitM_SimplifiedTree(tree);

    # Get a single object
    if Length(MitM_Content(tree)) > 1 then
        Error("There are several top-level objects");
    fi;
    tree := MitM_Content(tree)[1];

    return tree;
end);

InstallGlobalFunction(MitM_SimplifiedTree,
function(tree)
    local out, item, len, data;
    if tree.name = "PCDATA" then
        # content should be a string
        if IsEmpty(NormalizedWhitespace(tree.content)) then
            return fail;
        fi;
        return tree.content;
    elif tree.name = "XMLCOMMENT" then
        return fail;
    fi;
    out := rec();
    out.name := tree.name;
    if IsBound(tree.attributes) and not IsEmpty(RecNames(tree.attributes)) then
        out.attributes := tree.attributes;
    fi;
    if tree.content <> 0 then
        out.content := [];
        len := 0;
        for item in tree.content do
            # item should be a record
            data := MitM_SimplifiedTree(item);
            if data <> fail then
                if len>0 and IsString(data) and IsString(out.content[len]) then
                    Append(out.content[len], data);
                else
                    len := len + 1;
                    out.content[len] := data;
                fi;
            fi;
        od;
    fi;
    return Objectify(MitM_OMRecType, out);
end);


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

_prepVars := function(vars, vargen, pfx)
    local v, res, newpfx, newv;
    res := []; newpfx := Concat("p", pfx);
    for v in vars do
        if IsArrayT(v.t) then
	    newv := vargen.next(TPtr(v.t.t), newpfx);
	    Add(res, [ v, newv, zallocate(newv, v.t) ]);
	else
	    Add(res, [ v, v, skip() ]);
	fi;
    od;
    return res;
end;

GenerateMultiIOBench := function(t,code, domain, range, opts)
    local vargen, code, inp, out, inout, args, allocs;
    vargen := VarGenNumeric();
    inp := List(domain, t -> vargen.next(t, "_in"));
    inp := _prepVars(inp, vargen, "_in");

    out := List(range, t -> vargen.next(t, "_out"));
    out := _prepVars(out, vargen, "_out");

    inout := Concatenation(out, inp);
    args := List(inout, x->x[2]);
    allocs := List(inout, x->x[3]);

    code := program(
	decl(args,
	    chain(
		SubstTopDown(code, program, x->chain(x.cmds)),
		func(TVoid, "init", [],
		    chain(allocs,
		    ApplyFunc(call, [var(opts.subInitName)]))),
		func(TVoid, "transform", [When(IsBound(opts.subParams), opts.subParams, [])],
		    ApplyFunc(call, Concatenation([var(opts.subName)], When(IsBound(opts.subParams), opts.subParams, []),args))))));
    return code;
end;

# Generate Bench does allocation for a program (a function and its initialization).
# It indirects both the init and the transform, does memory allocation for parameters
# in the new init and uses them to call the function in the new body.
#
#     init(){...}
#     transform(...){...}
#
# will be thus be renamed to:
#
#      <opts.subInitName>(){...}
#      <opts.subName>(...){...}
#
# and the following functions will be added:
#
#      init(){params=malloc();<opts.subInitName>();}
#      transform(){<opts.subName>(params);}
#
# GenerateBench(<t>,<code>,<opts>)
# <t> is the sums corresponding to the program <code> compiled with options <opts>
GenerateBench := (t,code,opts) ->
    GenerateMultiIOBench(t, code, t.dmn(), t.rng(), opts);


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

Class(SIMD_VMX, SIMD_ISA, rec(
#    gen := self >> CellCGenSIMD,
    compileStrategy := self >> CellCompileStrategyVector,
#    hackUnparser := self >> CellVHackUnparser(VectorDefaults.expandConstants),

    #NOTE: unparser should point to SIMD_ISA's unparser
    unparser := SSEUnparser,
    arch := "AltiVec",
    info := "AltiVec, VMX, Cell BE PPU and SPU",
    file := "vmx"
));

Class(AltiVec_4x32f, SIMD_VMX, rec(
    active := true,
    isFixedPoint := false,
    info := "AltiVec 4 x 32-bit float",
    v := 4,
    ctype := "float",
    vtype := "vector float",
    stype := "__attribute__ ((aligned(16))) float",
    instr := [vunpacklo_4x32f_av, vunpackhi_4x32f_av, vperm_4x32f, vuperm_4x32f],
    #instr := [vunpacklo_4x32f_spu, vunpackhi_4x32f_spu, vperm_4x32f_spu, vuperm_4x32f_spu], # <- cheat-code!
    bits := 32,
    isFloat := true,
    isFix := false,
    header := "#include <altivec.h>\n\n",
    infix_op := false,
    infix_assign := true,
    vadd := "vec_add",
    vsub := "vec_sub",
    vmul := "vec_madd",
    vmuladd := true,
    vconst := vconstpr_av,
    vconstv := "(vector float)",
    vconst1 := "(vector float)",
    splopts := rec(precision := "single")
));

#Class(AltiVec_8x16i, rec(
#    active := false,
#    isFixedPoint := true,
#    info := "AltiVec 8 x 16-bit integer",
#    v := 8,
#    ctype := "int16",
#    vtype := "vector int16",
#    stype := "__attribute__ ((aligned(16))) int16",
#    instr := [vunpacklo_8x16i, vunpackhi_8x16i, vperm_8x16i, vuperm_8x16i],
#    bits := 16,
#    isFloat := true,
#    isFix := false,
#    header := "",
#    infix_op := false,
#    infix_assign := true,
#    vadd := "vec_add",
#    vsub := "vec_sub",
#    vmul := "vec_mul",
#    vconst := ""
#));
#
#Class(AltiVec_16x8i, rec(
#    active := false,
#    isFixedPoint := true,
#    info := "AltiVec 16 x 8-bit integer",
#    v := 16,
#    ctype := "int8",
#    vtype := "vector int8",
#    stype := "__attribute__ ((aligned(16))) int8",
#    instr := [vunpacklo_16x8i, vunpackhi_16x8i, vperm_16x8i, vuperm_16x8i],
#    bits := 8,
#    isFloat := true,
#    isFix := false,
#    header := "",
#    infix_op := false,
#    infix_assign := true,
#    vadd := "vec_add",
#    vsub := "vec_sub",
#    vmul := "vec_mul",
#    vconst := ""
#));

SIMD_ISA_DB.addISA(AltiVec_4x32f);
#SIMD_ISA_DB.addISA(AltiVec_8x16i);
#SIMD_ISA_DB.addISA(AltiVec_16x8i);


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

_IsCompute  := (asgn) >> (IsBound(asgn.isCompute) and asgn.isCompute);
_IsLoad  := (asgn) >> (IsBound(asgn.isLoad) and asgn.isLoad);
_IsStore  := (asgn) >> (IsBound(asgn.isStore) and asgn.isStore);

#NOTE: Need a much better marking heuristic
MarkSWPLoops := function(loop)
  # Obviously, we can't sw-pipeline if we don't have adequate iterations
  if Length(loop.range) >=4 then
    # Current heuristic: Mark loops where the loop body has at least 10 commands.
    if IsBound(loop.cmd) and IsBound(loop.cmd.cmd) and IsBound(loop.cmd.cmd.cmds) and Length(loop.cmd.cmd.cmds) >= 10 then
      return(loop_sw(loop.rChildren()[1], loop.rChildren()[2], loop.rChildren()[3]));
    else
      return(loop);
    fi;
  else
    return(loop);
  fi;
end;

MarkLoadinPreds := function(asgn)
  local i;
   if not _IsCompute(asgn) then # Mark as load
      asgn.isLoad := true;
   fi;

   # Mark all predecessors as loads
   if IsBound(asgn.loc) and IsBound(asgn.loc.pred) then
     for i in [1..Length(asgn.loc.pred)] do
        if IsBound(asgn.loc.pred[i].def) then
           MarkLoadinPreds(asgn.loc.pred[i].def);
        fi;
     od;
   fi;
end;

MarkStoreinPreds := function(asgn)
  local i;
   if not _IsCompute(asgn) then # Mark as store
      asgn.isStore := true;

     # Mark all predecessors as stores (stops at computes)
     for i in [1..Length(asgn.loc.pred)] do
        if IsBound(asgn.loc.pred[i].def) then
           MarkStoreinPreds(asgn.loc.pred[i].def);
        fi;
     od;
   fi;
end;

MarkAllSucceedingLoadsAsComputes := function(asgn)
  local i;
  # Mark all successors that are loads as computes
  #
  for i in [1..Length(asgn.loc.succ)] do
     if IsBound(asgn.loc.succ[i].def) and _IsLoad(asgn.loc.succ[i].def) then
       #Error("Aha!");
       asgn.loc.succ[i].def.isLoad := false;
       asgn.loc.succ[i].def.isCompute := true;
     fi;
  od;

end;

SubstLoopVarCopy := function(asgns, loopvar, value)
   local retval, i;
   retval := Copy(asgns);
   for i in retval do
      SubstVars(i, rec((loopvar.id) := value));
   od;
   return(retval);
end;

SoftwarePipeline := function(lsw)
local alllsws, allasgns, loads, stores, loopvar, n1, n2, computes, isCompute, arg, asgn, asgns, g0, g1, c0, sn2, sn1, cn1, bodyload, vars, computeCount;
# Collect all loops to be software pipelined

   # Mark all computes
   computes := Collect(lsw, [assign, ..., @(2, [add, mul, sub]), ...]);

   #Error("BP");

   # For each compute: kick out all those that don't have a TReal type for all exp.arg
   # NOTE: Include TVects in TReal. NOTE: Won't work for code where loopvar datatype = compute datatype
   computeCount := 0;
   for asgn in computes do
      isCompute := true;
      for arg in asgn.exp.args do
       if arg.t <> TReal and arg.t.__name__ <> "TVect" then
          isCompute := false;
       fi;
      od;

      if (isCompute) then
         asgn.isCompute := true;
         computeCount := computeCount + 1;
         #Print(".");
      fi;
   od;

   # Heuristic: if there're no computes, this is probably a huge permute (load or
   # store) block, and should not be sw-pipelined.

   if computeCount = 0 then
     return(loop(lsw.rChildren()[1], lsw.rChildren()[2], lsw.rChildren()[3]));
   fi;

   #Error("BP");

   # Mark all Loads
   # Loads are all predcessors of all the computes
   asgns := Collect(lsw, assign);
   for asgn in asgns do
      if IsBound(asgn.isCompute) and asgn.isCompute then
         #Print(asgn);
         MarkLoadinPreds(asgn);
      fi;
   od;

   #Error("BP");

   # HACK: must really check to ensure this is a store!
   asgns := Collect(lsw, assign);
   for asgn in asgns do
      if not _IsCompute(asgn) and not _IsLoad(asgn) then
         asgn.isStore := true;
         MarkStoreinPreds(asgn);
         #NOTE: the loopvar assign should also be a store
      fi;
   od;

   # Mark loads which are to be marked as computes because they are
   # both preceded by and succeeded by a compute

   # For each compute, find all successors that are loads, and mark them as
   # computes.

   asgns := Collect(lsw, assign);
   for asgn in asgns do
      if IsBound(asgn.isCompute) and asgn.isCompute then
         MarkAllSucceedingLoadsAsComputes(asgn);
      fi;
   od;

   # Now, change the loop_sw to a software pipelined loop
   # Cmds should be strictly in order.

   # Make a list of loads, computes, and stores
   loads    := [];
   computes := [];
   stores   := [];
   allasgns := Collect(lsw, chain)[1].cmds;
   for asgn in allasgns do
      if _IsLoad(asgn) then
         loads := Concatenation(loads, [asgn]);
      fi;
      if _IsCompute(asgn) then
         computes := Concatenation(computes, [asgn]);
      fi;
      if _IsStore(asgn) then
         stores := Concatenation(stores, [asgn]);
      fi;
   od;

   #Error("BP");

   loopvar := lsw.var;
   n1 := Length(lsw.range)-1;
   n2 := n1-1;

   g0  := SubstLoopVarCopy(loads, loopvar, V(0));
   g1  := SubstLoopVarCopy(loads, loopvar, V(1));
   c0  := Copy(computes);

   sn2 := SubstLoopVarCopy(stores, loopvar, V(n2));
   sn1 := SubstLoopVarCopy(stores, loopvar, V(n1));
   cn1 := Copy(computes);

   bodyload  := SubstLoopVarCopy(loads,  loopvar, add(loopvar, V(2)));
   #prologue := chain(g0,   c0,  g1); #epilogue := chain(sn2, cn1, sn1);

   vars := Collect(lsw, decl)[1].vars;
   lsw := decl(vars, chain(g0, c0, g1, loop(loopvar, n2, chain(stores, c0, bodyload)), sn2, cn1, sn1));
   #Print(lsw);
   return(lsw);
end;


#############################################################################
####
##
#W  anupqopt.gi                ANUPQ package                    Werner Nickel
#W                                                                Greg Gamble
##
##  Install file for functions to do with option manipulation.
##
#Y  Copyright (C) 2001  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
##

#############################################################################
##
#V  PQ_FUNCTION . . . . . . . . . internal functions called by user functions
##
##  A record whose fields are (function)  names  and  whose  values  are  the
##  internal functions called by the functions with those names.
##
InstallValue( PQ_FUNCTION,
              rec( Pq                   := PQ_EPI_OR_PCOVER,
                   PqDescendants        := PQ_DESCENDANTS,
                   StandardPresentation := PQ_EPIMORPHISM_STANDARD_PRESENTATION,
                   PqDescendantsTreeCoclassOne := PqDescendantsTreeCoclassOne
                  )
             );

#############################################################################
##
#V  ANUPQoptions  . . . . . . . . . . . . . . . . . . . .  admissible options
##
##  is a record of lists of names of admissible {\ANUPQ} options,  such  that
##  each field is either the name of a (``key'') {\ANUPQ}  function  and  the
##  corresponding value is the list of option names that are  admissible  for
##  the function.
##
InstallValue( ANUPQoptions,
              rec( # options for `Pq' and `PqEpimorphism'
                   Pq  := [ "Prime",
                            "ClassBound",
                            "Exponent",
                            "Metabelian",
                            "OutputLevel",
                            "Relators",
                            "Identities",
                            "GroupName",
                            "SetupFile",
                            "PqWorkspace",
                            "RedoPcp" ],

                   # options for `PqDescendants'
                   PqDescendants
                       := [ "ClassBound",
                            "OrderBound",
                            "Relators",
                            "GroupName",
                            "StepSize",
                            "PcgsAutomorphisms",
                            "RankInitialSegmentSubgroups",
                            "SpaceEfficient",
                            "CapableDescendants",
                            "AllDescendants",
                            "Exponent",
                            "Metabelian",
                            "SubList",
                            "BasicAlgorithm",
                            "CustomiseOutput",
                            "SetupFile",
                            "PqWorkspace" ],

                   # options for `[Epimorphism][Pq]StandardPresentation'
                   StandardPresentation
                       := [ "Prime",
                            "pQuotient",
                            "ClassBound",
                            "Relators",
                            "GroupName",
                            "PcgsAutomorphisms",
                            "Exponent",
                            "Metabelian",
                            "OutputLevel",
                            "StandardPresentationFile",
                            "SetupFile",
                            "PqWorkspace" ],

                   # options for `PqDescendantsTreeCoclassOne'
                   PqDescendantsTreeCoclassOne
                       := [ "ClassBound",
                            "OrderBound",
                            "Relators",
                            "GroupName",
                            "StepSize",
                            "PcgsAutomorphisms",
                            "RankInitialSegmentSubgroups",
                            "SpaceEfficient",
                            "CapableDescendants",
                            "AllDescendants",
                            "Exponent",
                            "Metabelian",
                            "SubList",
                            "BasicAlgorithm",
                            "CustomiseOutput",
                            "TreeDepth",
                            "SetupFile",
                            "PqWorkspace" ],

                   PqList
                       := [ "SubList" ],
                   PqPcPresentation
                       := [ "Prime",
                            "ClassBound",
                            "Exponent",
                            "Metabelian",
                            "OutputLevel",
                            "Relators",
                            "Identities",
                            "GroupName" ],
                   PqNextClass
                       := [ "QueueFactor" ],
                   PqEvaluateIdentities
                       := [ "Identities" ],
                   PqDoExponentChecks
                       := [ "Bounds" ],
                   PqDisplayStructure
                       := [ "Bounds" ],
                   PqDisplayAutomorphisms
                       := [ "Bounds" ],
                   PqSPComputePcpAndPCover
                       := [ "Prime",
                            "ClassBound",
                            "Exponent",
                            "Metabelian",
                            "OutputLevel",
                            "Relators",
                            "GroupName" ],
                   PqSPSavePresentation
                       := [ "ClassBound",
                            "PcgsAutomorphisms",
                            "StandardPresentationFile" ],
                   PqPGSetDescendantToPcp
                       := [ "Filename" ],
                   PqPGSupplyAutomorphisms
                       := [ "NumberOfSolubleAutomorphisms",
                            "RelativeOrders" ],
                   PqPGConstructDescendants
                       := [ "ClassBound",
                            "OrderBound",
                            "StepSize",
                            "PcgsAutomorphisms",
                            "RankInitialSegmentSubgroups",
                            "SpaceEfficient",
                            "CapableDescendants",
                            "AllDescendants",
                            "Exponent",
                            "Metabelian",
                            "BasicAlgorithm",
                            "CustomiseOutput" ],
                   PqAPGDegree
                       := [ "Exponent" ],
                   PqAPGPermutations
                       := [ "PcgsAutomorphisms",
                            "SpaceEfficient",
                            "PrintAutomorphisms",
                            "PrintPermutations" ],
                   PqAPGOrbits
                       := [ "PcgsAutomorphisms",
                            "SpaceEfficient",
                            "CustomiseOutput" ],
                   PqAPGOrbitRepresentatives
                       := [ "PcgsAutomorphisms",
                            "SpaceEfficient",
                            "CapableDescendants",
                            "AllDescendants",
                            "Exponent",
                            "Metabelian",
                            "CustomiseOutput",
                            "Filename" ],
                   PqAPGSingleStage
                       := [ "StepSize",
                            "PcgsAutomorphisms",
                            "RankInitialSegmentSubgroups",
                            "SpaceEfficient",
                            "CapableDescendants",
                            "AllDescendants",
                            "Exponent",
                            "Metabelian",
                            "BasicAlgorithm",
                            "CustomiseOutput" ]
                  )
             );

#############################################################################
##
#F  AllANUPQoptions() . . . . . . . .  lists all options of the ANUPQ package
##
##  lists all the {\GAP}  options  defined  for  functions  of  the  {\ANUPQ}
##  package.
##
InstallGlobalFunction( AllANUPQoptions, function()
  return Set( Concatenation(
                  List( RecNames(ANUPQoptions), fld -> ANUPQoptions.(fld) )
                  ) );
end );

#############################################################################
##
#V  ANUPQGlobalOptions . . . . .  options that can be set globally by PqStart
##
##  A list of the options that `PqStart' can set and thereby  make  available
##  to any function  interacting  with  the  {\ANUPQ}  process  initiated  by
##  `PqStart'.
##
InstallValue( ANUPQGlobalOptions, [ "Prime", "Exponent", "Relators" ] );

#############################################################################
##
#V  ANUPQoptionChecks . . . . . . . . . . . the checks for admissible options
##
##  A record whose fields are the names of admissible ANUPQ options and whose
##  values are one-argument functions that return `true' when given  a  value
##  that is a valid value for the option, and `false' otherwise.
##
InstallValue( ANUPQoptionChecks,
              rec( Prime := x -> IsInt(x) and IsPrimeInt(x),
                   pQuotient  := IsPcGroup and IsPGroup,
                   ClassBound := IsPosInt,
                   OrderBound := IsPosInt,
                   Exponent   := IsPosInt,
                   Metabelian := IsBool,
                   GroupName  := IsString,
                   Identities := x -> IsList(x) and ForAll(x, IsFunction),
                   OutputLevel := x -> x in [0..3],
                   Relators   := x -> IsList(x) and ForAll(x, IsString),
                   StandardPresentationFile := IsString,
                   SetupFile  := IsString,
                   PqWorkspace := IsPosInt,
                   StepSize := x -> IsPosInt(x) or
                                    (IsList(x) and ForAll(x, IsPosInt)),
                   PcgsAutomorphisms := IsBool,
                   BasicAlgorithm := IsBool,
                   RankInitialSegmentSubgroups := x -> x = 0 or IsPosInt(x),
                   SpaceEfficient := IsBool,
                   CapableDescendants := IsBool,
                   AllDescendants := IsBool,
                   SubList := x -> IsPosInt(x) or
                                   (IsSet(x) and ForAll(x, IsInt)
                                    and IsPosInt(x[1])),
                   CustomiseOutput := IsRecord,
                   Bounds := x -> IsSet(x) and 2 = Length(x) and
                                  ForAll(x, IsPosInt),
                   QueueFactor := IsPosInt,
                   RedoPcp := IsBool,
                   PrintAutomorphisms := IsBool,
                   PrintPermutations := IsBool,
                   NumberOfSolubleAutomorphisms := x -> x = 0 or IsPosInt(x),
                   RelativeOrders := x -> IsList(x) and ForAll(x, IsPosInt),
                   Filename := IsString,
                   TreeDepth := IsPosInt
                   )
             );

#############################################################################
##
#V  ANUPQoptionTypes . . . . . .  the types (in words) for admissible options
##
##  A record whose fields are the names of admissible ANUPQ options and whose
##  values are valid types of the options in plain words.
##
InstallValue( ANUPQoptionTypes,
              rec( Prime := "prime integer",
                   pQuotient  := "pc p-group",
                   ClassBound := "positive integer",
                   OrderBound := "positive integer",
                   Exponent   := "positive integer",
                   Metabelian := "boolean",
                   GroupName  := "string",
                   Identities := "list of functions",
                   OutputLevel := "integer in [0..3]",
                   Relators   := "list of strings",
                   StandardPresentationFile := "string",
                   SetupFile  := "string",
                   PqWorkspace := "positive integer",
                   StepSize := "positive integer or positive integer list",
                   PcgsAutomorphisms := "boolean",
                   BasicAlgorithm := "boolean",
                   RankInitialSegmentSubgroups := "nonnegative integer",
                   SpaceEfficient := "boolean",
                   CapableDescendants := "boolean",
                   AllDescendants := "boolean",
                   SubList
                       := "pos've integer or increasing pos've integer list",
                   CustomiseOutput := "record",
                   Bounds := "pair of increasing positive integers",
                   QueueFactor := "positive integer",
                   RedoPcp := "boolean",
                   PrintAutomorphisms := "boolean",
                   PrintPermutations := "boolean",
                   NumberOfSolubleAutomorphisms := "nonnegative integer",
                   RelativeOrders := "list of positive integers",
                   Filename := "string",
                   TreeDepth := "positive integer"
                   )
             );

#############################################################################
##
#F  PQ_OTHER_OPTS_CHK( <funcname>, <interactive> ) . check opts belong to f'n
##
##  checks the `OptionsStack'  only  has  recognised  options  for  (generic)
##  function <funcname> and if not and if  `ANUPQWarnOfOtherOptions  =  true'
##  (see~"ANUPQWarnOfOtherOptions") `Info's  the  non-<funcname>  options  at
##  `InfoANUPQ' level 1.
##
##  The argument <interactive> is only relevant for those functions that have
##  both an interactive and non-interactive form, namely those with fields in
##  `PQ_FUNCTION', for which some options need to be excluded.
##
InstallGlobalFunction(PQ_OTHER_OPTS_CHK, function(funcname, interactive)
local optnames, excopts, generic, interactivestr;
  if ANUPQWarnOfOtherOptions and ValueOption("recursive") = fail and
     not IsEmpty(OptionsStack) then
    excopts := [];
    if funcname in RecNames(PQ_FUNCTION) then
      if interactive then
        excopts := ["PqWorkspace", "SetupFile"];
        interactivestr := "interactive";
      else
        interactivestr := "non-interactive";
        if funcname = "Pq" then
          excopts  := ["RedoPcp"];
        fi;
      fi;
      generic := "generic ";
    else
      generic := "";
    fi;
    optnames := Difference( RecNames( OptionsStack[ Length(OptionsStack) ] ),
                            Difference( ANUPQoptions.(funcname), excopts ) );
    if funcname = "Pq" then
      optnames := Difference( optnames, ["PqEpiOrPCover"] );
    fi;
    if not IsEmpty(optnames) then
      Info( InfoANUPQ + InfoWarning, 1,
            "ANUPQ Warning: Options: ", optnames, " ignored" );
      if IsSubset(excopts, optnames) then
        Info( InfoANUPQ + InfoWarning, 1,
              "(invalid for ", interactivestr, " call of generic function: `",
              funcname, "')." );
      else
        Info( InfoANUPQ + InfoWarning, 1,
              "(invalid for ", generic, "function: `", funcname, "')." );
      fi;
    fi;
  fi;
end);

#############################################################################
##
#F  VALUE_PQ_OPTION( <optname> ) . . . . . . . . . enhancement of ValueOption
#F  VALUE_PQ_OPTION( <optname>, <defaultval> )
#F  VALUE_PQ_OPTION( <optname>, <datarec> )
#F  VALUE_PQ_OPTION( <optname>, <defaultval>, <datarec> )
##
##  If the value <optval> of <optname> is not `fail' and it is  an  ok  value
##  for <optname> then <optval> is returned; if <optval> is not an  ok  value
##  an error is signalled. If <optval> is `fail' and <datarec> is  given  and
##  <datarec>.(<optname>) is already  bound  then  that  value  is  returned;
##  otherwise, if  <optval>  is  `fail'  and  a  default  value  <defaultval>
##  different  from  `fail'  is  supplied  then  <defaultval>  is   returned.
##  Supplying a <defaultval> of `fail' is special; it indicates  that  option
##  <optname> must have a value i.e. <optval> is not allowed to be `fail' and
##  if it is an error is signalled. If  a  <datarec>  argument  is  supplied,
##  which must be a record, then the return value, if not `fail' and a  legal
##  value, is also stored in `<datarec>.(<optname>)'.
##
##  *Note:* <defaultval> cannot be a record.
##
InstallGlobalFunction(VALUE_PQ_OPTION, function(arg)
local optname, optval, len;
  optname := arg[1];
  optval := ValueOption(optname);
  len := Length(arg);
  if optval = fail then
    if 1 = len then
      return optval;
    elif IsRecord( arg[len] ) and IsBound( arg[len].(optname) ) then
      # return the previously recorded value
      return arg[len].(optname);
    elif not IsRecord(arg[2]) then
      if arg[2] = fail then
        Error("you must supply a value for option: \"", optname, "\"\n");
      fi;
      optval := arg[2];
    fi;
  elif not ANUPQoptionChecks.(optname)(optval) then
    Error("\"", optname, "\" value must be a ",
          ANUPQoptionTypes.(optname), "\n");
  fi;
  if (optval <> fail) and (2 <= len) and IsRecord(arg[len]) then
    arg[len].(optname) := optval;
  fi;
  return optval;
end);

#############################################################################
##
#F  PQ_OPTION_CHECK(<basefn>,<datarec>) . check optns present/setable if nec.
##
##  If `<basefn> = "Pq"' (i.e. this check is  carried  out  if  the  function
##  called is `Pq', `PqEpimorphism' or  `PqPCover')  check  that  the  option
##  `Prime' has been  passed  or,  in  a  special  `PqPCover'  case,  can  be
##  determined from the `<datarec>.group'  which  must  be  present.  In  the
##  special `PqPCover' case, the options `Prime' and `ClassBound'  determined
##  are saved in <datarec>. If `Prime' is not supplied in the cases where  it
##  needs to be, an error is emitted.
##
InstallGlobalFunction(PQ_OPTION_CHECK, function(basefn, datarec)
local optname, out;
  if basefn = "Pq" then
    if datarec.calltype = "interactive" then
      if VALUE_PQ_OPTION("RedoPcp", false) then
        PQ_UNBIND(datarec, ["Prime",  "ClassBound", "Exponent", "Metabelian",
                            "pCover", "pQuotient",  "pQepi"] );
      fi;
    fi;
    if ValueOption("PqEpiOrPCover") = "pCover" and
       HasIsPGroup(datarec.group) and IsPGroup(datarec.group) then
      if VALUE_PQ_OPTION("Prime", datarec) = fail then
        if not HasPrimePGroup(datarec.group) then
          Error( "supplied group is not known to be a p-group or p unknown.\n",
                 "Option `Prime' must be supplied" );
        else
          datarec.Prime := PrimePGroup(datarec.group);
        fi;
      fi;
      if VALUE_PQ_OPTION("ClassBound", datarec) = fail and
         HasPClassPGroup(datarec.group) then
        datarec.ClassBound := PClassPGroup(datarec.group);
      fi;
    else
      VALUE_PQ_OPTION("Prime", fail, datarec);
    fi;
    VALUE_PQ_OPTION("ClassBound", 63, datarec);
  elif basefn = "StandardPresentation" then
    if VALUE_PQ_OPTION("Prime", datarec) = fail and
       VALUE_PQ_OPTION("pQuotient", datarec) = fail then
      if IsPcGroup(datarec.group) and IsPGroup(datarec.group) then
        datarec.Prime := PrimePGroup(datarec.group);
      else
        Error( "since group of process is not a pc p-group, a prime or\n",
               "p-quotient (pc group) of the group of the process ",
               "must be supplied\n" );
      fi;
    fi;
  fi;
end);

#############################################################################
##
#F  PQ_CUSTOMISE_OUTPUT(<datarec>, <subopt>, <suboptstring>, <suppstrings>)
##
##  writes the required output to the `pq' binary for the sub-option <subopt>
##  of  the  option  `CustomiseOutput',  the  value  of  that  option  having
##  previously been stored in `<datarec>.des.CustomiseOutput'; <suboptstring>
##  is part of the comment written to the `pq' binary for the sub-option  and
##  <suppstrings> is a list of such comments for the supplementary  questions
##  asked by the `pq' binary for the sub-option <subopt>.
##
InstallGlobalFunction( PQ_CUSTOMISE_OUTPUT,
function(datarec, subopt, suboptstring, suppstrings)
local optrec, isOptionSet, i;
  optrec := datarec.des.CustomiseOutput;
  if IsEmpty(suppstrings) then
    isOptionSet := IsBound( optrec.(subopt) ) and optrec.(subopt) in [1, true];
    ToPQ_BOOL(datarec, isOptionSet, suboptstring);
  elif IsBound( optrec.(subopt) ) and IsList( optrec.(subopt) ) then
    ToPQ(datarec, [ 0 ], [ "  #customise ", suboptstring ]);
    for i in [1 .. Length(suppstrings)] do
      isOptionSet := IsBound( optrec.(subopt)[i] ) and
                     optrec.(subopt)[i] in [1, true];
      ToPQ_BOOL(datarec, isOptionSet, suppstrings[i]);
    od;
  else
    ToPQ(datarec, [ 1 ], [ "  #default ", suboptstring ]);
  fi;
end);

#############################################################################
##
#F  PQ_APG_CUSTOM_OUTPUT(<datarec>, <subopt>, <suboptstring>, <suppstrings>)
##
##  writes the required output to the `pq' binary for the sub-option <subopt>
##  of the option `CustomiseOutput',  as  required  by  an  Advanced  p-Group
##  Generation Menu item, the value of that  option  having  previously  been
##  stored in `<datarec>.des.CustomiseOutput'; <suboptstring> is part of  the
##  comment written to the `pq' binary for the sub-option  and  <suppstrings>
##  is a list of such comments for the supplementary questions asked  by  the
##  `pq' binary for the sub-option <subopt>.
##
InstallGlobalFunction( PQ_APG_CUSTOM_OUTPUT,
function(datarec, subopt, suboptstring, suppstrings)
local optrec, optlist, isOptionSet, i;
  optrec := datarec.des.CustomiseOutput;
  if not( IsRecord(optrec) and IsBound( optrec.(subopt) ) and
          IsList( optrec.(subopt) ) ) then
    optlist := [];
    datarec.des.CustomiseOutput.(subopt) := optlist;
  else
    optlist := optrec.(subopt);
  fi;
  for i in [1 .. Length(suppstrings)] do
    isOptionSet := IsBound( optlist[i] ) and optlist[i] in [1, true];
    ToPQ_BOOL(datarec, isOptionSet, suppstrings[i]);
  od;
end);

#############################################################################
##
#F  SET_ANUPQ_OPTIONS( <funcname>, <fnname> )  . set options from OptionStack
##
##  When called by a function with name  <funcname>  sets  the  options  from
##  `OptionsStack'    checking    that    they    are     a     subset     of
##  `ANUPQoptions.<fnname>'. Both <funcname> and <fnname> should be strings.
##
InstallGlobalFunction( SET_ANUPQ_OPTIONS, function( funcname, fnname )
    local optrec, optnames, opt;

    # there should be options
    if IsEmpty( OptionsStack ) then
        # no options??
        optrec := rec();
        Info( InfoANUPQ, 1, funcname, " called with no options!" );
    else
        optrec := ShallowCopy( OptionsStack[ Length( OptionsStack ) ] );
        optnames := Set( REC_NAMES(optrec) );
        SubtractSet( optnames, Set( ANUPQoptions.(fnname) ) );
        Info( InfoANUPQ, 2, funcname, " called with options: ",
                            OptionsStack[ Length( OptionsStack ) ] );
        if 0 < Length(optnames) then
            # it's not an error to have unknown options,
            # function may have been called recursively and the
            # options may be intended for some other function
            Info( InfoWarning + InfoANUPQ, 2,
                  funcname, " called with unknown options: ", optnames);
        fi;
        for opt in optnames do
            Unbind( optrec.(opt) );
        od;
    fi;
    return optrec;
end );

#############################################################################
##
#F  ANUPQoptError( <funcname>, <illegal> )  . . . . . create an error message
##
##  creates an error message  for  the  function  with  name  <funcname>.  If
##  <illegal> is a string it is taken to be  the  first  line  of  the  error
##  message. Otherwise <illegal> should be alist of illegal options (strings)
##  found. The error message (string) returned also gives the list  of  valid
##  options together with the value types expected for function <funcname>.
##
InstallGlobalFunction( ANUPQoptError, function( funcname, illegal )
    local Optstring, Valstring, errmsg, optname;

    Optstring := optname -> Concatenation("\"", optname, "\"");
    Valstring := optval  -> Concatenation("<",  optval,  ">");

    if IsString(illegal) then
        errmsg := illegal;
    else # IsList(illegal)
        errmsg := Concatenation("Illegal ", funcname, " option");
        if Length(illegal) > 1 then
            Append(errmsg, "s");
        fi;
        Append(errmsg, ": ");
        Append(errmsg, JoinStringsWithSeparator( List(illegal, Optstring) ));
    fi;
    Append(errmsg, Concatenation(".\nValid ", funcname, " options:\n"));
    for optname in ANUPQoptions.(funcname) do
        Append(errmsg, "    ");
        Append(errmsg, Optstring(optname));
        if ANUPQoptionChecks.(optname) <> IsBool then
            Append(errmsg, ", ");
            Append(errmsg, Valstring( ANUPQoptionTypes.(optname) ));
        fi;
        Append(errmsg, "\n");
    od;
    return errmsg;
end );

#############################################################################
##
#F  ANUPQextractOptions( <funcname>, <args> ) . . . . . . . . extract options
##
##  extracts options from  <args>  for  function  with  name  <funcname>  and
##  returns a record suitable for use with `PushOptions'.  Abbreviations  are
##  allowed for option names so long as  each  abbreviates  a  unique  option
##  name.
##
InstallGlobalFunction( ANUPQextractOptions, function(funcname, args)
    local   Match, error, optrec, i, optname;

    # allow to give only a prefix
    Match := function( argi )
        local matches;
        if IsString(argi) then
            matches := Filtered(ANUPQoptions.(funcname),
                                optname -> 0 < Length(argi) and
                                           Length(argi) <= Length(optname) and
                                           optname{[1..Length(argi)]} = argi);
            if 1 = Length(matches) then
                return matches[1];
            fi;
            error := Concatenation( "argument: \"", argi,
                                    "\" doesn't abbreviate a unique option");
        else
            error := Concatenation( "argument: ", String(argi),
                                    " is not a (non-null) string (option name)"
                                    );
        fi;
        return fail;
    end;

    # extract options from args
    optrec := rec();
    i := 1;
    while i <= Length(args)  do
        optname := Match( args[i] );
        if optname = fail then
            Error( ANUPQoptError( funcname, error ) );
        elif ANUPQoptionChecks.(optname) = IsBool then
            optrec.(optname) := true;
            i := i + 1;
        elif i = Length(args) then
            # all remaining options are non-boolean and expect a value to
            # follow
            Error( ANUPQoptError(
                       funcname,
                       Concatenation( "Expected value for option: ", args[i] )
                       ) );
        else
            # checking values are ok is done later
            optrec.(optname) := args[i + 1];
            i := i + 2;
        fi;
    od;
    return optrec;

end );

#E  anupqopt.gi . . . . . . . . . . . . . . . . . . . . . . . . . . ends here


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

# Icode objects that are not cuda-specific (those are defined in cuda_icode.gi)

# A simt index is derived from a SIMT dim tag

Class(simtIdx, Exp, rec(
    computeType := (self) >> TInt,

    size := self >> When(Length(self.args)>0, self.args[1], 0),

    count := (self) >> let(rng := self.get_rng(), When(rng<>[], rng[2]-rng[1]+1, 0 ) ),

    set_rng := meth(self, l, h)
        if Length(self.args)>1 then
            self.args[2] := [l, h];
        else
            Add(self.args, [l, h]);
        fi;
        return self;
    end,

    eval := self >> self,

    can_fold := False,

    get_rng := (self) >> Cond(Length(self.args)>1, When(IsValue(self.args[2]), self.args[2].v, self.args[2]), Length(self.args)>0, [0, self.args[1]-1], [])

));

Class(simtBlockIdx, simtIdx);
Class(simtThreadIdx, simtIdx);

Class(simtBlockIdxX, simtBlockIdx);
Class(simtBlockIdxY, simtBlockIdx);
Class(simtBlockIdxZ, simtBlockIdx);

IsSimtBlockIdx := (idx) -> ObjId(idx) in simtBlockIdx._all_descendants();

Class(simtThreadIdxX, simtThreadIdx);
Class(simtThreadIdxY, simtThreadIdx);
Class(simtThreadIdxZ, simtThreadIdx);

IsSimtThreadIdx := (idx) -> ObjId(idx) in simtThreadIdx._all_descendants();

# Used to identify blocks of code that can be mapped to a kernel
Class(simt_block, chain);

Class(simt_loop, loop, rec(
    drop_range1 := false,

    __call__ := meth(self, simt_idx, loopvar, range, cmd)
        local result;
        Constraint(IsCommand(cmd));
        if IsSymbolic(range) then return loopn(loopvar, range, cmd); fi;
        range := toRange(range);
        if self.drop_range1 and range = 1 then
            return SubstBottomUp(Copy(cmd), @(1, var, e->e=loopvar), e->V(0));
        elif range = 0 then
            return skip();
        elif simt_idx = Ignore then
            return loop(loopvar, range, cmd);
        else
            loopvar.setRange(range);
            range := listRange(range);
            result := WithBases(self,
                rec(operations := CmdOps, simt_idx := simt_idx, cmd := cmd, var := loopvar, range := range));
            loopvar.isLoopIndex := true;
            #loopvar.loop := result;
            return result;
        fi;
    end,

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

    ));

# A function that allows declaration specifiers (eg, __global__, __device__, etc..)
Class(specifiers_func, func, rec(
    __call__ := (self, decl_specs, ret, id, params, cmd) >> WithBases(self, rec(
            decl_specs := Checked(IsList(decl_specs), decl_specs),
            ret    := Checked(IsType(ret), ret),
            id     := Checked(IsString(id), id),
            params := Checked(IsList(params), params),
            cmd    := Checked(IsCommand(cmd), cmd),
            operations := CmdOps)),

    rChildren := self >> [self.decl_specs, self.ret, self.id, self.params, self.cmd],
    rSetChild := rSetChildFields("decl_specs", "ret", "id", "params", "cmd"),

    print := (self, i, si) >> Print(self.__name__, "(", self.decl_specs, ", ", self.ret, ", \"", self.id, "\", ", self.params, ", \n",
        Blanks(i+si), self.cmd.print(i+si, si), "\n", Blanks(i), ")", self.printA()),
    )
);

# sync primitives. Their relationship is defined by their sync scope (cluster < block < grid).
# A grid is composed of blocks and blocks of clusters (eg, cuda: grid, blocks, warps).

Class(simtSyncOps, CmdOps, rec(
    \< := (v1, v2) -> Cond(
                            ObjId(v1) = ObjId(v2) or ObjId(v1) = simt_syncgrid, false,
                            ObjId(v1) = skip, true,
                            ObjId(v1) = simt_synccluster and ObjId(v2) <> skip, true,
                            ObjId(v1) = simt_syncblock and not ObjId(v2) in [skip, simt_synccluster], true,
                            false
                        )
    ));

Class(simt_sync, call, rec(
    __call__ := (arg) >> let(o := Inherited(), CopyFields(o, rec(operations := simtSyncOps) ) )
    ));

Class(simt_synccluster, simt_sync);

Class(simt_syncblock, simt_sync);

Class(simt_syncgrid, simt_sync);

# unparsed into C-style printf

Class(cprintf, call);