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

# The Wire class implements OL connection system
# usage: Wire(inputs, interconnection matrix)
# ex: Wire([1,2,3,4],MatSPL(L(4,2)));
 Class(Wire, BaseMat, rec(
   abbrevs := [ (inp, mat) ->  Checked(IsList(inp), IsMat(mat), [[inp, mat]])],
   new := meth(self, p)
       local res;
       res := SPL(WithBases(self, rec(params := p, TType:=Replicate(Length(p[1]),TUnknown))));
       return res;
   end,
   isPermutation := self >> false,
   #now just make it work, assuming all inputs have the same type
   dmn:=self >> List(self.params[1],x->TArray(self.TType[1],x)),
   rng:=self >> List(self.params[2]*self.params[1],x->TArray(self.TType[1],x)),
   sums:= self>>self,
   numops:=self>>0,
   rChildren := self >> [],
   print := meth(self,i,is)
     Print(self.name, "(", PrintCS(self.params), ")");
     return;
   end
 ));

 Class(LinkIO, BaseMat, rec(
   abbrevs := [ (sums, mat) ->  Checked(IsMat(mat), [[sums, mat]])],
   new := meth(self, p)
       local res;
       res := SPL(WithBases(self, rec(params := p, TType:=Replicate(Length(p[1]),TUnknown))));
       return res;
   end,
   isPermutation := self >> false,
   dmn:=self >> self.params[1].dmn(),
   rng:=self >> self.params[1].rng(),
   sums:= self>>self,
   numops:=self>>0,
   rChildren := self >> self.params,
   rSetChild := meth ( self, n, newChild )
     if n = 1  then
         self.params[1] := newChild;
     elif n = 2 then
         self.params[2] := newChild;
    else
        Error("<n> not in range");
     fi;
   end,
   print := meth(self,i,is)
     Print(self.name, "(", PrintCS(self.params), ")");
     return;
   end
 ));


Class(Dot_X, BaseOperation, rec(
  __call__ := (self, sr, x_n, s1, s2, range) >> SPL(WithBases(self, rec(
    sr := Checked(IsSemiring(sr), sr),
    start1 := s1,
    start2 := s2,
    range := range,
    x_n := x_n,
    _children := [range]
  ))),
  dims := self >> [self.x_n, V(1)],
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(", self.sr, ", ", self.start1, ", ", self.start2, ", ", self.range, ")"
  )
));

Class(Accum_X, BaseOperation, rec(
  __call__ := (self, sr, x_n, var, st, range, func) >> SPL(WithBases(self, rec(
    sr := Checked(IsSemiring(sr), sr),
    var := var,
    start := st,
    range := range,
    func := self >> self._children[1],
    x_n := x_n,
    _children := [func, range]
  ))),
  dims := self >> [self.x_n, V(1)],
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(", self.sr, ", ", self.var, ", ", self.start, ", ", self.range, ",\n",
        Blanks(i+is), self.func().print(i+is, is), "\n",
        Blanks(i), ")"
	)
));

Class(Scat_E, BaseOperation, rec(
  __call__ := (self, sr, x_n, v1, v2, range, svar, func) >> SPL(WithBases(self, rec(
    sr := Checked(IsSemiring(sr), sr),
    v1 := v1,
    v2 := v2,
    range := range,
    svar := svar,
    func := self >> self._children[1],
    x_n := x_n,
    _children := [func, range]
  ))),
  dims := self >> [self.x_n, V(1)],
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(", self.sr, ", ", self.v1, ", ", self.v2, ", ", self.range, ", ", self.svar, ",\n",
        Blanks(i+is), self.func().print(i+is, is), "\n",
        Blanks(i), ")"
  )
));

Class(SMP_Scat_E, BaseOperation, rec(
  __call__ := (self, sr, x_n, v1, v2, range, svar, func, nthreads) >> SPL(WithBases(self, rec(
    sr := Checked(IsSemiring(sr), sr),
    v1 := v1,
    v2 := v2,
    range := range,
    svar := svar,
    func := self >> self._children[1],
    x_n := x_n,
    nthreads := nthreads,
    _children := [func, range]
  ))),
  dims := self >> [self.x_n, V(1)],
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(", self.sr, ", ", self.v1, ", ", self.v2, ", ", self.range, ", ", self.svar, ",\n",
        Blanks(i+is), self.func().print(i+is, is), "\n",
        Blanks(i), ")"
  )
));

Class(CheckEdgesUpdate, BaseOperation, rec(
  __call__ := (self, edges, var, func) >> SPL(WithBases(self, rec(
    edges := edges,
    var := var,
    func := self >> self._children[1],
    _children := [func]
  ))),
  dims := self >> [self.edges, V(1)],
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(", self.edges, ", ", self.var, ",\n",
        Blanks(i+is), self.func().print(i+is, is), "\n",
        Blanks(i), ")"
  )
));

Class(PruneEdges, BaseOperation, rec(
  __call__ := (self, idx, range, var, x_n, s, k) >> SPL(WithBases(self, rec(
    idx := idx,
    range := range,
    var := var,
    x_n := x_n,
    s := s,
    k := k,
    _children := [range, k]
  ))),
  dims := self >> [self.x_n, V(1)],
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(", self.idx, ", ", self.range, ", ", self.var, ", ", self.s, ", ", self.k, ")"
  )
));

Class(Accum, BaseOperation, rec(
  __call__ := (self, sr, var, range_min, range_max, func) >> SPL(WithBases(self, rec(
    sr := Checked(IsSemiring(sr), sr),
    var := var,
    range_min := range_min,
    range_max := range_max,
    func := self >> self._children[1],
    _children := [func, range_min, range_max]
  ))),
  dims := self >> self._children[1].dims(),
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(", self.sr, ", ", self.var, ", ", self.range_min, ", ", self.range_max, ",\n",
        Blanks(i+is), self.func().print(i+is, is), "\n",
        Blanks(i), ")"
  )
));

Class(SMP_Accum, BaseOperation, rec(
  __call__ := (self, sr, var, range_min, range_max, func, nthreads) >> SPL(WithBases(self, rec(
    sr := Checked(IsSemiring(sr), sr),
    var := var,
    range_min := range_min,
    range_max := range_max,
    func := self >> self._children[1],
    nthreads := nthreads,
    _children := [func, range_min, range_max]
  ))),
  dims := self >> self._children[1].dims(),
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(", self.sr, ", ", self.var, ", ", self.range_min, ", ", self.range_max, ",\n",
        Blanks(i+is), self.func().print(i+is, is), "\n",
        Blanks(i), ")"
  )
));

Class(Assign_Ptr, BaseOperation, rec(
  __call__ := (self, func) >> SPL(WithBases(self, rec(
    func := self >> self._children[1],
    _children := [func]
  ))),
  dims := self >> self._children[1].dims(),
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(\n",
        Blanks(i+is), self.func().print(i+is, is), "\n",
        Blanks(i), ")"
  )
));

Class(Scale_Pt, BaseOperation, rec(
  __call__ := (self, scalar, func) >> SPL(WithBases(self, rec(
    scalar := scalar,
    func := self >> self._children[1],
    _children := [func]
  ))),
  dims := self >> self._children[1].dims(),
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(", self.scalar, ",\n",
        Blanks(i+is), self.func().print(i+is, is), "\n",
        Blanks(i), ")"
  )
));

Class(IterateIndefinite, BaseOperation, rec(
  __call__ := (self, op1, op2) >> SPL(WithBases(self, rec(
    op1 := self >> self._children[1],
    op2 := self >> self._children[2],
    _children := [op1, op2]
  ))),
  dims := self >> [V(1), V(1)],
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(\n",
        Blanks(i+is), self.op1().print(i+is, is), "\n",
        Blanks(i+is), self.op2().print(i+is, is), "\n",
        Blanks(i), ")"
  )
));

Class(KTrussWrap, BaseOperation, rec(
  __call__ := (self, s, body) >> SPL(WithBases(self, rec(
    s := s,
    body := self >> self._children[1],
    _children := [body]
  ))),
  dims := self >> [V(1), V(1)],
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(", self.s, "\n",
        Blanks(i+is), self.body().print(i+is, is), "\n",
        Blanks(i), ")"
  )
));

Class(loopw, Command, rec(
  __call__ := (self, cond, cmd) >> WithBases(self, rec(
    cond := toExpArg(cond),
    cmd := Checked(IsCommand(cmd), cmd),
    operations := CmdOps
  )),
  rChildren := self >> [self.cond, self.cmd],
  rSetChild := rSetChildFields("cond", "cmd"),
  print := (self, i, si) >> Print(self.__name__, "(", self.cond, ",\n",
        Blanks(i+si), self.cmd.print(i+si, si), "\n",
        Blanks(i), ")"
  )
));

Class(loopf, Command, rec(
  __call__ := (self, var, range_min, range_max, cmd) >> WithBases(self, rec(
    var := var,
    range_min := range_min,
    range_max := range_max,
    cmd := Checked(IsCommand(cmd), cmd),
    operations := CmdOps
  )),
  rChildren := self >> [self.var, self.range_min, self.range_max, self.cmd],
  rSetChild := rSetChildFields("var", "range_min", "range_max", "cmd"),
  print := (self, i, si) >> Print(self.__name__, "(", self.var, ", ", self.range_min, ", ", self.range_max, ",\n",
        Blanks(i+si), self.cmd.print(i+si, si), "\n",
        Blanks(i), ")"
  )
));

Class(smp_reduct_loopf, Command, rec(
  __call__ := (self, sr, var, range_min, range_max, y, nthreads, cmd) >> WithBases(self, rec(
    sr := sr,
    var := var,
    range_min := range_min,
    range_max := range_max,
    y := y,
    nthreads := nthreads,
    cmd := Checked(IsCommand(cmd), cmd),
    operations := CmdOps
  )),
  rChildren := self >> [self.sr, self.var, self.range_min, self.range_max, self.y, self.nthreads, self.cmd],
  rSetChild := rSetChildFields("sr", "var", "range_min", "range_max", "y", "nthreads", "cmd"),
  print := (self, i, si) >> Print(self.__name__, "(", self.var, ", ", self.range_min, ", ", self.range_max, ", ", self.nthreads, ",\n",
        Blanks(i+si), self.cmd.print(i+si, si), "\n",
        Blanks(i), ")"
  )
));

Class(smp_loopf, Command, rec(
  __call__ := (self, var, range_min, range_max, nthreads, cmd) >> WithBases(self, rec(
    var := var,
    range_min := range_min,
    range_max := range_max,
    nthreads := nthreads,
    cmd := Checked(IsCommand(cmd), cmd),
    operations := CmdOps
  )),
  rChildren := self >> [self.var, self.range_min, self.range_max, self.nthreads, self.cmd],
  rSetChild := rSetChildFields("var", "range_min", "range_max", "nthreads", "cmd"),
  print := (self, i, si) >> Print(self.__name__, "(", self.var, ", ", self.range_min, ", ", self.range_max, ", ", self.nthreads, ",\n",
        Blanks(i+si), self.cmd.print(i+si, si), "\n",
        Blanks(i), ")"
  )
));

Class(if1, Command, rec(
  __call__ := (self, if_cond, if_cmd) >> WithBases(self, rec(
    if_cond := toExpArg(if_cond),
    if_cmd := Checked(IsCommand(if_cmd), if_cmd),
    operations := CmdOps
  )),
  rChildren := self >> [self.if_cond, self.if_cmd],
  rSetChild := rSetChildFields("if_cond", "if_cmd"),
  print := (self, i, si) >> Print(self.__name__, "(", self.if_cond, ",\n",
        Blanks(i+si), self.if_cmd.print(i+si, si), "\n",
        Blanks(i), ")"
  )
));

Class(if2, Command, rec(
  __call__ := (self, if_cond, if_cmd, ei_cond, ei_cmd, else_cmd) >> WithBases(self, rec(
    if_cond := toExpArg(if_cond),
    if_cmd := Checked(IsCommand(if_cmd), if_cmd),
    else_cmd := Checked(IsCommand(else_cmd), else_cmd),
    operations := CmdOps
  )),
  rChildren := self >> [self.if_cond, self.if_cmd, self.else_cmd],
  rSetChild := rSetChildFields("if_cond", "if_cmd", "else_cmd"),
  print := (self, i, si) >> Print(self.__name__, "(", self.if_cond, ",\n",
        Blanks(i+si), self.if_cmd.print(i+si, si), ",\n",
        Blanks(i+si), self.else_cmd.print(i+si, si), "\n",
        Blanks(i), ")"
  )
));

Class(if3, Command, rec(
  __call__ := (self, if_cond, if_cmd, ei_cond, ei_cmd, else_cmd) >> WithBases(self, rec(
    if_cond := toExpArg(if_cond),
    if_cmd := Checked(IsCommand(if_cmd), if_cmd),
    ei_cond := toExpArg(ei_cond),
    ei_cmd := Checked(IsCommand(ei_cmd), ei_cmd),
    else_cmd := Checked(IsCommand(else_cmd), else_cmd),
    operations := CmdOps
  )),
  rChildren := self >> [self.if_cond, self.if_cmd, self.ei_cond, self.ei_cmd, self.else_cmd],
  rSetChild := rSetChildFields("if_cond", "if_cmd", "ei_cond", "ei_cmd", "else_cmd"),
  print := (self, i, si) >> Print(self.__name__, "(", self.if_cond, ",\n",
        Blanks(i+si), self.if_cmd.print(i+si, si), ",\n",
        Blanks(i+si), self.ei_cond, ",\n",
        Blanks(i+si), self.ei_cmd.print(i+si, si), ",\n",
        Blanks(i+si), self.else_cmd.print(i+si, si), "\n",
        Blanks(i), ")"
  )
));

Class(break_ic, Command, rec(
  __call__ := (self) >> WithBases(self, rec(
    operations := CmdOps
  )),
  rChildren := self >> [],
  rSetChild := rSetChildFields(),
  print := (self, i, si) >> Print(self.__name__, "()")
));

CUnparser.loopw := (self,o,i,is) >> Print(Blanks(i),
    "while (", self(o.cond,i,is), ") {\n",
    self(o.cmd,i+is,is), Blanks(i), "}\n");

CUnparser.loopf := (self,o,i,is) >> Print(Blanks(i),
    "for (int ", o.var, " = ", self(o.range_min,i,is), "; ", o.var, " < ", self(o.range_max,i,is), "; ", o.var, "++) {\n",
    self(o.cmd,i+is,is), Blanks(i), "}\n");

CUnparser.smp_reduct_loopf := (self,o,i,is) >> Print(Blanks(i),
    "#pragma omp parallel for schedule(dynamic) reduction(", o.sr.OpenMP_sum, ":", o.y, ") num_threads(", o.nthreads, ")\n",
    Blanks(i), "for (int ", o.var, " = ", self(o.range_min,i,is), "; ", o.var, " < ", self(o.range_max,i,is), "; ", o.var, "++) {\n",
    self(o.cmd,i+is,is), Blanks(i), "}\n");

CUnparser.smp_loopf := (self,o,i,is) >> Print(Blanks(i),
    "#pragma omp parallel for schedule(dynamic) num_threads(", o.nthreads, ")\n",
    Blanks(i), "for (int ", o.var, " = ", self(o.range_min,i,is), "; ", o.var, " < ", self(o.range_max,i,is), "; ", o.var, "++) {\n",
    self(o.cmd,i+is,is), Blanks(i), "}\n");

CUnparser.if1 := (self,o,i,is) >> Print(Blanks(i),
    "if (", self(o.if_cond,i,is), ") {\n", self(o.if_cmd,i+is,is), Blanks(i), "}\n");

CUnparser.if2 := (self,o,i,is) >> Print(Blanks(i),
    "if (", self(o.if_cond,i,is), ") {\n", self(o.if_cmd,i+is,is), Blanks(i), "}",
    " else {\n", self(o.else_cmd,i+is,is), Blanks(i), "}\n");

CUnparser.if3 := (self,o,i,is) >> Print(Blanks(i),
    "if (", self(o.if_cond,i,is), ") {\n", self(o.if_cmd,i+is,is), Blanks(i), "}",
    " else if (", self(o.ei_cond,i,is), ") {\n", self(o.ei_cmd,i+is,is), Blanks(i), "}",
    " else {\n", self(o.else_cmd,i+is,is), Blanks(i), "}\n");

CUnparser.break_ic := (self,o,i,is) >> Print(Blanks(i),
    "break;\n");

Class(VMV_X, TaggedNonTerminal, rec(
  __call__ := (self, sr, s1, sm, s2, d1, d2, x_n) >> WithBases(self, rec(
    sr := Checked(IsSemiring(sr), sr),
    start1 := s1,
    startm := sm,
    start2 := s2,
    d1 := d1,
    d2 := d2,
    x_n := x_n,
    params := []
  )),
  isReal := self >> true,
  dims := self >> [self.x_n, V(1)]
));

Class(TriangleCount, TaggedNonTerminal, rec(
  abbrevs := [ (n) -> [n] ],
  isReal := self >> true,
  dims := self >> [self.params[1], self.params[1]]
));

Class(KTruss, TaggedNonTerminal, rec(
  abbrevs := [ (n, m, k) -> [n, m, k] ],
  isReal := self >> true,
  dims := self >> [self.params[1], self.params[1]]
));

Class(TriangleCountEdges, TaggedNonTerminal, rec(
  abbrevs := [ (n, m, s) -> [n, m, s] ],
  isReal := self >> true,
  dims := self >> [self.params[1], self.params[1]]
));

Class(KTrussPrune, TaggedNonTerminal, rec(
  abbrevs := [ (n, m, k, s) -> [n, m, k, s] ],
  isReal := self >> true,
  dims := self >> [self.params[1], self.params[1]]
));

NewRulesFor(VMV_X, rec(
  Accum_X_Dot := rec(
    info := "Selective accumulation of dot products <Mi,v2> over existing elements in v1",
    maxSize := false,
    applicable := (self, t) >> true,
    apply := (nt, C, ct) -> let(i := Ind(), sr := nt.sr, x_n := nt.x_n,
              Accum_X(sr, x_n, i, nt.start1, nt.d1, Dot_X(sr, x_n, [i, nt.startm[2]], nt.start2, nt.d2)))
  )
));

NewRulesFor(TriangleCount, rec(
  Accum_VMV_FLAME1 := rec(
    info := "FLAME Approach #1",
    maxSize := false,
    applicable := nt -> not nt.hasTags(),
    children := (self, nt) >> let(i := Ind(), n := nt.params[1], sr := TSemiring_Arithmetic(n.t),
              [[ VMV_X(sr, [i, V(0)], [V(0), V(0)], [i, V(0)], i, i, n) ]]),
    apply := (nt, C, ct) -> let(i := C[1]._children[1].rt.node.d1, n := nt.params[1], sr := TSemiring_Arithmetic(n.t),
              Assign_Ptr(Scale_Pt(V(0.5), Accum(sr, i, V(1), n, C[1]))))
  ),
  Accum_VMV_FLAME2 := rec(
    info := "FLAME Approach #2",
    maxSize := false,
    applicable := nt -> not nt.hasTags(),
    children := (self, nt) >> let(i := Ind(), n := nt.params[1], sr := TSemiring_Arithmetic(n.t),
              [[ VMV_X(sr, [i, V(0)], [V(0), i+1], [i, i+1], i, n-i-1, n) ]]),
    apply := (nt, C, ct) -> let(i := C[1]._children[1].rt.node.d1, n := nt.params[1], sr := TSemiring_Arithmetic(n.t),
              Assign_Ptr(Accum(sr, i, V(1), n-1, C[1])))
  ),
  Accum_VMV_FLAME4 := rec(
    info := "FLAME Approach #4",
    maxSize := false,
    applicable := nt -> not nt.hasTags(),
    children := (self, nt) >> let(i := Ind(), n := nt.params[1], sr := TSemiring_Arithmetic(n.t),
              [[ VMV_X(sr, [i-1, i], [i, i], [i-1, i], n-i, n-i, n) ]]),
    apply := (nt, C, ct) -> let(i := C[1]._children[1].rt.node.startm[1], n := nt.params[1], sr := TSemiring_Arithmetic(n.t),
              Assign_Ptr(Scale_Pt(V(0.5), Accum(sr, i, V(1), n, C[1]))))
  ),
  Accum_VMV_FLAME2_SMP := rec(
    info := "FLAME Approach #2",
    maxSize := false,
    applicable := nt -> nt.hasTags(),
    children := (self, nt) >> let(i := Ind(), n := nt.params[1], sr := TSemiring_Arithmetic(n.t),
              [[ VMV_X(sr, [i, V(0)], [V(0), i+1], [i, i+1], i, n-i-1, n) ]]),
    apply := (nt, C, ct) -> let(i := C[1]._children[1].rt.node.d1, n := nt.params[1], sr := TSemiring_Arithmetic(n.t),
              Assign_Ptr(SMP_Accum(sr, i, V(1), n-1, C[1], nt.firstTag().params[1])))
  )
));

NewRulesFor(KTruss, rec(
  TC_Support_Prune := rec(
    info := "Triangle Count for Support, then Prune. Iterate",
    maxSize := false,
    applicable := nt -> not nt.hasTags(),
    children := (self, nt) >> let(n := nt.params[1], m := nt.params[2], k := nt.params[3], s := var.fresh_t("s", TArray(TInt, nt.params[2])),
              [[ TriangleCountEdges(n, m, s), KTrussPrune(n, m, k, s) ]]),
    apply := (nt, C, ct) -> Assign_Ptr(Scale_Pt(V(0.5), IterateIndefinite(C[1], C[2])))
  ),
  TC_Support_Prune_SMP := rec(
    info := "Triangle Count for Support, then Prune. Iterate",
    maxSize := false,
    applicable := nt -> nt.hasTags(),
    children := (self, nt) >> let(n := nt.params[1], m := nt.params[2], k := nt.params[3], s := var.fresh_t("s", TArray(TInt, nt.params[2])),
              [[ TriangleCountEdges(n, m, s).withTags(nt.tags), KTrussPrune(n, m, k, s) ]]),
    apply := (nt, C, ct) -> Assign_Ptr(Scale_Pt(V(0.5), IterateIndefinite(C[1], C[2])))
  )
));

NewRulesFor(TriangleCountEdges, rec(
  Endpoint_Row_Dot := rec(
    info := "Dot products of rows corresponding to endpoints of each edge",
    maxSize := false,
    applicable := nt -> not nt.hasTags(),
    apply := (nt, C, ct) -> let(v1 := var.fresh_t("v", TInt), v2 := var.fresh_t("v", TInt), n := nt.params[1], m := nt.params[2], s := nt.params[3], sr := TSemiring_Arithmetic(n.t),
              Scat_E(sr, n, v1, v2, m, s, Dot_X(sr, n, [v1, 1], [v2, 1], n)))
  ),
  Endpoint_Row_Dot_SMP := rec(
    info := "Dot products of rows corresponding to endpoints of each edge",
    maxSize := false,
    applicable := nt -> nt.hasTags(),
    apply := (nt, C, ct) -> let(v1 := var.fresh_t("v", TInt), v2 := var.fresh_t("v", TInt), n := nt.params[1], m := nt.params[2], s := nt.params[3], sr := TSemiring_Arithmetic(n.t),
              SMP_Scat_E(sr, n, v1, v2, m, s, Dot_X(sr, n, [v1, 1], [v2, 1], n), nt.firstTag().params[1]))
  )
));

NewRulesFor(KTrussPrune, rec(
  Check_Support_Prune := rec(
    info := "Eliminate edges without enough support and break if nothing changes",
    maxSize := false,
    applicable := nt -> not nt.hasTags(),
    apply := (nt, C, ct) -> let(i := Ind(), v := var.fresh_t("v", TInt), n := nt.params[1], m := nt.params[2], k := nt.params[3], s := nt.params[4],
              CheckEdgesUpdate(m, v, PruneEdges(i, m, v, n, s, k)))
  )
));

DefaultSumsGen.Accum := (self, o, opts) >> Accum(o.sr, o.var, o.range_min, o.range_max, self(o.func(), opts));

DefaultSumsGen.Accum_X := (self, o, opts) >> Accum_X(o.sr, o.x_n, o.var, o.start, o.range, self(o.func(), opts));

DefaultSumsGen.Scat_E := (self, o, opts) >> Scat_E(o.sr, o.x_n, o.v1, o.v2, o.range, o.svar, self(o.func(), opts));

DefaultSumsGen.SMP_Scat_E := (self, o, opts) >> SMP_Scat_E(o.sr, o.x_n, o.v1, o.v2, o.range, o.svar, self(o.func(), opts), o.nthreads);

DefaultSumsGen.Dot_X := (self, o, opts) >> o;

DefaultSumsGen.CheckEdgesUpdate := (self, o, opts) >> CheckEdgesUpdate(o.edges, o.var, self(o.func(), opts));

DefaultSumsGen.PruneEdges := (self, o, opts) >> o;

DefaultSumsGen.SMP_Accum := (self, o, opts) >> SMP_Accum(o.sr, o.var, o.range_min, o.range_max, self(o.func(), opts), o.nthreads);

DefaultSumsGen.Assign_Ptr := (self, o, opts) >> Assign_Ptr(self(o.func(), opts));

DefaultSumsGen.Scale_Pt := (self, o, opts) >> Scale_Pt(o.scalar, self(o.func(), opts));

DefaultSumsGen.IterateIndefinite := (self, o, opts) >> IterateIndefinite(self(o.op1(), opts), self(o.op2(), opts));

DefaultCodegen.Dot_X := meth(self, o, y, x, opts)
  local j1, j1m, j2, j2m;
  if (IsBound(opts.isCSR) and opts.isCSR) then
    j1 := var.fresh_t("j1", x.t);
    j1m := var.fresh_t("j1m", x.t);
    j2 := var.fresh_t("j2", x.t);
    j2m := var.fresh_t("j2m", x.t);
    return decl([j1, j1m, j2, j2m], chain(
      assign(y, o.sr.zero()),
      assign(j1, add(x, o.x_n, V(1), nth(x, o.start1[1]))),
      assign(j1m, add(x, o.x_n, V(1), nth(x, add(o.start1[1], V(1))))),
      assign(j2, add(x, o.x_n, V(1), nth(x, o.start2[1]))),
      assign(j2m, add(x, o.x_n, V(1), nth(x, add(o.start2[1], V(1))))),
      loopw(logic_and(lt(j1, j1m), lt(deref(j1), o.start1[2])),
        assign(j1, add(j1, V(1)))),
      loopw(logic_and(lt(j2, j2m), lt(deref(j2), o.start2[2])),
        assign(j2, add(j2, V(1)))),
      loopw(logic_and(logic_and(lt(j1, j1m), lt(j2, j2m)), logic_and(lt(deref(j1), add(o.start1[2], o.range)), lt(deref(j2), add(o.start2[2], o.range)))),
        if3(lt(deref(j1), deref(j2)),
          assign(j1, add(j1, V(1))),
        lt(deref(j2), deref(j1)),
          assign(j2, add(j2, V(1))),
        chain(
          assign(y, o.sr.sum(y, V(1))),
          assign(j1, add(j1, V(1))),
          assign(j2, add(j2, V(1))))))));
  fi;
end;

DefaultCodegen.Accum_X := meth(self, o, y, x, opts)
  local j, jm, t;
  t := var.fresh_t("t", y.t);
  if (IsBound(opts.isCSR) and opts.isCSR) then
    j := var.fresh_t("j", x.t);
    jm := var.fresh_t("jm", x.t);
    return decl([j, jm], chain(
      assign(y, o.sr.zero()),
      assign(j, add(x, o.x_n, V(1), nth(x, o.start[1]))),
      assign(jm, add(x, o.x_n, V(1), nth(x, add(o.start[1], V(1))))),
      loopw(logic_and(lt(j, jm), lt(deref(j), o.start[2])),
        assign(j, add(j, V(1)))),
      loopw(logic_and(lt(j, jm), lt(deref(j), add(o.start[2], o.range))), decl([o.var, t], chain(
        assign(o.var, deref(j)),
        self(o.func(), t, x, opts),
        assign(y, o.sr.sum(y, t)),
        assign(j, add(j, V(1))))))));
  fi;
end;

DefaultCodegen.Scat_E := meth(self, o, y, x, opts)
  local t, i;
  t := var.fresh_t("t", y.t);
  i := Ind();
  if (IsBound(opts.isCSR) and opts.isCSR) then
    return decl([o.v1, o.svar], chain(
      assign(o.v1, V(0)),
      loopf(i, V(0), o.range, decl([t, o.v2], chain(
        loopw(eq(nth(x, add(o.v1, V(1))), i),
          assign(o.v1, add(o.v1, V(1)))),
        assign(o.v2, nth(x, add(o.x_n, V(1), i))),
        self(o.func(), t, x, opts),
        assign(nth(o.svar, i), t))))));
  fi;
end;

DefaultCodegen.SMP_Scat_E := meth(self, o, y, x, opts)
  local t, i, j;
  t := var.fresh_t("t", y.t);
  i := Ind();
  j := Ind();
  if (IsBound(opts.isCSR) and opts.isCSR) then
    return decl([o.v1, o.svar],
      smp_loopf(i, V(0), o.x_n, o.nthreads,
        loopf(j, nth(x, i), nth(x, add(i, V(1))), decl([o.v1, o.v2, t], chain(
          assign(o.v1, i),
          assign(o.v2, nth(x, add(o.x_n, V(1), j))),
          self(o.func(), t, x, opts),
          assign(nth(o.svar, j), t))))));
  fi;
end;

DefaultCodegen.CheckEdgesUpdate := meth(self, o, y, x, opts)
  return decl([o.var], chain(
    assign(o.var, V(0)),
    assign(y, o.edges),
    self(o.func(), y, x, opts),
    if1(eq(o.edges, o.var),
      break_ic()),
    assign(o.edges, o.var),
    assign(y, o.var)));
end;

DefaultCodegen.PruneEdges := meth(self, o, y, x, opts)
  local t;
  t := var.fresh_t("t", y.t);
  if (IsBound(opts.isCSR) and opts.isCSR) then
    return decl([t], chain(
      assign(t, V(0)),
      loopf(o.idx, V(0), o.range, chain(
        loopw(eq(nth(x, add(t, V(1))), o.idx), chain(
          assign(t, add(t, V(1))),
          assign(nth(x, t), o.var))),
        if1(geq(nth(o.s, o.idx), sub(o.k, V(2))), chain(
          assign(nth(x, add(o.x_n, V(1), o.var)), nth(x, add(o.x_n, V(1), o.idx))),
          assign(o.var, add(o.var, V(1))))))),
      assign(nth(x, add(t, V(1))), o.var)));
  fi;
end;

DefaultCodegen.Accum := meth(self, o, y, x, opts)
  local t;
  t := var.fresh_t("t", y.t);
  return chain(
    assign(y, o.sr.zero()),
    loopf(o.var, o.range_min, o.range_max, decl([t], chain(
      self(o.func(), t, x, opts),
      assign(y, o.sr.sum(y, t))))));
end;

DefaultCodegen.SMP_Accum := meth(self, o, y, x, opts)
  local t;
  t := var.fresh_t("t", y.t);
  return chain(
    assign(y, o.sr.zero()),
    smp_reduct_loopf(o.sr, o.var, o.range_min, o.range_max, y, o.nthreads, decl([t], chain(
      self(o.func(), t, x, opts),
      assign(y, o.sr.sum(y, t))))));
end;

DefaultCodegen.Scale_Pt := meth(self, o, y, x, opts)
  return chain(
    self(o.func(), y, x, opts),
    assign(y, mul(o.scalar, y)));
end;

DefaultCodegen.Assign_Ptr := meth(self, o, y, x, opts)
  local t;
  t := var.fresh_t("t", y.t.t);
  return decl([t], chain(
    self(o._children[1], t, x, opts),
    assign(deref(y), t)));
end;

DefaultCodegen.IterateIndefinite := meth(self, o, y, x, opts)
  return loopw(V(1), chain(
    self(o.op1(), y, x, opts),
    self(o.op2(), y, x, opts)));
end;

GraphIndicesCS := [
    c -> Compile.pullDataDeclsRefs(c),
    c -> Compile.fastScalarize(c),
    c -> UnrollCode(c),
    c -> FlattenCode(c),
    c -> UntangleChain(c),
    #(c, opts) -> CopyPropagate.initial(c, opts),
    #(c, opts) -> HashConsts(c, opts),
    #c -> MarkDefUse(c),
    #(c, opts) -> BinSplit(c, opts),
    #c -> MarkDefUse(c),
    #CopyPropagate, # does CSE
    c -> Compile.declareVars(c)
];

TCDefaults := CopyFields(SpiralDefaults, rec(
  compileStrategy := GraphIndicesCS,
  X := var("IJ", TPtr(TInt)),
  XType := TPtr(TInt),
  arrayDataModifier := "",
  arrayBufModifier := "",
  Y := var("res", TPtr(TInt)),
  YType := TPtr(TInt),
  isCSR := true,
));


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

Class(AVX_LDST, rec(
    list := [],
    __call__ := meth(arg)
        local self;
	self := arg[1];
	Append(self.list, Drop(arg, 1));
    end,

    getList := self >> self.list :: SSE_LDST.list,

));

_evshuf1 := self >> let(
    a := _unwrap(self.args[1].ev()),
    p := self.args[2].p,
    self.semantic(a, p));

_evshuf2 := self >> let(
    a := _unwrap(self.args[1].ev()),
    b := _unwrap(self.args[2].ev()),
    p := self.args[3].p,
    self.semantic(a, b, p));

_evpack := self >> let(
    a := _unwrap(self.args[1].ev()),
    b := _unwrap(self.args[2].ev()),
    self.semantic(a, b, []));

#######################################################################################
#   AVX 4-way 64-bit floating-point instructions

vzero_4x64f_const := TVect(T_Real(64), 4).zero();
vzero_4x64f := () -> vzero_4x64f_const;

# Load
#
AVX_LDST(
    # __m256d _mm256_maskload_pd(double *a, __m256i mask);
    Class(vloadmask_4x64f, VecExp_4.unary(), rec(
        mask := n -> Reversed(Flat(List([1..4], i->["0x00000000", When(i <= n, "0x80000000", "0x00000000")])))
    )),

    # __m256d _mm256_broadcast_sd(const double *a)
    Class(vbroadcast_4x64f, VecExp_4.unary()),
    # __m256d _mm256_loadu_pd(double const *a)
    Class(vloadu_4x64f, VecExp_4.unary())
);

# Store
#
AVX_LDST(
    # void _mm256_maskstore_pd(double *a, __m256i mask, __m256d b);
    Class(vstoremask_4x64f, VecStoreCommand.ternary(), rec(
        mask := n -> Reversed(Flat(List([1..4], i->["0x00000000", When(i <= n, "0x80000000", "0x00000000")])))
    )),

    # void _mm256_storeu_pd(double *a, __m256d b)
    Class(vstoreu_4x64f, VecStoreCommand.binary())
);

Class(addsub_4x64f,   VecExp_4.binary(), rec(
    ev := self >> add(self.args[1], mul(self.t.value([-1.0, 1.0, -1.0, 1.0]), self.args[2])).ev(),
));

Class(fmaddsub_4x64f, VecExp_4.ternary());

# __m256d _mm256_insertf128_pd(__m256d a, __m128d b, int offset);
Class(vinsert_2l_4x64f, VecExp_4.binary(), rec(
    ev := self >> let(
        a := _unwrap(self.args[1].ev()),
        b := _unwrap(self.args[2].ev()),
        When( self.args[3].p[1] = 0,
            b :: a{[3 .. 4]},
            a{[1 .. 2]} :: b )),
    computeType := self >> self.args[1].t,
));

# __m128d _mm256_extractf128_pd(__m256d a, int offset);
Class(vextract_2l_4x64f, VecExp_4.unary(), rec(
    semantic := (in1, p) -> in1{[1+2*p[1] .. 2 + 2*p[1]]},
    ev       := _evshuf1,

    computeType := self >> Checked(IsVecT(self.args[1].t),
	TVect(self.args[1].t.t, 2)), #self.args[1].t.size/2,
));

# Binary shuffle
#

# __m256d _mm256_unpacklo_pd(__m256d a, __m256d b);
Class(vunpacklo_4x64f, VecExp_4.binary(), rec(
    semantic := (in1, in2, p) -> [in1[1], in2[1], in1[3], in2[3]],
    ev := _evpack
));

# __m256d _mm256_unpackhi_pd(__m256d a, __m256d b);
Class(vunpackhi_4x64f, VecExp_4.binary(), rec(
    semantic := (in1, in2, p) -> [in1[2], in2[2], in1[4], in2[4]],
    ev := _evpack
));

# __m256d _mm256_shuffle_pd(__m256d a, __m256d b, const int select);
Class(vshuffle_4x64f,  VecExp_4.binary(), rec(
    semantic := (in1, in2, p) -> [in1[p[1]], in2[p[2]], in1[p[3]+2], in2[p[4]+2]],
    params := self >> [[1,2], [1,2], [1,2], [1,2]],
    ev := _evshuf2
));

# __m256d _mm256_permute2_pd(__m256d a, __m256d b, __m256i control, int imm);
Class(vperm2_4x64f,    VecExp_4.binary(), rec(
    semantic := (in1, in2, p) -> let(lane1 := Concat(in1{[1..2]}, in2{[1..2]}), lane2 := Concat(in1{[3..4]}, in2{[3..4]}),
                                    [lane1[p[1]], lane1[p[2]], lane2[p[3]], lane2[p[4]]]),
    params := self >> [[1..4], [1..4], [1..4], [1..4]],
    ev := _evshuf2
));

#__m256d _mm256_blend_pd(__m256d m1, __m256d m2, const int mask);
Class(vblend_4x64f,  VecExp_4.binary(), rec(
    semantic := (in1, in2, p) -> List( Zip2(TransposedMat([in1, in2]), p), e -> e[1][e[2]]),
    params := self >> Replicate(4, [1,2]),
    ev := _evshuf2
));

# __m256d _mm256_permute2f128_pd(__m256d a, __m256d b, int control);
Class(vpermf128_4x64f, VecExp_4.binary(), rec(
    semantic := (in1, in2, p) -> let(v128 := [[in1[1], in1[2]], [in1[3], in1[4]], [in2[1], in2[2]], [in2[3], in2[4]]],
                                    Concat(v128[p[1]], v128[p[2]])),
    params := self >> [[1..4], [1..4]],
    ev := _evshuf2
));

# Unary shuffle
#

# __m256d _mm256_permute_pd(__m256d a, int control);
Class(vperm_4x64f, VecExp_4.unary(), rec(
    semantic := (in1, p) -> [in1[p[1]], in1[p[2]], in1[p[3]+2], in1[p[4]+2]],
    params := self >> [[1,2], [1,2], [1,2], [1,2]],
    ev := _evshuf1
));

Class(vuunpacklo_4x64f, VecExp_4.unaryFromBinop(vunpacklo_4x64f));
Class(vuunpackhi_4x64f, VecExp_4.unaryFromBinop(vunpackhi_4x64f));
Class(vushuffle_4x64f,  VecExp_4.unaryFromBinop(vshuffle_4x64f));
Class(vuperm2_4x64f,    VecExp_4.unaryFromBinop(vperm2_4x64f));
Class(vupermf128_4x64f, VecExp_4.unaryFromBinop(vpermf128_4x64f));

#######################################################################################
#   AVX 8-way 32-bit float instructions

vzero_8x32f_const := TVect(T_Real(64), 8).zero();
vzero_8x32f := () -> vzero_8x32f_const;

Class(addsub_8x32f,   VecExp_8.binary(), rec(
    ev := self >> add(self.args[1], mul(self.t.value([-1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0, 1.0]), self.args[2])).ev(),
));
Class(fmaddsub_8x32f, VecExp_8.ternary());

# Load
#
AVX_LDST(
    # __m256 _mm256_maskload_ps(float *a, __m256i mask);
    Class(vloadmask_8x32f, VecExp_8.unary(), rec(
        mask := n -> Reversed(List([1..8], i -> When(i <= n, "0x80000000", "0x00000000")))
    )),

    # __m256 _mm256_loadu_ps(float const *a)
    Class(vloadu_8x32f, VecExp_8.unary())
);

# Store
#
AVX_LDST(
    # void _mm256_maskstore_ps(float *a, __m256i mask, __m256 b);
    Class(vstoremask_8x32f, VecStoreCommand.ternary(), rec(
        mask := n -> Reversed(List([1..8], i->When(i <= n, "0x80000000", "0x00000000")))
    )),

    # void _mm256_storeu_ps(float *a, __m256 b)
    Class(vstoreu_8x32f, VecStoreCommand.binary())
);

# __m256 _mm256_insertf128_ps(__m256 a, __m128d , int offset);
Class(vinsert_4l_8x32f, VecExp_4.binary(), rec(
    ev := self >> let(
        a := _unwrap(self.args[1].ev()),
        b := _unwrap(self.args[2].ev()),
        When( self.args[3].p[1] = 0,
            b :: a{[5 .. 8]},
            a{[1 .. 4]} :: b )),
    computeType := self >> self.args[1].t,
));

# __m128 _mm256_extractf128_pd(__m256 a, int offset);
Class(vextract_4l_8x32f, VecExp_8.unary(), rec(
    semantic := (in1, p) -> in1{[1+4*p[1] .. 4 + 4*p[1]]},
    ev       := _evshuf1,

    computeType := self >> Checked(IsVecT(self.args[1].t),
	TVect(self.args[1].t.t, 4)), #self.args[1].t.size/2,
));

# Binary shuffle
#

# __m256 _mm256_unpacklo_ps(__m256 a, __m256 b);
Class(vunpacklo_8x32f, VecExp_8.binary(), rec(
    semantic := (in1, in2, p) -> [in1[1], in2[1], in1[2], in2[2], in1[5], in2[5], in1[6], in2[6]],
    ev := _evpack,
));

# __m256 _mm256_unpackhi_ps(__m256 a, __m256 b);
Class(vunpackhi_8x32f, VecExp_8.binary(), rec(
    semantic := (in1, in2, p) -> [in1[3], in2[3], in1[4], in2[4], in1[7], in2[7], in1[8], in2[8]],
    ev := _evpack,
));

# __m256 _mm256_permute2f128_ps(__m256 a, __m256 b, int control);
Class(vpermf128_8x32f, VecExp_8.binary(), rec(
    semantic := (in1, in2, p) -> let(v128 := [in1{[1..4]}, in1{[5..8]}, in2{[1..4]}, in2{[5..8]}],
                                    Concat(v128[p[1]], v128[p[2]])),
    params := self >> [[1..4], [1..4]],
    ev := _evshuf2,
));

# __m256 _mm256_permute2_ps(__m256 a, __m256 b, __m256i control, int imm);
Class(vperm2_8x32f, VecExp_8.binary(), rec(
    semantic := (in1, in2, p) -> let(lane1 := Concat(in1{[1..4]}, in2{[1..4]}), lane2 := Concat(in1{[5..8]}, in2{[5..8]}),
                                    [lane1[p[1]], lane1[p[2]], lane1[p[3]], lane1[p[4]], lane2[p[1]], lane2[p[2]], lane2[p[3]], lane2[p[4]]]),
    params := self >> [[1..8], [1..8], [1..8], [1..8]],
    ev := _evshuf2
));

# __m256 _mm256_shuffle_ps(__m256 a, __m256 b, const int select);
Class(vshuffle_8x32f, VecExp_8.binary(), rec(
    semantic := (in1, in2, p) -> [in1[p[1]], in1[p[2]], in2[p[3]], in2[p[4]], in1[p[1]+4], in1[p[2]+4], in2[p[3]+4], in2[p[4]+4]],
    params := self >> [[1..4], [1..4], [1..4], [1..4]],
    ev := _evshuf2,
));

#__m256 _mm256_blend_ps(__m256 m1, __m256 m2, const int mask);
Class(vblend_8x32f,  VecExp_8.binary(), rec(
    semantic := (in1, in2, p) -> List( Zip2(TransposedMat([in1, in2]), p), e -> e[1][e[2]]),
    params := self >> Replicate(8, [1,2]),
    ev := _evshuf2
));

# Unary shuffle
#

# __m256 _mm256_permute_ps(__m256 a, int control);
Class(vperm_8x32f, VecExp_8.unary(), rec(
    semantic := (in1, p) -> [in1[p[1]], in1[p[2]], in1[p[3]], in1[p[4]], in1[p[1]+4], in1[p[2]+4], in1[p[3]+4], in1[p[4]+4]],
    params := self >> [[1..4], [1..4], [1..4], [1..4]],
    ev := _evshuf1
));

Class(vuunpacklo_8x32f, VecExp_8.unaryFromBinop(vunpacklo_8x32f));
Class(vuunpackhi_8x32f, VecExp_8.unaryFromBinop(vunpackhi_8x32f));
Class(vushuffle_8x32f,  VecExp_8.unaryFromBinop(vshuffle_8x32f));
Class(vupermf128_8x32f, VecExp_8.unaryFromBinop(vpermf128_8x32f));

# __m256 _mm256_permutevar_ps(__m256 a, __m256i control);
Class(vpermv_8x32f, VecExp_8.unary(), rec(
    semantic := (in1, p) -> [in1[p[1]], in1[p[2]], in1[p[3]], in1[p[4]], in1[p[5]+4], in1[p[6]+4], in1[p[7]+4], in1[p[8]+4]],
    params := self >> Replicate(8, [1,2]),
    ev := _evshuf1,
));

# __m256 _mm256_movehdup_ps (__m256 a);
Class(vhdup_8x32f, VecExp_8.unary(), rec(
    semantic := (in1, p) -> [in1[2], in1[2], in1[4], in1[4], in1[6], in1[6], in1[8], in1[8]],
    ev := self >> let( v := self._vval(1), self.t.value(self.semantic(v, []))),
));

# __m256 _mm256_moveldup_ps (__m256 a);
Class(vldup_8x32f, VecExp_8.unary(), rec(
    semantic := (in1, p) -> [in1[1], in1[1], in1[3], in1[3], in1[5], in1[5], in1[7], in1[7]],
    ev := self >> let( v := self._vval(1), self.t.value(self.semantic(v, []))),
));

# vcxtr_8x32f is a virtual instruction: in-register Tensor(L(4,2),I(2))
#    later rewritten to vblend_8x32f(x, vperm_8x32f(vupermf128_8x32f(x, [ 2, 1 ]), [3,4,1,2]), [1,1,2,2,2,2,1,1])
#    this helps SIMD_ISA_DB to find this permutation
Class(vcxtr_8x32f, VecExp_8.unary(), rec(
    semantic := (in1, p) -> [in1[1], in1[2], in1[5], in1[6], in1[3], in1[4], in1[7], in1[8]],
    ev := self >> let( v := self._vval(1), self.t.value(self.semantic(v, []))),
    vcost := 5, # 3 instructions + dependency penalty
));

# Type Conversion

# __m256 _mm256_cvtpd_ps (__m256d a)
Class(vcvt_8x32f_4x64f, VecExp_4.unary(), rec(
    computeType := (self) >> TVect(T_Real(32), 8)
));

# __m256d _mm256_cvtps_pd (__m128 a)
Class(vcvt_4x64f_4x32f, VecExp_4.unary(), rec(
    computeType := (self) >> TVect(T_Real(64), 4)
));

# __m256d _mm256_cvtepi32_pd (__m128i src)
Class(vcvt_4x64f_4x32i, VecExp_4.unary(), rec(
    computeType := (self) >> TVect(T_Real(64), 4)
));

# __m128i _mm256_cvtpd_epi32 (__m256d src), rounding
Class(vcvt_4x32i_4x64f, VecExp_4.unary(), rec(
    computeType := (self) >> TVect(T_Int(32), 4)
));

# __m128i _mm256_cvttpd_epi32 (__m256d src), truncation
Class(vcvtt_4x32i_4x64f, VecExp_4.unary(), rec(
    computeType := (self) >> TVect(T_Int(32), 4)
));

# __m256 _mm256_cvtepi32_ps (__m256i src)
Class(vcvt_8x32f_8x32i, VecExp_8.unary(), rec(
    computeType := (self) >> TVect(T_Real(32), 8)
));

# type conversion 8x32f to 8x32i, rounding
# __m256i _mm256_cvtps_epi32 (__m256 a)
Class(vcvt_8x32i_8x32f, VecExp_8.unary(), rec(
    computeType := (self) >> TVect(T_Int(32), 8)
));

# type conversion 8x32f to 8x32i, truncation toward zero
# __m256i _mm256_cvttps_epi32 (__m256 a)
Class(vcvtt_8x32i_8x32f, VecExp_8.unary(), rec(
    computeType := (self) >> TVect(T_Int(32), 8)
));


#############################################################################
##
#W  small.gi                 GAP group library             Hans Ulrich Besche
##                                               Bettina Eick, Eamonn O'Brien
##
##  This file contains the basic installations for the library of small
##  groups and the group identification routines.
##

#############################################################################
##
#F  SMALL_AVAILABLE_FUNCS
##
##  On every level of the small groups library one function is written into
##  this list. It will detect those sizes, which are contained in this
##  library level.
SMALL_AVAILABLE_FUNCS := [ ];

#############################################################################
##
#F  SMALL_AVAILABLE( size )
##
##  returns fail if the library of groups of <size> is not installed.
##  Otherwise a record with some information about the construction of the
##  groups of <size> is returned.
InstallGlobalFunction( SMALL_AVAILABLE, function( size )
    local l, r;

    if not IsPosInt( size ) then
      Error( "<size> must be a positive integer");
    fi;

    for l in [ 1 .. Length( SMALL_AVAILABLE_FUNCS ) ] do
        if IsBound( SMALL_AVAILABLE_FUNCS[ l ] ) then
            r := SMALL_AVAILABLE_FUNCS[ l ]( size );
            if r <> fail then
                return r;
            fi;
        fi;
    od;
    return fail;
end );

InstallGlobalFunction( SmallGroupsAvailable,
function(order)
    return SMALL_AVAILABLE(order) <> fail;
end);

InstallGlobalFunction( NumberSmallGroupsAvailable,
function(order)
    if order = 1024 then
        return true;
    else
        return SmallGroupsAvailable(order);
    fi;
end);

#############################################################################
##
#F  SMALL_GROUP_FUNCS
##
##  This list will contain all functions to construct/read the groups from
##  the library.
SMALL_GROUP_FUNCS := [ ];

#############################################################################
##
#F  CODE_SMALL_GROUP_FUNCS
##
##  This list will contain those functions used to read the code of the
##  groups of some sizes from the data files.
CODE_SMALL_GROUP_FUNCS := [ ];

#############################################################################
##
#F  NUMBER_SMALL_GROUPS_FUNCS
##
NUMBER_SMALL_GROUPS_FUNCS := [ ];

#############################################################################
##
#F  SELECT_SMALL_GROUPS_FUNCS
##
SELECT_SMALL_GROUPS_FUNCS := [ ];

#############################################################################
##
#V  SMALL_GROUP_LIB
##
##  This list will contain all data for the group construction read from the
##  small group library.
SMALL_GROUP_LIB := [ ];

#############################################################################
##
#V  PROPERTIES_SMALL_GROUPS
##
##  This list will contain all data for the group selection read from the
##  small group library.
PROPERTIES_SMALL_GROUPS := [ ];

#############################################################################
##
#F  SmallGroup(<size>,<i>)
##
##  returns the <i>th  group of  order <size> in the catalogue. It will return
##  an PcGroup, if the group is soluble and a permutation group otherwise.
##  If the groups of this size are not installed, it will return an error.
InstallGlobalFunction( SmallGroup, function( arg )
    local inforec, g, size, i, nid;

    if Length( arg ) = 1 then
        if not IsList( arg[1] ) or Length( arg[1] ) <> 2 then
            Error( "usage: SmallGroup( order, number )" );
        fi;
        size := arg[ 1 ][ 1 ];
        i    := arg[ 1 ][ 2 ];
    elif Length( arg ) = 2 then
        size := arg[ 1 ];
        i    := arg[ 2 ];
    else
        Error( "usage: SmallGroup( order, number )" );
    fi;
    if not IsPosInt( size ) or not IsPosInt( i ) then
        Error( "usage: SmallGroup( order, number )" );
    fi;
    inforec := SMALL_AVAILABLE( size );
    if inforec = fail then
        Error( "the library of groups of size ", size, " is not available" );
    fi;
    nid := i;
    if not SMALL_GROUPS_OLD_ORDER then
        if size = 3^7 then
            nid := SMALLGP_PERM3(i);
        elif size = 5^7 then
            nid := SMALLGP_PERM5(i);
        elif size = 7^7 then
            nid := SMALLGP_PERM7(i);
        elif size = 11^7 then
            nid := SMALLGP_PERM11(i);
        fi;
    fi;
    g := SMALL_GROUP_FUNCS[ inforec.func ]( size, nid, inforec );
    SetIdGroup( g, [ size, i ] );
    IsPGroup( g );
    return g;
end );

#############################################################################
##
#F  NumberSmallGroups(<size>)
##
##  returns the  number of groups of the order <size>.
InstallGlobalFunction( NumberSmallGroups, function( size )
    local inforec;

    if not IsPosInt( size ) then
        Error( "usage: NumberSmallGroups( order )" );
    fi;
    if size = 1024 then
        return 49487365422;
    fi;

    inforec := SMALL_AVAILABLE( size );
    if inforec = fail then
        Error( "the library of groups of size ", size, " is not available" );
    fi;

    if IsBound( inforec.number ) then
        return inforec.number;
    fi;
    return NUMBER_SMALL_GROUPS_FUNCS[ inforec.func ]( size, inforec ).number;
end );

#############################################################################
##
#F  SelectSmallGroups( argl, all, id )
##
InstallGlobalFunction( SelectSmallGroups, function( argl, all, id )
    local sizes, size, i, funcs, vals, gs, inforec, result, hasSizes, pos,
          idList;

    sizes := [ ];
    hasSizes := false;
    idList := fail;

    for i in [ 1 .. Length( argl ) ] do
        if i = 1 and argl[ i ] = Size then
            ;
        elif ( not hasSizes ) and IsList( argl[ i ] )
                              and Length( sizes ) = 1 then
            idList := argl[ i ];
        elif ( not hasSizes ) and IsList( argl[ i ] ) then
            Append( sizes, argl[ i ] );
        elif ( not hasSizes ) and IsPosInt( argl[ i ] ) then
            Add( sizes, argl[ i ] );
        elif ( not hasSizes ) and sizes <> [] and IsFunction( argl[i] ) then
            hasSizes     := true;
            funcs        := [ argl[ i ] ];
            vals         := [ [ ] ];
            pos          := 1;
        elif not hasSizes then
            Error( "usage: AllSmallGroups / OneGroup(\n",
                   "             Size, [ sizes ],\n",
                   "             function1, [ values1 ],\n",
                   "             function2, [ values2 ], ... )" );
        elif vals[ pos ] <> [ ] and IsFunction( argl[ i ] ) then
            pos          := pos + 1;
            funcs[ pos ] := argl[ i ];
            vals[ pos ]  := [ ];
        elif IsFunction( argl[ i ] ) then
            vals[ pos ]  := [ true ];
            pos          := pos + 1;
            funcs[ pos ] := argl[ i ];
            vals[ pos ]  := [ ];
        elif IsList( argl[ i ] ) and vals[ pos ] = [ ] then
            vals[ pos ]  := argl[ i ];
        elif IsList( argl[ i ] ) and IsInt( argl[ i ][ 1 ] ) and
             IsList( vals[ pos ][ 1 ] ) and IsInt( vals[ pos ][1][ 1 ] ) then
            Add( vals[ pos ], argl[ i ] );
        elif IsList( argl[ i ] ) and IsInt( argl[ i ][ 1 ] ) and
             IsInt( vals[ pos ][ 1 ] ) then
            vals[ pos ]  := [ vals[ pos ], argl[ i ] ];
        else
            Add( vals[ pos ], argl[ i ] );
        fi;
    od;

    if sizes <> [ ] and ( not IsBound( vals ) ) then
        funcs := [ ];
        vals  := [ ];
    elif vals[ pos ] = [ ] then
        vals[ pos ] := [ true ];
    fi;

    result := [ ];
    for size in sizes do
        inforec := SMALL_AVAILABLE( size );
        if inforec = fail then
            Error( "AllSmallGroups / OneGroup: groups of order ", size,
                   " not available" );
        fi;
        gs := SELECT_SMALL_GROUPS_FUNCS[ inforec.func ]
                             ( size, funcs, vals, inforec, all, id, idList );
        if all then
            Append( result, gs );
        elif gs <> fail then
            return gs;
        fi;
    od;

    if all then
        return result;
    else
        return fail;
    fi;
end );

#############################################################################
##
#F ID_AVAILABLE_FUNCS
##
ID_AVAILABLE_FUNCS := [ ];

#############################################################################
##
#F ID_AVAILABLE
##
InstallGlobalFunction( ID_AVAILABLE, function( size )
    local l, r;

    if not IsInt( size ) then return fail; fi;

    for l in [ 1 .. Length( ID_AVAILABLE_FUNCS ) ] do
        if IsBound( ID_AVAILABLE_FUNCS[ l ] ) then
            r := ID_AVAILABLE_FUNCS[ l ]( size );
            if r <> fail then
                return r;
            fi;
        fi;
    od;
    return fail;
end );

InstallGlobalFunction( IdGroupsAvailable,
function(order)
    return ID_AVAILABLE(order) <> fail;
end);

#############################################################################
##
#F  ID_GROUP_FUNCS
##
ID_GROUP_FUNCS := [ ];

#############################################################################
##
#M  IdGroup( G )
##
InstallMethod( IdGroup,
               "generic method for groups",
               true,
               [ IsGroup ],
               0,
function( G )
    local inforec, size, id;

    size := Size( G );
    if size = 1 then return [ 1, 1 ]; fi;

    inforec := ID_AVAILABLE( size );
    if inforec = fail then
        Error( "the group identification for groups of size ", size,
               " is not available" );
    fi;

    if not ( IsPcGroup( G ) or IsPermGroup( G ) ) then
        if IsSolvableGroup( G ) then
            G := Image( IsomorphismPcGroup( G ) );
        else
            G := Image( IsomorphismPermGroup( G ) );
        fi;
    fi;

    if Size( G ) > 1000 and IsPermGroup( G )
          and LargestMovedPoint( G ) > 100 and IsSolvableGroup( G ) then
        G := Image( IsomorphismPcGroup( G ) );
    fi;

    if IsPcGroup( G ) and HasParent( G ) and Size( Parent( G ) ) > 10000
       and Size( Parent( G ) ) / Size( G ) > 10 then
        G := PcGroupCode( CodePcGroup( G ), Size( G ) );
    fi;

    id := ID_GROUP_FUNCS[ inforec.func ]( G, inforec );

    if not SMALL_GROUPS_OLD_ORDER then
        if size = 3^7 then
          id:=First([1..NrSmallGroups(3^7)],x->SMALLGP_PERM3(x)=id);
        elif size = 5^7 then
          # note that the permutation is not an involution!
          id:=First([1..NrSmallGroups(5^7)],x->SMALLGP_PERM5(x)=id);
        elif size = 7^7 then
          id:=First([1..NrSmallGroups(7^7)],x->SMALLGP_PERM7(x)=id);
        elif size = 11^7 then
          id:=First([1..NrSmallGroups(11^7)],x->SMALLGP_PERM11(x)=id);
        fi;
    fi;
    return [ size, id ];
end );

#############################################################################
##
#V  ID_GROUP_TREE
##
##  Variable containing information for group identification
ID_GROUP_TREE := rec( fp := [ 1 .. 50000 ], next := [ ] );

#############################################################################
##
#F  ReadSmallLib( str, i, size, list )
##
##  universal reading function for data files
ReadSmallLib := function( str, i, size, list )
    local l, str2, str3, j;

    l := "abcdefghijklmnopqrstuvwxyz";
    str2 := Concatenation( str, String( size ) );
    str3 :=  [ ];
    for j in list do
        if j > 702 then
            Add( str3, l[ QuoInt( j - 27, 676 ) ] );
            j := 27 + ( j - 27 ) mod 676;
        fi;
        if j > 26 then
            Add( str3, l[ QuoInt( j - 1, 26 ) ] );
        fi;
        Add( str3, l[ ( j - 1 ) mod 26 + 1 ] );
    od;

    if Length( str2 ) > 8 then
        str3 := Concatenation( str2{[ 9..Length( str2 ) ]} , str3 );
        str2 := str2{[ 1..8 ]};
    elif Length( str3 ) = 0 then
        str3 := "z";
    elif Length( str3 ) > 3 then
        str2 := Concatenation( str2, str3{[ 1 .. Length( str3 ) - 3 ]} );
        str3 := str3{[ Length( str3 ) - 2 .. Length( str3 ) ]};
    fi;

    if str in [ "sml", "col", "prop", "nor" ] then
        READ_SMALL_FUNCS[ i ]( Concatenation( str2, ".", str3 ) );
    else
        READ_IDLIB_FUNCS[ i ]( Concatenation( str2, ".", str3 ) );
    fi;
end;

#############################################################################
##
#V  GAP3_CATALOGUE_ID_GROUP
##
##  List with the gap3-ids. Will be loaded before use.
GAP3_CATALOGUE_ID_GROUP := fail;

#############################################################################
##
#M  Gap3CatalogueIdGroup(<G>)
##
InstallMethod( Gap3CatalogueIdGroup,
               "for permgroups or pcgroups",
               true,
               [ IsGroup ],
               0,
function( G )
    if Size( G ) > 100 then
        Error( "Gap3CatalogueIdGroup: the group catalogue of gap-3.0 was\n",
               "limited to size 100" );
    fi;

    if GAP3_CATALOGUE_ID_GROUP = fail then
        ReadPackage( "smallgrp", "gap/gap3cat.g" );
    fi;

    if not IsBound( GAP3_CATALOGUE_ID_GROUP[ Size( G ) ] ) then
        return IdGroup( G );
    fi;

    return [ Size( G ),
             GAP3_CATALOGUE_ID_GROUP[ Size( G ) ][ IdGroup( G )[ 2 ] ] ];
end );

#############################################################################
##
#F  Gap3CatalogueGroup(<size>,<i>)
##
InstallGlobalFunction( Gap3CatalogueGroup,
function( size, i )
    local p;

    if size > 100 then
        Error( "Gap3CatalogueIdGroup: the group catalogue of gap-3.0 was\n",
               "limited to size 100" );
    fi;

    if GAP3_CATALOGUE_ID_GROUP = fail then
        ReadPackage("smallgrp", "gap/gap3cat.g");
    fi;

    if not IsBound( GAP3_CATALOGUE_ID_GROUP[ size ] ) then
        return SmallGroup( size, i );
    fi;

    p := Position( GAP3_CATALOGUE_ID_GROUP[ size ], i );
    if p = fail then
        Error( "Gap3CatalogueGroup: there are just ",
               Length( GAP3_CATALOGUE_ID_GROUP[ size ] ),
               " groups of size ", size );
    fi;

    return SmallGroup( size, p );
end );

#############################################################################
##
#F  UnloadSmallGroupsData( )
##
##  will remove the data from the small groups library from memory.
InstallGlobalFunction( UnloadSmallGroupsData, function( )
    SMALL_GROUP_LIB := [ ];
    PROPERTIES_SMALL_GROUPS := [ ];
    GAP3_CATALOGUE_ID_GROUP := fail;
    ID_GROUP_TREE := rec( fp := [ 1 .. 50000 ], next := [ ] );
end );

#############################################################################
##
#M  FrattinifactorSize(<G>)
##
InstallMethod( FrattinifactorSize,
               "generic method for groups",
               true,
               [ IsGroup ],
               0,
function( G )
    return Size( G ) / Size( FrattiniSubgroup( G ) );
end );

#############################################################################
##
#M  FrattinifactorId(<G>)
##
InstallMethod( FrattinifactorId,
               "generic method for groups",
               true,
               [ IsGroup ],
               0,
function( G )
    local ff;

    ff := G / FrattiniSubgroup( G );
    if ID_AVAILABLE( Size( ff ) ) = fail then
        Error( "FrattinifactorId: IdGroup for groups of size ", Size( ff ),
               " not available" );
    fi;
    return IdGroup( ff );
end );


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

#############################################################################
##
#M  AutomGrp2FR (<G>)
##
InstallMethod(AutomGrp2FR, "for [IsSelfSimilarGroup]", [IsSelfSimilarGroup],
function(G)
  local fam,ngens;
  fam:=UnderlyingSelfSimFamily(G);
  ngens:=Length(fam!.names);
  return SCGroup(FRMachine(fam!.names, List(fam!.recurlist{[1..ngens]},x->x{[1..fam!.deg]}),
                                  List(fam!.recurlist{[1..ngens]},x->x[fam!.deg+1])));
end);

#############################################################################
##
#M  AutomGrp2FR (<G>)
##
InstallMethod(AutomGrp2FR, "for [IsSelfSimGroup]", [IsSelfSimGroup],
function(G)
  local fam,gens_letter_reps,ngens,M;
  gens_letter_reps:=List(GeneratorsOfGroup(G),w->LetterRepAssocWord(w!.word));
  fam:=UnderlyingSelfSimFamily(G);
  ngens:=Length(fam!.names);
  M:=FRMachine(fam!.names, List(fam!.recurlist{[1..ngens]},x->x{[1..fam!.deg]}),
                                  List(fam!.recurlist{[1..ngens]},x->x[fam!.deg+1]));
  return Group(List(gens_letter_reps,w->FRElement(M,w)));
end);

#############################################################################
##
#M  AutomGrp2FR (<G>)
##
InstallMethod(AutomGrp2FR, "for [IsSelfSimilarSemigroup]", [IsSelfSimilarSemigroup],
function(G)
  local fam,ngens;
  fam:=UnderlyingSelfSimFamily(G);
  ngens:=Length(fam!.names);
  return SCSemigroup(FRMachine(fam!.names, List(fam!.recurlist{[1..ngens]},x->x{[1..fam!.deg]}),
                                  List(fam!.recurlist{[1..ngens]},x->x[fam!.deg+1])));
end);

#############################################################################
##
#M  AutomGrp2FR (<G>)
##
InstallMethod(AutomGrp2FR, "for [IsSelfSimSemigroup]", [IsSelfSimSemigroup],
function(G)
  local fam,gens_letter_reps,ngens,M;
  gens_letter_reps:=List(GeneratorsOfSemigroup(G),w->LetterRepAssocWord(w!.word));
  fam:=UnderlyingSelfSimFamily(G);
  ngens:=Length(fam!.names);
  M:=FRMachine(fam!.names, List(fam!.recurlist{[1..ngens]},x->x{[1..fam!.deg]}),
                                  List(fam!.recurlist{[1..ngens]},x->x[fam!.deg+1]));
  return Semigroup(List(gens_letter_reps,w->FRElement(M,w)));
end);

#############################################################################
##
#M  AutomGrp2FR (<G>)
##
InstallMethod(AutomGrp2FR, "for [IsAutomatonGroup]", [IsAutomatonGroup],
function(G)
  local recur_list, fam, names, d, i, s;
  fam := UnderlyingAutomFamily(G);
  names := fam!.names;
  d:=DegreeOfTree(fam);
  recur_list := StructuralCopy(fam!.automatonlist{[1..Length(names)]});

  # if identity is not one of the states
  if Length(fam!.automatonlist)=2*Length(names) then
    for s in recur_list do
      for i in [1..d] do s[i]:=[s[i]]; od;
    od;
  # if identity is one of the states, it should be the last one, so
  # when converting to the recurlist, we replace corresponding entries
  # with empty lists
  else
    for s in recur_list do
      for i in [1..d] do
        if s[i]<=Length(names) then
          s[i]:=[s[i]];
        else
          s[i]:=[];
        fi;
      od;
    od;
  fi;
  return AutomGrp2FR(SelfSimilarGroup(recur_list{[1..Length(names)]},names));
end);

#############################################################################
##
#M  AutomGrp2FR (<G>)
##
InstallMethod(AutomGrp2FR, "for [IsAutomGroup]", [IsAutomGroup],
function(G)
  local recur_list, fam, names, d, i, s, gens_letter_reps, M;
  fam := UnderlyingAutomFamily(G);
  names := fam!.names;
  d:=DegreeOfTree(fam);
  recur_list := StructuralCopy(fam!.automatonlist{[1..Length(names)]});

  # if identity is not one of the states
  if Length(fam!.automatonlist)=2*Length(names) then
    for s in recur_list do
      for i in [1..d] do s[i]:=[s[i]]; od;
    od;
  # if identity is one of the states, it should be the last one, so
  # when converting to the recurlist, we replace corresponding entries
  # with empty lists
  else
    for s in recur_list do
      for i in [1..d] do
        if s[i]<=Length(names) then
          s[i]:=[s[i]];
        else
          s[i]:=[];
        fi;
      od;
    od;
  fi;

  gens_letter_reps:=List(GeneratorsOfGroup(G),w->LetterRepAssocWord(w!.word));

  M:=FRMachine(fam!.names, List(recur_list,x->x{[1..fam!.deg]}),
                                  List(recur_list,x->x[fam!.deg+1]));

  return Group(List(gens_letter_reps,w->FRElement(M,w)));
end);

#############################################################################
##
#M  AutomGrp2FR (<G>)
##
InstallMethod(AutomGrp2FR, "for [IsAutomatonSemigroup]", [IsAutomatonSemigroup],
function(G)
  local recur_list, fam, names, d, i, s;
  fam := UnderlyingAutomFamily(G);
  names := fam!.names;
  d:=DegreeOfTree(fam);
  recur_list := StructuralCopy(fam!.automatonlist{[1..Length(names)]});

  # if identity is not one of the states
  if Length(fam!.automatonlist)=2*Length(names) then
    for s in recur_list do
      for i in [1..d] do s[i]:=[s[i]]; od;
    od;
  # if identity is one of the states, it should be the last one, so
  # when converting to the recurlist, we replace corresponding entries
  # with empty lists
  else
    for s in recur_list do
      for i in [1..d] do
        if s[i]<=Length(names) then
          s[i]:=[s[i]];
        else
          s[i]:=[];
        fi;
      od;
    od;
  fi;
  return AutomGrp2FR(SelfSimilarSemigroup(recur_list{[1..Length(names)]},names));
end);

#############################################################################
##
#M  AutomGrp2FR (<G>)
##
InstallMethod(AutomGrp2FR, "for [IsAutomSemigroup]", [IsAutomSemigroup],
function(G)
  local recur_list, fam, names, d, i, s, gens_letter_reps, M;
  fam := UnderlyingAutomFamily(G);
  names := fam!.names;
  d:=DegreeOfTree(fam);
  recur_list := StructuralCopy(fam!.automatonlist{[1..Length(names)]});

  # if identity is not one of the states
  if Length(fam!.automatonlist)=2*Length(names) then
    for s in recur_list do
      for i in [1..d] do s[i]:=[s[i]]; od;
    od;
  # if identity is one of the states, it should be the last one, so
  # when converting to the recurlist, we replace corresponding entries
  # with empty lists
  else
    for s in recur_list do
      for i in [1..d] do
        if s[i]<=Length(names) then
          s[i]:=[s[i]];
        else
          s[i]:=[];
        fi;
      od;
    od;
  fi;

  gens_letter_reps:=List(GeneratorsOfSemigroup(G),w->LetterRepAssocWord(w!.word));

  M:=FRMachine(fam!.names, List(recur_list,x->x{[1..fam!.deg]}),
                                  List(recur_list,x->x[fam!.deg+1]));

  return Semigroup(List(gens_letter_reps,w->FRElement(M,w)));
end);

#############################################################################
##
#M  AutomGrp2FR (<G>)
##
InstallMethod(AutomGrp2FR, "for [IsAutom or IsSelfSim]", [IsAutom],
function(a)
  local fam,G;
  fam:=FamilyObj(a);
  if fam!.isgroup then
    G:=AutomGrp2FR(Group(a));
  else
    G:=AutomGrp2FR(Semigroup(a));
  fi;
  return G.1;
end);

#############################################################################
##
#M  AutomGrp2FR (<G>)
##
InstallMethod(AutomGrp2FR, "for [IsAutom or IsSelfSim]", [IsSelfSim],
function(a)
  local fam,G;
  fam:=FamilyObj(a);
  if fam!.isgroup then
    G:=AutomGrp2FR(Group(a));
  else
    G:=AutomGrp2FR(Semigroup(a));
  fi;
  return G.1;
end);

#############################################################################
##
#M  FR2AutomGrp (<G>)
##
InstallMethod(FR2AutomGrp, "for [IsFRGroup and HasUnderlyingFRMachine]", [IsFRGroup and HasUnderlyingFRMachine],
function(G)
  local M, names, recurlist, i;
  M := UnderlyingFRMachine(G);
  names := List(GeneratorsOfGroup(M!.free),x->String(x));
  recurlist := List(M!.transitions,x->List(x,w->LetterRepAssocWord(w)));
  for i in [1..Length(recurlist)] do
    Add(recurlist[i],PermList(M!.output[i]));
  od;
  return SelfSimilarGroup(recurlist,names,false);
end);

#############################################################################
##
#M  FR2AutomGrp (<G>)
##
InstallMethod(FR2AutomGrp, "for [IsFRGroup]", [IsFRGroup],
function(G)
  local UG;
  UG := FR2AutomGrp(SCGroup(UnderlyingFRMachine(Representative(G))));
  return Group(List(GeneratorsOfGroup(G),x->SelfSim(AssocWordByLetterRep(FamilyObj(One(UnderlyingFreeGroup(UG))),
                                                    LetterRepAssocWord(InitialState(x))), UnderlyingSelfSimFamily(UG))));
end);

#############################################################################
##
#M  FR2AutomGrp (<G>)
##
InstallMethod(FR2AutomGrp, "for [IsFRSemigroup and HasUnderlyingFRMachine]", [IsFRSemigroup and HasUnderlyingFRMachine],
function(G)
  local M, names, recurlist, i;
  M := UnderlyingFRMachine(G);
  names := List(GeneratorsOfSemigroup(M!.free),x->String(x));
  recurlist := List(M!.transitions,x->List(x,w->LetterRepAssocWord(w)));
  for i in [1..Length(recurlist)] do
    Add(recurlist[i],Transformation(M!.output[i]));
  od;
  return SelfSimilarSemigroup(recurlist,names,false);
end);

#############################################################################
##
#M  FR2AutomGrp (<G>)
InstallMethod(FR2AutomGrp, "for [IsFRSemigroup]", [IsFRSemigroup],
function(G)
  local UG;
  UG := FR2AutomGrp(SCSemigroup(UnderlyingFRMachine(Representative(G))));
  return Semigroup(List(GeneratorsOfSemigroup(G),x->SelfSim(AssocWordByLetterRep(FamilyObj(One(UnderlyingFreeGroup(UG))),
                                                           LetterRepAssocWord(InitialState(x))), UnderlyingSelfSimFamily(UG))));
end);

#############################################################################
##
#M  FR2AutomGrp (<G>)
##
InstallMethod(FR2AutomGrp, "for [IsFRMonoid and HasUnderlyingFRMachine]", [IsFRMonoid and HasUnderlyingFRMachine],
function(G)
  local M, names, recurlist, i;
  M := UnderlyingFRMachine(G);
  names := List(GeneratorsOfMonoid(M!.free),x->String(x));
  recurlist := List(M!.transitions,x->List(x,w->LetterRepAssocWord(w)));
  for i in [1..Length(recurlist)] do
    Add(recurlist[i],Transformation(M!.output[i]));
  od;
  return Monoid(GeneratorsOfSemigroup(SelfSimilarSemigroup(recurlist,names,false)));
end);

#############################################################################
##
#M  FR2AutomGrp (<G>)
InstallMethod(FR2AutomGrp, "for [IsFRMonoid]", [IsFRMonoid],
function(G)
  local UG;
  UG := FR2AutomGrp(SCSemigroup(UnderlyingFRMachine(Representative(G))));
  return Monoid(List(GeneratorsOfMonoid(G),x->SelfSim(AssocWordByLetterRep(FamilyObj(One(UnderlyingFreeGroup(UG))),
                                                           LetterRepAssocWord(InitialState(x))), UnderlyingSelfSimFamily(UG))));
end);

#############################################################################
##
#M  FR2AutomGrp (<G>)
##
InstallMethod(FR2AutomGrp, "for [IsFRElement]", [IsFRElement],
function(a)
  local G, M;
  M:=UnderlyingFRMachine(a);
  # Group case
  if ForAll(M!.output,l->Set(l)=[1..Length(l)]) then
    G:=FR2AutomGrp(SCGroup(M));
  # Semigroup case
  else
    G:=FR2AutomGrp(SCSemigroup(M));
  fi;
  return SelfSim(AssocWordByLetterRep(FamilyObj(One(UnderlyingFreeGroup(G))),
                 LetterRepAssocWord(InitialState(a))), UnderlyingSelfSimFamily(G));
end);

#E


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

reps:=[[[1,1],[2,1],[3,1],[4,1],[5,1],[6,1],[7,1]],            # E_7
       [[1,1],[3,1],[10,1],[9,1],[5,1],[6,1],[7,1]],           # E_7(a_1)
       [[1,1],[2,1],[3,1],[9,1],[11,1],[12,1],[13,1]],         # E_7(a_2)
       [[15,1],[1,1],[17,1],[6,1],[7,1],[16,1],[4,1]],         # E_7(a_3) asta functioneaza in caracteristica 3
#       [[1,1],[4,1],[7,1],[11,1],[12,1],[15,1],[17,1]],        # E_7(a_3)
       [[1,1],[2,1],[3,1],[4,1],[5,1],[6,1]],                  # E_6
#       [[3,1],[5,1],[1,1],[6,1],[10,1],[11,1],[2,1]],          # E_6(a_1)
       [[1,1],[2,1],[10,1],[11,1],[5,1],[6,1]],                # E_6(a_1)
       [[7,1],[6,1],[5,1],[4,1],[2,1],[3,1]],                  # D_6
       [[1,1],[4,1],[7,1],[13,1],[15,1],[16,1],[17,1],[23,1]], # E_7(a_4) acelas ca cel mai de jos dar ordonat
#       [[15,1],[1,1],[17,1],[13,1],[23,1],[7,1],[16,1],[4,1]], # E_7(a_4) asta functioneaza in caracteristica 3
#       [[1,1],[4,1],[7,1],[10,1],[22,1],[23,1],[24,1]],        # E_7(a_4)
#       [[7,1],[6,1],[5,1],[9,1],[10,-1],[2,1],[3,1]],          # D_6(a_1)
       [[2,1],[3,1],[9,1],[11,1],[6,1],[7,1]],                # D_6(a_1)
       [[1,1],[3,1],[4,1],[2,1],[5,1],[7,1]],                  # D_5A_1
       [[1,1],[3,1],[4,1],[5,1],[6,1],[7,1]],                  # A_6
#       [[21,1],[23,1],[7,1],[24,1],[20,1],[4,1],[22,1]],       # E_7(a_5)
       [[4,1],[10,1],[13,1],[14,1],[21,1],[22,1],[23,1]],      # E_7(a_5)
       [[1,1],[3,1],[4,1],[2,1],[5,1]],                        # D_5
       [[15,1],[1,1],[17,1],[6,1],[16,1],[4,1]],               # E_6(a_3) this works in characteristic 3
#       [[4,1],[6,1],[8,1],[10,1],[16,1],[17,1]],               # E_6(a_3)
#       [[7,1],[12,1],[9,1],[10,-1],[11,1],[2,1],[3,1]],        # D_6(a_2)
       [[2,1],[3,1],[9,1],[11,1],[12,1],[13,1]],              # D_6(a_2)
#       [[1,1],[3,1],[9,1],[11,1],[2,1],[5,1],[7,1]],           # D_5(a_1)A_1
       [[1,1],[9,1],[10,1],[2,1],[5,1],[7,1]],                # D_5(a_1)A_1

       [[2,1],[4,1],[5,1],[6,1],[7,1],[1,1]],       # A_5A_1
       [[1,1],[3,1],[4,1],[5,1],[6,1]],             # (A_5)'
       [[1,1],[3,1],[4,1],[2,1],[6,1],[7,1]],       # A_4A_2
#       [[1,1],[3,1],[9,1],[11,1],[2,1],[5,1]],      # D_5(a_1)
#       [[1,1],[10,1],[11,1],[2,1],[5,1]],           # D_5(a_1) ALSO WORKS?
       [[1,1],[9,1],[10,1],[2,1],[5,1]],           # D_5(a_1)
       [[1,1],[2,1],[3,1],[4,1],[6,1]],             # A_4A_1
       [[3,1],[4,1],[2,1],[5,1],[7,1]],             # D_4A_1
       [[2,1],[4,1],[5,1],[6,1],[7,1]],             # (A_5)''
       [[1,1],[3,1],[2,1],[5,1],[6,1],[7,1]],       # A_3A_2A_1
       [[1,1],[2,1],[3,1],[4,1]],                   # A_4
#       [[3,1],[4,1],[2,1],[6,1],[7,1]],             # A_3A_2
       [[3,1],[4,1],[2,1],[6,1],[7,1]],             # A_3A_2
#       [[3,1],[9,1],[11,1],[2,1],[5,1],[7,1]],      # D_4(a_1)A_1
#       [[2,1],[3,1],[9,1],[11,1],[7,1]],           # D_4(a_1)A_1
       [[2,1],[5,1],[9,1],[10,1],[7,1]],           # D_4(a_1)A_1  cel de deasupra simetric fata de D4
       [[3,1],[4,1],[2,1],[5,1]],                   # D_4
       [[5,1],[6,1],[7,1],[2,1],[3,1]],             # A_3A_1^2
#       [[3,1],[9,1],[11,1],[2,1],[5,1]],            # D_4(a_1)
       [[2,1],[3,1],[9,1],[11,1]],                 # D_4(a_1)
       [[1,1],[3,1],[4,1],[6,1]],                   # (A_3A_1)'
       [[1,1],[3,1],[5,1],[6,1],[2,1]],             # A_2^2A_1
       [[5,1],[6,1],[7,1],[2,1]],                   # (A_3A_1)''
       [[1,1],[3,1],[2,1],[5,1],[7,1]],             # A_2A_1^3
       [[1,1],[3,1],[5,1],[6,1]],                   # A_2^2
       [[1,1],[3,1],[4,1]],                         # A_3
       [[2,1],[4,1],[1,1],[6,1]],                   # A_2A_1^2
       [[1,1],[3,1],[2,1]],                         # A_2A_1
       [[2,1],[3,1],[5,1],[7,1]],                   # A_1^4
       [[1,1],[3,1]],                               # A_2
       [[1,1],[4,1],[6,1]],                         # (A_1^3)'
       [[2,1],[5,1],[7,1]],                         # (A_1^3)''
       [[1,1],[6,1]],                               # A_1^2
       [[1,1]]                                      # A_1
       ];

I:=[[],          # E_7
    [4],         # E_7(a_1)
    [4,6],       # E_7(a_2)
#    [2,3,5],     # E_7(a_3)
    [],          # E_7(a_3)
    [],          # E_6
#    [4],         # E_6(a_1)
    [],          # E_6(a_1)
    [],          # D_6
#    [2,3,5,6],   # E_7(a_4)
    [],          # E_7(a_4)
#    [4],         # D_6(a_1)
    [],          # D_6(a_1)
    [],          # D_5A_1
    [],          # A_6
#    [1,2,3,5,6], # E_7(a_5)
    [],          # E_7(a_5)
    [],          # D_5
#    [2,3,5],     # E_6(a_3)
    [],          # E_6(a_3)
#    [4,5],       # D_6(a_2)    ???
    [],          # D_6(a_2)    ???
#    [4],         # D_5(a_1)A_1 ???
    [],          # D_5(a_1)A_1 ???

    [],          # A_5A_1
    [],          # (A_5)'
    [],          # A_4A_2
#    [4],         # D_5(a_1)    ???
    [],          # D_5(a_1)    ???
    [],          # A_4A_1
    [],          # D_4A_1
    [],          # (A_5)''
    [],          # A_3A_2A_1
    [],          # A_4
    [],          # A_3A_2
#    [4],         # D_4(a_1)A_1
    [],          # D_4(a_1)A_1
    [],          # D_4
    [],          # A_3A_1^2
#    [4],         # D_4(a_1)
    [],          # D_4(a_1)
    [],          # (A_3A_1)'
    [],          # A_2^2A_1
    [],          # (A_3A_1)''
    [],          # A_2A_1^3
    [],          # A_2^2
    [],          # A_3
    [],          # A_2A_1^2
    [],          # A_2A_1
    [],          # A_1^4
    [],          # A_2
    [],          # (A_1^3)'
    [],          # (A_1^3)''
    [],          # A_1^2
    []           # A_1
    ];

#
# The parabolic where the representative is distinguished
#
II:=[[1,2,3,4,5,6,7],  # E_7
     [1,2,3,4,5,6,7],  # E_7(a_1)
     [1,2,3,4,5,6,7],  # E_7(a_2)
     [1,2,3,4,5,6,7],  # E_7(a_3)
#     [],  # E_7(a_3)
     [1,2,3,4,5,6],    # E_6
     [1,2,3,4,5,6],    # E_6(a_1)
#     [],    # E_6(a_1)
     [2,3,4,5,6,7],    # D_6
     [1,2,3,4,5,6,7],  # E_7(a_4)
#     [],  # E_7(a_4)
     [2,3,4,5,6,7],    # D_6(a_1)
#     [],    # D_6(a_1)
     [1,2,3,4,5,7],    # D_5A_1
     [1,3,4,5,6,7],    # A_6
     [1,2,3,4,5,6,7],  # E_7(a_5)
#     [],  # E_7(a_5)
     [1,2,3,4,5],      # D_5
     [1,2,3,4,5,6],    # E_6(a_3)
#     [],    # E_6(a_3)
     [2,3,4,5,6,7],    # D_6(a_2)
#     [],    # D_6(a_2)
     [1,2,3,4,5,7],    # D_5(a_1)A_1
#     [],    # D_5(a_1)A_1

     [1,2,4,5,6,7],    # A_5A_1
     [1,3,4,5,6],      # (A_5)'
     [1,2,3,4,6,7],    # A_4A_2
     [1,2,3,4,5],      # D_5(a_1)
#     [],      # D_5(a_1)
     [1,2,3,4,6],      # A_4A_1
     [2,3,4,5,7],      # D_4A_1
     [2,4,5,6,7],      # (A_5)''
     [1,2,3,5,6,7],    # A_3A_2A_1
     [1,2,3,4],        # A_4
     [2,3,4,6,7],      # A_3A_2
     [2,3,4,5,7],      # D_4(a_1)A_1
#     [],      # D_4(a_1)A_1
     [2,3,4,5],        # D_4
     [2,3,5,6,7],      # A_3A_1^2
     [2,3,4,5],        # D_4(a_1)
#     [],        # D_4(a_1)
     [1,3,4,6],        # (A_3A_1)'
     [1,2,3,5,6],      # A_2^2A_1
     [2,5,6,7],        # (A_3A_1)''
     [1,2,3,5,7],      # A_2A_1^3
     [1,3,5,6],        # A_2^2
     [1,3,4],          # A_3
     [1,2,4,6],        # A_2A_1^2
     [1,2,3],          # A_2A_1
     [2,3,5,7],        # A_1^4
     [1,3],            # A_2
     [1,4,6],          # (A_1^3)'
     [2,5,7],          # (A_1^3)''
     [1,6],            # A_1^2
     [1]               # A_1
     ];

labels:=["E_7",
         "E_7(a_1)",
         "E_7(a_2)",
         "E_7(a_3)",
         "E_6",
         "E_6(a_1)",
         "D_6",
         "E_7(a_4)",
         "D_6(a_1)",
         "D_5A_1",
         "A_6",
         "E_7(a_5)",
         "D_5",
         "E_6(a_3)",
         "D_6(a_2)",
         "D_5(a_1)A_1",

         "A_5A_1",
         "(A_5)1",
         "A_4A_2",
         "D_5(a_1)",
         "A_4A_1",
         "D_4A_1",
         "(A_5)2",
         "A_3A_2A_1",
         "A_4",
         "A_3A_2",
         "D_4(a_1)A_1",
         "D_4",
         "A_3A_1^2",
         "D_4(a_1)",
         "(A_3A_1)1",
         "A_2^2A_1",
         "(A_3A_1)2",
         "A_2A_1^3",
         "A_2^2",
         "A_3",
         "A_2A_1^2",
         "A_2A_1",
         "A_1^4",
         "A_2",
         "(A_1^3)1",
         "(A_1^3)2",
         "A_1^2",
         "A_1"
         ];

tori:=[
       [2,2,2,2,2,2,2],   # E_7
       [2,2,2,0,2,2,2],   # E_7(a_1)
       [2,2,2,0,2,0,2],   # E_7(a_2)
       [2,0,0,2,0,2,2],   # E_7(a_3)
#    [],   # E_7(a_3)
       [2,2,2,2,2,2,-16], # E_6
       [2,2,2,0,2,2,-12], # E_6(a_1)
#    [], # E_6(a_1)
       [-15,2,2,2,2,2,2], # D_6
       [2,0,0,2,0,0,2],   # E_7(a_4)
#    [],   # E_7(a_4)
       [-11,2,2,0,2,2,2], # D_6(a_1)
#    [], # D_6(a_1)
       [2,2,2,2,2,-11,2], # D_5A_1
       [2,-12,2,2,2,2,2], # A_6
       [0,0,0,2,0,0,2],   # E_7(a_5)
#    [],   # E_7(a_5)
       [2,2,2,2,2,-10,0], # D_5
       [2,0,0,2,0,2,-8],  # E_6(a_3)
#    [],  # E_6(a_3)
       [-9,2,2,0,2,0,2],  # D_6(a_2)
#    [],  # D_6(a_2)
       [2,2,2,0,2,-8,2],  # D_5(a_1)A_1
#    [],  # D_5(a_1)A_1

       [2,2,-9,2,2,2,2],   # A_5A_1
       [2,-9,2,2,2,2,-5],  # (A_1)'
       [2,2,2,2,-8,2,2],   # A_4A_2
       [2,2,2,0,2,-7,0],   # D_5(a_1)
#    [],   # D_5(a_1)
       [2,2,2,2,-7,2,-1],  # A_4A_1
       [-6,2,2,2,2,-7,2],  # D_4A_1
       [0,2,-8,2,2,2,2],   # (A_5)''
       [2,2,2,-6,2,2,2],   # A_3A_2A_1
       [2,2,2,2,-6,0,0],   # A_4
       [-3,2,2,2,-6,2,2],  # A_3A_2
       [-4,2,2,0,2,-5,2],  # D_4(a_1)A_1
#    [],  # D_4(a_1)A_1
       [-6,2,2,2,2,-6,0],  # D_4
       [-1,2,2,-5,2,2,2],  # A_3A_1^2
       [-4,2,2,0,2,-4,0],  # D_4(a_1)
#    [],  # D_4(a_1)
       [2,-3,2,2,-4,2,-1], # (A_3A_1)'
       [2,2,2,-5,2,2,-2],  # A_2^2A_1
       [0,2,0,-4,2,2,2],   # (A_3A_1)''
       [2,2,2,-4,2,-2,2],  # A_2A_1^3
       [2,0,2,-4,2,2,-2],  # A_2^2
       [2,-3,2,2,-3,0,0],  # A_3
       [2,2,-3,2,-3,2,-1], # A_2A_1^2
       [2,2,2,-3,0,0,0],   # A_2A_1
       [-1,2,2,-3,2,-2,2], # A_1^4
       [2,0,2,-2,0,0,0],   # A_2
       [2,-1,-2,2,-2,2,-1],# (A_1^3)'
       [0,2,0,-2,2,-2,2],  # (A_1^3)''
       [2,0,-1,0,-1,2,-1], # A_1^2
       [2,0,-1,0,0,0,0],   # A_1
    ];

#blocks:=[];
blocks:=
[[[27, 3], [19, 1], [15, 1], [9, 2]], [[27, 1], [19, 1], [18, 2], [15, 1], [9, 4]], [[19, 1], [18, 2], [15, 1], [9, 7]], [[19, 1], [17, 1], [15, 2], [11, 2], [9, 3], [6, 2], [3, 2]], [[19, 1], [15, 4], [9, 5], [3, 3]], [[9, 14], [7, 1]], [[19, 1], [16, 2], [15, 1], [11, 1], [10, 2], [9, 2], [6, 2], [3, 1], [1, 3]], [[9, 12], [7, 1], [6, 2], [3, 2]], [[9, 11], [8, 2], [6, 2], [3, 1], [1, 3]], [[9, 11], [8, 2], [6, 2], [3, 1], [1, 3]], [[9, 11], [7, 4], [3, 1], [1, 3]], [[9, 9], [7, 1], [6, 2], [5, 3], [3, 6]], [[9, 11], [7, 4], [1, 6]], [[9, 6], [7, 1], [6, 8], [3, 8]], [[9, 9], [7, 1], [6, 2], [5, 1], [4, 4], [3, 3], [1, 3]], [[9, 5], [7, 4], [6, 6], [3, 7], [1, 3]], [[9, 9], [3, 16], [2, 2]], [[9, 5], [8, 2], [6, 8], [3, 7], [1, 3]], [[9, 3], [7, 1], [6, 8], [5, 3], [3, 12]], [[9, 3], [8, 4], [7, 2], [6, 6], [3, 4], [2, 4], [1, 4]], [[9, 1], [8, 2], [7, 3], [6, 4], [5, 5], [4, 2], [3, 8], [2, 2], [1, 2]], [[9, 2], [8, 4], [7, 5], [6, 4], [3, 2], [2, 4], [1, 10]], [[9, 9], [3, 15], [1, 7]], [[7, 1], [6, 8], [5, 3], [3, 21]], [[9, 1], [7, 7], [5, 9], [3, 7], [1, 9]], [[7, 1], [6, 8], [5, 1], [4, 4], [3, 18], [1, 3]], [[7, 1], [6, 6], [5, 4], [4, 4], [3, 16], [1, 6]], [[9, 2], [7, 13], [3, 1], [1, 21]], [[7, 1], [6, 4], [5, 7], [4, 4], [3, 11], [2, 6], [1, 6]], [[7, 1], [6, 2], [5, 12], [3, 15], [1, 9]], [[7, 1], [6, 2], [5, 7], [4, 10], [3, 6], [2, 6], [1, 9]], [[3, 43], [2, 2]], [[7, 1], [5, 15], [3, 10], [1, 21]], [[3, 42], [1, 7]], [[3, 42], [1, 7]], [[7, 1], [5, 7], [4, 16], [3, 1], [1, 24]], [[3, 37], [2, 8], [1, 6]], [[3, 34], [2, 8], [1, 15]], [[3, 28], [2, 14], [1, 21]], [[3, 33], [1, 34]], [[3, 19], [2, 26], [1, 24]], [[3, 27], [1, 52]], [[3, 10], [2, 32], [1, 39]], [[3, 1], [2, 32], [1, 66]]];

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

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


#############################################################################
##
##                                ActionsForCAP package
##
##  Copyright 2015, Sebastian Gutsche, TU Kaiserslautern
##                  Sebastian Posur,   RWTH Aachen
##
##
#############################################################################

DeclareRepresentation( "IsLeftCoactionObjectRep",
                       IsLeftCoactionObject and IsAttributeStoringRep,
                       [ ] );

BindGlobal( "TheFamilyOfLeftCoactionObjects",
            NewFamily( "TheFamilyOfLeftCoactionObjects" ) );

BindGlobal( "TheTypeOfLeftCoactionObjects",
            NewType( TheFamilyOfLeftCoactionObjects,
                     IsLeftCoactionObjectRep ) );

DeclareRepresentation( "IsRightCoactionObjectRep",
                       IsRightCoactionObject and IsAttributeStoringRep,
                       [ ] );

BindGlobal( "TheFamilyOfRightCoactionObjects",
            NewFamily( "TheFamilyOfRightCoactionObjects" ) );

BindGlobal( "TheTypeOfRightCoactionObjects",
            NewType( TheFamilyOfRightCoactionObjects,
                     IsRightCoactionObjectRep ) );

#############################
##
## Constructors
##
#############################

##
InstallMethod( LeftCoactionObject,
               [ IsCapCategoryMorphism, IsCapCategoryObject ],

  function( structure_morphism, coacting_object )

    return LeftCoactionObject( structure_morphism, LeftCoactionsCategory( coacting_object ) );

end );

##
InstallMethod( RightCoactionObject,
               [ IsCapCategoryMorphism, IsCapCategoryObject ],

  function( structure_morphism, coacting_object )

    return RightCoactionObject( structure_morphism, RightCoactionsCategory( coacting_object ) );

end );


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

# A variable is volatile if its value can change invisibly.
# For scalar variables this can never happen, because we keep track of all reads/writes, and also convert
# program to SSA on the fly.
#
# For arrays, however, this CAN happen, if an array is not scalarized -- because we do
# not keep track of reads/writes, and we do not convert to array SSA.
#
# Knowing the volatility allows us to block CSE from eliminating loads to the same location,
# which would be unsafe.
#
# The error due to lack of volatility checking occurs in the simple case of unrolling the
# following piece of code, without scalarizing T:
#
# loop i
#     T[0] = X[i]
#     Y[i] = T[0]
#
# unrolled:
#   T[0] = X[0]
#   Y[0] = T[0]
#
#   T[0] = X[1]
#   Y[1] = T[0]
#
#   T[0] = X[2]
#   Y[2] = T[0]
#
# CSE without considering T to be volatile:
#
#   T[0] = X[0]
#   s1 = T[0]
#   Y[0] = s1
#
#   T[0] = X[1]
#   Y[1] = s1
#
#   T[0] = X[2]
#   Y[2] = s1
#
#
var.isVolatile := self >> IsArrayT(self.t) and (self in Compile.doNotScalarize);

IsVolatileExp := x -> Cond(
    IsRec(x) and IsBound(x.isVolatile), x.isVolatile(),
    IsRec(x) and IsBound(x.rChildren),
        ForAny(x.rChildren(), IsVolatileExp),
    false
);

Class(CSE, rec(
    _op := (oid, args) -> oid.__name__
        :: Cond(IsBound(args[1]) and IsRec(args[1]) and IsBound(args[1].id), args[1].id, "")
        :: Cond(IsBound(args[2]) and IsRec(args[2]) and IsBound(args[2].id), args[2].id, ""),

    # returns a pair [lst, index]
    _lookup := meth(self, exp)
        local op, pos, args, lst;
	if not IsRec(exp) or not IsBound(exp.rChildren) or IsParam(exp) then
	    return false;
	fi;
	args := exp.rChildren();
	op   := self._op(ObjId(exp), args);
        if not IsBound(self.csetab.(op)) then
	    return false;
	else
	    lst := self.csetab.(op);
	    pos := PositionProperty(lst, ent -> ent.args=args);
	    return When(pos=false, false, [lst, pos]);
	fi;
    end,

    _add := meth(self, loc, oid, args)
        local op, ent;
	op := self._op(oid, args);
	ent := rec(loc := loc, args := args);
        if not IsBound(self.csetab.(op)) then
            self.csetab.(op) := [ent];
	else
            Add(self.csetab.(op), ent);
	fi;
    end,

    cseLookup := meth(self, exp)
        local lkup, lst, idx;
	lkup := self._lookup(exp);
	if lkup = false then return false;
	else
	    [lst, idx] := lkup;
	    return lst[idx].loc;
	fi;
    end,

    cseInvalidate := meth(self, exp)
        local lkup, lst, idx;
	lkup := self._lookup(exp);
	if lkup = false then return false;
	else
	    [lst, idx] := lkup;
	    Unbind(lst[idx]); # this introduces holes to the list, which gap allows
	fi;
    end,

    cseAdd := meth(self, loc, exp)
        local ent, v, co, args, a, b;
	if not IsBound(exp.isExpComposite) then return; fi;
	args := exp.rChildren();
	if ForAny(args, IsVolatileExp) then return; fi;

	self._add(loc, ObjId(exp), args);

	if ObjId(exp) = mul and exp.t.isSigned() and Length(exp.args)=2 and IsValue(exp.args[1]) then
	    v := Copy(exp.args[1]);
	    v.v := -v.v; # negate
	    self._add(neg(loc), mul, [v, exp.args[2]]);

        elif ObjId(exp) in [add,sub] and Length(exp.args)=2 and not IsValue(exp.args[1]) and not IsValue(exp.args[2]) then
            ent := loc;
            [a, b] := exp.args;

            if ObjId(exp)=sub then
                co := self.cseLookup(add(a, b));
                if co=false then
                    co  := self.cseLookup(add(b, a));
                fi;
                [ent,co] := [co, ent];
            else
                co := self.cseLookup(sub(a, b));
                if co=false then
                   co := self.cseLookup(sub(b, a));
                   [b, a] := exp.args;
                fi;
            fi;

            if ent<>false and co<>false then
		self._add( 2 * a, add, [ent, co]);
		self._add( 2 * a, add, [co, ent]);
		self._add( 2 * b, sub, [ent, co]);
		self._add(-2 * b, sub, [co, ent]);
            fi;

        fi;
    end,

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

    init :=  self >> WithBases(self, rec(csetab := tab())),

    __call__ := meth(self, code)
        self.csetab := tab();
	DoForAll( Collect(code, assign),
	          cmd -> self.cseCmd(cmd));
	return code;
    end
));


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

Declare(ScatHUnion, eUnion);

Class(ISumUnion, ISum, rec(
    toOperator := self >> (vec -> Checked(Length(vec)=self.dims()[2],
        Flat(List(TransposedMat(List([0..self.var.range-1],
        j->RulesStrengthReduce(SubstVars(Copy(self._children[1]), rec((self.var.id):=V(j)))).toOperator()(vec))), i->Filtered(i, k->k<>()))
    )))
));

Class(ISumReduction, ISum, rec(
    abbrevs := [ (v, rng, op, idval, isSaturated, expr) -> [v, rng, op, idval, isSaturated, expr] ],
    new := meth(self, var, domain, op, idval, isSaturated, expr)
        local res;
        Constraint(IsSPL(expr));
        # if domain is an integer (not symbolic) it must be positive
        Constraint(not IsInt(domain) or domain >= 0);
        var.isLoopIndex := true;
        res := SPL(WithBases(self, rec(_children := [expr], var := var, domain := domain, op := op, idval := idval, isSaturated := isSaturated)));
        res.dimensions := res.dims();
        return res;
    end,
    print := (self, i, is) >> Print(
        self.name, "(", self.var, ", ", self.domain, ", ", self.op, ", ", self.idval, ", ", self.isSaturated, ",\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(""))
    ),
    toOperator := self >> (vec -> Checked(Length(vec)=self.dims()[2],
        List(List(TransposedMat(List([0..self.var.range-1],
        j->RulesStrengthReduce(SubstVars(Copy(self._children[1]), rec((self.var.id):=V(j)))).toOperator()(vec))), i->Filtered(i, k->k<>())),
        e->_unwrap(FoldL(e, self.op, self.idval)))))
));

Class(GathH, SumsBase, BaseMat, rec(
    rChildren := self >> [self.N, self.n, self.base, self.stride],
    rSetChild := rSetChildFields("N", "n", "base", "stride"),
    new := (self, N, n, base, stride) >>
	SPL(WithBases(self, rec(
      	N:= N, n := n, base := base, stride := stride, dimensions := [n, N]))),
    dims := self >> self.dimensions,
    sums := self >> self,
    area := self >> self.n,
    isReal := self >> true,
    transpose := self >> ScatHUnion(self.N, self.n, self.base, self.stride),
    conjTranspose := self >> self.transpose(),
    inverse := self >> self.transpose(),
    toAMat := self >> let(
	   n := self.n,
       N := self.N,
       base := self.base,
       stride := self.stride,
       AMatMat(List([0..n-1], row -> let(
         idx := base+row*stride,
		 BasisVec(N, idx))))
    ),
    isIdentity := self >> (self.n=self.N) and self.base=0 and self.stride = 1,
    toOperator := self >> (vec-> Checked(Checked(Length(vec) = self.N, List([0..self.n-1], i->vec[_unwrap(self.base+i*self.stride+1)]))))
));

Class(ScatHUnion, SumsBase, BaseMat, rec(
    rChildren := self >> [self.N, self.n, self.base, self.stride],
    rSetChild := rSetChildFields("N", "n", "base", "stride"),
    new := (self, N, n, base, stride) >>

    SPL(WithBases(self, rec(
        N:= N, n := n, base := base, stride := stride, dimensions := [N, n]))),
    dims := self >> self.dimensions,
    sums := self >> self,
    area := self >> self.n,
    isReal := self >> true,
    transpose := self >> GathH(self.N, self.n, self.base, self.stride),
    conjTranspose := self >> self.transpose(),
    inverse := self >> self.transpose(),
    toAMat := self >> let(
	   n := self.n,
       N := self.N,
       base := self.base,
       stride := self.stride,
       TransposedAMat(AMatMat(List([0..n-1], row -> let(
         idx := base+row*stride,
		 BasisVec(N, idx))))
    )),
    isIdentity := self >> (self.n=self.N) and self.base=0 and self.stride = 1,
    toOperator := self >>(vec -> Checked(Length(vec) = self.n, List([0..self.N-1], j->let(i := (j-_unwrap(self.base))/_unwrap(self.stride), When(IsPosInt0(i) and i < _unwrap(self.n), vec[i+1], ())))))
));

Class(ScatHAcc, ScatHUnion);

Class(eT, SumsBase, BaseMat, rec(
    rChildren := self >> [self.N, self.base],
    rSetChild := rSetChildFields("N", "base"),
    new := (self, N, base) >> SPL(WithBases(self, rec(
      	N:= N, base := base, dimensions := [1, N]))),
    dims := self >> self.dimensions,
    sums := self >> self,
    area := self >> self.N,
    isReal := self >> true,
    transpose := self >> eUnion(self.N, self.base),
    conjTranspose := self >> self.transpose(),
    inverse := self >> self.transpose(),
    toAMat := self >> let(
	   n := self.n,
       N := self.N,
       base := self.base,
       stride := self.stride,
       AMatMat(List([0..n-1], row -> let(
         idx := base+row*stride,
		 BasisVec(N, idx))))
    ),
    isIdentity := self >> false,#(self.N=1),
    toOperator := self >>(vec -> Checked(Length(vec) = self.N, [vec[_unwrap(self.base)+1]]))
));

Class(eUnion, SumsBase, BaseMat, rec(
    rChildren := self >> [self.N, self.base],
    rSetChild := rSetChildFields("N", "base"),
    new := (self, N, base) >> SPL(WithBases(self, rec(
      	N:= N, base := base, dimensions := [N, 1]))),
    dims := self >> self.dimensions,
    sums := self >> self,
    area := self >> 1,
    isReal := self >> true,
    transpose := self >> eT(self.N, self.base),
    conjTranspose := self >> self.transpose(),
    inverse := self >> self.transpose(),
    toAMat := self >> let(
	   n := 1,
       N := self.N,
       base := self.base,
       stride := 1,
       TransposedAMat(AMatMat(List([0..n-1], row -> let(
         idx := base+row*stride,
		 BasisVec(N, idx))))
    )),
    isIdentity := False,
    toOperator := self >>(vec -> Checked(Length(vec) = 1, List([0..self.N-1], i->When(i = _unwrap(self.base), vec[1], ()))))
));

Class(Mul1, Blk1, rec(
    toOperator := self >> (vec -> Checked(Length(vec) = 1, [_unwrap(RulesStrengthReduce(vec[1]*_unwrap(self.element)))]))
));

Class(SUMUnion, SUM, rec(
    toOperator := self >> (vec -> Checked(Length(vec)=self.dims()[2],
        Flat(List(TransposedMat(List(self.children(), c->RulesStrengthReduce(c.toOperator()(vec)))), i->Filtered(i, k->k<>())))))
));

Class(Inductor,  BaseMat, rec(
    abbrevs := [ (N, i, op, initval) -> [N, i, op, initval] ],
    new := (self, N, i, op, initval) >> SPL(WithBases(self, rec(
        N := N, i := i, op := op, initval := initval, dimensions := [1, 1]))),
    print := (self, i, is) >> Print("Inductor(", self.N, ", ", self.i, ", ", self.op, ", ", self.initval, ")"),
    dims  := self >> self.dimensions,
    rChildren := self >> [self.N, self.i, self.op, self.initval],
    rSetChild := rSetChildFields("N", "i", "op", "initval"),
    isReal := True,
    recurrence := self >> ((j,v)->When(j=0, self.initval, self.op.at(self.recurrence()(j-1,v),v))),
    toOperator := self >> (vec -> Checked(Length(vec)=self.dims()[2], [List([0..self.N-1], i->_unwrap(RulesStrengthReduce(self.recurrence()(i,vec[1]))))[_unwrap(self.i)+1]]))
));


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

Class(RulesDropSymDecl, RuleSet);
RewriteRules(RulesDropSymDecl, rec(
    drop_decl := Rule(@@(1, decl, (e,cx)->ForAny(cx.opts.symbol, i->i in e.vars)),
        (e,cx)-> decl(Filtered(@@(1).val.vars, i->not i in cx.opts.symbol), @@(1).val.cmd))
));


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

Class(vdup, Exp, rec(
    __call__ := (self, a, n) >> WithBases(self, rec(
	    args       := [toExpArg(a), toExpArg(n)],
	    operations := ExpOps,
	)).setType(),

    computeType := self >> let(t := self.args[1].t,
	Cond(IsVecT(t),
	         ObjId(t)(t.t, t.size * self.args[2].ev()),
	     # else
	         TVect(t, self.args[2].ev())
	)),

    ev := self >> Value(self.t, Flat(Replicate(self.args[2].ev(), self.args[1].ev())))
));

# tcast(<newtype>, <exp>)
#
Class(tcast, Exp, rec(
    isLoc := true,
    __call__ := (self, t, exp) >> Checked(IsType(t), WithBases(self, rec(
	 args := [t, toExpArg(exp)],
	 t := t,
	 operations := ExpOps
    ))),

    zero := self >> self.args[1].zero(),

    computeType := self >> self.args[1]
));

# Packs n arguments into an n-way vector,
# this should be considered a pseudo-instruction
#
Class(vpack, AutoFoldExp, rec(
    ev := self >> self.t.value(List(self.args, x->x.ev())),
    computeType := self >> TVect(UnifyTypes(List(self.args, x->x.t)), Length(self.args))
));

Class(velem, nth, rec(
    __call__ := (self, loc, idx) >> Cond(
	# velem(vpack(a, b), 1) == a
	ObjId(loc)=vpack and IsInt(idx), loc.args[idx+1],
        WithBases(self, rec(loc := loc, idx := toExpArg(idx), t := loc.t.t, operations := ExpOps))),

    computeType := self >> self.loc.t.t,
    cprint := self >> Print(self.name, "(", self.loc.cprint(), ", ", self.idx.cprint(), ")"),
    print := self >> Print(self.name, "(", self.loc, ", ", self.idx, ")")
));

# tcvt(<newtype>, <exp>)
#
Class(tcvt, tcast);

# sizeof(<type>)
#
Class(sizeof, Exp, rec(
    __call__ := (self, t) >> Checked(IsType(t),
        WithBases(self, rec(args := [t], t := TInt, operations := ExpOps))),

    computeType := self >> TInt
));