diff options
Diffstat (limited to 'cpan/Math-BigInt/lib')
| -rw-r--r-- | cpan/Math-BigInt/lib/Math/BigFloat.pm | 845 | ||||
| -rw-r--r-- | cpan/Math-BigInt/lib/Math/BigInt.pm | 1796 | ||||
| -rw-r--r-- | cpan/Math-BigInt/lib/Math/BigInt/Calc.pm | 55 | ||||
| -rw-r--r-- | cpan/Math-BigInt/lib/Math/BigInt/Lib.pm | 80 |
4 files changed, 1796 insertions, 980 deletions
diff --git a/cpan/Math-BigInt/lib/Math/BigFloat.pm b/cpan/Math-BigInt/lib/Math/BigFloat.pm index 5dcc919e1a..b6d0bcbaf0 100644 --- a/cpan/Math-BigInt/lib/Math/BigFloat.pm +++ b/cpan/Math-BigInt/lib/Math/BigFloat.pm @@ -16,10 +16,11 @@ use 5.006001; use strict; use warnings; -use Carp qw< carp croak >; -use Math::BigInt (); +use Carp qw< carp croak >; +use Scalar::Util qw< blessed >; +use Math::BigInt qw< >; -our $VERSION = '1.999823'; +our $VERSION = '1.999827'; require Exporter; our @ISA = qw/Math::BigInt/; @@ -58,21 +59,21 @@ use overload # overload key: assign - '+=' => sub { $_[0]->badd($_[1]); }, + '+=' => sub { $_[0] -> badd($_[1]); }, - '-=' => sub { $_[0]->bsub($_[1]); }, + '-=' => sub { $_[0] -> bsub($_[1]); }, - '*=' => sub { $_[0]->bmul($_[1]); }, + '*=' => sub { $_[0] -> bmul($_[1]); }, - '/=' => sub { scalar $_[0]->bdiv($_[1]); }, + '/=' => sub { scalar $_[0] -> bdiv($_[1]); }, - '%=' => sub { $_[0]->bmod($_[1]); }, + '%=' => sub { $_[0] -> bmod($_[1]); }, - '**=' => sub { $_[0]->bpow($_[1]); }, + '**=' => sub { $_[0] -> bpow($_[1]); }, - '<<=' => sub { $_[0]->blsft($_[1]); }, + '<<=' => sub { $_[0] -> blsft($_[1]); }, - '>>=' => sub { $_[0]->brsft($_[1]); }, + '>>=' => sub { $_[0] -> brsft($_[1]); }, # 'x=' => sub { }, @@ -194,7 +195,7 @@ use overload '0+' => sub { $_[0] -> numify(); }, - '=' => sub { $_[0]->copy(); }, + '=' => sub { $_[0] -> copy(); }, ; @@ -360,52 +361,80 @@ sub new { my $selfref = ref $self; my $class = $selfref || $self; + # Make "require" work. + + $class -> import() if $IMPORT == 0; + + # Although this use has been discouraged for more than 10 years, people + # apparently still use it, so we still support it. + + return $class -> bzero() unless @_; + my ($wanted, @r) = @_; - # avoid numify-calls by not using || on $wanted! + if (!defined($wanted)) { + #if (warnings::enabled("uninitialized")) { + # warnings::warn("uninitialized", + # "Use of uninitialized value in new()"); + #} + return $class -> bzero(@r); + } - unless (defined $wanted) { - #carp("Use of uninitialized value in new"); - return $self->bzero(@r); + if (!ref($wanted) && $wanted eq "") { + #if (warnings::enabled("numeric")) { + # warnings::warn("numeric", + # q|Argument "" isn't numeric in new()|); + #} + #return $class -> bzero(@r); + return $class -> bnan(@r); } - # Using $wanted->isa("Math::BigFloat") here causes a 'Deep recursion on + # Initialize a new object. + + $self = bless {}, $class unless $selfref; + + # The first following ought to work. However, it causes a 'Deep recursion on # subroutine "Math::BigFloat::as_number"' in some tests. Fixme! - if (UNIVERSAL::isa($wanted, 'Math::BigFloat')) { - my $copy = $wanted -> copy(); - if ($selfref) { # if new() called as instance method - %$self = %$copy; - } else { # if new() called as class method - $self = $copy; - } - return $copy; + if (defined(blessed($wanted)) && $wanted -> isa('Math::BigFloat')) { + #if (defined(blessed($wanted)) && UNIVERSAL::isa($wanted, 'Math::BigFloat')) { + $self -> {sign} = $wanted -> {sign}; + $self -> {_m} = $LIB -> _copy($wanted -> {_m}); + $self -> {_es} = $wanted -> {_es}; + $self -> {_e} = $LIB -> _copy($wanted -> {_e}); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } - $class->import() if $IMPORT == 0; # make require work - - # If called as a class method, initialize a new object. + # Shortcut for Math::BigInt and its subclasses. This should be improved. - $self = bless {}, $class unless $selfref; + if (defined(blessed($wanted))) { + if ($wanted -> isa('Math::BigInt')) { + $self->{sign} = $wanted -> {sign}; + $self->{_m} = $LIB -> _copy($wanted -> {value}); + $self->{_es} = '+'; + $self->{_e} = $LIB -> _zero(); + return $self -> bnorm(); + } - # shortcut for bigints and its subclasses - if ((ref($wanted)) && $wanted -> can("as_number")) { - $self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy - $self->{_e} = $LIB->_zero(); - $self->{_es} = '+'; - $self->{sign} = $wanted->sign(); - return $self->bnorm(); + if ($wanted -> can("as_number")) { + $self->{sign} = $wanted -> sign(); + $self->{_m} = $wanted -> as_number() -> {value}; + $self->{_es} = '+'; + $self->{_e} = $LIB -> _zero(); + return $self -> bnorm(); + } } - # else: got a string or something masquerading as number (with overload) # Handle Infs. if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { return $downgrade->new($wanted) if $downgrade; my $sgn = $1 || '+'; - $self->{sign} = $sgn . 'inf'; # set a default sign for bstr() - return $self->binf($sgn); + $self = $class -> binf($sgn); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } # Handle explicit NaNs (not the ones returned due to invalid input). @@ -417,142 +446,119 @@ sub new { return $self; } - # Handle hexadecimal numbers. Just like CORE::oct(), we accept octal numbers with - # prefix "0x", "0X", "x", or "X". + # Shortcut for simple forms like '123' that have no trailing zeros. - if ($wanted =~ /^\s*[+-]?0?[Xx]/) { - $self = $class -> from_hex($wanted); + if ($wanted =~ / ^ + \s* # optional leading whitespace + ( [+-]? ) # optional sign + 0* # optional leading zeros + ( [1-9] (?: [0-9]* [1-9] )? ) # significand + \s* # optional trailing whitespace + $ + /x) + { + return $downgrade->new($1 . $2) if $downgrade; + $self->{sign} = $1 || '+'; + $self->{_m} = $LIB -> _new($2); + $self->{_es} = '+'; + $self->{_e} = $LIB -> _zero(); $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; return $self; } - # Handle octal numbers. Just like CORE::oct(), we accept octal numbers with - # prefix "0o", "0O", "o", or "O". If the prefix is just "0", the number must - # have a binary exponent, or else the number is interpreted as decimal. - - if ($wanted =~ / - ^ - \s* - - # sign - [+-]? - - (?: - # prefix - 0? [Oo] - | - - # prefix - 0 - - # significand using the octal digits 0..7 - [0-7]+ (?: _ [0-7]+ )* - (?: - \. - (?: [0-7]+ (?: _ [0-7]+ )* )? - )? - - # exponent (power of 2) using decimal digits - [Pp] - [+-]? - \d+ (?: _ \d+ )* - \s* - $ - ) - /x) + my @parts; + + if ( + # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they + # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct(). + + $wanted =~ /^\s*[+-]?0?[Xx]/ and + @parts = $class -> _hex_str_to_lib_parts($wanted) + + or + + # Handle octal numbers. We auto-detect octal numbers if they have a + # "0o", "0O", "o", "O" prefix, cf. CORE::oct(). + + $wanted =~ /^\s*[+-]?0?[Oo]/ and + @parts = $class -> _oct_str_to_lib_parts($wanted) + + or + + # Handle binary numbers. We auto-detect binary numbers if they have a + # "0b", "0B", "b", or "B" prefix, cf. CORE::oct(). + + $wanted =~ /^\s*[+-]?0?[Bb]/ and + @parts = $class -> _bin_str_to_lib_parts($wanted) + + or + + # At this point, what is left are decimal numbers that aren't handled + # above and octal floating point numbers that don't have any of the + # "0o", "0O", "o", or "O" prefixes. First see if it is a decimal number. + + @parts = $class -> _dec_str_to_lib_parts($wanted) + or + + # See if it is an octal floating point number. The extra check is + # included because _oct_str_to_lib_parts() accepts octal numbers that + # don't have a prefix (this is needed to make it work with, e.g., + # from_oct() that don't require a prefix). However, Perl requires a + # prefix for octal floating point literals. For example, "1p+0" is not + # valid, but "01p+0" and "0__1p+0" are. + + $wanted =~ /^\s*[+-]?0_*\d/ and + @parts = $class -> _oct_str_to_lib_parts($wanted)) { - $self = $class -> from_oct($wanted); - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; - } + # The value is an integer iff the exponent is non-negative. - # Handle binary numbers. Just like CORE::oct(), we accept octal numbers with - # prefix "0b", "0B", "b", or "B". + if ($parts[2] eq '+' && $downgrade) { + #return $downgrade->new($str, @r); + return $downgrade->new($wanted, @r); + } - if ($wanted =~ /^\s*[+-]?0?[Bb]/) { - $self = $class -> from_bin($wanted); - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - # Shortcut for simple forms like '12' that have no trailing zeros. - if ($wanted =~ /^([+-]?)0*([1-9][0-9]*[1-9])$/) { - $self->{_e} = $LIB -> _zero(); - $self->{_es} = '+'; - $self->{sign} = $1 || '+'; - $self->{_m} = $LIB -> _new($2); - if (!$downgrade) { - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; - } - } + # If we get here, the value is neither a valid decimal, binary, octal, or + # hexadecimal number. It is not an explicit Inf or a NaN either. - my ($mis, $miv, $mfv, $es, $ev) = Math::BigInt::_split($wanted); - if (!ref $mis) { - if ($_trap_nan) { - croak("$wanted is not a number initialized to $class"); - } + return $class -> bnan(); +} - return $downgrade->bnan() if $downgrade; +sub from_dec { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; - $self->{_e} = $LIB->_zero(); - $self->{_es} = '+'; - $self->{_m} = $LIB->_zero(); - $self->{sign} = $nan; - } else { - # make integer from mantissa by adjusting exp, then convert to int - $self->{_e} = $LIB->_new($$ev); # exponent - $self->{_es} = $$es || '+'; - my $mantissa = "$$miv$$mfv"; # create mant. - $mantissa =~ s/^0+(\d)/$1/; # strip leading zeros - $self->{_m} = $LIB->_new($mantissa); # create mant. - - # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5 - if (CORE::length($$mfv) != 0) { - my $len = $LIB->_new(CORE::length($$mfv)); - ($self->{_e}, $self->{_es}) = - _e_sub($self->{_e}, $len, $self->{_es}, '+'); - } - # we can only have trailing zeros on the mantissa if $$mfv eq '' - else { - # Use a regexp to count the trailing zeros in $$miv instead of - # _zeros() because that is faster, especially when _m is not stored - # in base 10. - my $zeros = 0; - $zeros = CORE::length($1) if $$miv =~ /[1-9](0*)$/; - if ($zeros != 0) { - my $z = $LIB->_new($zeros); - # turn '120e2' into '12e3' - $self->{_m} = $LIB->_rsft($self->{_m}, $z, 10); - ($self->{_e}, $self->{_es}) = - _e_add($self->{_e}, $z, $self->{_es}, '+'); - } - } - $self->{sign} = $$mis; + # Don't modify constant (read-only) objects. - # for something like 0Ey, set y to 0, and -0 => +0 - # Check $$miv for being '0' and $$mfv eq '', because otherwise _m could not - # have become 0. That's faster than to call $LIB->_is_zero(). - $self->{sign} = '+', $self->{_e} = $LIB->_zero() - if $$miv eq '0' and $$mfv eq ''; + return if $selfref && $self->modify('from_dec'); - if (!$downgrade) { - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; - } - } + my $str = shift; + my @r = @_; + + # If called as a class method, initialize a new object. - # if downgrade, inf, NaN or integers go down + $self = $class -> bzero() unless $selfref; + + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + + # The value is an integer iff the exponent is non-negative. - if ($downgrade && $self->{_es} eq '+') { - if ($LIB->_is_zero($self->{_e})) { - return $downgrade->new($$mis . $LIB->_str($self->{_m})); + if ($parts[2] eq '+' && $downgrade) { + #$str = $parts[0] . $LIB -> _lsft($parts[1], $parts[3], 10); + return $downgrade->new($str, @r); } - return $downgrade->new($self->bsstr()); + + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } - $self->bnorm(); - $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; - return $self; + + return $self -> bnan(@r); } sub from_hex { @@ -565,85 +571,27 @@ sub from_hex { return if $selfref && $self->modify('from_hex'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - - # sign - ( [+-]? ) - - # optional hexadecimal prefix - (?: 0? [Xx] )? - - # significand using the hex digits 0..9 and a..f - ( - [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* - (?: - \. - (?: [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* )? - )? - | - \. - [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* - ) - - # exponent (power of 2) using decimal digits - (?: - [Pp] - ( [+-]? ) - ( \d+ (?: _ \d+ )* ) - )? - - \s* - $ - //x) - { - my $s_sign = $1 || '+'; - my $s_value = $2; - my $e_sign = $3 || '+'; - my $e_value = $4 || '0'; - $s_value =~ tr/_//d; - $e_value =~ tr/_//d; - - # The significand must be multiplied by 2 raised to this exponent. - - my $two_expon = $class -> new($e_value); - $two_expon -> bneg() if $e_sign eq '-'; - - # If there is a dot in the significand, remove it and adjust the - # exponent according to the number of digits in the fraction part of - # the significand. Since the digits in the significand are in base 16, - # but the exponent is only in base 2, multiply the exponent adjustment - # value by log(16) / log(2) = 4. - - my $idx = index($s_value, '.'); - if ($idx >= 0) { - substr($s_value, $idx, 1) = ''; - $two_expon -= $class -> new(CORE::length($s_value)) - -> bsub($idx) - -> bmul("4"); - } + if (my @parts = $class -> _hex_str_to_lib_parts($str)) { - $self -> {sign} = $s_sign; - $self -> {_m} = $LIB -> _from_hex('0x' . $s_value); + # The value is an integer iff the exponent is non-negative. - if ($two_expon > 0) { - my $factor = $class -> new("2") -> bpow($two_expon); - $self -> bmul($factor); - } elsif ($two_expon < 0) { - my $factor = $class -> new("0.5") -> bpow(-$two_expon); - $self -> bmul($factor); + if ($parts[2] eq '+' && $downgrade) { + #$str = $parts[0] . $LIB -> _lsft($parts[1], $parts[3], 10); + return $downgrade -> from_hex($str, @r); } + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - return $self->bnan(); + return $self -> bnan(@r); } sub from_oct { @@ -656,85 +604,27 @@ sub from_oct { return if $selfref && $self->modify('from_oct'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - - # sign - ( [+-]? ) - - # optional octal prefix - (?: 0? [Oo] )? - - # significand using the octal digits 0..7 - ( - [0-7]+ (?: _ [0-7]+ )* - (?: - \. - (?: [0-7]+ (?: _ [0-7]+ )* )? - )? - | - \. - [0-7]+ (?: _ [0-7]+ )* - ) - - # exponent (power of 2) using decimal digits - (?: - [Pp] - ( [+-]? ) - ( \d+ (?: _ \d+ )* ) - )? - - \s* - $ - //x) - { - my $s_sign = $1 || '+'; - my $s_value = $2; - my $e_sign = $3 || '+'; - my $e_value = $4 || '0'; - $s_value =~ tr/_//d; - $e_value =~ tr/_//d; - - # The significand must be multiplied by 2 raised to this exponent. - - my $two_expon = $class -> new($e_value); - $two_expon -> bneg() if $e_sign eq '-'; - - # If there is a dot in the significand, remove it and adjust the - # exponent according to the number of digits in the fraction part of - # the significand. Since the digits in the significand are in base 8, - # but the exponent is only in base 2, multiply the exponent adjustment - # value by log(8) / log(2) = 3. - - my $idx = index($s_value, '.'); - if ($idx >= 0) { - substr($s_value, $idx, 1) = ''; - $two_expon -= $class -> new(CORE::length($s_value)) - -> bsub($idx) - -> bmul("3"); - } + if (my @parts = $class -> _oct_str_to_lib_parts($str)) { - $self -> {sign} = $s_sign; - $self -> {_m} = $LIB -> _from_oct($s_value); + # The value is an integer iff the exponent is non-negative. - if ($two_expon > 0) { - my $factor = $class -> new("2") -> bpow($two_expon); - $self -> bmul($factor); - } elsif ($two_expon < 0) { - my $factor = $class -> new("0.5") -> bpow(-$two_expon); - $self -> bmul($factor); + if ($parts[2] eq '+' && $downgrade) { + #$str = $parts[0] . $LIB -> _lsft($parts[1], $parts[3], 10); + return $downgrade -> from_oct($str, @r); } + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - return $self->bnan(); + return $self -> bnan(@r); } sub from_bin { @@ -747,82 +637,27 @@ sub from_bin { return if $selfref && $self->modify('from_bin'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - - # sign - ( [+-]? ) - - # optional binary prefix - (?: 0? [Bb] )? - - # significand using the binary digits 0 and 1 - ( - [01]+ (?: _ [01]+ )* - (?: - \. - (?: [01]+ (?: _ [01]+ )* )? - )? - | - \. - [01]+ (?: _ [01]+ )* - ) - - # exponent (power of 2) using decimal digits - (?: - [Pp] - ( [+-]? ) - ( \d+ (?: _ \d+ )* ) - )? - - \s* - $ - //x) - { - my $s_sign = $1 || '+'; - my $s_value = $2; - my $e_sign = $3 || '+'; - my $e_value = $4 || '0'; - $s_value =~ tr/_//d; - $e_value =~ tr/_//d; - - # The significand must be multiplied by 2 raised to this exponent. - - my $two_expon = $class -> new($e_value); - $two_expon -> bneg() if $e_sign eq '-'; - - # If there is a dot in the significand, remove it and adjust the - # exponent according to the number of digits in the fraction part of - # the significand. - - my $idx = index($s_value, '.'); - if ($idx >= 0) { - substr($s_value, $idx, 1) = ''; - $two_expon -= $class -> new(CORE::length($s_value)) - -> bsub($idx); - } + if (my @parts = $class -> _bin_str_to_lib_parts($str)) { - $self -> {sign} = $s_sign; - $self -> {_m} = $LIB -> _from_bin('0b' . $s_value); + # The value is an integer iff the exponent is non-negative. - if ($two_expon > 0) { - my $factor = $class -> new("2") -> bpow($two_expon); - $self -> bmul($factor); - } elsif ($two_expon < 0) { - my $factor = $class -> new("0.5") -> bpow(-$two_expon); - $self -> bmul($factor); + if ($parts[2] eq '+' && $downgrade) { + #$str = $parts[0] . $LIB -> _lsft($parts[1], $parts[3], 10); + return $downgrade -> from_bin($str, @r); } + ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - return $self->bnan(); + return $self -> bnan(@r); } sub from_ieee754 { @@ -839,6 +674,7 @@ sub from_ieee754 { my $enc; # significand encoding (applies only to decimal) my $k; # storage width in bits my $b; # base + my @r = @_; if ($format =~ /^binary(\d+)\z/) { $k = $1; @@ -907,7 +743,7 @@ sub from_ieee754 { unless (defined $in) { carp("Input is undefined"); - return $self -> bzero(); + return $self -> bzero(@r); } # Make sure input string is a string of zeros and ones. @@ -978,7 +814,7 @@ sub from_ieee754 { } else { $self = $x; } - return $self; + return $self -> round(@r); } croak("The format '$format' is not yet supported."); @@ -1208,7 +1044,7 @@ sub bpi { # we assume bpi() is called as a function. if (@_ == 0 && - (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/i) + (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/) || !defined($self)) { @@ -1462,7 +1298,7 @@ sub bcmp { # Handle all 'nan' cases. - return undef if ($x->{sign} eq $nan) || ($y->{sign} eq $nan); + return if ($x->{sign} eq $nan) || ($y->{sign} eq $nan); # Handle all '+inf' and '-inf' cases. @@ -1620,9 +1456,9 @@ sub bacmp { # handle +-inf and NaN's if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) { - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - return 0 if ($x->is_inf() && $y->is_inf()); - return 1 if ($x->is_inf() && !$y->is_inf()); + return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return 0 if ($x->is_inf() && $y->is_inf()); + return 1 if ($x->is_inf() && !$y->is_inf()); return -1; } @@ -1825,6 +1661,7 @@ sub badd { my $es; ($e, $es) = _e_sub($e, $x->{_e}, $y->{_es} || '+', $x->{_es}); + #($e, $es) = $LIB -> _ssub($e, $y->{_es} || '+', $x->{_e}, $x->{_es}); my $add = $LIB->_copy($y->{_m}); @@ -1832,6 +1669,9 @@ sub badd { { $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); + #$x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); + #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es); + } elsif (!$LIB->_is_zero($e)) # > 0 { $add = $LIB->_lsft($add, $e, 10); @@ -1844,6 +1684,8 @@ sub badd { } else { ($x->{_m}, $x->{sign}) = _e_add($x->{_m}, $add, $x->{sign}, $y->{sign}); + #($x->{_m}, $x->{sign}) = + # $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $y->{sign}); } # delete trailing zeros, then round @@ -1916,6 +1758,7 @@ sub bmul { # aEb * cEd = (a*c)E(b+d) $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m}); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); + #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es}); $r[3] = $y; # no push! @@ -1953,6 +1796,7 @@ sub bmuladd { # aEb * cEd = (a*c)E(b+d) $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m}); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); + #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es}); $r[3] = $y; # no push! @@ -1970,6 +1814,7 @@ sub bmuladd { my $es; ($e, $es) = _e_sub($e, $x->{_e}, $z->{_es} || '+', $x->{_es}); + #($e, $es) = $LIB -> _ssub($e, $z->{_es} || '+', $x->{_e}, $x->{_es}); my $add = $LIB->_copy($z->{_m}); @@ -1977,6 +1822,8 @@ sub bmuladd { { $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); + #$x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); + #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es); } elsif (!$LIB->_is_zero($e)) # > 0 { $add = $LIB->_lsft($add, $e, 10); @@ -1989,6 +1836,8 @@ sub bmuladd { } else { ($x->{_m}, $x->{sign}) = _e_add($x->{_m}, $add, $x->{sign}, $z->{sign}); + #($x->{_m}, $x->{sign}) = + # $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $z->{sign}); } # delete trailing zeros, then round @@ -2153,8 +2002,12 @@ sub bdiv { # correct exponent of $x ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); + #($x->{_e}, $x->{_es}) + # = $LIB -> _ssub($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es}); # correct for 10**scale ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $LIB->_new($scale), $x->{_es}, '+'); + #($x->{_e}, $x->{_es}) + # = $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($scale), '+'); $x->bnorm(); # remove trailing 0's } } # end else $x != $y @@ -4685,58 +4538,96 @@ sub numify { sub import { my $class = shift; $IMPORT++; # remember we did import() + + my @import = ('objectify'); my @a; # unrecognized arguments - my $lib = ''; - my $lib_kind = 'try'; - for (my $i = 0; $i <= $#_ ; $i++) { - croak "Error in import(): argument with index $i is undefined" - unless defined($_[$i]); + while (@_) { + my $param = shift; + + # Enable overloading of constants. + + if ($param eq ':constant') { + overload::constant - if ($_[$i] eq ':constant') { - # This causes overlord er load to step in. 'binary' and 'integer' - # are handled by BigInt. - overload::constant float => sub { $class->new(shift); }; + integer => sub { + $class -> new(shift); + }, + + float => sub { + $class -> new(shift); + }, + + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; + next; + } + + # Upgrading. + + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; + } + + # Downgrading. + + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; + } + + # Accuracy. + + if ($param eq 'accuracy') { + $class -> accuracy(shift); + next; } - elsif ($_[$i] eq 'upgrade') { - # this causes upgrading - $upgrade = $_[$i+1]; # or undef to disable - $i++; + # Precision. + + if ($param eq 'precision') { + $class -> precision(shift); + next; } - elsif ($_[$i] eq 'downgrade') { - # this causes downgrading - $downgrade = $_[$i+1]; # or undef to disable - $i++; + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; } - elsif ($_[$i] =~ /^(lib|try|only)\z/) { - # alternative library - $lib = $_[$i+1] || ''; - $lib_kind = $1; # "lib", "try", or "only" - $i++; + # Backend library. + + if ($param =~ /^(lib|try|only)\z/) { + push @import, $param; + push @import, shift() if @_; + next; } - elsif ($_[$i] eq 'with') { + if ($param eq 'with') { # alternative class for our private parts() # XXX: no longer supported - # $LIB = $_[$i+1] || 'Calc'; + # $LIB = shift() || 'Calc'; # carp "'with' is no longer supported, use 'lib', 'try', or 'only'"; - $i++; + shift; + next; } - else { - push @a, $_[$i]; - } + # Unrecognized parameter. + + push @a, $param; } - my @import = ('objectify'); - push @import, $lib_kind, $lib if $lib ne ''; Math::BigInt -> import(@import); # find out which one was actually loaded - $LIB = Math::BigInt->config('lib'); + $LIB = Math::BigInt -> config('lib'); $class->export_to_level(1, $class, @a); # export wanted functions } @@ -4998,7 +4889,8 @@ sub _log_10 { } ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $LIB->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23 - + #($x->{_e}, $x->{_es}) = + # $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($dbd), $dbd_sign); } # Now: 0.1 <= $x < 10 (and possible correction in l_10) @@ -5088,6 +4980,7 @@ sub _e_sub { # flip sign $ys = $ys eq '+' ? '-' : '+'; # swap sign of second operand ... _e_add($x, $y, $xs, $ys); # ... and let _e_add() do the job + #$LIB -> _sadd($x, $xs, $y, $ys); # ... and let $LIB -> _sadd() do the job } sub _pow { @@ -5386,7 +5279,8 @@ exactly what you expect. =head2 Input Input values to these routines may be any scalar number or string that looks -like a number and represents a floating point number. +like a number. Anything that is accepted by Perl as a literal numeric constant +should be accepted by this module. =over @@ -5403,19 +5297,22 @@ gives a NaN. And while "0377" gives 255, "0377p0" gives 255. =item * -If the string has a "0x" prefix, it is interpreted as a hexadecimal number. +If the string has a "0x" or "0X" prefix, it is interpreted as a hexadecimal +number. =item * -If the string has a "0o" prefix, it is interpreted as an octal number. +If the string has a "0o" or "0O" prefix, it is interpreted as an octal number. A +floating point literal with a "0" prefix is also interpreted as an octal number. =item * -If the string has a "0b" prefix, it is interpreted as a binary number. +If the string has a "0b" or "0B" prefix, it is interpreted as a binary number. =item * -One underline is allowed between any two digits. +Underline characters are allowed in the same way as they are allowed in literal +numerical constants. =item * @@ -5423,26 +5320,44 @@ If the string can not be interpreted, NaN is returned. =item * -For hexadecimal, octal, and binary numbers, the exponent must be separated from -the significand (mantissa) by the letter "p" or "P", not "e" or "E" as with -decimal numbers. +For hexadecimal, octal, and binary floating point numbers, the exponent must be +separated from the significand (mantissa) by the letter "p" or "P", not "e" or +"E" as with decimal numbers. =back Some examples of valid string input Input string Resulting value + 123 123 1.23e2 123 12300e-2 123 - 0xcafe 51966 - 0XCAFE 51966 - 0o1337 735 - 0O1337 735 - 0b1101 13 - 0B1101 13 + 67_538_754 67538754 -4_5_6.7_8_9e+0_1_0 -4567890000000 + + 0x13a 314 + 0x13ap0 314 + 0x1.3ap+8 314 + 0x0.00013ap+24 314 + 0x13a000p-12 314 + + 0o472 314 + 0o1.164p+8 314 + 0o0.0001164p+20 314 + 0o1164000p-10 314 + + 0472 472 Note! + 01.164p+8 314 + 00.0001164p+20 314 + 01164000p-10 314 + + 0b100111010 314 + 0b1.0011101p+8 314 + 0b0.00010011101p+12 314 + 0b100111010000p-3 314 + 0x1.921fb5p+1 3.14159262180328369140625e+0 0o1.2677025p1 2.71828174591064453125 01.2677025p1 2.71828174591064453125 @@ -5816,76 +5731,103 @@ C<as_number()>: $x = Math::BigFloat->new(2.5); $y = $x->as_number('odd'); # $y = 3 -=head1 Autocreating constants +=head1 NUMERIC LITERALS -After C<use Math::BigFloat ':constant'> all the floating point constants -in the given scope are converted to C<Math::BigFloat>. This conversion -happens at compile time. +After C<use Math::BigFloat ':constant'> all numeric literals in the given scope +are converted to C<Math::BigFloat> objects. This conversion happens at compile +time. -In particular +For example, - perl -MMath::BigFloat=:constant -e 'print 2E-100,"\n"' + perl -MMath::BigFloat=:constant -le 'print 2e-150' -prints the value of C<2E-100>. Note that without conversion of -constants the expression 2E-100 will be calculated as normal floating point -number. +prints the exact value of C<2e-150>. Note that without conversion of constants +the expression C<2e-150> is calculated using Perl scalars, which leads to an +inaccuracte result. -Please note that ':constant' does not affect integer constants, nor binary -nor hexadecimal constants. Use L<bignum> or L<Math::BigInt> to get this to -work. +Note that strings are not affected, so that -=head2 Math library + use Math::BigFloat qw/:constant/; -Math with the numbers is done (by default) by a module called -Math::BigInt::Calc. This is equivalent to saying: + $y = "1234567890123456789012345678901234567890" + + "123456789123456789"; - use Math::BigFloat lib => 'Calc'; +does not give you what you expect. You need an explicit Math::BigFloat->new() +around at least one of the operands. You should also quote large constants to +prevent loss of precision: -You can change this by using: + use Math::BigFloat; - use Math::BigFloat lib => 'GMP'; + $x = Math::BigFloat->new("1234567889123456789123456789123456789"); -B<Note>: General purpose packages should not be explicit about the library -to use; let the script author decide which is best. +Without the quotes Perl converts the large number to a floating point constant +at compile time, and then converts the result to a Math::BigFloat object at +runtime, which results in an inaccurate result. -Note: The keyword 'lib' will warn when the requested library could not be -loaded. To suppress the warning use 'try' instead: +=head2 Hexadecimal, octal, and binary floating point literals - use Math::BigFloat try => 'GMP'; +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. Below are some examples of +different ways to write the number decimal 314. -If your script works with huge numbers and Calc is too slow for them, -you can also for the loading of one of these libraries and if none -of them can be used, the code will die: +Hexadecimal floating point literals: - use Math::BigFloat only => 'GMP,Pari'; + 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 -The following would first try to find Math::BigInt::Foo, then -Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: +Octal floating point literals (with "0" prefix): - use Math::BigFloat lib => 'Foo,Math::BigInt::Bar'; + 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 -See the respective low-level library documentation for further details. +Octal floating point literals (with "0o" prefix) (requires v5.34.0): -Please note that Math::BigFloat does B<not> use the denoted library itself, -but it merely passes the lib argument to Math::BigInt. So, instead of the need -to do: + 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 - use Math::BigInt lib => 'GMP'; - use Math::BigFloat; +Binary floating point literals: -you can roll it all into one line: + 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 - use Math::BigFloat lib => 'GMP'; +=head2 Math library -It is also possible to just require Math::BigFloat: +Math with the numbers is done (by default) by a module called +Math::BigInt::Calc. This is equivalent to saying: - require Math::BigFloat; + use Math::BigFloat lib => "Calc"; + +You can change this by using: + + use Math::BigFloat lib => "GMP"; + +B<Note>: General purpose packages should not be explicit about the library to +use; let the script author decide which is best. -This will load the necessary things (like BigInt) when they are needed, and -automatically. +Note: The keyword 'lib' will warn when the requested library could not be +loaded. To suppress the warning use 'try' instead: + + use Math::BigFloat try => "GMP"; + +If your script works with huge numbers and Calc is too slow for them, you can +also for the loading of one of these libraries and if none of them can be used, +the code will die: + + use Math::BigFloat only => "GMP,Pari"; + +The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar, +and when this also fails, revert to Math::BigInt::Calc: + + use Math::BigFloat lib => "Foo,Math::BigInt::Bar"; + +See the respective low-level library documentation for further details. -See L<Math::BigInt> for more details than you ever wanted to know about using -a different low-level library. +See L<Math::BigInt> for more details about using a different low-level library. =head2 Using Math::BigInt::Lite @@ -6072,8 +6014,7 @@ the same terms as Perl itself. L<Math::BigInt> and L<Math::BigInt> as well as the backends L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>. -The pragmas L<bignum>, L<bigint> and L<bigrat> also might be of interest -because they solve the autoupgrading/downgrading issue, at least partly. +The pragmas L<bignum>, L<bigint> and L<bigrat>. =head1 AUTHORS diff --git a/cpan/Math-BigInt/lib/Math/BigInt.pm b/cpan/Math-BigInt/lib/Math/BigInt.pm index 82d289752e..84c4bcdcf4 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt.pm @@ -20,9 +20,10 @@ use 5.006001; use strict; use warnings; -use Carp qw< carp croak >; +use Carp qw< carp croak >; +use Scalar::Util qw< blessed >; -our $VERSION = '1.999823'; +our $VERSION = '1.999827'; require Exporter; our @ISA = qw(Exporter); @@ -45,44 +46,44 @@ use overload '+' => sub { $_[0] -> copy() -> badd($_[1]); }, - '-' => sub { my $c = $_[0] -> copy; + '-' => sub { my $c = $_[0] -> copy(); $_[2] ? $c -> bneg() -> badd($_[1]) : $c -> bsub($_[1]); }, '*' => sub { $_[0] -> copy() -> bmul($_[1]); }, '/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0]) - : $_[0] -> copy -> bdiv($_[1]); }, + : $_[0] -> copy() -> bdiv($_[1]); }, '%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0]) - : $_[0] -> copy -> bmod($_[1]); }, + : $_[0] -> copy() -> bmod($_[1]); }, '**' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0]) - : $_[0] -> copy -> bpow($_[1]); }, + : $_[0] -> copy() -> bpow($_[1]); }, '<<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blsft($_[0]) - : $_[0] -> copy -> blsft($_[1]); }, + : $_[0] -> copy() -> blsft($_[1]); }, '>>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> brsft($_[0]) - : $_[0] -> copy -> brsft($_[1]); }, + : $_[0] -> copy() -> brsft($_[1]); }, # overload key: assign - '+=' => sub { $_[0]->badd($_[1]); }, + '+=' => sub { $_[0] -> badd($_[1]); }, - '-=' => sub { $_[0]->bsub($_[1]); }, + '-=' => sub { $_[0] -> bsub($_[1]); }, - '*=' => sub { $_[0]->bmul($_[1]); }, + '*=' => sub { $_[0] -> bmul($_[1]); }, - '/=' => sub { scalar $_[0]->bdiv($_[1]); }, + '/=' => sub { scalar $_[0] -> bdiv($_[1]); }, - '%=' => sub { $_[0]->bmod($_[1]); }, + '%=' => sub { $_[0] -> bmod($_[1]); }, - '**=' => sub { $_[0]->bpow($_[1]); }, + '**=' => sub { $_[0] -> bpow($_[1]); }, - '<<=' => sub { $_[0]->blsft($_[1]); }, + '<<=' => sub { $_[0] -> blsft($_[1]); }, - '>>=' => sub { $_[0]->brsft($_[1]); }, + '>>=' => sub { $_[0] -> brsft($_[1]); }, # 'x=' => sub { }, @@ -116,13 +117,13 @@ use overload # overload key: str_comparison -# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0]) +# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0]) # : $_[0] -> bstrlt($_[1]); }, # # 'le' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0]) # : $_[0] -> bstrle($_[1]); }, # -# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0]) +# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0]) # : $_[0] -> bstrgt($_[1]); }, # # 'ge' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0]) @@ -135,17 +136,17 @@ use overload # overload key: binary '&' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0]) - : $_[0] -> copy -> band($_[1]); }, + : $_[0] -> copy() -> band($_[1]); }, '&=' => sub { $_[0] -> band($_[1]); }, '|' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0]) - : $_[0] -> copy -> bior($_[1]); }, + : $_[0] -> copy() -> bior($_[1]); }, '|=' => sub { $_[0] -> bior($_[1]); }, '^' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0]) - : $_[0] -> copy -> bxor($_[1]); }, + : $_[0] -> copy() -> bxor($_[1]); }, '^=' => sub { $_[0] -> bxor($_[1]); }, @@ -182,9 +183,9 @@ use overload 'atan2' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0]) : $_[0] -> copy() -> batan2($_[1]); }, - 'cos' => sub { $_[0] -> copy -> bcos(); }, + 'cos' => sub { $_[0] -> copy() -> bcos(); }, - 'sin' => sub { $_[0] -> copy -> bsin(); }, + 'sin' => sub { $_[0] -> copy() -> bsin(); }, 'exp' => sub { $_[0] -> copy() -> bexp($_[1]); }, @@ -204,7 +205,7 @@ use overload '0+' => sub { $_[0] -> numify(); }, - '=' => sub { $_[0]->copy(); }, + '=' => sub { $_[0] -> copy(); }, ; @@ -228,11 +229,14 @@ our $_trap_inf = 0; # are infs ok? set w/ config() my $nan = 'NaN'; # constants for easier life +# Module to do the low level math. + my $DEFAULT_LIB = 'Math::BigInt::Calc'; -my $LIB; # module to do the low level math - # default is Calc.pm -my $IMPORT = 0; # was import() called yet? - # used to make require work +my $LIB; + +# Has import() been called yet? Needed to make "require" work. + +my $IMPORT = 0; ############################################################################## # the old code had $rnd_mode, so we need to support it, too @@ -530,49 +534,54 @@ sub new { my $selfref = ref $self; my $class = $selfref || $self; - # The POD says: - # - # "Currently, Math::BigInt->new() defaults to 0, while Math::BigInt->new('') - # results in 'NaN'. This might change in the future, so use always the - # following explicit forms to get a zero or NaN: - # $zero = Math::BigInt->bzero(); - # $nan = Math::BigInt->bnan(); - # - # But although this use has been discouraged for more than 10 years, people - # apparently still use it, so we still support it. + # Make "require" work. - return $self->bzero() unless @_; + $class -> import() if $IMPORT == 0; - my ($wanted, $a, $p, $r) = @_; + # Although this use has been discouraged for more than 10 years, people + # apparently still use it, so we still support it. - # Always return a new object, so if called as an instance method, copy the - # invocand, and if called as a class method, initialize a new object. + return $class -> bzero() unless @_; - $self = $selfref ? $self -> copy() - : bless {}, $class; + my ($wanted, @r) = @_; - unless (defined $wanted) { - #carp("Use of uninitialized value in new()"); - return $self->bzero($a, $p, $r); + if (!defined($wanted)) { + #if (warnings::enabled("uninitialized")) { + # warnings::warn("uninitialized", + # "Use of uninitialized value in new()"); + #} + return $class -> bzero(@r); } - if (ref($wanted) && $wanted->isa($class)) { # MBI or subclass - # Using "$copy = $wanted -> copy()" here fails some tests. Fixme! - my $copy = $class -> copy($wanted); - if ($selfref) { - %$self = %$copy; - } else { - $self = $copy; - } - return $self; + if (!ref($wanted) && $wanted eq "") { + #if (warnings::enabled("numeric")) { + # warnings::warn("numeric", + # q|Argument "" isn't numeric in new()|); + #} + #return $class -> bzero(@r); + return $class -> bnan(@r); } - $class->import() if $IMPORT == 0; # make require work + # Initialize a new object. + + $self = bless {}, $class; + + # Math::BigInt or subclass + + if (defined(blessed($wanted)) && $wanted -> isa($class)) { + + # We don't copy the accuracy and precision, because a new object should + # get them from the global configuration. + + $self -> {sign} = $wanted -> {sign}; + $self -> {value} = $LIB -> _copy($wanted -> {value}); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; + } # Shortcut for non-zero scalar integers with no non-zero exponent. - if (!ref($wanted) && - $wanted =~ / ^ + if ($wanted =~ / ^ ([+-]?) # optional sign ([1-9][0-9]*) # non-zero significand (\.0*)? # ... with optional zero fraction @@ -584,16 +593,7 @@ sub new { my $abs = $2; $self->{sign} = $sgn || '+'; $self->{value} = $LIB->_new($abs); - - no strict 'refs'; - if (defined($a) || defined($p) - || defined(${"${class}::precision"}) - || defined(${"${class}::accuracy"})) - { - $self->round($a, $p, $r) - unless @_ >= 3 && !defined $a && !defined $p; - } - + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } @@ -601,123 +601,118 @@ sub new { if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { my $sgn = $1 || '+'; - $self->{sign} = $sgn . 'inf'; # set a default sign for bstr() - return $class->binf($sgn); + $self = $class -> binf($sgn); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } # Handle explicit NaNs (not the ones returned due to invalid input). if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) { $self = $class -> bnan(); - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); return $self; } - # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they - # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct(). + my @parts; - if ($wanted =~ /^\s*[+-]?0?[Xx]/) { - $self = $class -> from_hex($wanted); - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; - return $self; - } + if ( + # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they + # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct(). - # Handle octal numbers. We auto-detect octal numbers if they have a "0o", - # "0O", "o", "O" prefix, cf. CORE::oct(). + $wanted =~ /^\s*[+-]?0?[Xx]/ and + @parts = $class -> _hex_str_to_lib_parts($wanted) - if ($wanted =~ /^\s*[+-]?0?[Oo]/) { - $self = $class -> from_oct($wanted); - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; - return $self; - } + or - # Handle binary numbers. We auto-detect binary numbers if they have a "0b", - # "B", "b", or "B" prefix, cf. CORE::oct(). + # Handle octal numbers. We auto-detect octal numbers if they have a + # "0o", "0O", "o", "O" prefix, cf. CORE::oct(). - if ($wanted =~ /^\s*[+-]?0?[Bb]/) { - $self = $class -> from_bin($wanted); - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; - return $self; - } + $wanted =~ /^\s*[+-]?0?[Oo]/ and + @parts = $class -> _oct_str_to_lib_parts($wanted) - # Split string into mantissa, exponent, integer, fraction, value, and sign. - my ($mis, $miv, $mfv, $es, $ev) = _split($wanted); - if (!ref $mis) { - if ($_trap_nan) { - croak("$wanted is not a number in $class"); - } - $self->{value} = $LIB->_zero(); - $self->{sign} = $nan; - return $self; - } + or - if (!ref $miv) { - # _from_hex or _from_bin - $self->{value} = $mis->{value}; - $self->{sign} = $mis->{sign}; - return $self; # throw away $mis - } + # Handle binary numbers. We auto-detect binary numbers if they have a + # "0b", "0B", "b", or "B" prefix, cf. CORE::oct(). - # Make integer from mantissa by adjusting exponent, then convert to a - # Math::BigInt. - $self->{sign} = $$mis; # store sign - $self->{value} = $LIB->_zero(); # for all the NaN cases - my $e = int("$$es$$ev"); # exponent (avoid recursion) - if ($e > 0) { - my $diff = $e - CORE::length($$mfv); - if ($diff < 0) { # Not integer - if ($_trap_nan) { - croak("$wanted not an integer in $class"); - } - #print "NOI 1\n"; - return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; - $self->{sign} = $nan; - } else { # diff >= 0 - # adjust fraction and add it to value - #print "diff > 0 $$miv\n"; - $$miv = $$miv . ($$mfv . '0' x $diff); + $wanted =~ /^\s*[+-]?0?[Bb]/ and + @parts = $class -> _bin_str_to_lib_parts($wanted) + + or + + # At this point, what is left are decimal numbers that aren't handled + # above and octal floating point numbers that don't have any of the + # "0o", "0O", "o", or "O" prefixes. First see if it is a decimal number. + + @parts = $class -> _dec_str_to_lib_parts($wanted) + or + + # See if it is an octal floating point number. The extra check is + # included because _oct_str_to_lib_parts() accepts octal numbers that + # don't have a prefix (this is needed to make it work with, e.g., + # from_oct() that don't require a prefix). However, Perl requires a + # prefix for octal floating point literals. For example, "1p+0" is not + # valid, but "01p+0" and "0__1p+0" are. + + $wanted =~ /^\s*[+-]?0_*\d/ and + @parts = $class -> _oct_str_to_lib_parts($wanted)) + { + # The value is an integer iff the exponent is non-negative. + + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } + + # If we get here, the value is a valid number, but it is not an integer. + + return $upgrade -> new($wanted, @r) if defined $upgrade; + return $class -> bnan(); } - else { - if ($$mfv ne '') { # e <= 0 - # fraction and negative/zero E => NOI - if ($_trap_nan) { - croak("$wanted not an integer in $class"); - } - #print "NOI 2 \$\$mfv '$$mfv'\n"; - return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; - $self->{sign} = $nan; - } elsif ($e < 0) { - # xE-y, and empty mfv - # Split the mantissa at the decimal point. E.g., if - # $$miv = 12345 and $e = -2, then $frac = 45 and $$miv = 123. - - my $frac = substr($$miv, $e); # $frac is fraction part - substr($$miv, $e) = ""; # $$miv is now integer part - - if ($frac =~ /[^0]/) { - if ($_trap_nan) { - croak("$wanted not an integer in $class"); - } - #print "NOI 3\n"; - return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; - $self->{sign} = $nan; - } + # If we get here, the value is neither a valid decimal, binary, octal, or + # hexadecimal number. It is not explicit an Inf or a NaN either. + + return $class -> bnan(); +} + +# Create a Math::BigInt from a decimal string. This is an equivalent to +# from_hex(), from_oct(), and from_bin(). It is like new() except that it does +# not accept anything but a string representing a finite decimal number. + +sub from_dec { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + # Don't modify constant (read-only) objects. + + return if $selfref && $self->modify('from_dec'); + + my $str = shift; + my @r = @_; + + # If called as a class method, initialize a new object. + + $self = $class -> bzero() unless $selfref; + + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + + # The value is an integer iff the exponent is non-negative. + + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + return $self -> round(@r); } - } - unless ($self->{sign} eq $nan) { - $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0 - $self->{value} = $LIB->_new($$miv) if $self->{sign} =~ /^[+-]$/; + return $upgrade -> new($str, @r) if defined $upgrade; } - # If any of the globals are set, use them to round, and store them inside - # $self. Do not round for new($x, undef, undef) since that is used by MBF - # to signal no rounding. - - $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p; - $self; + return $self -> bnan(@r); } # Create a Math::BigInt from a hexadecimal string. @@ -732,48 +727,26 @@ sub from_hex { return if $selfref && $self->modify('from_hex'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - ( [+-]? ) - ( 0? [Xx] )? - ( - [0-9a-fA-F]* - ( _ [0-9a-fA-F]+ )* - ) - \s* - $ - //x) - { - # Get a "clean" version of the string, i.e., non-emtpy and with no - # underscores or invalid characters. - - my $sign = $1; - my $chrs = $3; - $chrs =~ tr/_//d; - $chrs = '0' unless CORE::length $chrs; - - # The library method requires a prefix. + if (my @parts = $class -> _hex_str_to_lib_parts($str)) { - $self->{value} = $LIB->_from_hex('0x' . $chrs); + # The value is an integer iff the exponent is non-negative. - # Place the sign. - - $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value}) - ? '-' : '+'; + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + return $self -> round(@r); + } - return $self; + return $upgrade -> new($str, @r) if defined $upgrade; } - # CORE::hex() parses as much as it can, and ignores any trailing garbage. - # For backwards compatibility, we return NaN. - - return $self->bnan(); + return $self -> bnan(@r); } # Create a Math::BigInt from an octal string. @@ -788,48 +761,26 @@ sub from_oct { return if $selfref && $self->modify('from_oct'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - ( [+-]? ) - ( 0? [Oo] )? - ( - [0-7]* - ( _ [0-7]+ )* - ) - \s* - $ - //x) - { - # Get a "clean" version of the string, i.e., non-emtpy and with no - # underscores or invalid characters. - - my $sign = $1; - my $chrs = $3; - $chrs =~ tr/_//d; - $chrs = '0' unless CORE::length $chrs; - - # The library method requires a prefix. + if (my @parts = $class -> _oct_str_to_lib_parts($str)) { - $self->{value} = $LIB->_from_oct('0' . $chrs); + # The value is an integer iff the exponent is non-negative. - # Place the sign. - - $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value}) - ? '-' : '+'; + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + return $self -> round(@r); + } - return $self; + return $upgrade -> new($str, @r) if defined $upgrade; } - # CORE::oct() parses as much as it can, and ignores any trailing garbage. - # For backwards compatibility, we return NaN. - - return $self->bnan(); + return $self -> bnan(@r); } # Create a Math::BigInt from a binary string. @@ -844,49 +795,26 @@ sub from_bin { return if $selfref && $self->modify('from_bin'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; - if ($str =~ s/ - ^ - \s* - ( [+-]? ) - ( 0? [Bb] )? - ( - [01]* - ( _ [01]+ )* - ) - \s* - $ - //x) - { - # Get a "clean" version of the string, i.e., non-emtpy and with no - # underscores or invalid characters. - - my $sign = $1; - my $chrs = $3; - $chrs =~ tr/_//d; - $chrs = '0' unless CORE::length $chrs; - - # The library method requires a prefix. + if (my @parts = $class -> _bin_str_to_lib_parts($str)) { - $self->{value} = $LIB->_from_bin('0b' . $chrs); + # The value is an integer iff the exponent is non-negative. - # Place the sign. - - $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value}) - ? '-' : '+'; + if ($parts[2] eq '+') { + $self -> {sign} = $parts[0]; + $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); + return $self -> round(@r); + } - return $self; + return $upgrade -> new($str, @r) if defined $upgrade; } - # For consistency with from_hex() and from_oct(), we return NaN when the - # input is invalid. - - return $self->bnan(); - + return $self -> bnan(@r); } # Create a Math::BigInt from a byte string. @@ -904,13 +832,14 @@ sub from_bytes { unless $LIB->can('_from_bytes'); my $str = shift; + my @r = @_; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; $self -> {sign} = '+'; $self -> {value} = $LIB -> _from_bytes($str); - return $self; + return $self -> round(@r); } sub from_base { @@ -954,7 +883,7 @@ sub from_base { $self -> {sign} = '+'; $self -> {value} = $LIB->_from_base($str, $base -> {value}, @_ ? shift() : ()); - return $self + return $self; } sub from_base_num { @@ -983,6 +912,8 @@ sub from_base_num { my $base = shift; $base = $class -> new($base) unless ref($base) && $base -> isa($class); + my @r = @_; + # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; @@ -994,7 +925,7 @@ sub from_base_num { $self -> {value} = $LIB -> _from_base_num([ map { $_ -> {value} } @$nums ], $base -> {value}); - return $self; + return $self -> round(@r); } sub bzero { @@ -1175,24 +1106,86 @@ sub bnan { $self -> {sign} = $nan; $self -> {value} = $LIB -> _zero(); + # If rounding parameters are given as arguments, use them. If no rounding + # parameters are given, and if called as a class method initialize the new + # instance with the class variables. + + if (@_) { + croak "can't specify both accuracy and precision" + if @_ >= 2 && defined $_[0] && defined $_[1]; + $self->{_a} = $_[0]; + $self->{_p} = $_[1]; + } else { + unless($selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); + } + } + return $self; } sub bpi { - # Calculate PI to N digits. Unless upgrading is in effect, returns the - # result truncated to an integer, that is, always returns '3'. - my ($self, $n) = @_; - if (@_ == 1) { - # called like Math::BigInt::bpi(10); - $n = $self; - $self = __PACKAGE__; + + # Called as Argument list + # --------- ------------- + # Math::BigInt->bpi() ("Math::BigInt") + # Math::BigInt->bpi(10) ("Math::BigInt", 10) + # $x->bpi() ($x) + # $x->bpi(10) ($x, 10) + # Math::BigInt::bpi() () + # Math::BigInt::bpi(10) (10) + # + # In ambiguous cases, we favour the OO-style, so the following case + # + # $n = Math::BigInt->new("10"); + # $x = Math::BigInt->bpi($n); + # + # which gives an argument list with the single element $n, is resolved as + # + # $n->bpi(); + + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + my @r; # rounding paramters + + # If bpi() is called as a function ... + # + # This cludge is necessary because we still support bpi() as a function. If + # bpi() is called with either no argument or one argument, and that one + # argument is either undefined or a scalar that looks like a number, then + # we assume bpi() is called as a function. + + if (@_ == 0 && + (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/) + || + !defined($self)) + { + $r[0] = $self; + $class = __PACKAGE__; + $self = bless {}, $class; + } + + # ... or if bpi() is called as a method ... + + else { + @r = @_; + if ($selfref) { # bpi() called as instance method + return $self if $self -> modify('bpi'); + } else { # bpi() called as class method + $self = bless {}, $class; + } } - $self = ref($self) if ref($self); - return $upgrade->new($n) if defined $upgrade; + return $upgrade -> bpi(@r) if defined $upgrade; # hard-wired to "3" - $self->new(3); + $self -> {sign} = '+'; + $self -> {value} = $LIB -> _new("3"); + $self -> round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]); + return $self; } sub copy { @@ -1344,8 +1337,8 @@ sub bcmp { if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # handle +-inf and NaN - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; + return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; return +1 if $x->{sign} eq '+inf'; return -1 if $x->{sign} eq '-inf'; return -1 if $y->{sign} eq '+inf'; @@ -1384,7 +1377,7 @@ sub bacmp { if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # handle +-inf and NaN - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; return -1; @@ -4137,9 +4130,13 @@ sub objectify { no strict 'refs'; - # What we upgrade to, if anything. + # What we upgrade to, if anything. Note that we need the whole chain of + # upgrading, because we accept objects that go through multiple upgrades, + # e.g., when Math::BigInt upgrades to Math::BigFloat which upgrades to + # Math::BigRat. We delay getting the chain until we actually need it. - my $up = ${"$a[0]::upgrade"}; + my @upg = (); + my $have_upgrade_chain = 0; # Disable downgrading, because Math::BigFloat -> foo('1.0', '2.0') needs # floats. @@ -4150,7 +4147,7 @@ sub objectify { ${"$a[0]::downgrade"} = undef; } - for my $i (1 .. $count) { + ARG: for my $i (1 .. $count) { my $ref = ref $a[$i]; @@ -4167,8 +4164,19 @@ sub objectify { # Upgrading is OK, so skip further tests if the argument is upgraded. - if (defined $up && $ref -> isa($up)) { - next; + unless ($have_upgrade_chain) { + my $cls = $class; + my $upg = $cls -> upgrade(); + while (defined $upg) { + push @upg, $upg; + $cls = $upg; + $upg = $cls -> upgrade(); + } + $have_upgrade_chain = 1; + } + + for my $upg (@upg) { + next ARG if $ref -> isa($upg); } # See if we can call one of the as_xxx() methods. We don't know whether @@ -4227,129 +4235,174 @@ sub import { my $class = shift; $IMPORT++; # remember we did import() my @a; # unrecognized arguments - my @libs; # backend libriaries - my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die - for (my $i = 0; $i <= $#_ ; $i++) { - croak "Error in import(): argument with index $i is undefined" - unless defined($_[$i]); + while (@_) { + my $param = shift; # Enable overloading of constants. - if ($_[$i] eq ':constant') { + if ($param eq ':constant') { overload::constant - integer => sub { $class->new(shift) }, - binary => sub { $class->new(shift) }; + + integer => sub { + $class -> new(shift); + }, + + float => sub { + $class -> new(shift); + }, + + binary => sub { + # E.g., a literal 0377 shall result in an object whose value + # is decimal 255, but new("0377") returns decimal 377. + return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; + $class -> new(shift); + }; + next; } - # Enable/disable upgrading. + # Upgrading. - elsif ($_[$i] eq 'upgrade') { - $upgrade = $_[$i+1]; # undef to disable - $i++; + if ($param eq 'upgrade') { + $class -> upgrade(shift); + next; } - # Use a user-specified backend libray. + # Downgrading. - elsif ($_[$i] =~ /^(lib|try|only)\z/) { + if ($param eq 'downgrade') { + $class -> downgrade(shift); + next; + } + + # Accuracy. + + if ($param eq 'accuracy') { + $class -> accuracy(shift); + next; + } + + # Precision. + + if ($param eq 'precision') { + $class -> precision(shift); + next; + } + + # Rounding mode. + + if ($param eq 'round_mode') { + $class -> round_mode(shift); + next; + } + + # Backend library. + + if ($param =~ /^(lib|try|only)\z/) { # try => 0 (no warn if unavailable module) # lib => 1 (warn on fallback) # only => 2 (die on fallback) - $warn_or_die = 1 if $_[$i] eq 'lib'; - $warn_or_die = 2 if $_[$i] eq 'only'; - - # Get and check the list of libraries. - - my $userlibs = $_[$i+1]; - croak "Library argument for import parameter '$_[$i]' is undefined" - unless defined($userlibs); - $userlibs =~ s/^\s+//; - $userlibs =~ s/\s+$//; - my @userlibs = split /\s*,\s*/, $userlibs; - carp "Argument for import parameter '$_[$i]' contains no libraries" - unless @userlibs; - - for my $lib (@userlibs) { - # Limit to sane characters. Should we warn about invalid - # characters, i.e., invalid module names? - $lib =~ tr/a-zA-Z0-9_://cd; - if (CORE::length $lib) { - $lib = "Math::BigInt::$lib" if $lib !~ /^Math::BigInt::/i; - push @libs, $lib; - next; - } - carp "Specified library name is empty or invalid"; - } - $i++; - } + # Get the list of user-specified libraries. - else { - push @a, $_[$i]; - } - } + croak "Library argument for import parameter '$param' is missing" + unless @_; + my $libs = shift; + croak "Library argument for import parameter '$param' is undefined" + unless defined($libs); - # Any non ':constant' stuff is handled by our parent, Exporter + # Check and clean up the list of user-specified libraries. - if (@a > 0) { - $class->SUPER::import(@a); # need it for subclasses - $class->export_to_level(1, $class, @a); # need it for MBF - } + my @libs; + for my $lib (split /,/, $libs) { + $lib =~ s/^\s+//; + $lib =~ s/\s+$//; - if (@libs) { + if ($lib =~ /[^a-zA-Z0-9_:]/) { + carp "Library name '$lib' contains invalid characters"; + next; + } - # Try to load the specified libraries, if any. + if (! CORE::length $lib) { + carp "Library name is empty"; + next; + } - my $numfail = 0; # increment for each lib that fails to load - for (my $i = 0 ; $i <= $#libs ; $i++) { - my $lib = $libs[$i]; - eval "require $lib"; - unless ($@) { - $LIB = $lib; - last; + $lib = "Math::BigInt::$lib" if $lib !~ /^Math::BigInt::/i; + + # If a library has already been loaded, that is OK only if the + # requested library is identical to the loaded one. + + if (defined($LIB)) { + if ($lib ne $LIB) { + #carp "Library '$LIB' has already been loaded, so", + # " ignoring requested library '$lib'"; + } + next; + } + + push @libs, $lib; } - $numfail++; - } - # All attempts to load a library failed. + next if defined $LIB; - if ($numfail == @libs) { + croak "Library list contains no valid libraries" unless @libs; - # The fallback library is either the most recently loaded library, - # or the default library, if no library has been successfully yet. + # Try to load the specified libraries, if any. - my $FALLBACK_LIB = defined($LIB) ? $LIB : $DEFAULT_LIB; + for (my $i = 0 ; $i <= $#libs ; $i++) { + my $lib = $libs[$i]; + eval "require $lib"; + unless ($@) { + $LIB = $lib; + last; + } + } + + next if defined $LIB; - # If the user requested a specific list of modules and didn't allow - # a fallback. + # No library has been loaded, and none of the requested libraries + # could be loaded, and fallback and the user doesn't allow fallback. - if ($warn_or_die == 2) { + if ($param eq 'only') { croak "Couldn't load the specified math lib(s) ", join(", ", map "'$_'", @libs), - ", and fallback to '$FALLBACK_LIB' is disallowed"; + ", and fallback to '$DEFAULT_LIB' is not allowed"; } - # The user accepts the use of a fallback library, so try to load it. - # Note that it might already have been loaded successfully, but we - # don't know that, and there is minimal overhead in trying to load - # it again. + # No library has been loaded, and none of the requested libraries + # could be loaded, but the user accepts the use of a fallback + # library, so try to load it. - eval "require $FALLBACK_LIB"; + eval "require $DEFAULT_LIB"; if ($@) { croak "Couldn't load the specified math lib(s) ", join(", ", map "'$_'", @libs), - ", not even the fallback lib '$FALLBACK_LIB'"; + ", not even the fallback lib '$DEFAULT_LIB'"; } - # The fallback library was successfully loaded, but the user might - # want to know that we are using the fallback. + # The fallback library was successfully loaded, but the user + # might want to know that we are using the fallback. - if ($warn_or_die == 1) { + if ($param eq 'lib') { carp "Couldn't load the specified math lib(s) ", join(", ", map "'$_'", @libs), - ", so using fallback lib '$FALLBACK_LIB'"; + ", so using fallback lib '$DEFAULT_LIB'"; } + + next; } + + # Unrecognized parameter. + + push @a, $param; + } + + # Any non-':constant' stuff is handled by our parent, Exporter + + if (@a) { + $class->SUPER::import(@a); # need it for subclasses + $class->export_to_level(1, $class, @a); # need it for Math::BigFlaot } # We might not have loaded any backend library yet, either because the user @@ -4368,79 +4421,6 @@ sub import { # import done } -sub _split_dec_string { - my $str = shift; - - if ($str =~ s/ - ^ - - # leading whitespace - ( \s* ) - - # optional sign - ( [+-]? ) - - # significand - ( - \d+ (?: _ \d+ )* - (?: - \. - (?: \d+ (?: _ \d+ )* )? - )? - | - \. - \d+ (?: _ \d+ )* - ) - - # optional exponent - (?: - [Ee] - ( [+-]? ) - ( \d+ (?: _ \d+ )* ) - )? - - # trailing stuff - ( \D .*? )? - - \z - //x) { - my $leading = $1; - my $significand_sgn = $2 || '+'; - my $significand_abs = $3; - my $exponent_sgn = $4 || '+'; - my $exponent_abs = $5 || '0'; - my $trailing = $6; - - # Remove underscores and leading zeros. - - $significand_abs =~ tr/_//d; - $exponent_abs =~ tr/_//d; - - $significand_abs =~ s/^0+(.)/$1/; - $exponent_abs =~ s/^0+(.)/$1/; - - # If the significand contains a dot, remove it and adjust the exponent - # accordingly. E.g., "1234.56789e+3" -> "123456789e-2" - - my $idx = index $significand_abs, '.'; - if ($idx > -1) { - $significand_abs =~ s/0+\z//; - substr($significand_abs, $idx, 1) = ''; - my $exponent = $exponent_sgn . $exponent_abs; - $exponent .= $idx - CORE::length($significand_abs); - $exponent_abs = abs $exponent; - $exponent_sgn = $exponent < 0 ? '-' : '+'; - } - - return($leading, - $significand_sgn, $significand_abs, - $exponent_sgn, $exponent_abs, - $trailing); - } - - return undef; -} - sub _split { # input: num_str; output: undef for invalid or # (\$mantissa_sign, \$mantissa_value, \$mantissa_fraction, @@ -4508,6 +4488,49 @@ sub _split { return; # NaN, not a number } +sub _e_add { + # Internal helper sub to take two positive integers and their signs and + # then add them. Input ($LIB, $LIB, ('+'|'-'), ('+'|'-')), output + # ($LIB, ('+'|'-')). + + my ($x, $y, $xs, $ys) = @_; + + # if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8) + if ($xs eq $ys) { + $x = $LIB->_add($x, $y); # +a + +b or -a + -b + } else { + my $a = $LIB->_acmp($x, $y); + if ($a == 0) { + # This does NOT modify $x in-place. TODO: Fix this? + $x = $LIB->_zero(); # result is 0 + $xs = '+'; + return ($x, $xs); + } + if ($a > 0) { + $x = $LIB->_sub($x, $y); # abs sub + } else { # a < 0 + $x = $LIB->_sub ($y, $x, 1); # abs sub + $xs = $ys; + } + } + + $xs = '+' if $xs eq '-' && $LIB->_is_zero($x); # no "-0" + + return ($x, $xs); +} + +sub _e_sub { + # Internal helper sub to take two positive integers and their signs and + # then subtract them. Input ($LIB, $LIB, ('+'|'-'), ('+'|'-')), + # output ($LIB, ('+'|'-')) + my ($x, $y, $xs, $ys) = @_; + + # flip sign + $ys = $ys eq '+' ? '-' : '+'; # swap sign of second operand ... + _e_add($x, $y, $xs, $ys); # ... and let _e_add() do the job + #$LIB -> _sadd($x, $xs, $y, $ys); # ... and let $LIB -> _sadd() do the job +} + sub _trailing_zeros { # return the amount of trailing zeros in $x (as scalar) my $x = shift; @@ -4596,6 +4619,635 @@ sub _find_round_parameters { ($self, $a, $p, $r); } +# Trims the sign of the significand, the (absolute value of the) significand, +# the sign of the exponent, and the (absolute value of the) exponent. The +# returned values have no underscores ("_") or unnecessary leading or trailing +# zeros. + +sub _trim_split_parts { + shift; + + my $sig_sgn = shift() || '+'; + my $sig_str = shift() || '0'; + my $exp_sgn = shift() || '+'; + my $exp_str = shift() || '0'; + + $sig_str =~ tr/_//d; # "1.0_0_0" -> "1.000" + $sig_str =~ s/^0+//; # "01.000" -> "1.000" + $sig_str =~ s/\.0*$// # "1.000" -> "1" + || $sig_str =~ s/(\..*[^0])0+$/$1/; # "1.010" -> "1.01" + $sig_str = '0' unless CORE::length($sig_str); + + return '+', '0', '+', '0' if $sig_str eq '0'; + + $exp_str =~ tr/_//d; # "01_234" -> "01234" + $exp_str =~ s/^0+//; # "01234" -> "1234" + $exp_str = '0' unless CORE::length($exp_str); + + return $sig_sgn, $sig_str, $exp_sgn, $exp_str; +} + +# Takes any string representing a valid decimal number and splits it into four +# strings: the sign of the significand, the absolute value of the significand, +# the sign of the exponent, and the absolute value of the exponent. Both the +# significand and the exponent are in base 10. +# +# Perl accepts literals like the following. The value is 100.1. +# +# 1__0__.__0__1__e+0__1__ (prints "Misplaced _ in number") +# 1_0.0_1e+0_1 +# +# Strings representing decimal numbers do not allow underscores, so only the +# following is valid +# +# "10.01e+01" + +sub _dec_str_to_str_parts { + my $class = shift; + my $str = shift; + + if ($str =~ / + ^ + + # optional leading whitespace + \s* + + # optional sign + ( [+-]? ) + + # significand + ( + # integer part and optional fraction part ... + \d+ (?: _+ \d+ )* _* + (?: + \. + (?: _* \d+ (?: _+ \d+ )* _* )? + )? + | + # ... or mandatory fraction part + \. + \d+ (?: _+ \d+ )* _* + ) + + # optional exponent + (?: + [Ee] + ( [+-]? ) + ( \d+ (?: _+ \d+ )* _* ) + )? + + # optional trailing whitespace + \s* + + $ + /x) + { + return $class -> _trim_split_parts($1, $2, $3, $4); + } + + return; +} + +# Takes any string representing a valid hexadecimal number and splits it into +# four strings: the sign of the significand, the absolute value of the +# significand, the sign of the exponent, and the absolute value of the exponent. +# The significand is in base 16, and the exponent is in base 2. +# +# Perl accepts literals like the following. The "x" might be a capital "X". The +# value is 32.0078125. +# +# 0x__1__0__.0__1__p+0__1__ (prints "Misplaced _ in number") +# 0x1_0.0_1p+0_1 +# +# The CORE::hex() function does not accept floating point accepts +# +# "0x_1_0" +# "x_1_0" +# "_1_0" + +sub _hex_str_to_str_parts { + my $class = shift; + my $str = shift; + + if ($str =~ / + ^ + + # optional leading whitespace + \s* + + # optional sign + ( [+-]? ) + + # optional hex prefix + (?: 0? [Xx] _* )? + + # significand using the hex digits 0..9 and a..f + ( + # integer part and optional fraction part ... + [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* + (?: + \. + (?: _* [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* )? + )? + | + # ... or mandatory fraction part + \. + [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* + ) + + # optional exponent (power of 2) using decimal digits + (?: + [Pp] + ( [+-]? ) + ( \d+ (?: _+ \d+ )* _* ) + )? + + # optional trailing whitespace + \s* + + $ + /x) + { + return $class -> _trim_split_parts($1, $2, $3, $4); + } + + return; +} + +# Takes any string representing a valid octal number and splits it into four +# strings: the sign of the significand, the absolute value of the significand, +# the sign of the exponent, and the absolute value of the exponent. The +# significand is in base 8, and the exponent is in base 2. + +sub _oct_str_to_str_parts { + my $class = shift; + my $str = shift; + + if ($str =~ / + ^ + + # optional leading whitespace + \s* + + # optional sign + ( [+-]? ) + + # optional octal prefix + (?: 0? [Oo] _* )? + + # significand using the octal digits 0..7 + ( + # integer part and optional fraction part ... + [0-7]+ (?: _+ [0-7]+ )* _* + (?: + \. + (?: _* [0-7]+ (?: _+ [0-7]+ )* _* )? + )? + | + # ... or mandatory fraction part + \. + [0-7]+ (?: _+ [0-7]+ )* _* + ) + + # optional exponent (power of 2) using decimal digits + (?: + [Pp] + ( [+-]? ) + ( \d+ (?: _+ \d+ )* _* ) + )? + + # optional trailing whitespace + \s* + + $ + /x) + { + return $class -> _trim_split_parts($1, $2, $3, $4); + } + + return; +} + +# Takes any string representing a valid binary number and splits it into four +# strings: the sign of the significand, the absolute value of the significand, +# the sign of the exponent, and the absolute value of the exponent. The +# significand is in base 2, and the exponent is in base 2. + +sub _bin_str_to_str_parts { + my $class = shift; + my $str = shift; + + if ($str =~ / + ^ + + # optional leading whitespace + \s* + + # optional sign + ( [+-]? ) + + # optional binary prefix + (?: 0? [Bb] _* )? + + # significand using the binary digits 0 and 1 + ( + # integer part and optional fraction part ... + [01]+ (?: _+ [01]+ )* _* + (?: + \. + (?: _* [01]+ (?: _+ [01]+ )* _* )? + )? + | + # ... or mandatory fraction part + \. + [01]+ (?: _+ [01]+ )* _* + ) + + # optional exponent (power of 2) using decimal digits + (?: + [Pp] + ( [+-]? ) + ( \d+ (?: _+ \d+ )* _* ) + )? + + # optional trailing whitespace + \s* + + $ + /x) + { + return $class -> _trim_split_parts($1, $2, $3, $4); + } + + return; +} + +# Takes any string representing a valid decimal number and splits it into four +# parts: the sign of the significand, the absolute value of the significand as a +# libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _dec_parts_to_lib_parts { + shift; + + my ($sig_sgn, $sig_str, $exp_sgn, $exp_str) = @_; + + # Handle zero. + + if ($sig_str eq '0') { + return '+', $LIB -> _zero(), '+', $LIB -> _zero(); + } + + # Absolute value of exponent as library "object". + + my $exp_lib = $LIB -> _new($exp_str); + + # If there is a dot in the significand, remove it so the significand + # becomes an integer and adjust the exponent accordingly. Also remove + # leading zeros which might now appear in the significand. E.g., + # + # 12.345e-2 -> 12345e-5 + # 12.345e+2 -> 12345e-1 + # 0.0123e+5 -> 00123e+1 -> 123e+1 + + my $idx = index $sig_str, '.'; + if ($idx >= 0) { + substr($sig_str, $idx, 1) = ''; + + # delta = length - index + my $delta = $LIB -> _new(CORE::length($sig_str)); + $delta = $LIB -> _sub($delta, $LIB -> _new($idx)); + + # exponent - delta + ($exp_lib, $exp_sgn) = _e_sub($exp_lib, $delta, $exp_sgn, '+'); + #($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+'); + + $sig_str =~ s/^0+//; + } + + # If there are trailing zeros in the significand, remove them and + # adjust the exponent. E.g., + # + # 12340e-5 -> 1234e-4 + # 12340e-1 -> 1234e0 + # 12340e+3 -> 1234e4 + + if ($sig_str =~ s/(0+)\z//) { + my $len = CORE::length($1); + ($exp_lib, $exp_sgn) = + $LIB -> _sadd($exp_lib, $exp_sgn, $LIB -> _new($len), '+'); + } + + # At this point, the significand is empty or an integer with no trailing + # zeros. The exponent is in base 10. + + unless (CORE::length $sig_str) { + return '+', $LIB -> _zero(), '+', $LIB -> _zero(); + } + + # Absolute value of significand as library "object". + + my $sig_lib = $LIB -> _new($sig_str); + + return $sig_sgn, $sig_lib, $exp_sgn, $exp_lib; +} + +# Takes any string representing a valid binary number and splits it into four +# parts: the sign of the significand, the absolute value of the significand as a +# libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _bin_parts_to_lib_parts { + shift; + + my ($sig_sgn, $sig_str, $exp_sgn, $exp_str, $bpc) = @_; + my $bpc_lib = $LIB -> _new($bpc); + + # Handle zero. + + if ($sig_str eq '0') { + return '+', $LIB -> _zero(), '+', $LIB -> _zero(); + } + + # Absolute value of exponent as library "object". + + my $exp_lib = $LIB -> _new($exp_str); + + # If there is a dot in the significand, remove it so the significand + # becomes an integer and adjust the exponent accordingly. Also remove + # leading zeros which might now appear in the significand. E.g., with + # hexadecimal numbers + # + # 12.345p-2 -> 12345p-14 + # 12.345p+2 -> 12345p-10 + # 0.0123p+5 -> 00123p-11 -> 123p-11 + + my $idx = index $sig_str, '.'; + if ($idx >= 0) { + substr($sig_str, $idx, 1) = ''; + + # delta = (length - index) * bpc + my $delta = $LIB -> _new(CORE::length($sig_str)); + $delta = $LIB -> _sub($delta, $LIB -> _new($idx)); + $delta = $LIB -> _mul($delta, $bpc_lib) if $bpc != 1; + + # exponent - delta + ($exp_lib, $exp_sgn) = _e_sub($exp_lib, $delta, $exp_sgn, '+'); + #($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+'); + + $sig_str =~ s/^0+//; + } + + # If there are trailing zeros in the significand, remove them and + # adjust the exponent accordingly. E.g., with hexadecimal numbers + # + # 12340p-5 -> 1234p-1 + # 12340p-1 -> 1234p+3 + # 12340p+3 -> 1234p+7 + + if ($sig_str =~ s/(0+)\z//) { + + # delta = length * bpc + my $delta = $LIB -> _new(CORE::length($1)); + $delta = $LIB -> _mul($delta, $bpc_lib) if $bpc != 1; + + # exponent + delta + ($exp_lib, $exp_sgn) = $LIB -> _sadd($exp_lib, $exp_sgn, $delta, '+'); + } + + # At this point, the significand is empty or an integer with no leading + # or trailing zeros. The exponent is in base 2. + + unless (CORE::length $sig_str) { + return '+', $LIB -> _zero(), '+', $LIB -> _zero(); + } + + # Absolute value of significand as library "object". + + my $sig_lib = $bpc == 1 ? $LIB -> _from_bin('0b' . $sig_str) + : $bpc == 3 ? $LIB -> _from_oct('0' . $sig_str) + : $bpc == 4 ? $LIB -> _from_hex('0x' . $sig_str) + : die "internal error: invalid exponent multiplier"; + + # If the exponent (in base 2) is positive or zero ... + + if ($exp_sgn eq '+') { + + if (!$LIB -> _is_zero($exp_lib)) { + + # Multiply significand by 2 raised to the exponent. + + my $p = $LIB -> _pow($LIB -> _two(), $exp_lib); + $sig_lib = $LIB -> _mul($sig_lib, $p); + $exp_lib = $LIB -> _zero(); + } + } + + # ... else if the exponent is negative ... + + else { + + # Rather than dividing the significand by 2 raised to the absolute + # value of the exponent, multiply the significand by 5 raised to the + # absolute value of the exponent and let the exponent be in base 10: + # + # a * 2^(-b) = a * 5^b * 10^(-b) = c * 10^(-b), where c = a * 5^b + + my $p = $LIB -> _pow($LIB -> _new("5"), $exp_lib); + $sig_lib = $LIB -> _mul($sig_lib, $p); + } + + # Adjust for the case when the conversion to decimal introduced trailing + # zeros in the significand. + + my $n = $LIB -> _zeros($sig_lib); + if ($n) { + $n = $LIB -> _new($n); + $sig_lib = $LIB -> _rsft($sig_lib, $n, 10); + ($exp_lib, $exp_sgn) = $LIB -> _sadd($exp_lib, $exp_sgn, $n, '+'); + } + + return $sig_sgn, $sig_lib, $exp_sgn, $exp_lib; +} + +# Takes any string representing a valid hexadecimal number and splits it into +# four parts: the sign of the significand, the absolute value of the significand +# as a libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _hex_str_to_lib_parts { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _hex_str_to_str_parts($str)) { + return $class -> _bin_parts_to_lib_parts(@parts, 4); # 4 bits pr. chr + } + return; +} + +# Takes any string representing a valid octal number and splits it into four +# parts: the sign of the significand, the absolute value of the significand as a +# libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _oct_str_to_lib_parts { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _oct_str_to_str_parts($str)) { + return $class -> _bin_parts_to_lib_parts(@parts, 3); # 3 bits pr. chr + } + return; +} + +# Takes any string representing a valid binary number and splits it into four +# parts: the sign of the significand, the absolute value of the significand as a +# libray thingy, the sign of the exponent, and the absolute value of the +# exponent as a library thingy. + +sub _bin_str_to_lib_parts { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _bin_str_to_str_parts($str)) { + return $class -> _bin_parts_to_lib_parts(@parts, 1); # 1 bit pr. chr + } + return; +} + +# Decimal string is split into the sign of the signficant, the absolute value of +# the significand as library thingy, the sign of the exponent, and the absolute +# value of the exponent as a a library thingy. + +sub _dec_str_to_lib_parts { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _dec_str_to_str_parts($str)) { + return $class -> _dec_parts_to_lib_parts(@parts); + } + return; +} + +# Hexdecimal string to a string using decimal floating point notation. + +sub hex_str_to_dec_flt_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _hex_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_flt_str(@parts); + } + return; +} + +# Octal string to a string using decimal floating point notation. + +sub oct_str_to_dec_flt_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _oct_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_flt_str(@parts); + } + return; +} + +# Binary string to a string decimal floating point notation. + +sub bin_str_to_dec_flt_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _bin_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_flt_str(@parts); + } + return; +} + +# Decimal string to a string using decimal floating point notation. + +sub dec_str_to_dec_flt_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_flt_str(@parts); + } + return; +} + +# Hexdecimal string to decimal notation (no exponent). + +sub hex_str_to_dec_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_dec_str(@parts); + } + return; +} + +# Octal string to decimal notation (no exponent). + +sub oct_str_to_dec_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _oct_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_dec_str(@parts); + } + return; +} + +# Binary string to decimal notation (no exponent). + +sub bin_str_to_dec_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _bin_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_dec_str(@parts); + } + return; +} + +# Decimal string to decimal notation (no exponent). + +sub dec_str_to_dec_str { + my $class = shift; + my $str = shift; + if (my @parts = $class -> _dec_str_to_lib_parts($str)) { + return $class -> _lib_parts_to_dec_str(@parts); + } + return; +} + +sub _lib_parts_to_flt_str { + my $class = shift; + my @parts = @_; + return $parts[0] . $LIB -> _str($parts[1]) + . 'e' . $parts[2] . $LIB -> _str($parts[3]); +} + +sub _lib_parts_to_dec_str { + my $class = shift; + my @parts = @_; + + # The number is an integer iff the exponent is non-negative. + + if ($parts[2] eq '+') { + my $str = $parts[0] + . $LIB -> _str($LIB -> _lsft($parts[1], $parts[3], 10)); + return $str; + } + + # If it is not an integer, add a decimal point. + + else { + my $mant = $LIB -> _str($parts[1]); + my $mant_len = CORE::length($mant); + my $expo = $LIB -> _num($parts[3]); + my $len_cmp = $mant_len <=> $expo; + if ($len_cmp <= 0) { + return $parts[0] . '0.' . '0' x ($expo - $mant_len) . $mant; + } else { + substr $mant, $mant_len - $expo, 0, '.'; + return $parts[0] . $mant; + } + } +} + ############################################################################### # this method returns 0 if the object can be modified, or 1 if not. # We use a fast constant sub() here, to avoid costly calls. Subclasses @@ -4815,7 +5467,9 @@ also provided for Perl operators. =head2 Input Input values to these routines may be any scalar number or string that looks -like a number and represents an integer. +like a number and represents an integer. Anything that is accepted by Perl as a +literal numeric constant should be accepted by this module, except that finite +non-integers return NaN. =over @@ -4825,57 +5479,86 @@ Leading and trailing whitespace is ignored. =item * -Leading zeros are ignored. +Leading zeros are ignored, except for floating point numbers with a binary +exponent, in which case the number is interpreted as an octal floating point +number. For example, "01.4p+0" gives 1.5, "00.4p+0" gives 0.5, but "0.4p+0" +gives a NaN. And while "0377" gives 255, "0377p0" gives 255. =item * -If the string has a "0x" prefix, it is interpreted as a hexadecimal number. +If the string has a "0x" or "0X" prefix, it is interpreted as a hexadecimal +number. =item * -If the string has a "0o" prefix, it is interpreted as an octal number. +If the string has a "0o" or "0O" prefix, it is interpreted as an octal number. A +floating point literal with a "0" prefix is also interpreted as an octal number. =item * -If the string has a "0b" prefix, it is interpreted as a binary number. +If the string has a "0b" or "0B" prefix, it is interpreted as a binary number. =item * -One underline is allowed between any two digits. +Underline characters are allowed in the same way as they are allowed in literal +numerical constants. =item * -If the string can not be interpreted, NaN is returned. +If the string can not be interpreted, or does not represent a finite integer, +NaN is returned. + +=item * + +For hexadecimal, octal, and binary floating point numbers, the exponent must be +separated from the significand (mantissa) by the letter "p" or "P", not "e" or +"E" as with decimal numbers. =back Some examples of valid string input Input string Resulting value + 123 123 1.23e2 123 12300e-2 123 - 0xcafe 51966 - 0XCAFE 51966 - 0o1337 735 - 0O1337 735 - 0b1101 13 - 0B1101 13 + 67_538_754 67538754 -4_5_6.7_8_9e+0_1_0 -4567890000000 + 0x13a 314 + 0x13ap0 314 + 0x1.3ap+8 314 + 0x0.00013ap+24 314 + 0x13a000p-12 314 + + 0o472 314 + 0o1.164p+8 314 + 0o0.0001164p+20 314 + 0o1164000p-10 314 + + 0472 472 Note! + 01.164p+8 314 + 00.0001164p+20 314 + 01164000p-10 314 + + 0b100111010 314 + 0b1.0011101p+8 314 + 0b0.00010011101p+12 314 + 0b100111010000p-3 314 + Input given as scalar numbers might lose precision. Quote your input to ensure that no digits are lost: $x = Math::BigInt->new( 56789012345678901234 ); # bad $x = Math::BigInt->new('56789012345678901234'); # good -Currently, Math::BigInt->new() defaults to 0, while Math::BigInt->new('') -results in 'NaN'. This might change in the future, so use always the following -explicit forms to get a zero or NaN: +Currently, C<Math::BigInt->new()> (no input argument) and +C<Math::BigInt->new("")> return 0. This might change in the future, so always +use the following explicit forms to get a zero: $zero = Math::BigInt->bzero(); - $nan = Math::BigInt->bnan(); =head2 Output @@ -5059,6 +5742,13 @@ The input is accepted as decimal, hexadecimal (with leading '0x') or binary See L</Input> for more info on accepted input formats. +=item from_dec() + + $x = Math::BigInt->from_dec("314159"); # input is decimal + +Interpret input as a decimal. It is equivalent to new(), but does not accept +anything but strings representing finite, decimal numbers. + =item from_hex() $x = Math::BigInt->from_hex("0xcafe"); # input is hexadecimal @@ -6213,6 +6903,94 @@ needed, for instance in array index operations. =back +=head2 Utility methods + +These utility methods are made public + +=over + +=item dec_str_to_dec_flt_str() + +Takes a string representing any valid number using decimal notation and converts +it to a string representing the same number using decimal floating point +notation. The output consists of five parts joined together: the sign of the +significand, the absolute value of the significand as the smallest possible +integer, the letter "e", the sign of the exponent, and the absolute value of the +exponent. If the input is invalid, nothing is returned. + + $str2 = $class -> dec_str_to_dec_flt_str($str1); + +Some examples + + Input Output + 31400.00e-4 +314e-2 + -0.00012300e8 -123e+2 + 0 +0e+0 + +=item hex_str_to_dec_flt_str() + +Takes a string representing any valid number using hexadecimal notation and +converts it to a string representing the same number using decimal floating +point notation. The output has the same format as that of +L</dec_str_to_dec_flt_str()>. + + $str2 = $class -> hex_str_to_dec_flt_str($str1); + +Some examples + + Input Output + 0xff +255e+0 + +Some examples + +=item oct_str_to_dec_flt_str() + +Takes a string representing any valid number using octal notation and converts +it to a string representing the same number using decimal floating point +notation. The output has the same format as that of +L</dec_str_to_dec_flt_str()>. + + $str2 = $class -> oct_str_to_dec_flt_str($str1); + +=item bin_str_to_dec_flt_str() + +Takes a string representing any valid number using binary notation and converts +it to a string representing the same number using decimal floating point +notation. The output has the same format as that of +L</dec_str_to_dec_flt_str()>. + + $str2 = $class -> bin_str_to_dec_flt_str($str1); + +=item dec_str_to_dec_str() + +Takes a string representing any valid number using decimal notation and converts +it to a string representing the same number using decimal notation. If the +number represents an integer, the output consists of a sign and the absolute +value. If the number represents a non-integer, the output consists of a sign, +the integer part of the number, the decimal point ".", and the fraction part of +the number without any trailing zeros. If the input is invalid, nothing is +returned. + +=item hex_str_to_dec_str() + +Takes a string representing any valid number using hexadecimal notation and +converts it to a string representing the same number using decimal notation. The +output has the same format as that of L</dec_str_to_dec_str()>. + +=item oct_str_to_dec_str() + +Takes a string representing any valid number using octal notation and converts +it to a string representing the same number using decimal notation. The +output has the same format as that of L</dec_str_to_dec_str()>. + +=item bin_str_to_dec_str() + +Takes a string representing any valid number using binary notation and converts +it to a string representing the same number using decimal notation. The output +has the same format as that of L</dec_str_to_dec_str()>. + +=back + =head1 ACCURACY and PRECISION Math::BigInt and Math::BigFloat have full support for accuracy and precision @@ -6613,8 +7391,8 @@ are much faster than the default library. =head3 The default library -The default library is L<Math::BigInt::Calc>, which is implemented in -pure Perl and hence does not require a compiler. +The default library is L<Math::BigInt::Calc>, which is implemented in pure Perl +and hence does not require a compiler. =head3 Specifying a library @@ -6637,8 +7415,8 @@ Multiple libraries can be specified by separating them by a comma, e.g., use Math::BigInt try => 'GMP,Pari'; -If you request a specific set of libraries and do not allow fallback, specify -them using "only", +If you request a specific set of libraries and do not allow fallback to the +default library, specify them using "only", use Math::BigInt only => 'GMP,Pari'; @@ -6652,34 +7430,16 @@ if this also fails, reverts to Math::BigInt::Calc: use Math::BigInt try => 'Foo,Math::BigInt::Bar'; -=head3 The fallback library - -The library that is used is the first library that was successfully loaded. The -fallback library is the most recent library that was successfully loaded, or the -default library, if no library has been successfully loaded. - -In the following example, assume "Pari" can be loaded, but "Foo" can't. Since -"Pari" can be loaded, it is used. Since "Foo" can't be loaded, "Pari" is used as -the fallback library, since it is the most recently successfully loaded library. - - use Math::BigInt; # "Calc" (default) is used - use Math::BigInt try => "Pari"; # "Pari" is used - use Math::BigFloat try => "Foo"; # fallback to "Pari" - -As shown, multiple libraries can be loaded, and the library in used can be -changed. However, all library loading should be done before any objects are -created. Mixing objects that use different backend libraries won't work. - -=head3 What library to use? +=head3 Which library to use? B<Note>: General purpose packages should not be explicit about the library to use; let the script author decide which is best. -L<Math::BigInt::GMP> and L<Math::BigInt::Pari> are in cases involving big -numbers much faster than L<Math::BigInt::Calc>. However it is slower when -dealing with very small numbers (less than about 20 digits) and when converting -very large numbers to decimal (for instance for printing, rounding, calculating -their length in decimal etc.). +L<Math::BigInt::GMP>, L<Math::BigInt::Pari>, and L<Math::BigInt::GMPz> are in +cases involving big numbers much faster than L<Math::BigInt::Calc>. However +these libraries are slower when dealing with very small numbers (less than about +20 digits) and when converting very large numbers to decimal (for instance for +printing, rounding, calculating their length in decimal etc.). So please select carefully what library you want to use. @@ -6689,6 +7449,16 @@ internal format. See the respective math library module documentation for further details. +=head3 Loading multiple libraries + +The first library that is successfully loaded is the one that will be used. Any +further attempts at loading a different module will be ignored. This is to avoid +the situation where module A requires math library X, and module B requires math +library Y, causing modules A and B to be incompatible. For example, + + use Math::BigInt; # loads default "Calc" + use Math::BigFloat only => "GMP"; # ignores "GMP" + =head2 SIGN The sign is either '+', '-', 'NaN', '+inf' or '-inf'. @@ -6749,49 +7519,69 @@ Examples for converting: my $x = Math::BigInt->new('0b1'.'01' x 123); print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n"; -=head1 Autocreating constants +=head1 NUMERIC LITERALS -After C<use Math::BigInt ':constant'> all the B<integer> decimal, hexadecimal -and binary constants in the given scope are converted to C<Math::BigInt>. This -conversion happens at compile time. +After C<use Math::BigInt ':constant'> all numeric literals in the given scope +are converted to C<Math::BigInt> objects. This conversion happens at compile +time. Every non-integer is convert to a NaN. -In particular, +For example, - perl -MMath::BigInt=:constant -e 'print 2**100,"\n"' + perl -MMath::BigInt=:constant -le 'print 2**150' -prints the integer value of C<2**100>. Note that without conversion of -constants the expression 2**100 is calculated using Perl scalars. +prints the exact value of C<2**150>. Note that without conversion of constants +to objects the expression C<2**150> is calculated using Perl scalars, which +leads to an inaccurate result. -Please note that strings and floating point constants are not affected, so that +Please note that strings are not affected, so that use Math::BigInt qw/:constant/; - $x = 1234567890123456789012345678901234567890 - + 123456789123456789; - $y = '1234567890123456789012345678901234567890' - + '123456789123456789'; + $x = "1234567890123456789012345678901234567890" + + "123456789123456789"; -does not give you what you expect. You need an explicit Math::BigInt->new() -around one of the operands. You should also quote large constants to protect +does give you what you expect. You need an explicit Math::BigInt->new() around +at least one of the operands. You should also quote large constants to prevent loss of precision: use Math::BigInt; - $x = Math::BigInt->new('1234567889123456789123456789123456789'); + $x = Math::BigInt->new("1234567889123456789123456789123456789"); + +Without the quotes Perl first converts the large number to a floating point +constant at compile time, and then converts the result to a Math::BigInt object +at run time, which results in an inaccurate result. + +=head2 Hexadecimal, octal, and binary floating point literals + +Perl (and this module) accepts hexadecimal, octal, and binary floating point +literals, but use them with care with Perl versions before v5.32.0, because some +versions of Perl silently give the wrong result. Below are some examples of +different ways to write the number decimal 314. + +Hexadecimal floating point literals: + + 0x1.3ap+8 0X1.3AP+8 + 0x1.3ap8 0X1.3AP8 + 0x13a0p-4 0X13A0P-4 + +Octal floating point literals (with "0" prefix): -Without the quotes Perl would convert the large number to a floating point -constant at compile time and then hand the result to Math::BigInt, which -results in an truncated result or a NaN. + 01.164p+8 01.164P+8 + 01.164p8 01.164P8 + 011640p-4 011640P-4 -This also applies to integers that look like floating point constants: +Octal floating point literals (with "0o" prefix) (requires v5.34.0): - use Math::BigInt ':constant'; + 0o1.164p+8 0O1.164P+8 + 0o1.164p8 0O1.164P8 + 0o11640p-4 0O11640P-4 - print ref(123e2),"\n"; - print ref(123.2e2),"\n"; +Binary floating point literals: -prints nothing but newlines. Use either L<bignum> or L<Math::BigFloat> to get -this to work. + 0b1.0011101p+8 0B1.0011101P+8 + 0b1.0011101p8 0B1.0011101P8 + 0b10011101000p-2 0B10011101000P-2 =head1 PERFORMANCE diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm index 61a5f63acd..1269f644bf 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm @@ -7,7 +7,7 @@ use warnings; use Carp qw< carp croak >; use Math::BigInt::Lib; -our $VERSION = '1.999823'; +our $VERSION = '1.999827'; our @ISA = ('Math::BigInt::Lib'); @@ -87,7 +87,8 @@ sub config { } sub _base_len { - my $class = shift; + #my $class = shift; # $class is not used + shift; if (@_) { # if called as setter ... my ($base_len, $use_int) = @_; @@ -402,10 +403,10 @@ sub _add { # For each in Y, add Y to X and carry. If after that, something is left in # X, foreach in X add carry to X and then return X, carry. Trades one # "$j++" for having to shift arrays. - my $i; + my $car = 0; my $j = 0; - for $i (@$y) { + for my $i (@$y) { $x->[$j] -= $BASE if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0; $j++; } @@ -451,10 +452,9 @@ sub _sub { my ($c, $sx, $sy, $s) = @_; my $car = 0; - my $i; my $j = 0; if (!$s) { - for $i (@$sx) { + for my $i (@$sx) { last unless defined $sy->[$j] || $car; $i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0); $j++; @@ -462,7 +462,7 @@ sub _sub { # might leave leading zeros, so fix that return __strip_zeros($sx); } - for $i (@$sx) { + for my $i (@$sx) { # We can't do an early out if $x < $y, since we need to copy the high # chunks from $y. Found by Bob Mathews. #last unless defined $sy->[$j] || $car; @@ -517,13 +517,13 @@ sub _mul_use_int { $yv = $c->_copy($xv) if $xv == $yv; # same references? my @prod = (); - my ($prod, $car, $cty, $xi, $yi); - for $xi (@$xv) { + my ($prod, $car, $cty); + for my $xi (@$xv) { $car = 0; $cty = 0; # looping through this if $xi == 0 is silly - so optimize it away! $xi = (shift(@prod) || 0), next if $xi == 0; - for $yi (@$yv) { + for my $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; $prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE; } @@ -578,13 +578,13 @@ sub _mul_no_int { $yv = $c->_copy($xv) if $xv == $yv; # same references? my @prod = (); - my ($prod, $rem, $car, $cty, $xi, $yi); - for $xi (@$xv) { + my ($prod, $rem, $car, $cty); + for my $xi (@$xv) { $car = 0; $cty = 0; # looping through this if $xi == 0 is silly - so optimize it away! $xi = (shift(@prod) || 0), next if $xi == 0; - for $yi (@$yv) { + for my $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; $rem = $prod % $BASE; $car = ($prod - $rem) / $BASE; @@ -2127,7 +2127,7 @@ sub _as_oct { my $x1 = $c->_copy($x); - my $x1000 = [ 0100000 ]; + my $x1000 = [ 1 << 15 ]; # 15 bits = 32768 = 0100000 my $es = ''; my $xr; @@ -2143,7 +2143,7 @@ sub _from_oct { # convert a octal number to decimal (string, return ref to array) my ($c, $os) = @_; - my $m = $c->_new(010000000000); # 30 bits at a time (<32 bits!) + my $m = $c->_new(1 << 30); # 30 bits at a time (<32 bits!) my $d = 10; # 10 octal digits at a time my $mul = $c->_one(); @@ -2219,7 +2219,7 @@ sub _modinv { # modulo zero if ($c->_is_zero($y)) { - return undef, undef; + return; } # modulo one @@ -2250,7 +2250,7 @@ sub _modinv { } # if the gcd is not 1, then return NaN - return (undef, undef) unless $c->_is_one($a); + return unless $c->_is_one($a); ($v, $sign == 1 ? '+' : '-'); } @@ -2393,6 +2393,27 @@ together with 'use_int', the current value for the base length is used. =back +=head1 METHODS + +This overview constains only the methods that are specific to +C<Math::BigInt::Calc>. For the other methods, see L<Math::BigInt::Lib>. + +=over 4 + +=item _base_len() + +Specify the desired base length and whether to enable "use integer" in the +computations. + + Math::BigInt::Calc -> _base_len($base_len, $use_int); + +Note that it is better to specify the base length and whether to use integers as +options when the module is loaded, for example like this + + use Math::BigInt::Calc base_len => 6, use_int => 1; + +=back + =head1 SEE ALSO L<Math::BigInt::Lib> for a description of the API. diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm b/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm index ee5577c6dd..ac570af3f1 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm @@ -4,7 +4,7 @@ use 5.006001; use strict; use warnings; -our $VERSION = '1.999823'; +our $VERSION = '1.999827'; use Carp; @@ -352,6 +352,56 @@ sub _dec { $class -> _sub($x, $class -> _one()); } +# Signed addition. If the flag is false, $xa might be modified, but not $ya. If +# the false is true, $ya might be modified, but not $xa. + +sub _sadd { + my $class = shift; + my ($xa, $xs, $ya, $ys, $flag) = @_; + my ($za, $zs); + + # If the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8) + + if ($xs eq $ys) { + if ($flag) { + $za = $class -> _add($ya, $xa); + } else { + $za = $class -> _add($xa, $ya); + } + $zs = $class -> _is_zero($za) ? '+' : $xs; + return $za, $zs; + } + + my $acmp = $class -> _acmp($xa, $ya); # abs(x) = abs(y) + + if ($acmp == 0) { # x = -y or -x = y + $za = $class -> _zero(); + $zs = '+'; + return $za, $zs; + } + + if ($acmp > 0) { # abs(x) > abs(y) + $za = $class -> _sub($xa, $ya, $flag); + $zs = $xs; + } else { # abs(x) < abs(y) + $za = $class -> _sub($ya, $xa, !$flag); + $zs = $ys; + } + return $za, $zs; +} + +# Signed subtraction. If the flag is false, $xa might be modified, but not $ya. +# If the false is true, $ya might be modified, but not $xa. + +sub _ssub { + my $class = shift; + my ($xa, $xs, $ya, $ys, $flag) = @_; + + # Swap sign of second operand and let _sadd() do the job. + $ys = $ys eq '+' ? '-' : '+'; + $class -> _sadd($xa, $xs, $ya, $ys, $flag); +} + ############################################################################## # testing @@ -2140,24 +2190,38 @@ arbitrarily large. =item CLASS-E<gt>_add(OBJ1, OBJ2) -Returns the result of adding OBJ2 to OBJ1. +Addition. Returns the result of adding OBJ2 to OBJ1. =item CLASS-E<gt>_mul(OBJ1, OBJ2) -Returns the result of multiplying OBJ2 and OBJ1. +Multiplication. Returns the result of multiplying OBJ2 and OBJ1. =item CLASS-E<gt>_div(OBJ1, OBJ2) -In scalar context, returns the quotient after dividing OBJ1 by OBJ2 and -truncating the result to an integer. In list context, return the quotient and -the remainder. +Division. In scalar context, returns the quotient after dividing OBJ1 by OBJ2 +and truncating the result to an integer. In list context, return the quotient +and the remainder. =item CLASS-E<gt>_sub(OBJ1, OBJ2, FLAG) =item CLASS-E<gt>_sub(OBJ1, OBJ2) -Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false or omitted, -OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified. +Subtraction. Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false +or omitted, OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified. + +=item CLASS-E<gt>_sadd(OBJ1, SIGN1, OBJ2, SIGN2) + +Signed addition. Returns the result of adding OBJ2 with sign SIGN2 to OBJ1 with +sign SIGN1. + + ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2); + +=item CLASS-E<gt>_ssub(OBJ1, SIGN1, OBJ2, SIGN2) + +Signed subtraction. Returns the result of subtracting OBJ2 with sign SIGN2 to +OBJ1 with sign SIGN1. + + ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2); =item CLASS-E<gt>_dec(OBJ) |