Using Moose Roles to create Singleton Methods
Randal Schwartz recently posted this bit of Smalltalk code on his Methods and Messages blog
p := 4 @ 3.
p changeClassTo: (p class copy superclass: p class).
p class methodDictionary at: #negated put: (p class methodDictionary at: #transpose).
p negated
My exposure to Smalltalk is limited to a quick look at Seaside web framework which is a bit like learning Rails instead of starting with Ruby 🙂
I can just about grok what this code does. Thankfully Rick DeNatale provided a nice Ruby conversion
Here is Rick’s subset of Smalltalk’s Point which replicates what the first Smalltalk line “p := 4 @ 3.” does:
class Point
attr_accessor :X, :y # :X should be lowercase but WordPress keeps converting it to a smiley!
def initialize(x, y)
@x, @y = x, y
end
def negated
self.class.new(-x, -y)
end
def transpose
self.class.new(y, x)
end
def inspect
"#{@x} @ #{@y}"
end
end
p = Point.new(4,3)
p.negated # => -4 @ -3
p.transpose # => 3 @ 4
So negated & transpose methods return new Point objects so all very straightforward so far.
In the Smalltalk code the object negated method gets amended to use the transpose method instead.
You can do this in Ruby by opening up the objects method like so:
def p.negated transpose end p.negated # => 3 @ 4 p.transpose # => 3 @ 4
Nice eh! The Ruby world refer to this has a Singleton Method. These are methods which are defined in the object and not the class.
I highly recommend watching this excellent video talk by Dave Thomas which provides excellent lucidity to how Ruby objects work.
Now how about Perl? I suspect you can use some MOP meta magic to do same but did you know that Moose Roles can be applied directly to objects?
Here’s is the Ruby Point code in Perl using classic Moose.
{
package Point;
use Moose;
has x => ( isa => 'Int', is => 'rw' );
has y => ( isa => 'Int', is => 'rw' );
sub negated {
my $self = shift;
$self->new( x => -$self->x, y => -$self->y );
}
sub transpose {
my $self = shift;
$self->new( x => $self->y, y => $self->x );
}
sub inspect { say "$_[0]->{x} \@ $_[0]->{y}" }
no Moose;
}
my $p = Point->new( x => 4, y => 3 );
$p->negated->inspect; # => -4 @ -3
$p->transpose->inspect; # => 3 @ 4
So all works same as the Ruby example. Now if we create a role like so:
{
package Negated;
use Moose::Role;
requires 'transpose';
sub negated {
my $self = shift;
$self->transpose;
}
no Moose::Role;
}
You can then “apply” it to any object like so:
Negated->meta->apply( $p ); $p->negated->inspect; # => 3 @ 4 $p->transpose->inspect; # => 3 @ 4
Lovely jubbly!
And as we’ve gone down this Moose Role route we might as well wrap it all up like this:
{
package Point;
use Moose;
with qw/DoesNegated DoesTranspose/;
has x => ( isa => 'Int', is => 'rw' );
has y => ( isa => 'Int', is => 'rw' );
sub inspect { say "$_[0]->{x} \@ $_[0]->{y}" }
no Moose;
}
{
package DoesNegated;
use Moose::Role;
sub negated {
my $self = shift;
$self->new( x => -$self->x, y => -$self->y );
}
no Moose::Role;
}
{
package DoesTranspose;
use Moose::Role;
sub transpose {
my $self = shift;
$self->new( x => $self->y, y => $self->x );
}
no Moose::Role;
}
my $p = Point->new( x => 4, y => 3 );
DoesTranspose->meta->apply( $p, alias => { transpose => 'negated' } );
$p->negated->inspect; # => 3 @ 4
$p->transpose->inspect; # => 3 @ 4
This time I used the “alias” option to rename the applied method on the Moose hoof 😉
And u can keep applying roles to objects at your hearts content adding or replacing methods
as many times as u like.
/I3az/
Some references:
transfixed but not dead! 
your last ‘wrap it all up’ using the ‘alias’ option doesn’t seem to work.
Hi lsm,
It works here fine (and I double checked by pasting it back from blog as well).
Remember that the inspect method uses
sayso you will need to have that loaded either by:use 5.010;or if instead you’re using an older perl:
use Perl6::Say;Alternatively just change that inspect method to use print:
sub inspect { print "$_[0]->{x} \@ $_[0]->{y}\n" };If the problem is something else then let me know.
/I3az/
The problem is something else. I’m running 5.10.1, I use feature (say) which works.
In the earlier blocks of code, culminating with
I get the values indicated in the comments
But in the final “wrap it all up” block after
DoesTranspose->meta->apply( $p, alias => { transpose => 'negated' } );the calls to
I don’t get the values in the comments, but instead the same values as before the
In other words,
DoesTranspose->meta->apply( $p, alias => { transpose => 'negated' } );does not have the expected impact on subsequent calls to the object methods.
I’m running Moose 1.01, perl 5.10.1. I hope this clarification helps.
Hi lsm,
Also on 5.10.1. However I’m on Moose 0.94.
Looking thru the Moose changelogs (http://cpansearch.perl.org/src/FLORA/Moose-1.01/Changes) I see that at 0.89 it mentions:
Rename alias and excludes to -alias and -excludes (but keep the old names for now, for backcompat) (doy)
So it looks like the “backcompat” was probably dropped after 0.94 (probably at 1.00). So code should now be:
DoesTranspose->meta->apply( $p, -alias => { transpose => 'negated' } );Thanks for the heads up. If you didn’t get any warnings then I’d better check all my code carefully when I do upgrade to 1.00 !!
/I3az/
I already tried that variation, aware of the change of syntax.
Still doesn’t work.
Could be a bug then? Or something as changed when applying roles to instances? (I’m a bit behind on the Moose mailing list at moment so its possible).
Its going to be a couple of weeks before I get time to test stuff on Moose 1.01 here. In meantime you could pass this by the Moose IRC or mailing list.
/I3az/
doy @ moose IRC says it’s a moose bug which arose in some recent refactoring.
http://github.com/nothingmuch/moose/commit/f315aab389b68172c5139d3f270e2a1e13930ea8
fix is in, and your example above is now entered as a moose test.
coutesy of doy (Jesse Leuhrs).
http://github.com/nothingmuch/moose/commit/f315aab389b68172c5139d3f270e2a1e13930ea8
fix is in, and your code entered as a test case, courtesy of doy (Jesse Leuhrs)
Excellent stuff lsm (& doy). Look forward to upgrading to 1.02 in a couple of weeks.
/I3az/
PS. The comments threading on this post seem to have gone a bit out of kilter!? Sorry about that it looks to be a WordPress and/or theme funny.