Commit | Line | Data |
f3d61276 |
1 | ############################################################################### |
2 | # core math lib for BigInt, representing big numbers by normal int/float's |
3 | # for testing only, will fail any bignum test if range is exceeded |
4 | |
5 | package Math::BigInt::Scalar; |
6 | |
7 | use 5.005; |
8 | use strict; |
9 | # use warnings; # dont use warnings for older Perls |
10 | |
11 | require Exporter; |
12 | |
13 | use vars qw/@ISA $VERSION/; |
14 | @ISA = qw(Exporter); |
15 | |
16 | $VERSION = '0.11'; |
17 | |
18 | ############################################################################## |
19 | # global constants, flags and accessory |
20 | |
21 | # constants for easier life |
22 | my $nan = 'NaN'; |
23 | |
24 | ############################################################################## |
25 | # create objects from various representations |
26 | |
27 | sub _new |
28 | { |
29 | # (string) return ref to num |
30 | my $d = $_[1]; |
31 | my $x = $$d; # make copy |
32 | return \$x; |
33 | } |
34 | |
35 | sub _zero |
36 | { |
37 | my $x = 0; return \$x; |
38 | } |
39 | |
40 | sub _one |
41 | { |
42 | my $x = 1; return \$x; |
43 | } |
44 | |
45 | sub _copy |
46 | { |
47 | my $x = $_[1]; |
48 | my $z = $$x; |
49 | return \$z; |
50 | } |
51 | |
52 | # catch and throw away |
53 | sub import { } |
54 | |
55 | ############################################################################## |
56 | # convert back to string and number |
57 | |
58 | sub _str |
59 | { |
60 | # make string |
61 | return \"${$_[1]}"; |
62 | } |
63 | |
64 | sub _num |
65 | { |
66 | # make a number |
67 | return ${$_[1]}; |
68 | } |
69 | |
70 | |
71 | ############################################################################## |
72 | # actual math code |
73 | |
74 | sub _add |
75 | { |
76 | my ($c,$x,$y) = @_; |
77 | $$x += $$y; |
78 | return $x; |
79 | } |
80 | |
81 | sub _sub |
82 | { |
83 | my ($c,$x,$y) = @_; |
84 | $$x -= $$y; |
85 | return $x; |
86 | } |
87 | |
88 | sub _mul |
89 | { |
90 | my ($c,$x,$y) = @_; |
91 | $$x *= $$y; |
92 | return $x; |
93 | } |
94 | |
95 | sub _div |
96 | { |
97 | my ($c,$x,$y) = @_; |
98 | |
99 | my $u = int($$x / $$y); my $r = $$x % $$y; $$x = $u; |
100 | return ($x,\$r) if wantarray; |
101 | return $x; |
102 | } |
103 | |
104 | sub _pow |
105 | { |
106 | my ($c,$x,$y) = @_; |
107 | my $u = $$x ** $$y; $$x = $u; |
108 | return $x; |
109 | } |
110 | |
111 | sub _and |
112 | { |
113 | my ($c,$x,$y) = @_; |
114 | my $u = int($$x) & int($$y); $$x = $u; |
115 | return $x; |
116 | } |
117 | |
118 | sub _xor |
119 | { |
120 | my ($c,$x,$y) = @_; |
121 | my $u = int($$x) ^ int($$y); $$x = $u; |
122 | return $x; |
123 | } |
124 | |
125 | sub _or |
126 | { |
127 | my ($c,$x,$y) = @_; |
128 | my $u = int($$x) | int($$y); $$x = $u; |
129 | return $x; |
130 | } |
131 | |
132 | sub _inc |
133 | { |
134 | my ($c,$x) = @_; |
135 | my $u = int($$x)+1; $$x = $u; |
136 | return $x; |
137 | } |
138 | |
139 | sub _dec |
140 | { |
141 | my ($c,$x) = @_; |
142 | my $u = int($$x)-1; $$x = $u; |
143 | return $x; |
144 | } |
145 | |
146 | ############################################################################## |
147 | # testing |
148 | |
149 | sub _acmp |
150 | { |
151 | my ($c,$x, $y) = @_; |
152 | return ($$x <=> $$y); |
153 | } |
154 | |
155 | sub _len |
156 | { |
157 | return length("${$_[1]}"); |
158 | } |
159 | |
160 | sub _digit |
161 | { |
162 | # return the nth digit, negative values count backward |
163 | # 0 is the rightmost digit |
164 | my ($c,$x,$n) = @_; |
165 | |
166 | $n ++; # 0 => 1, 1 => 2 |
167 | return substr($$x,-$n,1); # 1 => -1, -2 => 2 etc |
168 | } |
169 | |
170 | ############################################################################## |
171 | # _is_* routines |
172 | |
173 | sub _is_zero |
174 | { |
175 | # return true if arg is zero |
176 | my ($c,$x) = @_; |
177 | return ($$x == 0) <=> 0; |
178 | } |
179 | |
180 | sub _is_even |
181 | { |
182 | # return true if arg is even |
183 | my ($c,$x) = @_; |
184 | return (!($$x & 1)) <=> 0; |
185 | } |
186 | |
187 | sub _is_odd |
188 | { |
189 | # return true if arg is odd |
190 | my ($c,$x) = @_; |
191 | return ($$x & 1) <=> 0; |
192 | } |
193 | |
194 | sub _is_one |
195 | { |
196 | # return true if arg is one |
197 | my ($c,$x) = @_; |
198 | return ($$x == 1) <=> 0; |
199 | } |
200 | |
201 | ############################################################################### |
202 | # check routine to test internal state of corruptions |
203 | |
204 | sub _check |
205 | { |
206 | # no checks yet, pull it out from the test suite |
207 | my ($c,$x) = @_; |
208 | return "$x is not a reference" if !ref($x); |
209 | return 0; |
210 | } |
211 | |
212 | 1; |
213 | __END__ |
214 | |
215 | =head1 NAME |
216 | |
217 | Math::BigInt::Scalar - Pure Perl module to test Math::BigInt with scalars |
218 | |
219 | =head1 SYNOPSIS |
220 | |
221 | Provides support for big integer calculations via means of 'small' int/floats. |
222 | Only for testing purposes, since it will fail at large values. But it is simple |
223 | enough not to introduce bugs on it's own and to serve as a testbed. |
224 | |
225 | =head1 DESCRIPTION |
226 | |
227 | Please see Math::BigInt::Calc. |
228 | |
229 | =head1 LICENSE |
230 | |
231 | This program is free software; you may redistribute it and/or modify it under |
232 | the same terms as Perl itself. |
233 | |
234 | =head1 AUTHOR |
235 | |
236 | Tels http://bloodgate.com in 2001. |
237 | |
238 | =head1 SEE ALSO |
239 | |
240 | L<Math::BigInt>, L<Math::BigInt::Calc>. |
241 | |
242 | =cut |