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:

• Moose Cookbook Roles Recipe 3
• my Stackoverflow answer about applying roles on objects