# 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 themselves to Math::BigInt.

package Math::BigInt::Lite;

require 5.006002;
use strict;

require Exporter;
use Math::BigInt;
use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade
	    $accuracy $precision $round_mode $div_scale $_trap_inf
	    $_trap_nan);

@ISA = qw(Math::BigInt);
@EXPORT_OK = qw/objectify/;
my $class = 'Math::BigInt::Lite';

$VERSION = '0.12';

##############################################################################
# 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|common)$/;
    # 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];
  },
# fake HASH reference, so that Math::BigInt::Lite->new(123)->{sign} works
'%{}' => sub {
     {
     sign => ($_[0] < 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
  {
  # we aren't a BigInt nor BigRat/BigFloat
  $_[1] =~ /^Math::BigInt::Lite/ ? 1 : 0;
  }

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*)?\z/))
      {
      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]);

  $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 $num = ($_[0] || '') eq '-' ? -1 : 1;
  return $x->new($num) unless ref $x;		# Class->bone();
  $$x = $num;
  $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 ($self,$x,$y,$b,@r) = objectify(2,@_);

  $x = $class->new($x) unless ref($x);
  $y = $class->new($y) unless ref($y);
  $b = $$b if ref $b && $b->isa($class);
 
  if (!$x->isa($class))
    {
    $y = $upgrade->new($$y) if $y->isa($class);
    return $x->brsft($y,$b,@r);
    }
  return $upgrade->new($$x)->brsft($y,$b,@r)
   unless $y->isa($class);

  $b = 2 if !defined $b;  
  # can't do this
  return $upgrade->new($$x)->brsft($upgrade->new($$y),$b,@r)
   if $b != 2 || $$y < 0;
  use integer;
  $$x >>= $$y;		# only base 2 for now
  $x;
  }

sub blsft
  {
  # shift left 
  my ($self,$x,$y,$b,@r) = objectify(2,@_);

  $x = $class->new($x) unless ref($x);
  $y = $class->new($x) unless ref($y);

  return $x->blsft($upgrade->new($$y),$b,@r) unless $x->isa($class);
  return $upgrade->new($$x)->blsft($y,$b,@r)
   unless $y->isa($class);

  # overflow: can't do this
  return $upgrade->new($$x)->blsft($upgrade->new($$y),$b,@r)
   if $$y > 31;
  $b = 2 if !defined $b;  
  # can't do this
  return $upgrade->new($$x)->blsft($upgrade->new($$y),$b,@r)
   if $b != 2 || $$y < 0;
  use integer;
  $$x <<= $$y;		# only 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;

  # need to give Math::BigInt a chance to upgrade further
  return $upgrade->new($$x)->bdiv($$y,$a,$p,$r)
   if defined $Math::BigInt::upgrade;
  
  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) <=> 0 if $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,$s) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);

  my $one = 1; $one = -1 if ($s || '+') eq '-';
  return ($$x == $one) <=> 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]) ? (undef,$_[0]) : objectify(1,@_);

  $$x = abs($$x);
  $x;
  }

sub bneg
  {
  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  $$x = -$$x if $$x != 0;
  $x;
  }

sub bnot
  {
  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  $$x = -$$x - 1;
  $x;
  }

##############################################################################
# special calc routines

sub bceil
  {
  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  $x;		# no-op
  }

sub bfloor
  {
  my ($self,$x) = ref($_[0]) ? (undef,$_[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]);

  $x = $upgrade->new($$x) if $x->isa($class);
  $upgrade->bfac($x,$a,$p,$r);
  }

sub bpow
  {
  my ($self,$x,$y,@r) = objectify(2,@_);

  $x = $upgrade->new($$x) if $x->isa($class);
  $y = $upgrade->new($$y) if $y->isa($class);

  $x->bpow($y,@r);
  }

sub blog
  {
  my ($self,$x,$base,@r) = objectify(2,@_);

  $x = $upgrade->new($$x) if $x->isa($class);
  $base = $upgrade->new($$base) if defined $base && $base->isa($class);

  $x->blog($base,@r);
  }

sub bexp
  {
  my ($self,$x,@r) = objectify(2,@_);

  $x = $upgrade->new($$x) if $x->isa($class);

  $x->bexp(@r);
  }

sub bnok
  {
  my ($self,$x,$y,@r) = objectify(2,@_);

  $x = $upgrade->new($$x) if $x->isa($class);
  $y = $upgrade->new($$y) if $y->isa($class);

  $x->bnok($y,@r);
  }

sub broot
  {
  my ($self,$x,$base,@r) = objectify(2,@_);

  $x = $upgrade->new($$x) if $x->isa($class);
  $base = $upgrade->new($$base) if defined $base && $base->isa($class);

  $x->broot($base,@r);
  }

sub bmodpow
  {
  my ($self,$x,$y,@r) = objectify(2,@_);

  $x = $upgrade->new($$x) if $x->isa($class);
  $y = $upgrade->new($$y) if defined $y && $y->isa($class);

  $x->bmodpow($y,@r);
  }

sub bmodinv
  {
  my ($self,$x,$y,@r) = objectify(2,@_);

  $x = $upgrade->new($$x) if $x->isa($class);
  $y = $upgrade->new($$y) if defined $y && $y->isa($class);

  $x->bmodinv($y,@r);
  }

sub bsqrt
  {
  my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) :
    ($class,$class->new($_[0]),$_[1],$_[2],$_[3]);

  return $x->bsqrt(@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;
  }

##############################################################################

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;
      }
    }
  # 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 BigInts 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 much slower than normal Perl for operations like:

	my $x = 1 + 2;				# fast and correct
	my $x = 2 ** 256;			# fast, but wrong

	my $x = Math::BigInt->new(1) + 2;	# slow, but correct
	my $x = Math::BigInt->new(2) ** 256;	# slow, and still correct

But for some applications, you want fast speed for small numbers without
the risk of overflowing.

This is were C<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 => 'GMP';

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';

See the respective low-level math library 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

The pragmas L<bigrat>, L<bignum> and L<bigint> will automatically use
Math::BigInt::Lite whenever possible.

=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, an object of the class of C<$upgrade> (typically
Math::BigInt) will be returned.

All other methods from BigInt and BigFloat should work as expected.

=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::Pari> and L<Math::BigInt::GMP>.

The L<bignum|bignum> module.

=head1 AUTHORS

(C) by Tels L<http://bloodgate.com/> 2002-2007. 

=cut