1eac174f2Safresh1# -*- mode: perl; -*- 2b8851fccSafresh1 3b8851fccSafresh1package Math::BigInt::Trace; 4b8851fccSafresh1 5b8851fccSafresh1use strict; 6b8851fccSafresh1use warnings; 7b8851fccSafresh1 8b8851fccSafresh1use Exporter; 9b8851fccSafresh1use Math::BigInt; 10b8851fccSafresh1 11b8851fccSafresh1our @ISA = qw(Exporter Math::BigInt); 12b8851fccSafresh1 13*3d61058aSafresh1our $VERSION = '0.67'; 14b8851fccSafresh1 159f11ffb7Safresh1use overload; # inherit overload from Math::BigInt 16b8851fccSafresh1 17b8851fccSafresh1# Globals 18eac174f2Safresh1our $accuracy = undef; 19eac174f2Safresh1our $precision = undef; 20eac174f2Safresh1our $round_mode = 'even'; 21eac174f2Safresh1our $div_scale = 40; 22b8851fccSafresh1 23b8851fccSafresh1sub new { 24b8851fccSafresh1 my $proto = shift; 25b8851fccSafresh1 my $class = ref($proto) || $proto; 26b8851fccSafresh1 27b8851fccSafresh1 my $value = shift; 28eac174f2Safresh1 29b8851fccSafresh1 my $a = $accuracy; 30b8851fccSafresh1 $a = $_[0] if defined $_[0]; 31eac174f2Safresh1 32b8851fccSafresh1 my $p = $precision; 33b8851fccSafresh1 $p = $_[1] if defined $_[1]; 34eac174f2Safresh1 35eac174f2Safresh1 my $self = $class -> SUPER::new($value, $a, $p, $round_mode); 36eac174f2Safresh1 37eac174f2Safresh1 printf "Math::BigInt new '%s' => '%s' (%s)\n", 38eac174f2Safresh1 $value, $self, ref($self); 39eac174f2Safresh1 40b8851fccSafresh1 return $self; 41b8851fccSafresh1} 42b8851fccSafresh1 43b8851fccSafresh1sub import { 44eac174f2Safresh1 my $class = shift; 45eac174f2Safresh1 46eac174f2Safresh1 printf "%s -> import(%s)\n", $class, join(", ", @_); 47eac174f2Safresh1 48eac174f2Safresh1 # we catch the constants, the rest goes to parent 49eac174f2Safresh1 50eac174f2Safresh1 my $constant = grep { $_ eq ':constant' } @_; 51eac174f2Safresh1 my @a = grep { $_ ne ':constant' } @_; 52eac174f2Safresh1 53eac174f2Safresh1 if ($constant) { 54eac174f2Safresh1 overload::constant 55eac174f2Safresh1 56eac174f2Safresh1 integer => sub { 57eac174f2Safresh1 $class -> new(shift); 58eac174f2Safresh1 }, 59eac174f2Safresh1 60eac174f2Safresh1 float => sub { 61eac174f2Safresh1 $class -> new(shift); 62eac174f2Safresh1 }, 63eac174f2Safresh1 64eac174f2Safresh1 binary => sub { 65eac174f2Safresh1 # E.g., a literal 0377 shall result in an object whose value 66eac174f2Safresh1 # is decimal 255, but new("0377") returns decimal 377. 67eac174f2Safresh1 return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; 68eac174f2Safresh1 $class -> new(shift); 69eac174f2Safresh1 }; 70eac174f2Safresh1 } 71eac174f2Safresh1 72eac174f2Safresh1 $class -> SUPER::import(@a); # need it for subclasses 73eac174f2Safresh1 #$self -> export_to_level(1, $class, @_); # need this ? 74b8851fccSafresh1} 75b8851fccSafresh1 76b8851fccSafresh11; 77