/snap/gh/640/usr/share/perl/5.38.2
Edit: /snap/gh/640/usr/share/perl/5.38.2/bigrat.pm (21134B)
package bigrat;
use strict;
use warnings;
use Carp qw< carp croak >;
our $VERSION = '0.66';
use Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( PI e bpi bexp hex oct );
our @EXPORT = qw( inf NaN );
use overload;
my $obj_class = "Math::BigRat";
##############################################################################
sub accuracy {
my $self = shift;
$obj_class -> accuracy(@_);
}
sub precision {
my $self = shift;
$obj_class -> precision(@_);
}
sub round_mode {
my $self = shift;
$obj_class -> round_mode(@_);
}
sub div_scale {
my $self = shift;
$obj_class -> div_scale(@_);
}
sub in_effect {
my $level = shift || 0;
my $hinthash = (caller($level))[10];
$hinthash->{bigrat};
}
sub _float_constant {
my $str = shift;
# See if we can convert the input string to a string using a normalized form
# consisting of the significand as a signed integer, the character "e", and
# the exponent as a signed integer, e.g., "+0e+0", "+314e-2", and "-1e+3".
my $nstr;
if (
# See if it is an octal number. An octal number like '0377' is also
# accepted by the functions parsing decimal and hexadecimal numbers, so
# handle octal numbers before decimal and hexadecimal numbers.
$str =~ /^0(?:[Oo]|_*[0-7])/ and
$nstr = Math::BigInt -> oct_str_to_dec_flt_str($str)
or
# See if it is decimal number.
$nstr = Math::BigInt -> dec_str_to_dec_flt_str($str)
or
# See if it is a hexadecimal number. Every hexadecimal number has a
# prefix, but the functions parsing numbers don't require it, so check
# to see if it actually is a hexadecimal number.
$str =~ /^0[Xx]/ and
$nstr = Math::BigInt -> hex_str_to_dec_flt_str($str)
or
# See if it is a binary numbers. Every binary number has a prefix, but
# the functions parsing numbers don't require it, so check to see if it
# actually is a binary number.
$str =~ /^0[Bb]/ and
$nstr = Math::BigInt -> bin_str_to_dec_flt_str($str))
{
return $obj_class -> new($nstr);
}
# If we get here, there is a bug in the code above this point.
warn "Internal error: unable to handle literal constant '$str'.",
" This is a bug, so please report this to the module author.";
return $obj_class -> bnan();
}
#############################################################################
# the following two routines are for "use bigrat qw/hex oct/;":
use constant LEXICAL => $] > 5.009004;
# Internal function with the same semantics as CORE::hex(). This function is
# not used directly, but rather by other front-end functions.
sub _hex_core {
my $str = shift;
# Strip off, clean, and parse as much as we can from the beginning.
my $x;
if ($str =~ s/ ^ ( 0? [xX] )? ( [0-9a-fA-F]* ( _ [0-9a-fA-F]+ )* ) //x) {
my $chrs = $2;
$chrs =~ tr/_//d;
$chrs = '0' unless CORE::length $chrs;
$x = $obj_class -> from_hex($chrs);
} else {
$x = $obj_class -> bzero();
}
# Warn about trailing garbage.
if (CORE::length($str)) {
require Carp;
Carp::carp(sprintf("Illegal hexadecimal digit '%s' ignored",
substr($str, 0, 1)));
}
return $x;
}
# Internal function with the same semantics as CORE::oct(). This function is
# not used directly, but rather by other front-end functions.
sub _oct_core {
my $str = shift;
$str =~ s/^\s*//;
# Hexadecimal input.
return _hex_core($str) if $str =~ /^0?[xX]/;
my $x;
# Binary input.
if ($str =~ /^0?[bB]/) {
# Strip off, clean, and parse as much as we can from the beginning.
if ($str =~ s/ ^ ( 0? [bB] )? ( [01]* ( _ [01]+ )* ) //x) {
my $chrs = $2;
$chrs =~ tr/_//d;
$chrs = '0' unless CORE::length $chrs;
$x = $obj_class -> from_bin($chrs);
}
# Warn about trailing garbage.
if (CORE::length($str)) {
require Carp;
Carp::carp(sprintf("Illegal binary digit '%s' ignored",
substr($str, 0, 1)));
}
return $x;
}
# Octal input. Strip off, clean, and parse as much as we can from the
# beginning.
if ($str =~ s/ ^ ( 0? [oO] )? ( [0-7]* ( _ [0-7]+ )* ) //x) {
my $chrs = $2;
$chrs =~ tr/_//d;
$chrs = '0' unless CORE::length $chrs;
$x = $obj_class -> from_oct($chrs);
}
# Warn about trailing garbage. CORE::oct() only warns about 8 and 9, but it
# is more helpful to warn about all invalid digits.
if (CORE::length($str)) {
require Carp;
Carp::carp(sprintf("Illegal octal digit '%s' ignored",
substr($str, 0, 1)));
}
return $x;
}
{
my $proto = LEXICAL ? '_' : ';$';
eval '
sub hex(' . $proto . ') {' . <<'.';
my $str = @_ ? $_[0] : $_;
_hex_core($str);
}
.
eval '
sub oct(' . $proto . ') {' . <<'.';
my $str = @_ ? $_[0] : $_;
_oct_core($str);
}
.
}
#############################################################################
# the following two routines are for Perl 5.9.4 or later and are lexical
my ($prev_oct, $prev_hex, $overridden);
if (LEXICAL) { eval <<'.' }
sub _hex(_) {
my $hh = (caller 0)[10];
return $$hh{bigrat} ? bigrat::_hex_core($_[0])
: $$hh{bigfloat} ? bigfloat::_hex_core($_[0])
: $$hh{bigint} ? bigint::_hex_core($_[0])
: $prev_hex ? &$prev_hex($_[0])
: CORE::hex($_[0]);
}
sub _oct(_) {
my $hh = (caller 0)[10];
return $$hh{bigrat} ? bigrat::_oct_core($_[0])
: $$hh{bigfloat} ? bigfloat::_oct_core($_[0])
: $$hh{bigint} ? bigint::_oct_core($_[0])
: $prev_oct ? &$prev_oct($_[0])
: CORE::oct($_[0]);
}
.
sub _override {
return if $overridden;
$prev_oct = *CORE::GLOBAL::oct{CODE};
$prev_hex = *CORE::GLOBAL::hex{CODE};
no warnings 'redefine';
*CORE::GLOBAL::oct = \&_oct;
*CORE::GLOBAL::hex = \&_hex;
$overridden = 1;
}
sub unimport {
$^H{bigrat} = undef; # no longer in effect
overload::remove_constant('binary', '', 'float', '', 'integer');
}
sub import {
my $class = shift;
$^H{bigrat} = 1; # we are in effect
$^H{bigint} = undef;
$^H{bigfloat} = undef;
# for newer Perls always override hex() and oct() with a lexical version:
if (LEXICAL) {
_override();
}
my @import = ();
my @a = (); # unrecognized arguments
my $ver; # version?
while (@_) {
my $param = shift;
# Accuracy.
if ($param =~ /^a(ccuracy)?$/) {
push @import, 'accuracy', shift();
next;
}
# Precision.
if ($param =~ /^p(recision)?$/) {
push @import, 'precision', shift();
next;
}
# Rounding mode.
if ($param eq 'round_mode') {
push @import, 'round_mode', shift();
next;
}
# Backend library.
if ($param =~ /^(l|lib|try|only)$/) {
push @import, $param eq 'l' ? 'lib' : $param;
push @import, shift() if @_;
next;
}
if ($param =~ /^(v|version)$/) {
$ver = 1;
next;
}
if ($param =~ /^(t|trace)$/) {
$obj_class .= "::Trace";
eval "require $obj_class";
die $@ if $@;
next;
}
if ($param =~ /^(PI|e|bexp|bpi|hex|oct)\z/) {
push @a, $param;
next;
}
croak("Unknown option '$param'");
}
eval "require $obj_class";
die $@ if $@;
$obj_class -> import(@import);
if ($ver) {
printf "%-31s v%s\n", $class, $class -> VERSION();
printf " lib => %-23s v%s\n",
$obj_class -> config("lib"), $obj_class -> config("lib_version");
printf "%-31s v%s\n", $obj_class, $obj_class -> VERSION();
exit;
}
$class -> export_to_level(1, $class, @a); # export inf, NaN, etc.
overload::constant
# This takes care each number written as decimal integer and within the
# range of what perl can represent as an integer, e.g., "314", but not
# "3141592653589793238462643383279502884197169399375105820974944592307".
integer => sub {
#printf "Value '%s' handled by the 'integer' sub.\n", $_[0];
my $str = shift;
return $obj_class -> new($str);
},
# This takes care of each number written with a decimal point and/or
# using floating point notation, e.g., "3.", "3.0", "3.14e+2" (decimal),
# "0b1.101p+2" (binary), "03.14p+2" and "0o3.14p+2" (octal), and
# "0x3.14p+2" (hexadecimal).
float => sub {
#printf "# Value '%s' handled by the 'float' sub.\n", $_[0];
_float_constant(shift);
},
# Take care of each number written as an integer (no decimal point or
# exponent) using binary, octal, or hexadecimal notation, e.g., "0b101"
# (binary), "0314" and "0o314" (octal), and "0x314" (hexadecimal).
binary => sub {
#printf "# Value '%s' handled by the 'binary' sub.\n", $_[0];
my $str = shift;
return $obj_class -> new($str) if $str =~ /^0[XxBb]/;
$obj_class -> from_oct($str);
};
}
sub inf () { $obj_class -> binf(); }
sub NaN () { $obj_class -> bnan(); }
# This should depend on the current accuracy/precision. Fixme!
sub PI () { $obj_class -> new('3.141592653589793238462643383279502884197'); }
sub e () { $obj_class -> new('2.718281828459045235360287471352662497757'); }
sub bpi ($) {
my $up = Math::BigFloat -> upgrade(); # get current upgrading, if any ...
Math::BigFloat -> upgrade(undef); # ... and disable
my $x = Math::BigFloat -> bpi(@_);
Math::BigFloat -> upgrade($up); # reset the upgrading
return $obj_class -> new($x);
}
sub bexp ($$) {
my $up = Math::BigFloat -> upgrade(); # get current upgrading, if any ...
Math::BigFloat -> upgrade(undef); # ... and disable
my $x = Math::BigFloat -> new(shift);
$x -> bexp(@_);
Math::BigFloat -> upgrade($up); # reset the upgrading
return $obj_class -> new($x);
}
1;
__END__
=pod
=head1 NAME
bigrat - transparent big rational number support for Perl
=head1 SYNOPSIS
use bigrat;
print 2 + 4.5; # Math::BigRat 13/2
print 1/3 + 1/4; # Math::BigRat 7/12
print inf + 42; # Math::BigRat inf
print NaN * 7; # Math::BigRat NaN
print hex("0x1234567890123490"); # Perl v5.10.0 or later
{
no bigrat;
print 1/3; # 0.33333...
}
# for older Perls, import into current package:
use bigrat qw/hex oct/;
print hex("0x1234567890123490");
print oct("01234567890123490");
=head1 DESCRIPTION
All numeric literal in the given scope are converted to Math::BigRat objects.
All operators (including basic math operations) except the range operator C<..>
are overloaded.
So, the following:
use bigrat;
$x = 1234;
creates a Math::BigRat and stores a reference to in $x. This happens
transparently and behind your back, so to speak.
You can see this with the following:
perl -Mbigrat -le 'print ref(1234)'
Since numbers are actually objects, you can call all the usual methods from
Math::BigRat on them. This even works to some extent on expressions:
perl -Mbigrat -le '$x = 1234; print $x->bdec()'
perl -Mbigrat -le 'print 1234->copy()->binc();'
perl -Mbigrat -le 'print 1234->copy()->binc->badd(6);'
perl -Mbigrat -le 'print +(1234)->copy()->binc()'
(Note that print doesn't do what you expect if the expression starts with
'(' hence the C<+>)
You can even chain the operations together as usual:
perl -Mbigrat -le 'print 1234->copy()->binc->badd(6);'
1241
Please note the following does not work as expected (prints nothing), since
overloading of '..' is not yet possible in Perl (as of v5.8.0):
perl -Mbigrat -le 'for (1..2) { print ref($_); }'
=head2 Options
C
recognizes some options that can be passed while loading it via
C