- Added support for setting the global precision, accuracy and roundi…

…ng mode for Math::BigFloat with the following command-line options: -A int set the numeric accuracy to a certain number of digits -P int set the precision of floating-point numbers -M mode set the rounding mode of floating-point numbers valid modes: [even], odd, +inf, -inf, zero, trunc, common Also added some temporary patches for known bugs on Math::BigFloat to get rounding work correctly, or at least correctly in common places.
trizen · Dec 19, 2015 · 8157b53 · 8157b53
1 parent 0cc0dcf
commit 8157b53
Show file tree

Hide file tree

Showing 9 changed files with 374 additions and 30 deletions.
diff --git a/MANIFEST b/MANIFEST
@@ -791,6 +791,7 @@ utils/Experiments/bigint.sm
 utils/Experiments/bigrat.sm
 utils/Experiments/C-inline-function-call.pl
 utils/Experiments/Lazy/Lazy.pm
+utils/Experiments/NumberMPFR.pm
 utils/Experiments/operator_precendece.pl
 utils/Experiments/regexp_grammars_op_precedence.pl
 utils/Experiments/regexp_grammars_parser.pl

diff --git a/bin/sidef b/bin/sidef
@@ -32,7 +32,7 @@ sub NATIVE () { 0 }
 my %args;
 if ($#ARGV != -1 and chr ord $ARGV[0] eq '-') {
     require Getopt::Std;
-    Getopt::Std::getopts('e:E:d:Dho:ivHn:WwbcrR:ts:CO:k', \%args);
+    Getopt::Std::getopts('e:E:d:Dho:ivHn:WwbcrR:ts:CO:kP:A:M:', \%args);
 }
 
 # Help
@@ -180,7 +180,8 @@ else {
 
             my $header =
                 "\nuse lib ("
-              . join(', ', map { qq{"\Q$_\E"} } @INC) . ");\n\n"
+              . join(', ', map { qq{"\Q$_\E"} } @INC)
+              . ");\n\n"
               . "use Sidef;\n\n"
               . "binmode(STDIN, ':utf8');\n"
               . "binmode(STDOUT, ':utf8');\n"
@@ -287,34 +288,42 @@ sub load_math_backend {
 
 sub execute_struct {
     my ($struct, $return) = @_;
-    my $deparser = Sidef::Deparse::Perl->new(namespaces => [@Sidef::NAMESPACES]);
+    my $deparser = Sidef::Deparse::Perl->new(namespaces => [@Sidef::NAMESPACES], opt => \%args);
     local $Sidef::DEPARSER = $deparser;
     my $code = $deparser->deparse($struct);
     $return ? eval($code) : do { eval($code); $@ && die $@; exit };
 }
 
 sub output_usage {
+#<<<
     my %switches = (
                     '-i'         => 'interactive mode',
                     '-c'         => 'compile the code as a stand-alone Perl program',
                     '-C'         => 'check syntax only',
                     '-d file'    => 'load a dumped syntax tree',
                     '-D'         => 'dump the syntax tree of a program',
                     '-o file'    => 'file where to dump the output',
-                    '-O level'   => ['perform code optimizations before execution', 'valid levels: 0, 1, 2'],
+                    '-O level'   => ['perform code optimizations before execution',
+                                     'valid levels: [0], 1, 2'],
+                    '-P int'     => 'set the precision of floating-point numbers',
+                    '-A int'     => 'set the numeric accuracy to a certain number of digits',
+                    '-M mode'    => ['set the rounding mode of floating-point numbers',
+                                     'valid modes: [even], odd, +inf, -inf, zero, trunc, common'],
                     '-k'         => 'keep track of potential unsafe parser interpretations',
                     '-E program' => 'one line of program',
                     '-H'         => 'interactive help',
-                    '-n type'    => ['try to use a specific backend for Math::BigInt', 'valid types: GMP, Pari, FastCalc'],
+                    '-n type'    => ['try to use a specific backend for Math::BigInt',
+                                     'valid types: GMP, Pari, FastCalc'],
                     '-s int'     => 'the number of spaces used in code indentation',
                     '-v'         => 'print version number and exit',
                     '-t'         => 'treat all command-line arguments as scripts',
                     '-r'         => 'parse and deparse a Sidef program',
-                    '-R lang'    => ['parse and deparse a Sidef program to a given language', 'valid values: sidef, perl'],
+                    '-R lang'    => ['parse and deparse a Sidef program to a given language',
+                                     'valid values: sidef, perl'],
                     '-w'         => 'enable warnings with stack backtrace',
                     '-W'         => 'make warnings fatal (with stack backtrace)',
-                   );
-
+    );
+#>>>
     require File::Basename;
     my $basename = File::Basename::basename($0);
 
@@ -546,7 +555,7 @@ sub deparse_structure {
     my $pm     = ($module =~ s{::}{/}gr . '.pm');
 
     require $pm;
-    my $deparser = $module->new(namespaces => [@Sidef::NAMESPACES]);
+    my $deparser = $module->new(namespaces => [@Sidef::NAMESPACES], opt => \%args);
     my $code = $deparser->deparse($struct);
 
     return $code;
@@ -641,7 +650,7 @@ HEAD
 
                  close $fh;
              }
-           }
+         }
         } => ($path, $INC{'Sidef.pm'})
     );
 

diff --git a/lib/Sidef/Deparse/Perl.pm b/lib/Sidef/Deparse/Perl.pm
@@ -21,6 +21,7 @@ package Sidef::Deparse::Perl {
             between     => ";\n",
             after       => ";\n",
             namespaces  => [],
+            opt         => {},
 
             assignment_ops => {
                                '=' => '=',
@@ -68,6 +69,27 @@ use $];
 
 HEADER
 
+        if (exists $opts{opt}{A}) {
+            my $accuracy = abs(int($opts{opt}{A}));
+
+            #$opts{header} .= "Math::BigFloat->precision(-$p);";
+            #$opts{header} .= "local \$Math::BigFloat::precision = -$p;\n";
+            #$opts{header} .= "local \$Math::BigFloat::round_mode = 'trunc';" if $p == 0;
+            $opts{header} .= "local \$Math::BigFloat::accuracy = $accuracy;\n";
+
+            #$opts{header} .= "local \$Math::BigFloat::round_mode = 'common';";
+        }
+
+        if (exists $opts{opt}{P}) {
+            my $precision = abs(int($opts{opt}{P}));
+            $opts{header} .= "local \$Math::BigFloat::precision = -$precision;\n";
+        }
+
+        if (exists $opts{opt}{M}) {
+            my $mode = lc($opts{opt}{M}) =~ s/\s+//rg;
+            $opts{header} .= "local \$Math::BigFloat::round_mode = '${mode}';\n";
+        }
+
         %addr    = ();
         %type    = ();
         %top_add = ();

diff --git a/lib/Sidef/Deparse/Sidef.pm b/lib/Sidef/Deparse/Sidef.pm
@@ -16,6 +16,7 @@ package Sidef::Deparse::Sidef {
                     class        => 'main',
                     extra_parens => 0,
                     namespaces   => [],
+                    opt          => {},
                     %args,
                    );
         %addr = ();    # reset the addr map

diff --git a/lib/Sidef/Math/Math.pm b/lib/Sidef/Math/Math.pm
@@ -14,8 +14,17 @@ package Sidef::Math::Math {
 
         state %cache;
         state $table = {
-            e   => sub { Math::BigFloat->new(1)->bexp },
-            pi  => sub { Math::BigFloat->bpi },
+            e  => sub { Math::BigFloat->new(1)->bexp },
+            pi => sub {
+
+                # Old bug in Math::BigFloat
+                # https://rt.cpan.org/Ticket/Display.html?id=84950
+                my $pi = do {
+                    local $Math::BigFloat::precision = undef if defined($Math::BigFloat::precision);
+                    Math::BigFloat->bpi;
+                };
+                defined($Math::BigFloat::precision) ? $pi->bfround($Math::BigFloat::precision) : $pi;
+            },
             phi => sub { Math::BigFloat->new(1)->badd(Math::BigFloat->new(5)->bsqrt)->bdiv(2) },
 
             sqrt2   => sub { Math::BigFloat->new(2)->bsqrt },
@@ -38,8 +47,26 @@ package Sidef::Math::Math {
 
     sub e {
         my ($self, $places) = @_;
-        state $one = Math::BigFloat->new(1);
-        Sidef::Types::Number::Number->new($one->copy->bexp(defined($places) ? $places->get_value : ()));
+
+        my $precision = $Math::BigFloat::precision;
+
+        my $e = do {
+            local $Math::BigFloat::precision = undef if defined($precision);
+            Math::BigFloat->new(1)->bexp(
+                defined($places)
+                ? do {
+                    local $Sidef::Types::Number::Number::GET_PERL_VALUE = 1 if defined($precision);
+                    $places->get_value;
+                  }
+                : ()
+            );
+        };
+
+        Sidef::Types::Number::Number->new(
+            defined($precision)                 #&& !defined($places)
+            ? scalar($e->bfround($precision))
+            : $e
+        );
     }
 
     sub exp {
@@ -50,8 +77,28 @@ package Sidef::Math::Math {
 
     sub pi {
         my ($self, $places) = @_;
-        $places = defined($places) ? $places->get_value : undef;
-        Sidef::Types::Number::Number->new(Math::BigFloat->bpi(defined($places) ? $places : ()));
+
+        my $precision = $Math::BigFloat::precision;
+
+        # Old bug in Math::BigFloat
+        # https://rt.cpan.org/Ticket/Display.html?id=84950
+        my $pi = do {
+            local $Math::BigFloat::precision = undef if defined($precision);
+            Math::BigFloat->bpi(
+                defined($places)
+                ? do {
+                    local $Sidef::Types::Number::Number::GET_PERL_VALUE = 1 if defined($precision);
+                    $places->get_value;
+                  }
+                : ()
+            );
+        };
+
+        Sidef::Types::Number::Number->new(
+            defined($precision)                  #&& !defined($places)
+            ? scalar($pi->bfround($precision))
+            : $pi
+        );
     }
 
     *PI = \&pi;
@@ -70,19 +117,61 @@ package Sidef::Math::Math {
 
     sub log {
         my ($self, $n, $base) = @_;
-        Sidef::Types::Number::Number->new(Math::BigFloat->new($n->get_value)->blog(defined($base) ? $base->get_value : ()));
+
+        # Bug in Math::BigFloat
+        # https://rt.cpan.org/Ticket/Display.html?id=110444
+        if (defined $base) {
+
+            my $precision = $Math::BigFloat::precision;
+
+            my $log = do {
+                local $Math::BigFloat::precision = undef if defined($precision);
+                Math::BigFloat->new($n->get_value)->blog(
+                    do {
+                        local $Sidef::Types::Number::Number::GET_PERL_VALUE = 1 if defined($precision);
+                        $base->get_value;
+                      }
+                );
+            };
+
+            return Sidef::Types::Number::Number->new(defined($precision) ? scalar($log->bfround($precision)) : $log);
+        }
+
+        Sidef::Types::Number::Number->new(Math::BigFloat->new($n->get_value)->blog);
     }
 
     sub log2 {
         my ($self, $n) = @_;
-        state $two = Math::BigFloat->new(2);
-        Sidef::Types::Number::Number->new(Math::BigFloat->new($n->get_value)->blog($two));
+
+        # Bug in Math::BigFloat
+        # https://rt.cpan.org/Ticket/Display.html?id=110444
+        my $log = do {
+            local $Math::BigFloat::precision = undef if defined($Math::BigFloat::precision);
+            Math::BigFloat->new($n->get_value)->blog(2);
+        };
+
+        Sidef::Types::Number::Number->new(
+                                          defined($Math::BigFloat::precision)
+                                          ? scalar($log->bfround($Math::BigFloat::precision))
+                                          : $log
+                                         );
     }
 
     sub log10 {
         my ($self, $n) = @_;
-        state $ten = Math::BigFloat->new(10);
-        Sidef::Types::Number::Number->new(Math::BigFloat->new($n->get_value)->blog($ten));
+
+        # Bug in Math::BigFloat
+        # https://rt.cpan.org/Ticket/Display.html?id=110444
+        my $log = do {
+            local $Math::BigFloat::precision = undef if defined($Math::BigFloat::precision);
+            Math::BigFloat->new($n->get_value)->blog(10);
+        };
+
+        Sidef::Types::Number::Number->new(
+                                          defined($Math::BigFloat::precision)
+                                          ? scalar($log->bfround($Math::BigFloat::precision))
+                                          : $log
+                                         );
     }
 
     sub npow2 {
@@ -146,7 +235,25 @@ package Sidef::Math::Math {
 
     sub root {
         my ($self, $n, $m) = @_;
-        Sidef::Types::Number::Number->new(Math::BigFloat->new($n->get_value)->broot($m->get_value));
+
+        my $precision = $Math::BigFloat::precision;
+
+        # Bug in Math::BigFloat
+        my $root = do {
+            local $Math::BigFloat::precision = undef if defined($precision);
+            Math::BigFloat->new($n->get_value)->broot(
+                do {
+                    local $Sidef::Types::Number::Number::GET_PERL_VALUE = 1 if defined($precision);
+                    $m->get_value;
+                  }
+            );
+        };
+
+        Sidef::Types::Number::Number->new(
+                                          defined($precision)
+                                          ? scalar($root->bfround($precision))
+                                          : $root
+                                         );
     }
 
     sub troot {

diff --git a/lib/Sidef/Types/Hash/Hash.pm b/lib/Sidef/Types/Hash/Hash.pm
@@ -339,7 +339,7 @@ package Sidef::Types::Hash::Hash {
 
     sub to_list {
         my ($self) = @_;
-        map { (Sidef::Types::String::String->new($_) => $self->{$_}) } keys %$self;
+        map { (Sidef::Types::String::String->new($_), $self->{$_}) } keys %$self;
     }
 
     *as_list = \&to_list;