overload int()

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

p4raw-id: //depot/perl@8545

7 files changed, 114 insertions, 6 deletions

diff --git a/gv.c b/gv.c
index ea96c6f8fd..c73d503d5f 100644
--- 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 74a023e0d8..4c520fdd49 100644
--- 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 066577d4cc..839b746c24 100644
--- 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 69092a00cf..712c8eda57 100644
--- 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 bbea5dddd3..93e53f10f9 100644
--- 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 b335d13016..a9725bad69 100755
--- 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 e76f246f18..dac6f5f4a0 100755
--- 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