The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
## This file generated by InlineX::C2XS (version 0.22) using Inline::C (version 0.53)
package Math::Float128;
use warnings;
use strict;

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

use overload
  '+'     => \&_overload_add,
  '*'     => \&_overload_mul,
  '-'     => \&_overload_sub,
  '/'     => \&_overload_div,
  '**'    => \&_overload_pow,
  '+='    => \&_overload_add_eq,
  '*='    => \&_overload_mul_eq,
  '-='    => \&_overload_sub_eq,
  '/='    => \&_overload_div_eq,
  '**='   => \&_overload_pow_eq,
  '=='    => \&_overload_equiv,
  '""'    => \&_overload_string,
  '!='    => \&_overload_not_equiv,
  'bool'  => \&_overload_true,
  '!'     => \&_overload_not,
  '='     => \&_overload_copy,
  '<'     => \&_overload_lt,
  '<='    => \&_overload_lte,
  '>'     => \&_overload_gt,
  '>='    => \&_overload_gte,
  '<=>'   => \&_overload_spaceship,
  'abs'   => \&_overload_abs,
  'int'   => \&_overload_int,
  'sqrt'  => \&_overload_sqrt,
  'log'   => \&_overload_log,
  'exp'   => \&_overload_exp,
  'sin'   => \&_overload_sin,
  'cos'   => \&_overload_cos,
  'atan2' => \&_overload_atan2,
  '++'    => \&_overload_inc,
  '--'    => \&_overload_dec,
;

use subs qw(FLT128_DIG FLT128_MANT_DIG FLT128_MIN_EXP FLT128_MAX_EXP FLT128_MIN_10_EXP FLT128_MAX_10_EXP
            M_Eq M_LOG2Eq M_LOG10Eq M_LN2q M_LN10q M_PIq M_PI_2q M_PI_4q M_1_PIq M_2_PIq
            M_2_SQRTPIq M_SQRT2q M_SQRT1_2q
            FLT128_MAX FLT128_MIN FLT128_EPSILON FLT128_DENORM_MIN);

$Math::Float128::VERSION = '0.02';

DynaLoader::bootstrap Math::Float128 $Math::Float128::VERSION;

@Math::Float128::EXPORT = ();
@Math::Float128::EXPORT_OK = qw(
    flt128_set_prec flt128_get_prec InfF128 NaNF128 ZeroF128 UnityF128 is_NaNF128 
    is_InfF128 is_InfF128 is_ZeroF128 STRtoF128 NVtoF128 IVtoF128 UVtoF128 F128toSTR 
    F128toSTRP F128toF128 F128toNV
    FLT128_DIG FLT128_MANT_DIG FLT128_MIN_EXP FLT128_MAX_EXP FLT128_MIN_10_EXP FLT128_MAX_10_EXP
    M_Eq M_LOG2Eq M_LOG10Eq M_LN2q M_LN10q M_PIq M_PI_2q M_PI_4q M_1_PIq M_2_PIq
    M_2_SQRTPIq M_SQRT2q M_SQRT1_2q
    FLT128_MAX FLT128_MIN FLT128_EPSILON FLT128_DENORM_MIN
    cmp2NV
    );

%Math::Float128::EXPORT_TAGS = (all => [qw(
    flt128_set_prec flt128_get_prec InfF128 NaNF128 ZeroF128 UnityF128 is_NaNF128 
    is_InfF128 is_InfF128 is_ZeroF128 STRtoF128 NVtoF128 IVtoF128 UVtoF128 F128toSTR 
    F128toSTRP F128toF128 F128toNV
    FLT128_DIG FLT128_MANT_DIG FLT128_MIN_EXP FLT128_MAX_EXP FLT128_MIN_10_EXP FLT128_MAX_10_EXP
    M_Eq M_LOG2Eq M_LOG10Eq M_LN2q M_LN10q M_PIq M_PI_2q M_PI_4q M_1_PIq M_2_PIq
    M_2_SQRTPIq M_SQRT2q M_SQRT1_2q
    FLT128_MAX FLT128_MIN FLT128_EPSILON FLT128_DENORM_MIN
    cmp2NV 
    )]);

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

sub _overload_string {

    if(is_ZeroF128($_[0])) {
      return '-0' if is_ZeroF128($_[0]) < 0;
      return '0'; 
    }

    if(is_NaNF128($_[0])) {return 'NaN'}

    my $inf = is_InfF128($_[0]);
    return '-Inf' if $inf < 0;
    return 'Inf'  if $inf > 0;

    my @p = split /e/i, F128toSTR($_[0]);
    while(substr($p[0], -1, 1) eq '0' && substr($p[0], -2, 1) ne '.') {
      chop $p[0];
    }
    return $p[0] . 'e' . $p[1];
}

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 2 args
    # 2) that 'new' has been called as a function - in
    #    which case there will be a maximum of 1 arg.
    # If there are no args, then we just want to return a
    # Math::Float128 object that's a NaN.
    
    if(!@_) {return NaNF128()}
   
    if(@_ > 2) {die "More than 2 arguments supplied to new()"}

    # If 'new' has been called OOP style, the first arg is the string
    # "Math::Float128" which we don't need - so let's remove it. However,
    # if the first arg is a Math::Float128 object (which is a possibility),
    # then we'll get a fatal error when we check it for equivalence to
    # the string "Math::Float128". 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::Float128") {
      shift;
      if(!@_) {return NaNF128()}
      } 

    if(@_ > 1) {die "Too many arguments supplied to new() - expected no more than 1"}

    my $arg = shift;
    my $type = _itsa($arg);

    if($type == 3) { # NV
      if($arg == 0)    {return STRtoF128($arg)}
      if($arg != $arg) { return NaNF128()}
      if(($arg / $arg) != ($arg / $arg)) { # Inf
        if($arg < 0) {return InfF128(-1)}
        return InfF128(1);
      }
      return NVtoF128($arg);
    }

    if(
       $type == 1 || #UV
       $type == 2 || #IV
       $type == 4    #PV
                   ) {
      return STRtoF128($arg);
    }

    if($type == 113) { # Math::Float128
      return F128toF128($arg);
    }

    die "Bad argument given to new";
}

sub FLT128_DIG        {return _FLT128_DIG()}
sub FLT128_MAX        {return _FLT128_MAX()}
sub FLT128_MIN        {return _FLT128_MIN()}
sub FLT128_EPSILON    {return _FLT128_EPSILON()}
sub FLT128_DENORM_MIN {return _FLT128_DENORM_MIN()}
sub FLT128_MANT_DIG   {return _FLT128_MANT_DIG()}
sub FLT128_MIN_EXP    {return _FLT128_MIN_EXP()}
sub FLT128_MAX_EXP    {return _FLT128_MAX_EXP()}
sub FLT128_MIN_10_EXP {return _FLT128_MIN_10_EXP()}
sub FLT128_MAX_10_EXP {return _FLT128_MAX_10_EXP()}
sub M_Eq              {return _M_Eq()}
sub M_LOG2Eq          {return _M_LOG2Eq()}
sub M_LOG10Eq         {return _M_LOG10Eq()}
sub M_LN2q            {return _M_LN2q()}
sub M_LN10q           {return _M_LN10q()}
sub M_PIq             {return _M_PIq()}
sub M_PI_2q           {return _M_PI_2q()}
sub M_PI_4q           {return _M_PI_4q()}
sub M_1_PIq           {return _M_1_PIq()}
sub M_2_PIq           {return _M_2_PIq()}
sub M_2_SQRTPIq       {return _M_2_SQRTPIq()}
sub M_SQRT2q          {return _M_SQRT2q()}
sub M_SQRT1_2q        {return _M_SQRT1_2q()}

1;

__END__

=head1 NAME

Math::Float128 - perl interface to C's __float128 operations


=head1 BUGS

  exp() segfaults with Strawberry Perl's 32-bit and 64-bit MinGW compilers.
  Needs quadmath.h.


=head1 DESCRIPTION

   use Math::Float128 qw(:all);

   my $arg = 32.1;
   my $f1 = Math::Float128->new($arg);# Stringify $arg, then assign 
                                          # using C's strtoflt128()
   my $f2 = NVtoF128($arg); # Assign the NV 32.1 to $f2.


=head1 OVERLOADING

   The following operations are overloaded:
    + - * / **
    += -= *= /= **=
    != == <= >= <=> < >
    ++ --
    =
    abs bool ! int print
    sqrt log exp
    sin cos atan2

    Arguments to the overloaded operations must be Math::Float128
    objects.

     $f = $f + 3.1; # currently an error. Do instead:

     $f = $f + Math::Float128->new('3.1');

=head1 ASSIGNMENT FUNCTIONS

   The following create and assign a new Math::Float128.

    $f = Math::Float128->new($arg);
     Returns a Math::Float128 object to which the numeric value of $arg
     has been assigned.
     If no arg is supplied then $f will be NaN.

    $f = UVtoF128($arg);
     Returns a Math::Float128 object to which the numeric (unsigned
     integer) value of $arg has been assigned.

    $f = IVtoF128($arg);
     Returns a Math::Float128 object to which the numeric (signed
     integer) value of $arg has been assigned.

    $f = NVtoF128($arg);
     Returns a Math::Float128 object to which the numeric (floating
     point) value of $arg has been assigned.

    $f2 = F128toF128($f1);
     Returns a Math::Float128 object that is a copy of the
     Math::Float128 object provided as the argument.
     Courtesy of overloading, this is in effect no different to doing:
     $f2 = $f1;

    $f = STRtoF128($str);
     Returns a Math::Float128 object that has the value of the string
     $str.


=head1 ASSIGNMENT OF INF, NAN, UNITY and ZERO

   $f = InfF128($sign);
    If $sign < 0, returns a Math::Float128 object set to
    negative infinity; else returns a Math::Float128 object set
    to positive infinity.

   $f = NaNF128($sign);
    If $sign < 0, returns a Math::Float128 object set to
    negative NaN; else returns a Math::Float128 object set to
    positive NaN. It may be problematical as to whether a NaN
    with the correct sign has been returned ... but, either way,
    it should return a NaN.

   $f = ZeroF128($sign);
    If $sign < 0, returns a Math::Float128 object set to
    negative zero; else returns a Math::Float128 object set to 
    zero.

   $f = UnityF128($sign);
    If $sign < 0, returns a Math::Float128 object set to
    negative one; else returns a Math::Float128 object set to 
    one.

   flt128_set_prec($precision);
    Sets the precision of stringified values to $precision decimal
    digits.

   $precision = flt128_get_prec();
    Returns the precision (in decimal digits) that will be used
    when stringifying values (by printing them, or calling
    F128toSTR).



=head1 RETRIEVAL FUNCTIONS

   The following functions provide ways of seeing the value of
   Math::Float128 objects.

   $nv = F128toNV($f);
    This function returns the value of the Math::Float128 object to
    a perl scalar (NV). It may not translate the value accurately.

   $string = F128toSTR($f);
    Returns the value of the Math::Float128 object as a string.
    The returned string will contain the same as is displayed by
    "print $f", except that print() will strip the trailing zeroes
    in the mantissa (significand) whereas F128toSTR won't.
    By default, provides 33 decimal digits of precision. This can be
    altered by specifying the desired precision (in decimal digits)
    in a call to flt128_set_prec.

   $string = F128toSTRP(f, $precision);
    Same as F128toSTR, but takes an additional arg that specifies the
    precision (in decimal digits) of the stringified return value.


=head1 OTHER FUNCTIONS

   $bool = is_NaNF128($f); 
    Returns 1 if $f is a Math::Float128 NaN.
    Else returns 0

   $int = is_InfF128($f)
    If the Math::Float128 object $f is -inf, returns -1.
    If it is +inf, returns 1.
    Otherwise returns 0.

   $int = is_ZeroF128($f);
    If the Math::Float128 object $f is -0, returns -1.
    If it is zero, returns 1.
    Otherwise returns 0.

   $int = cmp2NV($f, $nv);
    $nv can be any perl number - ie NV, UV or IV.
    If the Math::Float128 object $f < $nv returns -1.
    If it is > $nv, returns 1.
    Otherwise returns 0.

=head1 BUGS

   The mingw64 compilers have a buggy expq() function; therefore the
   overloaded exp function doesn't return expq($arg) when a mingw64
   compiler is in use - instead it returns e**$arg.


=head1 LICENSE

   This program is free software; you may redistribute it and/or modify
   it under the same terms as Perl itself.
   Copyright 2013 Sisyphus


=head1 AUTHOR

   Sisyphus <sisyphus at(@) cpan dot (.) org>

=cut