File Coverage

blib/lib/Math/BigRat.pm

Criterion	Covered	Total	%
statement	828	1040	79.6
branch	538	808	66.5
condition	227	393	57.7
subroutine	97	132	73.4
pod	69	70	98.5
total	1759	2443	72.0

#
# "Tax the rat farms." - Lord Vetinari
#

# The following hash values are used:
#   sign : +,-,NaN,+inf,-inf
#   _d   : denominator
#   _n   : numerator (value = _n/_d)
#   _a   : accuracy
#   _p   : precision
# You should not look at the innards of a BigRat - use the methods for this.

package Math::BigRat;

use 5.006;
use strict;
use warnings;

use Carp         qw< carp croak >;
use Scalar::Util qw< blessed >;

use Math::BigFloat ();

our $VERSION = '0.2622';

our @ISA = qw(Math::BigFloat);

our ($accuracy, $precision, $round_mode, $div_scale,
     $upgrade, $downgrade, $_trap_nan, $_trap_inf);

use overload

  # overload key: with_assign

  '+'     =>      sub { $_[0] -> copy() -> badd($_[1]); },

  '-'     =>      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]); },

  '%'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0])
                              : $_[0] -> copy() -> bmod($_[1]); },

  '**'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0])
                              : $_[0] -> copy() -> bpow($_[1]); },

  '<<'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blsft($_[0])
                              : $_[0] -> copy() -> blsft($_[1]); },

  '>>'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> brsft($_[0])
                              : $_[0] -> copy() -> brsft($_[1]); },

  # overload key: assign

  '+='    =>      sub { $_[0]->badd($_[1]); },

  '-='    =>      sub { $_[0]->bsub($_[1]); },

  '*='    =>      sub { $_[0]->bmul($_[1]); },

  '/='    =>      sub { scalar $_[0]->bdiv($_[1]); },

  '%='    =>      sub { $_[0]->bmod($_[1]); },

  '**='   =>      sub { $_[0]->bpow($_[1]); },

  '<<='   =>      sub { $_[0]->blsft($_[1]); },

  '>>='   =>      sub { $_[0]->brsft($_[1]); },

#  'x='    =>      sub { },

#  '.='    =>      sub { },

  # overload key: num_comparison

  '<'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blt($_[0])
                              : $_[0] -> blt($_[1]); },

  '<='    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> ble($_[0])
                              : $_[0] -> ble($_[1]); },

  '>'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bgt($_[0])
                              : $_[0] -> bgt($_[1]); },

  '>='    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bge($_[0])
                              : $_[0] -> bge($_[1]); },

  '=='    =>      sub { $_[0] -> beq($_[1]); },

  '!='    =>      sub { $_[0] -> bne($_[1]); },

  # overload key: 3way_comparison

  '<=>'   =>      sub { my $cmp = $_[0] -> bcmp($_[1]);
                        defined($cmp) && $_[2] ? -$cmp : $cmp; },

  'cmp'   =>      sub { $_[2] ? "$_[1]" cmp $_[0] -> bstr()
                              : $_[0] -> bstr() cmp "$_[1]"; },

  # overload key: str_comparison

#  '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])
#                              : $_[0] -> bstrgt($_[1]); },
#
#  'ge'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0])
#                              : $_[0] -> bstrge($_[1]); },
#
#  'eq'    =>      sub { $_[0] -> bstreq($_[1]); },
#
#  'ne'    =>      sub { $_[0] -> bstrne($_[1]); },

  # overload key: binary

  '&'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0])
                              : $_[0] -> copy() -> band($_[1]); },

  '&='    =>      sub { $_[0] -> band($_[1]); },

  '|'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0])
                              : $_[0] -> copy() -> bior($_[1]); },

  '|='    =>      sub { $_[0] -> bior($_[1]); },

  '^'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0])
                              : $_[0] -> copy() -> bxor($_[1]); },

  '^='    =>      sub { $_[0] -> bxor($_[1]); },

#  '&.'    =>      sub { },

#  '&.='   =>      sub { },

#  '|.'    =>      sub { },

#  '|.='   =>      sub { },

#  '^.'    =>      sub { },

#  '^.='   =>      sub { },

  # overload key: unary

  'neg'   =>      sub { $_[0] -> copy() -> bneg(); },

#  '!'     =>      sub { },

  '~'     =>      sub { $_[0] -> copy() -> bnot(); },

#  '~.'    =>      sub { },

  # overload key: mutators

  '++'    =>      sub { $_[0] -> binc() },

  '--'    =>      sub { $_[0] -> bdec() },

  # overload key: func

  'atan2' =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0])
                              : $_[0] -> copy() -> batan2($_[1]); },

  'cos'   =>      sub { $_[0] -> copy() -> bcos(); },

  'sin'   =>      sub { $_[0] -> copy() -> bsin(); },

  'exp'   =>      sub { $_[0] -> copy() -> bexp($_[1]); },

  'abs'   =>      sub { $_[0] -> copy() -> babs(); },

  'log'   =>      sub { $_[0] -> copy() -> blog(); },

  'sqrt'  =>      sub { $_[0] -> copy() -> bsqrt(); },

  'int'   =>      sub { $_[0] -> copy() -> bint(); },

  # overload key: conversion

  'bool'  =>      sub { $_[0] -> is_zero() ? '' : 1; },

  '""'    =>      sub { $_[0] -> bstr(); },

  '0+'    =>      sub { $_[0] -> numify(); },

  '='     =>      sub { $_[0]->copy(); },

  ;

BEGIN {
    *objectify = \&Math::BigInt::objectify;  # inherit this from BigInt
    *AUTOLOAD  = \&Math::BigFloat::AUTOLOAD; # can't inherit AUTOLOAD
    # We inherit these from BigFloat because currently it is not possible that
    # Math::BigFloat has a different $LIB variable than we, because
    # Math::BigFloat also uses Math::BigInt::config->('lib') (there is always
    # only one library loaded)
    *_e_add = \&Math::BigFloat::_e_add;
    *_e_sub = \&Math::BigFloat::_e_sub;
    *as_number = \&as_int;
    *is_pos = \&is_positive;
    *is_neg = \&is_negative;
}

##############################################################################
# Global constants and flags. Access these only via the accessor methods!

$accuracy   = $precision = undef;
$round_mode = 'even';
$div_scale  = 40;
$upgrade    = undef;
$downgrade  = undef;

# These are internally, and not to be used from the outside at all!

$_trap_nan = 0;                         # are NaNs ok? set w/ config()
$_trap_inf = 0;                         # are infs ok? set w/ config()

# the math backend library

my $LIB = 'Math::BigInt::Calc';

my $nan   = 'NaN';
#my $class = 'Math::BigRat';

sub isa {
    return 0 if $_[1] =~ /^Math::Big(Int|Float)/;       # we aren't
    UNIVERSAL::isa(@_);
}

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

sub new {
    my $proto    = shift;
    my $protoref = ref $proto;
    my $class    = $protoref || $proto;

    # Check the way we are called.

    if ($protoref) {
        croak("new() is a class method, not an instance method");
    }

    if (@_ < 1) {
        #carp("Using new() with no argument is deprecated;",
        #           " use bzero() or new(0) instead");
        return $class -> bzero();
    }

    if (@_ > 2) {
        carp("Superfluous arguments to new() ignored.");
    }

    # Get numerator and denominator. If any of the arguments is undefined,
    # return zero.

    my ($n, $d) = @_;

    if (@_ == 1 && !defined $n ||
        @_ == 2 && (!defined $n || !defined $d))
    {
        #carp("Use of uninitialized value in new()");
        return $class -> bzero();
    }

    # Initialize a new object.

    my $self = bless {}, $class;

    # One or two input arguments may be given. First handle the numerator $n.

    if (ref($n)) {
        $n = Math::BigFloat -> new($n, undef, undef)
          unless ($n -> isa('Math::BigRat') ||
                  $n -> isa('Math::BigInt') ||
                  $n -> isa('Math::BigFloat'));
    } else {
        if (defined $d) {
            # If the denominator is defined, the numerator is not a string
            # fraction, e.g., "355/113".
            $n = Math::BigFloat -> new($n, undef, undef);
        } else {
            # If the denominator is undefined, the numerator might be a string
            # fraction, e.g., "355/113".
            if ($n =~ m| ^ \s* (\S+) \s* / \s* (\S+) \s* $ |x) {
                $n = Math::BigFloat -> new($1, undef, undef);
                $d = Math::BigFloat -> new($2, undef, undef);
            } else {
                $n = Math::BigFloat -> new($n, undef, undef);
            }
        }
    }

    # At this point $n is an object and $d is either an object or undefined. An
    # undefined $d means that $d was not specified by the caller (not that $d
    # was specified as an undefined value).

    unless (defined $d) {
        #return $n -> copy($n)               if $n -> isa('Math::BigRat');
        if ($n -> isa('Math::BigRat')) {
            return $downgrade -> new($n) if defined($downgrade) && $n -> is_int();
            return $class -> copy($n);
        }

        if ($n -> is_nan()) {
            return $class -> bnan();
        }

        if ($n -> is_inf()) {
            return $class -> binf($n -> sign());
        }

        if ($n -> isa('Math::BigInt')) {
            $self -> {_n}   = $LIB -> _new($n -> copy() -> babs() -> bstr());
            $self -> {_d}   = $LIB -> _one();
            $self -> {sign} = $n -> sign();
            return $downgrade -> new($n) if defined $downgrade;
            return $self;
        }

        if ($n -> isa('Math::BigFloat')) {
            my $m = $n -> mantissa() -> babs();
            my $e = $n -> exponent();
            $self -> {_n} = $LIB -> _new($m -> bstr());
            $self -> {_d} = $LIB -> _one();

            if ($e > 0) {
                $self -> {_n} = $LIB -> _lsft($self -> {_n},
                                              $LIB -> _new($e -> bstr()), 10);
            } elsif ($e < 0) {
                $self -> {_d} = $LIB -> _lsft($self -> {_d},
                                              $LIB -> _new(-$e -> bstr()), 10);

                my $gcd = $LIB -> _gcd($LIB -> _copy($self -> {_n}), $self -> {_d});
                if (!$LIB -> _is_one($gcd)) {
                    $self -> {_n} = $LIB -> _div($self->{_n}, $gcd);
                    $self -> {_d} = $LIB -> _div($self->{_d}, $gcd);
                }
            }

            $self -> {sign} = $n -> sign();
            return $downgrade -> new($n) if defined($downgrade) && $n -> is_int();
            return $self;
        }

        die "I don't know how to handle this";  # should never get here
    }

    # At the point we know that both $n and $d are defined. We know that $n is
    # an object, but $d might still be a scalar. Now handle $d.

    $d = Math::BigFloat -> new($d, undef, undef)
      unless ref($d) && ($d -> isa('Math::BigRat') ||
                         $d -> isa('Math::BigInt') ||
                         $d -> isa('Math::BigFloat'));

    # At this point both $n and $d are objects.

    if ($n -> is_nan() || $d -> is_nan()) {
        return $class -> bnan();
    }

    # At this point neither $n nor $d is a NaN.

    if ($n -> is_zero()) {
        if ($d -> is_zero()) {     # 0/0 = NaN
            return $class -> bnan();
        }
        return $class -> bzero();
    }

    if ($d -> is_zero()) {
        return $class -> binf($d -> sign());
    }

    # At this point, neither $n nor $d is a NaN or a zero.

    # Copy them now before manipulating them.

    $n = $n -> copy();
    $d = $d -> copy();

    if ($d < 0) {               # make sure denominator is positive
        $n -> bneg();
        $d -> bneg();
    }

    if ($n -> is_inf()) {
        return $class -> bnan() if $d -> is_inf();      # Inf/Inf = NaN
        return $class -> binf($n -> sign());
    }

    # At this point $n is finite.

    return $class -> bzero()            if $d -> is_inf();
    return $class -> binf($d -> sign()) if $d -> is_zero();

    # At this point both $n and $d are finite and non-zero.

    if ($n < 0) {
        $n -> bneg();
        $self -> {sign} = '-';
    } else {
        $self -> {sign} = '+';
    }

    if ($n -> isa('Math::BigRat')) {

        if ($d -> isa('Math::BigRat')) {

            # At this point both $n and $d is a Math::BigRat.

            # p   r    p * s    (p / gcd(p, r)) * (s / gcd(s, q))
            # - / -  = ----- =  ---------------------------------
            # q   s    q * r    (q / gcd(s, q)) * (r / gcd(p, r))

            my $p = $n -> {_n};
            my $q = $n -> {_d};
            my $r = $d -> {_n};
            my $s = $d -> {_d};
            my $gcd_pr = $LIB -> _gcd($LIB -> _copy($p), $r);
            my $gcd_sq = $LIB -> _gcd($LIB -> _copy($s), $q);
            $self -> {_n} = $LIB -> _mul($LIB -> _div($LIB -> _copy($p), $gcd_pr),
                                         $LIB -> _div($LIB -> _copy($s), $gcd_sq));
            $self -> {_d} = $LIB -> _mul($LIB -> _div($LIB -> _copy($q), $gcd_sq),
                                         $LIB -> _div($LIB -> _copy($r), $gcd_pr));

            return $downgrade -> new($n->bstr())
              if defined($downgrade) && $self -> is_int();
            return $self;       # no need for $self -> bnorm() here
        }

        # At this point, $n is a Math::BigRat and $d is a Math::Big(Int|Float).

        my $p = $n -> {_n};
        my $q = $n -> {_d};
        my $m = $d -> mantissa();
        my $e = $d -> exponent();

        #                   /      p
        #                  |  ------------  if e > 0
        #                  |  q * m * 10^e
        #                  |
        # p                |    p
        # - / (m * 10^e) = |  -----         if e == 0
        # q                |  q * m
        #                  |
        #                  |  p * 10^-e
        #                  |  --------      if e < 0
        #                   \  q * m

        $self -> {_n} = $LIB -> _copy($p);
        $self -> {_d} = $LIB -> _mul($LIB -> _copy($q), $m);
        if ($e > 0) {
            $self -> {_d} = $LIB -> _lsft($self -> {_d}, $e, 10);
        } elsif ($e < 0) {
            $self -> {_n} = $LIB -> _lsft($self -> {_n}, -$e, 10);
        }

        return $self -> bnorm();

    } else {

        if ($d -> isa('Math::BigRat')) {

            # At this point $n is a Math::Big(Int|Float) and $d is a
            # Math::BigRat.

            my $m = $n -> mantissa();
            my $e = $n -> exponent();
            my $p = $d -> {_n};
            my $q = $d -> {_d};

            #                   /  q * m * 10^e
            #                  |   ------------  if e > 0
            #                  |        p
            #                  |
            #              p   |   m * q
            # (m * 10^e) / - = |   -----         if e == 0
            #              q   |     p
            #                  |
            #                  |     q * m
            #                  |   ---------     if e < 0
            #                   \  p * 10^-e

            $self -> {_n} = $LIB -> _mul($LIB -> _copy($q), $m);
            $self -> {_d} = $LIB -> _copy($p);
            if ($e > 0) {
                $self -> {_n} = $LIB -> _lsft($self -> {_n}, $e, 10);
            } elsif ($e < 0) {
                $self -> {_d} = $LIB -> _lsft($self -> {_d}, -$e, 10);
            }
            return $self -> bnorm();

        } else {

            # At this point $n and $d are both a Math::Big(Int|Float)

            my $m1 = $n -> mantissa();
            my $e1 = $n -> exponent();
            my $m2 = $d -> mantissa();
            my $e2 = $d -> exponent();

            #               /
            #              |  m1 * 10^(e1 - e2)
            #              |  -----------------  if e1 > e2
            #              |         m2
            #              |
            # m1 * 10^e1   |  m1
            # ---------- = |  --                 if e1 = e2
            # m2 * 10^e2   |  m2
            #              |
            #              |         m1
            #              |  -----------------  if e1 < e2
            #              |  m2 * 10^(e2 - e1)
            #               \

            $self -> {_n} = $LIB -> _new($m1 -> bstr());
            $self -> {_d} = $LIB -> _new($m2 -> bstr());
            my $ediff = $e1 - $e2;
            if ($ediff > 0) {
                $self -> {_n} = $LIB -> _lsft($self -> {_n},
                                              $LIB -> _new($ediff -> bstr()),
                                              10);
            } elsif ($ediff < 0) {
                $self -> {_d} = $LIB -> _lsft($self -> {_d},
                                              $LIB -> _new(-$ediff -> bstr()),
                                              10);
            }

            return $self -> bnorm();
        }
    }

    return $downgrade -> new($self -> bstr())
      if defined($downgrade) && $self -> is_int();
    return $self;
}

sub copy {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    # If called as a class method, the object to copy is the next argument.

    $self = shift() unless $selfref;

    my $copy = bless {}, $class;

    $copy->{sign} = $self->{sign};
    $copy->{_d} = $LIB->_copy($self->{_d});
    $copy->{_n} = $LIB->_copy($self->{_n});
    $copy->{_a} = $self->{_a} if defined $self->{_a};
    $copy->{_p} = $self->{_p} if defined $self->{_p};

    #($copy, $copy->{_a}, $copy->{_p})
    #  = $copy->_find_round_parameters(@_);

    return $copy;
}

sub bnan {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    $self = bless {}, $class unless $selfref;

    if ($_trap_nan) {
        croak ("Tried to set a variable to NaN in $class->bnan()");
    }

    return $downgrade -> bnan() if defined $downgrade;

    $self -> {sign} = $nan;
    $self -> {_n}   = $LIB -> _zero();
    $self -> {_d}   = $LIB -> _one();

    ($self, $self->{_a}, $self->{_p})
      = $self->_find_round_parameters(@_);

    return $self;
}

sub binf {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    $self = bless {}, $class unless $selfref;

    my $sign = shift();
    $sign = defined($sign) && substr($sign, 0, 1) eq '-' ? '-inf' : '+inf';

    if ($_trap_inf) {
        croak ("Tried to set a variable to +-inf in $class->binf()");
    }

    return $downgrade -> binf($sign) if defined $downgrade;

    $self -> {sign} = $sign;
    $self -> {_n}   = $LIB -> _zero();
    $self -> {_d}   = $LIB -> _one();

    ($self, $self->{_a}, $self->{_p})
      = $self->_find_round_parameters(@_);

    return $self;
}

sub bone {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    my $sign = shift();
    $sign = '+' unless defined($sign) && $sign eq '-';

    return $downgrade -> bone($sign) if defined $downgrade;

    $self = bless {}, $class unless $selfref;
    $self -> {sign} = $sign;
    $self -> {_n}   = $LIB -> _one();
    $self -> {_d}   = $LIB -> _one();

    ($self, $self->{_a}, $self->{_p})
      = $self->_find_round_parameters(@_);

    return $self;
}

sub bzero {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    return $downgrade -> bzero() if defined $downgrade;

    $self = bless {}, $class unless $selfref;
    $self -> {sign} = '+';
    $self -> {_n}   = $LIB -> _zero();
    $self -> {_d}   = $LIB -> _one();

    ($self, $self->{_a}, $self->{_p})
      = $self->_find_round_parameters(@_);

    return $self;
}

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

sub config {
    # return (later set?) configuration data as hash ref
    my $class = shift() || 'Math::BigRat';

    if (@_ == 1 && ref($_[0]) ne 'HASH') {
        my $cfg = $class->SUPER::config();
        return $cfg->{$_[0]};
    }

    my $cfg = $class->SUPER::config(@_);

    # now we need only to override the ones that are different from our parent
    $cfg->{class} = $class;
    $cfg->{with}  = $LIB;

    $cfg;
}

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

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

    if ($x->{sign} !~ /^[+-]$/) {               # inf, NaN etc
        my $s = $x->{sign};
        $s =~ s/^\+//;                          # +inf => inf
        return $s;
    }

    my $s = '';
    $s = $x->{sign} if $x->{sign} ne '+';       # '+3/2' => '3/2'

    return $s . $LIB->_str($x->{_n}) if $LIB->_is_one($x->{_d});
    $s . $LIB->_str($x->{_n}) . '/' . $LIB->_str($x->{_d});
}

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

    if ($x->{sign} !~ /^[+-]$/) {               # inf, NaN etc
        my $s = $x->{sign};
        $s =~ s/^\+//;                          # +inf => inf
        return $s;
    }

    my $s = '';
    $s = $x->{sign} if $x->{sign} ne '+';       # +3 vs 3
    $s . $LIB->_str($x->{_n}) . '/' . $LIB->_str($x->{_d});
}

sub bnorm {
    # reduce the number to the shortest form
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    # Both parts must be objects of whatever we are using today.
    if (my $c = $LIB->_check($x->{_n})) {
        croak("n did not pass the self-check ($c) in bnorm()");
    }
    if (my $c = $LIB->_check($x->{_d})) {
        croak("d did not pass the self-check ($c) in bnorm()");
    }

    # no normalize for NaN, inf etc.
    if ($x->{sign} !~ /^[+-]$/) {
        return $downgrade -> new($x) if defined $downgrade;
        return $x;
    }

    # normalize zeros to 0/1
    if ($LIB->_is_zero($x->{_n})) {
        return $downgrade -> bzero() if defined($downgrade);
        $x->{sign} = '+';                               # never leave a -0
        $x->{_d} = $LIB->_one() unless $LIB->_is_one($x->{_d});
        return $x;
    }

    # n/1
    if ($LIB->_is_one($x->{_d})) {
        return $downgrade -> new($x) if defined($downgrade);
        return $x;               # no need to reduce
    }

    # Compute the GCD.
    my $gcd = $LIB->_gcd($LIB->_copy($x->{_n}), $x->{_d});
    if (!$LIB->_is_one($gcd)) {
        $x->{_n} = $LIB->_div($x->{_n}, $gcd);
        $x->{_d} = $LIB->_div($x->{_d}, $gcd);
    }

    $x;
}

##############################################################################
# sign manipulation

sub bneg {
    # (BRAT or num_str) return BRAT
    # negate number or make a negated number from string
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    return $x if $x->modify('bneg');

    # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN'
    $x->{sign} =~ tr/+-/-+/
      unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{_n}));

    return $downgrade -> new($x)
      if defined($downgrade) && $LIB -> _is_one($x->{_d});
    $x;
}

##############################################################################
# special values

sub _bnan {
    # used by parent class bnan() to initialize number to NaN
    my $self = shift;

    if ($_trap_nan) {
        my $class = ref($self);
        # "$self" below will stringify the object, this blows up if $self is a
        # partial object (happens under trap_nan), so fix it beforehand
        $self->{_d} = $LIB->_zero() unless defined $self->{_d};
        $self->{_n} = $LIB->_zero() unless defined $self->{_n};
        croak ("Tried to set $self to NaN in $class\::_bnan()");
    }
    $self->{_n} = $LIB->_zero();
    $self->{_d} = $LIB->_zero();
}

sub _binf {
    # used by parent class bone() to initialize number to +inf/-inf
    my $self = shift;

    if ($_trap_inf) {
        my $class = ref($self);
        # "$self" below will stringify the object, this blows up if $self is a
        # partial object (happens under trap_nan), so fix it beforehand
        $self->{_d} = $LIB->_zero() unless defined $self->{_d};
        $self->{_n} = $LIB->_zero() unless defined $self->{_n};
        croak ("Tried to set $self to inf in $class\::_binf()");
    }
    $self->{_n} = $LIB->_zero();
    $self->{_d} = $LIB->_zero();
}

sub _bone {
    # used by parent class bone() to initialize number to +1/-1
    my $self = shift;
    $self->{_n} = $LIB->_one();
    $self->{_d} = $LIB->_one();
}

sub _bzero {
    # used by parent class bzero() to initialize number to 0
    my $self = shift;
    $self->{_n} = $LIB->_zero();
    $self->{_d} = $LIB->_one();
}

##############################################################################
# mul/add/div etc

sub badd {
    # add two rational numbers

    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    unless ($x -> is_finite() && $y -> is_finite()) {
        if ($x -> is_nan() || $y -> is_nan()) {
            return $x -> bnan(@r);
        } elsif ($x -> is_inf("+")) {
            return $x -> bnan(@r) if $y -> is_inf("-");
            return $x -> binf("+", @r);
        } elsif ($x -> is_inf("-")) {
            return $x -> bnan(@r) if $y -> is_inf("+");
            return $x -> binf("-", @r);
        } elsif ($y -> is_inf("+")) {
            return $x -> binf("+", @r);
        } elsif ($y -> is_inf("-")) {
            return $x -> binf("-", @r);
        }
    }

    #  1   1    gcd(3, 4) = 1    1*3 + 1*4    7
    #  - + -                  = --------- = --
    #  4   3                      4*3       12

    # we do not compute the gcd() here, but simple do:
    #  5   7    5*3 + 7*4   43
    #  - + -  = --------- = --
    #  4   3       4*3      12

    # and bnorm() will then take care of the rest

    # 5 * 3
    $x->{_n} = $LIB->_mul($x->{_n}, $y->{_d});

    # 7 * 4
    my $m = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});

    # 5 * 3 + 7 * 4
    ($x->{_n}, $x->{sign}) = _e_add($x->{_n}, $m, $x->{sign}, $y->{sign});

    # 4 * 3
    $x->{_d} = $LIB->_mul($x->{_d}, $y->{_d});

    # normalize result, and possible round
    $x->bnorm()->round(@r);
}

sub bsub {
    # subtract two rational numbers

    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    # flip sign of $x, call badd(), then flip sign of result
    $x->{sign} =~ tr/+-/-+/
      unless $x->{sign} eq '+' && $x -> is_zero();      # not -0
    $x = $x->badd($y, @r);           # does norm and round
    $x->{sign} =~ tr/+-/-+/
      unless $x->{sign} eq '+' && $x -> is_zero();      # not -0

    $x->bnorm();
}

sub bmul {
    # multiply two rational numbers

    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN';

    # inf handling
    if ($x->{sign} =~ /^[+-]inf$/ || $y->{sign} =~ /^[+-]inf$/) {
        return $x->bnan() if $x->is_zero() || $y->is_zero();
        # result will always be +-inf:
        # +inf * +/+inf => +inf, -inf * -/-inf => +inf
        # +inf * -/-inf => -inf, -inf * +/+inf => -inf
        return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
        return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
        return $x->binf('-');
    }

    # x == 0  # also: or y == 1 or y == -1
    if ($x -> is_zero()) {
        $x = $downgrade -> bzero($x) if defined $downgrade;
        return wantarray ? ($x, $class->bzero()) : $x;
    }

    if ($y -> is_zero()) {
        $x = defined($downgrade) ? $downgrade -> bzero($x) : $x -> bzero();
        return wantarray ? ($x, $class->bzero()) : $x;
    }

    # According to Knuth, this can be optimized by doing gcd twice (for d
    # and n) and reducing in one step. This saves us a bnorm() at the end.
    #
    # p   s    p * s    (p / gcd(p, r)) * (s / gcd(s, q))
    # - * -  = ----- =  ---------------------------------
    # q   r    q * r    (q / gcd(s, q)) * (r / gcd(p, r))

    my $gcd_pr = $LIB -> _gcd($LIB -> _copy($x->{_n}), $y->{_d});
    my $gcd_sq = $LIB -> _gcd($LIB -> _copy($y->{_n}), $x->{_d});

    $x->{_n} = $LIB -> _mul(scalar $LIB -> _div($x->{_n}, $gcd_pr),
                            scalar $LIB -> _div($LIB -> _copy($y->{_n}),
                                                $gcd_sq));
    $x->{_d} = $LIB -> _mul(scalar $LIB -> _div($x->{_d}, $gcd_sq),
                            scalar $LIB -> _div($LIB -> _copy($y->{_d}),
                                                $gcd_pr));

    # compute new sign
    $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';

    $x->bnorm()->round(@r);
}

sub bdiv {
    # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
    # (BRAT, BRAT) (quo, rem) or BRAT (only rem)

    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    return $x if $x->modify('bdiv');

    my $wantarray = wantarray;  # call only once

    # At least one argument is NaN. This is handled the same way as in
    # Math::BigInt -> bdiv(). See the comments in the code implementing that
    # method.

    if ($x -> is_nan() || $y -> is_nan()) {
        if ($wantarray) {
            return $downgrade -> bnan(), $downgrade -> bnan()
              if defined($downgrade);
            return $x -> bnan(), $class -> bnan();
        } else {
            return $downgrade -> bnan()
              if defined($downgrade);
            return $x -> bnan();
        }
    }

    # Divide by zero and modulo zero. This is handled the same way as in
    # Math::BigInt -> bdiv(). See the comments in the code implementing that
    # method.

    if ($y -> is_zero()) {
        my ($quo, $rem);
        if ($wantarray) {
            $rem = $x -> copy();
        }
        if ($x -> is_zero()) {
            $quo = $x -> bnan();
        } else {
            $quo = $x -> binf($x -> {sign});
        }

        $quo = $downgrade -> new($quo)
          if defined($downgrade) && $quo -> is_int();
        $rem = $downgrade -> new($rem)
          if $wantarray && defined($downgrade) && $rem -> is_int();
        return $wantarray ? ($quo, $rem) : $quo;
    }

    # Numerator (dividend) is +/-inf. This is handled the same way as in
    # Math::BigInt -> bdiv(). See the comments in the code implementing that
    # method.

    if ($x -> is_inf()) {
        my ($quo, $rem);
        $rem = $class -> bnan() if $wantarray;
        if ($y -> is_inf()) {
            $quo = $x -> bnan();
        } else {
            my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
            $quo = $x -> binf($sign);
        }

        $quo = $downgrade -> new($quo)
          if defined($downgrade) && $quo -> is_int();
        $rem = $downgrade -> new($rem)
          if $wantarray && defined($downgrade) && $rem -> is_int();
        return $wantarray ? ($quo, $rem) : $quo;
    }

    # Denominator (divisor) is +/-inf. This is handled the same way as in
    # Math::BigFloat -> bdiv(). See the comments in the code implementing that
    # method.

    if ($y -> is_inf()) {
        my ($quo, $rem);
        if ($wantarray) {
            if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
                $rem = $x -> copy();
                $quo = $x -> bzero();
            } else {
                $rem = $class -> binf($y -> {sign});
                $quo = $x -> bone('-');
            }
            $quo = $downgrade -> new($quo)
              if defined($downgrade) && $quo -> is_int();
            $rem = $downgrade -> new($rem)
              if defined($downgrade) && $rem -> is_int();
            return ($quo, $rem);
        } else {
            if ($y -> is_inf()) {
                if ($x -> is_nan() || $x -> is_inf()) {
                    return $downgrade -> bnan() if defined $downgrade;
                    return $x -> bnan();
                } else {
                    return $downgrade -> bzero() if defined $downgrade;
                    return $x -> bzero();
                }
            }
        }
    }

    # At this point, both the numerator and denominator are finite numbers, and
    # the denominator (divisor) is non-zero.

    # x == 0?
    if ($x->is_zero()) {
        return $wantarray ? ($downgrade -> bzero(), $downgrade -> bzero())
                          : $downgrade -> bzero() if defined $downgrade;
        return $wantarray ? ($x, $class->bzero()) : $x;
    }

    # XXX TODO: list context, upgrade
    # According to Knuth, this can be optimized by doing gcd twice (for d and n)
    # and reducing in one step. This would save us the bnorm() at the end.
    #
    # p   r    p * s    (p / gcd(p, r)) * (s / gcd(s, q))
    # - / -  = ----- =  ---------------------------------
    # q   s    q * r    (q / gcd(s, q)) * (r / gcd(p, r))

    $x->{_n} = $LIB->_mul($x->{_n}, $y->{_d});
    $x->{_d} = $LIB->_mul($x->{_d}, $y->{_n});

    # compute new sign
    $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';

    $x -> bnorm();
    if (wantarray) {
        my $rem = $x -> copy();
        $x = $x -> bfloor();
        $x = $x -> round(@r);
        $rem = $rem -> bsub($x -> copy()) -> bmul($y);
        $x   = $downgrade -> new($x)   if defined($downgrade) && $x -> is_int();
        $rem = $downgrade -> new($rem) if defined($downgrade) && $rem -> is_int();
        return $x, $rem;
    } else {
        return $x -> round(@r);
    }
}

sub bmod {
    # compute "remainder" (in Perl way) of $x / $y

    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    return $x if $x->modify('bmod');

    # At least one argument is NaN. This is handled the same way as in
    # Math::BigInt -> bmod().

    if ($x -> is_nan() || $y -> is_nan()) {
        return $x -> bnan();
    }

    # Modulo zero. This is handled the same way as in Math::BigInt -> bmod().

    if ($y -> is_zero()) {
        return $downgrade -> bzero() if defined $downgrade;
        return $x;
    }

    # Numerator (dividend) is +/-inf. This is handled the same way as in
    # Math::BigInt -> bmod().

    if ($x -> is_inf()) {
        return $x -> bnan();
    }

    # Denominator (divisor) is +/-inf. This is handled the same way as in
    # Math::BigInt -> bmod().

    if ($y -> is_inf()) {
        if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
            return $downgrade -> new($x) if defined($downgrade) && $x -> is_int();
            return $x;
        } else {
            return $downgrade -> binf($y -> sign()) if defined($downgrade);
            return $x -> binf($y -> sign());
        }
    }

    # At this point, both the numerator and denominator are finite numbers, and
    # the denominator (divisor) is non-zero.

    if ($x->is_zero()) {        # 0 / 7 = 0, mod 0
        return $downgrade -> bzero() if defined $downgrade;
        return $x;
    }

    # Compute $x - $y * floor($x/$y). This can probably be optimized by working
    # on a lower level.

    $x -> bsub($x -> copy() -> bdiv($y) -> bfloor() -> bmul($y));
    return $x -> round(@r);
}

##############################################################################
# bdec/binc

sub bdec {
    # decrement value (subtract 1)
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    if ($x->{sign} !~ /^[+-]$/) {       # NaN, inf, -inf
        return $downgrade -> new($x) if defined $downgrade;
        return $x;
    }

    if ($x->{sign} eq '-') {
        $x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # -5/2 => -7/2
    } else {
        if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) # n < d?
        {
            # 1/3 -- => -2/3
            $x->{_n} = $LIB->_sub($LIB->_copy($x->{_d}), $x->{_n});
            $x->{sign} = '-';
        } else {
            $x->{_n} = $LIB->_sub($x->{_n}, $x->{_d}); # 5/2 => 3/2
        }
    }
    $x->bnorm()->round(@r);
}

sub binc {
    # increment value (add 1)
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    if ($x->{sign} !~ /^[+-]$/) {       # NaN, inf, -inf
        return $downgrade -> new($x) if defined $downgrade;
        return $x;
    }

    if ($x->{sign} eq '-') {
        if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) {
            # -1/3 ++ => 2/3 (overflow at 0)
            $x->{_n} = $LIB->_sub($LIB->_copy($x->{_d}), $x->{_n});
            $x->{sign} = '+';
        } else {
            $x->{_n} = $LIB->_sub($x->{_n}, $x->{_d}); # -5/2 => -3/2
        }
    } else {
        $x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # 5/2 => 7/2
    }
    $x->bnorm()->round(@r);
}

sub binv {
    my $x = shift;
    my @r = @_;

    return $x if $x->modify('binv');

    return $x              if $x -> is_nan();
    return $x -> bzero()   if $x -> is_inf();
    return $x -> binf("+") if $x -> is_zero();

    ($x -> {_n}, $x -> {_d}) = ($x -> {_d}, $x -> {_n});
    $x -> round(@r);
}

##############################################################################
# is_foo methods (the rest is inherited)

sub is_int {
    # return true if arg (BRAT or num_str) is an integer
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
      $LIB->_is_one($x->{_d});              # x/y && y != 1 => no integer
    0;
}

sub is_zero {
    # return true if arg (BRAT or num_str) is zero
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    return 1 if $x->{sign} eq '+' && $LIB->_is_zero($x->{_n});
    0;
}

sub is_one {
    # return true if arg (BRAT or num_str) is +1 or -1 if signis given
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    croak "too many arguments for is_one()" if @_ > 2;
    my $sign = $_[1] || '';
    $sign = '+' if $sign ne '-';
    return 1 if ($x->{sign} eq $sign &&
                 $LIB->_is_one($x->{_n}) && $LIB->_is_one($x->{_d}));
    0;
}

sub is_odd {
    # return true if arg (BFLOAT or num_str) is odd or false if even
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    return 1 if ($x->{sign} =~ /^[+-]$/) &&               # NaN & +-inf aren't
      ($LIB->_is_one($x->{_d}) && $LIB->_is_odd($x->{_n})); # x/2 is not, but 3/1
    0;
}

sub is_even {
    # return true if arg (BINT or num_str) is even or false if odd
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
    return 1 if ($LIB->_is_one($x->{_d}) # x/3 is never
                 && $LIB->_is_even($x->{_n})); # but 4/1 is
    0;
}

##############################################################################
# parts() and friends

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

    # NaN, inf, -inf
    return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);

    my $n = Math::BigInt->new($LIB->_str($x->{_n}));
    $n->{sign} = $x->{sign};
    $n;
}

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

    # NaN
    return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN';
    # inf, -inf
    return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/;

    Math::BigInt->new($LIB->_str($x->{_d}));
}

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

    my $c = 'Math::BigInt';

    return ($c->bnan(), $c->bnan()) if $x->{sign} eq 'NaN';
    return ($c->binf(), $c->binf()) if $x->{sign} eq '+inf';
    return ($c->binf('-'), $c->binf()) if $x->{sign} eq '-inf';

    my $n = $c->new($LIB->_str($x->{_n}));
    $n->{sign} = $x->{sign};
    my $d = $c->new($LIB->_str($x->{_d}));
    ($n, $d);
}

sub dparts {
    my $x = shift;
    my $class = ref $x;

    croak("dparts() is an instance method") unless $class;

    if ($x -> is_nan()) {
        return $class -> bnan(), $class -> bnan() if wantarray;
        return $class -> bnan();
    }

    if ($x -> is_inf()) {
        return $class -> binf($x -> sign()), $class -> bzero() if wantarray;
        return $class -> binf($x -> sign());
    }

    # 355/113 => 3 + 16/113

    my ($q, $r)  = $LIB -> _div($LIB -> _copy($x -> {_n}), $x -> {_d});

    my $int = Math::BigRat -> new($x -> {sign} . $LIB -> _str($q));
    return $int unless wantarray;

    my $frc = Math::BigRat -> new($x -> {sign} . $LIB -> _str($r),
                                  $LIB -> _str($x -> {_d}));

    return $int, $frc;
}

sub fparts {
    my $x = shift;
    my $class = ref $x;

    croak("fparts() is an instance method") unless $class;

    return ($class -> bnan(),
            $class -> bnan()) if $x -> is_nan();

    my $numer = $x -> copy();
    my $denom = $class -> bzero();

    $denom -> {_n} = $numer -> {_d};
    $numer -> {_d} = $LIB -> _one();

    return ($numer, $denom);
}

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

    return $nan unless $x->is_int();
    $LIB->_len($x->{_n});       # length(-123/1) => length(123)
}

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

    return $nan unless $x->is_int();
    $LIB->_digit($x->{_n}, $n || 0); # digit(-123/1, 2) => digit(123, 2)
}

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

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

    if ($x->{sign} !~ /^[+-]$/ ||     # NaN or inf or
        $LIB->_is_one($x->{_d}))      # integer
    {
        return $downgrade -> new($x) if defined $downgrade;
        return $x;
    }

    $x->{_n} = $LIB->_div($x->{_n}, $x->{_d});  # 22/7 => 3/1 w/ truncate
    $x->{_d} = $LIB->_one();                    # d => 1
    $x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '+';   # +22/7 => 4/1
    $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_zero($x->{_n}); # -0 => 0
    return $downgrade -> new($x) if defined $downgrade;
    $x;
}

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

    if ($x->{sign} !~ /^[+-]$/ ||     # NaN or inf or
        $LIB->_is_one($x->{_d}))      # integer
    {
        return $downgrade -> new($x) if defined $downgrade;
        return $x;
    }

    $x->{_n} = $LIB->_div($x->{_n}, $x->{_d});  # 22/7 => 3/1 w/ truncate
    $x->{_d} = $LIB->_one();                    # d => 1
    $x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '-';   # -22/7 => -4/1
    return $downgrade -> new($x) if defined $downgrade;
    $x;
}

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

    if ($x->{sign} !~ /^[+-]$/ ||     # NaN or inf or
        $LIB->_is_one($x->{_d}))      # integer
    {
        return $downgrade -> new($x) if defined $downgrade;
        return $x;
    }

    $x->{_n} = $LIB->_div($x->{_n}, $x->{_d});  # 22/7 => 3/1 w/ truncate
    $x->{_d} = $LIB->_one();                    # d => 1
    $x->{sign} = '+' if $x->{sign} eq '-' && $LIB -> _is_zero($x->{_n});
    return $downgrade -> new($x) if defined $downgrade;
    return $x;
}

sub bfac {
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    # if $x is not an integer
    if (($x->{sign} ne '+') || (!$LIB->_is_one($x->{_d}))) {
        return $x->bnan();
    }

    $x->{_n} = $LIB->_fac($x->{_n});
    # since _d is 1, we don't need to reduce/norm the result
    $x->round(@r);
}

sub bpow {
    # power ($x ** $y)

    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    return $x if $x->modify('bpow');

    # $x and/or $y is a NaN
    return $x->bnan() if $x->is_nan() || $y->is_nan();

    # $x and/or $y is a +/-Inf
    if ($x->is_inf("-")) {
        return $x->bzero()   if $y->is_negative();
        return $x->bnan()    if $y->is_zero();
        return $x            if $y->is_odd();
        return $x->bneg();
    } elsif ($x->is_inf("+")) {
        return $x->bzero()   if $y->is_negative();
        return $x->bnan()    if $y->is_zero();
        return $x;
    } elsif ($y->is_inf("-")) {
        return $x->bnan()    if $x -> is_one("-");
        return $x->binf("+") if $x > -1 && $x < 1;
        return $x->bone()    if $x -> is_one("+");
        return $x->bzero();
    } elsif ($y->is_inf("+")) {
        return $x->bnan()    if $x -> is_one("-");
        return $x->bzero()   if $x > -1 && $x < 1;
        return $x->bone()    if $x -> is_one("+");
        return $x->binf("+");
    }

    if ($x -> is_zero()) {
        return $x -> bone() if $y -> is_zero();
        return $x -> binf() if $y -> is_negative();
        return $x;
    }

    # We don't support complex numbers, so upgrade or return NaN.

    if ($x -> is_negative() && !$y -> is_int()) {
        return $upgrade -> bpow($upgrade -> new($x), $y, @r)
          if defined $upgrade;
        return $x -> bnan();
    }

    if ($x -> is_one("+") || $y -> is_one()) {
        return $x;
    }

    if ($x -> is_one("-")) {
        return $x if $y -> is_odd();
        return $x -> bneg();
    }

    # (a/b)^-(c/d) = (b/a)^(c/d)
    ($x->{_n}, $x->{_d}) = ($x->{_d}, $x->{_n}) if $y->is_negative();

    unless ($LIB->_is_one($y->{_n})) {
        $x->{_n} = $LIB->_pow($x->{_n}, $y->{_n});
        $x->{_d} = $LIB->_pow($x->{_d}, $y->{_n});
        $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_even($y->{_n});
    }

    unless ($LIB->_is_one($y->{_d})) {
        return $x->bsqrt(@r) if $LIB->_is_two($y->{_d}); # 1/2 => sqrt
        return $x->broot($LIB->_str($y->{_d}), @r);      # 1/N => root(N)
    }

    return $x->round(@r);
}

sub blog {
    # Return the logarithm of the operand. If a second operand is defined, that
    # value is used as the base, otherwise the base is assumed to be Euler's
    # constant.

    my ($class, $x, $base, @r);

    # Don't objectify the base, since an undefined base, as in $x->blog() or
    # $x->blog(undef) signals that the base is Euler's number.

    if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
        # E.g., Math::BigRat->blog(256, 2)
        ($class, $x, $base, @r) =
          defined $_[2] ? objectify(2, @_) : objectify(1, @_);
    } else {
        # E.g., Math::BigRat::blog(256, 2) or $x->blog(2)
        ($class, $x, $base, @r) =
          defined $_[1] ? objectify(2, @_) : objectify(1, @_);
    }

    return $x if $x->modify('blog');

    # Handle all exception cases and all trivial cases. I have used Wolfram Alpha
    # (http://www.wolframalpha.com) as the reference for these cases.

    return $x -> bnan() if $x -> is_nan();

    if (defined $base) {
        $base = $class -> new($base) unless ref $base;
        if ($base -> is_nan() || $base -> is_one()) {
            return $x -> bnan();
        } elsif ($base -> is_inf() || $base -> is_zero()) {
            return $x -> bnan() if $x -> is_inf() || $x -> is_zero();
            return $x -> bzero();
        } elsif ($base -> is_negative()) {        # -inf < base < 0
            return $x -> bzero() if $x -> is_one(); #     x = 1
            return $x -> bone()  if $x == $base;    #     x = base
            return $x -> bnan();                    #     otherwise
        }
        return $x -> bone() if $x == $base; # 0 < base && 0 < x < inf
    }

    # We now know that the base is either undefined or positive and finite.

    if ($x -> is_inf()) {       # x = +/-inf
        my $sign = defined $base && $base < 1 ? '-' : '+';
        return $x -> binf($sign);
    } elsif ($x -> is_neg()) {  # -inf < x < 0
        return $x -> bnan();
    } elsif ($x -> is_one()) {  # x = 1
        return $x -> bzero();
    } elsif ($x -> is_zero()) { # x = 0
        my $sign = defined $base && $base < 1 ? '+' : '-';
        return $x -> binf($sign);
    }

    # Now take care of the cases where $x and/or $base is 1/N.
    #
    #   log(1/N) / log(B)   = -log(N)/log(B)
    #   log(1/N) / log(1/B) =  log(N)/log(B)
    #   log(N)   / log(1/B) = -log(N)/log(B)

    my $neg = 0;
    if ($x -> numerator() -> is_one()) {
        $x -> binv();
        $neg = !$neg;
    }
    if (defined(blessed($base)) && $base -> isa($class)) {
        if ($base -> numerator() -> is_one()) {
            $base = $base -> copy() -> binv();
            $neg = !$neg;
        }
    }

    # At this point we are done handling all exception cases and trivial cases.

    $base = Math::BigFloat -> new($base) if defined $base;

    my $xn = Math::BigFloat -> new($LIB -> _str($x->{_n}));
    my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));

    my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> blog($base, @r) -> bsstr());

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_n}   = $xtmp -> {_n};
    $x -> {_d}   = $xtmp -> {_d};

    return $neg ? $x -> bneg() : $x;
}

sub bexp {
    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(1, @_);
    }

    return $x->binf(@r)  if $x->{sign} eq '+inf';
    return $x->bzero(@r) if $x->{sign} eq '-inf';

    # we need to limit the accuracy to protect against overflow
    my $fallback = 0;
    my ($scale, @params);
    ($x, @params) = $x->_find_round_parameters(@r);

    # also takes care of the "error in _find_round_parameters?" case
    return $x if $x->{sign} eq 'NaN';

    # no rounding at all, so must use fallback
    if (scalar @params == 0) {
        # simulate old behaviour
        $params[0] = $class->div_scale(); # and round to it as accuracy
        $params[1] = undef;              # P = undef
        $scale = $params[0]+4;           # at least four more for proper round
        $params[2] = $r[2];              # round mode by caller or undef
        $fallback = 1;                   # to clear a/p afterwards
    } else {
        # the 4 below is empirical, and there might be cases where it's not enough...
        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

    return $x->bone(@params) if $x->is_zero();

    # See the comments in Math::BigFloat on how this algorithm works.
    # Basically we calculate A and B (where B is faculty(N)) so that A/B = e

    my $x_org = $x->copy();
    if ($scale <= 75) {
        # set $x directly from a cached string form
        $x->{_n} =
          $LIB->_new("90933395208605785401971970164779391644753259799242");
        $x->{_d} =
          $LIB->_new("33452526613163807108170062053440751665152000000000");
        $x->{sign} = '+';
    } else {
        # compute A and B so that e = A / B.

        # After some terms we end up with this, so we use it as a starting point:
        my $A = $LIB->_new("90933395208605785401971970164779391644753259799242");
        my $F = $LIB->_new(42); my $step = 42;

        # Compute how many steps we need to take to get $A and $B sufficiently big
        my $steps = Math::BigFloat::_len_to_steps($scale - 4);
        #    print STDERR "# Doing $steps steps for ", $scale-4, " digits\n";
        while ($step++ <= $steps) {
            # calculate $a * $f + 1
            $A = $LIB->_mul($A, $F);
            $A = $LIB->_inc($A);
            # increment f
            $F = $LIB->_inc($F);
        }
        # compute $B as factorial of $steps (this is faster than doing it manually)
        my $B = $LIB->_fac($LIB->_new($steps));

        #  print "A ", $LIB->_str($A), "\nB ", $LIB->_str($B), "\n";

        $x->{_n} = $A;
        $x->{_d} = $B;
        $x->{sign} = '+';
    }

    # $x contains now an estimate of e, with some surplus digits, so we can round
    if (!$x_org->is_one()) {
        # raise $x to the wanted power and round it in one step:
        $x->bpow($x_org, @params);
    } else {
        # else just round the already computed result
        delete $x->{_a}; delete $x->{_p};
        # shortcut to not run through _find_round_parameters again
        if (defined $params[0]) {
            $x->bround($params[0], $params[2]); # then round accordingly
        } else {
            $x->bfround($params[1], $params[2]); # then round accordingly
        }
    }
    if ($fallback) {
        # clear a/p after round, since user did not request it
        delete $x->{_a}; delete $x->{_p};
    }

    $x;
}

sub bnok {
    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    return $x->bnan() if $x->is_nan() || $y->is_nan();
    return $x->bnan() if (($x->is_finite() && !$x->is_int()) ||
                          ($y->is_finite() && !$y->is_int()));

    my $xint = Math::BigInt -> new($x -> bstr());
    my $yint = Math::BigInt -> new($y -> bstr());
    $xint -> bnok($yint);
    my $xrat = Math::BigRat -> new($xint);

    $x -> {sign} = $xrat -> {sign};
    $x -> {_n}   = $xrat -> {_n};
    $x -> {_d}   = $xrat -> {_d};

    return $x;
}

sub broot {
    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    # Convert $x into a Math::BigFloat.

    my $xd   = Math::BigFloat -> new($LIB -> _str($x->{_d}));
    my $xflt = Math::BigFloat -> new($LIB -> _str($x->{_n})) -> bdiv($xd);
    $xflt -> {sign} = $x -> {sign};

    # Convert $y into a Math::BigFloat.

    my $yd   = Math::BigFloat -> new($LIB -> _str($y->{_d}));
    my $yflt = Math::BigFloat -> new($LIB -> _str($y->{_n})) -> bdiv($yd);
    $yflt -> {sign} = $y -> {sign};

    # Compute the root and convert back to a Math::BigRat.

    $xflt -> broot($yflt, @r);
    my $xtmp = Math::BigRat -> new($xflt -> bsstr());

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_n}   = $xtmp -> {_n};
    $x -> {_d}   = $xtmp -> {_d};

    return $x;
}

sub bmodpow {
    # set up parameters
    my ($class, $x, $y, $m, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, $m, @r) = objectify(3, @_);
    }

    # Convert $x, $y, and $m into Math::BigInt objects.

    my $xint = Math::BigInt -> new($x -> copy() -> bint());
    my $yint = Math::BigInt -> new($y -> copy() -> bint());
    my $mint = Math::BigInt -> new($m -> copy() -> bint());

    $xint -> bmodpow($yint, $mint, @r);
    my $xtmp = Math::BigRat -> new($xint -> bsstr());

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_n}   = $xtmp -> {_n};
    $x -> {_d}   = $xtmp -> {_d};
    return $x;
}

sub bmodinv {
    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

    # Convert $x and $y into Math::BigInt objects.

    my $xint = Math::BigInt -> new($x -> copy() -> bint());
    my $yint = Math::BigInt -> new($y -> copy() -> bint());

    $xint -> bmodinv($yint, @r);
    my $xtmp = Math::BigRat -> new($xint -> bsstr());

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_n}   = $xtmp -> {_n};
    $x -> {_d}   = $xtmp -> {_d};
    return $x;
}

sub bsqrt {
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
    return $x if $x->{sign} eq '+inf';         # sqrt(inf) == inf
    return $x->round(@r) if $x->is_zero() || $x->is_one();

    my $n = $x -> {_n};
    my $d = $x -> {_d};

    # Look for an exact solution. For the numerator and the denominator, take
    # the square root and square it and see if we got the original value. If we
    # did, for both the numerator and the denominator, we have an exact
    # solution.

    {
        my $nsqrt = $LIB -> _sqrt($LIB -> _copy($n));
        my $n2    = $LIB -> _mul($LIB -> _copy($nsqrt), $nsqrt);
        if ($LIB -> _acmp($n, $n2) == 0) {
            my $dsqrt = $LIB -> _sqrt($LIB -> _copy($d));
            my $d2    = $LIB -> _mul($LIB -> _copy($dsqrt), $dsqrt);
            if ($LIB -> _acmp($d, $d2) == 0) {
                $x -> {_n} = $nsqrt;
                $x -> {_d} = $dsqrt;
                return $x->round(@r);
            }
        }
    }

    local $Math::BigFloat::upgrade   = undef;
    local $Math::BigFloat::downgrade = undef;
    local $Math::BigFloat::precision = undef;
    local $Math::BigFloat::accuracy  = undef;
    local $Math::BigInt::upgrade     = undef;
    local $Math::BigInt::precision   = undef;
    local $Math::BigInt::accuracy    = undef;

    my $xn = Math::BigFloat -> new($LIB -> _str($n));
    my $xd = Math::BigFloat -> new($LIB -> _str($d));

    my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> bsqrt() -> bsstr());

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_n}   = $xtmp -> {_n};
    $x -> {_d}   = $xtmp -> {_d};

    $x->round(@r);
}

sub blsft {
    my ($class, $x, $y, $b) = objectify(2, @_);

    $b = 2 if !defined $b;
    $b = $class -> new($b) unless ref($b) && $b -> isa($class);

    return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();

    # shift by a negative amount?
    return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;

    $x -> bmul($b -> bpow($y));
}

sub brsft {
    my ($class, $x, $y, $b) = objectify(2, @_);

    $b = 2 if !defined $b;
    $b = $class -> new($b) unless ref($b) && $b -> isa($class);

    return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();

    # shift by a negative amount?
    return $x -> blsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;

    # the following call to bdiv() will return either quotient (scalar context)
    # or quotient and remainder (list context).
    $x -> bdiv($b -> bpow($y));
}

sub band {
    my $x     = shift;
    my $xref  = ref($x);
    my $class = $xref || $x;

    croak 'band() is an instance method, not a class method' unless $xref;
    croak 'Not enough arguments for band()' if @_ < 1;

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

    my @r = @_;

    my $xtmp = Math::BigInt -> new($x -> bint());   # to Math::BigInt
    $xtmp -> band($y);
    $xtmp = $class -> new($xtmp);                   # back to Math::BigRat

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_n}   = $xtmp -> {_n};
    $x -> {_d}   = $xtmp -> {_d};

    return $x -> round(@r);
}

sub bior {
    my $x     = shift;
    my $xref  = ref($x);
    my $class = $xref || $x;

    croak 'bior() is an instance method, not a class method' unless $xref;
    croak 'Not enough arguments for bior()' if @_ < 1;

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

    my @r = @_;

    my $xtmp = Math::BigInt -> new($x -> bint());   # to Math::BigInt
    $xtmp -> bior($y);
    $xtmp = $class -> new($xtmp);                   # back to Math::BigRat

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_n}   = $xtmp -> {_n};
    $x -> {_d}   = $xtmp -> {_d};

    return $x -> round(@r);
}

sub bxor {
    my $x     = shift;
    my $xref  = ref($x);
    my $class = $xref || $x;

    croak 'bxor() is an instance method, not a class method' unless $xref;
    croak 'Not enough arguments for bxor()' if @_ < 1;

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

    my @r = @_;

    my $xtmp = Math::BigInt -> new($x -> bint());   # to Math::BigInt
    $xtmp -> bxor($y);
    $xtmp = $class -> new($xtmp);                   # back to Math::BigRat

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_n}   = $xtmp -> {_n};
    $x -> {_d}   = $xtmp -> {_d};

    return $x -> round(@r);
}

sub bnot {
    my $x     = shift;
    my $xref  = ref($x);
    my $class = $xref || $x;

    croak 'bnot() is an instance method, not a class method' unless $xref;

    my @r = @_;

    my $xtmp = Math::BigInt -> new($x -> bint());   # to Math::BigInt
    $xtmp -> bnot();
    $xtmp = $class -> new($xtmp);                   # back to Math::BigRat

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_n}   = $xtmp -> {_n};
    $x -> {_d}   = $xtmp -> {_d};

    return $x -> round(@r);
}

##############################################################################
# round

sub round {
    my $x = shift;
    return $downgrade -> new($x) if defined($downgrade) &&
      ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
    $x;
}

sub bround {
    my $x = shift;
    return $downgrade -> new($x) if defined($downgrade) &&
      ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
    $x;
}

sub bfround {
    my $x = shift;
    return $downgrade -> new($x) if defined($downgrade) &&
      ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
    $x;
}

##############################################################################
# comparing

sub bcmp {
    # compare two signed numbers

    # set up parameters
    my ($class, $x, $y) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y) = objectify(2, @_);
    }

    if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
        # $x is NaN and/or $y is NaN
        return       if $x->{sign} eq $nan || $y->{sign} eq $nan;
        # $x and $y are both either +inf or -inf
        return  0    if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
        # $x = +inf and $y < +inf
        return +1    if $x->{sign} eq '+inf';
        # $x = -inf and $y > -inf
        return -1    if $x->{sign} eq '-inf';
        # $x < +inf and $y = +inf
        return -1    if $y->{sign} eq '+inf';
        # $x > -inf and $y = -inf
        return +1;
    }

    # $x >= 0 and $y < 0
    return  1 if $x->{sign} eq '+' && $y->{sign} eq '-';
    # $x < 0 and $y >= 0
    return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';

    # At this point, we know that $x and $y have the same sign.

    # shortcut
    my $xz = $LIB->_is_zero($x->{_n});
    my $yz = $LIB->_is_zero($y->{_n});
    return  0 if $xz && $yz;               # 0 <=> 0
    return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
    return  1 if $yz && $x->{sign} eq '+'; # +x <=> 0

    my $t = $LIB->_mul($LIB->_copy($x->{_n}), $y->{_d});
    my $u = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});

    my $cmp = $LIB->_acmp($t, $u);     # signs are equal
    $cmp = -$cmp if $x->{sign} eq '-'; # both are '-' => reverse
    $cmp;
}

sub bacmp {
    # compare two numbers (as unsigned)

    # set up parameters
    my ($class, $x, $y) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y) = objectify(2, @_);
    }

    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) {
        # handle +-inf and 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;
    }

    my $t = $LIB->_mul($LIB->_copy($x->{_n}), $y->{_d});
    my $u = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
    $LIB->_acmp($t, $u);        # ignore signs
}

sub beq {
    my $self    = shift;
    my $selfref = ref $self;
    #my $class   = $selfref || $self;

    croak 'beq() is an instance method, not a class method' unless $selfref;
    croak 'Wrong number of arguments for beq()' unless @_ == 1;

    my $cmp = $self -> bcmp(shift);
    return defined($cmp) && ! $cmp;
}

sub bne {
    my $self    = shift;
    my $selfref = ref $self;
    #my $class   = $selfref || $self;

    croak 'bne() is an instance method, not a class method' unless $selfref;
    croak 'Wrong number of arguments for bne()' unless @_ == 1;

    my $cmp = $self -> bcmp(shift);
    return defined($cmp) && ! $cmp ? '' : 1;
}

sub blt {
    my $self    = shift;
    my $selfref = ref $self;
    #my $class   = $selfref || $self;

    croak 'blt() is an instance method, not a class method' unless $selfref;
    croak 'Wrong number of arguments for blt()' unless @_ == 1;

    my $cmp = $self -> bcmp(shift);
    return defined($cmp) && $cmp < 0;
}

sub ble {
    my $self    = shift;
    my $selfref = ref $self;
    #my $class   = $selfref || $self;

    croak 'ble() is an instance method, not a class method' unless $selfref;
    croak 'Wrong number of arguments for ble()' unless @_ == 1;

    my $cmp = $self -> bcmp(shift);
    return defined($cmp) && $cmp <= 0;
}

sub bgt {
    my $self    = shift;
    my $selfref = ref $self;
    #my $class   = $selfref || $self;

    croak 'bgt() is an instance method, not a class method' unless $selfref;
    croak 'Wrong number of arguments for bgt()' unless @_ == 1;

    my $cmp = $self -> bcmp(shift);
    return defined($cmp) && $cmp > 0;
}

sub bge {
    my $self    = shift;
    my $selfref = ref $self;
    #my $class   = $selfref || $self;

    croak 'bge() is an instance method, not a class method'
        unless $selfref;
    croak 'Wrong number of arguments for bge()' unless @_ == 1;

    my $cmp = $self -> bcmp(shift);
    return defined($cmp) && $cmp >= 0;
}

##############################################################################
# output conversion

sub numify {
    # convert 17/8 => float (aka 2.125)
    my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    # Non-finite number.

    if ($x -> is_nan()) {
        require Math::Complex;
        my $inf = $Math::Complex::Inf;
        return $inf - $inf;
    }

    if ($x -> is_inf()) {
        require Math::Complex;
        my $inf = $Math::Complex::Inf;
        return $x -> is_negative() ? -$inf : $inf;
    }

    # Finite number.

    my $abs = $LIB->_is_one($x->{_d})
            ? $LIB->_num($x->{_n})
            : Math::BigFloat -> new($LIB->_str($x->{_n}))
                             -> bdiv($LIB->_str($x->{_d}))
                             -> bstr();
    return $x->{sign} eq '-' ? 0 - $abs : 0 + $abs;
}

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

    # NaN, inf etc
    return Math::BigInt->new($x->{sign}) if $x->{sign} !~ /^[+-]$/;

    my $u = Math::BigInt->bzero();
    $u->{value} = $LIB->_div($LIB->_copy($x->{_n}), $x->{_d}); # 22/7 => 3
    $u->bneg if $x->{sign} eq '-'; # no negative zero
    $u;
}

sub as_float {
    # return N/D as Math::BigFloat

    # set up parameters
    my ($class, $x, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    ($class, $x, @r) = objectify(1, @_) unless ref $_[0];

    # NaN, inf etc
    return Math::BigFloat->new($x->{sign}) if $x->{sign} !~ /^[+-]$/;

    my $xflt = Math::BigFloat -> new($LIB -> _str($x->{_n}));
    $xflt -> {sign} = $x -> {sign};

    unless ($LIB -> _is_one($x->{_d})) {
        my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
        $xflt -> bdiv($xd, @r);
    }

    return $xflt;
}

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

    return $x unless $x->is_int();

    my $s = $x->{sign};
    $s = '' if $s eq '+';
    $s . $LIB->_as_bin($x->{_n});
}

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

    return $x unless $x->is_int();

    my $s = $x->{sign}; $s = '' if $s eq '+';
    $s . $LIB->_as_hex($x->{_n});
}

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

    return $x unless $x->is_int();

    my $s = $x->{sign}; $s = '' if $s eq '+';
    $s . $LIB->_as_oct($x->{_n});
}

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

sub from_hex {
    my $class = shift;

    # The relationship should probably go the otherway, i.e, that new() calls
    # from_hex(). Fixme!
    my ($x, @r) = @_;
    $x =~ s|^\s*(?:0?[Xx]_*)?|0x|;
    $class->new($x, @r);
}

sub from_bin {
    my $class = shift;

    # The relationship should probably go the otherway, i.e, that new() calls
    # from_bin(). Fixme!
    my ($x, @r) = @_;
    $x =~ s|^\s*(?:0?[Bb]_*)?|0b|;
    $class->new($x, @r);
}

sub from_oct {
    my $class = shift;

    # Why is this different from from_hex() and from_bin()? Fixme!
    my @parts;
    for my $c (@_) {
        push @parts, Math::BigInt->from_oct($c);
    }
    $class->new (@parts);
}

##############################################################################
# import

sub import {
    my $class = shift;
    my @a;                      # unrecognized arguments
    my $lib_param = '';
    my $lib_value = '';

    while (@_) {
        my $param = shift;

        # Enable overloading of constants.

        if ($param eq ':constant') {
            overload::constant

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

        # 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/) {
            # alternative library
            $lib_param = $param;        # "lib", "try", or "only"
            $lib_value = shift;
            next;
        }

        if ($param eq 'with') {
            # alternative class for our private parts()
            # XXX: no longer supported
            # $LIB = shift() || 'Calc';
            # carp "'with' is no longer supported, use 'lib', 'try', or 'only'";
            shift;
            next;
        }

        # Unrecognized parameter.

        push @a, $param;
    }

    require Math::BigInt;

    my @import = ('objectify');
    push @import, $lib_param, $lib_value if $lib_param ne '';
    Math::BigInt -> import(@import);

    # find out which one was actually loaded
    $LIB = Math::BigInt -> config("lib");

    # any non :constant stuff is handled by Exporter (loaded by parent class)
    # even if @_ is empty, to give it a chance
    $class->SUPER::import(@a);           # for subclasses
    $class->export_to_level(1, $class, @a); # need this, too
}

1;

__END__