Operator overloading
 

Hi,

I've overloaded the '*' operator and that works as expected - simply
have the overload subroutine return a new object that holds the value of
the multiplication.

But I thought that a '*=' overload subroutine would modify in place the
first argument that the subroutine receives, rather than create a new
object to be returned. Seems that is not the case - I find the overload
subroutine must again create a new object that holds the result of the
multiplication and return that object.

When I do '$obj *= 11;' all that really needs to be done is have $obj
modified in place. Instead I find that 'DESTROY($obj)' is being called
and that the overload function is expected to create and return a
replacement - which strikes me as being inefficient, especially in a
tight loop.

Does it have to be that way, or have I missed something ?

Cheers,
Rob

--
To reply by email u have to take out the u in kalinaubears.

Re: Operator overloading
 

Sisyphus <kalinaubears@iinet.net.au> wrote in comp.lang.perl.misc:
> Hi,
>
> I've overloaded the '*' operator and that works as expected - simply
> have the overload subroutine return a new object that holds the value of
> the multiplication.
>
> But I thought that a '*=' overload subroutine would modify in place the
> first argument that the subroutine receives, rather than create a new
> object to be returned. Seems that is not the case - I find the overload
> subroutine must again create a new object that holds the result of the
> multiplication and return that object.

What brought you to that conclusion? It's wrong. The overload routine
must *return* an object, it doesn't have to create it. It is perfectly
free to return its first argument with or without prior modification.

> When I do '$obj *= 11;' all that really needs to be done is have $obj
> modified in place. Instead I find that 'DESTROY($obj)' is being called
> and that the overload function is expected to create and return a
> replacement - which strikes me as being inefficient, especially in a
> tight loop.

Show your code! Your conclusion is wrong, but since you don't say how
you arrived at it, we can't correct it.

Anno

Re: Operator overloading
 

Anno Siegel wrote:

>
> What brought you to that conclusion? It's wrong. The overload routine
> must *return* an object, it doesn't have to create it. It is perfectly
> free to return its first argument with or without prior modification.
>

That's what I needed to know.
If I want to return the "first argument with or without prior
modification" then the overload routine needs to increase the first
arg's reference count - otherwise 'DESTROY($obj)' gets called. That's
where I was stuffing up. Your definitive reply quickly led me to that
realisation. (Actually I don't know that the reference count *needs* to
be increased - but it's certainly one way of efficiently fixing the
problem I was experiencing.)

The overload routines are Inline C routines, and they use functions in
the GMP library - and I doubted there was much use in posting any code.
Perhaps I was wrong about that .... or perhaps not. The current script
I'm using to test things out is reproduced below and seems to me to be
working nicely - in so far as it goes :-)

Thanks Anno.

Cheers,
Rob

package overloaded;
use warnings;
use Benchmark;

use overload
'*' => \&overload_mul,
'+' => \&overload_add,
'*=' => \&overload_mul_eq;

use Inline (C => Config =>
LIBS => '-lgmp',
BUILD_NOISY => 1,
);

use Inline C => <<'EOC';

#include <stdio.h>
#include <stdlib.h>
#include <gmp.h>

SV * Rmpz_init_set_str(SV * num, SV * base) {
mpz_t * mpz_t_obj;
unsigned long b = SvUV(base);

if(b == 1 || b > 36) croak("Second argument supplied to
Rmpz_init_set_str() is not in acceptable range");

New(1, mpz_t_obj, sizeof(mpz_t), mpz_t);
if(mpz_t_obj == NULL) croak("Failed to allocate memory in
Rmpz_init_set_str function");

if(mpz_init_set_str (*mpz_t_obj, SvPV_nolen(num), b))
croak("First argument supplied to Rmpz_init_set_str() is not a
valid base %u number", b);

return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}

SV * overload_mul(SV * a, SV * b, SV * third) {
mpz_t * mpz_t_obj, t;

New(1, mpz_t_obj, sizeof(mpz_t), mpz_t);
if(mpz_t_obj == NULL) croak("Failed to allocate memory in
overload_mul function");
mpz_init(*mpz_t_obj);

if(SvUOK(b)) {
mpz_mul_ui(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvUV(b));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}

if(SvIOK(b)) {
mpz_mul_si(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvIV(b));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}

if(SvNOK(b)) {
mpz_init_set_d(t, SvNV(b));
mpz_mul(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), t);
mpz_clear(t);
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}

if(SvROK(b)) {
mpz_mul(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), *((mpz_t *)
SvIV(SvRV(b))));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}

croak("Invalid argument supplied to overload_mul");
}

SV * overload_mul_eq(SV * a, SV * b, SV * third) {
mpz_t t;

if(SvUOK(b)) {
SvREFCNT_inc(a);
mpz_mul_ui(*((mpz_t *) SvIV(SvRV(a))), *((mpz_t *)
SvIV(SvRV(a))), SvUV(b));
return a;
}

if(SvIOK(b)) {
SvREFCNT_inc(a);
mpz_mul_si(*((mpz_t *) SvIV(SvRV(a))), *((mpz_t *)
SvIV(SvRV(a))), SvIV(b));
return a;
}

if(SvNOK(b)) {
SvREFCNT_inc(a);
mpz_init_set_d(t, SvNV(b));
mpz_mul(*((mpz_t *) SvIV(SvRV(a))), *((mpz_t *) SvIV(SvRV(a))), t);
mpz_clear(t);
return a;
}

if(SvROK(b)) {
SvREFCNT_inc(a);
mpz_mul(*((mpz_t *) SvIV(SvRV(a))), *((mpz_t *) SvIV(SvRV(a))),
*((mpz_t *) SvIV(SvRV(b))));
return a;
}

croak("Invalid argument supplied to overload_mul_eq");
}

SV * overload_add(SV * a, SV * b, SV * third) {
mpz_t * mpz_t_obj, t;

New(1, mpz_t_obj, sizeof(mpz_t), mpz_t);
if(mpz_t_obj == NULL) croak("Failed to allocate memory in
overload_mul function");
mpz_init(*mpz_t_obj);

if(SvUOK(b)) {
mpz_add_ui(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvUV(b));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}

if(SvIOK(b)) {
if(SvIV(b) >= 0) {
mpz_add_ui(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvIV(b));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
mpz_sub_ui(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvIV(b) * -1);
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}

if(SvNOK(b)) {
mpz_init_set_d(t, SvNV(b));
mpz_add(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), t);
mpz_clear(t);
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}

if(SvROK(b)) {
mpz_add(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), *((mpz_t *)
SvIV(SvRV(b))));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}

croak("Invalid argument supplied to overload_add function");

}

SV * Rmpz_get_str(SV * p, SV * base) {
char * out;
SV * outsv;
unsigned long b = SvUV(base);

if(b < 2 || b > 36) croak("Second argument supplied to
Rmpz_get_str() is not in acceptable range");

New(2, out, mpz_sizeinbase(*((mpz_t *) SvIV(SvRV(p))), b) + 5, char);
if(out == NULL) croak("Failed to allocate memory in Rmpz_deref
function");

mpz_get_str(out, b, *((mpz_t *) SvIV(SvRV(p))));
outsv = newSVpv(out, 0);
Safefree(out);
return outsv;
}

void DESTROY(SV * p) {
/* printf("Destroying mpz "); */
mpz_clear(*((mpz_t *) SvIV(SvRV(p))));
Safefree((mpz_t *) SvIV(SvRV(p)));
}


EOC

my $str = '12345';
my $x = Rmpz_init_set_str($str, 10);
my $y = Rmpz_init_set_str('7', 10);

my $z = 1 * $x * $y * (2 ** 43);
print Rmpz_get_str($z, 10), "\n";

$z = -9 + $z + $y + -7;
print Rmpz_get_str($z, 10), "\n";

$z = $z + 9;
print Rmpz_get_str($z, 10), "\n";

$z *= 11;

print Rmpz_get_str($z, 10), "\n";

$z *= 11;
print Rmpz_get_str($z, 10), "\n";


$z *= $y;
print Rmpz_get_str($z, 10), "\n";

timethese (1, {
'ovrld1' => '$z = factorial_1(50000);',
'ovrld2' => '$z = factorial_2(50000);',
});

sub factorial_1 {
my $n = $_[0];
my $ret = Rmpz_init_set_str('1', 16);
for(2 .. $n) {$ret = $ret * $_}
return $ret;
}

sub factorial_2 {
my $n = $_[0];
my $ret = Rmpz_init_set_str('1', 16);
for(2 .. $n) {$ret *= $_}
return $ret;
}


--
To reply by email u have to take out the u in kalinaubears.

Re: Operator overloading
 

Sisyphus <kalinaubears@iinet.net.au> wrote in comp.lang.perl.misc:
> Anno Siegel wrote:
>
> >
> > What brought you to that conclusion? It's wrong. The overload routine
> > must *return* an object, it doesn't have to create it. It is perfectly
> > free to return its first argument with or without prior modification.
> >
>
> That's what I needed to know.
> If I want to return the "first argument with or without prior
> modification" then the overload routine needs to increase the first
> arg's reference count - otherwise 'DESTROY($obj)' gets called. That's
> where I was stuffing up. Your definitive reply quickly led me to that
> realisation. (Actually I don't know that the reference count *needs* to
> be increased - but it's certainly one way of efficiently fixing the
> problem I was experiencing.)

For overload routines written in Perl, there is nothing special to
consider. You return something, perl deals with the refcount.

> The overload routines are Inline C routines, and they use functions in

Now, that's a different story, though I seem to remember that Inline
can handle the refcounts of SVs you return for you. I may be wrong,
it's been a while...

> the GMP library - and I doubted there was much use in posting any code.
> Perhaps I was wrong about that .... or perhaps not. The current script
> I'm using to test things out is reproduced below and seems to me to be
> working nicely - in so far as it goes :-)

Well... I didn't look closely, but you seem to do quite a bit of
explicit refcount handling. I wonder if it's all necessary.

Anno

Re: Operator overloading
 

Anno Siegel wrote:

>
> Well... I didn't look closely, but you seem to do quite a bit of
> explicit refcount handling. I wonder if it's all necessary.
>

I'll think about that - though there's only a very small penalty with
the current '*=' overload subroutine. On my 1GHz box 50,000 calls to the
overload subroutine adds about 0.06 seconds (in comparison to 50,000
calls to the alternative GMP library function), so I don't think there's
much room for more gain there.

(The overload sub currently contains a 'SvREFCNT_inc()' inside every
'if{}' block. All that's really needed is just the one 'SvREFCNT_inc()'
before the first 'if{}' block. I'll change that in the interests of tidy
coding :-)

Thanks again Anno.

Cheers,
Rob

--
To reply by email u have to take out the u in kalinaubears.

Re: Operator overloading
 

[A complimentary Cc of this posting was sent to
Sisyphus
<kalinaubears@iinet.net.au>], who wrote in article <4087e0a9$0$16593$5a62ac22@freenews.iinet.net.au >:
> > What brought you to that conclusion? It's wrong. The overload routine
> > must *return* an object, it doesn't have to create it. It is perfectly
> > free to return its first argument with or without prior modification.

> That's what I needed to know.
> If I want to return the "first argument with or without prior
> modification" then the overload routine needs to increase the first
> arg's reference count - otherwise 'DESTROY($obj)' gets called.

This looks logical. Perl does not know whether you return a new
object, or an old one. If you return a new one, you preserve the
refcount of the old one, and create the new object with refcount 1.
When the new object is not needed (it is just a temporary needed until
the result is assigned somewhere), Perl will decrement its refcount.

So the total refcount is "the_old_refcount + 1". Does REFCOUNT_inc()
in the case when the old object is reused become logical now?

Hope this helps,
Ilya

Re: Operator overloading
 

Ilya Zakharevich wrote:

>>If I want to return the "first argument with or without prior
>>modification" then the overload routine needs to increase the first
>>arg's reference count - otherwise 'DESTROY($obj)' gets called.
>
>
> This looks logical. Perl does not know whether you return a new
> object, or an old one. If you return a new one, you preserve the
> refcount of the old one, and create the new object with refcount 1.
> When the new object is not needed (it is just a temporary needed until
> the result is assigned somewhere), Perl will decrement its refcount.
>
> So the total refcount is "the_old_refcount + 1". Does REFCOUNT_inc()
> in the case when the old object is reused become logical now?
>

Yes :-)

Thanks Ilya.

Cheers,
Rob


--
To reply by email u have to take out the u in kalinaubears.