The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Math::MPFI;
use strict;
use warnings;
use Math::MPFR;
use Math::MPFI::Constant;

require Exporter;
*import = \&Exporter::import;
require DynaLoader;

our $VERSION = '0.13';
#$VERSION = eval $VERSION;

Math::MPFI->DynaLoader::bootstrap($VERSION);

    use constant BOTH_ENDPOINTS_EXACT => 0;
    use constant LEFT_ENDPOINT_INEXACT => 1;
    use constant RIGHT_ENDPOINT_INEXACT => 2;
    use constant BOTH_ENDPOINTS_INEXACT => 3;

    use constant  _UOK_T   => 1;
    use constant  _IOK_T   => 2;
    use constant  _NOK_T   => 3;
    use constant  _POK_T   => 4;
    use constant  _MATH_MPFR_T   => 5;
    use constant  _MATH_GMPf_T   => 6;
    use constant  _MATH_GMPq_T   => 7;
    use constant  _MATH_GMPz_T   => 8;
    use constant  _MATH_GMP_T    => 9;
    use constant  _MATH_MPC_T    => 10;
    use constant  _MATH_MPFI_T    => 11;
    use constant  MPFI_PV_NV_BUG => Math::MPFI::Constant::_has_pv_nv_bug();

    # Inspired by https://github.com/Perl/perl5/issues/19550, which affects only perl-5.35.10:
    use constant ISSUE_19550    => Math::MPFI::Constant::_issue_19550();

    use subs qw(MPFI_VERSION_MAJOR MPFI_VERSION_MINOR
                MPFI_VERSION_PATCHLEVEL MPFI_VERSION_STRING);

    use overload
     '+'	=> \&overload_add,
     '-'	=> \&overload_sub,
     '*'	=> \&overload_mul,
     '/'	=> \&overload_div,
     '+='	=> \&overload_add_eq,
     '-='	=> \&overload_sub_eq,
     '*='	=> \&overload_mul_eq,
     '/='	=> \&overload_div_eq,
     'sqrt'	=> \&overload_sqrt,
     '<'	=> \&overload_lt,
     '>'	=> \&overload_gt,
     '<='	=> \&overload_lte,
     '>='	=> \&overload_gte,
     '<=>'	=> \&overload_spaceship,
     '=='	=> \&overload_equiv,
     '!='	=> \&overload_not_equiv,
     '""'	=> \&overload_string,
     'atan2'    => \&overload_atan2,
     'cos'      => \&overload_cos,
     'sin'      => \&overload_sin,
     'log'      => \&overload_log,
     'exp'      => \&overload_exp,
     'abs'      => \&overload_abs,
     'bool'     => \&overload_true,
     '!'        => \&overload_not;

@Math::MPFI::EXPORT = ();
my @tagged = qw(
MPFI_PV_NV_BUG
BOTH_ENDPOINTS_EXACT LEFT_ENDPOINT_INEXACT
RIGHT_ENDPOINT_INEXACT BOTH_ENDPOINTS_INEXACT
RMPFI_BOTH_ARE_EXACT RMPFI_LEFT_IS_INEXACT
RMPFI_RIGHT_IS_INEXACT RMPFI_BOTH_ARE_INEXACT
RMPFI_ERROR MPFI_VERSION_MAJOR
MPFI_VERSION_MINOR MPFI_VERSION_PATCHLEVEL MPFI_VERSION_STRING
Rmpfi_set_default_prec Rmpfi_get_default_prec
Rmpfi_abs Rmpfi_acos Rmpfi_acosh Rmpfi_add Rmpfi_add_d Rmpfi_add_fr
Rmpfi_add_q Rmpfi_add_si Rmpfi_add_ui Rmpfi_add_z Rmpfi_alea
Rmpfi_asin Rmpfi_asinh Rmpfi_atan Rmpfi_atanh Rmpfi_bisect
Rmpfi_blow Rmpfi_bounded_p Rmpfi_clear Rmpfi_cmp Rmpfi_cmp_d
Rmpfi_cmp_fr Rmpfi_cmp_q Rmpfi_cmp_si Rmpfi_cmp_ui Rmpfi_cmp_z
Rmpfi_const_euler Rmpfi_const_log2 Rmpfi_const_pi Rmpfi_cos
Rmpfi_cosh Rmpfi_d_div Rmpfi_d_sub Rmpfi_diam Rmpfi_diam_abs
Rmpfi_diam_rel Rmpfi_div Rmpfi_div_2exp Rmpfi_div_2si Rmpfi_div_2ui
Rmpfi_div_d Rmpfi_div_fr Rmpfi_div_q Rmpfi_div_si Rmpfi_div_ui
Rmpfi_div_z Rmpfi_exp Rmpfi_exp2 Rmpfi_expm1 Rmpfi_fr_div
Rmpfi_fr_sub Rmpfi_get_d Rmpfi_get_fr Rmpfi_get_left Rmpfi_get_prec
Rmpfi_get_right Rmpfi_has_zero Rmpfi_increase Rmpfi_inf_p Rmpfi_init
Rmpfi_init2 Rmpfi_init_set Rmpfi_init_set_d Rmpfi_init_set_fr
Rmpfi_init_set_q Rmpfi_init_set_si Rmpfi_init_set_str Rmpfi_init_set_ui
Rmpfi_init_set_z
Rmpfi_init_nobless Rmpfi_init2_nobless Rmpfi_init_set_nobless
Rmpfi_init_set_d_nobless Rmpfi_init_set_fr_nobless
Rmpfi_init_set_q_nobless Rmpfi_init_set_si_nobless Rmpfi_init_set_str_nobless
Rmpfi_init_set_ui_nobless Rmpfi_init_set_z_nobless
Rmpfi_inp_str Rmpfi_intersect Rmpfi_interv_d
Rmpfi_interv_fr Rmpfi_interv_q Rmpfi_interv_si Rmpfi_interv_ui
Rmpfi_interv_z Rmpfi_inv Rmpfi_is_empty Rmpfi_is_error
Rmpfi_is_inside Rmpfi_is_inside_d Rmpfi_is_inside_fr Rmpfi_is_inside_q
Rmpfi_is_inside_si Rmpfi_is_inside_ui Rmpfi_is_inside_z Rmpfi_is_neg
Rmpfi_is_nonneg Rmpfi_is_nonpos Rmpfi_is_pos Rmpfi_is_strictly_inside
Rmpfi_is_strictly_neg Rmpfi_is_strictly_pos Rmpfi_is_zero Rmpfi_log
Rmpfi_log10 Rmpfi_log1p Rmpfi_log2 Rmpfi_mag Rmpfi_mid Rmpfi_mig
Rmpfi_mul Rmpfi_mul_2exp Rmpfi_mul_2si Rmpfi_mul_2ui Rmpfi_mul_d
Rmpfi_mul_fr Rmpfi_mul_q Rmpfi_mul_si Rmpfi_mul_ui Rmpfi_mul_z
Rmpfi_nan_p Rmpfi_neg Rmpfi_out_str Rmpfi_print_binary Rmpfi_put
Rmpfi_put_d Rmpfi_put_fr Rmpfi_put_q Rmpfi_put_si Rmpfi_put_ui
Rmpfi_put_z Rmpfi_q_div Rmpfi_q_sub Rmpfi_reset_error
Rmpfi_revert_if_needed Rmpfi_round_prec Rmpfi_set Rmpfi_set_d
Rmpfi_set_error Rmpfi_set_fr Rmpfi_set_prec Rmpfi_set_q
Rmpfi_set_si Rmpfi_set_str Rmpfi_set_ui Rmpfi_set_z Rmpfi_si_div
Rmpfi_si_sub Rmpfi_sin Rmpfi_sinh Rmpfi_sqr Rmpfi_sqrt
Rmpfi_sub Rmpfi_sub_d Rmpfi_sub_fr Rmpfi_sub_q Rmpfi_sub_si
Rmpfi_sub_ui Rmpfi_sub_z Rmpfi_swap Rmpfi_t Rmpfi_tan
Rmpfi_tanh Rmpfi_ui_div Rmpfi_ui_sub Rmpfi_union Rmpfi_z_div
Rmpfi_z_sub
TRmpfi_out_str TRmpfi_inp_str
Rmpfi_get_version Rmpfi_const_catalan Rmpfi_cbrt Rmpfi_hypot
Rmpfi_sec Rmpfi_csc Rmpfi_cot Rmpfi_sech Rmpfi_csch Rmpfi_coth
Rmpfi_atan2 Rmpfi_urandom
Rmpfi_get_NV Rmpfi_set_NV
);

@Math::MPFI::EXPORT_OK = (@tagged);
%Math::MPFI::EXPORT_TAGS =(mpfi => \@tagged);

*TRmpfi_out_str = \&Rmpfi_out_str;
*TRmpfi_inp_str = \&Rmpfi_inp_str;

$Math::MPFI::NOK_POK = 0; # Set to 1 to allow warnings in new() and overloaded operations when
                          # a scalar that has set both NOK (NV) and POK (PV) flags is encountered

sub dl_load_flags {0} # Prevent DynaLoader from complaining and croaking

sub new {
    # This function caters for 2 possibilities:
    # 1) that 'new' has been called OOP style - in which
    #    case there will be a maximum of 3 args
    # 2) that 'new' has been called as a function - in
    #    which case there will be a maximum of 2 args.
    # If there are no args, then we just want to return an
    # initialized Math::MPFI object
    if(!@_) {return Rmpfi_init()}

    if(@_ > 3) {die "Too many arguments supplied to new()"}

    # If 'new' has been called OOP style, the first arg is the string
    # "Math::MPFI" which we don't need - so let's remove it. However,
    # if the first arg is a Math::MPFI object (which is a possibility),
    # then we'll get a fatal error when we check it for equivalence to
    # the string "Math::MPFI". So we first need to check that it's not
    # an object - which we'll do by using the ref() function:
    if(!ref($_[0]) && $_[0] eq "Math::MPFI") {
      shift;
      if(!@_) {return Rmpfi_init()}
      }

    # @_ can now contain a maximum of 2 args - the value, and iff the value is
    # a string, (optionally) the base of the numeric string.
    if(@_ > 2) {die "Too many arguments supplied to new() - expected no more than two"}

    my ($arg1, $type, $base);

    # $_[0] is the value, $_[1] (if supplied) is the base of the number
    # in the string $[_0].
    $arg1 = shift; # At this point, an infnan might acquire a POK flag - thus
                   # assigning to $type a value of 4, instead of 3. Such behaviour also
                   # turns $arg into a PV and NV dualvar. It's a fairly inconsequential
                   # bug - https://github.com/Perl/perl5/issues/19550.
                   # I could workaround this by simply not shifting and re-assigning, but
                   # I'll leave it as it is - otherwise there's nothing to mark that this
                   # minor issue (which might also show up in user code) ever existed.
    $base = 0;

    $type = _itsa($arg1);
    if(!$type) {die "Inappropriate argument supplied to new()"}

    my @ret;

    # Create a Math::MPFI object that has $arg1 as its value.
    # Die if there are any additional args (unless $type == _POK_T)
    if($type == _UOK_T) {
      if(@_ ) {die "Too many arguments supplied to new() - expected only one"}
       if(_has_longlong()) {
         my $t = Math::MPFR->new();
         Math::MPFR::Rmpfr_set_uj($t, $arg1, Math::MPFR::Rmpfr_get_default_rounding_mode());
         @ret = Rmpfi_init_set_fr($t);
       }
       else {@ret = Rmpfi_init_set_ui($arg1)}
      return $ret[0];
    }

    if($type == _IOK_T) {
      if(@_ ) {die "Too many arguments supplied to new() - expected only one"}
       if(_has_longlong()) {
         my $t = Math::MPFR->new();
         Math::MPFR::Rmpfr_set_sj($t, $arg1, Math::MPFR::Rmpfr_get_default_rounding_mode());
         @ret = Rmpfi_init_set_fr($t);
       }
       else {@ret = Rmpfi_init_set_si($arg1)}
      return $ret[0];
    }

    if($type == _NOK_T) {
      if(@_ ) {die "Too many arguments supplied to new() - expected only one"}

      if(MPFI_PV_NV_BUG) {
        if(_SvPOK($arg1)) {
          set_nok_pok(nok_pokflag() + 1);
          if($Math::MPFI::NOK_POK) {
            warn "Scalar passed to new() is both NV and PV. Using NV (numeric) value";
          }
        }
      }

      if(_has_longdouble()) {
        $ret[0] = Math::MPFI->new();
        Rmpfi_set_NV($ret[0], $arg1);
      }
      else {@ret = Rmpfi_init_set_d($arg1)}
      return $ret[0];
    }

    if($type == _POK_T) {
      if(@_ > 1) {die "Too many arguments supplied to new() - expected no more than two"}
      $base = shift if @_;
      if($base < 0 || $base == 1 || $base > 36) {die "Invalid value for base"}

      if(_SvNOK($arg1)) {
        set_nok_pok(nok_pokflag() + 1);
        if($Math::MPFI::NOK_POK) {
          warn "Scalar passed to new() is both NV and PV. Using PV (string) value";
        }
      }

      @ret = Rmpfi_init_set_str($arg1, $base);
      if($ret[1]) {warn "string supplied to new() contained invalid characters"}
      return $ret[0];
    }

    if($type == _MATH_MPFI_T) {
      if(@_) {die "Too many arguments supplied to new() - expected only one"}
      @ret = Rmpfi_init_set($arg1);
      return $ret[0];
    }

    if($type == _MATH_MPFR_T) {
      if(@_) {die "Too many arguments supplied to new() - expected only one"}
      @ret = Rmpfi_init_set_fr($arg1);
      return $ret[0];
    }

     ### Currently Unavailable
     if($type == _MATH_GMPf_T) {die "Inappropriate argument supplied to new()"}
#    if($type == _MATH_GMPf_T) {
#      if(@_) {die "Too many arguments supplied to new() - expected only one"}
#      @ret = Rmpfi_init_set_f($arg1);
#      return $ret[0];
#    }

    if($type == _MATH_GMPq_T) {
      if(@_) {die "Too many arguments supplied to new() - expected only one"}
      @ret = Rmpfi_init_set_q($arg1);
      return $ret[0];
    }

    if($type == _MATH_GMPz_T || $type == _MATH_GMP_T) {
      if(@_) {die "Too many arguments supplied to new() - expected only one"}
      @ret = Rmpfi_init_set_z($arg1);
      return $ret[0];
    }

    die "new() was passed an invalid argument";
}

sub Rmpfi_out_str {
    if(@_ == 4) {
      die "Inappropriate 4th arg supplied to Rmpfi_out_str" if _itsa($_[3]) != _MATH_MPFI_T;
      return _Rmpfi_out_str($_[0], $_[1], $_[2], $_[3]);
    }
    if(@_ == 5) {
      if(_itsa($_[3]) == _MATH_MPFI_T) {return _Rmpfi_out_strS($_[0], $_[1], $_[2], $_[3], $_[4])}
      die "Incorrect args supplied to Rmpfi_out_str" if _itsa($_[4]) != _MATH_MPFI_T;
      return _Rmpfi_out_strP($_[0], $_[1], $_[2], $_[3], $_[4]);
    }
    if(@_ == 6) {
      die "Inappropriate 5th arg supplied to Rmpfi_out_str" if _itsa($_[4]) != _MATH_MPFI_T;
      return _Rmpfi_out_strPS($_[0], $_[1], $_[2], $_[3], $_[4], $_[5]);
    }
    die "Wrong number of arguments supplied to Rmpfi_out_str()";
}

sub Rmpfi_set_default_prec { # Sets default prec for both Math::MPFR and Math::MPFI
    _Rmpfi_set_default_prec($_[0]);
    # Need to call Math::MPFR::Rmpfr_set_default_prec in
    # case Math::MPFR and Math::MPFI use different copies
    # of the mpfr library - eg if they've been built against
    # static libraries
    Math::MPFR::Rmpfr_set_default_prec($_[0]);
}

sub overload_string {
    my $prec = Rmpfi_get_prec($_[0]);
    my $mpfr = Math::MPFR::Rmpfr_init2($prec);
    Rmpfi_get_left($mpfr, $_[0]);
    my $ret = '[' . Math::MPFR::Rmpfr_get_str($mpfr, 10, 0, Math::MPFR::GMP_RNDD) . ',';
    #my $ret = '[' . "$mpfr" . ','; # Wrong - we need GMP_RNDD.
    Rmpfi_get_right($mpfr, $_[0]);
    $ret .= Math::MPFR::Rmpfr_get_str($mpfr, 10, 0, Math::MPFR::GMP_RNDU) . ']';
    #$ret .= "$mpfr" . ']'; # Wrong - we need GMP_RNDU.
    return $ret;
}

sub overload_not_equiv {
    return !overload_equiv(@_);
}

# Moved to XS
# sub overload_spaceship {
#    if(Rmpfi_nan_p($_[0]) || ($_[1] != $_[1])) {return undef}
#    if(overload_equiv(@_)) {return 0}
#    if(overload_gt(@_)) {return 1}
#    if(overload_lt(@_)) {return -1}
#}

sub MPFI_VERSION_MAJOR      () {return _MPFI_VERSION_MAJOR()}
sub MPFI_VERSION_MINOR      () {return _MPFI_VERSION_MINOR()}
sub MPFI_VERSION_PATCHLEVEL () {return _MPFI_VERSION_PATCHLEVEL()}
sub MPFI_VERSION_STRING     () {return _MPFI_VERSION_STRING()}

1;

__END__