view release on metacpan or  search on metacpan

Ryu.pm  view on Meta::CPAN

sub nv2s {
  my $nv = shift;
  return fmtpy( d2s($nv)) if MAX_DEC_DIG == 17;
  return fmtpy(ld2s($nv)) if MAX_DEC_DIG == 21;
  return fmtpy( q2s($nv));
}

sub n2s {
  my $arg = shift;
  die "The n2s() function does not accept ", ref($arg), " references"
    if ref($arg);
  if(!ryu_SvPOK($arg)) {
    return $arg if ryu_SvIOK($arg);
    return _from_NV($arg) if _NV_fits_IV($arg);
  }
  return nv2s($arg) if ryu_SvNOK($arg);
  # When this sub is called by pany() or sany(), it
  # will have returned before reaching here.
  # $arg is neither integer nor float nor reference.
  # If the numified $arg fits into an IV, return the
  # stringification of that value.
  # Else, return nv2s($arg), which will coerce $arg
  # to an NV.
  my $ret = $arg + 0;
  return "$ret"     if ryu_SvIOK($ret);
  #return nv2s($ret) if ryu_SvNOK($ret);
  return nv2s($arg);
}

sub fmtpy_pp {
  # Pure perl rendition of the fmtpy function. Not exported.
  # The given argument will be either 'Infinity', '-Infinity', 'NaN'
  # or a finite value of the form "mantissaEexponent".
  # The mantissa portion will include a decimal point (with that decimal
  # point being the second character in the mantissa) unless the
  # mantissa consists of only one decimal significant decimal digit,
  # in which case there is no decimal point and the mantissa consists
  # solely of that digit.

  my $s = shift;
  my $sign = '';
  my $bitpos = 0;

  $sign = '-' if $s =~ s/^\-//;

  $bitpos = 1 if substr($s, 1, 1) eq '.'; # else there isn't a decimal point.

  if($bitpos) {
    # Mantissa's second character is the decimal point.
    # Split into mantissa and exponent
    my @parts = split /E/i, $s;
    if($parts[1] > 0 && $parts[1] < MAX_DEC_DIG) {
      # We want, eg,  a value like 1.1E-3 to be returned as "0.0011".
      my $zero_pad = $parts[1] - (length($parts[0]) - 2);
      if($zero_pad >= 0 && ($zero_pad + length($parts[0])) < MAX_DEC_DIG + 1 ) {
        substr($parts[0], 1, 1, '');
        return $sign . $parts[0] . ('0' x $zero_pad) . '.0';
      }
      elsif($zero_pad < 0) {
        # We want, eg,  a value like 1.23625E2 to be returned as "123.625".
        # relocate the decimal point
        substr($parts[0], 1, 1, '');
        substr($parts[0], $zero_pad, 0, '.');
        return $sign . $parts[0];
      }
    }

    # Return as is, except that we replace the 'E' with 'e', ensuring also
    # that the exponent is preceded by a '+' or '-' sign, and that
    # negative exponents consist of at least 2 digits.
    $s =~ s/e/e\+/i if $parts[1] > 0;
    if ($parts[1] < -4 || $parts[1] >= 0) {
      $s =~ s/E0$//i;
      substr($s, -1, 0, '0') if substr($s, -2, 1) eq '-'; # pad exponent with a leading '0'.
      return $sign . lc($s);
    }
    # Return, eg 6.25E1 as "0.625"
    substr($parts[0], 1, 1, ''); # remove decimal point.
    return $sign . '0.' . ('0' x (abs($parts[1]) - 1)) . $parts[0] ;
  }
  else {
    # Return '-inf', 'inf', or 'nan' if (and as) appropriate.
    if($s =~ /n/i) {
      if($Math::Ryu::PERL_INFNAN) {
        return $Math::Ryu::nanvstr if $s =~ /a/i;
        return $Math::Ryu::ninfstr if $sign;
        return $Math::Ryu::pinfstr;
      }
      return $sign . lc(substr($s, 0, 3));
    }

    # Append '.0' to the mantissa and return it if the exponent is 0.
    return $sign . $s . '.0' if $s =~ s/E0$//i;
    my @parts = split /E/i, $s;

    # Return as is, except that we replace the 'E' with 'e', ensuring also
    # that the exponent is preceded by a '+' or '-' sign, and that
    # negative exponents consist of at least 2 digits.
    $s =~ s/e/e\+/i if $parts[1] > 0;
    $s =~ s/e\-/e\-0/i if ($parts[1] < -4 && $parts[1] > -10);
    return $sign . lc($s) if ($parts[1] < -4 || $parts[1] > MAX_DEC_DIG - 2);

    if($parts[1] >= 0 ) { # $parts[1] is in the range 1..(MAX_DEC_DIG - 2)
      return $sign . $parts[0] . (0 x $parts[1]) . '.0';
    }

    # Return, eg, 6E-3 as "0.006".
    return $sign . '0.' . ('0' x (abs($parts[1]) - 1)) . $parts[0] ;
  }
}

sub s2d {
  die "s2d() is available only to perls whose NV is of type 'double'"
    unless MAX_DEC_DIG == 17;
  my $str = shift;

  die("Strings passed to s2d() must \"look like a number\"")
    unless ryu_lln($str);
  # For _s2d, we need to remove all leading and trailing whitespace.
  # If $str contained internal whitespace, then s2d has already died.
  $str =~ s/\s//g;