Thanks for clarifying that Athanasius.
I've added some debug print() commands to help me understand the flow, and I've altered the code that performs (and displays the results of) the subtractions.
Here 'tis:
use warnings;
use strict;
{ package My::A;
use overload '-' => \−
sub minus { my($x, $y, $swap) = (shift, shift, shift);
print "In My::A minus\n";
return ref($x)->new(
($y->isa('My::B') ? $x->[0] - $y->{value}
: ($x->[0] - $y->[0])
) * (1, -1)[$swap]
)
}
sub new { my($class, $value) = (shift, shift);
bless [$value], $class
}
# We can change My::B outside of My::B, in fact.
eval q| package My::B;
print "Running the eval in My::A\n";
my $m = My::B->can('minus') or die 'My::B not loaded';# $m
+ is a reference to My::B::minus().
use overload "-" => sub { my($x, $y, $s) = (shift, shift,
+ shift);
print "From overload sub in My::A eval\n";
return $y->isa('My::A') ? $y->minus($x, 1) : $m->($x, $
+y, $s)
}
|;
}
{ package My::B; # Can't be changed!
use overload '-' => \−
sub minus { my($x, $y, $swap) = (shift, shift, shift);
print "In My::B::minus\n";
my $subtr = $x->{value} - $y->{value};
return ref($x)->new($swap ? -$subtr : $subtr)
}
sub new { my($class, $value) = (shift, shift);
bless {value => $value}, $class
}
}
my $a0 = My::A->new(16);
my $a1 = My::A->new(6);
my $b0 = My::B->new(16);
my $b1 = My::B->new(6);
print "All values assigned\n";
my $r1 = $a0 - $a1;
print ref($r1), ' = ', ref($a0), ' - ', ref($a1), "\n\n";
my $r2 = $a0 - $b1;
print ref($r2), ' = ', ref($a0), ' - ', ref($b1), "\n\n";
my $r3 = $b1 - $a0;
print ref($r3), ' = ', ref($b1), ' - ', ref($a0), "\n\n";
my $r4 = $b0 - $b1;
print ref($r4), ' = ', ref($b0), ' - ', ref($b1), "\n\n";
__END__
Outputs:
Running the eval in My::A
All values assigned
In My::A minus
My::A = My::A - My::A
In My::A minus
My::A = My::A - My::B
From overload sub in My::A eval
In My::A minus
My::A = My::B - My::A
From overload sub in My::A eval
In My::B::minus
My::B = My::B - My::B
I gather that:
1) the eval in My::A gets executed at start-up and sets its own subtraction subroutine as the subtraction subroutine that My::B's overloading of '-' will call (instead of calling My::B::minus);
2) it's the same behaviour, irrespective of the order in which packages My::A and My::B are loaded;
3) it would be the same behaviour if the 2 packages were in separate files (My/A.pm and My/B.pm), irrespective of the order in which the 2 pm files were loaded.
I certainly didn't know that this was do-able - and thanks, choroba, for drawing my attention to it.
It's something I can probably utilize wrt the overloading of objects from modules that I don't maintain.
Are there any caveats regarding the process by which this works ?
Cheers, Rob | [reply] [d/l] |
Are there any caveats regarding the process by which this works ?
I think the main caveat is that if multiple classes do this, you have behaviour dependent on order of loading. It also becomes difficult or impossible for one such class to unwind its change (though it could test an "enabled" flag to make its own intervention a noop).
| [reply] |
Thanks for the reply. (I haven't been able to access this webshite for the last 3 days.)
I was a bit confused by the fact that, with Choroba's script, the overloading was unaffected by the order in which package My::A and My::B were listed.
Eventually, I deduced that the overriding "use overload" directives were, courtesy of being inside an eval block, not executed until after both packages had loaded.
Anyway, I've been playing around with this approach and finding it to be relatively simple.
I've decided that the implementation should be effected by a standalone module (Math::GMP_OLOAD) which will handle the Math::GMP side of things regarding the handling of Math::GMP objects in Math::MPFR, Math::GMPq and Math::GMPz.
So it will contain stuff like:
{
package Math::GMP;
use overload "+" => sub ($$$) {
my($x, $y) = (shift, shift);
if(ref($y) eq 'Math::MPFR' || ref($y) eq 'Math::GMPq' || ref($y)
+ eq 'Math::GMPz') {
return $y + $x;
}
return Math::GMP::op_add($x, $y, 0);
};
use overload "-" => sub ($$$) {
my($x, $y) = (shift, shift);
if(ref($y) eq 'Math::MPFR' || ref($y) eq 'Math::GMPq' || ref($y)
+ eq 'Math::GMPz') {
return -($y - $x);
}
return Math::GMP::op_sub($x, $y, shift);
};
....
Seems to be working ok.
I doubt that anyone else will make much use of it, but I might use it a bit - and it's an enjoyable little exercise, anyway.
It's nearly all done outside of the 3 modules it's supporting - ie it adds negligible clutter to those 3 modules.
Cheers, Rob
| [reply] [d/l] |