develooper Front page | perl.perl5.porters | Postings from January 2001

[PATCH 5.7.0] overload int()

Thread Next
From:
Ilya Zakharevich
Date:
January 24, 2001 16:07
Subject:
[PATCH 5.7.0] overload int()
Message ID:
20010124190657.A8512@math.ohio-state.edu
Some arithmetic algos do not work with overloading, since there is
more arithmetic operation which was not overloaded: int().  This patch
closes this hole.

When putting things in BigFloat to test it more, I thrown in :constant
key for 'use Math::BigFloat', so now it behaves as Math::BigInt.

  perl -MMath::BigFloat=:constant -wle 'print 2*1427247692705959881058285969449495136382746624.'
  2854495385411919762116571938898990272765493248.

Enjoy,
Ilya

--- ./perl.h~	Tue Jan 16 20:44:51 2001
+++ ./perl.h	Wed Jan 24 15:21:04 2001
@@ -3064,7 +3064,8 @@ enum {
   to_sv_amg,   to_av_amg,
   to_hv_amg,   to_gv_amg,
   to_cv_amg,   iter_amg,
-  DESTROY_amg, max_amg_code
+  int_amg,	DESTROY_amg,
+  max_amg_code
   /* Do not leave a trailing comma here.  C9X allows it, C89 doesn't. */
 };
 
@@ -3110,7 +3111,7 @@ EXTCONST char * PL_AMG_names[NofAMmeth] 
   "(${}",	"(@{}",
   "(%{}",	"(*{}",
   "(&{}",	"(<>",
-  "DESTROY",
+  "(int",	"DESTROY",
 };
 #else
 EXTCONST char * PL_AMG_names[NofAMmeth];
--- ./pp.c~	Wed Jan 17 14:30:33 2001
+++ ./pp.c	Wed Jan 24 15:30:46 2001
@@ -2576,7 +2576,7 @@ PP(pp_sqrt)
 
 PP(pp_int)
 {
-    djSP; dTARGET;
+    djSP; dTARGET; tryAMAGICun(int);
     {
       NV value;
       IV iv = TOPi; /* attempt to convert to IV if possible. */
--- ./gv.c~	Wed Jan 17 22:45:46 2001
+++ ./gv.c	Wed Jan 24 17:53:07 2001
@@ -1411,6 +1411,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *rig
 	     lr = 1;
 	   }
 	   break;
+	 case int_amg:
 	 case iter_amg:			/* XXXX Eventually should do to_gv. */
 	     /* FAIL safe */
 	     return NULL;	/* Delegate operation to standard mechanisms. */
--- ./lib/overload.pm~	Wed Dec  6 10:10:18 2000
+++ ./lib/overload.pm	Wed Jan 24 15:45:40 2001
@@ -123,7 +123,7 @@ sub mycan {				# Real can would leave st
 	 binary		  => "& | ^",
 	 unary		  => "neg ! ~",
 	 mutators	  => '++ --',
-	 func		  => "atan2 cos sin exp abs log sqrt",
+	 func		  => "atan2 cos sin exp abs log sqrt int",
 	 conversion	  => 'bool "" 0+',
 	 iterators	  => '<>',
 	 dereferencing	  => '${} @{} %{} &{} *{}',
@@ -370,10 +370,15 @@ postfix form.
 
 =item * I<Transcendental functions>
 
-    "atan2", "cos", "sin", "exp", "abs", "log", "sqrt",
+    "atan2", "cos", "sin", "exp", "abs", "log", "sqrt", "int"
 
 If C<abs> is unavailable, it can be autogenerated using methods
 for "E<lt>" or "E<lt>=E<gt>" combined with either unary minus or subtraction.
+
+Note that traditionally the Perl function L<int> rounds to 0, thus for
+floating-point-like types one should follow the same semantic.  If
+C<int> is unavailable, it can be autogenerated using the overloading of
+C<0+>.
 
 =item * I<Boolean, string and numeric conversion>
 
--- ./t/pragma/overload.t~	Fri Dec 15 10:40:27 2000
+++ ./t/pragma/overload.t	Wed Jan 24 16:00:27 2001
@@ -970,6 +970,38 @@ unless ($aaa) {
     test($a =~ /^`1' is not a code reference at/); # 215
 }
 
+{
+  my $c = 0;
+  package ov_int1;
+  use overload '""'    => sub { 3+shift->[0] },
+               '0+'    => sub { 10+shift->[0] },
+               'int'   => sub { 100+shift->[0] };
+  sub new {my $p = shift; bless [shift], $p}
+
+  package ov_int2;
+  use overload '""'    => sub { 5+shift->[0] },
+               '0+'    => sub { 30+shift->[0] },
+               'int'   => sub { 'ov_int1'->new(1000+shift->[0]) };
+  sub new {my $p = shift; bless [shift], $p}
+
+  package noov_int;
+  use overload '""'    => sub { 2+shift->[0] },
+               '0+'    => sub { 9+shift->[0] };
+  sub new {my $p = shift; bless [shift], $p}
+
+  package main;
+
+  my $x = new noov_int 11;
+  my $int_x = int $x;
+  main::test("$int_x" eq 20);			# 216
+  $x = new ov_int1 31;
+  $int_x = int $x;
+  main::test("$int_x" eq 131);			# 217
+  $x = new ov_int2 51;
+  $int_x = int $x;
+  main::test("$int_x" eq 1054);			# 218
+}
+
 # make sure that we don't inifinitely recurse
 {
   my $c = 0;
@@ -979,10 +1011,12 @@ unless ($aaa) {
                'bool'  => sub { shift },
                fallback => 1;
   my $x = bless([]);
-  main::test("$x" =~ /Recurse=ARRAY/);		# 216
-  main::test($x);                               # 217
-  main::test($x+0 =~ /Recurse=ARRAY/);		# 218
-};
+  main::test("$x" =~ /Recurse=ARRAY/);		# 219
+  main::test($x);                               # 220
+  main::test($x+0 =~ /Recurse=ARRAY/);		# 221
+}
+
+
 
 # Last test is:
-sub last {218}
+sub last {221}
--- ./lib/Math/BigInt.pm~	Fri Jan 12 21:10:23 2001
+++ ./lib/Math/BigInt.pm	Wed Jan 24 17:54:30 2001
@@ -25,6 +25,7 @@ use overload
 '|'	=>	sub {new Math::BigInt &bior},
 '^'	=>	sub {new Math::BigInt &bxor},
 '~'	=>	sub {new Math::BigInt &bnot},
+'int'	=>	sub { shift },
 
 qw(
 ""	stringify
--- ./lib/Math/BigFloat.pm~	Thu Aug 17 00:09:45 2000
+++ ./lib/Math/BigFloat.pm	Wed Jan 24 18:40:52 2001
@@ -18,6 +18,7 @@ use overload
 			 scalar fdiv(${$_[0]},$_[1])},
 'neg'	=>	sub {new Math::BigFloat &fneg},
 'abs'	=>	sub {new Math::BigFloat &fabs},
+'int'	=>	sub {new Math::BigInt &f2int},
 
 qw(
 ""	stringify
@@ -58,6 +59,13 @@ sub stringify {
     return $n;
 }
 
+sub import {
+  shift;
+  return unless @_;
+  die "unknown import: @_" unless @_ == 1 and $_[0] eq ':constant';
+  overload::constant float => sub {Math::BigFloat->new(shift)};
+}
+
 $div_scale = 40;
 
 # Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
@@ -231,6 +239,26 @@ sub ffround { #(fnum_str, scale) return 
 	    } else {
 		&norm(&round(substr($xm,$[,$xe),
 		      "+0".substr($xm,$[+$xe,1),"+10"), $scale);
+	    }
+	}
+    }
+}
+
+# Calculate the integer part of $x
+sub f2int { #(fnum_str) return inum_str
+    local($x) = ${$_[$[]};
+    if ($x eq 'NaN') {
+	die "Attempt to take int(NaN)";
+    } else {
+	local($xm,$xe) = split('E',$x);
+	if ($xe >= 0) {
+	    $xm . '0' x $xe;
+	} else {
+	    $xe = length($xm)+$xe;
+	    if ($xe <= 1) {
+		'+0';
+	    } else {
+	        substr($xm,$[,$xe);
 	    }
 	}
     }
--- ./t/lib/bigintpm.t~	Tue Aug 29 08:54:11 2000
+++ ./t/lib/bigintpm.t	Wed Jan 24 18:20:17 2001
@@ -9,7 +9,7 @@ use Math::BigInt;
 
 $test = 0;
 $| = 1;
-print "1..278\n";
+print "1..283\n";
 while (<DATA>) {
        chop;
        if (s/^&//) {
@@ -25,6 +25,8 @@ while (<DATA>) {
                    $try .= "-\$x;";
                } elsif ($f eq "babs") {
                    $try .= "abs \$x;";
+               } elsif ($f eq "bint") {
+                   $try .= "int \$x;";
                } else {
                    $try .= "\$y = new Math::BigInt \"$args[1]\";";
                    if ($f eq "bcmp"){
@@ -375,3 +377,9 @@ abc:NaN
 +0:-1
 +8:-9
 +281474976710656:-281474976710657
+&bint
++0:+0
++1:+1
++11111111111111111234:+11111111111111111234
+-1:-1
+-11111111111111111234:-11111111111111111234
--- ./t/lib/bigfltpm.t~	Thu Dec  7 21:35:55 2000
+++ ./t/lib/bigfltpm.t	Wed Jan 24 18:54:00 2001
@@ -9,7 +9,7 @@ use Math::BigFloat;
 
 $test = 0;
 $| = 1;
-print "1..362\n";
+print "1..406\n";
 while (<DATA>) {
        chop;
        if (s/^&//) {
@@ -33,6 +33,8 @@ while (<DATA>) {
                    $try .= "-\$x;";
                } elsif ($f eq "fabs") {
                    $try .= "abs \$x;";
+               } elsif ($f eq "fint") {
+                   $try .= "int \$x;";
                } elsif ($f eq "fround") {
                    $try .= "0+\$x->fround($args[1]);";
                } elsif ($f eq "ffround") {
@@ -73,6 +75,25 @@ while (<DATA>) {
                }
        }
 } 
+
+{
+  use Math::BigFloat ':constant';
+
+  $test++;
+  # print "# " . 2. * '1427247692705959881058285969449495136382746624' . "\n";
+  print "not "
+    unless 2. * '1427247692705959881058285969449495136382746624'
+	    == "2854495385411919762116571938898990272765493248.";
+  print "ok $test\n";
+  $test++;
+  @a = ();
+  for ($i = 1.; $i < 10; $i++) {
+    push @a, $i;
+  }
+  print "not " unless "@a" eq "1. 2. 3. 4. 5. 6. 7. 8. 9.";
+  print "ok $test\n";
+}
+
 __END__
 &fnorm
 abc:NaN.
@@ -461,3 +482,46 @@ $Math::BigFloat::div_scale = 40
 +100:10.
 +123.456:11.11107555549866648462149404118219234119
 +15241.383936:123.456
+&fint
++0:+0
++1:+1
++11111111111111111234:+11111111111111111234
+-1:-1
+-11111111111111111234:-11111111111111111234
++0.3:+0
++1.3:+1
++23.3:+23
++12345678901234567890:+12345678901234567890
++12345678901234567.890:+12345678901234567
++12345678901234567890E13:+123456789012345678900000000000000
++12345678901234567.890E13:+123456789012345678900000000000
++12345678901234567890E-3:+12345678901234567
++12345678901234567.890E-3:+12345678901234
++12345678901234567890E-13:+1234567
++12345678901234567.890E-13:+1234
++12345678901234567890E-17:+123
++12345678901234567.890E-16:+1
++12345678901234567.890E-17:+0
++12345678901234567890E-19:+1
++12345678901234567890E-20:+0
++12345678901234567890E-21:+0
++12345678901234567890E-225:+0
+-0:+0
+-0.3:+0
+-1.3:-1
+-23.3:-23
+-12345678901234567890:-12345678901234567890
+-12345678901234567.890:-12345678901234567
+-12345678901234567890E13:-123456789012345678900000000000000
+-12345678901234567.890E13:-123456789012345678900000000000
+-12345678901234567890E-3:-12345678901234567
+-12345678901234567.890E-3:-12345678901234
+-12345678901234567890E-13:-1234567
+-12345678901234567.890E-13:-1234
+-12345678901234567890E-17:-123
+-12345678901234567.890E-16:-1
+-12345678901234567.890E-17:+0
+-12345678901234567890E-19:-1
+-12345678901234567890E-20:+0
+-12345678901234567890E-21:+0
+-12345678901234567890E-225:+0

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About