test/recipes/bc.pl

   1 #! /usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Math::BigInt;
   7
   8 sub calc {
   9     @_ = __adder(@_);
  10     if (scalar @_ != 1) { return "NaN"; }
  11     return shift;
  12 }
  13
  14 sub __canonhex {
  15     my ($sign, $hex) = (shift =~ /^([+\-]?)(.*)$/);
  16     $hex = "0x".$hex if $hex !~ /^0x/;
  17     return $sign.$hex;
  18 }
  19
  20 sub __adder {
  21     @_ = __multiplier(@_);
  22     while (scalar @_ > 1 && $_[1] =~ /^[\+\-]$/) {
  23         my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
  24         my $operator = shift;
  25         @_ = __multiplier(@_);
  26         my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
  27         if ($operator eq "+") {
  28             $operand1->badd($operand2);
  29         } elsif ($operator eq "-") {
  30             $operand1->bsub($operand2);
  31         } else {
  32             die "SOMETHING WENT AWFULLY WRONG";
  33         }
  34         unshift @_, $operand1->as_hex();
  35     }
  36     return @_;
  37 }
  38
  39 sub __multiplier {
  40     @_ = __power(@_);
  41     while (scalar @_ > 1 && $_[1] =~ /^[\*\/%]$/) {
  42         my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
  43         my $operator = shift;
  44         @_ = __power(@_);
  45         my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
  46         if ($operator eq "*") {
  47             $operand1->bmul($operand2);
  48         } elsif ($operator eq "/") {
  49             $operand1->bdiv($operand2);
  50         } elsif ($operator eq "%") {
  51             # Here's a bit of a quirk...
  52             # With OpenSSL's BN, as well as bc, the result of -10 % 3 is -1
  53             # while Math::BigInt, the result is 2.
  54             # The latter is mathematically more correct, but...
  55             my $o1isneg = $operand1->is_neg();
  56             $operand1->babs();
  57             # Math::BigInt does something different with a negative modulus,
  58             # while OpenSSL's BN and bc treat it like a positive number...
  59             $operand2->babs();
  60             $operand1->bmod($operand2);
  61             if ($o1isneg) { $operand1->bneg(); }
  62         } else {
  63             die "SOMETHING WENT AWFULLY WRONG";
  64         }
  65         unshift @_, $operand1->as_hex();
  66     }
  67     return @_;
  68 }
  69
  70 sub __power {
  71     @_ = __paren(@_);
  72     while (scalar @_ > 1 && $_[1] eq "^") {
  73         my $operand1 = Math::BigInt->from_hex(__canonhex(shift));
  74         shift;
  75         @_ = __paren(@_);
  76         my $operand2 = Math::BigInt->from_hex(__canonhex(shift));
  77         $operand1->bpow($operand2);
  78         unshift @_, $operand1->as_hex();
  79     }
  80     return @_;
  81 }
  82
  83 # returns array ( $result, @remaining )
  84 sub __paren {
  85     if (scalar @_ > 0 && $_[0] eq "(") {
  86         shift;
  87         my @result = __adder(@_);
  88         if (scalar @_ == 0 || $_[0] ne ")") {
  89             return ("NaN");
  90         }
  91         shift;
  92         return @result;
  93     }
  94     return @_;
  95 }
  96
  97 1;