applied suggested patch, added tests

	Message-Id: <199904121625.MAA00983@hwsrv1.avici.com>
	Subject: BigInt.pm extensions for logical operations

p4raw-id: //depot/perl@3332

diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index 16ebb1d..a43969c 100644 (file)
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -16,6 +16,14 @@ use overload
                       $_[2]? bpow($_[1],${$_[0]}) : bpow(${$_[0]},$_[1])},
 'neg'  =>      sub {new Math::BigInt &bneg},
 'abs'  =>      sub {new Math::BigInt &babs},
+'<<'   =>      sub {new Math::BigInt
+                      $_[2]? blsft($_[1],${$_[0]}) : blsft(${$_[0]},$_[1])},
+'>>'   =>      sub {new Math::BigInt
+                      $_[2]? brsft($_[1],${$_[0]}) : brsft(${$_[0]},$_[1])},
+'&'    =>      sub {new Math::BigInt &band},
+'|'    =>      sub {new Math::BigInt &bior},
+'^'    =>      sub {new Math::BigInt &bxor},
+'~'    =>      sub {new Math::BigInt &bnot},
 
 qw(
 ""     stringify
@@ -328,6 +336,69 @@ sub bpow { #(num_str, num_str) return num_str
     }
 }
 
+# compute x << y, y >= 0
+sub blsft { #(num_str, num_str) return num_str
+    &bmul($_[$[], &bpow(2, $_[$[+1]));
+}
+
+# compute x >> y, y >= 0
+sub brsft { #(num_str, num_str) return num_str
+    &bdiv($_[$[], &bpow(2, $_[$[+1]));
+}
+
+# compute x & y
+sub band { #(num_str, num_str) return num_str
+    local($x,$y,$r,$m,$xr,$yr) = (&bnorm($_[$[]),&bnorm($_[$[+1]),0,1);
+    if ($x eq 'NaN' || $y eq 'NaN') {
+       'NaN';
+    } else {
+       while ($x ne '+0' && $y ne '+0') {
+           ($x, $xr) = &bdiv($x, 0x10000);
+           ($y, $yr) = &bdiv($y, 0x10000);
+           $r = &badd(&bmul(int $xr & $yr, $m), $r);
+           $m = &bmul($m, 0x10000);
+       }
+       $r;
+    }
+}
+
+# compute x | y
+sub bior { #(num_str, num_str) return num_str
+    local($x,$y,$r,$m,$xr,$yr) = (&bnorm($_[$[]),&bnorm($_[$[+1]),0,1);
+    if ($x eq 'NaN' || $y eq 'NaN') {
+       'NaN';
+    } else {
+       while ($x ne '+0' || $y ne '+0') {
+           ($x, $xr) = &bdiv($x, 0x10000);
+           ($y, $yr) = &bdiv($y, 0x10000);
+           $r = &badd(&bmul(int $xr | $yr, $m), $r);
+           $m = &bmul($m, 0x10000);
+       }
+       $r;
+    }
+}
+
+# compute x ^ y
+sub bxor { #(num_str, num_str) return num_str
+    local($x,$y,$r,$m,$xr,$yr) = (&bnorm($_[$[]),&bnorm($_[$[+1]),0,1);
+    if ($x eq 'NaN' || $y eq 'NaN') {
+       'NaN';
+    } else {
+       while ($x ne '+0' || $y ne '+0') {
+           ($x, $xr) = &bdiv($x, 0x10000);
+           ($y, $yr) = &bdiv($y, 0x10000);
+           $r = &badd(&bmul(int $xr ^ $yr, $m), $r);
+           $m = &bmul($m, 0x10000);
+       }
+       $r;
+    }
+}
+
+# represent ~x as twos-complement number
+sub bnot { #(num_str) return num_str
+    &bsub(-1,$_[$[]);
+}
+
 1;
 __END__
 
@@ -350,6 +421,12 @@ Math::BigInt - Arbitrary size integer math package
   $i->bmod(BINT) return BINT         modulus
   $i->bgcd(BINT) return BINT         greatest common divisor
   $i->bnorm return BINT              normalization
+  $i->blsft(BINT) return BINT        left shift
+  $i->brsft(BINT) return (BINT,BINT) right shift (quo,rem) just quo if scalar
+  $i->band(BINT) return BINT         bit-wise and
+  $i->bior(BINT) return BINT         bit-wise inclusive or
+  $i->bxor(BINT) return BINT         bit-wise exclusive or
+  $i->bnot return BINT               bit-wise not
 
 =head1 DESCRIPTION
 

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index a7bbb2a..edef071 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -341,6 +341,11 @@ instead of
 
        $fullname = File::Spec->catfile($dir1, $dir2, $file);
 
+=item Math::BigInt
+
+The logical operations C<E<lt>E<lt>>, C<E<gt>E<gt>>, C<&>, C<|>
+and C<~> are now supported on bigints.
+
 =item Math::Complex
 
 The accessor methods Re, Im, arg, abs, rho, and theta, can now also

diff --git a/t/lib/bigintpm.t b/t/lib/bigintpm.t
index 62eea74..9606007 100755 (executable)
--- a/t/lib/bigintpm.t
+++ b/t/lib/bigintpm.t
@@ -27,20 +27,32 @@ while (<DATA>) {
                    $try .= "abs \$x;";
                } else {
                    $try .= "\$y = new Math::BigInt \"$args[1]\";";
-                   if ($f eq bcmp){
+                   if ($f eq "bcmp"){
                        $try .= "\$x <=> \$y;";
-                   }elsif ($f eq badd){
+                   }elsif ($f eq "badd"){
                        $try .= "\$x + \$y;";
-                   }elsif ($f eq bsub){
+                   }elsif ($f eq "bsub"){
                        $try .= "\$x - \$y;";
-                   }elsif ($f eq bmul){
+                   }elsif ($f eq "bmul"){
                        $try .= "\$x * \$y;";
-                   }elsif ($f eq bdiv){
+                   }elsif ($f eq "bdiv"){
                        $try .= "\$x / \$y;";
-                   }elsif ($f eq bmod){
+                   }elsif ($f eq "bmod"){
                        $try .= "\$x % \$y;";
-                   }elsif ($f eq bgcd){
+                   }elsif ($f eq "bgcd"){
                        $try .= "Math::BigInt::bgcd(\$x, \$y);";
+                   }elsif ($f eq "blsft"){
+                       $try .= "\$x << \$y;";
+                   }elsif ($f eq "brsft"){
+                       $try .= "\$x >> \$y;";
+                   }elsif ($f eq "band"){
+                       $try .= "\$x & \$y;";
+                   }elsif ($f eq "bior"){
+                       $try .= "\$x | \$y;";
+                   }elsif ($f eq "bxor"){
+                       $try .= "\$x ^ \$y;";
+                   }elsif ($f eq "bnot"){
+                       $try .= "~\$x;";
                    } else { warn "Unknown op"; }
                }
                #print ">>>",$try,"<<<\n";
@@ -311,3 +323,38 @@ abc:+0:NaN
 +3:+2:+1
 +100:+625:+25
 +4096:+81:+1
+&blsft
+abc:abc:NaN
++2:+2:+8
++1:+32:+4294967296
++1:+48:+281474976710656
++8:-2:NaN
+&brsft
+abc:abc:NaN
++8:+2:+2
++4294967296:+32:+1
++281474976710656:+48:+1
++2:-2:NaN
+&band
+abc:abc:NaN
++8:+2:+0
++281474976710656:+0:+0
++281474976710656:+1:+0
++281474976710656:+281474976710656:+281474976710656
+&bior
+abc:abc:NaN
++8:+2:+10
++281474976710656:+0:+281474976710656
++281474976710656:+1:+281474976710657
++281474976710656:+281474976710656:+281474976710656
+&bxor
+abc:abc:NaN
++8:+2:+10
++281474976710656:+0:+281474976710656
++281474976710656:+1:+281474976710657
++281474976710656:+281474976710656:+0
+&bnot
+abc:NaN
++0:-1
++8:-9
++281474976710656:-281474976710657