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

#############################################################################
#F
#F  sched.g                    Bag of Schedulers                Ernest Chan
#F
##

#############################################################################
##
##  Constants
##
PRINTDAG := false;
RED := 0;           # INPUT NODES
BLACK := 1;         # TEMP NODES
BLUE := 2;          # OUTPUT NODES
GREEN := 3;         # WEIRD! no pred and no succ

############################################################################
##
##  Building the DAG
##
##  Node structure
##    cmd:     the original statement
##    pred:    a list of predecessors
##    succ:    a list of successors
##    id:      list of command outputs
##

############################################################################
##
#F  AddNode( <dag>, <cmd> ) . . makes a node for a variable/input/output
##
AddNode := function(dag, cmd)
  local a;
  a := rec(
    id := Set(cmd.op_out() :: cmd.op_inout()),     # either var or nth
    index := Length(dag),
    pred := [],
    succ := [],
    cmd := cmd,
  );

  Add(dag, a);

  return a;
end;

############################################################################
##
#F  GetNode( <dag> , <id> ) . . . . . . if node with the specified <id> is
#F      in <dag>, then it is returned,  otherwise returns false
##
GetNode := function(dag, var)
  local i;

  i := Length(dag);
  while i >= 1 do
    if var in dag[i].id then
      return dag[i];
    fi;
    i := i-1;
  od;

  return false;
end;

############################################################################
##
#F  AddEdges( <dag> , <cmd> ) . . . parses out the variables from
#F      <exp>, and addes an edge from each of the variables to <node> in <dag>
##
AddEdges := function(dag, cmd)
    local v, n, ops_in, node;

    ops_in := Set(cmd.op_in() :: cmd.op_inout());

    node := AddNode(dag, cmd);

    for v in ops_in do
        n := GetNode(dag, v);
        if n <> false then
            Add(n.succ, node);
            Add(node.pred, n);
        fi;
    od;
end;

##############################################################################
##
#F  BuildDag( <chain> ) . . . . builds the Dag by examining
#F      each command statement in <chain>
##
BuildDag := function(chain_object)
    local i, j, k, dag, newnode, old_id, newnode_name, f, objid, assignstmt, node;
    if (ObjId(chain_object) = chain) then
        dag := [];
        for i in [1..Length(chain_object.cmds)] do
            # for each assign statement, make appropriate changes to the Dag have to
            #   1) add nodes if not in the graph
            #   2) add edges
            AddEdges(dag, chain_object.cmds[i]);
        od;
        return dag;
    else
        Print("in function BuildDag: argument not a chain structure");
    fi;
end;

##############################################################################
##
#F  PrintDag ( <dag> , <bool> ) . . . . if true, prints the dag with its orders,
#F      otherwise prints the dag with the names of the nodes
##
PrintDag := function(dag, order)
  local count, _PrintDag, __PrintDag;

  Print("digraph DAG {\n");

  count := 0;

  _PrintDag := function(dag, order)
    local i,j,templist;

    if Length(dag)<1 then return; fi;

    if IsList(dag[1]) then
      for i in [1..Length(dag)] do
        Print("  subgraph cluster");
        Print(count);
        count := count + 1;
        Print(" {\n");
        _PrintDag(dag[i], order);
        Print("  }\n");
      od;
    else
      for i in [1..Length(dag)] do
        Print("  ");
        if order then
          Print(dag[i].order);
        else
          Print("\"", dag[i].id, "\"");
        fi;
      od;
      Print("\n");
    fi;
  end;

  _PrintDag(dag, order);

  __PrintDag := function(dag,order)
    local i,j;

    if Length(dag)<1 then return; fi;

    if IsList(dag[1]) then
      for i in [1..Length(dag)] do
        __PrintDag(dag[i], order);
      od;
    else
      for i in [1..Length(dag)] do
        for j in [1..Length(dag[i].succ)] do
          Print("  ");
          if order then
            Print(dag[i].order);
          else
            Print("\"", dag[i].id, "\"");
          fi;
          Print(" -> ");
          if order then
            Print(dag[i].succ[j].order);
          else
            Print("\"", dag[i].succ[j].id, "\"");
          fi;
          Print("\n");
        od;
      od;
    fi;
  end;

  __PrintDag(dag, order);

  Print("}\n");
end;

##############################################################################
##
#F  OutputDag( <dag> , <string> ) . . . . . . . outputs a postscript file for
#F      the dag with filename <string>.ps
##
OutputDag := function(dag, file)
  if PRINTDAG then
    PrintTo("temp", PrintDag(dag, false));
    SYS_EXEC(Concat("dot -Tps -o",file," temp"));
    SYS_EXEC("rm temp");
  fi;
end;

##############################################################################
##
#F  InitColor ( <dag> )  . . . . . . . . initialize color of nodes in a dag
##
InitColor := function(dag)
  local i, j, pred_exists, succ_exists;

  for i in [1..Length(dag)] do
    pred_exists := Filtered(dag[i].pred, e->e in dag) <> [];
    succ_exists := Filtered(dag[i].succ, e->e in dag) <> [];

    if pred_exists then
      if succ_exists then
        dag[i].color := BLACK;
      else
        dag[i].color := BLUE;
      fi;
    else
      if succ_exists then
        dag[i].color := RED;
      else
        Error("Not a DAG");
      fi;
    fi;
  od;

end;

###############################################################################
##
#F  ColorPhase ( <dag> , <color> ) . . advances one step in the coloring phase
##
ColorPhase := function(dag, color)
  local i, j, pos, all_has_color, colorlist;

  colorlist := [];

  if color=RED then
    for i in [1..Length(dag)] do
      if dag[i].color = BLACK then
        all_has_color := true;
        for j in dag[i].pred do
          if j in dag then
            if j.color<>RED then
              all_has_color := false;
            fi;
          fi;
        od;
        if all_has_color then
          Add(colorlist, i);
        fi;
      fi;
    od;
  elif color=BLUE then
    for i in [1..Length(dag)] do
      if dag[i].color = BLACK then
        all_has_color := true;
        for j in dag[i].succ do
          if j in dag then
            if j.color<>BLUE then
              all_has_color := false;
            fi;
          fi;
        od;
        if all_has_color then
          dag[i].color := BLUE;
        fi;
      fi;
    od;
  fi;

  for i in [1..Length(colorlist)] do
    dag[colorlist[i]].color := color;
  od;

end;

###############################################################################
##
#F  SplitDag( <dag> ) . . . . . splits a dag into two (roughly equal) halves
##
SplitDag := function(dag)
  local getComponent, set, newset, temp, answer, i;

  getComponent := function(dag, set, node)
    local i, j, pred, succ, tempset;

    pred := Filtered(node.pred, e->e in dag);
    succ := Filtered(node.succ, e->e in dag);

    if not node in set then
      Add(set, node);
      node.taken := true;
    fi;
    for i in pred do
      if not i in set then
        Add(set, i);
        i.taken := true;
        set := getComponent(dag, set, i);
      fi;
    od;
    for i in succ do
      if not i in set then
        Add(set, i);
        i.taken := true;
        set := getComponent(dag, set, i);
      fi;
    od;
    return set;
  end;

  answer := [];
  for i in dag do
    i.taken := false;
  od;

  while not Length(Filtered(dag, x -> not x.taken)) = 0  do
    set := Filtered(dag, x -> not x.taken);
    temp := getComponent(dag, [], set[1]);
    Add(answer, temp);
  od;

  if Length(answer) = 1 then
    return rec(graph := answer[1], modified := false);
  else
    return rec(graph := answer, modified := true);
  fi;
end;

###############################################################################
##
#F  BreakDeps ( <dag> )  . . . . . . . . .  breaking one-to-many dependencies
##

BreakDeps := function (dag)
  local subset, split, graph, i;
  subset := List([1..Length(dag)], i -> rec(
    node_index := i,
    pred := Filtered(List(dag[i].pred, e->Position(dag, e)), e->e <> false),
    succ := Filtered(List(dag[i].succ, e->Position(dag, e)), e->e <> false)));
  split := Filtered(subset, r -> let( max := Maximum0(List(r.succ, i->Length(subset[i].succ))),
             Length(r.pred)=0 and Length(r.succ) > 0 and max > 0 and Length(r.succ) > 2*max));
  split := List(split, e->e.node_index);
  if Length(split) > 0 then
    graph := [[],[]];
    for i in [1..Length(dag)] do
      if i in split then
        Add(graph[1], dag[i]);
      else
        Add(graph[2], dag[i]);
      fi;
    od;
    return rec(graph := graph, modified := true);
  else
    return rec(graph := dag, modified := false);
  fi;
end;

###############################################################################
##
#F  PartitionDag ( <dag> )  . . . . . . . . . . . . returns a partitioned dag
##
PartitionDag := function(dag)
  local hasBlackNode, bBlackNodes, i, redlist, bluelist, serial;

  serial := BreakDeps(dag);
  if serial.modified then
    return List(serial.graph, x->PartitionDag(x));
  else
    serial := SplitDag(dag);
    if serial.modified then
      return List(serial.graph, x->PartitionDag(x));
    else

    # Parallel Split
    if Length(dag)>=2 then

      InitColor(dag);
      bBlackNodes := false;
      while (Length(Filtered(dag, x -> x.color = BLACK))>0) do
        bBlackNodes := true;
        ColorPhase(dag, RED);
        ColorPhase(dag, BLUE);
      od;

      if bBlackNodes then
        redlist := Filtered(dag, x->x.color=RED);
        bluelist := Filtered(dag, x->x.color=BLUE);
        return [PartitionDag(redlist), PartitionDag(bluelist)];
      fi;
    fi;
    return dag;
    fi;
  fi;
end;

##########################################################################
##
#F  ScheduleDag( <partitioned_dag> ) . . . . schedules a paritioned dag
##
ScheduleDag := function(pdag)
  local f, newlist, bigorder;

  newlist := [];
  bigorder := 0;

  f := function(pdag)
    local i,j,k,m;
    if Length(pdag)>0 then
      if IsRec(pdag[1]) then          # use bfs for the order of the nodes
        for j in pdag do j.taken := false; j.order:=0; od;
        while Length(Filtered(pdag, x->not x.taken))>0 do
          k := Filtered(pdag, x -> not x.taken);
          # want all nodes not taken, with preds either outside pdag or taken
          for j in k do
            m := true;
            for i in j.pred do
              if (i in pdag) and (not i.taken) then
                m := false;
              fi;
            od;
            if m then
               j.taken := true;
               Add(newlist, j.cmd);
               bigorder := bigorder + 1;
               j.order := bigorder;
            fi;
          od;
        od;
      elif IsList(pdag[1]) then
        for i in [1..Length(pdag)] do
           f(pdag[i]);
        od;
      fi;
    fi;
  end;

  f(pdag);
  return newlist;

end;

###############################################################################
##
#F  RandomScheduleDag( <dag> ) . . . . . . schedules a dag in a random manner
##
RandomScheduleDag := function(dag)
  local f, newlist, bigorder, list_of_recs;

  newlist := [];
  bigorder := 0;

  f := function(dag)
    local i,j,k,m;
    if Length(dag)>0 then
      if IsRec(dag[1]) then
        for j in dag do j.taken := false; j.order:=0; od;
        while Length(Filtered(dag, x->not x.taken))>0 do
          k := Filtered(dag, x -> not x.taken);
          list_of_recs := [];
          # want all nodes not taken, with preds either outside dag or taken
          for j in k do
            m := true;
            for i in j.pred do
              if (not i.taken) then
                m := false;
              fi;
            od;
            if m then
              Add(list_of_recs, j);
            fi;
          od;
          j := Random(list_of_recs);
          j.taken := true;
          Add(newlist, j.cmd);
          bigorder := bigorder + 1;
          j.order := bigorder;
        od;
      fi;
    fi;
  end;

  f(dag);
  return chain(Filtered(newlist, x -> x <> 0));

end;

###############################################################################
##
#F  GetCompleteSchedules( <dag>, <int_limit> ) . . . . . get complete set of
#F      schedules of a given dag, with the number of limit of the number of
#F      schedules
##
GetCompleteSchedules := function(dag, limit)
  local f, newlist, bigorder, li, dag_length, j;

  newlist := [];
  dag_length := Length(dag);

  f := function(dag, li, bigorder)
    local i,j,k,m, sel, newdag, li2;

    if Length(newlist) >= limit then
      return;
    fi;

    if Length(li) = dag_length then
      m := Filtered(li, x -> x<>0);
      if Length(Filtered(newlist, x->x=m))<=0 then
        Add(newlist, m);
      fi;
    elif Length(dag)>0 then
      if IsRec(dag[1]) then          # use bfs for the order of the nodes
        newdag := Copy(dag);
        # want all nodes not taken, with preds either outside dag or taken
        for j in [1..Length(dag)] do
          if not dag[j].taken  then
            m := true;
            for i in dag[j].pred do
              if (not i.taken) then
                m := false;
              fi;
            od;
            if m then
              dag[j].taken := true;
              li2 := Copy(li);
              if dag[j].cmd <> 0 then
                Add(li2, j);
              else
                Add(li2, 0);
              fi;
              dag[j].order := bigorder;
              newdag := Copy(dag);
              f(newdag, li2, bigorder + 1);
              dag[j].order := 0;
              dag[j].taken := false;
            fi;
          fi;
        od;
      fi;
    fi;
  end;

  for j in dag do j.taken := false; j.order:=0; od;
  f(dag, [], 0);

  newlist := List(newlist, x -> chain(List(x, y -> dag[y].cmd)));

  return newlist;
end;

###############################################################################
##
#F  FFTWScheduleAssignments( <chain> ) . . . schedule assignments
#F      using FFTW's scheduler
##
FFTWScheduleAssignments := function(chain_obj)
  local dag, pdag, schedule;

  dag := BuildDag(chain_obj);
  pdag := PartitionDag(dag); #SplitDagByDataType(dag);

  schedule := chain(ScheduleDag(pdag));

  if PRINTDAG then
    PrintTo("SA_dag", PrintDag(dag, false));
    SYS_EXEC("dot -Tps -odag.ps SA_dag");
    SYS_EXEC("rm SA_dag");

    PrintTo("SA_dag", PrintDag(dag, true));
    SYS_EXEC("dot -Tps -oorder.ps SA_dag");
    SYS_EXEC("rm SA_dag");

    PrintTo("SA_pdag", PrintDag(pdag, false));
    SYS_EXEC("dot -Tps -opdag.ps SA_pdag");
    SYS_EXEC("rm SA_pdag");

    PrintTo("SA_oldschedule", chain_obj);
    PrintTo("SA_newschedule", schedule);

    PrintTo("SA_order", PrintDag(pdag, true));
    SYS_EXEC("dot -Tps -oporder.ps SA_order");
    SYS_EXEC("rm SA_order");
  fi;

  return schedule;
end;

###############################################################################
##
#F  RandomScheduleAssignments(<chain>, <int>) . . . generates a random schedule
##
RandomScheduleAssignments := function(chain_obj)
  local dag, schedule;

  dag := BuildDag(chain_obj);

  schedule := RandomScheduleDag(dag);

  if PRINTDAG then
    PrintTo("SA_dag", PrintDag(dag, false));
    SYS_EXEC("dot -Tps -ordag.ps SA_dag");
    SYS_EXEC("rm SA_dag");

    PrintTo("SA_oldschedule", chain_obj);
    PrintTo("SA_newschedule", schedule);

    PrintTo("SA_dag", PrintDag(dag, true));
    SYS_EXEC("dot -Tps -ororder.ps SA_dag");
    SYS_EXEC("rm SA_dag");

  fi;

  return schedule;
end;

###############################################################################
##
#F  CompleteScheduleAssignments (<chain>, <int_limit>) . . .
#F      generates all the schedules (with limit as the number of schedules
#F      generated)
##
CompleteScheduleAssignments := function(chain_obj, number)
  local dag;

  dag := BuildDag(chain_obj);
  return GetCompleteSchedules(dag, number);

end;

###############################################################################
##
#F  EdwardScheduleAssignments( <chain>, <int_reg>) . . . using
#F      Edward's scheduling algorithm, generate a schedule
##
EdwardScheduleAssignments := function(chain_obj, n)
  local dag,i,j,k,l,m,mincost,minindex,readylist, final, registers, getcost, costlist;

  dag := BuildDag(chain_obj);

  # init readylist and taken
  readylist := Filtered(dag, x -> x.pred=[]);
  for i in dag do
    i.taken := false;
  od;

  final := [];
  registers := List([1..n], x->1);

  getcost := function(node)
    local i,j;
    i:=0;
    for j in node.pred do
      if not (i in registers) then
        i:=i+2;
      else
        i:=i-1;
      fi;
    od;
    return i;
  end;

  while (Length(readylist)>0) do
     # for each node in readylist, determine which to pick
     #   among the nodes in the readylist, pick one with
     #   least cost
     #   1) determine cost
     #   2) determine min
     #   3) take min
     #
     #   N.B. maintain registers
     costlist := List(readylist, x->getcost(x));
     minindex := 1;
     mincost := costlist[1];
#     Print(costlist, "\n");
#     Print("reg = ", Length(Filtered(registers, x->x<>1)), "\n");

     for i in [1..Length(costlist)] do
       if mincost > costlist[i] then
         minindex := i;
         mincost := costlist[i];
       fi;
     od;

     k := readylist[i];
#     Print(k.original, "\n");

     # update registers
     if k in registers then
       i := Position(registers, k);
       j := [k];
       for l in [1..i-1] do
         Add(j, registers[l]);
       od;
       for l in [i+1..n] do
         Add(j, registers[l]);
       od;
       registers := j;
     else
       j := [k];
       for l in [1..n-1] do
         Add(j, registers[l]);
       od;
       registers := j;
     fi;

     readylist := Filtered(readylist, x -> not x=k);
     Add(final, k.cmd);
     k.taken := true;

     for i in k.succ do
       if not i.taken then
         l := true;
         for j in i.pred do
           if not j.taken then
             l := false;
           fi;
         od;
         if l then
           Add(readylist, i);
         fi;
       fi;
     od;

  od;

  return chain(Filtered(final, x->x<>0));

end;

###############################################################################
##
#F  ImFFTWScheduleAssignments( <chain> ) . . . using an algorithm
#F      similar to Edwards scheduler, generate a schedule
##
ImFFTWScheduleAssignments := function(chain_obj)
  local dag, first_level, second_level, output_nodes,i,j,k, color, color_no, li;

  dag := BuildDag(chain_obj);

  # label second level nodes
  for i in dag do
    i.level := 3;        # OTHER LEVEL
  od;
  first_level := Filtered(dag, x -> x.pred=[]);
  second_level := [];
  for i in first_level do
    i.level:= 1;
    for j in i.succ do
      j.level:= 2;
      if not (j in second_level) then
        Add(second_level, j);
      fi;
    od;
  od;

  # get outputnodes;
  output_nodes := Filtered(dag, x->x.succ = []);

  # color output nodes
  for i in dag do
    i.color := 0;  # means uninitialized
  od;
  color := function(node, c)
    local i;
    if not node.color = 0 then
      return;
    elif node.level=3 then
      node.color := c;
      for i in node.pred do
        color(i, c);
      od;
      for i in node.succ do
        color(i, c);
      od;
    elif node.level = 2 then
      if node.color = 0 then
        node.color := c;
      fi;
    fi;
  end;

  color_no := 0;
  for i in output_nodes do
    if i.color=0 then
      color_no := color_no + 1;
      color(i, color_no);
    fi;
  od;

  # for each color, schedule graph
  li := [];
  for i in [1..color_no] do
    j := Filtered(dag, x -> x.color=i);
    j := ScheduleDag(j);
    for k in [1..Length(j)] do
      Add(li, j[k]);
    od;
  od;

  # output statements;
  return chain(li);
end;

# tochain := x -> Cond(IsChain(x), Copy(x), chain(Copy(x)));

# bsplit := function(code)
#     local dims;
#     dims := code.dimensions;
#     code := When(IsBound(code.cmd), code.cmd, code);
#     code := FlattenCode(BinSplit(tochain(code)));
#     code := Compile.declareVars(code);
#     code.dimensions := dims;
#     return code;
# end;

# sched := function(code)
#     local dims;
#     dims := code.dimensions;
#     code := When(IsBound(code.cmd), code.cmd, code);
#     code := FFTWScheduleAssignments(tochain(code));
#     code := Compile.declareVars(code);
#     code.dimensions := dims;
#     return code;
# end;

# sched2 := function(code)
#     local dims;
#     dims := code.dimensions;
#     code := When(IsBound(code.cmd), code.cmd, code);
#     code := EdwardScheduleAssignments(tochain(code), 8);
#     code := Compile.declareVars(code);
#     code.dimensions := dims;
#     return code;
# end;

# randsched := function(code)
#     local dims;
#     dims := code.dimensions;
#     code := When(IsBound(code.cmd), code.cmd, code);
#     code := RandomScheduleAssignments(tochain(code));
#     code := Compile.declareVars(code);
#     code.dimensions := dims;
#     return code;
# end;


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

########################################################################
# If RulesXYOffset correctly takes out base addresses out of H into RecursStep
# we can use the following hack to pass into the function only the stride
#
# H.codeletParNums := [4];
# H.signature := self >> [IntVar("s")];
# H.mkCodelet := self >> let(ss := self.signature(), H(self.params[1], self.params[2], 0, ss[1]));
#
#########################################################################

CollectRecursSteps := s -> Collect(s, RecursStep);

#F Shape(<obj>) - returns a LISP-style structural list, i.e. add(1,2) -> [add, 1, 2]
#F
Shape := x-> Cond(IsRec(x) and IsBound(x.shape), x.shape(),  x);

ClassSPL.shape := self >> Concatenation([ObjId(self)],
    List(self.rChildren(), Shape));

Exp.shape := self >> Concatenation([ObjId(self)],
    List(self.rChildren(), Shape));

RTWrap.shape := self >> self.rt.node.shape();

#F CodeletShape(<obj>) - returns a LISP-style structural list for a codelet
#F    In this case parameters that are passed into a codelet functions do not
#F    show up, i.e. Scat(H(16,2,0,1))*DFT(16)*... -> [Compose, [Scat, H], DFT, ...]
#F
CodeletShape := x-> Cond(IsRec(x) and IsBound(x.codeletShape), x.codeletShape(),  x);
ClassSPL.codeletShape := self >> Concatenation([ObjId(self)],
    List(self.rChildren(), CodeletShape));
FuncClassOper.codeletShape := ClassSPL.codeletShape;
RTWrap.codeletShape := self >> CodeletShape(self.rt.node);
NonTerminal.codeletShape := self >> Concatenation(
    [ObjId(self)],
    List(self.params, CodeletShape),
    When(self.transposed, ["T"], []));

#F CodeletSignature(<obj>) - codelet function signature
#F
CodeletSignature := x-> Cond(IsRec(x) and IsBound(x.signature), x.signature(),
    IsRec(x), Error(".signature() field missing (objid = ", ObjId(x), ")"), []);
ClassSPL.signature := self >> Concatenation(List(self.rChildren(), CodeletSignature));
FuncClassOper.signature := ClassSPL.signature;
RTWrap.signature := self >> CodeletSignature(self.rt.node);
Value.signature := self >> [];

#F CodeletParams(<obj>) - codelet function call params
#F
CodeletParams := x-> Cond(IsRec(x) and IsBound(x.codeletParams), x.codeletParams(),
    IsRec(x), Error(".codeletParams() field missing (objid = ", ObjId(x), ")"), []);
ClassSPL.codeletParams := self >> Concatenation(List(self.rChildren(), CodeletParams));
FuncClassOper.codeletParams := ClassSPL.codeletParams;
RTWrap.codeletParams := self >> CodeletParams(self.rt.node);
Value.codeletParams := self >> [];

#F MkCodelet(<obj>) - generalize <obj> by changing codelet params to be variables
#F
MkCodelet := x -> Cond(IsRec(x) and IsBound(x.mkCodelet), x.mkCodelet(),
    IsRec(x), Error(".mkCodelet() field missing (objid = ", ObjId(x), ")"), x);
#ClassSPL.codeletParams := self >> Concatenation(List(self.rChildren(), CodeletParams));
ClassSPL.mkCodelet := self >> ApplyFunc(ObjId(self),
    List(self.rChildren(), MkCodelet));
FuncClassOper.mkCodelet := BaseOperation.mkCodelet;
RTWrap.mkCodelet := self >> self;
NonTerminal.mkCodelet := self >> self;
Value.mkCodelet := self >> self;

#F CodeletName(<shape>)
#F
CodeletName := shape -> Cond(
    IsInt(shape),
        When(shape < 0, Concat("_n", String(-shape)), Concat("_",String(shape))),
    IsRat(shape),
        Concat(When(shape < 0, "_n", "_"), StringInt(AbsInt(Numerator(shape))), "d", StringInt(Denominator(shape))),
    IsValue(shape),
        CodeletName(shape.v),

    IsRec(shape), Concat(When(IsBound(shape.codeletNameNo_), "", "_"),
    When(IsBound(shape.codeletName), shape.codeletName, shape.name)),
    IsString(shape),
        shape,

    IsList(shape) and not (Length(shape) > 2 and IsRec(shape[1]) and IsBound(shape[1].codeletNameInfix)),
        When(Length(shape)=2 and not (IsRec(shape[2]) or IsList(shape[2])),
         Concat("", CodeletName(shape[1]), String(shape[2])),
         Concat("", Concatenation(List(shape, CodeletName)))),

    IsList(shape), let(cc := shape{[2..Length(shape)-1]}, op := shape[1].codeletName,
        Concat(
        ConcatList(cc, x->Concat(CodeletName(x), "_", op)), CodeletName(Last(shape)))),

    IsFunc(shape), "GAPFunc",

    Concat("_", String(shape)));

####################################################################################
Compose.codeletNameNo_ := true;
Scat.codeletNameNo_ := true;
fTensor.codeletNameNo_ := true;
Compose.codeletName := "";
fId.codeletName := "I";
fTensor.codeletName := "x";
Diag.codeletName := "D";
RCDiag.codeletName := "RD";
Gath.codeletName:= "G";
Scat.codeletName:= "S";

H.codeletShape     := self >> ObjId(self);
FList.codeletShape := self >> Concatenation([ObjId(self)], self.list);
FData.codeletShape := self >> ObjId(self);
FDataOfs.codeletShape := self >> ObjId(self);
#RCDiag.codeletShape:= self >> ObjId(self);

H.signature     := self >> List(["b", "s"], IntVar);
RM.signature    := self >> List(["N", "phi", "g"], IntVar);
FData.signature := self >> [ var.fresh_t("D", TPtr(self.var.t.t)) ];
FDataOfs.signature := self >> [ var.fresh_t("D", TPtr(self.var.t.t)) ];
FList.signature := self >> [];

FuncClass.codeletParams := self >> self.params{self.codeletParNums};
FuncClass.codeletParNums := [];
FuncClass.mkCodelet := self >> let(sig := self.signature(), ApplyFunc(ObjId(self),
    List([1..Length(self.params)], i -> let(parnums := self.codeletParNums,
    When(i in parnums, sig[Position(parnums,i)], self.params[i])))));
Sym.mkCodelet := FuncClass.mkCodelet;
Sym.codeletParNums := [];

H.codeletParNums    := [3, 4];
RM.codeletParNums   := [1, 3, 4];

FList.codeletParams := self >> [];
FData.codeletParams := self >> [self.var];
FData.mkCodelet := self >> FDataOfs(self.signature()[1], self.domain(), 0);

FDataOfs.codeletParams := self >> When(self.ofs=0, [self.var], [self.var+self.ofs]);
FDataOfs.mkCodelet := self >> FDataOfs(self.signature()[1], self.len, 0);
FList.mkCodelet := self >> self;

#
# Here we set some fields required by libgen for objects defined in transforms.*
# This system will change in the future to require less fields, and be
# more streamlined.
#
# Note: This code fragment depends on transforms. NOTE.
#
DFT.codeletShape := self >> When(self.params[2]=1, [ObjId(self), self.params[1]],
                                  [ObjId(self), self.params[1], self.params[2]]);

BHD.codeletShape := self >> ObjId(self);
BHD.mkCodelet    := self >> self; # NOTE?

Twid.signature  := self >> [ ];
Twid.codeletShape  := self >> [ObjId(self), self.params[1], self.params[2], self.params[3]];
Twid.codeletParams := self >> [];

BH.signature    := self >> List(["R", "b", "s"], IntVar);
BH.codeletShape    := self >> ObjId(self);
BH.codeletParNums  := [2, 4, 5];

RCData.signature  := self >> self.func.signature();
RCData.codeletShape  := self >> [ObjId(self), CodeletShape(self.func)];
RCData.codeletParams := self >> self.func.codeletParams();
RCData.mkCodelet := self >> ObjId(self)(self.func.mkCodelet());

FConj.signature  := self >> self.func.signature();
FConj.codeletShape  := self >> [ObjId(self), CodeletShape(self.func)];
FConj.codeletParams := self >> self.func.codeletParams();
FConj.mkCodelet := self >> ObjId(self)(self.func.mkCodelet());

Typ.signature := self >> [];
Typ.codeletShape := self >> [ObjId(self)];
Typ.codeletParams := self >> [];
Typ.mkCodelet := self >> self;


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

# helps translate VTensorInd(Scat(f), i) -> VScat_sv(f \tensor_i fId(i.range))
_fTensorInd := function(fnc, idx)
    local ds, irng, fdom, nidx, lambda;
    irng := idx.range;

    if not (idx in fnc.free()) then
        return fTensor(fnc, fId(irng));
    fi;

    fdom := fnc.domain();
    nidx := Ind(irng*fdom);

    lambda := Lambda(nidx, imod(nidx, irng)+V(irng)*Lambda(idx, fnc.at(idiv(nidx, irng))).at(imod(nidx, irng))).setRange(V(fnc.range())*V(irng));
    return lambda;
end;

#prevent VRC Rules from introducing VRCL/VRCR in the wrong spot
DontNeedSpecialVRC := e->not ForAny(e.children(), f->IsBound(f.needSpecialVRC) and f.needSpecialVRC());

# Test for VRCs that, for any construct, has a needSeparateVRC set
anyNeedSeparateVRC := e->ForAny(e.children(), f->IsBound(f.needSeparateVRC) and f.needSeparateVRC());

# Test for VRCs that for all constructs, cannot change data formats
TotallyNonChangeable := function(e)
    if ObjId(e)=Compose or ObjId(e)=ComposeDists then
      return(ForAll(e.children(), f->IsBound(f.totallyCannotChangeDataFormat) and f.totallyCannotChangeDataFormat()));
    else
      return(IsBound(e.totallyCannotChangeDataFormat) and e.totallyCannotChangeDataFormat());
    fi;
end;

# Test for VRCs that have at least one construct that cannot change data formats
HasNonchangeable := function(e)
    if ObjId(e)=Compose or ObjId(e)=ComposeDists then
      return(ForAny(e.children(), f->IsBound(f.cannotChangeDataFormat) and f.cannotChangeDataFormat()));
    else
      return(IsBound(e.cannotChangeDataFormat) and e.cannotChangeDataFormat());
    fi;
end;

NoSpecialOrNonchangeableVRC := e->(DontNeedSpecialVRC(e) and not HasNonchangeable(e));
NoSpecialAndChangeableVRC   := e->(DontNeedSpecialVRC(e) and     HasNonchangeable(e));

HandleCannotChangeDataFormatVRC := function(vrc, ch, v)
    local remch, ele, left, right, i, vrc1, vrc2;

    remch := Compose(Drop(ch, 1));
    #Error("BP: cannotChangeDataFormatVRC");

    if vrc=VRC then
        # NOTE: How do we handle this?
        # If ALL children cannot change data format, simply distribute the VRC amongst them

        if TotallyNonChangeable(Compose(ch)) then
            return( Compose(VRC(ch[1], v), VRC(remch,v)) );
        fi;

        # if any of the children NOTE: this is inefficient: what we really
        # should to is to bunch together the children that needSeparateVRC, and
        # the children that are regular, and handle them separately. For now,
        # this hack works because we should have no cases where such children
        # will be mixed together.

        if anyNeedSeparateVRC(Compose(ch)) then
            return( Compose(VRC(ch[1], v), VRC(remch,v)) );
        fi;

        # If not, we must do a VRCR/VRCL split
        # Find the rightmost child that can change dataformats. That and
        # everything right of that becomes a VRCL. Everything left of that is a VRCR.

        # Bad (but good:)) HACK: for things of the form S*A*G, where S and G
        # cannot change data formats, stuff the VRC into A, and hope that A is
        # big enough to handle it.

        if Length(ch)=3 and TotallyNonChangeable(ch[1]) and TotallyNonChangeable(ch[3]) then
          return(Compose( VRC(ch[1], v), VRC(ch[2], v), VRC(ch[3], v) ));
        fi;

        for i in Reversed([1..Length(ch)]) do
          if not TotallyNonChangeable(ch[i]) then
            # We found the rightmost child
            #Error("VRC: BP");
            left  := Compose(List([1..(i-1)], e->ch[e]));
            right := Compose(List([i..Length(ch)], e->ch[e]));
            #Error("VRC: BP");
            return( Compose( VRCR(left, v), VRCL(right, v) ) );
          fi;
        od;

        #Error("BP: cannotChangeDataformatVRC: VRC needs to be split into VRCL/VRCR");
    fi;

    if vrc=VRCLR then
        # This should really be handled as if the cannotChangeDataformat doesn't exist.
        #Error("VRCLR: BP");
        vrc1 := [[VRCL, VRCR], [VRCLR, VRCLR]];
        vrc2 := When(NeedInterleavedRight(ch[1]) or NeedInterleavedLeft(ch[2]), vrc1[1], vrc1[2]);
        #Error("VRCLR: BP");
        return( Compose(vrc2[1](ch[1], v), vrc2[2](Compose(Drop(ch, 1)), v)) );
    fi;

    if vrc=VRCL then
        # Find the first child from the right that is capable of making a
        # format change. We then have 2 cases.

        # Note: we really have 3 cases to be general: VRCL -> (VRCLR, VRCL, VRC)
        # Sometimes, the LR won't exist, and sometimes, the VRC won't exist
        # But it's easier to code if we only always break down to 2 cases

        for i in Reversed([1..Length(ch)]) do
          if not TotallyNonChangeable(ch[i]) then
            # We found the child that will do the dataformat change (VRCL)
            # We now have 2 cases.
            #   Case 1: VRCL -> (VRCL,  VRC)   (found child is not rightmost)
            #   Case 2: VRCL -> (VRCLR, VRCL)  (found child is rightmost)

            if i <> Length(ch) then # Case 1
              left  := Compose(List([1..i],              e->ch[e]));
              right := Compose(List([(i+1)..Length(ch)], e->ch[e]));
              #Error("BP:VRCL1\n, ---------VRCL(left)---------", left, "\n---------VRC(right)--------", right);
              return( Compose( VRCL(left, v), VRC(right, v) ) );
            else                    # Case 2
              left  := Compose(List([1..(i-1)], e->ch[e]));
              right := ch[i];
              #Error("BP:VRCL2\n, ---------VRCLR(left)---------", left, "\n---------VRCL(right)--------", right);
              return( Compose( VRCLR(left, v), VRCL(right, v) ) );
            fi;
          fi;
        od;
        Error("cannotChangeDataFormatVRC/L: Didn't find an appropriate child");
    fi;

    if vrc=VRCR then
        # Find the first child from the left that is capable of making a
        # format change. We then have 2 cases.

        for i in [1..Length(ch)] do
          if not TotallyNonChangeable(ch[i]) then
            # We found the child that will do the dataformat change (VRCR)
            # We now have 2 cases.
            #   Case 1: VRCR -> (VRC,  VRCR)   (found child is not leftmost)
            #   Case 2: VRCR -> (VRCR, VRCLR)  (found child is leftmost)

            if i <> 1 then # Case 1
              left  := Compose(List([1..(i-1)],      e->ch[e]));
              right := Compose(List([i..Length(ch)], e->ch[e]));
              #Error("BP:VRCR1\n, ---------VRC(left)---------", left, "\n---------VRCR(right)--------", right);
              return( Compose( VRC(left, v), VRCR(right, v) ) );
            else                    # Case 2
              left  := ch[i];
              right := Compose(List([(i+1)..Length(ch)], e->ch[e]));
              #Error("BP:VRCR2\n, ---------VRCR(left)---------", left, "\n---------VRCLR(right)--------", right);
              return( Compose( VRCR(left, v), VRCLR(right, v) ) );
            fi;
          fi;
        od;
        Error("cannotChangeDataFormatVRC/R: Didn't find an appropriate child");

    fi;

    Error("cannotChangeDataFormat: I don't know what to do with this one. None of the cases matched.");

#            vrc=VRCL and     HasNonchangeable(ch1) and not HasNonchangeable(ch2), Compose(VRCLR(ch1, v), VRCL(remch, v) ),
#            vrc=VRCL and not HasNonchangeable(ch1) and     HasNonchangeable(ch2), Compose(VRCL(ch1, v),  VRC(remch,v)   ),
#            vrc=VRCL and     HasNonchangeable(ch1) and     HasNonchangeable(ch2),
#                When(NeedInterleavedRight(ch1) or NeedInterleavedLeft(ch2), Compose(VRCL(I(ch1.dims()[1]),v),  VRC(ch,v)),
#                                                                            ComposeVRCLR(ch,v), VRCL(I(ch1.dims()[1]),v)),
#
#            vrc=VRCR and     HasNonchangeable(ch1) and not HasNonchangeable(ch2), Compose(VRC(ch1, v),   VRCR(remch, v) ),
#            vrc=VRCR and not HasNonchangeable(ch1) and     HasNonchangeable(ch2), Compose(VRCR(ch1, v),  VRCLR(remch,v) ),
#            vrc=VRCR and     HasNonchangeable(ch1) and     HasNonchangeable(ch2),
#                When(NeedInterleavedRight(ch1) or NeedInterleavedLeft(ch2), Compose(VRCL(I(ch1.dims()[1]),v),  VRC(ch,v)),
#                                                                            ComposeVRCLR(ch,v), VRCL(I(ch1.dims()[1]),v))
#          )
#        )
#    ),

end;

Scat.needInterleavedLeft:=False;
Scat.needInterleavedRight:=False;

# NOTE: Why were these set to False???
Gath.needInterleavedLeft:=True;
Gath.needInterleavedRight:=True;

VBlk.needInterleavedLeft:=False;
VBlk.needInterleavedRight:=False;

# NOTE: remove Diag here
Diag.needInterleavedLeft:=False;
Diag.needInterleavedRight:=False;

Inplace.needInterleavedRight := self >> self.child(1).needInterleavedRight();
Inplace.needInterleavedLeft := self >> self.child(1).needInterleavedLeft();
Inplace.cannotChangeDataFormat := self >> self.child(1).cannotChangeDataFormat();
Inplace.totallyCannotChangeDataFormat := self >> self.child(1).totallyCannotChangeDataFormat();

BB.needInterleavedRight := self >> self.child(1).needInterleavedRight();
BB.needInterleavedLeft := self >> self.child(1).needInterleavedLeft();
BB.cannotChangeDataFormat := self >> self.child(1).cannotChangeDataFormat();
BB.totallyCannotChangeDataFormat := self >> self.child(1).totallyCannotChangeDataFormat();

VContainer.needInterleavedRight := self >> self.child(1).needInterleavedRight();
VContainer.needInterleavedLeft := self >> self.child(1).needInterleavedLeft();
VContainer.cannotChangeDataFormat := self >> self.child(1).cannotChangeDataFormat();
VContainer.totallyCannotChangeDataFormat := self >> self.child(1).totallyCannotChangeDataFormat();

NoDiagPullin.needInterleavedRight := self >> self.child(1).needInterleavedRight();
NoDiagPullin.needInterleavedLeft := self >> self.child(1).needInterleavedLeft();
NoDiagPullin.cannotChangeDataFormat := self >> self.child(1).cannotChangeDataFormat();
NoDiagPullin.totallyCannotChangeDataFormat := self >> self.child(1).totallyCannotChangeDataFormat();

NoDiagPullinLeft.needInterleavedRight := self >> self.child(1).needInterleavedRight();
NoDiagPullinLeft.needInterleavedLeft := self >> self.child(1).needInterleavedLeft();
NoDiagPullinLeft.cannotChangeDataFormat := self >> self.child(1).cannotChangeDataFormat();
NoDiagPullinLeft.totallyCannotChangeDataFormat := self >> self.child(1).totallyCannotChangeDataFormat();

NoDiagPullinRight.needInterleavedRight := self >> self.child(1).needInterleavedRight();
NoDiagPullinRight.needInterleavedLeft := self >> self.child(1).needInterleavedLeft();
NoDiagPullinRight.cannotChangeDataFormat := self >> self.child(1).cannotChangeDataFormat();
NoDiagPullinRight.totallyCannotChangeDataFormat := self >> self.child(1).totallyCannotChangeDataFormat();

SymSPL.needInterleavedRight := self >> self.child(1).needInterleavedRight();
SymSPL.needInterleavedLeft := self >> self.child(1).needInterleavedLeft();
SymSPL.cannotChangeDataFormat := self >> self.child(1).cannotChangeDataFormat();
SymSPL.totallyCannotChangeDataFormat := self >> self.child(1).totallyCannotChangeDataFormat();

VGath_sv.rcVariant := RCVGath_sv;
VScat_sv.rcVariant := RCVScat_sv;

RCVGath_sv.vecVariant := (f,v)->VGath(f,v);
RCVScat_sv.vecVariant := (f,v)->VScat(f,v);

ScatGath.needInterleavedLeft:=True;
ScatGath.needInterleavedRight:=True;

SMPBarrier.needInterleavedLeft := (self) >> self.child(1).needInterleavedLeft();
SMPBarrier.needInterleavedRight := (self) >> self.child(1).needInterleavedRight();

_VRCFamily := [VRC, VRCL, VRCR, VRCLR];

Class(RulesVRC, RuleSet);
RewriteRules(RulesVRC, rec(
    VRC_VContainer := Rule([@(1, _VRCFamily), @(2, VContainer)],
	e -> let(cont := @(2).val,
	    VContainer(ObjId(@(1).val)(cont.child(1), @(1).val.v), cont.isa))),

    VRC_ISum := Rule([@(1, _VRCFamily), @(2, [ISum, SMPSum, SMPBarrier, SUM])], e->let(s := @(2).val,
    CopyFields(s, rec(_children := List(s.children(), c->ObjId(@(1).val)(c, @(1).val.v)),
                  dimensions := @(1).val.dimensions)))),

    VRC_Container := Rule([@(1, _VRCFamily),  @(2, [BB,Buf,Inplace,RecursStep,NoDiagPullin, NoDiagPullinLeft, NoDiagPullinRight])],
        e -> ObjId(@(2).val)(ObjId(@(1).val)(@(2).val.child(1), @(1).val.v))),

    VRC_Data := Rule([@(1, _VRCFamily), @(2, Data)],
	e -> Data(@(2).val.var, @(2).val.value, ObjId(e)(@(2).val.child(1)))),

#   VRC_SymSPL := Rule([@(1, _VRCFamily), @(2, SymSPL)],
#        e -> ObjId(@(1).val)(@(2).val.child(1), @(1).val.v)),

   VRC_Compose := Rule([@(1, _VRCFamily), @(2, [Compose,ComposeStreams]).cond(NoSpecialOrNonchangeableVRC)], # Use with VRC_ComposeNonchangeable below
        e->let(v := @(1).val.v, ch := @(2).val.children(), vrc := ObjId(@(1).val),
        vrc1 := Cond(
                 vrc=VRC,   [[VRC,  VRC ], [VRCR,  VRCL ]],
                 vrc=VRCLR, [[VRCL, VRCR], [VRCLR, VRCLR]],
                 vrc=VRCL,  [[VRCL, VRC ], [VRCLR, VRCL ]],
                 vrc=VRCR,  [[VRC,  VRCR], [VRCR,  VRCLR]]),
        vrc2 := When(NeedInterleavedRight(ch[1]) or NeedInterleavedLeft(ch[2]), vrc1[1], vrc1[2]),
            Compose(vrc2[1](ch[1], v), vrc2[2](Compose(Drop(ch, 1)), v)))),

    # NOTE: When building the format-change I() below, ch1.dims()[1] is
    #        always used. This is probably incorrect in some cases.
    VRC_ComposeNonchangeable := Rule([@(1, _VRCFamily), @(2, Compose).cond(NoSpecialAndChangeableVRC)],
        e->let(v     := @(1).val.v,
               ch    := @(2).val.children(),
               vrc   := ObjId(@(1).val),
               HandleCannotChangeDataFormatVRC(vrc, ch, v)
        )
    ),

    #VRC_ComposeStreams := Rule([@(1, VRC), @(2, ComposeStreams)],
    #    e->let(v := @(1).val.v, ch := @(2).val.children(),
    #        ComposeStreams( VRC(ch[1], v), VRC(ComposeStreams(Drop(ch,1)), v) )
    #        )
    #),

    VRCLR_VRCDiag:= Rule([@(1, _VRCFamily), @(2, VRCDiag)], e -> ObjId(@(1).val)(@(2).val.toloop().sums(), @(1).val.v)),

    VRCLR_VBlk:= Rule([@(1, VRCLR),@(2, VBlk)], e -> VBlk(RealVMatComplexVMat(@(2).val.element), @(2).val.v)),

    VRCLR_VGath_zero:= Rule([@(1, VRCLR),@(2, VGath_zero)], e -> let(g:=@(2).val,
        VRCLR(VGath(fAdd(g.N, g.n, 0), getV(g)), getV(g)))),

    VRCLR_VGathScat := Rule([@(1, VRCLR), @(2, [VGath, VScat, VScatAcc])],
        e -> ObjId(@(2).val)(fTensor(@(2).val.func, fId(2)), @(2).val.v)),

    VRCLR_GathScat := Rule([@(1, VRCLR), @(2, [Gath, Scat, ScatAcc])],
        e -> ObjId(@(2).val)(fTensor(@(2).val.func, fId(2)))),

    VRC_VGathVScat := Rule([@(1, VRC), @(2, [VGath, VScat, VScatAcc])],
        e -> ObjId(@(2).val)(fTensor(@(2).val.func, fId(2)), @(2).val.v)),

    VRCLR_VGathScat_sv := Rule([@(1, VRCLR), @(2, [VGath_sv, VScat_sv])], e->  # NOTE: acc variant missing
        @(2).val.rcVariant(@(2).val.func, @(2).val.v, @(2).val.sv, @(2).val.rem)),

    VRCLR_VTensor := Rule([@(1, VRCLR), @(2, VTensor)],
        e -> VTensor(RC(@(2).val.child(1)), @(2).val.vlen)),

    VRCLR_Diag := Rule([@(1, VRCLR), @(2, [Diag, VDiag])],
        e -> let(d := @(2).val.element, n := d.domain(), v := @(1).val.v,
            VRCDiag(VData(fCompose(RCData(d), fTensor(fId(n / v), L(2*v, 2))), v), v))),

    VRC_BlockVPerm := Rule([@(1, _VRCFamily), @(2, [BlockVPerm, BlockVPerm2])],
        e->let(bd := @(2).val.child(1), vrc := ObjId(@(1).val),
            BlockVPerm(@2.val.n, @2.val.vlen, vrc(bd, @(1).val.v),
            MatSPL(vrc(@2.val.perm, @1.val.v))))),

    fPrecompute_VData := Rule([VData, [fPrecompute, @(1)], @(2)], e -> fPrecompute(VData(@(1).val, @(2).val))),
    fPrecompute_VDup := Rule([VDup, [fPrecompute, @(1)], @(2)], e -> fPrecompute(VDup(@(1).val, @(2).val))),

    RCVScat_sv__fId := Rule(@(1,RCVScat_sv,e->IsInt(2*e.func.domain()/getV(e)) and ObjId(e.func) = fId),
        e->let(v:=getV(@(1).val), When(Cols(@(1).val)<>2*@(1).val.func.domain(),
            VGath_zero(Cols(@(1).val)/v, 2*@(1).val.func.domain()/v, v), VGath(fId(2*@(1).val.func.domain()/v), v))))
));

Class(RulesVRCTermDiag, RuleSet);
RewriteRules(RulesVRCTermDiag, rec(
    VRCLR_VDiag_x_I := Rule([@(1, VRCLR), @(2, VDiag_x_I)], e->VTensor(RC(Diag(@(2).val.element)), @(2).val.v))
));

Class(RulesVRCTerm, RulesVRCTermDiag);
RewriteRules(RulesVRCTerm, rec(
    VIxL := Rule(VIxL, (e, cx) -> e.implement(cx.opts.vector.isa)),
    VL := Rule(VL, (e, cx) -> e.implement(cx.opts.vector.isa)),
#--
### Rules for SAR -- to be moved and fixed...

    Term_VTensorInd_ScatGath := Rule([@(1, VTensorInd), @(2, ScatGath), @(3)],
        e->ScatGath(_fTensorInd(@(2).val.sfunc, @(3).val), _fTensorInd(@(2).val.gfunc, @(3).val))),

    RC_ScatGath := Rule([@@(1, RC), @(2, ScatGath)], (e,cx)->@(2).val.toloopRCVec(@(2).val.maxBkSize(), Last(cx.VContainer).isa.getV())),
##    VRCLR_ScatGath := Rule([@(1, VRCLR), @(2, ScatGath)], e->@(2).val.toloopRCVec(@(2).val.maxBkSize(), @(1).val.v)),

    RCVGathRCSVcat_sv_fTensor := Rule([@(1, [RCVGath_sv, RCVScat_sv]),
                            [@(2,fTensor), ..., [fId, @(3).cond(e -> Gcd(@(1).val.v/@(1).val.sv, EvalScalar(e)) = @(1).val.v)]]],
     e -> let(v := @(1).val.v, sv := @(1).val.sv,
          n := EvalScalar(@(3).val),   gcd := Gcd(v / sv, n),
          @(1).val.vecVariant(fTensor(DropLast(@(2).val.children(), 1), fId(2*n/gcd)), v))),

#    Id_RCV1 := Rule([@(1,[RCVScat_sv,RCVGath_sv]), @(2,fId,e->(IsValue(e.n) or IsInt(e.n)) and IsInt(EvalScalar(e.n/@(1).val.v)))], e->I(EvalScalar(@(2).val.n))),
#
#    Term__VScat_ScatGath := ARule(Compose, [@(1, VScat), @@(2, ScatGath, (e,cx)->not ForAny(_VRCFamily, i->IsBound(cx.(i.name)) and cx.(i.name) <> []))],
#        e->[@(1).val * @@(2).val.toloopVec(@@(2).val.maxBkSize(), @(1).val.v)]),
#
#    # in the precond of this rule there was a guard on VRCXX, but that was never matching due to an error. so I dont know if it was needed at all...
#    Term__ScatGath := Rule(@@(1, ScatGath, (e,cx)->not ForAny([VTensor, VTensorInd], i->IsBound(cx.(i.name)) and cx.(i.name) <> []) and
#        (IsBound(cx.VContainer) and cx.VContainer <> [])),
#        (e,cx)->@@(1).val.toloopVec(@@(1).val.maxBkSize(), Last(cx.VContainer).isa.getV())),
#
    Term_NeedInterleavedComplex_VRC := Rule([@(1, VRC), @(2, NeedInterleavedComplex)], e->RC(@(2).val.child(1))),
#    Term_NeedInterleavedComplex_RC := Rule([@(1, RC), @(2, NeedInterleavedComplex)], e->DRC(@(2).val.child(1))),
#
#    RC_GathScat_sv_fTensor := Rule([@(1, [VGath_sv, VScat_sv]), [@(2,fTensor), ..., [fId, 2]]],
#        e -> let(v := @(1).val.v, sv := @(1).val.sv,
#            @(1).val.rcVariant(fTensor(DropLast(@(2).val.children(), 1)), v, sv))),
#
    RC_XXX := Rule([@(1, RC), @(2, [VGath, VScat, VScatAcc])], e->ObjId(@(2).val)(fTensor(@(2).val.func, fId(2)), @(2).val.v)),
#    RC_XXX_sv := Rule([@(1, RC), @(2, [VGath_sv, VScat_sv])], e->@(2).val.rcVariant(@(2).val.func, @(2).val.v, @(2).val.sv)),
### end SAR
#--
#   these rules are buggy, as Scat_sv does zero padding.
#    RCVScat_sv_toVScat := Rule(@(1, RCVScat_sv, e->e.sv=1 and e.v=2), e -> VScat(e.func, e.v)),
#    RCVGath_sv_toVGath := Rule(@(1, RCVGath_sv, e->e.sv=1 and e.v=2), e -> VGath(e.func, e.v)),

#-- VPrm_x_I --

    #NOTE: Check if this rule is correct!
    #VRC_VPrm_x_I := Rule([@(1, VRC), @(2, VPrm_x_I)], e->let(p := @(2).val, v := p.v, b := p.dims()[1]/v,
    #    Compose(
    #        Tensor(I(2), VTensor(Prm(p.func), v)).sums().unroll()
    #    ))),

    # YSV: we use NoDiagPullin to prevent diagonals from going into the loops resulting from Tensor(I(2),...)
    #      because in some cases they can't be sucked in completely and one ends up with multiple Scat * Diag * Scat
    #      sequences inside a SUM, which overlap, implying that it is a SUMAcc. However, Spiral does not know
    #      that, and generates invalid code. I don't know of a better way to handle this at the moment.
    VRCLR_VPrm_x_I := Rule([@(1, [VRCLR, VRC]), @(2, VPrm_x_I)], e->let(p := @(2).val, v := p.v, b := p.dims()[1]/v,
        Compose(
            VTensor(Prm(L(2*b, b)), v),
            NoDiagPullin(Tensor(I(2), VTensor(Prm(p.func), v)).sums().unroll()),
            VTensor(Prm(L(2*b, 2)), v)
        ))),

    VRCL_VPrm_x_I := Rule([@(1, VRCL), @(2, VPrm_x_I)], e->let(p := @(2).val, v := p.v, b := p.dims()[1]/v,
        Compose(
            VIxL(b, 2, v),
            VTensor(Prm(L(2*b, b)), v),
            NoDiagPullin(Tensor(I(2), VTensor(Prm(p.func), v)).sums().unroll()),
            VTensor(Prm(L(2*b, 2)), v)
        ))),

    VRCR_VPrm_x_I := Rule([@(1, VRCR), @(2, VPrm_x_I)], e->let(p := @(2).val, v := p.v, b := p.dims()[1]/v,
        Compose(
            VTensor(Prm(L(2*b, b)), v),
            NoDiagPullin(Tensor(I(2), VTensor(Prm(p.func), v)).sums().unroll()),
            VTensor(Prm(L(2*b, 2)), v),
            VIxL(b, v, v)
        ))),

#-- VGath ------------------
    VRCL_VGath := Rule([@(1, VRCL), @(2, VGath)], e->let(v := @(2).val.v,
        Compose(
            VIxL(@(2).val.func.domain(), 2, v),
            VGath(fTensor(@(2).val.func, fId(2)), v)
        ))),

    VRCL_VScat := Rule([@(1, VRCL), @(2, [VScat, VScatAcc])], e->let(v := @(2).val.v,
        Compose(
            ObjId(@(2).val)(fTensor(@(2).val.func, fId(2)), v),
            VIxL(@(2).val.func.domain(), 2, v)
        ))),

    VRCL_VGath_sv := Rule([@(1, VRCL), @(2, VGath_sv)], e->let(v := @(2).val.v, sv := @(2).val.sv,
        Compose(
            VIxL(Rows(@(2).val)/v, 2, v),
            RCVGath_sv(@(2).val.func, v, sv, @(2).val.rem)
        ))),

    VRCL_IxVGath_pc := Rule([@(1, VRCL), @(2, IxVGath_pc)], e -> let(
	g := @(2).val, v := g.v,
        Compose(
            VIxL(g.k * _roundup(g.n, g.v) / v, 2, v),
            IxRCVGath_pc(g.k, g.N, g.n, g.ofs, v)
        ))),

    VRCLR_IxVGath_pc := Rule([@(1, VRCLR), @(2, IxVGath_pc, x->x.N*x.k mod x.v=0)], e -> let(
	g := @(2).val, v := g.v,
        Compose(
            VIxL(g.k * _roundup(g.n, v) / v, 2, v),
            IxRCVGath_pc(g.k, g.N, g.n, g.ofs, v),
            VIxL(g.k * g.N / v, v, v)
        ))),

    VRCL_VStretchGath := Rule([@(1, VRCL), @(2, VStretchGath)], e -> let(
	g := @(2).val,
	v := g.v,
	#XXX  Cond(???,
            Compose(
		VIxL(_roundup(Rows(g), v) / v, 2, v),
		RCVStretchGath(g.func, g.part, v))

	#XXX    VStretchGath(
	#XXX	fCompose(fTensor(fId(g.func.domain()/v), L(2*v, v)), fTensor(g.func, fId(2))),
	#XXX	...,
	#XXX	...)

        )),

    VRCR_VGath_zero:= Rule([@(1, VRCR),@(2, VGath_zero)], e -> let(g:=@(2).val,
        VGath_zero(2*g.N, 2*g.n, g.v) * VIxL(g.N, g.v, g.v))),

#-- VScat ------------------
    VRCR_VScat := Rule([@(1, VRCR), @(2, [VScat, VScatAcc])], e->let(v := @(2).val.v,
        Compose(
            ObjId(@(2).val)(fTensor(@(2).val.func, fId(2)), v),
            VIxL(@(2).val.func.domain(), v, v)
        ))),

    VRCR_VScat_sv := Rule([@(1, VRCR), @(2, VScat_sv)], e->let(v := @(2).val.v, sv := @(2).val.sv, # NOTE: acc variant missing
        Compose(
            RCVScat_sv(@(2).val.func, v, sv, @(2).val.rem),
            VIxL(Cols(@(2).val)/v, v, v)
        ))),

    VRCR_IxVScat_pc := Rule([@(1, VRCR), @(2, IxVScat_pc)], e->let(s:=@(2).val, v := s.v, # NOTE: acc variant missing
        Compose(
            IxRCVScat_pc(s.k, s.N, s.n, s.ofs, v),
            VIxL(s.k*_roundup(s.n, v)/v, v, v)
        ))),

    VRCLR_IxVScat_pc := Rule([@(1, VRCLR), @(2, IxVScat_pc, x->x.N*x.k mod x.v=0)], e -> let(
        s := @(2).val, v := s.v,
        Compose(
            VIxL(s.k * s.N / v, 2, v),
            IxRCVScat_pc(s.k, s.N, s.n, s.ofs, v),
            VIxL(s.k*_roundup(s.n, v)/v, v, v)
        ))),

    VRCR_VStretchScat := Rule([@(1, VRCR), @(2, VStretchScat)], e->let(s:=@(2).val, v := s.v,
        Compose(
            RCVStretchScat(s.func, s.part, v),
            VIxL(_roundup(Cols(s), v)/v, v, v)
        ))),

#----------------------------
    VRCLR_VPerm := Rule([@(1, VRCLR), @(2, VPerm)], e->let(p := @(2).val, v := p.vlen, b := p.dims()[1]/v,
        Compose(
            VTensor(Prm(L(2*b, b)), v),
            Tensor(I(2), p).sums().unroll(),
            VTensor(Prm(L(2*b, 2)), v)
        ))),

    VRCL_VPerm := Rule([@(1, VRCL), @(2, VPerm)], e->let(p := @(2).val, v := p.vlen, b := p.dims()[1]/v,
        Compose(
            VTensor(Prm(L(2*b, b)), v),
            Tensor(I(2), p).sums().unroll(),
            VTensor(Prm(L(2*b, 2)), v),
            VIxL(b, 2, v)
        ))),

    VRCR_VPerm := Rule([@(1, VRCR), @(2, VPerm)], e->let(p := @(2).val, v := p.vlen, b := p.dims()[1]/v,
        Compose(
            VIxL(b, v, v),
            VTensor(Prm(L(2*b, b)), v),
            Tensor(I(2), p).sums().unroll(),
            VTensor(Prm(L(2*b, 2)), v)
        ))),

#----------------------------
    VRCLR_Perm := Rule([@(1, VRCLR), @(2, Prm)], e->let(p := @(2).val, v := getV(@1.val), b := p.dims()[1]/v, n := @(2).val.dims()[2]/v,
        Compose(
            VIxL(n, 2, v),
            RCVScat_sv(fId(p.func.domain()), v, 1),
            RCVGath_sv(p.func, v, 1),
            VIxL(n, v, v)
        ))),

    VRC_Perm := Rule([@(1, VRC), @(2, Prm)], e->let(p := @(2).val, v := getV(@1.val), b := p.dims()[1]/v, n := @(2).val.dims()[2]/v,
            Compose (RCVScat_sv(fId(p.func.domain()), v, 1),
            RCVGath_sv(p.func, v, 1))
        )),

    VRCL_Split := Rule([@(1, VRCL), @(2, [VDiag, VTensor])], e->let(v := getV(@(2).val),
        Compose(
            VRCLR(@(2).val, v),
            VIxL(@(2).val.dims()[2]/v, 2, v)
        ))),

    VRCR_Split := Rule([@(1, VRCR), @(2, [VDiag, VTensor])], e->let(v := getV(@(2).val),
        Compose(
            VIxL(@(2).val.dims()[1]/v, v, v),
            VRCLR(@(2).val, v)
        ))),

    VRC_VTensor := Rule([@(1, VRC), @(2, [VTensor])], e->let(v := getV(@(2).val),
        Compose(
            VIxL(@(2).val.dims()[1]/v, v, v),
            VRCLR(@(2).val, v),
            VIxL(@(2).val.dims()[2]/v, 2, v)
        ))),

    VRC_VDiag := Rule([@(1, VRC), @(2, [VDiag])], e->let(
       v := getV(@(2).val), d := @(2).val.dims()[1],
       Cond(@(2).val.element.isReal(),
	   VDiag(diagTensor(@(2).val.element, fConst(TReal, 2, 1)), @(2).val.v),
	   VIxL(d/v, v, v) * VRCLR(@(2).val, v) * VIxL(d/v, 2, v)))),

    VRC_Blk := Rule([@(1, VRC), @(2, Blk)], e->RC(@(2).val)),

    VRCLR_VScat_zero := Rule([@(1, VRCLR), @(2, VScat_zero)], e->let(s:=@(2).val, VScat_zero(2*s.N, 2*s.n, s.v))),

    VRC_Gath := Rule([@(1, VRC), @(2, Gath)], e->let(g := @(2).val, v := getV(@1.val), b := g.dims()[1]/v, n := @(2).val.dims()[2]/v,
            Compose (VRCLR(VScat_sv(fId(g.func.domain()), v, 1), v),
            VRCLR(VGath_sv(g.func, v, 1), v))
        )),

    FormatPrm_Term := Rule([FormatPrm, @(1)], e -> Prm(@(1).val)),
));

Class(RulesSplitComplex, RuleSet);
RewriteRules(RulesSplitComplex, rec(
    VRCR_IxVScat_pc := ARule(Compose, [[@(1,[Prm, FormatPrm]), @(4,L,e->e.params[2]=2)], [@(2,VRCR), @(3,IxVScat_pc)]],
                e -> let(v:=@(2).val.v, c:=Cols(@(3).val), s:=@(3).val,
                    [IxVScat_pc(2*s.k, s.N, s.n, s.ofs, v), VPrm_x_I(L(2*c/v, 2), v)])),

    VRCL_IxVGath_pc := ARule(Compose, [[@(2,VRCL), @(3,IxVGath_pc)], [@(1,[Prm, FormatPrm]), @(4,L,e->e.params[2]=e.params[1]/2)]],
                e -> let(v:=@(2).val.v, r:=Rows(@(3).val), g:=@(3).val,
                    [VPrm_x_I(L(2*r/v, r/v), v), IxVGath_pc(2*g.k, g.N, g.n, g.ofs, v)])),

    VRCR_VStretchScat := ARule(Compose, [[@(1,[FormatPrm,Prm]), @(4,L,e->e.params[2]=2)], [@(2,VRCR), @(3,VStretchScat)]],
                e -> let(v:=@(2).val.v, c:=Cols(@(3).val), s:=@(3).val,
                    [VStretchScat(fTensor(fId(2), s.func), 2*s.part, v), VPrm_x_I(L(2*c/v, 2), v)])),

    VRCL_VStretchGath := ARule(Compose, [[@(2,VRCL), @(3,VStretchGath)],[@(1,[FormatPrm,Prm]), @(4,L,e->e.params[2]=e.params[1]/2)]],
                e -> let(v:=@(2).val.v, r:=Rows(@(3).val), g:=@(3).val,
                    [VPrm_x_I(L(2*r/v, r/v), v), VStretchGath(fTensor(fId(2), g.func), 2*g.part, v)])),

    VRCR_VScat_sv := ARule(Compose, [[@(1,[FormatPrm,Prm]), @(4,L,e->e.params[2]=2)], [@(2,VRCR), @(3,VScat_sv)]],
                e -> let(v:=@(2).val.v, c:=Cols(@(3).val), s:=@(3).val,
                    [VStretchScat(fTensor(fId(2), s.func), 2, v), VPrm_x_I(L(2*c/v, 2), v)])),

    VRCL_VGath_sv := ARule(Compose, [[@(2,VRCL), @(3,VGath_sv)],[@(1,[FormatPrm,Prm]), @(4,L,e->e.params[2]=e.params[1]/2)]],
                e -> let(v:=@(2).val.v, r:=Rows(@(3).val), g:=@(3).val,
                    [VPrm_x_I(L(2*r/v, r/v), v), VStretchGath(fTensor(fId(2), g.func), 2, v)])),

    VRCR_VScat := ARule(Compose, [[@(1,[Prm, FormatPrm]), @(4,L,e->e.params[2]=2)], [@(2,VRCR), @(3,[VScat, VScatAcc])]],
                e -> let(v:=@(2).val.v, c:=Cols(@(3).val), s:=@(3).val,
                    [ObjId(@(3).val)(fTensor(fId(2), s.func), v), VPrm_x_I(L(2*c/v, 2), v)])),

    VRCL_VGath := ARule(Compose, [[@(2,VRCL), @(3,VGath)],[@(1,[Prm, FormatPrm]), @(4,L,e->e.params[2]=e.params[1]/2)]],
                e -> let(v:=@(2).val.v, r:=Rows(@(3).val), g:=@(3).val,
                    [VPrm_x_I(L(2*r/v, r/v), v), VGath(fTensor(fId(2), g.func), v)])),

    VRCL_VScat := ARule(Compose, [[@(2,VRCL), @(3,[VScat, VScatAcc])],[@(1,Prm), @(4,L,e->e.params[2]=e.params[1]/2)]],
                e -> let(v:=@(2).val.v, r:=Rows(@(3).val), g:=@(3).val,
                    [VPrm_x_I(L(2*r/v, r/v), v), ObjId(@(3).val)(fTensor(fId(2), g.func), v)])),

    VRCR_VTensor1 := ARule(Compose, [[@(1, [FormatPrm, Prm]), @(4,L,e->e.params[2]=2)], [@(2,VRCR), @(3,VTensor)]],
                e -> let(v:=@(2).val.v, c:=Cols(@(3).val), s:=@(3).val,
                    [VPrm_x_I(L(2*c/v, 2), v), VRCLR(s, v)])),

    VRCR_VTensor1a := ARule(Compose, [[@(1, [FormatPrm, Prm]), @(4,L,e->e.params[2]=2)], [@(2,VRC), @(3,VTensor)]],
                e -> let(v:=@(2).val.v, c:=Cols(@(3).val), s:=@(3).val,
                    [VPrm_x_I(L(2*c/v, 2), v), VRCL(s, v)])),

    VRCL_VTensor2 := ARule(Compose, [[@(2,VRCL), @(3,VTensor)],[@(1, [FormatPrm, Prm]), @(4,L,e->e.params[2]=e.params[1]/2)]],
                e -> let(v:=@(2).val.v, c:=Cols(@(3).val), g:=@(3).val,
                    [VRCLR(g,v), VPrm_x_I(L(2*c/v, c/v), v)])),

    VRCL_VTensor2a := ARule(Compose, [[@(2,VRC), @(3,VTensor)],[@(1, [FormatPrm, Prm]), @(4,L,e->e.params[2]=e.params[1]/2)]],
                e -> let(v:=@(2).val.v, r:=Rows(@(3).val), g:=@(3).val,
                    [VRCR(g,v), VPrm_x_I(L(2*r/v, r/v), v)])),

#    VRCLR_VGath_split := Rule([@(1, VRCLR), @(2, VGath_sv)],
#                e -> let(g := @(2).val, v:= g.v, func := g.func, n := func.domain(), N:= func.range(),
#                        VGath_sv(fCompose(fTensor(L(2*N/v,2), fId(v)), fTensor(fId(2), func), fTensor(L(2*n/v,n/v), fId(v))), v, g.sv))),
#
#    VRCLR_VScat_split := Rule([@(1, VRCLR), @(2, VScat_sv)],
#                e -> let(g := @(2).val, v:= g.v, func := g.func, n := func.domain(), N:= func.range(),
#                        VScat_sv(fCompose(fTensor(L(2*N/v,2), fId(v)), fTensor(fId(2), func), fTensor(L(2*n/v,n/v), fId(v))), v, g.sv)))
#
    VGath_FormatPrm := ARule(Compose, [[@(1, VGath), [fTensor, fBase, @(2, fId)]],
            [@(3, FormatPrm), [fTensor, fId, @(4, L, e->IsInt(@(2).val.domain()/e.domain()))]]],
        e->[FormatPrm(fTensor(fId(Rows(@(1).val)/@(4).val.domain()), @(4).val)), @(1).val]),

    FormatPrm_VScat := ARule(Compose, [[@(1, FormatPrm), [fTensor, fId, @(2, L)]],
            [@(3, [VScat, VScatAcc]), [fTensor, fBase, @(4, fId, e->IsInt(e.domain()/@(2).val.domain()))]]],
        e->[@(3).val, FormatPrm(fTensor(fId(Cols(@(3).val)/@(2).val.domain()), @(2).val))]),

    VRCL_VGath_fIdxL := ARule(Compose, [[@(2,VRCL), @(3,VGath)], [@(1,FormatPrm), [@(4,fTensor), fId, @(5, L, e->e.params[1]=2*e.params[2])]]],
        e -> let(v:=@(2).val.v, r:=Rows(@(3).val), g:=@(3).val, [VGath(fTensor(g.func, fId(2)), v)])),

    VRCR_VScat_fIdxL := ARule(Compose, [[@(1, FormatPrm), [@(4,fTensor), fId, @(5, L, e->e.params[2]=2)]], [@(2,VRCR), @(3,[VScat, VScatAcc])]],
        e -> let(v:=@(2).val.v, c:=Cols(@(3).val), s:=@(3).val, [ObjId(@(3).val)(fTensor(s.func, fId(2)), v)]))

));

Class(RulesVBlkInt, RuleSet);
RewriteRules(RulesVBlkInt, rec(
    Merge_RulesVBlkInt_VRC_rt := ARule(Compose, [@(1, VBlkInt), @(2, VRC)],
                e -> let(v1 := @(1).val, v2 := @(2).val, v := v1.v, [ VIxL(Rows(v1)/(2*v), v, v), v1.child(1), VRCL(v2.child(1), v) ])),

    Merge_RulesVBlkInt_VRC_lft := ARule(Compose, [@(2, VRC), @(1, VBlkInt)],
                e -> let(v1 := @(1).val, v2 := @(2).val, v := v1.v, [ VRCR(v2.child(1), v), v1.child(1), VIxL(Rows(v1)/(2*v), 2, v) ])),

    Merge_RulesVBlkInt_vRC_rt := ARule(Compose, [@(1, VBlkInt), @(2, vRC)],
                e -> let(v1 := @(1).val, v := v1.v, [ VIxL(Rows(v1)/(2*v), v, v), v1.child(1), VIxL(Cols(v1)/(2*v), 2, v), @(2).val ])),

    Merge_RulesVBlkInt_vRC_lft := ARule(Compose, [@(2, vRC), @(1, VBlkInt)],
                e -> let(v1 := @(1).val, v := v1.v, [ @(2).val, VIxL(Rows(v1)/(2*v), v, v), v1.child(1), VIxL(Rows(v1)/(2*v), 2, v) ])),
));


#############################################################################
####
##
#W  ace.gi                     ACE Package                   Alexander Hulpke
#W                                                                Greg Gamble
##
##  `Head' file for the GAP interface to the ACE (Advanced Coset Enumerator),
##  by George Havas and Colin Ramsay.  The original interface was written  by
##  Alexander Hulpke and extensively modified by Greg Gamble.
##
#Y  Copyright (C) 2000  Centre for Discrete Mathematics and Computing
#Y                      Department of Information Technology & Electrical Eng.
#Y                      University of Queensland, Australia.
##

#############################################################################
####
##
#V  ACEData . . . . . . . record used by various functions of the ACE package
##
##  The fields of ACEData are:
##
##    "binary"  . . the path of the ACE binary
##    "tmpdir"  . . the path of the temporary directory for ACE i/o files
##    "ni"  . . . . record for a non-interactive process
##    "io"  . . . . list of data records for ACEStart IO Streams
##    "infile"  . . the path of the ACE input file
##    "outfile" . . the path of the ACE output file
##    "version" . . the version of the current ACE binary
##
InstallValue( ACEData,
  rec( binary := ExternalFilename(DirectoriesPackagePrograms("ace"), "ace"),
       tmpdir := DirectoryTemporary(),
       ni     := rec(),
       io     := [] # Initially no ACEStart IO Streams
       )
);
ACEData.infile  := Filename(ACEData.tmpdir, "in");
ACEData.outfile := Filename(ACEData.tmpdir, "out");

PrintTo(ACEData.infile, "\n");
# Fire up ACE with a null input (ACEData.infile contains only a "\n")
# ... to generate a banner (which has ACE's current version)
Exec(Concatenation(ACEData.binary, "<", ACEData.infile, ">", ACEData.outfile));
ACEData.version := StringFile( ACEData.outfile );
ACEData.scratch := PositionSublist(ACEData.version, "ACE") + 4;
ACEData.version := ACEData.version{[ACEData.scratch ..
                                    Position(ACEData.version, ' ',
                                             ACEData.scratch) - 1]};
Unbind(ACEData.scratch); # We don't need ACEData.scratch, anymore.

#############################################################################
##
#I  InfoClass
##
# Set the default level of InfoACE
SetInfoLevel(InfoACE, 1);

#############################################################################
####
##
#V  ACEIgnoreUnknownDefault . . . . . . . . . . . .  the default value of the
##  . . . . . . . . . . . . . . . . . . . . . . . . `aceignoreunknown' option
##
ACEIgnoreUnknownDefault := true;

#############################################################################
####
##  Ensure no zombie ACE processes from interactive (ACEStart)  sessions  are
##  . . . . .  . . . . . . . . . . . .  left lying around when user quits GAP
##
InstallAtExit( ACEQuitAll );

#E  ace.gi . . . . . . . . . . . . . . . . . . . . . . . . . . . .  ends here


BindGlobal("MitM_rnams", ["name", "attributes", "content"]);

# OM elements - known as "omel" in the specification
BindGlobal("MitM_OMel", [ "OMS", "OMV", "OMI", "OMB", "OMSTR", "OMF",
                          "OMA", "OMBIND", "OME", "OMATTR", "OMR"]);

#
# ValidXSD: a collection of functions to check some XML string types
#
BindGlobal("MitM_ValidXSD", rec());

MitM_ValidXSD.Empty := function(str)
    if not IsEmpty(str) then
        return "must be empty";
    fi;
    return true;
end;

MitM_ValidXSD.Text := function(str)
    if '<' in str then
        return "XML strings cannot contain '<'";
    elif Number(str, c -> c = '&') > Number(str, c -> c = ';') then
        return "there is a '&' character without a closing ';'";
    fi;
    # Perhaps we could check some other simple XML things?
    return true;
end;

MitM_ValidXSD.NCName := function(str)
    local result, char;
    result := MitM_ValidXSD.Text(str);
    if result <> true then
        return result;
    elif IsEmpty(str) then
        return "must not be the empty string";
    elif IsDigitChar(str[1]) or str[1] = '-' or str[1] = '.' then
        return "must start with a letter or underscore";
    fi;
    for char in str do
        if not (IsAlphaChar(char) or IsDigitChar(char)
                or char = '_' or char = '-' or char = '.') then
            return Concatenation("must not contain the character \"",
                                 String(char), "\"");
        fi;
    od;
    return true;
end;

# Checking ID uniqueness is difficult, but we may want to do it in the future
MitM_ValidXSD.ID := MitM_ValidXSD.Text;

# Validating URIs is difficult, but we may want to do it in the future
MitM_ValidXSD.AnyURI := MitM_ValidXSD.Text;

MitM_ValidXSD.Base64Binary := function(str)
    local len, nreq, i;
    str := ShallowCopy(str);
    RemoveCharacters(str, " \n\t\r"); # ignore whitespace
    len := Length(str);
    if len mod 4 <> 0 then
        return "must have length divisible by 4";
    fi;
    nreq := 0;
    if str[len] = '=' then
        nreq := 1;
        if str[len - 1] = '=' then
            nreq := 2;
            if not str[len - 2] in "AQgw" then
                return "one of [AQgw] must come before '=='";
            fi;
        elif not str[len - 1] in "AEIMQUYcgkosw048" then
            return "one of [AEIMQUYcgkosw048=] must come before '='";
        fi;
    fi;
    for i in [1 .. len - nreq] do
        if str[i] = '=' then
            return "only 1 or 2 '=' characters allowed, and only at the end";
        elif not (IsAlphaChar(str[i]) or IsDigitChar(str[i])
                  or str[i] = '+' or str[i] = '/') then
            return Concatenation("cannot contain character '", str{[i]}, "'");
        fi;
    od;
    return true;
end;

#
# ValidAttr: each object type's valid attributes,
#            along with functions to check their values
#
BindGlobal("MitM_ValidAttr",
rec(
     OMOBJ := rec(cdbase := MitM_ValidXSD.AnyURI,
                  version := MitM_ValidXSD.Text),
     OMS := rec(name := MitM_ValidXSD.NCName,
                cd := MitM_ValidXSD.NCName,
                cdbase := MitM_ValidXSD.AnyURI),
     OMV := rec(name := MitM_ValidXSD.NCName),
     OMI := rec(),
     OMB := rec(),
     OMSTR := rec(),
     OMF := rec(dec := function(str)
                   if str = "INF" or str = "-INF" or str = "NaN" then
                       return true;
                   elif Float(str) = fail then
                       return Concatenation(str, " is not a valid float");
                   fi;
                   return true;
                end,
                hex := function(str)
                    local valid_chars, char, err;
                    if Length(str) <> 16 then
                        return "must be 16 characters long";
                    fi;
                    valid_chars := "0123456789ABCDEF";
                    for char in str do
                        if not char in valid_chars then
                            err := "contains non-hex character '";
                            Add(err, char);
                            Add(err, ''');
                            if char in "abcdef" then
                                Append(err, " (not capital)");
                            fi;
                            return err;
                        fi;
                    od;
                    return true;
                end),
     OMA := rec(cdbase := MitM_ValidXSD.AnyURI),
     OMBIND := rec(cdbase := MitM_ValidXSD.AnyURI),
     OME := rec(),
     OMATTR := rec(cdbase := MitM_ValidXSD.AnyURI),
     OMR := rec(),
     OMBVAR := rec(),
     OMATP := rec(cdbase := MitM_ValidXSD.AnyURI),
     common := rec(id := MitM_ValidXSD.ID)
));

#
# RequiredAttr: a list of required attributes for each object type
#
BindGlobal("MitM_RequiredAttr",
rec(
     OMOBJ := [],
     OMS := ["cd", "name"],
     OMV := ["name"],
     OMI := [],
     OMB := [],
     OMSTR := [],
     OMF := [],
     OMA := [],
     OMBIND := [],
     OME := [],
     OMATTR := [],
     OMR := [],
     OMBVAR := [],
     OMATP := []
));

#
# ValidCont: a function to check content for each object type
#
BindGlobal("MitM_ValidCont",
rec(
     OMOBJ := function(content)
       if Length(content) <> 1 then
         return "must be precisely one object";
       elif not (MitM_OMRec(content[1]) and MitM_Tag(content[1]) in MitM_OMel) then
         return "must be an OM element";
       fi;
       return MitM_IsValidOMRec(content[1]);
     end,

     OMS := MitM_ValidXSD.Empty,

     OMV := MitM_ValidXSD.Empty,

     OMI := function(content)
         local str, pos, valid_chars;
         if not (Length(content) = 1 and IsString(content[1])) then
             return "must be only a string";
         fi;
         str := ShallowCopy(content[1]);
         RemoveCharacters(str, " \n\t\r"); # ignore whitespace
         pos := 1;
         if str[pos] = '-' then
             Remove(str, 1);
         fi;
         if str[pos] = 'x' then
             Remove(str, 1);
             valid_chars := "0123456789ABCDEF";
         else
             valid_chars := "0123456789";
         fi;
         if ForAny(str, char -> not char in valid_chars) or Length(str) = 0 then
             return Concatenation(content[1], " is not an integer");
         fi;
         return true;
     end,

     OMB := function(content)
         if IsEmpty(content) then
             return true;
         elif not (Length(content) = 1 and IsString(content[1])) then
             return "must be only a string";
         fi;
         return MitM_ValidXSD.Base64Binary(content[1]);
     end,

     OMSTR := function(content)
         if IsEmpty(content) then
             return true;
         elif not (Length(content) = 1 and IsString(content[1])) then
             return "must be only a string";
         fi;
         return MitM_ValidXSD.Text(content[1]);
     end,

     OMF := MitM_ValidXSD.Empty,

     OMA := function(content)
         local item, result;
         if Length(content) = 0 then
             return "must not be empty";
         fi;
         for item in content do
             if not MitM_OMRec(item) then
                 return "must only contain OM elements";
             elif not MitM_Tag(item) in MitM_OMel then
                 return Concatenation("cannot contain ", MitM_Tag(item), " objects");
             fi;
             result := MitM_IsValidOMRec(item);
             if result <> true then
                 return result;
             fi;
         od;
         return true;
     end,

     OMBIND := function(content)
         local item, result;
         if not (Length(content) = 3
                 and ForAll(content, MitM_OMRec)
                 and MitM_Tag(content[1]) in MitM_OMel
                 and MitM_Tag(content[2]) = "OMBVAR"
                 and MitM_Tag(content[3]) in MitM_OMel) then
             return "must be [OM elm, OMBVAR, OM elm] (in that order)";
         fi;
         for item in content do
             result := MitM_IsValidOMRec(item);
             if result <> true then
                 return result;
             fi;
         od;
         return true;
     end,

     OME := function(content) return "not implemented"; end,

     OMATTR := function(content)
         local i, result;
         if Length(content) <> 2 then
             return "must contain precisely two objects";
         elif not (MitM_OMRec(content[1]) and MitM_Tag(content[1]) = "OMATP") then
             return "first object must be OMATP";
         elif not (MitM_OMRec(content[2]) and MitM_Tag(content[2]) in MitM_OMel) then
             return "second object must be an OM element";
         fi;
         for i in [1 .. Length(content)] do
             result := MitM_IsValidOMRec(content[i]);
             if result <> true then
                 return result;
             fi;
         od;
         return true;
     end,

     OMR := function(content) return "not implemented"; end,

     OMBVAR := function(content)
         local item, result;
         if IsEmpty(content) then
             return "must not be empty";
         fi;
         for item in content do
             if not (MitM_OMRec(item) and MitM_Tag(item) = "OMV") then
                 return "must only contain OMV objects";
                 # ... or attvar objects in the full spec
             fi;
             result := MitM_IsValidOMRec(item);
             if result <> true then
                 return result;
             fi;
         od;
         return true;
     end,

     OMATP := function(content)
         local i, result;
         if Length(content) = 0 then
             return "must not be empty";
         elif Length(content) mod 2 <> 0 then
             return "must contain an even number of objects";
         fi;
         for i in [1, 3 .. Length(content) - 1] do
             if not (MitM_OMRec(content[i]) and MitM_Tag(content[i]) = "OMS") then
                 return StringFormatted("item {} must be an OMS object", i);
             elif not (MitM_OMRec(content[i + 1])
                       and MitM_Tag(content[i + 1]) in MitM_OMel) then
                 # TODO: allow OMFOREIGN
                 return StringFormatted("item {} must be an OM element", i + 1);
             fi;
             result := MitM_IsValidOMRec(content[i]);
             if result <> true then
                 return result;
             fi;
             result := MitM_IsValidOMRec(content[i + 1]);
             if result <> true then
                 return result;
             fi;
         od;
         return true;
     end
));

#
# IsValidOMRec: the function we call on an object to check its validity
#
InstallGlobalFunction(MitM_IsValidOMRec,
function(tree)
    local rnam, attr, result;
    # Check that this is a proper object
    if not MitM_OMRec(tree) then
        return "<tree> must be an OM record";
    elif not MitM_Tag(tree) in RecNames(MitM_ValidAttr) then
        return Concatenation(MitM_Tag(tree), " is not a valid OM object name");
    fi;
    for rnam in NamesOfComponents(tree) do
        if not rnam in MitM_rnams then
            return Concatenation("invalid XML: ", rnam, " should not exist");
        fi;
    od;

    # Validate the attributes
    for attr in RecNames(MitM_Attributes(tree)) do
        if attr in RecNames(MitM_ValidAttr.(MitM_Tag(tree))) then
            result := MitM_ValidAttr.(MitM_Tag(tree)).(attr)(MitM_Attributes(tree).(attr));
        elif attr in RecNames(MitM_ValidAttr.common) then
            result := MitM_ValidAttr.common.(attr)(MitM_Attributes(tree).(attr));
        else
            return Concatenation(attr, " is not a valid attribute of ",
                                 MitM_Tag(tree), " objects");
        fi;
        if result <> true then
            return StringFormatted("{} attribute of {} object: {}",
                                   attr, MitM_Tag(tree), result);
        fi;
    od;

    # Check required attributes
    for attr in MitM_RequiredAttr.(MitM_Tag(tree)) do
        if not attr in RecNames(MitM_Attributes(tree)) then
            return Concatenation(MitM_Tag(tree), " objects must have the ",
                                 attr, " attribute");
        fi;
    od;

    # Check antirequisite attributes - just one of these
    if MitM_Tag(tree) = "OMF" then
        if MitM_Attributes(tree) = fail
               or not (IsBound(MitM_Attributes(tree).dec)
                       or IsBound(MitM_Attributes(tree).hex)) then
            return "OMF objects must have either the dec or the hex attribute";
        elif IsBound(MitM_Attributes(tree).dec) and IsBound(MitM_Attributes(tree).hex) then
            return "OMF objects cannot have both the dec and the hex attribute";
        fi;
    fi;

    # Validate the content
    if MitM_Content(tree) <> fail then
        result := MitM_ValidCont.(MitM_Tag(tree))(MitM_Content(tree));
    else
        result := MitM_ValidCont.(MitM_Tag(tree))([]);
    fi;
    if result <> true then
        return Concatenation(MitM_Tag(tree), " contents: ", result);
    fi;
    return true;
end);


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

Class(OLBase, SumsBase, rec(
    isOL := true,
    visitAs := "OLBase",
));

## Multiplication operator
## OLMultiplication(1, n) is I(n)
## OLMultiplication(2, n) is a point-wise multiplication of two vectors of size n
Class(OLMultiplication, RewritableObject, BaseMat, OLBase, rec(
    dims := self >> [self.rChildren()[2], StripList(Replicate(self.rChildren()[1], self.rChildren()[2]))],
));

## OLConjMultiplication(n) is a point-wise multiplication of two vectors of size n where second vector is complex conjugated
##
Class(OLConjMultiplication, RewritableObject, BaseMat, OLBase, rec(
    dims := self >> [self.rChildren()[2], StripList(Replicate(self.rChildren()[1], self.rChildren()[2]))],
));

#F RCOLMultiplication is RC(OLMultiplication(..))
#F
Class(RCOLMultiplication, RewritableObject, BaseMat, OLBase, rec(
    dims := self >> [2*self.rChildren()[2], StripList(Replicate(self.rChildren()[1], 2*self.rChildren()[2]))],
));

## RCOLConjMultiplication(n) is RC(OLConjMultiplication(n))
##
Class(RCOLConjMultiplication, RewritableObject, BaseMat, OLBase, rec(
    dims := self >> [2*self.rChildren()[2], StripList(Replicate(self.rChildren()[1], 2*self.rChildren()[2]))],
));

Class( 2DI, SumsBase, RewritableObject, AttrMixin, rec(
   isSPL := true,
   isIdentity := True,
   advdims := self >> let(a:=self.rChildren(), [[a], [a]]),
   dims := self >> let(a:=Product(self.rChildren()), [a, a]),
   rng := self >> [ TArray(TUnknown, Product(self.rChildren()))],
   dmn := self >> [ TArray(TUnknown, Product(self.rChildren()))],
   children := self >> [],
   arity := ClassSPL.arity,
   updateParams := meth(self)
       self.func := fId(Product(self.params));
       Inherited();
   end,
));

Class(LeftOver, RewritableObject, ClassSPL, rec(
    isSums := true,
    isSPL := true,

    __call__ := (self, cond, spl) >> Cond(
	cond=true, spl,
	cond=false, let(d := spl.dims(), VirtualPad(d[1], d[2], I(0))),
	Inherited(cond, spl)),

    rng := self >> self.params[2].rng(),
    dmn := self >> self.params[2].dmn(),
    dims := self >> [ StripList(List(self.rng(), (l) -> l.size)), StripList(List(self.dmn(), (l) -> l.size)) ],
    advdims := self >> self.params[2].advdims(),

    isInplace := self >> self.params[2].isInplace(),
    transpose := self >> ObjId(self)(self.params[1], self.params[2].transpose()),
    conjTranspose := self >> ObjId(self)(self.params[1], self.params[2].conjTranspose()),

    isReal := self >> self.params[2].isReal(),

    a := rec(),

    print:= arg >> let(
	self := arg[1],
	i := Cond(Length(arg)>=3, arg[2], 0),
	is := Cond(Length(arg)>=3, arg[3], 4),
	Print(self.__name__, "(", self.params[1], "\n",
	    Blanks(i+is), self.params[2].print(i+is, is), "\n", Blanks(i), ")"))
));

Class( OLDup, RewritableObject, BaseMat, OLBase, rec(
    dims := self >> [Replicate(self.params[1], self.params[2]), self.params[2]],
));

# ParSeqWrap is a helper class used dduring codegen stage to ease code generation
#

Class(ParSeqWrap, BaseContainer, rec(
    __call__ := (self, p, ci, y, x) >>
        WithBases(self, rec(p := p, ci := ci, y := y, x := x, dimensions := [p.dimsCompL(p.child(ci)), p.dimsCompR(p.child(ci))])),
    dims := self >> self.dimensions,
    children := self >> [self.p.child(self.ci)],
));

#  ParSeq(<N>, <spl>, <spl>, ...) operator implements simultaneous sequentional (first <N> inputs/outputs) and
#    parallel (all other inputs/outputs) data flow:
#
#        +----+-<- +
#        |    |
#  * <- A <- B <- *
#        |    |
#  + <---+----+
#
# For example: ParSeq(1, Addition(2,1), Addition(2,1), Addition(2,1));
#              Y[0] := X1[0] + X2[0] + X2[0] + X2[0];

Class(ParSeq, SumsBase, BaseOperation, rec(
    area := self >> Sum(self.children(), x->x.area()),
    abbrevs := [ arg -> Checked( Length(arg)>1 and IsPosInt0(arg[1]),
                                 [ arg[1], Flat(Drop(arg, 1)) ] )
               ],

    # filter list leaving elements with positions of Compose inputs/outputs
    filtCompL := (self, lst) >> lst{[1..self.fb_cnt]},
    filtCompR := (self, lst) >> lst{[1..self.fb_cnt]},
    filtSUML  := (self, lst) >> lst{[self.fb_cnt+1..Length(lst)]},
    filtSUMR  := (self, lst) >> lst{[self.fb_cnt+1..Length(lst)]},

    dimsCompL := (self, child) >> self.filtCompL(Flat([self.dims()[1]])),
    dimsCompR := (self, child) >> self.filtCompR(Flat([self.dims()[2]])),
    dimsSUML  := (self, child) >> self.filtSUML(Flat([self.dims()[1]])),
    dimsSUMR  := (self, child) >> self.filtSUMR(Flat([self.dims()[2]])),

    checkDimsCompose := (self) >> let(chdims := List(self._children, c -> [self.dimsCompL(c), self.dimsCompR(c)]),
        DoForAll([1..Length(chdims)-1], i ->
            DoForAll(Zip2(chdims[i][2], chdims[i+1][1]), x->
                When( not(IsSymbolic(x[1]) or IsSymbolic(x[2])) and (x[1] <> x[2]),
                      Error("Dimensions of children ",i," and ",i+1," do not match (",x[1]," <> ",x[2],") in ", self._children), 0)))),

    checkDimsSUM := (self) >> let(
        chdims := TransposedMat(List(self._children, c -> [self.dimsSUML(c), self.dimsSUMR(c)])),
        dims := List(TransposedMat(chdims[1]) :: TransposedMat(chdims[2]), d -> Set(Filtered(d, e -> not IsSymbolic(e)))),
        When(not ForAll(dims, d -> Length(d) in [0,1]),
            Error("Dimensions of summands do not match"), 0)),

    #-----------------------------------------------------------------------
    new := meth(self, fb_cnt, C)
        local dims, obj, a;
        Constraint(Length(C) >= 1); Constraint(ForAll(C, IsSPL));
        a := C[1].arity();
        Constraint(ForAll(C, e -> e.arity()=a));
        Constraint(IsInt(fb_cnt) and fb_cnt>=0 and fb_cnt <= a[1] and fb_cnt <= a[2]);

        if Length(C) = 1 then return C[1]; fi;
        if fb_cnt=a[1] and a[1]=a[2] then return Compose(C); fi;
        if fb_cnt=0 then return SUM(C); fi;

        # check 'Compose' dims
        obj := SPL(WithBases(self, rec( _children := C, fb_cnt := fb_cnt)));
        obj.checkDimsCompose();
        obj.checkDimsSUM();
        return obj.setDims();
    end,

    rng:= self >> self._children[1].rng(),
    dmn:= self >> Last(self._children).dmn(),

    isPermutation := self >> false,

    from_rChildren := (self, rch) >> ApplyFunc(ObjId(self), [self.fb_cnt] :: rch).appendAobj(self),

    print := (self, i, is) >> self._print([self.fb_cnt] :: self.rChildren(), i, is),

));


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

#
# AVX conversion bridges
#

ISA_Bridge.add(Class(CVT_SSE_4x32f_AVX_8x32f, ISA_Bridge_I, rec(
    isa_from    := AVX_8x32f,
    isa_to      := SSE_4x32f(T_Real(32)),
    props       := [],
    code := (self, y, x, opts) >> let( t := var.fresh_t("c", self.isa_from.t),
        decl( [t], chain(
            assign(t, self._x(x,0)),
            assign(self._y(y,0), vextract_4l_8x32f(t, [0])),
            assign(self._y(y,1), vextract_4l_8x32f(t, [1]))
        )))
)));

ISA_Bridge.add(Class(CVT_AVX_8x32f_AVX_4x64f, ISA_Bridge_I, rec(
    isa_from    := AVX_4x64f,
    isa_to      := AVX_8x32f,
    props       := [],
    code := (self, y, x, opts) >>
        assign(self._y(y,0), vpermf128_8x32f(vcvt_8x32f_4x64f(self._x(x,0)), vcvt_8x32f_4x64f(self._x(x,1)), [1,3]))
)));

ISA_Bridge.add(Class(CVT_AVX_4x64f_SSE_4x32f, ISA_Bridge_I, rec(
    isa_from    := SSE_4x32f(T_Real(32)),
    isa_to      := AVX_4x64f,
    props       := [],
    code := (self, y, x, opts) >>
        assign(self._y(y,0), vcvt_4x64f_4x32f(self._x(x,0)))
)));

ISA_Bridge.add(Class(CVT_AVX_8x32f_SSE_4x32i, ISA_Bridge_I, rec(
    isa_from    := SSE_4x32f(T_Int(32)),
    isa_to      := AVX_8x32f,
    props       := [],
    code := (self, y, x, opts) >>
        assign(self._y(y,0), vcvt_8x32f_8x32i(vinsert_4l_8x32f(vinsert_4l_8x32f(self.isa_to.t.zero(), self._x(x,0), [0]), self._x(x,1), [1])))
)));

ISA_Bridge.add(Class(CVT_SSE_4x32i_AVX_8x32f_round, ISA_Bridge_I, rec(
    isa_from    := AVX_8x32f,
    isa_to      := SSE_4x32f(T_Int(32)),
    props       := ["round"],
    code := (self, y, x, opts) >> let( t := var.fresh_t("c", TVect(T_Int(32), 8)),
        decl([t], chain(
            assign(t, vcvt_8x32i_8x32f(self._x(x,0))),
            assign(self._y(y,0), vextract_4l_8x32f(t, [0])),
            assign(self._y(y,1), vextract_4l_8x32f(t, [1]))
        )))
)));

ISA_Bridge.add(Class(CVT_SSE_4x32i_AVX_8x32f_trunc, ISA_Bridge_I, rec(
    isa_from    := AVX_8x32f,
    isa_to      := SSE_4x32f(T_Int(32)),
    props       := ["trunc"],
    code := (self, y, x, opts) >> let( t := var.fresh_t("c", TVect(T_Int(32), 8)),
        decl([t], chain(
            assign(t, vcvtt_8x32i_8x32f(self._x(x,0))),
            assign(self._y(y,0), vextract_4l_8x32f(t, [0])),
            assign(self._y(y,1), vextract_4l_8x32f(t, [1]))
        )))
)));

ISA_Bridge.add(Class(CVT_AVX_4x64f_SSE_4x32i, ISA_Bridge_I, rec(
    isa_from    := SSE_4x32f(T_Int(32)),
    isa_to      := AVX_4x64f,
    props       := [],
    code := (self, y, x, opts) >>
        assign(self._y(y,0), vcvt_4x64f_4x32i(self._x(x,0)))
)));

ISA_Bridge.add(Class(CVT_SSE_4x32i_AVX_4x64f_round, ISA_Bridge_I, rec(
    isa_from    := AVX_4x64f,
    isa_to      := SSE_4x32f(T_Int(32)),
    props       := ["round"],
    code := (self, y, x, opts) >>
        assign(self._y(y,0), vcvt_4x32i_4x64f(self._x(x,0))),
)));

ISA_Bridge.add(Class(CVT_SSE_4x32i_AVX_4x64f_trunc, ISA_Bridge_I, rec(
    isa_from    := AVX_4x64f,
    isa_to      := SSE_4x32f(T_Int(32)),
    props       := ["trunc"],
    code := (self, y, x, opts) >>
        assign(self._y(y,0), vcvtt_4x32i_4x64f(self._x(x,0))),
)));

ISA_Bridge.add(Class(CVT_AVX_8x32f_8x32f_clip32i, ISA_Bridge_I, rec(
    isa_from    := AVX_8x32f,
    isa_to      := AVX_8x32f,
    props       := ["saturation"],
    range       := (self) >> RangeT(self.clip.min, self.clip.max, T_Real(32).range().eps),
    clip        := rec( min := T_Int(32).range().min, max := T_Int(32).range().max ),
    code := (self, y, x, opts) >> assign( self._y(y,0), min(max(self._x(x,0), self.isa_from.t.value(self.clip.min)), self.isa_from.t.value(self.clip.max)) ),
)));

ISA_Bridge.add(Class(CVT_AVX_8x32f_8x32f_clip32ui, CVT_AVX_8x32f_8x32f_clip32i, rec(
    clip        := rec( min := T_UInt(32).range().min, max := T_UInt(32).range().max ),
)));

ISA_Bridge.add(Class(CVT_AVX_8x32f_8x32f_clip16i, CVT_AVX_8x32f_8x32f_clip32i, rec(
    clip        := rec( min := T_Int(16).range().min,  max := T_Int(16).range().max ),
)));

ISA_Bridge.add(Class(CVT_AVX_8x32f_8x32f_clip16ui, CVT_AVX_8x32f_8x32f_clip32i, rec(
    clip        := rec( min := T_UInt(16).range().min, max := T_UInt(16).range().max ),
)));

ISA_Bridge.add(Class(CVT_AVX_8x32f_8x32f_clip8i, CVT_AVX_8x32f_8x32f_clip32i, rec(
    clip        := rec( min := T_Int(8).range().min,  max := T_Int(8).range().max ),
)));

ISA_Bridge.add(Class(CVT_AVX_8x32f_8x32f_clip8ui, CVT_AVX_8x32f_8x32f_clip32i, rec(
    clip        := rec( min := T_UInt(8).range().min, max := T_UInt(8).range().max ),
)));

ISA_Bridge.add(Class(CVT_AVX_4x64f_4x64f_clip32i, ISA_Bridge_I, rec(
    isa_from    := AVX_4x64f,
    isa_to      := AVX_4x64f,
    props       := ["saturation"],
    range       := (self) >> RangeT(self.clip.min, self.clip.max, T_Real(32).range().eps),
    clip        := rec( min := T_Int(32).range().min, max := T_Int(32).range().max ),
    code := (self, y, x, opts) >> assign( self._y(y,0), min(max(self._x(x,0), self.isa_from.t.value(self.clip.min)), self.isa_from.t.value(self.clip.max)) ),
)));

ISA_Bridge.add(Class(CVT_AVX_4x64f_4x64f_clip32ui, CVT_AVX_4x64f_4x64f_clip32i, rec(
    clip        := rec( min := T_UInt(32).range().min, max := T_UInt(32).range().max ),
)));


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

Import(compiler, code, fpgen);

# temporary fix to declare variables used in _mm_loadl_xx/_mm_loadh_xx
CellCompileStrategyVector := Concatenation(
#    [ c -> vref.setNoScalar(c) ], # must be at the begin; otherwise subvector access breaks
    BaseCS,
    [
    BinSplit, CSE,
    # MarkDefUse, FFTWScheduleAssignments, CopyPropagate, <- NOTE: breaks
#    MarkDefUse, DFSChain, # currently not used
    CopyPropagate,
    Compile.declareVars,
    (c,opts) -> opts.vector.isa.fixProblems(c, opts),
    (c, opts) -> ESReduce(c, opts)
#    c -> DeadCodeElim(c),
#    c -> vref.resetNoScalar(c) # must be at the end right before declaring the missing vars!!
    #DeclareVars
]);

CellCompileStrategyVectorFP := (bits, fracbits) -> Concatenation(
    CellCompileStrategyVector,
    [ c -> FixedPointCode(c, bits, fracbits) ]
);


Walk := function(name, op)
	local dir, file, e;
	dir := Directory(name);
	for e in SortedList(DirectoryContents(name)) do
		file := Filename(dir, e);
		if IsDirectoryPath(file) then
			if not (e in [".", ".."]) then
				Walk(file, op);
			fi;
		else
			op(file);
		fi;
	od;
end;

# This will print filenames
Walk(".", Display);


InstallGlobalFunction(MitM_SCSCPServerHandshake,
function(in_stream, out_stream)
    local msg, get, pi, client_versions, versions, version;
    # Send connection initiation message (5.1.1)
    msg := Concatenation("<?scscp service_name=\"{}\" service_version=\"{}\" ",
                         "service_id=\"{}\" scscp_versions=\"{}\" ?>");
    msg := StringFormatted(msg,
                           "gap", "4.10dev", String(IO_getpid()),
                           JoinStringsWithSeparator(MitM_SCSCPVersions, " "));
    WriteLine(out_stream, msg);
    # TODO: we are required to support SCSCP v1.0

    # Version negotiation (5.1.2)
    get := MitM_ReadToPI(in_stream);
    if get.success = false then
        Info(InfoMitMSCSCP, 2,
             "Version negotiation failed: no version request from client");
        return fail;
    fi;
    pi := Concatenation("<", get.pi, ">");
    pi := GetSTag(pi, 2);
    if not IsBound(pi.attributes.version) then
        Info(InfoMitMSCSCP, 2,
             "Version negotiation failed: no version request from client");
        return fail;
    fi;
    client_versions := SplitString(pi.attributes.version, "", " \n\r\t");
    versions := Filtered(client_versions, v -> v in MitM_SCSCPVersions);
    if IsEmpty(versions) then
        Info(InfoMitMSCSCP, 2,
             Concatenation("Version negotiation failed: client requested ",
                           Concatenation(client_versions),
                           ", none of which is supported"));
        WriteLine(out_stream,
                  "<?scscp quit reason=\"not supported version\" ?>");
        return fail;
    fi;
    version := Maximum(versions); # choose the highest lexicographically
    WriteLine(out_stream, Concatenation("<?scscp version=\"",
                                        version, "\" ?>"));
    # Successful handshake, now ready for procedure calls
    return version;
end);

InstallGlobalFunction(MitM_SCSCPClientHandshake,
function(in_stream, out_stream)
    local get, pi, start, finish;
    # Get connection initiation message (5.1.1)
    get := MitM_ReadToPI(in_stream);
    if not get.success then
        Info(InfoMitMSCSCP, 2,
             "Initiation failed: no processing instruction received");
        return false;
    fi;
    # Use XML parser to get at the information
    pi := Concatenation("<", get.pi, ">");
    pi := GetSTag(pi, 2);
    if pi.name <> "scscp" then
        Info(InfoMitMSCSCP, 2,
             "Initiation failed: no SCSCP instruction received");
        return false;
    elif Set(RecNames(pi.attributes)) <> ["scscp_versions",
                                          "service_id",
                                          "service_name",
                                          "service_version"] then
        Info(InfoMitMSCSCP, 2,
             "Initiation failed: bad connection initiation message received");
        return false;
    elif not "1.3" in SplitString(pi.attributes.scscp_versions, "", " ") then
        # TODO: we are required to support SCSCP v1.0
        Info(InfoMitMSCSCP, 2,
             "Initiation failed: server offers no SCSCP version we know");
        return false;
    fi;

    # Version negotiation (5.1.2)
    WriteLine(out_stream, "<?scscp version=\"1.3\" ?>");
    get := MitM_ReadToPI(in_stream);
    if not get.success then
        Info(InfoMitMSCSCP, 2,
             "Version negotiation failed: no valid response from server");
        return false;
    elif PositionSublist(get.pi, "quit") <> fail then
        Info(InfoMitMSCSCP, 2,
             "Version negotiation failed: server quit with following message:");
        start := Position(get.pi, '\"');
        finish := Position(get.pi, '\"', start);
        Info(InfoMitMSCSCP, 2, get.pi{[start..finish]});
        return false;
    fi;
    pi := Concatenation("<", get.pi, ">");
    pi := GetSTag(pi, 2);
    if not IsBound(pi.attributes.version) then
        Info(InfoMitMSCSCP, 2,
             "Version negotiation failed: server sent no version number");
        return false;
    elif pi.attributes.version <> "1.3" then
        Info(InfoMitMSCSCP, 2,
             Concatenation("Version negotiation failed: server chose version ",
                           pi.attributes.version,
                           ", which is not supported"));
        return false;
    fi;

    # Successful handshake, now ready for procedure calls
    return true;
end);

InstallGlobalFunction(MitM_ReadSCSCP,
function(stream)
    local get, pi, r;
    # Get first processing instruction
    get := MitM_ReadToPI(stream);
    # It should be an SCSCP start instruction
    if not get.success then
        return MitM_Error("no processing instruction found");
    fi;
    pi := get.pi;
    pi := SplitString(pi, "", " \n\r\t");
    if pi[1] <> "scscp" or pi[2] <> "start" or Length(pi) > 2 then
        return MitM_Error("no SCSCP start instruction found");
    fi;
    # Read to the end instruction
    get := MitM_ReadToPI(stream);
    if not get.success then
        return MitM_Error("only one processing instruction found");
    fi;
    pi := get.pi;
    pi := SplitString(pi, "", " \n\r\t");
    if pi[1] <> "scscp" or pi[2] <> "end" or Length(pi) > 2 then
        return MitM_Error("no SCSCP end instruction found");
    fi;
    # The in-between stuff should be an OMOBJ
    r := MitM_XMLToOMRec(get.pre);
    if MitM_Tag(r) <> "OMOBJ" then
        return MitM_Error("no OMOBJ object found");
    fi;
    return MitM_Result(r);
end);

InstallGlobalFunction(MitM_ReadToPI,
function(stream)
    local pre, len, char, byte, error, lastchar, pi;
    pre := "";
    len := 0;
    char := fail;
    repeat
        byte := ReadByte(stream);
        if byte = fail then
            return rec(success := false, pre := pre,
                       error := "stream ended before an XML PI was found");
        fi;
        lastchar := char;
        char := CharInt(byte);
        len := len + 1;
        pre[len] := char;
    until lastchar = '<' and char = '?';
    Remove(pre);
    Remove(pre);
    pi := "";
    len := 0;
    repeat
        byte := ReadByte(stream);
        if byte = fail then
            return rec(success := false, pre := pre, pi := pi,
                       error := "stream ended in middle of XML PI");
        elif byte = 60 then
            return rec(success := false, pre := pre, pi := pi,
                       error := "'<' character illegal inside XML PI");
        fi;
        lastchar := char;
        char := CharInt(byte);
        len := len + 1;
        if len > 4092 then # max length 4094 including "<?"
            return rec(success := false, pre := pre, pi := pi,
                       error := "XML PI cannot be longer than 4094 characters");
        fi;
        pi[len] := char;
    until lastchar = '?' and char = '>';
    Remove(pi);
    Remove(pi);
    return rec(success := true, pre := pre, pi := pi);
end);


EW schwarz,1,Projekt		//This line defines the kind of character to be created (EW=cube schwarz=black,1=size?,Projekt is not used)
  T(1,0,0)			//relocaded to (x,y,z)
  T(1,0,0)			//relocated to (x,y,z)
EW schwarz,1,Projekt		//This line defines the kind of character to be created (EW=cube schwarz=black,1=size?,Projekt is not used)
  S(2,2,2)			//redefines size of edges to (x,y,z)