Velocity Reviews - Computer Hardware Reviews

Velocity Reviews > Newsgroups > Programming > Perl > Perl Misc > Operator overloading

Reply
Thread Tools

Operator overloading

 
 
Sisyphus
Guest
Posts: n/a
 
      04-22-2004
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.

 
Reply With Quote
 
 
 
 
Anno Siegel
Guest
Posts: n/a
 
      04-22-2004
Sisyphus <(E-Mail Removed)> 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
 
Reply With Quote
 
 
 
 
Sisyphus
Guest
Posts: n/a
 
      04-22-2004
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.

 
Reply With Quote
 
Anno Siegel
Guest
Posts: n/a
 
      04-22-2004
Sisyphus <(E-Mail Removed)> 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
 
Reply With Quote
 
Sisyphus
Guest
Posts: n/a
 
      04-22-2004
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.

 
Reply With Quote
 
Ilya Zakharevich
Guest
Posts: n/a
 
      04-23-2004
[A complimentary Cc of this posting was sent to
Sisyphus
<(E-Mail Removed)>], who wrote in article <4087e0a9$0$16593$(E-Mail Removed) >:
> > 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
 
Reply With Quote
 
Sisyphus
Guest
Posts: n/a
 
      04-24-2004
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.

 
Reply With Quote
 
 
 
Reply

Thread Tools

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
overloading operator->*() and operator->() gob00st@googlemail.com C++ 2 02-21-2009 04:26 AM
overloading operator->*() and operator->() gob00st@googlemail.com C++ 11 02-20-2009 08:52 PM
user defined conversion operator or operator overloading? hurcan solter C++ 3 08-29-2007 07:39 PM
Why is overloading operator. (member operator) forbidden? dascandy@gmail.com C++ 11 05-16-2007 07:54 PM
Operator overloading on "default" operator John Smith C++ 2 10-06-2004 10:22 AM



Advertisments