A fix for Method::Also?

aliasable.md

This works and is tested!

unit module Aliasable;

my %aliases;
my %aliases-composed;

role AliasableClassHOW {

  method compose (Mu \o, :$compiler_services) is hidden-from-backtrace {
    o.^add_method(.key, .value) for %aliases{o.^name}[];
    nextsame;
  }

}

role AliasableRoleHOW {

  method specialize(Mu \r, Mu:U \obj, *@pos_args, *%named_args)
    is hidden-from-backtrace
  {

    obj.HOW does AliasableClassHOW unless obj.HOW ~~ AliasableClassHOW;

    my $*TYPE-ENV;
    my $r := callsame;
    note "*** Post-Specializing role {r.^name} on {obj.WHO}";
    unless %aliases-composed{r.^name} {
      for %aliases{r.^name}[] -> $p {
        next unless $p.value.is_dispatcher;
        say "Adding candidates for {$p.key}...";

        obj.^add_method($p.key, $p.value);
        for r.^multi_methods_to_incorporate {
          say "\tAdding multi {.code.signature.perl} ...";
          obj.^add_multi_method(
            $p.key,
            .code.instantiate_generic($*TYPE-ENV)
          );
        }
      }
      %aliases-composed{r.^name} = True;
    }
    $r;
  }

  method specialize_with (Mu \obj, Mu \type_env, @pos_args) {
    $*TYPE-ENV := type_env;
    nextsame;
  }

}

multi sub trait_mod:<is>(Method:D \meth, :$also!) is export {
    if $*PACKAGE.HOW ~~ Metamodel::ClassHOW {
      $*PACKAGE.HOW does AliasableClassHOW
        unless $*PACKAGE.HOW ~~ AliasableClassHOW
    }

    if $*PACKAGE.HOW ~~ Metamodel::ParametricRoleHOW {
      $*PACKAGE.HOW does AliasableRoleHOW
        unless $*PACKAGE.HOW does AliasableRoleHOW
    }

    if $also {
        if $also ~~ List {
            %aliases{$*PACKAGE.^name}.push: Pair.new(.Str, meth) for @$also;
        }
        else {
            %aliases{$*PACKAGE.^name}.push: Pair.new($also.Str, meth);
        }
    }
}

Test code:

use lib '.';

use test_how; 

role A {
  proto method this_is_also_aliasable (|)
    is also<this-is-also-aliasable>
  { * }

  multi method this_is_also_aliasable (Str $a) {
    say 'Str';
  }

  multi method this_is_also_aliasable (Int $b) {
    say 'Int';
  }
}

class AA does A {
  proto method this_is_aliasable (|)
    is also<this-is-aliasable>
  { * }

  multi method this_is_aliasable (Str $a) {
    say 'Str';
  }

  multi method this_is_aliasable (Int $b) {
    say 'Int';
  }
}

AA.HOW.^mro.say;
AA.^roles.say;

AA.new.this_is_aliasable('Hi');
AA.new.this_is_aliasable(1);
AA.new.this-is-aliasable('Hi');
AA.new.this-is-aliasable(1);
AA.new.this_is_also_aliasable('Hi');
AA.new.this_is_also_aliasable(1);
AA.new.this-is-also-aliasable('Hi');
AA.new.this-is-also-aliasable(1);

Output:

*** Post-Specializing role A on AA
Adding candidates for this-is-also-aliasable...
        Adding multi :($?CLASS: Str $a, *%_) ...
        Adding multi :($?CLASS: Int $b, *%_) ...
((AliasableClassHOW}) (ClassHOW) (Any) (Mu))
((A))
Str
Int
Str
Int
Str
Int
Str
Int