use strict;
use warnings;
package Math::FakeBfloat16;
use Math::MPFR qw(:mpfr);

use constant bf16_EMIN     => -132;
use constant bf16_EMAX     =>  128;
use constant bf16_MANTBITS =>    8;


use overload
'+'  => \&oload_add,
'-'  => \&oload_sub,
'*'  => \&oload_mul,
'/'  => \&oload_div,
'%'  => \&oload_fmod,
'**' => \&oload_pow,

'=='  => \&oload_equiv,
'!='  => \&oload_not_equiv,
'>'   => \&oload_gt,
'>='  => \&oload_gte,
'<'   => \&oload_lt,
'<='  => \&oload_lte,
'<=>' => \&oload_spaceship,
'abs'  => \&oload_abs,
'""'   => \&oload_interp,

'sqrt' => \&oload_sqrt,
'exp'  => \&oload_exp,
'log'  => \&oload_log,
'int'  => \&oload_int,
'!'    => \&oload_not,
'bool' => \&oload_bool,
;

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

$Math::FakeBfloat16::VERSION = '0.01';
Math::FakeBfloat16->DynaLoader::bootstrap($Math::FakeBfloat16::VERSION);

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


my @tagged = qw( is_bf16_nan is_bf16_inf is_bf16_zero bf16_set_nan bf16_set_inf bf16_set_zero
                 bf16_set
                 bf16_nextabove bf16_nextbelow
                 unpack_bf16_hex
                 bf16_EMIN bf16_EMAX bf16_MANTBITS
                 bf16_to_NV bf16_to_MPFR bf16_to_PV
               );

@Math::FakeBfloat16::EXPORT = ();
@Math::FakeBfloat16::EXPORT_OK = @tagged;
%Math::FakeBfloat16::EXPORT_TAGS = (all => \@tagged);


%Math::FakeBfloat16::handler = (1 => sub {print "OK: 1\n"},
               2  => sub {return _fromIV(shift)},
               4  => sub {return _fromPV(shift)},
               3  => sub {return _fromNV(shift)},
               5  => sub {return _fromMPFR(shift)},
               6  => sub {return _fromGMPf(shift)},
               7  => sub {return _fromGMPq(shift)},

               30 => sub {return _fromBfloat16(shift)},
               );

$Math::FakeBfloat16::bf16_DENORM_MIN = Math::FakeBfloat16->new(2) ** (bf16_EMIN - 1);                   # 9.184e-41
$Math::FakeBfloat16::bf16_DENORM_MAX = Math::FakeBfloat16->new(_get_denorm_max());                      # 1.166e-38
$Math::FakeBfloat16::bf16_NORM_MIN   = Math::FakeBfloat16->new(2) ** (bf16_EMIN + (bf16_MANTBITS - 2)); # 1.175e-38
$Math::FakeBfloat16::bf16_NORM_MAX   = Math::FakeBfloat16->new(_get_norm_max());                        # 3.39e38

sub new {
   shift if (@_ > 0 && !ref($_[0]) && _itsa($_[0]) == 4 && $_[0] eq "Math::FakeBfloat16");
   if(!@_) {
     my $ret = Rmpfr_init2(bf16_MANTBITS);
     return bless(\$ret);
   }
   die "Too many args given to new()" if @_ > 1;
   my $itsa = _itsa($_[0]);
   if($itsa) {
     return _fromIV($_[0]) if($itsa == 2);
     return _fromBfloat16($_[0]) if ($itsa == 30);
     my $ret = subnormalize_generic($_[0], bf16_EMIN, bf16_EMAX, bf16_MANTBITS);
     return bless(\$ret);
   #  my $coderef = $Math::FakeBfloat16::handler{$itsa};
   #  return $coderef->($_[0]);
    }
   die "Unrecognized 1st argument passed to new() function";
}

sub _fromPV {
  my $pv = shift;
  my $ret = subnormalize_generic($pv, bf16_EMIN, bf16_EMAX, bf16_MANTBITS);
  return bless(\$ret);
}

sub _fromIV {
  my $iv = shift;
  my $ret = Rmpfr_init2(bf16_MANTBITS);
  Rmpfr_set_IV($ret, $iv, MPFR_RNDN); # $ret is in normal range
  return bless(\$ret);
}

sub _fromNV {
  my $nv = shift;
  my $ret = subnormalize_generic($nv, bf16_EMIN, bf16_EMAX, bf16_MANTBITS);
  return bless(\$ret);
}

sub _fromMPFR {
  my $mpfr = shift;
  my $ret = subnormalize_generic($mpfr, bf16_EMIN, bf16_EMAX, bf16_MANTBITS);
  return bless(\$ret);
}

sub _fromGMPf {
  my $mpf = shift;
  my $ret = subnormalize_generic($mpf, bf16_EMIN, bf16_EMAX, bf16_MANTBITS);
  return bless(\$ret);
}

sub _fromGMPq {
  my $mpq = shift;
  my $ret = subnormalize_generic($mpq, bf16_EMIN, bf16_EMAX, bf16_MANTBITS);
  return bless(\$ret);
}

sub _fromBfloat16 { # ie from Math::FakeBfloat16 object
  my $bf16 = shift;
  my $ret = Rmpfr_init2(bf16_MANTBITS);
  my $inex = Rmpfr_set($ret, $$bf16, MPFR_RNDN);
  die "Error in assignment" if $inex;
  return bless(\$ret);
}

sub bf16_to_NV {
  # For compatibility with Math::Bfloat16
  return Rmpfr_get_NV(${$_[0]}, MPFR_RNDN);
}

sub bf16_to_MPFR {
  # For compatibility with Math::Bfloat16
  my $ret = Rmpfr_init2(8);
  Rmpfr_set($ret, ${$_[0]}, MPFR_RNDN);
  return $ret;
}

sub is_bf16_nan {
  return 1 if Rmpfr_nan_p(${$_[0]});
  return 0;
}

sub is_bf16_inf {
  if( Rmpfr_inf_p(${$_[0]}) ) {
    return 1 if ${$_[0]} > 0;
    return -1;
  }
  return 0;
}

sub is_bf16_zero {
  if ( Rmpfr_zero_p(${$_[0]}) ) {
    return -1 if Rmpfr_signbit( ${$_[0]} );
    return 1;
  }
  return 0;
}

sub bf16_set_nan {
  Rmpfr_set_nan(${$_[0]});
}

sub bf16_set_inf {
    Rmpfr_set_inf(${$_[0]}, $_[1]);
}

sub bf16_set_zero {
    Rmpfr_set_zero(${$_[0]}, $_[1]);
}

sub bf16_set {
   die "bf16_set expects to receive precisely 2 arguments" if @_ != 2;
   my $coderef = $Math::FakeBfloat16::handler{_itsa($_[1])};
   my $arg = $coderef->($_[1]);
   my ($emin_orig, $emax_orig) = (Rmpfr_get_emin(), Rmpfr_get_emax());
   SET_EMIN_EMAX(bf16_EMIN, bf16_EMAX);
   my $inex = Rmpfr_set(${$_[0]}, $$arg, MPFR_RNDN);
   Rmpfr_subnormalize(${$_[0]}, $inex, MPFR_RNDN);
   RESET_EMIN_EMAX($emin_orig, $emax_orig);
}

sub oload_add {
   my $ret = Rmpfr_init2(bf16_MANTBITS);
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_add() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   my ($emin_orig, $emax_orig) = (Rmpfr_get_emin(), Rmpfr_get_emax());
   SET_EMIN_EMAX(bf16_EMIN, bf16_EMAX);
   my $inex = Rmpfr_add($ret, ${$_[0]}, $$arg, MPFR_RNDN);
   Rmpfr_subnormalize($ret, $inex, MPFR_RNDN);
   RESET_EMIN_EMAX($emin_orig, $emax_orig);
   return bless(\$ret);
}

sub oload_mul {
   my $ret = Rmpfr_init2(bf16_MANTBITS);
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_mul() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   my ($emin_orig, $emax_orig) = (Rmpfr_get_emin(), Rmpfr_get_emax());
   SET_EMIN_EMAX(bf16_EMIN, bf16_EMAX);
   my $inex = Rmpfr_mul($ret, ${$_[0]}, $$arg, MPFR_RNDN);
   Rmpfr_subnormalize($ret, $inex, MPFR_RNDN);
   RESET_EMIN_EMAX($emin_orig, $emax_orig);
   return bless(\$ret);
}

sub oload_sub {
   my $ret = Rmpfr_init2(bf16_MANTBITS);
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_sub() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   my ($emin_orig, $emax_orig) = (Rmpfr_get_emin(), Rmpfr_get_emax());
   SET_EMIN_EMAX(bf16_EMIN, bf16_EMAX);
   my $inex;
   if($_[2]) { $inex = Rmpfr_sub($ret, $$arg, ${$_[0]}, MPFR_RNDN) }
   else      { $inex = Rmpfr_sub($ret, ${$_[0]}, $$arg, MPFR_RNDN) }
   Rmpfr_subnormalize($ret, $inex, MPFR_RNDN);
   RESET_EMIN_EMAX($emin_orig, $emax_orig);
   return bless(\$ret);
}

sub oload_div {
   my $ret = Rmpfr_init2(bf16_MANTBITS);
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_div() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   my ($emin_orig, $emax_orig) = (Rmpfr_get_emin(), Rmpfr_get_emax());
   SET_EMIN_EMAX(bf16_EMIN, bf16_EMAX);
   my $inex;
   if($_[2]) { $inex = Rmpfr_div($ret, $$arg, ${$_[0]}, MPFR_RNDN) }
   else      { $inex = Rmpfr_div($ret, ${$_[0]}, $$arg, MPFR_RNDN) }
   Rmpfr_subnormalize($ret, $inex, MPFR_RNDN);
   RESET_EMIN_EMAX($emin_orig, $emax_orig);
   return bless(\$ret);
}

sub oload_pow {
   my $ret = Rmpfr_init2(bf16_MANTBITS);
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_pow() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   my ($emin_orig, $emax_orig) = (Rmpfr_get_emin(), Rmpfr_get_emax());
   SET_EMIN_EMAX(bf16_EMIN, bf16_EMAX);
   my $inex;
   if($_[2]) { $inex = Rmpfr_pow($ret, $$arg, ${$_[0]}, MPFR_RNDN) }
   else      { $inex = Rmpfr_pow($ret, ${$_[0]}, $$arg, MPFR_RNDN) }
   Rmpfr_subnormalize($ret, $inex, MPFR_RNDN);
   RESET_EMIN_EMAX($emin_orig, $emax_orig);
   return bless(\$ret);
}

sub oload_fmod {
   my $ret = Rmpfr_init2(bf16_MANTBITS);
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_fmod() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   my ($emin_orig, $emax_orig) = (Rmpfr_get_emin(), Rmpfr_get_emax());
   SET_EMIN_EMAX(bf16_EMIN, bf16_EMAX);
   my $inex;
   if($_[2]) { $inex = Rmpfr_fmod($ret, $$arg, ${$_[0]}, MPFR_RNDN) }
   else      { $inex = Rmpfr_fmod($ret, ${$_[0]}, $$arg, MPFR_RNDN) }
   Rmpfr_subnormalize($ret, $inex, MPFR_RNDN);
   RESET_EMIN_EMAX($emin_orig, $emax_orig);
   return bless(\$ret);
}

sub oload_sqrt {
   my $ret = Rmpfr_init2(bf16_MANTBITS);
   my ($emin_orig, $emax_orig) = (Rmpfr_get_emin(), Rmpfr_get_emax());
   SET_EMIN_EMAX(bf16_EMIN, bf16_EMAX);
   my $inex = Rmpfr_sqrt($ret, ${$_[0]}, MPFR_RNDN);
   Rmpfr_subnormalize($ret, $inex, MPFR_RNDN);
   RESET_EMIN_EMAX($emin_orig, $emax_orig);
   return bless(\$ret);
}

sub oload_log {
   my $ret = Rmpfr_init2(bf16_MANTBITS);
   my ($emin_orig, $emax_orig) = (Rmpfr_get_emin(), Rmpfr_get_emax());
   SET_EMIN_EMAX(bf16_EMIN, bf16_EMAX);
   my $inex = Rmpfr_log($ret, ${$_[0]}, MPFR_RNDN);
   Rmpfr_subnormalize($ret, $inex, MPFR_RNDN);
   RESET_EMIN_EMAX($emin_orig, $emax_orig);
   return bless(\$ret);
}

sub oload_exp {
   my $ret = Rmpfr_init2(bf16_MANTBITS);
   my ($emin_orig, $emax_orig) = (Rmpfr_get_emin(), Rmpfr_get_emax());
   SET_EMIN_EMAX(bf16_EMIN, bf16_EMAX);
   my $inex = Rmpfr_exp($ret, ${$_[0]}, MPFR_RNDN);
   Rmpfr_subnormalize($ret, $inex, MPFR_RNDN);
   RESET_EMIN_EMAX($emin_orig, $emax_orig);
   return bless(\$ret);
}

sub oload_int {
   my $ret = Rmpfr_init2(bf16_MANTBITS);
   Rmpfr_trunc($ret, ${$_[0]});
   return bless(\$ret);
}

sub oload_abs {
  return $_[0] * -1 if $_[0] < 0;
  return $_[0];
}

sub oload_not {
  return 1 if( Rmpfr_nan_p(${$_[0]}) || Rmpfr_zero_p(${$_[0]}) );
  return 0;
}

sub oload_bool {
  return 0 if( Rmpfr_nan_p(${$_[0]}) || Rmpfr_zero_p(${$_[0]}) );
  return 1;
}

sub oload_equiv {
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_equiv() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   return 0 if( Rmpfr_nan_p(${$_[0]}) || Rmpfr_nan_p($$arg) );
   return 0 if Rmpfr_cmp(${$_[0]}, $$arg);
   return 1;
}

sub oload_not_equiv {
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_not_equiv() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   return 1 if( Rmpfr_nan_p(${$_[0]}) || Rmpfr_nan_p($$arg) );
   return 1 if Rmpfr_cmp(${$_[0]}, $$arg);
   return 0;
}

sub oload_gt {
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_gt() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   return 0 if( Rmpfr_nan_p(${$_[0]}) || Rmpfr_nan_p($$arg) );
   if($_[2]) {
     return 1 if Rmpfr_cmp($$arg, ${$_[0]}) > 0;
     return 0;
   }
   return 1 if Rmpfr_cmp(${$_[0]}, $$arg) > 0;
   return 0;
}

sub oload_gte {
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_gte() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   return 0 if( Rmpfr_nan_p(${$_[0]}) || Rmpfr_nan_p($$arg) );
   if($_[2]) {
     return 1 if Rmpfr_cmp($$arg, ${$_[0]}) >= 0;
     return 0;
   }
   return 1 if Rmpfr_cmp(${$_[0]}, $$arg) >= 0;
   return 0;
}

sub oload_lt {
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_lt() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   return 0 if( Rmpfr_nan_p(${$_[0]}) || Rmpfr_nan_p($$arg) );
   if($_[2]) {
     return 1 if Rmpfr_cmp($$arg, ${$_[0]}) < 0;
     return 0;
   }
   return 1 if Rmpfr_cmp(${$_[0]}, $$arg) < 0;
   return 0;
}

sub oload_lte {
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_lte() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   return 0 if( Rmpfr_nan_p(${$_[0]}) || Rmpfr_nan_p($$arg) );
   if($_[2]) {
     return 1 if Rmpfr_cmp($$arg, ${$_[0]}) <= 0;
     return 0;
   }
   return 1 if Rmpfr_cmp(${$_[0]}, $$arg) <= 0;
   return 0;
}


sub oload_spaceship {
   my $itsa = _itsa($_[1]);
   my $coderef = $Math::FakeBfloat16::handler{$itsa};
   die "Unrecognized 2nd argument passed to oload_spaceship() function"
     if ($itsa != 30 && ($itsa < 2 || $itsa > 4));
   my $arg = $coderef->($_[1]);
   return undef if(Rmpfr_nan_p(${$_[0]}) || Rmpfr_nan_p($$arg));
   my $ret = Rmpfr_cmp(${$_[0]}, $$arg);
   $ret = 1 if $ret > 0;
   $ret = -1 if $ret < 0;
   $ret *= -1 if $_[2];
   return $ret;
}

sub oload_interp {
   my $ret = Math::MPFR::Rmpfr_get_str(${$_[0]}, 10, 0, MPFR_RNDN);
   $ret =~ s/\@//g;
   return $ret;
}

sub bf16_nextabove {
  #if(Rmpfr_zero_p(${$_[0]})) {
  #  bf16_set($_[0], $Math::FakeBfloat16::bf16_DENORM_MIN);
  #}
  if($_[0] == $Math::FakeBfloat16::bf16_NORM_MAX) {
    Rmpfr_set_inf(${$_[0]}, 1);
  }
  elsif(is_bf16_inf($_[0]) == -1) {
    bf16_set($_[0], -$Math::FakeBfloat16::bf16_NORM_MAX);
  }
  elsif($_[0] < $Math::FakeBfloat16::bf16_NORM_MIN && $_[0] >= -$Math::FakeBfloat16::bf16_NORM_MIN ) {
    $_[0] += $Math::FakeBfloat16::bf16_DENORM_MIN;
    bf16_set_zero($_[0], -1) if is_bf16_zero($_[0]);
  }
  else {
    Rmpfr_nextabove(${$_[0]});
  }
}

sub bf16_nextbelow {
  #if(Rmpfr_zero_p(${$_[0]})) {
  #  bf16_set($_[0], -$Math::FakeBfloat16::bf16_DENORM_MIN);
  #}
  if($_[0] == -$Math::FakeBfloat16::bf16_NORM_MAX) {
    Rmpfr_set_inf(${$_[0]}, -1);
  }
  elsif(is_bf16_inf( $_[0] ) == 1) {
    bf16_set($_[0], $Math::FakeBfloat16::bf16_NORM_MAX);
  }
  elsif($_[0] <= $Math::FakeBfloat16::bf16_NORM_MIN && $_[0] > -$Math::FakeBfloat16::bf16_NORM_MIN ) {
   $_[0] -= $Math::FakeBfloat16::bf16_DENORM_MIN;
  }
  else {
    Rmpfr_nextbelow( ${$_[0]} );
  }
}

sub unpack_bf16_hex {
  die "Math::FakeBfloat16::unpack_bf16_hex() accepts only a Math::FakeBfloat16 object as its argument"
    unless ref($_[0]) eq "Math::FakeBfloat16";
  my $nv = Rmpfr_get_NV(${$_[0]}, MPFR_RNDN);
  my @ret = _unpack_float($nv);
  return join('', @ret);
}

sub _get_norm_max {
  my $ret = 0;
  for my $p(1 .. bf16_MANTBITS) { $ret += 2 ** (bf16_EMAX - $p) }
  return $ret;
}

sub _get_denorm_max {
  my $ret = 0;
  my $max = -(bf16_EMIN - 1);
  my $min = $max - (bf16_MANTBITS - 2);
  for my $p($min .. $max) { $ret += 2 ** -$p }
  return $ret;
}

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

sub SET_EMIN_EMAX {
  Rmpfr_set_emin($_[0]);
  Rmpfr_set_emax($_[1]);
}

sub RESET_EMIN_EMAX {
  Rmpfr_set_emin($_[0]);
  Rmpfr_set_emax($_[1]);
}
1;

__END__
