From: Ilya Zakharevich Date: Wed, 24 Jan 2001 19:06:57 +0000 (-0500) Subject: overload int() X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f216259dc50e3a06164781e025bbb486cdc1dbaa;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 - "atan2", "cos", "sin", "exp", "abs", "log", "sqrt", + "atan2", "cos", "sin", "exp", "abs", "log", "sqrt", "int" If C is unavailable, it can be autogenerated using methods for "E" or "E=E" combined with either unary minus or subtraction. +Note that traditionally the Perl function L rounds to 0, thus for +floating-point-like types one should follow the same semantic. If +C is unavailable, it can be autogenerated using the overloading of +C<0+>. + =item * I "bool", "\"\"", "0+", diff --git a/perl.h b/perl.h index bbea5dd..93e53f1 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 b335d13..a9725ba 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 () { chop; if (s/^&//) { @@ -33,6 +33,8 @@ while () { $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 () { } } } + +{ + 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 --- 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 () { chop; if (s/^&//) { @@ -25,6 +25,8 @@ while () { $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