#!/usr/bin/perl

use strict;
use warnings;
use feature qw( switch );
no if $] >= 5.017011, warnings => 'experimental::smartmatch';

use Devel::MAT;

my $pmat = Devel::MAT->load( $ARGV[0] // die "Need dumpfile\n" );

my $df = $pmat->dumpfile;

sub stringify
{
   my ( $sv ) = @_;

   if( $sv->type eq "SCALAR" ) {
      if( defined $sv->pv ) {
         my $str = substr $sv->pv, 0, 32;
         $str =~ s/'/\\'/g;
         return qq('$str') . ( $sv->pvlen > 32 ? "..." : "" );
      }
      else {
         return $sv->nv // $sv->uv // "undef";
      }
   }
   elsif( $sv->type eq "REF" ) {
      return "REF => " . stringify( $sv->rv );
   }
   elsif( $sv->blessed ) {
      return sprintf "%s=%s(0x%x)", $sv->blessed->stashname, $sv->type, $sv->addr;
   }
   else {
      return sprintf "%s(0x%x)", $sv->type, $sv->addr;
   }
}

foreach my $ctx ( $df->contexts ) {
   print $ctx->location . ": ";

   my @more;

   given( $ctx->type ) {
      when( "SUB" ) {
         my $cv = $ctx->cv;
         print $cv->name;

         my $args = $ctx->args or break;
         my @args = $args->elems;

         push @more, "\$_[$_]: " . stringify( $args[$_] ) for 0 .. $#args;

         my $self_padix = $cv->padix_from_padname( '$self' )
            or break;

         ( my $depth = $ctx->depth ) > -1 or break;

         my $pad = $cv->pad( $depth );

         if( my $self_sv = $pad->elem( $self_padix ) ) {
            push @more, "\$self: " . stringify( $self_sv );
         }
         else {
            push @more, "no \$self";
         }
      }
      when( "TRY" ) {
         print "eval {...}";
      }
      when( "EVAL" ) {
         my $code = substr $ctx->code->pv, 0, 32;
         $code =~ s/\n.*//;
         print 'eval ("' . $code . '"...)';
      }
   }

   printf " => %s\n", $ctx->gimme;
   print "  $_\n" for @more;
}