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

# utility functions

Range0 := (a) -> When(IsList(a), [0..Length(a)-1], [0..a-1]);
Range1 := (a) -> When(IsList(a), [1..Length(a)], [1..a]);

# special rules for annotating the recursion level for all variables.
# allows us to just keep the variables, instead of also needing to keep
# the ISums.

_checkTag := function(e, cx)
    local sums;

    if IsBound(e.var.order) then
        return false;
    fi;

    sums :=  Filtered(cx.parents, e -> ObjId(e) = ISum);

    return (sums = [] or IsBound(Last(sums).var.order));
end;

_setTag := function(e, cx)
    local sums;

    sums :=  Filtered(cx.parents, e -> ObjId(e) = ISum);

    if sums = [] then
        e.var.order := 0;
    else
        e.var.order := Last(sums).var.order + 1;
    fi;

    return e;
end;

Class(_MissEstPreprocessJams, RuleSet);
Class(_MissEstSanitize, RuleSet);
Class(_MissEstRules, RuleSet);
Class(_MissEstCleanup, RuleSet);
Class(_MissEstInplace, RuleSet);

Class(_GSWrap, SumsBase, rec(
    __call__ := (self, rng, dmn, payload) >> WithBases(self, rec(
        _dmn := dmn,
        _rng := rng,
        _payload := payload,
        _children := []
    )),
    rChildren := (self) >> [],
    dims := (self) >> [
        StripList(List(self.rng(), (l) -> l.size)),
        StripList(List(self.dmn(), (l) -> l.size))
    ],
    rSetChild := (self, n, what) >> Error("no kids"),
    rng := (self) >> self._rng,
    dmn := (self) >> self._dmn,
    print := (self,i,is) >> Print(self.name)
));

Class(_AltBB, BB);
Class(_AltInplace, Inplace);

# wrapper needs an identifier, for later matching since two wraps
# are always spawned. See _MissEstInplace.InplaceExpand rule.
#
Class(_InplaceWrap, _GSWrap);
#SumsBase, BaseMat, rec(
#    new := (self, id) >> SPL(WithBases(self, rec(
#        id := id
#    )))
#));

Class(_KeepScat, Scat);
Class(_KeepGath, Gath);

RewriteRules(_MissEstPreprocessJams, rec(

 ComposeGathGath := ARule(Compose, [ @(1, Gath), @(2, [Gath, Prm]) ], # o 1-> 2->
     e -> [ Gath(fCompose(@(2).val.func, @(1).val.func)) ]),

 ComposeScatScat := ARule(Compose, [ @(1, [Scat, ScatAcc]), @(2, [Scat, ScatAcc]) ], # <-1 <-2 o
     e -> [ Cond(ObjId(@(1).val)=ScatAcc or ObjId(@(2).val)=ScatAcc,
                 ScatAcc(fCompose(@(1).val.func, @(2).val.func)),
                 Scat   (fCompose(@(1).val.func, @(2).val.func))) ]),

 PullInRight := ARule( Compose,
       [ @(1, [Prm, Scat, ScatAcc, TCast, PushR, PushLR, Conj, ConjL, ConjR, ConjLR, FormatPrm]),
         @(2, [RecursStep, Grp, BB, SUM, JamISum, Buf, ISum, ICompose, Data, COND, NoDiagPullin, NoDiagPullinLeft, NoDiagPullinRight, NeedInterleavedComplex]) ],
  e -> [ CopyFields(@(2).val, rec(
             _children :=  List(@(2).val._children, c -> @(1).val * c),
             dimensions := [Rows(@(1).val), Cols(@(2).val)] )) ]),

 PullInLeft := ARule( Compose,
       [ @(1, [RecursStep, Grp, BB, SUM, SUMAcc, JamISum, Buf, ISum, ICompose, ISumAcc, Data, COND, NoDiagPullin, NoDiagPullinLeft, NoDiagPullinRight, NeedInterleavedComplex]),
         @(2, [Prm, Gath, TCast, PushL, PushLR, Conj, ConjL, ConjR, ConjLR, FormatPrm]) ],
     e -> [ CopyFields(@(1).val, rec(
                _children := List(@(1).val._children, c -> c * @(2).val),
                dimensions := [Rows(@(1).val), Cols(@(2).val)] )) ]),
));

RewriteRules(_MissEstSanitize, rec(

    # sometimes there is a BB inside a BB. this is not good for me.
    # this removes all interior BBs
    RemoveInnerBB := Rule(@@(1,BB,(e,cx) -> ForAny(cx.parents, e -> ObjId(e) = BB)), e -> @@(1).val.rChildren()[1]),

    # BB cannot have an inplace inside of it, since all operations inside
    # the BB do not spill to memory.
    RemoveInnerInplaceFromBB := Rule(@@(1,Inplace,(e,cx) -> ForAny(cx.parents, e -> ObjId(e) = BB)), e -> @@(1).val.rChildren()[1]),

    # same thing with Inplace wrappers. leave only the outer.
    RemoveInnerInplace := Rule(@@(1,Inplace,(e,cx) -> ForAny(cx.parents, e -> ObjId(e) = Inplace)), e -> @@(1).val.rChildren()[1])
));

# we tag the BB with an inplace tag, if that basic block is to be performed
# inplace.

_tagBBin := function(bb, v)
    bb.inplin := v;
    return bb;
end;

_tagBBout := function(bb, v)
    bb.inplout := v;
    return bb;
end;

_tagInplace := function(k, v)
    k.inplace := v;
    return k;
end;

#
# this thing works very similarly to the keepgath/keepscat below. we start with
# the inplace tag, generate some wrappers from it, propagate the wrappers
# into the sigm-spl tree looking for a BB. once the wrappers hit the BB, they
# tag it.

RewriteRules(_MissEstInplace, rec(
    InplaceExpand := Rule(Inplace,  e ->
        let(i := Ind(2),
            _AltInplace(Compose(Concat(
                [_InplaceWrap(e.rng(), e.rng(), i)],
                e.rChildren(),
                [_InplaceWrap(e.dmn(), e.dmn(), i)]
            )))
        )
    ),

    WrapCompose := ARule(Compose, [@(1, _InplaceWrap), @(2, Compose)], e -> [
        Compose(
            Concat([@(1).val], @(2).val.rChildren())
        )
    ]),

    ComposeWrap := ARule(Compose, [@(1, Compose), @(2, _InplaceWrap)], e -> [
        Compose(
            Concat(@(2).val.rChildren(), [@(1).val])
        )
    ]),

    WrapISum := ARule(Compose, [@(2, _InplaceWrap), @(1, [ISum, JamISum])], e -> [
        CopyFields(@(1).val, rec(
            _children := [
                Compose(
                    @(2).val, # _GSWrap(@(1).val.rng(), @(1).val.rng()),
                    @(1).val.child(1)
                )
            ],
            dimensions := [Rows(@(1).val), Cols(@(2).val)]
        ))
    ]),

    ISumWrap := ARule(Compose, [@(1, [ISum, JamISum]), @(2, _InplaceWrap)], e -> [
        CopyFields(@(1).val, rec(
            _children := [
                Compose(
                    @(1).val.child(1),
                    @(2).val # _GSWrap(@(1).val.rng(), @(1).val.dmn()) # have to adjust the size as we move it in.
                )
            ],
            dimensions := [Rows(@(1).val), Cols(@(2).val)]
        ))
    ]),

    InplaceWrapBB := ARule(Compose, [@(1, _InplaceWrap), @(2,BB)], e -> [
        _tagBBout(@(2).val, @(1).val._payload)
    ]),

    BBInplaceWrap := ARule(Compose, [@(1, BB), @(2, _InplaceWrap)], e -> [
        _tagBBin(@(1).val, @(2).val._payload)
    ]),

    ComposeAssoc := ARule( Compose, [ @(1,Compose) ],  e -> @(1).val.children() )

));

#
# we push into the basic block to figure out the gath/scat which access memory.
#
RewriteRules(_MissEstRules, rec(

    # insert a first gather and last scatter. replace BB with
    # a fake for a while.
    BBExpand := Rule(BB,  e ->
        _AltBB(Compose(Concat(
            [_GSWrap(e.rng(), e.rng(), When(IsBound(e.inplout), e.inplout, false))],
            e.rChildren(),
            [_GSWrap(e.dmn(), e.dmn(), When(IsBound(e.inplin), e.inplin, false))])
        ))
    ),
    WrapCompose := ARule(Compose, [@(1, _GSWrap), @(2, Compose)], e -> [
        Compose(
            Concat([@(1).val], @(2).val.rChildren())
        )
    ]),

    ComposeWrap := ARule(Compose, [@(1, Compose), @(2, _GSWrap)], e -> [
        Compose(
            Concat(@(2).val.rChildren(), [@(1).val])
        )
    ]),

    WrapISum := ARule(Compose, [@(2, _GSWrap), @(1, [JamISum, ISum])], e -> [
        CopyFields(@(1).val, rec(
            _children := [
                Compose(
                    @(2).val, # _GSWrap(@(1).val.rng(), @(1).val.rng()),
                    @(1).val.child(1)
                )
            ],
            dimensions := [Rows(@(1).val), Cols(@(2).val)]
        ))
    ]),

    ISumWrap := ARule(Compose, [@(1, [JamISum, ISum]), @(2, _GSWrap)], e -> [
        CopyFields(@(1).val, rec(
            _children := [
                Compose(
                    @(1).val.child(1),
                    @(2).val # _GSWrap(@(1).val.rng(), @(1).val.dmn()) # have to adjust the size as we move it in.
                )
            ],
            dimensions := [Rows(@(1).val), Cols(@(2).val)]
        ))
    ]),

    GSWrapScat := ARule(Compose, [@(1, _GSWrap), @(2,Scat)], e -> [
        _tagInplace(_KeepScat(@(2).val.func), @(1).val._payload)
    ]),

    GathGSWrap := ARule(Compose, [@(1, Gath), @(2, _GSWrap)], e -> [
        _tagInplace(_KeepGath(@(1).val.func), @(2).val._payload)
    ]),

    ComposeAssoc := ARule( Compose, [ @(1,Compose) ],  e -> @(1).val.children() )
));

RewriteRules(_MissEstCleanup, rec(
    ISumTagVar := Rule(@@(1,[JamISum, ISum], _checkTag), _setTag),

    RemoveBlk := ARule(Compose, [Blk], e -> []),
    RemoveRCDiag := ARule(Compose, [RCDiag], e -> []),

#    RemoveScatGath := ARule(Compose, [Scat, Gath], e -> []),
#    RemoveGath := ARule(Compose, [Gath], e -> []),
#    RemoveScat := ARule(Compose, [Scat], e -> []),
    # collapse ISums with just one G or S inside.
#    ISumGath := Rule([ISum, @(1, [Gath, Scat])], e -> @(1).val),

    ComposeAssoc := ARule( Compose, [ @(1,Compose) ],  e -> @(1).val.children() ),

    AltBBtoBB := Rule(@(1, _AltBB), e -> BB(@(1).val.child(1))),

    AltInplacetoInplace := Rule(@(1,_AltInplace), e -> Inplace(@(1).val.child(1))),

#    ComposeAltInplacetoInplace := ARule(Compose, [@(1, _AltInplace)], e ->
#        [Inplace(@(1).val.child(1))]
#    ),

#    buggy rule. huh?
#    DropInplaceWrap := ARule(Compose, [@(1, _InplaceWrap)], e -> [])
));

# plot 1
# naive iterative inplace WHT(1M)

_returnAndReset := function(a)
    local t;

    t := a.switch;

    a.switch := false;

    return t;
end;

_set := function(a, v)
    a.switch := v;
end;

Class(cachesim, rec(
    __call__ := (self, e, s, a) >> WithBases(self, rec(
        e := e,
        s := s,
        a := a,

        tagstore := List(Range1(s), e ->
            List(Range1(a), ee ->
                rec(tag:=-1, time:=0)
            )
        ),
        count := 0,
		hash := false
    )),

    reset := meth(self)
        self.tagstore := List(Range1(self.s), e ->
            List(Range1(self.a), ee ->
                rec(tag:=-1, time:=0)
            )
        );
        self.count := 0;
    end,

    access := meth(self, addr)
        local setidx, tag, tagidx, new, bits, mask, shift;

		if self.hash then
			bits := Log2Int(self.a * self.s);
			mask := self.e * ((self.a * self.s) - 1);
			shift := bits;

			# we clip it (somewhat arbitrarily) at 30 bits.
			while (shift < 30) do
				addr := BinXor(
					addr,
					BinAnd(
						mask,
						Int(addr / shift)
					)
				);
				shift := shift + bits;
			od;
		fi;

		# add 1 for array offset
       	setidx := 1 + (Int(addr / self.e) mod self.s);

        tag := Int(addr / (self.e * self.s));

        tagidx := Filtered(Range1(self.a), e ->
            tag = self.tagstore[setidx][e].tag
        );

        # paranoia
        Constraint(Length(tagidx) <= 1);

        if Length(tagidx) = 0 then
            tagidx := self.a;
            self.tagstore[setidx][tagidx].tag := tag;
            new := 1;
        else
            tagidx := tagidx[1];
            new := 0;
        fi;

        self.count := self.count + 1;
        self.tagstore[setidx][tagidx].time := self.count;

        # sort based on access time, promotion to MRU happens here.
        Sort(self.tagstore[setidx], (a,b) -> a.time > b.time);

		# AppendTo("accesses", addr, " (", setidx, ", ", tagidx, "): ", new, "\n");
        return new;
    end,

    evaljam := meth(self, l, spl, res, jams)
        local l2, last, i, memaddr;

        if jams = [] then
            # get the actual address.
            memaddr := spl.array.offset + l.eval().v;

			# AppendTo("accesses", When(ObjId(spl) = _KeepGath, "G ", "S "));
            # perform the memory access!
            res.activ := res.activ + self.access(memaddr);
            res.access := res.access + 1;
        else

            last := Last(jams);

            for i in Range0(last.range) do
                l2 := Copy(l);

                SubstVars(l2, tab((last.id) := V(i)));

                self.evaljam(l2, spl, res, DropLast(jams, 1));

            od;
        fi;
    end,

	evalinner := meth(self, l, spl, res, inners, jams)
		local i, l2, last;

		if inners = [] then
        	for i in Range0(l.vars[1].range) do

            	l2 := Copy(l.at(i));

            	# now we have to deal with multiple jammed loops
            	# that means we have a nice little recursion here.
            	self.evaljam(l2, spl, res, jams);
        	od;
		else
			last := Last(inners);

			for i in Range0(last.range) do
				l2 := Copy(l);

				SubstVars(l2, tab((last.id) := V(i)));

				self.evalinner(l2, spl, res, DropLast(inners, 1), jams);
			od;
		fi;
	end,

    evalspl := meth(self, spl, data)
        local res, id, i, j, tres, l, l2;
        res := rec(access := 0, activ := 0);

        id := ObjId(spl);

        if id = ISum then

			# we evaluate ISums inside of BB differently
			if data.currsize <= data.K then
				# AppendTo("traverse", "inner ", spl.var.id, " ", spl.var.range,", ", data.currsize, "\n");
				Add(data.innervar, spl.var);
				data.currsize := data.currsize / spl.var.range;
            	tres := self.evalspl(spl.child(1), data);
				data.currsize := data.currsize * spl.var.range;
            	data.innervar := DropLast(data.innervar, 1);

            	res.access := res.access + tres.access;
            	res.activ := res.activ + tres.activ;

			else
				# AppendTo("traverse", "outer", spl.var.id, " ", spl.var.range,", ", data.currsize, "\n");
				data.currsize := data.currsize / spl.var.range;
            	for i in Range0(spl.var.range) do
                	Add(data.var, spl.var.id);
                	Add(data.val, V(i));
                	tres := self.evalspl(spl.child(1), data);
                	data.var := DropLast(data.var, 1);
                	data.val := DropLast(data.val, 1);

                	res.access := res.access + tres.access;
                	res.activ := res.activ + tres.activ;
            	od;
				data.currsize := data.currsize * spl.var.range;
			fi;

		elif id = BB then
			data.inBB := true;
            tres := self.evalspl(spl.child(1), data);
			data.inBB := false;

            res.access := res.access + tres.access;
            res.activ := res.activ + tres.activ;

        elif id = JamISum then
            Add(data.jamvar, spl.var);
            tres := self.evalspl(spl.child(1), data);
            data.jamvar := DropLast(data.jamvar, 1);

            res.access := res.access + tres.access;
            res.activ := res.activ + tres.activ;

        elif id = Compose then
            for i in Reversed(spl.children()) do
                tres := self.evalspl(i, data);
                res.access := res.access + tres.access;
                res.activ := res.activ + tres.activ;
            od;

        elif id = _KeepGath or id = _KeepScat then

            l := spl.func.lambda();

            # subst the normal loops
            DoForAll(Range1(data.var), e ->
                SubstVars(l, tab((data.var[e]) := data.val[e]))
            );

			# handle the innermost outer loop, nice little
			# recursion here.
			self.evalinner(l, spl, res, data.innervar, data.jamvar);

        else
            tres := List(spl.children(), e -> self.evalspl(e, data));
            res.access := Sum(List(tres, e -> e.access));
            res.activ := Sum(List(tres, e -> e.activ));
        fi;

        return res;
    end,

	applyRules := (self, s, o) >>
        ApplyStrategy(s, [
            _MissEstPreprocessJams,
            RulesFuncSimp,
            _MissEstSanitize,
            _MissEstInplace,
            _MissEstRules,
            _MissEstCleanup
        ], UntilDone, o),

    eval := meth(self, s, _K)
        local gath, scat, gf, sf, arrays, i;

        gath := Reversed(Collect(s, _KeepGath));
        scat := Reversed(Collect(s, _KeepScat));

        arrays := [TArray(TUnknown, gath[1].func.range())];

		# PrintTo("accesses", "\n");
		# PrintTo("traverse", "\n");

        # assign input/output arrays
        for i in Range1(gath) do

            # paranoia
            # Constraint(gath[i].func.domain() = scat[i].func.domain());

            gath[i].array := Last(arrays);

			# we can match any of the previous gather matrices.
			if scat[i].inplace <> false
				and ForAny(gath{[1..i]}, e -> e.inplace = scat[i].inplace) then

				scat[i].array :=
					Filtered(gath{[1..i]}, e -> e.inplace = scat[i].inplace)[1].array;
			else

                Add(arrays, TArray(TUnknown, scat[i].func.range()));
                scat[i].array := Last(arrays);
            fi;
        od;

        # descending order by size of array
        Sort(arrays, (a,b) -> a.size > b.size);

        # mark offsets
        arrays[1].offset := 0;

        # propagate offsets
        for i in [2..Length(arrays)] do
            arrays[i].offset := arrays[i-1].offset + arrays[i-1].size;
        od;

        # traverse the spl expression.
        return self.evalspl(s, rec(
			m := s.dims()[1],
			K := _K,

			currsize := s.dims()[1],
			var:=[],
			val:=[],
			innervar := [],
			jamvar:=[]
		));
    end,
));


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

# Extension of RulesRC/Sums/Diag to SIMT operators.

RewriteRules(RulesRC, rec(
    RC_SIMTISum := Rule([RC, @(1, SIMTISum)], e -> SIMTISum(@(1).val.simt_dim, @(1).val.var, @(1).val.domain, RC(@(1).val.child(1)))),
     RC_SIMTSUM := Rule([RC, @(1, SIMTSUM)], e -> SIMTSUM(@(1).val.simt_dim, List(@(1).val.children(), RC)))
    ));

RewriteRules(RulesSums, rec(
    SIMTSUMAssoc := ARule( SIMTSUM, [ @(1,SIMTSUM) ],
                            function(e) # Substitute rngs from inner SIMTSUM in simt_dim
                                local pos;

                                pos := Position(e.children(), @(1).val);
                                e.simt_dim := e.simt_dim.update_simt_range(pos, @(1).val.simt_dim);
                                return @(1).val.children();
                            end ),

    PullInRightSIMTSums := ARule( Compose,
            [ @(1, [Prm, Scat, ScatAcc, TCast, PushR, PushLR, Conj, ConjL, ConjR, ConjLR, FormatPrm]),
              @(2, [SIMTISum, SIMTSUM]) ],
              e -> [ CopyFields(@(2).val, rec(
                        _children :=  List(@(2).val._children, c -> @(1).val * c),
                        dimensions := [Rows(@(1).val), Cols(@(2).val)] )) ]),

    PullInLeftSIMTSums := ARule( Compose,
           [ @(1, [SIMTISum, SIMTSUM]),
             @(2, [Prm, Gath, TCast, PushL, PushLR, Conj, ConjL, ConjR, ConjLR, FormatPrm]) ],
             e -> [ CopyFields(@(1).val, rec(
                    _children := List(@(1).val._children, c -> c * @(2).val),
                    dimensions := [Rows(@(1).val), Cols(@(2).val)] )) ]),
    ));

RewriteRules(RulesDiag, rec(
    DiagSIMTISumLeft := ARule( Compose,
           [ @(1, SIMTISum, canReorder), @(2, RightPull) ],
      e -> [ SIMTISum(@1.val.simt_dim, @1.val.var, @1.val.domain, @1.val.child(1) * @2.val).attrs(@(1).val) ]),

    DiagSIMTISumRight := ARule( Compose,
             [ @(1, LeftPull), @(2, SIMTISum, canReorder) ],
        e -> [ SIMTISum(@2.val.simt_dim, @2.val.var, @2.val.domain, @1.val * @2.val.child(1)).attrs(@(2).val) ]),

     DiagSIMTSUMPullInRight := ARule( Compose,
           [ @(1, LeftPull), @(2, SIMTSUM) ],
      e -> [ ApplyFunc(ObjId(@2.val), [@2.val.simt_dim]::List(@2.val.children(), c -> @1.val * c)) ]),

     DiagSIMTSUMPullInLeft  := ARule( Compose,
           [ @(1, SIMTSUM), @(2, RightPull) ],
      e -> [ ApplyFunc(ObjId(@1.val), [@1.val.simt_dim]::List(@1.val.children(), c -> c * @2.val)) ]),

    ));

RewriteRules(RulesDiagStandalone, rec(
    # Gath * SIMTIDirSum
    CommuteGathSIMTIDirSum := ARule( Compose,
            [ [@(1, Gath), [@(3,fTensor), ..., [fId,@(2)]]],
              [@(0, [PushL, PushLR]), @(4, SIMTIDirSum, e -> (@(2).val mod Rows(e.child(1))) = 0)]
            ],
            e -> let(
                    ch := DropLast(@(3).val.children(), 1),
                    ratio := @(2).val / Rows(@(4).val.child(1)),
                    f := When(ratio=1, fTensor(ch), fTensor(Concatenation(ch, [fId(ratio)]))),
                    simt_dim := @(4).val.simt_dim,
                    j := @(4).val.var,
                    jj := Ind(f.domain()),

                    [ ObjId(@(0).val)(SIMTIDirSum(simt_dim, jj,      #SubstVars(@(4).val.child(1), rec((j.id) := f.at(jj)))),
                        Data(j, f.at(jj), SubstTopDown(@(4).val.child(1), @(5,fBase,e->e.params[2]=j),
                                                e -> fCompose(f, fBase(jj)))))),
                        @(1).val ]
                )
    ),

    # SIMTIDirSum * Scat
    CommuteSIMTIDirSumScat := ARule( Compose,
            [ [@(0,[PushR, PushLR]), @(4, SIMTIDirSum)],
              [@(1, Scat), [@(3,fTensor), ..., [fId,@(2).cond(e -> (e mod Cols(@(4).val.child(1))) = 0)]]]
            ],

            e -> let(
                    ch := DropLast(@(3).val.children(), 1),
                    ratio := @(2).val / Cols(@(4).val.child(1)),
                    f := When(ratio=1, fTensor(ch), fTensor(Concatenation(ch, [fId(ratio)]))),
                    simt_dim := @(4).val.simt_dim,
                    j := @(4).val.var,
                    jj := Ind(f.domain()),

                   [ @(1).val,
                     ObjId(@(0).val)(SIMTIDirSum(simt_dim, jj,      #SubstVars(@(4).val.child(1), rec((j.id) := f.at(jj)))),
                           Data(j, f.at(jj), SubstTopDown(@(4).val.child(1), @(5,fBase,e->e.params[2]=j),
                                               e -> fCompose(f, fBase(jj)))))) ]
                )
    ),

));

ext: gi

max_stars_repo_name: mikefranusich/spiral-package-simt

max_issues_repo_name: mikefranusich/spiral-package-simt

max_forks_repo_name: mikefranusich/spiral-package-simt


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

IsSIMD_ISA := x -> IsRec(x) and IsBound(x.isSIMD_ISA) and x.isSIMD_ISA=true;
IsISA      := x -> IsRec(x) and IsBound(x.isISA) and x.isISA=true;

Declare(ISAOps);
ISAOps := rec(
    operations := OpsOps,
    name := "ISAOps",
    Print := s->s.print(),
    # backward compatibility hack - descendants equal to parent classes
    \= := (c1, c2) -> Same(c1,c2) or (IsISA(c1) and IsISA(c2) and (Same(ObjId(c1),c2) or Same(c1,ObjId(c2)) or c1.id()=c2.id())),
    \< := (c1, c2) -> not ISAOps.\=(c1, c2) and Cond(not IsISA(c1) or not IsISA(c2), BagAddr(c1) < BagAddr(c2),  c1.id()<c2.id()),
);

Class(ISA, rec(
    verbose := false,
    isISA   := true,
    id      := self >> self.__name__,

    fixProblems := (c,opts) -> c,

    rChildren := self >> [],
    from_rChildren := (self, rch) >> self,

    gt := self >> self.t,

    operations := ISAOps,
    print := self >> Print(self.__name__, When(self._cplx, ".cplx()", "")),

    autolib := rec(
        includes      := () -> [], # list of includes, ex: [ "<pmmintrin.h>" ]
        timerIncludes := () -> [], # list of timer includes
    ),
    # wrap(<spl>) wraps spl to ISA boundaries container (at this moment VContainer)
    wrap := (self, spl) >> spl,
));

Class(SIMD_ISA, ISA, rec(
    isSIMD_ISA := true,

    _cplx := false,

    # isCplx()
    isCplx := self >> self._cplx,

    # cplx()  -- set the complex vectorization flag, which makes .getV() return v/2
    #            which is needed so that VContainer inside complex vectorization
    #            region correctly resolves its vector length
    cplx := self >> CopyFields(self, rec(_cplx := true)),

    # uncplx()  -- unset the complex vectorization flag, which makes .getV() return v
    #              which is needed so that VContainer inside complex vectorization
    #              region correctly resolves its vector length
    uncplx := self >> CopyFields(self, rec(_cplx := false)),

    # getV() -- returns the effective vector length that should be used, it is
    #           equal to ISA's vector length normally, but inside complex vector-
    #           ization regions it is vlen/2.
    getV := self >> Cond(self._cplx, self.v/2, self.v),

    getTags := self >> [AVecReg(self)],
    getTagsCx := self >> [AVecRegCx(self)],
    getOpts := self >> self.splopts,
    rules_loaded := false,
    rules_built := false,
    setRules := meth(self, rules)
                    self.rules := rules;
                    self.rules_loaded := true;
                end,
    flushRules := meth(self)
                      self.rules_loaded := false;
                      self.rules_built := false;
                      if IsBound(self.rules) then Unbind(self.rules); fi;
                  end,

    # realVect()  -- returns true if real vectorization is allowed
    realVect := True,
    # cplxVect()  -- returns true if complex vectorization is allowed
    cplxVect := True,

    simpIndicesInside := [], # to which instructions we should apply expensive index simplification rules,
                             # these should include gather/scatter instructions
    # ISA atomic data type
    gt := self >> self.t.t,

    wrap := (self, spl) >> spiral.paradigms.vector.sigmaspl.VContainer(spl, self),

    #F .loadCont(<n>, <y>, <yofs>, <x>, <xofs>, <xofs_align>)
    #F
    #F Read <n> values from address <x> + <xofs> into (lower) slots in vector pointer at <y> + <yofs>
    #F
    #F <n> - integer, how many points to load, must be <= self.v
    #F <y> - destination pointer
    #F <yofs> - destination offset in vectors
    #F <x> - source pointer
    #F <xofs> - source offset
    #F <xofs_align> - alignment, must be (xofs mod self.v), this parameter allows us
    #F                to pass in a simplified expression which may be constant
    #F
    #F Assumptions: 1 <= n <= self.v
    #F              xofs_align = xofs mod self.v
    #F
    #F When n = self.v, this operation becomes an unaligned load (unless xofs_align=0)
    #F
    loadCont := (self, n, y, yofs, x, xofs, xofs_align, opts) >> let(
	a  := _unwrap(xofs_align),
	nn := _unwrap(n),
	yy := vtref(self.t, y, yofs),
        When(IsBound(self.loadc_align) and IsInt(a) and not IsUnalignedPtrT(x.t),
	     self.loadc_align(nn, a, opts)(yy, x, xofs),
	     self.loadc(nn, opts)(yy, nth(x, xofs)))),

    #F .storeCont(<n>, <y>, <yofs>, <yofs_align>, <x>, <xofs>)
    #F
    #F Store (lower) <n> values from address <x> + <xofs> into address <y> + <yofs>
    #F
    #F <n> - integer, how many points to store, must be <= self.v
    #F <y> - destination pointer
    #F <yofs> - destination offset
    #F <yofs_align> - alignment, must be (yofs mod self.v), this parameter allows us
    #F                to pass in a simplified expression which may be constant
    #F <x> - source pointer
    #F <xofs> - source offset in vectors
    #F
    #F Assumptions: 1 <= n <= self.v
    #F              yofs_align = yofs mod self.v
    #F
    #F When n = self.v, this operation becomes an unaligned load (unless yofs_align=0)
    #F
    storeCont := (self, n, y, yofs, yofs_align, x, xofs, opts) >> let(
	a  := _unwrap(yofs_align),
	nn := _unwrap(n),
	xx := vtref(self.t, x, xofs),
        When(IsBound(self.storec_align) and IsInt(a) and not IsUnalignedPtrT(y.t),
	     self.storec_align(nn, a, opts)(y, yofs, xx), # storec_align is not implemented anywhere
	     self.storec[nn](nth(y, yofs), xx))),

    storeContAcc := (self, n, y, yofs, yofs_align, x, xofs, opts) >> let(
	a  := _unwrap(yofs_align),
	nn := _unwrap(n),
	xx := vtref(self.t, x, xofs),
	t  := TempVec(TArray(xx.t.t, xx.t.size)),
	decl([t], chain(
	    self.loadCont(nn, t, 0, y, yofs, yofs_align, opts),
	    assign(vtref(self.t, t, 0), vtref(self.t, t, 0) + xx),
	    self.storeCont(nn, y, yofs, yofs_align, t, 0, opts)))),

    # ===============================================================================
    # Other fields that must be defined in subclasses

    # Required:
    #  active
    #  bin_shl1  bin_shl2  bin_shr1  bin_shr2  bin_shrev
    #  bits, ctype, t, v
    #  countrec
    #  includes
    #  info
    #  instr
    #  isFixedPoint, isFloat
    #  loadc + loadc_align (optional)  OR  loadCont
    #  mul_cx, mul_cx_conj
    #  reverse
    #  splopts
    #  storec  OR  storeCont
    #  svload
    #  svstore
    #  RCVIxJ2
    #  dupload, duploadn
    #  hadd
    #  swap_cx
    #  vzero

    # Fixed point:
    #  fracbits
    #  saturatedArithmetic

    # Viterbi:
    #  interleavedmask, hmin, average (?), isSigned

    # Hacks (used in 2x32f), supported but not required:
    #  loadop,      requireLoad
    #  storeop,     requireStore
    #  scalarVar,   needScalarVarFix

));

IsSIMD_ISA := x -> IsRec(x) and IsBound(x.isSIMD_ISA) and x.isSIMD_ISA=true;
IsISA      := x -> IsRec(x) and IsBound(x.isISA) and x.isISA=true;

Class(SIMD_ISA_DB, rec(
    verbose := false,
    isa_db := rec(),
    addISA := meth(self, isa) self.isa_db.(isa.name) := isa; end,
    installed := self >> Filtered(RecFields(self.isa_db), x -> not IsSystemRecField(x)),
    active := self >> List(Filtered(Filtered(RecFields(self.isa_db), x -> not IsSystemRecField(x)), e->self.isa_db.(e).active), k->self.isa_db.(k)),
    info := self >> Print("\nSpiral SIMD ISA database\n",
                          "installed ISAs: ", PrintCS(self.installed()), "\n",
                          "active ISAs: ", PrintCS(self.active()), "\n"),
    getISA := (self, isa) >> self.isa_db.(isa),
#------------------------------------------
    HASH_FILE := file -> let(p := Conf("path_sep"), base := Conf("spiral_dir"), Concat(base, p, "namespaces", p, "spiral", p, "platforms", p, "_", file, "_generated1.gi")),
    RULES_FILE := file -> let(p := Conf("path_sep"), base := Conf("spiral_dir"), Concat(base, p, "namespaces", p, "spiral", p, "platforms", p, "_", file, "_generated0.gi")),
    hash := HashTableDP(),
    hashFlush := meth(self) self.hash := HashTableDP(); end,
    hashSave := meth(self)
                    local _entry, entry, item, isa;
                    if self.verbose then Print("saving hash\n"); fi;
                    _entry := Flat(Filtered(self.hash.entries, True));

                    for isa in self.active() do
                        PrintTo(self.HASH_FILE(isa.file), "");
                    od;

                    for isa in self.active() do
#                        Error();
                        for entry in Filtered(_entry, (a) -> a.key.getTags()[1].isa = isa)  do
#                            for item in entry  do
                            item := entry; #only save first hash entry
                            AppendTo(self.HASH_FILE(isa.file), self.name, ".hashAdd(", item.key, ", ", item.data, ");\n");
#                            od;
                        od;
                    od;
                end,
    hashAdd := meth(self, a, b) HashAdd(self.hash, a,b); end,
    getHash:= self >> Copy(self.hash),
    hash_rebuilt := false,
    rules_rebuilt := false,
    init0 := meth(self)
        local isa;
        self.rules_rebuilt := false;
        if self.verbose then Print("\n"); fi;
        for isa in self.active() do
            if self.verbose then Print(isa, ": base cases...\n"); fi;
            if not IsBound(isa.rules) then
                Print(isa, " rules are being rebuilt and saved...\n");
                isa.buildRules();
                self.rules_rebuilt := true;
            fi;
        od;
        if self.rules_rebuilt then self.saveRules(); fi;
    end,
    init1 := meth(self)
        local isa;
        self.hash_rebuilt := false;
        if self.verbose then Print("\n"); fi;
        for isa in self.active() do
            if self.verbose then Print(isa, ": TL hash...\n"); fi;
            if not self.checkBases(isa) then
                Print(isa, " hash is being rebuilt and saved...\n");
                self.buildBases(isa);
                self.hash_rebuilt := true;
            fi;
        od;
        if self.hash_rebuilt then self.hashSave(); fi;
    end,
    saveRules := meth(self)
                    local isa;
                    if self.verbose then Print("saving rules\n"); fi;
                    paradigms.vector.sigmaspl.VPerm.plong();

                    for isa in self.active() do
                        PrintTo(self.RULES_FILE(isa.file), "");
                    od;

                    for isa in self.active() do
                        if IsBound(isa.rules) then
                            AppendTo(self.RULES_FILE(isa.file), isa.name, ".setRules(", isa.rules, ");\n");
                        fi;
                    od;
                    paradigms.vector.sigmaspl.VPerm.pshort();
                 end,
    reset := meth(self)
                local isa, verb;
                verb := self.verbose;
                for isa in self.active() do
                    PrintTo(self.RULES_FILE(isa.file), "");
                    PrintTo(self.HASH_FILE(isa.file), "");
                od;
                self.verbose := true;
                self.hashFlush();
                for isa in self.active() do
                    isa.flushRules();
                od;
                self.init0();
                self.init1();
                self.verbose := verb;
             end,
    required_bases := isa -> Concat(
            When(isa.realVect(), [
                arch -> TL(2*arch.v,2,1,1).withTags(arch.getTags()),
                arch -> TL(2*arch.v,arch.v,1,1).withTags(arch.getTags()),
                arch -> TL(arch.v^2,arch.v,1,1).withTags(arch.getTags()) ], []),
            When(isa.cplxVect(), [
                arch -> TL(arch.v^2/4,arch.v/2,1,2).withTags(arch.getTags()) ], []),
            When(isa.cplxVect() and isa.v=8, [
                arch -> TL(4,2,1,2).withTags(arch.getTags()) ], [])),
    getBases := (self, isa) >> List(self.required_bases(isa), i-> i(isa)),
    lookupBases := (self, isa) >> List(self.getBases(isa), i-> HashLookup(self.hash, i)),
    checkBases := (self, isa) >> not ForAny(self.lookupBases(isa), i -> i=false or i=[])
));


text:
InstallGlobalFunction(MEMO_DiskCache,
function(memo, path)
  local dir, cache, type;

  # Directory for this function
  dir := Filename(Directory(path), memo!.funcname);

  # Make cache object
  cache := rec(memo := memo,  # memoised function
               dir := dir);  # directory for storing results
  # Objectify
  type := NewType(DictionariesFamily, MEMO_IsDiskCache);
  cache := Objectify(type, cache);

  return cache;
end);

InstallMethod(AddDictionary,
"for a memoisation disk cache and two objects",
[MEMO_IsDiskCache, IsObject, IsObject],
function(cache, key, val)
  local memo, filename, str, write, key_filename, key_str, metadata_filename,
        metadata_str;
  memo := cache!.memo;

  # Create directory if needed
  if not IsDirectoryPath(cache!.dir) then
    MEMO_CreateDirRecursively(cache!.dir);
  fi;

  # Get filename for storage
  filename := MEMO_KeyToFilename(cache, key, MEMO_OUT);
  Info(InfoMemoisation, 3, "Using filename ", filename);

  # Write to disk
  str := memo!.pickle(val);
  write := FileString(filename, str);
  if write = fail then
    Error("Memoisation: could not write result to ", filename);
    # user can "return;" and result will still be returned
  else
    Info(InfoMemoisation, 3, "Result stored in file");
  fi;

  # OPTION: storekey
  if memo!.storekey then
    key_filename := MEMO_KeyToFilename(cache, key, MEMO_KEY);
    key_str := memo!.pickle(key);
    FileString(key_filename, key_str);
    Info(InfoMemoisation, 3, "Key stored at ", key_filename);
  fi;

  # OPTION: metadata
  if memo!.metadata <> fail then
    metadata_filename := MEMO_KeyToFilename(cache, key, MEMO_META);
    metadata_str := memo!.metadata();
    FileString(metadata_filename, metadata_str);
    Info(InfoMemoisation, 3, "Metadata stored at ", metadata_filename);
  fi;

  # no return value
end);

InstallMethod(KnowsDictionary,
"for a memoisation disk cache and an object",
[MEMO_IsDiskCache, IsObject],
function(cache, key)
  local filename;
  filename := MEMO_KeyToFilename(cache, key, MEMO_OUT);
  return IsReadableFile(filename);
end);

InstallMethod(LookupDictionary,
"for a memoisation disk cache and an object",
[MEMO_IsDiskCache, IsObject],
function(cache, key)
  local memo, filename, key_filename, key_str, storedkey, str, val;
  memo := cache!.memo;

  # Get filename
  filename := MEMO_KeyToFilename(cache, key, MEMO_OUT);
  Info(InfoMemoisation, 3, "Using filename ", filename);
  if not IsReadableFile(filename) then
    # We shouldn't normally get here, as we usually check KnowsDictionary first
    Info(InfoMemoisation, 1, "File ", filename, " not readable");
    return fail;
  fi;

  # OPTION: storekey
  if memo!.storekey then
    key_filename := MEMO_KeyToFilename(cache, key, MEMO_KEY);
    key_str := StringFile(key_filename);
    storedkey := memo!.unpickle(key_str);
    # check if key still matches
    if key <> storedkey then
      ErrorNoReturn("Hash collision: <key> does not match <storedkey>");
    fi;
    Info(InfoMemoisation, 3, "Key matches ", key_filename);
  fi;

  # OPTION: unhash
  if memo!.unhash <> fail then
    # unhash and check if key still matches
    storedkey := MEMO_FilenameToKey(cache, filename);
    if key <> storedkey then
      ErrorNoReturn("Hash collision: <key> does not match <storedkey>");
    fi;
  fi;

  # Load result
  str := StringFile(filename);
  Info(InfoMemoisation, 4, "Got ", Length(str), " bytes from file");
  val := memo!.unpickle(str);

  return val;
end);

InstallMethod(MEMO_ClearCache,
"for a memoisation disk cache",
[MEMO_IsDiskCache],
function(cache)
  local dir, file, ext, path, result;
  dir := cache!.dir;
  if not IsDirectoryPath(dir) then
    return true;
  fi;
  for file in DirectoryContents(dir) do
    for ext in [MEMO_OUT, MEMO_KEY, MEMO_META] do
      if EndsWith(file, ext) then
        path := Filename(Directory(dir), file);
        if RemoveFile(path) <> true then
          Info(InfoMemoisation, 1, "Failed to delete ", path);
        fi;
      fi;
    od;
  od;
  result := RemoveDir(dir);
  if result = true then
    return true;
  fi;
  return false;
end);

InstallGlobalFunction(MEMO_KeyToFilename,
function(cache, key, ext)
  local h, fname;
  h := cache!.memo!.hash(key);
  fname := Concatenation(h, ext);
  return Filename(Directory(cache!.dir), fname);
end);

InstallGlobalFunction(MEMO_FilenameToKey,
function(cache, filename)
  local pos, h;
  if StartsWith(filename, cache!.dir) then  # remove directory
    filename := filename{[Length(cache!.dir) + 2 .. Length(filename)]};
  fi;
  # Remove extension
  pos := Remove(Positions(filename, '.'));  # position of final dot
  h := filename{[1 .. pos - 1]};
  return cache!.memo!.unhash(h);
end);

InstallGlobalFunction(MEMO_CreateDirRecursively,
function(dir)
  # Borrowed from PackageManager
  local path, newdir, i, res;
  path := SplitString(dir, "/");
  newdir := "";
  for i in [1 .. Length(path)] do
    Append(newdir, path[i]);
    Append(newdir, "/");
    if not IsDirectoryPath(newdir) then
      res := CreateDir(newdir);
      if res <> true then
        return fail;
      fi;
    fi;
  od;
  return true;
end);

max_stars_repo_name: gap-packages/Memoisation

max_issues_repo_name: gap-packages/Memoisation

max_forks_repo_name: gap-packages/Memoisation


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

#Class(MultiBufBB, RuleSet);
#RewriteRules(MultiBufBB, rec(
#     remove_bbs := Rule(@(1, Compose, e->ForAll(e.children(), c->ObjId(c)=DistSum)),
#        e -> ComposeDists(@(1).val.children()) )
#));

applyCellInplace := function(sums, opts)
    SubstBottomUp(sums, GathDist, e->Inplace(e));
    SubstBottomUp(sums, GathRecv, e->Inplace(e));
    SubstBottomUp(sums, ScatDist, e->Inplace(e));

    SubstBottomUp(sums, ScatMem, e->Inplace(e));
    SubstBottomUp(sums, GathMem, e->Inplace(e));

    # BB(Inplace()) -> Inplace() (So that a copy operation need not take place)
    SubstBottomUp(sums, [BB, Inplace], e->e.rChildren()[1]);
    return(sums);
end;

#s := SubstBottomUp(s, ScatMem, e->Inplace(e));
#s := SubstBottomUp(s, GathMem, e->Inplace(e));
#s := SubstBottomUp(s, [BB, Inplace], e->e.rChildren()[1]);

# DistSum(Scat__ * MultiBufISum() * Gath__) -> DistSumLoop(MultiBufISum(ScatMem * () * GathMem))

# DistSum has to be converted to a DistSumLoop because DistSum expects its Scat
# and Gath to span the entire expanse of the computation, and therefore assumes
# an appropriate Scat/Gath. DistSumLoop does not.

doMultiBufBC := function(sums, opts)
    Error("doMultiBufBC: BP");
    return(sums);
end;

#F Dist(MultiBuf) is for independent DFTs running on separate SPEs (or sets of
#F SPEs), each multibuffered separately
Class(DistMultiBuf, RuleSet);

RewriteRules(DistMultiBuf, rec(
     # HACK: rule assumes we do only independent DFTs
     join_dist_multibuf_compose := Rule([@(1,DistSum), @, @(2,Compose, e->Length(Collect(e.rChildren()[1], MultiBufISum))=1) ],
       e -> let(
          dsum := @(1).val,
          Error(""),
          msum := Collect(@(2).val, MultiBufISum)[1],
          sp   := Collect(dsum, @(3,[ScatDist, ScatSend]))[1],
          sm   := msum.scatmem,
          sdm  := fCompose(sp.func, fTensor(sm.func, fId(sm.pkSize/sp.pkSize))),

          gp   := Collect(dsum, @(3,[GathDist, GathRecv]))[1],
          gm   := msum.gathmem,
          gdm  := fCompose(gp.func, fTensor(gm.func, fId(gm.pkSize/gp.pkSize))),

          DistSumLoop(dsum.P, dsum.var, dsum.domain,
            MultiBufISum(msum.var, msum.domain,
              #ScatDirectMem(sdm, sp.pkSize, dsum.P, dsum.var),
              ScatMem(sdm, sp.pkSize),
              msum.rChildren()[2],
              #GathDirectMem(gdm, gp.pkSize, dsum.P, dsum.var)
              GathMem(gdm, gp.pkSize)
            )
          )
       )
     ),

     join_dist_multibuf_separate := Rule(@(1, DistSum, e->Length(Collect(e.rChildren()[2], MultiBufISum))=1),
       e -> let(
          dsum := @(1).val,
          msum := Collect(@(1).val, MultiBufISum)[1],

          sp   := Collect(dsum, @(3,[ScatDist, ScatSend]))[1],
          sm   := msum.scatmem,
          spm  := fCompose(fTensor(sp.func, fId(sp.pkSize/sm.pkSize)), sm.func),

          gp   := Collect(dsum, @(3,[GathDist, GathRecv]))[1],
          gm   := msum.gathmem,
          gpm  := fCompose(fTensor(gp.func, fId(gp.pkSize/gm.pkSize)), gm.func),

          DistSumLoop(dsum.P, dsum.var, dsum.domain,
            MultiBufISum(msum.var, msum.domain,
              #ScatDirectMem(spm, sp.pkSize, dsum.P, dsum.var),
              ScatMem(spm, sm.pkSize),
              msum.rChildren()[2],
              #GathDirectMem(gpm, gp.pkSize, dsum.P, dsum.var)
              GathMem(gpm, gm.pkSize)
            )
          )
       )
     )

));

#F MultiBuf(Dist) is for parallel DFTs that are multibuffered
#F We pull out a parallel scat (gath) function into the multibufisum's scat (gath) function
#F Sums becomes invalid (strictly speaking) because we now use loop vars outside of their definition.
Class(MultiBufDist, RuleSet);
RewriteRules(MultiBufDist, rec(
    # This has to be done exactly once, else will loop infinitely. Look at hack below
    #NOTE: The rule below doesn't seem to fire. Probably doesn't match becacuse of the # of @'s at the end in this line:
     join_multibuf_dist_compose := Rule([@(1,[MultiBufISum,MemISum]), @(2,[Compose,ComposeDists], e->Length(Collect(e.rChildren()[2], DistSum))=1), @, @ ],
       e -> let(

          #HACK: clean way of getting the right gath/scat is to ask for the Compose's leftmost Scat/Gath
          msum := @(1).val,
          dsums := Collect(@(2).val, DistSum),
          dsum1 := dsums[1],
          dsum2 := dsums[Length(dsums)],

          sd   := Collect(dsum1, @(3,[ScatDist, ScatSend]))[1],
          sm   := msum.scatmem,
          sdm  := fCompose(fTensor(sm.func, fId(sm.pkSize/sd.pkSize)), sd.func),

          gd   := Collect(dsum2, @(3,[GathDist, GathRecv]))[1],
          gm   := msum.gathmem,
          gdm  := fCompose(fTensor(gm.func, fId(gm.pkSize/gd.pkSize)), gd.func),

          isum := When(ObjId(@(1).val)=MultiBufISum, MultiBufISumFinal, MemISumFinal),

          # HACK: Converting to a MultiBufISumFinal so this rule won't match more than once
          isum(msum.var, msum.domain,
              ScatMem(sdm, sd.pkSize),
              msum.rChildren()[2],    #NOTE: is this okay?
              GathMem(gdm, gd.pkSize)
          )
       )
     ),

     join_multibuf_dist_separate := Rule(@(1, MultiBufISum, e->Length(Collect(e.rChildren()[2], DistSum))=1),
       e -> let(

          msum := @(1).val,
          dsum := Collect(@(1).val, DistSum)[1],

          sd   := Collect(dsum, @(3,[ScatDist, ScatSend]))[1],
          sm   := msum.scatmem,
          sdm  := fCompose(fTensor(sm.func, fId(sm.pkSize/sd.pkSize)), sd.func),

          gd   := Collect(dsum, @(3,[GathDist, GathRecv]))[1],
          gm   := msum.gathmem,
          gdm  := fCompose(fTensor(gm.func, fId(gm.pkSize/gd.pkSize)), gd.func),

          # HACK: Converting to a MultiBufISumFinal so this rule won't match more than once
          MultiBufISumFinal(msum.var, msum.domain,
              ScatMem(sdm, sd.pkSize),
              msum.rChildren()[2],    #NOTE: is this okay?
              GathMem(gdm, gd.pkSize)
          )
       )
     )
));

#F MultiBufDist_large is for large DFTs that must be multibuffered in parts.
#F Since the multibuf loop is the outer loop, it assumes the "chip" can bring
#F data from memory on to it. In reality, "chips" don't exist -- only cores do. So
#F this rule distributed chip access across the core. It's different from the
#F MultiBufDist rule in that it doesn't interact with the inside DistSum's
#F Scatters or gathers. It does use the parallel loop var outside of its
#F definition when done.

Class(MultiBufDist_large, RuleSet);

RewriteRules(MultiBufDist_large, rec(
    distribute_scatgathmems := Rule(@(1, MultiBufISum, e->Length(Collect(e.rChildren()[2], DistSum))>=1 ),
      e -> let(

        msum  := @(1).val,
        dsum  := Collect(@(1).val, DistSum)[1],
        sm    := msum.scatmem,
        gm    := msum.gathmem,

        sf    := When(sm.func.domain()=1, dsum.P, 1),
        gf    := When(gm.func.domain()=1, dsum.P, 1),

        sfunc := When(sf=1, sm.func, fTensor(sm.func, fId(sf))),
        gfunc := When(gf=1, gm.func, fTensor(gm.func, fId(gf))),

        Ns    := sf*sm.func.range()/msum.domain,
        ns    := sf*sm.func.domain()/dsum.P,
        bs    := (dsum.var * ns),

        Ng    := gf*gm.func.range()/msum.domain,
        ng    := gf*gm.func.domain()/dsum.P,
        bg    := (dsum.var * ng),

        smnew := ScatMem(fCompose(sfunc, H(Ns, ns, bs, 1)), sm.pkSize/sf),
        gmnew := GathMem(fCompose(gfunc, H(Ng, ng, bg, 1)), gm.pkSize/gf),

        #Error("BP"),

        isum := When(ObjId(@(1).val)=MultiBufISum, MultiBufISumFinal, MemISumFinal),

        isum(msum.var, msum.domain,
            smnew,
            msum.rChildren()[2],    #NOTE: is this okay?
            gmnew
        )
      )
    )
));

# HACK!!!
# This is the way the system works: the above rules (RulesVRC) passes VRCL and
# VRCR tags to the scat and gath of a multibufisum. BUT, these have
# cannotchangedataformat set to true, AND, they're not exposed to the VRC
# rules. So the VRC rules don't really touch these. So in some cases, they end
# up with VRCL and VRCR, when in reality, they don't have either. The following
# rule "fixes" this problem by simply assuming they're either VRCs or VRCLRs.
# Hackity hack.
RewriteRules(RulesVRC, rec(
    VRC_MultiBufISum := Rule([@(1, [VRC,VRCL,VRCR,VRCLR]), @(2, [MultiBufISum])],
       e->let(v := @(1).val,
              m := @(2).val,
              MultiBufISum(m.var, m.domain,
                ObjId(v)(m.scatmem, v.v),
                ObjId(v)(m._children[1], v.v),
                ObjId(v)(m.gathmem, v.v))
              )
       ),
    VRC_MemISum := Rule([@(1, [VRC,VRCL,VRCR,VRCLR]), @(2, [MemISum])],
       e->let(v := @(1).val,
              m := @(2).val,
              MemISum(m.var, m.domain,
                ObjId(v)(m.scatmem, v.v),
                ObjId(v)(m._children[1], v.v),
                ObjId(v)(m.gathmem, v.v))
              )
       )
));

RewriteRules(CellVRCTerm, rec(
    VRC_ScatMem_Term := Rule([@(1, [RC, VRCL, VRCR, VRC,VRCLR]), @(2, [ScatMem])],
    e->ScatMem(@(2).val.func, @(2).val.pkSize*2)),

    VRC_GathMem_Term := Rule([@(1, [RC, VRCL, VRCR, VRC,VRCLR]), @(2, [GathMem])],
    e->GathMem(@(2).val.func, @(2).val.pkSize*2)),
));

RewriteRules(RulesRC, rec(
    RC_MultiBufISum := Rule([RC, @(1, MultiBufISum)],
        e -> let(s:=@(1).val, MultiBufISum( s.var, s.domain, s.scatmem, RC(s.child(1)), s.gathmem ))
    ),
));

# To convert Compose(A, B) -> ComposeStreams(A, B) when A,B=MultiBufISum
# ObjId(c)=DistSumLoop below is a hack. Obviously, DistSumLoop does not necessarily imply composing streams.
Class(RulesComposeStreams, RuleSet);
RewriteRules(RulesComposeStreams, rec(
    stream_compose := Rule(@(1, Compose, e->ForAll(e.children(), c->(ObjId(c)=MultiBufISum  or ObjId(c)=MultiBufISumFinal or ObjId(c)=DistSumLoop) )),
        e -> ComposeStreams(@(1).val.children()) )
));

# Pull Diag into MultiBufISum. D*MBufISum(SAG) -> MBufISum(SDAG) and
# MBufISum(SAG)*D -> MBufISum(SADG) Unlike the DistSum rules to do the same
# thing, this combining has to be done in a single step because the Scat and
# Gath of the MultiBufISum are not exposed.

RewriteRules(RulesDiagStandalone, rec(
 #  MBufISum(SAG)*D
 CellPullInCommuteGathDiag := ARule(Compose, [ @(1, MultiBufISum), @(2, [Prm, Gath, Diag, RCDiag]) ],
    e->let(msum := @(1).val,
           diag := @(2).val,
           gath := msum.gathmem,
           newdiag := Diag(fCompose(diag.element, fTensor(gath.func, fId(gath.pkSize)))).attrs(diag),
        [ MultiBufISum(msum.var, msum.domain, msum.scatmem, msum.child(1) * newdiag, msum.gathmem) ]
       )
 ),

 CellPullInCommuteScatDiag := ARule(Compose,  [ @(1, [RCDiag, Diag, Prm, Scat]), @(2, MultiBufISum) ],
    e->let(msum := @(2).val,
           diag := @(1).val,
           scat := msum.scatmem,
           newdiag := Diag(fCompose(diag.element, fTensor(scat.func, fId(scat.pkSize))  )).attrs(diag),
        [ MultiBufISum(msum.var, msum.domain, msum.scatmem, newdiag * msums.child(1), msum.gathmem) ]
       )
 ),

 # NOTE
 ## Gath * RCDiag
 #CellCommuteGathRCDiag := ARule( Compose,
 #      [ [@(1, [ GathDist, GathRecv ]), [@(0,fTensor), ..., [fId,@(2).cond(IsEvenInt)]]],
 #     @(4, RCDiag) ],
 # e -> [ RCDiag(fCompose(@(4).val.element, @(0).val), @(4).val.post),
 #        @(1).val ]),

 ## RCDiag * Scat
 #CellCommuteRCDiagScat := ARule( Compose,
 #      [ @(4, RCDiag),
 #    [@(1, [Scat, ScatDist, ScatSend]), [@(0,fTensor), ..., [fId,@(2).cond(IsEvenInt)]]] ],
 # e -> [ @(1).val,
 #        RCDiag(fCompose(@(4).val.element, @(0).val), @(4).val.post) ]),

));


text:
ITER_POLY_WARN:=false;
Read(Filename(home_dir,"lib/io.gi"));
Read(Filename(home_dir,"handle.gi"));

sys:=ChevalleyAdj("E",6,GF(3));
alg:=AlgebraicU(sys);
orbs:=UnipotentClasses(alg,"");
infos:=List(AllClasses(orbs),o->handleClassShort(o));
labels:=List(AllClasses(orbs),x->Label(x));

APR:=ring(alg);
avars:=IndeterminatesOfPolynomialRing(APR);
vals:=ShallowCopy(avars);
pr:=positiveRoots(alg);
generic:=Unipotent(alg,List([1..Length(pr)],i->[i,avars[i]]));

Read(Filename(components_dir,"E6char3.gi"));


text:
################################################################################
##
#W pointed_data.gi              GroupTheoretical Package
##
#W Paul Bruillard, Cesar Galindo, Siu-Hung Ng, Julia Plavnik, Eric Rowell,
#W Zhenghan Wang
##
## Installation file for pointed_data functions of the GroupTheoretical Package
##
#Y Copyright (C) 2016, Battelle Memorial Institute
##
################################################################################

################################################################################
##
#F pointed_data(<group>,<function>,<function>). . . . compute the data of C(G,q,chi)
##
InstallGlobalFunction(pointed_data, function(G,q,chi)
  local S, T, FPdim, FPdimC, GSet, N, g,h,r,g_idx,h_idx,CC,g_cc,h_cc;
  GSet := AsSet(G);
  r:=Size(GSet);
  CC:=ConjugacyClasses(G);
  T:=List(GSet,g->0);
  S:=NullMat(r,r);
  for g_idx in [1..r] do
    g:=GSet[g_idx];
    g_cc:=Position(CC,ConjugacyClass(G,g));
    T[g_idx]:=chi[g_cc]*q(g);
    for h_idx in [g_idx..r] do
      h:=GSet[h_idx];
      h_cc:=Position(CC,ConjugacyClass(G,h));
      S[g_idx][h_idx]:=chi[g_cc]*chi[h_cc]*q(g*h)/(q(g)*q(h));
      S[h_idx][g_idx]:=S[g_idx][h_idx];
    od;
  od;
  FPdimC:=Order(G);
  FPdim:=List(GSet,g->1);
  if S[1] <> FPdim then
    Error("First row of S is not FPdimension\n");
  fi;

  N:=compute_fusion_rules(S,FPdimC);
  return [GSet,S,T,N,FPdim,FPdimC];
end);
#E pointed_data.gi  . . . . . . . . . . . . . . . . . . . . . . . . ends here

max_stars_repo_name: pnnl/GroupTheoretical

max_issues_repo_name: pnnl/GroupTheoretical

max_forks_repo_name: pnnl/GroupTheoretical


text:
# The vector product of two vectors with 3 elements.
BindGlobal("VectorProduct", function(u, v)
    return [u[2]*v[3]-u[3]*v[2], u[3]*v[1]-u[1]*v[3], u[1]*v[2]-u[2]*v[1]];
end);

# Multiplication in Hall algebras
BindGlobal("HallMultiplication", function(p)
    local r;
    r := CoefficientsOfUnivariatePolynomial(p)[2];
    return function(x, y)
        if IsZero(y[2]) then
            return x*y[1];
        else
            return [x[1]*y[1] - x[2]/y[2]*Value(p, y[1]),
                    x[1]*y[2] - x[2]*(y[1] + r)];
        fi;
    end;
end);

# Multiplication in Dickson near-fields
BindGlobal("DicksonMultiplication",
    q -> function(x, y)
            if IsZero(y) then
                return 0*Z(q);
            else
                return x^(q^LogFFE(y, Z(q^2))) * y;
            fi;
        end);

# Right division in Dickson near-fields
BindGlobal("DicksonRightDivision",
    q -> function(x, y)
            if IsZero(x) then
                return 0*Z(q);
            else
                return (x / y)^(q^LogFFE(y, Z(q^2)));
            fi;
        end);

# Multiplication in exceptional near-fields
BindGlobal("ExceptionalMultiplication", function(q, F, B)
    local mat;
    mat := ToExceptionalMatrix(q, F, B);
    return function(x, y)
        local M;
        M := mat(x) * mat(y);
        return M[1]*B;
    end;
end);

# Right division in exceptional near-fields
BindGlobal("ExceptionalRightDivision", function(q, F, B)
    local mat;
    mat := ToExceptionalMatrix(q, F, B);
    return function(x, y)
        local M;
        M := mat(x) * mat(y)^-1;
        return M[1]*B;
    end;
end);

# Normalize a vector over a semifield given the semifield right division.
BindGlobal("NormalizeSemifieldVector",
    div -> function(v)
        local n;
        n := First(v, x -> not IsZero(x));
        return List(v, x -> div(x, n));
    end);

ext: gap

max_stars_repo_name: jaanos/gap-graphs

max_issues_repo_name: jaanos/gap-graphs

max_forks_repo_name: jaanos/gap-graphs


text:
%Terminals
    DollarSign ::= '$'
    _

    a    b    c    d    e    f    g    h    i    j    k    l    m
    n    o    p    q    r    s    t    u    v    w    x    y    z
%End

%Headers
    /.
        //
        // Each upper case letter is mapped into its corresponding
        // lower case counterpart. For example, if an 'A' appears
        // in the input, it is mapped into $sym_type.$prefix$a$suffix$ just
        // like 'a'.
        //
        final static int tokenKind[] = new int[128];
        static
        {
            tokenKind['$'] = $sym_type.$prefix$DollarSign$suffix$;
            tokenKind['_'] = $sym_type.$prefix$_$suffix$;

            tokenKind['a'] = $sym_type.$prefix$a$suffix$;
            tokenKind['b'] = $sym_type.$prefix$b$suffix$;
            tokenKind['c'] = $sym_type.$prefix$c$suffix$;
            tokenKind['d'] = $sym_type.$prefix$d$suffix$;
            tokenKind['e'] = $sym_type.$prefix$e$suffix$;
            tokenKind['f'] = $sym_type.$prefix$f$suffix$;
            tokenKind['g'] = $sym_type.$prefix$g$suffix$;
            tokenKind['h'] = $sym_type.$prefix$h$suffix$;
            tokenKind['i'] = $sym_type.$prefix$i$suffix$;
            tokenKind['j'] = $sym_type.$prefix$j$suffix$;
            tokenKind['k'] = $sym_type.$prefix$k$suffix$;
            tokenKind['l'] = $sym_type.$prefix$l$suffix$;
            tokenKind['m'] = $sym_type.$prefix$m$suffix$;
            tokenKind['n'] = $sym_type.$prefix$n$suffix$;
            tokenKind['o'] = $sym_type.$prefix$o$suffix$;
            tokenKind['p'] = $sym_type.$prefix$p$suffix$;
            tokenKind['q'] = $sym_type.$prefix$q$suffix$;
            tokenKind['r'] = $sym_type.$prefix$r$suffix$;
            tokenKind['s'] = $sym_type.$prefix$s$suffix$;
            tokenKind['t'] = $sym_type.$prefix$t$suffix$;
            tokenKind['u'] = $sym_type.$prefix$u$suffix$;
            tokenKind['v'] = $sym_type.$prefix$v$suffix$;
            tokenKind['w'] = $sym_type.$prefix$w$suffix$;
            tokenKind['x'] = $sym_type.$prefix$x$suffix$;
            tokenKind['y'] = $sym_type.$prefix$y$suffix$;
            tokenKind['z'] = $sym_type.$prefix$z$suffix$;

            tokenKind['A'] = $sym_type.$prefix$a$suffix$;
            tokenKind['B'] = $sym_type.$prefix$b$suffix$;
            tokenKind['C'] = $sym_type.$prefix$c$suffix$;
            tokenKind['D'] = $sym_type.$prefix$d$suffix$;
            tokenKind['E'] = $sym_type.$prefix$e$suffix$;
            tokenKind['F'] = $sym_type.$prefix$f$suffix$;
            tokenKind['G'] = $sym_type.$prefix$g$suffix$;
            tokenKind['H'] = $sym_type.$prefix$h$suffix$;
            tokenKind['I'] = $sym_type.$prefix$i$suffix$;
            tokenKind['J'] = $sym_type.$prefix$j$suffix$;
            tokenKind['K'] = $sym_type.$prefix$k$suffix$;
            tokenKind['L'] = $sym_type.$prefix$l$suffix$;
            tokenKind['M'] = $sym_type.$prefix$m$suffix$;
            tokenKind['N'] = $sym_type.$prefix$n$suffix$;
            tokenKind['O'] = $sym_type.$prefix$o$suffix$;
            tokenKind['P'] = $sym_type.$prefix$p$suffix$;
            tokenKind['Q'] = $sym_type.$prefix$q$suffix$;
            tokenKind['R'] = $sym_type.$prefix$r$suffix$;
            tokenKind['S'] = $sym_type.$prefix$s$suffix$;
            tokenKind['T'] = $sym_type.$prefix$t$suffix$;
            tokenKind['U'] = $sym_type.$prefix$u$suffix$;
            tokenKind['V'] = $sym_type.$prefix$v$suffix$;
            tokenKind['W'] = $sym_type.$prefix$w$suffix$;
            tokenKind['X'] = $sym_type.$prefix$x$suffix$;
            tokenKind['Y'] = $sym_type.$prefix$y$suffix$;
            tokenKind['Z'] = $sym_type.$prefix$z$suffix$;
        };

        final int getKind(char c)
        {
            return (c < 128 ? tokenKind[c] : 0);
        }
    ./
%End

max_stars_repo_name: kuafuwang/LPG-VScode

max_issues_repo_name: kuafuwang/LPG-VScode

max_forks_repo_name: kuafuwang/LPG-VScode


text:
#In GAP strings are lists of characters. An affectation simply copy references
a := "more";
b := a;
b{[1..4]} := "less";
a;
# "less"

# Here is a true copy
a := "more";
b := ShallowCopy(a);
b{[1..4]} := "less";
a;
# "more"

max_issues_repo_name: seanwallawalla-forks/RosettaCodeData

max_forks_repo_name: seanwallawalla-forks/RosettaCodeData


text:
%Globals
    /.
    import { %exp_type } from ".\/%exp_type";
    ./
%End
%Trailers
/.
      export  class  %super_stream_class  extends LpgLexStream
        {
        public static tokenKind  : number[] =
        [
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 000    0x00
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 001    0x01
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 002    0x02
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 003    0x03
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 004    0x04
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 005    0x05
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 006    0x06
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 007    0x07
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 008    0x08
            %sym_type.%prefix%HT%suffix%,              // 009    0x09
            %sym_type.%prefix%LF%suffix%,              // 010    0x0A
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 011    0x0B
            %sym_type.%prefix%FF%suffix%,              // 012    0x0C
            %sym_type.%prefix%CR%suffix%,              // 013    0x0D
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 014    0x0E
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 015    0x0F
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 016    0x10
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 017    0x11
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 018    0x12
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 019    0x13
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 020    0x14
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 021    0x15
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 022    0x16
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 023    0x17
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 024    0x18
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 025    0x19
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 026    0x1A
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 027    0x1B
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 028    0x1C
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 029    0x1D
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 030    0x1E
            %sym_type.%prefix%CtlCharNotWS%suffix%,    // 031    0x1F
            %sym_type.%prefix%Space%suffix%,           // 032    0x20
            %sym_type.%prefix%Exclamation%suffix%,     // 033    0x21
            %sym_type.%prefix%DoubleQuote%suffix%,     // 034    0x22
            %sym_type.%prefix%Sharp%suffix%,           // 035    0x23
            %sym_type.%prefix%DollarSign%suffix%,      // 036    0x24
            %sym_type.%prefix%Percent%suffix%,         // 037    0x25
            %sym_type.%prefix%Ampersand%suffix%,       // 038    0x26
            %sym_type.%prefix%SingleQuote%suffix%,     // 039    0x27
            %sym_type.%prefix%LeftParen%suffix%,       // 040    0x28
            %sym_type.%prefix%RightParen%suffix%,      // 041    0x29
            %sym_type.%prefix%Star%suffix%,            // 042    0x2A
            %sym_type.%prefix%Plus%suffix%,            // 043    0x2B
            %sym_type.%prefix%Comma%suffix%,           // 044    0x2C
            %sym_type.%prefix%Minus%suffix%,           // 045    0x2D
            %sym_type.%prefix%Dot%suffix%,             // 046    0x2E
            %sym_type.%prefix%Slash%suffix%,           // 047    0x2F
            %sym_type.%prefix%0%suffix%,               // 048    0x30
            %sym_type.%prefix%1%suffix%,               // 049    0x31
            %sym_type.%prefix%2%suffix%,               // 050    0x32
            %sym_type.%prefix%3%suffix%,               // 051    0x33
            %sym_type.%prefix%4%suffix%,               // 052    0x34
            %sym_type.%prefix%5%suffix%,               // 053    0x35
            %sym_type.%prefix%6%suffix%,               // 054    0x36
            %sym_type.%prefix%7%suffix%,               // 055    0x37
            %sym_type.%prefix%8%suffix%,               // 056    0x38
            %sym_type.%prefix%9%suffix%,               // 057    0x39
            %sym_type.%prefix%Colon%suffix%,           // 058    0x3A
            %sym_type.%prefix%SemiColon%suffix%,       // 059    0x3B
            %sym_type.%prefix%LessThan%suffix%,        // 060    0x3C
            %sym_type.%prefix%Equal%suffix%,           // 061    0x3D
            %sym_type.%prefix%GreaterThan%suffix%,     // 062    0x3E
            %sym_type.%prefix%QuestionMark%suffix%,    // 063    0x3F
            %sym_type.%prefix%AtSign%suffix%,          // 064    0x40
            %sym_type.%prefix%A%suffix%,               // 065    0x41
            %sym_type.%prefix%B%suffix%,               // 066    0x42
            %sym_type.%prefix%C%suffix%,               // 067    0x43
            %sym_type.%prefix%D%suffix%,               // 068    0x44
            %sym_type.%prefix%E%suffix%,               // 069    0x45
            %sym_type.%prefix%F%suffix%,               // 070    0x46
            %sym_type.%prefix%G%suffix%,               // 071    0x47
            %sym_type.%prefix%H%suffix%,               // 072    0x48
            %sym_type.%prefix%I%suffix%,               // 073    0x49
            %sym_type.%prefix%J%suffix%,               // 074    0x4A
            %sym_type.%prefix%K%suffix%,               // 075    0x4B
            %sym_type.%prefix%L%suffix%,               // 076    0x4C
            %sym_type.%prefix%M%suffix%,               // 077    0x4D
            %sym_type.%prefix%N%suffix%,               // 078    0x4E
            %sym_type.%prefix%O%suffix%,               // 079    0x4F
            %sym_type.%prefix%P%suffix%,               // 080    0x50
            %sym_type.%prefix%Q%suffix%,               // 081    0x51
            %sym_type.%prefix%R%suffix%,               // 082    0x52
            %sym_type.%prefix%S%suffix%,               // 083    0x53
            %sym_type.%prefix%T%suffix%,               // 084    0x54
            %sym_type.%prefix%U%suffix%,               // 085    0x55
            %sym_type.%prefix%V%suffix%,               // 086    0x56
            %sym_type.%prefix%W%suffix%,               // 087    0x57
            %sym_type.%prefix%X%suffix%,               // 088    0x58
            %sym_type.%prefix%Y%suffix%,               // 089    0x59
            %sym_type.%prefix%Z%suffix%,               // 090    0x5A
            %sym_type.%prefix%LeftBracket%suffix%,     // 091    0x5B
            %sym_type.%prefix%BackSlash%suffix%,       // 092    0x5C
            %sym_type.%prefix%RightBracket%suffix%,    // 093    0x5D
            %sym_type.%prefix%Caret%suffix%,           // 094    0x5E
            %sym_type.%prefix%_%suffix%,               // 095    0x5F
            %sym_type.%prefix%BackQuote%suffix%,       // 096    0x60
            %sym_type.%prefix%a%suffix%,               // 097    0x61
            %sym_type.%prefix%b%suffix%,               // 098    0x62
            %sym_type.%prefix%c%suffix%,               // 099    0x63
            %sym_type.%prefix%d%suffix%,               // 100    0x64
            %sym_type.%prefix%e%suffix%,               // 101    0x65
            %sym_type.%prefix%f%suffix%,               // 102    0x66
            %sym_type.%prefix%g%suffix%,               // 103    0x67
            %sym_type.%prefix%h%suffix%,               // 104    0x68
            %sym_type.%prefix%i%suffix%,               // 105    0x69
            %sym_type.%prefix%j%suffix%,               // 106    0x6A
            %sym_type.%prefix%k%suffix%,               // 107    0x6B
            %sym_type.%prefix%l%suffix%,               // 108    0x6C
            %sym_type.%prefix%m%suffix%,               // 109    0x6D
            %sym_type.%prefix%n%suffix%,               // 110    0x6E
            %sym_type.%prefix%o%suffix%,               // 111    0x6F
            %sym_type.%prefix%p%suffix%,               // 112    0x70
            %sym_type.%prefix%q%suffix%,               // 113    0x71
            %sym_type.%prefix%r%suffix%,               // 114    0x72
            %sym_type.%prefix%s%suffix%,               // 115    0x73
            %sym_type.%prefix%t%suffix%,               // 116    0x74
            %sym_type.%prefix%u%suffix%,               // 117    0x75
            %sym_type.%prefix%v%suffix%,               // 118    0x76
            %sym_type.%prefix%w%suffix%,               // 119    0x77
            %sym_type.%prefix%x%suffix%,               // 120    0x78
            %sym_type.%prefix%y%suffix%,               // 121    0x79
            %sym_type.%prefix%z%suffix%,               // 122    0x7A
            %sym_type.%prefix%LeftBrace%suffix%,       // 123    0x7B
            %sym_type.%prefix%VerticalBar%suffix%,     // 124    0x7C
            %sym_type.%prefix%RightBrace%suffix%,      // 125    0x7D
            %sym_type.%prefix%Tilde%suffix%,           // 126    0x7E

            %sym_type.%prefix%AfterASCII%suffix%,      // for all chars in range 128..65534
            %sym_type.%prefix%EOF%suffix%              // for '\uffff' or 65535
        ];

        public    getKind(i :number)  : number // Classify character at ith location
        {
            let c = (i >= this.getStreamLength() ? 0xffff : this.getIntValue(i));
            return (c < 128 // ASCII Character
                      ? %super_stream_class.tokenKind[c]
                      : c == 0xffff
                           ? %sym_type.%prefix%EOF%suffix%
                           : %sym_type.%prefix%AfterASCII%suffix%);
        }

        public  orderedExportedSymbols(): string[]  { return %exp_type.orderedTerminalSymbols; }

         constructor(fileName: string, inputChars?: string, tab?: number) {
             super(fileName, inputChars, tab);
         }
        }
./
%End
%Headers

    --
    -- Additional methods for the action class not provided in the template
    --
    /.

        //
        // The Lexer contains an array of characters as the input stream to be parsed.
        // There are methods to retrieve and classify characters.
        // The lexparser "token" is implemented simply as the index of the next character in the array.
        // The Lexer : the abstract class LpgLexStream with an implementation of the abstract
        // method getKind.  The template defines the Lexer class and the lexer() method.
        // A driver creates the action class, "Lexer", passing an Option object to the constructor.
        //
       kwLexer? :  %kw_lexer_class ;
       public   printTokens : boolean =false;
       private static  readonly   ECLIPSE_TAB_VALUE: number = 4;

        public  getKeywordKinds() : number [] {
            if(!this.kwLexer){
                throw Error("please initilize kwLexer");
            }
            return this.kwLexer.getKeywordKinds();
        }

        /**
         * @deprecated function replaced by {@link %reset(content : string, filename : string)}
         */
        public  initialize(content : string, filename : string) : void
        {
            this.reset(filename,4,content);
        }

        makeToken1(left_token : number,right_token : number, kind : number) : void
        {
            this.lexStream.makeToken(left_token, right_token, kind);
        }

        makeToken( arg0 : number, arg1?: number, arg2? : number) : void
        {
            if(arg1 && arg2){

                this.makeToken1(arg0,arg1,arg2);
                return ;
            }
            let  startOffset  = this.getLeftSpan();
            let   endOffset = this.getRightSpan();
            this.lexStream.makeToken(startOffset, endOffset, arg0);
            if (this.printTokens)  this.printValue(startOffset, endOffset);
        }

        makeComment(kind : number) : void
        {
            let startOffset =  this.getLeftSpan(),
                endOffset =  this.getRightSpan();
            this.lexStream.getIPrsStream()?.makeAdjunct(startOffset, endOffset, kind);
        }

         skipToken() : void
        {
            if (this.printTokens)  this.printValue( this.getLeftSpan(),  this.getRightSpan());
        }

         checkForKeyWord1() : void
        {
            if(!this.kwLexer){
                throw Error("please initilize kwLexer");
            }
            let startOffset =  this.getLeftSpan(),
                endOffset =  this.getRightSpan();
             let   kwKind = this.kwLexer.lexer(startOffset, endOffset);
            this.lexStream.makeToken(startOffset, endOffset, kwKind);
            if ( this.printTokens)  this.printValue(startOffset, endOffset);
        }

        //
        // This flavor of checkForKeyWord is necessary when the default kind
        // (which is returned when the keyword filter doesn't match) is something
        // other than _IDENTIFIER.
        //
         checkForKeyWord(defaultKind? :number) : void
        {
           if(!defaultKind){
              this.checkForKeyWord1();
              return;
           }
            if(!this.kwLexer){
                throw Error("please initilize kwLexer");
            }
            let startOffset =  this.getLeftSpan(),
                endOffset =  this.getRightSpan();
            let    kwKind =  this.kwLexer.lexer(startOffset, endOffset);
            if (kwKind == %_IDENTIFIER)
                kwKind = defaultKind;
            this.lexStream.makeToken(startOffset, endOffset, kwKind);
            if ( this.printTokens)  this.printValue(startOffset, endOffset);
        }

         printValue(startOffset : number, endOffset : number) : void
        {
             let s = this.lexStream.getInputChars().substr(startOffset, endOffset - startOffset + 1);
             console.log(s);
        }

    ./
%End


text:
#
# francy: Interactive Discrete Mathematics in GAP
#

#############################################################################
##
#M  Callback( <callback type>, <trigger Type>,  <function>, <known args> ) .
##
## triggers a callback with a list of known args.
## Extra args, or required args, should be registered using:
##      Callback!.add(CallbackRequiredArg)
##
InstallMethod(Callback,
  "a function, a list of known args",
  true,
  [IsTriggerType,
   IsFunction,
   IsList],
  0,
function(triggerType, func, knownArgs)
  local object;
  object := Objectify(CallbackObjectType, rec(
    id           := GenerateID(),
    trigger      := triggerType!.value,
    func         := func,
    knownArgs    := knownArgs,
    requiredArgs := rec()
  ));
  FrancyCallbacks!.(object!.id) := object;
  return object;
end);

InstallOtherMethod(Callback,
  "a trigger type, a function",
  true,
  [IsTriggerType,
   IsFunction],
  0,
function(triggerType, func)
  return Callback(triggerType, func, []);
end);

InstallOtherMethod(Callback,
  "a function, a list of knownArgs",
  true,
  [IsFunction,
   IsList],
  0,
function(func, knownArgs)
  return Callback(TriggerType.CLICK, func, knownArgs);
end);

InstallOtherMethod(Callback,
  "a function",
  true,
  [IsFunction],
  0,
function(func)
  return Callback(TriggerType.CLICK, func, []);
end);

#############################################################################
##
#M  NoopCallback( )
##
## Creates an empty Callback object that does nothing
##
InstallMethod(NoopCallback,
  "",
  true,
  [],
  0,
function()
  return Objectify(CallbackObjectType, rec());
end);

#############################################################################
##
#M  RequiredArg( <callback arg type>, <title> )
##
InstallMethod(RequiredArg,
  "a callback arg type, a title",
  true,
  [IsArgType,
   IsString],
  0,
function(argType, title)
  # FIXME might have to add a new property with order of the arg!
  return Objectify(RequiredArgObjectType, rec(
    id    := GenerateID(),
    type  := argType!.value,
    title := title,
    value := ""
  ));
end);

#############################################################################
##
#M  Add( <callback>, <required arg> ) . . . . . add objects to canvas
##
InstallOtherMethod(Add,
  "a callback, a required arg",
  true,
  [IsCallback,
   IsRequiredArg],
  0,
function(callback, arg)
  callback!.requiredArgs!.(arg!.id) := arg;
  return callback;
end);

InstallOtherMethod(Add,
  "a callback, a list of francy objects",
  true,
  [IsCallback,
   IsList],
  0,
function(callback, objects)
  local object;
  for object in objects do
    Add(callback, object);
  od;
  return callback;
end);

#############################################################################
##
#M  Remove( <callback>, <required arg> ) . . . . . add objects to canvas
##
InstallOtherMethod(Remove,
  "a callback, a required arg",
  true,
  [IsCallback,
   IsRequiredArg],
  0,
function(callback, arg)
  Unbind(callback!.requiredArgs!.(arg!.id));
  return callback;
end);

InstallOtherMethod(Remove,
  "a callback, a list of francy objects",
  true,
  [IsCallback,
   IsList],
  0,
function(callback, objects)
  local object;
  for object in objects do
    Remove(callback, object);
  od;
  return callback;
end);

#############################################################################
##
#M  Trigger( <a json string> ) . triggers a callback
##
InstallMethod(Trigger,
  "a json string",
  true,
  [IsString],
  0,
function(json)
  local callback, object, requiredArgs, arg;
  object := JsonStringToGap(json);
  # FIXME need to validate the callback!
  #if not IsCallbackRep(object) then
  #  Error("Not a valid Callback!");
  #fi;
  callback := FrancyCallbacks!.(object!.id);
  requiredArgs := [];
  for arg in NamesOfComponents(object!.requiredArgs) do
    Add(requiredArgs, object!.requiredArgs!.(arg)!.value);
  od;
  return CallFuncList(callback!.func, Concatenation(callback!.knownArgs, requiredArgs));
end);

max_stars_repo_name: LaGuer/francy

max_issues_repo_name: LaGuer/francy

max_forks_repo_name: LaGuer/francy


text:
cube := Group([(1, 2, 3, 4)(5, 6, 7, 8), (1, 4, 8, 5)(2, 3, 7, 6)]);

Order(cube);

degree := 8;
colorings := Filtered(
  Combinations(Cartesian([1..degree], ["b","w"]), degree)
, \c -> Size(Set(List(c, \a -> a[1]))) = degree
);

Size(colorings);

OnFunctions := function(omega, g)
  local result;
  result := List(omega, t -> [t[1]^g, t[2]]);
  SortBy(result, t -> t[1]);
  return result;
end;

orbits := Orbits(cube, colorings, OnFunctions);
Size(orbits);

image := OnFunctions([
    [1, "w"],
    [2, "w"],
    [3, "w"],
    [4, "b"],
    [5, "b"],
    [6, "b"],
    [7, "b"],
    [8, "b"],
], cube.1);

IsFixed := function(omega, g)
    return OnFunctions(omega, g) = omega;
end;

fixed := Filtered(colorings, \c -> IsFixed(c, cube.1));

orbitCount := 1/Order(cube) * Sum(
  List(Elements(cube), \g -> Size(Filtered(colorings, \c -> IsFixed(c, g))))
);

max_stars_repo_name: dvberkel/burnside

max_issues_repo_name: dvberkel/burnside

max_forks_repo_name: dvberkel/burnside


text:
LoadPackage( "AutoDoc" );

AutoDocWorksheet( "HandsOn.gi" );

QUIT;


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

Class(SIMD_Macro, SIMD_ISA, rec(

    file := "macro",

    commonIncludes := self >> [],

    active       := true,

    isFixedPoint := false,
    isFloat      := true,
    ctype        := "double",
    bits         := 64,
    useDeref     := false,

    splopts      := rec(precision := "double"),

    duploadn := (y, x, n) -> Error("broadcast is undefined"),

    arrayDataModifier := "static ",
    arrayBufModifier  := "static ",

    declareConstants := true,
    threeOps         := true,
    fma		     := true,

    svload  := [],
    svstore := [],

    unparser := MACROUnparser,

    compileStrategy := self >> BaseIndicesCS
                               :: When(self.fma, [DoFMA], [])
                               :: [ MarkDefUse, #
                                    (c, opts) -> CopyPropagate(c, CopyFields(opts, rec(autoinline := true))),
                                    MarkDefUse, #
                                    (c, opts) -> CopyPropagate(c, CopyFields(opts, rec(autoinline := true)))]
                               :: When(self.threeOps, [DoThreeOp], [])
                               :: [ Compile.declareVars,
                                    (c, opts) -> opts.vector.isa.fixProblems(c, opts),
                                    HashConsts ],

));

Class(MACRO_2xf, SIMD_Macro, rec(

    info := "MACRO 2 x floating point",

    countrec := rec(
        ops := [
            [ add, sub ]
             :: [ add_cmd, sub_cmd ],
	    [ mul, vmulcx_2xf ]
	     :: [ mul_cmd, vmulcx_2xf_cmd ],
            [ fma, fms, nfma ]
             :: [fma_cmd, fms_cmd, nfma_cmd],
            [ vunpacklo_2xf, vunpackhi_2xf, vpacklo_2xf, vpackhi_2xf, vswapcx_2xf ]
             :: [ vunpacklo_2xf_cmd, vunpackhi_2xf_cmd, vpacklo_2xf_cmd, vpackhi_2xf_cmd, vswapcx_2xf_cmd ],
            [  ],
            [ deref, nth, vload_cmd, vstore_cmd ],
            Value      # Value without [] is a keyword in countOps !!
        ],
        printstrings := ["[adds]", "[mults]", "[fmas]", "[vperms]", "[svldst]", "[vldst]", "[vval]"],
        arithcost := (self, opcount) >> opcount[1]+opcount[2]
    ),

    v     := 2,
    t     := TVect(TReal, 2),

    instr := [vunpacklo_2xf, vunpackhi_2xf, vpacklo_2xf, vpackhi_2xf],

    includes := self >> self.commonIncludes() :: ["<include/macro_fv2.h>"],

    dupload  := (y, x) -> assign(y, vdup(x, 2)),

    mul_cx  := (self, opts) >> ((y,x,c) -> assign(y, vmulcx_2xf(x,c))),
    swap_cx := (y, x, opts) -> assign(y, vswapcx_2xf(x)),
));

Class(MACRO_4xf, SIMD_Macro, rec(

    info := "MACRO 4 x floating point",

    countrec := rec(
        ops := [
            [ add, sub ]
             :: [ add_cmd, sub_cmd ],
	    [ mul, vmulcx_4xf ]
	     :: [ mul_cmd, vmulcx_4xf_cmd ],
            [ fma, fms, nfma ]
             :: [fma_cmd, fms_cmd, nfma_cmd],
            [   vpacklo_4xf,   vpackhi_4xf,   vpacklo2_4xf,   vpackhi2_4xf,
              vunpacklo_4xf, vunpackhi_4xf, vunpacklo2_4xf, vunpackhi2_4xf,
              vswapcx_4xf ]
             :: [   vpacklo_4xf_cmd,   vpackhi_4xf_cmd,   vpacklo2_4xf_cmd,   vpackhi2_4xf_cmd,
              vunpacklo_4xf_cmd, vunpackhi_4xf_cmd, vunpacklo2_4xf_cmd, vunpackhi2_4xf_cmd,
              vswapcx_4xf_cmd ],
            [  ],
            [ deref, nth, vload_cmd, vstore_cmd ],
            Value      # Value without [] is a keyword in countOps !!
        ],
        printstrings := ["[adds]", "[mults]", "[fmas]", "[vperms]", "[svldst]", "[vldst]", "[vval]"],
        arithcost := (self, opcount) >> opcount[1]+opcount[2]
    ),

    v     := 4,
    t     := TVect(TReal, 4),

    instr    := [vpacklo_4xf,   vpackhi_4xf,   vpacklo2_4xf,   vpackhi2_4xf,
                 vunpacklo_4xf, vunpackhi_4xf, vunpacklo2_4xf, vunpackhi2_4xf],

    includes := self >> self.commonIncludes() :: ["<include/macro_fv4.h>"],

    dupload  := (y, x) -> assign(y, vdup(x, 4)),

    mul_cx := (self, opts) >> ((y,x,c) -> assign(y, vmulcx_4xf(x,c))),
    swap_cx := (y, x, opts) -> assign(y, vswapcx_4xf(x)),
));

Class(MACRO_8xf, SIMD_Macro, rec(

    info := "MACRO 8 x floating point",

    countrec := rec(
        ops := [
            [ add, sub ]
             :: [ add_cmd, sub_cmd ],
	    [ mul, vmulcx_4xf ]
	     :: [ mul_cmd, vmulcx_4xf_cmd ],
            [ fma, fms, nfma ]
             :: [fma_cmd, fms_cmd, nfma_cmd],
            [   vpacklo_8xf,   vpackhi_8xf,   vpacklo2_8xf,   vpackhi2_8xf,
              vunpacklo_8xf, vunpackhi_8xf, vunpacklo2_8xf, vunpackhi2_8xf,
              vswapcx_8xf, vtrcx_8xf ]
             :: [ vpacklo_8xf_cmd,   vpackhi_8xf_cmd,   vpacklo2_8xf_cmd,   vpackhi2_8xf_cmd,
              vunpacklo_8xf_cmd, vunpackhi_8xf_cmd, vunpacklo2_8xf_cmd, vunpackhi2_8xf_cmd,
              vswapcx_8xf_cmd, vtrcx_8xf_cmd ],
            [  ],
            [ deref, nth, vload_cmd, vstore_cmd ],
            Value      # Value without [] is a keyword in countOps !!
        ],
        printstrings := ["[adds]", "[mults]", "[fmas]", "[vperms]", "[svldst]", "[vldst]", "[vval]"],
        arithcost := (self, opcount) >> opcount[1]+opcount[2]
    ),

    v     := 8,
    t     := TVect(TReal, 8),

    instr := [  vpacklo_8xf,   vpackhi_8xf,   vpacklo2_8xf,   vpackhi2_8xf,
              vunpacklo_8xf, vunpackhi_8xf, vunpacklo2_8xf, vunpackhi2_8xf,
              vtrcx_8xf ],

    includes := self >> self.commonIncludes() :: ["<include/macro_fv8.h>"],

    dupload  := (y, x) -> assign(y, vdup(x, 8)),

    mul_cx := (self, opts) >> ((y,x,c) -> assign(y, vmulcx_8xf(x,c))),
    swap_cx := (y, x, opts) -> assign(y, vswapcx_8xf(x)),
));

SIMD_ISA_DB.addISA(MACRO_2xf);
SIMD_ISA_DB.addISA(MACRO_4xf);
SIMD_ISA_DB.addISA(MACRO_8xf);


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

Declare(DContainer);

##############################################################################
Class(DContainer, VRC, rec(
    toAMat := (self) >> AMatMat(MatSPL(self.child(1))),
    new := meth(self, spl, procs)
        local res;
        res := SPL(WithBases(self, rec(_children:=[spl], procs:=procs,
                                dimensions := spl.dimensions)));
        res.dimensions := res.dims();
        return res;
    end,
    print := (self, i, is) >> Print(self.name, "(", self.child(1).print(i+is,is), ", ", self.procs, ")"),
    unroll := self >> self,
    transpose := self >> DContainer(self.child(1).transpose(), self.procs),
    dims := self >> self.child(1).dims()
));


text:
#############################################################################
##
##  This file is part of GAP, a system for computational discrete algebra.
##  This file's authors include Alexander Hulpke.
##
##  Copyright of GAP belongs to its developers, whose names are too numerous
##  to list here. Please refer to the COPYRIGHT file for details.
##
##  SPDX-License-Identifier: GPL-2.0-or-later
##
##  This file contains the methods for the construction of the basic fp group
##  types.
##

#############################################################################
##
#M  TrivialGroupCons( <IsPcGroup> )
##
InstallMethod( TrivialGroupCons,  "fp group",
    [ IsFpGroup and IsTrivial ],
    filter -> FreeGroup(0));

#############################################################################
##
#M  AbelianGroupCons( <IsFpGroup and IsFinite>, <ints> )
##
InstallMethod( AbelianGroupCons, "fp group", true,
    [ IsFpGroup and IsAbelian, IsList ], 0,
function( filter, ints )
local   f,g,i,j,rels,gfam,fam;

  if Length(ints)=0 or not ForAll( ints, x -> IsInfinity(x) or (IsInt(x) and x >= 0) )  then
      Error( "<ints> must be a list of integers" );
  fi;

  f   := FreeGroup(IsSyllableWordsFamily, Length(ints));
  g   := GeneratorsOfGroup(f);
  rels:=[];
  for i in [1..Length(ints)] do
    for j in [1..i-1] do
      Add(rels,Comm(g[i],g[j]));
    od;
    if IsPosInt(ints[i]) then
      Add(rels,g[i]^ints[i]);
    fi;
  od;

  g:=f/rels;

  if ForAll(ints,IsPosInt) then
    SetSize( g, Product(ints) );
  else
    SetSize( g, infinity );
  fi;

  fam:=FamilyObj(One(f));
  gfam:=FamilyObj(One(g));
  gfam!.redorders:=ints;
  SetFpElementNFFunction(gfam,function(x)
    local u,e,i,j,n;
    u:=UnderlyingElement(x);
    e:=ExtRepOfObj(u); # syllable form

    # bring in correct order and reduction
    n:=ListWithIdenticalEntries(Length(gfam!.redorders),0);
    for i in [1,3..Length(e)-1] do
      j:=e[i];
      if IsPosInt(gfam!.redorders[j]) then
	n[j]:=n[j]+e[i+1] mod gfam!.redorders[j];
      else
	n[j]:=n[j]+e[i+1];
      fi;
    od;

    e:=[];
    for i in [1..Length(gfam!.redorders)] do
      if n[i]<>0 then
	Add(e,i);
	Add(e,n[i]);
      fi;
    od;

    return ObjByExtRep(fam,e);
  end);

  SetReducedMultiplication(g);
  SetIsAbelian( g, true );

  return g;
end );

#############################################################################
##
#M  CyclicGroupCons( <IsFpGroup>, <n> )
##
InstallOtherMethod( CyclicGroupCons, "fp group", true,
    [ IsFpGroup and IsCyclic, IsObject ], 0,
function( filter, n )
local f,g,fam,gfam;
  if n=infinity then
    return FreeGroup("a");
  elif not IsPosInt(n) then
    TryNextMethod();
  fi;
  f:=FreeGroup( IsSyllableWordsFamily, "a" );
  g:=f/[f.1^n];
  SetSize(g,n);
  fam:=FamilyObj(One(f));
  gfam:=FamilyObj(One(g));
  SetFpElementNFFunction(gfam,function(x)
    local u,e;
    u:=UnderlyingElement(x);
    e:=ExtRepOfObj(u); # syllable form
    if Length(e)=0 or (e[2]>=0 and e[2]<n) then
      return u;
    elif e[2] mod n=0 then
      return One(f);
    else
      e:=[e[1],e[2] mod n];
      return ObjByExtRep(fam,e);
    fi;
  end);

  SetReducedMultiplication(g);
  return g;
end );

#############################################################################
##
#M  DihedralGroupCons( <IsFpGroup and IsFinite>, <n> )
##
InstallMethod( DihedralGroupCons,
    "fp group",
    true,
    [ IsFpGroup and IsFinite,
      IsInt and IsPosRat ],
    0,

function( filter, n )
local f,rels,g;

  if n mod 2 = 1  then
      TryNextMethod();
  elif n = 2 then return
      CyclicGroup( IsFpGroup, 2 );
  fi;
  f   := FreeGroup( IsSyllableWordsFamily, "r", "s" );
  rels:= [f.1^(n/2),f.2^2,f.1^f.2*f.1];
  g   := f/rels;
  SetSize(g,n);
  SetReducedMultiplication(g);
  return g;

end );

InstallOtherMethod( DihedralGroupCons,
    "fp group",
    true,
    [ IsFpGroup and IsFinite,
      IsInfinity ],
    0,

function( filter, inf )
local f,rels,g;

  f   := FreeGroup( IsSyllableWordsFamily, "r", "s" );
  rels:= [f.2^2,f.1^f.2*f.1];
  g   := f/rels;
  SetSize(g,infinity);
  SetReducedMultiplication(g);
  return g;

end );

#############################################################################
##
#M  DicyclicGroupCons( <IsFpGroup and IsFinite>, <n> )
##
InstallMethod( DicyclicGroupCons,
    "fp group",
    true,
    [ IsFpGroup and IsFinite,
      IsInt and IsPosRat ],
    0,
function( filter, n )
local f,rels,g;
  if 0 <> n mod 4  then
      TryNextMethod();
  elif n = 4 then return
      CyclicGroup( IsFpGroup, 4 );
  fi;
  f   := FreeGroup( IsSyllableWordsFamily, "r", "s" );
  rels:= [ f.1^2/f.2^(n/4), f.2^(n/2), f.2^f.1*f.2 ];
  g   := f/rels;
  SetSize(g,n);
  if n <= 10^4 then SetReducedMultiplication(g); fi;
  return g;
end );

#############################################################################
##
#M  ElementaryAbelianGroupCons( <IsFpGroup and IsFinite>, <n> )
##
InstallMethod( ElementaryAbelianGroupCons,
    "fp group",
    true,
    [ IsFpGroup and IsFinite and IsElementaryAbelian,
      IsInt and IsPosRat ],
    0,

function( filter, n )
    if n = 1  then
        return CyclicGroupCons( IsFpGroup, 1 );
    elif not IsPrimePowerInt(n)  then
        Error( "<n> must be a prime power" );
    fi;
    n:= AbelianGroupCons( IsFpGroup, Factors(n) );
    SetIsElementaryAbelian( n, true );
    return n;
end );

#############################################################################
##
#M  FreeAbelianGroupCons( <IsFpGroup>, <rank> )
##
InstallMethod( FreeAbelianGroupCons,
    "fp group",
    true,
    [ IsFpGroup and IsAbelian,
      IsInt and IsPosRat ],
    0,

function( filter, rank )
    return AbelianGroupCons( filter, ListWithIdenticalEntries(rank, 0) );
    # TODO: Add the following if it ever moves from Polycyclic to the GAP core:
    #SetIsFreeAbelian( G, true );
end );