overload int()

Message-ID: <20010124190657.A8512@math.ohio-state.edu>

p4raw-id: //depot/perl@8545

diff --git a/gv.c b/gv.c
index ea96c6f..c73d503 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1411,6 +1411,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
             lr = 1;
           }
           break;
+        case int_amg:
         case iter_amg:                 /* XXXX Eventually should do to_gv. */
             /* FAIL safe */
             return NULL;       /* Delegate operation to standard mechanisms. */

diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index 74a023e..4c520fd 100644 (file)
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -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'.
@@ -235,6 +243,26 @@ sub ffround { #(fnum_str, scale) return fnum_str
        }
     }
 }
+
+# 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);
+           }
+       }
+    }
+}
     
 # compare 2 values returns one of undef, <0, =0, >0
 #   returns undef if either or both input value are not numbers

diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index 066577d..839b746 100644 (file)
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -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

diff --git a/lib/overload.pm b/lib/overload.pm
index 69092a0..712c8ed 100644 (file)
--- a/lib/overload.pm
+++ b/lib/overload.pm
@@ -123,7 +123,7 @@ sub mycan {                         # Real can would leave stubs.
         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,11 +370,16 @@ 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>
 
     "bool", "\"\"", "0+",

diff --git a/perl.h b/perl.h
index bbea5dd..93e53f1 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -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];

diff --git a/t/lib/bigfltpm.t b/t/lib/bigfltpm.t
index b335d13..a9725ba 100755 (executable)
--- a/t/lib/bigfltpm.t
+++ b/t/lib/bigfltpm.t
@@ -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

diff --git a/t/lib/bigintpm.t b/t/lib/bigintpm.t
index e76f246..dac6f5f 100755 (executable)
--- a/t/lib/bigintpm.t
+++ b/t/lib/bigintpm.t
@@ -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