Timer.mag

declare type PGGTimer;

declare type PGGTimerStack: PGGTimer;
declare attributes PGGTimerStack: current_label;

declare type PGGTimerBase: PGGTimerStack;
declare attributes PGGTimerBase: last_time, times, counts, labels, idxs;

declare type PGGTimerFork: PGGTimerStack;
declare attributes PGGTimerFork: parent, parent_label;

declare type PGGTimerNull: PGGTimer;

declare verbose PGG_Timer, 2;

intrinsic PGG_Timer() -> PGGTimerBase
  {A new timer.}
  t := New(PGGTimerBase);
  t`last_time := Cputime();
  t`times := [RealField()|];
  t`counts := [Integers()|];
  t`labels := [PowerSequence(Strings())|];
  t`current_label := [Strings()|];
  t`idxs := AssociativeArray(PowerSequence(Strings()));
  return t;
end intrinsic;

NULL := New(PGGTimerNull);

intrinsic PGG_NullTimer() -> PGGTimerNull
  {The null timer.}
  return NULL;
end intrinsic;

intrinsic Fork(t :: PGGTimerStack) -> PGGTimerFork
  {Forks t.}
  t2 := New(PGGTimerFork);
  t2`parent := t;
  t2`parent_label := t`current_label;
  t2`current_label := [Strings()|];
  return t2;
end intrinsic;

intrinsic Fork(t :: PGGTimerNull) -> PGGTimerNull
  {"}
  return NULL;
end intrinsic;

intrinsic FindIndex(t :: PGGTimerBase, label :: [MonStgElt]) -> RngIntElt
  {The index of the given label. If it doesn't exist, creates it first.}
  ok, i := IsDefined(t`idxs, label);
  if ok then
    return i;
  end if;
  Append(~t`times, 0);
  Append(~t`counts, 0);
  Append(~t`labels, label);
  t`idxs[label] := #t`labels;
  return #t`labels;
end intrinsic;

intrinsic Update(t :: PGGTimerBase, c :: RngIntElt, label :: [MonStgElt])
  {Assigns the accumulated time to the given label.}
  now := Cputime();
  ok, i := IsDefined(t`idxs, label);
  if not ok then
    Append(~t`times, 0);
    Append(~t`counts, 0);
    Append(~t`labels, label);
    t`idxs[label] := #t`labels;
    i := #t`labels;
  end if;
  t`times[i] +:= now - t`last_time;
  t`counts[i] +:= c;
  t`last_time := now;
  vprint PGG_Timer: "PGG_Timer", label, c, now;
end intrinsic;

intrinsic Update(t :: PGGTimerFork, c :: RngIntElt, label :: [MonStgElt])
  {"}
  Update(t`parent, c, t`parent_label cat label);
end intrinsic;

intrinsic Update(t :: PGGTimerNull, c :: RngIntElt, label :: [MonStgElt])
  {"}
  return;
end intrinsic;

intrinsic Update(t :: PGGTimer, label :: [MonStgElt])
  {"}
  Update(t, 0, label);
end intrinsic;

intrinsic GetLabel(t :: PGGTimer) -> []
  {Gets the current label.}
  return t`current_label;
end intrinsic;

intrinsic SetLabel(t :: PGGTimer, label :: [MonStgElt])
  {Sets the label.}
  Update(t, t`current_label);
  t`current_label := label;
end intrinsic;

intrinsic Push(t :: PGGTimerBase, x :: MonStgElt)
  {Assings time to the current label, then appends x to the label.}
  Update(t, t`current_label);
  Append(~t`current_label, x);
end intrinsic;

intrinsic Push(t :: PGGTimerNull, x :: MonStgElt)
  {"}
  return;
end intrinsic;

intrinsic Pop(t :: PGGTimerStack, n :: RngIntElt)
  {Assigns time to the current label, then pops n items from the label.}
  error if #t`current_label lt n, "n greater than label length";
  Update(t, 1, t`current_label);
  t`current_label := t`current_label[1..#t`current_label-n];
end intrinsic;

intrinsic Pop(t :: PGGTimerNull, n :: RngIntElt)
  {"}
  return;
end intrinsic;

intrinsic Pop(t :: PGGTimerStack, n :: RngIntElt, x :: MonStgElt)
  {Assigns time to the current label, then pops n items from the label, the nth being x.}
  error if #t`current_label lt n, "n greater than label length";
  error if t`current_label[#t`current_label-n+1] ne x, "incorrect label entry";
  Update(t, 1, t`current_label);
  t`current_label := t`current_label[1..#t`current_label-n];
end intrinsic;

intrinsic Pop(t :: PGGTimerNull, n :: RngIntElt, x :: MonStgElt)
  {"}
  return;
end intrinsic;

intrinsic Pop(t :: PGGTimer, x :: MonStgElt)
  {Assigns time to the current label, then pops the last item from the label, which must be x.}
  Pop(t, 1, x);
end intrinsic;

intrinsic Pop(t :: PGGTimer)
  {Assigns time to the current label, then pops the last item from the label.}
  Pop(t, 1);
end intrinsic;

intrinsic Swap(t :: PGGTimerStack, x :: MonStgElt)
  {Assigns time to the current label, then swaps the last item from the label to x.}
  error if #t`current_label lt 1, "label too short";
  Update(t, 1, t`current_label);
  t`current_label[#t`current_label] := x;
end intrinsic;

intrinsic Swap(t :: PGGTimerNull, x :: MonStgElt)
  {"}
  return;
end intrinsic;

intrinsic Log(t :: PGGTimerStack, x :: MonStgElt)
  {Assigns time to the current label with x appended.}
  Update(t, 1, Append(t`current_label, x));
end intrinsic;

intrinsic Log(t :: PGGTimerNull, x :: MonStgElt)
  {"}
  return;
end intrinsic;

intrinsic Tree(t :: PGGTimerBase : Total:="TOTAL", Other:="OTHER") -> Tup
  {A tree representation of t.}
  procedure insert(~node, label, tm, ct)
    node[2] +:= tm;
    if #label gt 0 then
      for i in [1..#node[4]] do
        if node[4][i][1] eq label[1] then
          insert(~node[4][i], label[2..#label], tm, ct);
          return;
        end if;
      end for;
      Append(~node[4], <label[1], 0.0, 0, [**]>);
      insert(~node[4][#node[4]], label[2..#label], tm, ct);
    else
      node[3] +:= ct;
    end if;
  end procedure;
  procedure rest(~node)
    if #node[4] gt 0 then
      Append(~node[4], <Other, node[2] - &+[n[2] : n in node[4]], 0, [**]>);
      for i in [1..#node[4]] do
        rest(~node[4][i]);
      end for;
    end if;
  end procedure;
  root := <Total, 0.0, 0, [**]>;
  for i in [1..#t`labels] do
    insert(~root, t`labels[i], t`times[i], t`counts[i]);
  end for;
  rest(~root);
  return root;
end intrinsic;

intrinsic PrintTree(t :: PGGTimer)
  {Prints t as a tree.}
  procedure pr(node, depth)
    if node[3] ge 1 or node[2] ge 0.01 then
      printf "%o%6.2o", &cat[Strings() | "  " : i in [1..depth]], node[2];
      if node[3] ne 0 then
        printf " (%o)", node[3];
      end if;
      printf " %o\n", node[1];
      for n in node[4] do
        pr(n, depth+1);
      end for;
    end if;
  end procedure;
  pr(Tree(t), 0);
end intrinsic;