Skip to content

Using Moose Roles to create Singleton Methods

June 3, 2009

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:

About these ads
12 Comments leave one →
  1. lsm permalink
    April 7, 2010 8:54 pm

    your last ‘wrap it all up’ using the ‘alias’ option doesn’t seem to work.

    • April 8, 2010 7:33 am

      Hi lsm,

      It works here fine (and I double checked by pasting it back from blog as well).

      Remember that the inspect method uses say so 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/

      • lsm permalink
        April 8, 2010 4:40 pm

        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

        Negated->meta->apply( $p );

        I get the values indicated in the comments

        $p->negated->inspect;     # => 3 @ 4
        $p->transpose->inspect;   # => 3 @ 4

        But in the final "wrap it all up" block after

        DoesTranspose->meta->apply( $p, alias => { transpose => 'negated' } );

        the calls to

        $p->negated->inspect;     # => 3 @ 4
        $p->transpose->inspect;   # => 3 @ 4

        I don't get the values in the comments, but instead the same values as before the

        -4 @ -3
        3 @ 4

        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.

      • April 8, 2010 7:45 pm

        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/

      • lsm permalink
        April 8, 2010 8:03 pm

        I already tried that variation, aware of the change of syntax.

        Still doesn’t work.

      • April 8, 2010 8:44 pm

        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/

      • lsm permalink
        April 8, 2010 11:20 pm

        doy @ moose IRC says it’s a moose bug which arose in some recent refactoring.

  2. lsm permalink
    April 8, 2010 11:56 pm

    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).

  3. lsm permalink
    April 8, 2010 11:57 pm

    http://github.com/nothingmuch/moose/commit/f315aab389b68172c5139d3f270e2a1e13930ea8

    fix is in, and your code entered as a test case, courtesy of doy (Jesse Leuhrs)

    • April 9, 2010 2:52 pm

      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.

Trackbacks

  1. Roles, Singleton Methods & MooseX::Declare « transfixed but not dead!
  2. Moose fairy dust « transfixed but not dead!

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

%d bloggers like this: