Operator overloading

S

Sisyphus

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
 
A

Anno Siegel

Sisyphus said:
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
 
S

Sisyphus

Anno said:
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;
}
 
A

Anno Siegel

Sisyphus said:
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
 
S

Sisyphus

Anno said:
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
 
I

Ilya Zakharevich

[A complimentary Cc of this posting was sent to
Sisyphus
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
 
S

Sisyphus

Ilya said:
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

Forum statistics

Threads
473,744
Messages
2,569,483
Members
44,903
Latest member
orderPeak8CBDGummies

Latest Threads

Top