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

# Cell Unparser
# Author: schellap

@TInt := @.cond(x->x.t=TInt);
@TRealOrInt := @.cond(x->x.t=TInt or x.t=TReal);
@TReal := @.cond(x->x.t=TReal);
@TVect := @.cond(x->ObjId(x.t)=TVect);

Class(CellUnparser, CMacroUnparserProg, rec(

    func_ppe := (self,o,i,is) >> "",

    # str = format string with $n for arguments ($1 = first argument)
    # list of arguments , arguments are printed using this unparser
    printf := (self, str, args) >> ApplyFunc(PrintEvalF, Concatenation([str],
        List(args, a->(When(IsFunc(a), a, ()->self(a,0,0)))))),

    # -----------------------------
    # ISA independent constructs
    # -----------------------------
    nth :=  (self, o, i, is) >> self.printf("$1[$2]", [o.loc, o.idx]),
    fdiv := (self, o, i, is) >> self.printf("((($3)$1) / $2)", Concatenation(o.args, [self.opts.vector.isa.ctype])),
    fdiv := (self, o, i, is) >> self.printf("($1 / $2)", o.args),
    idiv := (self, o, i, is) >> self.printf("($1 / $2)", o.args),
    imod := (self, o, i, is) >> self.printf("($1 % $2)", o.args),

    # This is the type used for declarations of vector variables
    ctype := (t, isa) -> Cond(
        #t in [TDouble, TVect(TDouble, 1)], "float",
        t = TReal,              isa.ctype, #evals to "float" or "double"
        t = TVect(TReal, 2),    isa.vtype, #evals to "vector double"
        t = TVect(TReal, 4),    isa.vtype,
        t = TVect(TReal, 8),    isa.vtype,
        Error("Unparser doesn't know how to declare type: ", t)
    ),

    Value := (self, o, i, is) >> Cond(
        o.t = TReal,
           let(v := When(IsCyc(o.v), ReComplex(Complex(o.v)), Double(o.v)), When(v<0, Print("(", v, ")"), Print(v))),
        o.t = TInt,
           When(o.v < 0, Print("(", o.v, ")"), Print(o.v)),
        ObjId(o.t)=TVect,
           Print("((", self.ctype(o.t, self.opts.vector.isa), "){", self.infix(o.v, ", "), "})"),
        #NOTE: Adding this for parallel cell, but this shouldn't be needed, right?
       IsArray(o.t),
           Print("{", self.infix(o.v, ", "), "}"),
       o.t = TString,
           #Print("\"", o.v, "\"")
           Print(o.v),
       o.t = TBool, Print(When(o.v, "1", "0"))

    ),

    vdup         := (self, o, i, is) >> Print("spu_splats((", self.opts.vector.isa.ctype, ")", self(o.args[1], i, is), ")"),
    vsplat_8x16i := (self, o, i, is) >> Print("spu_splats((", self.opts.vector.isa.ctype, ")", self(o.args[1], i, is), ")"),
    vsplat_4x32f := (self, o, i, is) >> Print("spu_splats((", self.opts.vector.isa.ctype, ")", self(o.args[1], i, is), ")"),
    vsplat_2x64f := (self, o, i, is) >> Print("spu_splats((", self.opts.vector.isa.ctype, ")", self(o.args[1], i, is), ")"),

    # Declarations
    TVect := (self, t, vars, i, is) >> let(ctype := self.ctype(t, self.opts.vector.isa),
              Print(ctype, " ",
              self.infix(vars, ", "))),

    TVectPointer := (self, t, vars, i, is) >> let(ctype := self.ctype(t, self.opts.vector.isa),
              Print(ctype,
              When(IsBound(self.opts.useMemoryArena) and self.opts.useMemoryArena, "* ", " "),
              self.infix(vars, ", "))),

    TReal := ~.TVect,
    TRealPointer := ~.TVectPointer,

    TInt := (self, t, vars, i, is) >> Print("int ", self.infix(vars, ", ")),

    # Arithmetic
    # --------------------------------
    # -- mul --
    mul := (self, o, i, is) >> CondPat(o,
    [mul, @TReal, @TVect],
        Cond(self.opts.vector.isa.v = 2,
            self.printf("spu_mul(((vector $1){$2,$2}), $3)",       [self.ctype(o.args[1].t, self.opts.vector.isa), o.args[1], o.args[2]]),
        self.opts.vector.isa.v = 4,
            self.printf("spu_mul(((vector $1){$2,$2,$2,$2}), $3)", [self.ctype(o.args[1].t, self.opts.vector.isa), o.args[1], o.args[2]]),
        Error("Don't know how to unparse vector arch of length: ", self.opts.vector.isa.v)
        ),
    [mul, @TVect,   @TVect],
        self.printf("spu_mul($1, $2)",              [o.args[1], o.args[2]]),
    [mul, @TRealOrInt, @TRealOrInt],
        self.printf("($1 * $2)", o.args),
    [mul, @TRealOrInt, @TRealOrInt, @TRealOrInt],
        self.printf("($1 * $2 * $3)", o.args),
    Error("Don't know how to unparse <o>. Unrecognized type combination: ", o)),

    # -- add --
    add := (self, o, i, is) >> When(Length(o.args) > 2,
       self(_computeExpType(add(o.args[1], _computeExpType(ApplyFunc(add, Drop(o.args, 1))))), i, is),
       CondPat(o,
           [add, @TVect,   @TVect],
              self.printf("spu_add($1, $2)", [o.args[1], o.args[2]]),
           #[add, @TRealOrInt, @TRealOrInt],
           [add, @TVect,   @],
              self.printf("spu_add($1, $2)", [o.args[1], o.args[2]]),
           [add, @, @],
              self.printf("($1 + $2)", o.args),
           Error("Don't know how to unparse <o>. Unrecognized type combination")
       )
    ),

    # -- sub --
    sub := (self, o, i, is) >> When(Length(o.args) > 2,
       self(_computeExpType(sub(o.args[1], _computeExpType(ApplyFunc(sub, Drop(o.args, 1))))), i, is),
       CondPat(o,
           [sub, @TVect,   @TVect],
              self.printf("spu_sub($1, $2)", [o.args[1], o.args[2]]),
           [sub, @TVect,   @],
              self.printf("spu_sub($1, $2)", [o.args[1], o.args[2]]),
           [sub, @TRealOrInt, @TRealOrInt],
              self.printf("($1 - $2)", o.args),
           [sub, @, @],
              self.printf("($1 - $2)", o.args),
           Error("Don't know how to unparse <o>. Unrecognized type combination")
       )
    ),

    # -- neg --
    neg := (self, o, i, is) >> CondPat(o,
       #[neg, @TVect],
       #    self(o.t.value(Replicate(o.t.size,0)) - o.args[1], i, is),
       #self.printf("(-$1)", o.args)
       [neg, @TVect], Cond( self.opts.vector.isa.v = 2, self.printf("_negated2($1)", o.args),
                            self.opts.vector.isa.v = 4, self.printf("_negatef4($1)", o.args),
                            Error("What kind of vector length are you trying to pull on me?")
                ),
        self.printf("(-$1)", o.args)
    ),

    v_neg01 := (self, o, i, is) >> self.printf("_negated2($1)", o.args),

    vpack := (self, o, i, is) >> Print(self.opts.vector.isa.vconstv, "{", self.infix(o.args, ", "), "}"),

    # Spiral: fma(rt, x, y, z)    -> rt = x + (y*z)
    # SPU:    FMA(rt, ra, rb, rc) -> rt = (ra*rb) + rc
    # -- fma --
    fma  := (self, o, i, is) >> CondPat(o,
       [fma, @TVect, @TVect, @TVect],
          self.printf("spu_madd($2, $3, $1)",  [o.args[1], o.args[2], o.args[3]]),
       [fma, @TVect, @TReal, @TVect],
          self.printf("spu_madd(((vector $4){$2,$2,$2,$2}), $3, $1)",  [o.args[1], o.args[2], o.args[3], self.ctype(o.args[2].t, self.opts.vector.isa)]),
       [fma, @TReal, @TReal, @TReal],
          self.printf("$1 + ($2 * $3)", [o.args[1], o.args[2], o.args[3]]),
        Error("Don't know how to unparse fma instruction <o>. Unrecognized type combination:", o.args[1].t, o.args[2].t, o.args[3].t)
    ),

    # Spiral: fms(rt, x, y, z)    -> rt = x - (y*z)
    # SPU:    FNMS(rt, ra, rb, rc) -> rt = rc - (ra*rb)
    fms  := (self, o, i, is) >> CondPat(o,
       [fms, @TVect, @TVect, @TVect],
          self.printf("spu_nmsub($2, $3, $1)",  [o.args[1], o.args[2], o.args[3]]),
       [fms, @TVect, @TReal, @TVect],
          self.printf("spu_nmsub(((vector $4){$2,$2,$2,$2}), $3, $1)",  [o.args[1], o.args[2], o.args[3], self.ctype(o.args[2].t, self.opts.vector.isa)]),
       [fms, @TInt, @TVect, @TVect], #HACK
          self.printf("spu_nmsub($2, $3, (($4){$1,$1,$1,$1}))",  [o.args[1].v, o.args[2], o.args[3], self.ctype(o.args[2].t, self.opts.vector.isa)]),
       [fms, @TInt, @TReal, @TVect], #HACK
          self.printf("spu_nmsub(((vector $4){$2,$2,$2,$2}), $3, ((vector $4){$1,$1,$1,$1}))",  [o.args[1].v, o.args[2], o.args[3], self.ctype(o.args[2].t, self.opts.vector.isa)]),
       [fms, @TReal, @TReal, @TReal],
          self.printf("$1 + ($2 - $3)", [o.args[1], o.args[2], o.args[3]]),
        Error("Don't know how to unparse fms instruction <o>. Unrecognized type combination")
    ),

    # Spiral: nfma(rt, x, y, z)   -> rt = (y*z) - x
    # SPU:    FMS(rt, ra, rb, rc) -> rt = (ra*rb) - rc
    #NOTE: Change above and below vector constants to spu_splats so the v=2 or v=4 cases are both implicitly taken care of
    nfma := (self, o, i, is) >> CondPat(o,
       [nfma, @TVect, @TVect, @TVect],
          self.printf("spu_msub($2, $3, $1)",  [o.args[1], o.args[2], o.args[3]]),
       [nfma, @TVect, @TReal, @TVect],
          self.printf("spu_msub(((vector $4){$2,$2,$2,$2}), $3, $1)",  [o.args[1], o.args[2], o.args[3], self.ctype(o.args[2].t, self.opts.vector.isa)]),
        Error("Don't know how to unparse nfma instruction <o>. Unrecognized type combination")
    ),

    # logic
    # --------------------------------
    bin_and := (self, o, i, is) >> self.prefix("spu_and", o.args),

    bin_or := (self, o, i, is) >> self.prefix("spu_or", o.args),

    # comparison
    # --------------------------------
    eq := (self, o, i, is) >> CondPat(o,
        [eq, @TVect, @], self.printf("spu_cmpeq($1, spu_splat($2))", o.args),
        [eq, @, @TVect], self.printf("spu_cmpeq(spu_splat($1), $2)", o.args),
        [eq, @, @], self.printf("(($1) == ($2))", o.args)
        ),
    cmpg := (self, o, i, is) >> CondPat(o,
        [eq, @TVect, @], self.printf("spu_cmpgt($1, spu_splat($2))", o.args),
        [eq, @, @TVect], self.printf("spu_cmpgt(spu_splat($1), $2)", o.args),
        [eq, @, @], self.printf("(($1) > ($2))", o.args)
        ),
    cmpl := (self, o, i, is) >> CondPat(o,
        [eq, @TVect, @], self.printf("spu_LT_IS_EXPENSIVE($1, spu_splat($2))", o.args),
        [eq, @, @TVect], self.printf("spu_LT_IS_EXPENSIVE(spu_splat($1), $2)", o.args),
        [eq, @, @], self.printf("(($1) < ($2))", o.args)
        ),

    promote_spu8x16i := (self, o, i, is) >> self.prefix("spu_promote", o.args),
    promote_spu4x32f := (self, o, i, is) >> self.prefix("spu_promote", o.args),
    promote_spu2x64f := (self, o, i, is) >> self.prefix("spu_promote", o.args),

    extract_spu8x16i := (self, o, i, is) >> self.prefix("spu_extract", o.args),
    extract_spu4x32f := (self, o, i, is) >> self.prefix("spu_extract", o.args),
    extract_spu2x64f := (self, o, i, is) >> self.prefix("spu_extract", o.args),

    insert_spu8x16i  := (self, o, i, is) >> self.prefix("spu_insert",  o.args),
    insert_spu4x32f  := (self, o, i, is) >> self.prefix("spu_insert",  o.args),
    insert_spu2x64f  := (self, o, i, is) >> self.prefix("spu_insert",  o.args),

    vparam_spu := (self, o, i, is) >>
      Print("((vector unsigned char){", PrintCS(prep_perm_string_spu(o.p)), "})"),

   vzero_8x16i := (self, o, i, is) >> Print("((", self.opts.vector.isa.vtype ,"){", PrintCS(List([1..self.opts.vector.isa.v], i->0)), "})"),
   vzero_4x32f := (self, o, i, is) >> Print("((", self.opts.vector.isa.vtype ,"){", PrintCS(List([1..self.opts.vector.isa.v], i->0)), "})"),
   vzero_2x64f := (self, o, i, is) >> Print("((", self.opts.vector.isa.vtype ,"){", PrintCS(List([1..self.opts.vector.isa.v], i->0)), "})"),

   # ----------------------------------------------------------------------------------
   # ISA specific : spu_8x16i
   # ----------------------------------------------------------------------------------
   vperm_8x16i_spu := (self, o, i, is) >>
     self.printf("spu_shuffle($1, $2, $3)", o.args),

   vuperm_8x16i_spu := (self, o, i, is) >>
     self.printf("spu_shuffle($1, $1, $2)", o.args),

   vloadu8_spu8x16i := (self, o, i, is) >>
   Print("spu_or(spu_slqwbyte(*((vector signed short*) (&(",self(o.args[1],i,is),"))), (unsigned) ((vector signed short*) (&(",self(o.args[1],i,is),"))) & 15), spu_rlmaskqwbyte(*(((vector signed short*) (&(",self(o.args[1],i,is),")))+1), ((unsigned) ((vector signed short*) (&(",self(o.args[1],i,is),"))) & 15)-16))"),

   # ----------------------------------------------------------------------------------
   # ISA specific : spu_4x32f
   # ----------------------------------------------------------------------------------
   vperm_4x32f_spu := (self, o, i, is) >>
     self.printf("spu_shuffle($1, $2, $3)", o.args),

   vuperm_4x32f_spu := (self, o, i, is) >>
     self.printf("spu_shuffle($1, $1, $2)", o.args),

   #vloadu1,2,4 should produce:
   #spu_shuffle(spu_slqwbyte((*((vector float *)(&X[element]))), (unsigned int)(&X[element]) & 15), ((vector float){0,0,0,0}), ((vector unsigned char){0, 1, 2, 3, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128}));
   #spu_shuffle(spu_promote(X[element], 0), spu_promote(X[element+1], 0), ((vector unsigned char){0, 1, 2, 3, 16, 17, 18, 19, 128, 128, 128, 128, 128, 128, 128, 128}));
   #spu_or(spu_slqwbyte(*ptr,            (unsigned) ptr & 15), spu_rlmaskqwbyte(*(ptr+1), ((unsigned) ptr & 15)-16));

   #NOTE: Both these are HACKs!
   slqwbyte_spu4x32f := (self, o, i, is) >>
       self.printf("spu_slqwbyte(*$1, (unsigned) ($1) & 15)", o.args),

   rlmaskqwbyte_spu4x32f := (self, o, i, is) >>
       self.printf("spu_rlmaskqwbyte(*$1, ((unsigned) $1 & 15)-16)", o.args),

   vloadu_spu4x32f := (self, o, i, is) >>
       Print("spu_or(spu_slqwbyte(*",self(o.args[1],i,is),", (unsigned) ",self(o.args[1],i,is)," & 15), spu_rlmaskqwbyte(*(",self(o.args[1],i,is),"+1), ((unsigned) ",self(o.args[1],i,is)," & 15)-16))"),

   vloadu4_spu4x32f := (self, o, i, is) >>
   Print("spu_or(spu_slqwbyte(*((vector float*) (&(",self(o.args[1],i,is),"))), (unsigned) ((vector float*) (&(",self(o.args[1],i,is),"))) & 15), spu_rlmaskqwbyte(*(((vector float*) (&(",self(o.args[1],i,is),")))+1), ((unsigned) ((vector float*) (&(",self(o.args[1],i,is),"))) & 15)-16))"),

# spu_or(
#       spu_slqwbyte(*((vector float*) (&(",ptr,"))), (unsigned) ((vector float*) (&(",ptr,"))) & 15),
#       spu_rlmaskqwbyte(*(((vector float*) (&(",ptr,")))+1), ((unsigned) ((vector float*) (&(",ptr,"))) & 15)-16))

   #spu_or(spu_slqwbyte(*ptr,            (unsigned) ptr & 15), spu_rlmaskqwbyte(*(ptr+1), ((unsigned) ptr & 15)-16));

   # ----------------------------------------------------------------------------------
   # ISA specific : spu_2x64f
   # ----------------------------------------------------------------------------------

   vperm_2x64f_spu := (self, o, i, is) >>
     self.printf("spu_shuffle($1, $2, $3)", o.args),

   vuperm_2x64f_spu := (self, o, i, is) >>
     self.printf("spu_shuffle($1, $1, $2)", o.args),

   # ----------------------------------------------------------------------------------
   # Cell Parallel unparser
   # ----------------------------------------------------------------------------------
   extraHeader := "TODO",
#Concat("#include <spu_mfcio.h>\n\
#extern spe_infostruct spe_info;\n\
#//extern DATATYPE_NO_QUOTES* Xalt;\
#//extern DATATYPE_NO_QUOTES* Yalt;\
#extern DATATYPE_NO_QUOTES* XYalt;\
#extern mfc_list_element_t gathlist[2048], scatlist[2048];\
##define Xalt XYalt\
##define Yalt XYalt\
#/* extern volatile int writeSignal[4];\n\
#extern int check;\n\
#extern void sig_barrier();\n\
#n*/\n\
##include \"spumacros.h\"\n\
#// Declare memory arena\
##ifdef ARENA_SIZE\
#  __attribute__((aligned(16))) DATATYPE_NO_QUOTES ARENA[ARENA_SIZE];\
#  int arenalevel = ARENA_SIZE;\
##endif\
#\n\
#\n\n\n"),

   dist_loop := meth(self, o, i, is)
       Print(Blanks(i),    "{\n");
       #Print(Blanks(i+is), "unsigned int ", o.var, " = spe_info.spuid;\n"); # Not needed since spuid is now a param
       self(o.cmd,i+is,is);
       Print(Blanks(i),    "}\n");
       #Print(Blanks(i),    "//ALL_TO_ALL_BARRIER;\n");
       #Print(Blanks(i),    "BLOCK_ON_READ();\n");
    end,

    #NOTE: this should really be just a berrier (shouldn't have
    #BLOCK_ON_CPUDMA). But leaving this in there for legacy compatibility.
    #Should'nt affect performance significantly.

    dist_barrier := (self,o,i,is) >> Print(Blanks(i), "BLOCK_ON_CPUDMA; ALL_TO_ALL_BARRIER;\n"),

    dma_barrier := (self,o,i,is) >> Print(Blanks(i), "BLOCK_ON_CPUDMA;\n"),

    #NOTE: might be hacks. Need to possibly fix inside parent unparser's methods.
    call := (self, o, i, is) >> Print(Blanks(i), o.args[1].id, self.pinfix(Drop(o.args, 1), ", "), ";\n"),

    fcall := (self, o, i, is) >> Print(self(o.args[1],0,0), "(", self.infix(Drop(o.args, 1), ", "), ")"),

    #fcall_addr := (self, o, i, is) >> Print(self(o.args[1],0,0), "(", self.infix(Drop(o.args, 1), ", "), ")"),

   # ----------------------------------------------------------------------------------
   # Cell Multibuffering unparser
   # ----------------------------------------------------------------------------------
    multibuffer_loop := meth(self, o, i, is)
       local v, lo, hi, measSteadyState, swapx, swapy, swapxy, block_on_diag, swap_twiddles, n;

       n  := Length(o.range);
       v  := o.var;
       lo := o.range[1] + 1;
       hi := Last(o.range) - 1;
       measSteadyState := When(
            IsBound(self.opts.measSteadyState) and self.opts.measSteadyState = true,
            true,
            false);

       #swapx := Concat("SWAP(", o.x.id, ", ", o.x.id, "alt);\n");
       #swapy := Concat("SWAP(", o.y.id, ", ", o.y.id, "alt);\n");

       swapx  := Concat("SWAP(", o.x.id, ", XYalt);\n");
       swapy  := Concat("SWAP(", o.y.id, ", XYalt);\n");
       swapxy := Concat("SWAP(", o.y.id, ", ", o.x.id, ");\n");

       swap_twiddles := When(o.twiddles=[], "\n",
            Concat("SWAP(", o.bufs[1].id, ", ", o.bufs[2].id, ");\n")
       );

       block_on_diag := When(o.twiddles=[], "\n", "BLOCK_ON_DIAG;\n");

       Print(

       Blanks(i), When(measSteadyState, "/*", ""),
       Blanks(i), "\n{// ------------- Multibuffer header begin -----------\n",
       Blanks(i+is), "int ", v, " = ", lo-1, ";\n",
       # Begin skewiter:
       Blanks(i+is), v, "= (", v, "+(spuid/  ( SPUS>",n," ? (SPUS/",n,") : 1  )  ))%", n, ";\n",

       Blanks(i+is), "{\n",
       self(o.gathmem, i+is, is),
       When(o.twiddles=[], "", self(o.twiddles, i+is, is)),
       Blanks(i+is), "}\n",

       Blanks(i+is), "BLOCK_ON_MEMDMA;\n",
       Blanks(i+is), block_on_diag,
       Blanks(i+is), swapx,
       Blanks(i+is), swap_twiddles,

       Blanks(i+is), "{\n",
       # skewiter increment
       Blanks(i+is), v, "= (", v, "+1) % ", n, ";\n",
       #Blanks(i+is), v, "++;\n",
       self(o.gathmem, i+is, is),
       When(o.twiddles=[], "", self(o.twiddles, i+is, is)),
       # skewiter decrement
       Blanks(i+is), v, "= (", v, "+", n, "-1) % ", n, ";\n",
       #Blanks(i+is), v, "--;\n",
       Blanks(i+is), "}\n",

       Blanks(i+is), "{ // Loopbody begin\n",
       When(IsBound(self.opts.mbuf_nobody) and self.opts.mbuf_nobody = true, "", self(o.cmd,i+is,is)),
       Blanks(i+is), "} // Loopbody end\n",
       Blanks(i+is), "BLOCK_ON_MEMDMA;\n",
       Blanks(i+is), block_on_diag,
       Blanks(i), "}// ------------- Multibuffer header end -----------\n\n",
       Blanks(i), When(measSteadyState, "*/", ""),

       Blanks(i), "for(int ", v, " = ", lo, "; ", v, " <= ", hi, "; ", v, "++) {\n",
       # Begin skewiter:
       Blanks(i+is), v, "= (", v, "+(spuid/  ( SPUS>",n," ? (SPUS/",n,") : 1  )  ))%", n, ";\n",
       Blanks(i+is), swapy,
       Blanks(i+is), swapxy,
       # skewiter decrement
       Blanks(i+is), v, "= (", v, "+", n, "-1) % ", n, ";\n",
       #Blanks(i+is), v, "--;\n",
       self(o.scatmem, i+is, is),
       # skewiter increment
       Blanks(i+is), v, "= (", v, "+1) % ", n, ";\n",
       #Blanks(i+is), v, "++;\n",
       #Blanks(i+is), swapx,
       Blanks(i+is), swap_twiddles,
       # skewiter increment
       Blanks(i+is), v, "= (", v, "+1) % ", n, ";\n",
       #Blanks(i+is), v, "++;\n",
       self(o.gathmem, i+is, is),
       When(o.twiddles=[], "", self(o.twiddles, i+is, is)),
       # skewiter decrement
       Blanks(i+is), v, "= (", v, "+", n, "-1) % ", n, ";\n",
       #Blanks(i+is), v, "--;\n",
       Blanks(i+is), "{ // Loopbody begin\n",
       When(IsBound(self.opts.mbuf_nobody) and self.opts.mbuf_nobody = true, "", self(o.cmd,i+is,is)),
       Blanks(i+is), "} // Loopbody end\n",
       Blanks(i+is), "BLOCK_ON_MEMDMA;\n",
       Blanks(i+is), block_on_diag,
       # End skewiter:
       Blanks(i+is), v, "= (", v, "+", n, "-(spuid/  ( SPUS>",n," ? (SPUS/",n,") : 1  )  ))%", n, ";\n",
       Blanks(i), "}\n",

       Blanks(i), When(measSteadyState, "/*", ""),
       Blanks(i), "\n{// ------------- Multibuffer footer begin -----------\n",
       Blanks(i+is), "int ", v, "=", hi, "+1;\n",
       # Begin skewiter:
       Blanks(i+is), v, "= (", v, "+(spuid/  ( SPUS>",n," ? (SPUS/",n,") : 1  )  ))%", n, ";\n",
       Blanks(i+is), swapy,
       Blanks(i+is), swapxy,
       # skewiter decrement
       Blanks(i+is), v, "= (", v, "+", n, "-1) % ", n, ";\n",
       #Blanks(i+is), v, "--;\n",

       Blanks(i+is), "{\n",
       self(o.scatmem, i+is, is),
       Blanks(i+is), "}\n",

       # skewiter increment
       Blanks(i+is), v, "= (", v, "+1) % ", n, ";\n",
       #Blanks(i+is), v, "++;\n",
       #Blanks(i+is), swapx,
       Blanks(i+is), swap_twiddles,
       Blanks(i+is), "{ // Loopbody begin\n",
       When(IsBound(self.opts.mbuf_nobody) and self.opts.mbuf_nobody = true, "", self(o.cmd,i+is,is)),
       Blanks(i+is), "} // Loopbody end\n",
       Blanks(i+is), "BLOCK_ON_MEMDMA;\n",
       Blanks(i+is), swapy,
       #Blanks(i+is), v, "++;\n",

       Blanks(i+is), "{\n",
       self(o.scatmem, i+is, is),
       Blanks(i+is), "}\n",

       Blanks(i+is), "BLOCK_ON_MEMDMA;\n",
       Blanks(i), "}// ------------- Multibuffer footer end -----------\n\n",
       Blanks(i), When(measSteadyState, "*/", "")
       );

       #NOTE: Last wait can be avoided by DMA_putting Y directly (same for X?)

    end,

#F For debugging:
#F Multibuffer_loop that doesn't do multibuffering. Easier for humans to parse when looking at C code
    mem_loop := meth(self, o, i, is)
       local v, lo, hi, swapx, swapy, block_on_diag, swap_twiddles;

       swapx := Concat("SWAP(", o.x.id, ", ", o.x.id, "alt);\n");
       swapy := Concat("SWAP(", o.y.id, ", ", o.y.id, "alt);\n");
       swap_twiddles := When(o.twiddles=[], "\n",
            Concat("SWAP(", o.bufs[1].id, ", ", o.bufs[2].id, ");\n")
       );

       v  := o.var;
       lo := o.range[1];
       hi := Last(o.range);

       block_on_diag := When(o.twiddles=[], "\n", "BLOCK_ON_DIAG;\n");

       Print(

       Blanks(i), "for(int ", v, " = ", lo, "; ", v, " <= ", hi, "; ", v, "++) {\n",

       self(o.gathmem, i+is, is),
       When(o.twiddles=[], "", self(o.twiddles, i+is, is)),
       Blanks(i+is), "BLOCK_ON_MEMDMA;\n",
       Blanks(i+is), block_on_diag,
       Blanks(i+is), swapx,
       Blanks(i+is), swap_twiddles,

       Blanks(i+is), "{ // Loopbody begin\n",
       When(IsBound(self.opts.mbuf_nobody) and self.opts.mbuf_nobody = true, "", self(o.cmd,i+is,is)),
       Blanks(i+is), "} // Loopbody end\n",

       Blanks(i+is), swapy,
       self(o.scatmem, i+is, is),
       Blanks(i+is), "BLOCK_ON_MEMDMA;\n",

       Blanks(i), "}\n"

       );

    end,

    kern := (self, o, i, is) >> self(o.cmd, i, is)

));

Class(CellUnparser_parallel, CellUnparser);


text:
# The first two work with rationals or with floats
# (but bear in mind that support of floating point is very poor in GAP)
mean := v -> Sum(v) / Length(v);
harmean := v -> Length(v) / Sum(v, Inverse);
geomean := v -> EXP_FLOAT(Sum(v, LOG_FLOAT) / Length(v));

mean([1 .. 10]);
# 11/2
harmean([1 .. 10]);
# 25200/7381

v := List([1..10], FLOAT_INT);;
mean(v);
# 5.5
harmean(v);
# 3.41417
geomean(v);
# 4.52873

ext: gap

max_issues_repo_name: seanwallawalla-forks/RosettaCodeData

max_forks_repo_name: seanwallawalla-forks/RosettaCodeData


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

#F ScriptGenBase()
#F

Class(ScriptGenBase, rec(

	_settings := rec(),

    ##
    ## Public methods
    ##

	getAllSettings := (self) >> Copy(self._settings),

	setAllSettings := meth(self, newrec)
		local field;

		if not IsRec(newrec) then
			return false;
		fi;

		for field in RecFields(newrec) do
			self._settings.(field) := Copy(newrec.(field));
		od;

		#later validate new settings

		return true;
	end,

	getSettingsValue := meth(self, key)
		if not IsBound(self._settings.(key)) then
			return "";
		fi;
		return self._settings.(key);
	end,

	setSettingsValue := meth(arg)
		local self, key, value;
		if Length(arg) < 3 then return false; fi;

		self  := arg[1];
		key   := arg[2];
		value := arg[3];

		#quick out if already set
		if IsBound(self._settings.(key)) and (value = self._settings.(key)) then
			return true;
		fi;

		if key = SGKEY_TRANSFORM then
			return self._setTransform(value);
		elif key = SGKEY_SIZE then
			return self._setSize(value);
		elif (key = SGKEY_DATATYPE) then
			return self._setType(value);
		elif key = SGKEY_FILENAME then
			return self._setFilename(value);
		elif key = SGKEY_FUNCNAME then
			return self._setFuncname(value);
		fi;

		self._settings.(key) := value;

		return true;
	end,

	# TEMP simple set of sequences for early release, just works for FFT
	getSettingsSequence := meth(self)
		local seq;

		seq  := [SGKEY_TRANSFORM, SGKEY_DATATYPE, SGKEY_SIZE];

		return seq;
	end,

	getSettingsDetails := meth(self, key)
		local retrec;

		if not IsString(key) then
			return rec();
		fi;

		retrec := rec(
			(SGKEY_NAME)		:= key,
			(SGKEY_DISPLAYNAME)	:= self.getDisplayName(key),
		);

		if key = SGKEY_SIZE then
			if self.getSettingsValue(SGKEY_TRANSFORM) in [SGKEY_FFT_2D, SGKEY_IFFT_2D] then
				retrec.(SGKEY_TYPE) := [SGTYPE_INT, SGTYPE_INT];
			else
				retrec.(SGKEY_TYPE) := SGTYPE_INT;
			fi;
			retrec.(SGKEY_MULTIPLEVALUES) := true;
		elif key in [SGKEY_DATATYPE, SGKEY_FILENAME, SGKEY_TRANSFORM] then
			retrec.(SGKEY_TYPE) := SGTYPE_STRING;
		fi;

		return retrec;
	end,

	getValidValues := meth(self, key)
		if (key = SGKEY_TRANSFORM) then
			return Cond(IsBound(self._validTransforms), self._validTransforms(), []);
		elif (key = SGKEY_SIZE) then
			return Cond(IsBound(self._validSizes), self._validSizes(), []);
		elif (key = SGKEY_DATATYPE) then
			return Cond(IsBound(self._validTypes), self._validTypes(), []);
		else
			return [];
		fi;
	end,

	getDisplayName := key -> GetScriptGenDisplayName(key),

	setDisplayName := function(key, string)
		if not ( IsString(key) and IsString(string) ) then
			Error("usage: setDisplayName(key, string)\n  both <key> and <string> must be strings");
		fi;

		SetScriptGenDisplayName(key, string);
	end,

    getDocumentation := key -> GetScriptGenDocumentation(key),

	setDocumentation := function(key, string)
		if not ( IsString(key) and IsString(string) ) then
			Error("usage: setDocumentation(key, string)\n  both <key> and <string> must be strings");
		fi;

		SetScriptGenDocumentation(key, string);
	end,

	writeScript := meth(arg)
		local self, key, choiceKey, fname, myPrint, allKeys;

		self := arg[1];
		if Length(arg) > 1 then
			key := arg[2];
		else
			key := SGSTR_ALL;
		fi;

		fname   := self.getSettingsValue(SGKEY_FILENAME);

		if fname = SGSTR_STDOUT then
			myPrint := (arg) -> ApplyFunc(Print, arg);
		else
			# create file or overwrite existing, then use AppendTo for actual writing
			PrintTo(fname, "");
			myPrint := (arg) -> ApplyFunc(AppendTo, Concat([fname], arg));
		fi;

		if key in self.getScriptChoices() then
			myPrint(self._genScript(key));
		elif key = SGSTR_CONSTRUCTOR then
			myPrint("NewScriptGen(\""::self._arch()::"\", ");
			myPrint(self._settings);
			myPrint(");\n");
		elif key = SGSTR_ALL then
			myPrint("\n##! BEGIN CONSTRUCTOR\n\n");
			myPrint("NewScriptGen(\""::self._arch()::"\", ");
			myPrint(self._settings);
			myPrint(");\n");
			myPrint("\n##! END CONSTRUCTOR\n\n");

			for choiceKey in self.getScriptChoices() do
				myPrint("##! BEGIN SCRIPT "::choiceKey::"\n");
				myPrint("# "::self.getDisplayName(choiceKey)::"\n\n");
				myPrint(self._genScript(choiceKey));
				myPrint("\n##! END SCRIPT "::choiceKey::"\n\n");
			od;
		else
			allKeys := Concat([SGSTR_ALL, SGSTR_CONSTRUCTOR], self.getScriptChoices());
			Error("key must be one of: ", allKeys);
		fi;
	end,

	getScriptChoices := (self) >> [SGSTR_RUNRANDOMALL, SGSTR_RUNALL],

	getAllChoicesAsJSON := meth(self)
		local json, indentStr, tree;

		indentStr := "    ";

		json := "{\n" :: indentStr :: "\"isa\" : \"" :: self._arch() :: "\"";

		tree := self._getChoicesDetailsJSON(1, indentStr);

		if Length(tree) > 0 then
			json := json :: ",\n" :: tree;
		fi;

		json := json :: "\n}\n";

		return json;
	end,

	writeJSONChoices := meth(arg)
		local self, file, json;

		self := arg[1];
		if Length(arg) > 1 then
			file := arg[2];
		else
			file := SGSTR_STDOUT;
		fi;

		json := self.getAllChoicesAsJSON();

		PrintTo(file, json);
	end,

    ##
    ## Private methods
	##

	__call__ := meth(arg)
		local self, me, field;
		self := arg[1];

		# create a new instance of the class

		me := WithBases(self, rec(_settings := rec()));

		me._init();

		if IsBound(arg[2]) and IsRec(arg[2]) then
			for field in RecFields(arg[2]) do
				me._settings.(field) := Copy(arg[2].(field));
			od;
		fi;

		return me;
	end,

	# subclass must implement _init()
	_init := (self) >> Error("Cannot instantiate abstract class\n"),

	_setTransform := meth(self, tr)
		local szs;
		if not tr in self._validTransforms() then
			return false;
		fi;
		self._settings.(SGKEY_TRANSFORM) := tr;

		# make sure size is still valid
		self._validateAndFixSize();

		return true;
	end,

	_setType := meth(self, type)
		local szs;
		if not type in self._validTypes() then
			return false;
		fi;
		self._settings.(SGKEY_DATATYPE) := type;

		# make sure size is still valid
		self._validateAndFixSize();

		return true;
	end,

	_setSize := meth(arg)
		local self, sz, szlist, idx, xform;

		if Length(arg) < 2 then return false; fi;

		self := arg[1];
		sz   := arg[2];

		# 1D is a list of one or more valid ints
		# 2D is a list of one or more valid pairs of ints

		xform := self.getSettingsValue(SGKEY_TRANSFORM);
		if xform in [SGKEY_FFT_2D, SGKEY_IFFT_2D] then
			if (not IsList(sz)) or (Length(sz) < 1) then
				return false;
			fi;
			if IsInt(sz[1]) then
				szlist := [ sz ];
			else
				szlist := sz;
			fi;
		else
			if IsList(sz) and (Length(sz) > 0) then
				szlist := sz;
			else
				szlist := [ sz ];
			fi;
		fi;

		if szlist <> self._validateSize(szlist) then
			return false;
		fi;

		self._settings.(SGKEY_SIZE) := szlist;
		return true;
	end,

	_setFilename := meth(self, fname)
		if not IsString(fname) then
			return false;
		fi;
		if Length(fname) = 0 then
			self._settings.(SGKEY_FILENAME) := SGSTR_STDOUT;
		else
			self._settings.(SGKEY_FILENAME) := fname;
		fi;
		return true;
	end,

	_setFuncname := meth(self, fname)
		if not IsString(fname) then
			return false;
		fi;

		### NOTE don't allow whitespace in string

		if Length(fname) = 0 then
			Unbind(self._settings.(SGKEY_FUNCNAME));
		else
			self._settings.(SGKEY_FUNCNAME) := fname;
		fi;
		return true;
	end,

	_validateSize := meth(self, szlist)
		local goodsizes;
		goodsizes := self._validSizes();
		if (Length(szlist) > 0) and ForAll(szlist, s -> s in goodsizes) then
			return szlist;
		fi;

		return Cond(Length(goodsizes) > 0, [ goodsizes[1] ], []);
	end,

	_validateAndFixSize := meth(self)
		local oldsz, newsz;
		oldsz := Cond(IsBound(self._settings.(SGKEY_SIZE)), self._settings.(SGKEY_SIZE), [ 0 ]) ;
		newsz := self._validateSize(oldsz);
		if newsz <> oldsz then
			self._settings.(SGKEY_SIZE) := newsz;
		fi;
	end,

	_getChoicesDetailsJSON := meth(arg)
		local self, level, indentStr, id, descr, json, indent, i, sequence, key, choices, value;

		if Length(arg) < 3 then
			return "";
		fi;
		self := arg[1];
		level := arg[2];
		indentStr := arg[3];
		id    := Cond(IsBound(arg[4]) and IsString(arg[4]), arg[4], "");
		descr := self.getDisplayName(id);

		indent := "";
		for i in [2..level] do
			indent := indent :: indentStr :: indentStr;
		od;

		sequence := self.getSettingsSequence();
		if level > Length(sequence) then return ""; fi;
		key := sequence[level];

		if level > 1 then
			json := indent :: indentStr :: "\"ident\" : \"" :: id :: "\",\n";
			json := json :: indent :: indentStr :: "\"descr\" : \"" :: descr :: "\",\n";
		else
			json := "";
		fi;

		json := json :: indent :: indentStr :: "\"choice_name\" : \"" :: key :: "\",\n";
		json := json :: indent :: indentStr :: "\"choice_display\" : \"" :: self.getDisplayName(key) :: "\",\n";

		choices := self.getValidValues(key);

		if level >= Length(sequence) then
			return json :: indent :: indentStr :: "\"choices\" : " :: String(choices);
		fi;

		json := json :: indent :: indentStr :: "\"choices\" : [\n";

		for i in [1..Length(choices)] do
			json := json :: indent :: indentStr :: indentStr :: "{\n";

			value := choices[i];
			self.setSettingsValue(key, value);
			json := json :: self._getChoicesDetailsJSON(level+1, indentStr, value) :: "\n";

			json := json :: indent :: indentStr :: indentStr :: Cond(i < Length(choices), "},\n", "}\n");
		od;

		json := json :: indent :: indentStr :: "]";

		return json;
	end,

	_genScript := (self, runType) >> "",

	_localSupport := () -> true,

)); # Class ScriptGen

_constructors := rec();

SetScriptGenConstructor := function(gen)
	if IsCallable(gen) and IsBound(gen._arch) then
		_constructors.(gen._arch()) := gen;
	else
		Error("Invalid argument\n");
	fi;
end;

ext: gi


text:
Eval := function(f, x)
  return f(x);
end;

Eval(x -> x^3, 7);
# 343


text:
# A bijective map from elements of F_q to integers from [0..q-1].
BindGlobal("FFEToInt", function(x, q)
    if IsZero(x) then
        return 0;
    else
        return LogFFE(x, Z(q))+1;
    fi;
end);

# A bijective map from integers from [0..q-1] to elements of F_q.
BindGlobal("IntToFFE", function(x, q)
    if x = 0 then
        return 0*Z(q);
    else
        return Z(q)^(x-1);
    fi;
end);

# Transforms a matrix over GF(r) to a Hermitean matrix over GF(r^2).
BindGlobal("ToHermitean", function(A, r)
    local c, n, Hermitize;
    c := Conjugates(GF(r^2), GF(r), Z(r^2));
    Hermitize := function(i, j)
        if i = j then
            return A[i][j];
        elif i < j then
            return A[i][j] + c[1]*A[j][i];
        else
            return A[j][i] + c[2]*A[i][j];
        fi;
    end;
    n := Size(A);
    return Immutable(List([1..n],
        i -> List([1..n], j -> Hermitize(i, j))));
end);

BindGlobal("ToExceptionalMatrix", function(q, F, B)
    return x -> F[IntVecFFE(Coefficients(B, x))*[q, 1] + 1];
end);

# Read a file into a list of lines.
BindGlobal("ReadLines", function(file)
    local f, ln, lns;
    f := InputTextFile(file);
    lns := [];
    ln := ReadLine(f);
    while ln <> fail do
        RemoveCharacters(ln, "\r\n");
        Add(lns, ln);
        ln := ReadLine(f);
    od;
    CloseStream(f);
    return lns;
end);

max_stars_repo_name: jaanos/gap-graphs

max_issues_repo_name: jaanos/gap-graphs

max_forks_repo_name: jaanos/gap-graphs


text:
# De Caen, Mathon and Moorhouse's Preparata graph Pr(t, e)
BindGlobal("PreparataGraph", function(arg)
    local t, e, q, s, F, K, dp;
    if Length(arg) < 1 then
        Error("at least one argument expected");
        return fail;
    fi;
    t := arg[1];
    if Length(arg) > 1 then
        e := arg[2];
    else
        e := 1;
    fi;
    q := 2^(2*t-1);
    s := 2^e;
    F := GF(q);
    dp := DirectProduct(FieldMultiplicationPermutationGroup(q),
                        FieldAdditionPermutationGroup(2),
                        FieldAdditionPermutationGroup(q),
                        FieldExponentiationPermutationGroup(q));
    return Graph(dp, Cartesian(F, GF(2), F), OnPreparata(q, s, dp),
        function(x,y)
            return x <> y
                and x[3]+y[3] = x[1]^s * y[1] + x[1] * y[1]^s + (x[2]+y[2])*(x[1]^(s+1) + y[1]^(s+1));
        end, true);
end);

# Quotient graph of the Preparata graph
BindGlobal("PreparataQuotientGraph", function(arg)
    local h, s, t, e, B, G, H, K, T, V;
    if Length(arg) < 2 then
        Error("at least two arguments expected");
        return fail;
    fi;
    h := arg[1];
    if IsGraph(arg[2]) then
        G := arg[2];
        if IsFFE(G.names[1][3]) then
            s := 1;
        else
            s := Size(G.names[1][3]);
        fi;
        t := Log2Int(2*s*G.order)/4;
    else
        t := arg[2];
        if Length(arg) > 2 then
            e := arg[3];
        else
            e := 1;
        fi;
        G := PreparataGraph(t, e);
    fi;
    B := BasisVectors(Basis(GF(2^(2*t-1))));
    if IsFFE(G.names[1][3]) then
        K := AdditiveGroup(B{[1..h]});
        V := List(G.names, x -> [x[1], x[2], x[3]+K]);
    else
        K := AdditiveGroup(B{[1..h+Log2Int(s)]});
        V := List(G.names, x -> [x[1], x[2], Elements(x[3])[1]+K]);
    fi;
    T := Set(List(V, x -> Positions(V, x)));
    H := Graph(Stabilizer(G.group, T, OnSetsSets), T, OnSets, function(x,y)
        return IsSubset(DistanceSet(G, 1, x), y);
    end, true);
    AssignVertexNames(H, List(T, x -> V[x[1]]));
    return H;
end);

# The coset graph of a Kasami code over an odd power extension
# of a binary field.
BindGlobal("KasamiGraph", function(i, j, m)
    local q, s, t, dp, G;
    q := 2^i;
    s := q^(2*j+1);
    t := q^m + 1;
    G := FieldAdditionPermutationGroup(s);
    dp := DirectProduct(G, G, FieldExponentiationPermutationGroup(s));
    return Graph(dp, Elements(GF(s)^2), OnKasami(s, s, dp),
        function(x, y)
            return x <> y and x[1]+y[1] = (x[2]+y[2])^t;
        end, true);
end);

# The coset graph of an extended Kasami code over an odd power extension
# of a binary field.
BindGlobal("ExtendedKasamiGraph", function(i, j, m)
    return ExtendedBipartiteDoubleGraph(KasamiGraph(i, j, m));
end);

# The coset graph of a Kasami code over a quadratic extension
# of a binary field.
BindGlobal("QuadraticKasamiGraph", function(i)
    local q, s, t, dp;
    q := 2^i;
    s := q^2;
    t := q + 1;
    dp := DirectProduct(FieldAdditionPermutationGroup(q),
            FieldAdditionPermutationGroup(s),
            FieldExponentiationPermutationGroup(s));
    return Graph(dp, Cartesian(GF(q), GF(s)), OnKasami(q, s, dp),
        function(x, y)
            return x <> y and x[1]+y[1] = (x[2]+y[2])^t;
        end, true);
end);

# The coset graph of an extended Kasami code over a quadratic extension
# of a binary field.
BindGlobal("ExtendedQuadraticKasamiGraph", function(i)
    return ExtendedBipartiteDoubleGraph(QuadraticKasamiGraph(i));
end);


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

###############################################################################
##
#R  IsAutomRep
##
##  This is how IsAutom object is stored in GAP:
##  IsAutom object is a thing of kind "w = (w_1, w_2, ..., w_d)\pi", where
##    deg = d - arity of tree;
##    perm = \pi - permutation on first level;
##    w, w_1, ..., w_d - elements of free group representing elements of
##      automata group;
##    word = w;
##    states = [w_1, ..., w_d].
##
DeclareRepresentation("IsAutomRep",
                      IsComponentObjectRep and IsAttributeStoringRep,
                      ["word", "states", "perm", "deg"]);

InstallGlobalFunction(__AG_CreateAutom,
function(family, word, states, perm, invertible)
  local a, cat;

  if invertible then
    cat := IsInvertibleAutom and IsAutomRep;

    if perm^-1=fail then
      Error(perm, " is not invertible");
    else
      perm := AG_PermFromTransformation(perm);
    fi;
  else
    cat := IsAutom and IsAutomRep;
  fi;

  a := Objectify(NewType(family, cat),
                 rec(word := word,
                     states := states,
                     perm := perm,
                     deg := family!.deg));

  SetIsActingOnBinaryTree(a, a!.deg = 2);

  return a;
end);

###############################################################################
##
#M  Autom(<word>, <fam>)
##
InstallMethod(Autom, "for [IsAssocWord, IsAutomFamily]",
              [IsAssocWord, IsAutomFamily],
function(w, fam)
  local exp, wstates, curstate, newstate, curletter, newletter,
        nperm, i, j, perm, a, wtmp, reduced, invertible;

  if fam!.use_rws then
    w := AG_ReducedForm(fam!.rws, w);
  fi;

  if Length(w) = 0 then
    return One(fam);
  elif Length(w) = 1 then
    if ExponentSyllable(w, 1) = 1 then
      return fam!.automgens[GeneratorSyllable(w, 1)];
    else
      return fam!.automgens[GeneratorSyllable(w, 1) + fam!.numstates];
    fi;
  fi;

  # TODO
  exp := LetterRepAssocWord(w);
  for i in [1..Length(exp)] do
    if exp[i] < 0 then exp[i] := -exp[i] + fam!.numstates; fi;
  od;
  wstates := [];
  nperm := ();
  for i in [1..Length(exp)] do
    nperm := nperm * fam!.automatonlist[exp[i]][fam!.deg+1];
  od;

  for i in [1..fam!.deg] do
    wstates[i] := [];
    perm := ();

    for j in [1..Length(exp)] do
      newstate := fam!.automatonlist[exp[j]][i^perm];
      if newstate <> fam!.trivstate then
        if newstate > fam!.numstates then
          newstate := -(newstate - fam!.numstates);
        fi;
        if Length(wstates[i]) > 0 and wstates[i][Length(wstates[i])] = -newstate then
          Remove(wstates[i], Length(wstates[i]));
        else
          Add(wstates[i], newstate);
        fi;
      fi;
      perm := perm * fam!.automatonlist[exp[j]][fam!.deg+1];
    od;
    if Length(wstates[i]) > 0 then
      wstates[i] := AssocWordByLetterRep(FamilyObj(w), wstates[i]);
    else
      wstates[i] := One(fam!.freegroup);
    fi;
    if fam!.use_rws and not IsOne(wstates[i]) then
      wstates[i] := AG_ReducedForm(fam!.rws, wstates[i]);
    fi;
  od;

  invertible := true;
  if not fam!.isgroup then
    for i in exp do
      if i <= fam!.numstates and not IsInvertibleAutom(fam!.automgens[i]) then
        invertible := false;
        break;
      fi;
    od;
  fi;

  return __AG_CreateAutom(fam, w, wstates, nperm, invertible);
end);

###############################################################################
##
#M  Autom(<word>, <a>)
##
InstallMethod(Autom, "for [IsAssocWord, IsAutom]", [IsAssocWord, IsAutom],
function(w, a)
  return Autom(w, FamilyObj(a));
end);

InstallMethod(MappedWord, [IsAssocWord,
                           IsList and IsAssocWordCollection,
                           IsList and IsAutomCollection],
function(w, fgens, agens)
  local img;
  img := MappedWord(w, fgens, List(agens, a -> a!.word));
  return Autom(img, FamilyObj(agens[1]));
end);

###############################################################################
##
#M  Autom(<word>, <list>)
##
InstallMethod(Autom, "for [IsAssocWord, IsList]",
                   [IsAssocWord, IsList],
function(w, list)
  local fam;
  fam := AutomFamily(list);
  if fam = fail then
    return fail;
  fi;
  return Autom(w, fam);
end);

###############################################################################
##
#M  PrintObj(<a>)
##
InstallMethod(PrintObj, "for [IsAutom]",
              [IsAutom],
function (a)
  local deg, printword, i;

  printword := function(w)
    if IsOne(w) then Print(AG_Globals.identity_symbol);
    else Print(w); fi;
  end;

  if true then
    View(a);
    return;
  fi;

  deg := a!.deg;
  printword(a!.word);
  Print(" = (");
  for i in [1..deg] do
    printword(a!.states[i]);
    if i <> deg then Print(", "); fi;
  od;
  Print(")");
  if not IsOne(a!.perm) then AG_PrintTransformation(a!.perm); fi;
end);

###############################################################################
##
#M  ViewObj(<a>)
##
InstallMethod(ViewObj, "for [IsAutom]",
              [IsAutom],
function (a)
  if IsOne(a!.word) then Print(AG_Globals.identity_symbol);
  else Print(a!.word); fi;
end);

###############################################################################
##
#M  String(<a>)
##
InstallMethod(String, "for [IsAutom]",
              [IsAutom],
function (a)
  if IsOne(a!.word) then return AG_Globals.identity_symbol;
  else return String(a!.word); fi;
end);

###############################################################################
##
#M  Perm(<a>)
##
InstallMethod(Perm, "for [IsAutom]", [IsAutom],
function(a)
    return a!.perm;
end);

###############################################################################
##
#M  Word(<a>)
##
InstallMethod(Word, "for [IsAutom]", [IsAutom],
function(a)
    return a!.word;
end);

###############################################################################
##
#M  <a1> * <a2>
##
InstallMethod(\*, "for [IsAutom, IsAutom]", [IsAutom, IsAutom],
function(a1, a2)
    local a, i, fam, word, states;

    fam := FamilyObj(a1);
    word := a1!.word * a2!.word;

    if fam!.use_rws then
      word := AG_ReducedForm(fam!.rws, word);
    fi;

    if IsOne(word) then
      return One(a1);
    fi;

    states := List([1..a1!.deg], i -> a1!.states[i] * a2!.states[i^(a1!.perm)]);

    if fam!.use_rws then
      for i in [1..a1!.deg] do
        states[i] := AG_ReducedForm(fam!.rws, states[i]);
      od;
    fi;

    return __AG_CreateAutom(FamilyObj(a1), word, states, a1!.perm * a2!.perm,
                           IsInvertibleAutom(a1) and IsInvertibleAutom(a2));
end);

AG_IsOne_Autom := function(a)
  local deg, w, aw, checked, to_check;

  if IsOne(a!.word) then
    return true;
  fi;

  if not IsOne(a!.perm) then
    return false;
  fi;

  deg := a!.deg;
  checked := [];
  to_check := Filtered(a!.states, w -> not IsOne(w) and w <> a!.word);

  while not IsEmpty(to_check) do
    w := Remove(to_check, Length(to_check));
    # TODO Use AddSet() here?
    Add(checked, w);
    aw := Autom(w, a);
    if not IsOne(aw!.perm) then
      return false;
    fi;
    for w in aw!.states do
      if not IsOne(w) and not w in checked and not w in to_check then
        # TODO Use AddSet() here?
        Add(to_check, w);
      fi;
    od;
  od;

  return true;
end;

###############################################################################
##
#M  IsOne(a)
##
InstallMethod(IsOne, "for [IsAutom]", [IsAutom],
function(a)
  local i, w, nw, d, to_check, checked, deb_i, perm, autlist, pos, istrivstate, exp, G, trivstate;

  if IsOne(a!.word) then return true; fi;

  G := GroupOfAutomFamily(FamilyObj(a));
  if G <>fail and HasIsContracting(G) and IsContracting(G) and FamilyObj(a)!.use_contraction = true  then
    return IsOneContr(a);
  fi;

  # this seems working well enough
  return AG_IsOne_Autom(a);

  d := a!.deg;
  autlist := FamilyObj(a)!.automatonlist;
  trivstate := FamilyObj(a)!.trivstate;
  checked := [];

  istrivstate := function(v)
    local i, j, perm;

    if IsEmpty(v) then
      return true;
    fi;

    if v in checked then
      return true;
    else
      perm := ();
      for i in [1..Length(v)] do perm := perm * autlist[v[i]][d+1]; od;
      if perm <> () then return false; fi;
      Add(checked, v);
      for j in [1..d] do
        if not istrivstate(AG_WordStateInList(v, j, autlist, true, trivstate)) then
          return false;
        fi;
      od;
      return true;
    fi;
  end;

  exp := LetterRepAssocWord(a!.word);
  for i in [1..Length(exp)] do
    if exp[i] < 0 then
      exp[i] := -exp[i] + FamilyObj(a)!.numstates;
    fi;
  od;

  return istrivstate(exp);
end);

###############################################################################
##
#M  a1 = a2
##
InstallMethod(\=, "for [IsAutom, IsAutom]", IsIdenticalObj, [IsAutom, IsAutom],
function(a1, a2)
  local areequalstates, exp, i, d, checked, autlist, G, trivstate;

  G := GroupOfAutomFamily(FamilyObj(a1));
  if G <> fail and HasIsContracting(G) and IsContracting(G) and UseContraction(G) then
    return IsOneContr(a1*a2^-1);
  fi;

  # TODO can there be a problem if we do this?
  if G <> fail then
    return AG_IsOne_Autom(a1*a2^-1);
  fi;

  d := a1!.deg;
  checked := [];
  autlist := FamilyObj(a1)!.automatonlist;
  trivstate := FamilyObj(a1)!.trivstate;

  areequalstates := function(p)
    local i, j, perm1, perm2;

    if p[1] = p[2] then
      return true;
    fi;

    if p in checked then
      return true;
    else
      perm1 := ();
      perm2 := ();

      for i in [1..Length(p[1])] do
        perm1 := perm1 * autlist[p[1][i]][d+1];
      od;
      for i in [1..Length(p[2])] do
        perm2 := perm2 * autlist[p[2][i]][d+1];
      od;

      if perm1 <> perm2 then
        return false;
      fi;

      AddSet(checked, p);
      for j in [1..d] do
        if not areequalstates([AG_WordStateInList(p[1], j, autlist, true, trivstate),
                               AG_WordStateInList(p[2], j, autlist, true, trivstate)])
        then
          return false;
        fi;
      od;
      return true;
    fi;
  end;

  exp := [LetterRepAssocWord(a1!.word), LetterRepAssocWord(a2!.word)];
  for i in [1..Length(exp[1])] do
    if exp[1][i] < 0 then exp[1][i] := -exp[1][i] + FamilyObj(a1)!.numstates; fi;
  od;
  for i in [1..Length(exp[2])] do
    if exp[2][i] < 0 then exp[2][i] := -exp[2][i] + FamilyObj(a2)!.numstates; fi;
  od;
  return areequalstates(exp);
end);

###############################################################################
##
#M  a1 < a2
##
InstallMethod(\<, "for [IsAutom, IsAutom]", IsIdenticalObj, [IsAutom, IsAutom],
function(a1, a2)
  local d, checked, pos, aw1, aw2, p, np, i, exp, perm1, perm2, autlist, cmp;

  d := a1!.deg;
  autlist := FamilyObj(a1)!.automatonlist;
  exp := [LetterRepAssocWord(a1!.word), LetterRepAssocWord(a2!.word)];
  for i in [1..Length(exp[1])] do
    if exp[1][i] < 0 then exp[1][i] := -exp[1][i] + FamilyObj(a1)!.numstates; fi;
  od;
  for i in [1..Length(exp[2])] do
    if exp[2][i] < 0 then exp[2][i] := -exp[2][i] + FamilyObj(a2)!.numstates; fi;
  od;
  checked := [exp];
  pos := 0;

  while Length(checked) <> pos do
    pos := pos + 1;
    p := checked[pos];
    perm1 := ();
    perm2 := ();
    for i in [1..Length(p[1])] do perm1 := perm1 * autlist[p[1][i]][d+1]; od;
    for i in [1..Length(p[2])] do perm2 := perm2 * autlist[p[2][i]][d+1]; od;
    cmp := AG_TrCmp(perm1, perm2, d);
    if cmp < 0 then
      return true;
    elif cmp > 0 then
      return false;
    fi;
    for i in [1..d] do
      np := [AG_WordStateInList(p[1], i, autlist, false, 0),
             AG_WordStateInList(p[2], i, autlist, false, 0)];
      if not np in checked then
        Add(checked, np);
      fi;
    od;
  od;

  return false;
end);

###############################################################################
##
#M  InverseOp(<a>)
##
InstallMethod(InverseOp, "for [IsInvertibleAutom]", [IsInvertibleAutom],
function(a)
  local i, inv, fam, word, states;

  fam := FamilyObj(a);
  word := a!.word ^ -1;
  if fam!.use_rws then
    word := AG_ReducedForm(fam!.rws, word);
    if IsOne(word) then
      return One(a);
    fi;
  fi;

  states := List([1..a!.deg], i -> a!.states[i^(a!.perm^-1)]^-1);

  if fam!.use_rws then
    for i in [1..a!.deg] do
      states[i] := AG_ReducedForm(fam!.rws, states[i]);
    od;
  fi;

  return __AG_CreateAutom(FamilyObj(a), word, states, a!.perm^-1, true);
end);

###############################################################################
##
#M  OneOp(<a>)
##
InstallMethod(OneOp, "for [IsAutom]", [IsAutom],
function(a)
    return One(FamilyObj(a));
end);

###############################################################################
##
#M  StatesWords(<a>)
##
InstallMethod(StatesWords, "for [IsAutom]", [IsAutom],
function(a)
  return a!.states;
end);

###############################################################################
##
#M  Sections(a)
##
InstallMethod(Sections, "for [IsAutom]", [IsAutom],
function(a)
  return List(a!.states, s -> Autom(s, a));
end);

###############################################################################
##
#M  Section(a, k)
##
InstallMethod(Section, "for [IsAutom, IsPosInt]", [IsAutom, IsPosInt],
function(a, k)
  if k > a!.deg then
    Error("in Section(IsAutom, IsPosInt): invalid vertex ", k);
  fi;
  return Autom(a!.states[k], a);
end);

###############################################################################
##
#M  Section(a, seq)
##
## TODO
InstallMethod(Section, "for [IsAutom, IsList]", [IsAutom, IsList],
function(a, v)
  if Length(v) = 0 then
    return a;
  fi;

  if Length(v) = 1 then
    return Section(a, v[1]);
  fi;

  return Section(Section(a, v[1]), v{[2..Length(v)]});
end);

###############################################################################
##
#M  k ^ a
##
InstallMethod(\^, "for [IsPosInt, IsAutom]", [IsPosInt, IsAutom],
function(k, a)
    return k ^ Perm(a);
end);

###############################################################################
##
#M  seq ^ a
##
InstallMethod(\^, "for [IsList, IsAutom]", [IsList, IsAutom],
function(seq, a)
    local i, deg, img, cur;

    deg := DegreeOfTree(a);
    for i in seq do
      if not IsInt(i) or i < 1 or i > deg then
         Error("\^(IsList, IsAutom): ",
              i, " is out of range 1..", deg, " and is not a letter of the alphabet\n");
#        Print("\^(IsList, IsAutom): ",
#             i, " is out of range 1..", deg, " and is not a letter of the alphabet\n");
#        return seq;
      fi;
    od;

    if Length(seq) = 0 then return []; fi;
    if Length(seq) = 1 then return [seq[1]^Perm(a)]; fi;

    cur := LetterRepAssocWord(Word(a));
    for i in [1..Length(cur)] do
      if cur[i] < 0 then cur[i] := -cur[i]+FamilyObj(a)!.numstates; fi;
    od;
    cur := [cur, Perm(a)];

    img := [];
    for i in [1..Length(seq)] do
        img[i] := seq[i]^cur[2];
        cur := AG_WordStateAndPermInList(cur[1], seq[i],
                                         FamilyObj(a)!.automatonlist);
    od;

    return img;
end);

###############################################################################
##
#M  PermOnLevelOp(a, k)
##
## TODO
InstallMethod(PermOnLevelOp, "for [IsIsInvertibleAutom, IsPosInt]",
              [IsInvertibleAutom, IsPosInt],
function(a, k)
  local dom, perm;

  if k = 1 then
    return a!.perm;
  fi;

  dom := AsList(Tuples([1.. a!.deg], k));
  perm := List(dom, s -> s ^ a);
  perm := PermListList(dom, perm);

  return perm;
end);

InstallMethod(TransformationOnFirstLevel, [IsAutom],
function(a)
  return AsTransformation(a!.perm);
end);

###############################################################################
##
#M  IsActingOnBinaryTree(<a>)
##
InstallMethod(IsActingOnBinaryTree, "for [IsAutom]",
              [IsAutom],
function(a)
    return a!.deg = 2;
end);

InstallMethod(SphericalIndex, "for [IsAutom]", [IsAutom],
function(a)
  # XXX check uses of SphericalIndex everywhere
  return rec(start := [], period := [a!.deg]);
end);

# XXX check uses of this everywhere
InstallMethod(DegreeOfTree, "for [IsAutom]", [IsAutom],
function(a)
  return a!.deg;
end);

# XXX check uses of this everywhere
InstallMethod(TopDegreeOfTree, "for [IsAutom]", [IsAutom],
function(a)
  return a!.deg;
end);

###############################################################################
##
#M  CanEasilyTestSphericalTransitivity(<a>)
##
InstallTrueMethod(CanEasilyTestSphericalTransitivity,
                  IsActingOnBinaryTree and IsAutom);

###############################################################################
##
#M  IsSphericallyTransitive(<a>)
##
InstallMethod(IsSphericallyTransitive, "for [IsAutom]",
              [IsInvertibleAutom],
function(a)
  local w, i, ab, abs;

  if IsOne(Word(a)) then
    Info(InfoAutomGrp, 3, "IsSphericallyTransitive(a): false");
    Info(InfoAutomGrp, 3, "  IsOne(Word(a)): a = ", a);
    return false;
  fi;

  TryNextMethod();
end);

#########################################################################
##
#M  Order(<a>)
##
InstallMethod(Order, "for [IsInvertibleAutom]", true,
                   [IsInvertibleAutom],
function(a)
  local ord_loc;
  if IsGeneratedByBoundedAutomaton(GroupOfAutomFamily(FamilyObj(a))) then
    return OrderUsingSections(a, infinity);
  fi;
  if IsActingOnBinaryTree(a) and IsSphericallyTransitive(a) then
    return infinity;
  fi;
  ord_loc := OrderUsingSections(a, 10);
  if ord_loc <> fail then
    return ord_loc;
  fi;
  return OrderUsingSections(a, infinity);
end);

#########################################################################
##
#M  IsTransitiveOnLevel( <a>, <lev> )
##
InstallMethod(IsTransitiveOnLevel, "for [IsInvertibleAutom, IsPosInt]",
              [IsInvertibleAutom, IsPosInt],
function(a, lev)
  return Length(OrbitPerms([PermOnLevel(a, lev)], 1)) = a!.deg^lev;
end);

#########################################################################
##
#M  AllSections( <a> )
##
InstallMethod(AllSections, "for [IsAutom]",
              [IsAutom],
function(a)
  local states, find_all_sections;

  find_all_sections := function(s)
    local i;
    if not s in states then
      Add(states, s);
      for i in [1..s!.deg] do find_all_sections(Section(s, i)); od;
    fi;
  end;

  states := [];
  find_all_sections(a);
  return states;
end);

#E

max_stars_repo_name: gap-packages/automgrp

max_issues_repo_name: gap-packages/automgrp

max_forks_repo_name: gap-packages/automgrp