view release on metacpan or  search on metacpan

lib/LaTeXML/Core/Definition.pm  view on Meta::CPAN

#======================================================================
# Overriding methods
sub stringify {
  my ($self) = @_;
  my $type = ref $self;
  $type =~ s/^LaTeXML:://;
  my $name = ($$self{alias} || $$self{cs}->getCSName);
  return $type . '[' . ($$self{parameters}
    ? $name . ' ' . Stringify($$self{parameters}) : $name) . ']'; }

sub toString {
  my ($self) = @_;
  return ($$self{parameters}
    ? ToString($$self{cs}) . ' ' . ToString($$self{parameters}) : ToString($$self{cs})); }

#======================================================================
# Tracing support
sub tracingCSName {
  my ($self) = @_;
  my $parameters = $$self{parameters};
  return ToString($self->getCSName)
    # Show parameter string too
    . ($parameters ? ' ' . ToString($parameters) : '')
    # And if this was \let to something show the name it was called by
    . ($LaTeXML::CURRENT_TOKEN && !$$self{cs}->equals($LaTeXML::CURRENT_TOKEN)
    ? ' [for ' . ToString($LaTeXML::CURRENT_TOKEN) . ']' : ''); }

sub tracingArgs {
  my ($self, @args) = @_;
  my $i = 1;
  return join("\n", map { '#' . $i++ . '<-' . tracingArgToString($_) } @args); }

# Annoying special handing of registers
sub tracingArgToString {
  my ($arg) = @_;
  return (ref $arg eq 'ARRAY' ? '[' . join(',', map { ToString($_) } @$arg) . ']' : ToString($arg)); }

#======================================================================
# Profiling support
#======================================================================
# If the value PROFILING is true, we'll collect some primitive profiling info.

# Start profiling $CS (typically $LaTeXML::CURRENT_TOKEN)
# Call from within ->invoke.
# $mode = expand | digest | absorb
sub startProfiling {
  my ($cs, $mode) = @_;
  my $name  = $cs->getCSName;
  my $entry = $STATE->lookupMapping('runtime_profile', $name);
  # [#calls, max_depth, inclusive_time, exclusive_time, #pending
  #   starts of pending calls...]
  if (!defined $entry) {
    $entry = [0, 0, 0, 0, 0]; $STATE->assignMapping('runtime_profile', $name, $entry); }
  $$entry[0]++ unless $mode eq 'absorb';    # One more call.
  $$entry[4]++;                             # One more pending...
                                            #Debug("START PROFILE $mode of ".ToString($cs));
  $STATE->pushValue('runtime_stack', [$name, $mode, [Time::HiRes::gettimeofday], $entry]);
  return; }

# Stop profiling $CS.
# Complication w/Macros: If the expansion of a macro contains CS's that read tokens,
# the end MARKER of macros may get read before the macro's effects have really been processed.
# So we need to ignore a stop on a macro that isn't at the top of the stack,
# and conversely, automatically stop a macro that is at the top above a CS that is being stopped.
sub stopProfiling {
  my ($cs, $mode) = @_;
  $cs = $cs->getString if $cs->getCatcode == CC_MARKER;    # Special case for macros!!
  return unless ref $cs;
  my $name      = $cs->getCSName;
  my $stack     = $STATE->lookupValue('runtime_stack');
  my $currdepth = scalar(@$stack);
  my $prevdepth = $STATE->lookupValue('runtime_maxdepth') || '0';
  $STATE->assignValue('runtime_maxdepth' => $currdepth, 'global') if $currdepth > $prevdepth;

  while (@{$stack}) {
    my ($top, $topmode, $t0, $entry) = @{ $$stack[-1] };
    if ((($top ne $name) || ($topmode ne $mode)) && ($topmode ne 'expand')) {
      return if $mode eq 'expand';    # No error (yet) if this is a macro end marker.
      Debug("PROFILE Error: ending $mode of $name but stack holds "
          . join(',', map { $$_[0] . '(' . $$_[1] . ')' } @$stack) . ", $top ($topmode)");
      return; }
    pop(@$stack);
    my $duration = Time::HiRes::tv_interval($t0, [Time::HiRes::gettimeofday]);
    my $depth    = $$entry[4];
    if ($depth > $$entry[1]) {
      $$entry[1] = $depth; }
    $$entry[2] += $duration if $depth == 1;    # add to inclusive time only in uppermost call
    $$entry[3] += $duration;                   # add to exclusive time (see below)
    $$entry[4]--;
    if (my $caller = $$stack[-1]) {
      my ($callername, $callermode, $callerstart, $callerentry) = @$caller;
      $$callerentry[3] -= $duration; }         # Remove our cost from caller's exclusive time.
    return if $top eq $name; }
  Debug("PROFILE Error: ending $mode of $name but stack is empty")
    unless $mode eq 'expand';
  return; }

our $MAX_PROFILE_ENTRIES = 30;    # [CONSTANT]

# Print out profiling information, if any was collected
sub showProfile {
  if (my $profile = $STATE->lookupValue('runtime_profile')) {
    my @cs    = keys %$profile;
    my $calls = 0;
    map { $calls += $$profile{$_}[0] } @cs;
    my $depth    = $STATE->lookupValue('runtime_maxdepth');
    my @frequent = sort { $$profile{$b}[0] <=> $$profile{$a}[0] } @cs;
    @frequent = @frequent[0 .. $MAX_PROFILE_ENTRIES];
    my @deepest = sort { $$profile{$b}[1] <=> $$profile{$a}[1] } @cs;
    @deepest = @deepest[0 .. $MAX_PROFILE_ENTRIES];
    my @inclusive = sort { $$profile{$b}[2] <=> $$profile{$a}[2] } @cs;
    @inclusive = @inclusive[0 .. $MAX_PROFILE_ENTRIES];
    my @exclusive = sort { $$profile{$b}[3] <=> $$profile{$a}[3] } @cs;
    @exclusive = @exclusive[0 .. $MAX_PROFILE_ENTRIES];
    Debug("Profiling results:");
    Debug("Total calls: $calls; Maximum depth: $depth");
    Debug("Most frequent:\n   "
        . join(', ', map { $_ . ':' . $$profile{$_}[0] } @frequent));
    Debug("Deepest :\n   "
        . join(', ', map { $_ . ':' . $$profile{$_}[1] } @deepest));
    Debug("Most expensive inclusive:\n   "