xref: /openbsd-src/gnu/usr.bin/perl/cpan/bignum/lib/Math/BigInt/Trace.pm (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
1eac174f2Safresh1# -*- mode: perl; -*-
2b8851fccSafresh1
3b8851fccSafresh1package Math::BigInt::Trace;
4b8851fccSafresh1
5b8851fccSafresh1use strict;
6b8851fccSafresh1use warnings;
7b8851fccSafresh1
8b8851fccSafresh1use Exporter;
9b8851fccSafresh1use Math::BigInt;
10b8851fccSafresh1
11b8851fccSafresh1our @ISA = qw(Exporter Math::BigInt);
12b8851fccSafresh1
13*3d61058aSafresh1our $VERSION = '0.67';
14b8851fccSafresh1
159f11ffb7Safresh1use overload;                   # inherit overload from Math::BigInt
16b8851fccSafresh1
17b8851fccSafresh1# Globals
18eac174f2Safresh1our $accuracy   = undef;
19eac174f2Safresh1our $precision  = undef;
20eac174f2Safresh1our $round_mode = 'even';
21eac174f2Safresh1our $div_scale  = 40;
22b8851fccSafresh1
23b8851fccSafresh1sub new {
24b8851fccSafresh1    my $proto = shift;
25b8851fccSafresh1    my $class = ref($proto) || $proto;
26b8851fccSafresh1
27b8851fccSafresh1    my $value = shift;
28eac174f2Safresh1
29b8851fccSafresh1    my $a = $accuracy;
30b8851fccSafresh1    $a = $_[0] if defined $_[0];
31eac174f2Safresh1
32b8851fccSafresh1    my $p = $precision;
33b8851fccSafresh1    $p = $_[1] if defined $_[1];
34eac174f2Safresh1
35eac174f2Safresh1    my $self = $class -> SUPER::new($value, $a, $p, $round_mode);
36eac174f2Safresh1
37eac174f2Safresh1    printf "Math::BigInt new '%s' => '%s' (%s)\n",
38eac174f2Safresh1      $value, $self, ref($self);
39eac174f2Safresh1
40b8851fccSafresh1    return $self;
41b8851fccSafresh1}
42b8851fccSafresh1
43b8851fccSafresh1sub import {
44eac174f2Safresh1    my $class = shift;
45eac174f2Safresh1
46eac174f2Safresh1    printf "%s -> import(%s)\n", $class, join(", ", @_);
47eac174f2Safresh1
48eac174f2Safresh1    # we catch the constants, the rest goes to parent
49eac174f2Safresh1
50eac174f2Safresh1    my $constant = grep { $_ eq ':constant' } @_;
51eac174f2Safresh1    my @a = grep { $_ ne ':constant' } @_;
52eac174f2Safresh1
53eac174f2Safresh1    if ($constant) {
54eac174f2Safresh1        overload::constant
55eac174f2Safresh1
56eac174f2Safresh1            integer => sub {
57eac174f2Safresh1                $class -> new(shift);
58eac174f2Safresh1            },
59eac174f2Safresh1
60eac174f2Safresh1            float   => sub {
61eac174f2Safresh1                $class -> new(shift);
62eac174f2Safresh1            },
63eac174f2Safresh1
64eac174f2Safresh1            binary  => sub {
65eac174f2Safresh1                # E.g., a literal 0377 shall result in an object whose value
66eac174f2Safresh1                # is decimal 255, but new("0377") returns decimal 377.
67eac174f2Safresh1                return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/;
68eac174f2Safresh1                $class -> new(shift);
69eac174f2Safresh1            };
70eac174f2Safresh1    }
71eac174f2Safresh1
72eac174f2Safresh1    $class -> SUPER::import(@a);                # need it for subclasses
73eac174f2Safresh1    #$self -> export_to_level(1, $class, @_);    # need this ?
74b8851fccSafresh1}
75b8851fccSafresh1
76b8851fccSafresh11;
77