--- /dev/null
+#!/usr/bin/perl -w
+
+# For speed and simplicity, Lite objects are a reference to a scalar. When
+# something more complex needs to happen (like +inf,-inf, NaN or rounding),
+# they will upgrade.
+
+package Math::BigInt::Lite;
+
+require 5.005_02;
+use strict;
+
+use Exporter;
+use Math::BigInt;
+use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade
+ $accuracy $precision $round_mode $div_scale);
+
+@ISA = qw(Exporter Math::BigInt);
+my $class = 'Math::BigInt::Lite';
+
+$VERSION = '0.08';
+
+##############################################################################
+# global constants, flags and accessory
+
+$accuracy = $precision = undef;
+$round_mode = 'even';
+$div_scale = 40;
+$upgrade = 'Math::BigInt';
+$downgrade = undef;
+
+my $nan = 'NaN';
+
+my $MAX_NEW_LEN;
+my $MAX_MUL;
+my $MAX_ADD;
+
+BEGIN
+ {
+ # from Daniel Pfeiffer: determine largest group of digits that is precisely
+ # multipliable with itself plus carry
+ # Test now changed to expect the proper pattern, not a result off by 1 or 2
+ my ($e, $num) = 3; # lowest value we will use is 3+1-1 = 3
+ do
+ {
+ $num = ('9' x ++$e) + 0;
+ $num *= $num + 1.0;
+ } while ("$num" =~ /9{$e}0{$e}/); # must be a certain pattern
+ $e--; # last test failed, so retract one step
+ # the limits below brush the problems with the test above under the rug:
+ # the test should be able to find the proper $e automatically
+ $e = 5 if $^O =~ /^uts/; # UTS get's some special treatment
+ $e = 5 if $^O =~ /^unicos/; # unicos is also problematic (6 seems to work
+ # there, but we play safe)
+ $e = 8 if $e > 8; # cap, for VMS, OS/390 and other 64 bit systems
+
+ my $bi = $e;
+
+# # determine how many digits fit into an integer and can be safely added
+# # together plus carry w/o causing an overflow
+#
+# # this below detects 15 on a 64 bit system, because after that it becomes
+# # 1e16 and not 1000000 :/ I can make it detect 18, but then I get a lot of
+# # test failures. Ugh! (Tomake detect 18: uncomment lines marked with *)
+# use integer;
+# my $bi = 5; # approx. 16 bit
+# $num = int('9' x $bi);
+# # $num = 99999; # *
+# # while ( ($num+$num+1) eq '1' . '9' x $bi) # *
+# while ( int($num+$num+1) eq '1' . '9' x $bi)
+# {
+# $bi++; $num = int('9' x $bi);
+# # $bi++; $num *= 10; $num += 9; # *
+# }
+# $bi--; # back off one step
+
+ # we ensure that every number created is below the length for the add, so
+ # that it is always safe to add two objects together
+ $MAX_NEW_LEN = $bi;
+ # The constant below is used to check the result of any add, if above, we
+ # need to upgrade.
+ $MAX_ADD = int("1E$bi");
+ # For mul, we need to check *before* the operation that both operands are
+ # below the number benlow, since otherwise it could overflow.
+ $MAX_MUL = int("1E$e");
+
+ # print "MAX_NEW_LEN $MAX_NEW_LEN MAX_ADD $MAX_ADD MAX_MUL $MAX_MUL\n\n";
+ }
+
+##############################################################################
+# we tie our accuracy/precision/round_mode to BigInt, so that setting it here
+# will do it in BigInt, too. You can't use Lite w/o BigInt, anyway.
+
+sub round_mode
+ {
+ no strict 'refs';
+ # make Class->round_mode() work
+ my $self = shift;
+ my $class = ref($self) || $self || __PACKAGE__;
+ if (defined $_[0])
+ {
+ my $m = shift;
+ die "Unknown round mode $m"
+ if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
+ # set in BigInt, too
+ Math::BigInt->round_mode($m);
+ return ${"${class}::round_mode"} = $m;
+ }
+ return ${"${class}::round_mode"};
+ }
+
+sub accuracy
+ {
+ # $x->accuracy($a); ref($x) $a
+ # $x->accuracy(); ref($x)
+ # Class->accuracy(); class
+ # Class->accuracy($a); class $a
+
+ my $x = shift;
+ my $class = ref($x) || $x || __PACKAGE__;
+
+ no strict 'refs';
+ # need to set new value?
+ if (@_ > 0)
+ {
+ my $a = shift;
+ die ('accuracy must not be zero') if defined $a && $a == 0;
+ if (ref($x))
+ {
+ # $object->accuracy() or fallback to global
+ $x->bround($a) if defined $a;
+ $x->{_a} = $a; # set/overwrite, even if not rounded
+ $x->{_p} = undef; # clear P
+ }
+ else
+ {
+ # set global
+ Math::BigInt->accuracy($a);
+ # and locally here
+ $accuracy = $a;
+ $precision = undef; # clear P
+ }
+ return $a; # shortcut
+ }
+
+ if (ref($x))
+ {
+ # $object->accuracy() or fallback to global
+ return $x->{_a} || ${"${class}::accuracy"};
+ }
+ return ${"${class}::accuracy"};
+ }
+
+sub precision
+ {
+ # $x->precision($p); ref($x) $p
+ # $x->precision(); ref($x)
+ # Class->precision(); class
+ # Class->precision($p); class $p
+
+ my $x = shift;
+ my $class = ref($x) || $x || __PACKAGE__;
+
+ no strict 'refs';
+ # need to set new value?
+ if (@_ > 0)
+ {
+ my $p = shift;
+ if (ref($x))
+ {
+ # $object->precision() or fallback to global
+ $x->bfround($p) if defined $p;
+ $x->{_p} = $p; # set/overwrite, even if not rounded
+ $x->{_a} = undef; # clear A
+ }
+ else
+ {
+ Math::BigInt->precision($p);
+ # and locally here
+ $accuracy = undef; # clear A
+ $precision = $p;
+ }
+ return $p; # shortcut
+ }
+
+ if (ref($x))
+ {
+ # $object->precision() or fallback to global
+ return $x->{_p} || ${"${class}::precision"};
+ }
+ return ${"${class}::precision"};
+ }
+
+use overload
+'+' =>
+ sub
+ {
+ my $x = $_[0];
+ my $s = $_[1]; $s = $class->new($s) unless ref($s);
+ if ($s->isa($class))
+ {
+ $x = \($$x + $$s); bless $x,$class; # inline copy
+ $upgrade->new($$x) if abs($$x) >= $MAX_ADD;
+ }
+ else
+ {
+ $x = $upgrade->new($$x)->badd($s);
+ }
+ $x;
+ },
+
+'*' =>
+ sub
+ {
+ my $x = $_[0];
+ my $s = $_[1]; $s = $class->new($s) unless ref($s);
+ if ($s->isa($class))
+ {
+ $x = \($$x * $$s); $$x = 0 if $$x eq '-0'; # correct 5.x.x bug
+ bless $x,$class; # inline copy
+ }
+ else
+ {
+ $x = $upgrade->new(${$_[0]})->bmul($s);
+ }
+ },
+
+# some shortcuts for speed (assumes that reversed order of arguments is routed
+# to normal '+' and we thus can always modify first arg. If this is changed,
+# this breaks and must be adjusted.)
+#'/=' => sub { scalar $_[0]->bdiv($_[1]); },
+#'*=' => sub { $_[0]->bmul($_[1]); },
+#'+=' => sub { $_[0]->badd($_[1]); },
+#'-=' => sub { $_[0]->bsub($_[1]); },
+#'%=' => sub { $_[0]->bmod($_[1]); },
+#'&=' => sub { $_[0]->band($_[1]); },
+#'^=' => sub { $_[0]->bxor($_[1]); },
+#'|=' => sub { $_[0]->bior($_[1]); },
+#'**=' => sub { $upgrade->bpow($_[0],$_[1]); },
+
+'<=>' => sub { $_[2] ? bcmp($_[1],$_[0]) : bcmp($_[0],$_[1]); },
+
+'""' => sub { ${$_[0]}; },
+'0+' => sub { ${$_[0]}; },
+
+'++' => sub {
+ ${$_[0]}++;
+ return $upgrade->new(${$_[0]}) if ${$_[0]} >= $MAX_ADD;
+ $_[0];
+ },
+'--' => sub {
+ ${$_[0]}--;
+ return $upgrade->new(${$_[0]}) if ${$_[0]} <= -$MAX_ADD;
+ $_[0];
+ }
+ ;
+
+BEGIN
+ {
+ *objectify = \&Math::BigInt::objectify;
+ }
+
+sub config
+ {
+ my $cfg = Math::BigInt->config();
+ $cfg->{version_lite} = $VERSION;
+ $cfg;
+ }
+
+sub bgcd
+ {
+ if (@_ == 1) # bgcd (8) == bgcd(8,0) == 8
+ {
+ my $x = shift; $x = $class->new($x) unless ref($x);
+ return $x;
+ }
+
+ my @a = ();
+ foreach (@_)
+ {
+ my $x = $_;
+ $x = $upgrade->new($x) unless ref ($x);
+ $x = $upgrade->new($$x) if $x->isa($class);
+ push @a, $x;
+ }
+ Math::BigInt::bgcd(@a);
+ }
+
+sub blcm
+ {
+ my @a = ();
+ foreach (@_)
+ {
+ my $x = $_;
+ $x = $upgrade->new($x) unless ref ($x);
+ $x = $upgrade->new($$x) if $x->isa($class);
+ push @a, $x;
+ }
+ Math::BigInt::blcm(@a);
+ }
+
+sub isa
+ {
+ return 0 if $_[1] eq 'Math::BigInt'; # we aren't a BigInt
+ UNIVERSAL::isa(@_);
+ }
+
+sub new
+ {
+ my ($class,$wanted,@r) = @_;
+
+ return $upgrade->new($wanted) if !defined $wanted;
+
+ # 1e12, NaN, inf, 0x12, 0b11, 1.2e2, "12345678901234567890" etc all upgrade
+ if (!ref($wanted))
+ {
+ if ((length($wanted) <= $MAX_NEW_LEN) &&
+ ($wanted =~ /^[+-]?[0-9]{1,$MAX_NEW_LEN}(\.0*)?$/))
+ {
+ my $a = \($wanted+0); # +0 to make a copy and force it numeric
+ return bless $a, $class;
+ }
+ # TODO: 1e10 style constants that are still below MAX_NEW
+ if ($wanted =~ /^([+-])?([0-9]+)[eE][+]?([0-9]+)$/)
+ {
+ if ((length($2) + $3) < $MAX_NEW_LEN)
+ {
+ my $a = \($wanted+0); # +0 to make a copy and force it numeric
+ return bless $a, $class;
+ }
+ }
+# print "new '$$a' $BASE_LEN ($wanted)\n";
+ }
+ $upgrade->new($wanted,@r);
+ }
+
+sub bstr
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return $x->bstr() unless $x->isa($class);
+ $$x;
+ }
+
+sub bsstr
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ $upgrade->new($$x)->bsstr();
+ }
+
+sub bnorm
+ {
+ # no-op
+ my $x = ref($_[0]) ? $_[0] : $_[0]->new($_[1]);
+
+# # zap "-0" (TODO find a way to avoid this)
+# print "bnorm l $$x\n" if ref($x) eq $class;
+# print "bnorm b $x\n" if ref($x) ne $class;
+# $$x = 0 if $x->isa($class) && $$x eq '-0';
+ $x;
+ }
+
+sub _upgrade_2
+ {
+ # This takes the two possible arguments, and checks them. It uses new() to
+ # convert literals to objects first. Then it upgrades the operation
+ # when it detects that:
+ # * one or both of the argument(s) is/are BigInt,
+ # * global A or P are set
+ # Input arguments: x,y,a,p,r
+ # Output: flag (1: need to upgrade, 0: need not),x,y,$a,$p,$r
+
+ # Math::BigInt::Lite->badd(1,2) style calls
+ shift if !ref($_[0]) && $_[0] =~ /^Math::BigInt::Lite/;
+
+ my ($x,$y,$a,$p,$r) = @_;
+
+ my $up = 0; # default: don't upgrade
+
+ $up = 1
+ if (defined $a || defined $p || defined $accuracy || defined $precision);
+ $x = __PACKAGE__->new($x) unless ref $x; # upgrade literals
+ $y = __PACKAGE__->new($y) unless ref $y; # upgrade literals
+ $up = 1 unless $x->isa($class) && $y->isa($class);
+ # no need to check for overflow for add/sub/div/mod math
+ if ($up == 1)
+ {
+ $x = $upgrade->new($$x) if $x->isa($class);
+ $y = $upgrade->new($$y) if $y->isa($class);
+ }
+
+ ($up,$x,$y,$a,$p,$r);
+ }
+
+sub _upgrade_2_mul
+ {
+ # This takes the two possible arguments, and checks them. It uses new() to
+ # convert literals to objects first. Then it upgrades the operation
+ # when it detects that:
+ # * one or both of the argument(s) is/are BigInt,
+ # * global A or P are set
+ # * One of the arguments is too large for the operation
+ # Input arguments: x,y,a,p,r
+ # Output: flag (1: need to upgrade, 0: need not),x,y,$a,$p,$r
+
+ # Math::BigInt::Lite->badd(1,2) style calls
+ shift if !ref($_[0]) && $_[0] =~ /^Math::BigInt::Lite/;
+
+ my ($x,$y,$a,$p,$r) = @_;
+
+ my $up = 0; # default: don't upgrade
+
+ $up = 1
+ if (defined $a || defined $p || defined $accuracy || defined $precision);
+ $x = __PACKAGE__->new($x) unless ref $x; # upgrade literals
+ $y = __PACKAGE__->new($y) unless ref $y; # upgrade literals
+ $up = 1 unless $x->isa($class) && $y->isa($class);
+ $up = 1 if ($up == 0 && (abs($$x) >= $MAX_MUL || abs($$y) >= $MAX_MUL) );
+ if ($up == 1)
+ {
+ $x = $upgrade->new($$x) if $x->isa($class);
+ $y = $upgrade->new($$y) if $y->isa($class);
+ }
+ ($up,$x,$y,$a,$p,$r);
+ }
+
+sub _upgrade_1
+ {
+ # This takes the one possible argument, and checks it. It uses new() to
+ # convert a literal to an object first. Then it checks for a necc. upgrade:
+ # * the argument is a BigInt
+ # * global A or P are set
+ # Input arguments: x,a,p,r
+ # Output: flag (1: need to upgrade, 0: need not), x,$a,$p,$r
+ my ($x,$a,$p,$r) = @_;
+
+ my $up = 0; # default: don't upgrade
+
+ $up = 1
+ if (defined $a || defined $p || defined $accuracy || defined $precision);
+ $x = __PACKAGE_->new($x) unless ref $x; # upgrade literals
+ $up = 1 unless $x->isa($class);
+ if ($up == 1)
+ {
+ $x = $upgrade->new($$x) if $x->isa($class);
+ }
+ ($up,$x,$a,$p,$r);
+ }
+
+##############################################################################
+# rounding functions
+
+sub bround
+ {
+ my ($self,$x,$a,$m) = ref($_[0]) ? (ref($_[0]),@_) :
+ ($class,$class->new($_[0]),$_[1],$_[2]);
+
+ #$m = $self->round_mode() if !defined $m;
+ #$a = $self->accuracy() if !defined $a;
+
+ $x = $upgrade->new($$x) if $x->isa($class);
+ $x->bround($a,$m);
+ }
+
+sub bfround
+ {
+ my ($self,$x,$p,$m) = ref($_[0]) ? (ref($_[0]),@_) :
+ ($class,$class->new($_[0]),$_[1],$_[2]);
+
+ #$m = $self->round_mode() if !defined $m;
+ #$p = $self->precision() if !defined $p;
+
+ $x = $upgrade->new($$x) if $x->isa($class);
+ $x->bfround($p,$m);
+
+ }
+
+sub round
+ {
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) :
+ ($class,$class->new(@_),$_[0],$_[1],$_[2]);
+
+ $x = $upgrade->new($$x) if $x->isa($class);
+ $x->round($a,$p,$r);
+ }
+
+##############################################################################
+# special values
+
+sub bnan
+ {
+ # return a bnan or set object to NaN
+ my $x = shift;
+
+ $upgrade->bnan();
+ }
+
+sub binf
+ {
+ # return a binf
+ my $x = shift;
+
+# return $upgrade->new($$x)->binf(@_) if ref $x;
+ $upgrade->binf(@_); # binf(1,'-') form
+ }
+
+sub bone
+ {
+ # return a one
+ my $x = shift;
+
+ my $sign = '+'; $sign = '-' if ($_[0] ||'') eq '-';
+ return $x->new($sign.'1') unless ref $x; # Class->bone();
+ $$x = 1;
+ $$x = -1 if $sign eq '-';
+ $x;
+ }
+
+sub bzero
+ {
+ # return a one
+ my $x = shift;
+
+ return $x->new(0) unless ref $x; # Class->bone();
+ #return $x->bzero() unless $x->isa($class); # should not happen
+ $$x = 0;
+ $x;
+ }
+
+sub bcmp
+ {
+ # compare two objects
+ my ($x,$y) = @_;
+
+ $x = $class->new($x) unless ref $x;
+ $y = $class->new($y) unless ref $y;
+
+ return ($$x <=> $$y) if ($x->isa($class) && ($y->isa($class)));
+ my $x1 = $x; my $y1 = $y;
+ $x1 = $upgrade->new($$x) if $x->isa($class);
+ $y1 = $upgrade->new($$y) if $y->isa($class);
+ $x1->bcmp($y1); # one of them other class
+ }
+
+sub bacmp
+ {
+ # compare two objects
+ my ($x,$y) = @_;
+
+# print "bacmp $x $y\n";
+ $x = $class->new($x) unless ref $x;
+ $y = $class->new($y) unless ref $y;
+ return (abs($$x) <=> abs($$y))
+ if ($x->isa($class) && ($y->isa($class)));
+ my $x1 = $x; my $y1 = $y;
+ $x1 = $upgrade->new($$x) if $x->isa($class);
+ $y1 = $upgrade->new($$y) if $y->isa($class);
+ $x1->bacmp($y1); # one of them other class
+ }
+
+##############################################################################
+# copy/conversion
+
+sub copy
+ {
+ my $x = shift;
+ return $class->new($x) if !ref $x;
+
+ my $a = $$x; my $t = \$a; bless $t, $class;
+ }
+
+sub as_number
+ {
+ my ($x) = shift;
+
+ return $upgrade->new($x) unless ref($x);
+ # as_number needs to return a BigInt
+ return $upgrade->new($$x) if $x->isa($class);
+ $x->copy();
+ }
+
+sub numify
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : ($class,$class->new(@_));
+
+ return $$x if $x->isa($class);
+ $x->numify();
+ }
+
+sub as_hex
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : ($class,$class->new(@_));
+
+ return $upgrade->new($$x)->as_hex() if $x->isa($class);
+ $x->as_hex();
+ }
+
+sub as_bin
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : ($class,$class->new(@_));
+
+ return $upgrade->new($$x)->as_bin() if $x->isa($class);
+ $x->as_bin();
+ }
+
+##############################################################################
+# binc/bdec
+
+sub binc
+ {
+ # increment by one
+ my ($up,$x,$y,$a,$p,$r) = _upgrade_1(@_);
+
+ return $x->binc($a,$p,$r) if $up;
+ $$x++;
+ return $upgrade->new($$x) if abs($$x) > $MAX_ADD;
+ $x;
+ }
+
+sub bdec
+ {
+ # decrement by one
+ my ($up,$x,$y,$a,$p,$r) = _upgrade_1(@_);
+
+ return $x->bdec($a,$p,$r) if $up;
+ $$x--;
+ return $upgrade->new($$x) if abs($$x) > $MAX_ADD;
+ $x;
+ }
+
+##############################################################################
+# shifting
+
+sub brsft
+ {
+ # shift right
+ my ($x,$y,$b,$a,$p,$r) = @_; #objectify(2,@_);
+
+ $x = $class->new($x) unless ref($x);
+ $y = $class->new($x) unless ref($y);
+
+ return $x->brsft($y,$b,$a,$p,$r) unless $x->isa($class);
+ return $upgrade->new($$x)->brsft($y,$b,$a,$p,$r)
+ unless $y->isa($class);
+
+ $b = 2 if !defined $b;
+ # can't do this
+ return $upgrade->new($$x)->brsft($upgrade->new($$y),$b,$a,$p,$r)
+ if $b != 2 || $$y < 0;
+ use integer;
+ $$x = $$x >> $$y; # base 2 for now
+ $x;
+ }
+
+sub blsft
+ {
+ # shift left
+ my ($x,$y,$b,$a,$p,$r) = @_; #objectify(2,@_);
+
+ $x = $class->new($x) unless ref($x);
+ $y = $class->new($x) unless ref($y);
+
+ return $x->blsft($upgrade->new($$y),$b,$a,$p,$r) unless $x->isa($class);
+ return $upgrade->new($$x)->blsft($y,$b,$a,$p,$r)
+ unless $y->isa($class);
+
+ # overflow: can't do this
+ return $upgrade->new($$x)->blsft($upgrade->new($$y),$b,$a,$p,$r)
+ if $$y > 31;
+ $b = 2 if !defined $b;
+ # can't do this
+ return $upgrade->new($$x)->blsft($upgrade->new($$y),$b,$a,$p,$r)
+ if $b != 2 || $$y < 0;
+ use integer;
+ $$x = $$x << $$y; # base 2 for now
+ $x;
+ }
+
+##############################################################################
+# bitwise logical operators
+
+sub band
+ {
+ # AND two objects
+ my ($x,$y,$a,$p,$r) = @_; #objectify(2,@_);
+
+ $x = $class->new($x) unless ref($x);
+ $y = $class->new($x) unless ref($y);
+
+ return $x->band($y,$a,$p,$r) unless $x->isa($class);
+ return $upgrade->band($x,$y,$a,$p,$r) unless $y->isa($class);
+ use integer;
+ $$x = ($$x+0) & ($$y+0); # +0 to avoid string-context
+ $x;
+ }
+
+sub bxor
+ {
+ # XOR two objects
+ my ($x,$y,$a,$p,$r) = @_; #objectify(2,@_);
+
+ $x = $class->new($x) unless ref($x);
+ $y = $class->new($x) unless ref($y);
+
+ return $x->bxor($y,$a,$p,$r) unless $x->isa($class);
+ return $upgrade->bxor($x,$y,$a,$p,$r) unless $y->isa($class);
+ use integer;
+ $$x = ($$x+0) ^ ($$y+0); # +0 to avoid string-context
+ $x;
+ }
+
+sub bior
+ {
+ # OR two objects
+ my ($x,$y,$a,$p,$r) = @_; #objectify(2,@_);
+
+ $x = $class->new($x) unless ref($x);
+ $y = $class->new($x) unless ref($y);
+
+ return $x->bior($y,$a,$p,$r) unless $x->isa($class);
+ return $upgrade->bior($x,$y,$a,$p,$r) unless $y->isa($class);
+ use integer;
+ $$x = ($$x+0) | ($$y+0); # +0 to avoid string-context
+ $x;
+ }
+
+##############################################################################
+# mul/add/div etc
+
+sub badd
+ {
+ # add two objects
+ my ($up,$x,$y,$a,$p,$r) = _upgrade_2(@_);
+
+ return $x->badd($y,$a,$p,$r) if $up;
+
+ $$x = $$x + $$y;
+ return $upgrade->new($$x) if abs($$x) > $MAX_ADD;
+ $x;
+ }
+
+sub bsub
+ {
+ # subtract two objects
+ my ($up,$x,$y,$a,$p,$r) = _upgrade_2(@_);
+ return $x->bsub($y,$a,$p,$r) if $up;
+ $$x = $$x - $$y;
+ return $upgrade->new($$x) if abs($$x) > $MAX_ADD;
+ $x;
+ }
+
+sub bmul
+ {
+ # multiply two objects
+ my ($up,$x,$y,$a,$p,$r) = _upgrade_2_mul(@_);
+ return $x->bmul($y,$a,$p,$r) if $up;
+ $$x = $$x * $$y;
+ $$x = 0 if $$x eq '-0'; # for some Perls leave '-0' here
+ #return $upgrade->new($$x) if abs($$x) > $MAX_ADD;
+ $x;
+ }
+
+sub bmod
+ {
+ # remainder of div
+ my ($up,$x,$y,$a,$p,$r) = _upgrade_2(@_);
+ return $x->bmod($y,$a,$p,$r) if $up;
+ return $upgrade->new($$x)->bmod($y,$a,$p,$r) if $$y == 0;
+ $$x = $$x % $$y;
+ $x;
+ }
+
+sub bdiv
+ {
+ # divide two objects
+ my ($up,$x,$y,$a,$p,$r) = _upgrade_2(@_);
+
+ return $x->bdiv($y,$a,$p,$r) if $up;
+
+ return $upgrade->new($$x)->bdiv($y,$a,$p,$r) if $$y == 0;
+
+ if (wantarray)
+ {
+ my $a = \($$x % $$y); bless $a,$class;
+ $$x = int($$x / $$y);
+ return ($x,$a);
+ }
+ $$x = int($$x / $$y);
+ $x;
+ }
+
+##############################################################################
+# is_foo methods (the rest is inherited)
+
+sub is_int
+ {
+ # return true if arg (BLite or num_str) is an integer
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return 1 if $x->isa($class); # Lite objects are always int
+ $x->is_int();
+ }
+
+sub is_inf
+ {
+ # return true if arg (BLite or num_str) is an infinity
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return 0 if $x->isa($class); # Lite objects are never inf
+ $x->is_inf();
+ }
+
+sub is_nan
+ {
+ # return true if arg (BLite or num_str) is an NaN
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return 0 if $x->isa($class); # Lite objects are never NaN
+ $x->is_nan();
+ }
+
+sub is_zero
+ {
+ # return true if arg (BLite or num_str) is zero
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return ($$x == 0) <=> 0if $x->isa($class);
+ $x->is_zero();
+ }
+
+sub is_positive
+ {
+ # return true if arg (BLite or num_str) is positive
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return ($$x >= 0) <=> 0 if $x->isa($class);
+ $x->is_positive();
+ }
+
+sub is_negative
+ {
+ # return true if arg (BLite or num_str) is negative
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return ($$x < 0) <=> 0 if $x->isa($class);
+ $x->is_positive();
+ }
+
+sub is_one
+ {
+ # return true if arg (BLite or num_str) is one
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return ($$x == 1) <=> 0 if $x->isa($class);
+ $x->is_one();
+ }
+
+sub is_odd
+ {
+ # return true if arg (BLite or num_str) is odd
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return $x->is_odd() unless $x->isa($class);
+ $$x & 1 == 1 ? 1 : 0;
+ }
+
+sub is_even
+ {
+ # return true if arg (BLite or num_str) is even
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return $x->is_even() unless $x->isa($class);
+ $$x & 1 == 1 ? 0 : 1;
+ }
+
+##############################################################################
+# parts() and friends
+
+sub parts
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) :
+ ($class,$class->new($_[0]));
+
+ $x = $upgrade->new("$x") if $x->isa($class);
+ return $x->parts();
+ }
+
+sub sign
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) :
+ ($class,$class->new($_[0]));
+
+ $$x >= 0 ? '+' : '-';
+ }
+
+sub exponent
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) :
+ ($class,$class->new($_[0]));
+
+ return $upgrade->new($$x)->exponent() if $x->isa($class);
+ $x->exponent();
+ }
+
+sub mantissa
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) :
+ ($class,$class->new($_[0]));
+
+ return $upgrade->new($$x)->mantissa() if $x->isa($class);
+ $x->mantissa();
+ }
+
+sub digit
+ {
+ my ($self,$x,$n) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+
+ return $x->digit($n) unless $x->isa($class);
+
+ $n = 0 if !defined $n;
+ my $len = length("$$x");
+
+ $n = $len+$n if $n < 0; # -1 last, -2 second-to-last
+ $n = abs($n); # if negative was too big
+ $len--; $n = $len if $n > $len; # n to big?
+
+ substr($$x,-$n-1,1);
+ }
+
+sub length
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return $x->length() unless $x->isa($class);
+ my $l = length($$x); $l-- if $$x < 0; # -123 => 123
+ $l;
+ }
+
+##############################################################################
+# sign based methods
+
+sub babs
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ $$x = abs($$x);
+ $x;
+ }
+
+sub bneg
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ $$x = -$$x if $$x != 0;
+ $x;
+ }
+
+sub bnot
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ $$x = -$$x - 1;
+ $x;
+ }
+
+##############################################################################
+# special calc routines
+
+sub bceil
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ $x; # no-op
+ }
+
+sub bfloor
+ {
+ my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ $x; # no-op
+ }
+
+sub bfac
+ {
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) :
+ ($class,$class->new($_[0]),$_[1],$_[2],$_[3],$_[4]);
+
+ $upgrade->bfac($x,$a,$p,$r);
+ }
+
+sub bpow
+ {
+ my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+
+ $x = $upgrade->new($$x) if $x->isa($class);
+ $y = $upgrade->new($$y) if $y->isa($class);
+
+ $x->bpow($y,$a,$p,$r);
+ }
+
+sub blog
+ {
+ my ($self,$x,$base,$a,$p,$r) = objectify(2,@_);
+
+ $x = $upgrade->new($$x) if $x->isa($class);
+ $base = $upgrade->new($$base) if $base->isa($class);
+
+ $x->blog($base,$a,$p,$r);
+ }
+
+sub bsqrt
+ {
+ my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) :
+ ($class,$class->new($_[0]),$_[1],$_[2],$_[3]);
+
+ return $x->bsqrt($a,$p,$r) unless $x->isa($class);
+
+ return $upgrade->new($$x)->bsqrt() if $$x < 0; # NaN
+ my $s = sqrt($$x);
+ # If MBI's upgrade is defined, and result is non-integer, we need to hand
+ # up. If upgrade is undef, result would be the same, anyway
+ if (int($s) != $s)
+ {
+ return $upgrade->new($$x)->bsqrt();
+ }
+ $$x = $s; $x;
+ }
+
+##############################################################################
+# bgcd/blcm
+
+sub import
+ {
+ my $self = shift;
+
+ my @a = @_; my $l = scalar @_; my $j = 0;
+ my $lib = '';
+ for ( my $i = 0; $i < $l ; $i++,$j++ )
+ {
+ if ($_[$i] eq ':constant')
+ {
+ # this causes overlord er load to step in
+ overload::constant integer => sub { $self->new(shift) };
+ splice @a, $j, 1; $j --;
+ }
+ elsif ($_[$i] eq 'upgrade')
+ {
+ # this causes upgrading
+ $upgrade = $_[$i+1]; # or undef to disable
+ my $s = 2; $s = 1 if @a-$j < 2; # no "can not modify non-existant..."
+ splice @a, $j, $s; $j -= $s;
+ }
+ elsif ($_[$i] eq 'lib')
+ {
+ $lib = $_[$i+1]; # or undef to disable
+ my $s = 2; $s = 1 if @a-$j < 2; # no "can not modify non-existant..."
+ splice @a, $j, $s; $j -= $s;
+ }
+ # hand this up to Math::BigInt
+# elsif ($_[$i] =~ /^lib$/i)
+# {
+# # this causes a different low lib to take care...
+# $CALC = $_[$i+1] || '';
+# my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." splice @a, $j, $s; $j -= $s;
+# }
+ }
+ # any non :constant stuff is handled by our parent, Math::BigInt or Exporter
+ # even if @_ is empty, to give it a chance
+ $self->SUPER::import(@a); # need it for subclasses
+ $self->export_to_level(1,$self,@a); # need it for MBF
+ }
+
+1;
+
+__END__
+
+=head1 NAME
+
+Math::BigInt::Lite - What BigInt's are before they become big
+
+=head1 SYNOPSIS
+
+ use Math::BigInt::Lite;
+
+ $x = Math::BigInt::Lite->new(1);
+
+ print $x->bstr(),"\n"; # 1
+ $x = Math::BigInt::Lite->new('1e1234');
+ print $x->bsstr(),"\n"; # 1e1234 (silently upgrades to
+ # Math::BigInt)
+
+=head1 DESCRIPTION
+
+Math::BigInt is not very good suited to work with small (read: typical
+less than 10 digits) numbers, since it has a quite high per-operation overhead
+and is thus too slow.
+
+But for some simple applications, you don't need rounding, infinity nor NaN
+handling, and yet want fast speed for small numbers without the risk of
+overflowing.
+
+This is were Math::BigInt::Lite comes into play.
+
+Math::BigInt::Lite objects should behave in every way like Math::BigInt
+objects, that is apart from the different label, you should not be able
+to tell the difference. Since Math::BigInt::Lite is designed with speed in
+mind, there are certain limitations build-in. In praxis, however, you will
+not feel them, because everytime something gets to big to pass as Lite
+(literally), it will upgrade the objects and operation in question to
+Math::BigInt.
+
+=head2 Math library
+
+Math with the numbers is done (by default) by a module called
+Math::BigInt::Calc. This is equivalent to saying:
+
+ use Math::BigInt::Lite lib => 'Calc';
+
+You can change this by using:
+
+ use Math::BigInt::Lite lib => 'BitVect';
+
+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::BigInt::Lite lib => 'Foo,Math::BigInt::Bar';
+
+Calc.pm uses as internal format an array of elements of some decimal base
+(usually 1e7, but this might be differen for some systems) with the least
+significant digit first, while BitVect.pm uses a bit vector of base 2, most
+significant bit first. Other modules might use even different means of
+representing the numbers. See the respective module documentation for further
+details.
+
+Please note that Math::BigInt::Lite 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:
+
+ use Math::BigInt lib => 'GMP';
+ use Math::BigInt::Lite;
+
+you can roll it all into one line:
+
+ use Math::BigInt::Lite lib => 'GMP';
+
+Use the lib, Luke!
+
+=head2 Using Lite as substitute for Math::BigInt
+
+While Lite is fine when used directly in a script, you also want to make
+other modules such as Math::BigFloat or Math::BigRat using it. Here is how
+(you need a fairly recent version of the aforementioned modules to get this
+to work!):
+
+ # 1
+ use Math::BigFloat with => 'Math::BigInt::Lite';
+
+There is no need to "use Math::BigInt" or "use Math::BigInt::Lite", but you
+can combine these if you want. For instance, you may want to use
+Math::BigInt objects in your main script, too.
+
+ # 2
+ use Math::BigInt;
+ use Math::BigFloat with => 'Math::BigInt::Lite';
+
+Of course, you can combine this with the C<lib> parameter.
+
+ # 3
+ use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'GMP,Pari';
+
+If you want to use Math::BigInt's, too, simple add a Math::BigInt B<before>:
+
+ # 4
+ use Math::BigInt;
+ use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'GMP,Pari';
+
+Notice that the module with the last C<lib> will "win" and thus
+it's lib will be used if the lib is available:
+
+ # 5
+ use Math::BigInt lib => 'Bar,Baz';
+ use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'Foo';
+
+That would try to load Foo, Bar, Baz and Calc (in that order). Or in other
+words, Math::BigFloat will try to retain previously loaded libs when you
+don't specify it one.
+
+Actually, the lib loading order would be "Bar,Baz,Calc", and then
+"Foo,Bar,Baz,Calc", but independend of which lib exists, the result is the
+same as trying the latter load alone, except for the fact that Bar or Baz
+might be loaded needlessly in an intermidiate step
+
+The old way still works though:
+
+ # 6
+ use Math::BigInt lib => 'Bar,Baz';
+ use Math::BigFloat;
+
+But B<examples #3 and #4 are recommended> for usage.
+
+=head1 METHODS
+
+=head2 new
+
+ $x = Math::BigInt::Lite->new('1');
+
+Create a new Math::BigInt:Lite object. When the input is not of an suitable
+simple and small form, a C<$upgrade> object will be returned.
+
+=head1 BUGS
+
+None know yet. Please see also L<Math::BigInt>.
+
+=head1 LICENSE
+
+This program is free software; you may redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
+L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
+
+The L<bignum|bignum> module.
+
+=head1 AUTHORS
+
+(C) by Tels L<http://bloodgate.com/> 2002.
+
+=cut
projects / p5sagit/p5-mst-13.2.git / commitdiff