Junctions, Overloading, and Yesterday's Post

Ovid on 2008-06-13T08:14:35

The Problem

In yesterday's "guess why this works" post, I mentioned the following snippet:

foreach my $method (@methods) {
    no strict 'refs';
    *$method = sub { shift->$method(@_) };
}

I'm using this to get around documented core behavior, but no one guessed exactly what was going on (I think this is a first).

Ben Tilly's Suggestion

Both Ben Tilly and Chris Dolan replied with reasonable answers (Chris's answer is close to what I thought is going on, but not quite there). Ben pointed out this:

$object->Foo::bar(@args);

# later

package Foo;

sub bar {
    my $self = shift;
    $self->bar(@_);
}

That can avoid recursion if $object is blessed into a subclass of Foo and Foo is saying "no, I really do want the subclass to handle this". Under the hood, this might might be what's going on, but I'm not sure.

Chris Dolan's Suggestion

Chris Dolan mentioned that it might be a case of print($object, @args) or any other built-in that I might want the object itself to handle. While this is close, it exposes the more general (and annoying problem) of people sometimes doing this:

some_method( $object, @args );

If you have a flat hierarchy (i.e., no inheritance) and have your class declared as final (i.e., you can never subclass from it), then this function call behaves pretty darned similarly to a method call, but it breaks inheritance terribly. I think that's what is happening under the hood, but the docs are vague (or maybe I'm just too slow to understand them. Wouldn't be the first time).

What's Really Going On

In the "Inheritance and overloading" section of the "overload" documentation, we find the following confusing explanation:

Any class derived from an overloaded class is also overloaded. The set of overloaded methods is the union of overloaded methods of all the ancestors. If some method is overloaded in several ancestor, then which description will be used is decided by the usual inheritance rules:

If "A" inherits from "B" and "C" (in this order), "B" overloads "+" with "\&D::plus_sub", and "C" overloads "+" by "plus_meth", then the subroutine "D::plus_sub" will be called to implement operation "+" for an object in package "A".

In other words, if Child inherits from Parent and Parent uses overloading, Child will also overload the same operators as Parent. However, you can't override the methods! The appropriate overriding subroutine will be searched for (in the same order as inheritance normally follows) and that subroutine is called directly.

What this means is that the following fails:

#!/usr/bin/env perl

use strict;

{
    package Some::Base;
    use overload '==' => \&num_eq, fallback => 1;

    sub new    { bless {} => shift }
}
{
    package Some::Child;

    our @ISA = 'Some::Base';
    sub num_eq { print "object is $_[0]\n"; }
}

Some::Child->new == 2;

Superficially it looks fine, but since num_eq is not actually defined in Some::Base, you'll fail with an "Undefined subroutine &Some::Base::num_eq" error. This really perplexed me at first because I could clearly see that I had provided that method. One simple fix is to add the following to the parent class:

sub num_eq { shift->num_eq(@_) }

So how did I stumble on this? Well, Perl6::Junction is a fantastic module, but I had a serious problem. I needed to be able to create new junctions based on the value of old junctions, but with some elements removed. These junctions have no means to return their values, so I had no way of creating new junctions. Fine, I thought. I'll just submit a patch.

In opening up the code, I saw four different packages with identical constructors, identical interfaces and each beginning with this:

use overload(
    '=='   => \&num_eq,
    '!='   => \&num_ne,
    '>='   => \&num_ge,
    '>'    => \&num_gt,
    '<='   => \&num_le,
    '<'    => \&num_lt,
    'eq'   => \&str_eq,
    'ne'   => \&str_ne,
    'ge'   => \&str_ge,
    'gt'   => \&str_gt,
    'le'   => \&str_le,
    'lt'   => \&str_lt,
    'bool' => \&bool,
    '""'   => sub {shift},
);

Ack! This won't do! I need to refactor the overloading and constructors into a base class. That's when I discovered why the author duplicated this code rather than create a base class: it's confusing as hell.

I pushed the overloading code into a base class, removed it from the junction classes, had them inherit and then included this:

BEGIN {
    my @methods = qw(
        num_eq
        num_ne
        num_ge
        num_gt
        num_le
        num_lt
        str_eq
        str_ne
        str_ge
        str_gt
        str_le
        str_lt
        bool
    );

    foreach my $method (@methods) {
        no strict 'refs';
        *$method = sub { shift->$method(@_) };
    }
}

And that, of course, is why I posted yesterday's snippet. However, what's really annoying is that this is not a solid general-purpose technique. What's to stop the subclass from calling SUPER? You can't just check the caller package because things like this will break:

if( all(@customers) == all(@dead) ) { ... }

I should play around and look for more ways to stop SUPER calls here, but I got fed up with what is, essentially, overload breaking the object model.

Bonus #1: a patch for Perl6::Junction

There is also, now, a values method on each junction and it allows you to do stuff like this:

my $number = any( 0 .. 19 );
while ($number->values) {
    my $random_number int(rand(20));
    if ( $number == $random_number ) {
        # handle some task and discard the number
        $number = any( grep { $_ != $random_number } $number->values );
    }
}

(Note that there are plenty of reasons you don't want to mutate these junctions in place, but that's another story).

If you need this behavior, a "values" patch can be downloaded from the RT queue.

Bonus #2: Making overload segfault.

P5P has already been notified, but they're not sure what's going on. However, while investigating the above, I found that the following snippet will reliably segfault on multiple platforms.

use strict;
use warnings;

{
    package Some::Package;

    use overload
        '++'     => sub { print "object is $_[0]\n" },
        fallback => 1;

    sub new { bless {} => shift }
}

my $object = Some::Package->new;
print $object++;


Why are you giving coderefs?

dah1002 on 2008-06-13T13:45:03

# Why not just

use overload(
    '=='   => "num_eq",
    '!='   => "num_ne",
    '>='   => "num_ge",
    '>'    => "num_gt",
    '<='   => "num_le",
    '<'    => "num_lt",
    'eq'   => "str_eq",
    'ne'   => "str_ne",
    'ge'   => "str_ge",
    'gt'   => "str_gt",
    'le'   => "str_le",
    'lt'   => "str_lt",
    'bool' => "bool",
    '""'   => "stringify",
);

# ?

Re:Why are you giving coderefs?

Ovid on 2008-06-13T14:00:12

That's how the code was originally written. Switching from code references to strings makes this all go away. It's such a force of habit for me to use code refs that I feel really, really stupid about now :)

Re:Why are you giving coderefs?

ChrisDolan on 2008-06-14T03:14:57

That makes sense. Using a coderef ends up being like Ben's original idea: when you do $bool = \&Foo::Bar::bool and then $obj->$bool() you get the same thing as $obj->Foo::Bar::bool() instead of $obj->bool().