develooper Front page | perl.perl6.users | Postings from October 2018

a necessary no-op

Thread Next
From:
Joseph Brenner
Date:
October 30, 2018 02:36
Subject:
a necessary no-op
Message ID:
CAFfgvXXT=ae7zZOfJwY2b3U-O8PHxC7k-BO2-n+9J5GsxtN7Qw@mail.gmail.com
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();

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About