Rakudo nom backtraces

callframe.pl

class CallTraceInfo {
    has Str $.file;
    has Int $.line;
    has Str $.subname;
    has     $.subtype;

    multi method Str(CallTraceInfo:D:) {
        my $s = $.subname // '<anon>';
        my $what = lc $.subtype.perl;
        "  in $what $s at {$.file}:$.line"
    }
}

class BackTrace is List {
    method new(Int $offset = 1) {
        my $new = self.bless(*);
        my $bt = nqp::atkey(pir::getinterp, 'context').backtrace;
        for $offset .. $bt.elems - 1 {
            next if pir::isnull($bt[$_]<sub>);
            my Mu $p6sub =
                pir::perl6_code_object_from_parrot_sub__PP($bt[$_]<sub>);
            next unless $p6sub.defined;
            next unless $p6sub ~~ Routine;
            my $line     = $bt[$_]<annotations><line>;
            my $file     = $bt[$_]<annotations><file>;
            last if $file eq 'src/stage2/gen/NQPHLL.pm';
            my $subname  = nqp::p6box_s($bt[$_]<sub>);
            $subname = '<anon>' if $subname.substr(0, 6) eq '_block';
            $new.push: CallTraceInfo.new(
                :$line,
                :$file,
                :$subname,
                :subtype($p6sub.WHAT),
            );
        }
        $new;
    }

    multi method Str(BackTrace:D:) {
        self.join("\n") ~ "\n"
    }
}

class Foo {
    method bar() {
         for 1 { # not visisble in the backtrace!
            say BackTrace.new;
        }
    }
}

(sub () { Foo.bar }).();


# vim: ft=perl6 ts=4 sw=4 expandtab

output:

$ ./perl6 callframe.pl
  in method reify at src/gen/CORE.setting:1828
  in method reify at src/gen/CORE.setting:1735
  in method reify at src/gen/CORE.setting:1735
  in method gimme at src/gen/CORE.setting:2062
  in method eager at src/gen/CORE.setting:2038
  in method eager at src/gen/CORE.setting:463
  in sub eager at src/gen/CORE.setting:2178
  in method bar at callframe.pl:46
  in sub <anon> at callframe.pl:52