I've got a weird one here... a line that looks like it does
nothing significant is needed for the code to work.
If the line below marked "The Mystery Line" is commented out,
you just get the error:
===SORRY!===
Cannot look up attributes in a VMNull type object
Augment::Util:
class Recomposer {
method recompose_core {
my @type_symbols = (|CORE::).grep({ .key eq .value.^name
}).map( *.value );
for @type_symbols -> $type_symbol {
my $type_symbol_name = $type_symbol.^name;
try {
my $nada = $type_symbol.gist; # The Mystery Line
$type_symbol.^compose;
# if there's no ^.compose method, just skip to next
type symbol object
CATCH {
default { }
}
}
}
}
}
The problem seems to be local to that "recompose_core" routine,
though just to be complete I'll tack on the rest of my code...
sorry about the length, it's hard to strip it down much further
than this.
The goal here is to be able to start the repl with the command:
perl6 -Mmethod-menu
And have a new method (something like .^methods) named simply .m
available everywhere.
method-menu:
use Object::Examine;
use Augment::Util;
use MONKEY-TYPING;
augment class Any does Introspector {
method m {
return self.menu;
}
Recomposer.recompose_core();
}
Object::Examine:
role Introspector {
method menu {
my @seen_methods = ();
my @levels = self.^mro; # better than ^parents: current class and above
my $report = '';
my @data;
for @levels -> $l {
my $level_name = $l.^name;
my @current_methods = clean_methods( methods_for( $l ) );
my @child_methods = ( @current_methods (-) @seen_methods ).keys;
# saving up the data...
for @child_methods -> $cm {
@data.push([$cm, $level_name]);
}
@seen_methods = ( @seen_methods (+) @current_methods ).keys;
}
my @lines = @data.sort({ $_[0] });
for @lines -> $l {
my $fmt = "%-25s %-25s\n";
$report ~= sprintf $fmt, $l[0], $l[1];
}
return $report;
}
sub methods_for(Mu $obj) {
my @raws = $obj.^methods(:local); # or :all?
}
sub clean_methods (@raws) {
my @strs = @raws.map({ .gist });
my @ways = @strs.sort;
my @unis = @ways.unique;
# filter out methods 'Method+{is-nodal}.new' and 'menu'
my @trim = @unis.grep({ ! /^ Method\+\{is\-nodal\}\.new /
}).grep({ ! / ^ (menu) \s* $ / });
}
}
01-method-menu.t:
use v6;
use Test;
use method-menu;
my $test_case = "'use method-menu;' and the 'm' method";
subtest {
my $report1 = (Array).m;
my @report1 = $report1.lines;
my $l1 = @report1.elems; # 203
cmp-ok($l1, '>', 24, "report1 shows over 24 methods: $l1");
}, $test_case;
done-testing();
