X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMath%2FBigFloat.pm;h=fbe0cf660ba9912ebaf0768352ed343ed6c81bb3;hb=5dca256ec738057dc331fb644a93eca44ad5fa14;hp=f7008aacf66a77b7225cb146f486c09812105de1;hpb=27e7b8bb4225378079f42e58c59f6131c62cace5;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index f7008aa..fbe0cf6 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -12,14 +12,14 @@ package Math::BigFloat;
 #   _a	: accuracy
 #   _p	: precision
 
-$VERSION = '1.44';
+$VERSION = '1.47';
 require 5.005;
 
 require Exporter;
 @ISA =       qw(Exporter Math::BigInt);
 
 use strict;
-# $_trap_inf and $_trap_nan are internal and should never be accessed from the outside
+# $_trap_inf/$_trap_nan are internal and should never be accessed from outside
 use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode
 	    $upgrade $downgrade $_trap_nan $_trap_inf/;
 my $class = "Math::BigFloat";
@@ -132,7 +132,8 @@ sub new
     $self->{sign} = $wanted->sign();
     return $self->bnorm();
     }
-  # got string
+  # else: got a string
+
   # handle '+inf', '-inf' first
   if ($wanted =~ /^[+-]?inf$/)
     {
@@ -146,6 +147,17 @@ sub new
     return $self->bnorm();
     }
 
+  # shortcut for simple forms like '12' that neither have trailing nor leading
+  # zeros
+  if ($wanted =~ /^([+-]?)([1-9][0-9]*[1-9])$/)
+    {
+    $self->{_e} = $MBI->_zero();
+    $self->{_es} = '+';
+    $self->{sign} = $1 || '+';
+    $self->{_m} = $MBI->_new($2);
+    return $self->round(@r) if !$downgrade;
+    }
+
   my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($wanted);
   if (!ref $mis)
     {
@@ -178,22 +190,28 @@ sub new
       ($self->{_e}, $self->{_es}) =
 	_e_sub ($self->{_e}, $len, $self->{_es}, '+');
       }
-    $self->{sign} = $$mis;
-    
-    # we can only have trailing zeros on the mantissa of $$mfv eq ''
-    if (CORE::length($$mfv) == 0)
+    # we can only have trailing zeros on the mantissa if $$mfv eq ''
+    else
       {
-      my $zeros = $MBI->_zeros($self->{_m});	# correct for trailing zeros 
+      # Use a regexp to count the trailing zeros in $$miv instead of _zeros()
+      # because that is faster, especially when _m is not stored in base 10.
+      my $zeros = 0; $zeros = CORE::length($1) if $$miv =~ /[1-9](0*)$/; 
       if ($zeros != 0)
         {
         my $z = $MBI->_new($zeros);
+        # turn '120e2' into '12e3'
         $MBI->_rsft ( $self->{_m}, $z, 10);
 	_e_add ( $self->{_e}, $z, $self->{_es}, '+');
         }
       }
+    $self->{sign} = $$mis;
+
     # for something like 0Ey, set y to 1, and -0 => +0
+    # Check $$miv for beeing '0' and $$mfv eq '', because otherwise _m could not
+    # have become 0. That's faster than to call $MBI->_is_zero().
     $self->{sign} = '+', $self->{_e} = $MBI->_one()
-     if $MBI->_is_zero($self->{_m});
+     if $$miv eq '0' and $$mfv eq '';
+
     return $self->round(@r) if !$downgrade;
     }
   # if downgrade, inf, NaN or integers go down
@@ -626,30 +644,7 @@ sub badd
   $x->bnorm()->round($a,$p,$r,$y);
   }
 
-sub bsub 
-  {
-  # (BigFloat or num_str, BigFloat or num_str) return BigFloat
-  # subtract second arg from first, modify first
-
-  # set up parameters
-  my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
-  # objectify is costly, so avoid it
-  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
-    {
-    ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
-    }
-
-  if ($y->is_zero())		# still round for not adding zero
-    {
-    return $x->round($a,$p,$r);
-    }
- 
-  # $x - $y = -$x + $y 
-  $y->{sign} =~ tr/+-/-+/;	# does nothing for NaN
-  $x->badd($y,$a,$p,$r);	# badd does not leave internal zeros
-  $y->{sign} =~ tr/+-/-+/;	# refix $y (does nothing for NaN)
-  $x;				# already rounded by badd()
-  }
+# sub bsub is inherited from Math::BigInt!
 
 sub binc
   {
@@ -768,7 +763,16 @@ sub blog
     return $x->bnan() if $base->is_zero() || $base->is_one() ||
       $base->{sign} ne '+';
     # if $x == $base, we know the result must be 1.0
-    return $x->bone('+',@params) if $x->bcmp($base) == 0;
+    if ($x->bcmp($base) == 0)
+      {
+      $x->bone('+',@params);
+      if ($fallback)
+        {
+        # clear a/p after round, since user did not request it
+        delete $x->{_a}; delete $x->{_p};
+        }
+      return $x;
+      }
     }
 
   # when user set globals, they would interfere with our calculation, so
@@ -1293,39 +1297,53 @@ sub bdiv
     # enough...
     $scale = abs($params[0] || $params[1]) + 4;	# take whatever is defined
     }
+
+  my $rem; $rem = $self->bzero() if wantarray;
+
+  $y = $self->new($y) unless $y->isa('Math::BigFloat');
+
   my $lx = $MBI->_len($x->{_m}); my $ly = $MBI->_len($y->{_m});
   $scale = $lx if $lx > $scale;
   $scale = $ly if $ly > $scale;
   my $diff = $ly - $lx;
   $scale += $diff if $diff > 0;		# if lx << ly, but not if ly << lx!
-    
-  # make copy of $x in case of list context for later reminder calculation
-  my $rem;
-  if (wantarray && !$y->is_one())
+  
+  # cases like $x /= $x (but not $x /= $y!) were wrong due to modifying $x
+  # twice below)
+  require Scalar::Util;
+  if (Scalar::Util::refaddr($x) == Scalar::Util::refaddr($y)) 
     {
-    $rem = $x->copy();
+    $x->bone();				# x/x => 1, rem 0
     }
-
-  $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+'; 
-
-  # check for / +-1 ( +/- 1E0)
-  if (!$y->is_one())
+  else
     {
-    # promote BigInts and it's subclasses (except when already a BigFloat)
-    $y = $self->new($y) unless $y->isa('Math::BigFloat'); 
+ 
+    # make copy of $x in case of list context for later reminder calculation
+    if (wantarray && !$y->is_one())
+      {
+      $rem = $x->copy();
+      }
 
-    # calculate the result to $scale digits and then round it
-    # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
-    $MBI->_lsft($x->{_m},$MBI->_new($scale),10);
-    $MBI->_div ($x->{_m},$y->{_m} );	# a/c
+    $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+'; 
 
-    ($x->{_e},$x->{_es}) = 
-     _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
-    # correct for 10**scale
-    ($x->{_e},$x->{_es}) = 
-      _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+');
-    $x->bnorm();		# remove trailing 0's
-    }
+    # check for / +-1 ( +/- 1E0)
+    if (!$y->is_one())
+      {
+      # promote BigInts and it's subclasses (except when already a BigFloat)
+      $y = $self->new($y) unless $y->isa('Math::BigFloat'); 
+
+      # calculate the result to $scale digits and then round it
+      # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
+      $MBI->_lsft($x->{_m},$MBI->_new($scale),10);
+      $MBI->_div ($x->{_m},$y->{_m});	# a/c
+
+      # correct exponent of $x
+      ($x->{_e},$x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
+      # correct for 10**scale
+      ($x->{_e},$x->{_es}) = _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+');
+      $x->bnorm();		# remove trailing 0's
+      }
+    } # ende else $x != $y
 
   # shortcut to not run through _find_round_parameters again
   if (defined $params[0])
@@ -1343,17 +1361,13 @@ sub bdiv
     # clear a/p after round, since user did not request it
     delete $x->{_a}; delete $x->{_p};
     }
-  
+
   if (wantarray)
     {
     if (!$y->is_one())
       {
       $rem->bmod($y,@params);			# copy already done
       }
-    else
-      {
-      $rem = $self->bzero();
-      }
     if ($fallback)
       {
       # clear a/p after round, since user did not request it
@@ -1839,7 +1853,7 @@ sub _pow
 
   $below = $v->copy();
   $over = $u->copy();
- 
+
   $limit = $self->new("1E-". ($scale-1));
   #my $steps = 0;
   while (3 < 5)
@@ -1891,14 +1905,21 @@ sub bpow
     ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
     }
 
-  return $x if $x->{sign} =~ /^[+-]inf$/;
   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
-  return $x->bone() if $y->is_zero();
+  return $x if $x->{sign} =~ /^[+-]inf$/;
+  
+  # -2 ** -2 => NaN
+  return $x->bnan() if $x->{sign} eq '-' && $y->{sign} eq '-';
+
+  # cache the result of is_zero
+  my $y_is_zero = $y->is_zero();
+  return $x->bone() if $y_is_zero;
   return $x         if $x->is_one() || $y->is_one();
 
-  return $x->_pow($y,$a,$p,$r) if !$y->is_int();	# non-integer power
+  my $x_is_zero = $x->is_zero();
+  return $x->_pow($y,$a,$p,$r) if !$x_is_zero && !$y->is_int();		# non-integer power
 
-  my $y1 = $y->as_number()->{value};			# make CALC
+  my $y1 = $y->as_number()->{value};			# make MBI part
 
   # if ($x == -1)
   if ($x->{sign} eq '-' && $MBI->_is_one($x->{_m}) && $MBI->_is_zero($x->{_e}))
@@ -1906,27 +1927,27 @@ sub bpow
     # if $x == -1 and odd/even y => +1/-1  because +-1 ^ (+-1) => +-1
     return $MBI->_is_odd($y1) ? $x : $x->babs(1);
     }
-  if ($x->is_zero())
+  if ($x_is_zero)
     {
-    return $x->bone() if $y->is_zero();
+    return $x->bone() if $y_is_zero;
     return $x if $y->{sign} eq '+'; 	# 0**y => 0 (if not y <= 0)
     # 0 ** -y => 1 / (0 ** y) => 1 / 0! (1 / 0 => +inf)
     return $x->binf();
     }
 
   my $new_sign = '+';
-  $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
+  $new_sign = $MBI->_is_odd($y1) ? '-' : '+' if $x->{sign} ne '+';
 
   # calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
   $x->{_m} = $MBI->_pow( $x->{_m}, $y1);
-  $MBI->_mul ($x->{_e}, $y1);
+  $x->{_e} = $MBI->_mul ($x->{_e}, $y1);
 
   $x->{sign} = $new_sign;
   $x->bnorm();
   if ($y->{sign} eq '-')
     {
     # modify $x in place!
-    my $z = $x->copy(); $x->bzero()->binc();
+    my $z = $x->copy(); $x->bone();
     return $x->bdiv($z,$a,$p,$r);	# round in one go (might ignore y's A!)
     }
   $x->round($a,$p,$r,$y);
@@ -2039,7 +2060,7 @@ sub bfround
        }
     }
   # pass sign to bround for rounding modes '+inf' and '-inf'
-  my $m = Math::BigInt->new( $x->{sign} . $MBI->_str($x->{_m}));
+  my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
   $m->bround($scale,$mode);
   $x->{_m} = $m->{value};			# get our mantissa back
   $x->bnorm();
@@ -2080,7 +2101,7 @@ sub bround
     }
 
   # pass sign to bround for '+inf' and '-inf' rounding modes
-  my $m = Math::BigInt->new( $x->{sign} . $MBI->_str($x->{_m}));
+  my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
 
   $m->bround($scale,$mode);		# round mantissa
   $x->{_m} = $m->{value};		# get our mantissa back
@@ -2312,19 +2333,13 @@ sub import
     # MBI not loaded, or with ne "Math::BigInt::Calc"
     $lib .= ",$mbilib" if defined $mbilib;
     $lib =~ s/^,//;				# don't leave empty 
+    
     # replacement library can handle lib statement, but also could ignore it
-    if ($] < 5.006)
-      {
-      # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
-      # used in the same script, or eval inside import().
-      require Math::BigInt;
-      Math::BigInt->import( lib => $lib, 'objectify' );
-      }
-    else
-      {
-      my $rc = "use Math::BigInt lib => '$lib', 'objectify';";
-      eval $rc;
-      }
+    
+    # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
+    # used in the same script, or eval inside import(). So we require MBI:
+    require Math::BigInt;
+    Math::BigInt->import( lib => $lib, 'objectify' );
     }
   if ($@)
     {