role Perl6::Metamodel::RolePunning {
    # Meta-object we use to make a pun.
    my $pun_meta;

    # Exceptions to the punning. Hash of name to actual object to call on.
    my %exceptions;

    # The pun for the current meta-object.
    has $!pun;

    # Did we make a pun?
    has $!made_pun;

    # Representation to pun to, if any.
    has str $!pun_repr;

    # Configures the punning.
    method configure_punning($my_pun_meta, %my_exceptions) {
        $pun_meta := $my_pun_meta;
        %exceptions := %my_exceptions;
    }

    method set_pun_repr($obj, $repr) {
        $!pun_repr := $repr
    }

    method pun_repr($obj) {
        $!pun_repr
    }

    # Produces the pun.
    method make_pun($obj) {
        my $pun := $!pun_repr
            ?? $pun_meta.new_type(:name(self.name($obj)), :repr($!pun_repr))
            !! $pun_meta.new_type(:name(self.name($obj)));
        $pun.HOW.add_role($pun, $obj);
        $pun.HOW.set_pun_source($pun, $obj);
        $pun.HOW.compose($pun);
        my $why := self.WHY;
        if $why {
            $pun.set_why(self.WHY);
        }
        $pun
    }

    # Returns the pun (only creating it if it wasn't already created)
    method pun($obj) {
        unless $!made_pun {
            $!pun := self.make_pun($obj);
            $!made_pun := 1;
        }
        $!pun
    }

    # Produces something that can be inherited from (the pun).
    method inheritalize($obj) {
        self.pun($obj)
    }

    # Do a pun-based dispatch. If we pun, return a thunk that will delegate.
    method find_method($obj, $name, *%c) {
        if nqp::existskey(%exceptions, $name) {
            return nqp::findmethod(%exceptions{$name}, $name);
        }
        unless $!made_pun {
            $!pun := self.make_pun($obj);
            $!made_pun := 1;
        }
        unless nqp::can($!pun, $name) {
            return nqp::null();
        }
        -> $inv, *@pos, *%named {
            $!pun."$name"(|@pos, |%named)
        }
    }

    method is_method_call_punned($obj, $name) {
        !nqp::existskey(%exceptions, $name)
    }
}

# vim: expandtab sw=4
