My working unpac space for OCaml projects in development
Merge opam/patches/zarith
+20204
+4
vendor/opam/zarith/.gitattributes
+4
vendor/opam/zarith/.gitattributes
+32
vendor/opam/zarith/.github/workflows/CI.yml
+32
vendor/opam/zarith/.github/workflows/CI.yml
···
1
+
name: CI
2
+
3
+
on: [push, pull_request]
4
+
5
+
jobs:
6
+
Ubuntu:
7
+
runs-on: ubuntu-latest
8
+
steps:
9
+
- name: Install packages
10
+
run: sudo apt-get install ocaml-nox libgmp-dev
11
+
- name: Checkout
12
+
uses: actions/checkout@v2
13
+
- name: configure tree
14
+
run: ./configure
15
+
- name: Build
16
+
run: make
17
+
- name: Run the testsuite
18
+
run: make -C tests test
19
+
20
+
MacOS:
21
+
runs-on: macos-latest
22
+
steps:
23
+
- name: Install packages
24
+
run: brew install ocaml ocaml-findlib gmp
25
+
- name: Checkout
26
+
uses: actions/checkout@v2
27
+
- name: configure tree
28
+
run: ./configure
29
+
- name: Build
30
+
run: make
31
+
- name: Run the testsuite
32
+
run: make -C tests test
+49
vendor/opam/zarith/.github/workflows/build.yml
+49
vendor/opam/zarith/.github/workflows/build.yml
···
1
+
name: build
2
+
3
+
on:
4
+
pull_request:
5
+
push:
6
+
branches:
7
+
- master
8
+
schedule:
9
+
# Prime the caches every Monday
10
+
- cron: 0 1 * * MON
11
+
12
+
jobs:
13
+
build:
14
+
strategy:
15
+
fail-fast: false
16
+
matrix:
17
+
os:
18
+
- ubuntu-latest
19
+
- windows-latest
20
+
- macos-latest
21
+
ocaml-compiler:
22
+
- "4.14"
23
+
- "5.2"
24
+
25
+
runs-on: ${{ matrix.os }}
26
+
27
+
steps:
28
+
- name: Checkout code
29
+
uses: actions/checkout@v4
30
+
31
+
- name: Set-up OCaml ${{ matrix.ocaml-compiler }}
32
+
uses: ocaml/setup-ocaml@v3
33
+
with:
34
+
ocaml-compiler: ${{ matrix.ocaml-compiler }}
35
+
36
+
- run: opam install . --with-test --deps-only
37
+
38
+
- name: configure tree
39
+
run: opam exec -- sh ./configure
40
+
41
+
- name: Build
42
+
run: opam exec -- make
43
+
44
+
- name: Run the testsuite
45
+
run: opam exec -- make -C tests test
46
+
47
+
- run: opam install . --with-test
48
+
49
+
- run: opam exec -- git diff --exit-code
+14
vendor/opam/zarith/.gitignore
+14
vendor/opam/zarith/.gitignore
+143
vendor/opam/zarith/Changes
+143
vendor/opam/zarith/Changes
···
1
+
Release 1.14 (2024-07-10)
2
+
- #148, #149: Fail unmarshaling when it would produce non-canonical big ints
3
+
- #145, #150: Use standard hash function for `Z.hash` and add `Z.seeded_hash`
4
+
- #140, #147: Add fast path for `Z.divisible` on small arguments
5
+
6
+
Release 1.13 (2023-07-19)
7
+
- #113: add conversions to/from small unsigned integers `(to|fits)_(int32|int64|nativeint)_unsigned` [Antoine Miné]
8
+
- #128: add functions to pseudo-randomly generate integers [Xavier Leroy]
9
+
- #105: add `Big_int.big_int_of_float` [Yishuai Li]
10
+
- #90: add fast path to `Z.extract` when extraction leads to a small integer [Frédéric Recoules]
11
+
- #137: more precise bounds for of_float conversion to small ints [Antoine Miné]
12
+
- #118: fix Z_mlgmpidl interface for mlgmpidl >= 1.2 [Simmo Saan]
13
+
- #109: fix typo in `ml_z_mul` function [Bernhard Schommer]
14
+
- #108: fix dependency on C evaluation order in `ml_z_remove` [Xavier Clerc]
15
+
- #117 #120 #129 #132 #135 #139 #141: configure & build simplifications and fixes [various authors]
16
+
- #134: CI testing: add Windows, test both 4.14 and 5.0 [Hugo Heuzard]
17
+
18
+
Release 1.12 (2021-03-03)
19
+
- PR #79: fast path in OCaml (instead of assembly language) [Xavier Leroy]
20
+
- PR #94: remove source preprocessing and simplify configuration [Xavier Leroy]
21
+
- PR #93: fix parallel build [Guillaume Melquiond]
22
+
- PR #92: fix benchmark for subtraction [Guillaume Melquiond]
23
+
- Require OCaml 4.04 or later [Xavier Leroy]
24
+
- Add CI testing on macOS [Xavier Leroy]
25
+
26
+
Release 1.11 (2020-11-09)
27
+
- Fixes #72, #75, #78: multiple fixes for of_string, support for underscores [hhugo]
28
+
- Fix #74: fix Q.to_float for denormal numbers [pascal-cuoq]
29
+
- Fix #84: always represent min_int by a tagged integer [xavierleroy]
30
+
- muliple fixes for min_int arguments [xavierleroy]
31
+
- Improvement #85: optimize the fast paths for comparison and equality tests [xavierleroy]
32
+
- Fix #80: ar tool is detected in configure [jsmolic]
33
+
34
+
Release 1.10 (2020-09-11)
35
+
- Improvement #66: added some mpz functions (divisible, congruent, jacobi, legendre, krobecker, remove, fac, primorial, bin, fib, lucnum)
36
+
- Improvement #65: Q.of_string now handles decimal point and scientific notation [Ghiles Ziat]
37
+
- Fix #60: Z.root now raises an exception for invalid arguments
38
+
- Fix #62: raise division by 0 for 0-modulo in powm
39
+
- Fix #59: improved abs for negative arguments
40
+
- Fix #58: gcd, lcm, gcdext now behave as gmp for negative arguments
41
+
- Fix #57: clean compile with safe strings [hhugo]
42
+
43
+
Release 1.9.1 (2019-08-28) (bugfix):
44
+
- Fix configure issue for non-bash sh introduced in #45
45
+
- Tweaks to opam file [kit-ty-kate]
46
+
47
+
Release 1.9 (2019-08-22):
48
+
- Issue #50: add opam file, make it easy to "opam publish" new versions
49
+
- Issue #38: configure detects 32bit OCaml switch on 64bit host
50
+
- Fix #36: change Q.equal, leq, geq comparisons for undef
51
+
- Request #47: move infix comparison operators of Z in submodule
52
+
avoid shadowing the polymorphic compare [Bernhard Schommer]
53
+
- Fix #49: INT_MAX undeclared
54
+
- Request #46: add prefixnonocaml option [Et7f3]
55
+
- Request #45: fix ocamllibdir/caml/mlvalues.h bug (Cygwin) [Et7f3]
56
+
- Fix: attempting to build numbers too large for GMP raises an OCaml exception
57
+
instead of crashing with "gmp: overflow in mpz type"
58
+
59
+
Release 1.8 (2019-03-30):
60
+
- Request #20: infix comparison operators for Q and Z [Max Mouratov]
61
+
- Request #39: gdc(x,0) = gcd(0,x) = x [Vincent Laporte]
62
+
- Request #41: support for upcoming OCaml 4.08 [Daniel Hillerström]
63
+
- Issue #17: add package zarith.top with REPL printer [Christophe Troestler]
64
+
- Issue #22: wrong stack marking directive in caml_z_x86_64_mingw64.S
65
+
[Bernhard Schommer]
66
+
- Issue #24: generate and install .cmti files for easy access to documentation
67
+
- Issue #25: false alarm in tests/zq.ml owing to unreliable printing
68
+
of FP values
69
+
- Request #28: better handling of absolute paths in "configure"
70
+
71
+
Release 1.7 (2017-10-13):
72
+
- Issue#14, pull request#15: ARM assembly code was broken.
73
+
- Fix tests so that they work even if the legacy Num library is unavailable.
74
+
75
+
Release 1.6 (2017-09-23):
76
+
- On Linux and BSD, keep the stack non-executable.
77
+
- Issue#10: clarify documentation of Q.of_string
78
+
- Fixed spurious installation error if shared libraries not supported
79
+
[Bernhard Schommer]
80
+
81
+
Release 1.5 (2017-05-26):
82
+
- Install all .cmx files, improving performance of clients and
83
+
avoiding a warning from OCaml 4.03 and up.
84
+
- Z.of_float: fix a bug in the fast path [Richard Jones]
85
+
(See https://bugzilla.redhat.com/show_bug.cgi?id=1392247)
86
+
- Improve compatibility with OCaml 4.03 and up
87
+
[Bernhard Schommer]
88
+
- Overflow issue in Z.pow and Z.root with very large exponents (GPR#5)
89
+
[Andre Maroneze]
90
+
- Added function Q.to_float.
91
+
92
+
Release 1.4.1 (2015-11-09):
93
+
- Fixed ml_z_of_substring_base and Z.of_substring [Thomas Braibant]
94
+
- Integrated Opam fix for Perl scripts [Thomas Braibant]
95
+
96
+
Release 1.4 (2015-11-02):
97
+
- Improvements to Q (using divexact) [Bertrand Jeannet]
98
+
- Fixed div_2exp bug [Bertrand Jeannet]
99
+
- Improvements for divexact [Bertrand Jeannet]
100
+
- Added of_substring, with fast path for native integers [Thomas Braibant]
101
+
- Added Z.powm_sec (constant-time modular exponentiation)
102
+
- Reimplemented Z.to_float, now produces correctly rounded FP numbers
103
+
- Added Z.trailing_zeros.
104
+
- Added Z.testbit, Z.is_even, Z.is_odd.
105
+
- Added Z.numbits, Z.log2 and Z.log2up.
106
+
- PR#1467: Z.hash is declared as "noalloc" [François Bobot]
107
+
- PR#1451: configure fix [Spiros Eliopoulos]
108
+
- PR#1436: disable "(void)" trick for unused variables on Windows [Bernhard Schommer]
109
+
- PR#1434: removed dependencies on printf & co when Z_PERFORM_CHECK is 0 [Hannes Mehnert]
110
+
- PR#1462: issues with Z.to_float and large numbers.
111
+
112
+
Release 1.3 (2014-09-03):
113
+
- Fixed inefficiencies in asm fast path for ARM.
114
+
- Revised detection of NaNs and infinities in Z.of_float
115
+
- Suppress the redundant fast paths written in C if a corresponding
116
+
fast path exists in asm.
117
+
- Use <stdint.h> to ensure compatibility with OCaml 4.02.
118
+
- More prudent implementation of Z.of_int, avoids GC problem
119
+
with OCaml < 4.02 (PR#6501 in the OCaml bug tracker).
120
+
- PR#1429: of_string accepts 'a' in base 10.
121
+
- Macro change to avoid compiler warnings on unused variables.
122
+
123
+
Release 1.2.1 (2013-06-12):
124
+
- Install fixes
125
+
126
+
Release 1.2 (2013-05-19):
127
+
- Added fast asm path for ARMv7 processors.
128
+
- PR#1192: incorrect behavior of div_2exp
129
+
- Issue with aggressive C compiler optimization in the fast path for multiply
130
+
- Better support for Windows/Mingw32
131
+
132
+
Release 1.1 (2012-03-24):
133
+
- Various improvements in the asm fast path for i686 and x86_64
134
+
- PR#1034: support for static linking of GMP/MPIR
135
+
- PR#1046: autodetection of ocamlopt and dynlink
136
+
- PR#1048: autodetection of more platforms that we support
137
+
- PR#1051: support architectures with strict alignment constraints for
138
+
64-bit integers (e.g. Sparc)
139
+
- Fixed 1-bit precision loss when converting doubles to rationals
140
+
- Improved support for the forthcoming release 4.00 of OCaml
141
+
142
+
Release 1.0 (2011-08-18):
143
+
- First public release
+501
vendor/opam/zarith/LICENSE
+501
vendor/opam/zarith/LICENSE
···
1
+
This Library is distributed under the terms of the GNU Library General
2
+
Public License version 2 (included below).
3
+
4
+
As a special exception to the GNU Library General Public License, you
5
+
may link, statically or dynamically, a "work that uses the Library"
6
+
with a publicly distributed version of the Library to produce an
7
+
executable file containing portions of the Library, and distribute
8
+
that executable file under terms of your choice, without any of the
9
+
additional requirements listed in clause 6 of the GNU Library General
10
+
Public License. By "a publicly distributed version of the Library",
11
+
we mean either the unmodified Library as distributed by INRIA, or a
12
+
modified version of the Library that is distributed under the
13
+
conditions defined in clause 3 of the GNU Library General Public
14
+
License. This exception does not however invalidate any other reasons
15
+
why the executable file might be covered by the GNU Library General
16
+
Public License.
17
+
18
+
----------------------------------------------------------------------
19
+
20
+
GNU LIBRARY GENERAL PUBLIC LICENSE
21
+
Version 2, June 1991
22
+
23
+
Copyright (C) 1991 Free Software Foundation, Inc.
24
+
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
25
+
Everyone is permitted to copy and distribute verbatim copies
26
+
of this license document, but changing it is not allowed.
27
+
28
+
[This is the first released version of the library GPL. It is
29
+
numbered 2 because it goes with version 2 of the ordinary GPL.]
30
+
31
+
Preamble
32
+
33
+
The licenses for most software are designed to take away your
34
+
freedom to share and change it. By contrast, the GNU General Public
35
+
Licenses are intended to guarantee your freedom to share and change
36
+
free software--to make sure the software is free for all its users.
37
+
38
+
This license, the Library General Public License, applies to some
39
+
specially designated Free Software Foundation software, and to any
40
+
other libraries whose authors decide to use it. You can use it for
41
+
your libraries, too.
42
+
43
+
When we speak of free software, we are referring to freedom, not
44
+
price. Our General Public Licenses are designed to make sure that you
45
+
have the freedom to distribute copies of free software (and charge for
46
+
this service if you wish), that you receive source code or can get it
47
+
if you want it, that you can change the software or use pieces of it
48
+
in new free programs; and that you know you can do these things.
49
+
50
+
To protect your rights, we need to make restrictions that forbid
51
+
anyone to deny you these rights or to ask you to surrender the rights.
52
+
These restrictions translate to certain responsibilities for you if
53
+
you distribute copies of the library, or if you modify it.
54
+
55
+
For example, if you distribute copies of the library, whether gratis
56
+
or for a fee, you must give the recipients all the rights that we gave
57
+
you. You must make sure that they, too, receive or can get the source
58
+
code. If you link a program with the library, you must provide
59
+
complete object files to the recipients so that they can relink them
60
+
with the library, after making changes to the library and recompiling
61
+
it. And you must show them these terms so they know their rights.
62
+
63
+
Our method of protecting your rights has two steps: (1) copyright
64
+
the library, and (2) offer you this license which gives you legal
65
+
permission to copy, distribute and/or modify the library.
66
+
67
+
Also, for each distributor's protection, we want to make certain
68
+
that everyone understands that there is no warranty for this free
69
+
library. If the library is modified by someone else and passed on, we
70
+
want its recipients to know that what they have is not the original
71
+
version, so that any problems introduced by others will not reflect on
72
+
the original authors' reputations.
73
+
74
+
Finally, any free program is threatened constantly by software
75
+
patents. We wish to avoid the danger that companies distributing free
76
+
software will individually obtain patent licenses, thus in effect
77
+
transforming the program into proprietary software. To prevent this,
78
+
we have made it clear that any patent must be licensed for everyone's
79
+
free use or not licensed at all.
80
+
81
+
Most GNU software, including some libraries, is covered by the ordinary
82
+
GNU General Public License, which was designed for utility programs. This
83
+
license, the GNU Library General Public License, applies to certain
84
+
designated libraries. This license is quite different from the ordinary
85
+
one; be sure to read it in full, and don't assume that anything in it is
86
+
the same as in the ordinary license.
87
+
88
+
The reason we have a separate public license for some libraries is that
89
+
they blur the distinction we usually make between modifying or adding to a
90
+
program and simply using it. Linking a program with a library, without
91
+
changing the library, is in some sense simply using the library, and is
92
+
analogous to running a utility program or application program. However, in
93
+
a textual and legal sense, the linked executable is a combined work, a
94
+
derivative of the original library, and the ordinary General Public License
95
+
treats it as such.
96
+
97
+
Because of this blurred distinction, using the ordinary General
98
+
Public License for libraries did not effectively promote software
99
+
sharing, because most developers did not use the libraries. We
100
+
concluded that weaker conditions might promote sharing better.
101
+
102
+
However, unrestricted linking of non-free programs would deprive the
103
+
users of those programs of all benefit from the free status of the
104
+
libraries themselves. This Library General Public License is intended to
105
+
permit developers of non-free programs to use free libraries, while
106
+
preserving your freedom as a user of such programs to change the free
107
+
libraries that are incorporated in them. (We have not seen how to achieve
108
+
this as regards changes in header files, but we have achieved it as regards
109
+
changes in the actual functions of the Library.) The hope is that this
110
+
will lead to faster development of free libraries.
111
+
112
+
The precise terms and conditions for copying, distribution and
113
+
modification follow. Pay close attention to the difference between a
114
+
"work based on the library" and a "work that uses the library". The
115
+
former contains code derived from the library, while the latter only
116
+
works together with the library.
117
+
118
+
Note that it is possible for a library to be covered by the ordinary
119
+
General Public License rather than by this special one.
120
+
121
+
GNU LIBRARY GENERAL PUBLIC LICENSE
122
+
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
123
+
124
+
0. This License Agreement applies to any software library which
125
+
contains a notice placed by the copyright holder or other authorized
126
+
party saying it may be distributed under the terms of this Library
127
+
General Public License (also called "this License"). Each licensee is
128
+
addressed as "you".
129
+
130
+
A "library" means a collection of software functions and/or data
131
+
prepared so as to be conveniently linked with application programs
132
+
(which use some of those functions and data) to form executables.
133
+
134
+
The "Library", below, refers to any such software library or work
135
+
which has been distributed under these terms. A "work based on the
136
+
Library" means either the Library or any derivative work under
137
+
copyright law: that is to say, a work containing the Library or a
138
+
portion of it, either verbatim or with modifications and/or translated
139
+
straightforwardly into another language. (Hereinafter, translation is
140
+
included without limitation in the term "modification".)
141
+
142
+
"Source code" for a work means the preferred form of the work for
143
+
making modifications to it. For a library, complete source code means
144
+
all the source code for all modules it contains, plus any associated
145
+
interface definition files, plus the scripts used to control compilation
146
+
and installation of the library.
147
+
148
+
Activities other than copying, distribution and modification are not
149
+
covered by this License; they are outside its scope. The act of
150
+
running a program using the Library is not restricted, and output from
151
+
such a program is covered only if its contents constitute a work based
152
+
on the Library (independent of the use of the Library in a tool for
153
+
writing it). Whether that is true depends on what the Library does
154
+
and what the program that uses the Library does.
155
+
156
+
1. You may copy and distribute verbatim copies of the Library's
157
+
complete source code as you receive it, in any medium, provided that
158
+
you conspicuously and appropriately publish on each copy an
159
+
appropriate copyright notice and disclaimer of warranty; keep intact
160
+
all the notices that refer to this License and to the absence of any
161
+
warranty; and distribute a copy of this License along with the
162
+
Library.
163
+
164
+
You may charge a fee for the physical act of transferring a copy,
165
+
and you may at your option offer warranty protection in exchange for a
166
+
fee.
167
+
168
+
2. You may modify your copy or copies of the Library or any portion
169
+
of it, thus forming a work based on the Library, and copy and
170
+
distribute such modifications or work under the terms of Section 1
171
+
above, provided that you also meet all of these conditions:
172
+
173
+
a) The modified work must itself be a software library.
174
+
175
+
b) You must cause the files modified to carry prominent notices
176
+
stating that you changed the files and the date of any change.
177
+
178
+
c) You must cause the whole of the work to be licensed at no
179
+
charge to all third parties under the terms of this License.
180
+
181
+
d) If a facility in the modified Library refers to a function or a
182
+
table of data to be supplied by an application program that uses
183
+
the facility, other than as an argument passed when the facility
184
+
is invoked, then you must make a good faith effort to ensure that,
185
+
in the event an application does not supply such function or
186
+
table, the facility still operates, and performs whatever part of
187
+
its purpose remains meaningful.
188
+
189
+
(For example, a function in a library to compute square roots has
190
+
a purpose that is entirely well-defined independent of the
191
+
application. Therefore, Subsection 2d requires that any
192
+
application-supplied function or table used by this function must
193
+
be optional: if the application does not supply it, the square
194
+
root function must still compute square roots.)
195
+
196
+
These requirements apply to the modified work as a whole. If
197
+
identifiable sections of that work are not derived from the Library,
198
+
and can be reasonably considered independent and separate works in
199
+
themselves, then this License, and its terms, do not apply to those
200
+
sections when you distribute them as separate works. But when you
201
+
distribute the same sections as part of a whole which is a work based
202
+
on the Library, the distribution of the whole must be on the terms of
203
+
this License, whose permissions for other licensees extend to the
204
+
entire whole, and thus to each and every part regardless of who wrote
205
+
it.
206
+
207
+
Thus, it is not the intent of this section to claim rights or contest
208
+
your rights to work written entirely by you; rather, the intent is to
209
+
exercise the right to control the distribution of derivative or
210
+
collective works based on the Library.
211
+
212
+
In addition, mere aggregation of another work not based on the Library
213
+
with the Library (or with a work based on the Library) on a volume of
214
+
a storage or distribution medium does not bring the other work under
215
+
the scope of this License.
216
+
217
+
3. You may opt to apply the terms of the ordinary GNU General Public
218
+
License instead of this License to a given copy of the Library. To do
219
+
this, you must alter all the notices that refer to this License, so
220
+
that they refer to the ordinary GNU General Public License, version 2,
221
+
instead of to this License. (If a newer version than version 2 of the
222
+
ordinary GNU General Public License has appeared, then you can specify
223
+
that version instead if you wish.) Do not make any other change in
224
+
these notices.
225
+
226
+
Once this change is made in a given copy, it is irreversible for
227
+
that copy, so the ordinary GNU General Public License applies to all
228
+
subsequent copies and derivative works made from that copy.
229
+
230
+
This option is useful when you wish to copy part of the code of
231
+
the Library into a program that is not a library.
232
+
233
+
4. You may copy and distribute the Library (or a portion or
234
+
derivative of it, under Section 2) in object code or executable form
235
+
under the terms of Sections 1 and 2 above provided that you accompany
236
+
it with the complete corresponding machine-readable source code, which
237
+
must be distributed under the terms of Sections 1 and 2 above on a
238
+
medium customarily used for software interchange.
239
+
240
+
If distribution of object code is made by offering access to copy
241
+
from a designated place, then offering equivalent access to copy the
242
+
source code from the same place satisfies the requirement to
243
+
distribute the source code, even though third parties are not
244
+
compelled to copy the source along with the object code.
245
+
246
+
5. A program that contains no derivative of any portion of the
247
+
Library, but is designed to work with the Library by being compiled or
248
+
linked with it, is called a "work that uses the Library". Such a
249
+
work, in isolation, is not a derivative work of the Library, and
250
+
therefore falls outside the scope of this License.
251
+
252
+
However, linking a "work that uses the Library" with the Library
253
+
creates an executable that is a derivative of the Library (because it
254
+
contains portions of the Library), rather than a "work that uses the
255
+
library". The executable is therefore covered by this License.
256
+
Section 6 states terms for distribution of such executables.
257
+
258
+
When a "work that uses the Library" uses material from a header file
259
+
that is part of the Library, the object code for the work may be a
260
+
derivative work of the Library even though the source code is not.
261
+
Whether this is true is especially significant if the work can be
262
+
linked without the Library, or if the work is itself a library. The
263
+
threshold for this to be true is not precisely defined by law.
264
+
265
+
If such an object file uses only numerical parameters, data
266
+
structure layouts and accessors, and small macros and small inline
267
+
functions (ten lines or less in length), then the use of the object
268
+
file is unrestricted, regardless of whether it is legally a derivative
269
+
work. (Executables containing this object code plus portions of the
270
+
Library will still fall under Section 6.)
271
+
272
+
Otherwise, if the work is a derivative of the Library, you may
273
+
distribute the object code for the work under the terms of Section 6.
274
+
Any executables containing that work also fall under Section 6,
275
+
whether or not they are linked directly with the Library itself.
276
+
277
+
6. As an exception to the Sections above, you may also compile or
278
+
link a "work that uses the Library" with the Library to produce a
279
+
work containing portions of the Library, and distribute that work
280
+
under terms of your choice, provided that the terms permit
281
+
modification of the work for the customer's own use and reverse
282
+
engineering for debugging such modifications.
283
+
284
+
You must give prominent notice with each copy of the work that the
285
+
Library is used in it and that the Library and its use are covered by
286
+
this License. You must supply a copy of this License. If the work
287
+
during execution displays copyright notices, you must include the
288
+
copyright notice for the Library among them, as well as a reference
289
+
directing the user to the copy of this License. Also, you must do one
290
+
of these things:
291
+
292
+
a) Accompany the work with the complete corresponding
293
+
machine-readable source code for the Library including whatever
294
+
changes were used in the work (which must be distributed under
295
+
Sections 1 and 2 above); and, if the work is an executable linked
296
+
with the Library, with the complete machine-readable "work that
297
+
uses the Library", as object code and/or source code, so that the
298
+
user can modify the Library and then relink to produce a modified
299
+
executable containing the modified Library. (It is understood
300
+
that the user who changes the contents of definitions files in the
301
+
Library will not necessarily be able to recompile the application
302
+
to use the modified definitions.)
303
+
304
+
b) Accompany the work with a written offer, valid for at
305
+
least three years, to give the same user the materials
306
+
specified in Subsection 6a, above, for a charge no more
307
+
than the cost of performing this distribution.
308
+
309
+
c) If distribution of the work is made by offering access to copy
310
+
from a designated place, offer equivalent access to copy the above
311
+
specified materials from the same place.
312
+
313
+
d) Verify that the user has already received a copy of these
314
+
materials or that you have already sent this user a copy.
315
+
316
+
For an executable, the required form of the "work that uses the
317
+
Library" must include any data and utility programs needed for
318
+
reproducing the executable from it. However, as a special exception,
319
+
the source code distributed need not include anything that is normally
320
+
distributed (in either source or binary form) with the major
321
+
components (compiler, kernel, and so on) of the operating system on
322
+
which the executable runs, unless that component itself accompanies
323
+
the executable.
324
+
325
+
It may happen that this requirement contradicts the license
326
+
restrictions of other proprietary libraries that do not normally
327
+
accompany the operating system. Such a contradiction means you cannot
328
+
use both them and the Library together in an executable that you
329
+
distribute.
330
+
331
+
7. You may place library facilities that are a work based on the
332
+
Library side-by-side in a single library together with other library
333
+
facilities not covered by this License, and distribute such a combined
334
+
library, provided that the separate distribution of the work based on
335
+
the Library and of the other library facilities is otherwise
336
+
permitted, and provided that you do these two things:
337
+
338
+
a) Accompany the combined library with a copy of the same work
339
+
based on the Library, uncombined with any other library
340
+
facilities. This must be distributed under the terms of the
341
+
Sections above.
342
+
343
+
b) Give prominent notice with the combined library of the fact
344
+
that part of it is a work based on the Library, and explaining
345
+
where to find the accompanying uncombined form of the same work.
346
+
347
+
8. You may not copy, modify, sublicense, link with, or distribute
348
+
the Library except as expressly provided under this License. Any
349
+
attempt otherwise to copy, modify, sublicense, link with, or
350
+
distribute the Library is void, and will automatically terminate your
351
+
rights under this License. However, parties who have received copies,
352
+
or rights, from you under this License will not have their licenses
353
+
terminated so long as such parties remain in full compliance.
354
+
355
+
9. You are not required to accept this License, since you have not
356
+
signed it. However, nothing else grants you permission to modify or
357
+
distribute the Library or its derivative works. These actions are
358
+
prohibited by law if you do not accept this License. Therefore, by
359
+
modifying or distributing the Library (or any work based on the
360
+
Library), you indicate your acceptance of this License to do so, and
361
+
all its terms and conditions for copying, distributing or modifying
362
+
the Library or works based on it.
363
+
364
+
10. Each time you redistribute the Library (or any work based on the
365
+
Library), the recipient automatically receives a license from the
366
+
original licensor to copy, distribute, link with or modify the Library
367
+
subject to these terms and conditions. You may not impose any further
368
+
restrictions on the recipients' exercise of the rights granted herein.
369
+
You are not responsible for enforcing compliance by third parties to
370
+
this License.
371
+
372
+
11. If, as a consequence of a court judgment or allegation of patent
373
+
infringement or for any other reason (not limited to patent issues),
374
+
conditions are imposed on you (whether by court order, agreement or
375
+
otherwise) that contradict the conditions of this License, they do not
376
+
excuse you from the conditions of this License. If you cannot
377
+
distribute so as to satisfy simultaneously your obligations under this
378
+
License and any other pertinent obligations, then as a consequence you
379
+
may not distribute the Library at all. For example, if a patent
380
+
license would not permit royalty-free redistribution of the Library by
381
+
all those who receive copies directly or indirectly through you, then
382
+
the only way you could satisfy both it and this License would be to
383
+
refrain entirely from distribution of the Library.
384
+
385
+
If any portion of this section is held invalid or unenforceable under any
386
+
particular circumstance, the balance of the section is intended to apply,
387
+
and the section as a whole is intended to apply in other circumstances.
388
+
389
+
It is not the purpose of this section to induce you to infringe any
390
+
patents or other property right claims or to contest validity of any
391
+
such claims; this section has the sole purpose of protecting the
392
+
integrity of the free software distribution system which is
393
+
implemented by public license practices. Many people have made
394
+
generous contributions to the wide range of software distributed
395
+
through that system in reliance on consistent application of that
396
+
system; it is up to the author/donor to decide if he or she is willing
397
+
to distribute software through any other system and a licensee cannot
398
+
impose that choice.
399
+
400
+
This section is intended to make thoroughly clear what is believed to
401
+
be a consequence of the rest of this License.
402
+
403
+
12. If the distribution and/or use of the Library is restricted in
404
+
certain countries either by patents or by copyrighted interfaces, the
405
+
original copyright holder who places the Library under this License may add
406
+
an explicit geographical distribution limitation excluding those countries,
407
+
so that distribution is permitted only in or among countries not thus
408
+
excluded. In such case, this License incorporates the limitation as if
409
+
written in the body of this License.
410
+
411
+
13. The Free Software Foundation may publish revised and/or new
412
+
versions of the Library General Public License from time to time.
413
+
Such new versions will be similar in spirit to the present version,
414
+
but may differ in detail to address new problems or concerns.
415
+
416
+
Each version is given a distinguishing version number. If the Library
417
+
specifies a version number of this License which applies to it and
418
+
"any later version", you have the option of following the terms and
419
+
conditions either of that version or of any later version published by
420
+
the Free Software Foundation. If the Library does not specify a
421
+
license version number, you may choose any version ever published by
422
+
the Free Software Foundation.
423
+
424
+
14. If you wish to incorporate parts of the Library into other free
425
+
programs whose distribution conditions are incompatible with these,
426
+
write to the author to ask for permission. For software which is
427
+
copyrighted by the Free Software Foundation, write to the Free
428
+
Software Foundation; we sometimes make exceptions for this. Our
429
+
decision will be guided by the two goals of preserving the free status
430
+
of all derivatives of our free software and of promoting the sharing
431
+
and reuse of software generally.
432
+
433
+
NO WARRANTY
434
+
435
+
15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
436
+
WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
437
+
EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
438
+
OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
439
+
KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
440
+
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
441
+
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
442
+
LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
443
+
THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
444
+
445
+
16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
446
+
WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
447
+
AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
448
+
FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
449
+
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
450
+
LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
451
+
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
452
+
FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
453
+
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
454
+
DAMAGES.
455
+
456
+
END OF TERMS AND CONDITIONS
457
+
458
+
Appendix: How to Apply These Terms to Your New Libraries
459
+
460
+
If you develop a new library, and you want it to be of the greatest
461
+
possible use to the public, we recommend making it free software that
462
+
everyone can redistribute and change. You can do so by permitting
463
+
redistribution under these terms (or, alternatively, under the terms of the
464
+
ordinary General Public License).
465
+
466
+
To apply these terms, attach the following notices to the library. It is
467
+
safest to attach them to the start of each source file to most effectively
468
+
convey the exclusion of warranty; and each file should have at least the
469
+
"copyright" line and a pointer to where the full notice is found.
470
+
471
+
<one line to give the library's name and a brief idea of what it does.>
472
+
Copyright (C) <year> <name of author>
473
+
474
+
This library is free software; you can redistribute it and/or
475
+
modify it under the terms of the GNU Library General Public
476
+
License as published by the Free Software Foundation; either
477
+
version 2 of the License, or (at your option) any later version.
478
+
479
+
This library is distributed in the hope that it will be useful,
480
+
but WITHOUT ANY WARRANTY; without even the implied warranty of
481
+
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
482
+
Library General Public License for more details.
483
+
484
+
You should have received a copy of the GNU Library General Public
485
+
License along with this library; if not, write to the Free
486
+
Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
487
+
MA 02111-1307, USA
488
+
489
+
Also add information on how to contact you by electronic and paper mail.
490
+
491
+
You should also get your employer (if you work as a programmer) or your
492
+
school, if any, to sign a "copyright disclaimer" for the library, if
493
+
necessary. Here is a sample; alter the names:
494
+
495
+
Yoyodyne, Inc., hereby disclaims all copyright interest in the
496
+
library `Frob' (a library for tweaking knobs) written by James Random Hacker.
497
+
498
+
<signature of Ty Coon>, 1 April 1990
499
+
Ty Coon, President of Vice
500
+
501
+
That's all there is to it!
+18
vendor/opam/zarith/META
+18
vendor/opam/zarith/META
···
1
+
description = "Arbitrary precision integers"
2
+
requires = ""
3
+
version = "1.14"
4
+
archive(byte) = "zarith.cma"
5
+
archive(native) = "zarith.cmxa"
6
+
plugin(byte) = "zarith.cma"
7
+
plugin(native) = "zarith.cmxs"
8
+
9
+
package "top" (
10
+
version = "1.13"
11
+
description = "ZArith toplevel support"
12
+
requires = "zarith"
13
+
archive(byte) = "zarith_top.cma"
14
+
archive(native) = "zarith_top.cmxa"
15
+
plugin(byte) = "zarith_top.cma"
16
+
plugin(native) = "zarith_top.cmxs"
17
+
exists_if = "zarith_top.cma"
18
+
)
+143
vendor/opam/zarith/Makefile
+143
vendor/opam/zarith/Makefile
···
1
+
# This file is part of the Zarith library
2
+
# http://forge.ocamlcore.org/projects/zarith .
3
+
# It is distributed under LGPL 2 licensing, with static linking exception.
4
+
# See the LICENSE file included in the distribution.
5
+
#
6
+
# Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
7
+
# Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
8
+
# a joint laboratory by:
9
+
# CNRS (Centre national de la recherche scientifique, France),
10
+
# ENS (École normale supérieure, Paris, France),
11
+
# INRIA Rocquencourt (Institut national de recherche en informatique, France).
12
+
13
+
include Makefile.config
14
+
15
+
# project files
16
+
###############
17
+
18
+
CSRC = caml_z.c
19
+
MLSRC = zarith_version.ml z.ml q.ml big_int_Z.ml
20
+
MLISRC = z.mli q.mli big_int_Z.mli
21
+
22
+
AUTOGEN = zarith_version.ml
23
+
24
+
CMIOBJ = $(MLISRC:%.mli=%.cmi)
25
+
CMXOBJ = $(MLSRC:%.ml=%.cmx)
26
+
CMIDOC = $(MLISRC:%.mli=%.cmti)
27
+
28
+
TOBUILD = zarith.cma libzarith.$(LIBSUFFIX) $(CMIOBJ) zarith_top.cma z.mli
29
+
30
+
TOINSTALL = $(TOBUILD) zarith.h q.mli big_int_Z.mli
31
+
32
+
ifeq ($(HASOCAMLOPT),yes)
33
+
TOBUILD += zarith.cmxa $(CMXOBJ)
34
+
TOINSTALL += zarith.$(LIBSUFFIX)
35
+
endif
36
+
DEBUG = -g
37
+
OCAMLFLAGS += $(DEBUG) -I +compiler-libs
38
+
OCAMLOPTFLAGS += $(DEBUG) -I +compiler-libs
39
+
40
+
ifeq ($(HASDYNLINK),yes)
41
+
TOBUILD += zarith.cmxs
42
+
endif
43
+
44
+
ifeq ($(HASBINANNOT),yes)
45
+
TOINSTALL += $(CMIDOC)
46
+
OCAMLFLAGS += -bin-annot
47
+
endif
48
+
49
+
# build targets
50
+
###############
51
+
52
+
all: $(TOBUILD)
53
+
54
+
tests:
55
+
make -C tests test
56
+
57
+
zarith.cma: $(MLSRC:%.ml=%.cmo)
58
+
$(OCAMLMKLIB) $(DEBUG) -failsafe -o zarith $+ $(LIBS) $(LDFLAGS)
59
+
60
+
zarith.cmxa: $(MLSRC:%.ml=%.cmx)
61
+
$(OCAMLMKLIB) $(DEBUG) -failsafe -o zarith $+ $(LIBS) $(LDFLAGS)
62
+
63
+
zarith.cmxs: zarith.cmxa libzarith.$(LIBSUFFIX)
64
+
$(OCAMLOPT) -shared -o $@ -I . zarith.cmxa -linkall
65
+
66
+
libzarith.$(LIBSUFFIX): $(CSRC:%.c=%.$(OBJSUFFIX))
67
+
$(OCAMLMKLIB) $(DEBUG) -failsafe -o zarith $+ $(LIBS) $(LDFLAGS)
68
+
69
+
zarith_top.cma: zarith_top.cmo
70
+
$(OCAMLC) $(DEBUG) -o $@ -a $<
71
+
72
+
doc: $(MLISRC)
73
+
ifneq ($(OCAMLDOC),)
74
+
mkdir -p html
75
+
$(OCAMLDOC) -html -d html -charset utf8 $+
76
+
else
77
+
$(error ocamldoc is required to build the documentation)
78
+
endif
79
+
80
+
zarith_version.ml: META
81
+
(echo "let"; grep "version" META | head -1) > zarith_version.ml
82
+
83
+
# install targets
84
+
#################
85
+
86
+
ifeq ($(INSTMETH),install)
87
+
install:
88
+
install -d $(INSTALLDIR) $(INSTALLDIR)/zarith $(INSTALLDIR)/stublibs
89
+
for i in $(TOINSTALL); do \
90
+
if test -f $$i; then $(INSTALL) -m 0644 $$i $(INSTALLDIR)/zarith/$$i; fi; \
91
+
done
92
+
if test -f dllzarith.$(DLLSUFFIX); then $(INSTALL) -m 0755 dllzarith.$(DLLSUFFIX) $(INSTALLDIR)/stublibs/dllzarith.$(DLLSUFFIX); fi
93
+
94
+
uninstall:
95
+
for i in $(TOINSTALL); do \
96
+
rm -f $(INSTALLDIR)/zarith/$$i; \
97
+
done
98
+
if test -f $(INSTALLDIR)/stublibs/dllzarith.$(DLLSUFFIX); then rm -f $(INSTALLDIR)/stublibs/dllzarith.$(DLLSUFFIX); fi
99
+
endif
100
+
101
+
ifeq ($(INSTMETH),findlib)
102
+
install:
103
+
$(OCAMLFIND) install -destdir "$(INSTALLDIR)" zarith META $(TOINSTALL) -optional dllzarith.$(DLLSUFFIX)
104
+
105
+
uninstall:
106
+
$(OCAMLFIND) remove -destdir "$(INSTALLDIR)" zarith
107
+
endif
108
+
109
+
110
+
# rules
111
+
#######
112
+
113
+
%.cmi: %.mli
114
+
$(OCAMLC) $(OCAMLFLAGS) $(OCAMLINC) -c $<
115
+
116
+
%.cmo: %.ml %.cmi
117
+
$(OCAMLC) $(OCAMLFLAGS) $(OCAMLINC) -c $<
118
+
119
+
%.cmx: %.ml %.cmi
120
+
$(OCAMLOPT) $(OCAMLOPTFLAGS) $(OCAMLINC) -c $<
121
+
122
+
%.cmo: %.ml
123
+
$(OCAMLC) $(OCAMLFLAGS) $(OCAMLINC) -c $<
124
+
125
+
%.cmx: %.ml
126
+
$(OCAMLOPT) $(OCAMLOPTFLAGS) $(OCAMLINC) -c $<
127
+
128
+
%.$(OBJSUFFIX): %.c
129
+
$(OCAMLC) -ccopt "$(CFLAGS)" -c $<
130
+
131
+
clean:
132
+
/bin/rm -rf *.o *.obj *.lib *.a *.cmi *.cmo *.cmx *.cmxa *.cmxs *.cma *.cmt *.cmti *~ \#* depend test $(AUTOGEN) tmp.c depend
133
+
make -C tests clean
134
+
135
+
depend: $(AUTOGEN)
136
+
$(OCAMLDEP) $(OCAMLINC) $(MLSRC) $(MLISRC) > depend
137
+
138
+
include depend
139
+
140
+
$(CSRC:%.c=%.$(OBJSUFFIX)): zarith.h
141
+
142
+
.PHONY: clean
143
+
.PHONY: tests
+129
vendor/opam/zarith/README.md
+129
vendor/opam/zarith/README.md
···
1
+
# The Zarith library
2
+
3
+
## OVERVIEW
4
+
5
+
This library implements arithmetic and logical operations over
6
+
arbitrary-precision integers.
7
+
8
+
The module is simply named `Z`. Its interface is similar to that of
9
+
the `Int32`, `Int64` and `Nativeint` modules from the OCaml standard
10
+
library, with some additional functions. See the file `z.mli` for
11
+
documentation.
12
+
13
+
The implementation uses GMP (the GNU Multiple Precision arithmetic
14
+
library) to compute over big integers.
15
+
However, small integers are represented as unboxed Caml integers, to save
16
+
space and improve performance. Big integers are allocated in the Caml heap,
17
+
bypassing GMP's memory management and achieving better GC behavior than e.g.
18
+
the MLGMP library.
19
+
Computations on small integers use a special, faster path (in C or OCaml)
20
+
eschewing calls to GMP, while computations on large integers use the
21
+
low-level MPN functions from GMP.
22
+
23
+
Arbitrary-precision integers can be compared correctly using OCaml's
24
+
polymorphic comparison operators (`=`, `<`, `>`, etc.).
25
+
26
+
Additional features include:
27
+
* a module `Q` for rationals, built on top of `Z` (see `q.mli`)
28
+
* a compatibility layer `Big_int_Z` that implements the same API as Big_int from the legacy `Num` library, but uses `Z` internally
29
+
30
+
Support for [js_of_ocaml](https://github.com/ocsigen/js_of_ocaml/) is
31
+
provided by [Zarith_stubs_js](https://github.com/janestreet/zarith_stubs_js).
32
+
33
+
## REQUIREMENTS
34
+
35
+
* OCaml, version 4.04.0 or later.
36
+
* Either the GMP library or the MPIR library, including development files.
37
+
* GCC or Clang or a gcc-compatible C compiler and assembler (other compilers may work).
38
+
* The Findlib package manager (optional, recommended).
39
+
40
+
41
+
## INSTALLATION
42
+
43
+
1) First, run the "configure" script by typing:
44
+
```
45
+
./configure
46
+
```
47
+
The `configure` script has a few options. Use the `-help` option to get a
48
+
list and short description of each option.
49
+
50
+
2) It creates a Makefile, which can be invoked by:
51
+
```
52
+
make
53
+
```
54
+
This builds native and bytecode versions of the library.
55
+
56
+
3) The libraries are installed by typing:
57
+
```
58
+
make install
59
+
```
60
+
or, if you install to a system location but are not an administrator
61
+
```
62
+
sudo make install
63
+
```
64
+
If Findlib is detected, it is used to install files.
65
+
Otherwise, the files are copied to a `zarith/` subdirectory of the directory
66
+
given by `ocamlc -where`.
67
+
68
+
The libraries are named `zarith.cmxa` and `zarith.cma`, and the Findlib module
69
+
is named `zarith`.
70
+
71
+
Compiling and linking with the library requires passing the `-I +zarith`
72
+
option to `ocamlc` / `ocamlopt`, or the `-package zarith` option to `ocamlfind`.
73
+
74
+
4) (optional, recommended) Test programs are built and run by the additional command
75
+
```
76
+
make tests
77
+
```
78
+
(but these are not installed).
79
+
80
+
5) (optional) HTML API documentation is built (using `ocamldoc`) by the additional command
81
+
```
82
+
make doc
83
+
```
84
+
85
+
## ONLINE DOCUMENTATION
86
+
87
+
The documentation for the latest release is hosted on [GitHub Pages](https://antoinemine.github.io/Zarith/doc/latest/index.html).
88
+
89
+
90
+
## LICENSE
91
+
92
+
This Library is distributed under the terms of the GNU Library General
93
+
Public License version 2, with a special exception allowing unconstrained
94
+
static linking.
95
+
See LICENSE file for details.
96
+
97
+
98
+
## AUTHORS
99
+
100
+
* Antoine Miné, Sorbonne Université, formerly at ENS Paris.
101
+
* Xavier Leroy, Collège de France, formerly at Inria Paris.
102
+
* Pascal Cuoq, TrustInSoft.
103
+
* Christophe Troestler (toplevel module)
104
+
105
+
106
+
## COPYRIGHT
107
+
108
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
109
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
110
+
a joint laboratory by:
111
+
CNRS (Centre national de la recherche scientifique, France),
112
+
ENS (École normale supérieure, Paris, France),
113
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
114
+
115
+
116
+
## CONTENTS
117
+
118
+
Source files | Description
119
+
--------------------|-----------------------------------------
120
+
configure | configuration script
121
+
z.ml[i] | Z module and implementation for small integers
122
+
caml_z.c | C implementation
123
+
big_int_z.ml[i] | wrapper to provide a Big_int compatible API to Z
124
+
q.ml[i] | rational library, pure OCaml on top of Z
125
+
zarith_top.ml | toplevel module to provide pretty-printing
126
+
projet.mak | builds Z, Q and the tests
127
+
zarith.opam | package description for opam
128
+
z_mlgmpidl.ml[i] | conversion between Zarith and MLGMPIDL
129
+
tests/ | simple regression tests and benchmarks
vendor/opam/zarith/_build/.db
vendor/opam/zarith/_build/.db
This is a binary file and will not be displayed.
vendor/opam/zarith/_build/.digest-db
vendor/opam/zarith/_build/.digest-db
This is a binary file and will not be displayed.
+1
vendor/opam/zarith/_build/.filesystem-clock
+1
vendor/opam/zarith/_build/.filesystem-clock
···
1
+
<dummy>
vendor/opam/zarith/_build/.lock
vendor/opam/zarith/_build/.lock
This is a binary file and will not be displayed.
+2
vendor/opam/zarith/_build/default/.dune/configurator
+2
vendor/opam/zarith/_build/default/.dune/configurator
···
1
+
(ocamlc /home/node/.opam/default/bin/ocamlc.opt)
2
+
(ocaml_config_vars (afl_instrument false) (align_double false) (align_int64 false) (architecture amd64) (asm as) (asm_cfi_supported true) (asm_size_type_directives true) (ast_impl_magic_number Caml1999M036) (ast_intf_magic_number Caml1999N036) (bytecode_cflags "-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread ") (bytecode_cppflags " -D_FILE_OFFSET_BITS=64 ") (bytecomp_c_compiler "gcc -O2 -fno-strict-aliasing -fwrapv -fPIC -pthread -D_FILE_OFFSET_BITS=64 ") (bytecomp_c_libraries "-lzstd -lm -lpthread") (c_compiler gcc) (ccomp_type cc) (cma_magic_number Caml1999A036) (cmi_magic_number Caml1999I036) (cmo_magic_number Caml1999O036) (cmt_magic_number Caml1999T036) (cmx_magic_number Caml1999Y036) (cmxa_magic_number Caml1999Z036) (cmxs_magic_number Caml1999D036) (compression_c_libraries "-lzstd ") (default_executable_name a.out) (default_safe_string true) (exec_magic_number Caml1999X036) (ext_asm .s) (ext_dll .so) (ext_exe "") (ext_lib .a) (ext_obj .o) (flambda false) (flat_float_array true) (function_sections true) (host x86_64-pc-linux-gnu) (int_size 63) (linear_magic_number Caml1999L036) (model default) (naked_pointers false) (native_c_compiler "gcc -O2 -fno-strict-aliasing -fwrapv -fPIC -pthread -D_FILE_OFFSET_BITS=64 ") (native_c_libraries " -lm -lpthread") (native_cflags "-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread ") (native_compiler true) (native_cppflags " -D_FILE_OFFSET_BITS=64 ") (native_dynlink true) (native_ldflags "") (native_pack_linker "ld -r -o ") (ocamlc_cflags "-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread ") (ocamlc_cppflags " -D_FILE_OFFSET_BITS=64 ") (ocamlopt_cflags "-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread ") (ocamlopt_cppflags " -D_FILE_OFFSET_BITS=64 ") (os_type Unix) (safe_string true) (standard_library /home/node/.opam/default/lib/ocaml) (standard_library_default /home/node/.opam/default/lib/ocaml) (supports_shared_libraries true) (system linux) (systhread_supported true) (target x86_64-pc-linux-gnu) (tsan false) (version 5.4.0) (windows_unicode false) (with_codegen_invariants true) (with_frame_pointers false) (with_nonexecstack_note true) (word_size 64))
+1
vendor/opam/zarith/_build/default/.dune/configurator.v2
+1
vendor/opam/zarith/_build/default/.dune/configurator.v2
···
1
+
((6:ocamlc39:/home/node/.opam/default/bin/ocamlc.opt)(17:ocaml_config_vars((14:afl_instrument5:false)(12:align_double5:false)(11:align_int645:false)(12:architecture5:amd64)(3:asm2:as)(17:asm_cfi_supported4:true)(24:asm_size_type_directives4:true)(21:ast_impl_magic_number12:Caml1999M036)(21:ast_intf_magic_number12:Caml1999N036)(15:bytecode_cflags49:-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread )(17:bytecode_cppflags24: -D_FILE_OFFSET_BITS=64 )(19:bytecomp_c_compiler78:gcc -O2 -fno-strict-aliasing -fwrapv -fPIC -pthread -D_FILE_OFFSET_BITS=64 )(20:bytecomp_c_libraries23:-lzstd -lm -lpthread)(10:c_compiler3:gcc)(10:ccomp_type2:cc)(16:cma_magic_number12:Caml1999A036)(16:cmi_magic_number12:Caml1999I036)(16:cmo_magic_number12:Caml1999O036)(16:cmt_magic_number12:Caml1999T036)(16:cmx_magic_number12:Caml1999Y036)(17:cmxa_magic_number12:Caml1999Z036)(17:cmxs_magic_number12:Caml1999D036)(23:compression_c_libraries7:-lzstd )(23:default_executable_name5:a.out)(19:default_safe_string4:true)(17:exec_magic_number12:Caml1999X036)(7:ext_asm2:.s)(7:ext_dll3:.so)(7:ext_exe0:)(7:ext_lib2:.a)(7:ext_obj2:.o)(7:flambda5:false)(16:flat_float_array4:true)(17:function_sections4:true)(4:host19:x86_64-pc-linux-gnu)(8:int_size2:63)(19:linear_magic_number12:Caml1999L036)(5:model7:default)(14:naked_pointers5:false)(17:native_c_compiler78:gcc -O2 -fno-strict-aliasing -fwrapv -fPIC -pthread -D_FILE_OFFSET_BITS=64 )(18:native_c_libraries15: -lm -lpthread)(13:native_cflags49:-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread )(15:native_compiler4:true)(15:native_cppflags24: -D_FILE_OFFSET_BITS=64 )(14:native_dynlink4:true)(14:native_ldflags0:)(18:native_pack_linker9:ld -r -o )(13:ocamlc_cflags49:-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread )(15:ocamlc_cppflags24: -D_FILE_OFFSET_BITS=64 )(15:ocamlopt_cflags49:-O2 -fno-strict-aliasing -fwrapv -fPIC -pthread )(17:ocamlopt_cppflags24: -D_FILE_OFFSET_BITS=64 )(7:os_type4:Unix)(11:safe_string4:true)(16:standard_library34:/home/node/.opam/default/lib/ocaml)(24:standard_library_default34:/home/node/.opam/default/lib/ocaml)(25:supports_shared_libraries4:true)(6:system5:linux)(19:systhread_supported4:true)(6:target19:x86_64-pc-linux-gnu)(4:tsan5:false)(7:version5:5.4.0)(15:windows_unicode5:false)(23:with_codegen_invariants4:true)(19:with_frame_pointers5:false)(22:with_nonexecstack_note4:true)(9:word_size2:64))))
vendor/opam/zarith/_build/default/.merlin-conf/lib-zarith
vendor/opam/zarith/_build/default/.merlin-conf/lib-zarith
This is a binary file and will not be displayed.
vendor/opam/zarith/_build/default/.merlin-conf/lib-zarith.top
vendor/opam/zarith/_build/default/.merlin-conf/lib-zarith.top
This is a binary file and will not be displayed.
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Big_int_Z.impl.all-deps
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Big_int_Z.impl.all-deps
···
1
+
zarith__Z
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Big_int_Z.impl.d
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Big_int_Z.impl.d
···
1
+
big_int_Z.ml: Z
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Big_int_Z.intf.all-deps
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Big_int_Z.intf.all-deps
···
1
+
zarith__Z
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Big_int_Z.intf.d
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Big_int_Z.intf.d
···
1
+
big_int_Z.mli: Z
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Q.impl.all-deps
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Q.impl.all-deps
···
1
+
zarith__Z
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Q.impl.d
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Q.impl.d
···
1
+
q.ml: Buffer Format Int64 String Z
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Q.intf.all-deps
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Q.intf.all-deps
···
1
+
zarith__Z
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Q.intf.d
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Q.intf.d
···
1
+
q.mli: Buffer Format Z
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Z.impl.all-deps
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Z.impl.all-deps
···
1
+
zarith__Zarith_version
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Z.impl.d
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Z.impl.d
···
1
+
z.ml: Buffer Bytes Callback Format Int64 Nativeint Obj Random Stdlib String Sys Zarith_version
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Z.intf.all-deps
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Z.intf.all-deps
This is a binary file and will not be displayed.
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Z.intf.d
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Z.intf.d
···
1
+
z.mli: Buffer Format Random
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Zarith_version.impl.all-deps
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Zarith_version.impl.all-deps
This is a binary file and will not be displayed.
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Zarith_version.impl.d
+1
vendor/opam/zarith/_build/default/.zarith.objs/zarith__Zarith_version.impl.d
···
1
+
zarith_version.ml:
+501
vendor/opam/zarith/_build/default/LICENSE
+501
vendor/opam/zarith/_build/default/LICENSE
···
1
+
This Library is distributed under the terms of the GNU Library General
2
+
Public License version 2 (included below).
3
+
4
+
As a special exception to the GNU Library General Public License, you
5
+
may link, statically or dynamically, a "work that uses the Library"
6
+
with a publicly distributed version of the Library to produce an
7
+
executable file containing portions of the Library, and distribute
8
+
that executable file under terms of your choice, without any of the
9
+
additional requirements listed in clause 6 of the GNU Library General
10
+
Public License. By "a publicly distributed version of the Library",
11
+
we mean either the unmodified Library as distributed by INRIA, or a
12
+
modified version of the Library that is distributed under the
13
+
conditions defined in clause 3 of the GNU Library General Public
14
+
License. This exception does not however invalidate any other reasons
15
+
why the executable file might be covered by the GNU Library General
16
+
Public License.
17
+
18
+
----------------------------------------------------------------------
19
+
20
+
GNU LIBRARY GENERAL PUBLIC LICENSE
21
+
Version 2, June 1991
22
+
23
+
Copyright (C) 1991 Free Software Foundation, Inc.
24
+
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
25
+
Everyone is permitted to copy and distribute verbatim copies
26
+
of this license document, but changing it is not allowed.
27
+
28
+
[This is the first released version of the library GPL. It is
29
+
numbered 2 because it goes with version 2 of the ordinary GPL.]
30
+
31
+
Preamble
32
+
33
+
The licenses for most software are designed to take away your
34
+
freedom to share and change it. By contrast, the GNU General Public
35
+
Licenses are intended to guarantee your freedom to share and change
36
+
free software--to make sure the software is free for all its users.
37
+
38
+
This license, the Library General Public License, applies to some
39
+
specially designated Free Software Foundation software, and to any
40
+
other libraries whose authors decide to use it. You can use it for
41
+
your libraries, too.
42
+
43
+
When we speak of free software, we are referring to freedom, not
44
+
price. Our General Public Licenses are designed to make sure that you
45
+
have the freedom to distribute copies of free software (and charge for
46
+
this service if you wish), that you receive source code or can get it
47
+
if you want it, that you can change the software or use pieces of it
48
+
in new free programs; and that you know you can do these things.
49
+
50
+
To protect your rights, we need to make restrictions that forbid
51
+
anyone to deny you these rights or to ask you to surrender the rights.
52
+
These restrictions translate to certain responsibilities for you if
53
+
you distribute copies of the library, or if you modify it.
54
+
55
+
For example, if you distribute copies of the library, whether gratis
56
+
or for a fee, you must give the recipients all the rights that we gave
57
+
you. You must make sure that they, too, receive or can get the source
58
+
code. If you link a program with the library, you must provide
59
+
complete object files to the recipients so that they can relink them
60
+
with the library, after making changes to the library and recompiling
61
+
it. And you must show them these terms so they know their rights.
62
+
63
+
Our method of protecting your rights has two steps: (1) copyright
64
+
the library, and (2) offer you this license which gives you legal
65
+
permission to copy, distribute and/or modify the library.
66
+
67
+
Also, for each distributor's protection, we want to make certain
68
+
that everyone understands that there is no warranty for this free
69
+
library. If the library is modified by someone else and passed on, we
70
+
want its recipients to know that what they have is not the original
71
+
version, so that any problems introduced by others will not reflect on
72
+
the original authors' reputations.
73
+
74
+
Finally, any free program is threatened constantly by software
75
+
patents. We wish to avoid the danger that companies distributing free
76
+
software will individually obtain patent licenses, thus in effect
77
+
transforming the program into proprietary software. To prevent this,
78
+
we have made it clear that any patent must be licensed for everyone's
79
+
free use or not licensed at all.
80
+
81
+
Most GNU software, including some libraries, is covered by the ordinary
82
+
GNU General Public License, which was designed for utility programs. This
83
+
license, the GNU Library General Public License, applies to certain
84
+
designated libraries. This license is quite different from the ordinary
85
+
one; be sure to read it in full, and don't assume that anything in it is
86
+
the same as in the ordinary license.
87
+
88
+
The reason we have a separate public license for some libraries is that
89
+
they blur the distinction we usually make between modifying or adding to a
90
+
program and simply using it. Linking a program with a library, without
91
+
changing the library, is in some sense simply using the library, and is
92
+
analogous to running a utility program or application program. However, in
93
+
a textual and legal sense, the linked executable is a combined work, a
94
+
derivative of the original library, and the ordinary General Public License
95
+
treats it as such.
96
+
97
+
Because of this blurred distinction, using the ordinary General
98
+
Public License for libraries did not effectively promote software
99
+
sharing, because most developers did not use the libraries. We
100
+
concluded that weaker conditions might promote sharing better.
101
+
102
+
However, unrestricted linking of non-free programs would deprive the
103
+
users of those programs of all benefit from the free status of the
104
+
libraries themselves. This Library General Public License is intended to
105
+
permit developers of non-free programs to use free libraries, while
106
+
preserving your freedom as a user of such programs to change the free
107
+
libraries that are incorporated in them. (We have not seen how to achieve
108
+
this as regards changes in header files, but we have achieved it as regards
109
+
changes in the actual functions of the Library.) The hope is that this
110
+
will lead to faster development of free libraries.
111
+
112
+
The precise terms and conditions for copying, distribution and
113
+
modification follow. Pay close attention to the difference between a
114
+
"work based on the library" and a "work that uses the library". The
115
+
former contains code derived from the library, while the latter only
116
+
works together with the library.
117
+
118
+
Note that it is possible for a library to be covered by the ordinary
119
+
General Public License rather than by this special one.
120
+
121
+
GNU LIBRARY GENERAL PUBLIC LICENSE
122
+
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
123
+
124
+
0. This License Agreement applies to any software library which
125
+
contains a notice placed by the copyright holder or other authorized
126
+
party saying it may be distributed under the terms of this Library
127
+
General Public License (also called "this License"). Each licensee is
128
+
addressed as "you".
129
+
130
+
A "library" means a collection of software functions and/or data
131
+
prepared so as to be conveniently linked with application programs
132
+
(which use some of those functions and data) to form executables.
133
+
134
+
The "Library", below, refers to any such software library or work
135
+
which has been distributed under these terms. A "work based on the
136
+
Library" means either the Library or any derivative work under
137
+
copyright law: that is to say, a work containing the Library or a
138
+
portion of it, either verbatim or with modifications and/or translated
139
+
straightforwardly into another language. (Hereinafter, translation is
140
+
included without limitation in the term "modification".)
141
+
142
+
"Source code" for a work means the preferred form of the work for
143
+
making modifications to it. For a library, complete source code means
144
+
all the source code for all modules it contains, plus any associated
145
+
interface definition files, plus the scripts used to control compilation
146
+
and installation of the library.
147
+
148
+
Activities other than copying, distribution and modification are not
149
+
covered by this License; they are outside its scope. The act of
150
+
running a program using the Library is not restricted, and output from
151
+
such a program is covered only if its contents constitute a work based
152
+
on the Library (independent of the use of the Library in a tool for
153
+
writing it). Whether that is true depends on what the Library does
154
+
and what the program that uses the Library does.
155
+
156
+
1. You may copy and distribute verbatim copies of the Library's
157
+
complete source code as you receive it, in any medium, provided that
158
+
you conspicuously and appropriately publish on each copy an
159
+
appropriate copyright notice and disclaimer of warranty; keep intact
160
+
all the notices that refer to this License and to the absence of any
161
+
warranty; and distribute a copy of this License along with the
162
+
Library.
163
+
164
+
You may charge a fee for the physical act of transferring a copy,
165
+
and you may at your option offer warranty protection in exchange for a
166
+
fee.
167
+
168
+
2. You may modify your copy or copies of the Library or any portion
169
+
of it, thus forming a work based on the Library, and copy and
170
+
distribute such modifications or work under the terms of Section 1
171
+
above, provided that you also meet all of these conditions:
172
+
173
+
a) The modified work must itself be a software library.
174
+
175
+
b) You must cause the files modified to carry prominent notices
176
+
stating that you changed the files and the date of any change.
177
+
178
+
c) You must cause the whole of the work to be licensed at no
179
+
charge to all third parties under the terms of this License.
180
+
181
+
d) If a facility in the modified Library refers to a function or a
182
+
table of data to be supplied by an application program that uses
183
+
the facility, other than as an argument passed when the facility
184
+
is invoked, then you must make a good faith effort to ensure that,
185
+
in the event an application does not supply such function or
186
+
table, the facility still operates, and performs whatever part of
187
+
its purpose remains meaningful.
188
+
189
+
(For example, a function in a library to compute square roots has
190
+
a purpose that is entirely well-defined independent of the
191
+
application. Therefore, Subsection 2d requires that any
192
+
application-supplied function or table used by this function must
193
+
be optional: if the application does not supply it, the square
194
+
root function must still compute square roots.)
195
+
196
+
These requirements apply to the modified work as a whole. If
197
+
identifiable sections of that work are not derived from the Library,
198
+
and can be reasonably considered independent and separate works in
199
+
themselves, then this License, and its terms, do not apply to those
200
+
sections when you distribute them as separate works. But when you
201
+
distribute the same sections as part of a whole which is a work based
202
+
on the Library, the distribution of the whole must be on the terms of
203
+
this License, whose permissions for other licensees extend to the
204
+
entire whole, and thus to each and every part regardless of who wrote
205
+
it.
206
+
207
+
Thus, it is not the intent of this section to claim rights or contest
208
+
your rights to work written entirely by you; rather, the intent is to
209
+
exercise the right to control the distribution of derivative or
210
+
collective works based on the Library.
211
+
212
+
In addition, mere aggregation of another work not based on the Library
213
+
with the Library (or with a work based on the Library) on a volume of
214
+
a storage or distribution medium does not bring the other work under
215
+
the scope of this License.
216
+
217
+
3. You may opt to apply the terms of the ordinary GNU General Public
218
+
License instead of this License to a given copy of the Library. To do
219
+
this, you must alter all the notices that refer to this License, so
220
+
that they refer to the ordinary GNU General Public License, version 2,
221
+
instead of to this License. (If a newer version than version 2 of the
222
+
ordinary GNU General Public License has appeared, then you can specify
223
+
that version instead if you wish.) Do not make any other change in
224
+
these notices.
225
+
226
+
Once this change is made in a given copy, it is irreversible for
227
+
that copy, so the ordinary GNU General Public License applies to all
228
+
subsequent copies and derivative works made from that copy.
229
+
230
+
This option is useful when you wish to copy part of the code of
231
+
the Library into a program that is not a library.
232
+
233
+
4. You may copy and distribute the Library (or a portion or
234
+
derivative of it, under Section 2) in object code or executable form
235
+
under the terms of Sections 1 and 2 above provided that you accompany
236
+
it with the complete corresponding machine-readable source code, which
237
+
must be distributed under the terms of Sections 1 and 2 above on a
238
+
medium customarily used for software interchange.
239
+
240
+
If distribution of object code is made by offering access to copy
241
+
from a designated place, then offering equivalent access to copy the
242
+
source code from the same place satisfies the requirement to
243
+
distribute the source code, even though third parties are not
244
+
compelled to copy the source along with the object code.
245
+
246
+
5. A program that contains no derivative of any portion of the
247
+
Library, but is designed to work with the Library by being compiled or
248
+
linked with it, is called a "work that uses the Library". Such a
249
+
work, in isolation, is not a derivative work of the Library, and
250
+
therefore falls outside the scope of this License.
251
+
252
+
However, linking a "work that uses the Library" with the Library
253
+
creates an executable that is a derivative of the Library (because it
254
+
contains portions of the Library), rather than a "work that uses the
255
+
library". The executable is therefore covered by this License.
256
+
Section 6 states terms for distribution of such executables.
257
+
258
+
When a "work that uses the Library" uses material from a header file
259
+
that is part of the Library, the object code for the work may be a
260
+
derivative work of the Library even though the source code is not.
261
+
Whether this is true is especially significant if the work can be
262
+
linked without the Library, or if the work is itself a library. The
263
+
threshold for this to be true is not precisely defined by law.
264
+
265
+
If such an object file uses only numerical parameters, data
266
+
structure layouts and accessors, and small macros and small inline
267
+
functions (ten lines or less in length), then the use of the object
268
+
file is unrestricted, regardless of whether it is legally a derivative
269
+
work. (Executables containing this object code plus portions of the
270
+
Library will still fall under Section 6.)
271
+
272
+
Otherwise, if the work is a derivative of the Library, you may
273
+
distribute the object code for the work under the terms of Section 6.
274
+
Any executables containing that work also fall under Section 6,
275
+
whether or not they are linked directly with the Library itself.
276
+
277
+
6. As an exception to the Sections above, you may also compile or
278
+
link a "work that uses the Library" with the Library to produce a
279
+
work containing portions of the Library, and distribute that work
280
+
under terms of your choice, provided that the terms permit
281
+
modification of the work for the customer's own use and reverse
282
+
engineering for debugging such modifications.
283
+
284
+
You must give prominent notice with each copy of the work that the
285
+
Library is used in it and that the Library and its use are covered by
286
+
this License. You must supply a copy of this License. If the work
287
+
during execution displays copyright notices, you must include the
288
+
copyright notice for the Library among them, as well as a reference
289
+
directing the user to the copy of this License. Also, you must do one
290
+
of these things:
291
+
292
+
a) Accompany the work with the complete corresponding
293
+
machine-readable source code for the Library including whatever
294
+
changes were used in the work (which must be distributed under
295
+
Sections 1 and 2 above); and, if the work is an executable linked
296
+
with the Library, with the complete machine-readable "work that
297
+
uses the Library", as object code and/or source code, so that the
298
+
user can modify the Library and then relink to produce a modified
299
+
executable containing the modified Library. (It is understood
300
+
that the user who changes the contents of definitions files in the
301
+
Library will not necessarily be able to recompile the application
302
+
to use the modified definitions.)
303
+
304
+
b) Accompany the work with a written offer, valid for at
305
+
least three years, to give the same user the materials
306
+
specified in Subsection 6a, above, for a charge no more
307
+
than the cost of performing this distribution.
308
+
309
+
c) If distribution of the work is made by offering access to copy
310
+
from a designated place, offer equivalent access to copy the above
311
+
specified materials from the same place.
312
+
313
+
d) Verify that the user has already received a copy of these
314
+
materials or that you have already sent this user a copy.
315
+
316
+
For an executable, the required form of the "work that uses the
317
+
Library" must include any data and utility programs needed for
318
+
reproducing the executable from it. However, as a special exception,
319
+
the source code distributed need not include anything that is normally
320
+
distributed (in either source or binary form) with the major
321
+
components (compiler, kernel, and so on) of the operating system on
322
+
which the executable runs, unless that component itself accompanies
323
+
the executable.
324
+
325
+
It may happen that this requirement contradicts the license
326
+
restrictions of other proprietary libraries that do not normally
327
+
accompany the operating system. Such a contradiction means you cannot
328
+
use both them and the Library together in an executable that you
329
+
distribute.
330
+
331
+
7. You may place library facilities that are a work based on the
332
+
Library side-by-side in a single library together with other library
333
+
facilities not covered by this License, and distribute such a combined
334
+
library, provided that the separate distribution of the work based on
335
+
the Library and of the other library facilities is otherwise
336
+
permitted, and provided that you do these two things:
337
+
338
+
a) Accompany the combined library with a copy of the same work
339
+
based on the Library, uncombined with any other library
340
+
facilities. This must be distributed under the terms of the
341
+
Sections above.
342
+
343
+
b) Give prominent notice with the combined library of the fact
344
+
that part of it is a work based on the Library, and explaining
345
+
where to find the accompanying uncombined form of the same work.
346
+
347
+
8. You may not copy, modify, sublicense, link with, or distribute
348
+
the Library except as expressly provided under this License. Any
349
+
attempt otherwise to copy, modify, sublicense, link with, or
350
+
distribute the Library is void, and will automatically terminate your
351
+
rights under this License. However, parties who have received copies,
352
+
or rights, from you under this License will not have their licenses
353
+
terminated so long as such parties remain in full compliance.
354
+
355
+
9. You are not required to accept this License, since you have not
356
+
signed it. However, nothing else grants you permission to modify or
357
+
distribute the Library or its derivative works. These actions are
358
+
prohibited by law if you do not accept this License. Therefore, by
359
+
modifying or distributing the Library (or any work based on the
360
+
Library), you indicate your acceptance of this License to do so, and
361
+
all its terms and conditions for copying, distributing or modifying
362
+
the Library or works based on it.
363
+
364
+
10. Each time you redistribute the Library (or any work based on the
365
+
Library), the recipient automatically receives a license from the
366
+
original licensor to copy, distribute, link with or modify the Library
367
+
subject to these terms and conditions. You may not impose any further
368
+
restrictions on the recipients' exercise of the rights granted herein.
369
+
You are not responsible for enforcing compliance by third parties to
370
+
this License.
371
+
372
+
11. If, as a consequence of a court judgment or allegation of patent
373
+
infringement or for any other reason (not limited to patent issues),
374
+
conditions are imposed on you (whether by court order, agreement or
375
+
otherwise) that contradict the conditions of this License, they do not
376
+
excuse you from the conditions of this License. If you cannot
377
+
distribute so as to satisfy simultaneously your obligations under this
378
+
License and any other pertinent obligations, then as a consequence you
379
+
may not distribute the Library at all. For example, if a patent
380
+
license would not permit royalty-free redistribution of the Library by
381
+
all those who receive copies directly or indirectly through you, then
382
+
the only way you could satisfy both it and this License would be to
383
+
refrain entirely from distribution of the Library.
384
+
385
+
If any portion of this section is held invalid or unenforceable under any
386
+
particular circumstance, the balance of the section is intended to apply,
387
+
and the section as a whole is intended to apply in other circumstances.
388
+
389
+
It is not the purpose of this section to induce you to infringe any
390
+
patents or other property right claims or to contest validity of any
391
+
such claims; this section has the sole purpose of protecting the
392
+
integrity of the free software distribution system which is
393
+
implemented by public license practices. Many people have made
394
+
generous contributions to the wide range of software distributed
395
+
through that system in reliance on consistent application of that
396
+
system; it is up to the author/donor to decide if he or she is willing
397
+
to distribute software through any other system and a licensee cannot
398
+
impose that choice.
399
+
400
+
This section is intended to make thoroughly clear what is believed to
401
+
be a consequence of the rest of this License.
402
+
403
+
12. If the distribution and/or use of the Library is restricted in
404
+
certain countries either by patents or by copyrighted interfaces, the
405
+
original copyright holder who places the Library under this License may add
406
+
an explicit geographical distribution limitation excluding those countries,
407
+
so that distribution is permitted only in or among countries not thus
408
+
excluded. In such case, this License incorporates the limitation as if
409
+
written in the body of this License.
410
+
411
+
13. The Free Software Foundation may publish revised and/or new
412
+
versions of the Library General Public License from time to time.
413
+
Such new versions will be similar in spirit to the present version,
414
+
but may differ in detail to address new problems or concerns.
415
+
416
+
Each version is given a distinguishing version number. If the Library
417
+
specifies a version number of this License which applies to it and
418
+
"any later version", you have the option of following the terms and
419
+
conditions either of that version or of any later version published by
420
+
the Free Software Foundation. If the Library does not specify a
421
+
license version number, you may choose any version ever published by
422
+
the Free Software Foundation.
423
+
424
+
14. If you wish to incorporate parts of the Library into other free
425
+
programs whose distribution conditions are incompatible with these,
426
+
write to the author to ask for permission. For software which is
427
+
copyrighted by the Free Software Foundation, write to the Free
428
+
Software Foundation; we sometimes make exceptions for this. Our
429
+
decision will be guided by the two goals of preserving the free status
430
+
of all derivatives of our free software and of promoting the sharing
431
+
and reuse of software generally.
432
+
433
+
NO WARRANTY
434
+
435
+
15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
436
+
WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
437
+
EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
438
+
OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
439
+
KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
440
+
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
441
+
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
442
+
LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
443
+
THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
444
+
445
+
16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
446
+
WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
447
+
AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
448
+
FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
449
+
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
450
+
LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
451
+
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
452
+
FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
453
+
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
454
+
DAMAGES.
455
+
456
+
END OF TERMS AND CONDITIONS
457
+
458
+
Appendix: How to Apply These Terms to Your New Libraries
459
+
460
+
If you develop a new library, and you want it to be of the greatest
461
+
possible use to the public, we recommend making it free software that
462
+
everyone can redistribute and change. You can do so by permitting
463
+
redistribution under these terms (or, alternatively, under the terms of the
464
+
ordinary General Public License).
465
+
466
+
To apply these terms, attach the following notices to the library. It is
467
+
safest to attach them to the start of each source file to most effectively
468
+
convey the exclusion of warranty; and each file should have at least the
469
+
"copyright" line and a pointer to where the full notice is found.
470
+
471
+
<one line to give the library's name and a brief idea of what it does.>
472
+
Copyright (C) <year> <name of author>
473
+
474
+
This library is free software; you can redistribute it and/or
475
+
modify it under the terms of the GNU Library General Public
476
+
License as published by the Free Software Foundation; either
477
+
version 2 of the License, or (at your option) any later version.
478
+
479
+
This library is distributed in the hope that it will be useful,
480
+
but WITHOUT ANY WARRANTY; without even the implied warranty of
481
+
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
482
+
Library General Public License for more details.
483
+
484
+
You should have received a copy of the GNU Library General Public
485
+
License along with this library; if not, write to the Free
486
+
Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
487
+
MA 02111-1307, USA
488
+
489
+
Also add information on how to contact you by electronic and paper mail.
490
+
491
+
You should also get your employer (if you work as a programmer) or your
492
+
school, if any, to sign a "copyright disclaimer" for the library, if
493
+
necessary. Here is a sample; alter the names:
494
+
495
+
Yoyodyne, Inc., hereby disclaims all copyright interest in the
496
+
library `Frob' (a library for tweaking knobs) written by James Random Hacker.
497
+
498
+
<signature of Ty Coon>, 1 April 1990
499
+
Ty Coon, President of Vice
500
+
501
+
That's all there is to it!
+17
vendor/opam/zarith/_build/default/META.zarith
+17
vendor/opam/zarith/_build/default/META.zarith
···
1
+
version = "1.14"
2
+
description = ""
3
+
requires = ""
4
+
archive(byte) = "zarith.cma"
5
+
archive(native) = "zarith.cmxa"
6
+
plugin(byte) = "zarith.cma"
7
+
plugin(native) = "zarith.cmxs"
8
+
package "top" (
9
+
directory = "top"
10
+
version = "1.14"
11
+
description = ""
12
+
requires = "compiler-libs.toplevel zarith"
13
+
archive(byte) = "zarith_top.cma"
14
+
archive(native) = "zarith_top.cmxa"
15
+
plugin(byte) = "zarith_top.cma"
16
+
plugin(native) = "zarith_top.cmxs"
17
+
)
+129
vendor/opam/zarith/_build/default/README.md
+129
vendor/opam/zarith/_build/default/README.md
···
1
+
# The Zarith library
2
+
3
+
## OVERVIEW
4
+
5
+
This library implements arithmetic and logical operations over
6
+
arbitrary-precision integers.
7
+
8
+
The module is simply named `Z`. Its interface is similar to that of
9
+
the `Int32`, `Int64` and `Nativeint` modules from the OCaml standard
10
+
library, with some additional functions. See the file `z.mli` for
11
+
documentation.
12
+
13
+
The implementation uses GMP (the GNU Multiple Precision arithmetic
14
+
library) to compute over big integers.
15
+
However, small integers are represented as unboxed Caml integers, to save
16
+
space and improve performance. Big integers are allocated in the Caml heap,
17
+
bypassing GMP's memory management and achieving better GC behavior than e.g.
18
+
the MLGMP library.
19
+
Computations on small integers use a special, faster path (in C or OCaml)
20
+
eschewing calls to GMP, while computations on large integers use the
21
+
low-level MPN functions from GMP.
22
+
23
+
Arbitrary-precision integers can be compared correctly using OCaml's
24
+
polymorphic comparison operators (`=`, `<`, `>`, etc.).
25
+
26
+
Additional features include:
27
+
* a module `Q` for rationals, built on top of `Z` (see `q.mli`)
28
+
* a compatibility layer `Big_int_Z` that implements the same API as Big_int from the legacy `Num` library, but uses `Z` internally
29
+
30
+
Support for [js_of_ocaml](https://github.com/ocsigen/js_of_ocaml/) is
31
+
provided by [Zarith_stubs_js](https://github.com/janestreet/zarith_stubs_js).
32
+
33
+
## REQUIREMENTS
34
+
35
+
* OCaml, version 4.04.0 or later.
36
+
* Either the GMP library or the MPIR library, including development files.
37
+
* GCC or Clang or a gcc-compatible C compiler and assembler (other compilers may work).
38
+
* The Findlib package manager (optional, recommended).
39
+
40
+
41
+
## INSTALLATION
42
+
43
+
1) First, run the "configure" script by typing:
44
+
```
45
+
./configure
46
+
```
47
+
The `configure` script has a few options. Use the `-help` option to get a
48
+
list and short description of each option.
49
+
50
+
2) It creates a Makefile, which can be invoked by:
51
+
```
52
+
make
53
+
```
54
+
This builds native and bytecode versions of the library.
55
+
56
+
3) The libraries are installed by typing:
57
+
```
58
+
make install
59
+
```
60
+
or, if you install to a system location but are not an administrator
61
+
```
62
+
sudo make install
63
+
```
64
+
If Findlib is detected, it is used to install files.
65
+
Otherwise, the files are copied to a `zarith/` subdirectory of the directory
66
+
given by `ocamlc -where`.
67
+
68
+
The libraries are named `zarith.cmxa` and `zarith.cma`, and the Findlib module
69
+
is named `zarith`.
70
+
71
+
Compiling and linking with the library requires passing the `-I +zarith`
72
+
option to `ocamlc` / `ocamlopt`, or the `-package zarith` option to `ocamlfind`.
73
+
74
+
4) (optional, recommended) Test programs are built and run by the additional command
75
+
```
76
+
make tests
77
+
```
78
+
(but these are not installed).
79
+
80
+
5) (optional) HTML API documentation is built (using `ocamldoc`) by the additional command
81
+
```
82
+
make doc
83
+
```
84
+
85
+
## ONLINE DOCUMENTATION
86
+
87
+
The documentation for the latest release is hosted on [GitHub Pages](https://antoinemine.github.io/Zarith/doc/latest/index.html).
88
+
89
+
90
+
## LICENSE
91
+
92
+
This Library is distributed under the terms of the GNU Library General
93
+
Public License version 2, with a special exception allowing unconstrained
94
+
static linking.
95
+
See LICENSE file for details.
96
+
97
+
98
+
## AUTHORS
99
+
100
+
* Antoine Miné, Sorbonne Université, formerly at ENS Paris.
101
+
* Xavier Leroy, Collège de France, formerly at Inria Paris.
102
+
* Pascal Cuoq, TrustInSoft.
103
+
* Christophe Troestler (toplevel module)
104
+
105
+
106
+
## COPYRIGHT
107
+
108
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
109
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
110
+
a joint laboratory by:
111
+
CNRS (Centre national de la recherche scientifique, France),
112
+
ENS (École normale supérieure, Paris, France),
113
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
114
+
115
+
116
+
## CONTENTS
117
+
118
+
Source files | Description
119
+
--------------------|-----------------------------------------
120
+
configure | configuration script
121
+
z.ml[i] | Z module and implementation for small integers
122
+
caml_z.c | C implementation
123
+
big_int_z.ml[i] | wrapper to provide a Big_int compatible API to Z
124
+
q.ml[i] | rational library, pure OCaml on top of Z
125
+
zarith_top.ml | toplevel module to provide pretty-printing
126
+
projet.mak | builds Z, Q and the tests
127
+
zarith.opam | package description for opam
128
+
z_mlgmpidl.ml[i] | conversion between Zarith and MLGMPIDL
129
+
tests/ | simple regression tests and benchmarks
+144
vendor/opam/zarith/_build/default/big_int_Z.ml
+144
vendor/opam/zarith/_build/default/big_int_Z.ml
···
1
+
(**
2
+
[Big_int] interface for Z module.
3
+
4
+
This modules provides an interface compatible with [Big_int], but using
5
+
[Z] functions internally.
6
+
7
+
8
+
This file is part of the Zarith library
9
+
http://forge.ocamlcore.org/projects/zarith .
10
+
It is distributed under LGPL 2 licensing, with static linking exception.
11
+
See the LICENSE file included in the distribution.
12
+
13
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
14
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
15
+
a joint laboratory by:
16
+
CNRS (Centre national de la recherche scientifique, France),
17
+
ENS (École normale supérieure, Paris, France),
18
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
19
+
20
+
*)
21
+
22
+
type big_int = Z.t
23
+
24
+
let zero_big_int = Z.zero
25
+
26
+
let unit_big_int = Z.one
27
+
28
+
let minus_big_int = Z.neg
29
+
30
+
let abs_big_int = Z.abs
31
+
32
+
let add_big_int = Z.add
33
+
34
+
let succ_big_int = Z.succ
35
+
36
+
let add_int_big_int x y = Z.add (Z.of_int x) y
37
+
38
+
let sub_big_int = Z.sub
39
+
40
+
let pred_big_int = Z.pred
41
+
42
+
let mult_big_int = Z.mul
43
+
44
+
let mult_int_big_int x y = Z.mul (Z.of_int x) y
45
+
46
+
let square_big_int x = Z.mul x x
47
+
48
+
let sqrt_big_int = Z.sqrt
49
+
50
+
let quomod_big_int = Z.ediv_rem
51
+
52
+
let div_big_int = Z.ediv
53
+
54
+
let mod_big_int = Z.erem
55
+
56
+
let gcd_big_int = Z.gcd
57
+
58
+
let power = Z.pow
59
+
60
+
let power_big a b =
61
+
Z.pow a (Z.to_int b)
62
+
63
+
let power_int_positive_int a b =
64
+
if b < 0 then raise (Invalid_argument "power_int_positive_int");
65
+
power (Z.of_int a) b
66
+
67
+
let power_big_int_positive_int a b =
68
+
if b < 0 then raise (Invalid_argument "power_big_int_positive_int");
69
+
power a b
70
+
71
+
let power_int_positive_big_int a b =
72
+
if Z.sign b < 0 then raise (Invalid_argument "power_int_positive_big_int");
73
+
power_big (Z.of_int a) b
74
+
75
+
let power_big_int_positive_big_int a b =
76
+
if Z.sign b < 0 then raise (Invalid_argument "power_big_int_positive_big_int");
77
+
power_big a b
78
+
79
+
let sign_big_int = Z.sign
80
+
81
+
let compare_big_int = Z.compare
82
+
83
+
let eq_big_int = Z.equal
84
+
85
+
let le_big_int a b = Z.compare a b <= 0
86
+
87
+
let ge_big_int a b = Z.compare a b >= 0
88
+
89
+
let lt_big_int a b = Z.compare a b < 0
90
+
91
+
let gt_big_int a b = Z.compare a b > 0
92
+
93
+
let max_big_int = Z.max
94
+
95
+
let min_big_int = Z.min
96
+
97
+
let num_digits_big_int = Z.size
98
+
99
+
let string_of_big_int = Z.to_string
100
+
101
+
let big_int_of_string = Z.of_string
102
+
103
+
let big_int_of_int = Z.of_int
104
+
105
+
let is_int_big_int = Z.fits_int
106
+
107
+
let int_of_big_int x =
108
+
try Z.to_int x with Z.Overflow -> failwith "int_of_big_int"
109
+
110
+
let big_int_of_int32 = Z.of_int32
111
+
112
+
let big_int_of_nativeint = Z.of_nativeint
113
+
114
+
let big_int_of_int64 = Z.of_int64
115
+
116
+
let int32_of_big_int x =
117
+
try Z.to_int32 x with Z.Overflow -> failwith "int32_of_big_int"
118
+
119
+
let nativeint_of_big_int x =
120
+
try Z.to_nativeint x with Z.Overflow -> failwith "nativeint_of_big_int"
121
+
122
+
let int64_of_big_int x =
123
+
try Z.to_int64 x with Z.Overflow -> failwith "int64_of_big_int"
124
+
125
+
let float_of_big_int = Z.to_float
126
+
127
+
let big_int_of_float = Z.of_float
128
+
129
+
let and_big_int = Z.logand
130
+
131
+
let or_big_int = Z.logor
132
+
133
+
let xor_big_int = Z.logxor
134
+
135
+
let shift_left_big_int = Z.shift_left
136
+
137
+
let shift_right_big_int = Z.shift_right
138
+
139
+
let shift_right_towards_zero_big_int = Z.shift_right_trunc
140
+
141
+
let extract_big_int = Z.extract
142
+
143
+
144
+
+78
vendor/opam/zarith/_build/default/big_int_Z.mli
+78
vendor/opam/zarith/_build/default/big_int_Z.mli
···
1
+
(**
2
+
[Big_int] interface for Z module.
3
+
4
+
This modules provides an interface compatible with [Big_int], but using
5
+
[Z] functions internally.
6
+
7
+
8
+
This file is part of the Zarith library
9
+
http://forge.ocamlcore.org/projects/zarith .
10
+
It is distributed under LGPL 2 licensing, with static linking exception.
11
+
See the LICENSE file included in the distribution.
12
+
13
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
14
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
15
+
a joint laboratory by:
16
+
CNRS (Centre national de la recherche scientifique, France),
17
+
ENS (École normale supérieure, Paris, France),
18
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
19
+
20
+
*)
21
+
22
+
(* note: generated with ocamlc -i *)
23
+
24
+
type big_int = Z.t
25
+
26
+
val zero_big_int : Z.t
27
+
val unit_big_int : Z.t
28
+
val minus_big_int : Z.t -> Z.t
29
+
val abs_big_int : Z.t -> Z.t
30
+
val add_big_int : Z.t -> Z.t -> Z.t
31
+
val succ_big_int : Z.t -> Z.t
32
+
val add_int_big_int : int -> Z.t -> Z.t
33
+
val sub_big_int : Z.t -> Z.t -> Z.t
34
+
val pred_big_int : Z.t -> Z.t
35
+
val mult_big_int : Z.t -> Z.t -> Z.t
36
+
val mult_int_big_int : int -> Z.t -> Z.t
37
+
val square_big_int : Z.t -> Z.t
38
+
val sqrt_big_int : Z.t -> Z.t
39
+
val quomod_big_int : Z.t -> Z.t -> Z.t * Z.t
40
+
val div_big_int : Z.t -> Z.t -> Z.t
41
+
val mod_big_int : Z.t -> Z.t -> Z.t
42
+
val gcd_big_int : Z.t -> Z.t -> Z.t
43
+
val power : Z.t -> int -> Z.t
44
+
val power_big : Z.t -> Z.t -> Z.t
45
+
val power_int_positive_int : int -> int -> Z.t
46
+
val power_big_int_positive_int : Z.t -> int -> Z.t
47
+
val power_int_positive_big_int : int -> Z.t -> Z.t
48
+
val power_big_int_positive_big_int : Z.t -> Z.t -> Z.t
49
+
val sign_big_int : Z.t -> int
50
+
val compare_big_int : Z.t -> Z.t -> int
51
+
val eq_big_int : Z.t -> Z.t -> bool
52
+
val le_big_int : Z.t -> Z.t -> bool
53
+
val ge_big_int : Z.t -> Z.t -> bool
54
+
val lt_big_int : Z.t -> Z.t -> bool
55
+
val gt_big_int : Z.t -> Z.t -> bool
56
+
val max_big_int : Z.t -> Z.t -> Z.t
57
+
val min_big_int : Z.t -> Z.t -> Z.t
58
+
val num_digits_big_int : Z.t -> int
59
+
val string_of_big_int : Z.t -> string
60
+
val big_int_of_string : string -> Z.t
61
+
val big_int_of_int : int -> Z.t
62
+
val is_int_big_int : Z.t -> bool
63
+
val int_of_big_int : Z.t -> int
64
+
val big_int_of_int32 : int32 -> Z.t
65
+
val big_int_of_nativeint : nativeint -> Z.t
66
+
val big_int_of_int64 : int64 -> Z.t
67
+
val int32_of_big_int : Z.t -> int32
68
+
val nativeint_of_big_int : Z.t -> nativeint
69
+
val int64_of_big_int : Z.t -> int64
70
+
val float_of_big_int : Z.t -> float
71
+
val big_int_of_float : float -> Z.t
72
+
val and_big_int : Z.t -> Z.t -> Z.t
73
+
val or_big_int : Z.t -> Z.t -> Z.t
74
+
val xor_big_int : Z.t -> Z.t -> Z.t
75
+
val shift_left_big_int : Z.t -> int -> Z.t
76
+
val shift_right_big_int : Z.t -> int -> Z.t
77
+
val shift_right_towards_zero_big_int : Z.t -> int -> Z.t
78
+
val extract_big_int : Z.t -> int -> int -> Z.t
+3543
vendor/opam/zarith/_build/default/caml_z.c
+3543
vendor/opam/zarith/_build/default/caml_z.c
···
1
+
/**
2
+
Implementation of Z module.
3
+
4
+
5
+
This file is part of the Zarith library
6
+
http://forge.ocamlcore.org/projects/zarith .
7
+
It is distributed under LGPL 2 licensing, with static linking exception.
8
+
See the LICENSE file included in the distribution.
9
+
10
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
11
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
12
+
a joint laboratory by:
13
+
CNRS (Centre national de la recherche scientifique, France),
14
+
ENS (École normale supérieure, Paris, France),
15
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
16
+
17
+
*/
18
+
19
+
20
+
/*---------------------------------------------------
21
+
INCLUDES
22
+
---------------------------------------------------*/
23
+
24
+
#include <stdio.h>
25
+
#include <stdlib.h>
26
+
#include <string.h>
27
+
#include <math.h>
28
+
#include <stdint.h>
29
+
#include <limits.h>
30
+
31
+
#ifdef HAS_GMP
32
+
#include <gmp.h>
33
+
#endif
34
+
#ifdef HAS_MPIR
35
+
#include <mpir.h>
36
+
#endif
37
+
38
+
#include "zarith.h"
39
+
40
+
#ifdef __cplusplus
41
+
extern "C" {
42
+
#endif
43
+
44
+
#include <caml/mlvalues.h>
45
+
#include <caml/memory.h>
46
+
#include <caml/alloc.h>
47
+
#include <caml/fail.h>
48
+
#include <caml/custom.h>
49
+
#include <caml/intext.h>
50
+
#include <caml/callback.h>
51
+
#include <caml/intext.h>
52
+
#include <caml/hash.h>
53
+
54
+
#define inline __inline
55
+
56
+
#ifdef _MSC_VER
57
+
#include <float.h>
58
+
#include <intrin.h>
59
+
#endif
60
+
61
+
/* The "__has_builtin" special macro from Clang */
62
+
#ifdef __has_builtin
63
+
#define HAS_BUILTIN(x) __has_builtin(x)
64
+
#else
65
+
#define HAS_BUILTIN(x) 0
66
+
#endif
67
+
68
+
/*---------------------------------------------------
69
+
CONFIGURATION
70
+
---------------------------------------------------*/
71
+
72
+
/* Whether to enable native (i.e. non-mpn_) operations and output
73
+
ocaml integers when possible.
74
+
Highly recommended.
75
+
*/
76
+
#define Z_FAST_PATH 1
77
+
#define Z_USE_NATINT 1
78
+
79
+
/* Whether the fast path (arguments and result are small integers)
80
+
has already be handled in OCaml, so that there is no need to
81
+
re-test for it in C functions.
82
+
Applies to: neg, abs, add, sub, mul, div, rem, succ, pred,
83
+
logand, logor, logxor, lognot, shifts, divexact.
84
+
*/
85
+
#define Z_FAST_PATH_IN_OCAML 1
86
+
87
+
/* Sanity checks. */
88
+
#define Z_PERFORM_CHECK 0
89
+
90
+
/* Enable performance counters.
91
+
Prints some info on stdout at exit.
92
+
*/
93
+
/*
94
+
#define Z_PERF_COUNTER 0
95
+
now set by configure
96
+
*/
97
+
98
+
/* whether to use custom blocks (supporting serialization, comparison &
99
+
hashing) instead of abstract tags
100
+
*/
101
+
#define Z_CUSTOM_BLOCK 1
102
+
103
+
/*---------------------------------------------------
104
+
DATA STRUCTURES
105
+
---------------------------------------------------*/
106
+
107
+
/*
108
+
we assume that:
109
+
- intnat is a signed integer type
110
+
- mp_limb_t is an unsigned integer type
111
+
- sizeof(intnat) == sizeof(mp_limb_t) == either 4 or 8
112
+
*/
113
+
114
+
#ifdef _WIN64
115
+
#define PRINTF_LIMB "I64"
116
+
#else
117
+
#define PRINTF_LIMB "l"
118
+
#endif
119
+
120
+
/*
121
+
A z object x can be:
122
+
- either an ocaml int
123
+
- or a block with abstract or custom tag and containing:
124
+
. a 1 value header containing the sign Z_SIGN(x) and the size Z_SIZE(x)
125
+
. Z_SIZE(x) mp_limb_t
126
+
127
+
Invariant:
128
+
- if the number fits in an int, it is stored in an int, not a block
129
+
- if the number is stored in a block, then Z_SIZE(x) >= 1 and
130
+
the most significant limb Z_LIMB(x)[Z_SIZE(x)] is not 0
131
+
*/
132
+
133
+
134
+
/* a sign is always denoted as 0 (+) or Z_SIGN_MASK (-) */
135
+
#ifdef ARCH_SIXTYFOUR
136
+
#define Z_SIGN_MASK 0x8000000000000000
137
+
#define Z_SIZE_MASK 0x7fffffffffffffff
138
+
#else
139
+
#define Z_SIGN_MASK 0x80000000
140
+
#define Z_SIZE_MASK 0x7fffffff
141
+
#endif
142
+
143
+
#if Z_CUSTOM_BLOCK
144
+
#define Z_HEAD(x) (*((value*)Data_custom_val((x))))
145
+
#define Z_LIMB(x) ((mp_limb_t*)Data_custom_val((x)) + 1)
146
+
#else
147
+
#define Z_HEAD(x) (Field((x),0))
148
+
#define Z_LIMB(x) ((mp_limb_t*)&(Field((x),1)))
149
+
#endif
150
+
#define Z_SIGN(x) (Z_HEAD((x)) & Z_SIGN_MASK)
151
+
#define Z_SIZE(x) (Z_HEAD((x)) & Z_SIZE_MASK)
152
+
153
+
/* bounds of an Ocaml int */
154
+
#ifdef ARCH_SIXTYFOUR
155
+
#define Z_MAX_INT 0x3fffffffffffffff
156
+
#define Z_MIN_INT (-0x4000000000000000)
157
+
#else
158
+
#define Z_MAX_INT 0x3fffffff
159
+
#define Z_MIN_INT (-0x40000000)
160
+
#endif
161
+
#define Z_FITS_INT(v) ((v) >= Z_MIN_INT && (v) <= Z_MAX_INT)
162
+
163
+
/* greatest/smallest double that can fit in an int */
164
+
#ifdef ARCH_SIXTYFOUR
165
+
#define Z_MAX_INT_FL 0x3ffffffffffffe00
166
+
#define Z_MIN_INT_FL (-0x4000000000000000)
167
+
#else
168
+
#define Z_MAX_INT_FL Z_MAX_INT
169
+
#define Z_MIN_INT_FL Z_MIN_INT
170
+
#endif
171
+
172
+
/* safe bounds to avoid overflow in multiplication */
173
+
#ifdef ARCH_SIXTYFOUR
174
+
#define Z_MAX_HINT 0x3fffffff
175
+
#else
176
+
#define Z_MAX_HINT 0x3fff
177
+
#endif
178
+
#define Z_MIN_HINT (-Z_MAX_HINT)
179
+
#define Z_FITS_HINT(v) ((v) >= Z_MIN_HINT && (v) <= Z_MAX_HINT)
180
+
181
+
/* hi bit of OCaml int32, int64 & nativeint */
182
+
#define Z_HI_INT32 0x80000000
183
+
#define Z_HI_UINT32 0x100000000LL
184
+
#define Z_HI_INT64 0x8000000000000000LL
185
+
#ifdef ARCH_SIXTYFOUR
186
+
#define Z_HI_INTNAT Z_HI_INT64
187
+
#define Z_HI_INT 0x4000000000000000
188
+
#else
189
+
#define Z_HI_INTNAT Z_HI_INT32
190
+
#define Z_HI_INT 0x40000000
191
+
#endif
192
+
193
+
/* safe bounds for the length of a base n string fitting in a native
194
+
int. Defined as the result of (n - 2) log_base(2) with n = 64 or
195
+
32.
196
+
*/
197
+
#ifdef ARCH_SIXTYFOUR
198
+
#define Z_BASE16_LENGTH_OP 15
199
+
#define Z_BASE10_LENGTH_OP 18
200
+
#define Z_BASE8_LENGTH_OP 20
201
+
#define Z_BASE2_LENGTH_OP 62
202
+
#else
203
+
#define Z_BASE16_LENGTH_OP 7
204
+
#define Z_BASE10_LENGTH_OP 9
205
+
#define Z_BASE8_LENGTH_OP 10
206
+
#define Z_BASE2_LENGTH_OP 30
207
+
#endif
208
+
209
+
#define Z_LIMB_BITS (8 * sizeof(mp_limb_t))
210
+
211
+
212
+
/* performance counters */
213
+
unsigned long ml_z_ops = 0;
214
+
unsigned long ml_z_slow = 0;
215
+
unsigned long ml_z_ops_as = 0;
216
+
217
+
#if Z_PERF_COUNTER
218
+
#define Z_MARK_OP ml_z_ops++
219
+
#define Z_MARK_SLOW ml_z_slow++
220
+
#else
221
+
#define Z_MARK_OP
222
+
#define Z_MARK_SLOW
223
+
#endif
224
+
225
+
/*---------------------------------------------------
226
+
UTILITIES
227
+
---------------------------------------------------*/
228
+
229
+
extern struct custom_operations ml_z_custom_ops;
230
+
231
+
static double ml_z_2p32; /* 2 ^ 32 in double */
232
+
233
+
#if Z_PERFORM_CHECK
234
+
/* for debugging: dump a mp_limb_t array */
235
+
static void ml_z_dump(const char* msg, mp_limb_t* p, mp_size_t sz)
236
+
{
237
+
mp_size_t i;
238
+
printf("%s %i: ",msg,(int)sz);
239
+
for (i = 0; i < sz; i++)
240
+
#ifdef ARCH_SIXTYFOUR
241
+
printf("%08" PRINTF_LIMB "x ",p[i]);
242
+
#else
243
+
printf("%04" PRINTF_LIMB "x ",p[i]);
244
+
#endif
245
+
printf("\n");
246
+
fflush(stdout);
247
+
}
248
+
#endif
249
+
250
+
#if Z_PERFORM_CHECK
251
+
/* for debugging: check invariant */
252
+
void ml_z_check(const char* fn, int line, const char* arg, value v)
253
+
{
254
+
mp_size_t sz;
255
+
256
+
if (Is_long(v)) {
257
+
#if Z_USE_NATINT
258
+
return;
259
+
#else
260
+
printf("ml_z_check: unexpected tagged integer for %s at %s:%i.\n", arg, fn, line);
261
+
exit(1);
262
+
#endif
263
+
}
264
+
#if Z_CUSTOM_BLOCK
265
+
if (Custom_ops_val(v) != &ml_z_custom_ops) {
266
+
printf("ml_z_check: wrong custom block for %s at %s:%i.\n",
267
+
arg, fn, line);
268
+
exit(1);
269
+
}
270
+
sz = Wosize_val(v) - 1;
271
+
#else
272
+
sz = Wosize_val(v);
273
+
#endif
274
+
if (Z_SIZE(v) + 2 > sz) {
275
+
printf("ml_z_check: invalid block size (%i / %i) for %s at %s:%i.\n",
276
+
(int)Z_SIZE(v), (int)sz,
277
+
arg, fn, line);
278
+
exit(1);
279
+
}
280
+
if ((mp_size_t) Z_LIMB(v)[sz - 2] != (mp_size_t)(0xDEADBEEF ^ (sz - 2))) {
281
+
printf("ml_z_check: corrupted block for %s at %s:%i.\n",
282
+
arg, fn, line);
283
+
exit(1);
284
+
}
285
+
if (Z_SIZE(v) && !Z_LIMB(v)[Z_SIZE(v)-1]) {
286
+
printf("ml_z_check: unreduced argument for %s at %s:%i.\n", arg, fn, line);
287
+
ml_z_dump("offending argument: ", Z_LIMB(v), Z_SIZE(v));
288
+
exit(1);
289
+
}
290
+
#if Z_USE_NATINT
291
+
if (Z_SIZE(v) == 0
292
+
|| (Z_SIZE(v) <= 1
293
+
&& (Z_LIMB(v)[0] <= Z_MAX_INT
294
+
|| (Z_LIMB(v)[0] == -Z_MIN_INT && Z_SIGN(v))))) {
295
+
printf("ml_z_check: expected a tagged integer for %s at %s:%i.\n", arg, fn, line);
296
+
ml_z_dump("offending argument: ", Z_LIMB(v), Z_SIZE(v));
297
+
exit(1);
298
+
}
299
+
#else
300
+
if (!Z_SIZE(v) && Z_SIGN(v)) {
301
+
printf("ml_z_check: invalid sign of 0 for %s at %s:%i.\n",
302
+
arg, fn, line);
303
+
exit(1);
304
+
}
305
+
#endif
306
+
}
307
+
#endif
308
+
309
+
/* for debugging */
310
+
#if Z_PERFORM_CHECK
311
+
#define Z_CHECK(v) ml_z_check(__FUNCTION__, __LINE__, #v, v)
312
+
#else
313
+
#define Z_CHECK(v)
314
+
#endif
315
+
316
+
/* allocates z object block with space for sz mp_limb_t;
317
+
does not set the header
318
+
*/
319
+
320
+
#if !Z_PERFORM_CHECK
321
+
/* inlined allocation */
322
+
#if Z_CUSTOM_BLOCK
323
+
#define ml_z_alloc(sz) \
324
+
caml_alloc_custom(&ml_z_custom_ops, (1 + (sz)) * sizeof(value), 0, 1)
325
+
#else
326
+
#define ml_z_alloc(sz) \
327
+
caml_alloc(1 + (sz), Abstract_tag);
328
+
#endif
329
+
330
+
#else
331
+
/* out-of-line allocation, inserting a canary after the last limb */
332
+
static value ml_z_alloc(mp_size_t sz)
333
+
{
334
+
value v;
335
+
#if Z_CUSTOM_BLOCK
336
+
v = caml_alloc_custom(&ml_z_custom_ops, (1 + sz + 1) * sizeof(value), 0, 1);
337
+
#else
338
+
v = caml_alloc(1 + sz + 1, Abstract_tag);
339
+
#endif
340
+
Z_LIMB(v)[sz] = 0xDEADBEEF ^ sz;
341
+
return v;
342
+
}
343
+
#endif
344
+
345
+
/* duplicates the caml block src */
346
+
static inline void ml_z_cpy_limb(mp_limb_t* dst, mp_limb_t* src, mp_size_t sz)
347
+
{
348
+
memcpy(dst, src, sz * sizeof(mp_limb_t));
349
+
}
350
+
351
+
/* duplicates the mp_limb_t array src */
352
+
static inline mp_limb_t* ml_z_dup_limb(mp_limb_t* src, mp_size_t sz)
353
+
{
354
+
mp_limb_t* r = (mp_limb_t*) malloc(sz * sizeof(mp_limb_t));
355
+
memcpy(r, src, sz * sizeof(mp_limb_t));
356
+
return r;
357
+
}
358
+
359
+
360
+
#ifdef _MSC_VER
361
+
#define MAYBE_UNUSED
362
+
#else
363
+
#define MAYBE_UNUSED (void)
364
+
#endif
365
+
366
+
/* given a z object, define:
367
+
- ptr_arg: a pointer to the first mp_limb_t
368
+
- size_arg: the number of mp-limb_t
369
+
- sign_arg: the sign of the number
370
+
if arg is an int, it is converted to a 1-limb number
371
+
*/
372
+
#define Z_DECL(arg) \
373
+
mp_limb_t loc_##arg, *ptr_##arg; \
374
+
mp_size_t size_##arg; \
375
+
intnat sign_##arg; \
376
+
MAYBE_UNUSED loc_##arg; \
377
+
MAYBE_UNUSED ptr_##arg; \
378
+
MAYBE_UNUSED size_##arg; \
379
+
MAYBE_UNUSED sign_##arg;
380
+
381
+
#define Z_ARG(arg) \
382
+
if (Is_long(arg)) { \
383
+
intnat n = Long_val(arg); \
384
+
loc_##arg = n < 0 ? -n : n; \
385
+
sign_##arg = n & Z_SIGN_MASK; \
386
+
size_##arg = n != 0; \
387
+
ptr_##arg = &loc_##arg; \
388
+
} \
389
+
else { \
390
+
size_##arg = Z_SIZE(arg); \
391
+
sign_##arg = Z_SIGN(arg); \
392
+
ptr_##arg = Z_LIMB(arg); \
393
+
}
394
+
395
+
/* After an allocation, a heap-allocated Z argument may have moved and
396
+
its ptr_arg pointer can be invalid. Reset the ptr_arg pointer to
397
+
its correct value. */
398
+
399
+
#define Z_REFRESH(arg) \
400
+
if (! Is_long(arg)) ptr_##arg = Z_LIMB(arg);
401
+
402
+
/* computes the actual size of the z object r and updates its header,
403
+
either returns r or, if the number is small enough, an int
404
+
*/
405
+
static value ml_z_reduce(value r, mp_size_t sz, intnat sign)
406
+
{
407
+
while (sz > 0 && !Z_LIMB(r)[sz-1]) sz--;
408
+
#if Z_USE_NATINT
409
+
if (!sz) return Val_long(0);
410
+
if (sz <= 1) {
411
+
if (Z_LIMB(r)[0] <= Z_MAX_INT) {
412
+
if (sign) return Val_long(-Z_LIMB(r)[0]);
413
+
else return Val_long(Z_LIMB(r)[0]);
414
+
}
415
+
if (Z_LIMB(r)[0] == -Z_MIN_INT && sign) {
416
+
return Val_long(Z_MIN_INT);
417
+
}
418
+
}
419
+
#else
420
+
if (!sz) sign = 0;
421
+
#endif
422
+
Z_HEAD(r) = sz | sign;
423
+
return r;
424
+
}
425
+
426
+
static void ml_z_raise_overflow()
427
+
{
428
+
caml_raise_constant(*caml_named_value("ml_z_overflow"));
429
+
}
430
+
431
+
#define ml_z_raise_divide_by_zero() \
432
+
caml_raise_zero_divide()
433
+
434
+
435
+
436
+
/*---------------------------------------------------
437
+
CONVERSION FUNCTIONS
438
+
---------------------------------------------------*/
439
+
440
+
CAMLprim value ml_z_of_int(value v)
441
+
{
442
+
#if Z_USE_NATINT
443
+
Z_MARK_OP;
444
+
return v;
445
+
#else
446
+
intnat x;
447
+
value r;
448
+
Z_MARK_OP;
449
+
Z_MARK_SLOW;
450
+
x = Long_val(v);
451
+
r = ml_z_alloc(1);
452
+
if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; }
453
+
else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -x; }
454
+
else Z_HEAD(r) = 0;
455
+
Z_CHECK(r);
456
+
return r;
457
+
#endif
458
+
}
459
+
460
+
CAMLprim value ml_z_of_nativeint(value v)
461
+
{
462
+
intnat x;
463
+
value r;
464
+
Z_MARK_OP;
465
+
x = Nativeint_val(v);
466
+
#if Z_USE_NATINT
467
+
if (Z_FITS_INT(x)) return Val_long(x);
468
+
#endif
469
+
Z_MARK_SLOW;
470
+
r = ml_z_alloc(1);
471
+
if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; }
472
+
else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -x; }
473
+
else Z_HEAD(r) = 0;
474
+
Z_CHECK(r);
475
+
return r;
476
+
}
477
+
478
+
CAMLprim value ml_z_of_int32(value v)
479
+
{
480
+
int32_t x;
481
+
Z_MARK_OP;
482
+
x = Int32_val(v);
483
+
#if Z_USE_NATINT && defined(ARCH_SIXTYFOUR)
484
+
return Val_long(x);
485
+
#else
486
+
#if Z_USE_NATINT
487
+
if (Z_FITS_INT(x)) return Val_long(x);
488
+
#endif
489
+
{
490
+
value r;
491
+
Z_MARK_SLOW;
492
+
r = ml_z_alloc(1);
493
+
if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; }
494
+
else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -(mp_limb_t)x; }
495
+
else Z_HEAD(r) = 0;
496
+
Z_CHECK(r);
497
+
return r;
498
+
}
499
+
#endif
500
+
}
501
+
502
+
CAMLprim value ml_z_of_int64(value v)
503
+
{
504
+
int64_t x;
505
+
value r;
506
+
Z_MARK_OP;
507
+
x = Int64_val(v);
508
+
#if Z_USE_NATINT
509
+
if (Z_FITS_INT(x)) return Val_long(x);
510
+
#endif
511
+
Z_MARK_SLOW;
512
+
#ifdef ARCH_SIXTYFOUR
513
+
r = ml_z_alloc(1);
514
+
if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; }
515
+
else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -x; }
516
+
else Z_HEAD(r) = 0;
517
+
#else
518
+
{
519
+
mp_limb_t sign;
520
+
r = ml_z_alloc(2);
521
+
if (x >= 0) { sign = 0; }
522
+
else { sign = Z_SIGN_MASK; x = -x; }
523
+
Z_LIMB(r)[0] = x;
524
+
Z_LIMB(r)[1] = x >> 32;
525
+
r = ml_z_reduce(r, 2, sign);
526
+
}
527
+
#endif
528
+
Z_CHECK(r);
529
+
return r;
530
+
}
531
+
532
+
CAMLprim value ml_z_of_float(value v)
533
+
{
534
+
double x;
535
+
int exp;
536
+
int64_t y, m;
537
+
value r;
538
+
Z_MARK_OP;
539
+
x = Double_val(v);
540
+
#if Z_USE_NATINT
541
+
if (x >= Z_MIN_INT_FL && x <= Z_MAX_INT_FL) return Val_long((intnat) x);
542
+
#endif
543
+
Z_MARK_SLOW;
544
+
#ifdef ARCH_ALIGN_INT64
545
+
memcpy(&y, (void *) v, 8);
546
+
#else
547
+
y = *((int64_t*)v);
548
+
#endif
549
+
exp = ((y >> 52) & 0x7ff) - 1023; /* exponent */
550
+
if (exp < 0) return(Val_long(0));
551
+
if (exp == 1024) ml_z_raise_overflow(); /* NaN or infinity */
552
+
m = (y & 0x000fffffffffffffLL) | 0x0010000000000000LL; /* mantissa */
553
+
if (exp <= 52) {
554
+
m >>= 52-exp;
555
+
#ifdef ARCH_SIXTYFOUR
556
+
r = Val_long((x >= 0.) ? m : -m);
557
+
#else
558
+
r = ml_z_alloc(2);
559
+
Z_LIMB(r)[0] = m;
560
+
Z_LIMB(r)[1] = m >> 32;
561
+
r = ml_z_reduce(r, 2, (x >= 0.) ? 0 : Z_SIGN_MASK);
562
+
#endif
563
+
}
564
+
else {
565
+
int c1 = (exp-52) / Z_LIMB_BITS;
566
+
int c2 = (exp-52) % Z_LIMB_BITS;
567
+
mp_size_t i;
568
+
#ifdef ARCH_SIXTYFOUR
569
+
r = ml_z_alloc(c1 + 2);
570
+
for (i = 0; i < c1; i++) Z_LIMB(r)[i] = 0;
571
+
Z_LIMB(r)[c1] = m << c2;
572
+
Z_LIMB(r)[c1+1] = c2 ? (m >> (64-c2)) : 0;
573
+
r = ml_z_reduce(r, c1 + 2, (x >= 0.) ? 0 : Z_SIGN_MASK);
574
+
#else
575
+
r = ml_z_alloc(c1 + 3);
576
+
for (i = 0; i < c1; i++) Z_LIMB(r)[i] = 0;
577
+
Z_LIMB(r)[c1] = m << c2;
578
+
Z_LIMB(r)[c1+1] = m >> (32-c2);
579
+
Z_LIMB(r)[c1+2] = c2 ? (m >> (64-c2)) : 0;
580
+
r = ml_z_reduce(r, c1 + 3, (x >= 0.) ? 0 : Z_SIGN_MASK);
581
+
#endif
582
+
}
583
+
Z_CHECK(r);
584
+
return r;
585
+
}
586
+
587
+
CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value length)
588
+
{
589
+
CAMLparam1(v);
590
+
CAMLlocal1(r);
591
+
intnat ofs = Long_val(offset);
592
+
intnat len = Long_val(length);
593
+
/* make sure the ofs/length make sense */
594
+
if (ofs < 0
595
+
|| len < 0
596
+
|| (intnat)caml_string_length(v) < ofs + len)
597
+
caml_invalid_argument("Z.of_substring_base: invalid offset or length");
598
+
/* process the string */
599
+
const char *d = String_val(v) + ofs;
600
+
const char *end = d + len;
601
+
mp_size_t i, j, sz, sz2, num_digits = 0;
602
+
mp_limb_t sign = 0;
603
+
intnat base = Long_val(b);
604
+
/* We allow [d] to advance beyond [end] while parsing the prefix:
605
+
sign, base, and/or leading zeros.
606
+
This simplifies the code, and reading these locations is safe since
607
+
we don't progress beyond a terminating null character.
608
+
At the end of the prefix, if we ran past the end, we return 0.
609
+
*/
610
+
/* get optional sign */
611
+
if (*d == '-') { sign ^= Z_SIGN_MASK; d++; }
612
+
if (*d == '+') d++;
613
+
/* get optional base */
614
+
if (!base) {
615
+
base = 10;
616
+
if (*d == '0') {
617
+
d++;
618
+
if (*d == 'o' || *d == 'O') { base = 8; d++; }
619
+
else if (*d == 'x' || *d == 'X') { base = 16; d++; }
620
+
else if (*d == 'b' || *d == 'B') { base = 2; d++; }
621
+
else {
622
+
/* The leading zero is not part of a base prefix. This is an
623
+
important distinction for the check below looking at
624
+
leading underscore
625
+
*/
626
+
d--; }
627
+
}
628
+
}
629
+
if (base < 2 || base > 16)
630
+
caml_invalid_argument("Z.of_substring_base: base must be between 2 and 16");
631
+
/* we do not allow leading underscore */
632
+
if (*d == '_')
633
+
caml_invalid_argument("Z.of_substring_base: invalid digit");
634
+
while (*d == '0' || *d == '_') d++;
635
+
/* sz is the length of the substring that has not been consumed above. */
636
+
sz = end - d;
637
+
for(i = 0; i < sz; i++){
638
+
/* underscores are going to be ignored below. Assuming the string
639
+
is well formatted, this will give us the exact number of digits */
640
+
if(d[i] != '_') num_digits++;
641
+
}
642
+
#if Z_USE_NATINT
643
+
if (sz <= 0) {
644
+
/* "+", "-", "0x" are parsed as 0. */
645
+
r = Val_long(0);
646
+
}
647
+
/* Process common case (fits into a native integer) */
648
+
else if ((base == 10 && num_digits <= Z_BASE10_LENGTH_OP)
649
+
|| (base == 16 && num_digits <= Z_BASE16_LENGTH_OP)
650
+
|| (base == 8 && num_digits <= Z_BASE8_LENGTH_OP)
651
+
|| (base == 2 && num_digits <= Z_BASE2_LENGTH_OP)) {
652
+
Z_MARK_OP;
653
+
intnat ret = 0;
654
+
for (i = 0; i < sz; i++) {
655
+
int digit = 0;
656
+
if (d[i] == '_') continue;
657
+
if (d[i] >= '0' && d[i] <= '9') digit = d[i] - '0';
658
+
else if (d[i] >= 'a' && d[i] <= 'f') digit = d[i] - 'a' + 10;
659
+
else if (d[i] >= 'A' && d[i] <= 'F') digit = d[i] - 'A' + 10;
660
+
else caml_invalid_argument("Z.of_substring_base: invalid digit");
661
+
if (digit >= base)
662
+
caml_invalid_argument("Z.of_substring_base: invalid digit");
663
+
ret = ret * base + digit;
664
+
}
665
+
r = Val_long(ret * (sign ? -1 : 1));
666
+
} else
667
+
#endif
668
+
{
669
+
/* converts to sequence of digits */
670
+
char* digits = (char*)malloc(num_digits+1);
671
+
for (i = 0, j = 0; i < sz; i++) {
672
+
if (d[i] == '_') continue;
673
+
if (d[i] >= '0' && d[i] <= '9') digits[j] = d[i] - '0';
674
+
else if (d[i] >= 'a' && d[i] <= 'f') digits[j] = d[i] - 'a' + 10;
675
+
else if (d[i] >= 'A' && d[i] <= 'F') digits[j] = d[i] - 'A' + 10;
676
+
else {
677
+
free(digits);
678
+
caml_invalid_argument("Z.of_substring_base: invalid digit");
679
+
}
680
+
if (digits[j] >= base) {
681
+
free(digits);
682
+
caml_invalid_argument("Z.of_substring_base: invalid digit");
683
+
}
684
+
j++;
685
+
}
686
+
/* make sure that digits is nul terminated */
687
+
digits[j] = 0;
688
+
r = ml_z_alloc(1 + j / (2 * sizeof(mp_limb_t)));
689
+
sz2 = mpn_set_str(Z_LIMB(r), (unsigned char*)digits, j, base);
690
+
r = ml_z_reduce(r, sz2, sign);
691
+
free(digits);
692
+
}
693
+
Z_CHECK(r);
694
+
CAMLreturn(r);
695
+
}
696
+
697
+
/* either stores the result in r and returns 0 (no overflow),
698
+
or returns 1 and leave r undefined (overflow)
699
+
*/
700
+
static int ml_to_int(value v, intnat* r)
701
+
{
702
+
Z_DECL(v);
703
+
Z_MARK_OP;
704
+
Z_CHECK(v);
705
+
if (Is_long(v)) { *r = v; return 0; }
706
+
Z_MARK_SLOW;
707
+
Z_ARG(v);
708
+
if (size_v > 1) return 1;
709
+
else if (!size_v) { *r = Val_long(0); return 0; }
710
+
else {
711
+
intnat x = *ptr_v;
712
+
if (sign_v) {
713
+
if ((uintnat)x > Z_HI_INT) return 1;
714
+
*r = Val_long(-x);
715
+
}
716
+
else {
717
+
if ((uintnat)x >= Z_HI_INT) return 1;
718
+
*r = Val_long(x);
719
+
}
720
+
return 0;
721
+
}
722
+
}
723
+
724
+
CAMLprim value ml_z_to_int(value v)
725
+
{
726
+
value x;
727
+
if (ml_to_int(v, &x)) ml_z_raise_overflow();
728
+
return x;
729
+
}
730
+
731
+
CAMLprim value ml_z_fits_int(value v)
732
+
{
733
+
value x;
734
+
if (ml_to_int(v, &x)) return Val_false;
735
+
return Val_true;
736
+
}
737
+
738
+
static int ml_to_nativeint(value v, intnat* r)
739
+
{
740
+
Z_DECL(v);
741
+
Z_MARK_OP;
742
+
Z_CHECK(v);
743
+
if (Is_long(v)) { *r = Long_val(v); return 0; }
744
+
Z_MARK_SLOW;
745
+
Z_ARG(v);
746
+
if (size_v > 1) return 1;
747
+
if (!size_v) { *r = 0; return 0; }
748
+
else {
749
+
intnat x;
750
+
x = *ptr_v;
751
+
if (sign_v) {
752
+
if ((uintnat)x > Z_HI_INTNAT) return 1;
753
+
*r = -x;
754
+
}
755
+
else {
756
+
if ((uintnat)x >= Z_HI_INTNAT) return 1;
757
+
*r = x;
758
+
}
759
+
return 0;
760
+
}
761
+
}
762
+
763
+
CAMLprim value ml_z_to_nativeint(value v)
764
+
{
765
+
intnat x;
766
+
if (ml_to_nativeint(v, &x)) ml_z_raise_overflow();
767
+
return caml_copy_nativeint(x);
768
+
}
769
+
770
+
CAMLprim value ml_z_fits_nativeint(value v)
771
+
{
772
+
intnat x;
773
+
if (ml_to_nativeint(v, &x)) return Val_false;
774
+
return Val_true;
775
+
}
776
+
777
+
static int ml_to_nativeint_unsigned(value v, uintnat* r)
778
+
{
779
+
Z_DECL(v);
780
+
Z_MARK_OP;
781
+
Z_CHECK(v);
782
+
if (Is_long(v)) {
783
+
intnat x = Long_val(v);
784
+
if (x < 0) return 1;
785
+
*r = (uintnat)x;
786
+
return 0;
787
+
}
788
+
Z_MARK_SLOW;
789
+
Z_ARG(v);
790
+
if (!size_v) { *r = 0; return 0; }
791
+
else if (sign_v || size_v > 1) return 1;
792
+
else {
793
+
*r = *ptr_v;
794
+
return 0;
795
+
}
796
+
}
797
+
798
+
CAMLprim value ml_z_to_nativeint_unsigned(value v)
799
+
{
800
+
uintnat x;
801
+
if (ml_to_nativeint_unsigned(v, &x)) ml_z_raise_overflow();
802
+
return caml_copy_nativeint(x);
803
+
}
804
+
805
+
CAMLprim value ml_z_fits_nativeint_unsigned(value v)
806
+
{
807
+
uintnat x;
808
+
if (ml_to_nativeint_unsigned(v, &x)) return Val_false;
809
+
return Val_true;
810
+
}
811
+
812
+
static int ml_to_int32(value v, int32_t* r)
813
+
{
814
+
Z_DECL(v);
815
+
Z_MARK_OP;
816
+
Z_CHECK(v);
817
+
if (Is_long(v)) {
818
+
intnat x = Long_val(v);
819
+
#ifdef ARCH_SIXTYFOUR
820
+
if (x >= (intnat)Z_HI_INT32 || x < -(intnat)Z_HI_INT32)
821
+
return 1;
822
+
#endif
823
+
*r = x;
824
+
return 0;
825
+
}
826
+
else {
827
+
Z_ARG(v);
828
+
Z_MARK_SLOW;
829
+
if (size_v > 1) return 1;
830
+
if (!size_v) { *r = 0; return 0; }
831
+
else {
832
+
uintnat x = *ptr_v;
833
+
if (sign_v) {
834
+
if (x > Z_HI_INT32) return 1;
835
+
*r = -x;
836
+
}
837
+
else {
838
+
if (x >= Z_HI_INT32) return 1;
839
+
*r = x;
840
+
}
841
+
return 0;
842
+
}
843
+
}
844
+
}
845
+
846
+
CAMLprim value ml_z_to_int32(value v)
847
+
{
848
+
int32_t x;
849
+
if (ml_to_int32(v, &x)) ml_z_raise_overflow();
850
+
return caml_copy_int32(x);
851
+
}
852
+
853
+
CAMLprim value ml_z_fits_int32(value v)
854
+
{
855
+
int32_t x;
856
+
if (ml_to_int32(v, &x)) return Val_false;
857
+
return Val_true;
858
+
}
859
+
860
+
static int ml_to_int32_unsigned(value v, uint32_t* r)
861
+
{
862
+
Z_DECL(v);
863
+
Z_MARK_OP;
864
+
Z_CHECK(v);
865
+
if (Is_long(v)) {
866
+
intnat x = Long_val(v);
867
+
#ifdef ARCH_SIXTYFOUR
868
+
if (x < 0 || x >= Z_HI_UINT32)
869
+
#else
870
+
if (x < 0)
871
+
#endif
872
+
return 1;
873
+
*r = x;
874
+
return 0;
875
+
}
876
+
else {
877
+
Z_ARG(v);
878
+
Z_MARK_SLOW;
879
+
if (!size_v) { *r = 0; return 0; }
880
+
else if (sign_v || size_v > 1) return 1;
881
+
else {
882
+
uintnat x = *ptr_v;
883
+
#ifdef ARCH_SIXTYFOUR
884
+
if (x >= Z_HI_UINT32) return 1;
885
+
#endif
886
+
*r = x;
887
+
return 0;
888
+
}
889
+
}
890
+
}
891
+
892
+
CAMLprim value ml_z_to_int32_unsigned(value v)
893
+
{
894
+
uint32_t x;
895
+
if (ml_to_int32_unsigned(v, &x)) ml_z_raise_overflow();
896
+
return caml_copy_int32(x);
897
+
}
898
+
899
+
CAMLprim value ml_z_fits_int32_unsigned(value v)
900
+
{
901
+
uint32_t x;
902
+
if (ml_to_int32_unsigned(v, &x)) return Val_false;
903
+
return Val_true;
904
+
}
905
+
906
+
static int ml_to_int64(value v, int64_t* r)
907
+
{
908
+
int64_t x;
909
+
Z_DECL(v);
910
+
Z_MARK_OP;
911
+
Z_CHECK(v);
912
+
if (Is_long(v)) { *r = Long_val(v); return 0; }
913
+
Z_MARK_SLOW;
914
+
Z_ARG(v);
915
+
switch (size_v) {
916
+
case 0: x = 0; break;
917
+
case 1: x = ptr_v[0]; break;
918
+
#ifndef ARCH_SIXTYFOUR
919
+
case 2: x = ptr_v[0] | ((uint64_t)ptr_v[1] << 32); break;
920
+
#endif
921
+
default: return 1;
922
+
}
923
+
if (sign_v) {
924
+
if ((uint64_t)x > Z_HI_INT64) return 1;
925
+
*r = -x;
926
+
}
927
+
else {
928
+
if ((uint64_t)x >= Z_HI_INT64) return 1;
929
+
*r = x;
930
+
}
931
+
return 0;
932
+
}
933
+
934
+
CAMLprim value ml_z_to_int64(value v)
935
+
{
936
+
int64_t x;
937
+
if (ml_to_int64(v, &x)) ml_z_raise_overflow();
938
+
return caml_copy_int64(x);
939
+
}
940
+
941
+
CAMLprim value ml_z_fits_int64(value v)
942
+
{
943
+
int64_t x;
944
+
if (ml_to_int64(v, &x)) return Val_false;
945
+
return Val_true;
946
+
}
947
+
948
+
static int ml_to_int64_unsigned(value v, uint64_t* r)
949
+
{
950
+
Z_DECL(v);
951
+
Z_MARK_OP;
952
+
Z_CHECK(v);
953
+
if (Is_long(v)) {
954
+
intnat x = Long_val(v);
955
+
if (x < 0) return 1;
956
+
*r = x;
957
+
return 0;
958
+
}
959
+
Z_MARK_SLOW;
960
+
Z_ARG(v);
961
+
if (sign_v) return 1;
962
+
switch (size_v) {
963
+
case 0: *r = 0; return 0;
964
+
case 1: *r = ptr_v[0]; return 0;
965
+
#ifndef ARCH_SIXTYFOUR
966
+
case 2: *r = ptr_v[0] | ((uint64_t) ptr_v[1] << 32); return 0;
967
+
#endif
968
+
default: return 1;
969
+
}
970
+
}
971
+
972
+
CAMLprim value ml_z_to_int64_unsigned(value v)
973
+
{
974
+
uint64_t x;
975
+
if (ml_to_int64_unsigned(v, &x)) ml_z_raise_overflow();
976
+
return caml_copy_int64(x);
977
+
}
978
+
979
+
CAMLprim value ml_z_fits_int64_unsigned(value v)
980
+
{
981
+
uint64_t x;
982
+
if (ml_to_int64_unsigned(v, &x)) return Val_false;
983
+
return Val_true;
984
+
}
985
+
986
+
/* XXX: characters that do not belong to the format are ignored, this departs
987
+
from the classic printf behavior (it copies them in the output)
988
+
*/
989
+
CAMLprim value ml_z_format(value f, value v)
990
+
{
991
+
CAMLparam2(f,v);
992
+
Z_DECL(v);
993
+
const char tab[2][16] =
994
+
{ { '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' },
995
+
{ '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f' } };
996
+
char* buf, *dst;
997
+
mp_size_t i, size_dst, max_size;
998
+
value r;
999
+
const char* fmt = String_val(f);
1000
+
int base = 10; /* base */
1001
+
int cas = 0; /* uppercase X / lowercase x */
1002
+
int width = 0;
1003
+
int alt = 0; /* alternate # */
1004
+
int dir = 0; /* right / left adjusted */
1005
+
char sign = 0; /* sign char */
1006
+
char pad = ' '; /* padding char */
1007
+
char *prefix = "";
1008
+
Z_MARK_OP;
1009
+
Z_CHECK(v);
1010
+
Z_ARG(v);
1011
+
Z_MARK_SLOW;
1012
+
1013
+
/* parse format */
1014
+
while (*fmt == '%') fmt++;
1015
+
for (; ; fmt++) {
1016
+
if (*fmt == '#') alt = 1;
1017
+
else if (*fmt == '0') pad = '0';
1018
+
else if (*fmt == '-') dir = 1;
1019
+
else if (*fmt == ' ' || *fmt == '+') sign = *fmt;
1020
+
else break;
1021
+
}
1022
+
if (sign_v) sign = '-';
1023
+
for (;*fmt>='0' && *fmt<='9';fmt++)
1024
+
width = 10*width + *fmt-'0';
1025
+
switch (*fmt) {
1026
+
case 'i': case 'd': case 'u': break;
1027
+
case 'b': base = 2; if (alt) prefix = "0b"; break;
1028
+
case 'o': base = 8; if (alt) prefix = "0o"; break;
1029
+
case 'x': base = 16; if (alt) prefix = "0x"; cas = 1; break;
1030
+
case 'X': base = 16; if (alt) prefix = "0X"; break;
1031
+
default: caml_invalid_argument("Z.format: invalid format");
1032
+
}
1033
+
if (dir) pad = ' ';
1034
+
/* get digits */
1035
+
/* we need space for sign + prefix + digits + 1 + padding + terminal 0 */
1036
+
max_size = 1 + 2 + Z_LIMB_BITS * size_v + 1 + 2 * width + 1;
1037
+
buf = (char*) malloc(max_size);
1038
+
dst = buf + 1 + 2 + width;
1039
+
if (!size_v) {
1040
+
size_dst = 1;
1041
+
*dst = '0';
1042
+
}
1043
+
else {
1044
+
mp_limb_t* copy_v = ml_z_dup_limb(ptr_v, size_v);
1045
+
size_dst = mpn_get_str((unsigned char*)dst, base, copy_v, size_v);
1046
+
if (dst + size_dst >= buf + max_size)
1047
+
caml_failwith("Z.format: internal error");
1048
+
free(copy_v);
1049
+
while (size_dst && !*dst) { dst++; size_dst--; }
1050
+
for (i = 0; i < size_dst; i++)
1051
+
dst[i] = tab[cas][ (int) dst[i] ];
1052
+
}
1053
+
/* add prefix, sign & padding */
1054
+
if (pad == ' ') {
1055
+
if (dir) {
1056
+
/* left alignment */
1057
+
for (i = strlen(prefix); i > 0; i--, size_dst++)
1058
+
*(--dst) = prefix[i-1];
1059
+
if (sign) { *(--dst) = sign; size_dst++; }
1060
+
for (; size_dst < width; size_dst++)
1061
+
dst[size_dst] = pad;
1062
+
}
1063
+
else {
1064
+
/* right alignment, space padding */
1065
+
for (i = strlen(prefix); i > 0; i--, size_dst++)
1066
+
*(--dst) = prefix[i-1];
1067
+
if (sign) { *(--dst) = sign; size_dst++; }
1068
+
for (; size_dst < width; size_dst++) *(--dst) = pad;
1069
+
}
1070
+
}
1071
+
else {
1072
+
/* right alignment, non-space padding */
1073
+
width -= strlen(prefix) + (sign ? 1 : 0);
1074
+
for (; size_dst < width; size_dst++) *(--dst) = pad;
1075
+
for (i = strlen(prefix); i > 0; i--, size_dst++)
1076
+
*(--dst) = prefix[i-1];
1077
+
if (sign) { *(--dst) = sign; size_dst++; }
1078
+
}
1079
+
dst[size_dst] = 0;
1080
+
if (dst < buf || dst + size_dst >= buf + max_size)
1081
+
caml_failwith("Z.format: internal error");
1082
+
r = caml_copy_string(dst);
1083
+
free(buf);
1084
+
CAMLreturn(r);
1085
+
}
1086
+
1087
+
/* Fast path since len < BITS_PER_WORD */
1088
+
CAMLprim value ml_z_extract_small(value arg, value off, value len)
1089
+
{
1090
+
Z_DECL(arg);
1091
+
uintnat o, l; /* caml code ensures off and len are non signed */
1092
+
intnat x;
1093
+
mp_size_t c1, c2, csz, i;
1094
+
mp_limb_t cr;
1095
+
Z_ARG(arg);
1096
+
o = (uintnat)Long_val(off);
1097
+
l = (uintnat)Long_val(len);
1098
+
c1 = o / Z_LIMB_BITS;
1099
+
c2 = o % Z_LIMB_BITS;
1100
+
csz = size_arg - c1;
1101
+
if (csz > 0) {
1102
+
if (c2) {
1103
+
x = ptr_arg[c1] >> c2;
1104
+
if ((c2 + l > (intnat)Z_LIMB_BITS) && (csz > 1))
1105
+
x |= (ptr_arg[c1 + 1] << (Z_LIMB_BITS - c2));
1106
+
}
1107
+
else x = ptr_arg[c1];
1108
+
}
1109
+
else x = 0;
1110
+
if (sign_arg) {
1111
+
x = ~x;
1112
+
if (csz > 0) {
1113
+
/* carry (cr=0 if all shifted-out bits are 0) */
1114
+
cr = ptr_arg[c1] & (((intnat)1 << c2) - 1);
1115
+
for (i = 0; !cr && i < c1; i++)
1116
+
cr = ptr_arg[i];
1117
+
if (!cr) x ++;
1118
+
}
1119
+
}
1120
+
x &= ((intnat)1 << l) - 1;
1121
+
return Val_long(x);
1122
+
}
1123
+
1124
+
CAMLprim value ml_z_extract(value arg, value off, value len)
1125
+
{
1126
+
uintnat o, l; /* caml code ensures off and len are non signed */
1127
+
intnat x;
1128
+
mp_size_t sz, c1, c2, csz, i;
1129
+
mp_limb_t cr;
1130
+
value r;
1131
+
Z_DECL(arg);
1132
+
Z_MARK_OP;
1133
+
MAYBE_UNUSED x;
1134
+
o = (uintnat)Long_val(off);
1135
+
l = (uintnat)Long_val(len);
1136
+
Z_MARK_SLOW;
1137
+
{
1138
+
CAMLparam1(arg);
1139
+
Z_ARG(arg);
1140
+
sz = (l + Z_LIMB_BITS - 1) / Z_LIMB_BITS;
1141
+
r = ml_z_alloc(sz + 1);
1142
+
Z_REFRESH(arg);
1143
+
c1 = o / Z_LIMB_BITS;
1144
+
c2 = o % Z_LIMB_BITS;
1145
+
/* shift or copy */
1146
+
csz = size_arg - c1;
1147
+
if (csz > sz + 1) csz = sz + 1;
1148
+
cr = 0;
1149
+
if (csz > 0) {
1150
+
if (c2) cr = mpn_rshift(Z_LIMB(r), ptr_arg + c1, csz, c2);
1151
+
else ml_z_cpy_limb(Z_LIMB(r), ptr_arg + c1, csz);
1152
+
}
1153
+
else csz = 0;
1154
+
/* 0-pad */
1155
+
for (i = csz; i < sz; i++)
1156
+
Z_LIMB(r)[i] = 0;
1157
+
/* 2's complement */
1158
+
if (sign_arg) {
1159
+
for (i = 0; i < sz; i++)
1160
+
Z_LIMB(r)[i] = ~Z_LIMB(r)[i];
1161
+
/* carry (cr=0 if all shifted-out bits are 0) */
1162
+
for (i = 0; !cr && i < c1 && i < size_arg; i++)
1163
+
cr = ptr_arg[i];
1164
+
if (!cr) mpn_add_1(Z_LIMB(r), Z_LIMB(r), sz, 1);
1165
+
}
1166
+
/* mask out high bits */
1167
+
l %= Z_LIMB_BITS;
1168
+
if (l) Z_LIMB(r)[sz-1] &= ((uintnat)(intnat)-1) >> (Z_LIMB_BITS - l);
1169
+
r = ml_z_reduce(r, sz, 0);
1170
+
CAMLreturn(r);
1171
+
}
1172
+
}
1173
+
1174
+
/* NOTE: the sign is not stored */
1175
+
CAMLprim value ml_z_to_bits(value arg)
1176
+
{
1177
+
CAMLparam1(arg);
1178
+
CAMLlocal1(r);
1179
+
Z_DECL(arg);
1180
+
mp_size_t i;
1181
+
unsigned char* p;
1182
+
Z_MARK_OP;
1183
+
Z_MARK_SLOW;
1184
+
Z_ARG(arg);
1185
+
r = caml_alloc_string(size_arg * sizeof(mp_limb_t));
1186
+
Z_REFRESH(arg);
1187
+
p = (unsigned char*) String_val(r);
1188
+
memset(p, 0, size_arg * sizeof(mp_limb_t));
1189
+
for (i = 0; i < size_arg; i++) {
1190
+
mp_limb_t x = ptr_arg[i];
1191
+
*(p++) = x;
1192
+
*(p++) = x >> 8;
1193
+
*(p++) = x >> 16;
1194
+
*(p++) = x >> 24;
1195
+
#ifdef ARCH_SIXTYFOUR
1196
+
*(p++) = x >> 32;
1197
+
*(p++) = x >> 40;
1198
+
*(p++) = x >> 48;
1199
+
*(p++) = x >> 56;
1200
+
#endif
1201
+
}
1202
+
CAMLreturn(r);
1203
+
}
1204
+
1205
+
CAMLprim value ml_z_of_bits(value arg)
1206
+
{
1207
+
CAMLparam1(arg);
1208
+
CAMLlocal1(r);
1209
+
mp_size_t sz, szw;
1210
+
mp_size_t i = 0;
1211
+
mp_limb_t x;
1212
+
const unsigned char* p;
1213
+
Z_MARK_OP;
1214
+
Z_MARK_SLOW;
1215
+
sz = caml_string_length(arg);
1216
+
szw = (sz + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t);
1217
+
r = ml_z_alloc(szw);
1218
+
p = (const unsigned char*) String_val(arg);
1219
+
/* all limbs but last */
1220
+
if (szw > 1) {
1221
+
for (; i < szw - 1; i++) {
1222
+
x = *(p++);
1223
+
x |= ((mp_limb_t) *(p++)) << 8;
1224
+
x |= ((mp_limb_t) *(p++)) << 16;
1225
+
x |= ((mp_limb_t) *(p++)) << 24;
1226
+
#ifdef ARCH_SIXTYFOUR
1227
+
x |= ((mp_limb_t) *(p++)) << 32;
1228
+
x |= ((mp_limb_t) *(p++)) << 40;
1229
+
x |= ((mp_limb_t) *(p++)) << 48;
1230
+
x |= ((mp_limb_t) *(p++)) << 56;
1231
+
#endif
1232
+
Z_LIMB(r)[i] = x;
1233
+
}
1234
+
sz -= i * sizeof(mp_limb_t);
1235
+
}
1236
+
/* last limb */
1237
+
if (sz > 0) {
1238
+
x = *(p++);
1239
+
if (sz > 1) x |= ((mp_limb_t) *(p++)) << 8;
1240
+
if (sz > 2) x |= ((mp_limb_t) *(p++)) << 16;
1241
+
if (sz > 3) x |= ((mp_limb_t) *(p++)) << 24;
1242
+
#ifdef ARCH_SIXTYFOUR
1243
+
if (sz > 4) x |= ((mp_limb_t) *(p++)) << 32;
1244
+
if (sz > 5) x |= ((mp_limb_t) *(p++)) << 40;
1245
+
if (sz > 6) x |= ((mp_limb_t) *(p++)) << 48;
1246
+
if (sz > 7) x |= ((mp_limb_t) *(p++)) << 56;
1247
+
#endif
1248
+
Z_LIMB(r)[i] = x;
1249
+
}
1250
+
r = ml_z_reduce(r, szw, 0);
1251
+
Z_CHECK(r);
1252
+
CAMLreturn(r);
1253
+
}
1254
+
1255
+
/*---------------------------------------------------
1256
+
TESTS AND COMPARISONS
1257
+
---------------------------------------------------*/
1258
+
1259
+
CAMLprim value ml_z_compare(value arg1, value arg2)
1260
+
{
1261
+
int r;
1262
+
Z_DECL(arg1); Z_DECL(arg2);
1263
+
Z_MARK_OP;
1264
+
Z_CHECK(arg1); Z_CHECK(arg2);
1265
+
#if Z_FAST_PATH
1266
+
/* Value-equal small integers are equal.
1267
+
Pointer-equal big integers are equal as well. */
1268
+
if (arg1 == arg2) return Val_long(0);
1269
+
if (Is_long(arg2)) {
1270
+
if (Is_long(arg1)) {
1271
+
return arg1 > arg2 ? Val_long(1) : Val_long(-1);
1272
+
} else {
1273
+
/* Either arg1 is positive and arg1 > Z_MAX_INT >= arg2 -> result +1
1274
+
or arg1 is negative and arg1 < Z_MIN_INT <= arg2 -> result -1 */
1275
+
return Z_SIGN(arg1) ? Val_long(-1) : Val_long(1);
1276
+
}
1277
+
}
1278
+
else if (Is_long(arg1)) {
1279
+
/* Either arg2 is positive and arg2 > Z_MAX_INT >= arg1 -> result -1
1280
+
or arg2 is negative and arg2 < Z_MIN_INT <= arg1 -> result +1 */
1281
+
return Z_SIGN(arg2) ? Val_long(1) : Val_long(-1);
1282
+
}
1283
+
#endif
1284
+
/* mpn_ version */
1285
+
Z_MARK_SLOW;
1286
+
Z_ARG(arg1);
1287
+
Z_ARG(arg2);
1288
+
r = 0;
1289
+
if (sign_arg1 != sign_arg2) r = 1;
1290
+
else if (size_arg1 > size_arg2) r = 1;
1291
+
else if (size_arg1 < size_arg2) r = -1;
1292
+
else {
1293
+
mp_size_t i;
1294
+
for (i = size_arg1 - 1; i >= 0; i--) {
1295
+
if (ptr_arg1[i] > ptr_arg2[i]) { r = 1; break; }
1296
+
if (ptr_arg1[i] < ptr_arg2[i]) { r = -1; break; }
1297
+
}
1298
+
}
1299
+
if (sign_arg1) r = -r;
1300
+
return Val_long(r);
1301
+
}
1302
+
1303
+
CAMLprim value ml_z_equal(value arg1, value arg2)
1304
+
{
1305
+
mp_size_t i;
1306
+
Z_DECL(arg1); Z_DECL(arg2);
1307
+
Z_MARK_OP;
1308
+
Z_CHECK(arg1); Z_CHECK(arg2);
1309
+
#if Z_FAST_PATH
1310
+
/* Value-equal small integers are equal.
1311
+
Pointer-equal big integers are equal as well. */
1312
+
if (arg1 == arg2) return Val_true;
1313
+
/* If both arg1 and arg2 are small integers but failed the equality
1314
+
test above, they are different.
1315
+
If one of arg1/arg2 is a small integer and the other is a big integer,
1316
+
they are different: one is in the range [Z_MIN_INT,Z_MAX_INT]
1317
+
and the other is outside this range. */
1318
+
if (Is_long(arg2) || Is_long(arg1)) return Val_false;
1319
+
#endif
1320
+
/* mpn_ version */
1321
+
Z_MARK_SLOW;
1322
+
Z_ARG(arg1);
1323
+
Z_ARG(arg2);
1324
+
if (sign_arg1 != sign_arg2 || size_arg1 != size_arg2) return Val_false;
1325
+
for (i = 0; i < size_arg1; i++)
1326
+
if (ptr_arg1[i] != ptr_arg2[i]) return Val_false;
1327
+
return Val_true;
1328
+
}
1329
+
1330
+
int ml_z_sgn(value arg)
1331
+
{
1332
+
if (Is_long(arg)) {
1333
+
if (arg > Val_long(0)) return 1;
1334
+
else if (arg < Val_long(0)) return -1;
1335
+
else return 0;
1336
+
}
1337
+
else {
1338
+
Z_MARK_SLOW;
1339
+
#if !Z_USE_NATINT
1340
+
/* In "use natint" mode, zero is a small integer, treated above */
1341
+
if (!Z_SIZE(arg)) return 0;
1342
+
#endif
1343
+
if (Z_SIGN(arg)) return -1; else return 1;
1344
+
}
1345
+
}
1346
+
CAMLprim value ml_z_sign(value arg)
1347
+
{
1348
+
Z_MARK_OP;
1349
+
Z_CHECK(arg);
1350
+
return Val_long(ml_z_sgn(arg));
1351
+
}
1352
+
1353
+
CAMLprim value ml_z_size(value v)
1354
+
{
1355
+
Z_MARK_OP;
1356
+
if (Is_long(v)) return Val_long(1);
1357
+
else return Val_long(Z_SIZE(v));
1358
+
}
1359
+
1360
+
1361
+
/*---------------------------------------------------
1362
+
ARITHMETIC OPERATORS
1363
+
---------------------------------------------------*/
1364
+
1365
+
CAMLprim value ml_z_neg(value arg)
1366
+
{
1367
+
Z_MARK_OP;
1368
+
Z_CHECK(arg);
1369
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1370
+
if (Is_long(arg)) {
1371
+
/* fast path */
1372
+
if (arg > Val_long(Z_MIN_INT)) return 2 - arg;
1373
+
}
1374
+
#endif
1375
+
/* mpn_ version */
1376
+
Z_MARK_SLOW;
1377
+
{
1378
+
CAMLparam1(arg);
1379
+
value r;
1380
+
Z_DECL(arg);
1381
+
Z_ARG(arg);
1382
+
r = ml_z_alloc(size_arg);
1383
+
Z_REFRESH(arg);
1384
+
ml_z_cpy_limb(Z_LIMB(r), ptr_arg, size_arg);
1385
+
r = ml_z_reduce(r, size_arg, sign_arg ^ Z_SIGN_MASK);
1386
+
Z_CHECK(r);
1387
+
CAMLreturn(r);
1388
+
}
1389
+
}
1390
+
1391
+
CAMLprim value ml_z_abs(value arg)
1392
+
{
1393
+
Z_MARK_OP;
1394
+
Z_CHECK(arg);
1395
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1396
+
if (Is_long(arg)) {
1397
+
/* fast path */
1398
+
if (arg >= Val_long(0)) return arg;
1399
+
if (arg > Val_long(Z_MIN_INT)) return 2 - arg;
1400
+
}
1401
+
#endif
1402
+
/* mpn_ version */
1403
+
Z_MARK_SLOW;
1404
+
{
1405
+
CAMLparam1(arg);
1406
+
Z_DECL(arg);
1407
+
value r;
1408
+
Z_ARG(arg);
1409
+
if (sign_arg) {
1410
+
r = ml_z_alloc(size_arg);
1411
+
Z_REFRESH(arg);
1412
+
ml_z_cpy_limb(Z_LIMB(r), ptr_arg, size_arg);
1413
+
r = ml_z_reduce(r, size_arg, 0);
1414
+
Z_CHECK(r);
1415
+
}
1416
+
else r = arg;
1417
+
CAMLreturn(r);
1418
+
}
1419
+
}
1420
+
1421
+
/* helper function for add/sub */
1422
+
static value ml_z_addsub(value arg1, value arg2, intnat sign)
1423
+
{
1424
+
CAMLparam2(arg1,arg2);
1425
+
Z_DECL(arg1); Z_DECL(arg2);
1426
+
value r;
1427
+
mp_limb_t c;
1428
+
Z_ARG(arg1);
1429
+
Z_ARG(arg2);
1430
+
sign_arg2 ^= sign;
1431
+
if (!size_arg2) r = arg1;
1432
+
else if (!size_arg1) {
1433
+
if (sign) {
1434
+
/* negation */
1435
+
r = ml_z_alloc(size_arg2);
1436
+
Z_REFRESH(arg2);
1437
+
ml_z_cpy_limb(Z_LIMB(r), ptr_arg2, size_arg2);
1438
+
r = ml_z_reduce(r, size_arg2, sign_arg2);
1439
+
}
1440
+
else r = arg2;
1441
+
}
1442
+
else if (sign_arg1 == sign_arg2) {
1443
+
/* addition */
1444
+
if (size_arg1 >= size_arg2) {
1445
+
r = ml_z_alloc(size_arg1 + 1);
1446
+
Z_REFRESH(arg1);
1447
+
Z_REFRESH(arg2);
1448
+
c = mpn_add(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2, size_arg2);
1449
+
Z_LIMB(r)[size_arg1] = c;
1450
+
r = ml_z_reduce(r, size_arg1+1, sign_arg1);
1451
+
}
1452
+
else {
1453
+
r = ml_z_alloc(size_arg2 + 1);
1454
+
Z_REFRESH(arg1);
1455
+
Z_REFRESH(arg2);
1456
+
c = mpn_add(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1, size_arg1);
1457
+
Z_LIMB(r)[size_arg2] = c;
1458
+
r = ml_z_reduce(r, size_arg2+1, sign_arg1);
1459
+
}
1460
+
}
1461
+
else {
1462
+
/* subtraction */
1463
+
if (size_arg1 > size_arg2) {
1464
+
r = ml_z_alloc(size_arg1);
1465
+
Z_REFRESH(arg1);
1466
+
Z_REFRESH(arg2);
1467
+
mpn_sub(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2, size_arg2);
1468
+
r = ml_z_reduce(r, size_arg1, sign_arg1);
1469
+
}
1470
+
else if (size_arg1 < size_arg2) {
1471
+
r = ml_z_alloc(size_arg2);
1472
+
Z_REFRESH(arg1);
1473
+
Z_REFRESH(arg2);
1474
+
mpn_sub(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1, size_arg1);
1475
+
r = ml_z_reduce(r, size_arg2, sign_arg2);
1476
+
}
1477
+
else {
1478
+
int cmp = mpn_cmp(ptr_arg1, ptr_arg2, size_arg1);
1479
+
if (cmp > 0) {
1480
+
r = ml_z_alloc(size_arg1+1);
1481
+
Z_REFRESH(arg1);
1482
+
Z_REFRESH(arg2);
1483
+
mpn_sub_n(Z_LIMB(r), ptr_arg1, ptr_arg2, size_arg1);
1484
+
r = ml_z_reduce(r, size_arg1, sign_arg1);
1485
+
}
1486
+
else if (cmp < 0) {
1487
+
r = ml_z_alloc(size_arg1);
1488
+
Z_REFRESH(arg1);
1489
+
Z_REFRESH(arg2);
1490
+
mpn_sub_n(Z_LIMB(r), ptr_arg2, ptr_arg1, size_arg1);
1491
+
r = ml_z_reduce(r, size_arg1, sign_arg2);
1492
+
}
1493
+
else r = Val_long(0);
1494
+
}
1495
+
}
1496
+
Z_CHECK(r);
1497
+
CAMLreturn(r);
1498
+
}
1499
+
1500
+
CAMLprim value ml_z_add(value arg1, value arg2)
1501
+
{
1502
+
Z_MARK_OP;
1503
+
Z_CHECK(arg1); Z_CHECK(arg2);
1504
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1505
+
if (Is_long(arg1) && Is_long(arg2)) {
1506
+
/* fast path */
1507
+
intnat a1 = Long_val(arg1);
1508
+
intnat a2 = Long_val(arg2);
1509
+
intnat v = a1 + a2;
1510
+
if (Z_FITS_INT(v)) return Val_long(v);
1511
+
}
1512
+
#endif
1513
+
/* mpn_ version */
1514
+
Z_MARK_SLOW;
1515
+
return ml_z_addsub(arg1, arg2, 0);
1516
+
}
1517
+
1518
+
CAMLprim value ml_z_sub(value arg1, value arg2)
1519
+
{
1520
+
Z_MARK_OP;
1521
+
Z_CHECK(arg1); Z_CHECK(arg2);
1522
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1523
+
if (Is_long(arg1) && Is_long(arg2)) {
1524
+
/* fast path */
1525
+
intnat a1 = Long_val(arg1);
1526
+
intnat a2 = Long_val(arg2);
1527
+
intnat v = a1 - a2;
1528
+
if (Z_FITS_INT(v)) return Val_long(v);
1529
+
}
1530
+
#endif
1531
+
/* mpn_ version */
1532
+
Z_MARK_SLOW;
1533
+
return ml_z_addsub(arg1, arg2, Z_SIGN_MASK);
1534
+
}
1535
+
1536
+
CAMLprim value ml_z_mul_overflows(value vx, value vy)
1537
+
{
1538
+
#if HAS_BUILTIN(__builtin_mul_overflow) || __GNUC__ >= 5
1539
+
intnat z;
1540
+
return Val_bool(__builtin_mul_overflow(vx - 1, vy >> 1, &z));
1541
+
#elif defined(__GNUC__) && defined(__x86_64__)
1542
+
intnat z;
1543
+
unsigned char o;
1544
+
asm("imulq %1, %3; seto %0"
1545
+
: "=q" (o), "=r" (z)
1546
+
: "1" (vx - 1), "r" (vy >> 1)
1547
+
: "cc");
1548
+
return Val_int(o);
1549
+
#elif defined(_MSC_VER) && defined(_M_X64)
1550
+
intnat hi, lo;
1551
+
lo = _mul128(vx - 1, vy >> 1, &hi);
1552
+
return Val_bool(hi != lo >> 63);
1553
+
#else
1554
+
/* Portable C code */
1555
+
intnat x = Long_val(vx);
1556
+
intnat y = Long_val(vy);
1557
+
/* Quick approximate check for small values of x and y.
1558
+
Also catches the cases x = 0, x = 1, y = 0, y = 1. */
1559
+
if (Z_FITS_HINT(x)) {
1560
+
if (Z_FITS_HINT(y)) return Val_false;
1561
+
if ((uintnat) x <= 1) return Val_false;
1562
+
}
1563
+
if ((uintnat) y <= 1) return Val_false;
1564
+
#if 1
1565
+
/* Give up at this point; we'll go through the general case in ml_z_mul */
1566
+
return Val_true;
1567
+
#else
1568
+
/* The product x*y is representable as an unboxed integer if
1569
+
it is in [Z_MIN_INT, Z_MAX_INT].
1570
+
x >= 0 y >= 0: x*y >= 0 and x*y <= Z_MAX_INT <-> y <= Z_MAX_INT / x
1571
+
x < 0 y >= 0: x*y <= 0 and x*y >= Z_MIN_INT <-> x >= Z_MIN_INT / y
1572
+
x >= 0 y < 0 : x*y <= 0 and x*y >= Z_MIN_INT <-> y >= Z_MIN_INT / x
1573
+
x < 0 y < 0 : x*y >= 0 and x*y <= Z_MAX_INT <-> x >= Z_MAX_INT / y */
1574
+
if (x >= 0)
1575
+
if (y >= 0)
1576
+
return Val_bool(y > Z_MAX_INT / x);
1577
+
else
1578
+
return Val_bool(y < Z_MIN_INT / x);
1579
+
else
1580
+
if (y >= 0)
1581
+
return Val_bool(x < Z_MIN_INT / y);
1582
+
else
1583
+
return Val_bool(x < Z_MAX_INT / y);
1584
+
#endif
1585
+
#endif
1586
+
}
1587
+
1588
+
CAMLprim value ml_z_mul(value arg1, value arg2)
1589
+
{
1590
+
Z_DECL(arg1); Z_DECL(arg2);
1591
+
Z_MARK_OP;
1592
+
Z_CHECK(arg1); Z_CHECK(arg2);
1593
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1594
+
if (Is_long(arg1) && Is_long(arg2) &&
1595
+
ml_z_mul_overflows(arg1, arg2) == Val_false) {
1596
+
return Val_long(Long_val(arg1) * Long_val(arg2));
1597
+
}
1598
+
#endif
1599
+
/* mpn_ version */
1600
+
Z_MARK_SLOW;
1601
+
Z_ARG(arg1);
1602
+
Z_ARG(arg2);
1603
+
if (!size_arg1 || !size_arg2) return Val_long(0);
1604
+
{
1605
+
CAMLparam2(arg1,arg2);
1606
+
value r = ml_z_alloc(size_arg1 + size_arg2);
1607
+
mp_limb_t c;
1608
+
Z_REFRESH(arg1);
1609
+
Z_REFRESH(arg2);
1610
+
if (size_arg2 == 1) {
1611
+
c = mpn_mul_1(Z_LIMB(r), ptr_arg1, size_arg1, *ptr_arg2);
1612
+
Z_LIMB(r)[size_arg1] = c;
1613
+
}
1614
+
else if (size_arg1 == 1) {
1615
+
c = mpn_mul_1(Z_LIMB(r), ptr_arg2, size_arg2, *ptr_arg1);
1616
+
Z_LIMB(r)[size_arg2] = c;
1617
+
}
1618
+
#if HAVE_NATIVE_mpn_mul_2 /* untested */
1619
+
else if (size_arg2 == 2) {
1620
+
c = mpn_mul_2(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2);
1621
+
Z_LIMB(r)[size_arg1 + 1] = c;
1622
+
}
1623
+
else if (size_arg1 == 2) {
1624
+
c = mpn_mul_2(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1);
1625
+
Z_LIMB(r)[size_arg2 + 1] = c;
1626
+
}
1627
+
#endif
1628
+
else if (size_arg1 > size_arg2)
1629
+
mpn_mul(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2, size_arg2);
1630
+
else if (size_arg1 < size_arg2)
1631
+
mpn_mul(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1, size_arg1);
1632
+
/* older GMP don't have mpn_sqr, so we make the optimisation optional */
1633
+
#ifdef mpn_sqr
1634
+
else if (ptr_arg1 == ptr_arg2)
1635
+
mpn_sqr(Z_LIMB(r), ptr_arg1, size_arg1);
1636
+
#endif
1637
+
else
1638
+
mpn_mul_n(Z_LIMB(r), ptr_arg1, ptr_arg2, size_arg1);
1639
+
r = ml_z_reduce(r, size_arg1 + size_arg2, sign_arg1^sign_arg2);
1640
+
Z_CHECK(r);
1641
+
CAMLreturn(r);
1642
+
}
1643
+
}
1644
+
1645
+
/* helper function for division: returns truncated quotient and remainder */
1646
+
static value ml_z_tdiv_qr(value arg1, value arg2)
1647
+
{
1648
+
CAMLparam2(arg1, arg2);
1649
+
CAMLlocal3(q, r, p);
1650
+
Z_DECL(arg1); Z_DECL(arg2);
1651
+
Z_ARG(arg1); Z_ARG(arg2);
1652
+
if (!size_arg2) ml_z_raise_divide_by_zero();
1653
+
if (size_arg1 >= size_arg2) {
1654
+
q = ml_z_alloc(size_arg1 - size_arg2 + 1);
1655
+
r = ml_z_alloc(size_arg2);
1656
+
Z_REFRESH(arg1); Z_REFRESH(arg2);
1657
+
mpn_tdiv_qr(Z_LIMB(q), Z_LIMB(r), 0,
1658
+
ptr_arg1, size_arg1, ptr_arg2, size_arg2);
1659
+
q = ml_z_reduce(q, size_arg1 - size_arg2 + 1, sign_arg1 ^ sign_arg2);
1660
+
r = ml_z_reduce(r, size_arg2, sign_arg1);
1661
+
}
1662
+
else {
1663
+
q = Val_long(0);
1664
+
r = arg1;
1665
+
}
1666
+
Z_CHECK(q);
1667
+
Z_CHECK(r);
1668
+
p = caml_alloc_small(2, 0);
1669
+
Field(p,0) = q;
1670
+
Field(p,1) = r;
1671
+
CAMLreturn(p);
1672
+
}
1673
+
1674
+
CAMLprim value ml_z_div_rem(value arg1, value arg2)
1675
+
{
1676
+
Z_MARK_OP;
1677
+
Z_CHECK(arg1); Z_CHECK(arg2);
1678
+
#if Z_FAST_PATH
1679
+
if (Is_long(arg1) && Is_long(arg2)) {
1680
+
/* fast path */
1681
+
intnat a1 = Long_val(arg1);
1682
+
intnat a2 = Long_val(arg2);
1683
+
intnat q, r;
1684
+
if (!a2) ml_z_raise_divide_by_zero();
1685
+
q = a1 / a2;
1686
+
r = a1 % a2;
1687
+
if (Z_FITS_INT(q) && Z_FITS_INT(r)) {
1688
+
value p = caml_alloc_small(2, 0);
1689
+
Field(p,0) = Val_long(q);
1690
+
Field(p,1) = Val_long(r);
1691
+
return p;
1692
+
}
1693
+
}
1694
+
#endif
1695
+
/* mpn_ version */
1696
+
Z_MARK_SLOW;
1697
+
return ml_z_tdiv_qr(arg1, arg2);
1698
+
}
1699
+
1700
+
CAMLprim value ml_z_div(value arg1, value arg2)
1701
+
{
1702
+
Z_MARK_OP;
1703
+
Z_CHECK(arg1); Z_CHECK(arg2);
1704
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1705
+
if (Is_long(arg1) && Is_long(arg2)) {
1706
+
/* fast path */
1707
+
intnat a1 = Long_val(arg1);
1708
+
intnat a2 = Long_val(arg2);
1709
+
intnat q;
1710
+
if (!a2) ml_z_raise_divide_by_zero();
1711
+
q = a1 / a2;
1712
+
if (Z_FITS_INT(q)) return Val_long(q);
1713
+
}
1714
+
#endif
1715
+
/* mpn_ version */
1716
+
Z_MARK_SLOW;
1717
+
return Field(ml_z_tdiv_qr(arg1, arg2), 0);
1718
+
}
1719
+
1720
+
CAMLprim value ml_z_rem(value arg1, value arg2)
1721
+
{
1722
+
Z_MARK_OP;
1723
+
Z_CHECK(arg1); Z_CHECK(arg2);
1724
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1725
+
if (Is_long(arg1) && Is_long(arg2)) {
1726
+
/* fast path */
1727
+
intnat a1 = Long_val(arg1);
1728
+
intnat a2 = Long_val(arg2);
1729
+
intnat r;
1730
+
if (!a2) ml_z_raise_divide_by_zero();
1731
+
r = a1 % a2;
1732
+
if (Z_FITS_INT(r)) return Val_long(r);
1733
+
}
1734
+
#endif
1735
+
/* mpn_ version */
1736
+
Z_MARK_SLOW;
1737
+
return Field(ml_z_tdiv_qr(arg1, arg2), 1);
1738
+
}
1739
+
1740
+
/* helper function for division with rounding towards +oo / -oo */
1741
+
static value ml_z_rdiv(value arg1, value arg2, intnat dir)
1742
+
{
1743
+
CAMLparam2(arg1, arg2);
1744
+
CAMLlocal2(q, r);
1745
+
Z_DECL(arg1); Z_DECL(arg2);
1746
+
Z_ARG(arg1); Z_ARG(arg2);
1747
+
if (!size_arg2) ml_z_raise_divide_by_zero();
1748
+
if (size_arg1 >= size_arg2) {
1749
+
mp_limb_t c = 0;
1750
+
q = ml_z_alloc(size_arg1 - size_arg2 + 2);
1751
+
r = ml_z_alloc(size_arg2);
1752
+
Z_REFRESH(arg1); Z_REFRESH(arg2);
1753
+
mpn_tdiv_qr(Z_LIMB(q), Z_LIMB(r), 0,
1754
+
ptr_arg1, size_arg1, ptr_arg2, size_arg2);
1755
+
if ((sign_arg1 ^ sign_arg2) == dir) {
1756
+
/* outward rounding */
1757
+
mp_size_t sz;
1758
+
for (sz = size_arg2; sz > 0 && !Z_LIMB(r)[sz-1]; sz--);
1759
+
if (sz) {
1760
+
/* r != 0: needs adjustment */
1761
+
c = mpn_add_1(Z_LIMB(q), Z_LIMB(q), size_arg1 - size_arg2 + 1, 1);
1762
+
}
1763
+
}
1764
+
Z_LIMB(q)[size_arg1 - size_arg2 + 1] = c;
1765
+
q = ml_z_reduce(q, size_arg1 - size_arg2 + 2, sign_arg1 ^ sign_arg2);
1766
+
}
1767
+
else {
1768
+
if (size_arg1 && (sign_arg1 ^ sign_arg2) == dir) {
1769
+
if (dir) q = Val_long(-1);
1770
+
else q = Val_long(1);
1771
+
}
1772
+
else q = Val_long(0);
1773
+
}
1774
+
Z_CHECK(q);
1775
+
CAMLreturn(q);
1776
+
}
1777
+
1778
+
CAMLprim value ml_z_cdiv(value arg1, value arg2)
1779
+
{
1780
+
Z_MARK_OP;
1781
+
Z_CHECK(arg1); Z_CHECK(arg2);
1782
+
#if Z_FAST_PATH
1783
+
if (Is_long(arg1) && Is_long(arg2)) {
1784
+
/* fast path */
1785
+
intnat a1 = Long_val(arg1);
1786
+
intnat a2 = Long_val(arg2);
1787
+
intnat q;
1788
+
if (!a2) ml_z_raise_divide_by_zero();
1789
+
/* adjust to round towards +oo */
1790
+
if (a1 > 0 && a2 > 0) a1 += a2-1;
1791
+
else if (a1 < 0 && a2 < 0) a1 += a2+1;
1792
+
q = a1 / a2;
1793
+
if (Z_FITS_INT(q)) return Val_long(q);
1794
+
}
1795
+
#endif
1796
+
/* mpn_ version */
1797
+
Z_MARK_SLOW;
1798
+
return ml_z_rdiv(arg1, arg2, 0);
1799
+
}
1800
+
1801
+
CAMLprim value ml_z_fdiv(value arg1, value arg2)
1802
+
{
1803
+
Z_MARK_OP;
1804
+
Z_CHECK(arg1); Z_CHECK(arg2);
1805
+
#if Z_FAST_PATH
1806
+
if (Is_long(arg1) && Is_long(arg2)) {
1807
+
/* fast path */
1808
+
intnat a1 = Long_val(arg1);
1809
+
intnat a2 = Long_val(arg2);
1810
+
intnat q;
1811
+
if (!a2) ml_z_raise_divide_by_zero();
1812
+
/* adjust to round towards -oo */
1813
+
if (a1 < 0 && a2 > 0) a1 -= a2-1;
1814
+
else if (a1 > 0 && a2 < 0) a1 -= a2+1;
1815
+
q = a1 / a2;
1816
+
if (Z_FITS_INT(q)) return Val_long(q);
1817
+
}
1818
+
#endif
1819
+
/* mpn_ version */
1820
+
Z_MARK_SLOW;
1821
+
return ml_z_rdiv(arg1, arg2, Z_SIGN_MASK);
1822
+
}
1823
+
1824
+
/* helper function for succ / pred */
1825
+
static value ml_z_succpred(value arg, intnat sign)
1826
+
{
1827
+
CAMLparam1(arg);
1828
+
Z_DECL(arg);
1829
+
value r;
1830
+
Z_ARG(arg);
1831
+
r = ml_z_alloc(size_arg + 1);
1832
+
Z_REFRESH(arg);
1833
+
if (!size_arg) {
1834
+
Z_LIMB(r)[0] = 1;
1835
+
r = ml_z_reduce(r, 1, sign);
1836
+
}
1837
+
else if (sign_arg == sign) {
1838
+
/* add 1 */
1839
+
mp_limb_t c = mpn_add_1(Z_LIMB(r), ptr_arg, size_arg, 1);
1840
+
Z_LIMB(r)[size_arg] = c;
1841
+
r = ml_z_reduce(r, size_arg + 1, sign_arg);
1842
+
}
1843
+
else {
1844
+
/* subtract 1 */
1845
+
mpn_sub_1(Z_LIMB(r), ptr_arg, size_arg, 1);
1846
+
r = ml_z_reduce(r, size_arg, sign_arg);
1847
+
}
1848
+
Z_CHECK(r);
1849
+
CAMLreturn(r);
1850
+
}
1851
+
1852
+
CAMLprim value ml_z_succ(value arg)
1853
+
{
1854
+
Z_MARK_OP;
1855
+
Z_CHECK(arg);
1856
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1857
+
if (Is_long(arg)) {
1858
+
/* fast path */
1859
+
if (arg < Val_long(Z_MAX_INT)) return arg + 2;
1860
+
}
1861
+
#endif
1862
+
/* mpn_ version */
1863
+
Z_MARK_SLOW;
1864
+
return ml_z_succpred(arg, 0);
1865
+
}
1866
+
1867
+
CAMLprim value ml_z_pred(value arg)
1868
+
{
1869
+
Z_MARK_OP;
1870
+
Z_CHECK(arg);
1871
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1872
+
if (Is_long(arg)) {
1873
+
/* fast path */
1874
+
if (arg > Val_long(Z_MIN_INT)) return arg - 2;
1875
+
}
1876
+
#endif
1877
+
/* mpn_ version */
1878
+
Z_MARK_SLOW;
1879
+
return ml_z_succpred(arg, Z_SIGN_MASK);
1880
+
}
1881
+
1882
+
CAMLprim value ml_z_sqrt(value arg)
1883
+
{
1884
+
/* XXX TODO: fast path */
1885
+
CAMLparam1(arg);
1886
+
Z_DECL(arg);
1887
+
value r;
1888
+
Z_MARK_OP;
1889
+
Z_MARK_SLOW;
1890
+
Z_CHECK(arg);
1891
+
Z_ARG(arg);
1892
+
if (sign_arg)
1893
+
caml_invalid_argument("Z.sqrt: square root of a negative number");
1894
+
if (size_arg) {
1895
+
mp_size_t sz = (size_arg + 1) / 2;
1896
+
r = ml_z_alloc(sz);
1897
+
Z_REFRESH(arg);
1898
+
mpn_sqrtrem(Z_LIMB(r), NULL, ptr_arg, size_arg);
1899
+
r = ml_z_reduce(r, sz, 0);
1900
+
}
1901
+
else r = Val_long(0);
1902
+
Z_CHECK(r);
1903
+
CAMLreturn(r);
1904
+
}
1905
+
1906
+
CAMLprim value ml_z_sqrt_rem(value arg)
1907
+
{
1908
+
CAMLparam1(arg);
1909
+
CAMLlocal3(r, s, p);
1910
+
Z_DECL(arg);
1911
+
/* XXX TODO: fast path */
1912
+
Z_MARK_OP;
1913
+
Z_MARK_SLOW;
1914
+
Z_CHECK(arg);
1915
+
Z_ARG(arg);
1916
+
if (sign_arg)
1917
+
caml_invalid_argument("Z.sqrt_rem: square root of a negative number");
1918
+
if (size_arg) {
1919
+
mp_size_t sz = (size_arg + 1) / 2, sz2;
1920
+
r = ml_z_alloc(sz);
1921
+
s = ml_z_alloc(size_arg);
1922
+
Z_REFRESH(arg);
1923
+
sz2 = mpn_sqrtrem(Z_LIMB(r), Z_LIMB(s), ptr_arg, size_arg);
1924
+
r = ml_z_reduce(r, sz, 0);
1925
+
s = ml_z_reduce(s, sz2, 0);
1926
+
}
1927
+
else r = s = Val_long(0);
1928
+
Z_CHECK(r);
1929
+
Z_CHECK(s);
1930
+
p = caml_alloc_small(2, 0);
1931
+
Field(p,0) = r;
1932
+
Field(p,1) = s;
1933
+
CAMLreturn(p);
1934
+
}
1935
+
1936
+
CAMLprim value ml_z_gcd(value arg1, value arg2)
1937
+
{
1938
+
Z_MARK_OP;
1939
+
Z_CHECK(arg1); Z_CHECK(arg2);
1940
+
#if Z_FAST_PATH
1941
+
if (Is_long(arg1) && Is_long(arg2)) {
1942
+
/* fast path */
1943
+
intnat a1 = Long_val(arg1);
1944
+
intnat a2 = Long_val(arg2);
1945
+
if (a1 < 0) a1 = -a1;
1946
+
if (a2 < 0) a2 = -a2;
1947
+
if (a1 < a2) { intnat t = a1; a1 = a2; a2 = t; }
1948
+
while (a2) {
1949
+
intnat r = a1 % a2;
1950
+
a1 = a2; a2 = r;
1951
+
}
1952
+
/* If arg1 = arg2 = min_int, the result a1 is -min_int, not representable
1953
+
as a tagged integer; fall through the slow case, then. */
1954
+
if (a1 <= Z_MAX_INT) return Val_long(a1);
1955
+
}
1956
+
#endif
1957
+
/* mpn_ version */
1958
+
Z_MARK_SLOW;
1959
+
{
1960
+
CAMLparam2(arg1, arg2);
1961
+
CAMLlocal3(r, tmp1, tmp2);
1962
+
mp_size_t sz, pos1, pos2, limb1, limb2, bit1, bit2, pos, limb, bit, i;
1963
+
Z_DECL(arg1); Z_DECL(arg2);
1964
+
Z_ARG(arg1); Z_ARG(arg2);
1965
+
if (!size_arg1) r = sign_arg2 ? ml_z_neg(arg2) : arg2;
1966
+
else if (!size_arg2) r = sign_arg1 ? ml_z_neg(arg1) : arg1;
1967
+
else {
1968
+
/* copy args to tmp storage & remove lower 0 bits */
1969
+
pos1 = mpn_scan1(ptr_arg1, 0);
1970
+
pos2 = mpn_scan1(ptr_arg2, 0);
1971
+
limb1 = pos1 / Z_LIMB_BITS;
1972
+
limb2 = pos2 / Z_LIMB_BITS;
1973
+
bit1 = pos1 % Z_LIMB_BITS;
1974
+
bit2 = pos2 % Z_LIMB_BITS;
1975
+
size_arg1 -= limb1;
1976
+
size_arg2 -= limb2;
1977
+
tmp1 = ml_z_alloc(size_arg1 + 1);
1978
+
tmp2 = ml_z_alloc(size_arg2 + 1);
1979
+
Z_REFRESH(arg1);
1980
+
Z_REFRESH(arg2);
1981
+
if (bit1) {
1982
+
mpn_rshift(Z_LIMB(tmp1), ptr_arg1 + limb1, size_arg1, bit1);
1983
+
if (!Z_LIMB(tmp1)[size_arg1-1]) size_arg1--;
1984
+
}
1985
+
else ml_z_cpy_limb(Z_LIMB(tmp1), ptr_arg1 + limb1, size_arg1);
1986
+
if (bit2) {
1987
+
mpn_rshift(Z_LIMB(tmp2), ptr_arg2 + limb2, size_arg2, bit2);
1988
+
if (!Z_LIMB(tmp2)[size_arg2-1]) size_arg2--;
1989
+
}
1990
+
else ml_z_cpy_limb(Z_LIMB(tmp2), ptr_arg2 + limb2, size_arg2);
1991
+
/* compute gcd of 2^pos1 & 2^pos2 */
1992
+
pos = (pos1 <= pos2) ? pos1 : pos2;
1993
+
limb = pos / Z_LIMB_BITS;
1994
+
bit = pos % Z_LIMB_BITS;
1995
+
/* compute gcd of arg1 & arg2 without lower 0 bits */
1996
+
/* second argument must have less bits than first */
1997
+
if ((size_arg1 > size_arg2) ||
1998
+
((size_arg1 == size_arg2) &&
1999
+
(Z_LIMB(tmp1)[size_arg1 - 1] >= Z_LIMB(tmp2)[size_arg1 - 1]))) {
2000
+
r = ml_z_alloc(size_arg2 + limb + 1);
2001
+
sz = mpn_gcd(Z_LIMB(r) + limb, Z_LIMB(tmp1), size_arg1, Z_LIMB(tmp2), size_arg2);
2002
+
}
2003
+
else {
2004
+
r = ml_z_alloc(size_arg1 + limb + 1);
2005
+
sz = mpn_gcd(Z_LIMB(r) + limb, Z_LIMB(tmp2), size_arg2, Z_LIMB(tmp1), size_arg1);
2006
+
}
2007
+
/* glue the two results */
2008
+
for (i = 0; i < limb; i++)
2009
+
Z_LIMB(r)[i] = 0;
2010
+
Z_LIMB(r)[sz + limb] = 0;
2011
+
if (bit) mpn_lshift(Z_LIMB(r) + limb, Z_LIMB(r) + limb, sz + 1, bit);
2012
+
r = ml_z_reduce(r, limb + sz + 1, 0);
2013
+
}
2014
+
Z_CHECK(r);
2015
+
CAMLreturn(r);
2016
+
}
2017
+
}
2018
+
2019
+
/* only computes one cofactor */
2020
+
CAMLprim value ml_z_gcdext_intern(value arg1, value arg2)
2021
+
{
2022
+
/* XXX TODO: fast path */
2023
+
CAMLparam2(arg1, arg2);
2024
+
CAMLlocal5(r, res_arg1, res_arg2, s, p);
2025
+
Z_DECL(arg1); Z_DECL(arg2);
2026
+
mp_size_t sz, sn;
2027
+
Z_MARK_OP;
2028
+
Z_MARK_SLOW;
2029
+
Z_CHECK(arg1); Z_CHECK(arg2);
2030
+
Z_ARG(arg1); Z_ARG(arg2);
2031
+
if (!size_arg1 || !size_arg2) ml_z_raise_divide_by_zero();
2032
+
/* copy args to tmp storage */
2033
+
res_arg1 = ml_z_alloc(size_arg1 + 1);
2034
+
res_arg2 = ml_z_alloc(size_arg2 + 1);
2035
+
Z_REFRESH(arg1);
2036
+
Z_REFRESH(arg2);
2037
+
ml_z_cpy_limb(Z_LIMB(res_arg1), ptr_arg1, size_arg1);
2038
+
ml_z_cpy_limb(Z_LIMB(res_arg2), ptr_arg2, size_arg2);
2039
+
/* must have arg1 >= arg2 */
2040
+
if ((size_arg1 > size_arg2) ||
2041
+
((size_arg1 == size_arg2) &&
2042
+
(mpn_cmp(Z_LIMB(res_arg1), Z_LIMB(res_arg2), size_arg1) >= 0))) {
2043
+
r = ml_z_alloc(size_arg1 + 1);
2044
+
s = ml_z_alloc(size_arg1 + 1);
2045
+
sz = mpn_gcdext(Z_LIMB(r), Z_LIMB(s), &sn,
2046
+
Z_LIMB(res_arg1), size_arg1, Z_LIMB(res_arg2), size_arg2);
2047
+
p = caml_alloc_small(3, 0);
2048
+
Field(p,2) = Val_true;
2049
+
}
2050
+
else {
2051
+
r = ml_z_alloc(size_arg2 + 1);
2052
+
s = ml_z_alloc(size_arg2 + 1);
2053
+
sz = mpn_gcdext(Z_LIMB(r), Z_LIMB(s), &sn,
2054
+
Z_LIMB(res_arg2), size_arg2, Z_LIMB(res_arg1), size_arg1);
2055
+
p = caml_alloc_small(3, 0);
2056
+
Field(p,2) = Val_false;
2057
+
sign_arg1 = sign_arg2;
2058
+
}
2059
+
/* pack result */
2060
+
r = ml_z_reduce(r, sz, 0);
2061
+
if ((int)sn >= 0) s = ml_z_reduce(s, sn, sign_arg1);
2062
+
else s = ml_z_reduce(s, -sn, sign_arg1 ^ Z_SIGN_MASK);
2063
+
Z_CHECK(r);
2064
+
Z_CHECK(s);
2065
+
Field(p,0) = r;
2066
+
Field(p,1) = s;
2067
+
CAMLreturn(p);
2068
+
}
2069
+
2070
+
2071
+
/*---------------------------------------------------
2072
+
BITWISE OPERATORS
2073
+
---------------------------------------------------*/
2074
+
2075
+
CAMLprim value ml_z_logand(value arg1, value arg2)
2076
+
{
2077
+
Z_MARK_OP;
2078
+
Z_CHECK(arg1); Z_CHECK(arg2);
2079
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2080
+
if (Is_long(arg1) && Is_long(arg2)) {
2081
+
/* fast path */
2082
+
return arg1 & arg2;
2083
+
}
2084
+
#endif
2085
+
/* mpn_ version */
2086
+
Z_MARK_SLOW;
2087
+
{
2088
+
CAMLparam2(arg1,arg2);
2089
+
value r;
2090
+
mp_size_t i;
2091
+
mp_limb_t c;
2092
+
Z_DECL(arg1); Z_DECL(arg2);
2093
+
Z_ARG(arg1); Z_ARG(arg2);
2094
+
/* ensure size_arg1 >= size_arg2 */
2095
+
if (size_arg1 < size_arg2) {
2096
+
mp_size_t sz;
2097
+
mp_limb_t *p, s;
2098
+
value a;
2099
+
sz = size_arg1; size_arg1 = size_arg2; size_arg2 = sz;
2100
+
p = ptr_arg1; ptr_arg1 = ptr_arg2; ptr_arg2 = p;
2101
+
s = sign_arg1; sign_arg1 = sign_arg2; sign_arg2 = s;
2102
+
a = arg1; arg1 = arg2; arg2 = a;
2103
+
}
2104
+
if (!size_arg2) r = arg2;
2105
+
else if (sign_arg1 && sign_arg2) {
2106
+
/* arg1 < 0, arg2 < 0 => r < 0 */
2107
+
r = ml_z_alloc(size_arg1 + 1);
2108
+
Z_REFRESH(arg1);
2109
+
Z_REFRESH(arg2);
2110
+
mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1);
2111
+
c = 1; /* carry when decrementing arg2 */
2112
+
for (i = 0; i < size_arg2; i++) {
2113
+
mp_limb_t v = ptr_arg2[i];
2114
+
Z_LIMB(r)[i] = Z_LIMB(r)[i] | (v - c);
2115
+
c = c && !v;
2116
+
}
2117
+
c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1);
2118
+
Z_LIMB(r)[size_arg1] = c;
2119
+
r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK);
2120
+
}
2121
+
else if (sign_arg1) {
2122
+
/* arg1 < 0, arg2 > 0 => r >= 0 */
2123
+
r = ml_z_alloc(size_arg2);
2124
+
Z_REFRESH(arg1);
2125
+
Z_REFRESH(arg2);
2126
+
mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg2, 1);
2127
+
for (i = 0; i < size_arg2; i++)
2128
+
Z_LIMB(r)[i] = (~Z_LIMB(r)[i]) & ptr_arg2[i];
2129
+
r = ml_z_reduce(r, size_arg2, 0);
2130
+
}
2131
+
else if (sign_arg2) {
2132
+
/* arg1 > 0, arg2 < 0 => r >= 0 */
2133
+
r = ml_z_alloc(size_arg1);
2134
+
Z_REFRESH(arg1);
2135
+
Z_REFRESH(arg2);
2136
+
mpn_sub_1(Z_LIMB(r), ptr_arg2, size_arg2, 1);
2137
+
for (i = 0; i < size_arg2; i++)
2138
+
Z_LIMB(r)[i] = ptr_arg1[i] & (~Z_LIMB(r)[i]);
2139
+
for (; i < size_arg1; i++)
2140
+
Z_LIMB(r)[i] = ptr_arg1[i];
2141
+
r = ml_z_reduce(r, size_arg1, 0);
2142
+
}
2143
+
else {
2144
+
/* arg1, arg2 > 0 => r >= 0 */
2145
+
r = ml_z_alloc(size_arg2);
2146
+
Z_REFRESH(arg1);
2147
+
Z_REFRESH(arg2);
2148
+
for (i = 0; i < size_arg2; i++)
2149
+
Z_LIMB(r)[i] = ptr_arg1[i] & ptr_arg2[i];
2150
+
r = ml_z_reduce(r, size_arg2, 0);
2151
+
}
2152
+
Z_CHECK(r);
2153
+
CAMLreturn(r);
2154
+
}
2155
+
}
2156
+
2157
+
CAMLprim value ml_z_logor(value arg1, value arg2)
2158
+
{
2159
+
Z_MARK_OP;
2160
+
Z_CHECK(arg1); Z_CHECK(arg2);
2161
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2162
+
if (Is_long(arg1) && Is_long(arg2)) {
2163
+
/* fast path */
2164
+
return arg1 | arg2;
2165
+
}
2166
+
#endif
2167
+
/* mpn_ version */
2168
+
Z_MARK_SLOW;
2169
+
{
2170
+
CAMLparam2(arg1,arg2);
2171
+
Z_DECL(arg1); Z_DECL(arg2);
2172
+
mp_size_t i;
2173
+
mp_limb_t c;
2174
+
value r;
2175
+
Z_ARG(arg1); Z_ARG(arg2);
2176
+
/* ensure size_arg1 >= size_arg2 */
2177
+
if (size_arg1 < size_arg2) {
2178
+
mp_size_t sz;
2179
+
mp_limb_t *p, s;
2180
+
value a;
2181
+
sz = size_arg1; size_arg1 = size_arg2; size_arg2 = sz;
2182
+
p = ptr_arg1; ptr_arg1 = ptr_arg2; ptr_arg2 = p;
2183
+
s = sign_arg1; sign_arg1 = sign_arg2; sign_arg2 = s;
2184
+
a = arg1; arg1 = arg2; arg2 = a;
2185
+
}
2186
+
if (!size_arg2) r = arg1;
2187
+
else if (sign_arg1 && sign_arg2) {
2188
+
/* arg1 < 0, arg2 < 0 => r < 0 */
2189
+
r = ml_z_alloc(size_arg2 + 1);
2190
+
Z_REFRESH(arg1);
2191
+
Z_REFRESH(arg2);
2192
+
mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg2, 1);
2193
+
c = 1; /* carry when decrementing arg2 */
2194
+
for (i = 0; i < size_arg2; i++) {
2195
+
mp_limb_t v = ptr_arg2[i];
2196
+
Z_LIMB(r)[i] = Z_LIMB(r)[i] & (v - c);
2197
+
c = c && !v;
2198
+
}
2199
+
c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg2, 1);
2200
+
Z_LIMB(r)[size_arg2] = c;
2201
+
r = ml_z_reduce(r, size_arg2 + 1, Z_SIGN_MASK);
2202
+
}
2203
+
else if (sign_arg1) {
2204
+
/* arg1 < 0, arg2 > 0 => r < 0 */
2205
+
r = ml_z_alloc(size_arg1 + 1);
2206
+
Z_REFRESH(arg1);
2207
+
Z_REFRESH(arg2);
2208
+
mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1);
2209
+
for (i = 0; i < size_arg2; i++)
2210
+
Z_LIMB(r)[i] = Z_LIMB(r)[i] & (~ptr_arg2[i]);
2211
+
c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1);
2212
+
Z_LIMB(r)[size_arg1] = c;
2213
+
r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK);
2214
+
}
2215
+
else if (sign_arg2) {
2216
+
/* arg1 > 0, arg2 < 0 => r < 0*/
2217
+
r = ml_z_alloc(size_arg2 + 1);
2218
+
Z_REFRESH(arg1);
2219
+
Z_REFRESH(arg2);
2220
+
mpn_sub_1(Z_LIMB(r), ptr_arg2, size_arg2, 1);
2221
+
for (i = 0; i < size_arg2; i++)
2222
+
Z_LIMB(r)[i] = (~ptr_arg1[i]) & Z_LIMB(r)[i];
2223
+
c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg2, 1);
2224
+
Z_LIMB(r)[size_arg2] = c;
2225
+
r = ml_z_reduce(r, size_arg2 + 1, Z_SIGN_MASK);
2226
+
}
2227
+
else {
2228
+
/* arg1, arg2 > 0 => r > 0 */
2229
+
r = ml_z_alloc(size_arg1);
2230
+
Z_REFRESH(arg1);
2231
+
Z_REFRESH(arg2);
2232
+
for (i = 0; i < size_arg2; i++)
2233
+
Z_LIMB(r)[i] = ptr_arg1[i] | ptr_arg2[i];
2234
+
for (; i < size_arg1; i++)
2235
+
Z_LIMB(r)[i] = ptr_arg1[i];
2236
+
r = ml_z_reduce(r, size_arg1, 0);
2237
+
}
2238
+
Z_CHECK(r);
2239
+
CAMLreturn(r);
2240
+
}
2241
+
}
2242
+
2243
+
CAMLprim value ml_z_logxor(value arg1, value arg2)
2244
+
{
2245
+
Z_MARK_OP;
2246
+
Z_CHECK(arg1); Z_CHECK(arg2);
2247
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2248
+
if (Is_long(arg1) && Is_long(arg2)) {
2249
+
/* fast path */
2250
+
return (arg1 ^ arg2) | 1;
2251
+
}
2252
+
#endif
2253
+
/* mpn_ version */
2254
+
Z_MARK_SLOW;
2255
+
{
2256
+
CAMLparam2(arg1,arg2);
2257
+
Z_DECL(arg1); Z_DECL(arg2);
2258
+
value r;
2259
+
mp_size_t i;
2260
+
mp_limb_t c;
2261
+
Z_ARG(arg1); Z_ARG(arg2);
2262
+
/* ensure size_arg1 >= size_arg2 */
2263
+
if (size_arg1 < size_arg2) {
2264
+
mp_size_t sz;
2265
+
mp_limb_t *p, s;
2266
+
value a;
2267
+
sz = size_arg1; size_arg1 = size_arg2; size_arg2 = sz;
2268
+
p = ptr_arg1; ptr_arg1 = ptr_arg2; ptr_arg2 = p;
2269
+
s = sign_arg1; sign_arg1 = sign_arg2; sign_arg2 = s;
2270
+
a = arg1; arg1 = arg2; arg2 = a;
2271
+
}
2272
+
if (!size_arg2) r = arg1;
2273
+
else if (sign_arg1 && sign_arg2) {
2274
+
/* arg1 < 0, arg2 < 0 => r >=0 */
2275
+
r = ml_z_alloc(size_arg1);
2276
+
Z_REFRESH(arg1);
2277
+
Z_REFRESH(arg2);
2278
+
mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1);
2279
+
c = 1; /* carry when decrementing arg2 */
2280
+
for (i = 0; i < size_arg2; i++) {
2281
+
mp_limb_t v = ptr_arg2[i];
2282
+
Z_LIMB(r)[i] = Z_LIMB(r)[i] ^ (v - c);
2283
+
c = c && !v;
2284
+
}
2285
+
r = ml_z_reduce(r, size_arg1, 0);
2286
+
}
2287
+
else if (sign_arg1) {
2288
+
/* arg1 < 0, arg2 > 0 => r < 0 */
2289
+
r = ml_z_alloc(size_arg1 + 1);
2290
+
Z_REFRESH(arg1);
2291
+
Z_REFRESH(arg2);
2292
+
mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1);
2293
+
for (i = 0; i < size_arg2; i++)
2294
+
Z_LIMB(r)[i] = Z_LIMB(r)[i] ^ ptr_arg2[i];
2295
+
c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1);
2296
+
Z_LIMB(r)[size_arg1] = c;
2297
+
r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK);
2298
+
}
2299
+
else if (sign_arg2) {
2300
+
/* arg1 > 0, arg2 < 0 => r < 0 */
2301
+
r = ml_z_alloc(size_arg1 + 1);
2302
+
Z_REFRESH(arg1);
2303
+
Z_REFRESH(arg2);
2304
+
mpn_sub_1(Z_LIMB(r), ptr_arg2, size_arg2, 1);
2305
+
for (i = 0; i < size_arg2; i++)
2306
+
Z_LIMB(r)[i] = ptr_arg1[i] ^ Z_LIMB(r)[i];
2307
+
for (; i < size_arg1; i++)
2308
+
Z_LIMB(r)[i] = ptr_arg1[i];
2309
+
c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1);
2310
+
Z_LIMB(r)[size_arg1] = c;
2311
+
r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK);
2312
+
}
2313
+
else {
2314
+
/* arg1, arg2 > 0 => r >= 0 */
2315
+
r = ml_z_alloc(size_arg1);
2316
+
Z_REFRESH(arg1);
2317
+
Z_REFRESH(arg2);
2318
+
for (i = 0; i < size_arg2; i++)
2319
+
Z_LIMB(r)[i] = ptr_arg1[i] ^ ptr_arg2[i];
2320
+
for (; i < size_arg1; i++)
2321
+
Z_LIMB(r)[i] = ptr_arg1[i];
2322
+
r = ml_z_reduce(r, size_arg1, 0);
2323
+
}
2324
+
Z_CHECK(r);
2325
+
CAMLreturn(r);
2326
+
}
2327
+
}
2328
+
2329
+
CAMLprim value ml_z_lognot(value arg)
2330
+
{
2331
+
Z_MARK_OP;
2332
+
Z_CHECK(arg);
2333
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2334
+
if (Is_long(arg)) {
2335
+
/* fast path */
2336
+
return (~arg) | 1;
2337
+
}
2338
+
#endif
2339
+
/* mpn_ version */
2340
+
Z_MARK_SLOW;
2341
+
{
2342
+
CAMLparam1(arg);
2343
+
Z_DECL(arg);
2344
+
value r;
2345
+
Z_ARG(arg);
2346
+
r = ml_z_alloc(size_arg + 1);
2347
+
Z_REFRESH(arg);
2348
+
/* compute r = -arg - 1 */
2349
+
if (!size_arg) {
2350
+
/* arg = 0 => r = -1 */
2351
+
Z_LIMB(r)[0] = 1;
2352
+
r = ml_z_reduce(r, 1, Z_SIGN_MASK);
2353
+
}
2354
+
else if (sign_arg) {
2355
+
/* arg < 0, r > 0, |r| = |arg| - 1 */
2356
+
mpn_sub_1(Z_LIMB(r), ptr_arg, size_arg, 1);
2357
+
r = ml_z_reduce(r, size_arg, 0);
2358
+
}
2359
+
else {
2360
+
/* arg > 0, r < 0, |r| = |arg| + 1 */
2361
+
mp_limb_t c = mpn_add_1(Z_LIMB(r), ptr_arg, size_arg, 1);
2362
+
Z_LIMB(r)[size_arg] = c;
2363
+
r = ml_z_reduce(r, size_arg + 1, Z_SIGN_MASK);
2364
+
}
2365
+
Z_CHECK(r);
2366
+
CAMLreturn(r);
2367
+
}
2368
+
}
2369
+
2370
+
CAMLprim value ml_z_shift_left(value arg, value count)
2371
+
{
2372
+
Z_DECL(arg);
2373
+
intnat c = Long_val(count);
2374
+
intnat c1, c2;
2375
+
Z_MARK_OP;
2376
+
Z_CHECK(arg);
2377
+
if (c < 0)
2378
+
caml_invalid_argument("Z.shift_left: count argument must be positive");
2379
+
if (!c) return arg;
2380
+
c1 = c / Z_LIMB_BITS;
2381
+
c2 = c % Z_LIMB_BITS;
2382
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2383
+
if (Is_long(arg) && !c1) {
2384
+
/* fast path */
2385
+
value a = arg - 1;
2386
+
value r = arg << c2;
2387
+
if (a == (r >> c2)) return r | 1;
2388
+
}
2389
+
#endif
2390
+
Z_ARG(arg);
2391
+
if (!size_arg) return Val_long(0);
2392
+
/* mpn_ version */
2393
+
Z_MARK_SLOW;
2394
+
{
2395
+
CAMLparam1(arg);
2396
+
value r;
2397
+
mp_size_t i;
2398
+
r = ml_z_alloc(size_arg + c1 + 1);
2399
+
Z_REFRESH(arg);
2400
+
/* 0-filled limbs */
2401
+
for (i = 0; i < c1; i++) Z_LIMB(r)[i] = 0;
2402
+
if (c2) {
2403
+
/* shifted bits */
2404
+
mp_limb_t x = mpn_lshift(Z_LIMB(r) + c1, ptr_arg, size_arg, c2);
2405
+
Z_LIMB(r)[size_arg + c1] = x;
2406
+
}
2407
+
else {
2408
+
/* unshifted copy */
2409
+
ml_z_cpy_limb(Z_LIMB(r) + c1, ptr_arg, size_arg);
2410
+
Z_LIMB(r)[size_arg + c1] = 0;
2411
+
}
2412
+
r = ml_z_reduce(r, size_arg + c1 + 1, sign_arg);
2413
+
Z_CHECK(r);
2414
+
CAMLreturn(r);
2415
+
}
2416
+
}
2417
+
2418
+
CAMLprim value ml_z_shift_right(value arg, value count)
2419
+
{
2420
+
Z_DECL(arg);
2421
+
intnat c = Long_val(count);
2422
+
intnat c1, c2;
2423
+
value r;
2424
+
Z_MARK_OP;
2425
+
Z_CHECK(arg);
2426
+
if (c < 0)
2427
+
caml_invalid_argument("Z.shift_right: count argument must be positive");
2428
+
if (!c) return arg;
2429
+
c1 = c / Z_LIMB_BITS;
2430
+
c2 = c % Z_LIMB_BITS;
2431
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2432
+
if (Is_long(arg)) {
2433
+
/* fast path */
2434
+
if (c1) {
2435
+
if (arg < 0) return Val_long(-1);
2436
+
else return Val_long(0);
2437
+
}
2438
+
return (arg >> c2) | 1;
2439
+
}
2440
+
#endif
2441
+
Z_ARG(arg);
2442
+
if (c1 >= size_arg) {
2443
+
if (sign_arg) return Val_long(-1);
2444
+
else return Val_long(0);
2445
+
}
2446
+
/* mpn_ version */
2447
+
Z_MARK_SLOW;
2448
+
{
2449
+
CAMLparam1(arg);
2450
+
mp_limb_t cr;
2451
+
r = ml_z_alloc(size_arg - c1 + 1);
2452
+
Z_REFRESH(arg);
2453
+
if (c2)
2454
+
/* shifted bits */
2455
+
cr = mpn_rshift(Z_LIMB(r), ptr_arg + c1, size_arg - c1, c2);
2456
+
else {
2457
+
/* unshifted copy */
2458
+
ml_z_cpy_limb(Z_LIMB(r), ptr_arg + c1, size_arg - c1);
2459
+
cr = 0;
2460
+
}
2461
+
if (sign_arg) {
2462
+
/* round |arg| to +oo */
2463
+
mp_size_t i;
2464
+
if (!cr) {
2465
+
for (i = 0; i < c1; i++)
2466
+
if (ptr_arg[i]) { cr = 1; break; }
2467
+
}
2468
+
if (cr)
2469
+
cr = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg - c1, 1);
2470
+
}
2471
+
else cr = 0;
2472
+
Z_LIMB(r)[size_arg - c1] = cr;
2473
+
r = ml_z_reduce(r, size_arg - c1 + 1, sign_arg);
2474
+
Z_CHECK(r);
2475
+
CAMLreturn(r);
2476
+
}
2477
+
}
2478
+
2479
+
CAMLprim value ml_z_shift_right_trunc(value arg, value count)
2480
+
{
2481
+
Z_DECL(arg);
2482
+
intnat c = Long_val(count);
2483
+
intnat c1, c2;
2484
+
value r;
2485
+
Z_MARK_OP;
2486
+
Z_CHECK(arg);
2487
+
if (c < 0)
2488
+
caml_invalid_argument("Z.shift_right_trunc: count argument must be positive");
2489
+
if (!c) return arg;
2490
+
c1 = c / Z_LIMB_BITS;
2491
+
c2 = c % Z_LIMB_BITS;
2492
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2493
+
if (Is_long(arg)) {
2494
+
/* fast path */
2495
+
if (c1) return Val_long(0);
2496
+
if (arg >= 1) return (arg >> c2) | 1;
2497
+
else return Val_long(- ((- Long_val(arg)) >> c2));
2498
+
}
2499
+
#endif
2500
+
Z_ARG(arg);
2501
+
if (c1 >= size_arg) return Val_long(0);
2502
+
/* mpn_ version */
2503
+
Z_MARK_SLOW;
2504
+
{
2505
+
CAMLparam1(arg);
2506
+
r = ml_z_alloc(size_arg - c1);
2507
+
Z_REFRESH(arg);
2508
+
if (c2)
2509
+
/* shifted bits */
2510
+
mpn_rshift(Z_LIMB(r), ptr_arg + c1, size_arg - c1, c2);
2511
+
else
2512
+
/* unshifted copy */
2513
+
ml_z_cpy_limb(Z_LIMB(r), ptr_arg + c1, size_arg - c1);
2514
+
r = ml_z_reduce(r, size_arg - c1, sign_arg);
2515
+
Z_CHECK(r);
2516
+
CAMLreturn(r);
2517
+
}
2518
+
}
2519
+
2520
+
/* Helper function for numbits: number of leading 0 bits in x */
2521
+
2522
+
#ifdef _LONG_LONG_LIMB
2523
+
#define BUILTIN_CLZ __builtin_clzll
2524
+
#else
2525
+
#define BUILTIN_CLZ __builtin_clzl
2526
+
#endif
2527
+
2528
+
/* Use GCC or Clang built-in if available. The argument must be != 0. */
2529
+
#if defined(__clang__) || __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
2530
+
#define ml_z_clz BUILTIN_CLZ
2531
+
#else
2532
+
/* Portable C implementation - Hacker's Delight fig 5.12 */
2533
+
int ml_z_clz(mp_limb_t x)
2534
+
{
2535
+
int n;
2536
+
mp_limb_t y;
2537
+
#ifdef ARCH_SIXTYFOUR
2538
+
n = 64;
2539
+
y = x >> 32; if (y != 0) { n = n - 32; x = y; }
2540
+
#else
2541
+
n = 32;
2542
+
#endif
2543
+
y = x >> 16; if (y != 0) { n = n - 16; x = y; }
2544
+
y = x >> 8; if (y != 0) { n = n - 8; x = y; }
2545
+
y = x >> 4; if (y != 0) { n = n - 4; x = y; }
2546
+
y = x >> 2; if (y != 0) { n = n - 2; x = y; }
2547
+
y = x >> 1; if (y != 0) return n - 2;
2548
+
return n - x;
2549
+
}
2550
+
#endif
2551
+
2552
+
CAMLprim value ml_z_numbits(value arg)
2553
+
{
2554
+
Z_DECL(arg);
2555
+
intnat r;
2556
+
int n;
2557
+
Z_MARK_OP;
2558
+
Z_CHECK(arg);
2559
+
#if Z_FAST_PATH
2560
+
if (Is_long(arg)) {
2561
+
/* fast path */
2562
+
r = Long_val(arg);
2563
+
if (r == 0) {
2564
+
return Val_int(0);
2565
+
} else {
2566
+
n = ml_z_clz(r > 0 ? r : -r);
2567
+
return Val_long(sizeof(intnat) * 8 - n);
2568
+
}
2569
+
}
2570
+
#endif
2571
+
/* mpn_ version */
2572
+
Z_MARK_SLOW;
2573
+
Z_ARG(arg);
2574
+
if (size_arg == 0) return Val_int(0);
2575
+
n = ml_z_clz(ptr_arg[size_arg - 1]);
2576
+
return Val_long(size_arg * Z_LIMB_BITS - n);
2577
+
}
2578
+
2579
+
/* Helper function for trailing_zeros: number of trailing 0 bits in x */
2580
+
2581
+
#ifdef _LONG_LONG_LIMB
2582
+
#define BUILTIN_CTZ __builtin_ctzll
2583
+
#else
2584
+
#define BUILTIN_CTZ __builtin_ctzl
2585
+
#endif
2586
+
2587
+
/* Use GCC or Clang built-in if available. The argument must be != 0. */
2588
+
#if defined(__clang__) || __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
2589
+
#define ml_z_ctz BUILTIN_CTZ
2590
+
#else
2591
+
/* Portable C implementation - Hacker's Delight fig 5.21 */
2592
+
int ml_z_ctz(mp_limb_t x)
2593
+
{
2594
+
int n;
2595
+
mp_limb_t y;
2596
+
CAMLassert (x != 0);
2597
+
#ifdef ARCH_SIXTYFOUR
2598
+
n = 63;
2599
+
y = x << 32; if (y != 0) { n = n - 32; x = y; }
2600
+
#else
2601
+
n = 31;
2602
+
#endif
2603
+
y = x << 16; if (y != 0) { n = n - 16; x = y; }
2604
+
y = x << 8; if (y != 0) { n = n - 8; x = y; }
2605
+
y = x << 4; if (y != 0) { n = n - 4; x = y; }
2606
+
y = x << 2; if (y != 0) { n = n - 2; x = y; }
2607
+
y = x << 1; if (y != 0) { n = n - 1; }
2608
+
return n;
2609
+
}
2610
+
#endif
2611
+
2612
+
CAMLprim value ml_z_trailing_zeros(value arg)
2613
+
{
2614
+
Z_DECL(arg);
2615
+
intnat r;
2616
+
mp_size_t i;
2617
+
Z_MARK_OP;
2618
+
Z_CHECK(arg);
2619
+
#if Z_FAST_PATH
2620
+
if (Is_long(arg)) {
2621
+
/* fast path */
2622
+
r = Long_val(arg);
2623
+
if (r == 0) {
2624
+
return Val_long (Max_long);
2625
+
} else {
2626
+
/* No need to take absolute value of r, as ctz(-x) = ctz(x) */
2627
+
return Val_long (ml_z_ctz(r));
2628
+
}
2629
+
}
2630
+
#endif
2631
+
/* mpn_ version */
2632
+
Z_MARK_SLOW;
2633
+
Z_ARG(arg);
2634
+
if (size_arg == 0) return Val_long (Max_long);
2635
+
for (i = 0; ptr_arg[i] == 0; i++) /* skip */;
2636
+
return Val_long(i * Z_LIMB_BITS + ml_z_ctz(ptr_arg[i]));
2637
+
}
2638
+
2639
+
/* helper function for popcount & hamdist: number of bits at 1 in x */
2640
+
/* maybe we should use the mpn_ function even for small arguments, in case
2641
+
the CPU has a fast popcount opcode?
2642
+
*/
2643
+
uintnat ml_z_count(uintnat x)
2644
+
{
2645
+
#ifdef ARCH_SIXTYFOUR
2646
+
x = (x & 0x5555555555555555UL) + ((x >> 1) & 0x5555555555555555UL);
2647
+
x = (x & 0x3333333333333333UL) + ((x >> 2) & 0x3333333333333333UL);
2648
+
x = (x & 0x0f0f0f0f0f0f0f0fUL) + ((x >> 4) & 0x0f0f0f0f0f0f0f0fUL);
2649
+
x = (x & 0x00ff00ff00ff00ffUL) + ((x >> 8) & 0x00ff00ff00ff00ffUL);
2650
+
x = (x & 0x0000ffff0000ffffUL) + ((x >> 16) & 0x0000ffff0000ffffUL);
2651
+
x = (x & 0x00000000ffffffffUL) + ((x >> 32) & 0x00000000ffffffffUL);
2652
+
#else
2653
+
x = (x & 0x55555555UL) + ((x >> 1) & 0x55555555UL);
2654
+
x = (x & 0x33333333UL) + ((x >> 2) & 0x33333333UL);
2655
+
x = (x & 0x0f0f0f0fUL) + ((x >> 4) & 0x0f0f0f0fUL);
2656
+
x = (x & 0x00ff00ffUL) + ((x >> 8) & 0x00ff00ffUL);
2657
+
x = (x & 0x0000ffffUL) + ((x >> 16) & 0x0000ffffUL);
2658
+
#endif
2659
+
return x;
2660
+
}
2661
+
2662
+
CAMLprim value ml_z_popcount(value arg)
2663
+
{
2664
+
Z_DECL(arg);
2665
+
intnat r;
2666
+
Z_MARK_OP;
2667
+
Z_CHECK(arg);
2668
+
#if Z_FAST_PATH
2669
+
if (Is_long(arg)) {
2670
+
/* fast path */
2671
+
r = Long_val(arg);
2672
+
if (r < 0) ml_z_raise_overflow();
2673
+
return Val_long(ml_z_count(r));
2674
+
}
2675
+
#endif
2676
+
/* mpn_ version */
2677
+
Z_MARK_SLOW;
2678
+
Z_ARG(arg);
2679
+
if (sign_arg) ml_z_raise_overflow();
2680
+
if (!size_arg) return Val_long(0);
2681
+
r = mpn_popcount(ptr_arg, size_arg);
2682
+
if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow();
2683
+
return Val_long(r);
2684
+
}
2685
+
2686
+
CAMLprim value ml_z_hamdist(value arg1, value arg2)
2687
+
{
2688
+
Z_DECL(arg1); Z_DECL(arg2);
2689
+
intnat r;
2690
+
mp_size_t sz;
2691
+
Z_MARK_OP;
2692
+
Z_CHECK(arg1);
2693
+
Z_CHECK(arg2);
2694
+
#if Z_FAST_PATH
2695
+
if (Is_long(arg1) && Is_long(arg2)) {
2696
+
/* fast path */
2697
+
r = Long_val(arg1) ^ Long_val(arg2);
2698
+
if (r < 0) ml_z_raise_overflow();
2699
+
return Val_long(ml_z_count(r));
2700
+
}
2701
+
#endif
2702
+
/* mpn_ version */
2703
+
Z_MARK_SLOW;
2704
+
Z_ARG(arg1);
2705
+
Z_ARG(arg2);
2706
+
if (sign_arg1 != sign_arg2) ml_z_raise_overflow();
2707
+
/* XXX TODO: case where arg1 & arg2 are both negative */
2708
+
if (sign_arg1 || sign_arg2)
2709
+
caml_invalid_argument("Z.hamdist: negative arguments");
2710
+
/* distance on common size */
2711
+
sz = (size_arg1 <= size_arg2) ? size_arg1 : size_arg2;
2712
+
if (sz) {
2713
+
r = mpn_hamdist(ptr_arg1, ptr_arg2, sz);
2714
+
if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow();
2715
+
}
2716
+
else r = 0;
2717
+
/* add stray bits */
2718
+
if (size_arg1 > size_arg2) {
2719
+
r += mpn_popcount(ptr_arg1 + size_arg2, size_arg1 - size_arg2);
2720
+
if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow();
2721
+
}
2722
+
else if (size_arg2 > size_arg1) {
2723
+
r += mpn_popcount(ptr_arg2 + size_arg1, size_arg2 - size_arg1);
2724
+
if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow();
2725
+
}
2726
+
return Val_long(r);
2727
+
}
2728
+
2729
+
CAMLprim value ml_z_testbit(value arg, value index)
2730
+
{
2731
+
Z_DECL(arg);
2732
+
uintnat b_idx;
2733
+
mp_size_t l_idx, i;
2734
+
mp_limb_t limb;
2735
+
Z_MARK_OP;
2736
+
Z_CHECK(arg);
2737
+
b_idx = Long_val(index); /* Caml code checked index >= 0 */
2738
+
#if Z_FAST_PATH
2739
+
if (Is_long(arg)) {
2740
+
if (b_idx >= Z_LIMB_BITS) b_idx = Z_LIMB_BITS - 1;
2741
+
return Val_int((Long_val(arg) >> b_idx) & 1);
2742
+
}
2743
+
#endif
2744
+
Z_MARK_SLOW;
2745
+
Z_ARG(arg);
2746
+
l_idx = b_idx / Z_LIMB_BITS;
2747
+
if (l_idx >= size_arg) return Val_bool(sign_arg);
2748
+
limb = ptr_arg[l_idx];
2749
+
if (sign_arg != 0) {
2750
+
/* If arg is negative, its 2-complement representation is
2751
+
bitnot(abs(arg) - 1).
2752
+
If any of the limbs of abs(arg) below l_idx is nonzero,
2753
+
the carry from the decrement dies before reaching l_idx,
2754
+
and we just test bitnot(limb).
2755
+
If all the limbs below l_idx are zero, the carry from the
2756
+
decrement propagates to l_idx,
2757
+
and we test bitnot(limb - 1) = - limb. */
2758
+
for (i = 0; i < l_idx; i++) {
2759
+
if (ptr_arg[i] != 0) { limb = ~limb; goto extract; }
2760
+
}
2761
+
limb = -limb;
2762
+
}
2763
+
extract:
2764
+
return Val_int((limb >> (b_idx % Z_LIMB_BITS)) & 1);
2765
+
}
2766
+
2767
+
/*---------------------------------------------------
2768
+
FUNCTIONS BASED ON mpz_t
2769
+
---------------------------------------------------*/
2770
+
2771
+
/* sets rop to the value in op (limbs are copied) */
2772
+
void ml_z_mpz_set_z(mpz_t rop, value op)
2773
+
{
2774
+
Z_DECL(op);
2775
+
Z_CHECK(op);
2776
+
Z_ARG(op);
2777
+
if (size_op * Z_LIMB_BITS > INT_MAX)
2778
+
caml_invalid_argument("Z: risk of overflow in mpz type");
2779
+
mpz_realloc2(rop, size_op * Z_LIMB_BITS);
2780
+
rop->_mp_size = (sign_op >= 0) ? size_op : -size_op;
2781
+
ml_z_cpy_limb(rop->_mp_d, ptr_op, size_op);
2782
+
}
2783
+
2784
+
/* inits and sets rop to the value in op (limbs are copied) */
2785
+
void ml_z_mpz_init_set_z(mpz_t rop, value op)
2786
+
{
2787
+
mpz_init(rop);
2788
+
ml_z_mpz_set_z(rop,op);
2789
+
}
2790
+
2791
+
/* returns a new z objects equal to op (limbs are copied) */
2792
+
value ml_z_from_mpz(mpz_t op)
2793
+
{
2794
+
value r;
2795
+
size_t sz = mpz_size(op);
2796
+
r = ml_z_alloc(sz);
2797
+
ml_z_cpy_limb(Z_LIMB(r), op->_mp_d, sz);
2798
+
return ml_z_reduce(r, sz, (mpz_sgn(op) >= 0) ? 0 : Z_SIGN_MASK);
2799
+
}
2800
+
2801
+
#if __GNU_MP_VERSION >= 5
2802
+
/* not exported by gmp.h */
2803
+
extern void __gmpn_divexact (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t);
2804
+
#endif
2805
+
2806
+
CAMLprim value ml_z_divexact(value arg1, value arg2)
2807
+
{
2808
+
Z_DECL(arg1); Z_DECL(arg2);
2809
+
Z_MARK_OP;
2810
+
Z_CHECK(arg1); Z_CHECK(arg2);
2811
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2812
+
if (Is_long(arg1) && Is_long(arg2)) {
2813
+
/* fast path */
2814
+
intnat a1 = Long_val(arg1);
2815
+
intnat a2 = Long_val(arg2);
2816
+
intnat q;
2817
+
if (!a2) ml_z_raise_divide_by_zero();
2818
+
q = a1 / a2;
2819
+
if (Z_FITS_INT(q)) return Val_long(q);
2820
+
}
2821
+
#endif
2822
+
Z_MARK_SLOW;
2823
+
#if __GNU_MP_VERSION >= 5
2824
+
{
2825
+
/* mpn_ version */
2826
+
Z_ARG(arg1);
2827
+
Z_ARG(arg2);
2828
+
if (!size_arg2)
2829
+
ml_z_raise_divide_by_zero();
2830
+
if (size_arg1 < size_arg2)
2831
+
return Val_long(0);
2832
+
{
2833
+
CAMLparam2(arg1,arg2);
2834
+
CAMLlocal1(q);
2835
+
q = ml_z_alloc(size_arg1 - size_arg2 + 1);
2836
+
Z_REFRESH(arg1); Z_REFRESH(arg2);
2837
+
__gmpn_divexact(Z_LIMB(q),
2838
+
ptr_arg1, size_arg1, ptr_arg2, size_arg2);
2839
+
q = ml_z_reduce(q, size_arg1 - size_arg2 + 1, sign_arg1 ^ sign_arg2);
2840
+
Z_CHECK(q);
2841
+
CAMLreturn(q);
2842
+
}
2843
+
}
2844
+
#else
2845
+
{
2846
+
/* mpz_ version */
2847
+
CAMLparam2(arg1,arg2);
2848
+
CAMLlocal1(r);
2849
+
mpz_t a,b;
2850
+
if (!ml_z_sgn(arg2))
2851
+
ml_z_raise_divide_by_zero();
2852
+
ml_z_mpz_init_set_z(a, arg1);
2853
+
ml_z_mpz_init_set_z(b, arg2);
2854
+
mpz_divexact(a, a, b);
2855
+
r = ml_z_from_mpz(a);
2856
+
mpz_clear(a);
2857
+
mpz_clear(b);
2858
+
CAMLreturn(r);
2859
+
}
2860
+
#endif
2861
+
}
2862
+
2863
+
CAMLprim value ml_z_powm(value base, value exp, value mod)
2864
+
{
2865
+
CAMLparam3(base,exp,mod);
2866
+
CAMLlocal1(r);
2867
+
Z_DECL(mod);
2868
+
mpz_t mbase, mexp, mmod;
2869
+
Z_ARG(mod);
2870
+
if (!size_mod)
2871
+
ml_z_raise_divide_by_zero();
2872
+
ml_z_mpz_init_set_z(mbase, base);
2873
+
ml_z_mpz_init_set_z(mexp, exp);
2874
+
ml_z_mpz_init_set_z(mmod, mod);
2875
+
if (mpz_sgn(mexp) < 0) {
2876
+
/* we need to check whether base is invertible to avoid a division by zero
2877
+
in mpz_powm, so we can as well use the computed inverse
2878
+
*/
2879
+
if (!mpz_invert(mbase, mbase, mmod)) {
2880
+
mpz_clear(mbase);
2881
+
mpz_clear(mexp);
2882
+
mpz_clear(mmod);
2883
+
ml_z_raise_divide_by_zero();
2884
+
}
2885
+
mpz_neg(mexp, mexp);
2886
+
}
2887
+
mpz_powm(mbase, mbase, mexp, mmod);
2888
+
r = ml_z_from_mpz(mbase);
2889
+
mpz_clear(mbase);
2890
+
mpz_clear(mexp);
2891
+
mpz_clear(mmod);
2892
+
CAMLreturn(r);
2893
+
}
2894
+
2895
+
CAMLprim value ml_z_powm_sec(value base, value exp, value mod)
2896
+
{
2897
+
#ifndef HAS_MPIR
2898
+
#if __GNU_MP_VERSION >= 5
2899
+
CAMLparam3(base,exp,mod);
2900
+
CAMLlocal1(r);
2901
+
mpz_t mbase, mexp, mmod;
2902
+
ml_z_mpz_init_set_z(mbase, base);
2903
+
ml_z_mpz_init_set_z(mexp, exp);
2904
+
ml_z_mpz_init_set_z(mmod, mod);
2905
+
if (mpz_sgn(mexp) <= 0) {
2906
+
mpz_clear(mbase);
2907
+
mpz_clear(mexp);
2908
+
mpz_clear(mmod);
2909
+
caml_invalid_argument("Z.powm_sec: exponent must be positive");
2910
+
}
2911
+
if (! mpz_odd_p(mmod)) {
2912
+
mpz_clear(mbase);
2913
+
mpz_clear(mexp);
2914
+
mpz_clear(mmod);
2915
+
caml_invalid_argument("Z.powm_sec: modulus must be odd");
2916
+
}
2917
+
mpz_powm_sec(mbase, mbase, mexp, mmod);
2918
+
r = ml_z_from_mpz(mbase);
2919
+
mpz_clear(mbase);
2920
+
mpz_clear(mexp);
2921
+
mpz_clear(mmod);
2922
+
CAMLreturn(r);
2923
+
#else
2924
+
MAYBE_UNUSED(base);
2925
+
MAYBE_UNUSED(exp);
2926
+
MAYBE_UNUSED(mod);
2927
+
caml_invalid_argument("Z.powm_sec: not available, needs GMP version >= 5");
2928
+
#endif
2929
+
#else
2930
+
MAYBE_UNUSED(base);
2931
+
MAYBE_UNUSED(exp);
2932
+
MAYBE_UNUSED(mod);
2933
+
caml_invalid_argument("Z.powm_sec: not available in MPIR, needs GMP version >= 5");
2934
+
#endif
2935
+
}
2936
+
2937
+
CAMLprim value ml_z_pow(value base, value exp)
2938
+
{
2939
+
CAMLparam2(base,exp);
2940
+
CAMLlocal1(r);
2941
+
mpz_t mbase;
2942
+
intnat e = Long_val(exp);
2943
+
mp_size_t sz, ralloc;
2944
+
int cnt;
2945
+
if (e < 0)
2946
+
caml_invalid_argument("Z.pow: exponent must be nonnegative");
2947
+
ml_z_mpz_init_set_z(mbase, base);
2948
+
2949
+
/* Safe overapproximation of the size of the result.
2950
+
In case this overflows an int, GMP may abort with a message
2951
+
"gmp: overflow in mpz type". To avoid this, we test the size before
2952
+
calling mpz_pow_ui and raise an OCaml exception.
2953
+
Note: we lifted the computation from mpz_n_pow_ui.
2954
+
*/
2955
+
sz = mbase->_mp_size;
2956
+
if (sz < 0) sz = -sz;
2957
+
cnt = sz > 0 ? ml_z_clz(mbase->_mp_d[sz - 1]) : 0;
2958
+
ralloc = (sz * GMP_NUMB_BITS - cnt + GMP_NAIL_BITS) * e / GMP_NUMB_BITS + 5;
2959
+
if (ralloc > INT_MAX) {
2960
+
mpz_clear(mbase);
2961
+
caml_invalid_argument("Z.pow: risk of overflow in mpz type");
2962
+
}
2963
+
mpz_pow_ui(mbase, mbase, e);
2964
+
r = ml_z_from_mpz(mbase);
2965
+
mpz_clear(mbase);
2966
+
CAMLreturn(r);
2967
+
}
2968
+
2969
+
CAMLprim value ml_z_root(value a, value b)
2970
+
{
2971
+
CAMLparam2(a,b);
2972
+
CAMLlocal1(r);
2973
+
Z_DECL(a);
2974
+
mpz_t ma;
2975
+
intnat mb = Long_val(b);
2976
+
if (mb <= 0)
2977
+
caml_invalid_argument("Z.root: exponent must be positive");
2978
+
Z_ARG(a);
2979
+
if (!(mb & 1) && sign_a)
2980
+
caml_invalid_argument("Z.root: even root of a negative number");
2981
+
ml_z_mpz_init_set_z(ma, a);
2982
+
mpz_root(ma, ma, mb);
2983
+
r = ml_z_from_mpz(ma);
2984
+
mpz_clear(ma);
2985
+
CAMLreturn(r);
2986
+
}
2987
+
2988
+
CAMLprim value ml_z_rootrem(value a, value b)
2989
+
{
2990
+
CAMLparam2(a,b);
2991
+
CAMLlocal3(r1,r2,r3);
2992
+
Z_DECL(a);
2993
+
mpz_t ma, mr1, mr2;
2994
+
intnat mb = Long_val(b);
2995
+
if (mb <= 0)
2996
+
caml_invalid_argument("Z.rootrem: exponent must be positive");
2997
+
Z_ARG(a);
2998
+
if (!(mb & 1) && sign_a)
2999
+
caml_invalid_argument("Z.rootrem: even root of a negative number");
3000
+
ml_z_mpz_init_set_z(ma, a);
3001
+
mpz_init(mr1);
3002
+
mpz_init(mr2);
3003
+
mpz_rootrem(mr1, mr2, ma, mb);
3004
+
r1 = ml_z_from_mpz(mr1);
3005
+
r2 = ml_z_from_mpz(mr2);
3006
+
r3 = caml_alloc_small(2, 0);
3007
+
Field(r3,0) = r1;
3008
+
Field(r3,1) = r2;
3009
+
mpz_clear(ma);
3010
+
mpz_clear(mr1);
3011
+
mpz_clear(mr2);
3012
+
CAMLreturn(r3);
3013
+
}
3014
+
3015
+
CAMLprim value ml_z_perfect_power(value a)
3016
+
{
3017
+
CAMLparam1(a);
3018
+
int r;
3019
+
mpz_t ma;
3020
+
ml_z_mpz_init_set_z(ma, a);
3021
+
r = mpz_perfect_power_p(ma);
3022
+
mpz_clear(ma);
3023
+
CAMLreturn(r ? Val_true : Val_false);
3024
+
}
3025
+
3026
+
CAMLprim value ml_z_perfect_square(value a)
3027
+
{
3028
+
CAMLparam1(a);
3029
+
int r;
3030
+
mpz_t ma;
3031
+
ml_z_mpz_init_set_z(ma, a);
3032
+
r = mpz_perfect_square_p(ma);
3033
+
mpz_clear(ma);
3034
+
CAMLreturn(r ? Val_true : Val_false);
3035
+
}
3036
+
3037
+
CAMLprim value ml_z_probab_prime(value a, int b)
3038
+
{
3039
+
CAMLparam1(a);
3040
+
int r;
3041
+
mpz_t ma;
3042
+
ml_z_mpz_init_set_z(ma, a);
3043
+
r = mpz_probab_prime_p(ma, Int_val(b));
3044
+
mpz_clear(ma);
3045
+
CAMLreturn(Val_int(r));
3046
+
}
3047
+
3048
+
CAMLprim value ml_z_nextprime(value a)
3049
+
{
3050
+
CAMLparam1(a);
3051
+
CAMLlocal1(r);
3052
+
mpz_t ma;
3053
+
ml_z_mpz_init_set_z(ma, a);
3054
+
mpz_nextprime(ma, ma);
3055
+
r = ml_z_from_mpz(ma);
3056
+
mpz_clear(ma);
3057
+
CAMLreturn(r);
3058
+
}
3059
+
3060
+
CAMLprim value ml_z_invert(value base, value mod)
3061
+
{
3062
+
CAMLparam2(base,mod);
3063
+
CAMLlocal1(r);
3064
+
mpz_t mbase, mmod;
3065
+
ml_z_mpz_init_set_z(mbase, base);
3066
+
ml_z_mpz_init_set_z(mmod, mod);
3067
+
if (!mpz_invert(mbase, mbase, mmod)) {
3068
+
mpz_clear(mbase);
3069
+
mpz_clear(mmod);
3070
+
ml_z_raise_divide_by_zero();
3071
+
}
3072
+
r = ml_z_from_mpz(mbase);
3073
+
mpz_clear(mbase);
3074
+
mpz_clear(mmod);
3075
+
CAMLreturn(r);
3076
+
}
3077
+
3078
+
CAMLprim value ml_z_divisible(value a, value b)
3079
+
{
3080
+
CAMLparam2(a,b);
3081
+
mpz_t ma, mb;
3082
+
int r;
3083
+
ml_z_mpz_init_set_z(ma, a);
3084
+
ml_z_mpz_init_set_z(mb, b);
3085
+
r = mpz_divisible_p(ma, mb);
3086
+
mpz_clear(ma);
3087
+
mpz_clear(mb);
3088
+
CAMLreturn(Val_bool(r));
3089
+
}
3090
+
3091
+
CAMLprim value ml_z_congruent(value a, value b, value c)
3092
+
{
3093
+
CAMLparam3(a,b,c);
3094
+
mpz_t ma, mb, mc;
3095
+
int r;
3096
+
ml_z_mpz_init_set_z(ma, a);
3097
+
ml_z_mpz_init_set_z(mb, b);
3098
+
ml_z_mpz_init_set_z(mc, c);
3099
+
r = mpz_congruent_p(ma, mb, mc);
3100
+
mpz_clear(ma);
3101
+
mpz_clear(mb);
3102
+
mpz_clear(mc);
3103
+
CAMLreturn(Val_bool(r));
3104
+
}
3105
+
3106
+
CAMLprim value ml_z_jacobi(value a, value b)
3107
+
{
3108
+
CAMLparam2(a,b);
3109
+
mpz_t ma, mb;
3110
+
int r;
3111
+
ml_z_mpz_init_set_z(ma, a);
3112
+
ml_z_mpz_init_set_z(mb, b);
3113
+
r = mpz_jacobi(ma, mb);
3114
+
mpz_clear(ma);
3115
+
mpz_clear(mb);
3116
+
CAMLreturn(Val_int(r));
3117
+
}
3118
+
3119
+
CAMLprim value ml_z_legendre(value a, value b)
3120
+
{
3121
+
CAMLparam2(a,b);
3122
+
mpz_t ma, mb;
3123
+
int r;
3124
+
ml_z_mpz_init_set_z(ma, a);
3125
+
ml_z_mpz_init_set_z(mb, b);
3126
+
r = mpz_legendre(ma, mb);
3127
+
mpz_clear(ma);
3128
+
mpz_clear(mb);
3129
+
CAMLreturn(Val_int(r));
3130
+
}
3131
+
3132
+
CAMLprim value ml_z_kronecker(value a, value b)
3133
+
{
3134
+
CAMLparam2(a,b);
3135
+
mpz_t ma, mb;
3136
+
int r;
3137
+
ml_z_mpz_init_set_z(ma, a);
3138
+
ml_z_mpz_init_set_z(mb, b);
3139
+
r = mpz_kronecker(ma, mb);
3140
+
mpz_clear(ma);
3141
+
mpz_clear(mb);
3142
+
CAMLreturn(Val_int(r));
3143
+
}
3144
+
3145
+
CAMLprim value ml_z_remove(value a, value b)
3146
+
{
3147
+
CAMLparam2(a,b);
3148
+
CAMLlocal2(r,tmp);
3149
+
mpz_t ma, mb, mr;
3150
+
int i;
3151
+
ml_z_mpz_init_set_z(ma, a);
3152
+
ml_z_mpz_init_set_z(mb, b);
3153
+
mpz_init(mr);
3154
+
i = mpz_remove(mr, ma, mb);
3155
+
tmp = ml_z_from_mpz(mr);
3156
+
r = caml_alloc_small(2, 0);
3157
+
Field(r,0) = tmp;
3158
+
Field(r,1) = Val_int(i);
3159
+
mpz_clear(ma);
3160
+
mpz_clear(mb);
3161
+
mpz_clear(mr);
3162
+
CAMLreturn(r);
3163
+
}
3164
+
3165
+
CAMLprim value ml_z_fac(value a)
3166
+
{
3167
+
CAMLparam1(a);
3168
+
CAMLlocal1(r);
3169
+
mpz_t mr;
3170
+
intnat ma = Long_val(a);
3171
+
if (ma < 0)
3172
+
caml_invalid_argument("Z.fac: non-positive argument");
3173
+
mpz_init(mr);
3174
+
mpz_fac_ui(mr, ma);
3175
+
r = ml_z_from_mpz(mr);
3176
+
mpz_clear(mr);
3177
+
CAMLreturn(r);
3178
+
}
3179
+
3180
+
CAMLprim value ml_z_fac2(value a)
3181
+
{
3182
+
CAMLparam1(a);
3183
+
CAMLlocal1(r);
3184
+
mpz_t mr;
3185
+
intnat ma = Long_val(a);
3186
+
if (ma < 0)
3187
+
caml_invalid_argument("Z.fac2: non-positive argument");
3188
+
mpz_init(mr);
3189
+
mpz_2fac_ui(mr, ma);
3190
+
r = ml_z_from_mpz(mr);
3191
+
mpz_clear(mr);
3192
+
CAMLreturn(r);
3193
+
}
3194
+
3195
+
CAMLprim value ml_z_facM(value a, value b)
3196
+
{
3197
+
CAMLparam2(a,b);
3198
+
CAMLlocal1(r);
3199
+
mpz_t mr;
3200
+
intnat ma = Long_val(a), mb = Long_val(b);
3201
+
if (ma < 0 || mb < 0)
3202
+
caml_invalid_argument("Z.facM: non-positive argument");
3203
+
mpz_init(mr);
3204
+
mpz_mfac_uiui(mr, ma, mb);
3205
+
r = ml_z_from_mpz(mr);
3206
+
mpz_clear(mr);
3207
+
CAMLreturn(r);
3208
+
}
3209
+
3210
+
CAMLprim value ml_z_primorial(value a)
3211
+
{
3212
+
CAMLparam1(a);
3213
+
CAMLlocal1(r);
3214
+
mpz_t mr;
3215
+
intnat ma = Long_val(a);
3216
+
if (ma < 0)
3217
+
caml_invalid_argument("Z.primorial: non-positive argument");
3218
+
mpz_init(mr);
3219
+
mpz_primorial_ui(mr, ma);
3220
+
r = ml_z_from_mpz(mr);
3221
+
mpz_clear(mr);
3222
+
CAMLreturn(r);
3223
+
}
3224
+
3225
+
CAMLprim value ml_z_bin(value a, value b)
3226
+
{
3227
+
CAMLparam2(a,b);
3228
+
CAMLlocal1(r);
3229
+
mpz_t ma;
3230
+
intnat mb = Long_val(b);
3231
+
if (mb < 0)
3232
+
caml_invalid_argument("Z.bin: non-positive argument");
3233
+
ml_z_mpz_init_set_z(ma, a);
3234
+
mpz_bin_ui(ma, ma, mb);
3235
+
r = ml_z_from_mpz(ma);
3236
+
mpz_clear(ma);
3237
+
CAMLreturn(r);
3238
+
}
3239
+
3240
+
CAMLprim value ml_z_fib(value a)
3241
+
{
3242
+
CAMLparam1(a);
3243
+
CAMLlocal1(r);
3244
+
mpz_t mr;
3245
+
intnat ma = Long_val(a);
3246
+
if (ma < 0)
3247
+
caml_invalid_argument("Z.fib: non-positive argument");
3248
+
mpz_init(mr);
3249
+
mpz_fib_ui(mr, ma);
3250
+
r = ml_z_from_mpz(mr);
3251
+
mpz_clear(mr);
3252
+
CAMLreturn(r);
3253
+
}
3254
+
3255
+
CAMLprim value ml_z_lucnum(value a)
3256
+
{
3257
+
CAMLparam1(a);
3258
+
CAMLlocal1(r);
3259
+
mpz_t mr;
3260
+
intnat ma = Long_val(a);
3261
+
if (ma < 0)
3262
+
caml_invalid_argument("Z.lucnum: non-positive argument");
3263
+
mpz_init(mr);
3264
+
mpz_lucnum_ui(mr, ma);
3265
+
r = ml_z_from_mpz(mr);
3266
+
mpz_clear(mr);
3267
+
CAMLreturn(r);
3268
+
}
3269
+
3270
+
3271
+
3272
+
/* XXX should we support the following?
3273
+
mpz_scan0, mpz_scan1
3274
+
mpz_setbit, mpz_clrbit, mpz_combit, mpz_tstbit
3275
+
mpz_odd_p, mpz_even_p
3276
+
random numbers
3277
+
*/
3278
+
3279
+
3280
+
3281
+
/*---------------------------------------------------
3282
+
CUSTOMS BLOCKS
3283
+
---------------------------------------------------*/
3284
+
3285
+
/* With OCaml < 3.12.1, comparing a block an int with OCaml's
3286
+
polymorphic compare will give erroneous results (int always
3287
+
strictly smaller than block). OCaml 3.12.1 and above
3288
+
give the correct result.
3289
+
*/
3290
+
int ml_z_custom_compare(value arg1, value arg2)
3291
+
{
3292
+
Z_DECL(arg1); Z_DECL(arg2);
3293
+
int r;
3294
+
Z_CHECK(arg1); Z_CHECK(arg2);
3295
+
#if Z_FAST_PATH
3296
+
/* Value-equal small integers are equal.
3297
+
Pointer-equal big integers are equal as well. */
3298
+
if (arg1 == arg2) return 0;
3299
+
if (Is_long(arg2)) {
3300
+
if (Is_long(arg1)) {
3301
+
return arg1 > arg2 ? 1 : -1;
3302
+
} else {
3303
+
/* Either arg1 is positive and arg1 > Z_MAX_INT >= arg2 -> result +1
3304
+
or arg1 is negative and arg1 < Z_MIN_INT <= arg2 -> result -1 */
3305
+
return Z_SIGN(arg1) ? -1 : 1;
3306
+
}
3307
+
}
3308
+
else if (Is_long(arg1)) {
3309
+
/* Either arg2 is positive and arg2 > Z_MAX_INT >= arg1 -> result -1
3310
+
or arg2 is negative and arg2 < Z_MIN_INT <= arg1 -> result +1 */
3311
+
return Z_SIGN(arg2) ? 1 : -1;
3312
+
}
3313
+
#endif
3314
+
r = 0;
3315
+
Z_ARG(arg1);
3316
+
Z_ARG(arg2);
3317
+
if (sign_arg1 != sign_arg2) r = 1;
3318
+
else if (size_arg1 > size_arg2) r = 1;
3319
+
else if (size_arg1 < size_arg2) r = -1;
3320
+
else {
3321
+
mp_size_t i;
3322
+
for (i = size_arg1 - 1; i >= 0; i--) {
3323
+
if (ptr_arg1[i] > ptr_arg2[i]) { r = 1; break; }
3324
+
if (ptr_arg1[i] < ptr_arg2[i]) { r = -1; break; }
3325
+
}
3326
+
}
3327
+
if (sign_arg1) r = -r;
3328
+
return r;
3329
+
}
3330
+
3331
+
static intnat ml_z_custom_hash(value v)
3332
+
{
3333
+
Z_DECL(v);
3334
+
mp_size_t i;
3335
+
uint32_t acc = 0;
3336
+
Z_CHECK(v);
3337
+
Z_ARG(v);
3338
+
for (i = 0; i < size_v; i++) {
3339
+
acc = caml_hash_mix_uint32(acc, (uint32_t)(ptr_v[i]));
3340
+
#ifdef ARCH_SIXTYFOUR
3341
+
acc = caml_hash_mix_uint32(acc, ptr_v[i] >> 32);
3342
+
#endif
3343
+
}
3344
+
#ifndef ARCH_SIXTYFOUR
3345
+
/* To obtain the same hash value on 32- and 64-bit platforms */
3346
+
if (size_v % 2 != 0)
3347
+
acc = caml_hash_mix_uint32(acc, 0);
3348
+
#endif
3349
+
if (sign_v) acc++;
3350
+
return acc;
3351
+
}
3352
+
3353
+
/* serialized format:
3354
+
- 1-byte sign (1 for negative, 0 for positive)
3355
+
- 4-byte size in bytes
3356
+
- size-byte unsigned integer, in little endian order
3357
+
*/
3358
+
static void ml_z_custom_serialize(value v,
3359
+
uintnat * wsize_32,
3360
+
uintnat * wsize_64)
3361
+
{
3362
+
mp_size_t i,nb;
3363
+
Z_DECL(v);
3364
+
Z_CHECK(v);
3365
+
Z_ARG(v);
3366
+
if ((mp_size_t)(uint32_t) size_v != size_v)
3367
+
caml_failwith("Z.serialize: number is too large");
3368
+
nb = size_v * sizeof(mp_limb_t);
3369
+
caml_serialize_int_1(sign_v ? 1 : 0);
3370
+
caml_serialize_int_4(nb);
3371
+
for (i = 0; i < size_v; i++) {
3372
+
mp_limb_t x = ptr_v[i];
3373
+
caml_serialize_int_1(x);
3374
+
caml_serialize_int_1(x >> 8);
3375
+
caml_serialize_int_1(x >> 16);
3376
+
caml_serialize_int_1(x >> 24);
3377
+
#ifdef ARCH_SIXTYFOUR
3378
+
caml_serialize_int_1(x >> 32);
3379
+
caml_serialize_int_1(x >> 40);
3380
+
caml_serialize_int_1(x >> 48);
3381
+
caml_serialize_int_1(x >> 56);
3382
+
#endif
3383
+
}
3384
+
*wsize_32 = 4 * (1 + (nb + 3) / 4);
3385
+
*wsize_64 = 8 * (1 + (nb + 7) / 8);
3386
+
#if Z_PERFORM_CHECK
3387
+
/* Add space for canary */
3388
+
*wsize_32 += 4;
3389
+
*wsize_64 += 8;
3390
+
#endif
3391
+
}
3392
+
3393
+
/* There are two issues with integers that are tagged ints on a 64-bit
3394
+
machine but boxed bigints on a 32-bit machine, namely integers in the
3395
+
[2^30, 2^62) and [-2^62, -2^30) ranges:
3396
+
- Serializing such an integer on a 64-bit machine and
3397
+
deserializing on a 32-bit machine will fail in the generic unmarshaler.
3398
+
The correct behavior would be to return a boxed integer.
3399
+
- Serializing such an integer on a 32-bit machine and
3400
+
deserializing on a 64-bit machine must fail.
3401
+
The wrong behavior would be to return a block containing a
3402
+
non-normalized, boxed integer (issue #148).
3403
+
*/
3404
+
static uintnat ml_z_custom_deserialize(void * dst)
3405
+
{
3406
+
mp_limb_t* d = ((mp_limb_t*)dst) + 1;
3407
+
int sign = caml_deserialize_uint_1();
3408
+
uint32_t sz = caml_deserialize_uint_4();
3409
+
uint32_t szw = (sz + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t);
3410
+
uint32_t i = 0;
3411
+
mp_limb_t x;
3412
+
/* all limbs but last */
3413
+
if (szw > 1) {
3414
+
for (; i < szw - 1; i++) {
3415
+
x = caml_deserialize_uint_1();
3416
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 8;
3417
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 16;
3418
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 24;
3419
+
#ifdef ARCH_SIXTYFOUR
3420
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 32;
3421
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 40;
3422
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 48;
3423
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 56;
3424
+
#endif
3425
+
d[i] = x;
3426
+
}
3427
+
sz -= i * sizeof(mp_limb_t);
3428
+
}
3429
+
/* last limb */
3430
+
if (sz > 0) {
3431
+
x = caml_deserialize_uint_1();
3432
+
if (sz > 1) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 8;
3433
+
if (sz > 2) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 16;
3434
+
if (sz > 3) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 24;
3435
+
#ifdef ARCH_SIXTYFOUR
3436
+
if (sz > 4) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 32;
3437
+
if (sz > 5) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 40;
3438
+
if (sz > 6) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 48;
3439
+
if (sz > 7) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 56;
3440
+
#endif
3441
+
d[i] = x;
3442
+
i++;
3443
+
}
3444
+
while (i > 0 && !d[i-1]) i--;
3445
+
d[-1] = i | (sign ? Z_SIGN_MASK : 0);
3446
+
#if Z_PERFORM_CHECK
3447
+
d[szw] = 0xDEADBEEF ^ szw;
3448
+
szw++;
3449
+
#endif
3450
+
#if Z_USE_NATINT
3451
+
if (i == 0 ||
3452
+
(i == 1 && (d[0] <= Z_MAX_INT || (d[0] == -Z_MIN_INT && sign)))) {
3453
+
/* Issue #148: this is not a canonical representation,
3454
+
so we raise a Failure */
3455
+
caml_deserialize_error("Z.t value produced on a 32-bit platform cannot be read on a 64-bit platform");
3456
+
}
3457
+
#endif
3458
+
return (szw+1) * sizeof(mp_limb_t);
3459
+
}
3460
+
3461
+
struct custom_operations ml_z_custom_ops = {
3462
+
/* Identifiers starting with _ are normally reserved for the OCaml runtime
3463
+
system, but we got authorization form Gallium to use "_z".
3464
+
It is very compact and stays in the spirit of identifiers used for
3465
+
int32 & co ("_i" & co.).
3466
+
*/
3467
+
"_z",
3468
+
custom_finalize_default,
3469
+
ml_z_custom_compare,
3470
+
ml_z_custom_hash,
3471
+
ml_z_custom_serialize,
3472
+
ml_z_custom_deserialize,
3473
+
ml_z_custom_compare,
3474
+
#ifndef Z_OCAML_LEGACY_CUSTOM_OPERATIONS
3475
+
custom_fixed_length_default
3476
+
#endif
3477
+
};
3478
+
3479
+
3480
+
/*---------------------------------------------------
3481
+
CONVERSION WITH MLGMPIDL
3482
+
---------------------------------------------------*/
3483
+
3484
+
CAMLprim value ml_z_mlgmpidl_of_mpz(value a)
3485
+
{
3486
+
CAMLparam1(a);
3487
+
mpz_ptr mpz = (mpz_ptr)(Data_custom_val(a));
3488
+
CAMLreturn(ml_z_from_mpz(mpz));
3489
+
}
3490
+
3491
+
/* stores the Z.t object into an existing Mpz.t one;
3492
+
as we never allocate Mpz.t objects, we don't need any pointer to
3493
+
mlgmpidl's custom block ops, and so, can link the function even if
3494
+
mlgmpidl is not installed
3495
+
*/
3496
+
CAMLprim value ml_z_mlgmpidl_set_mpz(value r, value a)
3497
+
{
3498
+
CAMLparam2(r,a);
3499
+
mpz_ptr mpz = (mpz_ptr)(Data_custom_val(r));
3500
+
ml_z_mpz_set_z(mpz,a);
3501
+
CAMLreturn(Val_unit);
3502
+
}
3503
+
3504
+
3505
+
3506
+
/*---------------------------------------------------
3507
+
INIT / EXIT
3508
+
---------------------------------------------------*/
3509
+
3510
+
/* called at program exit to display performance information */
3511
+
#if Z_PERF_COUNTER
3512
+
static void ml_z_dump_count()
3513
+
{
3514
+
printf("Z: %lu asm operations, %lu C operations, %lu slow (%lu%%)\n",
3515
+
ml_z_ops_as, ml_z_ops, ml_z_slow,
3516
+
ml_z_ops ? (ml_z_slow*100/(ml_z_ops+ml_z_ops_as)) : 0);
3517
+
}
3518
+
#endif
3519
+
3520
+
CAMLprim value ml_z_init()
3521
+
{
3522
+
ml_z_2p32 = ldexp(1., 32);
3523
+
/* run-time checks */
3524
+
#ifdef ARCH_SIXTYFOUR
3525
+
if (sizeof(intnat) != 8 || sizeof(mp_limb_t) != 8)
3526
+
caml_failwith("Z.init: invalid size of types, 8 expected");
3527
+
#else
3528
+
if (sizeof(intnat) != 4 || sizeof(mp_limb_t) != 4)
3529
+
caml_failwith("Z.init: invalid size of types, 4 expected");
3530
+
#endif
3531
+
/* install functions */
3532
+
#if Z_PERF_COUNTER
3533
+
atexit(ml_z_dump_count);
3534
+
#endif
3535
+
#if Z_CUSTOM_BLOCK
3536
+
caml_register_custom_operations(&ml_z_custom_ops);
3537
+
#endif
3538
+
return Val_unit;
3539
+
}
3540
+
3541
+
#ifdef __cplusplus
3542
+
}
3543
+
#endif
+574
vendor/opam/zarith/_build/default/q.ml
+574
vendor/opam/zarith/_build/default/q.ml
···
1
+
(**
2
+
Rationals.
3
+
4
+
5
+
This file is part of the Zarith library
6
+
http://forge.ocamlcore.org/projects/zarith .
7
+
It is distributed under LGPL 2 licensing, with static linking exception.
8
+
See the LICENSE file included in the distribution.
9
+
10
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
11
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
12
+
a joint laboratory by:
13
+
CNRS (Centre national de la recherche scientifique, France),
14
+
ENS (École normale supérieure, Paris, France),
15
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
16
+
17
+
*)
18
+
19
+
type t = {
20
+
num: Z.t; (** Numerator. *)
21
+
den: Z.t; (** Denominator, >= 0 *)
22
+
}
23
+
(* Type of rationals.
24
+
Invariants:
25
+
- den is always >= 0;
26
+
- num and den have no common factor;
27
+
- if den=0, then num is -1, 0 or 1.
28
+
- if num=0, then den is -1, 0 or 1.
29
+
*)
30
+
31
+
32
+
33
+
(* creation *)
34
+
(* -------- *)
35
+
36
+
(* make *)
37
+
let mk n d =
38
+
{ num = n; den = d; }
39
+
40
+
(* make and normalize n/d, assuming d > 0 *)
41
+
let make_real n d =
42
+
if n == Z.zero || d == Z.one then mk n Z.one
43
+
else
44
+
let g = Z.gcd n d in
45
+
if g == Z.one
46
+
then mk n d
47
+
else mk (Z.divexact n g) (Z.divexact d g)
48
+
49
+
(* make and normalize any fraction *)
50
+
let make n d =
51
+
let sd = Z.sign d in
52
+
if sd = 0 then mk (Z.of_int (Z.sign n)) Z.zero else
53
+
if sd > 0 then make_real n d else
54
+
make_real (Z.neg n) (Z.neg d)
55
+
56
+
let of_bigint n = mk n Z.one
57
+
(* n/1 *)
58
+
59
+
let of_int n = of_bigint (Z.of_int n)
60
+
61
+
let of_int32 n = of_bigint (Z.of_int32 n)
62
+
63
+
let of_int64 n = of_bigint (Z.of_int64 n)
64
+
65
+
let of_nativeint n = of_bigint (Z.of_nativeint n)
66
+
67
+
let of_ints n d = make (Z.of_int n) (Z.of_int d)
68
+
69
+
let zero = of_bigint Z.zero
70
+
(* 0/1 *)
71
+
72
+
let one = of_bigint Z.one
73
+
(* 1/1 *)
74
+
75
+
let minus_one = of_bigint Z.minus_one
76
+
(* -1/1 *)
77
+
78
+
let inf = mk Z.one Z.zero
79
+
(* 1/0 *)
80
+
81
+
let minus_inf = mk Z.minus_one Z.zero
82
+
(* -1/0 *)
83
+
84
+
let undef = mk Z.zero Z.zero
85
+
(* 0/0 *)
86
+
87
+
let of_float d =
88
+
if d = infinity then inf else
89
+
if d = neg_infinity then minus_inf else
90
+
if classify_float d = FP_nan then undef else
91
+
let m,e = frexp d in
92
+
(* put into the form m * 2^e, where m is an integer *)
93
+
let m,e = Z.of_float (ldexp m 53), e-53 in
94
+
if e >= 0 then of_bigint (Z.shift_left m e)
95
+
else make_real m (Z.shift_left Z.one (-e))
96
+
97
+
(* queries *)
98
+
(* ------- *)
99
+
100
+
type kind =
101
+
| ZERO (* 0 *)
102
+
| INF (* 1/0 *)
103
+
| MINF (* -1/0 *)
104
+
| UNDEF (* 0/0 *)
105
+
| NZERO (* non-special, non-0 *)
106
+
107
+
let classify n =
108
+
if n.den == Z.zero then
109
+
match Z.sign n.num with
110
+
| 1 -> INF
111
+
| -1 -> MINF
112
+
| _ -> UNDEF
113
+
else
114
+
if n.num == Z.zero
115
+
then ZERO
116
+
else NZERO
117
+
118
+
let is_real n = (n.den != Z.zero)
119
+
120
+
let num x = x.num
121
+
122
+
let den x = x.den
123
+
124
+
let sign x = Z.sign x.num
125
+
(* sign undef = 0
126
+
sign inf = 1
127
+
sign -inf = -1
128
+
*)
129
+
130
+
let equal x y =
131
+
(Z.equal x.num y.num) && (Z.equal x.den y.den) && (classify x <> UNDEF)
132
+
133
+
let compare x y =
134
+
match classify x, classify y with
135
+
| UNDEF,UNDEF | INF,INF | MINF,MINF -> 0
136
+
| UNDEF,_ -> -1
137
+
| _,UNDEF -> 1
138
+
| MINF,_ | _,INF -> -1
139
+
| INF,_ | _,MINF -> 1
140
+
| _ ->
141
+
if x.den = y.den (* implies equality,
142
+
especially if immediate value and not a pointer,
143
+
in particular in the case den = 1 *)
144
+
then Z.compare x.num y.num
145
+
else
146
+
Z.compare
147
+
(Z.mul x.num y.den)
148
+
(Z.mul y.num x.den)
149
+
150
+
let min a b = if compare a b <= 0 then a else b
151
+
let max a b = if compare a b >= 0 then a else b
152
+
153
+
154
+
let leq x y =
155
+
match classify x, classify y with
156
+
| UNDEF,_ | _,UNDEF -> false
157
+
| MINF,_ | _,INF -> true
158
+
| INF,_ | _,MINF -> false
159
+
| _ ->
160
+
if x.den = y.den
161
+
then Z.leq x.num y.num
162
+
else
163
+
Z.leq
164
+
(Z.mul x.num y.den)
165
+
(Z.mul y.num x.den)
166
+
167
+
let lt x y =
168
+
match classify x, classify y with
169
+
| UNDEF,_ | _,UNDEF -> false
170
+
| INF,_ | _,MINF -> false
171
+
| MINF,_ | _,INF -> true
172
+
| _ ->
173
+
if x.den = y.den
174
+
then Z.lt x.num y.num
175
+
else
176
+
Z.lt
177
+
(Z.mul x.num y.den)
178
+
(Z.mul y.num x.den)
179
+
180
+
let geq x y = leq y x
181
+
let gt x y = lt y x
182
+
183
+
let to_string n =
184
+
match classify n with
185
+
| UNDEF -> "undef"
186
+
| INF -> "+inf"
187
+
| MINF -> "-inf"
188
+
| ZERO -> "0"
189
+
| NZERO ->
190
+
if Z.equal n.den Z.one then Z.to_string n.num
191
+
else (Z.to_string n.num) ^ "/" ^ (Z.to_string n.den)
192
+
193
+
let to_bigint x = Z.div x.num x.den
194
+
(* raises a Division by zero in case x is undefined or infinity *)
195
+
196
+
let to_int x = Z.to_int (to_bigint x)
197
+
198
+
let to_int32 x = Z.to_int32 (to_bigint x)
199
+
200
+
let to_int64 x = Z.to_int64 (to_bigint x)
201
+
202
+
let to_nativeint x = Z.to_nativeint (to_bigint x)
203
+
204
+
let to_float x =
205
+
match classify x with
206
+
| ZERO -> 0.0
207
+
| INF -> infinity
208
+
| MINF -> neg_infinity
209
+
| UNDEF -> nan
210
+
| NZERO ->
211
+
let p = x.num and q = x.den in
212
+
let np = Z.numbits p and nq = Z.numbits q in
213
+
if np <= 53 && nq <= 53 then
214
+
(* p and q convert to floats exactly; use FP division to get the
215
+
correctly-rounded result. *)
216
+
Int64.to_float (Z.to_int64 p) /. Int64.to_float (Z.to_int64 q)
217
+
else begin
218
+
let negat =
219
+
if Z.sign p < 0 then -1 else 1
220
+
in
221
+
(* p is in [2^(np-1), 2^np)
222
+
q is in [2^(nq-1), 2^nq)
223
+
We define n,p',q' such that p'/q'*2^n=p/q and |p'/q'| is in [1, 2). *)
224
+
let n = np - nq in
225
+
(* Scaling p/q by 2^n *)
226
+
let (p', q') =
227
+
if n >= 0
228
+
then (p, Z.shift_left q n)
229
+
else (Z.shift_left p (-n), q)
230
+
in
231
+
let (p', n) =
232
+
if Z.geq (Z.abs p') q'
233
+
then (p', n)
234
+
else (Z.shift_left p' 1, pred n)
235
+
in
236
+
(* If we divided p' by q' now, the resulting quotient would
237
+
have one significant digit. *)
238
+
let p' = Z.shift_left p' 54 in
239
+
(* When we divide p' by q' next, the resulting quotient will
240
+
have 55 significant digits. The strategy is:
241
+
- First, compute the quotient with 55 significant digits in
242
+
round-to-odd, and
243
+
- Second, round that number to the number of effective
244
+
significant digits we desire for the result, which is 53
245
+
for a normal result and less than 53 for a subnormal result.
246
+
We cannot afford an intermediate rounding at 53 significant digits
247
+
if the end-result is subnormal. See
248
+
https://github.com/ocaml/Zarith/issues/29 *)
249
+
(* Euclidean division of p' by q' *)
250
+
let (quo, rem) = Z.ediv_rem p' q' in
251
+
if n <= -1080
252
+
then
253
+
(* The end result is +0.0 or -0.0 (depending on negat)
254
+
or perhaps the next floating-point number of the same
255
+
sign (depending on the current rounding mode. *)
256
+
ldexp (float_of_int negat) (-1080)
257
+
else
258
+
let offset =
259
+
if n <= -1023
260
+
then
261
+
(* The end result will be subnormal, add an offset
262
+
to make the rounding happen directly at the place
263
+
where it should happend.
264
+
quo has the form: 1xxxx...
265
+
we add: 1000000...
266
+
so as to end up with: 101xxxx... *)
267
+
Z.shift_left (Z.of_int negat) (55 + (-1023 - n))
268
+
else
269
+
Z.zero
270
+
in
271
+
let quo = Z.add offset quo in
272
+
let quo =
273
+
if Z.sign rem = 0
274
+
then quo
275
+
else Z.logor Z.one quo (* round to odd *)
276
+
in
277
+
(* The FPU rounding mode affects the Z.to_float that comes next,
278
+
making the rounding computed according to the current FPU rounding
279
+
mode. *)
280
+
let f = Z.to_float quo in
281
+
(* The subtraction that comes next is exact, so that the rounding
282
+
mode does not change what it does. *)
283
+
let f = f -. (Z.to_float offset)
284
+
in
285
+
(* ldexp is also exact and unaffected by the rounding mode.
286
+
We have made sure that if the end result is going to be subnormal,
287
+
then f has exactly the correct number of significant digits for
288
+
no rounding to happen here. *)
289
+
ldexp f (n - 54)
290
+
end
291
+
292
+
(* operations *)
293
+
(* ---------- *)
294
+
295
+
let neg x =
296
+
mk (Z.neg x.num) x.den
297
+
(* neg undef = undef
298
+
neg inf = -inf
299
+
neg -inf = inf
300
+
*)
301
+
302
+
let abs x =
303
+
mk (Z.abs x.num) x.den
304
+
(* abs undef = undef
305
+
abs inf = abs -inf = inf
306
+
*)
307
+
308
+
(* addition or substraction (zaors) of finite numbers *)
309
+
let aors zaors x y =
310
+
if x.den == y.den then (* implies equality,
311
+
especially if immediate value and not a pointer,
312
+
in particular in the case den = 1 *)
313
+
make_real (zaors x.num y.num) x.den
314
+
else
315
+
make_real
316
+
(zaors
317
+
(Z.mul x.num y.den)
318
+
(Z.mul y.num x.den))
319
+
(Z.mul x.den y.den)
320
+
321
+
let add x y =
322
+
if x.den == Z.zero || y.den == Z.zero then match classify x, classify y with
323
+
| ZERO,_ -> y
324
+
| _,ZERO -> x
325
+
| UNDEF,_ | _,UNDEF -> undef
326
+
| INF,MINF | MINF,INF -> undef
327
+
| INF,_ | _,INF -> inf
328
+
| MINF,_ | _,MINF -> minus_inf
329
+
| NZERO,NZERO -> failwith "impossible case"
330
+
else
331
+
aors Z.add x y
332
+
(* undef + x = x + undef = undef
333
+
inf + -inf = -inf + inf = undef
334
+
inf + x = x + inf = inf
335
+
-inf + x = x + -inf = -inf
336
+
*)
337
+
338
+
let sub x y =
339
+
if x.den == Z.zero || y.den == Z.zero then match classify x, classify y with
340
+
| ZERO,_ -> neg y
341
+
| _,ZERO -> x
342
+
| UNDEF,_ | _,UNDEF -> undef
343
+
| INF,INF | MINF,MINF -> undef
344
+
| INF,_ | _,MINF -> inf
345
+
| MINF,_ | _,INF -> minus_inf
346
+
| NZERO,NZERO -> failwith "impossible case"
347
+
else
348
+
aors Z.sub x y
349
+
(* sub x y = add x (neg y) *)
350
+
351
+
let mul x y =
352
+
if x.den == Z.zero || y.den == Z.zero then
353
+
mk
354
+
(Z.of_int ((Z.sign x.num) * (Z.sign y.num)))
355
+
Z.zero
356
+
else
357
+
make_real (Z.mul x.num y.num) (Z.mul x.den y.den)
358
+
359
+
(* undef * x = x * undef = undef
360
+
0 * inf = inf * 0 = 0 * -inf = -inf * 0 = undef
361
+
inf * x = x * inf = sign x * inf
362
+
-inf * x = x * -inf = - sign x * inf
363
+
*)
364
+
365
+
let inv x =
366
+
match Z.sign x.num with
367
+
| 1 -> mk x.den x.num
368
+
| -1 -> mk (Z.neg x.den) (Z.neg x.num)
369
+
| _ -> if x.den == Z.zero then undef else inf
370
+
(* 1 / undef = undef
371
+
1 / inf = 1 / -inf = 0
372
+
1 / 0 = inf
373
+
374
+
note that: inv (inv -inf) = inf <> -inf
375
+
*)
376
+
377
+
let div x y =
378
+
if Z.sign y.num >= 0
379
+
then mul x (mk y.den y.num)
380
+
else mul x (mk (Z.neg y.den) (Z.neg y.num))
381
+
(* undef / x = x / undef = undef
382
+
0 / 0 = undef
383
+
inf / inf = inf / -inf = -inf / inf = -inf / -inf = undef
384
+
0 / inf = 0 / -inf = x / inf = x / -inf = 0
385
+
inf / x = sign x * inf
386
+
-inf / x = - sign x * inf
387
+
inf / 0 = inf
388
+
-inf / 0 = -inf
389
+
x / 0 = sign x * inf
390
+
391
+
we have div x y = mul x (inv y)
392
+
*)
393
+
394
+
let mul_2exp x n =
395
+
if x.den == Z.zero then x
396
+
else make_real (Z.shift_left x.num n) x.den
397
+
398
+
let div_2exp x n =
399
+
if x.den == Z.zero then x
400
+
else make_real x.num (Z.shift_left x.den n)
401
+
402
+
403
+
type supported_base =
404
+
| B2 | B8 | B10 | B16
405
+
406
+
let int_of_base = function
407
+
| B2 -> 2
408
+
| B8 -> 8
409
+
| B10 -> 10
410
+
| B16 -> 16
411
+
412
+
(* [find_in_string s ~pos ~last pred] find the first index in the string between [pos]
413
+
(inclusive) and [last] (exclusive) that satisfy the predicate [pred] *)
414
+
let rec find_in_string s ~pos ~last p =
415
+
if pos >= last
416
+
then None
417
+
else if p s.[pos]
418
+
then Some pos
419
+
else find_in_string s ~pos:(pos + 1) ~last p
420
+
421
+
(* The current implementation supports plain decimals, decimal points,
422
+
scientific notation ('e' or 'E' for base 10 litteral and 'p' or 'P'
423
+
for base 16), and fraction of integers (eg. 1/2). In particular it
424
+
accepts any numeric literal accepted by OCaml's lexer.
425
+
Restrictions:
426
+
- exponents in scientific notation should fit on an integer
427
+
- scientific notation only available in hexa and decimal (as in OCaml) *)
428
+
let of_string =
429
+
(* return a boolean (true for negative) and the next offset to read *)
430
+
let parse_sign s i j =
431
+
if j < i + 1
432
+
then false, i
433
+
else
434
+
match s.[i] with
435
+
| '-' -> true , i + 1
436
+
| '+' -> false, i + 1
437
+
| _ -> false ,i
438
+
in
439
+
(* return the base and the next offset to read *)
440
+
let parse_base s i j =
441
+
if j < i + 2
442
+
then B10, i
443
+
else
444
+
match s.[i],s.[i+1] with
445
+
| '0',('x'|'X') -> B16, i + 2
446
+
| '0',('o'|'O') -> B8, i + 2
447
+
| '0',('b'|'B') -> B2, i + 2
448
+
| _ -> B10, i
449
+
in
450
+
let find_exponent_mark = function
451
+
| B10 -> (function 'e' | 'E' -> true | _ -> false)
452
+
| B16 -> (function 'p' | 'P' -> true | _ -> false)
453
+
| B8 | B2 -> (fun _ -> false)
454
+
in
455
+
let of_scientific_notation s =
456
+
let i = 0 in
457
+
let j = String.length s in
458
+
let sign,i = parse_sign s i j in
459
+
let base,i = parse_base s i j in
460
+
(* shift left due to the exponent *)
461
+
let shift_left, j =
462
+
match find_in_string s ~pos:i ~last:j (find_exponent_mark base) with
463
+
| None -> 0, j
464
+
| Some ei ->
465
+
let pos = ei + 1 in
466
+
let ez = Z.of_substring_base 10 s ~pos ~len:(j - pos) in
467
+
Z.to_int ez, ei
468
+
in
469
+
(* shift right due to the radix *)
470
+
let z, shift_right =
471
+
match base with
472
+
| B2 | B8 -> Z.of_substring_base (int_of_base base) s ~pos:i ~len:(j - i), 0
473
+
| B10 | B16 ->
474
+
match find_in_string s ~pos:i ~last:j ((=) '.') with
475
+
| None -> Z.of_substring_base (int_of_base base) s ~pos:i ~len:(j - i), 0
476
+
| Some k ->
477
+
(* shift_right_factor correspond to the shift to apply when we move the decimal
478
+
point one position to the left.
479
+
480
+
0x1.1p1 = 0x11p-3 = 0x0.11p5
481
+
1.1e1 = 11e0 = 0.11e2 *)
482
+
let shift_right_factor =
483
+
match base with
484
+
| B10 -> 1
485
+
| B16 -> 4
486
+
| B2 | B8 -> assert false
487
+
in
488
+
(* We should only consider actual digits to perform the shift. *)
489
+
let num_digits = ref 0 in
490
+
for h = k + 1 to j - 1 do
491
+
match s.[h] with
492
+
| '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' ->
493
+
incr num_digits
494
+
| '_' -> ()
495
+
| _ ->
496
+
(* '-' and '+' could wrongly be accepted by Z.of_string_base *)
497
+
invalid_arg "Q.of_string: invalid digit"
498
+
done;
499
+
let first_digit_after_dot =
500
+
match find_in_string s ~pos:(k+1) ~last:j ((<>) '_') with
501
+
| None -> j
502
+
| Some x -> x
503
+
in
504
+
let shift = !num_digits * shift_right_factor in
505
+
let without_dot =
506
+
String.sub s i (k-i)
507
+
^ (String.sub s first_digit_after_dot (j - first_digit_after_dot))
508
+
in
509
+
Z.of_string_base (int_of_base base) without_dot, shift
510
+
in
511
+
let shift = shift_left - shift_right in
512
+
let exponent_pow =
513
+
match base with
514
+
| B10 -> 10
515
+
| B16 -> 2
516
+
| B8 | B2 -> 1
517
+
in
518
+
let abs =
519
+
if shift < 0 then
520
+
make z (Z.pow (Z.of_int exponent_pow) (~- shift))
521
+
else
522
+
of_bigint (Z.mul z (Z.pow (Z.of_int exponent_pow) shift))
523
+
in
524
+
if sign
525
+
then neg abs
526
+
else abs
527
+
in
528
+
function
529
+
| "" -> zero
530
+
| "inf" | "+inf" -> inf
531
+
| "-inf" -> minus_inf
532
+
| "undef" -> undef
533
+
| s ->
534
+
try
535
+
let i = String.index s '/' in
536
+
make
537
+
(Z.of_substring s ~pos:0 ~len:i)
538
+
(Z.of_substring s ~pos:(i+1) ~len:(String.length s-i-1))
539
+
with Not_found ->
540
+
of_scientific_notation s
541
+
542
+
543
+
544
+
(* printing *)
545
+
(* -------- *)
546
+
547
+
let print x = print_string (to_string x)
548
+
let output chan x = output_string chan (to_string x)
549
+
let sprint () x = to_string x
550
+
let bprint b x = Buffer.add_string b (to_string x)
551
+
let pp_print f x = Format.pp_print_string f (to_string x)
552
+
553
+
554
+
(* prefix and infix *)
555
+
(* ---------------- *)
556
+
557
+
let (~-) = neg
558
+
let (~+) x = x
559
+
let (+) = add
560
+
let (-) = sub
561
+
let ( * ) = mul
562
+
let (/) = div
563
+
let (lsl) = mul_2exp
564
+
let (asr) = div_2exp
565
+
let (~$) = of_int
566
+
let (//) = of_ints
567
+
let (~$$) = of_bigint
568
+
let (///) = make
569
+
let (=) = equal
570
+
let (<) = lt
571
+
let (>) = gt
572
+
let (<=) = leq
573
+
let (>=) = geq
574
+
let (<>) a b = not (equal a b)
+298
vendor/opam/zarith/_build/default/q.mli
+298
vendor/opam/zarith/_build/default/q.mli
···
1
+
(**
2
+
Rationals.
3
+
4
+
This modules builds arbitrary precision rationals on top of arbitrary
5
+
integers from module Z.
6
+
7
+
8
+
This file is part of the Zarith library
9
+
http://forge.ocamlcore.org/projects/zarith .
10
+
It is distributed under LGPL 2 licensing, with static linking exception.
11
+
See the LICENSE file included in the distribution.
12
+
13
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
14
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
15
+
a joint laboratory by:
16
+
CNRS (Centre national de la recherche scientifique, France),
17
+
ENS (École normale supérieure, Paris, France),
18
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
19
+
20
+
*)
21
+
22
+
(** {1 Types} *)
23
+
24
+
type t = {
25
+
num: Z.t; (** Numerator. *)
26
+
den: Z.t; (** Denominator, >= 0 *)
27
+
}
28
+
(** A rational is represented as a pair numerator/denominator, reduced to
29
+
have a non-negative denominator and no common factor.
30
+
This form is canonical (enabling polymorphic equality and hashing).
31
+
The representation allows three special numbers: [inf] (1/0), [-inf] (-1/0)
32
+
and [undef] (0/0).
33
+
*)
34
+
35
+
(** {1 Construction} *)
36
+
37
+
val make: Z.t -> Z.t -> t
38
+
(** [make num den] constructs a new rational equal to [num]/[den].
39
+
It takes care of putting the rational in canonical form.
40
+
*)
41
+
42
+
val zero: t
43
+
val one: t
44
+
val minus_one:t
45
+
(** 0, 1, -1. *)
46
+
47
+
val inf: t
48
+
(** 1/0. *)
49
+
50
+
val minus_inf: t
51
+
(** -1/0. *)
52
+
53
+
val undef: t
54
+
(** 0/0. *)
55
+
56
+
val of_bigint: Z.t -> t
57
+
val of_int: int -> t
58
+
val of_int32: int32 -> t
59
+
val of_int64: int64 -> t
60
+
val of_nativeint: nativeint -> t
61
+
(** Conversions from various integer types. *)
62
+
63
+
val of_ints: int -> int -> t
64
+
(** Conversion from an [int] numerator and an [int] denominator. *)
65
+
66
+
val of_float: float -> t
67
+
(** Conversion from a [float].
68
+
The conversion is exact, and maps NaN to [undef].
69
+
*)
70
+
71
+
72
+
val of_string: string -> t
73
+
(** Converts a string to a rational. Plain integers, [/] separated
74
+
integer ratios (with optional sign), decimal point and scientific
75
+
notations are understood.
76
+
Additionally, the special [inf], [-inf], and [undef] are
77
+
recognized (they can also be typeset respectively as [1/0], [-1/0],
78
+
[0/0]). *)
79
+
80
+
81
+
(** {1 Inspection} *)
82
+
83
+
val num: t -> Z.t
84
+
(** Get the numerator. *)
85
+
86
+
val den: t -> Z.t
87
+
(** Get the denominator. *)
88
+
89
+
90
+
(** {1 Testing} *)
91
+
92
+
type kind =
93
+
| ZERO (** 0 *)
94
+
| INF (** infinity, i.e. 1/0 *)
95
+
| MINF (** minus infinity, i.e. -1/0 *)
96
+
| UNDEF (** undefined, i.e., 0/0 *)
97
+
| NZERO (** well-defined, non-infinity, non-zero number *)
98
+
(** Rationals can be categorized into different kinds, depending mainly on
99
+
whether the numerator and/or denominator is null.
100
+
*)
101
+
102
+
val classify: t -> kind
103
+
(** Determines the kind of a rational. *)
104
+
105
+
val is_real: t -> bool
106
+
(** Whether the argument is non-infinity and non-undefined. *)
107
+
108
+
val sign: t -> int
109
+
(** Returns 1 if the argument is positive (including inf), -1 if it is
110
+
negative (including -inf), and 0 if it is null or undefined.
111
+
*)
112
+
113
+
val compare: t -> t -> int
114
+
(** [compare x y] compares [x] to [y] and returns 1 if [x] is strictly
115
+
greater that [y], -1 if it is strictly smaller, and 0 if they are
116
+
equal.
117
+
This is a total ordering.
118
+
Infinities are ordered in the natural way, while undefined is considered
119
+
the smallest of all: undef = undef < -inf <= -inf < x < inf <= inf.
120
+
This is consistent with OCaml's handling of floating-point infinities
121
+
and NaN.
122
+
123
+
OCaml's polymorphic comparison will NOT return a result consistent with
124
+
the ordering of rationals.
125
+
*)
126
+
127
+
val equal: t -> t -> bool
128
+
(** Equality testing.
129
+
Unlike [compare], this follows IEEE semantics: [undef] <> [undef].
130
+
*)
131
+
132
+
val min: t -> t -> t
133
+
(** Returns the smallest of its arguments. *)
134
+
135
+
val max: t -> t -> t
136
+
(** Returns the largest of its arguments. *)
137
+
138
+
val leq: t -> t -> bool
139
+
(** Less than or equal. [leq undef undef] returns false. *)
140
+
141
+
val geq: t -> t -> bool
142
+
(** Greater than or equal. [leq undef undef] returns false. *)
143
+
144
+
val lt: t -> t -> bool
145
+
(** Less than (not equal). *)
146
+
147
+
val gt: t -> t -> bool
148
+
(** Greater than (not equal). *)
149
+
150
+
151
+
(** {1 Conversions} *)
152
+
153
+
val to_bigint: t -> Z.t
154
+
val to_int: t -> int
155
+
val to_int32: t -> int32
156
+
val to_int64: t -> int64
157
+
val to_nativeint: t -> nativeint
158
+
(** Convert to integer by truncation.
159
+
Raises a [Divide_by_zero] if the argument is an infinity or undefined.
160
+
Raises a [Z.Overflow] if the result does not fit in the destination
161
+
type.
162
+
*)
163
+
164
+
val to_string: t -> string
165
+
(** Converts to human-readable, base-10, [/]-separated rational. *)
166
+
167
+
val to_float: t -> float
168
+
(** Converts to a floating-point number, using the current
169
+
floating-point rounding mode. With the default rounding mode,
170
+
the result is the floating-point number closest to the given
171
+
rational; ties break to even mantissa. *)
172
+
173
+
(** {1 Arithmetic operations} *)
174
+
175
+
(**
176
+
In all operations, the result is [undef] if one argument is [undef].
177
+
Other operations can return [undef]: such as [inf]-[inf], [inf]*0, 0/0.
178
+
*)
179
+
180
+
val neg: t -> t
181
+
(** Negation. *)
182
+
183
+
val abs: t -> t
184
+
(** Absolute value. *)
185
+
186
+
val add: t -> t -> t
187
+
(** Addition. *)
188
+
189
+
val sub: t -> t -> t
190
+
(** Subtraction. We have [sub x y] = [add x (neg y)]. *)
191
+
192
+
val mul: t -> t -> t
193
+
(** Multiplication. *)
194
+
195
+
val inv: t -> t
196
+
(** Inverse.
197
+
Note that [inv 0] is defined, and equals [inf].
198
+
*)
199
+
200
+
val div: t -> t -> t
201
+
(** Division.
202
+
We have [div x y] = [mul x (inv y)], and [inv x] = [div one x].
203
+
*)
204
+
205
+
val mul_2exp: t -> int -> t
206
+
(** [mul_2exp x n] multiplies [x] by 2 to the power of [n]. *)
207
+
208
+
val div_2exp: t -> int -> t
209
+
(** [div_2exp x n] divides [x] by 2 to the power of [n]. *)
210
+
211
+
212
+
(** {1 Printing} *)
213
+
214
+
val print: t -> unit
215
+
(** Prints the argument on the standard output. *)
216
+
217
+
val output: out_channel -> t -> unit
218
+
(** Prints the argument on the specified channel.
219
+
Also intended to be used as [%a] format printer in [Printf.printf].
220
+
*)
221
+
222
+
val sprint: unit -> t -> string
223
+
(** To be used as [%a] format printer in [Printf.sprintf]. *)
224
+
225
+
val bprint: Buffer.t -> t -> unit
226
+
(** To be used as [%a] format printer in [Printf.bprintf]. *)
227
+
228
+
val pp_print: Format.formatter -> t -> unit
229
+
(** Prints the argument on the specified formatter.
230
+
Also intended to be used as [%a] format printer in [Format.printf].
231
+
*)
232
+
233
+
234
+
(** {1 Prefix and infix operators} *)
235
+
236
+
(**
237
+
Classic prefix and infix [int] operators are redefined on [t].
238
+
*)
239
+
240
+
val (~-): t -> t
241
+
(** Negation [neg]. *)
242
+
243
+
val (~+): t -> t
244
+
(** Identity. *)
245
+
246
+
val (+): t -> t -> t
247
+
(** Addition [add]. *)
248
+
249
+
val (-): t -> t -> t
250
+
(** Subtraction [sub]. *)
251
+
252
+
val ( * ): t -> t -> t
253
+
(** Multiplication [mul]. *)
254
+
255
+
val (/): t -> t -> t
256
+
(** Division [div]. *)
257
+
258
+
val (lsl): t -> int -> t
259
+
(** Multiplication by a power of two [mul_2exp]. *)
260
+
261
+
val (asr): t -> int -> t
262
+
(** Division by a power of two [shift_right]. *)
263
+
264
+
val (~$): int -> t
265
+
(** Conversion from [int]. *)
266
+
267
+
val (//): int -> int -> t
268
+
(** Creates a rational from two [int]s. *)
269
+
270
+
val (~$$): Z.t -> t
271
+
(** Conversion from [Z.t]. *)
272
+
273
+
val (///): Z.t -> Z.t -> t
274
+
(** Creates a rational from two [Z.t]. *)
275
+
276
+
val (=): t -> t -> bool
277
+
(** Same as [equal].
278
+
@since 1.8 *)
279
+
280
+
val (<): t -> t -> bool
281
+
(** Same as [lt].
282
+
@since 1.8 *)
283
+
284
+
val (>): t -> t -> bool
285
+
(** Same as [gt].
286
+
@since 1.8 *)
287
+
288
+
val (<=): t -> t -> bool
289
+
(** Same as [leq].
290
+
@since 1.8 *)
291
+
292
+
val (>=): t -> t -> bool
293
+
(** Same as [geq].
294
+
@since 1.8 *)
295
+
296
+
val (<>): t -> t -> bool
297
+
(** [a <> b] is equivalent to [not (equal a b)].
298
+
@since 1.8 *)
+555
vendor/opam/zarith/_build/default/z.ml
+555
vendor/opam/zarith/_build/default/z.ml
···
1
+
(**
2
+
Integers.
3
+
4
+
5
+
This file is part of the Zarith library
6
+
http://forge.ocamlcore.org/projects/zarith .
7
+
It is distributed under LGPL 2 licensing, with static linking exception.
8
+
See the LICENSE file included in the distribution.
9
+
10
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
11
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
12
+
a joint laboratory by:
13
+
CNRS (Centre national de la recherche scientifique, France),
14
+
ENS (École normale supérieure, Paris, France),
15
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
16
+
17
+
*)
18
+
19
+
type t
20
+
21
+
exception Overflow
22
+
23
+
external init: unit -> unit = "ml_z_init"
24
+
let _ = init ()
25
+
26
+
let _ = Callback.register_exception "ml_z_overflow" Overflow
27
+
28
+
external is_small_int: t -> bool = "%obj_is_int"
29
+
external unsafe_to_int: t -> int = "%identity"
30
+
external of_int: int -> t = "%identity"
31
+
32
+
external c_neg: t -> t = "ml_z_neg"
33
+
34
+
let neg x =
35
+
if is_small_int x && unsafe_to_int x <> min_int
36
+
then of_int (- unsafe_to_int x)
37
+
else c_neg x
38
+
39
+
external c_add: t -> t -> t = "ml_z_add"
40
+
41
+
let add x y =
42
+
if is_small_int x && is_small_int y then begin
43
+
let z = unsafe_to_int x + unsafe_to_int y in
44
+
(* Overflow check -- Hacker's Delight, section 2.12 *)
45
+
if (z lxor unsafe_to_int x) land (z lxor unsafe_to_int y) >= 0
46
+
then of_int z
47
+
else c_add x y
48
+
end else
49
+
c_add x y
50
+
51
+
external c_sub: t -> t -> t = "ml_z_sub"
52
+
53
+
let sub x y =
54
+
if is_small_int x && is_small_int y then begin
55
+
let z = unsafe_to_int x - unsafe_to_int y in
56
+
(* Overflow check -- Hacker's Delight, section 2.12 *)
57
+
if (unsafe_to_int x lxor unsafe_to_int y)
58
+
land (z lxor unsafe_to_int x) >= 0
59
+
then of_int z
60
+
else c_sub x y
61
+
end else
62
+
c_sub x y
63
+
64
+
external mul_overflows: int -> int -> bool = "ml_z_mul_overflows" [@@noalloc]
65
+
external c_mul: t -> t -> t = "ml_z_mul"
66
+
67
+
let mul x y =
68
+
if is_small_int x && is_small_int y
69
+
&& not (mul_overflows (unsafe_to_int x) (unsafe_to_int y))
70
+
then of_int (unsafe_to_int x * unsafe_to_int y)
71
+
else c_mul x y
72
+
73
+
external c_div: t -> t -> t = "ml_z_div"
74
+
75
+
let div x y =
76
+
if is_small_int y then
77
+
if unsafe_to_int y = -1 then
78
+
neg x
79
+
else if is_small_int x then
80
+
of_int (unsafe_to_int x / unsafe_to_int y)
81
+
else
82
+
c_div x y
83
+
else
84
+
c_div x y
85
+
86
+
external cdiv: t -> t -> t = "ml_z_cdiv"
87
+
external fdiv: t -> t -> t = "ml_z_fdiv"
88
+
89
+
external c_rem: t -> t -> t = "ml_z_rem"
90
+
91
+
let rem x y =
92
+
if is_small_int y then
93
+
if unsafe_to_int y = -1 then
94
+
of_int 0
95
+
else if is_small_int x then
96
+
of_int (unsafe_to_int x mod unsafe_to_int y)
97
+
else
98
+
c_rem x y
99
+
else
100
+
c_rem x y
101
+
102
+
external div_rem: t -> t -> (t * t) = "ml_z_div_rem"
103
+
104
+
external c_divexact: t -> t -> t = "ml_z_divexact"
105
+
106
+
let divexact x y =
107
+
if is_small_int y then
108
+
if unsafe_to_int y = -1 then
109
+
neg x
110
+
else if is_small_int x then
111
+
of_int (unsafe_to_int x / unsafe_to_int y)
112
+
else
113
+
c_divexact x y
114
+
else
115
+
c_divexact x y
116
+
117
+
external c_succ: t -> t = "ml_z_succ"
118
+
119
+
let succ x =
120
+
if is_small_int x && unsafe_to_int x <> max_int
121
+
then of_int (unsafe_to_int x + 1)
122
+
else c_succ x
123
+
124
+
external c_pred: t -> t = "ml_z_pred"
125
+
126
+
let pred x =
127
+
if is_small_int x && unsafe_to_int x <> min_int
128
+
then of_int (unsafe_to_int x - 1)
129
+
else c_pred x
130
+
131
+
external c_abs: t -> t = "ml_z_abs"
132
+
133
+
let abs x =
134
+
if is_small_int x then
135
+
if unsafe_to_int x >= 0 then x
136
+
else if unsafe_to_int x <> min_int then
137
+
of_int (- unsafe_to_int x)
138
+
else
139
+
c_abs x
140
+
else
141
+
c_abs x
142
+
143
+
external c_logand: t -> t -> t = "ml_z_logand"
144
+
145
+
let logand x y =
146
+
if is_small_int x && is_small_int y
147
+
then of_int (unsafe_to_int x land unsafe_to_int y)
148
+
else c_logand x y
149
+
150
+
external c_logor: t -> t -> t = "ml_z_logor"
151
+
152
+
let logor x y =
153
+
if is_small_int x && is_small_int y
154
+
then of_int (unsafe_to_int x lor unsafe_to_int y)
155
+
else c_logor x y
156
+
157
+
external c_logxor: t -> t -> t = "ml_z_logxor"
158
+
159
+
let logxor x y =
160
+
if is_small_int x && is_small_int y
161
+
then of_int (unsafe_to_int x lxor unsafe_to_int y)
162
+
else c_logxor x y
163
+
164
+
external c_lognot: t -> t = "ml_z_lognot"
165
+
166
+
let lognot x =
167
+
if is_small_int x
168
+
then of_int (unsafe_to_int x lxor (-1))
169
+
else c_lognot x
170
+
171
+
external c_shift_left: t -> int -> t = "ml_z_shift_left"
172
+
173
+
let shift_left x y =
174
+
if is_small_int x && y >= 0 && y < Sys.word_size then begin
175
+
let z = unsafe_to_int x lsl y in
176
+
if z asr y = unsafe_to_int x
177
+
then of_int z
178
+
else c_shift_left x y
179
+
end else
180
+
c_shift_left x y
181
+
182
+
external c_shift_right: t -> int -> t = "ml_z_shift_right"
183
+
184
+
let shift_right x y =
185
+
if is_small_int x && y >= 0 then
186
+
of_int
187
+
(unsafe_to_int x asr (if y < Sys.word_size then y else Sys.word_size - 1))
188
+
else
189
+
c_shift_right x y
190
+
191
+
external c_shift_right_trunc: t -> int -> t = "ml_z_shift_right_trunc"
192
+
193
+
let shift_right_trunc x y =
194
+
if is_small_int x && y >= 0 then
195
+
if y >= Sys.word_size then
196
+
of_int 0
197
+
else if unsafe_to_int x >= 0 then
198
+
of_int (unsafe_to_int x lsr y)
199
+
else
200
+
of_int (- ((- unsafe_to_int x) lsr y))
201
+
else
202
+
c_shift_right_trunc x y
203
+
204
+
external of_int32: int32 -> t = "ml_z_of_int32"
205
+
external of_int64: int64 -> t = "ml_z_of_int64"
206
+
external of_nativeint: nativeint -> t = "ml_z_of_nativeint"
207
+
external of_float: float -> t = "ml_z_of_float"
208
+
209
+
let uint32_mask = pred (shift_left (of_int 1) 32)
210
+
let of_int32_unsigned x = logand (of_int32 x) uint32_mask
211
+
212
+
let uint64_mask = pred (shift_left (of_int 1) 64)
213
+
let of_int64_unsigned x = logand (of_int64 x) uint64_mask
214
+
215
+
let uintnat_mask = pred (shift_left (of_int 1) Nativeint.size)
216
+
let of_nativeint_unsigned x = logand (of_nativeint x) uintnat_mask
217
+
218
+
external c_to_int: t -> int = "ml_z_to_int"
219
+
220
+
let to_int x =
221
+
if is_small_int x then unsafe_to_int x else c_to_int x
222
+
223
+
external to_int32: t -> int32 = "ml_z_to_int32"
224
+
external to_int64: t -> int64 = "ml_z_to_int64"
225
+
external to_nativeint: t -> nativeint = "ml_z_to_nativeint"
226
+
external to_int32_unsigned: t -> int32 = "ml_z_to_int32_unsigned"
227
+
external to_int64_unsigned: t -> int64 = "ml_z_to_int64_unsigned"
228
+
external to_nativeint_unsigned: t -> nativeint = "ml_z_to_nativeint_unsigned"
229
+
external format: string -> t -> string = "ml_z_format"
230
+
external of_substring_base: int -> string -> pos:int -> len:int -> t = "ml_z_of_substring_base"
231
+
external compare: t -> t -> int = "ml_z_compare" [@@noalloc]
232
+
external equal: t -> t -> bool = "ml_z_equal" [@@noalloc]
233
+
external sign: t -> int = "ml_z_sign" [@@noalloc]
234
+
external gcd: t -> t -> t = "ml_z_gcd"
235
+
external gcdext_intern: t -> t -> (t * t * bool) = "ml_z_gcdext_intern"
236
+
external sqrt: t -> t = "ml_z_sqrt"
237
+
external sqrt_rem: t -> (t * t) = "ml_z_sqrt_rem"
238
+
external numbits: t -> int = "ml_z_numbits" [@@noalloc]
239
+
external trailing_zeros: t -> int = "ml_z_trailing_zeros" [@@noalloc]
240
+
external popcount: t -> int = "ml_z_popcount"
241
+
external hamdist: t -> t -> int = "ml_z_hamdist"
242
+
external size: t -> int = "ml_z_size" [@@noalloc]
243
+
external fits_int: t -> bool = "ml_z_fits_int" [@@noalloc]
244
+
external fits_int32: t -> bool = "ml_z_fits_int32" [@@noalloc]
245
+
external fits_int64: t -> bool = "ml_z_fits_int64" [@@noalloc]
246
+
external fits_nativeint: t -> bool = "ml_z_fits_nativeint" [@@noalloc]
247
+
external fits_int32_unsigned: t -> bool = "ml_z_fits_int32_unsigned" [@@noalloc]
248
+
external fits_int64_unsigned: t -> bool = "ml_z_fits_int64_unsigned" [@@noalloc]
249
+
external fits_nativeint_unsigned: t -> bool = "ml_z_fits_nativeint_unsigned" [@@noalloc]
250
+
external extract: t -> int -> int -> t = "ml_z_extract"
251
+
external powm: t -> t -> t -> t = "ml_z_powm"
252
+
external pow: t -> int -> t = "ml_z_pow"
253
+
external powm_sec: t -> t -> t -> t = "ml_z_powm_sec"
254
+
external root: t -> int -> t = "ml_z_root"
255
+
external rootrem: t -> int -> t * t = "ml_z_rootrem"
256
+
external invert: t -> t -> t = "ml_z_invert"
257
+
external perfect_power: t -> bool = "ml_z_perfect_power"
258
+
external perfect_square: t -> bool = "ml_z_perfect_square"
259
+
external probab_prime: t -> int -> int = "ml_z_probab_prime"
260
+
external nextprime: t -> t = "ml_z_nextprime"
261
+
let hash: t -> int = Stdlib.Hashtbl.hash
262
+
let seeded_hash: int -> t -> int = Stdlib.Hashtbl.seeded_hash
263
+
external to_bits: t -> string = "ml_z_to_bits"
264
+
external of_bits: string -> t = "ml_z_of_bits"
265
+
266
+
external c_divisible: t -> t -> bool = "ml_z_divisible"
267
+
268
+
let divisible x y =
269
+
if is_small_int x then
270
+
if is_small_int y then
271
+
if unsafe_to_int y = 0
272
+
then unsafe_to_int x = 0
273
+
else (unsafe_to_int x) mod (unsafe_to_int y) = 0
274
+
else
275
+
(* If y divides x, we have |y| <= |x| or x = 0.
276
+
Here, x is small: min_int <= x <= max_int
277
+
and y is not small: y < min_int \/ y > max_int.
278
+
|y| <= |x| is possible only if
279
+
x = min_int and y = -min_int = max_int+1 .
280
+
So, the only two cases where y divides x are
281
+
x = 0 or x = min_int /\ y = -min_int. *)
282
+
unsafe_to_int x = 0 || (unsafe_to_int x = min_int && y = c_neg x)
283
+
else
284
+
c_divisible x y
285
+
286
+
external congruent: t -> t -> t -> bool = "ml_z_congruent"
287
+
external jacobi: t -> t -> int = "ml_z_jacobi"
288
+
external legendre: t -> t -> int = "ml_z_legendre"
289
+
external kronecker: t -> t -> int = "ml_z_kronecker"
290
+
external remove: t -> t -> t * int = "ml_z_remove"
291
+
external fac: int -> t = "ml_z_fac"
292
+
external fac2: int -> t = "ml_z_fac2"
293
+
external facM: int -> int -> t = "ml_z_facM"
294
+
external primorial: int -> t = "ml_z_primorial"
295
+
external bin: t -> int -> t = "ml_z_bin"
296
+
external fib: int -> t = "ml_z_fib"
297
+
external lucnum: int -> t = "ml_z_lucnum"
298
+
299
+
let zero = of_int 0
300
+
let one = of_int 1
301
+
let minus_one = of_int (-1)
302
+
303
+
let min a b = if compare a b <= 0 then a else b
304
+
let max a b = if compare a b >= 0 then a else b
305
+
306
+
let leq a b = compare a b <= 0
307
+
let geq a b = compare a b >= 0
308
+
let lt a b = compare a b < 0
309
+
let gt a b = compare a b > 0
310
+
311
+
let to_string = format "%d"
312
+
313
+
let of_string s = of_substring_base 0 s ~pos:0 ~len:(String.length s)
314
+
let of_substring = of_substring_base 0
315
+
let of_string_base base s = of_substring_base base s ~pos:0 ~len:(String.length s)
316
+
317
+
let ediv_rem a b =
318
+
(* we have a = q * b + r, but [Big_int]'s remainder satisfies 0 <= r < |b|,
319
+
while [Z]'s remainder satisfies -|b| < r < |b| and sign(r) = sign(a)
320
+
*)
321
+
let q,r = div_rem a b in
322
+
if sign r >= 0 then (q,r) else
323
+
if sign b >= 0 then (pred q, add r b)
324
+
else (succ q, sub r b)
325
+
326
+
let ediv a b =
327
+
if sign b >= 0 then fdiv a b else cdiv a b
328
+
329
+
let erem a b =
330
+
let r = rem a b in
331
+
if sign r >= 0 then r else add r (abs b)
332
+
333
+
let gcdext u v =
334
+
match sign u, sign v with
335
+
(* special cases: one argument is null *)
336
+
| 0, 0 -> zero, zero, zero
337
+
| 0, 1 -> v, zero, one
338
+
| 0, -1 -> neg v, zero, minus_one
339
+
| 1, 0 -> u, one, zero
340
+
| -1, 0 -> neg u, minus_one, zero
341
+
| _ ->
342
+
(* general case *)
343
+
let g,s,z = gcdext_intern u v in
344
+
if z then g, s, div (sub g (mul u s)) v
345
+
else g, div (sub g (mul v s)) u, s
346
+
347
+
let lcm u v =
348
+
if u = zero || v = zero then zero
349
+
else
350
+
let g = gcd u v in
351
+
abs (mul (divexact u g) v)
352
+
353
+
external testbit_internal: t -> int -> bool = "ml_z_testbit" [@@noalloc]
354
+
let testbit x n =
355
+
if n >= 0 then testbit_internal x n else invalid_arg "Z.testbit"
356
+
(* The test [n >= 0] is done in Caml rather than in the C stub code
357
+
so that the latter raises no exceptions and can be declared [@@noalloc]. *)
358
+
359
+
let is_odd x = testbit_internal x 0
360
+
let is_even x = not (testbit_internal x 0)
361
+
362
+
external c_extract_small: t -> int -> int -> t
363
+
= "ml_z_extract_small" [@@noalloc]
364
+
external c_extract: t -> int -> int -> t = "ml_z_extract"
365
+
366
+
let extract_internal x o l =
367
+
if is_small_int x then
368
+
(* Fast path *)
369
+
let o = if o >= Sys.int_size then Sys.int_size - 1 else o in
370
+
(* Shift away low "o" bits. If "o" too big, just replicate sign bit. *)
371
+
let z = unsafe_to_int x asr o in
372
+
if l < Sys.int_size then
373
+
(* Extract "l" low bits, if "l" is small enough *)
374
+
of_int (z land ((1 lsl l) - 1))
375
+
else if z >= 0 then
376
+
(* If x >= 0, the extraction of "l" low bits keeps x unchanged. *)
377
+
of_int z
378
+
else
379
+
(* If x < 0, fall through slow path *)
380
+
c_extract x o l
381
+
else if l < Sys.int_size then
382
+
(* Alternative fast path since no allocation is required *)
383
+
c_extract_small x o l
384
+
else
385
+
c_extract x o l
386
+
387
+
let extract x o l =
388
+
if o < 0 then invalid_arg "Z.extract: negative bit offset";
389
+
if l < 1 then invalid_arg "Z.extract: nonpositive bit length";
390
+
extract_internal x o l
391
+
392
+
let signed_extract x o l =
393
+
if o < 0 then invalid_arg "Z.signed_extract: negative bit offset";
394
+
if l < 1 then invalid_arg "Z.signed_extract: nonpositive bit length";
395
+
if testbit x (o + l - 1)
396
+
then lognot (extract (lognot x) o l)
397
+
else extract x o l
398
+
399
+
let log2 x =
400
+
if sign x > 0 then (numbits x) - 1 else invalid_arg "Z.log2"
401
+
let log2up x =
402
+
if sign x > 0 then numbits (pred x) else invalid_arg "Z.log2up"
403
+
404
+
(* Consider a real number [r] such that
405
+
- the integral part of [r] is the bigint [x]
406
+
- 2^54 <= |x| < 2^63
407
+
- the fractional part of [r] is 0 if [exact = true],
408
+
nonzero if [exact = false].
409
+
Then, the following function returns [r] correctly rounded
410
+
according to the current rounding mode of the processor.
411
+
This is an instance of the "round to odd" technique formalized in
412
+
"When double rounding is odd" by S. Boldo and G. Melquiond.
413
+
The claim above is lemma Fappli_IEEE_extra.round_odd_fix
414
+
from the CompCert Coq development. *)
415
+
416
+
let round_to_float x exact =
417
+
let m = to_int64 x in
418
+
(* Unless the fractional part is exactly 0, round m to an odd integer *)
419
+
let m = if exact then m else Int64.logor m 1L in
420
+
(* Then convert m to float, with the current rounding mode. *)
421
+
Int64.to_float m
422
+
423
+
let to_float x =
424
+
if Obj.is_int (Obj.repr x) then
425
+
(* Fast path *)
426
+
float_of_int (Obj.magic x : int)
427
+
else begin
428
+
let n = numbits x in
429
+
if n <= 63 then
430
+
Int64.to_float (to_int64 x)
431
+
else begin
432
+
let n = n - 55 in
433
+
(* Extract top 55 bits of x *)
434
+
let top = shift_right x n in
435
+
(* Check if the other bits are all zero *)
436
+
let exact = equal x (shift_left top n) in
437
+
(* Round to float and apply exponent *)
438
+
ldexp (round_to_float top exact) n
439
+
end
440
+
end
441
+
442
+
(* Formatting *)
443
+
444
+
let print x = print_string (to_string x)
445
+
let output chan x = output_string chan (to_string x)
446
+
let sprint () x = to_string x
447
+
let bprint b x = Buffer.add_string b (to_string x)
448
+
let pp_print f x = Format.pp_print_string f (to_string x)
449
+
450
+
(* Pseudo-random generation *)
451
+
452
+
let rec raw_bits_random ?(rng: Random.State.t option) nbits =
453
+
let rec raw_bits accu n =
454
+
if n >= nbits then (accu, n) else begin
455
+
let i =
456
+
match rng with
457
+
| None -> Random.bits ()
458
+
| Some r -> Random.State.bits r in
459
+
raw_bits (logxor (shift_left accu 30) (of_int i)) (n + 30)
460
+
end in
461
+
raw_bits zero 0
462
+
463
+
let raw_bits_from_bytes ~(fill: bytes -> int -> int -> unit) nbits =
464
+
let nbytes = (nbits + 7) / 8 in
465
+
let buf = Bytes.create nbytes in
466
+
fill buf 0 nbytes;
467
+
(of_bits (Bytes.to_string buf), nbytes * 8)
468
+
469
+
let random_bits_aux (f: int -> t * int) nbits =
470
+
if nbits < 0 then invalid_arg "random_bits: number of bits must be >= 0";
471
+
let (x, _) = f nbits in
472
+
extract x 0 nbits
473
+
474
+
let random_int_aux (f: int -> t * int) bound =
475
+
if sign bound <= 0 then invalid_arg "random_int: bound must be > 0";
476
+
let nbits1 = log2up bound in
477
+
let rec draw () =
478
+
(* The minimal number of random bits we need to draw is nbits1.
479
+
However, in the worst case, rejection (as described below)
480
+
will occur with probability almost 1/2. So, we draw more bits
481
+
than strictly necessary to make rejection much less likely.
482
+
With 4 extra bits, the probability of rejection is less than
483
+
1/32. *)
484
+
let (x, nbits) = f (nbits1 + 4) in
485
+
let y = rem x bound in
486
+
(* We divide the range of x, namely [0 .. 2^nbits), into
487
+
- k intervals of width bound :
488
+
[0 .. bound) [bound.. 2*bound) .. [(k-1) * bound.. k * bound)
489
+
- the remaining numbers: [k * bound .. 2^nbits)
490
+
491
+
k is chosen as large as possible: k = floor (2^nbits / bound).
492
+
493
+
If x falls within the k intervals of width bound,
494
+
y = x mod bound is evenly distributed in [0 .. bound)
495
+
and we can use it as the pseudo-random number.
496
+
If x falls within the [k * bound .. 2^nbits) interval,
497
+
y = x mod bound may not be evenly distributed;
498
+
we reject and draw again.
499
+
500
+
We can decide efficiently whether to reject, as follows.
501
+
Write 2^nbits = k * bound + r and x = q * bound + y,
502
+
with r and y in [0 .. bound).
503
+
If x - y <= 2^nbits - bound, then
504
+
q * bound = x - y <= 2^nbits - bound < 2^nbits - r = k * bound,
505
+
hence q < k and we can accept x.
506
+
Otherwise,
507
+
q * bound = x - y > 2^nbits - bound = (k - 1) * bound + r
508
+
hence q >= k and we must reject x.
509
+
*)
510
+
if leq (sub x y) (sub (shift_left one nbits) bound)
511
+
then y
512
+
else draw () in
513
+
draw ()
514
+
515
+
let random_int ?rng bound =
516
+
random_int_aux (raw_bits_random ?rng) bound
517
+
let random_bits ?rng nbits =
518
+
random_bits_aux (raw_bits_random ?rng) nbits
519
+
520
+
let random_int_gen ~fill bound =
521
+
random_int_aux (raw_bits_from_bytes ~fill) bound
522
+
let random_bits_gen ~fill nbits =
523
+
random_bits_aux (raw_bits_from_bytes ~fill) nbits
524
+
525
+
(* Infix notations *)
526
+
527
+
let (~-) = neg
528
+
let (~+) x = x
529
+
let (+) = add
530
+
let (-) = sub
531
+
let ( * ) = mul
532
+
let (/) = div
533
+
external (/>): t -> t -> t = "ml_z_cdiv"
534
+
external (/<): t -> t -> t = "ml_z_fdiv"
535
+
let (/|) = divexact
536
+
let (mod) = rem
537
+
let (land) = logand
538
+
let (lor) = logor
539
+
let (lxor) = logxor
540
+
let (~!) = lognot
541
+
let (lsl) = shift_left
542
+
let (asr) = shift_right
543
+
external (~$): int -> t = "%identity"
544
+
external ( ** ): t -> int -> t = "ml_z_pow"
545
+
546
+
module Compare = struct
547
+
let (=) = equal
548
+
let (<) = lt
549
+
let (>) = gt
550
+
let (<=) = leq
551
+
let (>=) = geq
552
+
let (<>) a b = not (equal a b)
553
+
end
554
+
555
+
let version = Zarith_version.version
+880
vendor/opam/zarith/_build/default/z.mli
+880
vendor/opam/zarith/_build/default/z.mli
···
1
+
(**
2
+
Integers.
3
+
4
+
This modules provides arbitrary-precision integers.
5
+
Small integers internally use a regular OCaml [int].
6
+
When numbers grow too large, we switch transparently to GMP numbers
7
+
([mpn] numbers fully allocated on the OCaml heap).
8
+
9
+
This interface is rather similar to that of [Int32] and [Int64],
10
+
with some additional functions provided natively by GMP
11
+
(GCD, square root, pop-count, etc.).
12
+
13
+
14
+
This file is part of the Zarith library
15
+
http://forge.ocamlcore.org/projects/zarith .
16
+
It is distributed under LGPL 2 licensing, with static linking exception.
17
+
See the LICENSE file included in the distribution.
18
+
19
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
20
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
21
+
a joint laboratory by:
22
+
CNRS (Centre national de la recherche scientifique, France),
23
+
ENS (École normale supérieure, Paris, France),
24
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
25
+
26
+
*)
27
+
28
+
29
+
(** {1 Toplevel} *)
30
+
31
+
(** For an optimal experience with the [ocaml] interactive toplevel,
32
+
the magic commands are:
33
+
34
+
{[
35
+
#load "zarith.cma";;
36
+
#install_printer Z.pp_print;;
37
+
]}
38
+
39
+
Alternatively, using the new [Zarith_top] toplevel module, simply:
40
+
{[
41
+
#require "zarith.top";;
42
+
]}
43
+
*)
44
+
45
+
46
+
47
+
(** {1 Types} *)
48
+
49
+
type t
50
+
(** Type of integers of arbitrary length. *)
51
+
52
+
exception Overflow
53
+
(** Raised by conversion functions when the value cannot be represented in
54
+
the destination type.
55
+
*)
56
+
57
+
(** {1 Construction} *)
58
+
59
+
val zero: t
60
+
(** The number 0. *)
61
+
62
+
val one: t
63
+
(** The number 1. *)
64
+
65
+
val minus_one: t
66
+
(** The number -1. *)
67
+
68
+
external of_int: int -> t = "%identity"
69
+
(** Converts from a base integer. *)
70
+
71
+
external of_int32: int32 -> t = "ml_z_of_int32"
72
+
(** Converts from a 32-bit (signed) integer. *)
73
+
74
+
external of_int64: int64 -> t = "ml_z_of_int64"
75
+
(** Converts from a 64-bit (signed) integer. *)
76
+
77
+
external of_nativeint: nativeint -> t = "ml_z_of_nativeint"
78
+
(** Converts from a native (signed) integer. *)
79
+
80
+
val of_int32_unsigned: int32 -> t
81
+
(** Converts from a 32-bit integer, interpreted as an unsigned integer.
82
+
@since 1.13
83
+
*)
84
+
85
+
val of_int64_unsigned: int64 -> t
86
+
(** Converts from a 64-bit integer, interpreted as an unsigned integer.
87
+
@since 1.13
88
+
*)
89
+
90
+
val of_nativeint_unsigned: nativeint -> t
91
+
(** Converts from a native integer, interpreted as an unsigned integer..
92
+
@since 1.13
93
+
*)
94
+
95
+
external of_float: float -> t = "ml_z_of_float"
96
+
(** Converts from a floating-point value.
97
+
The value is truncated (rounded towards zero).
98
+
Raises [Overflow] on infinity and NaN arguments.
99
+
*)
100
+
101
+
val of_string: string -> t
102
+
(** Converts a string to an integer.
103
+
An optional [-] prefix indicates a negative number, while a [+]
104
+
prefix is ignored.
105
+
An optional prefix [0x], [0o], or [0b] (following the optional [-]
106
+
or [+] prefix) indicates that the number is,
107
+
represented, in hexadecimal, octal, or binary, respectively.
108
+
Otherwise, base 10 is assumed.
109
+
(Unlike C, a lone [0] prefix does not denote octal.)
110
+
Raises an [Invalid_argument] exception if the string is not a
111
+
syntactically correct representation of an integer.
112
+
*)
113
+
114
+
val of_substring : string -> pos:int -> len:int -> t
115
+
(** [of_substring s ~pos ~len] is the same as [of_string (String.sub s
116
+
pos len)]
117
+
@since 1.4
118
+
*)
119
+
120
+
val of_string_base: int -> string -> t
121
+
(** Parses a number represented as a string in the specified base,
122
+
with optional [-] or [+] prefix.
123
+
The base must be between 2 and 16.
124
+
*)
125
+
126
+
external of_substring_base
127
+
: int -> string -> pos:int -> len:int -> t
128
+
= "ml_z_of_substring_base"
129
+
(** [of_substring_base base s ~pos ~len] is the same as [of_string_base
130
+
base (String.sub s pos len)]
131
+
@since 1.4
132
+
*)
133
+
134
+
135
+
(** {1 Basic arithmetic operations} *)
136
+
137
+
val succ: t -> t
138
+
(** Returns its argument plus one. *)
139
+
140
+
val pred: t -> t
141
+
(** Returns its argument minus one. *)
142
+
143
+
val abs: t -> t
144
+
(** Absolute value. *)
145
+
146
+
val neg: t -> t
147
+
(** Unary negation. *)
148
+
149
+
val add: t -> t -> t
150
+
(** Addition. *)
151
+
152
+
val sub: t -> t -> t
153
+
(** Subtraction. *)
154
+
155
+
val mul: t -> t -> t
156
+
(** Multiplication. *)
157
+
158
+
val div: t -> t -> t
159
+
(** Integer division. The result is truncated towards zero
160
+
and obeys the rule of signs.
161
+
Raises [Division_by_zero] if the divisor (second argument) is 0.
162
+
*)
163
+
164
+
val rem: t -> t -> t
165
+
(** Integer remainder. Can raise a [Division_by_zero].
166
+
The result of [rem a b] has the sign of [a], and its absolute value is
167
+
strictly smaller than the absolute value of [b].
168
+
The result satisfies the equality [a = b * div a b + rem a b].
169
+
*)
170
+
171
+
external div_rem: t -> t -> (t * t) = "ml_z_div_rem"
172
+
(** Computes both the integer quotient and the remainder.
173
+
[div_rem a b] is equal to [(div a b, rem a b)].
174
+
Raises [Division_by_zero] if [b = 0].
175
+
*)
176
+
177
+
external cdiv: t -> t -> t = "ml_z_cdiv"
178
+
(** Integer division with rounding towards +oo (ceiling).
179
+
Can raise a [Division_by_zero].
180
+
*)
181
+
182
+
external fdiv: t -> t -> t = "ml_z_fdiv"
183
+
(** Integer division with rounding towards -oo (floor).
184
+
Can raise a [Division_by_zero].
185
+
*)
186
+
187
+
val ediv_rem: t -> t -> (t * t)
188
+
(** Euclidean division and remainder. [ediv_rem a b] returns a pair [(q, r)]
189
+
such that [a = b * q + r] and [0 <= r < |b|].
190
+
Raises [Division_by_zero] if [b = 0].
191
+
*)
192
+
193
+
val ediv: t -> t -> t
194
+
(** Euclidean division. [ediv a b] is equal to [fst (ediv_rem a b)].
195
+
The result satisfies [0 <= a - b * ediv a b < |b|].
196
+
Raises [Division_by_zero] if [b = 0].
197
+
*)
198
+
199
+
val erem: t -> t -> t
200
+
(** Euclidean remainder. [erem a b] is equal to [snd (ediv_rem a b)].
201
+
The result satisfies [0 <= erem a b < |b|] and
202
+
[a = b * ediv a b + erem a b]. Raises [Division_by_zero] if [b = 0].
203
+
*)
204
+
205
+
val divexact: t -> t -> t
206
+
(** [divexact a b] divides [a] by [b], only producing correct result when the
207
+
division is exact, i.e., when [b] evenly divides [a].
208
+
It should be faster than general division.
209
+
Can raise a [Division_by_zero].
210
+
*)
211
+
212
+
val divisible: t -> t -> bool
213
+
(** [divisible a b] returns [true] if [a] is exactly divisible by [b].
214
+
Unlike the other division functions, [b = 0] is accepted
215
+
(only 0 is considered divisible by 0).
216
+
@since 1.10
217
+
*)
218
+
219
+
external congruent: t -> t -> t -> bool = "ml_z_congruent"
220
+
(** [congruent a b c] returns [true] if [a] is congruent to [b] modulo [c].
221
+
Unlike the other division functions, [c = 0] is accepted
222
+
(only equal numbers are considered equal congruent 0).
223
+
@since 1.10
224
+
*)
225
+
226
+
227
+
228
+
229
+
(** {1 Bit-level operations} *)
230
+
231
+
(** For all bit-level operations, negative numbers are considered in 2's
232
+
complement representation, starting with a virtual infinite number of
233
+
1s.
234
+
*)
235
+
236
+
val logand: t -> t -> t
237
+
(** Bitwise logical and. *)
238
+
239
+
val logor: t -> t -> t
240
+
(** Bitwise logical or. *)
241
+
242
+
val logxor: t -> t -> t
243
+
(** Bitwise logical exclusive or. *)
244
+
245
+
val lognot: t -> t
246
+
(** Bitwise logical negation.
247
+
The identity [lognot a]=[-a-1] always hold.
248
+
*)
249
+
250
+
val shift_left: t -> int -> t
251
+
(** Shifts to the left.
252
+
Equivalent to a multiplication by a power of 2.
253
+
The second argument must be nonnegative.
254
+
*)
255
+
256
+
val shift_right: t -> int -> t
257
+
(** Shifts to the right.
258
+
This is an arithmetic shift,
259
+
equivalent to a division by a power of 2 with rounding towards -oo.
260
+
The second argument must be nonnegative.
261
+
*)
262
+
263
+
val shift_right_trunc: t -> int -> t
264
+
(** Shifts to the right, rounding towards 0.
265
+
This is equivalent to a division by a power of 2, with truncation.
266
+
The second argument must be nonnegative.
267
+
*)
268
+
269
+
external numbits: t -> int = "ml_z_numbits" [@@noalloc]
270
+
(** Returns the number of significant bits in the given number.
271
+
If [x] is zero, [numbits x] returns 0. Otherwise,
272
+
[numbits x] returns a positive integer [n] such that
273
+
[2^{n-1} <= |x| < 2^n]. Note that [numbits] is defined
274
+
for negative arguments, and that [numbits (-x) = numbits x].
275
+
@since 1.4
276
+
*)
277
+
278
+
external trailing_zeros: t -> int = "ml_z_trailing_zeros" [@@noalloc]
279
+
(** Returns the number of trailing 0 bits in the given number.
280
+
If [x] is zero, [trailing_zeros x] returns [max_int].
281
+
Otherwise, [trailing_zeros x] returns a nonnegative integer [n]
282
+
which is the largest [n] such that [2^n] divides [x] evenly.
283
+
Note that [trailing_zeros] is defined for negative arguments,
284
+
and that [trailing_zeros (-x) = trailing_zeros x].
285
+
@since 1.4
286
+
*)
287
+
288
+
val testbit: t -> int -> bool
289
+
(** [testbit x n] return the value of bit number [n] in [x]:
290
+
[true] if the bit is 1, [false] if the bit is 0.
291
+
Bits are numbered from 0. Raise [Invalid_argument] if [n]
292
+
is negative.
293
+
@since 1.4
294
+
*)
295
+
296
+
external popcount: t -> int = "ml_z_popcount"
297
+
(** Counts the number of bits set.
298
+
Raises [Overflow] for negative arguments, as those have an infinite
299
+
number of bits set.
300
+
*)
301
+
302
+
external hamdist: t -> t -> int = "ml_z_hamdist"
303
+
(** Counts the number of different bits.
304
+
Raises [Overflow] if the arguments have different signs
305
+
(in which case the distance is infinite).
306
+
*)
307
+
308
+
(** {1 Conversions} *)
309
+
310
+
(** Note that, when converting to an integer type that cannot represent the
311
+
converted value, an [Overflow] exception is raised.
312
+
*)
313
+
314
+
val to_int: t -> int
315
+
(** Converts to a signed OCaml [int].
316
+
Raises an [Overflow] if the value does not fit in a signed OCaml [int]. *)
317
+
318
+
external to_int32: t -> int32 = "ml_z_to_int32"
319
+
(** Converts to a signed 32-bit integer [int32].
320
+
Raises an [Overflow] if the value does not fit in a signed [int32]. *)
321
+
322
+
external to_int64: t -> int64 = "ml_z_to_int64"
323
+
(** Converts to a signed 64-bit integer [int64].
324
+
Raises an [Overflow] if the value does not fit in a signed [int64]. *)
325
+
326
+
external to_nativeint: t -> nativeint = "ml_z_to_nativeint"
327
+
(** Converts to a native signed integer [nativeint].
328
+
Raises an [Overflow] if the value does not fit in a signed [nativeint]. *)
329
+
330
+
external to_int32_unsigned: t -> int32 = "ml_z_to_int32_unsigned"
331
+
(** Converts to an unsigned 32-bit integer.
332
+
The result is stored into an OCaml [int32].
333
+
Beware that most [Int32] operations consider [int32] to a signed type, not unsigned.
334
+
Raises an [Overflow] if the value is negative or does not fit in an unsigned 32-bit integer.
335
+
@since 1.13
336
+
*)
337
+
338
+
external to_int64_unsigned: t -> int64 = "ml_z_to_int64_unsigned"
339
+
(** Converts to an unsigned 64-bit integer.
340
+
The result is stored into an OCaml [int64].
341
+
Beware that most [Int64] operations consider [int64] to a signed type, not unsigned.
342
+
Raises an [Overflow] if the value is negative or does not fit in an unsigned 64-bit integer.
343
+
@since 1.13
344
+
*)
345
+
346
+
external to_nativeint_unsigned: t -> nativeint = "ml_z_to_nativeint_unsigned"
347
+
(** Converts to a native unsigned integer.
348
+
The result is stored into an OCaml [nativeint].
349
+
Beware that most [Nativeint] operations consider [nativeint] to a signed type, not unsigned.
350
+
Raises an [Overflow] if the value is negative or does not fit in an unsigned native integer.
351
+
@since 1.13
352
+
*)
353
+
354
+
val to_float: t -> float
355
+
(** Converts to a floating-point value.
356
+
This function rounds the given integer according to the current
357
+
rounding mode of the processor. In default mode, it returns
358
+
the floating-point number nearest to the given integer,
359
+
breaking ties by rounding to even. *)
360
+
361
+
val to_string: t -> string
362
+
(** Gives a human-readable, decimal string representation of the argument. *)
363
+
364
+
external format: string -> t -> string = "ml_z_format"
365
+
(** Gives a string representation of the argument in the specified
366
+
printf-like format.
367
+
The general specification has the following form:
368
+
369
+
[% \[flags\] \[width\] type]
370
+
371
+
Where the type actually indicates the base:
372
+
373
+
- [i], [d], [u]: decimal
374
+
- [b]: binary
375
+
- [o]: octal
376
+
- [x]: lowercase hexadecimal
377
+
- [X]: uppercase hexadecimal
378
+
379
+
Supported flags are:
380
+
381
+
- [+]: prefix positive numbers with a [+] sign
382
+
- space: prefix positive numbers with a space
383
+
- [-]: left-justify (default is right justification)
384
+
- [0]: pad with zeroes (instead of spaces)
385
+
- [#]: alternate formatting (actually, simply output a literal-like prefix: [0x], [0b], [0o])
386
+
387
+
Unlike the classic [printf], all numbers are signed (even hexadecimal ones),
388
+
there is no precision field, and characters that are not part of the format
389
+
are simply ignored (and not copied in the output).
390
+
*)
391
+
392
+
external fits_int: t -> bool = "ml_z_fits_int" [@@noalloc]
393
+
(** Whether the argument fits in an OCaml signed [int]. *)
394
+
395
+
external fits_int32: t -> bool = "ml_z_fits_int32" [@@noalloc]
396
+
(** Whether the argument fits in a signed [int32]. *)
397
+
398
+
external fits_int64: t -> bool = "ml_z_fits_int64" [@@noalloc]
399
+
(** Whether the argument fits in a signed [int64]. *)
400
+
401
+
external fits_nativeint: t -> bool = "ml_z_fits_nativeint" [@@noalloc]
402
+
(** Whether the argument fits in a signed [nativeint]. *)
403
+
404
+
external fits_int32_unsigned: t -> bool = "ml_z_fits_int32_unsigned" [@@noalloc]
405
+
(** Whether the argument is non-negative and fits in an unsigned [int32].
406
+
@since 1.13
407
+
*)
408
+
409
+
external fits_int64_unsigned: t -> bool = "ml_z_fits_int64_unsigned" [@@noalloc]
410
+
(** Whether the argument is non-negative and fits in an unsigned [int64].
411
+
@since 1.13
412
+
*)
413
+
414
+
external fits_nativeint_unsigned: t -> bool = "ml_z_fits_nativeint_unsigned" [@@noalloc]
415
+
(** Whether the argument is non-negative fits in an unsigned [nativeint].
416
+
@since 1.13
417
+
*)
418
+
419
+
420
+
(** {1 Printing} *)
421
+
422
+
val print: t -> unit
423
+
(** Prints the argument on the standard output. *)
424
+
425
+
val output: out_channel -> t -> unit
426
+
(** Prints the argument on the specified channel.
427
+
Also intended to be used as [%a] format printer in [Printf.printf].
428
+
*)
429
+
430
+
val sprint: unit -> t -> string
431
+
(** To be used as [%a] format printer in [Printf.sprintf]. *)
432
+
433
+
val bprint: Buffer.t -> t -> unit
434
+
(** To be used as [%a] format printer in [Printf.bprintf]. *)
435
+
436
+
val pp_print: Format.formatter -> t -> unit
437
+
(** Prints the argument on the specified formatter.
438
+
Can be used as [%a] format printer in [Format.printf] and as
439
+
argument to [#install_printer] in the top-level.
440
+
*)
441
+
442
+
443
+
(** {1 Ordering} *)
444
+
445
+
external compare: t -> t -> int = "ml_z_compare" [@@noalloc]
446
+
(** Comparison. [compare x y] returns 0 if [x] equals [y],
447
+
-1 if [x] is smaller than [y], and 1 if [x] is greater than [y].
448
+
449
+
Note that Pervasive.compare can be used to compare reliably two integers
450
+
only on OCaml 3.12.1 and later versions.
451
+
*)
452
+
453
+
external equal: t -> t -> bool = "ml_z_equal" [@@noalloc]
454
+
(** Equality test. *)
455
+
456
+
val leq: t -> t -> bool
457
+
(** Less than or equal. *)
458
+
459
+
val geq: t -> t -> bool
460
+
(** Greater than or equal. *)
461
+
462
+
val lt: t -> t -> bool
463
+
(** Less than (and not equal). *)
464
+
465
+
val gt: t -> t -> bool
466
+
(** Greater than (and not equal). *)
467
+
468
+
external sign: t -> int = "ml_z_sign" [@@noalloc]
469
+
(** Returns -1, 0, or 1 when the argument is respectively negative, null, or
470
+
positive.
471
+
*)
472
+
473
+
val min: t -> t -> t
474
+
(** Returns the minimum of its arguments. *)
475
+
476
+
val max: t -> t -> t
477
+
(** Returns the maximum of its arguments. *)
478
+
479
+
val is_even: t -> bool
480
+
(** Returns true if the argument is even (divisible by 2), false if odd.
481
+
@since 1.4
482
+
*)
483
+
484
+
val is_odd: t -> bool
485
+
(** Returns true if the argument is odd, false if even.
486
+
@since 1.4
487
+
*)
488
+
489
+
val hash: t -> int
490
+
(** Hashes a number, producing a small integer.
491
+
The result is consistent with equality:
492
+
if [a] = [b], then [hash a] = [hash b].
493
+
The result is the same as produced by OCaml's generic hash function,
494
+
{!Hashtbl.hash}.
495
+
Together with type {!Z.t}, the function {!Z.hash} makes it possible
496
+
to pass module {!Z} as argument to the functor {!Hashtbl.Make}.
497
+
@before 1.14 a different hash algorithm was used.
498
+
*)
499
+
500
+
val seeded_hash: int -> t -> int
501
+
(** Like {!Z.hash}, but takes a seed as extra argument for diversification.
502
+
The result is the same as produced by OCaml's generic seeded hash function,
503
+
{!Hashtbl.seeded_hash}.
504
+
Together with type {!Z.t}, the function {!Z.hash} makes it possible
505
+
to pass module {!Z} as argument to the functor {!Hashtbl.MakeSeeded}.
506
+
@since 1.14
507
+
*)
508
+
509
+
(** {1 Elementary number theory} *)
510
+
511
+
external gcd: t -> t -> t = "ml_z_gcd"
512
+
(** Greatest common divisor.
513
+
The result is always nonnegative.
514
+
We have [gcd(a,0) = gcd(0,a) = abs(a)], including [gcd(0,0) = 0].
515
+
*)
516
+
517
+
val gcdext: t -> t -> (t * t * t)
518
+
(** [gcdext u v] returns [(g,s,t)] where [g] is the greatest common divisor
519
+
and [g=us+vt].
520
+
[g] is always nonnegative.
521
+
522
+
Note: the function is based on the GMP [mpn_gcdext] function. The exact choice of [s] and [t] such that [g=us+vt] is not specified, as it may vary from a version of GMP to another (it has changed notably in GMP 4.3.0 and 4.3.1).
523
+
*)
524
+
525
+
val lcm: t -> t -> t
526
+
(**
527
+
Least common multiple.
528
+
The result is always nonnegative.
529
+
We have [lcm(a,0) = lcm(0,a) = 0].
530
+
*)
531
+
532
+
external powm: t -> t -> t -> t = "ml_z_powm"
533
+
(** [powm base exp mod] computes [base]^[exp] modulo [mod].
534
+
Negative [exp] are supported, in which case ([base]^-1)^(-[exp]) modulo
535
+
[mod] is computed.
536
+
However, if [exp] is negative but [base] has no inverse modulo [mod], then
537
+
a [Division_by_zero] is raised.
538
+
*)
539
+
540
+
external powm_sec: t -> t -> t -> t = "ml_z_powm_sec"
541
+
(** [powm_sec base exp mod] computes [base]^[exp] modulo [mod].
542
+
Unlike [Z.powm], this function is designed to take the same time
543
+
and have the same cache access patterns for any two same-size
544
+
arguments. Used in cryptographic applications, it provides better
545
+
resistance to side-channel attacks than [Z.powm].
546
+
The exponent [exp] must be positive, and the modulus [mod]
547
+
must be odd. Otherwise, [Invalid_arg] is raised.
548
+
@since 1.4
549
+
*)
550
+
551
+
external invert: t -> t -> t = "ml_z_invert"
552
+
(** [invert base mod] returns the inverse of [base] modulo [mod].
553
+
Raises a [Division_by_zero] if [base] is not invertible modulo [mod].
554
+
*)
555
+
556
+
external probab_prime: t -> int -> int = "ml_z_probab_prime"
557
+
(** [probab_prime x r] returns 0 if [x] is definitely composite,
558
+
1 if [x] is probably prime, and 2 if [x] is definitely prime.
559
+
The [r] argument controls how many Miller-Rabin probabilistic
560
+
primality tests are performed (5 to 10 is a reasonable value).
561
+
*)
562
+
563
+
external nextprime: t -> t = "ml_z_nextprime"
564
+
(** Returns the next prime greater than the argument.
565
+
The result is only prime with very high probability.
566
+
*)
567
+
568
+
external jacobi: t -> t -> int = "ml_z_jacobi"
569
+
(** [jacobi a b] returns the Jacobi symbol [(a/b)].
570
+
@since 1.10 *)
571
+
572
+
external legendre: t -> t -> int = "ml_z_legendre"
573
+
(** [legendre a b] returns the Legendre symbol [(a/b)].
574
+
@since 1.10 *)
575
+
576
+
external kronecker: t -> t -> int = "ml_z_kronecker"
577
+
(** [kronecker a b] returns the Kronecker symbol [(a/b)].
578
+
@since 1.10 *)
579
+
580
+
external remove: t -> t -> t * int = "ml_z_remove"
581
+
(** [remove a b] returns [a] after removing all the occurences of the
582
+
factor [b].
583
+
Also returns how many occurrences were removed.
584
+
@since 1.10 *)
585
+
586
+
external fac: int -> t = "ml_z_fac"
587
+
(** [fac n] returns the factorial of [n] ([n!]).
588
+
Raises an [Invaid_argument] if [n] is non-positive.
589
+
@since 1.10 *)
590
+
591
+
external fac2: int -> t = "ml_z_fac2"
592
+
(** [fac2 n] returns the double factorial of [n] ([n!!]).
593
+
Raises an [Invaid_argument] if [n] is non-positive.
594
+
@since 1.10 *)
595
+
596
+
external facM: int -> int -> t = "ml_z_facM"
597
+
(** [facM n m] returns the [m]-th factorial of [n].
598
+
Raises an [Invaid_argument] if [n] or [m] is non-positive.
599
+
@since 1.10 *)
600
+
601
+
external primorial: int -> t = "ml_z_primorial"
602
+
(** [primorial n] returns the product of all positive prime numbers less
603
+
than or equal to [n].
604
+
Raises an [Invaid_argument] if [n] is non-positive.
605
+
@since 1.10 *)
606
+
607
+
external bin: t -> int -> t = "ml_z_bin"
608
+
(** [bin n k] returns the binomial coefficient [n] over [k].
609
+
Raises an [Invaid_argument] if [k] is non-positive.
610
+
@since 1.10 *)
611
+
612
+
external fib: int -> t = "ml_z_fib"
613
+
(** [fib n] returns the [n]-th Fibonacci number.
614
+
Raises an [Invaid_argument] if [n] is non-positive.
615
+
@since 1.10 *)
616
+
617
+
external lucnum: int -> t = "ml_z_lucnum"
618
+
(** [lucnum n] returns the [n]-th Lucas number.
619
+
Raises an [Invaid_argument] if [n] is non-positive.
620
+
@since 1.10 *)
621
+
622
+
623
+
(** {1 Powers} *)
624
+
625
+
external pow: t -> int -> t = "ml_z_pow"
626
+
(** [pow base exp] raises [base] to the [exp] power.
627
+
[exp] must be nonnegative.
628
+
Note that only exponents fitting in a machine integer are supported, as
629
+
larger exponents would surely make the result's size overflow the
630
+
address space.
631
+
*)
632
+
633
+
external sqrt: t -> t = "ml_z_sqrt"
634
+
(** Returns the square root. The result is truncated (rounded down
635
+
to an integer).
636
+
Raises an [Invalid_argument] on negative arguments.
637
+
*)
638
+
639
+
external sqrt_rem: t -> (t * t) = "ml_z_sqrt_rem"
640
+
(** Returns the square root truncated, and the remainder.
641
+
Raises an [Invalid_argument] on negative arguments.
642
+
*)
643
+
644
+
external root: t -> int -> t = "ml_z_root"
645
+
(** [root x n] computes the [n]-th root of [x].
646
+
[n] must be positive and, if [n] is even, then [x] must be nonnegative.
647
+
Otherwise, an [Invalid_argument] is raised.
648
+
*)
649
+
650
+
external rootrem: t -> int -> t * t = "ml_z_rootrem"
651
+
(** [rootrem x n] computes the [n]-th root of [x] and the remainder
652
+
[x-root**n].
653
+
[n] must be positive and, if [n] is even, then [x] must be nonnegative.
654
+
Otherwise, an [Invalid_argument] is raised.
655
+
@since 1.10 *)
656
+
657
+
external perfect_power: t -> bool = "ml_z_perfect_power"
658
+
(** True if the argument has the form [a^b], with [b>1] *)
659
+
660
+
external perfect_square: t -> bool = "ml_z_perfect_square"
661
+
(** True if the argument has the form [a^2]. *)
662
+
663
+
val log2: t -> int
664
+
(** Returns the base-2 logarithm of its argument, rounded down to
665
+
an integer. If [x] is positive, [log2 x] returns the largest [n]
666
+
such that [2^n <= x]. If [x] is negative or zero, [log2 x] raise
667
+
the [Invalid_argument] exception.
668
+
@since 1.4
669
+
*)
670
+
671
+
val log2up: t -> int
672
+
(** Returns the base-2 logarithm of its argument, rounded up to
673
+
an integer. If [x] is positive, [log2up x] returns the smallest [n]
674
+
such that [x <= 2^n]. If [x] is negative or zero, [log2up x] raise
675
+
the [Invalid_argument] exception.
676
+
@since 1.4
677
+
*)
678
+
679
+
(** {1 Representation} *)
680
+
681
+
external size: t -> int = "ml_z_size" [@@noalloc]
682
+
(** Returns the number of machine words used to represent the number. *)
683
+
684
+
val extract: t -> int -> int -> t
685
+
(** [extract a off len] returns a nonnegative number corresponding to bits
686
+
[off] to [off]+[len]-1 of [a].
687
+
Negative [a] are considered in infinite-length 2's complement
688
+
representation.
689
+
Raises an [Invalid_argument] if [off] is strictly negative, or if [len] is negative or null.
690
+
*)
691
+
692
+
val signed_extract: t -> int -> int -> t
693
+
(** [signed_extract a off len] extracts bits [off] to [off]+[len]-1 of [b],
694
+
as [extract] does, then sign-extends bit [len-1] of the result
695
+
(that is, bit [off + len - 1] of [a]). The result is between
696
+
[- 2{^[len]-1}] (included) and [2{^[len]-1}] (excluded),
697
+
and equal to [extract a off len] modulo [2{^len}].
698
+
Raises an [Invalid_argument] if [off] is strictly negative, or if [len] is negative or null.
699
+
*)
700
+
701
+
external to_bits: t -> string = "ml_z_to_bits"
702
+
(** Returns a binary representation of the argument.
703
+
The string result should be interpreted as a sequence of bytes,
704
+
corresponding to the binary representation of the absolute value of
705
+
the argument in little endian ordering.
706
+
The sign is not stored in the string.
707
+
*)
708
+
709
+
external of_bits: string -> t = "ml_z_of_bits"
710
+
(** Constructs a number from a binary string representation.
711
+
The string is interpreted as a sequence of bytes in little endian order,
712
+
and the result is always positive.
713
+
We have the identity: [of_bits (to_bits x) = abs x].
714
+
However, we can have [to_bits (of_bits s) <> s] due to the presence of
715
+
trailing zeros in s.
716
+
*)
717
+
718
+
(** {1 Pseudo-random number generation} *)
719
+
720
+
val random_int: ?rng: Random.State.t -> t -> t
721
+
(** [random_int bound] returns a random integer between 0 (inclusive)
722
+
and [bound] (exclusive). [bound] must be greater than 0.
723
+
724
+
The source of randomness is the {!Random} module from the OCaml
725
+
standard library. The optional [rng] argument specifies which
726
+
random state to use. If omitted, the default random state for the
727
+
{!Random} module is used.
728
+
729
+
Random numbers produced by this function are not cryptographically
730
+
strong and must not be used in cryptographic or high-security
731
+
contexts. See {!Z.random_int_gen} for an alternative.
732
+
733
+
@since 1.13
734
+
*)
735
+
736
+
val random_bits: ?rng: Random.State.t -> int -> t
737
+
(** [random_bits nbits] returns a random integer between 0 (inclusive)
738
+
and [2{^nbits}] (exclusive). [nbits] must be nonnegative.
739
+
This is a more efficient special case of {!Z.random_int} when the
740
+
bound is a power of two.
741
+
742
+
The source of randomness and the [rng] optional argument are as
743
+
described in {!Z.random_int}.
744
+
745
+
Random numbers produced by this function are not cryptographically
746
+
strong and must not be used in cryptographic or high-security
747
+
contexts. See {!Z.random_bits_gen} for an alternative.
748
+
749
+
@since 1.13
750
+
*)
751
+
752
+
val random_int_gen: fill: (bytes -> int -> int -> unit) -> t -> t
753
+
(** [random_int_gen ~fill bound] returns a random integer between 0 (inclusive)
754
+
and [bound] (exclusive). [bound] must be greater than 0.
755
+
756
+
The [fill] parameter is the source of randomness. It is called
757
+
as [fill buf pos len], and is responsible for drawing [len] random
758
+
bytes and writing them to offsets [pos] to [pos + len - 1] of
759
+
the byte array [buf].
760
+
761
+
Example of use where [/dev/random] provides the random bytes:
762
+
<<
763
+
In_channel.with_open_bin "/dev/random"
764
+
(fun ic -> Z.random_int_gen ~fill:(really_input ic) bound)
765
+
>>
766
+
Example of use where the Cryptokit library provides the random bytes:
767
+
<<
768
+
Z.random_int_gen ~fill:Cryptokit.Random.secure_rng#bytes bound
769
+
>>
770
+
@since 1.13
771
+
*)
772
+
773
+
val random_bits_gen: fill: (bytes -> int -> int -> unit) -> int -> t
774
+
(** [random_bits_gen ~fill nbits] returns a random integer between 0 (inclusive)
775
+
and [2{^nbits}] (exclusive). [nbits] must be nonnegative.
776
+
This is a more efficient special case of {!Z.random_int_gen} when the
777
+
bound is a power of two. The [fill] parameter is as described in
778
+
{!Z.random_int_gen}.
779
+
@since 1.13
780
+
*)
781
+
782
+
(** {1 Prefix and infix operators} *)
783
+
784
+
(**
785
+
Classic (and less classic) prefix and infix [int] operators are
786
+
redefined on [t].
787
+
788
+
This makes it easy to typeset expressions.
789
+
Using OCaml 3.12's local open, you can simply write
790
+
[Z.(~$2 + ~$5 * ~$10)].
791
+
*)
792
+
793
+
val (~-): t -> t
794
+
(** Negation [neg]. *)
795
+
796
+
val (~+): t -> t
797
+
(** Identity. *)
798
+
799
+
val (+): t -> t -> t
800
+
(** Addition [add]. *)
801
+
802
+
val (-): t -> t -> t
803
+
(** Subtraction [sub]. *)
804
+
805
+
val ( * ): t -> t -> t
806
+
(** Multiplication [mul]. *)
807
+
808
+
val (/): t -> t -> t
809
+
(** Truncated division [div]. *)
810
+
811
+
external (/>): t -> t -> t = "ml_z_cdiv"
812
+
(** Ceiling division [cdiv]. *)
813
+
814
+
external (/<): t -> t -> t = "ml_z_fdiv"
815
+
(** Flooring division [fdiv]. *)
816
+
817
+
val (/|): t -> t -> t
818
+
(** Exact division [divexact]. *)
819
+
820
+
val (mod): t -> t -> t
821
+
(** Remainder [rem]. *)
822
+
823
+
val (land): t -> t -> t
824
+
(** Bit-wise logical and [logand]. *)
825
+
826
+
val (lor): t -> t -> t
827
+
(** Bit-wise logical inclusive or [logor]. *)
828
+
829
+
val (lxor): t -> t -> t
830
+
(** Bit-wise logical exclusive or [logxor]. *)
831
+
832
+
val (~!): t -> t
833
+
(** Bit-wise logical negation [lognot]. *)
834
+
835
+
val (lsl): t -> int -> t
836
+
(** Bit-wise shift to the left [shift_left]. *)
837
+
838
+
val (asr): t -> int -> t
839
+
(** Bit-wise shift to the right [shift_right]. *)
840
+
841
+
external (~$): int -> t = "%identity"
842
+
843
+
(** Conversion from [int] [of_int]. *)
844
+
845
+
external ( ** ): t -> int -> t = "ml_z_pow"
846
+
(** Power [pow]. *)
847
+
848
+
module Compare : sig
849
+
850
+
val (=): t -> t -> bool
851
+
(** Same as [equal]. *)
852
+
853
+
val (<): t -> t -> bool
854
+
(** Same as [lt]. *)
855
+
856
+
val (>): t -> t -> bool
857
+
(** Same as [gt]. *)
858
+
859
+
val (<=): t -> t -> bool
860
+
(** Same as [leq]. *)
861
+
862
+
val (>=): t -> t -> bool
863
+
(** Same as [geq]. *)
864
+
865
+
val (<>): t -> t -> bool
866
+
(** [a <> b] is equivalent to [not (equal a b)]. *)
867
+
868
+
end
869
+
870
+
(** {1 Miscellaneous} *)
871
+
872
+
val version: string
873
+
(** Library version.
874
+
@since 1.1
875
+
*)
876
+
877
+
(**/**)
878
+
879
+
(** For internal use in module [Q]. *)
880
+
val round_to_float: t -> bool -> float
+104
vendor/opam/zarith/_build/default/zarith.dune-package
+104
vendor/opam/zarith/_build/default/zarith.dune-package
···
1
+
(lang dune 3.20)
2
+
(name zarith)
3
+
(version 1.14)
4
+
(sections (lib .) (libexec .) (doc ../../doc/zarith) (stublibs ../stublibs))
5
+
(files
6
+
(lib
7
+
(META
8
+
big_int_Z.ml
9
+
big_int_Z.mli
10
+
dune-package
11
+
libzarith_stubs.a
12
+
opam
13
+
q.ml
14
+
q.mli
15
+
top/zarith_top.a
16
+
top/zarith_top.cma
17
+
top/zarith_top.cmi
18
+
top/zarith_top.cmt
19
+
top/zarith_top.cmx
20
+
top/zarith_top.cmxa
21
+
top/zarith_top.ml
22
+
z.ml
23
+
z.mli
24
+
zarith.a
25
+
zarith.cma
26
+
zarith.cmi
27
+
zarith.cmt
28
+
zarith.cmx
29
+
zarith.cmxa
30
+
zarith.ml
31
+
zarith__Big_int_Z.cmi
32
+
zarith__Big_int_Z.cmt
33
+
zarith__Big_int_Z.cmti
34
+
zarith__Big_int_Z.cmx
35
+
zarith__Q.cmi
36
+
zarith__Q.cmt
37
+
zarith__Q.cmti
38
+
zarith__Q.cmx
39
+
zarith__Z.cmi
40
+
zarith__Z.cmt
41
+
zarith__Z.cmti
42
+
zarith__Z.cmx
43
+
zarith__Zarith_version.cmi
44
+
zarith__Zarith_version.cmt
45
+
zarith__Zarith_version.cmx
46
+
zarith_version.ml))
47
+
(libexec (top/zarith_top.cmxs zarith.cmxs))
48
+
(doc (LICENSE README.md))
49
+
(stublibs (dllzarith_stubs.so)))
50
+
(library
51
+
(name zarith)
52
+
(kind normal)
53
+
(archives (byte zarith.cma) (native zarith.cmxa))
54
+
(plugins (byte zarith.cma) (native zarith.cmxs))
55
+
(foreign_objects caml_z.o)
56
+
(foreign_archives (archives (for all) (files libzarith_stubs.a)))
57
+
(foreign_dll_files ../stublibs/dllzarith_stubs.so)
58
+
(native_archives zarith.a)
59
+
(main_module_name Zarith)
60
+
(modes byte native)
61
+
(modules
62
+
(wrapped
63
+
(group
64
+
(alias
65
+
(obj_name zarith)
66
+
(visibility public)
67
+
(kind alias)
68
+
(source (path Zarith) (impl (path zarith.ml-gen))))
69
+
(name Zarith)
70
+
(modules
71
+
(module
72
+
(obj_name zarith__Big_int_Z)
73
+
(visibility public)
74
+
(source
75
+
(path Big_int_Z)
76
+
(intf (path big_int_Z.mli))
77
+
(impl (path big_int_Z.ml))))
78
+
(module
79
+
(obj_name zarith__Q)
80
+
(visibility public)
81
+
(source (path Q) (intf (path q.mli)) (impl (path q.ml))))
82
+
(module
83
+
(obj_name zarith__Z)
84
+
(visibility public)
85
+
(source (path Z) (intf (path z.mli)) (impl (path z.ml))))
86
+
(module
87
+
(obj_name zarith__Zarith_version)
88
+
(visibility public)
89
+
(source (path Zarith_version) (impl (path zarith_version.ml))))))
90
+
(wrapped true))))
91
+
(library
92
+
(name zarith.top)
93
+
(kind normal)
94
+
(archives (byte top/zarith_top.cma) (native top/zarith_top.cmxa))
95
+
(plugins (byte top/zarith_top.cma) (native top/zarith_top.cmxs))
96
+
(native_archives top/zarith_top.a)
97
+
(requires zarith compiler-libs.toplevel)
98
+
(main_module_name Zarith_top)
99
+
(modes byte native)
100
+
(modules
101
+
(singleton
102
+
(obj_name zarith_top)
103
+
(visibility public)
104
+
(source (path Zarith_top) (impl (path top/zarith_top.ml))))))
+42
vendor/opam/zarith/_build/default/zarith.h
+42
vendor/opam/zarith/_build/default/zarith.h
···
1
+
/**
2
+
Public C interface for Zarith.
3
+
4
+
This is intended for C libraries that wish to convert between mpz_t and
5
+
Z.t objects.
6
+
7
+
8
+
This file is part of the Zarith library
9
+
http://forge.ocamlcore.org/projects/zarith .
10
+
It is distributed under LGPL 2 licensing, with static linking exception.
11
+
See the LICENSE file included in the distribution.
12
+
13
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
14
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
15
+
a joint laboratory by:
16
+
CNRS (Centre national de la recherche scientifique, France),
17
+
ENS (École normale supérieure, Paris, France),
18
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
19
+
20
+
*/
21
+
22
+
23
+
/* gmp.h or mpir.h must be included manually before zarith.h */
24
+
25
+
#ifdef __cplusplus
26
+
extern "C" {
27
+
#endif
28
+
29
+
#include <caml/mlvalues.h>
30
+
31
+
/* sets rop to the value in op (limbs are copied) */
32
+
void ml_z_mpz_set_z(mpz_t rop, value op);
33
+
34
+
/* inits and sets rop to the value in op (limbs are copied) */
35
+
void ml_z_mpz_init_set_z(mpz_t rop, value op);
36
+
37
+
/* returns a new z objects equal to op (limbs are copied) */
38
+
value ml_z_from_mpz(mpz_t op);
39
+
40
+
#ifdef __cplusplus
41
+
}
42
+
#endif
+53
vendor/opam/zarith/_build/default/zarith.install
+53
vendor/opam/zarith/_build/default/zarith.install
···
1
+
lib: [
2
+
"_build/install/default/lib/zarith/META"
3
+
"_build/install/default/lib/zarith/big_int_Z.ml"
4
+
"_build/install/default/lib/zarith/big_int_Z.mli"
5
+
"_build/install/default/lib/zarith/dune-package"
6
+
"_build/install/default/lib/zarith/libzarith_stubs.a"
7
+
"_build/install/default/lib/zarith/opam"
8
+
"_build/install/default/lib/zarith/q.ml"
9
+
"_build/install/default/lib/zarith/q.mli"
10
+
"_build/install/default/lib/zarith/top/zarith_top.a" {"top/zarith_top.a"}
11
+
"_build/install/default/lib/zarith/top/zarith_top.cma" {"top/zarith_top.cma"}
12
+
"_build/install/default/lib/zarith/top/zarith_top.cmi" {"top/zarith_top.cmi"}
13
+
"_build/install/default/lib/zarith/top/zarith_top.cmt" {"top/zarith_top.cmt"}
14
+
"_build/install/default/lib/zarith/top/zarith_top.cmx" {"top/zarith_top.cmx"}
15
+
"_build/install/default/lib/zarith/top/zarith_top.cmxa" {"top/zarith_top.cmxa"}
16
+
"_build/install/default/lib/zarith/top/zarith_top.ml" {"top/zarith_top.ml"}
17
+
"_build/install/default/lib/zarith/z.ml"
18
+
"_build/install/default/lib/zarith/z.mli"
19
+
"_build/install/default/lib/zarith/zarith.a"
20
+
"_build/install/default/lib/zarith/zarith.cma"
21
+
"_build/install/default/lib/zarith/zarith.cmi"
22
+
"_build/install/default/lib/zarith/zarith.cmt"
23
+
"_build/install/default/lib/zarith/zarith.cmx"
24
+
"_build/install/default/lib/zarith/zarith.cmxa"
25
+
"_build/install/default/lib/zarith/zarith.ml"
26
+
"_build/install/default/lib/zarith/zarith__Big_int_Z.cmi"
27
+
"_build/install/default/lib/zarith/zarith__Big_int_Z.cmt"
28
+
"_build/install/default/lib/zarith/zarith__Big_int_Z.cmti"
29
+
"_build/install/default/lib/zarith/zarith__Big_int_Z.cmx"
30
+
"_build/install/default/lib/zarith/zarith__Q.cmi"
31
+
"_build/install/default/lib/zarith/zarith__Q.cmt"
32
+
"_build/install/default/lib/zarith/zarith__Q.cmti"
33
+
"_build/install/default/lib/zarith/zarith__Q.cmx"
34
+
"_build/install/default/lib/zarith/zarith__Z.cmi"
35
+
"_build/install/default/lib/zarith/zarith__Z.cmt"
36
+
"_build/install/default/lib/zarith/zarith__Z.cmti"
37
+
"_build/install/default/lib/zarith/zarith__Z.cmx"
38
+
"_build/install/default/lib/zarith/zarith__Zarith_version.cmi"
39
+
"_build/install/default/lib/zarith/zarith__Zarith_version.cmt"
40
+
"_build/install/default/lib/zarith/zarith__Zarith_version.cmx"
41
+
"_build/install/default/lib/zarith/zarith_version.ml"
42
+
]
43
+
libexec: [
44
+
"_build/install/default/lib/zarith/top/zarith_top.cmxs" {"top/zarith_top.cmxs"}
45
+
"_build/install/default/lib/zarith/zarith.cmxs"
46
+
]
47
+
doc: [
48
+
"_build/install/default/doc/zarith/LICENSE"
49
+
"_build/install/default/doc/zarith/README.md"
50
+
]
51
+
stublibs: [
52
+
"_build/install/default/lib/stublibs/dllzarith_stubs.so"
53
+
]
+13
vendor/opam/zarith/_build/default/zarith.ml-gen
+13
vendor/opam/zarith/_build/default/zarith.ml-gen
···
1
+
(* generated by dune *)
2
+
3
+
(** @canonical Zarith.Big_int_Z *)
4
+
module Big_int_Z = Zarith__Big_int_Z
5
+
6
+
(** @canonical Zarith.Q *)
7
+
module Q = Zarith__Q
8
+
9
+
(** @canonical Zarith.Z *)
10
+
module Z = Zarith__Z
11
+
12
+
(** @canonical Zarith.Zarith_version *)
13
+
module Zarith_version = Zarith__Zarith_version
+54
vendor/opam/zarith/_build/default/zarith.opam
+54
vendor/opam/zarith/_build/default/zarith.opam
···
1
+
opam-version: "2.0"
2
+
name: "zarith"
3
+
version: "1.14"
4
+
maintainer: "Xavier Leroy <xavier.leroy@inria.fr>"
5
+
authors: [
6
+
"Antoine Miné"
7
+
"Xavier Leroy"
8
+
"Pascal Cuoq"
9
+
]
10
+
homepage: "https://github.com/ocaml/Zarith"
11
+
bug-reports: "https://github.com/ocaml/Zarith/issues"
12
+
dev-repo: "git+https://github.com/ocaml/Zarith.git"
13
+
license: "LGPL-2.0-only WITH OCaml-LGPL-linking-exception"
14
+
x-maintenance-intent: ["(latest)"]
15
+
build: [
16
+
["./configure"] {os != "openbsd" & os != "freebsd" & os != "macos"}
17
+
[
18
+
"sh"
19
+
"-exc"
20
+
"LDFLAGS=\"$LDFLAGS -L/usr/local/lib\" CFLAGS=\"$CFLAGS -I/usr/local/include\" ./configure"
21
+
] {os = "openbsd" | os = "freebsd"}
22
+
[
23
+
"sh"
24
+
"-exc"
25
+
"LDFLAGS=\"$LDFLAGS -L/opt/local/lib -L/usr/local/lib\" CFLAGS=\"$CFLAGS -I/opt/local/include -I/usr/local/include\" ./configure"
26
+
] {os = "macos" & os-distribution != "homebrew"}
27
+
[
28
+
"sh"
29
+
"-exc"
30
+
"LDFLAGS=\"$LDFLAGS -L/opt/local/lib -L/usr/local/lib\" CFLAGS=\"$CFLAGS -I/opt/local/include -I/usr/local/include\" ./configure"
31
+
] {os = "macos" & os-distribution = "homebrew" & arch = "x86_64" }
32
+
[
33
+
"sh"
34
+
"-exc"
35
+
"LDFLAGS=\"$LDFLAGS -L/opt/homebrew/lib\" CFLAGS=\"$CFLAGS -I/opt/homebrew/include\" ./configure"
36
+
] {os = "macos" & os-distribution = "homebrew" & arch = "arm64" }
37
+
[make]
38
+
]
39
+
install: [
40
+
[make "install"]
41
+
]
42
+
depends: [
43
+
"ocaml" {>= "4.07.0"}
44
+
"ocamlfind"
45
+
"conf-pkg-config"
46
+
"conf-gmp"
47
+
]
48
+
synopsis:
49
+
"Implements arithmetic and logical operations over arbitrary-precision integers"
50
+
description: """
51
+
The Zarith library implements arithmetic and logical operations over
52
+
arbitrary-precision integers. It uses GMP to efficiently implement
53
+
arithmetic over big integers. Small integers are represented as Caml
54
+
unboxed integers, for speed and space economy."""
+23
vendor/opam/zarith/_build/default/zarith_top.ml
+23
vendor/opam/zarith/_build/default/zarith_top.ml
···
1
+
(*
2
+
This file is part of the Zarith library
3
+
http://forge.ocamlcore.org/projects/zarith .
4
+
It is distributed under LGPL 2 licensing, with static linking exception.
5
+
See the LICENSE file included in the distribution.
6
+
7
+
Contributed by Christophe Troestler.
8
+
*)
9
+
10
+
open Printf
11
+
12
+
let eval_string
13
+
?(print_outcome = false) ?(err_formatter = Format.err_formatter) str =
14
+
let lexbuf = Lexing.from_string str in
15
+
let phrase = !Toploop.parse_toplevel_phrase lexbuf in
16
+
Toploop.execute_phrase print_outcome err_formatter phrase
17
+
18
+
let () =
19
+
let printers = ["Z.pp_print"; "Q.pp_print"] in
20
+
let ok = List.fold_left (fun b p ->
21
+
b && eval_string(sprintf "#install_printer %s;;" p))
22
+
true printers in
23
+
if not ok then Format.eprintf "Problem installing ZArith-printers@."
+1
vendor/opam/zarith/_build/install/default/doc/zarith/LICENSE
+1
vendor/opam/zarith/_build/install/default/doc/zarith/LICENSE
···
1
+
../../../../default/LICENSE
+1
vendor/opam/zarith/_build/install/default/doc/zarith/README.md
+1
vendor/opam/zarith/_build/install/default/doc/zarith/README.md
···
1
+
../../../../default/README.md
+1
vendor/opam/zarith/_build/install/default/lib/zarith/META
+1
vendor/opam/zarith/_build/install/default/lib/zarith/META
···
1
+
../../../../default/META.zarith
+1
vendor/opam/zarith/_build/install/default/lib/zarith/big_int_Z.ml
+1
vendor/opam/zarith/_build/install/default/lib/zarith/big_int_Z.ml
···
1
+
../../../../default/big_int_Z.ml
+1
vendor/opam/zarith/_build/install/default/lib/zarith/big_int_Z.mli
+1
vendor/opam/zarith/_build/install/default/lib/zarith/big_int_Z.mli
···
1
+
../../../../default/big_int_Z.mli
+1
vendor/opam/zarith/_build/install/default/lib/zarith/dune-package
+1
vendor/opam/zarith/_build/install/default/lib/zarith/dune-package
···
1
+
../../../../default/zarith.dune-package
+1
vendor/opam/zarith/_build/install/default/lib/zarith/opam
+1
vendor/opam/zarith/_build/install/default/lib/zarith/opam
···
1
+
../../../../default/zarith.opam
+1
vendor/opam/zarith/_build/install/default/lib/zarith/q.ml
+1
vendor/opam/zarith/_build/install/default/lib/zarith/q.ml
···
1
+
../../../../default/q.ml
+1
vendor/opam/zarith/_build/install/default/lib/zarith/q.mli
+1
vendor/opam/zarith/_build/install/default/lib/zarith/q.mli
···
1
+
../../../../default/q.mli
+1
vendor/opam/zarith/_build/install/default/lib/zarith/top/zarith_top.ml
+1
vendor/opam/zarith/_build/install/default/lib/zarith/top/zarith_top.ml
···
1
+
../../../../../default/zarith_top.ml
+1
vendor/opam/zarith/_build/install/default/lib/zarith/z.ml
+1
vendor/opam/zarith/_build/install/default/lib/zarith/z.ml
···
1
+
../../../../default/z.ml
+1
vendor/opam/zarith/_build/install/default/lib/zarith/z.mli
+1
vendor/opam/zarith/_build/install/default/lib/zarith/z.mli
···
1
+
../../../../default/z.mli
+1
vendor/opam/zarith/_build/install/default/lib/zarith/zarith.ml
+1
vendor/opam/zarith/_build/install/default/lib/zarith/zarith.ml
···
1
+
../../../../default/zarith.ml-gen
+32
vendor/opam/zarith/_build/log
+32
vendor/opam/zarith/_build/log
···
1
+
# dune build
2
+
# OCAMLPARAM: unset
3
+
# Shared cache: enabled-except-user-rules
4
+
# Shared cache location: /home/node/.cache/dune/db
5
+
# Workspace root: /workspace/myspace/opam/patches/zarith/vendor/opam/zarith
6
+
# Auto-detected concurrency: 128
7
+
# Dune context:
8
+
# { name = "default"
9
+
# ; kind = "default"
10
+
# ; profile = Dev
11
+
# ; merlin = true
12
+
# ; fdo_target_exe = None
13
+
# ; build_dir = In_build_dir "default"
14
+
# ; instrument_with = []
15
+
# }
16
+
$ /home/node/.opam/default/bin/ocamlc.opt -config > /tmp/dune_4c6607_output
17
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlc.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -bin-annot -bin-annot-occurrences -I .zarith.objs/byte -no-alias-deps -opaque -open Zarith -o .zarith.objs/byte/zarith__Zarith_version.cmo -c -impl zarith_version.ml)
18
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlopt.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -I .zarith.objs/byte -I .zarith.objs/native -cmi-file .zarith.objs/byte/zarith__Zarith_version.cmi -no-alias-deps -opaque -open Zarith -o .zarith.objs/native/zarith__Zarith_version.cmx -c -impl zarith_version.ml)
19
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlc.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -bin-annot -bin-annot-occurrences -I .zarith.objs/byte -no-alias-deps -opaque -open Zarith -o .zarith.objs/byte/zarith__Z.cmi -c -intf z.mli)
20
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlc.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -bin-annot -bin-annot-occurrences -I .zarith.objs/byte -no-alias-deps -opaque -open Zarith -o .zarith.objs/byte/zarith__Big_int_Z.cmi -c -intf big_int_Z.mli)
21
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlc.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -bin-annot -bin-annot-occurrences -I .zarith.objs/byte -no-alias-deps -opaque -open Zarith -o .zarith.objs/byte/zarith__Q.cmi -c -intf q.mli)
22
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlc.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -bin-annot -bin-annot-occurrences -I .zarith.objs/byte -cmi-file .zarith.objs/byte/zarith__Z.cmi -no-alias-deps -opaque -open Zarith -o .zarith.objs/byte/zarith__Z.cmo -c -impl z.ml)
23
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlc.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -bin-annot -bin-annot-occurrences -I .zarith.objs/byte -cmi-file .zarith.objs/byte/zarith__Big_int_Z.cmi -no-alias-deps -opaque -open Zarith -o .zarith.objs/byte/zarith__Big_int_Z.cmo -c -impl big_int_Z.ml)
24
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlopt.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -I .zarith.objs/byte -I .zarith.objs/native -cmi-file .zarith.objs/byte/zarith__Big_int_Z.cmi -no-alias-deps -opaque -open Zarith -o .zarith.objs/native/zarith__Big_int_Z.cmx -c -impl big_int_Z.ml)
25
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlopt.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -I .zarith.objs/byte -I .zarith.objs/native -cmi-file .zarith.objs/byte/zarith__Z.cmi -no-alias-deps -opaque -open Zarith -o .zarith.objs/native/zarith__Z.cmx -c -impl z.ml)
26
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlc.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -bin-annot -bin-annot-occurrences -I .zarith.objs/byte -cmi-file .zarith.objs/byte/zarith__Q.cmi -no-alias-deps -opaque -open Zarith -o .zarith.objs/byte/zarith__Q.cmo -c -impl q.ml)
27
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlc.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -a -o zarith.cma -dllib -lzarith_stubs -cclib -lzarith_stubs -cclib -lgmp .zarith.objs/byte/zarith.cmo .zarith.objs/byte/zarith__Zarith_version.cmo .zarith.objs/byte/zarith__Z.cmo .zarith.objs/byte/zarith__Q.cmo .zarith.objs/byte/zarith__Big_int_Z.cmo)
28
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlopt.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -I .zarith.objs/byte -I .zarith.objs/native -cmi-file .zarith.objs/byte/zarith__Q.cmi -no-alias-deps -opaque -open Zarith -o .zarith.objs/native/zarith__Q.cmx -c -impl q.ml)
29
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlopt.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -a -o zarith.cmxa -cclib -lzarith_stubs -cclib -lgmp .zarith.objs/native/zarith.cmx .zarith.objs/native/zarith__Zarith_version.cmx .zarith.objs/native/zarith__Z.cmx .zarith.objs/native/zarith__Q.cmx .zarith.objs/native/zarith__Big_int_Z.cmx)
30
+
$ (cd _build/default && /usr/bin/gcc -DHAS_GMP -fPIC -g -I /home/node/.opam/default/lib/ocaml -o caml_z.o -c caml_z.c)
31
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlmklib -g -o zarith_stubs caml_z.o -ldopt -lgmp)
32
+
$ (cd _build/default && /home/node/.opam/default/bin/ocamlopt.opt -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -w -32-39 -g -shared -linkall -I . -o zarith.cmxs zarith.cmxa)
+144
vendor/opam/zarith/big_int_Z.ml
+144
vendor/opam/zarith/big_int_Z.ml
···
1
+
(**
2
+
[Big_int] interface for Z module.
3
+
4
+
This modules provides an interface compatible with [Big_int], but using
5
+
[Z] functions internally.
6
+
7
+
8
+
This file is part of the Zarith library
9
+
http://forge.ocamlcore.org/projects/zarith .
10
+
It is distributed under LGPL 2 licensing, with static linking exception.
11
+
See the LICENSE file included in the distribution.
12
+
13
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
14
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
15
+
a joint laboratory by:
16
+
CNRS (Centre national de la recherche scientifique, France),
17
+
ENS (École normale supérieure, Paris, France),
18
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
19
+
20
+
*)
21
+
22
+
type big_int = Z.t
23
+
24
+
let zero_big_int = Z.zero
25
+
26
+
let unit_big_int = Z.one
27
+
28
+
let minus_big_int = Z.neg
29
+
30
+
let abs_big_int = Z.abs
31
+
32
+
let add_big_int = Z.add
33
+
34
+
let succ_big_int = Z.succ
35
+
36
+
let add_int_big_int x y = Z.add (Z.of_int x) y
37
+
38
+
let sub_big_int = Z.sub
39
+
40
+
let pred_big_int = Z.pred
41
+
42
+
let mult_big_int = Z.mul
43
+
44
+
let mult_int_big_int x y = Z.mul (Z.of_int x) y
45
+
46
+
let square_big_int x = Z.mul x x
47
+
48
+
let sqrt_big_int = Z.sqrt
49
+
50
+
let quomod_big_int = Z.ediv_rem
51
+
52
+
let div_big_int = Z.ediv
53
+
54
+
let mod_big_int = Z.erem
55
+
56
+
let gcd_big_int = Z.gcd
57
+
58
+
let power = Z.pow
59
+
60
+
let power_big a b =
61
+
Z.pow a (Z.to_int b)
62
+
63
+
let power_int_positive_int a b =
64
+
if b < 0 then raise (Invalid_argument "power_int_positive_int");
65
+
power (Z.of_int a) b
66
+
67
+
let power_big_int_positive_int a b =
68
+
if b < 0 then raise (Invalid_argument "power_big_int_positive_int");
69
+
power a b
70
+
71
+
let power_int_positive_big_int a b =
72
+
if Z.sign b < 0 then raise (Invalid_argument "power_int_positive_big_int");
73
+
power_big (Z.of_int a) b
74
+
75
+
let power_big_int_positive_big_int a b =
76
+
if Z.sign b < 0 then raise (Invalid_argument "power_big_int_positive_big_int");
77
+
power_big a b
78
+
79
+
let sign_big_int = Z.sign
80
+
81
+
let compare_big_int = Z.compare
82
+
83
+
let eq_big_int = Z.equal
84
+
85
+
let le_big_int a b = Z.compare a b <= 0
86
+
87
+
let ge_big_int a b = Z.compare a b >= 0
88
+
89
+
let lt_big_int a b = Z.compare a b < 0
90
+
91
+
let gt_big_int a b = Z.compare a b > 0
92
+
93
+
let max_big_int = Z.max
94
+
95
+
let min_big_int = Z.min
96
+
97
+
let num_digits_big_int = Z.size
98
+
99
+
let string_of_big_int = Z.to_string
100
+
101
+
let big_int_of_string = Z.of_string
102
+
103
+
let big_int_of_int = Z.of_int
104
+
105
+
let is_int_big_int = Z.fits_int
106
+
107
+
let int_of_big_int x =
108
+
try Z.to_int x with Z.Overflow -> failwith "int_of_big_int"
109
+
110
+
let big_int_of_int32 = Z.of_int32
111
+
112
+
let big_int_of_nativeint = Z.of_nativeint
113
+
114
+
let big_int_of_int64 = Z.of_int64
115
+
116
+
let int32_of_big_int x =
117
+
try Z.to_int32 x with Z.Overflow -> failwith "int32_of_big_int"
118
+
119
+
let nativeint_of_big_int x =
120
+
try Z.to_nativeint x with Z.Overflow -> failwith "nativeint_of_big_int"
121
+
122
+
let int64_of_big_int x =
123
+
try Z.to_int64 x with Z.Overflow -> failwith "int64_of_big_int"
124
+
125
+
let float_of_big_int = Z.to_float
126
+
127
+
let big_int_of_float = Z.of_float
128
+
129
+
let and_big_int = Z.logand
130
+
131
+
let or_big_int = Z.logor
132
+
133
+
let xor_big_int = Z.logxor
134
+
135
+
let shift_left_big_int = Z.shift_left
136
+
137
+
let shift_right_big_int = Z.shift_right
138
+
139
+
let shift_right_towards_zero_big_int = Z.shift_right_trunc
140
+
141
+
let extract_big_int = Z.extract
142
+
143
+
144
+
+78
vendor/opam/zarith/big_int_Z.mli
+78
vendor/opam/zarith/big_int_Z.mli
···
1
+
(**
2
+
[Big_int] interface for Z module.
3
+
4
+
This modules provides an interface compatible with [Big_int], but using
5
+
[Z] functions internally.
6
+
7
+
8
+
This file is part of the Zarith library
9
+
http://forge.ocamlcore.org/projects/zarith .
10
+
It is distributed under LGPL 2 licensing, with static linking exception.
11
+
See the LICENSE file included in the distribution.
12
+
13
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
14
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
15
+
a joint laboratory by:
16
+
CNRS (Centre national de la recherche scientifique, France),
17
+
ENS (École normale supérieure, Paris, France),
18
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
19
+
20
+
*)
21
+
22
+
(* note: generated with ocamlc -i *)
23
+
24
+
type big_int = Z.t
25
+
26
+
val zero_big_int : Z.t
27
+
val unit_big_int : Z.t
28
+
val minus_big_int : Z.t -> Z.t
29
+
val abs_big_int : Z.t -> Z.t
30
+
val add_big_int : Z.t -> Z.t -> Z.t
31
+
val succ_big_int : Z.t -> Z.t
32
+
val add_int_big_int : int -> Z.t -> Z.t
33
+
val sub_big_int : Z.t -> Z.t -> Z.t
34
+
val pred_big_int : Z.t -> Z.t
35
+
val mult_big_int : Z.t -> Z.t -> Z.t
36
+
val mult_int_big_int : int -> Z.t -> Z.t
37
+
val square_big_int : Z.t -> Z.t
38
+
val sqrt_big_int : Z.t -> Z.t
39
+
val quomod_big_int : Z.t -> Z.t -> Z.t * Z.t
40
+
val div_big_int : Z.t -> Z.t -> Z.t
41
+
val mod_big_int : Z.t -> Z.t -> Z.t
42
+
val gcd_big_int : Z.t -> Z.t -> Z.t
43
+
val power : Z.t -> int -> Z.t
44
+
val power_big : Z.t -> Z.t -> Z.t
45
+
val power_int_positive_int : int -> int -> Z.t
46
+
val power_big_int_positive_int : Z.t -> int -> Z.t
47
+
val power_int_positive_big_int : int -> Z.t -> Z.t
48
+
val power_big_int_positive_big_int : Z.t -> Z.t -> Z.t
49
+
val sign_big_int : Z.t -> int
50
+
val compare_big_int : Z.t -> Z.t -> int
51
+
val eq_big_int : Z.t -> Z.t -> bool
52
+
val le_big_int : Z.t -> Z.t -> bool
53
+
val ge_big_int : Z.t -> Z.t -> bool
54
+
val lt_big_int : Z.t -> Z.t -> bool
55
+
val gt_big_int : Z.t -> Z.t -> bool
56
+
val max_big_int : Z.t -> Z.t -> Z.t
57
+
val min_big_int : Z.t -> Z.t -> Z.t
58
+
val num_digits_big_int : Z.t -> int
59
+
val string_of_big_int : Z.t -> string
60
+
val big_int_of_string : string -> Z.t
61
+
val big_int_of_int : int -> Z.t
62
+
val is_int_big_int : Z.t -> bool
63
+
val int_of_big_int : Z.t -> int
64
+
val big_int_of_int32 : int32 -> Z.t
65
+
val big_int_of_nativeint : nativeint -> Z.t
66
+
val big_int_of_int64 : int64 -> Z.t
67
+
val int32_of_big_int : Z.t -> int32
68
+
val nativeint_of_big_int : Z.t -> nativeint
69
+
val int64_of_big_int : Z.t -> int64
70
+
val float_of_big_int : Z.t -> float
71
+
val big_int_of_float : float -> Z.t
72
+
val and_big_int : Z.t -> Z.t -> Z.t
73
+
val or_big_int : Z.t -> Z.t -> Z.t
74
+
val xor_big_int : Z.t -> Z.t -> Z.t
75
+
val shift_left_big_int : Z.t -> int -> Z.t
76
+
val shift_right_big_int : Z.t -> int -> Z.t
77
+
val shift_right_towards_zero_big_int : Z.t -> int -> Z.t
78
+
val extract_big_int : Z.t -> int -> int -> Z.t
+3543
vendor/opam/zarith/caml_z.c
+3543
vendor/opam/zarith/caml_z.c
···
1
+
/**
2
+
Implementation of Z module.
3
+
4
+
5
+
This file is part of the Zarith library
6
+
http://forge.ocamlcore.org/projects/zarith .
7
+
It is distributed under LGPL 2 licensing, with static linking exception.
8
+
See the LICENSE file included in the distribution.
9
+
10
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
11
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
12
+
a joint laboratory by:
13
+
CNRS (Centre national de la recherche scientifique, France),
14
+
ENS (École normale supérieure, Paris, France),
15
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
16
+
17
+
*/
18
+
19
+
20
+
/*---------------------------------------------------
21
+
INCLUDES
22
+
---------------------------------------------------*/
23
+
24
+
#include <stdio.h>
25
+
#include <stdlib.h>
26
+
#include <string.h>
27
+
#include <math.h>
28
+
#include <stdint.h>
29
+
#include <limits.h>
30
+
31
+
#ifdef HAS_GMP
32
+
#include <gmp.h>
33
+
#endif
34
+
#ifdef HAS_MPIR
35
+
#include <mpir.h>
36
+
#endif
37
+
38
+
#include "zarith.h"
39
+
40
+
#ifdef __cplusplus
41
+
extern "C" {
42
+
#endif
43
+
44
+
#include <caml/mlvalues.h>
45
+
#include <caml/memory.h>
46
+
#include <caml/alloc.h>
47
+
#include <caml/fail.h>
48
+
#include <caml/custom.h>
49
+
#include <caml/intext.h>
50
+
#include <caml/callback.h>
51
+
#include <caml/intext.h>
52
+
#include <caml/hash.h>
53
+
54
+
#define inline __inline
55
+
56
+
#ifdef _MSC_VER
57
+
#include <float.h>
58
+
#include <intrin.h>
59
+
#endif
60
+
61
+
/* The "__has_builtin" special macro from Clang */
62
+
#ifdef __has_builtin
63
+
#define HAS_BUILTIN(x) __has_builtin(x)
64
+
#else
65
+
#define HAS_BUILTIN(x) 0
66
+
#endif
67
+
68
+
/*---------------------------------------------------
69
+
CONFIGURATION
70
+
---------------------------------------------------*/
71
+
72
+
/* Whether to enable native (i.e. non-mpn_) operations and output
73
+
ocaml integers when possible.
74
+
Highly recommended.
75
+
*/
76
+
#define Z_FAST_PATH 1
77
+
#define Z_USE_NATINT 1
78
+
79
+
/* Whether the fast path (arguments and result are small integers)
80
+
has already be handled in OCaml, so that there is no need to
81
+
re-test for it in C functions.
82
+
Applies to: neg, abs, add, sub, mul, div, rem, succ, pred,
83
+
logand, logor, logxor, lognot, shifts, divexact.
84
+
*/
85
+
#define Z_FAST_PATH_IN_OCAML 1
86
+
87
+
/* Sanity checks. */
88
+
#define Z_PERFORM_CHECK 0
89
+
90
+
/* Enable performance counters.
91
+
Prints some info on stdout at exit.
92
+
*/
93
+
/*
94
+
#define Z_PERF_COUNTER 0
95
+
now set by configure
96
+
*/
97
+
98
+
/* whether to use custom blocks (supporting serialization, comparison &
99
+
hashing) instead of abstract tags
100
+
*/
101
+
#define Z_CUSTOM_BLOCK 1
102
+
103
+
/*---------------------------------------------------
104
+
DATA STRUCTURES
105
+
---------------------------------------------------*/
106
+
107
+
/*
108
+
we assume that:
109
+
- intnat is a signed integer type
110
+
- mp_limb_t is an unsigned integer type
111
+
- sizeof(intnat) == sizeof(mp_limb_t) == either 4 or 8
112
+
*/
113
+
114
+
#ifdef _WIN64
115
+
#define PRINTF_LIMB "I64"
116
+
#else
117
+
#define PRINTF_LIMB "l"
118
+
#endif
119
+
120
+
/*
121
+
A z object x can be:
122
+
- either an ocaml int
123
+
- or a block with abstract or custom tag and containing:
124
+
. a 1 value header containing the sign Z_SIGN(x) and the size Z_SIZE(x)
125
+
. Z_SIZE(x) mp_limb_t
126
+
127
+
Invariant:
128
+
- if the number fits in an int, it is stored in an int, not a block
129
+
- if the number is stored in a block, then Z_SIZE(x) >= 1 and
130
+
the most significant limb Z_LIMB(x)[Z_SIZE(x)] is not 0
131
+
*/
132
+
133
+
134
+
/* a sign is always denoted as 0 (+) or Z_SIGN_MASK (-) */
135
+
#ifdef ARCH_SIXTYFOUR
136
+
#define Z_SIGN_MASK 0x8000000000000000
137
+
#define Z_SIZE_MASK 0x7fffffffffffffff
138
+
#else
139
+
#define Z_SIGN_MASK 0x80000000
140
+
#define Z_SIZE_MASK 0x7fffffff
141
+
#endif
142
+
143
+
#if Z_CUSTOM_BLOCK
144
+
#define Z_HEAD(x) (*((value*)Data_custom_val((x))))
145
+
#define Z_LIMB(x) ((mp_limb_t*)Data_custom_val((x)) + 1)
146
+
#else
147
+
#define Z_HEAD(x) (Field((x),0))
148
+
#define Z_LIMB(x) ((mp_limb_t*)&(Field((x),1)))
149
+
#endif
150
+
#define Z_SIGN(x) (Z_HEAD((x)) & Z_SIGN_MASK)
151
+
#define Z_SIZE(x) (Z_HEAD((x)) & Z_SIZE_MASK)
152
+
153
+
/* bounds of an Ocaml int */
154
+
#ifdef ARCH_SIXTYFOUR
155
+
#define Z_MAX_INT 0x3fffffffffffffff
156
+
#define Z_MIN_INT (-0x4000000000000000)
157
+
#else
158
+
#define Z_MAX_INT 0x3fffffff
159
+
#define Z_MIN_INT (-0x40000000)
160
+
#endif
161
+
#define Z_FITS_INT(v) ((v) >= Z_MIN_INT && (v) <= Z_MAX_INT)
162
+
163
+
/* greatest/smallest double that can fit in an int */
164
+
#ifdef ARCH_SIXTYFOUR
165
+
#define Z_MAX_INT_FL 0x3ffffffffffffe00
166
+
#define Z_MIN_INT_FL (-0x4000000000000000)
167
+
#else
168
+
#define Z_MAX_INT_FL Z_MAX_INT
169
+
#define Z_MIN_INT_FL Z_MIN_INT
170
+
#endif
171
+
172
+
/* safe bounds to avoid overflow in multiplication */
173
+
#ifdef ARCH_SIXTYFOUR
174
+
#define Z_MAX_HINT 0x3fffffff
175
+
#else
176
+
#define Z_MAX_HINT 0x3fff
177
+
#endif
178
+
#define Z_MIN_HINT (-Z_MAX_HINT)
179
+
#define Z_FITS_HINT(v) ((v) >= Z_MIN_HINT && (v) <= Z_MAX_HINT)
180
+
181
+
/* hi bit of OCaml int32, int64 & nativeint */
182
+
#define Z_HI_INT32 0x80000000
183
+
#define Z_HI_UINT32 0x100000000LL
184
+
#define Z_HI_INT64 0x8000000000000000LL
185
+
#ifdef ARCH_SIXTYFOUR
186
+
#define Z_HI_INTNAT Z_HI_INT64
187
+
#define Z_HI_INT 0x4000000000000000
188
+
#else
189
+
#define Z_HI_INTNAT Z_HI_INT32
190
+
#define Z_HI_INT 0x40000000
191
+
#endif
192
+
193
+
/* safe bounds for the length of a base n string fitting in a native
194
+
int. Defined as the result of (n - 2) log_base(2) with n = 64 or
195
+
32.
196
+
*/
197
+
#ifdef ARCH_SIXTYFOUR
198
+
#define Z_BASE16_LENGTH_OP 15
199
+
#define Z_BASE10_LENGTH_OP 18
200
+
#define Z_BASE8_LENGTH_OP 20
201
+
#define Z_BASE2_LENGTH_OP 62
202
+
#else
203
+
#define Z_BASE16_LENGTH_OP 7
204
+
#define Z_BASE10_LENGTH_OP 9
205
+
#define Z_BASE8_LENGTH_OP 10
206
+
#define Z_BASE2_LENGTH_OP 30
207
+
#endif
208
+
209
+
#define Z_LIMB_BITS (8 * sizeof(mp_limb_t))
210
+
211
+
212
+
/* performance counters */
213
+
unsigned long ml_z_ops = 0;
214
+
unsigned long ml_z_slow = 0;
215
+
unsigned long ml_z_ops_as = 0;
216
+
217
+
#if Z_PERF_COUNTER
218
+
#define Z_MARK_OP ml_z_ops++
219
+
#define Z_MARK_SLOW ml_z_slow++
220
+
#else
221
+
#define Z_MARK_OP
222
+
#define Z_MARK_SLOW
223
+
#endif
224
+
225
+
/*---------------------------------------------------
226
+
UTILITIES
227
+
---------------------------------------------------*/
228
+
229
+
extern struct custom_operations ml_z_custom_ops;
230
+
231
+
static double ml_z_2p32; /* 2 ^ 32 in double */
232
+
233
+
#if Z_PERFORM_CHECK
234
+
/* for debugging: dump a mp_limb_t array */
235
+
static void ml_z_dump(const char* msg, mp_limb_t* p, mp_size_t sz)
236
+
{
237
+
mp_size_t i;
238
+
printf("%s %i: ",msg,(int)sz);
239
+
for (i = 0; i < sz; i++)
240
+
#ifdef ARCH_SIXTYFOUR
241
+
printf("%08" PRINTF_LIMB "x ",p[i]);
242
+
#else
243
+
printf("%04" PRINTF_LIMB "x ",p[i]);
244
+
#endif
245
+
printf("\n");
246
+
fflush(stdout);
247
+
}
248
+
#endif
249
+
250
+
#if Z_PERFORM_CHECK
251
+
/* for debugging: check invariant */
252
+
void ml_z_check(const char* fn, int line, const char* arg, value v)
253
+
{
254
+
mp_size_t sz;
255
+
256
+
if (Is_long(v)) {
257
+
#if Z_USE_NATINT
258
+
return;
259
+
#else
260
+
printf("ml_z_check: unexpected tagged integer for %s at %s:%i.\n", arg, fn, line);
261
+
exit(1);
262
+
#endif
263
+
}
264
+
#if Z_CUSTOM_BLOCK
265
+
if (Custom_ops_val(v) != &ml_z_custom_ops) {
266
+
printf("ml_z_check: wrong custom block for %s at %s:%i.\n",
267
+
arg, fn, line);
268
+
exit(1);
269
+
}
270
+
sz = Wosize_val(v) - 1;
271
+
#else
272
+
sz = Wosize_val(v);
273
+
#endif
274
+
if (Z_SIZE(v) + 2 > sz) {
275
+
printf("ml_z_check: invalid block size (%i / %i) for %s at %s:%i.\n",
276
+
(int)Z_SIZE(v), (int)sz,
277
+
arg, fn, line);
278
+
exit(1);
279
+
}
280
+
if ((mp_size_t) Z_LIMB(v)[sz - 2] != (mp_size_t)(0xDEADBEEF ^ (sz - 2))) {
281
+
printf("ml_z_check: corrupted block for %s at %s:%i.\n",
282
+
arg, fn, line);
283
+
exit(1);
284
+
}
285
+
if (Z_SIZE(v) && !Z_LIMB(v)[Z_SIZE(v)-1]) {
286
+
printf("ml_z_check: unreduced argument for %s at %s:%i.\n", arg, fn, line);
287
+
ml_z_dump("offending argument: ", Z_LIMB(v), Z_SIZE(v));
288
+
exit(1);
289
+
}
290
+
#if Z_USE_NATINT
291
+
if (Z_SIZE(v) == 0
292
+
|| (Z_SIZE(v) <= 1
293
+
&& (Z_LIMB(v)[0] <= Z_MAX_INT
294
+
|| (Z_LIMB(v)[0] == -Z_MIN_INT && Z_SIGN(v))))) {
295
+
printf("ml_z_check: expected a tagged integer for %s at %s:%i.\n", arg, fn, line);
296
+
ml_z_dump("offending argument: ", Z_LIMB(v), Z_SIZE(v));
297
+
exit(1);
298
+
}
299
+
#else
300
+
if (!Z_SIZE(v) && Z_SIGN(v)) {
301
+
printf("ml_z_check: invalid sign of 0 for %s at %s:%i.\n",
302
+
arg, fn, line);
303
+
exit(1);
304
+
}
305
+
#endif
306
+
}
307
+
#endif
308
+
309
+
/* for debugging */
310
+
#if Z_PERFORM_CHECK
311
+
#define Z_CHECK(v) ml_z_check(__FUNCTION__, __LINE__, #v, v)
312
+
#else
313
+
#define Z_CHECK(v)
314
+
#endif
315
+
316
+
/* allocates z object block with space for sz mp_limb_t;
317
+
does not set the header
318
+
*/
319
+
320
+
#if !Z_PERFORM_CHECK
321
+
/* inlined allocation */
322
+
#if Z_CUSTOM_BLOCK
323
+
#define ml_z_alloc(sz) \
324
+
caml_alloc_custom(&ml_z_custom_ops, (1 + (sz)) * sizeof(value), 0, 1)
325
+
#else
326
+
#define ml_z_alloc(sz) \
327
+
caml_alloc(1 + (sz), Abstract_tag);
328
+
#endif
329
+
330
+
#else
331
+
/* out-of-line allocation, inserting a canary after the last limb */
332
+
static value ml_z_alloc(mp_size_t sz)
333
+
{
334
+
value v;
335
+
#if Z_CUSTOM_BLOCK
336
+
v = caml_alloc_custom(&ml_z_custom_ops, (1 + sz + 1) * sizeof(value), 0, 1);
337
+
#else
338
+
v = caml_alloc(1 + sz + 1, Abstract_tag);
339
+
#endif
340
+
Z_LIMB(v)[sz] = 0xDEADBEEF ^ sz;
341
+
return v;
342
+
}
343
+
#endif
344
+
345
+
/* duplicates the caml block src */
346
+
static inline void ml_z_cpy_limb(mp_limb_t* dst, mp_limb_t* src, mp_size_t sz)
347
+
{
348
+
memcpy(dst, src, sz * sizeof(mp_limb_t));
349
+
}
350
+
351
+
/* duplicates the mp_limb_t array src */
352
+
static inline mp_limb_t* ml_z_dup_limb(mp_limb_t* src, mp_size_t sz)
353
+
{
354
+
mp_limb_t* r = (mp_limb_t*) malloc(sz * sizeof(mp_limb_t));
355
+
memcpy(r, src, sz * sizeof(mp_limb_t));
356
+
return r;
357
+
}
358
+
359
+
360
+
#ifdef _MSC_VER
361
+
#define MAYBE_UNUSED
362
+
#else
363
+
#define MAYBE_UNUSED (void)
364
+
#endif
365
+
366
+
/* given a z object, define:
367
+
- ptr_arg: a pointer to the first mp_limb_t
368
+
- size_arg: the number of mp-limb_t
369
+
- sign_arg: the sign of the number
370
+
if arg is an int, it is converted to a 1-limb number
371
+
*/
372
+
#define Z_DECL(arg) \
373
+
mp_limb_t loc_##arg, *ptr_##arg; \
374
+
mp_size_t size_##arg; \
375
+
intnat sign_##arg; \
376
+
MAYBE_UNUSED loc_##arg; \
377
+
MAYBE_UNUSED ptr_##arg; \
378
+
MAYBE_UNUSED size_##arg; \
379
+
MAYBE_UNUSED sign_##arg;
380
+
381
+
#define Z_ARG(arg) \
382
+
if (Is_long(arg)) { \
383
+
intnat n = Long_val(arg); \
384
+
loc_##arg = n < 0 ? -n : n; \
385
+
sign_##arg = n & Z_SIGN_MASK; \
386
+
size_##arg = n != 0; \
387
+
ptr_##arg = &loc_##arg; \
388
+
} \
389
+
else { \
390
+
size_##arg = Z_SIZE(arg); \
391
+
sign_##arg = Z_SIGN(arg); \
392
+
ptr_##arg = Z_LIMB(arg); \
393
+
}
394
+
395
+
/* After an allocation, a heap-allocated Z argument may have moved and
396
+
its ptr_arg pointer can be invalid. Reset the ptr_arg pointer to
397
+
its correct value. */
398
+
399
+
#define Z_REFRESH(arg) \
400
+
if (! Is_long(arg)) ptr_##arg = Z_LIMB(arg);
401
+
402
+
/* computes the actual size of the z object r and updates its header,
403
+
either returns r or, if the number is small enough, an int
404
+
*/
405
+
static value ml_z_reduce(value r, mp_size_t sz, intnat sign)
406
+
{
407
+
while (sz > 0 && !Z_LIMB(r)[sz-1]) sz--;
408
+
#if Z_USE_NATINT
409
+
if (!sz) return Val_long(0);
410
+
if (sz <= 1) {
411
+
if (Z_LIMB(r)[0] <= Z_MAX_INT) {
412
+
if (sign) return Val_long(-Z_LIMB(r)[0]);
413
+
else return Val_long(Z_LIMB(r)[0]);
414
+
}
415
+
if (Z_LIMB(r)[0] == -Z_MIN_INT && sign) {
416
+
return Val_long(Z_MIN_INT);
417
+
}
418
+
}
419
+
#else
420
+
if (!sz) sign = 0;
421
+
#endif
422
+
Z_HEAD(r) = sz | sign;
423
+
return r;
424
+
}
425
+
426
+
static void ml_z_raise_overflow()
427
+
{
428
+
caml_raise_constant(*caml_named_value("ml_z_overflow"));
429
+
}
430
+
431
+
#define ml_z_raise_divide_by_zero() \
432
+
caml_raise_zero_divide()
433
+
434
+
435
+
436
+
/*---------------------------------------------------
437
+
CONVERSION FUNCTIONS
438
+
---------------------------------------------------*/
439
+
440
+
CAMLprim value ml_z_of_int(value v)
441
+
{
442
+
#if Z_USE_NATINT
443
+
Z_MARK_OP;
444
+
return v;
445
+
#else
446
+
intnat x;
447
+
value r;
448
+
Z_MARK_OP;
449
+
Z_MARK_SLOW;
450
+
x = Long_val(v);
451
+
r = ml_z_alloc(1);
452
+
if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; }
453
+
else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -x; }
454
+
else Z_HEAD(r) = 0;
455
+
Z_CHECK(r);
456
+
return r;
457
+
#endif
458
+
}
459
+
460
+
CAMLprim value ml_z_of_nativeint(value v)
461
+
{
462
+
intnat x;
463
+
value r;
464
+
Z_MARK_OP;
465
+
x = Nativeint_val(v);
466
+
#if Z_USE_NATINT
467
+
if (Z_FITS_INT(x)) return Val_long(x);
468
+
#endif
469
+
Z_MARK_SLOW;
470
+
r = ml_z_alloc(1);
471
+
if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; }
472
+
else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -x; }
473
+
else Z_HEAD(r) = 0;
474
+
Z_CHECK(r);
475
+
return r;
476
+
}
477
+
478
+
CAMLprim value ml_z_of_int32(value v)
479
+
{
480
+
int32_t x;
481
+
Z_MARK_OP;
482
+
x = Int32_val(v);
483
+
#if Z_USE_NATINT && defined(ARCH_SIXTYFOUR)
484
+
return Val_long(x);
485
+
#else
486
+
#if Z_USE_NATINT
487
+
if (Z_FITS_INT(x)) return Val_long(x);
488
+
#endif
489
+
{
490
+
value r;
491
+
Z_MARK_SLOW;
492
+
r = ml_z_alloc(1);
493
+
if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; }
494
+
else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -(mp_limb_t)x; }
495
+
else Z_HEAD(r) = 0;
496
+
Z_CHECK(r);
497
+
return r;
498
+
}
499
+
#endif
500
+
}
501
+
502
+
CAMLprim value ml_z_of_int64(value v)
503
+
{
504
+
int64_t x;
505
+
value r;
506
+
Z_MARK_OP;
507
+
x = Int64_val(v);
508
+
#if Z_USE_NATINT
509
+
if (Z_FITS_INT(x)) return Val_long(x);
510
+
#endif
511
+
Z_MARK_SLOW;
512
+
#ifdef ARCH_SIXTYFOUR
513
+
r = ml_z_alloc(1);
514
+
if (x > 0) { Z_HEAD(r) = 1; Z_LIMB(r)[0] = x; }
515
+
else if (x < 0) { Z_HEAD(r) = 1 | Z_SIGN_MASK; Z_LIMB(r)[0] = -x; }
516
+
else Z_HEAD(r) = 0;
517
+
#else
518
+
{
519
+
mp_limb_t sign;
520
+
r = ml_z_alloc(2);
521
+
if (x >= 0) { sign = 0; }
522
+
else { sign = Z_SIGN_MASK; x = -x; }
523
+
Z_LIMB(r)[0] = x;
524
+
Z_LIMB(r)[1] = x >> 32;
525
+
r = ml_z_reduce(r, 2, sign);
526
+
}
527
+
#endif
528
+
Z_CHECK(r);
529
+
return r;
530
+
}
531
+
532
+
CAMLprim value ml_z_of_float(value v)
533
+
{
534
+
double x;
535
+
int exp;
536
+
int64_t y, m;
537
+
value r;
538
+
Z_MARK_OP;
539
+
x = Double_val(v);
540
+
#if Z_USE_NATINT
541
+
if (x >= Z_MIN_INT_FL && x <= Z_MAX_INT_FL) return Val_long((intnat) x);
542
+
#endif
543
+
Z_MARK_SLOW;
544
+
#ifdef ARCH_ALIGN_INT64
545
+
memcpy(&y, (void *) v, 8);
546
+
#else
547
+
y = *((int64_t*)v);
548
+
#endif
549
+
exp = ((y >> 52) & 0x7ff) - 1023; /* exponent */
550
+
if (exp < 0) return(Val_long(0));
551
+
if (exp == 1024) ml_z_raise_overflow(); /* NaN or infinity */
552
+
m = (y & 0x000fffffffffffffLL) | 0x0010000000000000LL; /* mantissa */
553
+
if (exp <= 52) {
554
+
m >>= 52-exp;
555
+
#ifdef ARCH_SIXTYFOUR
556
+
r = Val_long((x >= 0.) ? m : -m);
557
+
#else
558
+
r = ml_z_alloc(2);
559
+
Z_LIMB(r)[0] = m;
560
+
Z_LIMB(r)[1] = m >> 32;
561
+
r = ml_z_reduce(r, 2, (x >= 0.) ? 0 : Z_SIGN_MASK);
562
+
#endif
563
+
}
564
+
else {
565
+
int c1 = (exp-52) / Z_LIMB_BITS;
566
+
int c2 = (exp-52) % Z_LIMB_BITS;
567
+
mp_size_t i;
568
+
#ifdef ARCH_SIXTYFOUR
569
+
r = ml_z_alloc(c1 + 2);
570
+
for (i = 0; i < c1; i++) Z_LIMB(r)[i] = 0;
571
+
Z_LIMB(r)[c1] = m << c2;
572
+
Z_LIMB(r)[c1+1] = c2 ? (m >> (64-c2)) : 0;
573
+
r = ml_z_reduce(r, c1 + 2, (x >= 0.) ? 0 : Z_SIGN_MASK);
574
+
#else
575
+
r = ml_z_alloc(c1 + 3);
576
+
for (i = 0; i < c1; i++) Z_LIMB(r)[i] = 0;
577
+
Z_LIMB(r)[c1] = m << c2;
578
+
Z_LIMB(r)[c1+1] = m >> (32-c2);
579
+
Z_LIMB(r)[c1+2] = c2 ? (m >> (64-c2)) : 0;
580
+
r = ml_z_reduce(r, c1 + 3, (x >= 0.) ? 0 : Z_SIGN_MASK);
581
+
#endif
582
+
}
583
+
Z_CHECK(r);
584
+
return r;
585
+
}
586
+
587
+
CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value length)
588
+
{
589
+
CAMLparam1(v);
590
+
CAMLlocal1(r);
591
+
intnat ofs = Long_val(offset);
592
+
intnat len = Long_val(length);
593
+
/* make sure the ofs/length make sense */
594
+
if (ofs < 0
595
+
|| len < 0
596
+
|| (intnat)caml_string_length(v) < ofs + len)
597
+
caml_invalid_argument("Z.of_substring_base: invalid offset or length");
598
+
/* process the string */
599
+
const char *d = String_val(v) + ofs;
600
+
const char *end = d + len;
601
+
mp_size_t i, j, sz, sz2, num_digits = 0;
602
+
mp_limb_t sign = 0;
603
+
intnat base = Long_val(b);
604
+
/* We allow [d] to advance beyond [end] while parsing the prefix:
605
+
sign, base, and/or leading zeros.
606
+
This simplifies the code, and reading these locations is safe since
607
+
we don't progress beyond a terminating null character.
608
+
At the end of the prefix, if we ran past the end, we return 0.
609
+
*/
610
+
/* get optional sign */
611
+
if (*d == '-') { sign ^= Z_SIGN_MASK; d++; }
612
+
if (*d == '+') d++;
613
+
/* get optional base */
614
+
if (!base) {
615
+
base = 10;
616
+
if (*d == '0') {
617
+
d++;
618
+
if (*d == 'o' || *d == 'O') { base = 8; d++; }
619
+
else if (*d == 'x' || *d == 'X') { base = 16; d++; }
620
+
else if (*d == 'b' || *d == 'B') { base = 2; d++; }
621
+
else {
622
+
/* The leading zero is not part of a base prefix. This is an
623
+
important distinction for the check below looking at
624
+
leading underscore
625
+
*/
626
+
d--; }
627
+
}
628
+
}
629
+
if (base < 2 || base > 16)
630
+
caml_invalid_argument("Z.of_substring_base: base must be between 2 and 16");
631
+
/* we do not allow leading underscore */
632
+
if (*d == '_')
633
+
caml_invalid_argument("Z.of_substring_base: invalid digit");
634
+
while (*d == '0' || *d == '_') d++;
635
+
/* sz is the length of the substring that has not been consumed above. */
636
+
sz = end - d;
637
+
for(i = 0; i < sz; i++){
638
+
/* underscores are going to be ignored below. Assuming the string
639
+
is well formatted, this will give us the exact number of digits */
640
+
if(d[i] != '_') num_digits++;
641
+
}
642
+
#if Z_USE_NATINT
643
+
if (sz <= 0) {
644
+
/* "+", "-", "0x" are parsed as 0. */
645
+
r = Val_long(0);
646
+
}
647
+
/* Process common case (fits into a native integer) */
648
+
else if ((base == 10 && num_digits <= Z_BASE10_LENGTH_OP)
649
+
|| (base == 16 && num_digits <= Z_BASE16_LENGTH_OP)
650
+
|| (base == 8 && num_digits <= Z_BASE8_LENGTH_OP)
651
+
|| (base == 2 && num_digits <= Z_BASE2_LENGTH_OP)) {
652
+
Z_MARK_OP;
653
+
intnat ret = 0;
654
+
for (i = 0; i < sz; i++) {
655
+
int digit = 0;
656
+
if (d[i] == '_') continue;
657
+
if (d[i] >= '0' && d[i] <= '9') digit = d[i] - '0';
658
+
else if (d[i] >= 'a' && d[i] <= 'f') digit = d[i] - 'a' + 10;
659
+
else if (d[i] >= 'A' && d[i] <= 'F') digit = d[i] - 'A' + 10;
660
+
else caml_invalid_argument("Z.of_substring_base: invalid digit");
661
+
if (digit >= base)
662
+
caml_invalid_argument("Z.of_substring_base: invalid digit");
663
+
ret = ret * base + digit;
664
+
}
665
+
r = Val_long(ret * (sign ? -1 : 1));
666
+
} else
667
+
#endif
668
+
{
669
+
/* converts to sequence of digits */
670
+
char* digits = (char*)malloc(num_digits+1);
671
+
for (i = 0, j = 0; i < sz; i++) {
672
+
if (d[i] == '_') continue;
673
+
if (d[i] >= '0' && d[i] <= '9') digits[j] = d[i] - '0';
674
+
else if (d[i] >= 'a' && d[i] <= 'f') digits[j] = d[i] - 'a' + 10;
675
+
else if (d[i] >= 'A' && d[i] <= 'F') digits[j] = d[i] - 'A' + 10;
676
+
else {
677
+
free(digits);
678
+
caml_invalid_argument("Z.of_substring_base: invalid digit");
679
+
}
680
+
if (digits[j] >= base) {
681
+
free(digits);
682
+
caml_invalid_argument("Z.of_substring_base: invalid digit");
683
+
}
684
+
j++;
685
+
}
686
+
/* make sure that digits is nul terminated */
687
+
digits[j] = 0;
688
+
r = ml_z_alloc(1 + j / (2 * sizeof(mp_limb_t)));
689
+
sz2 = mpn_set_str(Z_LIMB(r), (unsigned char*)digits, j, base);
690
+
r = ml_z_reduce(r, sz2, sign);
691
+
free(digits);
692
+
}
693
+
Z_CHECK(r);
694
+
CAMLreturn(r);
695
+
}
696
+
697
+
/* either stores the result in r and returns 0 (no overflow),
698
+
or returns 1 and leave r undefined (overflow)
699
+
*/
700
+
static int ml_to_int(value v, intnat* r)
701
+
{
702
+
Z_DECL(v);
703
+
Z_MARK_OP;
704
+
Z_CHECK(v);
705
+
if (Is_long(v)) { *r = v; return 0; }
706
+
Z_MARK_SLOW;
707
+
Z_ARG(v);
708
+
if (size_v > 1) return 1;
709
+
else if (!size_v) { *r = Val_long(0); return 0; }
710
+
else {
711
+
intnat x = *ptr_v;
712
+
if (sign_v) {
713
+
if ((uintnat)x > Z_HI_INT) return 1;
714
+
*r = Val_long(-x);
715
+
}
716
+
else {
717
+
if ((uintnat)x >= Z_HI_INT) return 1;
718
+
*r = Val_long(x);
719
+
}
720
+
return 0;
721
+
}
722
+
}
723
+
724
+
CAMLprim value ml_z_to_int(value v)
725
+
{
726
+
value x;
727
+
if (ml_to_int(v, &x)) ml_z_raise_overflow();
728
+
return x;
729
+
}
730
+
731
+
CAMLprim value ml_z_fits_int(value v)
732
+
{
733
+
value x;
734
+
if (ml_to_int(v, &x)) return Val_false;
735
+
return Val_true;
736
+
}
737
+
738
+
static int ml_to_nativeint(value v, intnat* r)
739
+
{
740
+
Z_DECL(v);
741
+
Z_MARK_OP;
742
+
Z_CHECK(v);
743
+
if (Is_long(v)) { *r = Long_val(v); return 0; }
744
+
Z_MARK_SLOW;
745
+
Z_ARG(v);
746
+
if (size_v > 1) return 1;
747
+
if (!size_v) { *r = 0; return 0; }
748
+
else {
749
+
intnat x;
750
+
x = *ptr_v;
751
+
if (sign_v) {
752
+
if ((uintnat)x > Z_HI_INTNAT) return 1;
753
+
*r = -x;
754
+
}
755
+
else {
756
+
if ((uintnat)x >= Z_HI_INTNAT) return 1;
757
+
*r = x;
758
+
}
759
+
return 0;
760
+
}
761
+
}
762
+
763
+
CAMLprim value ml_z_to_nativeint(value v)
764
+
{
765
+
intnat x;
766
+
if (ml_to_nativeint(v, &x)) ml_z_raise_overflow();
767
+
return caml_copy_nativeint(x);
768
+
}
769
+
770
+
CAMLprim value ml_z_fits_nativeint(value v)
771
+
{
772
+
intnat x;
773
+
if (ml_to_nativeint(v, &x)) return Val_false;
774
+
return Val_true;
775
+
}
776
+
777
+
static int ml_to_nativeint_unsigned(value v, uintnat* r)
778
+
{
779
+
Z_DECL(v);
780
+
Z_MARK_OP;
781
+
Z_CHECK(v);
782
+
if (Is_long(v)) {
783
+
intnat x = Long_val(v);
784
+
if (x < 0) return 1;
785
+
*r = (uintnat)x;
786
+
return 0;
787
+
}
788
+
Z_MARK_SLOW;
789
+
Z_ARG(v);
790
+
if (!size_v) { *r = 0; return 0; }
791
+
else if (sign_v || size_v > 1) return 1;
792
+
else {
793
+
*r = *ptr_v;
794
+
return 0;
795
+
}
796
+
}
797
+
798
+
CAMLprim value ml_z_to_nativeint_unsigned(value v)
799
+
{
800
+
uintnat x;
801
+
if (ml_to_nativeint_unsigned(v, &x)) ml_z_raise_overflow();
802
+
return caml_copy_nativeint(x);
803
+
}
804
+
805
+
CAMLprim value ml_z_fits_nativeint_unsigned(value v)
806
+
{
807
+
uintnat x;
808
+
if (ml_to_nativeint_unsigned(v, &x)) return Val_false;
809
+
return Val_true;
810
+
}
811
+
812
+
static int ml_to_int32(value v, int32_t* r)
813
+
{
814
+
Z_DECL(v);
815
+
Z_MARK_OP;
816
+
Z_CHECK(v);
817
+
if (Is_long(v)) {
818
+
intnat x = Long_val(v);
819
+
#ifdef ARCH_SIXTYFOUR
820
+
if (x >= (intnat)Z_HI_INT32 || x < -(intnat)Z_HI_INT32)
821
+
return 1;
822
+
#endif
823
+
*r = x;
824
+
return 0;
825
+
}
826
+
else {
827
+
Z_ARG(v);
828
+
Z_MARK_SLOW;
829
+
if (size_v > 1) return 1;
830
+
if (!size_v) { *r = 0; return 0; }
831
+
else {
832
+
uintnat x = *ptr_v;
833
+
if (sign_v) {
834
+
if (x > Z_HI_INT32) return 1;
835
+
*r = -x;
836
+
}
837
+
else {
838
+
if (x >= Z_HI_INT32) return 1;
839
+
*r = x;
840
+
}
841
+
return 0;
842
+
}
843
+
}
844
+
}
845
+
846
+
CAMLprim value ml_z_to_int32(value v)
847
+
{
848
+
int32_t x;
849
+
if (ml_to_int32(v, &x)) ml_z_raise_overflow();
850
+
return caml_copy_int32(x);
851
+
}
852
+
853
+
CAMLprim value ml_z_fits_int32(value v)
854
+
{
855
+
int32_t x;
856
+
if (ml_to_int32(v, &x)) return Val_false;
857
+
return Val_true;
858
+
}
859
+
860
+
static int ml_to_int32_unsigned(value v, uint32_t* r)
861
+
{
862
+
Z_DECL(v);
863
+
Z_MARK_OP;
864
+
Z_CHECK(v);
865
+
if (Is_long(v)) {
866
+
intnat x = Long_val(v);
867
+
#ifdef ARCH_SIXTYFOUR
868
+
if (x < 0 || x >= Z_HI_UINT32)
869
+
#else
870
+
if (x < 0)
871
+
#endif
872
+
return 1;
873
+
*r = x;
874
+
return 0;
875
+
}
876
+
else {
877
+
Z_ARG(v);
878
+
Z_MARK_SLOW;
879
+
if (!size_v) { *r = 0; return 0; }
880
+
else if (sign_v || size_v > 1) return 1;
881
+
else {
882
+
uintnat x = *ptr_v;
883
+
#ifdef ARCH_SIXTYFOUR
884
+
if (x >= Z_HI_UINT32) return 1;
885
+
#endif
886
+
*r = x;
887
+
return 0;
888
+
}
889
+
}
890
+
}
891
+
892
+
CAMLprim value ml_z_to_int32_unsigned(value v)
893
+
{
894
+
uint32_t x;
895
+
if (ml_to_int32_unsigned(v, &x)) ml_z_raise_overflow();
896
+
return caml_copy_int32(x);
897
+
}
898
+
899
+
CAMLprim value ml_z_fits_int32_unsigned(value v)
900
+
{
901
+
uint32_t x;
902
+
if (ml_to_int32_unsigned(v, &x)) return Val_false;
903
+
return Val_true;
904
+
}
905
+
906
+
static int ml_to_int64(value v, int64_t* r)
907
+
{
908
+
int64_t x;
909
+
Z_DECL(v);
910
+
Z_MARK_OP;
911
+
Z_CHECK(v);
912
+
if (Is_long(v)) { *r = Long_val(v); return 0; }
913
+
Z_MARK_SLOW;
914
+
Z_ARG(v);
915
+
switch (size_v) {
916
+
case 0: x = 0; break;
917
+
case 1: x = ptr_v[0]; break;
918
+
#ifndef ARCH_SIXTYFOUR
919
+
case 2: x = ptr_v[0] | ((uint64_t)ptr_v[1] << 32); break;
920
+
#endif
921
+
default: return 1;
922
+
}
923
+
if (sign_v) {
924
+
if ((uint64_t)x > Z_HI_INT64) return 1;
925
+
*r = -x;
926
+
}
927
+
else {
928
+
if ((uint64_t)x >= Z_HI_INT64) return 1;
929
+
*r = x;
930
+
}
931
+
return 0;
932
+
}
933
+
934
+
CAMLprim value ml_z_to_int64(value v)
935
+
{
936
+
int64_t x;
937
+
if (ml_to_int64(v, &x)) ml_z_raise_overflow();
938
+
return caml_copy_int64(x);
939
+
}
940
+
941
+
CAMLprim value ml_z_fits_int64(value v)
942
+
{
943
+
int64_t x;
944
+
if (ml_to_int64(v, &x)) return Val_false;
945
+
return Val_true;
946
+
}
947
+
948
+
static int ml_to_int64_unsigned(value v, uint64_t* r)
949
+
{
950
+
Z_DECL(v);
951
+
Z_MARK_OP;
952
+
Z_CHECK(v);
953
+
if (Is_long(v)) {
954
+
intnat x = Long_val(v);
955
+
if (x < 0) return 1;
956
+
*r = x;
957
+
return 0;
958
+
}
959
+
Z_MARK_SLOW;
960
+
Z_ARG(v);
961
+
if (sign_v) return 1;
962
+
switch (size_v) {
963
+
case 0: *r = 0; return 0;
964
+
case 1: *r = ptr_v[0]; return 0;
965
+
#ifndef ARCH_SIXTYFOUR
966
+
case 2: *r = ptr_v[0] | ((uint64_t) ptr_v[1] << 32); return 0;
967
+
#endif
968
+
default: return 1;
969
+
}
970
+
}
971
+
972
+
CAMLprim value ml_z_to_int64_unsigned(value v)
973
+
{
974
+
uint64_t x;
975
+
if (ml_to_int64_unsigned(v, &x)) ml_z_raise_overflow();
976
+
return caml_copy_int64(x);
977
+
}
978
+
979
+
CAMLprim value ml_z_fits_int64_unsigned(value v)
980
+
{
981
+
uint64_t x;
982
+
if (ml_to_int64_unsigned(v, &x)) return Val_false;
983
+
return Val_true;
984
+
}
985
+
986
+
/* XXX: characters that do not belong to the format are ignored, this departs
987
+
from the classic printf behavior (it copies them in the output)
988
+
*/
989
+
CAMLprim value ml_z_format(value f, value v)
990
+
{
991
+
CAMLparam2(f,v);
992
+
Z_DECL(v);
993
+
const char tab[2][16] =
994
+
{ { '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' },
995
+
{ '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f' } };
996
+
char* buf, *dst;
997
+
mp_size_t i, size_dst, max_size;
998
+
value r;
999
+
const char* fmt = String_val(f);
1000
+
int base = 10; /* base */
1001
+
int cas = 0; /* uppercase X / lowercase x */
1002
+
int width = 0;
1003
+
int alt = 0; /* alternate # */
1004
+
int dir = 0; /* right / left adjusted */
1005
+
char sign = 0; /* sign char */
1006
+
char pad = ' '; /* padding char */
1007
+
char *prefix = "";
1008
+
Z_MARK_OP;
1009
+
Z_CHECK(v);
1010
+
Z_ARG(v);
1011
+
Z_MARK_SLOW;
1012
+
1013
+
/* parse format */
1014
+
while (*fmt == '%') fmt++;
1015
+
for (; ; fmt++) {
1016
+
if (*fmt == '#') alt = 1;
1017
+
else if (*fmt == '0') pad = '0';
1018
+
else if (*fmt == '-') dir = 1;
1019
+
else if (*fmt == ' ' || *fmt == '+') sign = *fmt;
1020
+
else break;
1021
+
}
1022
+
if (sign_v) sign = '-';
1023
+
for (;*fmt>='0' && *fmt<='9';fmt++)
1024
+
width = 10*width + *fmt-'0';
1025
+
switch (*fmt) {
1026
+
case 'i': case 'd': case 'u': break;
1027
+
case 'b': base = 2; if (alt) prefix = "0b"; break;
1028
+
case 'o': base = 8; if (alt) prefix = "0o"; break;
1029
+
case 'x': base = 16; if (alt) prefix = "0x"; cas = 1; break;
1030
+
case 'X': base = 16; if (alt) prefix = "0X"; break;
1031
+
default: caml_invalid_argument("Z.format: invalid format");
1032
+
}
1033
+
if (dir) pad = ' ';
1034
+
/* get digits */
1035
+
/* we need space for sign + prefix + digits + 1 + padding + terminal 0 */
1036
+
max_size = 1 + 2 + Z_LIMB_BITS * size_v + 1 + 2 * width + 1;
1037
+
buf = (char*) malloc(max_size);
1038
+
dst = buf + 1 + 2 + width;
1039
+
if (!size_v) {
1040
+
size_dst = 1;
1041
+
*dst = '0';
1042
+
}
1043
+
else {
1044
+
mp_limb_t* copy_v = ml_z_dup_limb(ptr_v, size_v);
1045
+
size_dst = mpn_get_str((unsigned char*)dst, base, copy_v, size_v);
1046
+
if (dst + size_dst >= buf + max_size)
1047
+
caml_failwith("Z.format: internal error");
1048
+
free(copy_v);
1049
+
while (size_dst && !*dst) { dst++; size_dst--; }
1050
+
for (i = 0; i < size_dst; i++)
1051
+
dst[i] = tab[cas][ (int) dst[i] ];
1052
+
}
1053
+
/* add prefix, sign & padding */
1054
+
if (pad == ' ') {
1055
+
if (dir) {
1056
+
/* left alignment */
1057
+
for (i = strlen(prefix); i > 0; i--, size_dst++)
1058
+
*(--dst) = prefix[i-1];
1059
+
if (sign) { *(--dst) = sign; size_dst++; }
1060
+
for (; size_dst < width; size_dst++)
1061
+
dst[size_dst] = pad;
1062
+
}
1063
+
else {
1064
+
/* right alignment, space padding */
1065
+
for (i = strlen(prefix); i > 0; i--, size_dst++)
1066
+
*(--dst) = prefix[i-1];
1067
+
if (sign) { *(--dst) = sign; size_dst++; }
1068
+
for (; size_dst < width; size_dst++) *(--dst) = pad;
1069
+
}
1070
+
}
1071
+
else {
1072
+
/* right alignment, non-space padding */
1073
+
width -= strlen(prefix) + (sign ? 1 : 0);
1074
+
for (; size_dst < width; size_dst++) *(--dst) = pad;
1075
+
for (i = strlen(prefix); i > 0; i--, size_dst++)
1076
+
*(--dst) = prefix[i-1];
1077
+
if (sign) { *(--dst) = sign; size_dst++; }
1078
+
}
1079
+
dst[size_dst] = 0;
1080
+
if (dst < buf || dst + size_dst >= buf + max_size)
1081
+
caml_failwith("Z.format: internal error");
1082
+
r = caml_copy_string(dst);
1083
+
free(buf);
1084
+
CAMLreturn(r);
1085
+
}
1086
+
1087
+
/* Fast path since len < BITS_PER_WORD */
1088
+
CAMLprim value ml_z_extract_small(value arg, value off, value len)
1089
+
{
1090
+
Z_DECL(arg);
1091
+
uintnat o, l; /* caml code ensures off and len are non signed */
1092
+
intnat x;
1093
+
mp_size_t c1, c2, csz, i;
1094
+
mp_limb_t cr;
1095
+
Z_ARG(arg);
1096
+
o = (uintnat)Long_val(off);
1097
+
l = (uintnat)Long_val(len);
1098
+
c1 = o / Z_LIMB_BITS;
1099
+
c2 = o % Z_LIMB_BITS;
1100
+
csz = size_arg - c1;
1101
+
if (csz > 0) {
1102
+
if (c2) {
1103
+
x = ptr_arg[c1] >> c2;
1104
+
if ((c2 + l > (intnat)Z_LIMB_BITS) && (csz > 1))
1105
+
x |= (ptr_arg[c1 + 1] << (Z_LIMB_BITS - c2));
1106
+
}
1107
+
else x = ptr_arg[c1];
1108
+
}
1109
+
else x = 0;
1110
+
if (sign_arg) {
1111
+
x = ~x;
1112
+
if (csz > 0) {
1113
+
/* carry (cr=0 if all shifted-out bits are 0) */
1114
+
cr = ptr_arg[c1] & (((intnat)1 << c2) - 1);
1115
+
for (i = 0; !cr && i < c1; i++)
1116
+
cr = ptr_arg[i];
1117
+
if (!cr) x ++;
1118
+
}
1119
+
}
1120
+
x &= ((intnat)1 << l) - 1;
1121
+
return Val_long(x);
1122
+
}
1123
+
1124
+
CAMLprim value ml_z_extract(value arg, value off, value len)
1125
+
{
1126
+
uintnat o, l; /* caml code ensures off and len are non signed */
1127
+
intnat x;
1128
+
mp_size_t sz, c1, c2, csz, i;
1129
+
mp_limb_t cr;
1130
+
value r;
1131
+
Z_DECL(arg);
1132
+
Z_MARK_OP;
1133
+
MAYBE_UNUSED x;
1134
+
o = (uintnat)Long_val(off);
1135
+
l = (uintnat)Long_val(len);
1136
+
Z_MARK_SLOW;
1137
+
{
1138
+
CAMLparam1(arg);
1139
+
Z_ARG(arg);
1140
+
sz = (l + Z_LIMB_BITS - 1) / Z_LIMB_BITS;
1141
+
r = ml_z_alloc(sz + 1);
1142
+
Z_REFRESH(arg);
1143
+
c1 = o / Z_LIMB_BITS;
1144
+
c2 = o % Z_LIMB_BITS;
1145
+
/* shift or copy */
1146
+
csz = size_arg - c1;
1147
+
if (csz > sz + 1) csz = sz + 1;
1148
+
cr = 0;
1149
+
if (csz > 0) {
1150
+
if (c2) cr = mpn_rshift(Z_LIMB(r), ptr_arg + c1, csz, c2);
1151
+
else ml_z_cpy_limb(Z_LIMB(r), ptr_arg + c1, csz);
1152
+
}
1153
+
else csz = 0;
1154
+
/* 0-pad */
1155
+
for (i = csz; i < sz; i++)
1156
+
Z_LIMB(r)[i] = 0;
1157
+
/* 2's complement */
1158
+
if (sign_arg) {
1159
+
for (i = 0; i < sz; i++)
1160
+
Z_LIMB(r)[i] = ~Z_LIMB(r)[i];
1161
+
/* carry (cr=0 if all shifted-out bits are 0) */
1162
+
for (i = 0; !cr && i < c1 && i < size_arg; i++)
1163
+
cr = ptr_arg[i];
1164
+
if (!cr) mpn_add_1(Z_LIMB(r), Z_LIMB(r), sz, 1);
1165
+
}
1166
+
/* mask out high bits */
1167
+
l %= Z_LIMB_BITS;
1168
+
if (l) Z_LIMB(r)[sz-1] &= ((uintnat)(intnat)-1) >> (Z_LIMB_BITS - l);
1169
+
r = ml_z_reduce(r, sz, 0);
1170
+
CAMLreturn(r);
1171
+
}
1172
+
}
1173
+
1174
+
/* NOTE: the sign is not stored */
1175
+
CAMLprim value ml_z_to_bits(value arg)
1176
+
{
1177
+
CAMLparam1(arg);
1178
+
CAMLlocal1(r);
1179
+
Z_DECL(arg);
1180
+
mp_size_t i;
1181
+
unsigned char* p;
1182
+
Z_MARK_OP;
1183
+
Z_MARK_SLOW;
1184
+
Z_ARG(arg);
1185
+
r = caml_alloc_string(size_arg * sizeof(mp_limb_t));
1186
+
Z_REFRESH(arg);
1187
+
p = (unsigned char*) String_val(r);
1188
+
memset(p, 0, size_arg * sizeof(mp_limb_t));
1189
+
for (i = 0; i < size_arg; i++) {
1190
+
mp_limb_t x = ptr_arg[i];
1191
+
*(p++) = x;
1192
+
*(p++) = x >> 8;
1193
+
*(p++) = x >> 16;
1194
+
*(p++) = x >> 24;
1195
+
#ifdef ARCH_SIXTYFOUR
1196
+
*(p++) = x >> 32;
1197
+
*(p++) = x >> 40;
1198
+
*(p++) = x >> 48;
1199
+
*(p++) = x >> 56;
1200
+
#endif
1201
+
}
1202
+
CAMLreturn(r);
1203
+
}
1204
+
1205
+
CAMLprim value ml_z_of_bits(value arg)
1206
+
{
1207
+
CAMLparam1(arg);
1208
+
CAMLlocal1(r);
1209
+
mp_size_t sz, szw;
1210
+
mp_size_t i = 0;
1211
+
mp_limb_t x;
1212
+
const unsigned char* p;
1213
+
Z_MARK_OP;
1214
+
Z_MARK_SLOW;
1215
+
sz = caml_string_length(arg);
1216
+
szw = (sz + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t);
1217
+
r = ml_z_alloc(szw);
1218
+
p = (const unsigned char*) String_val(arg);
1219
+
/* all limbs but last */
1220
+
if (szw > 1) {
1221
+
for (; i < szw - 1; i++) {
1222
+
x = *(p++);
1223
+
x |= ((mp_limb_t) *(p++)) << 8;
1224
+
x |= ((mp_limb_t) *(p++)) << 16;
1225
+
x |= ((mp_limb_t) *(p++)) << 24;
1226
+
#ifdef ARCH_SIXTYFOUR
1227
+
x |= ((mp_limb_t) *(p++)) << 32;
1228
+
x |= ((mp_limb_t) *(p++)) << 40;
1229
+
x |= ((mp_limb_t) *(p++)) << 48;
1230
+
x |= ((mp_limb_t) *(p++)) << 56;
1231
+
#endif
1232
+
Z_LIMB(r)[i] = x;
1233
+
}
1234
+
sz -= i * sizeof(mp_limb_t);
1235
+
}
1236
+
/* last limb */
1237
+
if (sz > 0) {
1238
+
x = *(p++);
1239
+
if (sz > 1) x |= ((mp_limb_t) *(p++)) << 8;
1240
+
if (sz > 2) x |= ((mp_limb_t) *(p++)) << 16;
1241
+
if (sz > 3) x |= ((mp_limb_t) *(p++)) << 24;
1242
+
#ifdef ARCH_SIXTYFOUR
1243
+
if (sz > 4) x |= ((mp_limb_t) *(p++)) << 32;
1244
+
if (sz > 5) x |= ((mp_limb_t) *(p++)) << 40;
1245
+
if (sz > 6) x |= ((mp_limb_t) *(p++)) << 48;
1246
+
if (sz > 7) x |= ((mp_limb_t) *(p++)) << 56;
1247
+
#endif
1248
+
Z_LIMB(r)[i] = x;
1249
+
}
1250
+
r = ml_z_reduce(r, szw, 0);
1251
+
Z_CHECK(r);
1252
+
CAMLreturn(r);
1253
+
}
1254
+
1255
+
/*---------------------------------------------------
1256
+
TESTS AND COMPARISONS
1257
+
---------------------------------------------------*/
1258
+
1259
+
CAMLprim value ml_z_compare(value arg1, value arg2)
1260
+
{
1261
+
int r;
1262
+
Z_DECL(arg1); Z_DECL(arg2);
1263
+
Z_MARK_OP;
1264
+
Z_CHECK(arg1); Z_CHECK(arg2);
1265
+
#if Z_FAST_PATH
1266
+
/* Value-equal small integers are equal.
1267
+
Pointer-equal big integers are equal as well. */
1268
+
if (arg1 == arg2) return Val_long(0);
1269
+
if (Is_long(arg2)) {
1270
+
if (Is_long(arg1)) {
1271
+
return arg1 > arg2 ? Val_long(1) : Val_long(-1);
1272
+
} else {
1273
+
/* Either arg1 is positive and arg1 > Z_MAX_INT >= arg2 -> result +1
1274
+
or arg1 is negative and arg1 < Z_MIN_INT <= arg2 -> result -1 */
1275
+
return Z_SIGN(arg1) ? Val_long(-1) : Val_long(1);
1276
+
}
1277
+
}
1278
+
else if (Is_long(arg1)) {
1279
+
/* Either arg2 is positive and arg2 > Z_MAX_INT >= arg1 -> result -1
1280
+
or arg2 is negative and arg2 < Z_MIN_INT <= arg1 -> result +1 */
1281
+
return Z_SIGN(arg2) ? Val_long(1) : Val_long(-1);
1282
+
}
1283
+
#endif
1284
+
/* mpn_ version */
1285
+
Z_MARK_SLOW;
1286
+
Z_ARG(arg1);
1287
+
Z_ARG(arg2);
1288
+
r = 0;
1289
+
if (sign_arg1 != sign_arg2) r = 1;
1290
+
else if (size_arg1 > size_arg2) r = 1;
1291
+
else if (size_arg1 < size_arg2) r = -1;
1292
+
else {
1293
+
mp_size_t i;
1294
+
for (i = size_arg1 - 1; i >= 0; i--) {
1295
+
if (ptr_arg1[i] > ptr_arg2[i]) { r = 1; break; }
1296
+
if (ptr_arg1[i] < ptr_arg2[i]) { r = -1; break; }
1297
+
}
1298
+
}
1299
+
if (sign_arg1) r = -r;
1300
+
return Val_long(r);
1301
+
}
1302
+
1303
+
CAMLprim value ml_z_equal(value arg1, value arg2)
1304
+
{
1305
+
mp_size_t i;
1306
+
Z_DECL(arg1); Z_DECL(arg2);
1307
+
Z_MARK_OP;
1308
+
Z_CHECK(arg1); Z_CHECK(arg2);
1309
+
#if Z_FAST_PATH
1310
+
/* Value-equal small integers are equal.
1311
+
Pointer-equal big integers are equal as well. */
1312
+
if (arg1 == arg2) return Val_true;
1313
+
/* If both arg1 and arg2 are small integers but failed the equality
1314
+
test above, they are different.
1315
+
If one of arg1/arg2 is a small integer and the other is a big integer,
1316
+
they are different: one is in the range [Z_MIN_INT,Z_MAX_INT]
1317
+
and the other is outside this range. */
1318
+
if (Is_long(arg2) || Is_long(arg1)) return Val_false;
1319
+
#endif
1320
+
/* mpn_ version */
1321
+
Z_MARK_SLOW;
1322
+
Z_ARG(arg1);
1323
+
Z_ARG(arg2);
1324
+
if (sign_arg1 != sign_arg2 || size_arg1 != size_arg2) return Val_false;
1325
+
for (i = 0; i < size_arg1; i++)
1326
+
if (ptr_arg1[i] != ptr_arg2[i]) return Val_false;
1327
+
return Val_true;
1328
+
}
1329
+
1330
+
int ml_z_sgn(value arg)
1331
+
{
1332
+
if (Is_long(arg)) {
1333
+
if (arg > Val_long(0)) return 1;
1334
+
else if (arg < Val_long(0)) return -1;
1335
+
else return 0;
1336
+
}
1337
+
else {
1338
+
Z_MARK_SLOW;
1339
+
#if !Z_USE_NATINT
1340
+
/* In "use natint" mode, zero is a small integer, treated above */
1341
+
if (!Z_SIZE(arg)) return 0;
1342
+
#endif
1343
+
if (Z_SIGN(arg)) return -1; else return 1;
1344
+
}
1345
+
}
1346
+
CAMLprim value ml_z_sign(value arg)
1347
+
{
1348
+
Z_MARK_OP;
1349
+
Z_CHECK(arg);
1350
+
return Val_long(ml_z_sgn(arg));
1351
+
}
1352
+
1353
+
CAMLprim value ml_z_size(value v)
1354
+
{
1355
+
Z_MARK_OP;
1356
+
if (Is_long(v)) return Val_long(1);
1357
+
else return Val_long(Z_SIZE(v));
1358
+
}
1359
+
1360
+
1361
+
/*---------------------------------------------------
1362
+
ARITHMETIC OPERATORS
1363
+
---------------------------------------------------*/
1364
+
1365
+
CAMLprim value ml_z_neg(value arg)
1366
+
{
1367
+
Z_MARK_OP;
1368
+
Z_CHECK(arg);
1369
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1370
+
if (Is_long(arg)) {
1371
+
/* fast path */
1372
+
if (arg > Val_long(Z_MIN_INT)) return 2 - arg;
1373
+
}
1374
+
#endif
1375
+
/* mpn_ version */
1376
+
Z_MARK_SLOW;
1377
+
{
1378
+
CAMLparam1(arg);
1379
+
value r;
1380
+
Z_DECL(arg);
1381
+
Z_ARG(arg);
1382
+
r = ml_z_alloc(size_arg);
1383
+
Z_REFRESH(arg);
1384
+
ml_z_cpy_limb(Z_LIMB(r), ptr_arg, size_arg);
1385
+
r = ml_z_reduce(r, size_arg, sign_arg ^ Z_SIGN_MASK);
1386
+
Z_CHECK(r);
1387
+
CAMLreturn(r);
1388
+
}
1389
+
}
1390
+
1391
+
CAMLprim value ml_z_abs(value arg)
1392
+
{
1393
+
Z_MARK_OP;
1394
+
Z_CHECK(arg);
1395
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1396
+
if (Is_long(arg)) {
1397
+
/* fast path */
1398
+
if (arg >= Val_long(0)) return arg;
1399
+
if (arg > Val_long(Z_MIN_INT)) return 2 - arg;
1400
+
}
1401
+
#endif
1402
+
/* mpn_ version */
1403
+
Z_MARK_SLOW;
1404
+
{
1405
+
CAMLparam1(arg);
1406
+
Z_DECL(arg);
1407
+
value r;
1408
+
Z_ARG(arg);
1409
+
if (sign_arg) {
1410
+
r = ml_z_alloc(size_arg);
1411
+
Z_REFRESH(arg);
1412
+
ml_z_cpy_limb(Z_LIMB(r), ptr_arg, size_arg);
1413
+
r = ml_z_reduce(r, size_arg, 0);
1414
+
Z_CHECK(r);
1415
+
}
1416
+
else r = arg;
1417
+
CAMLreturn(r);
1418
+
}
1419
+
}
1420
+
1421
+
/* helper function for add/sub */
1422
+
static value ml_z_addsub(value arg1, value arg2, intnat sign)
1423
+
{
1424
+
CAMLparam2(arg1,arg2);
1425
+
Z_DECL(arg1); Z_DECL(arg2);
1426
+
value r;
1427
+
mp_limb_t c;
1428
+
Z_ARG(arg1);
1429
+
Z_ARG(arg2);
1430
+
sign_arg2 ^= sign;
1431
+
if (!size_arg2) r = arg1;
1432
+
else if (!size_arg1) {
1433
+
if (sign) {
1434
+
/* negation */
1435
+
r = ml_z_alloc(size_arg2);
1436
+
Z_REFRESH(arg2);
1437
+
ml_z_cpy_limb(Z_LIMB(r), ptr_arg2, size_arg2);
1438
+
r = ml_z_reduce(r, size_arg2, sign_arg2);
1439
+
}
1440
+
else r = arg2;
1441
+
}
1442
+
else if (sign_arg1 == sign_arg2) {
1443
+
/* addition */
1444
+
if (size_arg1 >= size_arg2) {
1445
+
r = ml_z_alloc(size_arg1 + 1);
1446
+
Z_REFRESH(arg1);
1447
+
Z_REFRESH(arg2);
1448
+
c = mpn_add(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2, size_arg2);
1449
+
Z_LIMB(r)[size_arg1] = c;
1450
+
r = ml_z_reduce(r, size_arg1+1, sign_arg1);
1451
+
}
1452
+
else {
1453
+
r = ml_z_alloc(size_arg2 + 1);
1454
+
Z_REFRESH(arg1);
1455
+
Z_REFRESH(arg2);
1456
+
c = mpn_add(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1, size_arg1);
1457
+
Z_LIMB(r)[size_arg2] = c;
1458
+
r = ml_z_reduce(r, size_arg2+1, sign_arg1);
1459
+
}
1460
+
}
1461
+
else {
1462
+
/* subtraction */
1463
+
if (size_arg1 > size_arg2) {
1464
+
r = ml_z_alloc(size_arg1);
1465
+
Z_REFRESH(arg1);
1466
+
Z_REFRESH(arg2);
1467
+
mpn_sub(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2, size_arg2);
1468
+
r = ml_z_reduce(r, size_arg1, sign_arg1);
1469
+
}
1470
+
else if (size_arg1 < size_arg2) {
1471
+
r = ml_z_alloc(size_arg2);
1472
+
Z_REFRESH(arg1);
1473
+
Z_REFRESH(arg2);
1474
+
mpn_sub(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1, size_arg1);
1475
+
r = ml_z_reduce(r, size_arg2, sign_arg2);
1476
+
}
1477
+
else {
1478
+
int cmp = mpn_cmp(ptr_arg1, ptr_arg2, size_arg1);
1479
+
if (cmp > 0) {
1480
+
r = ml_z_alloc(size_arg1+1);
1481
+
Z_REFRESH(arg1);
1482
+
Z_REFRESH(arg2);
1483
+
mpn_sub_n(Z_LIMB(r), ptr_arg1, ptr_arg2, size_arg1);
1484
+
r = ml_z_reduce(r, size_arg1, sign_arg1);
1485
+
}
1486
+
else if (cmp < 0) {
1487
+
r = ml_z_alloc(size_arg1);
1488
+
Z_REFRESH(arg1);
1489
+
Z_REFRESH(arg2);
1490
+
mpn_sub_n(Z_LIMB(r), ptr_arg2, ptr_arg1, size_arg1);
1491
+
r = ml_z_reduce(r, size_arg1, sign_arg2);
1492
+
}
1493
+
else r = Val_long(0);
1494
+
}
1495
+
}
1496
+
Z_CHECK(r);
1497
+
CAMLreturn(r);
1498
+
}
1499
+
1500
+
CAMLprim value ml_z_add(value arg1, value arg2)
1501
+
{
1502
+
Z_MARK_OP;
1503
+
Z_CHECK(arg1); Z_CHECK(arg2);
1504
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1505
+
if (Is_long(arg1) && Is_long(arg2)) {
1506
+
/* fast path */
1507
+
intnat a1 = Long_val(arg1);
1508
+
intnat a2 = Long_val(arg2);
1509
+
intnat v = a1 + a2;
1510
+
if (Z_FITS_INT(v)) return Val_long(v);
1511
+
}
1512
+
#endif
1513
+
/* mpn_ version */
1514
+
Z_MARK_SLOW;
1515
+
return ml_z_addsub(arg1, arg2, 0);
1516
+
}
1517
+
1518
+
CAMLprim value ml_z_sub(value arg1, value arg2)
1519
+
{
1520
+
Z_MARK_OP;
1521
+
Z_CHECK(arg1); Z_CHECK(arg2);
1522
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1523
+
if (Is_long(arg1) && Is_long(arg2)) {
1524
+
/* fast path */
1525
+
intnat a1 = Long_val(arg1);
1526
+
intnat a2 = Long_val(arg2);
1527
+
intnat v = a1 - a2;
1528
+
if (Z_FITS_INT(v)) return Val_long(v);
1529
+
}
1530
+
#endif
1531
+
/* mpn_ version */
1532
+
Z_MARK_SLOW;
1533
+
return ml_z_addsub(arg1, arg2, Z_SIGN_MASK);
1534
+
}
1535
+
1536
+
CAMLprim value ml_z_mul_overflows(value vx, value vy)
1537
+
{
1538
+
#if HAS_BUILTIN(__builtin_mul_overflow) || __GNUC__ >= 5
1539
+
intnat z;
1540
+
return Val_bool(__builtin_mul_overflow(vx - 1, vy >> 1, &z));
1541
+
#elif defined(__GNUC__) && defined(__x86_64__)
1542
+
intnat z;
1543
+
unsigned char o;
1544
+
asm("imulq %1, %3; seto %0"
1545
+
: "=q" (o), "=r" (z)
1546
+
: "1" (vx - 1), "r" (vy >> 1)
1547
+
: "cc");
1548
+
return Val_int(o);
1549
+
#elif defined(_MSC_VER) && defined(_M_X64)
1550
+
intnat hi, lo;
1551
+
lo = _mul128(vx - 1, vy >> 1, &hi);
1552
+
return Val_bool(hi != lo >> 63);
1553
+
#else
1554
+
/* Portable C code */
1555
+
intnat x = Long_val(vx);
1556
+
intnat y = Long_val(vy);
1557
+
/* Quick approximate check for small values of x and y.
1558
+
Also catches the cases x = 0, x = 1, y = 0, y = 1. */
1559
+
if (Z_FITS_HINT(x)) {
1560
+
if (Z_FITS_HINT(y)) return Val_false;
1561
+
if ((uintnat) x <= 1) return Val_false;
1562
+
}
1563
+
if ((uintnat) y <= 1) return Val_false;
1564
+
#if 1
1565
+
/* Give up at this point; we'll go through the general case in ml_z_mul */
1566
+
return Val_true;
1567
+
#else
1568
+
/* The product x*y is representable as an unboxed integer if
1569
+
it is in [Z_MIN_INT, Z_MAX_INT].
1570
+
x >= 0 y >= 0: x*y >= 0 and x*y <= Z_MAX_INT <-> y <= Z_MAX_INT / x
1571
+
x < 0 y >= 0: x*y <= 0 and x*y >= Z_MIN_INT <-> x >= Z_MIN_INT / y
1572
+
x >= 0 y < 0 : x*y <= 0 and x*y >= Z_MIN_INT <-> y >= Z_MIN_INT / x
1573
+
x < 0 y < 0 : x*y >= 0 and x*y <= Z_MAX_INT <-> x >= Z_MAX_INT / y */
1574
+
if (x >= 0)
1575
+
if (y >= 0)
1576
+
return Val_bool(y > Z_MAX_INT / x);
1577
+
else
1578
+
return Val_bool(y < Z_MIN_INT / x);
1579
+
else
1580
+
if (y >= 0)
1581
+
return Val_bool(x < Z_MIN_INT / y);
1582
+
else
1583
+
return Val_bool(x < Z_MAX_INT / y);
1584
+
#endif
1585
+
#endif
1586
+
}
1587
+
1588
+
CAMLprim value ml_z_mul(value arg1, value arg2)
1589
+
{
1590
+
Z_DECL(arg1); Z_DECL(arg2);
1591
+
Z_MARK_OP;
1592
+
Z_CHECK(arg1); Z_CHECK(arg2);
1593
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1594
+
if (Is_long(arg1) && Is_long(arg2) &&
1595
+
ml_z_mul_overflows(arg1, arg2) == Val_false) {
1596
+
return Val_long(Long_val(arg1) * Long_val(arg2));
1597
+
}
1598
+
#endif
1599
+
/* mpn_ version */
1600
+
Z_MARK_SLOW;
1601
+
Z_ARG(arg1);
1602
+
Z_ARG(arg2);
1603
+
if (!size_arg1 || !size_arg2) return Val_long(0);
1604
+
{
1605
+
CAMLparam2(arg1,arg2);
1606
+
value r = ml_z_alloc(size_arg1 + size_arg2);
1607
+
mp_limb_t c;
1608
+
Z_REFRESH(arg1);
1609
+
Z_REFRESH(arg2);
1610
+
if (size_arg2 == 1) {
1611
+
c = mpn_mul_1(Z_LIMB(r), ptr_arg1, size_arg1, *ptr_arg2);
1612
+
Z_LIMB(r)[size_arg1] = c;
1613
+
}
1614
+
else if (size_arg1 == 1) {
1615
+
c = mpn_mul_1(Z_LIMB(r), ptr_arg2, size_arg2, *ptr_arg1);
1616
+
Z_LIMB(r)[size_arg2] = c;
1617
+
}
1618
+
#if HAVE_NATIVE_mpn_mul_2 /* untested */
1619
+
else if (size_arg2 == 2) {
1620
+
c = mpn_mul_2(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2);
1621
+
Z_LIMB(r)[size_arg1 + 1] = c;
1622
+
}
1623
+
else if (size_arg1 == 2) {
1624
+
c = mpn_mul_2(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1);
1625
+
Z_LIMB(r)[size_arg2 + 1] = c;
1626
+
}
1627
+
#endif
1628
+
else if (size_arg1 > size_arg2)
1629
+
mpn_mul(Z_LIMB(r), ptr_arg1, size_arg1, ptr_arg2, size_arg2);
1630
+
else if (size_arg1 < size_arg2)
1631
+
mpn_mul(Z_LIMB(r), ptr_arg2, size_arg2, ptr_arg1, size_arg1);
1632
+
/* older GMP don't have mpn_sqr, so we make the optimisation optional */
1633
+
#ifdef mpn_sqr
1634
+
else if (ptr_arg1 == ptr_arg2)
1635
+
mpn_sqr(Z_LIMB(r), ptr_arg1, size_arg1);
1636
+
#endif
1637
+
else
1638
+
mpn_mul_n(Z_LIMB(r), ptr_arg1, ptr_arg2, size_arg1);
1639
+
r = ml_z_reduce(r, size_arg1 + size_arg2, sign_arg1^sign_arg2);
1640
+
Z_CHECK(r);
1641
+
CAMLreturn(r);
1642
+
}
1643
+
}
1644
+
1645
+
/* helper function for division: returns truncated quotient and remainder */
1646
+
static value ml_z_tdiv_qr(value arg1, value arg2)
1647
+
{
1648
+
CAMLparam2(arg1, arg2);
1649
+
CAMLlocal3(q, r, p);
1650
+
Z_DECL(arg1); Z_DECL(arg2);
1651
+
Z_ARG(arg1); Z_ARG(arg2);
1652
+
if (!size_arg2) ml_z_raise_divide_by_zero();
1653
+
if (size_arg1 >= size_arg2) {
1654
+
q = ml_z_alloc(size_arg1 - size_arg2 + 1);
1655
+
r = ml_z_alloc(size_arg2);
1656
+
Z_REFRESH(arg1); Z_REFRESH(arg2);
1657
+
mpn_tdiv_qr(Z_LIMB(q), Z_LIMB(r), 0,
1658
+
ptr_arg1, size_arg1, ptr_arg2, size_arg2);
1659
+
q = ml_z_reduce(q, size_arg1 - size_arg2 + 1, sign_arg1 ^ sign_arg2);
1660
+
r = ml_z_reduce(r, size_arg2, sign_arg1);
1661
+
}
1662
+
else {
1663
+
q = Val_long(0);
1664
+
r = arg1;
1665
+
}
1666
+
Z_CHECK(q);
1667
+
Z_CHECK(r);
1668
+
p = caml_alloc_small(2, 0);
1669
+
Field(p,0) = q;
1670
+
Field(p,1) = r;
1671
+
CAMLreturn(p);
1672
+
}
1673
+
1674
+
CAMLprim value ml_z_div_rem(value arg1, value arg2)
1675
+
{
1676
+
Z_MARK_OP;
1677
+
Z_CHECK(arg1); Z_CHECK(arg2);
1678
+
#if Z_FAST_PATH
1679
+
if (Is_long(arg1) && Is_long(arg2)) {
1680
+
/* fast path */
1681
+
intnat a1 = Long_val(arg1);
1682
+
intnat a2 = Long_val(arg2);
1683
+
intnat q, r;
1684
+
if (!a2) ml_z_raise_divide_by_zero();
1685
+
q = a1 / a2;
1686
+
r = a1 % a2;
1687
+
if (Z_FITS_INT(q) && Z_FITS_INT(r)) {
1688
+
value p = caml_alloc_small(2, 0);
1689
+
Field(p,0) = Val_long(q);
1690
+
Field(p,1) = Val_long(r);
1691
+
return p;
1692
+
}
1693
+
}
1694
+
#endif
1695
+
/* mpn_ version */
1696
+
Z_MARK_SLOW;
1697
+
return ml_z_tdiv_qr(arg1, arg2);
1698
+
}
1699
+
1700
+
CAMLprim value ml_z_div(value arg1, value arg2)
1701
+
{
1702
+
Z_MARK_OP;
1703
+
Z_CHECK(arg1); Z_CHECK(arg2);
1704
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1705
+
if (Is_long(arg1) && Is_long(arg2)) {
1706
+
/* fast path */
1707
+
intnat a1 = Long_val(arg1);
1708
+
intnat a2 = Long_val(arg2);
1709
+
intnat q;
1710
+
if (!a2) ml_z_raise_divide_by_zero();
1711
+
q = a1 / a2;
1712
+
if (Z_FITS_INT(q)) return Val_long(q);
1713
+
}
1714
+
#endif
1715
+
/* mpn_ version */
1716
+
Z_MARK_SLOW;
1717
+
return Field(ml_z_tdiv_qr(arg1, arg2), 0);
1718
+
}
1719
+
1720
+
CAMLprim value ml_z_rem(value arg1, value arg2)
1721
+
{
1722
+
Z_MARK_OP;
1723
+
Z_CHECK(arg1); Z_CHECK(arg2);
1724
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1725
+
if (Is_long(arg1) && Is_long(arg2)) {
1726
+
/* fast path */
1727
+
intnat a1 = Long_val(arg1);
1728
+
intnat a2 = Long_val(arg2);
1729
+
intnat r;
1730
+
if (!a2) ml_z_raise_divide_by_zero();
1731
+
r = a1 % a2;
1732
+
if (Z_FITS_INT(r)) return Val_long(r);
1733
+
}
1734
+
#endif
1735
+
/* mpn_ version */
1736
+
Z_MARK_SLOW;
1737
+
return Field(ml_z_tdiv_qr(arg1, arg2), 1);
1738
+
}
1739
+
1740
+
/* helper function for division with rounding towards +oo / -oo */
1741
+
static value ml_z_rdiv(value arg1, value arg2, intnat dir)
1742
+
{
1743
+
CAMLparam2(arg1, arg2);
1744
+
CAMLlocal2(q, r);
1745
+
Z_DECL(arg1); Z_DECL(arg2);
1746
+
Z_ARG(arg1); Z_ARG(arg2);
1747
+
if (!size_arg2) ml_z_raise_divide_by_zero();
1748
+
if (size_arg1 >= size_arg2) {
1749
+
mp_limb_t c = 0;
1750
+
q = ml_z_alloc(size_arg1 - size_arg2 + 2);
1751
+
r = ml_z_alloc(size_arg2);
1752
+
Z_REFRESH(arg1); Z_REFRESH(arg2);
1753
+
mpn_tdiv_qr(Z_LIMB(q), Z_LIMB(r), 0,
1754
+
ptr_arg1, size_arg1, ptr_arg2, size_arg2);
1755
+
if ((sign_arg1 ^ sign_arg2) == dir) {
1756
+
/* outward rounding */
1757
+
mp_size_t sz;
1758
+
for (sz = size_arg2; sz > 0 && !Z_LIMB(r)[sz-1]; sz--);
1759
+
if (sz) {
1760
+
/* r != 0: needs adjustment */
1761
+
c = mpn_add_1(Z_LIMB(q), Z_LIMB(q), size_arg1 - size_arg2 + 1, 1);
1762
+
}
1763
+
}
1764
+
Z_LIMB(q)[size_arg1 - size_arg2 + 1] = c;
1765
+
q = ml_z_reduce(q, size_arg1 - size_arg2 + 2, sign_arg1 ^ sign_arg2);
1766
+
}
1767
+
else {
1768
+
if (size_arg1 && (sign_arg1 ^ sign_arg2) == dir) {
1769
+
if (dir) q = Val_long(-1);
1770
+
else q = Val_long(1);
1771
+
}
1772
+
else q = Val_long(0);
1773
+
}
1774
+
Z_CHECK(q);
1775
+
CAMLreturn(q);
1776
+
}
1777
+
1778
+
CAMLprim value ml_z_cdiv(value arg1, value arg2)
1779
+
{
1780
+
Z_MARK_OP;
1781
+
Z_CHECK(arg1); Z_CHECK(arg2);
1782
+
#if Z_FAST_PATH
1783
+
if (Is_long(arg1) && Is_long(arg2)) {
1784
+
/* fast path */
1785
+
intnat a1 = Long_val(arg1);
1786
+
intnat a2 = Long_val(arg2);
1787
+
intnat q;
1788
+
if (!a2) ml_z_raise_divide_by_zero();
1789
+
/* adjust to round towards +oo */
1790
+
if (a1 > 0 && a2 > 0) a1 += a2-1;
1791
+
else if (a1 < 0 && a2 < 0) a1 += a2+1;
1792
+
q = a1 / a2;
1793
+
if (Z_FITS_INT(q)) return Val_long(q);
1794
+
}
1795
+
#endif
1796
+
/* mpn_ version */
1797
+
Z_MARK_SLOW;
1798
+
return ml_z_rdiv(arg1, arg2, 0);
1799
+
}
1800
+
1801
+
CAMLprim value ml_z_fdiv(value arg1, value arg2)
1802
+
{
1803
+
Z_MARK_OP;
1804
+
Z_CHECK(arg1); Z_CHECK(arg2);
1805
+
#if Z_FAST_PATH
1806
+
if (Is_long(arg1) && Is_long(arg2)) {
1807
+
/* fast path */
1808
+
intnat a1 = Long_val(arg1);
1809
+
intnat a2 = Long_val(arg2);
1810
+
intnat q;
1811
+
if (!a2) ml_z_raise_divide_by_zero();
1812
+
/* adjust to round towards -oo */
1813
+
if (a1 < 0 && a2 > 0) a1 -= a2-1;
1814
+
else if (a1 > 0 && a2 < 0) a1 -= a2+1;
1815
+
q = a1 / a2;
1816
+
if (Z_FITS_INT(q)) return Val_long(q);
1817
+
}
1818
+
#endif
1819
+
/* mpn_ version */
1820
+
Z_MARK_SLOW;
1821
+
return ml_z_rdiv(arg1, arg2, Z_SIGN_MASK);
1822
+
}
1823
+
1824
+
/* helper function for succ / pred */
1825
+
static value ml_z_succpred(value arg, intnat sign)
1826
+
{
1827
+
CAMLparam1(arg);
1828
+
Z_DECL(arg);
1829
+
value r;
1830
+
Z_ARG(arg);
1831
+
r = ml_z_alloc(size_arg + 1);
1832
+
Z_REFRESH(arg);
1833
+
if (!size_arg) {
1834
+
Z_LIMB(r)[0] = 1;
1835
+
r = ml_z_reduce(r, 1, sign);
1836
+
}
1837
+
else if (sign_arg == sign) {
1838
+
/* add 1 */
1839
+
mp_limb_t c = mpn_add_1(Z_LIMB(r), ptr_arg, size_arg, 1);
1840
+
Z_LIMB(r)[size_arg] = c;
1841
+
r = ml_z_reduce(r, size_arg + 1, sign_arg);
1842
+
}
1843
+
else {
1844
+
/* subtract 1 */
1845
+
mpn_sub_1(Z_LIMB(r), ptr_arg, size_arg, 1);
1846
+
r = ml_z_reduce(r, size_arg, sign_arg);
1847
+
}
1848
+
Z_CHECK(r);
1849
+
CAMLreturn(r);
1850
+
}
1851
+
1852
+
CAMLprim value ml_z_succ(value arg)
1853
+
{
1854
+
Z_MARK_OP;
1855
+
Z_CHECK(arg);
1856
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1857
+
if (Is_long(arg)) {
1858
+
/* fast path */
1859
+
if (arg < Val_long(Z_MAX_INT)) return arg + 2;
1860
+
}
1861
+
#endif
1862
+
/* mpn_ version */
1863
+
Z_MARK_SLOW;
1864
+
return ml_z_succpred(arg, 0);
1865
+
}
1866
+
1867
+
CAMLprim value ml_z_pred(value arg)
1868
+
{
1869
+
Z_MARK_OP;
1870
+
Z_CHECK(arg);
1871
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
1872
+
if (Is_long(arg)) {
1873
+
/* fast path */
1874
+
if (arg > Val_long(Z_MIN_INT)) return arg - 2;
1875
+
}
1876
+
#endif
1877
+
/* mpn_ version */
1878
+
Z_MARK_SLOW;
1879
+
return ml_z_succpred(arg, Z_SIGN_MASK);
1880
+
}
1881
+
1882
+
CAMLprim value ml_z_sqrt(value arg)
1883
+
{
1884
+
/* XXX TODO: fast path */
1885
+
CAMLparam1(arg);
1886
+
Z_DECL(arg);
1887
+
value r;
1888
+
Z_MARK_OP;
1889
+
Z_MARK_SLOW;
1890
+
Z_CHECK(arg);
1891
+
Z_ARG(arg);
1892
+
if (sign_arg)
1893
+
caml_invalid_argument("Z.sqrt: square root of a negative number");
1894
+
if (size_arg) {
1895
+
mp_size_t sz = (size_arg + 1) / 2;
1896
+
r = ml_z_alloc(sz);
1897
+
Z_REFRESH(arg);
1898
+
mpn_sqrtrem(Z_LIMB(r), NULL, ptr_arg, size_arg);
1899
+
r = ml_z_reduce(r, sz, 0);
1900
+
}
1901
+
else r = Val_long(0);
1902
+
Z_CHECK(r);
1903
+
CAMLreturn(r);
1904
+
}
1905
+
1906
+
CAMLprim value ml_z_sqrt_rem(value arg)
1907
+
{
1908
+
CAMLparam1(arg);
1909
+
CAMLlocal3(r, s, p);
1910
+
Z_DECL(arg);
1911
+
/* XXX TODO: fast path */
1912
+
Z_MARK_OP;
1913
+
Z_MARK_SLOW;
1914
+
Z_CHECK(arg);
1915
+
Z_ARG(arg);
1916
+
if (sign_arg)
1917
+
caml_invalid_argument("Z.sqrt_rem: square root of a negative number");
1918
+
if (size_arg) {
1919
+
mp_size_t sz = (size_arg + 1) / 2, sz2;
1920
+
r = ml_z_alloc(sz);
1921
+
s = ml_z_alloc(size_arg);
1922
+
Z_REFRESH(arg);
1923
+
sz2 = mpn_sqrtrem(Z_LIMB(r), Z_LIMB(s), ptr_arg, size_arg);
1924
+
r = ml_z_reduce(r, sz, 0);
1925
+
s = ml_z_reduce(s, sz2, 0);
1926
+
}
1927
+
else r = s = Val_long(0);
1928
+
Z_CHECK(r);
1929
+
Z_CHECK(s);
1930
+
p = caml_alloc_small(2, 0);
1931
+
Field(p,0) = r;
1932
+
Field(p,1) = s;
1933
+
CAMLreturn(p);
1934
+
}
1935
+
1936
+
CAMLprim value ml_z_gcd(value arg1, value arg2)
1937
+
{
1938
+
Z_MARK_OP;
1939
+
Z_CHECK(arg1); Z_CHECK(arg2);
1940
+
#if Z_FAST_PATH
1941
+
if (Is_long(arg1) && Is_long(arg2)) {
1942
+
/* fast path */
1943
+
intnat a1 = Long_val(arg1);
1944
+
intnat a2 = Long_val(arg2);
1945
+
if (a1 < 0) a1 = -a1;
1946
+
if (a2 < 0) a2 = -a2;
1947
+
if (a1 < a2) { intnat t = a1; a1 = a2; a2 = t; }
1948
+
while (a2) {
1949
+
intnat r = a1 % a2;
1950
+
a1 = a2; a2 = r;
1951
+
}
1952
+
/* If arg1 = arg2 = min_int, the result a1 is -min_int, not representable
1953
+
as a tagged integer; fall through the slow case, then. */
1954
+
if (a1 <= Z_MAX_INT) return Val_long(a1);
1955
+
}
1956
+
#endif
1957
+
/* mpn_ version */
1958
+
Z_MARK_SLOW;
1959
+
{
1960
+
CAMLparam2(arg1, arg2);
1961
+
CAMLlocal3(r, tmp1, tmp2);
1962
+
mp_size_t sz, pos1, pos2, limb1, limb2, bit1, bit2, pos, limb, bit, i;
1963
+
Z_DECL(arg1); Z_DECL(arg2);
1964
+
Z_ARG(arg1); Z_ARG(arg2);
1965
+
if (!size_arg1) r = sign_arg2 ? ml_z_neg(arg2) : arg2;
1966
+
else if (!size_arg2) r = sign_arg1 ? ml_z_neg(arg1) : arg1;
1967
+
else {
1968
+
/* copy args to tmp storage & remove lower 0 bits */
1969
+
pos1 = mpn_scan1(ptr_arg1, 0);
1970
+
pos2 = mpn_scan1(ptr_arg2, 0);
1971
+
limb1 = pos1 / Z_LIMB_BITS;
1972
+
limb2 = pos2 / Z_LIMB_BITS;
1973
+
bit1 = pos1 % Z_LIMB_BITS;
1974
+
bit2 = pos2 % Z_LIMB_BITS;
1975
+
size_arg1 -= limb1;
1976
+
size_arg2 -= limb2;
1977
+
tmp1 = ml_z_alloc(size_arg1 + 1);
1978
+
tmp2 = ml_z_alloc(size_arg2 + 1);
1979
+
Z_REFRESH(arg1);
1980
+
Z_REFRESH(arg2);
1981
+
if (bit1) {
1982
+
mpn_rshift(Z_LIMB(tmp1), ptr_arg1 + limb1, size_arg1, bit1);
1983
+
if (!Z_LIMB(tmp1)[size_arg1-1]) size_arg1--;
1984
+
}
1985
+
else ml_z_cpy_limb(Z_LIMB(tmp1), ptr_arg1 + limb1, size_arg1);
1986
+
if (bit2) {
1987
+
mpn_rshift(Z_LIMB(tmp2), ptr_arg2 + limb2, size_arg2, bit2);
1988
+
if (!Z_LIMB(tmp2)[size_arg2-1]) size_arg2--;
1989
+
}
1990
+
else ml_z_cpy_limb(Z_LIMB(tmp2), ptr_arg2 + limb2, size_arg2);
1991
+
/* compute gcd of 2^pos1 & 2^pos2 */
1992
+
pos = (pos1 <= pos2) ? pos1 : pos2;
1993
+
limb = pos / Z_LIMB_BITS;
1994
+
bit = pos % Z_LIMB_BITS;
1995
+
/* compute gcd of arg1 & arg2 without lower 0 bits */
1996
+
/* second argument must have less bits than first */
1997
+
if ((size_arg1 > size_arg2) ||
1998
+
((size_arg1 == size_arg2) &&
1999
+
(Z_LIMB(tmp1)[size_arg1 - 1] >= Z_LIMB(tmp2)[size_arg1 - 1]))) {
2000
+
r = ml_z_alloc(size_arg2 + limb + 1);
2001
+
sz = mpn_gcd(Z_LIMB(r) + limb, Z_LIMB(tmp1), size_arg1, Z_LIMB(tmp2), size_arg2);
2002
+
}
2003
+
else {
2004
+
r = ml_z_alloc(size_arg1 + limb + 1);
2005
+
sz = mpn_gcd(Z_LIMB(r) + limb, Z_LIMB(tmp2), size_arg2, Z_LIMB(tmp1), size_arg1);
2006
+
}
2007
+
/* glue the two results */
2008
+
for (i = 0; i < limb; i++)
2009
+
Z_LIMB(r)[i] = 0;
2010
+
Z_LIMB(r)[sz + limb] = 0;
2011
+
if (bit) mpn_lshift(Z_LIMB(r) + limb, Z_LIMB(r) + limb, sz + 1, bit);
2012
+
r = ml_z_reduce(r, limb + sz + 1, 0);
2013
+
}
2014
+
Z_CHECK(r);
2015
+
CAMLreturn(r);
2016
+
}
2017
+
}
2018
+
2019
+
/* only computes one cofactor */
2020
+
CAMLprim value ml_z_gcdext_intern(value arg1, value arg2)
2021
+
{
2022
+
/* XXX TODO: fast path */
2023
+
CAMLparam2(arg1, arg2);
2024
+
CAMLlocal5(r, res_arg1, res_arg2, s, p);
2025
+
Z_DECL(arg1); Z_DECL(arg2);
2026
+
mp_size_t sz, sn;
2027
+
Z_MARK_OP;
2028
+
Z_MARK_SLOW;
2029
+
Z_CHECK(arg1); Z_CHECK(arg2);
2030
+
Z_ARG(arg1); Z_ARG(arg2);
2031
+
if (!size_arg1 || !size_arg2) ml_z_raise_divide_by_zero();
2032
+
/* copy args to tmp storage */
2033
+
res_arg1 = ml_z_alloc(size_arg1 + 1);
2034
+
res_arg2 = ml_z_alloc(size_arg2 + 1);
2035
+
Z_REFRESH(arg1);
2036
+
Z_REFRESH(arg2);
2037
+
ml_z_cpy_limb(Z_LIMB(res_arg1), ptr_arg1, size_arg1);
2038
+
ml_z_cpy_limb(Z_LIMB(res_arg2), ptr_arg2, size_arg2);
2039
+
/* must have arg1 >= arg2 */
2040
+
if ((size_arg1 > size_arg2) ||
2041
+
((size_arg1 == size_arg2) &&
2042
+
(mpn_cmp(Z_LIMB(res_arg1), Z_LIMB(res_arg2), size_arg1) >= 0))) {
2043
+
r = ml_z_alloc(size_arg1 + 1);
2044
+
s = ml_z_alloc(size_arg1 + 1);
2045
+
sz = mpn_gcdext(Z_LIMB(r), Z_LIMB(s), &sn,
2046
+
Z_LIMB(res_arg1), size_arg1, Z_LIMB(res_arg2), size_arg2);
2047
+
p = caml_alloc_small(3, 0);
2048
+
Field(p,2) = Val_true;
2049
+
}
2050
+
else {
2051
+
r = ml_z_alloc(size_arg2 + 1);
2052
+
s = ml_z_alloc(size_arg2 + 1);
2053
+
sz = mpn_gcdext(Z_LIMB(r), Z_LIMB(s), &sn,
2054
+
Z_LIMB(res_arg2), size_arg2, Z_LIMB(res_arg1), size_arg1);
2055
+
p = caml_alloc_small(3, 0);
2056
+
Field(p,2) = Val_false;
2057
+
sign_arg1 = sign_arg2;
2058
+
}
2059
+
/* pack result */
2060
+
r = ml_z_reduce(r, sz, 0);
2061
+
if ((int)sn >= 0) s = ml_z_reduce(s, sn, sign_arg1);
2062
+
else s = ml_z_reduce(s, -sn, sign_arg1 ^ Z_SIGN_MASK);
2063
+
Z_CHECK(r);
2064
+
Z_CHECK(s);
2065
+
Field(p,0) = r;
2066
+
Field(p,1) = s;
2067
+
CAMLreturn(p);
2068
+
}
2069
+
2070
+
2071
+
/*---------------------------------------------------
2072
+
BITWISE OPERATORS
2073
+
---------------------------------------------------*/
2074
+
2075
+
CAMLprim value ml_z_logand(value arg1, value arg2)
2076
+
{
2077
+
Z_MARK_OP;
2078
+
Z_CHECK(arg1); Z_CHECK(arg2);
2079
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2080
+
if (Is_long(arg1) && Is_long(arg2)) {
2081
+
/* fast path */
2082
+
return arg1 & arg2;
2083
+
}
2084
+
#endif
2085
+
/* mpn_ version */
2086
+
Z_MARK_SLOW;
2087
+
{
2088
+
CAMLparam2(arg1,arg2);
2089
+
value r;
2090
+
mp_size_t i;
2091
+
mp_limb_t c;
2092
+
Z_DECL(arg1); Z_DECL(arg2);
2093
+
Z_ARG(arg1); Z_ARG(arg2);
2094
+
/* ensure size_arg1 >= size_arg2 */
2095
+
if (size_arg1 < size_arg2) {
2096
+
mp_size_t sz;
2097
+
mp_limb_t *p, s;
2098
+
value a;
2099
+
sz = size_arg1; size_arg1 = size_arg2; size_arg2 = sz;
2100
+
p = ptr_arg1; ptr_arg1 = ptr_arg2; ptr_arg2 = p;
2101
+
s = sign_arg1; sign_arg1 = sign_arg2; sign_arg2 = s;
2102
+
a = arg1; arg1 = arg2; arg2 = a;
2103
+
}
2104
+
if (!size_arg2) r = arg2;
2105
+
else if (sign_arg1 && sign_arg2) {
2106
+
/* arg1 < 0, arg2 < 0 => r < 0 */
2107
+
r = ml_z_alloc(size_arg1 + 1);
2108
+
Z_REFRESH(arg1);
2109
+
Z_REFRESH(arg2);
2110
+
mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1);
2111
+
c = 1; /* carry when decrementing arg2 */
2112
+
for (i = 0; i < size_arg2; i++) {
2113
+
mp_limb_t v = ptr_arg2[i];
2114
+
Z_LIMB(r)[i] = Z_LIMB(r)[i] | (v - c);
2115
+
c = c && !v;
2116
+
}
2117
+
c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1);
2118
+
Z_LIMB(r)[size_arg1] = c;
2119
+
r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK);
2120
+
}
2121
+
else if (sign_arg1) {
2122
+
/* arg1 < 0, arg2 > 0 => r >= 0 */
2123
+
r = ml_z_alloc(size_arg2);
2124
+
Z_REFRESH(arg1);
2125
+
Z_REFRESH(arg2);
2126
+
mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg2, 1);
2127
+
for (i = 0; i < size_arg2; i++)
2128
+
Z_LIMB(r)[i] = (~Z_LIMB(r)[i]) & ptr_arg2[i];
2129
+
r = ml_z_reduce(r, size_arg2, 0);
2130
+
}
2131
+
else if (sign_arg2) {
2132
+
/* arg1 > 0, arg2 < 0 => r >= 0 */
2133
+
r = ml_z_alloc(size_arg1);
2134
+
Z_REFRESH(arg1);
2135
+
Z_REFRESH(arg2);
2136
+
mpn_sub_1(Z_LIMB(r), ptr_arg2, size_arg2, 1);
2137
+
for (i = 0; i < size_arg2; i++)
2138
+
Z_LIMB(r)[i] = ptr_arg1[i] & (~Z_LIMB(r)[i]);
2139
+
for (; i < size_arg1; i++)
2140
+
Z_LIMB(r)[i] = ptr_arg1[i];
2141
+
r = ml_z_reduce(r, size_arg1, 0);
2142
+
}
2143
+
else {
2144
+
/* arg1, arg2 > 0 => r >= 0 */
2145
+
r = ml_z_alloc(size_arg2);
2146
+
Z_REFRESH(arg1);
2147
+
Z_REFRESH(arg2);
2148
+
for (i = 0; i < size_arg2; i++)
2149
+
Z_LIMB(r)[i] = ptr_arg1[i] & ptr_arg2[i];
2150
+
r = ml_z_reduce(r, size_arg2, 0);
2151
+
}
2152
+
Z_CHECK(r);
2153
+
CAMLreturn(r);
2154
+
}
2155
+
}
2156
+
2157
+
CAMLprim value ml_z_logor(value arg1, value arg2)
2158
+
{
2159
+
Z_MARK_OP;
2160
+
Z_CHECK(arg1); Z_CHECK(arg2);
2161
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2162
+
if (Is_long(arg1) && Is_long(arg2)) {
2163
+
/* fast path */
2164
+
return arg1 | arg2;
2165
+
}
2166
+
#endif
2167
+
/* mpn_ version */
2168
+
Z_MARK_SLOW;
2169
+
{
2170
+
CAMLparam2(arg1,arg2);
2171
+
Z_DECL(arg1); Z_DECL(arg2);
2172
+
mp_size_t i;
2173
+
mp_limb_t c;
2174
+
value r;
2175
+
Z_ARG(arg1); Z_ARG(arg2);
2176
+
/* ensure size_arg1 >= size_arg2 */
2177
+
if (size_arg1 < size_arg2) {
2178
+
mp_size_t sz;
2179
+
mp_limb_t *p, s;
2180
+
value a;
2181
+
sz = size_arg1; size_arg1 = size_arg2; size_arg2 = sz;
2182
+
p = ptr_arg1; ptr_arg1 = ptr_arg2; ptr_arg2 = p;
2183
+
s = sign_arg1; sign_arg1 = sign_arg2; sign_arg2 = s;
2184
+
a = arg1; arg1 = arg2; arg2 = a;
2185
+
}
2186
+
if (!size_arg2) r = arg1;
2187
+
else if (sign_arg1 && sign_arg2) {
2188
+
/* arg1 < 0, arg2 < 0 => r < 0 */
2189
+
r = ml_z_alloc(size_arg2 + 1);
2190
+
Z_REFRESH(arg1);
2191
+
Z_REFRESH(arg2);
2192
+
mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg2, 1);
2193
+
c = 1; /* carry when decrementing arg2 */
2194
+
for (i = 0; i < size_arg2; i++) {
2195
+
mp_limb_t v = ptr_arg2[i];
2196
+
Z_LIMB(r)[i] = Z_LIMB(r)[i] & (v - c);
2197
+
c = c && !v;
2198
+
}
2199
+
c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg2, 1);
2200
+
Z_LIMB(r)[size_arg2] = c;
2201
+
r = ml_z_reduce(r, size_arg2 + 1, Z_SIGN_MASK);
2202
+
}
2203
+
else if (sign_arg1) {
2204
+
/* arg1 < 0, arg2 > 0 => r < 0 */
2205
+
r = ml_z_alloc(size_arg1 + 1);
2206
+
Z_REFRESH(arg1);
2207
+
Z_REFRESH(arg2);
2208
+
mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1);
2209
+
for (i = 0; i < size_arg2; i++)
2210
+
Z_LIMB(r)[i] = Z_LIMB(r)[i] & (~ptr_arg2[i]);
2211
+
c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1);
2212
+
Z_LIMB(r)[size_arg1] = c;
2213
+
r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK);
2214
+
}
2215
+
else if (sign_arg2) {
2216
+
/* arg1 > 0, arg2 < 0 => r < 0*/
2217
+
r = ml_z_alloc(size_arg2 + 1);
2218
+
Z_REFRESH(arg1);
2219
+
Z_REFRESH(arg2);
2220
+
mpn_sub_1(Z_LIMB(r), ptr_arg2, size_arg2, 1);
2221
+
for (i = 0; i < size_arg2; i++)
2222
+
Z_LIMB(r)[i] = (~ptr_arg1[i]) & Z_LIMB(r)[i];
2223
+
c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg2, 1);
2224
+
Z_LIMB(r)[size_arg2] = c;
2225
+
r = ml_z_reduce(r, size_arg2 + 1, Z_SIGN_MASK);
2226
+
}
2227
+
else {
2228
+
/* arg1, arg2 > 0 => r > 0 */
2229
+
r = ml_z_alloc(size_arg1);
2230
+
Z_REFRESH(arg1);
2231
+
Z_REFRESH(arg2);
2232
+
for (i = 0; i < size_arg2; i++)
2233
+
Z_LIMB(r)[i] = ptr_arg1[i] | ptr_arg2[i];
2234
+
for (; i < size_arg1; i++)
2235
+
Z_LIMB(r)[i] = ptr_arg1[i];
2236
+
r = ml_z_reduce(r, size_arg1, 0);
2237
+
}
2238
+
Z_CHECK(r);
2239
+
CAMLreturn(r);
2240
+
}
2241
+
}
2242
+
2243
+
CAMLprim value ml_z_logxor(value arg1, value arg2)
2244
+
{
2245
+
Z_MARK_OP;
2246
+
Z_CHECK(arg1); Z_CHECK(arg2);
2247
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2248
+
if (Is_long(arg1) && Is_long(arg2)) {
2249
+
/* fast path */
2250
+
return (arg1 ^ arg2) | 1;
2251
+
}
2252
+
#endif
2253
+
/* mpn_ version */
2254
+
Z_MARK_SLOW;
2255
+
{
2256
+
CAMLparam2(arg1,arg2);
2257
+
Z_DECL(arg1); Z_DECL(arg2);
2258
+
value r;
2259
+
mp_size_t i;
2260
+
mp_limb_t c;
2261
+
Z_ARG(arg1); Z_ARG(arg2);
2262
+
/* ensure size_arg1 >= size_arg2 */
2263
+
if (size_arg1 < size_arg2) {
2264
+
mp_size_t sz;
2265
+
mp_limb_t *p, s;
2266
+
value a;
2267
+
sz = size_arg1; size_arg1 = size_arg2; size_arg2 = sz;
2268
+
p = ptr_arg1; ptr_arg1 = ptr_arg2; ptr_arg2 = p;
2269
+
s = sign_arg1; sign_arg1 = sign_arg2; sign_arg2 = s;
2270
+
a = arg1; arg1 = arg2; arg2 = a;
2271
+
}
2272
+
if (!size_arg2) r = arg1;
2273
+
else if (sign_arg1 && sign_arg2) {
2274
+
/* arg1 < 0, arg2 < 0 => r >=0 */
2275
+
r = ml_z_alloc(size_arg1);
2276
+
Z_REFRESH(arg1);
2277
+
Z_REFRESH(arg2);
2278
+
mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1);
2279
+
c = 1; /* carry when decrementing arg2 */
2280
+
for (i = 0; i < size_arg2; i++) {
2281
+
mp_limb_t v = ptr_arg2[i];
2282
+
Z_LIMB(r)[i] = Z_LIMB(r)[i] ^ (v - c);
2283
+
c = c && !v;
2284
+
}
2285
+
r = ml_z_reduce(r, size_arg1, 0);
2286
+
}
2287
+
else if (sign_arg1) {
2288
+
/* arg1 < 0, arg2 > 0 => r < 0 */
2289
+
r = ml_z_alloc(size_arg1 + 1);
2290
+
Z_REFRESH(arg1);
2291
+
Z_REFRESH(arg2);
2292
+
mpn_sub_1(Z_LIMB(r), ptr_arg1, size_arg1, 1);
2293
+
for (i = 0; i < size_arg2; i++)
2294
+
Z_LIMB(r)[i] = Z_LIMB(r)[i] ^ ptr_arg2[i];
2295
+
c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1);
2296
+
Z_LIMB(r)[size_arg1] = c;
2297
+
r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK);
2298
+
}
2299
+
else if (sign_arg2) {
2300
+
/* arg1 > 0, arg2 < 0 => r < 0 */
2301
+
r = ml_z_alloc(size_arg1 + 1);
2302
+
Z_REFRESH(arg1);
2303
+
Z_REFRESH(arg2);
2304
+
mpn_sub_1(Z_LIMB(r), ptr_arg2, size_arg2, 1);
2305
+
for (i = 0; i < size_arg2; i++)
2306
+
Z_LIMB(r)[i] = ptr_arg1[i] ^ Z_LIMB(r)[i];
2307
+
for (; i < size_arg1; i++)
2308
+
Z_LIMB(r)[i] = ptr_arg1[i];
2309
+
c = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg1, 1);
2310
+
Z_LIMB(r)[size_arg1] = c;
2311
+
r = ml_z_reduce(r, size_arg1 + 1, Z_SIGN_MASK);
2312
+
}
2313
+
else {
2314
+
/* arg1, arg2 > 0 => r >= 0 */
2315
+
r = ml_z_alloc(size_arg1);
2316
+
Z_REFRESH(arg1);
2317
+
Z_REFRESH(arg2);
2318
+
for (i = 0; i < size_arg2; i++)
2319
+
Z_LIMB(r)[i] = ptr_arg1[i] ^ ptr_arg2[i];
2320
+
for (; i < size_arg1; i++)
2321
+
Z_LIMB(r)[i] = ptr_arg1[i];
2322
+
r = ml_z_reduce(r, size_arg1, 0);
2323
+
}
2324
+
Z_CHECK(r);
2325
+
CAMLreturn(r);
2326
+
}
2327
+
}
2328
+
2329
+
CAMLprim value ml_z_lognot(value arg)
2330
+
{
2331
+
Z_MARK_OP;
2332
+
Z_CHECK(arg);
2333
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2334
+
if (Is_long(arg)) {
2335
+
/* fast path */
2336
+
return (~arg) | 1;
2337
+
}
2338
+
#endif
2339
+
/* mpn_ version */
2340
+
Z_MARK_SLOW;
2341
+
{
2342
+
CAMLparam1(arg);
2343
+
Z_DECL(arg);
2344
+
value r;
2345
+
Z_ARG(arg);
2346
+
r = ml_z_alloc(size_arg + 1);
2347
+
Z_REFRESH(arg);
2348
+
/* compute r = -arg - 1 */
2349
+
if (!size_arg) {
2350
+
/* arg = 0 => r = -1 */
2351
+
Z_LIMB(r)[0] = 1;
2352
+
r = ml_z_reduce(r, 1, Z_SIGN_MASK);
2353
+
}
2354
+
else if (sign_arg) {
2355
+
/* arg < 0, r > 0, |r| = |arg| - 1 */
2356
+
mpn_sub_1(Z_LIMB(r), ptr_arg, size_arg, 1);
2357
+
r = ml_z_reduce(r, size_arg, 0);
2358
+
}
2359
+
else {
2360
+
/* arg > 0, r < 0, |r| = |arg| + 1 */
2361
+
mp_limb_t c = mpn_add_1(Z_LIMB(r), ptr_arg, size_arg, 1);
2362
+
Z_LIMB(r)[size_arg] = c;
2363
+
r = ml_z_reduce(r, size_arg + 1, Z_SIGN_MASK);
2364
+
}
2365
+
Z_CHECK(r);
2366
+
CAMLreturn(r);
2367
+
}
2368
+
}
2369
+
2370
+
CAMLprim value ml_z_shift_left(value arg, value count)
2371
+
{
2372
+
Z_DECL(arg);
2373
+
intnat c = Long_val(count);
2374
+
intnat c1, c2;
2375
+
Z_MARK_OP;
2376
+
Z_CHECK(arg);
2377
+
if (c < 0)
2378
+
caml_invalid_argument("Z.shift_left: count argument must be positive");
2379
+
if (!c) return arg;
2380
+
c1 = c / Z_LIMB_BITS;
2381
+
c2 = c % Z_LIMB_BITS;
2382
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2383
+
if (Is_long(arg) && !c1) {
2384
+
/* fast path */
2385
+
value a = arg - 1;
2386
+
value r = arg << c2;
2387
+
if (a == (r >> c2)) return r | 1;
2388
+
}
2389
+
#endif
2390
+
Z_ARG(arg);
2391
+
if (!size_arg) return Val_long(0);
2392
+
/* mpn_ version */
2393
+
Z_MARK_SLOW;
2394
+
{
2395
+
CAMLparam1(arg);
2396
+
value r;
2397
+
mp_size_t i;
2398
+
r = ml_z_alloc(size_arg + c1 + 1);
2399
+
Z_REFRESH(arg);
2400
+
/* 0-filled limbs */
2401
+
for (i = 0; i < c1; i++) Z_LIMB(r)[i] = 0;
2402
+
if (c2) {
2403
+
/* shifted bits */
2404
+
mp_limb_t x = mpn_lshift(Z_LIMB(r) + c1, ptr_arg, size_arg, c2);
2405
+
Z_LIMB(r)[size_arg + c1] = x;
2406
+
}
2407
+
else {
2408
+
/* unshifted copy */
2409
+
ml_z_cpy_limb(Z_LIMB(r) + c1, ptr_arg, size_arg);
2410
+
Z_LIMB(r)[size_arg + c1] = 0;
2411
+
}
2412
+
r = ml_z_reduce(r, size_arg + c1 + 1, sign_arg);
2413
+
Z_CHECK(r);
2414
+
CAMLreturn(r);
2415
+
}
2416
+
}
2417
+
2418
+
CAMLprim value ml_z_shift_right(value arg, value count)
2419
+
{
2420
+
Z_DECL(arg);
2421
+
intnat c = Long_val(count);
2422
+
intnat c1, c2;
2423
+
value r;
2424
+
Z_MARK_OP;
2425
+
Z_CHECK(arg);
2426
+
if (c < 0)
2427
+
caml_invalid_argument("Z.shift_right: count argument must be positive");
2428
+
if (!c) return arg;
2429
+
c1 = c / Z_LIMB_BITS;
2430
+
c2 = c % Z_LIMB_BITS;
2431
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2432
+
if (Is_long(arg)) {
2433
+
/* fast path */
2434
+
if (c1) {
2435
+
if (arg < 0) return Val_long(-1);
2436
+
else return Val_long(0);
2437
+
}
2438
+
return (arg >> c2) | 1;
2439
+
}
2440
+
#endif
2441
+
Z_ARG(arg);
2442
+
if (c1 >= size_arg) {
2443
+
if (sign_arg) return Val_long(-1);
2444
+
else return Val_long(0);
2445
+
}
2446
+
/* mpn_ version */
2447
+
Z_MARK_SLOW;
2448
+
{
2449
+
CAMLparam1(arg);
2450
+
mp_limb_t cr;
2451
+
r = ml_z_alloc(size_arg - c1 + 1);
2452
+
Z_REFRESH(arg);
2453
+
if (c2)
2454
+
/* shifted bits */
2455
+
cr = mpn_rshift(Z_LIMB(r), ptr_arg + c1, size_arg - c1, c2);
2456
+
else {
2457
+
/* unshifted copy */
2458
+
ml_z_cpy_limb(Z_LIMB(r), ptr_arg + c1, size_arg - c1);
2459
+
cr = 0;
2460
+
}
2461
+
if (sign_arg) {
2462
+
/* round |arg| to +oo */
2463
+
mp_size_t i;
2464
+
if (!cr) {
2465
+
for (i = 0; i < c1; i++)
2466
+
if (ptr_arg[i]) { cr = 1; break; }
2467
+
}
2468
+
if (cr)
2469
+
cr = mpn_add_1(Z_LIMB(r), Z_LIMB(r), size_arg - c1, 1);
2470
+
}
2471
+
else cr = 0;
2472
+
Z_LIMB(r)[size_arg - c1] = cr;
2473
+
r = ml_z_reduce(r, size_arg - c1 + 1, sign_arg);
2474
+
Z_CHECK(r);
2475
+
CAMLreturn(r);
2476
+
}
2477
+
}
2478
+
2479
+
CAMLprim value ml_z_shift_right_trunc(value arg, value count)
2480
+
{
2481
+
Z_DECL(arg);
2482
+
intnat c = Long_val(count);
2483
+
intnat c1, c2;
2484
+
value r;
2485
+
Z_MARK_OP;
2486
+
Z_CHECK(arg);
2487
+
if (c < 0)
2488
+
caml_invalid_argument("Z.shift_right_trunc: count argument must be positive");
2489
+
if (!c) return arg;
2490
+
c1 = c / Z_LIMB_BITS;
2491
+
c2 = c % Z_LIMB_BITS;
2492
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2493
+
if (Is_long(arg)) {
2494
+
/* fast path */
2495
+
if (c1) return Val_long(0);
2496
+
if (arg >= 1) return (arg >> c2) | 1;
2497
+
else return Val_long(- ((- Long_val(arg)) >> c2));
2498
+
}
2499
+
#endif
2500
+
Z_ARG(arg);
2501
+
if (c1 >= size_arg) return Val_long(0);
2502
+
/* mpn_ version */
2503
+
Z_MARK_SLOW;
2504
+
{
2505
+
CAMLparam1(arg);
2506
+
r = ml_z_alloc(size_arg - c1);
2507
+
Z_REFRESH(arg);
2508
+
if (c2)
2509
+
/* shifted bits */
2510
+
mpn_rshift(Z_LIMB(r), ptr_arg + c1, size_arg - c1, c2);
2511
+
else
2512
+
/* unshifted copy */
2513
+
ml_z_cpy_limb(Z_LIMB(r), ptr_arg + c1, size_arg - c1);
2514
+
r = ml_z_reduce(r, size_arg - c1, sign_arg);
2515
+
Z_CHECK(r);
2516
+
CAMLreturn(r);
2517
+
}
2518
+
}
2519
+
2520
+
/* Helper function for numbits: number of leading 0 bits in x */
2521
+
2522
+
#ifdef _LONG_LONG_LIMB
2523
+
#define BUILTIN_CLZ __builtin_clzll
2524
+
#else
2525
+
#define BUILTIN_CLZ __builtin_clzl
2526
+
#endif
2527
+
2528
+
/* Use GCC or Clang built-in if available. The argument must be != 0. */
2529
+
#if defined(__clang__) || __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
2530
+
#define ml_z_clz BUILTIN_CLZ
2531
+
#else
2532
+
/* Portable C implementation - Hacker's Delight fig 5.12 */
2533
+
int ml_z_clz(mp_limb_t x)
2534
+
{
2535
+
int n;
2536
+
mp_limb_t y;
2537
+
#ifdef ARCH_SIXTYFOUR
2538
+
n = 64;
2539
+
y = x >> 32; if (y != 0) { n = n - 32; x = y; }
2540
+
#else
2541
+
n = 32;
2542
+
#endif
2543
+
y = x >> 16; if (y != 0) { n = n - 16; x = y; }
2544
+
y = x >> 8; if (y != 0) { n = n - 8; x = y; }
2545
+
y = x >> 4; if (y != 0) { n = n - 4; x = y; }
2546
+
y = x >> 2; if (y != 0) { n = n - 2; x = y; }
2547
+
y = x >> 1; if (y != 0) return n - 2;
2548
+
return n - x;
2549
+
}
2550
+
#endif
2551
+
2552
+
CAMLprim value ml_z_numbits(value arg)
2553
+
{
2554
+
Z_DECL(arg);
2555
+
intnat r;
2556
+
int n;
2557
+
Z_MARK_OP;
2558
+
Z_CHECK(arg);
2559
+
#if Z_FAST_PATH
2560
+
if (Is_long(arg)) {
2561
+
/* fast path */
2562
+
r = Long_val(arg);
2563
+
if (r == 0) {
2564
+
return Val_int(0);
2565
+
} else {
2566
+
n = ml_z_clz(r > 0 ? r : -r);
2567
+
return Val_long(sizeof(intnat) * 8 - n);
2568
+
}
2569
+
}
2570
+
#endif
2571
+
/* mpn_ version */
2572
+
Z_MARK_SLOW;
2573
+
Z_ARG(arg);
2574
+
if (size_arg == 0) return Val_int(0);
2575
+
n = ml_z_clz(ptr_arg[size_arg - 1]);
2576
+
return Val_long(size_arg * Z_LIMB_BITS - n);
2577
+
}
2578
+
2579
+
/* Helper function for trailing_zeros: number of trailing 0 bits in x */
2580
+
2581
+
#ifdef _LONG_LONG_LIMB
2582
+
#define BUILTIN_CTZ __builtin_ctzll
2583
+
#else
2584
+
#define BUILTIN_CTZ __builtin_ctzl
2585
+
#endif
2586
+
2587
+
/* Use GCC or Clang built-in if available. The argument must be != 0. */
2588
+
#if defined(__clang__) || __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
2589
+
#define ml_z_ctz BUILTIN_CTZ
2590
+
#else
2591
+
/* Portable C implementation - Hacker's Delight fig 5.21 */
2592
+
int ml_z_ctz(mp_limb_t x)
2593
+
{
2594
+
int n;
2595
+
mp_limb_t y;
2596
+
CAMLassert (x != 0);
2597
+
#ifdef ARCH_SIXTYFOUR
2598
+
n = 63;
2599
+
y = x << 32; if (y != 0) { n = n - 32; x = y; }
2600
+
#else
2601
+
n = 31;
2602
+
#endif
2603
+
y = x << 16; if (y != 0) { n = n - 16; x = y; }
2604
+
y = x << 8; if (y != 0) { n = n - 8; x = y; }
2605
+
y = x << 4; if (y != 0) { n = n - 4; x = y; }
2606
+
y = x << 2; if (y != 0) { n = n - 2; x = y; }
2607
+
y = x << 1; if (y != 0) { n = n - 1; }
2608
+
return n;
2609
+
}
2610
+
#endif
2611
+
2612
+
CAMLprim value ml_z_trailing_zeros(value arg)
2613
+
{
2614
+
Z_DECL(arg);
2615
+
intnat r;
2616
+
mp_size_t i;
2617
+
Z_MARK_OP;
2618
+
Z_CHECK(arg);
2619
+
#if Z_FAST_PATH
2620
+
if (Is_long(arg)) {
2621
+
/* fast path */
2622
+
r = Long_val(arg);
2623
+
if (r == 0) {
2624
+
return Val_long (Max_long);
2625
+
} else {
2626
+
/* No need to take absolute value of r, as ctz(-x) = ctz(x) */
2627
+
return Val_long (ml_z_ctz(r));
2628
+
}
2629
+
}
2630
+
#endif
2631
+
/* mpn_ version */
2632
+
Z_MARK_SLOW;
2633
+
Z_ARG(arg);
2634
+
if (size_arg == 0) return Val_long (Max_long);
2635
+
for (i = 0; ptr_arg[i] == 0; i++) /* skip */;
2636
+
return Val_long(i * Z_LIMB_BITS + ml_z_ctz(ptr_arg[i]));
2637
+
}
2638
+
2639
+
/* helper function for popcount & hamdist: number of bits at 1 in x */
2640
+
/* maybe we should use the mpn_ function even for small arguments, in case
2641
+
the CPU has a fast popcount opcode?
2642
+
*/
2643
+
uintnat ml_z_count(uintnat x)
2644
+
{
2645
+
#ifdef ARCH_SIXTYFOUR
2646
+
x = (x & 0x5555555555555555UL) + ((x >> 1) & 0x5555555555555555UL);
2647
+
x = (x & 0x3333333333333333UL) + ((x >> 2) & 0x3333333333333333UL);
2648
+
x = (x & 0x0f0f0f0f0f0f0f0fUL) + ((x >> 4) & 0x0f0f0f0f0f0f0f0fUL);
2649
+
x = (x & 0x00ff00ff00ff00ffUL) + ((x >> 8) & 0x00ff00ff00ff00ffUL);
2650
+
x = (x & 0x0000ffff0000ffffUL) + ((x >> 16) & 0x0000ffff0000ffffUL);
2651
+
x = (x & 0x00000000ffffffffUL) + ((x >> 32) & 0x00000000ffffffffUL);
2652
+
#else
2653
+
x = (x & 0x55555555UL) + ((x >> 1) & 0x55555555UL);
2654
+
x = (x & 0x33333333UL) + ((x >> 2) & 0x33333333UL);
2655
+
x = (x & 0x0f0f0f0fUL) + ((x >> 4) & 0x0f0f0f0fUL);
2656
+
x = (x & 0x00ff00ffUL) + ((x >> 8) & 0x00ff00ffUL);
2657
+
x = (x & 0x0000ffffUL) + ((x >> 16) & 0x0000ffffUL);
2658
+
#endif
2659
+
return x;
2660
+
}
2661
+
2662
+
CAMLprim value ml_z_popcount(value arg)
2663
+
{
2664
+
Z_DECL(arg);
2665
+
intnat r;
2666
+
Z_MARK_OP;
2667
+
Z_CHECK(arg);
2668
+
#if Z_FAST_PATH
2669
+
if (Is_long(arg)) {
2670
+
/* fast path */
2671
+
r = Long_val(arg);
2672
+
if (r < 0) ml_z_raise_overflow();
2673
+
return Val_long(ml_z_count(r));
2674
+
}
2675
+
#endif
2676
+
/* mpn_ version */
2677
+
Z_MARK_SLOW;
2678
+
Z_ARG(arg);
2679
+
if (sign_arg) ml_z_raise_overflow();
2680
+
if (!size_arg) return Val_long(0);
2681
+
r = mpn_popcount(ptr_arg, size_arg);
2682
+
if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow();
2683
+
return Val_long(r);
2684
+
}
2685
+
2686
+
CAMLprim value ml_z_hamdist(value arg1, value arg2)
2687
+
{
2688
+
Z_DECL(arg1); Z_DECL(arg2);
2689
+
intnat r;
2690
+
mp_size_t sz;
2691
+
Z_MARK_OP;
2692
+
Z_CHECK(arg1);
2693
+
Z_CHECK(arg2);
2694
+
#if Z_FAST_PATH
2695
+
if (Is_long(arg1) && Is_long(arg2)) {
2696
+
/* fast path */
2697
+
r = Long_val(arg1) ^ Long_val(arg2);
2698
+
if (r < 0) ml_z_raise_overflow();
2699
+
return Val_long(ml_z_count(r));
2700
+
}
2701
+
#endif
2702
+
/* mpn_ version */
2703
+
Z_MARK_SLOW;
2704
+
Z_ARG(arg1);
2705
+
Z_ARG(arg2);
2706
+
if (sign_arg1 != sign_arg2) ml_z_raise_overflow();
2707
+
/* XXX TODO: case where arg1 & arg2 are both negative */
2708
+
if (sign_arg1 || sign_arg2)
2709
+
caml_invalid_argument("Z.hamdist: negative arguments");
2710
+
/* distance on common size */
2711
+
sz = (size_arg1 <= size_arg2) ? size_arg1 : size_arg2;
2712
+
if (sz) {
2713
+
r = mpn_hamdist(ptr_arg1, ptr_arg2, sz);
2714
+
if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow();
2715
+
}
2716
+
else r = 0;
2717
+
/* add stray bits */
2718
+
if (size_arg1 > size_arg2) {
2719
+
r += mpn_popcount(ptr_arg1 + size_arg2, size_arg1 - size_arg2);
2720
+
if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow();
2721
+
}
2722
+
else if (size_arg2 > size_arg1) {
2723
+
r += mpn_popcount(ptr_arg2 + size_arg1, size_arg2 - size_arg1);
2724
+
if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow();
2725
+
}
2726
+
return Val_long(r);
2727
+
}
2728
+
2729
+
CAMLprim value ml_z_testbit(value arg, value index)
2730
+
{
2731
+
Z_DECL(arg);
2732
+
uintnat b_idx;
2733
+
mp_size_t l_idx, i;
2734
+
mp_limb_t limb;
2735
+
Z_MARK_OP;
2736
+
Z_CHECK(arg);
2737
+
b_idx = Long_val(index); /* Caml code checked index >= 0 */
2738
+
#if Z_FAST_PATH
2739
+
if (Is_long(arg)) {
2740
+
if (b_idx >= Z_LIMB_BITS) b_idx = Z_LIMB_BITS - 1;
2741
+
return Val_int((Long_val(arg) >> b_idx) & 1);
2742
+
}
2743
+
#endif
2744
+
Z_MARK_SLOW;
2745
+
Z_ARG(arg);
2746
+
l_idx = b_idx / Z_LIMB_BITS;
2747
+
if (l_idx >= size_arg) return Val_bool(sign_arg);
2748
+
limb = ptr_arg[l_idx];
2749
+
if (sign_arg != 0) {
2750
+
/* If arg is negative, its 2-complement representation is
2751
+
bitnot(abs(arg) - 1).
2752
+
If any of the limbs of abs(arg) below l_idx is nonzero,
2753
+
the carry from the decrement dies before reaching l_idx,
2754
+
and we just test bitnot(limb).
2755
+
If all the limbs below l_idx are zero, the carry from the
2756
+
decrement propagates to l_idx,
2757
+
and we test bitnot(limb - 1) = - limb. */
2758
+
for (i = 0; i < l_idx; i++) {
2759
+
if (ptr_arg[i] != 0) { limb = ~limb; goto extract; }
2760
+
}
2761
+
limb = -limb;
2762
+
}
2763
+
extract:
2764
+
return Val_int((limb >> (b_idx % Z_LIMB_BITS)) & 1);
2765
+
}
2766
+
2767
+
/*---------------------------------------------------
2768
+
FUNCTIONS BASED ON mpz_t
2769
+
---------------------------------------------------*/
2770
+
2771
+
/* sets rop to the value in op (limbs are copied) */
2772
+
void ml_z_mpz_set_z(mpz_t rop, value op)
2773
+
{
2774
+
Z_DECL(op);
2775
+
Z_CHECK(op);
2776
+
Z_ARG(op);
2777
+
if (size_op * Z_LIMB_BITS > INT_MAX)
2778
+
caml_invalid_argument("Z: risk of overflow in mpz type");
2779
+
mpz_realloc2(rop, size_op * Z_LIMB_BITS);
2780
+
rop->_mp_size = (sign_op >= 0) ? size_op : -size_op;
2781
+
ml_z_cpy_limb(rop->_mp_d, ptr_op, size_op);
2782
+
}
2783
+
2784
+
/* inits and sets rop to the value in op (limbs are copied) */
2785
+
void ml_z_mpz_init_set_z(mpz_t rop, value op)
2786
+
{
2787
+
mpz_init(rop);
2788
+
ml_z_mpz_set_z(rop,op);
2789
+
}
2790
+
2791
+
/* returns a new z objects equal to op (limbs are copied) */
2792
+
value ml_z_from_mpz(mpz_t op)
2793
+
{
2794
+
value r;
2795
+
size_t sz = mpz_size(op);
2796
+
r = ml_z_alloc(sz);
2797
+
ml_z_cpy_limb(Z_LIMB(r), op->_mp_d, sz);
2798
+
return ml_z_reduce(r, sz, (mpz_sgn(op) >= 0) ? 0 : Z_SIGN_MASK);
2799
+
}
2800
+
2801
+
#if __GNU_MP_VERSION >= 5
2802
+
/* not exported by gmp.h */
2803
+
extern void __gmpn_divexact (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t);
2804
+
#endif
2805
+
2806
+
CAMLprim value ml_z_divexact(value arg1, value arg2)
2807
+
{
2808
+
Z_DECL(arg1); Z_DECL(arg2);
2809
+
Z_MARK_OP;
2810
+
Z_CHECK(arg1); Z_CHECK(arg2);
2811
+
#if Z_FAST_PATH && !Z_FAST_PATH_IN_OCAML
2812
+
if (Is_long(arg1) && Is_long(arg2)) {
2813
+
/* fast path */
2814
+
intnat a1 = Long_val(arg1);
2815
+
intnat a2 = Long_val(arg2);
2816
+
intnat q;
2817
+
if (!a2) ml_z_raise_divide_by_zero();
2818
+
q = a1 / a2;
2819
+
if (Z_FITS_INT(q)) return Val_long(q);
2820
+
}
2821
+
#endif
2822
+
Z_MARK_SLOW;
2823
+
#if __GNU_MP_VERSION >= 5
2824
+
{
2825
+
/* mpn_ version */
2826
+
Z_ARG(arg1);
2827
+
Z_ARG(arg2);
2828
+
if (!size_arg2)
2829
+
ml_z_raise_divide_by_zero();
2830
+
if (size_arg1 < size_arg2)
2831
+
return Val_long(0);
2832
+
{
2833
+
CAMLparam2(arg1,arg2);
2834
+
CAMLlocal1(q);
2835
+
q = ml_z_alloc(size_arg1 - size_arg2 + 1);
2836
+
Z_REFRESH(arg1); Z_REFRESH(arg2);
2837
+
__gmpn_divexact(Z_LIMB(q),
2838
+
ptr_arg1, size_arg1, ptr_arg2, size_arg2);
2839
+
q = ml_z_reduce(q, size_arg1 - size_arg2 + 1, sign_arg1 ^ sign_arg2);
2840
+
Z_CHECK(q);
2841
+
CAMLreturn(q);
2842
+
}
2843
+
}
2844
+
#else
2845
+
{
2846
+
/* mpz_ version */
2847
+
CAMLparam2(arg1,arg2);
2848
+
CAMLlocal1(r);
2849
+
mpz_t a,b;
2850
+
if (!ml_z_sgn(arg2))
2851
+
ml_z_raise_divide_by_zero();
2852
+
ml_z_mpz_init_set_z(a, arg1);
2853
+
ml_z_mpz_init_set_z(b, arg2);
2854
+
mpz_divexact(a, a, b);
2855
+
r = ml_z_from_mpz(a);
2856
+
mpz_clear(a);
2857
+
mpz_clear(b);
2858
+
CAMLreturn(r);
2859
+
}
2860
+
#endif
2861
+
}
2862
+
2863
+
CAMLprim value ml_z_powm(value base, value exp, value mod)
2864
+
{
2865
+
CAMLparam3(base,exp,mod);
2866
+
CAMLlocal1(r);
2867
+
Z_DECL(mod);
2868
+
mpz_t mbase, mexp, mmod;
2869
+
Z_ARG(mod);
2870
+
if (!size_mod)
2871
+
ml_z_raise_divide_by_zero();
2872
+
ml_z_mpz_init_set_z(mbase, base);
2873
+
ml_z_mpz_init_set_z(mexp, exp);
2874
+
ml_z_mpz_init_set_z(mmod, mod);
2875
+
if (mpz_sgn(mexp) < 0) {
2876
+
/* we need to check whether base is invertible to avoid a division by zero
2877
+
in mpz_powm, so we can as well use the computed inverse
2878
+
*/
2879
+
if (!mpz_invert(mbase, mbase, mmod)) {
2880
+
mpz_clear(mbase);
2881
+
mpz_clear(mexp);
2882
+
mpz_clear(mmod);
2883
+
ml_z_raise_divide_by_zero();
2884
+
}
2885
+
mpz_neg(mexp, mexp);
2886
+
}
2887
+
mpz_powm(mbase, mbase, mexp, mmod);
2888
+
r = ml_z_from_mpz(mbase);
2889
+
mpz_clear(mbase);
2890
+
mpz_clear(mexp);
2891
+
mpz_clear(mmod);
2892
+
CAMLreturn(r);
2893
+
}
2894
+
2895
+
CAMLprim value ml_z_powm_sec(value base, value exp, value mod)
2896
+
{
2897
+
#ifndef HAS_MPIR
2898
+
#if __GNU_MP_VERSION >= 5
2899
+
CAMLparam3(base,exp,mod);
2900
+
CAMLlocal1(r);
2901
+
mpz_t mbase, mexp, mmod;
2902
+
ml_z_mpz_init_set_z(mbase, base);
2903
+
ml_z_mpz_init_set_z(mexp, exp);
2904
+
ml_z_mpz_init_set_z(mmod, mod);
2905
+
if (mpz_sgn(mexp) <= 0) {
2906
+
mpz_clear(mbase);
2907
+
mpz_clear(mexp);
2908
+
mpz_clear(mmod);
2909
+
caml_invalid_argument("Z.powm_sec: exponent must be positive");
2910
+
}
2911
+
if (! mpz_odd_p(mmod)) {
2912
+
mpz_clear(mbase);
2913
+
mpz_clear(mexp);
2914
+
mpz_clear(mmod);
2915
+
caml_invalid_argument("Z.powm_sec: modulus must be odd");
2916
+
}
2917
+
mpz_powm_sec(mbase, mbase, mexp, mmod);
2918
+
r = ml_z_from_mpz(mbase);
2919
+
mpz_clear(mbase);
2920
+
mpz_clear(mexp);
2921
+
mpz_clear(mmod);
2922
+
CAMLreturn(r);
2923
+
#else
2924
+
MAYBE_UNUSED(base);
2925
+
MAYBE_UNUSED(exp);
2926
+
MAYBE_UNUSED(mod);
2927
+
caml_invalid_argument("Z.powm_sec: not available, needs GMP version >= 5");
2928
+
#endif
2929
+
#else
2930
+
MAYBE_UNUSED(base);
2931
+
MAYBE_UNUSED(exp);
2932
+
MAYBE_UNUSED(mod);
2933
+
caml_invalid_argument("Z.powm_sec: not available in MPIR, needs GMP version >= 5");
2934
+
#endif
2935
+
}
2936
+
2937
+
CAMLprim value ml_z_pow(value base, value exp)
2938
+
{
2939
+
CAMLparam2(base,exp);
2940
+
CAMLlocal1(r);
2941
+
mpz_t mbase;
2942
+
intnat e = Long_val(exp);
2943
+
mp_size_t sz, ralloc;
2944
+
int cnt;
2945
+
if (e < 0)
2946
+
caml_invalid_argument("Z.pow: exponent must be nonnegative");
2947
+
ml_z_mpz_init_set_z(mbase, base);
2948
+
2949
+
/* Safe overapproximation of the size of the result.
2950
+
In case this overflows an int, GMP may abort with a message
2951
+
"gmp: overflow in mpz type". To avoid this, we test the size before
2952
+
calling mpz_pow_ui and raise an OCaml exception.
2953
+
Note: we lifted the computation from mpz_n_pow_ui.
2954
+
*/
2955
+
sz = mbase->_mp_size;
2956
+
if (sz < 0) sz = -sz;
2957
+
cnt = sz > 0 ? ml_z_clz(mbase->_mp_d[sz - 1]) : 0;
2958
+
ralloc = (sz * GMP_NUMB_BITS - cnt + GMP_NAIL_BITS) * e / GMP_NUMB_BITS + 5;
2959
+
if (ralloc > INT_MAX) {
2960
+
mpz_clear(mbase);
2961
+
caml_invalid_argument("Z.pow: risk of overflow in mpz type");
2962
+
}
2963
+
mpz_pow_ui(mbase, mbase, e);
2964
+
r = ml_z_from_mpz(mbase);
2965
+
mpz_clear(mbase);
2966
+
CAMLreturn(r);
2967
+
}
2968
+
2969
+
CAMLprim value ml_z_root(value a, value b)
2970
+
{
2971
+
CAMLparam2(a,b);
2972
+
CAMLlocal1(r);
2973
+
Z_DECL(a);
2974
+
mpz_t ma;
2975
+
intnat mb = Long_val(b);
2976
+
if (mb <= 0)
2977
+
caml_invalid_argument("Z.root: exponent must be positive");
2978
+
Z_ARG(a);
2979
+
if (!(mb & 1) && sign_a)
2980
+
caml_invalid_argument("Z.root: even root of a negative number");
2981
+
ml_z_mpz_init_set_z(ma, a);
2982
+
mpz_root(ma, ma, mb);
2983
+
r = ml_z_from_mpz(ma);
2984
+
mpz_clear(ma);
2985
+
CAMLreturn(r);
2986
+
}
2987
+
2988
+
CAMLprim value ml_z_rootrem(value a, value b)
2989
+
{
2990
+
CAMLparam2(a,b);
2991
+
CAMLlocal3(r1,r2,r3);
2992
+
Z_DECL(a);
2993
+
mpz_t ma, mr1, mr2;
2994
+
intnat mb = Long_val(b);
2995
+
if (mb <= 0)
2996
+
caml_invalid_argument("Z.rootrem: exponent must be positive");
2997
+
Z_ARG(a);
2998
+
if (!(mb & 1) && sign_a)
2999
+
caml_invalid_argument("Z.rootrem: even root of a negative number");
3000
+
ml_z_mpz_init_set_z(ma, a);
3001
+
mpz_init(mr1);
3002
+
mpz_init(mr2);
3003
+
mpz_rootrem(mr1, mr2, ma, mb);
3004
+
r1 = ml_z_from_mpz(mr1);
3005
+
r2 = ml_z_from_mpz(mr2);
3006
+
r3 = caml_alloc_small(2, 0);
3007
+
Field(r3,0) = r1;
3008
+
Field(r3,1) = r2;
3009
+
mpz_clear(ma);
3010
+
mpz_clear(mr1);
3011
+
mpz_clear(mr2);
3012
+
CAMLreturn(r3);
3013
+
}
3014
+
3015
+
CAMLprim value ml_z_perfect_power(value a)
3016
+
{
3017
+
CAMLparam1(a);
3018
+
int r;
3019
+
mpz_t ma;
3020
+
ml_z_mpz_init_set_z(ma, a);
3021
+
r = mpz_perfect_power_p(ma);
3022
+
mpz_clear(ma);
3023
+
CAMLreturn(r ? Val_true : Val_false);
3024
+
}
3025
+
3026
+
CAMLprim value ml_z_perfect_square(value a)
3027
+
{
3028
+
CAMLparam1(a);
3029
+
int r;
3030
+
mpz_t ma;
3031
+
ml_z_mpz_init_set_z(ma, a);
3032
+
r = mpz_perfect_square_p(ma);
3033
+
mpz_clear(ma);
3034
+
CAMLreturn(r ? Val_true : Val_false);
3035
+
}
3036
+
3037
+
CAMLprim value ml_z_probab_prime(value a, int b)
3038
+
{
3039
+
CAMLparam1(a);
3040
+
int r;
3041
+
mpz_t ma;
3042
+
ml_z_mpz_init_set_z(ma, a);
3043
+
r = mpz_probab_prime_p(ma, Int_val(b));
3044
+
mpz_clear(ma);
3045
+
CAMLreturn(Val_int(r));
3046
+
}
3047
+
3048
+
CAMLprim value ml_z_nextprime(value a)
3049
+
{
3050
+
CAMLparam1(a);
3051
+
CAMLlocal1(r);
3052
+
mpz_t ma;
3053
+
ml_z_mpz_init_set_z(ma, a);
3054
+
mpz_nextprime(ma, ma);
3055
+
r = ml_z_from_mpz(ma);
3056
+
mpz_clear(ma);
3057
+
CAMLreturn(r);
3058
+
}
3059
+
3060
+
CAMLprim value ml_z_invert(value base, value mod)
3061
+
{
3062
+
CAMLparam2(base,mod);
3063
+
CAMLlocal1(r);
3064
+
mpz_t mbase, mmod;
3065
+
ml_z_mpz_init_set_z(mbase, base);
3066
+
ml_z_mpz_init_set_z(mmod, mod);
3067
+
if (!mpz_invert(mbase, mbase, mmod)) {
3068
+
mpz_clear(mbase);
3069
+
mpz_clear(mmod);
3070
+
ml_z_raise_divide_by_zero();
3071
+
}
3072
+
r = ml_z_from_mpz(mbase);
3073
+
mpz_clear(mbase);
3074
+
mpz_clear(mmod);
3075
+
CAMLreturn(r);
3076
+
}
3077
+
3078
+
CAMLprim value ml_z_divisible(value a, value b)
3079
+
{
3080
+
CAMLparam2(a,b);
3081
+
mpz_t ma, mb;
3082
+
int r;
3083
+
ml_z_mpz_init_set_z(ma, a);
3084
+
ml_z_mpz_init_set_z(mb, b);
3085
+
r = mpz_divisible_p(ma, mb);
3086
+
mpz_clear(ma);
3087
+
mpz_clear(mb);
3088
+
CAMLreturn(Val_bool(r));
3089
+
}
3090
+
3091
+
CAMLprim value ml_z_congruent(value a, value b, value c)
3092
+
{
3093
+
CAMLparam3(a,b,c);
3094
+
mpz_t ma, mb, mc;
3095
+
int r;
3096
+
ml_z_mpz_init_set_z(ma, a);
3097
+
ml_z_mpz_init_set_z(mb, b);
3098
+
ml_z_mpz_init_set_z(mc, c);
3099
+
r = mpz_congruent_p(ma, mb, mc);
3100
+
mpz_clear(ma);
3101
+
mpz_clear(mb);
3102
+
mpz_clear(mc);
3103
+
CAMLreturn(Val_bool(r));
3104
+
}
3105
+
3106
+
CAMLprim value ml_z_jacobi(value a, value b)
3107
+
{
3108
+
CAMLparam2(a,b);
3109
+
mpz_t ma, mb;
3110
+
int r;
3111
+
ml_z_mpz_init_set_z(ma, a);
3112
+
ml_z_mpz_init_set_z(mb, b);
3113
+
r = mpz_jacobi(ma, mb);
3114
+
mpz_clear(ma);
3115
+
mpz_clear(mb);
3116
+
CAMLreturn(Val_int(r));
3117
+
}
3118
+
3119
+
CAMLprim value ml_z_legendre(value a, value b)
3120
+
{
3121
+
CAMLparam2(a,b);
3122
+
mpz_t ma, mb;
3123
+
int r;
3124
+
ml_z_mpz_init_set_z(ma, a);
3125
+
ml_z_mpz_init_set_z(mb, b);
3126
+
r = mpz_legendre(ma, mb);
3127
+
mpz_clear(ma);
3128
+
mpz_clear(mb);
3129
+
CAMLreturn(Val_int(r));
3130
+
}
3131
+
3132
+
CAMLprim value ml_z_kronecker(value a, value b)
3133
+
{
3134
+
CAMLparam2(a,b);
3135
+
mpz_t ma, mb;
3136
+
int r;
3137
+
ml_z_mpz_init_set_z(ma, a);
3138
+
ml_z_mpz_init_set_z(mb, b);
3139
+
r = mpz_kronecker(ma, mb);
3140
+
mpz_clear(ma);
3141
+
mpz_clear(mb);
3142
+
CAMLreturn(Val_int(r));
3143
+
}
3144
+
3145
+
CAMLprim value ml_z_remove(value a, value b)
3146
+
{
3147
+
CAMLparam2(a,b);
3148
+
CAMLlocal2(r,tmp);
3149
+
mpz_t ma, mb, mr;
3150
+
int i;
3151
+
ml_z_mpz_init_set_z(ma, a);
3152
+
ml_z_mpz_init_set_z(mb, b);
3153
+
mpz_init(mr);
3154
+
i = mpz_remove(mr, ma, mb);
3155
+
tmp = ml_z_from_mpz(mr);
3156
+
r = caml_alloc_small(2, 0);
3157
+
Field(r,0) = tmp;
3158
+
Field(r,1) = Val_int(i);
3159
+
mpz_clear(ma);
3160
+
mpz_clear(mb);
3161
+
mpz_clear(mr);
3162
+
CAMLreturn(r);
3163
+
}
3164
+
3165
+
CAMLprim value ml_z_fac(value a)
3166
+
{
3167
+
CAMLparam1(a);
3168
+
CAMLlocal1(r);
3169
+
mpz_t mr;
3170
+
intnat ma = Long_val(a);
3171
+
if (ma < 0)
3172
+
caml_invalid_argument("Z.fac: non-positive argument");
3173
+
mpz_init(mr);
3174
+
mpz_fac_ui(mr, ma);
3175
+
r = ml_z_from_mpz(mr);
3176
+
mpz_clear(mr);
3177
+
CAMLreturn(r);
3178
+
}
3179
+
3180
+
CAMLprim value ml_z_fac2(value a)
3181
+
{
3182
+
CAMLparam1(a);
3183
+
CAMLlocal1(r);
3184
+
mpz_t mr;
3185
+
intnat ma = Long_val(a);
3186
+
if (ma < 0)
3187
+
caml_invalid_argument("Z.fac2: non-positive argument");
3188
+
mpz_init(mr);
3189
+
mpz_2fac_ui(mr, ma);
3190
+
r = ml_z_from_mpz(mr);
3191
+
mpz_clear(mr);
3192
+
CAMLreturn(r);
3193
+
}
3194
+
3195
+
CAMLprim value ml_z_facM(value a, value b)
3196
+
{
3197
+
CAMLparam2(a,b);
3198
+
CAMLlocal1(r);
3199
+
mpz_t mr;
3200
+
intnat ma = Long_val(a), mb = Long_val(b);
3201
+
if (ma < 0 || mb < 0)
3202
+
caml_invalid_argument("Z.facM: non-positive argument");
3203
+
mpz_init(mr);
3204
+
mpz_mfac_uiui(mr, ma, mb);
3205
+
r = ml_z_from_mpz(mr);
3206
+
mpz_clear(mr);
3207
+
CAMLreturn(r);
3208
+
}
3209
+
3210
+
CAMLprim value ml_z_primorial(value a)
3211
+
{
3212
+
CAMLparam1(a);
3213
+
CAMLlocal1(r);
3214
+
mpz_t mr;
3215
+
intnat ma = Long_val(a);
3216
+
if (ma < 0)
3217
+
caml_invalid_argument("Z.primorial: non-positive argument");
3218
+
mpz_init(mr);
3219
+
mpz_primorial_ui(mr, ma);
3220
+
r = ml_z_from_mpz(mr);
3221
+
mpz_clear(mr);
3222
+
CAMLreturn(r);
3223
+
}
3224
+
3225
+
CAMLprim value ml_z_bin(value a, value b)
3226
+
{
3227
+
CAMLparam2(a,b);
3228
+
CAMLlocal1(r);
3229
+
mpz_t ma;
3230
+
intnat mb = Long_val(b);
3231
+
if (mb < 0)
3232
+
caml_invalid_argument("Z.bin: non-positive argument");
3233
+
ml_z_mpz_init_set_z(ma, a);
3234
+
mpz_bin_ui(ma, ma, mb);
3235
+
r = ml_z_from_mpz(ma);
3236
+
mpz_clear(ma);
3237
+
CAMLreturn(r);
3238
+
}
3239
+
3240
+
CAMLprim value ml_z_fib(value a)
3241
+
{
3242
+
CAMLparam1(a);
3243
+
CAMLlocal1(r);
3244
+
mpz_t mr;
3245
+
intnat ma = Long_val(a);
3246
+
if (ma < 0)
3247
+
caml_invalid_argument("Z.fib: non-positive argument");
3248
+
mpz_init(mr);
3249
+
mpz_fib_ui(mr, ma);
3250
+
r = ml_z_from_mpz(mr);
3251
+
mpz_clear(mr);
3252
+
CAMLreturn(r);
3253
+
}
3254
+
3255
+
CAMLprim value ml_z_lucnum(value a)
3256
+
{
3257
+
CAMLparam1(a);
3258
+
CAMLlocal1(r);
3259
+
mpz_t mr;
3260
+
intnat ma = Long_val(a);
3261
+
if (ma < 0)
3262
+
caml_invalid_argument("Z.lucnum: non-positive argument");
3263
+
mpz_init(mr);
3264
+
mpz_lucnum_ui(mr, ma);
3265
+
r = ml_z_from_mpz(mr);
3266
+
mpz_clear(mr);
3267
+
CAMLreturn(r);
3268
+
}
3269
+
3270
+
3271
+
3272
+
/* XXX should we support the following?
3273
+
mpz_scan0, mpz_scan1
3274
+
mpz_setbit, mpz_clrbit, mpz_combit, mpz_tstbit
3275
+
mpz_odd_p, mpz_even_p
3276
+
random numbers
3277
+
*/
3278
+
3279
+
3280
+
3281
+
/*---------------------------------------------------
3282
+
CUSTOMS BLOCKS
3283
+
---------------------------------------------------*/
3284
+
3285
+
/* With OCaml < 3.12.1, comparing a block an int with OCaml's
3286
+
polymorphic compare will give erroneous results (int always
3287
+
strictly smaller than block). OCaml 3.12.1 and above
3288
+
give the correct result.
3289
+
*/
3290
+
int ml_z_custom_compare(value arg1, value arg2)
3291
+
{
3292
+
Z_DECL(arg1); Z_DECL(arg2);
3293
+
int r;
3294
+
Z_CHECK(arg1); Z_CHECK(arg2);
3295
+
#if Z_FAST_PATH
3296
+
/* Value-equal small integers are equal.
3297
+
Pointer-equal big integers are equal as well. */
3298
+
if (arg1 == arg2) return 0;
3299
+
if (Is_long(arg2)) {
3300
+
if (Is_long(arg1)) {
3301
+
return arg1 > arg2 ? 1 : -1;
3302
+
} else {
3303
+
/* Either arg1 is positive and arg1 > Z_MAX_INT >= arg2 -> result +1
3304
+
or arg1 is negative and arg1 < Z_MIN_INT <= arg2 -> result -1 */
3305
+
return Z_SIGN(arg1) ? -1 : 1;
3306
+
}
3307
+
}
3308
+
else if (Is_long(arg1)) {
3309
+
/* Either arg2 is positive and arg2 > Z_MAX_INT >= arg1 -> result -1
3310
+
or arg2 is negative and arg2 < Z_MIN_INT <= arg1 -> result +1 */
3311
+
return Z_SIGN(arg2) ? 1 : -1;
3312
+
}
3313
+
#endif
3314
+
r = 0;
3315
+
Z_ARG(arg1);
3316
+
Z_ARG(arg2);
3317
+
if (sign_arg1 != sign_arg2) r = 1;
3318
+
else if (size_arg1 > size_arg2) r = 1;
3319
+
else if (size_arg1 < size_arg2) r = -1;
3320
+
else {
3321
+
mp_size_t i;
3322
+
for (i = size_arg1 - 1; i >= 0; i--) {
3323
+
if (ptr_arg1[i] > ptr_arg2[i]) { r = 1; break; }
3324
+
if (ptr_arg1[i] < ptr_arg2[i]) { r = -1; break; }
3325
+
}
3326
+
}
3327
+
if (sign_arg1) r = -r;
3328
+
return r;
3329
+
}
3330
+
3331
+
static intnat ml_z_custom_hash(value v)
3332
+
{
3333
+
Z_DECL(v);
3334
+
mp_size_t i;
3335
+
uint32_t acc = 0;
3336
+
Z_CHECK(v);
3337
+
Z_ARG(v);
3338
+
for (i = 0; i < size_v; i++) {
3339
+
acc = caml_hash_mix_uint32(acc, (uint32_t)(ptr_v[i]));
3340
+
#ifdef ARCH_SIXTYFOUR
3341
+
acc = caml_hash_mix_uint32(acc, ptr_v[i] >> 32);
3342
+
#endif
3343
+
}
3344
+
#ifndef ARCH_SIXTYFOUR
3345
+
/* To obtain the same hash value on 32- and 64-bit platforms */
3346
+
if (size_v % 2 != 0)
3347
+
acc = caml_hash_mix_uint32(acc, 0);
3348
+
#endif
3349
+
if (sign_v) acc++;
3350
+
return acc;
3351
+
}
3352
+
3353
+
/* serialized format:
3354
+
- 1-byte sign (1 for negative, 0 for positive)
3355
+
- 4-byte size in bytes
3356
+
- size-byte unsigned integer, in little endian order
3357
+
*/
3358
+
static void ml_z_custom_serialize(value v,
3359
+
uintnat * wsize_32,
3360
+
uintnat * wsize_64)
3361
+
{
3362
+
mp_size_t i,nb;
3363
+
Z_DECL(v);
3364
+
Z_CHECK(v);
3365
+
Z_ARG(v);
3366
+
if ((mp_size_t)(uint32_t) size_v != size_v)
3367
+
caml_failwith("Z.serialize: number is too large");
3368
+
nb = size_v * sizeof(mp_limb_t);
3369
+
caml_serialize_int_1(sign_v ? 1 : 0);
3370
+
caml_serialize_int_4(nb);
3371
+
for (i = 0; i < size_v; i++) {
3372
+
mp_limb_t x = ptr_v[i];
3373
+
caml_serialize_int_1(x);
3374
+
caml_serialize_int_1(x >> 8);
3375
+
caml_serialize_int_1(x >> 16);
3376
+
caml_serialize_int_1(x >> 24);
3377
+
#ifdef ARCH_SIXTYFOUR
3378
+
caml_serialize_int_1(x >> 32);
3379
+
caml_serialize_int_1(x >> 40);
3380
+
caml_serialize_int_1(x >> 48);
3381
+
caml_serialize_int_1(x >> 56);
3382
+
#endif
3383
+
}
3384
+
*wsize_32 = 4 * (1 + (nb + 3) / 4);
3385
+
*wsize_64 = 8 * (1 + (nb + 7) / 8);
3386
+
#if Z_PERFORM_CHECK
3387
+
/* Add space for canary */
3388
+
*wsize_32 += 4;
3389
+
*wsize_64 += 8;
3390
+
#endif
3391
+
}
3392
+
3393
+
/* There are two issues with integers that are tagged ints on a 64-bit
3394
+
machine but boxed bigints on a 32-bit machine, namely integers in the
3395
+
[2^30, 2^62) and [-2^62, -2^30) ranges:
3396
+
- Serializing such an integer on a 64-bit machine and
3397
+
deserializing on a 32-bit machine will fail in the generic unmarshaler.
3398
+
The correct behavior would be to return a boxed integer.
3399
+
- Serializing such an integer on a 32-bit machine and
3400
+
deserializing on a 64-bit machine must fail.
3401
+
The wrong behavior would be to return a block containing a
3402
+
non-normalized, boxed integer (issue #148).
3403
+
*/
3404
+
static uintnat ml_z_custom_deserialize(void * dst)
3405
+
{
3406
+
mp_limb_t* d = ((mp_limb_t*)dst) + 1;
3407
+
int sign = caml_deserialize_uint_1();
3408
+
uint32_t sz = caml_deserialize_uint_4();
3409
+
uint32_t szw = (sz + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t);
3410
+
uint32_t i = 0;
3411
+
mp_limb_t x;
3412
+
/* all limbs but last */
3413
+
if (szw > 1) {
3414
+
for (; i < szw - 1; i++) {
3415
+
x = caml_deserialize_uint_1();
3416
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 8;
3417
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 16;
3418
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 24;
3419
+
#ifdef ARCH_SIXTYFOUR
3420
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 32;
3421
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 40;
3422
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 48;
3423
+
x |= ((mp_limb_t) caml_deserialize_uint_1()) << 56;
3424
+
#endif
3425
+
d[i] = x;
3426
+
}
3427
+
sz -= i * sizeof(mp_limb_t);
3428
+
}
3429
+
/* last limb */
3430
+
if (sz > 0) {
3431
+
x = caml_deserialize_uint_1();
3432
+
if (sz > 1) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 8;
3433
+
if (sz > 2) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 16;
3434
+
if (sz > 3) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 24;
3435
+
#ifdef ARCH_SIXTYFOUR
3436
+
if (sz > 4) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 32;
3437
+
if (sz > 5) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 40;
3438
+
if (sz > 6) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 48;
3439
+
if (sz > 7) x |= ((mp_limb_t) caml_deserialize_uint_1()) << 56;
3440
+
#endif
3441
+
d[i] = x;
3442
+
i++;
3443
+
}
3444
+
while (i > 0 && !d[i-1]) i--;
3445
+
d[-1] = i | (sign ? Z_SIGN_MASK : 0);
3446
+
#if Z_PERFORM_CHECK
3447
+
d[szw] = 0xDEADBEEF ^ szw;
3448
+
szw++;
3449
+
#endif
3450
+
#if Z_USE_NATINT
3451
+
if (i == 0 ||
3452
+
(i == 1 && (d[0] <= Z_MAX_INT || (d[0] == -Z_MIN_INT && sign)))) {
3453
+
/* Issue #148: this is not a canonical representation,
3454
+
so we raise a Failure */
3455
+
caml_deserialize_error("Z.t value produced on a 32-bit platform cannot be read on a 64-bit platform");
3456
+
}
3457
+
#endif
3458
+
return (szw+1) * sizeof(mp_limb_t);
3459
+
}
3460
+
3461
+
struct custom_operations ml_z_custom_ops = {
3462
+
/* Identifiers starting with _ are normally reserved for the OCaml runtime
3463
+
system, but we got authorization form Gallium to use "_z".
3464
+
It is very compact and stays in the spirit of identifiers used for
3465
+
int32 & co ("_i" & co.).
3466
+
*/
3467
+
"_z",
3468
+
custom_finalize_default,
3469
+
ml_z_custom_compare,
3470
+
ml_z_custom_hash,
3471
+
ml_z_custom_serialize,
3472
+
ml_z_custom_deserialize,
3473
+
ml_z_custom_compare,
3474
+
#ifndef Z_OCAML_LEGACY_CUSTOM_OPERATIONS
3475
+
custom_fixed_length_default
3476
+
#endif
3477
+
};
3478
+
3479
+
3480
+
/*---------------------------------------------------
3481
+
CONVERSION WITH MLGMPIDL
3482
+
---------------------------------------------------*/
3483
+
3484
+
CAMLprim value ml_z_mlgmpidl_of_mpz(value a)
3485
+
{
3486
+
CAMLparam1(a);
3487
+
mpz_ptr mpz = (mpz_ptr)(Data_custom_val(a));
3488
+
CAMLreturn(ml_z_from_mpz(mpz));
3489
+
}
3490
+
3491
+
/* stores the Z.t object into an existing Mpz.t one;
3492
+
as we never allocate Mpz.t objects, we don't need any pointer to
3493
+
mlgmpidl's custom block ops, and so, can link the function even if
3494
+
mlgmpidl is not installed
3495
+
*/
3496
+
CAMLprim value ml_z_mlgmpidl_set_mpz(value r, value a)
3497
+
{
3498
+
CAMLparam2(r,a);
3499
+
mpz_ptr mpz = (mpz_ptr)(Data_custom_val(r));
3500
+
ml_z_mpz_set_z(mpz,a);
3501
+
CAMLreturn(Val_unit);
3502
+
}
3503
+
3504
+
3505
+
3506
+
/*---------------------------------------------------
3507
+
INIT / EXIT
3508
+
---------------------------------------------------*/
3509
+
3510
+
/* called at program exit to display performance information */
3511
+
#if Z_PERF_COUNTER
3512
+
static void ml_z_dump_count()
3513
+
{
3514
+
printf("Z: %lu asm operations, %lu C operations, %lu slow (%lu%%)\n",
3515
+
ml_z_ops_as, ml_z_ops, ml_z_slow,
3516
+
ml_z_ops ? (ml_z_slow*100/(ml_z_ops+ml_z_ops_as)) : 0);
3517
+
}
3518
+
#endif
3519
+
3520
+
CAMLprim value ml_z_init()
3521
+
{
3522
+
ml_z_2p32 = ldexp(1., 32);
3523
+
/* run-time checks */
3524
+
#ifdef ARCH_SIXTYFOUR
3525
+
if (sizeof(intnat) != 8 || sizeof(mp_limb_t) != 8)
3526
+
caml_failwith("Z.init: invalid size of types, 8 expected");
3527
+
#else
3528
+
if (sizeof(intnat) != 4 || sizeof(mp_limb_t) != 4)
3529
+
caml_failwith("Z.init: invalid size of types, 4 expected");
3530
+
#endif
3531
+
/* install functions */
3532
+
#if Z_PERF_COUNTER
3533
+
atexit(ml_z_dump_count);
3534
+
#endif
3535
+
#if Z_CUSTOM_BLOCK
3536
+
caml_register_custom_operations(&ml_z_custom_ops);
3537
+
#endif
3538
+
return Val_unit;
3539
+
}
3540
+
3541
+
#ifdef __cplusplus
3542
+
}
3543
+
#endif
+415
vendor/opam/zarith/configure
+415
vendor/opam/zarith/configure
···
1
+
#! /bin/sh
2
+
3
+
# configuration script
4
+
5
+
# This file is part of the Zarith library
6
+
# http://forge.ocamlcore.org/projects/zarith .
7
+
# It is distributed under LGPL 2 licensing, with static linking exception.
8
+
# See the LICENSE file included in the distribution.
9
+
#
10
+
# Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
11
+
# Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
12
+
# a joint laboratory by:
13
+
# CNRS (Centre national de la recherche scientifique, France),
14
+
# ENS (École normale supérieure, Paris, France),
15
+
# INRIA Rocquencourt (Institut national de recherche en informatique, France).
16
+
17
+
18
+
# options
19
+
installdir='auto'
20
+
ocamllibdir='auto'
21
+
gmp='auto'
22
+
perf='no'
23
+
24
+
ocaml='ocaml'
25
+
ocamlc='ocamlc'
26
+
ocamlopt='ocamlopt'
27
+
ocamlmklib='ocamlmklib'
28
+
ocamldep='ocamldep'
29
+
ocamldoc='ocamldoc'
30
+
ccinc="$CPPFLAGS"
31
+
ldflags="$LDFLAGS"
32
+
cclib=''
33
+
ccdef=''
34
+
mlflags="$OCAMLFLAGS"
35
+
mloptflags="$OCAMLOPTFLAGS"
36
+
mlinc="$OCAMLINC"
37
+
ocamlfind="auto"
38
+
39
+
# sanitize
40
+
LC_ALL=C
41
+
export LC_ALL
42
+
unset IFS
43
+
44
+
45
+
# help
46
+
help()
47
+
{
48
+
cat <<EOF
49
+
usage: configure [options]
50
+
51
+
where options include:
52
+
-installdir dir installation directory
53
+
-ocamllibdir dir ocaml library directory
54
+
-gmp use GMP library (default if found)
55
+
-mpir use MPIR library instead of GMP
56
+
-perf enable performance statistics
57
+
-prefixnonocaml add for non ocaml tool, e.g. -prefixnonocaml x86_64-w64-mingw32-
58
+
59
+
Environment variables that affect configuration:
60
+
CFLAGS extra flags to pass to the C compiler
61
+
CPPFLAGS extra includes, e.g. -I/path/to/gmp/include
62
+
LDFLAGS extra link flags, e.g. -L/path/to/gmp/lib
63
+
OCAMLFLAGS extra flags to pass to the ocamlc Caml compiler
64
+
OCAMLOPTFLAGS extra flags to pass to the ocamlopt Caml compiler
65
+
OCAMLINC extra includes to pass to the Caml compilers
66
+
EOF
67
+
exit
68
+
}
69
+
70
+
# parse arguments
71
+
while : ; do
72
+
case "$1" in
73
+
"")
74
+
break;;
75
+
-installdir|--installdir)
76
+
installdir="$2"
77
+
shift;;
78
+
-ocamllibdir|--ocamllibdir)
79
+
ocamllibdir="$2"
80
+
shift;;
81
+
-no-ocamlfind|--no-ocamlfind)
82
+
ocamlfind="no"
83
+
shift;;
84
+
-help|--help)
85
+
help;;
86
+
-gmp|--gmp)
87
+
gmp='gmp';;
88
+
-mpir|--mpir)
89
+
gmp='mpir';;
90
+
-perf|--perf)
91
+
perf='yes';;
92
+
-prefixnonocaml|--prefixnonocaml)
93
+
prefixnonocaml="$2"
94
+
shift;;
95
+
*)
96
+
echo "unknown option $1, try -help"
97
+
exit 2;;
98
+
esac
99
+
shift
100
+
done
101
+
102
+
if test "$perf" = "yes"; then ccdef="-DZ_PERF_COUNTER $ccdef"; fi
103
+
104
+
echo_n()
105
+
{
106
+
echo "$1" | tr -d '\012'
107
+
}
108
+
109
+
# checking binaries in $PATH
110
+
111
+
searchbin()
112
+
{
113
+
if test "x$1" = "x"; then return 0; fi
114
+
echo_n "binary $1: "
115
+
case "$1" in
116
+
/*|./*|../*)
117
+
if test -f "$1" && test -x "$1"
118
+
then echo "found"; return 1
119
+
else echo "not found"; return 0
120
+
fi;;
121
+
esac
122
+
IFS=':'
123
+
for i in $PATH
124
+
do
125
+
if test -z "$i"; then i='.'; fi
126
+
if test -f $i/$1 && test -x $i/$1; then echo "found in $i"; unset IFS; return 1; fi
127
+
done
128
+
echo "not found"
129
+
unset IFS
130
+
return 0
131
+
}
132
+
133
+
searchbinreq()
134
+
{
135
+
searchbin $1
136
+
if test $? -eq 0; then echo "required program $1 not found"; exit 2; fi
137
+
}
138
+
139
+
140
+
# checking includes and libraries
141
+
142
+
checkinc()
143
+
{
144
+
echo_n "include $1: "
145
+
rm -f tmp.c tmp.o
146
+
echo "#include <$1>" > tmp.c
147
+
echo "int main() { return 1; }" >> tmp.c
148
+
r=1
149
+
$ocamlc -ccopt "$ccopt $ccinc" -c tmp.c -o tmp.o >/dev/null 2>/dev/null || r=0
150
+
if test ! -f tmp.o; then r=0; fi
151
+
rm -f tmp.c tmp.o
152
+
if test $r -eq 0; then echo "not found"; else echo "found"; fi
153
+
return $r
154
+
}
155
+
156
+
checklib()
157
+
{
158
+
echo_n "library $1: "
159
+
rm -f tmp.ml tmp.out
160
+
echo "" > tmp.ml
161
+
r=1
162
+
$ocamlc -custom -ccopt "$ldflags $cclib" tmp.ml -cclib -l$1 -o tmp.out >/dev/null 2>/dev/null || r=0
163
+
if test ! -x tmp.out; then r=0; fi
164
+
rm -f tmp.out tmp.ml tmp.cmi tmp.cmo
165
+
if test $r -eq 0; then echo "not found"; else echo "found"; fi
166
+
return $r
167
+
}
168
+
169
+
checkcc()
170
+
{
171
+
echo_n "checking compilation with $ocamlc $ccopt: "
172
+
rm -f tmp.c tmp.out
173
+
echo "int main() { return 1; }" >> tmp.c
174
+
echo "" > tmpml.ml
175
+
r=1
176
+
$ocamlc -ccopt "$ccopt" tmp.c tmpml.ml -o tmp.out >/dev/null 2>/dev/null || r=0
177
+
if test ! -x tmp.out; then r=0; fi
178
+
rm -f tmp.c tmp.o tmp.out tmpml.ml tmpml.cm*
179
+
if test $r -eq 0; then echo "not working"; else echo "working"; fi
180
+
return $r
181
+
}
182
+
183
+
checkcmxalib()
184
+
{
185
+
echo_n "library $1: "
186
+
$ocamlopt $mloptflags $1 -o tmp.out >/dev/null 2>/dev/null || r=0
187
+
if test ! -x tmp.out; then r=0; fi
188
+
rm -f tmp.out
189
+
if test $r -eq 0; then echo "not found"; else echo "found"; fi
190
+
return $r
191
+
}
192
+
193
+
194
+
# check required programs
195
+
196
+
searchbinreq $ocaml
197
+
searchbinreq $ocamlc
198
+
searchbinreq $ocamldep
199
+
searchbinreq $ocamlmklib
200
+
if searchbin $ocamldoc; then
201
+
ocamldoc=''
202
+
fi
203
+
204
+
if test -n "$CC"; then
205
+
searchbinreq "$CC"
206
+
ccopt="$CFLAGS"
207
+
else
208
+
ccopt="-O3 -Wall -Wextra $CFLAGS"
209
+
fi
210
+
211
+
case "$("$ocamlc" -config | tr -d '\r' | sed -ne '/^system:/s/.*: //p')" in
212
+
win32|win64)
213
+
# MSVC
214
+
objsuffix='obj'
215
+
libsuffix='lib'
216
+
dllsuffix='dll'
217
+
exe='.exe'
218
+
;;
219
+
mingw|mingw64)
220
+
# mingw-w64
221
+
objsuffix='o'
222
+
libsuffix='a'
223
+
dllsuffix='dll'
224
+
exe='.exe'
225
+
;;
226
+
*)
227
+
# Unix
228
+
objsuffix='o'
229
+
libsuffix='a'
230
+
dllsuffix='so'
231
+
exe=''
232
+
;;
233
+
esac
234
+
235
+
# optional native-code generation
236
+
237
+
hasocamlopt='no'
238
+
239
+
searchbin $ocamlopt
240
+
if test $? -eq 1; then hasocamlopt='yes'; fi
241
+
242
+
243
+
# check C compiler
244
+
245
+
checkcc
246
+
if test $? -eq 0; then
247
+
# try again with (almost) no options
248
+
ccopt='-O'
249
+
checkcc
250
+
if test $? -eq 0; then echo "cannot compile and link program"; exit 2; fi
251
+
fi
252
+
253
+
254
+
# directories
255
+
256
+
if test "$ocamllibdir" = "auto"
257
+
then ocamllibdir="$(ocamlc -where | tr -d '\r')"
258
+
fi
259
+
260
+
if test ! -f "$ocamllibdir/caml/mlvalues.h"
261
+
then echo "cannot find OCaml libraries in $ocamllibdir"; exit 2; fi
262
+
ccinc="-I$ocamllibdir $ccinc"
263
+
checkinc "caml/mlvalues.h"
264
+
if test $? -eq 0; then echo "cannot include caml/mlvalues.h"; exit 2; fi
265
+
266
+
267
+
# optional dynamic linking
268
+
269
+
hasdynlink='no'
270
+
271
+
if test $hasocamlopt = yes
272
+
then
273
+
checkcmxalib dynlink.cmxa
274
+
if test $? -eq 1; then hasdynlink='yes'; fi
275
+
fi
276
+
277
+
278
+
# installation method
279
+
280
+
searchbin ocamlfind
281
+
if test $? -eq 1 && test $ocamlfind != "no"; then
282
+
instmeth='findlib'
283
+
if test "$installdir" = "auto"
284
+
then installdir="$(ocamlfind printconf destdir | tr -d '\r')"; fi
285
+
else
286
+
searchbin install
287
+
if test $? -eq 1; then instmeth='install'
288
+
else echo "no installation method found"; exit 2; fi
289
+
if test "$installdir" = "auto"; then installdir="$ocamllibdir"; fi
290
+
fi
291
+
292
+
293
+
# detect OCaml's word-size
294
+
295
+
echo "print_int (Sys.word_size);;" > tmp.ml
296
+
wordsize="$(ocaml tmp.ml)"
297
+
echo "OCaml's word size is $wordsize"
298
+
rm -f tmp.ml
299
+
300
+
301
+
# check GMP, MPIR
302
+
303
+
if test "$gmp" = 'gmp' || test "$gmp" = 'auto'; then
304
+
if pkg-config gmp 2>/dev/null; then
305
+
echo 'package gmp: found'
306
+
gmp='OK'
307
+
cclib="$cclib $(pkg-config --libs gmp)"
308
+
ccinc="$ccinc $(pkg-config --cflags gmp)"
309
+
ccdef="-DHAS_GMP $ccdef"
310
+
else
311
+
checkinc gmp.h
312
+
if test $? -eq 1; then
313
+
checklib gmp
314
+
if test $? -eq 1; then
315
+
gmp='OK'
316
+
cclib="$cclib -lgmp"
317
+
ccdef="-DHAS_GMP $ccdef"
318
+
fi
319
+
fi
320
+
fi
321
+
fi
322
+
if test "$gmp" = 'mpir' || test "$gmp" = 'auto'; then
323
+
checkinc mpir.h
324
+
if test $? -eq 1; then
325
+
checklib mpir
326
+
if test $? -eq 1; then
327
+
gmp='OK'
328
+
cclib="$cclib -lmpir"
329
+
ccdef="-DHAS_MPIR $ccdef"
330
+
fi
331
+
fi
332
+
fi
333
+
if test "$gmp" != 'OK'; then echo "cannot find GMP nor MPIR"; exit 2; fi
334
+
335
+
336
+
# OCaml version
337
+
338
+
ocamlver="$(ocamlc -version)"
339
+
340
+
# OCaml version 4.07 or later is required
341
+
342
+
case "$ocamlver" in
343
+
[123].* | 4.0[0123456].*)
344
+
echo "OCaml version $ocamlver is no longer supported."
345
+
echo "OCaml version 4.07.0 or later is required."
346
+
exit 2
347
+
;;
348
+
esac
349
+
350
+
# -bin-annot available since 4.00.0
351
+
echo "OCaml supports -bin-annot to produce documentation"
352
+
hasbinannot='yes'
353
+
354
+
# Changes to C API (the custom_operation struct) since 4.08.0
355
+
case "$ocamlver" in
356
+
[123].* | 4.0[01234567].* )
357
+
echo "Using OCaml legacy C API custom operations"
358
+
ccdef="-DZ_OCAML_LEGACY_CUSTOM_OPERATIONS $ccdef"
359
+
;;
360
+
*)
361
+
;;
362
+
esac
363
+
364
+
# dump Makefile
365
+
366
+
cat > Makefile.config <<EOF
367
+
# generated by ./configure
368
+
369
+
OCAMLC=$ocamlc
370
+
OCAMLOPT=$ocamlopt
371
+
OCAMLDEP=$ocamldep
372
+
OCAMLMKLIB=$ocamlmklib
373
+
OCAMLDOC=$ocamldoc
374
+
OCAMLFLAGS=$mlflags
375
+
OCAMLOPTFLAGS=$mloptflags
376
+
OCAMLINC=$mlinc
377
+
CFLAGS=$ccinc $ccdef $ccopt
378
+
LIBS=$cclib
379
+
LDFLAGS=$ldflags
380
+
INSTALLDIR=$installdir
381
+
INSTALL=install
382
+
OCAMLFIND=ocamlfind
383
+
INSTMETH=$instmeth
384
+
OBJSUFFIX=$objsuffix
385
+
LIBSUFFIX=$libsuffix
386
+
DLLSUFFIX=$dllsuffix
387
+
EXESUFFIX=$exe
388
+
HASOCAMLOPT=$hasocamlopt
389
+
HASDYNLINK=$hasdynlink
390
+
HASBINANNOT=$hasbinannot
391
+
WORDSIZE=$wordsize
392
+
STDLIBDIR=$ocamllibdir
393
+
EOF
394
+
395
+
396
+
# dump summary
397
+
398
+
cat <<EOF
399
+
400
+
detected configuration:
401
+
402
+
native-code: $hasocamlopt
403
+
dynamic linking: $hasdynlink
404
+
defines: $ccdef
405
+
includes: $ccinc
406
+
libraries: $cclib
407
+
linker options: $ldflags
408
+
C options: $ccopt
409
+
installation path: $installdir
410
+
installation method $instmeth
411
+
412
+
configuration successful!
413
+
now type "make" to build
414
+
then type "make install" or "sudo make install" to install
415
+
EOF
+16
vendor/opam/zarith/dune
+16
vendor/opam/zarith/dune
···
1
+
(library
2
+
(name zarith)
3
+
(public_name zarith)
4
+
(modules zarith_version z q big_int_Z)
5
+
(flags :standard -w -32-39)
6
+
(foreign_stubs
7
+
(language c)
8
+
(names caml_z)
9
+
(flags -DHAS_GMP -fPIC))
10
+
(c_library_flags -lgmp))
11
+
12
+
(library
13
+
(name zarith_top)
14
+
(public_name zarith.top)
15
+
(modules zarith_top)
16
+
(libraries zarith compiler-libs.toplevel))
+574
vendor/opam/zarith/q.ml
+574
vendor/opam/zarith/q.ml
···
1
+
(**
2
+
Rationals.
3
+
4
+
5
+
This file is part of the Zarith library
6
+
http://forge.ocamlcore.org/projects/zarith .
7
+
It is distributed under LGPL 2 licensing, with static linking exception.
8
+
See the LICENSE file included in the distribution.
9
+
10
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
11
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
12
+
a joint laboratory by:
13
+
CNRS (Centre national de la recherche scientifique, France),
14
+
ENS (École normale supérieure, Paris, France),
15
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
16
+
17
+
*)
18
+
19
+
type t = {
20
+
num: Z.t; (** Numerator. *)
21
+
den: Z.t; (** Denominator, >= 0 *)
22
+
}
23
+
(* Type of rationals.
24
+
Invariants:
25
+
- den is always >= 0;
26
+
- num and den have no common factor;
27
+
- if den=0, then num is -1, 0 or 1.
28
+
- if num=0, then den is -1, 0 or 1.
29
+
*)
30
+
31
+
32
+
33
+
(* creation *)
34
+
(* -------- *)
35
+
36
+
(* make *)
37
+
let mk n d =
38
+
{ num = n; den = d; }
39
+
40
+
(* make and normalize n/d, assuming d > 0 *)
41
+
let make_real n d =
42
+
if n == Z.zero || d == Z.one then mk n Z.one
43
+
else
44
+
let g = Z.gcd n d in
45
+
if g == Z.one
46
+
then mk n d
47
+
else mk (Z.divexact n g) (Z.divexact d g)
48
+
49
+
(* make and normalize any fraction *)
50
+
let make n d =
51
+
let sd = Z.sign d in
52
+
if sd = 0 then mk (Z.of_int (Z.sign n)) Z.zero else
53
+
if sd > 0 then make_real n d else
54
+
make_real (Z.neg n) (Z.neg d)
55
+
56
+
let of_bigint n = mk n Z.one
57
+
(* n/1 *)
58
+
59
+
let of_int n = of_bigint (Z.of_int n)
60
+
61
+
let of_int32 n = of_bigint (Z.of_int32 n)
62
+
63
+
let of_int64 n = of_bigint (Z.of_int64 n)
64
+
65
+
let of_nativeint n = of_bigint (Z.of_nativeint n)
66
+
67
+
let of_ints n d = make (Z.of_int n) (Z.of_int d)
68
+
69
+
let zero = of_bigint Z.zero
70
+
(* 0/1 *)
71
+
72
+
let one = of_bigint Z.one
73
+
(* 1/1 *)
74
+
75
+
let minus_one = of_bigint Z.minus_one
76
+
(* -1/1 *)
77
+
78
+
let inf = mk Z.one Z.zero
79
+
(* 1/0 *)
80
+
81
+
let minus_inf = mk Z.minus_one Z.zero
82
+
(* -1/0 *)
83
+
84
+
let undef = mk Z.zero Z.zero
85
+
(* 0/0 *)
86
+
87
+
let of_float d =
88
+
if d = infinity then inf else
89
+
if d = neg_infinity then minus_inf else
90
+
if classify_float d = FP_nan then undef else
91
+
let m,e = frexp d in
92
+
(* put into the form m * 2^e, where m is an integer *)
93
+
let m,e = Z.of_float (ldexp m 53), e-53 in
94
+
if e >= 0 then of_bigint (Z.shift_left m e)
95
+
else make_real m (Z.shift_left Z.one (-e))
96
+
97
+
(* queries *)
98
+
(* ------- *)
99
+
100
+
type kind =
101
+
| ZERO (* 0 *)
102
+
| INF (* 1/0 *)
103
+
| MINF (* -1/0 *)
104
+
| UNDEF (* 0/0 *)
105
+
| NZERO (* non-special, non-0 *)
106
+
107
+
let classify n =
108
+
if n.den == Z.zero then
109
+
match Z.sign n.num with
110
+
| 1 -> INF
111
+
| -1 -> MINF
112
+
| _ -> UNDEF
113
+
else
114
+
if n.num == Z.zero
115
+
then ZERO
116
+
else NZERO
117
+
118
+
let is_real n = (n.den != Z.zero)
119
+
120
+
let num x = x.num
121
+
122
+
let den x = x.den
123
+
124
+
let sign x = Z.sign x.num
125
+
(* sign undef = 0
126
+
sign inf = 1
127
+
sign -inf = -1
128
+
*)
129
+
130
+
let equal x y =
131
+
(Z.equal x.num y.num) && (Z.equal x.den y.den) && (classify x <> UNDEF)
132
+
133
+
let compare x y =
134
+
match classify x, classify y with
135
+
| UNDEF,UNDEF | INF,INF | MINF,MINF -> 0
136
+
| UNDEF,_ -> -1
137
+
| _,UNDEF -> 1
138
+
| MINF,_ | _,INF -> -1
139
+
| INF,_ | _,MINF -> 1
140
+
| _ ->
141
+
if x.den = y.den (* implies equality,
142
+
especially if immediate value and not a pointer,
143
+
in particular in the case den = 1 *)
144
+
then Z.compare x.num y.num
145
+
else
146
+
Z.compare
147
+
(Z.mul x.num y.den)
148
+
(Z.mul y.num x.den)
149
+
150
+
let min a b = if compare a b <= 0 then a else b
151
+
let max a b = if compare a b >= 0 then a else b
152
+
153
+
154
+
let leq x y =
155
+
match classify x, classify y with
156
+
| UNDEF,_ | _,UNDEF -> false
157
+
| MINF,_ | _,INF -> true
158
+
| INF,_ | _,MINF -> false
159
+
| _ ->
160
+
if x.den = y.den
161
+
then Z.leq x.num y.num
162
+
else
163
+
Z.leq
164
+
(Z.mul x.num y.den)
165
+
(Z.mul y.num x.den)
166
+
167
+
let lt x y =
168
+
match classify x, classify y with
169
+
| UNDEF,_ | _,UNDEF -> false
170
+
| INF,_ | _,MINF -> false
171
+
| MINF,_ | _,INF -> true
172
+
| _ ->
173
+
if x.den = y.den
174
+
then Z.lt x.num y.num
175
+
else
176
+
Z.lt
177
+
(Z.mul x.num y.den)
178
+
(Z.mul y.num x.den)
179
+
180
+
let geq x y = leq y x
181
+
let gt x y = lt y x
182
+
183
+
let to_string n =
184
+
match classify n with
185
+
| UNDEF -> "undef"
186
+
| INF -> "+inf"
187
+
| MINF -> "-inf"
188
+
| ZERO -> "0"
189
+
| NZERO ->
190
+
if Z.equal n.den Z.one then Z.to_string n.num
191
+
else (Z.to_string n.num) ^ "/" ^ (Z.to_string n.den)
192
+
193
+
let to_bigint x = Z.div x.num x.den
194
+
(* raises a Division by zero in case x is undefined or infinity *)
195
+
196
+
let to_int x = Z.to_int (to_bigint x)
197
+
198
+
let to_int32 x = Z.to_int32 (to_bigint x)
199
+
200
+
let to_int64 x = Z.to_int64 (to_bigint x)
201
+
202
+
let to_nativeint x = Z.to_nativeint (to_bigint x)
203
+
204
+
let to_float x =
205
+
match classify x with
206
+
| ZERO -> 0.0
207
+
| INF -> infinity
208
+
| MINF -> neg_infinity
209
+
| UNDEF -> nan
210
+
| NZERO ->
211
+
let p = x.num and q = x.den in
212
+
let np = Z.numbits p and nq = Z.numbits q in
213
+
if np <= 53 && nq <= 53 then
214
+
(* p and q convert to floats exactly; use FP division to get the
215
+
correctly-rounded result. *)
216
+
Int64.to_float (Z.to_int64 p) /. Int64.to_float (Z.to_int64 q)
217
+
else begin
218
+
let negat =
219
+
if Z.sign p < 0 then -1 else 1
220
+
in
221
+
(* p is in [2^(np-1), 2^np)
222
+
q is in [2^(nq-1), 2^nq)
223
+
We define n,p',q' such that p'/q'*2^n=p/q and |p'/q'| is in [1, 2). *)
224
+
let n = np - nq in
225
+
(* Scaling p/q by 2^n *)
226
+
let (p', q') =
227
+
if n >= 0
228
+
then (p, Z.shift_left q n)
229
+
else (Z.shift_left p (-n), q)
230
+
in
231
+
let (p', n) =
232
+
if Z.geq (Z.abs p') q'
233
+
then (p', n)
234
+
else (Z.shift_left p' 1, pred n)
235
+
in
236
+
(* If we divided p' by q' now, the resulting quotient would
237
+
have one significant digit. *)
238
+
let p' = Z.shift_left p' 54 in
239
+
(* When we divide p' by q' next, the resulting quotient will
240
+
have 55 significant digits. The strategy is:
241
+
- First, compute the quotient with 55 significant digits in
242
+
round-to-odd, and
243
+
- Second, round that number to the number of effective
244
+
significant digits we desire for the result, which is 53
245
+
for a normal result and less than 53 for a subnormal result.
246
+
We cannot afford an intermediate rounding at 53 significant digits
247
+
if the end-result is subnormal. See
248
+
https://github.com/ocaml/Zarith/issues/29 *)
249
+
(* Euclidean division of p' by q' *)
250
+
let (quo, rem) = Z.ediv_rem p' q' in
251
+
if n <= -1080
252
+
then
253
+
(* The end result is +0.0 or -0.0 (depending on negat)
254
+
or perhaps the next floating-point number of the same
255
+
sign (depending on the current rounding mode. *)
256
+
ldexp (float_of_int negat) (-1080)
257
+
else
258
+
let offset =
259
+
if n <= -1023
260
+
then
261
+
(* The end result will be subnormal, add an offset
262
+
to make the rounding happen directly at the place
263
+
where it should happend.
264
+
quo has the form: 1xxxx...
265
+
we add: 1000000...
266
+
so as to end up with: 101xxxx... *)
267
+
Z.shift_left (Z.of_int negat) (55 + (-1023 - n))
268
+
else
269
+
Z.zero
270
+
in
271
+
let quo = Z.add offset quo in
272
+
let quo =
273
+
if Z.sign rem = 0
274
+
then quo
275
+
else Z.logor Z.one quo (* round to odd *)
276
+
in
277
+
(* The FPU rounding mode affects the Z.to_float that comes next,
278
+
making the rounding computed according to the current FPU rounding
279
+
mode. *)
280
+
let f = Z.to_float quo in
281
+
(* The subtraction that comes next is exact, so that the rounding
282
+
mode does not change what it does. *)
283
+
let f = f -. (Z.to_float offset)
284
+
in
285
+
(* ldexp is also exact and unaffected by the rounding mode.
286
+
We have made sure that if the end result is going to be subnormal,
287
+
then f has exactly the correct number of significant digits for
288
+
no rounding to happen here. *)
289
+
ldexp f (n - 54)
290
+
end
291
+
292
+
(* operations *)
293
+
(* ---------- *)
294
+
295
+
let neg x =
296
+
mk (Z.neg x.num) x.den
297
+
(* neg undef = undef
298
+
neg inf = -inf
299
+
neg -inf = inf
300
+
*)
301
+
302
+
let abs x =
303
+
mk (Z.abs x.num) x.den
304
+
(* abs undef = undef
305
+
abs inf = abs -inf = inf
306
+
*)
307
+
308
+
(* addition or substraction (zaors) of finite numbers *)
309
+
let aors zaors x y =
310
+
if x.den == y.den then (* implies equality,
311
+
especially if immediate value and not a pointer,
312
+
in particular in the case den = 1 *)
313
+
make_real (zaors x.num y.num) x.den
314
+
else
315
+
make_real
316
+
(zaors
317
+
(Z.mul x.num y.den)
318
+
(Z.mul y.num x.den))
319
+
(Z.mul x.den y.den)
320
+
321
+
let add x y =
322
+
if x.den == Z.zero || y.den == Z.zero then match classify x, classify y with
323
+
| ZERO,_ -> y
324
+
| _,ZERO -> x
325
+
| UNDEF,_ | _,UNDEF -> undef
326
+
| INF,MINF | MINF,INF -> undef
327
+
| INF,_ | _,INF -> inf
328
+
| MINF,_ | _,MINF -> minus_inf
329
+
| NZERO,NZERO -> failwith "impossible case"
330
+
else
331
+
aors Z.add x y
332
+
(* undef + x = x + undef = undef
333
+
inf + -inf = -inf + inf = undef
334
+
inf + x = x + inf = inf
335
+
-inf + x = x + -inf = -inf
336
+
*)
337
+
338
+
let sub x y =
339
+
if x.den == Z.zero || y.den == Z.zero then match classify x, classify y with
340
+
| ZERO,_ -> neg y
341
+
| _,ZERO -> x
342
+
| UNDEF,_ | _,UNDEF -> undef
343
+
| INF,INF | MINF,MINF -> undef
344
+
| INF,_ | _,MINF -> inf
345
+
| MINF,_ | _,INF -> minus_inf
346
+
| NZERO,NZERO -> failwith "impossible case"
347
+
else
348
+
aors Z.sub x y
349
+
(* sub x y = add x (neg y) *)
350
+
351
+
let mul x y =
352
+
if x.den == Z.zero || y.den == Z.zero then
353
+
mk
354
+
(Z.of_int ((Z.sign x.num) * (Z.sign y.num)))
355
+
Z.zero
356
+
else
357
+
make_real (Z.mul x.num y.num) (Z.mul x.den y.den)
358
+
359
+
(* undef * x = x * undef = undef
360
+
0 * inf = inf * 0 = 0 * -inf = -inf * 0 = undef
361
+
inf * x = x * inf = sign x * inf
362
+
-inf * x = x * -inf = - sign x * inf
363
+
*)
364
+
365
+
let inv x =
366
+
match Z.sign x.num with
367
+
| 1 -> mk x.den x.num
368
+
| -1 -> mk (Z.neg x.den) (Z.neg x.num)
369
+
| _ -> if x.den == Z.zero then undef else inf
370
+
(* 1 / undef = undef
371
+
1 / inf = 1 / -inf = 0
372
+
1 / 0 = inf
373
+
374
+
note that: inv (inv -inf) = inf <> -inf
375
+
*)
376
+
377
+
let div x y =
378
+
if Z.sign y.num >= 0
379
+
then mul x (mk y.den y.num)
380
+
else mul x (mk (Z.neg y.den) (Z.neg y.num))
381
+
(* undef / x = x / undef = undef
382
+
0 / 0 = undef
383
+
inf / inf = inf / -inf = -inf / inf = -inf / -inf = undef
384
+
0 / inf = 0 / -inf = x / inf = x / -inf = 0
385
+
inf / x = sign x * inf
386
+
-inf / x = - sign x * inf
387
+
inf / 0 = inf
388
+
-inf / 0 = -inf
389
+
x / 0 = sign x * inf
390
+
391
+
we have div x y = mul x (inv y)
392
+
*)
393
+
394
+
let mul_2exp x n =
395
+
if x.den == Z.zero then x
396
+
else make_real (Z.shift_left x.num n) x.den
397
+
398
+
let div_2exp x n =
399
+
if x.den == Z.zero then x
400
+
else make_real x.num (Z.shift_left x.den n)
401
+
402
+
403
+
type supported_base =
404
+
| B2 | B8 | B10 | B16
405
+
406
+
let int_of_base = function
407
+
| B2 -> 2
408
+
| B8 -> 8
409
+
| B10 -> 10
410
+
| B16 -> 16
411
+
412
+
(* [find_in_string s ~pos ~last pred] find the first index in the string between [pos]
413
+
(inclusive) and [last] (exclusive) that satisfy the predicate [pred] *)
414
+
let rec find_in_string s ~pos ~last p =
415
+
if pos >= last
416
+
then None
417
+
else if p s.[pos]
418
+
then Some pos
419
+
else find_in_string s ~pos:(pos + 1) ~last p
420
+
421
+
(* The current implementation supports plain decimals, decimal points,
422
+
scientific notation ('e' or 'E' for base 10 litteral and 'p' or 'P'
423
+
for base 16), and fraction of integers (eg. 1/2). In particular it
424
+
accepts any numeric literal accepted by OCaml's lexer.
425
+
Restrictions:
426
+
- exponents in scientific notation should fit on an integer
427
+
- scientific notation only available in hexa and decimal (as in OCaml) *)
428
+
let of_string =
429
+
(* return a boolean (true for negative) and the next offset to read *)
430
+
let parse_sign s i j =
431
+
if j < i + 1
432
+
then false, i
433
+
else
434
+
match s.[i] with
435
+
| '-' -> true , i + 1
436
+
| '+' -> false, i + 1
437
+
| _ -> false ,i
438
+
in
439
+
(* return the base and the next offset to read *)
440
+
let parse_base s i j =
441
+
if j < i + 2
442
+
then B10, i
443
+
else
444
+
match s.[i],s.[i+1] with
445
+
| '0',('x'|'X') -> B16, i + 2
446
+
| '0',('o'|'O') -> B8, i + 2
447
+
| '0',('b'|'B') -> B2, i + 2
448
+
| _ -> B10, i
449
+
in
450
+
let find_exponent_mark = function
451
+
| B10 -> (function 'e' | 'E' -> true | _ -> false)
452
+
| B16 -> (function 'p' | 'P' -> true | _ -> false)
453
+
| B8 | B2 -> (fun _ -> false)
454
+
in
455
+
let of_scientific_notation s =
456
+
let i = 0 in
457
+
let j = String.length s in
458
+
let sign,i = parse_sign s i j in
459
+
let base,i = parse_base s i j in
460
+
(* shift left due to the exponent *)
461
+
let shift_left, j =
462
+
match find_in_string s ~pos:i ~last:j (find_exponent_mark base) with
463
+
| None -> 0, j
464
+
| Some ei ->
465
+
let pos = ei + 1 in
466
+
let ez = Z.of_substring_base 10 s ~pos ~len:(j - pos) in
467
+
Z.to_int ez, ei
468
+
in
469
+
(* shift right due to the radix *)
470
+
let z, shift_right =
471
+
match base with
472
+
| B2 | B8 -> Z.of_substring_base (int_of_base base) s ~pos:i ~len:(j - i), 0
473
+
| B10 | B16 ->
474
+
match find_in_string s ~pos:i ~last:j ((=) '.') with
475
+
| None -> Z.of_substring_base (int_of_base base) s ~pos:i ~len:(j - i), 0
476
+
| Some k ->
477
+
(* shift_right_factor correspond to the shift to apply when we move the decimal
478
+
point one position to the left.
479
+
480
+
0x1.1p1 = 0x11p-3 = 0x0.11p5
481
+
1.1e1 = 11e0 = 0.11e2 *)
482
+
let shift_right_factor =
483
+
match base with
484
+
| B10 -> 1
485
+
| B16 -> 4
486
+
| B2 | B8 -> assert false
487
+
in
488
+
(* We should only consider actual digits to perform the shift. *)
489
+
let num_digits = ref 0 in
490
+
for h = k + 1 to j - 1 do
491
+
match s.[h] with
492
+
| '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' ->
493
+
incr num_digits
494
+
| '_' -> ()
495
+
| _ ->
496
+
(* '-' and '+' could wrongly be accepted by Z.of_string_base *)
497
+
invalid_arg "Q.of_string: invalid digit"
498
+
done;
499
+
let first_digit_after_dot =
500
+
match find_in_string s ~pos:(k+1) ~last:j ((<>) '_') with
501
+
| None -> j
502
+
| Some x -> x
503
+
in
504
+
let shift = !num_digits * shift_right_factor in
505
+
let without_dot =
506
+
String.sub s i (k-i)
507
+
^ (String.sub s first_digit_after_dot (j - first_digit_after_dot))
508
+
in
509
+
Z.of_string_base (int_of_base base) without_dot, shift
510
+
in
511
+
let shift = shift_left - shift_right in
512
+
let exponent_pow =
513
+
match base with
514
+
| B10 -> 10
515
+
| B16 -> 2
516
+
| B8 | B2 -> 1
517
+
in
518
+
let abs =
519
+
if shift < 0 then
520
+
make z (Z.pow (Z.of_int exponent_pow) (~- shift))
521
+
else
522
+
of_bigint (Z.mul z (Z.pow (Z.of_int exponent_pow) shift))
523
+
in
524
+
if sign
525
+
then neg abs
526
+
else abs
527
+
in
528
+
function
529
+
| "" -> zero
530
+
| "inf" | "+inf" -> inf
531
+
| "-inf" -> minus_inf
532
+
| "undef" -> undef
533
+
| s ->
534
+
try
535
+
let i = String.index s '/' in
536
+
make
537
+
(Z.of_substring s ~pos:0 ~len:i)
538
+
(Z.of_substring s ~pos:(i+1) ~len:(String.length s-i-1))
539
+
with Not_found ->
540
+
of_scientific_notation s
541
+
542
+
543
+
544
+
(* printing *)
545
+
(* -------- *)
546
+
547
+
let print x = print_string (to_string x)
548
+
let output chan x = output_string chan (to_string x)
549
+
let sprint () x = to_string x
550
+
let bprint b x = Buffer.add_string b (to_string x)
551
+
let pp_print f x = Format.pp_print_string f (to_string x)
552
+
553
+
554
+
(* prefix and infix *)
555
+
(* ---------------- *)
556
+
557
+
let (~-) = neg
558
+
let (~+) x = x
559
+
let (+) = add
560
+
let (-) = sub
561
+
let ( * ) = mul
562
+
let (/) = div
563
+
let (lsl) = mul_2exp
564
+
let (asr) = div_2exp
565
+
let (~$) = of_int
566
+
let (//) = of_ints
567
+
let (~$$) = of_bigint
568
+
let (///) = make
569
+
let (=) = equal
570
+
let (<) = lt
571
+
let (>) = gt
572
+
let (<=) = leq
573
+
let (>=) = geq
574
+
let (<>) a b = not (equal a b)
+298
vendor/opam/zarith/q.mli
+298
vendor/opam/zarith/q.mli
···
1
+
(**
2
+
Rationals.
3
+
4
+
This modules builds arbitrary precision rationals on top of arbitrary
5
+
integers from module Z.
6
+
7
+
8
+
This file is part of the Zarith library
9
+
http://forge.ocamlcore.org/projects/zarith .
10
+
It is distributed under LGPL 2 licensing, with static linking exception.
11
+
See the LICENSE file included in the distribution.
12
+
13
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
14
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
15
+
a joint laboratory by:
16
+
CNRS (Centre national de la recherche scientifique, France),
17
+
ENS (École normale supérieure, Paris, France),
18
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
19
+
20
+
*)
21
+
22
+
(** {1 Types} *)
23
+
24
+
type t = {
25
+
num: Z.t; (** Numerator. *)
26
+
den: Z.t; (** Denominator, >= 0 *)
27
+
}
28
+
(** A rational is represented as a pair numerator/denominator, reduced to
29
+
have a non-negative denominator and no common factor.
30
+
This form is canonical (enabling polymorphic equality and hashing).
31
+
The representation allows three special numbers: [inf] (1/0), [-inf] (-1/0)
32
+
and [undef] (0/0).
33
+
*)
34
+
35
+
(** {1 Construction} *)
36
+
37
+
val make: Z.t -> Z.t -> t
38
+
(** [make num den] constructs a new rational equal to [num]/[den].
39
+
It takes care of putting the rational in canonical form.
40
+
*)
41
+
42
+
val zero: t
43
+
val one: t
44
+
val minus_one:t
45
+
(** 0, 1, -1. *)
46
+
47
+
val inf: t
48
+
(** 1/0. *)
49
+
50
+
val minus_inf: t
51
+
(** -1/0. *)
52
+
53
+
val undef: t
54
+
(** 0/0. *)
55
+
56
+
val of_bigint: Z.t -> t
57
+
val of_int: int -> t
58
+
val of_int32: int32 -> t
59
+
val of_int64: int64 -> t
60
+
val of_nativeint: nativeint -> t
61
+
(** Conversions from various integer types. *)
62
+
63
+
val of_ints: int -> int -> t
64
+
(** Conversion from an [int] numerator and an [int] denominator. *)
65
+
66
+
val of_float: float -> t
67
+
(** Conversion from a [float].
68
+
The conversion is exact, and maps NaN to [undef].
69
+
*)
70
+
71
+
72
+
val of_string: string -> t
73
+
(** Converts a string to a rational. Plain integers, [/] separated
74
+
integer ratios (with optional sign), decimal point and scientific
75
+
notations are understood.
76
+
Additionally, the special [inf], [-inf], and [undef] are
77
+
recognized (they can also be typeset respectively as [1/0], [-1/0],
78
+
[0/0]). *)
79
+
80
+
81
+
(** {1 Inspection} *)
82
+
83
+
val num: t -> Z.t
84
+
(** Get the numerator. *)
85
+
86
+
val den: t -> Z.t
87
+
(** Get the denominator. *)
88
+
89
+
90
+
(** {1 Testing} *)
91
+
92
+
type kind =
93
+
| ZERO (** 0 *)
94
+
| INF (** infinity, i.e. 1/0 *)
95
+
| MINF (** minus infinity, i.e. -1/0 *)
96
+
| UNDEF (** undefined, i.e., 0/0 *)
97
+
| NZERO (** well-defined, non-infinity, non-zero number *)
98
+
(** Rationals can be categorized into different kinds, depending mainly on
99
+
whether the numerator and/or denominator is null.
100
+
*)
101
+
102
+
val classify: t -> kind
103
+
(** Determines the kind of a rational. *)
104
+
105
+
val is_real: t -> bool
106
+
(** Whether the argument is non-infinity and non-undefined. *)
107
+
108
+
val sign: t -> int
109
+
(** Returns 1 if the argument is positive (including inf), -1 if it is
110
+
negative (including -inf), and 0 if it is null or undefined.
111
+
*)
112
+
113
+
val compare: t -> t -> int
114
+
(** [compare x y] compares [x] to [y] and returns 1 if [x] is strictly
115
+
greater that [y], -1 if it is strictly smaller, and 0 if they are
116
+
equal.
117
+
This is a total ordering.
118
+
Infinities are ordered in the natural way, while undefined is considered
119
+
the smallest of all: undef = undef < -inf <= -inf < x < inf <= inf.
120
+
This is consistent with OCaml's handling of floating-point infinities
121
+
and NaN.
122
+
123
+
OCaml's polymorphic comparison will NOT return a result consistent with
124
+
the ordering of rationals.
125
+
*)
126
+
127
+
val equal: t -> t -> bool
128
+
(** Equality testing.
129
+
Unlike [compare], this follows IEEE semantics: [undef] <> [undef].
130
+
*)
131
+
132
+
val min: t -> t -> t
133
+
(** Returns the smallest of its arguments. *)
134
+
135
+
val max: t -> t -> t
136
+
(** Returns the largest of its arguments. *)
137
+
138
+
val leq: t -> t -> bool
139
+
(** Less than or equal. [leq undef undef] returns false. *)
140
+
141
+
val geq: t -> t -> bool
142
+
(** Greater than or equal. [leq undef undef] returns false. *)
143
+
144
+
val lt: t -> t -> bool
145
+
(** Less than (not equal). *)
146
+
147
+
val gt: t -> t -> bool
148
+
(** Greater than (not equal). *)
149
+
150
+
151
+
(** {1 Conversions} *)
152
+
153
+
val to_bigint: t -> Z.t
154
+
val to_int: t -> int
155
+
val to_int32: t -> int32
156
+
val to_int64: t -> int64
157
+
val to_nativeint: t -> nativeint
158
+
(** Convert to integer by truncation.
159
+
Raises a [Divide_by_zero] if the argument is an infinity or undefined.
160
+
Raises a [Z.Overflow] if the result does not fit in the destination
161
+
type.
162
+
*)
163
+
164
+
val to_string: t -> string
165
+
(** Converts to human-readable, base-10, [/]-separated rational. *)
166
+
167
+
val to_float: t -> float
168
+
(** Converts to a floating-point number, using the current
169
+
floating-point rounding mode. With the default rounding mode,
170
+
the result is the floating-point number closest to the given
171
+
rational; ties break to even mantissa. *)
172
+
173
+
(** {1 Arithmetic operations} *)
174
+
175
+
(**
176
+
In all operations, the result is [undef] if one argument is [undef].
177
+
Other operations can return [undef]: such as [inf]-[inf], [inf]*0, 0/0.
178
+
*)
179
+
180
+
val neg: t -> t
181
+
(** Negation. *)
182
+
183
+
val abs: t -> t
184
+
(** Absolute value. *)
185
+
186
+
val add: t -> t -> t
187
+
(** Addition. *)
188
+
189
+
val sub: t -> t -> t
190
+
(** Subtraction. We have [sub x y] = [add x (neg y)]. *)
191
+
192
+
val mul: t -> t -> t
193
+
(** Multiplication. *)
194
+
195
+
val inv: t -> t
196
+
(** Inverse.
197
+
Note that [inv 0] is defined, and equals [inf].
198
+
*)
199
+
200
+
val div: t -> t -> t
201
+
(** Division.
202
+
We have [div x y] = [mul x (inv y)], and [inv x] = [div one x].
203
+
*)
204
+
205
+
val mul_2exp: t -> int -> t
206
+
(** [mul_2exp x n] multiplies [x] by 2 to the power of [n]. *)
207
+
208
+
val div_2exp: t -> int -> t
209
+
(** [div_2exp x n] divides [x] by 2 to the power of [n]. *)
210
+
211
+
212
+
(** {1 Printing} *)
213
+
214
+
val print: t -> unit
215
+
(** Prints the argument on the standard output. *)
216
+
217
+
val output: out_channel -> t -> unit
218
+
(** Prints the argument on the specified channel.
219
+
Also intended to be used as [%a] format printer in [Printf.printf].
220
+
*)
221
+
222
+
val sprint: unit -> t -> string
223
+
(** To be used as [%a] format printer in [Printf.sprintf]. *)
224
+
225
+
val bprint: Buffer.t -> t -> unit
226
+
(** To be used as [%a] format printer in [Printf.bprintf]. *)
227
+
228
+
val pp_print: Format.formatter -> t -> unit
229
+
(** Prints the argument on the specified formatter.
230
+
Also intended to be used as [%a] format printer in [Format.printf].
231
+
*)
232
+
233
+
234
+
(** {1 Prefix and infix operators} *)
235
+
236
+
(**
237
+
Classic prefix and infix [int] operators are redefined on [t].
238
+
*)
239
+
240
+
val (~-): t -> t
241
+
(** Negation [neg]. *)
242
+
243
+
val (~+): t -> t
244
+
(** Identity. *)
245
+
246
+
val (+): t -> t -> t
247
+
(** Addition [add]. *)
248
+
249
+
val (-): t -> t -> t
250
+
(** Subtraction [sub]. *)
251
+
252
+
val ( * ): t -> t -> t
253
+
(** Multiplication [mul]. *)
254
+
255
+
val (/): t -> t -> t
256
+
(** Division [div]. *)
257
+
258
+
val (lsl): t -> int -> t
259
+
(** Multiplication by a power of two [mul_2exp]. *)
260
+
261
+
val (asr): t -> int -> t
262
+
(** Division by a power of two [shift_right]. *)
263
+
264
+
val (~$): int -> t
265
+
(** Conversion from [int]. *)
266
+
267
+
val (//): int -> int -> t
268
+
(** Creates a rational from two [int]s. *)
269
+
270
+
val (~$$): Z.t -> t
271
+
(** Conversion from [Z.t]. *)
272
+
273
+
val (///): Z.t -> Z.t -> t
274
+
(** Creates a rational from two [Z.t]. *)
275
+
276
+
val (=): t -> t -> bool
277
+
(** Same as [equal].
278
+
@since 1.8 *)
279
+
280
+
val (<): t -> t -> bool
281
+
(** Same as [lt].
282
+
@since 1.8 *)
283
+
284
+
val (>): t -> t -> bool
285
+
(** Same as [gt].
286
+
@since 1.8 *)
287
+
288
+
val (<=): t -> t -> bool
289
+
(** Same as [leq].
290
+
@since 1.8 *)
291
+
292
+
val (>=): t -> t -> bool
293
+
(** Same as [geq].
294
+
@since 1.8 *)
295
+
296
+
val (<>): t -> t -> bool
297
+
(** [a <> b] is equivalent to [not (equal a b)].
298
+
@since 1.8 *)
+73
vendor/opam/zarith/tests/Makefile
+73
vendor/opam/zarith/tests/Makefile
···
1
+
ifeq ($(wildcard $(STDLIBDIR)/big_int.cmi),)
2
+
HAS_NUM=false
3
+
NUMS_CMA=
4
+
NUMS_CMXA=
5
+
else
6
+
HAS_NUM=true
7
+
NUMS_CMA=nums.cma
8
+
NUMS_CMXA=nums.cmxa
9
+
endif
10
+
11
+
include ../Makefile.config
12
+
13
+
test:: zq.exe
14
+
@echo "Testing zq (native)..."
15
+
@if ./zq.exe | cmp -s zq.output$(WORDSIZE) - ; then echo "zq: passed"; else echo "zq: FAILED"; exit 2; fi
16
+
17
+
test:: zq.byt
18
+
@echo "Testing zq (bytecode)..."
19
+
@if ocamlrun -I .. ./zq.byt | cmp -s zq.output$(WORDSIZE) - ; then echo "zq: passed"; else echo "zq: FAILED"; exit 2; fi
20
+
21
+
ifeq ($(HAS_NUM),true)
22
+
test:: bi.exe
23
+
@echo "Testing bi..."
24
+
@if ./bi.exe; then echo "bi: passed"; else echo "bi: FAILED"; exit 2; fi
25
+
endif
26
+
27
+
test:: pi.exe
28
+
@echo "Testing pi..."
29
+
@if ./pi.exe 500 | cmp -s pi.output - ; then echo "pi: passed"; else echo "pi: FAILED"; exit 2; fi
30
+
31
+
test:: tofloat.exe
32
+
@echo "Testing tofloat..."
33
+
@./tofloat.exe
34
+
35
+
test:: ofstring.exe
36
+
@echo "Testing ofstring..."
37
+
@./ofstring.exe
38
+
39
+
test:: chi2.exe
40
+
@echo "Testing random number generation..."
41
+
@if ./chi2.exe; then echo "chi2: passed"; else echo "chi2: FAILED"; exit 2; fi
42
+
43
+
bench:: timings.exe
44
+
./timings.exe
45
+
46
+
bench:: pi.exe
47
+
@echo "Benchmarking pi"; time ./pi.exe 10000 > /dev/null
48
+
49
+
test:: tst_extract.exe
50
+
@echo "Testing extract..."
51
+
@if ./tst_extract.exe; then echo "tst_extract: passed"; else echo "tst_extract: FAILED"; exit 2; fi
52
+
53
+
test:: intern.exe
54
+
@echo "Testing unmarshaling..."
55
+
@if ./intern.exe extern.data32 | cmp -s intern.output32$(WORDSIZE) -; then echo "intern 32: passed"; else echo "intern 32: failed"; exit 2; fi
56
+
@if ./intern.exe extern.data64 | cmp -s intern.output64$(WORDSIZE) -; then echo "intern 64: passed"; else echo "intern 64: failed"; exit 2; fi
57
+
58
+
extern.data$(WORDSIZE): extern.exe
59
+
./extern.exe extern.data$(WORDSIZE)
60
+
61
+
tofloat.exe: tofloat.ml setround.$(OBJSUFFIX) ../zarith.cmxa
62
+
ocamlopt -I .. -ccopt "-L.." zarith.cmxa -o tofloat.exe \
63
+
setround.$(OBJSUFFIX) tofloat.ml
64
+
65
+
%.exe: %.ml ../zarith.cmxa
66
+
ocamlopt -I .. -ccopt "-L.." zarith.cmxa $(NUMS_CMXA) -o $*.exe $*.ml
67
+
%.byt: %.ml ../zarith.cma
68
+
ocamlc -I .. -ccopt "-L.." zarith.cma $(NUMS_CMA) -o $*.byt $*.ml
69
+
%.$(OBJSUFFIX): %.c
70
+
ocamlc -c $*.c
71
+
72
+
clean:
73
+
rm -f *.cm[iox] *.o *.obj *.exe *.byt
+198
vendor/opam/zarith/tests/bi.ml
+198
vendor/opam/zarith/tests/bi.ml
···
1
+
(* stress test, using random and corner cases
2
+
compares Big_int_Z, a Big_int compatible interface for Z, to OCaml's
3
+
reference Big_int library
4
+
5
+
This file is part of the Zarith library
6
+
http://forge.ocamlcore.org/projects/zarith .
7
+
It is distributed under LGPL 2 licensing, with static linking exception.
8
+
See the LICENSE file included in the distribution.
9
+
10
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
11
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
12
+
a joint laboratory by:
13
+
CNRS (Centre national de la recherche scientifique, France),
14
+
ENS (École normale supérieure, Paris, France),
15
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
16
+
17
+
*)
18
+
19
+
20
+
module B = Big_int (* reference library *)
21
+
22
+
module T = Big_int_Z (* tested library *)
23
+
24
+
25
+
(* randomness *)
26
+
27
+
let _ = Random.init 42
28
+
29
+
let random_int64 () =
30
+
let a,b,c = Random.bits(), Random.bits(), Random.bits () in
31
+
let a,b,c = Int64.of_int a, Int64.of_int b, Int64.of_int c in
32
+
let a,b,c = Int64.shift_left a 60, Int64.shift_left b 30, c in
33
+
Int64.logor a (Int64.logor b c)
34
+
35
+
let random_int () = Int64.to_int (random_int64 ())
36
+
37
+
let random_string () =
38
+
let l = 1 + Random.int 200 in
39
+
let s = Buffer.create l in
40
+
let st = if l > 1 && Random.bool () then begin
41
+
Buffer.add_char s '-';
42
+
1
43
+
end else 0 in
44
+
for i = st to l - 1 do
45
+
Buffer.add_char s (Char.chr (48 + Random.int 10))
46
+
done;
47
+
Buffer.contents s
48
+
49
+
50
+
(* list utility *)
51
+
52
+
let list_make n f =
53
+
let rec doit i acc = if i < 0 then acc else doit (i-1) ((f i)::acc) in
54
+
doit (n-1) []
55
+
56
+
57
+
(* interesting numbers, as big_int *)
58
+
59
+
let p = (list_make 128 (B.shift_left_big_int B.unit_big_int))
60
+
let pn = p @ (List.map B.minus_big_int p)
61
+
let g_list =
62
+
[B.zero_big_int] @
63
+
pn @ (List.map B.succ_big_int pn) @ (List.map B.pred_big_int pn) @
64
+
(list_make 128 (fun _ -> B.big_int_of_int (random_int ()))) @
65
+
(list_make 128 (fun _ -> B.big_int_of_string (random_string())))
66
+
67
+
let sh_list = list_make 256 (fun x -> x)
68
+
let pow_list = [1;2;3;4;5;6;7;8;9;10;20;55]
69
+
70
+
(* conversion to Z *)
71
+
72
+
let g_t_list =
73
+
Printf.printf "converting %i numbers\n%!" (List.length g_list);
74
+
List.map
75
+
(fun g ->
76
+
let t = T.big_int_of_string (B.string_of_big_int g) in
77
+
let g' = B.big_int_of_string (T.string_of_big_int t) in
78
+
if B.compare_big_int g g' <> 0 then failwith (Printf.sprintf "string_of_big_int failure: %s" (B.string_of_big_int g));
79
+
g, t
80
+
)
81
+
g_list
82
+
83
+
let rec cut_list n l =
84
+
if n <= 0 then [] else match l with [] -> [] | h :: t -> h :: cut_list (n-1) t
85
+
86
+
let small_g_t_list = cut_list 256 g_t_list
87
+
88
+
(* operator tests *)
89
+
90
+
let test_un msg filt gf tf =
91
+
Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list);
92
+
List.iter
93
+
(fun (g,t) ->
94
+
try
95
+
if filt g then (
96
+
let g' = gf g and t' = tf t in
97
+
if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg=%s Bresult=%s Tresult=%s" msg (B.string_of_big_int g) (B.string_of_big_int g') (T.string_of_big_int t'))
98
+
)
99
+
with Failure _ -> ()
100
+
) g_t_list
101
+
102
+
let test_bin_gen msg filt gf tf l =
103
+
Printf.printf "testing %s on %i x %i numbers\n%!" msg (List.length l) (List.length l);
104
+
List.iter
105
+
(fun (g1,t1) ->
106
+
List.iter
107
+
(fun (g2,t2) ->
108
+
if filt (g1,g2) then (
109
+
let g' = gf g1 g2 and t' = tf t1 t2 in
110
+
if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%s Bresult=%s Tresult=%s" msg (B.string_of_big_int g1) (B.string_of_big_int g2) (B.string_of_big_int g') (T.string_of_big_int t'))
111
+
)
112
+
) l
113
+
) l
114
+
115
+
let test_bin msg filt gf tf = test_bin_gen msg filt gf tf g_t_list
116
+
let test_bin_small msg filt gf tf = test_bin_gen msg filt gf tf small_g_t_list
117
+
118
+
let test_shift msg gf tf =
119
+
Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list);
120
+
List.iter
121
+
(fun s ->
122
+
List.iter
123
+
(fun (g,t) ->
124
+
let g' = gf g s and t' = tf t s in
125
+
if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%i Bresult=%s Tresult=%s" msg (B.string_of_big_int g) s (B.string_of_big_int g') (T.string_of_big_int t'))
126
+
) g_t_list
127
+
) sh_list
128
+
129
+
let test_pow msg gf tf =
130
+
Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list);
131
+
List.iter
132
+
(fun s ->
133
+
List.iter
134
+
(fun (g,t) ->
135
+
let g' = gf g s and t' = tf t s in
136
+
if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%i Bresult=%s Tresult=%s" msg (B.string_of_big_int g) s (B.string_of_big_int g') (T.string_of_big_int t'))
137
+
) g_t_list
138
+
) pow_list
139
+
140
+
let test_comparison msg gf tf l =
141
+
Printf.printf "testing %s on %i x %i numbers\n%!" msg (List.length l) (List.length l);
142
+
List.iter
143
+
(fun (g1,t1) ->
144
+
List.iter
145
+
(fun (g2,t2) ->
146
+
let g' = gf g1 g2 and t' = tf t1 t2 in
147
+
if g' <> t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%s" msg (B.string_of_big_int g1) (B.string_of_big_int g2))
148
+
) l
149
+
) l
150
+
151
+
let filt_none _ = true
152
+
let filt_pos x = B.sign_big_int x >= 0
153
+
let filt_nonzero2 (_,d) = B.sign_big_int d <> 0
154
+
let filt_pos2 (x,y) = B.sign_big_int x >= 0 && B.sign_big_int y >= 0
155
+
let filt_nonzero22 (x,y) = B.sign_big_int x <> 0 && B.sign_big_int y <> 0
156
+
157
+
let ffst f x = fst (f x)
158
+
let fsnd f x = snd (f x)
159
+
let ffst2 f x y = fst (f x y)
160
+
let fsnd2 f x y = snd (f x y)
161
+
162
+
let _ = test_un "int_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_int (T.int_of_big_int x))
163
+
let _ = test_un "int32_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_int32 (T.int32_of_big_int x))
164
+
let _ = test_un "int64_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_int64 (T.int64_of_big_int x))
165
+
let _ = test_un "nativeint_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_nativeint (T.nativeint_of_big_int x))
166
+
let _ = test_un "string_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_string (T.string_of_big_int x))
167
+
168
+
let _ = test_un "minus_big_int" filt_none B.minus_big_int T.minus_big_int
169
+
let _ = test_un "abs_big_int" filt_none B.abs_big_int T.abs_big_int
170
+
let _ = test_un "succ_big_int"filt_none B.succ_big_int T.succ_big_int
171
+
let _ = test_un "pred_big_int" filt_none B.pred_big_int T.pred_big_int
172
+
let _ = test_un "sqrt_big_int" filt_pos B.sqrt_big_int T.sqrt_big_int
173
+
174
+
let _ = test_bin "add_big_int" filt_none B.add_big_int T.add_big_int
175
+
let _ = test_bin "sub_big_int" filt_none B.sub_big_int T.sub_big_int
176
+
let _ = test_bin "mult_big_int" filt_none B.mult_big_int T.mult_big_int
177
+
let _ = test_bin_small "div_big_int" filt_nonzero2 B.div_big_int T.div_big_int
178
+
let _ = test_bin_small "quomod_big_int #1" filt_nonzero2 (ffst2 B.quomod_big_int) (ffst2 T.quomod_big_int)
179
+
let _ = test_bin_small "quomod_big_int #2" filt_nonzero2 (fsnd2 B.quomod_big_int) (fsnd2 T.quomod_big_int)
180
+
let _ = test_bin_small "mod_big_int" filt_nonzero2 B.mod_big_int T.mod_big_int
181
+
let _ = test_bin_small "gcd_big_int" filt_nonzero22 B.gcd_big_int T.gcd_big_int
182
+
183
+
let _ = test_bin "and_big_int" filt_pos2 B.and_big_int T.and_big_int
184
+
let _ = test_bin "or_big_int" filt_pos2 B.or_big_int T.or_big_int
185
+
let _ = test_bin "xor_big_int" filt_pos2 B.xor_big_int T.xor_big_int
186
+
187
+
let _ = test_shift "shift_left_big_int" B.shift_left_big_int T.shift_left_big_int
188
+
let _ = test_shift "shift_right_big_int" B.shift_right_big_int T.shift_right_big_int
189
+
let _ = test_shift "shift_right_towards_zero_big_int" B.shift_right_towards_zero_big_int T.shift_right_towards_zero_big_int
190
+
191
+
let _ = test_pow "power_big_int_positive_int" B.power_big_int_positive_int T.power_big_int_positive_int
192
+
193
+
let _ = test_comparison "compare" B.compare_big_int Z.compare g_t_list
194
+
let _ = test_comparison "equal" B.eq_big_int Z.equal g_t_list
195
+
let _ = test_comparison "lt" B.lt_big_int (fun x y -> x < y) g_t_list
196
+
let _ = test_comparison "ge" B.ge_big_int (fun x y -> x >= y) g_t_list
197
+
198
+
let _ = Printf.printf "All tests passed!\n"
+60
vendor/opam/zarith/tests/chi2.ml
+60
vendor/opam/zarith/tests/chi2.ml
···
1
+
(* Accumulate [n] samples from function [f] and check the chi-square.
2
+
Assumes [f] returns integers in the [0..255] range. *)
3
+
4
+
let chisquare n f =
5
+
let r = 256 in
6
+
let freq = Array.make r 0 in
7
+
for i = 0 to n - 1 do
8
+
let t = f () in freq.(t) <- freq.(t) + 1
9
+
done;
10
+
let expected = float n /. float r in
11
+
let t =
12
+
Array.fold_left
13
+
(fun s x -> let d = float x -. expected in d *. d +. s)
14
+
0.0 freq in
15
+
let chi2 = t /. expected in
16
+
let degfree = float r -. 1.0 in
17
+
(* The degree of freedom is high, so we approximate as a normal
18
+
distribution with mean equal to degfree and variance 2 * degfree.
19
+
Four sigmas correspond to a 99.9968% confidence interval.
20
+
(Without the approximation, the confidence interval seems to be 99.986%.)
21
+
*)
22
+
chi2 <= degfree +. 4.0 *. sqrt (2.0 *. degfree)
23
+
24
+
let failed = ref false
25
+
26
+
let test_base name f =
27
+
if not (chisquare 100_000 f) then begin
28
+
Printf.printf "%s: suspicious result\n%!" name;
29
+
failed := true
30
+
end
31
+
32
+
let test name f =
33
+
(* Test the low 8 bits of the result of f *)
34
+
test_base name (fun () -> Z.to_int (Z.logand (f ()) (Z.of_int 0xFF)))
35
+
36
+
let p = Z.of_string "35742549198872617291353508656626642567"
37
+
38
+
let _ =
39
+
test "random_bits 15 (bits 0-7)"
40
+
(fun () -> Z.random_bits 15);
41
+
test "random_bits 32 (bits 12-19)"
42
+
(fun () -> Z.(shift_right (random_bits 32) 12));
43
+
test "random_bits 31 (bits 23-30)"
44
+
(fun () -> Z.(shift_right (random_bits 31) 23));
45
+
test "random_int 2^30 (bits 0-7)"
46
+
(fun () -> Z.(random_int (shift_left one 30)));
47
+
test "random_int 2^30 (bits 21-28)"
48
+
(fun () -> Z.(shift_right (random_int (shift_left one 30)) 21));
49
+
test "random_int (256 * p) / p"
50
+
(let bound = Z.shift_left p 8 in
51
+
fun () -> Z.(div (random_int bound) p));
52
+
(* Also test our hash function, why not? *)
53
+
test_base "hash (random_int p) (bits 0-7)"
54
+
(fun () -> Z.(hash (random_int p)) land 0xFF);
55
+
test_base "hash (random_int p) (bits 16-23)"
56
+
(fun () -> (Z.(hash (random_int p)) lsr 16) land 0xFF);
57
+
exit (if !failed then 2 else 0)
58
+
59
+
60
+
vendor/opam/zarith/tests/extern.data32
vendor/opam/zarith/tests/extern.data32
This is a binary file and will not be displayed.
vendor/opam/zarith/tests/extern.data64
vendor/opam/zarith/tests/extern.data64
This is a binary file and will not be displayed.
+14
vendor/opam/zarith/tests/extern.ml
+14
vendor/opam/zarith/tests/extern.ml
···
1
+
(* Marshal some interesting big integers to the given file *)
2
+
3
+
let _ =
4
+
let file = Sys.argv.(1) in
5
+
let oc = open_out_bin file in
6
+
for nbits = 16 to 128 do
7
+
let x = Z.shift_left Z.one nbits in
8
+
output_value oc (Z.pred (Z.neg x));
9
+
output_value oc (Z.neg x);
10
+
output_value oc (Z.pred x);
11
+
output_value oc x
12
+
done;
13
+
close_out oc
14
+
+24
vendor/opam/zarith/tests/intern.ml
+24
vendor/opam/zarith/tests/intern.ml
···
1
+
(* Unmarshal big integers from the given file, and report errors *)
2
+
3
+
open Printf
4
+
5
+
let expect ic n =
6
+
try
7
+
let m = (input_value ic : Z.t) in
8
+
if Z.equal m n then printf " OK" else printf " Wrong"
9
+
with Failure _ ->
10
+
printf " Fail"
11
+
12
+
let _ =
13
+
let file = Sys.argv.(1) in
14
+
let ic = open_in_bin file in
15
+
for nbits = 16 to 128 do
16
+
printf "%d:" nbits;
17
+
let x = Z.shift_left Z.one nbits in
18
+
expect ic (Z.pred (Z.neg x));
19
+
expect ic (Z.neg x);
20
+
expect ic (Z.pred x);
21
+
expect ic x;
22
+
print_newline()
23
+
done;
24
+
close_in ic
+113
vendor/opam/zarith/tests/intern.output3232
+113
vendor/opam/zarith/tests/intern.output3232
···
1
+
16: OK OK OK OK
2
+
17: OK OK OK OK
3
+
18: OK OK OK OK
4
+
19: OK OK OK OK
5
+
20: OK OK OK OK
6
+
21: OK OK OK OK
7
+
22: OK OK OK OK
8
+
23: OK OK OK OK
9
+
24: OK OK OK OK
10
+
25: OK OK OK OK
11
+
26: OK OK OK OK
12
+
27: OK OK OK OK
13
+
28: OK OK OK OK
14
+
29: OK OK OK OK
15
+
30: OK OK OK OK
16
+
31: OK OK OK OK
17
+
32: OK OK OK OK
18
+
33: OK OK OK OK
19
+
34: OK OK OK OK
20
+
35: OK OK OK OK
21
+
36: OK OK OK OK
22
+
37: OK OK OK OK
23
+
38: OK OK OK OK
24
+
39: OK OK OK OK
25
+
40: OK OK OK OK
26
+
41: OK OK OK OK
27
+
42: OK OK OK OK
28
+
43: OK OK OK OK
29
+
44: OK OK OK OK
30
+
45: OK OK OK OK
31
+
46: OK OK OK OK
32
+
47: OK OK OK OK
33
+
48: OK OK OK OK
34
+
49: OK OK OK OK
35
+
50: OK OK OK OK
36
+
51: OK OK OK OK
37
+
52: OK OK OK OK
38
+
53: OK OK OK OK
39
+
54: OK OK OK OK
40
+
55: OK OK OK OK
41
+
56: OK OK OK OK
42
+
57: OK OK OK OK
43
+
58: OK OK OK OK
44
+
59: OK OK OK OK
45
+
60: OK OK OK OK
46
+
61: OK OK OK OK
47
+
62: OK OK OK OK
48
+
63: OK OK OK OK
49
+
64: OK OK OK OK
50
+
65: OK OK OK OK
51
+
66: OK OK OK OK
52
+
67: OK OK OK OK
53
+
68: OK OK OK OK
54
+
69: OK OK OK OK
55
+
70: OK OK OK OK
56
+
71: OK OK OK OK
57
+
72: OK OK OK OK
58
+
73: OK OK OK OK
59
+
74: OK OK OK OK
60
+
75: OK OK OK OK
61
+
76: OK OK OK OK
62
+
77: OK OK OK OK
63
+
78: OK OK OK OK
64
+
79: OK OK OK OK
65
+
80: OK OK OK OK
66
+
81: OK OK OK OK
67
+
82: OK OK OK OK
68
+
83: OK OK OK OK
69
+
84: OK OK OK OK
70
+
85: OK OK OK OK
71
+
86: OK OK OK OK
72
+
87: OK OK OK OK
73
+
88: OK OK OK OK
74
+
89: OK OK OK OK
75
+
90: OK OK OK OK
76
+
91: OK OK OK OK
77
+
92: OK OK OK OK
78
+
93: OK OK OK OK
79
+
94: OK OK OK OK
80
+
95: OK OK OK OK
81
+
96: OK OK OK OK
82
+
97: OK OK OK OK
83
+
98: OK OK OK OK
84
+
99: OK OK OK OK
85
+
100: OK OK OK OK
86
+
101: OK OK OK OK
87
+
102: OK OK OK OK
88
+
103: OK OK OK OK
89
+
104: OK OK OK OK
90
+
105: OK OK OK OK
91
+
106: OK OK OK OK
92
+
107: OK OK OK OK
93
+
108: OK OK OK OK
94
+
109: OK OK OK OK
95
+
110: OK OK OK OK
96
+
111: OK OK OK OK
97
+
112: OK OK OK OK
98
+
113: OK OK OK OK
99
+
114: OK OK OK OK
100
+
115: OK OK OK OK
101
+
116: OK OK OK OK
102
+
117: OK OK OK OK
103
+
118: OK OK OK OK
104
+
119: OK OK OK OK
105
+
120: OK OK OK OK
106
+
121: OK OK OK OK
107
+
122: OK OK OK OK
108
+
123: OK OK OK OK
109
+
124: OK OK OK OK
110
+
125: OK OK OK OK
111
+
126: OK OK OK OK
112
+
127: OK OK OK OK
113
+
128: OK OK OK OK
+113
vendor/opam/zarith/tests/intern.output3264
+113
vendor/opam/zarith/tests/intern.output3264
···
1
+
16: OK OK OK OK
2
+
17: OK OK OK OK
3
+
18: OK OK OK OK
4
+
19: OK OK OK OK
5
+
20: OK OK OK OK
6
+
21: OK OK OK OK
7
+
22: OK OK OK OK
8
+
23: OK OK OK OK
9
+
24: OK OK OK OK
10
+
25: OK OK OK OK
11
+
26: OK OK OK OK
12
+
27: OK OK OK OK
13
+
28: OK OK OK OK
14
+
29: OK OK OK OK
15
+
30: Fail OK OK Fail
16
+
31: Fail Fail Fail Fail
17
+
32: Fail Fail Fail Fail
18
+
33: Fail Fail Fail Fail
19
+
34: Fail Fail Fail Fail
20
+
35: Fail Fail Fail Fail
21
+
36: Fail Fail Fail Fail
22
+
37: Fail Fail Fail Fail
23
+
38: Fail Fail Fail Fail
24
+
39: Fail Fail Fail Fail
25
+
40: Fail Fail Fail Fail
26
+
41: Fail Fail Fail Fail
27
+
42: Fail Fail Fail Fail
28
+
43: Fail Fail Fail Fail
29
+
44: Fail Fail Fail Fail
30
+
45: Fail Fail Fail Fail
31
+
46: Fail Fail Fail Fail
32
+
47: Fail Fail Fail Fail
33
+
48: Fail Fail Fail Fail
34
+
49: Fail Fail Fail Fail
35
+
50: Fail Fail Fail Fail
36
+
51: Fail Fail Fail Fail
37
+
52: Fail Fail Fail Fail
38
+
53: Fail Fail Fail Fail
39
+
54: Fail Fail Fail Fail
40
+
55: Fail Fail Fail Fail
41
+
56: Fail Fail Fail Fail
42
+
57: Fail Fail Fail Fail
43
+
58: Fail Fail Fail Fail
44
+
59: Fail Fail Fail Fail
45
+
60: Fail Fail Fail Fail
46
+
61: Fail Fail Fail Fail
47
+
62: OK Fail Fail OK
48
+
63: OK OK OK OK
49
+
64: OK OK OK OK
50
+
65: OK OK OK OK
51
+
66: OK OK OK OK
52
+
67: OK OK OK OK
53
+
68: OK OK OK OK
54
+
69: OK OK OK OK
55
+
70: OK OK OK OK
56
+
71: OK OK OK OK
57
+
72: OK OK OK OK
58
+
73: OK OK OK OK
59
+
74: OK OK OK OK
60
+
75: OK OK OK OK
61
+
76: OK OK OK OK
62
+
77: OK OK OK OK
63
+
78: OK OK OK OK
64
+
79: OK OK OK OK
65
+
80: OK OK OK OK
66
+
81: OK OK OK OK
67
+
82: OK OK OK OK
68
+
83: OK OK OK OK
69
+
84: OK OK OK OK
70
+
85: OK OK OK OK
71
+
86: OK OK OK OK
72
+
87: OK OK OK OK
73
+
88: OK OK OK OK
74
+
89: OK OK OK OK
75
+
90: OK OK OK OK
76
+
91: OK OK OK OK
77
+
92: OK OK OK OK
78
+
93: OK OK OK OK
79
+
94: OK OK OK OK
80
+
95: OK OK OK OK
81
+
96: OK OK OK OK
82
+
97: OK OK OK OK
83
+
98: OK OK OK OK
84
+
99: OK OK OK OK
85
+
100: OK OK OK OK
86
+
101: OK OK OK OK
87
+
102: OK OK OK OK
88
+
103: OK OK OK OK
89
+
104: OK OK OK OK
90
+
105: OK OK OK OK
91
+
106: OK OK OK OK
92
+
107: OK OK OK OK
93
+
108: OK OK OK OK
94
+
109: OK OK OK OK
95
+
110: OK OK OK OK
96
+
111: OK OK OK OK
97
+
112: OK OK OK OK
98
+
113: OK OK OK OK
99
+
114: OK OK OK OK
100
+
115: OK OK OK OK
101
+
116: OK OK OK OK
102
+
117: OK OK OK OK
103
+
118: OK OK OK OK
104
+
119: OK OK OK OK
105
+
120: OK OK OK OK
106
+
121: OK OK OK OK
107
+
122: OK OK OK OK
108
+
123: OK OK OK OK
109
+
124: OK OK OK OK
110
+
125: OK OK OK OK
111
+
126: OK OK OK OK
112
+
127: OK OK OK OK
113
+
128: OK OK OK OK
+113
vendor/opam/zarith/tests/intern.output6432
+113
vendor/opam/zarith/tests/intern.output6432
···
1
+
16: OK OK OK OK
2
+
17: OK OK OK OK
3
+
18: OK OK OK OK
4
+
19: OK OK OK OK
5
+
20: OK OK OK OK
6
+
21: OK OK OK OK
7
+
22: OK OK OK OK
8
+
23: OK OK OK OK
9
+
24: OK OK OK OK
10
+
25: OK OK OK OK
11
+
26: OK OK OK OK
12
+
27: OK OK OK OK
13
+
28: OK OK OK OK
14
+
29: OK OK OK OK
15
+
30: Fail OK OK Fail
16
+
31: Fail Fail Fail Fail
17
+
32: Fail Fail Fail Fail
18
+
33: Fail Fail Fail Fail
19
+
34: Fail Fail Fail Fail
20
+
35: Fail Fail Fail Fail
21
+
36: Fail Fail Fail Fail
22
+
37: Fail Fail Fail Fail
23
+
38: Fail Fail Fail Fail
24
+
39: Fail Fail Fail Fail
25
+
40: Fail Fail Fail Fail
26
+
41: Fail Fail Fail Fail
27
+
42: Fail Fail Fail Fail
28
+
43: Fail Fail Fail Fail
29
+
44: Fail Fail Fail Fail
30
+
45: Fail Fail Fail Fail
31
+
46: Fail Fail Fail Fail
32
+
47: Fail Fail Fail Fail
33
+
48: Fail Fail Fail Fail
34
+
49: Fail Fail Fail Fail
35
+
50: Fail Fail Fail Fail
36
+
51: Fail Fail Fail Fail
37
+
52: Fail Fail Fail Fail
38
+
53: Fail Fail Fail Fail
39
+
54: Fail Fail Fail Fail
40
+
55: Fail Fail Fail Fail
41
+
56: Fail Fail Fail Fail
42
+
57: Fail Fail Fail Fail
43
+
58: Fail Fail Fail Fail
44
+
59: Fail Fail Fail Fail
45
+
60: Fail Fail Fail Fail
46
+
61: Fail Fail Fail Fail
47
+
62: OK Fail Fail OK
48
+
63: OK OK OK OK
49
+
64: OK OK OK OK
50
+
65: OK OK OK OK
51
+
66: OK OK OK OK
52
+
67: OK OK OK OK
53
+
68: OK OK OK OK
54
+
69: OK OK OK OK
55
+
70: OK OK OK OK
56
+
71: OK OK OK OK
57
+
72: OK OK OK OK
58
+
73: OK OK OK OK
59
+
74: OK OK OK OK
60
+
75: OK OK OK OK
61
+
76: OK OK OK OK
62
+
77: OK OK OK OK
63
+
78: OK OK OK OK
64
+
79: OK OK OK OK
65
+
80: OK OK OK OK
66
+
81: OK OK OK OK
67
+
82: OK OK OK OK
68
+
83: OK OK OK OK
69
+
84: OK OK OK OK
70
+
85: OK OK OK OK
71
+
86: OK OK OK OK
72
+
87: OK OK OK OK
73
+
88: OK OK OK OK
74
+
89: OK OK OK OK
75
+
90: OK OK OK OK
76
+
91: OK OK OK OK
77
+
92: OK OK OK OK
78
+
93: OK OK OK OK
79
+
94: OK OK OK OK
80
+
95: OK OK OK OK
81
+
96: OK OK OK OK
82
+
97: OK OK OK OK
83
+
98: OK OK OK OK
84
+
99: OK OK OK OK
85
+
100: OK OK OK OK
86
+
101: OK OK OK OK
87
+
102: OK OK OK OK
88
+
103: OK OK OK OK
89
+
104: OK OK OK OK
90
+
105: OK OK OK OK
91
+
106: OK OK OK OK
92
+
107: OK OK OK OK
93
+
108: OK OK OK OK
94
+
109: OK OK OK OK
95
+
110: OK OK OK OK
96
+
111: OK OK OK OK
97
+
112: OK OK OK OK
98
+
113: OK OK OK OK
99
+
114: OK OK OK OK
100
+
115: OK OK OK OK
101
+
116: OK OK OK OK
102
+
117: OK OK OK OK
103
+
118: OK OK OK OK
104
+
119: OK OK OK OK
105
+
120: OK OK OK OK
106
+
121: OK OK OK OK
107
+
122: OK OK OK OK
108
+
123: OK OK OK OK
109
+
124: OK OK OK OK
110
+
125: OK OK OK OK
111
+
126: OK OK OK OK
112
+
127: OK OK OK OK
113
+
128: OK OK OK OK
+113
vendor/opam/zarith/tests/intern.output6464
+113
vendor/opam/zarith/tests/intern.output6464
···
1
+
16: OK OK OK OK
2
+
17: OK OK OK OK
3
+
18: OK OK OK OK
4
+
19: OK OK OK OK
5
+
20: OK OK OK OK
6
+
21: OK OK OK OK
7
+
22: OK OK OK OK
8
+
23: OK OK OK OK
9
+
24: OK OK OK OK
10
+
25: OK OK OK OK
11
+
26: OK OK OK OK
12
+
27: OK OK OK OK
13
+
28: OK OK OK OK
14
+
29: OK OK OK OK
15
+
30: OK OK OK OK
16
+
31: OK OK OK OK
17
+
32: OK OK OK OK
18
+
33: OK OK OK OK
19
+
34: OK OK OK OK
20
+
35: OK OK OK OK
21
+
36: OK OK OK OK
22
+
37: OK OK OK OK
23
+
38: OK OK OK OK
24
+
39: OK OK OK OK
25
+
40: OK OK OK OK
26
+
41: OK OK OK OK
27
+
42: OK OK OK OK
28
+
43: OK OK OK OK
29
+
44: OK OK OK OK
30
+
45: OK OK OK OK
31
+
46: OK OK OK OK
32
+
47: OK OK OK OK
33
+
48: OK OK OK OK
34
+
49: OK OK OK OK
35
+
50: OK OK OK OK
36
+
51: OK OK OK OK
37
+
52: OK OK OK OK
38
+
53: OK OK OK OK
39
+
54: OK OK OK OK
40
+
55: OK OK OK OK
41
+
56: OK OK OK OK
42
+
57: OK OK OK OK
43
+
58: OK OK OK OK
44
+
59: OK OK OK OK
45
+
60: OK OK OK OK
46
+
61: OK OK OK OK
47
+
62: OK OK OK OK
48
+
63: OK OK OK OK
49
+
64: OK OK OK OK
50
+
65: OK OK OK OK
51
+
66: OK OK OK OK
52
+
67: OK OK OK OK
53
+
68: OK OK OK OK
54
+
69: OK OK OK OK
55
+
70: OK OK OK OK
56
+
71: OK OK OK OK
57
+
72: OK OK OK OK
58
+
73: OK OK OK OK
59
+
74: OK OK OK OK
60
+
75: OK OK OK OK
61
+
76: OK OK OK OK
62
+
77: OK OK OK OK
63
+
78: OK OK OK OK
64
+
79: OK OK OK OK
65
+
80: OK OK OK OK
66
+
81: OK OK OK OK
67
+
82: OK OK OK OK
68
+
83: OK OK OK OK
69
+
84: OK OK OK OK
70
+
85: OK OK OK OK
71
+
86: OK OK OK OK
72
+
87: OK OK OK OK
73
+
88: OK OK OK OK
74
+
89: OK OK OK OK
75
+
90: OK OK OK OK
76
+
91: OK OK OK OK
77
+
92: OK OK OK OK
78
+
93: OK OK OK OK
79
+
94: OK OK OK OK
80
+
95: OK OK OK OK
81
+
96: OK OK OK OK
82
+
97: OK OK OK OK
83
+
98: OK OK OK OK
84
+
99: OK OK OK OK
85
+
100: OK OK OK OK
86
+
101: OK OK OK OK
87
+
102: OK OK OK OK
88
+
103: OK OK OK OK
89
+
104: OK OK OK OK
90
+
105: OK OK OK OK
91
+
106: OK OK OK OK
92
+
107: OK OK OK OK
93
+
108: OK OK OK OK
94
+
109: OK OK OK OK
95
+
110: OK OK OK OK
96
+
111: OK OK OK OK
97
+
112: OK OK OK OK
98
+
113: OK OK OK OK
99
+
114: OK OK OK OK
100
+
115: OK OK OK OK
101
+
116: OK OK OK OK
102
+
117: OK OK OK OK
103
+
118: OK OK OK OK
104
+
119: OK OK OK OK
105
+
120: OK OK OK OK
106
+
121: OK OK OK OK
107
+
122: OK OK OK OK
108
+
123: OK OK OK OK
109
+
124: OK OK OK OK
110
+
125: OK OK OK OK
111
+
126: OK OK OK OK
112
+
127: OK OK OK OK
113
+
128: OK OK OK OK
+292
vendor/opam/zarith/tests/ofstring.ml
+292
vendor/opam/zarith/tests/ofstring.ml
···
1
+
let pow2 n =
2
+
let rec doit acc n =
3
+
if n<=0 then acc else doit (Z.add acc acc) (n-1)
4
+
in
5
+
doit Z.one n
6
+
7
+
let p30 = pow2 30
8
+
let p62 = pow2 62
9
+
let p300 = pow2 300
10
+
let p120 = pow2 120
11
+
let p121 = pow2 121
12
+
13
+
let test_of_string_Z () =
14
+
let round_trip_Z () =
15
+
let round_trip fmt x=
16
+
(Z.equal (Z.of_string (Z.format fmt x)) x)
17
+
in
18
+
let formats = [
19
+
"%i"; "%#b"; "%#o"; "%#x"; "%#X";
20
+
"%+i"; "%#+b"; "%#+o"; "%#+x"; "%#+X";
21
+
"%+0i"; "%#+0b"; "%#+0o"; "%#+0x"; "%#+0X";
22
+
] in
23
+
let numbers =
24
+
let (+) = Z.add in
25
+
let l = [p30; p62; p30 + p62; p300; p120; p121] in
26
+
l @ (List.map Z.neg l)
27
+
in
28
+
List.iter
29
+
(fun fmt ->
30
+
assert
31
+
(
32
+
List.for_all
33
+
(fun x -> round_trip fmt x)
34
+
numbers
35
+
)
36
+
)
37
+
formats
38
+
in
39
+
let fail d f x =
40
+
try
41
+
ignore (f x);
42
+
Printf.printf "%s should fail on %s\n" d x
43
+
with _ -> ()
44
+
in
45
+
let succ d f x y =
46
+
try
47
+
let z = f x in
48
+
if Z.equal z y
49
+
then ()
50
+
else
51
+
Printf.printf
52
+
"%s(%s) returned %s, expected %s\n"
53
+
d
54
+
x
55
+
(Z.to_string z)
56
+
(Z.to_string y)
57
+
with _ ->
58
+
Printf.printf "%s failed. Expected %s\n" d (Z.to_string y)
59
+
in
60
+
let z_and_int_agree s =
61
+
let f = try Some (int_of_string s) with _ -> None in
62
+
let z = try Some (Z.of_string s) with _ -> None in
63
+
match f,z with
64
+
| None, None -> ()
65
+
| Some i, Some z ->
66
+
if not (Z.equal (Z.of_int i) z)
67
+
then
68
+
Printf.printf
69
+
"Z.of_string (%s) returned %s, expected %s\n"
70
+
s
71
+
(Z.to_string z)
72
+
(string_of_int i)
73
+
| Some i, None ->
74
+
Printf.printf
75
+
"Z.of_string (%s) failed, expected %s\n"
76
+
s
77
+
(string_of_int i)
78
+
| None, Some z ->
79
+
Printf.printf
80
+
"Z.of_string (%s) returned %s, failure expected"
81
+
s
82
+
(Z.to_string z)
83
+
in
84
+
85
+
round_trip_Z ();
86
+
87
+
fail "Z.of_string" Z.of_string "0b2";
88
+
fail "Z.of_string" Z.of_string "0o8";
89
+
fail "Z.of_string" Z.of_string "0xg";
90
+
fail "Z.of_string" Z.of_string "0xG";
91
+
fail "Z.of_string" Z.of_string "0A";
92
+
succ "Z.of_string" Z.of_string "" Z.zero;
93
+
succ "Z.of_string" Z.of_string "+" Z.zero;
94
+
succ "Z.of_string" Z.of_string "-" Z.zero;
95
+
succ "Z.of_string" Z.of_string "0x" Z.zero;
96
+
succ "Z.of_string" Z.of_string "0b" Z.zero;
97
+
98
+
fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:2) "0b2";
99
+
fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:2) "0o8";
100
+
fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:2) "0xg";
101
+
fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:2) "0xG";
102
+
fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:1) "0A";
103
+
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:0) "+" Z.zero;
104
+
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:1) "-+" Z.zero;
105
+
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:2)"--1-" (Z.minus_one);
106
+
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:2)"--1\000" (Z.minus_one);
107
+
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:2)"\000-1\000" (Z.minus_one);
108
+
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:1)"00b1" Z.zero;
109
+
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:2)"00b1" Z.zero;
110
+
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:3)"00b1" Z.one;
111
+
112
+
z_and_int_agree "_123";
113
+
z_and_int_agree "1_23";
114
+
z_and_int_agree "12_3";
115
+
z_and_int_agree "123_";
116
+
z_and_int_agree "0x_123";
117
+
z_and_int_agree "0_123";
118
+
119
+
let s = Z.format "%#b" p120 in
120
+
let n = String.length s in
121
+
for i = 0 to n - 3 do
122
+
succ "Z.of_substring"
123
+
(Z.of_substring ~pos:0 ~len:(n - i))
124
+
s
125
+
(Z.shift_right p120 i)
126
+
done
127
+
128
+
let _ = test_of_string_Z ()
129
+
130
+
let test_of_string_Q () =
131
+
let round_trip_Q () =
132
+
let round_trip fmt x=
133
+
let os = Q.of_string (Z.to_string x) in
134
+
let ob = Q.of_bigint x in
135
+
if Q.equal os ob then
136
+
true
137
+
else begin
138
+
Format.printf "%a not equal to %a\n" Q.pp_print os Q.pp_print ob;
139
+
false
140
+
end
141
+
in
142
+
let formats = [
143
+
"%i"; "%#b"; "%#o"; "%#x"; "%#X";
144
+
"%+i"; "%#+b"; "%#+o"; "%#+x"; "%#+X";
145
+
"%+0i"; "%#+0b"; "%#+0o"; "%#+0x"; "%#+0X";
146
+
] in
147
+
let numbers =
148
+
let (+) = Z.add in
149
+
let l = [p30; p62; p30 + p62; p300; p120; p121] in
150
+
(l @ (List.map Z.neg l))
151
+
in
152
+
List.iter
153
+
(fun fmt ->
154
+
assert
155
+
(
156
+
List.for_all
157
+
(fun x -> round_trip fmt x)
158
+
numbers
159
+
)
160
+
)
161
+
formats
162
+
in
163
+
let fail d f x =
164
+
try
165
+
let s = f x in
166
+
Printf.printf "%s should fail on %s. Got %s\n" d x (Q.to_string s)
167
+
with _ -> ()
168
+
in
169
+
let succ d f x y =
170
+
try
171
+
let z = f x in
172
+
if Q.equal z y
173
+
then ()
174
+
else
175
+
Printf.printf
176
+
"%s(%s) returned %s, expected %s\n"
177
+
d
178
+
x
179
+
(Q.to_string z)
180
+
(Q.to_string y)
181
+
with exc ->
182
+
Printf.printf "%s failed. Expected %s. Got %s\n" d (Q.to_string y)
183
+
(Printexc.to_string exc)
184
+
in
185
+
let q_and_float_agree s =
186
+
let f = try Some (float_of_string s) with _ -> None in
187
+
let q = try Some (Q.of_string s) with _ -> None in
188
+
match f,q with
189
+
| None, None -> ()
190
+
| Some f, Some q ->
191
+
if not ((Q.to_float q) = f)
192
+
then
193
+
Printf.printf
194
+
"Q.of_string (%s) returned %s, expected %s\n"
195
+
s
196
+
(Q.to_string q)
197
+
(string_of_float f)
198
+
| Some f, None ->
199
+
Printf.printf
200
+
"Q.of_string (%s) failed, expected %s\n"
201
+
s
202
+
(string_of_float f)
203
+
| None, Some q ->
204
+
Printf.printf
205
+
"Q.of_string (%s) returned %s, failure expected"
206
+
s
207
+
(Q.to_string q)
208
+
in
209
+
210
+
211
+
round_trip_Q ();
212
+
213
+
fail "Q.of_string" Q.of_string "0b2";
214
+
fail "Q.of_string" Q.of_string "0o8";
215
+
fail "Q.of_string" Q.of_string "0xg";
216
+
fail "Q.of_string" Q.of_string "0xG";
217
+
fail "Q.of_string" Q.of_string "0A";
218
+
succ "Q.of_string" Q.of_string "" Q.zero;
219
+
succ "Q.of_string" Q.of_string "+" Q.zero;
220
+
succ "Q.of_string" Q.of_string "-" Q.zero;
221
+
succ "Q.of_string" Q.of_string "0x" Q.zero;
222
+
succ "Q.of_string" Q.of_string "0X" Q.zero;
223
+
succ "Q.of_string" Q.of_string "0o" Q.zero;
224
+
succ "Q.of_string" Q.of_string "0O" Q.zero;
225
+
succ "Q.of_string" Q.of_string "0b" Q.zero;
226
+
succ "Q.of_string" Q.of_string "0B" Q.zero;
227
+
succ "Q.of_string" Q.of_string "0b101" (Q.of_string "5");
228
+
succ "Q.of_string" Q.of_string "0B101" (Q.of_string "5");
229
+
succ "Q.of_string" Q.of_string "0o101" (Q.of_string "65");
230
+
succ "Q.of_string" Q.of_string "0O101" (Q.of_string "65");
231
+
232
+
fail "Q.of_string" Q.of_string "0b2";
233
+
fail "Q.of_string" Q.of_string "0o8";
234
+
fail "Q.of_string" Q.of_string "0xg";
235
+
fail "Q.of_string" Q.of_string "0xG";
236
+
fail "Q.of_string" Q.of_string "0A";
237
+
fail "Q.of_string" Q.of_string "-0b0.1e1";
238
+
fail "Q.of_string" Q.of_string "-0o0.1E1";
239
+
fail "Q.of_string" Q.of_string "-0b0.1P1";
240
+
fail "Q.of_string" Q.of_string "-0o0.1p1";
241
+
fail "Q.of_string" Q.of_string "-0.1P1";
242
+
fail "Q.of_string" Q.of_string "-0.1p1";
243
+
succ "Q.of_string" Q.of_string "0x1e2" (Q.of_int 482);
244
+
succ "Q.of_string" Q.of_string "1e2" (Q.of_int 100);
245
+
succ "Q.of_string" Q.of_string "+" Q.zero;
246
+
succ "Q.of_string" Q.of_string "-+" Q.zero;
247
+
succ "Q.of_string" Q.of_string "-1" Q.minus_one;
248
+
succ "Q.of_string" Q.of_string "+0xFF.8" (Q.of_float 255.5);
249
+
succ "Q.of_string" Q.of_string "+0xff.8" (Q.of_float 255.5);
250
+
succ "Q.of_string" Q.of_string "-0xFF.8" (Q.of_float (-255.5));
251
+
succ "Q.of_string" Q.of_string "-0xff.8" (Q.of_float (-255.5));
252
+
succ "Q.of_string" Q.of_string "-0.1e1" (Q.of_float (float_of_string "-0.1e1")) ;
253
+
succ "Q.of_string" Q.of_string "-0.1E1" (Q.of_float (float_of_string "-0.1E1")) ;
254
+
succ "Q.of_string" Q.of_string "-0x0.1P1" (Q.of_float (float_of_string "-0x0.1P1")) ;
255
+
succ "Q.of_string" Q.of_string "-0x0.1p1" (Q.of_float (float_of_string "-0x0.1p1")) ;
256
+
succ "Q.of_string" Q.of_string "6.674e-11" (Q.of_string "0.00000000006674") ;
257
+
258
+
q_and_float_agree "-0x0.1p1" ;
259
+
q_and_float_agree "-0x0.1P1" ;
260
+
q_and_float_agree "-0x0.1p10" ;
261
+
q_and_float_agree "-0x0.1p10" ;
262
+
263
+
q_and_float_agree "1_2.34e03";
264
+
q_and_float_agree "12_.34e03";
265
+
q_and_float_agree "12._34e03";
266
+
q_and_float_agree "12.3_4e03";
267
+
q_and_float_agree "12.34_e03";
268
+
(* float_of_string accept leading underscores after ( 'e' | 'E'), Q does not. *)
269
+
(* q_and_float_agree "12.34e_03"; *)
270
+
q_and_float_agree "12.34e0_3";
271
+
q_and_float_agree "12.34e03_";
272
+
273
+
q_and_float_agree "000_001";
274
+
q_and_float_agree "001_000";
275
+
276
+
q_and_float_agree "123.";
277
+
278
+
(* underscores right after dot are accepted. *)
279
+
q_and_float_agree "1._001";
280
+
q_and_float_agree "._001";
281
+
(* float_of_string doesn't accept strings without digits, Q and Z do (e.g. "+", "-", "0x", "." *)
282
+
(* q_and_float_agree "."; *)
283
+
(* q_and_float_agree "._"; *)
284
+
285
+
286
+
q_and_float_agree "0.x00a";
287
+
q_and_float_agree ".-001";
288
+
289
+
()
290
+
291
+
292
+
let _ = test_of_string_Q ()
+65
vendor/opam/zarith/tests/pi.ml
+65
vendor/opam/zarith/tests/pi.ml
···
1
+
(* Pi digits computed with the streaming algorithm given on pages 4, 6
2
+
& 7 of "Unbounded Spigot Algorithms for the Digits of Pi", Jeremy
3
+
Gibbons, August 2004. *)
4
+
5
+
open Printf
6
+
7
+
let zero = Z.zero
8
+
and one = Z.one
9
+
and three = Z.of_int 3
10
+
and four = Z.of_int 4
11
+
and ten = Z.of_int 10
12
+
and neg_ten = Z.of_int (-10)
13
+
;;
14
+
15
+
(* Linear Fractional (aka M=F6bius) Transformations *)
16
+
module LFT = struct
17
+
18
+
let floor_ev (q, r, s, t) x =
19
+
Z.((q * x + r) / (s * x + t))
20
+
21
+
let unit = (one, zero, zero, one)
22
+
23
+
let comp (q, r, s, t) (q', r', s', t') =
24
+
Z.(q * q' + r * s', q * r' + r * t',
25
+
s * q' + t * s', s * r' + t * t')
26
+
27
+
end
28
+
29
+
let next z = LFT.floor_ev z three
30
+
31
+
let safe z n = (n = LFT.floor_ev z four)
32
+
33
+
let prod z n = LFT.comp (ten, Z.(neg_ten * n), zero, one) z
34
+
35
+
let cons z k =
36
+
let den = 2 * k + 1 in
37
+
LFT.comp z (Z.of_int k, Z.of_int (2 * den), zero, Z.of_int den)
38
+
39
+
let rec digit k z n row col =
40
+
if n > 0 then
41
+
let y = next z in
42
+
if safe z y then
43
+
if col = 10 then (
44
+
let row = row + 10 in
45
+
printf "\t:%i\n%a" row Z.output y;
46
+
digit k (prod z y) (n - 1) row 1
47
+
)
48
+
else (
49
+
printf "%a" Z.output y;
50
+
digit k (prod z y) (n - 1) row (col + 1)
51
+
)
52
+
else digit (k + 1) (cons z k) n row col
53
+
else
54
+
printf "%*s\t:%i\n" (10 - col) "" (row + col)
55
+
56
+
let digits n = digit 1 LFT.unit n 0 0
57
+
58
+
let usage () =
59
+
prerr_endline "Usage: pi <number of digits to compute for pi>";
60
+
exit 2
61
+
62
+
let _ =
63
+
let args = Sys.argv in
64
+
if Array.length args <> 2 then usage () else
65
+
digits (int_of_string Sys.argv.(1))
+50
vendor/opam/zarith/tests/pi.output
+50
vendor/opam/zarith/tests/pi.output
···
1
+
3141592653 :10
2
+
5897932384 :20
3
+
6264338327 :30
4
+
9502884197 :40
5
+
1693993751 :50
6
+
0582097494 :60
7
+
4592307816 :70
8
+
4062862089 :80
9
+
9862803482 :90
10
+
5342117067 :100
11
+
9821480865 :110
12
+
1328230664 :120
13
+
7093844609 :130
14
+
5505822317 :140
15
+
2535940812 :150
16
+
8481117450 :160
17
+
2841027019 :170
18
+
3852110555 :180
19
+
9644622948 :190
20
+
9549303819 :200
21
+
6442881097 :210
22
+
5665933446 :220
23
+
1284756482 :230
24
+
3378678316 :240
25
+
5271201909 :250
26
+
1456485669 :260
27
+
2346034861 :270
28
+
0454326648 :280
29
+
2133936072 :290
30
+
6024914127 :300
31
+
3724587006 :310
32
+
6063155881 :320
33
+
7488152092 :330
34
+
0962829254 :340
35
+
0917153643 :350
36
+
6789259036 :360
37
+
0011330530 :370
38
+
5488204665 :380
39
+
2138414695 :390
40
+
1941511609 :400
41
+
4330572703 :410
42
+
6575959195 :420
43
+
3092186117 :430
44
+
3819326117 :440
45
+
9310511854 :450
46
+
8074462379 :460
47
+
9627495673 :470
48
+
5188575272 :480
49
+
4891227938 :490
50
+
1830119491 :500
+27
vendor/opam/zarith/tests/setround.c
+27
vendor/opam/zarith/tests/setround.c
···
1
+
/* Auxiliary function to control FP rounding mode. Assumes ISO C99. */
2
+
3
+
#include <fenv.h>
4
+
#include <caml/mlvalues.h>
5
+
6
+
#ifndef FE_DOWNWARD
7
+
#define FE_DOWNWARD (-1)
8
+
#endif
9
+
#ifndef FE_TONEAREST
10
+
#define FE_TONEAREST (-1)
11
+
#endif
12
+
#ifndef FE_TOWARDZERO
13
+
#define FE_TOWARDZERO (-1)
14
+
#endif
15
+
#ifndef FE_UPWARD
16
+
#define FE_UPWARD (-1)
17
+
#endif
18
+
19
+
static int modes[4] = {
20
+
FE_DOWNWARD, FE_TONEAREST, FE_TOWARDZERO, FE_UPWARD
21
+
};
22
+
23
+
CAMLprim value caml_ztest_setround(value vmode)
24
+
{
25
+
int rc = fesetround(modes[Int_val(vmode)]);
26
+
return Val_bool(rc == 0);
27
+
}
+154
vendor/opam/zarith/tests/timings.ml
+154
vendor/opam/zarith/tests/timings.ml
···
1
+
open Printf
2
+
3
+
(* Timing harness harness *)
4
+
5
+
let time fn arg =
6
+
let start = Sys.time() in
7
+
let rec time accu =
8
+
let qty = fn arg in
9
+
let duration = Sys.time() -. start in
10
+
let qty = float qty in
11
+
if duration >= 1.0
12
+
then duration /. (accu +. qty)
13
+
else time (accu +. qty)
14
+
in time 0.0
15
+
16
+
let time_repeat rep fn arg =
17
+
time (fun () -> for i = 1 to rep do ignore (fn arg) done; rep) ()
18
+
19
+
(* Basic arithmetic operations *)
20
+
21
+
let add (x, y) =
22
+
for i = 1 to 50_000_000 do
23
+
ignore (Sys.opaque_identity (Z.add x y))
24
+
done;
25
+
50_000_000
26
+
27
+
let sub (x, y) =
28
+
for i = 1 to 50_000_000 do
29
+
ignore (Sys.opaque_identity (Z.sub x y))
30
+
done;
31
+
50_000_000
32
+
33
+
let mul (x, y) =
34
+
for i = 1 to 50_000_000 do
35
+
ignore (Sys.opaque_identity (Z.mul x y))
36
+
done;
37
+
50_000_000
38
+
39
+
let div (x, y) =
40
+
for i = 1 to 10_000_000 do
41
+
ignore (Sys.opaque_identity (Z.div x y))
42
+
done;
43
+
1_000_000
44
+
45
+
let shl (x, y) =
46
+
for i = 1 to 50_000_000 do
47
+
ignore (Sys.opaque_identity (Z.shift_left x y))
48
+
done;
49
+
50_000_000
50
+
51
+
let big = Z.pow (Z.of_int 17) 150
52
+
let med = Z.pow (Z.of_int 3) 150
53
+
54
+
let _ =
55
+
printf "%.2e add (small, no overflow)\n%!"
56
+
(time add (Z.of_int 1, Z.of_int 2));
57
+
printf "%.2e add (small, overflow)\n%!"
58
+
(time add (Z.of_int max_int, Z.of_int 2));
59
+
printf "%.2e add (small, big)\n%!"
60
+
(time add (Z.of_int 1, big));
61
+
printf "%.2e add (big, big)\n%!"
62
+
(time add (big, big));
63
+
printf "%.2e sub (small, no overflow)\n%!"
64
+
(time sub (Z.of_int 1, Z.of_int 2));
65
+
printf "%.2e sub (small, overflow)\n%!"
66
+
(time sub (Z.of_int max_int, Z.of_int (-2)));
67
+
printf "%.2e sub (big, small)\n%!"
68
+
(time sub (big, Z.of_int 1));
69
+
printf "%.2e sub (big, big)\n%!"
70
+
(time sub (big, big));
71
+
printf "%.2e mul (small, no overflow)\n%!"
72
+
(time mul (Z.of_int 42, Z.of_int 74));
73
+
printf "%.2e mul (small, overflow)\n%!"
74
+
(time mul (Z.of_int max_int, Z.of_int 3));
75
+
printf "%.2e mul (small, big)\n%!"
76
+
(time mul (Z.of_int 3, big));
77
+
printf "%.2e mul (medium, medium)\n%!"
78
+
(time mul (med, med));
79
+
printf "%.2e mul (big, big)\n%!"
80
+
(time mul (big, big));
81
+
printf "%.2e div (small, small)\n%!"
82
+
(time div (Z.of_int 12345678, Z.of_int 443));
83
+
printf "%.2e div (big, small)\n%!"
84
+
(time div (big, Z.of_int 443));
85
+
printf "%.2e div (big, medium)\n%!"
86
+
(time div (big, med));
87
+
printf "%.2e shl (small, no overflow)\n%!"
88
+
(time shl (Z.of_int 3, 10));
89
+
printf "%.2e shl (small, overflow)\n%!"
90
+
(time shl (Z.of_int max_int, 2));
91
+
printf "%.2e shl (big)\n%!"
92
+
(time shl (big, 42))
93
+
(* Factorial *)
94
+
95
+
let rec fact_z n =
96
+
if n <= 0 then Z.one else Z.mul (Z.of_int n) (fact_z (n-1))
97
+
98
+
let _ =
99
+
printf "%.2e fact 10\n%!"
100
+
(time_repeat 1_000_000 fact_z 10);
101
+
printf "%.2e fact 40\n%!"
102
+
(time_repeat 10_000 fact_z 40);
103
+
printf "%.2e fact 200\n%!"
104
+
(time_repeat 10_000 fact_z 200)
105
+
106
+
(* Fibonacci *)
107
+
108
+
let rec fib_int n =
109
+
if n < 2 then 1 else fib_int(n-1) + fib_int(n-2)
110
+
111
+
let rec fib_natint n =
112
+
if n < 2 then 1n else Nativeint.add (fib_natint(n-1)) (fib_natint(n-2))
113
+
114
+
let rec fib_z n =
115
+
if n < 2 then Z.one else Z.add (fib_z(n-1)) (fib_z(n-2))
116
+
117
+
let fib_arg = 32
118
+
119
+
let _ =
120
+
printf "%.2e fib (int)\n%!"
121
+
(time_repeat 100 fib_int fib_arg);
122
+
printf "%.2e fib (nativeint)\n%!"
123
+
(time_repeat 100 fib_natint fib_arg);
124
+
printf "%.2e fib (Z)\n%!"
125
+
(time_repeat 100 fib_z fib_arg)
126
+
127
+
(* Takeushi *)
128
+
129
+
let rec tak_int (x, y, z) =
130
+
if x > y
131
+
then tak_int(tak_int (x-1, y, z), tak_int (y-1, z, x), tak_int (z-1, x, y))
132
+
else z
133
+
134
+
let rec tak_natint (x, y, z) =
135
+
if x > y
136
+
then tak_natint(tak_natint (Nativeint.sub x 1n, y, z),
137
+
tak_natint (Nativeint.sub y 1n, z, x),
138
+
tak_natint (Nativeint.sub z 1n, x, y))
139
+
else z
140
+
141
+
let rec tak_z (x, y, z) =
142
+
if Z.compare x y > 0
143
+
then tak_z(tak_z (Z.pred x, y, z),
144
+
tak_z (Z.pred y, z, x),
145
+
tak_z (Z.pred z, x, y))
146
+
else z
147
+
148
+
let _ =
149
+
printf "%.2e tak (int)\n%!"
150
+
(time_repeat 1000 tak_int (18,12,6));
151
+
printf "%.2e tak (nativeint)\n%!"
152
+
(time_repeat 1000 tak_natint (18n,12n,6n));
153
+
printf "%.2e tak (Z)\n%!"
154
+
(time_repeat 1000 tak_z (Z.of_int 18, Z.of_int 12, Z.of_int 6))
+134
vendor/opam/zarith/tests/tofloat.ml
+134
vendor/opam/zarith/tests/tofloat.ml
···
1
+
(* Testing Z.to_float *)
2
+
3
+
open Printf
4
+
5
+
type rounding_mode =
6
+
FE_DOWNWARD | FE_TONEAREST | FE_TOWARDZERO | FE_UPWARD
7
+
8
+
external setround: rounding_mode -> bool = "caml_ztest_setround"
9
+
10
+
external format_float: string -> float -> string = "caml_format_float"
11
+
12
+
let hex_of_float f = format_float "%a" f
13
+
14
+
(* For testing, we use randomly-generated integers of the form
15
+
<signed 64-bit integer> * 2^<exponent>
16
+
We can predict their FP value by converting the integer part to FP,
17
+
then scale by the exponent using ldexp. *)
18
+
19
+
let test1 (mant: int64) (exp: int) =
20
+
let expected = ldexp (Int64.to_float mant) exp in
21
+
let actual = Z.to_float (Z.shift_left (Z.of_int64 mant) exp) in
22
+
if actual = expected then true else begin
23
+
printf "%Ld * 2^%d: expected %s, got %s\n"
24
+
mant exp (hex_of_float expected) (hex_of_float actual);
25
+
false
26
+
end
27
+
28
+
let rnd64 () =
29
+
let m1 = Random.bits() in (* 30 bits *)
30
+
let m2 = Random.bits() in (* 30 bits *)
31
+
let m3 = Random.bits() in
32
+
Int64.(logor (of_int m1)
33
+
(logor (shift_left (of_int m2) 30)
34
+
(shift_left (of_int m3) 60)))
35
+
36
+
let testN numrounds =
37
+
printf " (%d tests)... %!" numrounds;
38
+
let errors = ref 0 in
39
+
(* Some random int64 values *)
40
+
for i = 1 to numrounds do
41
+
let m = Random.int64 Int64.max_int in
42
+
if not (test1 m 0) then incr errors;
43
+
if not (test1 (Int64.neg m) 0) then incr errors
44
+
done;
45
+
(* Some random int64 values scaled by some random power of 2 *)
46
+
for i = 1 to numrounds do
47
+
let m = rnd64() in
48
+
let exp = Random.int 1100 in (* sometimes +inf will result *)
49
+
if not (test1 m exp) then incr errors
50
+
done;
51
+
(* Special test close to a rounding point *)
52
+
for i = 0 to 15 do
53
+
let m = Int64.(add 0xfffffffffffff0L (of_int i)) in
54
+
if not (test1 m 32) then incr errors;
55
+
if not (test1 (Int64.neg m) 32) then incr errors
56
+
done;
57
+
if !errors = 0
58
+
then printf "passed\n%!"
59
+
else printf "FAILED (%d errors)\n%!" !errors
60
+
61
+
let testQ1 (mant1: int64) (exp1: int) (mant2: int64) (exp2: int) =
62
+
let expected =
63
+
ldexp (Int64.to_float mant1) exp1 /. ldexp (Int64.to_float mant2) exp2 in
64
+
let actual =
65
+
Q.to_float (Q.make (Z.shift_left (Z.of_int64 mant1) exp1)
66
+
(Z.shift_left (Z.of_int64 mant2) exp2)) in
67
+
if compare actual expected = 0 then true else begin
68
+
printf "%Ld * 2^%d / %Ld * 2^%d : expected %s, got %s\n"
69
+
mant1 exp1 mant2 exp2 (hex_of_float expected) (hex_of_float actual);
70
+
false
71
+
end
72
+
73
+
let testQN numrounds =
74
+
printf " (%d tests)... %!" numrounds;
75
+
let errors = ref 0 in
76
+
(* Some special values *)
77
+
if not (testQ1 0L 0 1L 0) then incr errors;
78
+
if not (testQ1 1L 0 0L 0) then incr errors;
79
+
if not (testQ1 (-1L) 0 0L 0) then incr errors;
80
+
if not (testQ1 0L 0 0L 0) then incr errors;
81
+
(* Some random fractions *)
82
+
for i = 1 to numrounds do
83
+
let m1 = Random.int64 0x20000000000000L in
84
+
let m1 = if Random.bool() then m1 else Int64.neg m1 in
85
+
let exp1 = Random.int 500 in
86
+
let m2 = Random.int64 0x20000000000000L in
87
+
let exp2 = Random.int 500 in
88
+
if not (testQ1 m1 exp1 m2 exp2) then incr errors
89
+
done;
90
+
if !errors = 0
91
+
then printf "passed\n%!"
92
+
else printf "FAILED (%d errors)\n%!" !errors
93
+
94
+
let _ =
95
+
let numrounds =
96
+
if Array.length Sys.argv >= 2
97
+
then int_of_string Sys.argv.(1)
98
+
else 100_000 in
99
+
printf "Default rounding mode (Z)";
100
+
testN numrounds;
101
+
printf "Default rounding mode (Q)";
102
+
testQN numrounds;
103
+
if setround FE_TOWARDZERO then begin
104
+
printf "Round toward zero (Z)";
105
+
testN numrounds;
106
+
printf "Round toward zero (Q)";
107
+
testQN numrounds
108
+
end else begin
109
+
printf "Round toward zero not supported, skipping\n"
110
+
end;
111
+
if setround FE_DOWNWARD then begin
112
+
printf "Round downward (Z)";
113
+
testN numrounds;
114
+
printf "Round downward (Q)";
115
+
testQN numrounds
116
+
end else begin
117
+
printf "Round downward not supported, skipping\n"
118
+
end;
119
+
if setround FE_UPWARD then begin
120
+
printf "Round upward (Z)";
121
+
testN numrounds;
122
+
printf "Round upward (Q)";
123
+
testQN numrounds
124
+
end else begin
125
+
printf "Round upward not supported, skipping\n"
126
+
end;
127
+
if setround FE_TONEAREST then begin
128
+
printf "Round to nearest (Z)";
129
+
testN numrounds;
130
+
printf "Round to nearest (Q)";
131
+
testQN numrounds
132
+
end else begin
133
+
printf "Round to nearest not supported, skipping\n"
134
+
end
+35
vendor/opam/zarith/tests/tst_extract.ml
+35
vendor/opam/zarith/tests/tst_extract.ml
···
1
+
module I = Z
2
+
3
+
let pr ch x =
4
+
output_string ch (I.to_string x);
5
+
flush ch
6
+
7
+
let chk_extract x o l =
8
+
let expected =
9
+
I.logand (I.shift_right x o) (I.pred (I.shift_left (I.of_int 1) l))
10
+
and actual =
11
+
I.extract x o l in
12
+
if actual <> expected then (Printf.printf "extract %a %d %d = %a found %a\n" pr x o l pr expected pr actual; failwith "test failed")
13
+
14
+
let doit () =
15
+
let max = 128 in
16
+
for l = 1 to max do
17
+
if l mod 16 == 0 then Printf.printf "%i/%i\n%!" l max;
18
+
for o = 0 to 256 do
19
+
for n = 0 to 256 do
20
+
let x = I.shift_left I.one n in
21
+
chk_extract x o l;
22
+
chk_extract (I.mul x x) o l;
23
+
chk_extract (I.mul x (I.mul x x)) o l;
24
+
chk_extract (I.succ x) o l;
25
+
chk_extract (I.pred x) o l;
26
+
chk_extract (I.neg (I.mul x x)) o l;
27
+
chk_extract (I.neg (I.mul x (I.mul x x))) o l;
28
+
chk_extract (I.neg x) o l;
29
+
chk_extract (I.neg (I.succ x)) o l;
30
+
chk_extract (I.neg (I.pred x)) o l;
31
+
done
32
+
done
33
+
done
34
+
35
+
let _ = doit ()
+920
vendor/opam/zarith/tests/zq.ml
+920
vendor/opam/zarith/tests/zq.ml
···
1
+
(* Simple tests for the Z and Q modules.
2
+
3
+
4
+
This file is part of the Zarith library
5
+
http://forge.ocamlcore.org/projects/zarith .
6
+
It is distributed under LGPL 2 licensing, with static linking exception.
7
+
See the LICENSE file included in the distribution.
8
+
9
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
10
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
11
+
a joint laboratory by:
12
+
CNRS (Centre national de la recherche scientifique, France),
13
+
ENS (École normale supérieure, Paris, France),
14
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
15
+
16
+
*)
17
+
18
+
19
+
(* testing Z *)
20
+
21
+
module I = Z
22
+
23
+
let pr ch x =
24
+
output_string ch (I.to_string x);
25
+
flush ch
26
+
27
+
let pr2 ch (x,y) =
28
+
Printf.fprintf ch "%s, %s" (I.to_string x) (I.to_string y);
29
+
flush ch
30
+
31
+
let pr3 ch (x,y,z) =
32
+
Printf.fprintf ch "%s, %s, %s"
33
+
(I.to_string x) (I.to_string y) (I.to_string z);
34
+
flush ch
35
+
36
+
let prfloat ch (x,y : float * float) =
37
+
if x = y then
38
+
Printf.fprintf ch "OK"
39
+
else
40
+
Printf.fprintf ch "WRONG! (expected %g, got %g)" y x
41
+
42
+
let prmarshal ch (x,y : I.t * I.t) =
43
+
(if I.equal x y then
44
+
Printf.fprintf ch "OK"
45
+
else
46
+
Printf.fprintf ch "WRONG! (expected %a, got %a)" pr y pr x);
47
+
flush ch
48
+
49
+
let pow2 n =
50
+
let rec doit acc n =
51
+
if n<=0 then acc else doit (I.add acc acc) (n-1)
52
+
in
53
+
doit I.one n
54
+
55
+
let fact n =
56
+
let rec doit acc n =
57
+
if n<=1 then acc
58
+
else doit (I.mul acc (I.of_int n)) (n-1)
59
+
in
60
+
doit I.one n
61
+
62
+
let pow a b =
63
+
let rec doit b =
64
+
if b <= 0 then I.one else
65
+
let acc = doit (b lsr 1) in
66
+
if b land 1 = 1 then I.mul (I.mul acc acc) (I.of_int a)
67
+
else I.mul acc acc
68
+
in
69
+
doit b
70
+
71
+
let cvt_int x =
72
+
(string_of_bool (I.fits_int x))
73
+
^","^
74
+
(try string_of_int (I.to_int x) with I.Overflow -> "ovf")
75
+
76
+
let cvt_int32 x =
77
+
(string_of_bool (I.fits_int32 x))
78
+
^","^
79
+
(try Int32.to_string (I.to_int32 x) with I.Overflow -> "ovf")
80
+
81
+
let cvt_int64 x =
82
+
(string_of_bool (I.fits_int64 x))
83
+
^","^
84
+
(try Int64.to_string (I.to_int64 x) with I.Overflow -> "ovf")
85
+
86
+
let cvt_nativeint x =
87
+
(string_of_bool (I.fits_nativeint x))
88
+
^","^
89
+
(try Nativeint.to_string (I.to_nativeint x) with I.Overflow -> "ovf")
90
+
91
+
let cvt_int32_unsigned x =
92
+
(string_of_bool (I.fits_int32_unsigned x))
93
+
^","^
94
+
(try Int32.to_string (I.to_int32_unsigned x) with I.Overflow -> "ovf")
95
+
96
+
let cvt_int64_unsigned x =
97
+
(string_of_bool (I.fits_int64_unsigned x))
98
+
^","^
99
+
(try Int64.to_string (I.to_int64_unsigned x) with I.Overflow -> "ovf")
100
+
101
+
let cvt_nativeint_unsigned x =
102
+
(string_of_bool (I.fits_nativeint_unsigned x))
103
+
^","^
104
+
(try Nativeint.to_string (I.to_nativeint_unsigned x) with I.Overflow -> "ovf")
105
+
106
+
let p2 = I.of_int 2
107
+
let p3 = I.of_int 3
108
+
let p30 = pow2 30
109
+
let p62 = pow2 62
110
+
let p300 = pow2 300
111
+
let p120 = pow2 120
112
+
let p121 = pow2 121
113
+
let maxi = I.of_int max_int
114
+
let mini = I.of_int min_int
115
+
let maxi32 = I.of_int32 Int32.max_int
116
+
let mini32 = I.of_int32 Int32.min_int
117
+
let maxi64 = I.of_int64 Int64.max_int
118
+
let mini64 = I.of_int64 Int64.min_int
119
+
let maxni = I.of_nativeint Nativeint.max_int
120
+
let minni = I.of_nativeint Nativeint.min_int
121
+
122
+
let chk_bits x =
123
+
Printf.printf "to_bits %a\n =" pr x;
124
+
String.iter (fun c -> Printf.printf " %02x" (Char.code c)) (I.to_bits x);
125
+
Printf.printf "\n";
126
+
assert(I.equal (I.abs x) (I.of_bits (I.to_bits x)));
127
+
assert((I.to_bits x) = (I.to_bits (I.neg x)));
128
+
Printf.printf "marshal round trip %a\n =" pr x;
129
+
let y = Marshal.(from_string (to_string x []) 0) in
130
+
Printf.printf " %a\n" prmarshal (y, x)
131
+
132
+
let chk_extract (x, o, l) =
133
+
let expected =
134
+
I.logand (I.shift_right x o) (I.pred (I.shift_left (I.of_int 1) l))
135
+
and actual =
136
+
I.extract x o l in
137
+
Printf.printf "extract %a %d %d = %a " pr x o l pr actual;
138
+
if I.equal actual expected
139
+
then Printf.printf "(passed)\n"
140
+
else Printf.printf "(FAILED, expected %a)\n" pr expected
141
+
142
+
let chk_signed_extract (x, o, l) =
143
+
let uns_res = I.extract x o l in
144
+
let expected =
145
+
if I.compare uns_res (I.shift_left (I.of_int 1) (l-1)) >= 0
146
+
then I.sub uns_res (I.shift_left (I.of_int 1) l)
147
+
else uns_res in
148
+
let actual =
149
+
I.signed_extract x o l in
150
+
Printf.printf "signed_extract %a %d %d = %a " pr x o l pr actual;
151
+
if I.equal actual expected
152
+
then Printf.printf "(passed)\n"
153
+
else Printf.printf "(FAILED, expected %a)\n" pr expected
154
+
155
+
let chk_numbits_tz x =
156
+
Printf.printf "numbits / trailing_zeros %a " pr x;
157
+
let n = I.numbits x and z = I.trailing_zeros x in
158
+
if
159
+
if I.equal x I.zero then
160
+
n = 0 && z = max_int
161
+
else
162
+
n > 0 && z >= 0 && z < n
163
+
&& I.leq (I.shift_left I.one (n-1)) (I.abs x)
164
+
&& I.lt (I.abs x) (I.shift_left I.one n)
165
+
&& (z = 0 || I.equal (I.extract x 0 z) I.zero)
166
+
&& I.testbit x z
167
+
then Printf.printf "(passed)\n"
168
+
else Printf.printf "(FAILED)\n"
169
+
170
+
let chk_testbit x =
171
+
Printf.printf "testbit %a " pr x;
172
+
let n = I.numbits x in
173
+
let ok = ref true in
174
+
for i = 0 to n + 64 do
175
+
let actual = I.testbit x i
176
+
and expected = I.extract x i 1 in
177
+
if not (I.equal expected (if actual then I.one else I.zero))
178
+
then begin Printf.printf "(error on %d) " i; ok := false end
179
+
done;
180
+
if !ok
181
+
then Printf.printf "(passed)\n"
182
+
else Printf.printf "(FAILED)\n"
183
+
184
+
let pr_byte =
185
+
let state = ref 0 in
186
+
fun () ->
187
+
state := (!state * 65793 + 4282663) land 0xFF_FF_FF;
188
+
!state lsr 16
189
+
190
+
let pr_bytes buf pos len =
191
+
for i = pos to pos + len - 1 do
192
+
Bytes.set_uint8 buf i (pr_byte ())
193
+
done
194
+
195
+
let test_Z() =
196
+
Printf.printf "0\n = %a\n" pr I.zero;
197
+
Printf.printf "1\n = %a\n" pr I.one;
198
+
Printf.printf "-1\n = %a\n" pr I.minus_one;
199
+
Printf.printf "42\n = %a\n" pr (I.of_int 42);
200
+
Printf.printf "1+1\n = %a\n" pr (I.add I.one I.one);
201
+
Printf.printf "1-1\n = %a\n" pr (I.sub I.one I.one);
202
+
Printf.printf "- 1\n = %a\n" pr (I.neg I.one);
203
+
Printf.printf "0-1\n = %a\n" pr (I.sub I.zero I.one);
204
+
Printf.printf "max_int\n = %a\n" pr maxi;
205
+
Printf.printf "min_int\n = %a\n" pr mini;
206
+
Printf.printf "-max_int\n = %a\n" pr (I.neg maxi);
207
+
Printf.printf "-min_int\n = %a\n" pr (I.neg mini);
208
+
Printf.printf "2^300\n = %a\n" pr p300;
209
+
Printf.printf "2^120\n = %a\n" pr p120;
210
+
Printf.printf "2^300+2^120\n = %a\n" pr (I.add p300 p120);
211
+
Printf.printf "2^300-2^120\n = %a\n" pr (I.sub p300 p120);
212
+
Printf.printf "2^300+(-(2^120))\n = %a\n" pr (I.add p300 (I.neg p120));
213
+
Printf.printf "2^120-2^300\n = %a\n" pr (I.sub p120 p300);
214
+
Printf.printf "2^120+(-(2^300))\n = %a\n" pr (I.add p120 (I.neg p300));
215
+
Printf.printf "-(2^120)+(-(2^300))\n = %a\n" pr (I.add (I.neg p120) (I.neg p300));
216
+
Printf.printf "-(2^120)-2^300\n = %a\n" pr (I.sub (I.neg p120) p300);
217
+
Printf.printf "2^300-2^300\n = %a\n" pr (I.sub p300 p300);
218
+
Printf.printf "2^121\n = %a\n" pr p121;
219
+
Printf.printf "2^121+2^120\n = %a\n" pr (I.add p121 p120);
220
+
Printf.printf "2^121-2^120\n = %a\n" pr (I.sub p121 p120);
221
+
Printf.printf "2^121+(-(2^120))\n = %a\n" pr (I.add p121 (I.neg p120));
222
+
Printf.printf "2^120-2^121\n = %a\n" pr (I.sub p120 p121);
223
+
Printf.printf "2^120+(-(2^121))\n = %a\n" pr (I.add p120 (I.neg p121));
224
+
Printf.printf "-(2^120)+(-(2^121))\n = %a\n" pr (I.add (I.neg p120) (I.neg p121));
225
+
Printf.printf "-(2^120)-2^121\n = %a\n" pr (I.sub (I.neg p120) p121);
226
+
Printf.printf "2^121+0\n = %a\n" pr (I.add p121 I.zero);
227
+
Printf.printf "2^121-0\n = %a\n" pr (I.sub p121 I.zero);
228
+
Printf.printf "0+2^121\n = %a\n" pr (I.add I.zero p121);
229
+
Printf.printf "0-2^121\n = %a\n" pr (I.sub I.zero p121);
230
+
Printf.printf "2^300+1\n = %a\n" pr (I.add p300 I.one);
231
+
Printf.printf "2^300-1\n = %a\n" pr (I.sub p300 I.one);
232
+
Printf.printf "1+2^300\n = %a\n" pr (I.add I.one p300);
233
+
Printf.printf "1-2^300\n = %a\n" pr (I.sub I.one p300);
234
+
Printf.printf "2^300+(-1)\n = %a\n" pr (I.add p300 I.minus_one);
235
+
Printf.printf "2^300-(-1)\n = %a\n" pr (I.sub p300 I.minus_one);
236
+
Printf.printf "(-1)+2^300\n = %a\n" pr (I.add I.minus_one p300);
237
+
Printf.printf "(-1)-2^300\n = %a\n" pr (I.sub I.minus_one p300);
238
+
Printf.printf "-(2^300)+1\n = %a\n" pr (I.add (I.neg p300) I.one);
239
+
Printf.printf "-(2^300)-1\n = %a\n" pr (I.sub (I.neg p300) I.one);
240
+
Printf.printf "1+(-(2^300))\n = %a\n" pr (I.add I.one (I.neg p300));
241
+
Printf.printf "1-(-(2^300))\n = %a\n" pr (I.sub I.one (I.neg p300));
242
+
Printf.printf "-(2^300)+(-1)\n = %a\n" pr (I.add (I.neg p300) I.minus_one);
243
+
Printf.printf "-(2^300)-(-1)\n = %a\n" pr (I.sub (I.neg p300) I.minus_one);
244
+
Printf.printf "(-1)+(-(2^300))\n = %a\n" pr (I.add I.minus_one (I.neg p300));
245
+
Printf.printf "(-1)-(-(2^300))\n = %a\n" pr (I.sub I.minus_one (I.neg p300));
246
+
Printf.printf "max_int+1\n = %a\n" pr (I.add maxi I.one);
247
+
Printf.printf "min_int-1\n = %a\n" pr (I.sub mini I.one);
248
+
Printf.printf "-max_int-1\n = %a\n" pr (I.sub (I.neg maxi) I.one);
249
+
Printf.printf "-min_int-1\n = %a\n" pr (I.sub (I.neg mini) I.one);
250
+
Printf.printf "5! = %a\n" pr (fact 5);
251
+
Printf.printf "12! = %a\n" pr (fact 12);
252
+
Printf.printf "15! = %a\n" pr (fact 15);
253
+
Printf.printf "20! = %a\n" pr (fact 20);
254
+
Printf.printf "25! = %a\n" pr (fact 25);
255
+
Printf.printf "50! = %a\n" pr (fact 50);
256
+
Printf.printf "2^300*2^120\n = %a\n" pr (I.mul p300 p120);
257
+
Printf.printf "2^120*2^300\n = %a\n" pr (I.mul p120 p300);
258
+
Printf.printf "2^300*(-(2^120))\n = %a\n" pr (I.mul p300 (I.neg p120));
259
+
Printf.printf "2^120*(-(2^300))\n = %a\n" pr (I.mul p120 (I.neg p300));
260
+
Printf.printf "-(2^120)*(-(2^300))\n = %a\n" pr (I.mul (I.neg p120) (I.neg p300));
261
+
Printf.printf "2^121*2^120\n = %a\n" pr (I.mul p121 p120);
262
+
Printf.printf "2^120*2^121\n = %a\n" pr (I.mul p120 p121);
263
+
Printf.printf "2^121*0\n = %a\n" pr (I.mul p121 I.zero);
264
+
Printf.printf "0*2^121\n = %a\n" pr (I.mul I.zero p121);
265
+
Printf.printf "2^300*1\n = %a\n" pr (I.mul p300 I.one);
266
+
Printf.printf "1*2^300\n = %a\n" pr (I.mul I.one p300);
267
+
Printf.printf "2^300*(-1)\n = %a\n" pr (I.mul p300 I.minus_one);
268
+
Printf.printf "(-1)*2^300\n = %a\n" pr (I.mul I.minus_one p300);
269
+
Printf.printf "-(2^300)*1\n = %a\n" pr (I.mul (I.neg p300) I.one);
270
+
Printf.printf "1*(-(2^300))\n = %a\n" pr (I.mul I.one (I.neg p300));
271
+
Printf.printf "-(2^300)*(-1)\n = %a\n" pr (I.mul (I.neg p300) I.minus_one);
272
+
Printf.printf "(-1)*(-(2^300))\n = %a\n" pr (I.mul I.minus_one (I.neg p300));
273
+
Printf.printf "1*(2^30)\n = %a\n" pr (I.mul I.one p30);
274
+
Printf.printf "1*(2^62)\n = %a\n" pr (I.mul I.one p62);
275
+
Printf.printf "(2^30)*(2^30)\n = %a\n" pr (I.mul p30 p30);
276
+
Printf.printf "(2^62)*(2^62)\n = %a\n" pr (I.mul p62 p62);
277
+
Printf.printf "0+1\n = %a\n" pr (I.succ I.zero);
278
+
Printf.printf "1+1\n = %a\n" pr (I.succ I.one);
279
+
Printf.printf "-1+1\n = %a\n" pr (I.succ I.minus_one);
280
+
Printf.printf "2+1\n = %a\n" pr (I.succ p2);
281
+
Printf.printf "-2+1\n = %a\n" pr (I.succ (I.neg p2));
282
+
Printf.printf "(2^300)+1\n = %a\n" pr (I.succ p300);
283
+
Printf.printf "-(2^300)+1\n = %a\n" pr (I.succ (I.neg p300));
284
+
Printf.printf "0-1\n = %a\n" pr (I.pred I.zero);
285
+
Printf.printf "1-1\n = %a\n" pr (I.pred I.one);
286
+
Printf.printf "-1-1\n = %a\n" pr (I.pred I.minus_one);
287
+
Printf.printf "2-1\n = %a\n" pr (I.pred p2);
288
+
Printf.printf "-2-1\n = %a\n" pr (I.pred (I.neg p2));
289
+
Printf.printf "(2^300)-1\n = %a\n" pr (I.pred p300);
290
+
Printf.printf "-(2^300)-1\n = %a\n" pr (I.pred (I.neg p300));
291
+
Printf.printf "max_int+1\n = %a\n" pr (I.succ maxi);
292
+
Printf.printf "min_int-1\n = %a\n" pr (I.pred mini);
293
+
Printf.printf "-max_int-1\n = %a\n" pr (I.pred (I.neg maxi));
294
+
Printf.printf "-min_int-1\n = %a\n" pr (I.pred (I.neg mini));
295
+
Printf.printf "abs(0)\n = %a\n" pr (I.abs I.zero);
296
+
Printf.printf "abs(1)\n = %a\n" pr (I.abs I.one);
297
+
Printf.printf "abs(-1)\n = %a\n" pr (I.abs I.minus_one);
298
+
Printf.printf "abs(min_int)\n = %a\n" pr (I.abs mini);
299
+
Printf.printf "abs(2^300)\n = %a\n" pr (I.abs p300);
300
+
Printf.printf "abs(-(2^300))\n = %a\n" pr (I.abs (I.neg p300));
301
+
Printf.printf "max_nativeint\n = %a\n" pr maxni;
302
+
Printf.printf "max_int32\n = %a\n" pr maxi32;
303
+
Printf.printf "max_int64\n = %a\n" pr maxi64;
304
+
Printf.printf "to_int 1\n = %s\n" (cvt_int I.one);
305
+
Printf.printf "to_int max_int\n = %s\n" (cvt_int maxi);
306
+
Printf.printf "to_int max_nativeint\n = %s\n" (cvt_int maxni);
307
+
Printf.printf "to_int max_int32\n = %s\n" (cvt_int maxi32);
308
+
Printf.printf "to_int max_int64\n = %s\n" (cvt_int maxi64);
309
+
Printf.printf "to_int32 1\n = %s\n" (cvt_int32 I.one);
310
+
Printf.printf "to_int32 max_int\n = %s\n" (cvt_int32 maxi);
311
+
Printf.printf "to_int32 max_nativeint\n = %s\n" (cvt_int32 maxni);
312
+
Printf.printf "to_int32 max_int32\n = %s\n" (cvt_int32 maxi32);
313
+
Printf.printf "to_int32 max_int64\n = %s\n" (cvt_int32 maxi64);
314
+
Printf.printf "to_int64 1\n = %s\n" (cvt_int64 I.one);
315
+
Printf.printf "to_int64 max_int\n = %s\n" (cvt_int64 maxi);
316
+
Printf.printf "to_int64 max_nativeint\n = %s\n" (cvt_int64 maxni);
317
+
Printf.printf "to_int64 max_int32\n = %s\n" (cvt_int64 maxi32);
318
+
Printf.printf "to_int64 max_int64\n = %s\n" (cvt_int64 maxi64);
319
+
Printf.printf "to_nativeint 1\n = %s\n" (cvt_nativeint I.one);
320
+
Printf.printf "to_nativeint max_int\n = %s\n" (cvt_nativeint maxi);
321
+
Printf.printf "to_nativeint max_nativeint\n = %s\n" (cvt_nativeint maxni);
322
+
Printf.printf "to_nativeint max_int32\n = %s\n" (cvt_nativeint maxi32);
323
+
Printf.printf "to_nativeint max_int64\n = %s\n" (cvt_nativeint maxi64);
324
+
Printf.printf "to_int -min_int\n = %s\n" (cvt_int (I.neg mini));
325
+
Printf.printf "to_int -min_nativeint\n = %s\n" (cvt_int (I.neg minni));
326
+
Printf.printf "to_int -min_int32\n = %s\n" (cvt_int (I.neg mini32));
327
+
Printf.printf "to_int -min_int64\n = %s\n" (cvt_int (I.neg mini64));
328
+
Printf.printf "to_int32 -min_int\n = %s\n" (cvt_int32 (I.neg mini));
329
+
Printf.printf "to_int32 -min_nativeint\n = %s\n" (cvt_int32 (I.neg minni));
330
+
Printf.printf "to_int32 -min_int32\n = %s\n" (cvt_int32 (I.neg mini32));
331
+
Printf.printf "to_int32 -min_int64\n = %s\n" (cvt_int32(I.neg mini64));
332
+
Printf.printf "to_int64 -min_int\n = %s\n" (cvt_int64 (I.neg mini));
333
+
Printf.printf "to_int64 -min_nativeint\n = %s\n" (cvt_int64 (I.neg minni));
334
+
Printf.printf "to_int64 -min_int32\n = %s\n" (cvt_int64 (I.neg mini32));
335
+
Printf.printf "to_int64 -min_int64\n = %s\n" (cvt_int64 (I.neg mini64));
336
+
Printf.printf "to_nativeint -min_int\n = %s\n" (cvt_nativeint (I.neg mini));
337
+
Printf.printf "to_nativeint -min_nativeint\n = %s\n" (cvt_nativeint (I.neg minni));
338
+
Printf.printf "to_nativeint -min_int32\n = %s\n" (cvt_nativeint (I.neg mini32));
339
+
Printf.printf "to_nativeint -min_int64\n = %s\n" (cvt_nativeint (I.neg mini64));
340
+
Printf.printf "to_int32_unsigned 1\n = %s\n" (cvt_int32_unsigned I.one);
341
+
Printf.printf "to_int32_unsigned -1\n = %s\n" (cvt_int32_unsigned I.minus_one);
342
+
Printf.printf "to_int32_unsigned max_int\n = %s\n" (cvt_int32_unsigned maxi);
343
+
Printf.printf "to_int32_unsigned max_nativeint\n = %s\n" (cvt_int32_unsigned maxni);
344
+
Printf.printf "to_int32_unsigned max_int32\n = %s\n" (cvt_int32_unsigned maxi32);
345
+
Printf.printf "to_int32_unsigned 2max_int32\n = %s\n" (cvt_int32_unsigned (I.mul p2 maxi32));
346
+
Printf.printf "to_int32_unsigned 3max_int32\n = %s\n" (cvt_int32_unsigned (I.mul p3 maxi32));
347
+
Printf.printf "to_int32_unsigned max_int64\n = %s\n" (cvt_int32_unsigned maxi64);
348
+
Printf.printf "to_int64_unsigned 1\n = %s\n" (cvt_int64_unsigned I.one);
349
+
Printf.printf "to_int64_unsigned -1\n = %s\n" (cvt_int64_unsigned I.minus_one);
350
+
Printf.printf "to_int64_unsigned max_int\n = %s\n" (cvt_int64_unsigned maxi);
351
+
Printf.printf "to_int64_unsigned max_nativeint\n = %s\n" (cvt_int64_unsigned maxni);
352
+
Printf.printf "to_int64_unsigned max_int32\n = %s\n" (cvt_int64_unsigned maxi32);
353
+
Printf.printf "to_int64_unsigned max_int64\n = %s\n" (cvt_int64_unsigned maxi64);
354
+
Printf.printf "to_int64_unsigned 2max_int64\n = %s\n" (cvt_int64_unsigned (I.mul p2 maxi64));
355
+
Printf.printf "to_int64_unsigned 3max_int64\n = %s\n" (cvt_int64_unsigned (I.mul p3 maxi64));
356
+
Printf.printf "to_nativeint_unsigned 1\n = %s\n" (cvt_nativeint_unsigned I.one);
357
+
Printf.printf "to_nativeint_unsigned -1\n = %s\n" (cvt_nativeint_unsigned I.minus_one);
358
+
Printf.printf "to_nativeint_unsigned max_int\n = %s\n" (cvt_nativeint_unsigned maxi);
359
+
Printf.printf "to_nativeint_unsigned max_nativeint\n = %s\n" (cvt_nativeint_unsigned maxni);
360
+
Printf.printf "to_nativeint_unsigned 2max_nativeint\n = %s\n" (cvt_nativeint_unsigned (I.mul p2 maxni));
361
+
Printf.printf "to_nativeint_unsigned max_int32\n = %s\n" (cvt_nativeint_unsigned maxi32);
362
+
Printf.printf "to_nativeint_unsigned max_int64\n = %s\n" (cvt_nativeint_unsigned maxi64);
363
+
Printf.printf "to_nativeint_unsigned 2max_int64\n = %s\n" (cvt_nativeint_unsigned (I.mul p2 maxi64));
364
+
Printf.printf "to_nativeint_unsigned 3max_int64\n = %s\n" (cvt_nativeint_unsigned (I.mul p3 maxi64));
365
+
Printf.printf "of_int32_unsigned -1\n = %a\n" pr (I.of_int32_unsigned (-1l));
366
+
Printf.printf "of_int64_unsigned -1\n = %a\n" pr (I.of_int64_unsigned (-1L));
367
+
Printf.printf "of_nativeint_unsigned -1\n = %a\n" pr (I.of_nativeint_unsigned (-1n));
368
+
369
+
Printf.printf "of_float 1.\n = %a\n" pr (I.of_float 1.);
370
+
Printf.printf "of_float -1.\n = %a\n" pr (I.of_float (-. 1.));
371
+
Printf.printf "of_float pi\n = %a\n" pr (I.of_float (2. *. acos 0.));
372
+
Printf.printf "of_float 2^30\n = %a\n" pr (I.of_float (ldexp 1. 30));
373
+
Printf.printf "of_float 2^31\n = %a\n" pr (I.of_float (ldexp 1. 31));
374
+
Printf.printf "of_float 2^32\n = %a\n" pr (I.of_float (ldexp 1. 32));
375
+
Printf.printf "of_float 2^33\n = %a\n" pr (I.of_float (ldexp 1. 33));
376
+
Printf.printf "of_float -2^30\n = %a\n" pr (I.of_float (-.(ldexp 1. 30)));
377
+
Printf.printf "of_float -2^31\n = %a\n" pr (I.of_float (-.(ldexp 1. 31)));
378
+
Printf.printf "of_float -2^32\n = %a\n" pr (I.of_float (-.(ldexp 1. 32)));
379
+
Printf.printf "of_float -2^33\n = %a\n" pr (I.of_float (-.(ldexp 1. 33)));
380
+
Printf.printf "of_float 2^61\n = %a\n" pr (I.of_float (ldexp 1. 61));
381
+
Printf.printf "of_float 2^62\n = %a\n" pr (I.of_float (ldexp 1. 62));
382
+
Printf.printf "of_float 2^63\n = %a\n" pr (I.of_float (ldexp 1. 63));
383
+
Printf.printf "of_float 2^64\n = %a\n" pr (I.of_float (ldexp 1. 64));
384
+
Printf.printf "of_float 2^65\n = %a\n" pr (I.of_float (ldexp 1. 65));
385
+
Printf.printf "of_float -2^61\n = %a\n" pr (I.of_float (-.(ldexp 1. 61)));
386
+
Printf.printf "of_float -2^62\n = %a\n" pr (I.of_float (-.(ldexp 1. 62)));
387
+
Printf.printf "of_float -2^63\n = %a\n" pr (I.of_float (-.(ldexp 1. 63)));
388
+
Printf.printf "of_float -2^64\n = %a\n" pr (I.of_float (-.(ldexp 1. 64)));
389
+
Printf.printf "of_float -2^65\n = %a\n" pr (I.of_float (-.(ldexp 1. 65)));
390
+
Printf.printf "of_float 2^120\n = %a\n" pr (I.of_float (ldexp 1. 120));
391
+
Printf.printf "of_float 2^300\n = %a\n" pr (I.of_float (ldexp 1. 300));
392
+
Printf.printf "of_float -2^120\n = %a\n" pr (I.of_float (-.(ldexp 1. 120)));
393
+
Printf.printf "of_float -2^300\n = %a\n" pr (I.of_float (-.(ldexp 1. 300)));
394
+
Printf.printf "of_float 0.5\n = %a\n" pr (I.of_float 0.5);
395
+
Printf.printf "of_float -0.5\n = %a\n" pr (I.of_float (-. 0.5));
396
+
Printf.printf "of_float 200.5\n = %a\n" pr (I.of_float 200.5);
397
+
Printf.printf "of_float -200.5\n = %a\n" pr (I.of_float (-. 200.5));
398
+
Printf.printf "to_float 0\n = %a\n" prfloat (I.to_float I.zero, 0.0);
399
+
Printf.printf "to_float 1\n = %a\n" prfloat (I.to_float I.one, 1.0);
400
+
Printf.printf "to_float -1\n = %a\n" prfloat (I.to_float I.minus_one, -1.0);
401
+
Printf.printf "to_float 2^120\n = %a\n" prfloat (I.to_float p120, ldexp 1.0 120);
402
+
Printf.printf "to_float -2^120\n = %a\n" prfloat (I.to_float (I.neg p120), -. (ldexp 1.0 120));
403
+
Printf.printf "to_float (2^120-1)\n = %a\n" prfloat (I.to_float (I.pred p120), ldexp 1.0 120);
404
+
Printf.printf "to_float (-2^120+1)\n = %a\n" prfloat (I.to_float (I.succ (I.neg p120)), -. (ldexp 1.0 120));
405
+
Printf.printf "to_float 2^63\n = %a\n" prfloat (I.to_float (pow2 63), ldexp 1.0 63);
406
+
Printf.printf "to_float -2^63\n = %a\n" prfloat (I.to_float (I.neg (pow2 63)), -. (ldexp 1.0 63));
407
+
Printf.printf "to_float (2^63-1)\n = %a\n" prfloat (I.to_float (I.pred (pow2 63)), ldexp 1.0 63);
408
+
Printf.printf "to_float (-2^63-1)\n = %a\n" prfloat (I.to_float (I.pred (I.neg (pow2 63))), -. (ldexp 1.0 63));
409
+
Printf.printf "to_float (-2^63+1)\n = %a\n" prfloat (I.to_float (I.succ (I.neg (pow2 63))), -. (ldexp 1.0 63));
410
+
Printf.printf "to_float 2^300\n = %a\n" prfloat (I.to_float p300, ldexp 1.0 300);
411
+
Printf.printf "to_float -2^300\n = %a\n" prfloat (I.to_float (I.neg p300), -. (ldexp 1.0 300));
412
+
Printf.printf "to_float (2^300-1)\n = %a\n" prfloat (I.to_float (I.pred p300), ldexp 1.0 300);
413
+
Printf.printf "to_float (-2^300+1)\n = %a\n" prfloat (I.to_float (I.succ (I.neg p300)), -. (ldexp 1.0 300));
414
+
Printf.printf "of_string 12\n = %a\n" pr (I.of_string "12");
415
+
Printf.printf "of_string 0x12\n = %a\n" pr (I.of_string "0x12");
416
+
Printf.printf "of_string 0b10\n = %a\n" pr (I.of_string "0b10");
417
+
Printf.printf "of_string 0o12\n = %a\n" pr (I.of_string "0o12");
418
+
Printf.printf "of_string -12\n = %a\n" pr (I.of_string "-12");
419
+
Printf.printf "of_string -0x12\n = %a\n" pr (I.of_string "-0x12");
420
+
Printf.printf "of_string -0b10\n = %a\n" pr (I.of_string "-0b10");
421
+
Printf.printf "of_string -0o12\n = %a\n" pr (I.of_string "-0o12");
422
+
Printf.printf "of_string 000123456789012345678901234567890\n = %a\n" pr (I.of_string "000123456789012345678901234567890");
423
+
Printf.printf "2^120 / 2^300 (trunc)\n = %a\n" pr (I.div p120 p300);
424
+
Printf.printf "max_int / 2 (trunc)\n = %a\n" pr (I.div maxi p2);
425
+
Printf.printf "(2^300+1) / 2^120 (trunc)\n = %a\n" pr (I.div (I.succ p300) p120);
426
+
Printf.printf "(-(2^300+1)) / 2^120 (trunc)\n = %a\n" pr (I.div (I.neg (I.succ p300)) p120);
427
+
Printf.printf "(2^300+1) / (-(2^120)) (trunc)\n = %a\n" pr (I.div (I.succ p300) (I.neg p120));
428
+
Printf.printf "(-(2^300+1)) / (-(2^120)) (trunc)\n = %a\n" pr (I.div (I.neg (I.succ p300)) (I.neg p120));
429
+
Printf.printf "2^120 / 2^300 (ceil)\n = %a\n" pr (I.cdiv p120 p300);
430
+
Printf.printf "max_int / 2 (ceil)\n = %a\n" pr (I.cdiv maxi p2);
431
+
Printf.printf "(2^300+1) / 2^120 (ceil)\n = %a\n" pr (I.cdiv (I.succ p300) p120);
432
+
Printf.printf "(-(2^300+1)) / 2^120 (ceil)\n = %a\n" pr (I.cdiv (I.neg (I.succ p300)) p120);
433
+
Printf.printf "(2^300+1) / (-(2^120)) (ceil)\n = %a\n" pr (I.cdiv (I.succ p300) (I.neg p120));
434
+
Printf.printf "(-(2^300+1)) / (-(2^120)) (ceil)\n = %a\n" pr (I.cdiv (I.neg (I.succ p300)) (I.neg p120));
435
+
Printf.printf "2^120 / 2^300 (floor)\n = %a\n" pr (I.fdiv p120 p300);
436
+
Printf.printf "max_int / 2 (floor)\n = %a\n" pr (I.fdiv maxi p2);
437
+
Printf.printf "(2^300+1) / 2^120 (floor)\n = %a\n" pr (I.fdiv (I.succ p300) p120);
438
+
Printf.printf "(-(2^300+1)) / 2^120 (floor)\n = %a\n" pr (I.fdiv (I.neg (I.succ p300)) p120);
439
+
Printf.printf "(2^300+1) / (-(2^120)) (floor)\n = %a\n" pr (I.fdiv (I.succ p300) (I.neg p120));
440
+
Printf.printf "(-(2^300+1)) / (-(2^120)) (floor)\n = %a\n" pr (I.fdiv (I.neg (I.succ p300)) (I.neg p120));
441
+
Printf.printf "2^120 %% 2^300\n = %a\n" pr (I.rem p120 p300);
442
+
Printf.printf "max_int %% 2\n = %a\n" pr (I.rem maxi p2);
443
+
Printf.printf "(2^300+1) %% 2^120\n = %a\n" pr (I.rem (I.succ p300) p120);
444
+
Printf.printf "(-(2^300+1)) %% 2^120\n = %a\n" pr (I.rem (I.neg (I.succ p300)) p120);
445
+
Printf.printf "(2^300+1) %% (-(2^120))\n = %a\n" pr (I.rem (I.succ p300) (I.neg p120));
446
+
Printf.printf "(-(2^300+1)) %% (-(2^120))\n = %a\n" pr (I.rem (I.neg (I.succ p300)) (I.neg p120));
447
+
Printf.printf "2^120 /,%% 2^300\n = %a\n" pr2 (I.div_rem p120 p300);
448
+
Printf.printf "max_int /,%% 2\n = %a\n" pr2 (I.div_rem maxi p2);
449
+
Printf.printf "(2^300+1) /,%% 2^120\n = %a\n" pr2 (I.div_rem (I.succ p300) p120);
450
+
Printf.printf "(-(2^300+1)) /,%% 2^120\n = %a\n" pr2 (I.div_rem (I.neg (I.succ p300)) p120);
451
+
Printf.printf "(2^300+1) /,%% (-(2^120))\n = %a\n" pr2 (I.div_rem (I.succ p300) (I.neg p120));
452
+
Printf.printf "(-(2^300+1)) /,%% (-(2^120))\n = %a\n" pr2 (I.div_rem (I.neg (I.succ p300)) (I.neg p120));
453
+
Printf.printf "1 & 2\n = %a\n" pr (I.logand I.one p2);
454
+
Printf.printf "1 & 2^300\n = %a\n" pr (I.logand I.one p300);
455
+
Printf.printf "2^120 & 2^300\n = %a\n" pr (I.logand p120 p300);
456
+
Printf.printf "2^300 & 2^120\n = %a\n" pr (I.logand p300 p120);
457
+
Printf.printf "2^300 & 2^300\n = %a\n" pr (I.logand p300 p300);
458
+
Printf.printf "2^300 & 0\n = %a\n" pr (I.logand p300 I.zero);
459
+
Printf.printf "-2^120 & 2^300\n = %a\n" pr (I.logand (I.neg p120) p300);
460
+
Printf.printf " 2^120 & -2^300\n = %a\n" pr (I.logand p120 (I.neg p300));
461
+
Printf.printf "-2^120 & -2^300\n = %a\n" pr (I.logand (I.neg p120) (I.neg p300));
462
+
Printf.printf "-2^300 & 2^120\n = %a\n" pr (I.logand (I.neg p300) p120);
463
+
Printf.printf " 2^300 & -2^120\n = %a\n" pr (I.logand p300 (I.neg p120));
464
+
Printf.printf "-2^300 & -2^120\n = %a\n" pr (I.logand (I.neg p300) (I.neg p120));
465
+
Printf.printf "1 | 2\n = %a\n" pr (I.logor I.one p2);
466
+
Printf.printf "1 | 2^300\n = %a\n" pr (I.logor I.one p300);
467
+
Printf.printf "2^120 | 2^300\n = %a\n" pr (I.logor p120 p300);
468
+
Printf.printf "2^300 | 2^120\n = %a\n" pr (I.logor p300 p120);
469
+
Printf.printf "2^300 | 2^300\n = %a\n" pr (I.logor p300 p300);
470
+
Printf.printf "2^300 | 0\n = %a\n" pr (I.logor p300 I.zero);
471
+
Printf.printf "-2^120 | 2^300\n = %a\n" pr (I.logor (I.neg p120) p300);
472
+
Printf.printf " 2^120 | -2^300\n = %a\n" pr (I.logor p120 (I.neg p300));
473
+
Printf.printf "-2^120 | -2^300\n = %a\n" pr (I.logor (I.neg p120) (I.neg p300));
474
+
Printf.printf "-2^300 | 2^120\n = %a\n" pr (I.logor (I.neg p300) p120);
475
+
Printf.printf " 2^300 | -2^120\n = %a\n" pr (I.logor p300 (I.neg p120));
476
+
Printf.printf "-2^300 | -2^120\n = %a\n" pr (I.logor (I.neg p300) (I.neg p120));
477
+
Printf.printf "1 ^ 2\n = %a\n" pr (I.logxor I.one p2);
478
+
Printf.printf "1 ^ 2^300\n = %a\n" pr (I.logxor I.one p300);
479
+
Printf.printf "2^120 ^ 2^300\n = %a\n" pr (I.logxor p120 p300);
480
+
Printf.printf "2^300 ^ 2^120\n = %a\n" pr (I.logxor p300 p120);
481
+
Printf.printf "2^300 ^ 2^300\n = %a\n" pr (I.logxor p300 p300);
482
+
Printf.printf "2^300 ^ 0\n = %a\n" pr (I.logxor p300 I.zero);
483
+
Printf.printf "-2^120 ^ 2^300\n = %a\n" pr (I.logxor (I.neg p120) p300);
484
+
Printf.printf " 2^120 ^ -2^300\n = %a\n" pr (I.logxor p120 (I.neg p300));
485
+
Printf.printf "-2^120 ^ -2^300\n = %a\n" pr (I.logxor (I.neg p120) (I.neg p300));
486
+
Printf.printf "-2^300 ^ 2^120\n = %a\n" pr (I.logxor (I.neg p300) p120);
487
+
Printf.printf " 2^300 ^ -2^120\n = %a\n" pr (I.logxor p300 (I.neg p120));
488
+
Printf.printf "-2^300 ^ -2^120\n = %a\n" pr (I.logxor (I.neg p300) (I.neg p120));
489
+
Printf.printf "~0\n = %a\n" pr (I.lognot I.zero);
490
+
Printf.printf "~1\n = %a\n" pr (I.lognot I.one);
491
+
Printf.printf "~2\n = %a\n" pr (I.lognot p2);
492
+
Printf.printf "~2^300\n = %a\n" pr (I.lognot p300);
493
+
Printf.printf "~(-1)\n = %a\n" pr (I.lognot I.minus_one);
494
+
Printf.printf "~(-2)\n = %a\n" pr (I.lognot (I.neg p2));
495
+
Printf.printf "~(-(2^300))\n = %a\n" pr (I.lognot (I.neg p300));
496
+
Printf.printf "0 >> 1\n = %a\n" pr (I.shift_right I.zero 1);
497
+
Printf.printf "0 >> 100\n = %a\n" pr (I.shift_right I.zero 100);
498
+
Printf.printf "2 >> 1\n = %a\n" pr (I.shift_right p2 1);
499
+
Printf.printf "2 >> 2\n = %a\n" pr (I.shift_right p2 2);
500
+
Printf.printf "2 >> 100\n = %a\n" pr (I.shift_right p2 100);
501
+
Printf.printf "2^300 >> 1\n = %a\n" pr (I.shift_right p300 1);
502
+
Printf.printf "2^300 >> 2\n = %a\n" pr (I.shift_right p300 2);
503
+
Printf.printf "2^300 >> 100\n = %a\n" pr (I.shift_right p300 100);
504
+
Printf.printf "2^300 >> 200\n = %a\n" pr (I.shift_right p300 200);
505
+
Printf.printf "2^300 >> 300\n = %a\n" pr (I.shift_right p300 300);
506
+
Printf.printf "2^300 >> 400\n = %a\n" pr (I.shift_right p300 400);
507
+
Printf.printf "-1 >> 1\n = %a\n" pr (I.shift_right I.minus_one 1);
508
+
Printf.printf "-2 >> 1\n = %a\n" pr (I.shift_right (I.neg p2) 1);
509
+
Printf.printf "-2 >> 2\n = %a\n" pr (I.shift_right (I.neg p2) 2);
510
+
Printf.printf "-2 >> 100\n = %a\n" pr (I.shift_right (I.neg p2) 100);
511
+
Printf.printf "-2^300 >> 1\n = %a\n" pr (I.shift_right (I.neg p300) 1);
512
+
Printf.printf "-2^300 >> 2\n = %a\n" pr (I.shift_right (I.neg p300) 2);
513
+
Printf.printf "-2^300 >> 100\n = %a\n" pr (I.shift_right (I.neg p300) 100);
514
+
Printf.printf "-2^300 >> 200\n = %a\n" pr (I.shift_right (I.neg p300) 200);
515
+
Printf.printf "-2^300 >> 300\n = %a\n" pr (I.shift_right (I.neg p300) 300);
516
+
Printf.printf "-2^300 >> 400\n = %a\n" pr (I.shift_right (I.neg p300) 400);
517
+
Printf.printf "0 >>0 1\n = %a\n" pr (I.shift_right_trunc I.zero 1);
518
+
Printf.printf "0 >>0 100\n = %a\n" pr (I.shift_right_trunc I.zero 100);
519
+
Printf.printf "2 >>0 1\n = %a\n" pr (I.shift_right_trunc p2 1);
520
+
Printf.printf "2 >>0 2\n = %a\n" pr (I.shift_right_trunc p2 2);
521
+
Printf.printf "2 >>0 100\n = %a\n" pr (I.shift_right_trunc p2 100);
522
+
Printf.printf "2^300 >>0 1\n = %a\n" pr (I.shift_right_trunc p300 1);
523
+
Printf.printf "2^300 >>0 2\n = %a\n" pr (I.shift_right_trunc p300 2);
524
+
Printf.printf "2^300 >>0 100\n = %a\n" pr (I.shift_right_trunc p300 100);
525
+
Printf.printf "2^300 >>0 200\n = %a\n" pr (I.shift_right_trunc p300 200);
526
+
Printf.printf "2^300 >>0 300\n = %a\n" pr (I.shift_right_trunc p300 300);
527
+
Printf.printf "2^300 >>0 400\n = %a\n" pr (I.shift_right_trunc p300 400);
528
+
Printf.printf "-1 >>0 1\n = %a\n" pr (I.shift_right_trunc I.minus_one 1);
529
+
Printf.printf "-2 >>0 1\n = %a\n" pr (I.shift_right_trunc (I.neg p2) 1);
530
+
Printf.printf "-2 >>0 2\n = %a\n" pr (I.shift_right_trunc (I.neg p2) 2);
531
+
Printf.printf "-2 >>0 100\n = %a\n" pr (I.shift_right_trunc (I.neg p2) 100);
532
+
Printf.printf "-2^300 >>0 1\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 1);
533
+
Printf.printf "-2^300 >>0 2\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 2);
534
+
Printf.printf "-2^300 >>0 100\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 100);
535
+
Printf.printf "-2^300 >>0 200\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 200);
536
+
Printf.printf "-2^300 >>0 300\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 300);
537
+
Printf.printf "-2^300 >>0 400\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 400);
538
+
Printf.printf "0 << 1\n = %a\n" pr (I.shift_left I.zero 1);
539
+
Printf.printf "0 << 100\n = %a\n" pr (I.shift_left I.zero 100);
540
+
Printf.printf "2 << 1\n = %a\n" pr (I.shift_left p2 1);
541
+
Printf.printf "2 << 32\n = %a\n" pr (I.shift_left p2 32);
542
+
Printf.printf "2 << 64\n = %a\n" pr (I.shift_left p2 64);
543
+
Printf.printf "2 << 299\n = %a\n" pr (I.shift_left p2 299);
544
+
Printf.printf "2^120 << 1\n = %a\n" pr (I.shift_left p120 1);
545
+
Printf.printf "2^120 << 180\n = %a\n" pr (I.shift_left p120 180);
546
+
Printf.printf "compare 1 2\n = %i\n" (I.compare I.one p2);
547
+
Printf.printf "compare 1 1\n = %i\n" (I.compare I.one I.one);
548
+
Printf.printf "compare 2 1\n = %i\n" (I.compare p2 I.one);
549
+
Printf.printf "compare 2^300 2^120\n = %i\n" (I.compare p300 p120);
550
+
Printf.printf "compare 2^120 2^120\n = %i\n" (I.compare p120 p120);
551
+
Printf.printf "compare 2^120 2^300\n = %i\n" (I.compare p120 p300);
552
+
Printf.printf "compare 2^121 2^120\n = %i\n" (I.compare p121 p120);
553
+
Printf.printf "compare 2^120 2^121\n = %i\n" (I.compare p120 p121);
554
+
Printf.printf "compare 2^300 -2^120\n = %i\n" (I.compare p300 (I.neg p120));
555
+
Printf.printf "compare 2^120 -2^120\n = %i\n" (I.compare p120 (I.neg p120));
556
+
Printf.printf "compare 2^120 -2^300\n = %i\n" (I.compare p120 (I.neg p300));
557
+
Printf.printf "compare -2^300 2^120\n = %i\n" (I.compare (I.neg p300) p120);
558
+
Printf.printf "compare -2^120 2^120\n = %i\n" (I.compare (I.neg p120) p120);
559
+
Printf.printf "compare -2^120 2^300\n = %i\n" (I.compare (I.neg p120) p300);
560
+
Printf.printf "compare -2^300 -2^120\n = %i\n" (I.compare (I.neg p300) (I.neg p120));
561
+
Printf.printf "compare -2^120 -2^120\n = %i\n" (I.compare (I.neg p120) (I.neg p120));
562
+
Printf.printf "compare -2^120 -2^300\n = %i\n" (I.compare (I.neg p120) (I.neg p300));
563
+
Printf.printf "equal 1 2\n = %B\n" (I.equal I.one p2);
564
+
Printf.printf "equal 1 1\n = %B\n" (I.equal I.one I.one);
565
+
Printf.printf "equal 2 1\n = %B\n" (I.equal p2 I.one);
566
+
Printf.printf "equal 2^300 2^120\n = %B\n" (I.equal p300 p120);
567
+
Printf.printf "equal 2^120 2^120\n = %B\n" (I.equal p120 p120);
568
+
Printf.printf "equal 2^120 2^300\n = %B\n" (I.equal p120 p300);
569
+
Printf.printf "equal 2^121 2^120\n = %B\n" (I.equal p121 p120);
570
+
Printf.printf "equal 2^120 2^121\n = %B\n" (I.equal p120 p121);
571
+
Printf.printf "equal 2^120 -2^120\n = %B\n" (I.equal p120 (I.neg p120));
572
+
Printf.printf "equal -2^120 2^120\n = %B\n" (I.equal (I.neg p120) p120);
573
+
Printf.printf "equal -2^120 -2^120\n = %B\n" (I.equal (I.neg p120) (I.neg p120));
574
+
Printf.printf "sign 0\n = %i\n" (I.sign I.zero);
575
+
Printf.printf "sign 1\n = %i\n" (I.sign I.one);
576
+
Printf.printf "sign -1\n = %i\n" (I.sign I.minus_one);
577
+
Printf.printf "sign 2^300\n = %i\n" (I.sign p300);
578
+
Printf.printf "sign -2^300\n = %i\n" (I.sign (I.neg p300));
579
+
Printf.printf "gcd 0 0\n = %a\n" pr (I.gcd I.zero I.zero);
580
+
Printf.printf "gcd 0 -137\n = %a\n" pr (I.gcd (I.of_int 0) (I.of_int (-137)));
581
+
Printf.printf "gcd 12 27\n = %a\n" pr (I.gcd (I.of_int 12) (I.of_int 27));
582
+
Printf.printf "gcd 27 12\n = %a\n" pr (I.gcd (I.of_int 27) (I.of_int 12));
583
+
Printf.printf "gcd 27 27\n = %a\n" pr (I.gcd (I.of_int 27) (I.of_int 27));
584
+
Printf.printf "gcd -12 27\n = %a\n" pr (I.gcd (I.of_int (-12)) (I.of_int 27));
585
+
Printf.printf "gcd 12 -27\n = %a\n" pr (I.gcd (I.of_int 12) (I.of_int (-27)));
586
+
Printf.printf "gcd -12 -27\n = %a\n" pr (I.gcd (I.of_int (-12)) (I.of_int (-27)));
587
+
Printf.printf "gcd 0 2^300\n = %a\n" pr (I.gcd (I.of_int 0) p300);
588
+
Printf.printf "gcd 2^120 2^300\n = %a\n" pr (I.gcd p120 p300);
589
+
Printf.printf "gcd 2^300 2^120\n = %a\n" pr (I.gcd p300 p120);
590
+
Printf.printf "gcd 0 -2^300\n = %a\n" pr (I.gcd (I.of_int 0) (I.neg p300));
591
+
Printf.printf "gcd 2^120 -2^300\n = %a\n" pr (I.gcd p120 (I.neg p300));
592
+
Printf.printf "gcd 2^300 -2^120\n = %a\n" pr (I.gcd p300 (I.neg p120));
593
+
Printf.printf "gcd -2^120 2^300\n = %a\n" pr (I.gcd (I.neg p120) p300);
594
+
Printf.printf "gcd -2^300 2^120\n = %a\n" pr (I.gcd (I.neg p300) p120);
595
+
Printf.printf "gcd -2^120 -2^300\n = %a\n" pr (I.gcd (I.neg p120) (I.neg p300));
596
+
Printf.printf "gcd -2^300 -2^120\n = %a\n" pr (I.gcd (I.neg p300) (I.neg p120));
597
+
Printf.printf "gcdext 12 27\n = %a\n" pr3 (I.gcdext (I.of_int 12) (I.of_int 27));
598
+
Printf.printf "gcdext 27 12\n = %a\n" pr3 (I.gcdext (I.of_int 27) (I.of_int 12));
599
+
Printf.printf "gcdext 27 27\n = %a\n" pr3 (I.gcdext (I.of_int 27) (I.of_int 27));
600
+
Printf.printf "gcdext -12 27\n = %a\n" pr3 (I.gcdext (I.of_int (-12)) (I.of_int 27));
601
+
Printf.printf "gcdext 12 -27\n = %a\n" pr3 (I.gcdext (I.of_int 12) (I.of_int (-27)));
602
+
Printf.printf "gcdext -12 -27\n = %a\n" pr3 (I.gcdext (I.of_int (-12)) (I.of_int (-27)));
603
+
Printf.printf "gcdext 2^120 2^300\n = %a\n" pr3 (I.gcdext p120 p300);
604
+
Printf.printf "gcdext 2^300 2^120\n = %a\n" pr3 (I.gcdext p300 p120);
605
+
Printf.printf "gcdext 12 0\n = %a\n" pr3 (I.gcdext (I.of_int 12) I.zero);
606
+
Printf.printf "gcdext 0 27\n = %a\n" pr3 (I.gcdext I.zero (I.of_int 27));
607
+
Printf.printf "gcdext -12 0\n = %a\n" pr3 (I.gcdext (I.of_int (-12)) I.zero);
608
+
Printf.printf "gcdext 0 -27\n = %a\n" pr3 (I.gcdext I.zero (I.of_int (-27)));
609
+
Printf.printf "gcdext 2^120 0\n = %a\n" pr3 (I.gcdext p120 I.zero);
610
+
Printf.printf "gcdext 0 2^300\n = %a\n" pr3 (I.gcdext I.zero p300);
611
+
Printf.printf "gcdext -2^120 0\n = %a\n" pr3 (I.gcdext (I.neg p120) I.zero);
612
+
Printf.printf "gcdext 0 -2^300\n = %a\n" pr3 (I.gcdext I.zero (I.neg p300));
613
+
Printf.printf "gcdext 0 0\n = %a\n" pr3 (I.gcdext I.zero I.zero);
614
+
Printf.printf "lcm 0 0 = %a\n" pr (I.lcm I.zero I.zero);
615
+
Printf.printf "lcm 10 12 = %a\n" pr (I.lcm (I.of_int 10) (I.of_int 12));
616
+
Printf.printf "lcm -10 12 = %a\n" pr (I.lcm (I.of_int (-10)) (I.of_int 12));
617
+
Printf.printf "lcm 10 -12 = %a\n" pr (I.lcm (I.of_int 10) (I.of_int (-12)));
618
+
Printf.printf "lcm -10 -12 = %a\n" pr (I.lcm (I.of_int (-10)) (I.of_int (-12)));
619
+
Printf.printf "lcm 0 12 = %a\n" pr (I.lcm I.zero (I.of_int 12));
620
+
Printf.printf "lcm 0 -12 = %a\n" pr (I.lcm I.zero (I.of_int (-12)));
621
+
Printf.printf "lcm 10 0 = %a\n" pr (I.lcm (I.of_int 10) I.zero);
622
+
Printf.printf "lcm -10 0 = %a\n" pr (I.lcm (I.of_int (-10)) I.zero);
623
+
Printf.printf "lcm 2^120 2^300 = %a\n" pr (I.lcm p120 p300);
624
+
Printf.printf "lcm 2^120 -2^300 = %a\n" pr (I.lcm p120 (I.neg p300));
625
+
Printf.printf "lcm -2^120 2^300 = %a\n" pr (I.lcm (I.neg p120) p300);
626
+
Printf.printf "lcm -2^120 -2^300 = %a\n" pr (I.lcm (I.neg p120) (I.neg p300));
627
+
Printf.printf "lcm 2^120 0 = %a\n" pr (I.lcm p120 I.zero);
628
+
Printf.printf "lcm -2^120 0 = %a\n" pr (I.lcm (I.neg p120) I.zero);
629
+
Printf.printf "is_odd 0\n = %b\n" (I.is_odd (Z.of_int 0));
630
+
Printf.printf "is_odd 1\n = %b\n" (I.is_odd (Z.of_int 1));
631
+
Printf.printf "is_odd 2\n = %b\n" (I.is_odd (Z.of_int 2));
632
+
Printf.printf "is_odd 3\n = %b\n" (I.is_odd (Z.of_int 3));
633
+
Printf.printf "is_odd 2^120\n = %b\n" (I.is_odd p120);
634
+
Printf.printf "is_odd 2^120+1\n = %b\n" (I.is_odd (Z.succ p120));
635
+
Printf.printf "is_odd 2^300\n = %b\n" (I.is_odd p300);
636
+
Printf.printf "is_odd 2^300+1\n = %b\n" (I.is_odd (Z.succ p300));
637
+
Printf.printf "sqrt 0\n = %a\n" pr (I.sqrt I.zero);
638
+
Printf.printf "sqrt 1\n = %a\n" pr (I.sqrt I.one);
639
+
Printf.printf "sqrt 2\n = %a\n" pr (I.sqrt p2);
640
+
Printf.printf "sqrt 2^120\n = %a\n" pr (I.sqrt p120);
641
+
Printf.printf "sqrt 2^121\n = %a\n" pr (I.sqrt p121);
642
+
Printf.printf "sqrt_rem 0\n = %a\n" pr2 (I.sqrt_rem I.zero);
643
+
Printf.printf "sqrt_rem 1\n = %a\n" pr2 (I.sqrt_rem I.one);
644
+
Printf.printf "sqrt_rem 2\n = %a\n" pr2 (I.sqrt_rem p2);
645
+
Printf.printf "sqrt_rem 2^120\n = %a\n" pr2 (I.sqrt_rem p120);
646
+
Printf.printf "sqrt_rem 2^121\n = %a\n" pr2 (I.sqrt_rem p121);
647
+
Printf.printf "popcount 0\n = %i\n" (I.popcount I.zero);
648
+
Printf.printf "popcount 1\n = %i\n" (I.popcount I.one);
649
+
Printf.printf "popcount 2\n = %i\n" (I.popcount p2);
650
+
Printf.printf "popcount max_int32\n = %i\n" (I.popcount maxi32);
651
+
Printf.printf "popcount 2^120\n = %i\n" (I.popcount p120);
652
+
Printf.printf "popcount (2^120-1)\n = %i\n" (I.popcount (I.pred p120));
653
+
Printf.printf "hamdist 0 0\n = %i\n" (I.hamdist I.zero I.zero);
654
+
Printf.printf "hamdist 0 1\n = %i\n" (I.hamdist I.zero I.one);
655
+
Printf.printf "hamdist 0 2^300\n = %i\n" (I.hamdist I.zero p300);
656
+
Printf.printf "hamdist 2^120 2^120\n = %i\n" (I.hamdist p120 p120);
657
+
Printf.printf "hamdist 2^120 (2^120-1)\n = %i\n" (I.hamdist p120 (I.pred p120));
658
+
Printf.printf "hamdist 2^120 2^300\n = %i\n" (I.hamdist p120 p300);
659
+
Printf.printf "hamdist (2^120-1) (2^300-1)\n = %i\n" (I.hamdist (I.pred p120) (I.pred p300));
660
+
Printf.printf "divisible 42 7\n = %B\n" (I.divisible (I.of_int 42) (I.of_int 7));
661
+
Printf.printf "divisible 43 7\n = %B\n" (I.divisible (I.of_int 43) (I.of_int 7));
662
+
Printf.printf "divisible 0 0\n = %B\n" (I.divisible I.zero I.zero);
663
+
Printf.printf "divisible 0 2^120\n = %B\n" (I.divisible I.zero p120);
664
+
Printf.printf "divisible 2 2^120\n = %B\n" (I.divisible (I.of_int 2) p120);
665
+
Printf.printf "divisible 2^300 2^120\n = %B\n" (I.divisible p300 p120);
666
+
Printf.printf "divisible (2^300-1) 32\n = %B\n" (I.divisible (I.pred p300) (I.of_int 32));
667
+
Printf.printf "divisible min_int (max_int+1)\n = %B\n" (I.divisible (I.of_int min_int) (I.succ (I.of_int max_int)));
668
+
Printf.printf "divisible (max_int+1) min_int\n = %B\n" (I.divisible (I.succ (I.of_int max_int)) (I.of_int min_int));
669
+
670
+
(* always 0 when not using custom blocks *)
671
+
Printf.printf "hash(2^120)\n = %i\n" (Hashtbl.hash p120);
672
+
Printf.printf "hash(2^121)\n = %i\n" (Hashtbl.hash p121);
673
+
Printf.printf "hash(2^300)\n = %i\n" (Hashtbl.hash p300);
674
+
(* fails if not using custom blocks *)
675
+
Printf.printf "2^120 = 2^300\n = %B\n" (p120 = p300);
676
+
Printf.printf "2^120 = 2^120\n = %B\n" (p120 = p120);
677
+
Printf.printf "2^120 = 2^120\n = %B\n" (p120 = (pow2 120));
678
+
Printf.printf "2^120 > 2^300\n = %B\n" (p120 > p300);
679
+
Printf.printf "2^120 < 2^300\n = %B\n" (p120 < p300);
680
+
Printf.printf "2^120 = 1\n = %B\n" (p120 = I.one);
681
+
(* In OCaml < 3.12.1, the order is not consistent with integers when
682
+
comparing mpn_ and ints with OCaml's polymorphic compare operator.
683
+
In OCaml >= 3.12.1, the results are consistent.
684
+
*)
685
+
Printf.printf "2^120 > 1\n = %B\n" (p120 > I.one);
686
+
Printf.printf "2^120 < 1\n = %B\n" (p120 < I.one);
687
+
Printf.printf "-2^120 > 1\n = %B\n" ((I.neg p120) > I.one);
688
+
Printf.printf "-2^120 < 1\n = %B\n" ((I.neg p120) < I.one);
689
+
Printf.printf "demarshal 2^120, 2^300, 1\n = %a\n" pr3
690
+
(Marshal.from_string (Marshal.to_string (p120,p300,I.one) []) 0);
691
+
Printf.printf "demarshal -2^120, -2^300, -1\n = %a\n" pr3
692
+
(Marshal.from_string (Marshal.to_string (I.neg p120,I.neg p300,I.minus_one) []) 0);
693
+
Printf.printf "format %%i 0 = /%s/\n" (I.format "%i" I.zero);
694
+
Printf.printf "format %%i 1 = /%s/\n" (I.format "%i" I.one);
695
+
Printf.printf "format %%i -1 = /%s/\n" (I.format "%i" I.minus_one);
696
+
Printf.printf "format %%i 2^30 = /%s/\n" (I.format "%i" p30);
697
+
Printf.printf "format %%i -2^30 = /%s/\n" (I.format "%i" (I.neg p30));
698
+
Printf.printf "format %% i 1 = /%s/\n" (I.format "% i" I.one);
699
+
Printf.printf "format %%+i 1 = /%s/\n" (I.format "%+i" I.one);
700
+
Printf.printf "format %%x 0 = /%s/\n" (I.format "%x" I.zero);
701
+
Printf.printf "format %%x 1 = /%s/\n" (I.format "%x" I.one);
702
+
Printf.printf "format %%x -1 = /%s/\n" (I.format "%x" I.minus_one);
703
+
Printf.printf "format %%x 2^30 = /%s/\n" (I.format "%x" p30);
704
+
Printf.printf "format %%x -2^30 = /%s/\n" (I.format "%x" (I.neg p30));
705
+
Printf.printf "format %%X 0 = /%s/\n" (I.format "%X" I.zero);
706
+
Printf.printf "format %%X 1 = /%s/\n" (I.format "%X" I.one);
707
+
Printf.printf "format %%X -1 = /%s/\n" (I.format "%X" I.minus_one);
708
+
Printf.printf "format %%X 2^30 = /%s/\n" (I.format "%X" p30);
709
+
Printf.printf "format %%X -2^30 = /%s/\n" (I.format "%X" (I.neg p30));
710
+
Printf.printf "format %%o 0 = /%s/\n" (I.format "%o" I.zero);
711
+
Printf.printf "format %%o 1 = /%s/\n" (I.format "%o" I.one);
712
+
Printf.printf "format %%o -1 = /%s/\n" (I.format "%o" I.minus_one);
713
+
Printf.printf "format %%o 2^30 = /%s/\n" (I.format "%o" p30);
714
+
Printf.printf "format %%o -2^30 = /%s/\n" (I.format "%o" (I.neg p30));
715
+
Printf.printf "format %%10i 0 = /%s/\n" (I.format "%10i" I.zero);
716
+
Printf.printf "format %%10i 1 = /%s/\n" (I.format "%10i" I.one);
717
+
Printf.printf "format %%10i -1 = /%s/\n" (I.format "%10i" I.minus_one);
718
+
Printf.printf "format %%10i 2^30 = /%s/\n" (I.format "%10i" p30);
719
+
Printf.printf "format %%10i -2^30 = /%s/\n" (I.format "%10i" (I.neg p30));
720
+
Printf.printf "format %%-10i 0 = /%s/\n" (I.format "%-10i" I.zero);
721
+
Printf.printf "format %%-10i 1 = /%s/\n" (I.format "%-10i" I.one);
722
+
Printf.printf "format %%-10i -1 = /%s/\n" (I.format "%-10i" I.minus_one);
723
+
Printf.printf "format %%-10i 2^30 = /%s/\n" (I.format "%-10i" p30);
724
+
Printf.printf "format %%-10i -2^30 = /%s/\n" (I.format "%-10i" (I.neg p30));
725
+
Printf.printf "format %%+10i 0 = /%s/\n" (I.format "%+10i" I.zero);
726
+
Printf.printf "format %%+10i 1 = /%s/\n" (I.format "%+10i" I.one);
727
+
Printf.printf "format %%+10i -1 = /%s/\n" (I.format "%+10i" I.minus_one);
728
+
Printf.printf "format %%+10i 2^30 = /%s/\n" (I.format "%+10i" p30);
729
+
Printf.printf "format %%+10i -2^30 = /%s/\n" (I.format "%+10i" (I.neg p30));
730
+
Printf.printf "format %% 10i 0 = /%s/\n" (I.format "% 10i" I.zero);
731
+
Printf.printf "format %% 10i 1 = /%s/\n" (I.format "% 10i" I.one);
732
+
Printf.printf "format %% 10i -1 = /%s/\n" (I.format "% 10i" I.minus_one);
733
+
Printf.printf "format %% 10i 2^30 = /%s/\n" (I.format "% 10i" p30);
734
+
Printf.printf "format %% 10i -2^30 = /%s/\n" (I.format "% 10i" (I.neg p30));
735
+
Printf.printf "format %%010i 0 = /%s/\n" (I.format "%010i" I.zero);
736
+
Printf.printf "format %%010i 1 = /%s/\n" (I.format "%010i" I.one);
737
+
Printf.printf "format %%010i -1 = /%s/\n" (I.format "%010i" I.minus_one);
738
+
Printf.printf "format %%010i 2^30 = /%s/\n" (I.format "%010i" p30);
739
+
Printf.printf "format %%010i -2^30 = /%s/\n" (I.format "%010i" (I.neg p30));
740
+
Printf.printf "format %%#x 0 = /%s/\n" (I.format "%#x" I.zero);
741
+
Printf.printf "format %%#x 1 = /%s/\n" (I.format "%#x" I.one);
742
+
Printf.printf "format %%#x -1 = /%s/\n" (I.format "%#x" I.minus_one);
743
+
Printf.printf "format %%#x 2^30 = /%s/\n" (I.format "%#x" p30);
744
+
Printf.printf "format %%#x -2^30 = /%s/\n" (I.format "%#x" (I.neg p30));
745
+
Printf.printf "format %%#X 0 = /%s/\n" (I.format "%#X" I.zero);
746
+
Printf.printf "format %%#X 1 = /%s/\n" (I.format "%#X" I.one);
747
+
Printf.printf "format %%#X -1 = /%s/\n" (I.format "%#X" I.minus_one);
748
+
Printf.printf "format %%#X 2^30 = /%s/\n" (I.format "%#X" p30);
749
+
Printf.printf "format %%#X -2^30 = /%s/\n" (I.format "%#X" (I.neg p30));
750
+
Printf.printf "format %%#o 0 = /%s/\n" (I.format "%#o" I.zero);
751
+
Printf.printf "format %%#o 1 = /%s/\n" (I.format "%#o" I.one);
752
+
Printf.printf "format %%#o -1 = /%s/\n" (I.format "%#o" I.minus_one);
753
+
Printf.printf "format %%#o 2^30 = /%s/\n" (I.format "%#o" p30);
754
+
Printf.printf "format %%#o -2^30 = /%s/\n" (I.format "%#o" (I.neg p30));
755
+
Printf.printf "format %%#10x 0 = /%s/\n" (I.format "%#10x" I.zero);
756
+
Printf.printf "format %%#10x 1 = /%s/\n" (I.format "%#10x" I.one);
757
+
Printf.printf "format %%#10x -1 = /%s/\n" (I.format "%#10x" I.minus_one);
758
+
Printf.printf "format %%#10x 2^30 = /%s/\n" (I.format "%#10x" p30);
759
+
Printf.printf "format %%#10x -2^30 = /%s/\n" (I.format "%#10x" (I.neg p30));
760
+
Printf.printf "format %%#10X 0 = /%s/\n" (I.format "%#10X" I.zero);
761
+
Printf.printf "format %%#10X 1 = /%s/\n" (I.format "%#10X" I.one);
762
+
Printf.printf "format %%#10X -1 = /%s/\n" (I.format "%#10X" I.minus_one);
763
+
Printf.printf "format %%#10X 2^30 = /%s/\n" (I.format "%#10X" p30);
764
+
Printf.printf "format %%#10X -2^30 = /%s/\n" (I.format "%#10X" (I.neg p30));
765
+
Printf.printf "format %%#10o 0 = /%s/\n" (I.format "%#10o" I.zero);
766
+
Printf.printf "format %%#10o 1 = /%s/\n" (I.format "%#10o" I.one);
767
+
Printf.printf "format %%#10o -1 = /%s/\n" (I.format "%#10o" I.minus_one);
768
+
Printf.printf "format %%#10o 2^30 = /%s/\n" (I.format "%#10o" p30);
769
+
Printf.printf "format %%#10o -2^30 = /%s/\n" (I.format "%#10o" (I.neg p30));
770
+
Printf.printf "format %%#-10x 0 = /%s/\n" (I.format "%#-10x" I.zero);
771
+
Printf.printf "format %%#-10x 1 = /%s/\n" (I.format "%#-10x" I.one);
772
+
Printf.printf "format %%#-10x -1 = /%s/\n" (I.format "%#-10x" I.minus_one);
773
+
Printf.printf "format %%#-10x 2^30 = /%s/\n" (I.format "%#-10x" p30);
774
+
Printf.printf "format %%#-10x -2^30 = /%s/\n" (I.format "%#-10x" (I.neg p30));
775
+
Printf.printf "format %%#-10X 0 = /%s/\n" (I.format "%#-10X" I.zero);
776
+
Printf.printf "format %%#-10X 1 = /%s/\n" (I.format "%#-10X" I.one);
777
+
Printf.printf "format %%#-10X -1 = /%s/\n" (I.format "%#-10X" I.minus_one);
778
+
Printf.printf "format %%#-10X 2^30 = /%s/\n" (I.format "%#-10X" p30);
779
+
Printf.printf "format %%#-10X -2^30 = /%s/\n" (I.format "%#-10X" (I.neg p30));
780
+
Printf.printf "format %%#-10o 0 = /%s/\n" (I.format "%#-10o" I.zero);
781
+
Printf.printf "format %%#-10o 1 = /%s/\n" (I.format "%#-10o" I.one);
782
+
Printf.printf "format %%#-10o -1 = /%s/\n" (I.format "%#-10o" I.minus_one);
783
+
Printf.printf "format %%#-10o 2^30 = /%s/\n" (I.format "%#-10o" p30);
784
+
Printf.printf "format %%#-10o -2^30 = /%s/\n" (I.format "%#-10o" (I.neg p30));
785
+
786
+
let extract_testdata =
787
+
let a = I.of_int 42
788
+
and b = I.of_int (-42)
789
+
and c = I.of_string "3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701" in
790
+
[a,0,1; a,0,5; a,0,32; a,0,64;
791
+
a,1,1; a,1,5; a,1,32; a,1,63; a,1,64; a,1,127; a,1,128;
792
+
a,69,12;
793
+
b,0,1; b,0,5; b,0,32; b,0,64;
794
+
b,1,1; b,1,5; b,1,32; b,1,63; b,1,64; b,1,127; b,1,128;
795
+
b,69,12;
796
+
c,0,1; c,0,64; c,128,1; c,128,5; c,131,32; c,175,63; c,277,123] in
797
+
List.iter chk_extract extract_testdata;
798
+
List.iter chk_signed_extract extract_testdata;
799
+
800
+
chk_bits I.zero;
801
+
chk_bits p2;
802
+
chk_bits (I.neg p2);
803
+
chk_bits p30;
804
+
chk_bits (I.neg p30);
805
+
chk_bits p62;
806
+
chk_bits (I.neg p62);
807
+
chk_bits p300;
808
+
chk_bits p120;
809
+
chk_bits p121;
810
+
chk_bits maxi;
811
+
chk_bits mini;
812
+
chk_bits maxi32;
813
+
chk_bits mini32;
814
+
chk_bits maxi64;
815
+
chk_bits mini64;
816
+
chk_bits maxni;
817
+
chk_bits minni;
818
+
819
+
List.iter chk_testbit [
820
+
I.zero; I.one; I.of_int (-42);
821
+
I.of_string "31415926535897932384626433832795028841971693993751058209749445923078164062862089986";
822
+
I.neg (I.shift_left (I.of_int 123456) 64);
823
+
];
824
+
825
+
List.iter chk_numbits_tz [
826
+
I.zero; I.one; I.of_int (-42);
827
+
I.shift_left (I.of_int 9999) 77;
828
+
I.neg (I.shift_left (I.of_int 123456) 64);
829
+
];
830
+
831
+
Printf.printf "random_bits 45 = %a\n"
832
+
pr (I.random_bits_gen ~fill:pr_bytes 45);
833
+
Printf.printf "random_bits 45 = %a\n"
834
+
pr (I.random_bits_gen ~fill:pr_bytes 45);
835
+
Printf.printf "random_bits 12 = %a\n"
836
+
pr (I.random_bits_gen ~fill:pr_bytes 12);
837
+
Printf.printf "random_int 123456 = %a\n"
838
+
pr (I.random_int_gen ~fill:pr_bytes (I.of_int 123456));
839
+
Printf.printf "random_int 9999999 = %a\n"
840
+
pr (I.random_int_gen ~fill:pr_bytes (I.of_int 9999999));
841
+
842
+
()
843
+
844
+
845
+
(* testing Q *)
846
+
847
+
(* gcd extended to: gcd x 0 = gcd 0 x = 0 *)
848
+
let gcd2 a b =
849
+
if Z.sign a = 0 then b
850
+
else if Z.sign b = 0 then a
851
+
else Z.gcd a b
852
+
853
+
(* check invariant *)
854
+
let check x =
855
+
assert (Z.sign x.Q.den >= 0);
856
+
assert (Z.compare (gcd2 x.Q.num x.Q.den) Z.one <= 0)
857
+
858
+
859
+
let t_list = [Q.zero;Q.one;Q.minus_one;Q.inf;Q.minus_inf;Q.undef]
860
+
861
+
let test1 msg op =
862
+
List.iter
863
+
(fun x ->
864
+
let r = op x in
865
+
check r;
866
+
Printf.printf "%s %s = %s\n" msg (Q.to_string x) (Q.to_string r)
867
+
) t_list
868
+
869
+
let test2 msg op =
870
+
List.iter
871
+
(fun x ->
872
+
List.iter
873
+
(fun y ->
874
+
let r = op x y in
875
+
check r;
876
+
Printf.printf "%s %s %s = %s\n" (Q.to_string x) msg (Q.to_string y) (Q.to_string r)
877
+
) t_list
878
+
) t_list
879
+
880
+
let test_Q () =
881
+
let _ = List.iter check t_list in
882
+
let _ = test1 "-" Q.neg in
883
+
let _ = test1 "1/" Q.inv in
884
+
let _ = test1 "abs" Q.abs in
885
+
let _ = test2 "+" Q.add in
886
+
let _ = test2 "-" Q.sub in
887
+
let _ = test2 "*" Q.mul in
888
+
let _ = test2 "/" Q.div in
889
+
let _ = test2 "* 1/" (fun a b -> Q.mul a (Q.inv b)) in
890
+
let _ = test1 "mul_2exp (1) " (fun a -> Q.mul_2exp a 1) in
891
+
let _ = test1 "mul_2exp (2) " (fun a -> Q.mul_2exp a 2) in
892
+
let _ = test1 "div_2exp (1) " (fun a -> Q.div_2exp a 1) in
893
+
let _ = test1 "div_2exp (2) " (fun a -> Q.div_2exp a 2) in
894
+
(* check simple identitites *)
895
+
List.iter
896
+
(fun x ->
897
+
assert (0 = Q.compare x (Q.div_2exp (Q.mul_2exp x 2) 2));
898
+
assert (0 = Q.compare x (Q.mul_2exp (Q.div_2exp x 2) 2));
899
+
List.iter
900
+
(fun y ->
901
+
Printf.printf "identity checking %s %s\n" (Q.to_string x) (Q.to_string y);
902
+
assert (0 = Q.compare (Q.add x y) (Q.add y x));
903
+
assert (0 = Q.compare (Q.sub x y) (Q.neg (Q.sub y x)));
904
+
assert (0 = Q.compare (Q.sub x y) (Q.add x (Q.neg y)));
905
+
assert (0 = Q.compare (Q.mul x y) (Q.mul y x));
906
+
assert (0 = Q.compare (Q.div x y) (Q.mul x (Q.inv y)));
907
+
) t_list
908
+
) t_list;
909
+
assert (Q.compare Q.undef Q.undef = 0);
910
+
assert (not (Q.equal Q.undef Q.undef));
911
+
assert (not (Q.lt Q.undef Q.undef));
912
+
assert (not (Q.leq Q.undef Q.undef));
913
+
assert (not (Q.gt Q.undef Q.undef));
914
+
assert (not (Q.geq Q.undef Q.undef))
915
+
916
+
917
+
(* main *)
918
+
919
+
let _ = test_Z()
920
+
let _ = test_Q()
+1452
vendor/opam/zarith/tests/zq.output32
+1452
vendor/opam/zarith/tests/zq.output32
···
1
+
0
2
+
= 0
3
+
1
4
+
= 1
5
+
-1
6
+
= -1
7
+
42
8
+
= 42
9
+
1+1
10
+
= 2
11
+
1-1
12
+
= 0
13
+
- 1
14
+
= -1
15
+
0-1
16
+
= -1
17
+
max_int
18
+
= 1073741823
19
+
min_int
20
+
= -1073741824
21
+
-max_int
22
+
= -1073741823
23
+
-min_int
24
+
= 1073741824
25
+
2^300
26
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
27
+
2^120
28
+
= 1329227995784915872903807060280344576
29
+
2^300+2^120
30
+
= 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
31
+
2^300-2^120
32
+
= 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
33
+
2^300+(-(2^120))
34
+
= 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
35
+
2^120-2^300
36
+
= -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
37
+
2^120+(-(2^300))
38
+
= -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
39
+
-(2^120)+(-(2^300))
40
+
= -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
41
+
-(2^120)-2^300
42
+
= -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
43
+
2^300-2^300
44
+
= 0
45
+
2^121
46
+
= 2658455991569831745807614120560689152
47
+
2^121+2^120
48
+
= 3987683987354747618711421180841033728
49
+
2^121-2^120
50
+
= 1329227995784915872903807060280344576
51
+
2^121+(-(2^120))
52
+
= 1329227995784915872903807060280344576
53
+
2^120-2^121
54
+
= -1329227995784915872903807060280344576
55
+
2^120+(-(2^121))
56
+
= -1329227995784915872903807060280344576
57
+
-(2^120)+(-(2^121))
58
+
= -3987683987354747618711421180841033728
59
+
-(2^120)-2^121
60
+
= -3987683987354747618711421180841033728
61
+
2^121+0
62
+
= 2658455991569831745807614120560689152
63
+
2^121-0
64
+
= 2658455991569831745807614120560689152
65
+
0+2^121
66
+
= 2658455991569831745807614120560689152
67
+
0-2^121
68
+
= -2658455991569831745807614120560689152
69
+
2^300+1
70
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
71
+
2^300-1
72
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
73
+
1+2^300
74
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
75
+
1-2^300
76
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
77
+
2^300+(-1)
78
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
79
+
2^300-(-1)
80
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
81
+
(-1)+2^300
82
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
83
+
(-1)-2^300
84
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
85
+
-(2^300)+1
86
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
87
+
-(2^300)-1
88
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
89
+
1+(-(2^300))
90
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
91
+
1-(-(2^300))
92
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
93
+
-(2^300)+(-1)
94
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
95
+
-(2^300)-(-1)
96
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
97
+
(-1)+(-(2^300))
98
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
99
+
(-1)-(-(2^300))
100
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
101
+
max_int+1
102
+
= 1073741824
103
+
min_int-1
104
+
= -1073741825
105
+
-max_int-1
106
+
= -1073741824
107
+
-min_int-1
108
+
= 1073741823
109
+
5! = 120
110
+
12! = 479001600
111
+
15! = 1307674368000
112
+
20! = 2432902008176640000
113
+
25! = 15511210043330985984000000
114
+
50! = 30414093201713378043612608166064768844377641568960512000000000000
115
+
2^300*2^120
116
+
= 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576
117
+
2^120*2^300
118
+
= 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576
119
+
2^300*(-(2^120))
120
+
= -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576
121
+
2^120*(-(2^300))
122
+
= -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576
123
+
-(2^120)*(-(2^300))
124
+
= 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576
125
+
2^121*2^120
126
+
= 3533694129556768659166595001485837031654967793751237916243212402585239552
127
+
2^120*2^121
128
+
= 3533694129556768659166595001485837031654967793751237916243212402585239552
129
+
2^121*0
130
+
= 0
131
+
0*2^121
132
+
= 0
133
+
2^300*1
134
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
135
+
1*2^300
136
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
137
+
2^300*(-1)
138
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
139
+
(-1)*2^300
140
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
141
+
-(2^300)*1
142
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
143
+
1*(-(2^300))
144
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
145
+
-(2^300)*(-1)
146
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
147
+
(-1)*(-(2^300))
148
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
149
+
1*(2^30)
150
+
= 1073741824
151
+
1*(2^62)
152
+
= 4611686018427387904
153
+
(2^30)*(2^30)
154
+
= 1152921504606846976
155
+
(2^62)*(2^62)
156
+
= 21267647932558653966460912964485513216
157
+
0+1
158
+
= 1
159
+
1+1
160
+
= 2
161
+
-1+1
162
+
= 0
163
+
2+1
164
+
= 3
165
+
-2+1
166
+
= -1
167
+
(2^300)+1
168
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
169
+
-(2^300)+1
170
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
171
+
0-1
172
+
= -1
173
+
1-1
174
+
= 0
175
+
-1-1
176
+
= -2
177
+
2-1
178
+
= 1
179
+
-2-1
180
+
= -3
181
+
(2^300)-1
182
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
183
+
-(2^300)-1
184
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
185
+
max_int+1
186
+
= 1073741824
187
+
min_int-1
188
+
= -1073741825
189
+
-max_int-1
190
+
= -1073741824
191
+
-min_int-1
192
+
= 1073741823
193
+
abs(0)
194
+
= 0
195
+
abs(1)
196
+
= 1
197
+
abs(-1)
198
+
= 1
199
+
abs(min_int)
200
+
= 1073741824
201
+
abs(2^300)
202
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
203
+
abs(-(2^300))
204
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
205
+
max_nativeint
206
+
= 2147483647
207
+
max_int32
208
+
= 2147483647
209
+
max_int64
210
+
= 9223372036854775807
211
+
to_int 1
212
+
= true,1
213
+
to_int max_int
214
+
= true,1073741823
215
+
to_int max_nativeint
216
+
= false,ovf
217
+
to_int max_int32
218
+
= false,ovf
219
+
to_int max_int64
220
+
= false,ovf
221
+
to_int32 1
222
+
= true,1
223
+
to_int32 max_int
224
+
= true,1073741823
225
+
to_int32 max_nativeint
226
+
= true,2147483647
227
+
to_int32 max_int32
228
+
= true,2147483647
229
+
to_int32 max_int64
230
+
= false,ovf
231
+
to_int64 1
232
+
= true,1
233
+
to_int64 max_int
234
+
= true,1073741823
235
+
to_int64 max_nativeint
236
+
= true,2147483647
237
+
to_int64 max_int32
238
+
= true,2147483647
239
+
to_int64 max_int64
240
+
= true,9223372036854775807
241
+
to_nativeint 1
242
+
= true,1
243
+
to_nativeint max_int
244
+
= true,1073741823
245
+
to_nativeint max_nativeint
246
+
= true,2147483647
247
+
to_nativeint max_int32
248
+
= true,2147483647
249
+
to_nativeint max_int64
250
+
= false,ovf
251
+
to_int -min_int
252
+
= false,ovf
253
+
to_int -min_nativeint
254
+
= false,ovf
255
+
to_int -min_int32
256
+
= false,ovf
257
+
to_int -min_int64
258
+
= false,ovf
259
+
to_int32 -min_int
260
+
= true,1073741824
261
+
to_int32 -min_nativeint
262
+
= false,ovf
263
+
to_int32 -min_int32
264
+
= false,ovf
265
+
to_int32 -min_int64
266
+
= false,ovf
267
+
to_int64 -min_int
268
+
= true,1073741824
269
+
to_int64 -min_nativeint
270
+
= true,2147483648
271
+
to_int64 -min_int32
272
+
= true,2147483648
273
+
to_int64 -min_int64
274
+
= false,ovf
275
+
to_nativeint -min_int
276
+
= true,1073741824
277
+
to_nativeint -min_nativeint
278
+
= false,ovf
279
+
to_nativeint -min_int32
280
+
= false,ovf
281
+
to_nativeint -min_int64
282
+
= false,ovf
283
+
to_int32_unsigned 1
284
+
= true,1
285
+
to_int32_unsigned -1
286
+
= false,ovf
287
+
to_int32_unsigned max_int
288
+
= true,1073741823
289
+
to_int32_unsigned max_nativeint
290
+
= true,2147483647
291
+
to_int32_unsigned max_int32
292
+
= true,2147483647
293
+
to_int32_unsigned 2max_int32
294
+
= true,-2
295
+
to_int32_unsigned 3max_int32
296
+
= false,ovf
297
+
to_int32_unsigned max_int64
298
+
= false,ovf
299
+
to_int64_unsigned 1
300
+
= true,1
301
+
to_int64_unsigned -1
302
+
= false,ovf
303
+
to_int64_unsigned max_int
304
+
= true,1073741823
305
+
to_int64_unsigned max_nativeint
306
+
= true,2147483647
307
+
to_int64_unsigned max_int32
308
+
= true,2147483647
309
+
to_int64_unsigned max_int64
310
+
= true,9223372036854775807
311
+
to_int64_unsigned 2max_int64
312
+
= true,-2
313
+
to_int64_unsigned 3max_int64
314
+
= false,ovf
315
+
to_nativeint_unsigned 1
316
+
= true,1
317
+
to_nativeint_unsigned -1
318
+
= false,ovf
319
+
to_nativeint_unsigned max_int
320
+
= true,1073741823
321
+
to_nativeint_unsigned max_nativeint
322
+
= true,2147483647
323
+
to_nativeint_unsigned 2max_nativeint
324
+
= true,-2
325
+
to_nativeint_unsigned max_int32
326
+
= true,2147483647
327
+
to_nativeint_unsigned max_int64
328
+
= false,ovf
329
+
to_nativeint_unsigned 2max_int64
330
+
= false,ovf
331
+
to_nativeint_unsigned 3max_int64
332
+
= false,ovf
333
+
of_int32_unsigned -1
334
+
= 4294967295
335
+
of_int64_unsigned -1
336
+
= 18446744073709551615
337
+
of_nativeint_unsigned -1
338
+
= 4294967295
339
+
of_float 1.
340
+
= 1
341
+
of_float -1.
342
+
= -1
343
+
of_float pi
344
+
= 3
345
+
of_float 2^30
346
+
= 1073741824
347
+
of_float 2^31
348
+
= 2147483648
349
+
of_float 2^32
350
+
= 4294967296
351
+
of_float 2^33
352
+
= 8589934592
353
+
of_float -2^30
354
+
= -1073741824
355
+
of_float -2^31
356
+
= -2147483648
357
+
of_float -2^32
358
+
= -4294967296
359
+
of_float -2^33
360
+
= -8589934592
361
+
of_float 2^61
362
+
= 2305843009213693952
363
+
of_float 2^62
364
+
= 4611686018427387904
365
+
of_float 2^63
366
+
= 9223372036854775808
367
+
of_float 2^64
368
+
= 18446744073709551616
369
+
of_float 2^65
370
+
= 36893488147419103232
371
+
of_float -2^61
372
+
= -2305843009213693952
373
+
of_float -2^62
374
+
= -4611686018427387904
375
+
of_float -2^63
376
+
= -9223372036854775808
377
+
of_float -2^64
378
+
= -18446744073709551616
379
+
of_float -2^65
380
+
= -36893488147419103232
381
+
of_float 2^120
382
+
= 1329227995784915872903807060280344576
383
+
of_float 2^300
384
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
385
+
of_float -2^120
386
+
= -1329227995784915872903807060280344576
387
+
of_float -2^300
388
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
389
+
of_float 0.5
390
+
= 0
391
+
of_float -0.5
392
+
= 0
393
+
of_float 200.5
394
+
= 200
395
+
of_float -200.5
396
+
= -200
397
+
to_float 0
398
+
= OK
399
+
to_float 1
400
+
= OK
401
+
to_float -1
402
+
= OK
403
+
to_float 2^120
404
+
= OK
405
+
to_float -2^120
406
+
= OK
407
+
to_float (2^120-1)
408
+
= OK
409
+
to_float (-2^120+1)
410
+
= OK
411
+
to_float 2^63
412
+
= OK
413
+
to_float -2^63
414
+
= OK
415
+
to_float (2^63-1)
416
+
= OK
417
+
to_float (-2^63-1)
418
+
= OK
419
+
to_float (-2^63+1)
420
+
= OK
421
+
to_float 2^300
422
+
= OK
423
+
to_float -2^300
424
+
= OK
425
+
to_float (2^300-1)
426
+
= OK
427
+
to_float (-2^300+1)
428
+
= OK
429
+
of_string 12
430
+
= 12
431
+
of_string 0x12
432
+
= 18
433
+
of_string 0b10
434
+
= 2
435
+
of_string 0o12
436
+
= 10
437
+
of_string -12
438
+
= -12
439
+
of_string -0x12
440
+
= -18
441
+
of_string -0b10
442
+
= -2
443
+
of_string -0o12
444
+
= -10
445
+
of_string 000123456789012345678901234567890
446
+
= 123456789012345678901234567890
447
+
2^120 / 2^300 (trunc)
448
+
= 0
449
+
max_int / 2 (trunc)
450
+
= 536870911
451
+
(2^300+1) / 2^120 (trunc)
452
+
= 1532495540865888858358347027150309183618739122183602176
453
+
(-(2^300+1)) / 2^120 (trunc)
454
+
= -1532495540865888858358347027150309183618739122183602176
455
+
(2^300+1) / (-(2^120)) (trunc)
456
+
= -1532495540865888858358347027150309183618739122183602176
457
+
(-(2^300+1)) / (-(2^120)) (trunc)
458
+
= 1532495540865888858358347027150309183618739122183602176
459
+
2^120 / 2^300 (ceil)
460
+
= 1
461
+
max_int / 2 (ceil)
462
+
= 536870912
463
+
(2^300+1) / 2^120 (ceil)
464
+
= 1532495540865888858358347027150309183618739122183602177
465
+
(-(2^300+1)) / 2^120 (ceil)
466
+
= -1532495540865888858358347027150309183618739122183602176
467
+
(2^300+1) / (-(2^120)) (ceil)
468
+
= -1532495540865888858358347027150309183618739122183602176
469
+
(-(2^300+1)) / (-(2^120)) (ceil)
470
+
= 1532495540865888858358347027150309183618739122183602177
471
+
2^120 / 2^300 (floor)
472
+
= 0
473
+
max_int / 2 (floor)
474
+
= 536870911
475
+
(2^300+1) / 2^120 (floor)
476
+
= 1532495540865888858358347027150309183618739122183602176
477
+
(-(2^300+1)) / 2^120 (floor)
478
+
= -1532495540865888858358347027150309183618739122183602177
479
+
(2^300+1) / (-(2^120)) (floor)
480
+
= -1532495540865888858358347027150309183618739122183602177
481
+
(-(2^300+1)) / (-(2^120)) (floor)
482
+
= 1532495540865888858358347027150309183618739122183602176
483
+
2^120 % 2^300
484
+
= 1329227995784915872903807060280344576
485
+
max_int % 2
486
+
= 1
487
+
(2^300+1) % 2^120
488
+
= 1
489
+
(-(2^300+1)) % 2^120
490
+
= -1
491
+
(2^300+1) % (-(2^120))
492
+
= 1
493
+
(-(2^300+1)) % (-(2^120))
494
+
= -1
495
+
2^120 /,% 2^300
496
+
= 0, 1329227995784915872903807060280344576
497
+
max_int /,% 2
498
+
= 536870911, 1
499
+
(2^300+1) /,% 2^120
500
+
= 1532495540865888858358347027150309183618739122183602176, 1
501
+
(-(2^300+1)) /,% 2^120
502
+
= -1532495540865888858358347027150309183618739122183602176, -1
503
+
(2^300+1) /,% (-(2^120))
504
+
= -1532495540865888858358347027150309183618739122183602176, 1
505
+
(-(2^300+1)) /,% (-(2^120))
506
+
= 1532495540865888858358347027150309183618739122183602176, -1
507
+
1 & 2
508
+
= 0
509
+
1 & 2^300
510
+
= 0
511
+
2^120 & 2^300
512
+
= 0
513
+
2^300 & 2^120
514
+
= 0
515
+
2^300 & 2^300
516
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
517
+
2^300 & 0
518
+
= 0
519
+
-2^120 & 2^300
520
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
521
+
2^120 & -2^300
522
+
= 0
523
+
-2^120 & -2^300
524
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
525
+
-2^300 & 2^120
526
+
= 0
527
+
2^300 & -2^120
528
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
529
+
-2^300 & -2^120
530
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
531
+
1 | 2
532
+
= 3
533
+
1 | 2^300
534
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
535
+
2^120 | 2^300
536
+
= 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
537
+
2^300 | 2^120
538
+
= 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
539
+
2^300 | 2^300
540
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
541
+
2^300 | 0
542
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
543
+
-2^120 | 2^300
544
+
= -1329227995784915872903807060280344576
545
+
2^120 | -2^300
546
+
= -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
547
+
-2^120 | -2^300
548
+
= -1329227995784915872903807060280344576
549
+
-2^300 | 2^120
550
+
= -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
551
+
2^300 | -2^120
552
+
= -1329227995784915872903807060280344576
553
+
-2^300 | -2^120
554
+
= -1329227995784915872903807060280344576
555
+
1 ^ 2
556
+
= 3
557
+
1 ^ 2^300
558
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
559
+
2^120 ^ 2^300
560
+
= 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
561
+
2^300 ^ 2^120
562
+
= 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
563
+
2^300 ^ 2^300
564
+
= 0
565
+
2^300 ^ 0
566
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
567
+
-2^120 ^ 2^300
568
+
= -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
569
+
2^120 ^ -2^300
570
+
= -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
571
+
-2^120 ^ -2^300
572
+
= 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
573
+
-2^300 ^ 2^120
574
+
= -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
575
+
2^300 ^ -2^120
576
+
= -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
577
+
-2^300 ^ -2^120
578
+
= 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
579
+
~0
580
+
= -1
581
+
~1
582
+
= -2
583
+
~2
584
+
= -3
585
+
~2^300
586
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
587
+
~(-1)
588
+
= 0
589
+
~(-2)
590
+
= 1
591
+
~(-(2^300))
592
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
593
+
0 >> 1
594
+
= 0
595
+
0 >> 100
596
+
= 0
597
+
2 >> 1
598
+
= 1
599
+
2 >> 2
600
+
= 0
601
+
2 >> 100
602
+
= 0
603
+
2^300 >> 1
604
+
= 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688
605
+
2^300 >> 2
606
+
= 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344
607
+
2^300 >> 100
608
+
= 1606938044258990275541962092341162602522202993782792835301376
609
+
2^300 >> 200
610
+
= 1267650600228229401496703205376
611
+
2^300 >> 300
612
+
= 1
613
+
2^300 >> 400
614
+
= 0
615
+
-1 >> 1
616
+
= -1
617
+
-2 >> 1
618
+
= -1
619
+
-2 >> 2
620
+
= -1
621
+
-2 >> 100
622
+
= -1
623
+
-2^300 >> 1
624
+
= -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688
625
+
-2^300 >> 2
626
+
= -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344
627
+
-2^300 >> 100
628
+
= -1606938044258990275541962092341162602522202993782792835301376
629
+
-2^300 >> 200
630
+
= -1267650600228229401496703205376
631
+
-2^300 >> 300
632
+
= -1
633
+
-2^300 >> 400
634
+
= -1
635
+
0 >>0 1
636
+
= 0
637
+
0 >>0 100
638
+
= 0
639
+
2 >>0 1
640
+
= 1
641
+
2 >>0 2
642
+
= 0
643
+
2 >>0 100
644
+
= 0
645
+
2^300 >>0 1
646
+
= 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688
647
+
2^300 >>0 2
648
+
= 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344
649
+
2^300 >>0 100
650
+
= 1606938044258990275541962092341162602522202993782792835301376
651
+
2^300 >>0 200
652
+
= 1267650600228229401496703205376
653
+
2^300 >>0 300
654
+
= 1
655
+
2^300 >>0 400
656
+
= 0
657
+
-1 >>0 1
658
+
= 0
659
+
-2 >>0 1
660
+
= -1
661
+
-2 >>0 2
662
+
= 0
663
+
-2 >>0 100
664
+
= 0
665
+
-2^300 >>0 1
666
+
= -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688
667
+
-2^300 >>0 2
668
+
= -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344
669
+
-2^300 >>0 100
670
+
= -1606938044258990275541962092341162602522202993782792835301376
671
+
-2^300 >>0 200
672
+
= -1267650600228229401496703205376
673
+
-2^300 >>0 300
674
+
= -1
675
+
-2^300 >>0 400
676
+
= 0
677
+
0 << 1
678
+
= 0
679
+
0 << 100
680
+
= 0
681
+
2 << 1
682
+
= 4
683
+
2 << 32
684
+
= 8589934592
685
+
2 << 64
686
+
= 36893488147419103232
687
+
2 << 299
688
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
689
+
2^120 << 1
690
+
= 2658455991569831745807614120560689152
691
+
2^120 << 180
692
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
693
+
compare 1 2
694
+
= -1
695
+
compare 1 1
696
+
= 0
697
+
compare 2 1
698
+
= 1
699
+
compare 2^300 2^120
700
+
= 1
701
+
compare 2^120 2^120
702
+
= 0
703
+
compare 2^120 2^300
704
+
= -1
705
+
compare 2^121 2^120
706
+
= 1
707
+
compare 2^120 2^121
708
+
= -1
709
+
compare 2^300 -2^120
710
+
= 1
711
+
compare 2^120 -2^120
712
+
= 1
713
+
compare 2^120 -2^300
714
+
= 1
715
+
compare -2^300 2^120
716
+
= -1
717
+
compare -2^120 2^120
718
+
= -1
719
+
compare -2^120 2^300
720
+
= -1
721
+
compare -2^300 -2^120
722
+
= -1
723
+
compare -2^120 -2^120
724
+
= 0
725
+
compare -2^120 -2^300
726
+
= 1
727
+
equal 1 2
728
+
= false
729
+
equal 1 1
730
+
= true
731
+
equal 2 1
732
+
= false
733
+
equal 2^300 2^120
734
+
= false
735
+
equal 2^120 2^120
736
+
= true
737
+
equal 2^120 2^300
738
+
= false
739
+
equal 2^121 2^120
740
+
= false
741
+
equal 2^120 2^121
742
+
= false
743
+
equal 2^120 -2^120
744
+
= false
745
+
equal -2^120 2^120
746
+
= false
747
+
equal -2^120 -2^120
748
+
= true
749
+
sign 0
750
+
= 0
751
+
sign 1
752
+
= 1
753
+
sign -1
754
+
= -1
755
+
sign 2^300
756
+
= 1
757
+
sign -2^300
758
+
= -1
759
+
gcd 0 0
760
+
= 0
761
+
gcd 0 -137
762
+
= 137
763
+
gcd 12 27
764
+
= 3
765
+
gcd 27 12
766
+
= 3
767
+
gcd 27 27
768
+
= 27
769
+
gcd -12 27
770
+
= 3
771
+
gcd 12 -27
772
+
= 3
773
+
gcd -12 -27
774
+
= 3
775
+
gcd 0 2^300
776
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
777
+
gcd 2^120 2^300
778
+
= 1329227995784915872903807060280344576
779
+
gcd 2^300 2^120
780
+
= 1329227995784915872903807060280344576
781
+
gcd 0 -2^300
782
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
783
+
gcd 2^120 -2^300
784
+
= 1329227995784915872903807060280344576
785
+
gcd 2^300 -2^120
786
+
= 1329227995784915872903807060280344576
787
+
gcd -2^120 2^300
788
+
= 1329227995784915872903807060280344576
789
+
gcd -2^300 2^120
790
+
= 1329227995784915872903807060280344576
791
+
gcd -2^120 -2^300
792
+
= 1329227995784915872903807060280344576
793
+
gcd -2^300 -2^120
794
+
= 1329227995784915872903807060280344576
795
+
gcdext 12 27
796
+
= 3, -2, 1
797
+
gcdext 27 12
798
+
= 3, 1, -2
799
+
gcdext 27 27
800
+
= 27, 0, 1
801
+
gcdext -12 27
802
+
= 3, 2, 1
803
+
gcdext 12 -27
804
+
= 3, -2, -1
805
+
gcdext -12 -27
806
+
= 3, 2, -1
807
+
gcdext 2^120 2^300
808
+
= 1329227995784915872903807060280344576, 1, 0
809
+
gcdext 2^300 2^120
810
+
= 1329227995784915872903807060280344576, 0, 1
811
+
gcdext 12 0
812
+
= 12, 1, 0
813
+
gcdext 0 27
814
+
= 27, 0, 1
815
+
gcdext -12 0
816
+
= 12, -1, 0
817
+
gcdext 0 -27
818
+
= 27, 0, -1
819
+
gcdext 2^120 0
820
+
= 1329227995784915872903807060280344576, 1, 0
821
+
gcdext 0 2^300
822
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, 1
823
+
gcdext -2^120 0
824
+
= 1329227995784915872903807060280344576, -1, 0
825
+
gcdext 0 -2^300
826
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, -1
827
+
gcdext 0 0
828
+
= 0, 0, 0
829
+
lcm 0 0 = 0
830
+
lcm 10 12 = 60
831
+
lcm -10 12 = 60
832
+
lcm 10 -12 = 60
833
+
lcm -10 -12 = 60
834
+
lcm 0 12 = 0
835
+
lcm 0 -12 = 0
836
+
lcm 10 0 = 0
837
+
lcm -10 0 = 0
838
+
lcm 2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
839
+
lcm 2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
840
+
lcm -2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
841
+
lcm -2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
842
+
lcm 2^120 0 = 0
843
+
lcm -2^120 0 = 0
844
+
is_odd 0
845
+
= false
846
+
is_odd 1
847
+
= true
848
+
is_odd 2
849
+
= false
850
+
is_odd 3
851
+
= true
852
+
is_odd 2^120
853
+
= false
854
+
is_odd 2^120+1
855
+
= true
856
+
is_odd 2^300
857
+
= false
858
+
is_odd 2^300+1
859
+
= true
860
+
sqrt 0
861
+
= 0
862
+
sqrt 1
863
+
= 1
864
+
sqrt 2
865
+
= 1
866
+
sqrt 2^120
867
+
= 1152921504606846976
868
+
sqrt 2^121
869
+
= 1630477228166597776
870
+
sqrt_rem 0
871
+
= 0, 0
872
+
sqrt_rem 1
873
+
= 1, 0
874
+
sqrt_rem 2
875
+
= 1, 1
876
+
sqrt_rem 2^120
877
+
= 1152921504606846976, 0
878
+
sqrt_rem 2^121
879
+
= 1630477228166597776, 1772969445592542976
880
+
popcount 0
881
+
= 0
882
+
popcount 1
883
+
= 1
884
+
popcount 2
885
+
= 1
886
+
popcount max_int32
887
+
= 31
888
+
popcount 2^120
889
+
= 1
890
+
popcount (2^120-1)
891
+
= 120
892
+
hamdist 0 0
893
+
= 0
894
+
hamdist 0 1
895
+
= 1
896
+
hamdist 0 2^300
897
+
= 1
898
+
hamdist 2^120 2^120
899
+
= 0
900
+
hamdist 2^120 (2^120-1)
901
+
= 121
902
+
hamdist 2^120 2^300
903
+
= 2
904
+
hamdist (2^120-1) (2^300-1)
905
+
= 180
906
+
divisible 42 7
907
+
= true
908
+
divisible 43 7
909
+
= false
910
+
divisible 0 0
911
+
= true
912
+
divisible 0 2^120
913
+
= true
914
+
divisible 2 2^120
915
+
= false
916
+
divisible 2^300 2^120
917
+
= true
918
+
divisible (2^300-1) 32
919
+
= false
920
+
divisible min_int (max_int+1)
921
+
= true
922
+
divisible (max_int+1) min_int
923
+
= true
924
+
hash(2^120)
925
+
= 691199303
926
+
hash(2^121)
927
+
= 382412560
928
+
hash(2^300)
929
+
= 61759632
930
+
2^120 = 2^300
931
+
= false
932
+
2^120 = 2^120
933
+
= true
934
+
2^120 = 2^120
935
+
= true
936
+
2^120 > 2^300
937
+
= false
938
+
2^120 < 2^300
939
+
= true
940
+
2^120 = 1
941
+
= false
942
+
2^120 > 1
943
+
= true
944
+
2^120 < 1
945
+
= false
946
+
-2^120 > 1
947
+
= false
948
+
-2^120 < 1
949
+
= true
950
+
demarshal 2^120, 2^300, 1
951
+
= 1329227995784915872903807060280344576, 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 1
952
+
demarshal -2^120, -2^300, -1
953
+
= -1329227995784915872903807060280344576, -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, -1
954
+
format %i 0 = /0/
955
+
format %i 1 = /1/
956
+
format %i -1 = /-1/
957
+
format %i 2^30 = /1073741824/
958
+
format %i -2^30 = /-1073741824/
959
+
format % i 1 = / 1/
960
+
format %+i 1 = /+1/
961
+
format %x 0 = /0/
962
+
format %x 1 = /1/
963
+
format %x -1 = /-1/
964
+
format %x 2^30 = /40000000/
965
+
format %x -2^30 = /-40000000/
966
+
format %X 0 = /0/
967
+
format %X 1 = /1/
968
+
format %X -1 = /-1/
969
+
format %X 2^30 = /40000000/
970
+
format %X -2^30 = /-40000000/
971
+
format %o 0 = /0/
972
+
format %o 1 = /1/
973
+
format %o -1 = /-1/
974
+
format %o 2^30 = /10000000000/
975
+
format %o -2^30 = /-10000000000/
976
+
format %10i 0 = / 0/
977
+
format %10i 1 = / 1/
978
+
format %10i -1 = / -1/
979
+
format %10i 2^30 = /1073741824/
980
+
format %10i -2^30 = /-1073741824/
981
+
format %-10i 0 = /0 /
982
+
format %-10i 1 = /1 /
983
+
format %-10i -1 = /-1 /
984
+
format %-10i 2^30 = /1073741824/
985
+
format %-10i -2^30 = /-1073741824/
986
+
format %+10i 0 = / +0/
987
+
format %+10i 1 = / +1/
988
+
format %+10i -1 = / -1/
989
+
format %+10i 2^30 = /+1073741824/
990
+
format %+10i -2^30 = /-1073741824/
991
+
format % 10i 0 = / 0/
992
+
format % 10i 1 = / 1/
993
+
format % 10i -1 = / -1/
994
+
format % 10i 2^30 = / 1073741824/
995
+
format % 10i -2^30 = /-1073741824/
996
+
format %010i 0 = /0000000000/
997
+
format %010i 1 = /0000000001/
998
+
format %010i -1 = /-000000001/
999
+
format %010i 2^30 = /1073741824/
1000
+
format %010i -2^30 = /-1073741824/
1001
+
format %#x 0 = /0x0/
1002
+
format %#x 1 = /0x1/
1003
+
format %#x -1 = /-0x1/
1004
+
format %#x 2^30 = /0x40000000/
1005
+
format %#x -2^30 = /-0x40000000/
1006
+
format %#X 0 = /0X0/
1007
+
format %#X 1 = /0X1/
1008
+
format %#X -1 = /-0X1/
1009
+
format %#X 2^30 = /0X40000000/
1010
+
format %#X -2^30 = /-0X40000000/
1011
+
format %#o 0 = /0o0/
1012
+
format %#o 1 = /0o1/
1013
+
format %#o -1 = /-0o1/
1014
+
format %#o 2^30 = /0o10000000000/
1015
+
format %#o -2^30 = /-0o10000000000/
1016
+
format %#10x 0 = / 0x0/
1017
+
format %#10x 1 = / 0x1/
1018
+
format %#10x -1 = / -0x1/
1019
+
format %#10x 2^30 = /0x40000000/
1020
+
format %#10x -2^30 = /-0x40000000/
1021
+
format %#10X 0 = / 0X0/
1022
+
format %#10X 1 = / 0X1/
1023
+
format %#10X -1 = / -0X1/
1024
+
format %#10X 2^30 = /0X40000000/
1025
+
format %#10X -2^30 = /-0X40000000/
1026
+
format %#10o 0 = / 0o0/
1027
+
format %#10o 1 = / 0o1/
1028
+
format %#10o -1 = / -0o1/
1029
+
format %#10o 2^30 = /0o10000000000/
1030
+
format %#10o -2^30 = /-0o10000000000/
1031
+
format %#-10x 0 = /0x0 /
1032
+
format %#-10x 1 = /0x1 /
1033
+
format %#-10x -1 = /-0x1 /
1034
+
format %#-10x 2^30 = /0x40000000/
1035
+
format %#-10x -2^30 = /-0x40000000/
1036
+
format %#-10X 0 = /0X0 /
1037
+
format %#-10X 1 = /0X1 /
1038
+
format %#-10X -1 = /-0X1 /
1039
+
format %#-10X 2^30 = /0X40000000/
1040
+
format %#-10X -2^30 = /-0X40000000/
1041
+
format %#-10o 0 = /0o0 /
1042
+
format %#-10o 1 = /0o1 /
1043
+
format %#-10o -1 = /-0o1 /
1044
+
format %#-10o 2^30 = /0o10000000000/
1045
+
format %#-10o -2^30 = /-0o10000000000/
1046
+
extract 42 0 1 = 0 (passed)
1047
+
extract 42 0 5 = 10 (passed)
1048
+
extract 42 0 32 = 42 (passed)
1049
+
extract 42 0 64 = 42 (passed)
1050
+
extract 42 1 1 = 1 (passed)
1051
+
extract 42 1 5 = 21 (passed)
1052
+
extract 42 1 32 = 21 (passed)
1053
+
extract 42 1 63 = 21 (passed)
1054
+
extract 42 1 64 = 21 (passed)
1055
+
extract 42 1 127 = 21 (passed)
1056
+
extract 42 1 128 = 21 (passed)
1057
+
extract 42 69 12 = 0 (passed)
1058
+
extract -42 0 1 = 0 (passed)
1059
+
extract -42 0 5 = 22 (passed)
1060
+
extract -42 0 32 = 4294967254 (passed)
1061
+
extract -42 0 64 = 18446744073709551574 (passed)
1062
+
extract -42 1 1 = 1 (passed)
1063
+
extract -42 1 5 = 11 (passed)
1064
+
extract -42 1 32 = 4294967275 (passed)
1065
+
extract -42 1 63 = 9223372036854775787 (passed)
1066
+
extract -42 1 64 = 18446744073709551595 (passed)
1067
+
extract -42 1 127 = 170141183460469231731687303715884105707 (passed)
1068
+
extract -42 1 128 = 340282366920938463463374607431768211435 (passed)
1069
+
extract -42 69 12 = 4095 (passed)
1070
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = 1 (passed)
1071
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = 15536040655639606317 (passed)
1072
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = 1 (passed)
1073
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = 19 (passed)
1074
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = 2516587394 (passed)
1075
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = 7690089207107781587 (passed)
1076
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = 9888429935207999867003931753264634841 (passed)
1077
+
signed_extract 42 0 1 = 0 (passed)
1078
+
signed_extract 42 0 5 = 10 (passed)
1079
+
signed_extract 42 0 32 = 42 (passed)
1080
+
signed_extract 42 0 64 = 42 (passed)
1081
+
signed_extract 42 1 1 = -1 (passed)
1082
+
signed_extract 42 1 5 = -11 (passed)
1083
+
signed_extract 42 1 32 = 21 (passed)
1084
+
signed_extract 42 1 63 = 21 (passed)
1085
+
signed_extract 42 1 64 = 21 (passed)
1086
+
signed_extract 42 1 127 = 21 (passed)
1087
+
signed_extract 42 1 128 = 21 (passed)
1088
+
signed_extract 42 69 12 = 0 (passed)
1089
+
signed_extract -42 0 1 = 0 (passed)
1090
+
signed_extract -42 0 5 = -10 (passed)
1091
+
signed_extract -42 0 32 = -42 (passed)
1092
+
signed_extract -42 0 64 = -42 (passed)
1093
+
signed_extract -42 1 1 = -1 (passed)
1094
+
signed_extract -42 1 5 = 11 (passed)
1095
+
signed_extract -42 1 32 = -21 (passed)
1096
+
signed_extract -42 1 63 = -21 (passed)
1097
+
signed_extract -42 1 64 = -21 (passed)
1098
+
signed_extract -42 1 127 = -21 (passed)
1099
+
signed_extract -42 1 128 = -21 (passed)
1100
+
signed_extract -42 69 12 = -1 (passed)
1101
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = -1 (passed)
1102
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = -2910703418069945299 (passed)
1103
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = -1 (passed)
1104
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = -13 (passed)
1105
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = -1778379902 (passed)
1106
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = -1533282829746994221 (passed)
1107
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = -745394031071327116226524728978121767 (passed)
1108
+
to_bits 0
1109
+
=
1110
+
marshal round trip 0
1111
+
= OK
1112
+
to_bits 2
1113
+
= 02 00 00 00
1114
+
marshal round trip 2
1115
+
= OK
1116
+
to_bits -2
1117
+
= 02 00 00 00
1118
+
marshal round trip -2
1119
+
= OK
1120
+
to_bits 1073741824
1121
+
= 00 00 00 40
1122
+
marshal round trip 1073741824
1123
+
= OK
1124
+
to_bits -1073741824
1125
+
= 00 00 00 40
1126
+
marshal round trip -1073741824
1127
+
= OK
1128
+
to_bits 4611686018427387904
1129
+
= 00 00 00 00 00 00 00 40
1130
+
marshal round trip 4611686018427387904
1131
+
= OK
1132
+
to_bits -4611686018427387904
1133
+
= 00 00 00 00 00 00 00 40
1134
+
marshal round trip -4611686018427387904
1135
+
= OK
1136
+
to_bits 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
1137
+
= 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 10 00 00
1138
+
marshal round trip 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
1139
+
= OK
1140
+
to_bits 1329227995784915872903807060280344576
1141
+
= 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01
1142
+
marshal round trip 1329227995784915872903807060280344576
1143
+
= OK
1144
+
to_bits 2658455991569831745807614120560689152
1145
+
= 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 02
1146
+
marshal round trip 2658455991569831745807614120560689152
1147
+
= OK
1148
+
to_bits 1073741823
1149
+
= ff ff ff 3f
1150
+
marshal round trip 1073741823
1151
+
= OK
1152
+
to_bits -1073741824
1153
+
= 00 00 00 40
1154
+
marshal round trip -1073741824
1155
+
= OK
1156
+
to_bits 2147483647
1157
+
= ff ff ff 7f
1158
+
marshal round trip 2147483647
1159
+
= OK
1160
+
to_bits -2147483648
1161
+
= 00 00 00 80
1162
+
marshal round trip -2147483648
1163
+
= OK
1164
+
to_bits 9223372036854775807
1165
+
= ff ff ff ff ff ff ff 7f
1166
+
marshal round trip 9223372036854775807
1167
+
= OK
1168
+
to_bits -9223372036854775808
1169
+
= 00 00 00 00 00 00 00 80
1170
+
marshal round trip -9223372036854775808
1171
+
= OK
1172
+
to_bits 2147483647
1173
+
= ff ff ff 7f
1174
+
marshal round trip 2147483647
1175
+
= OK
1176
+
to_bits -2147483648
1177
+
= 00 00 00 80
1178
+
marshal round trip -2147483648
1179
+
= OK
1180
+
testbit 0 (passed)
1181
+
testbit 1 (passed)
1182
+
testbit -42 (passed)
1183
+
testbit 31415926535897932384626433832795028841971693993751058209749445923078164062862089986 (passed)
1184
+
testbit -2277361236363886404304896 (passed)
1185
+
numbits / trailing_zeros 0 (passed)
1186
+
numbits / trailing_zeros 1 (passed)
1187
+
numbits / trailing_zeros -42 (passed)
1188
+
numbits / trailing_zeros 1511006158790834639735881728 (passed)
1189
+
numbits / trailing_zeros -2277361236363886404304896 (passed)
1190
+
random_bits 45 = 25076743995969
1191
+
random_bits 45 = 33510880286625
1192
+
random_bits 12 = 1263
1193
+
random_int 123456 = 103797
1194
+
random_int 9999999 = 1089068
1195
+
- 0 = 0
1196
+
- 1 = -1
1197
+
- -1 = 1
1198
+
- +inf = -inf
1199
+
- -inf = +inf
1200
+
- undef = undef
1201
+
1/ 0 = +inf
1202
+
1/ 1 = 1
1203
+
1/ -1 = -1
1204
+
1/ +inf = 0
1205
+
1/ -inf = 0
1206
+
1/ undef = undef
1207
+
abs 0 = 0
1208
+
abs 1 = 1
1209
+
abs -1 = 1
1210
+
abs +inf = +inf
1211
+
abs -inf = +inf
1212
+
abs undef = undef
1213
+
0 + 0 = 0
1214
+
0 + 1 = 1
1215
+
0 + -1 = -1
1216
+
0 + +inf = +inf
1217
+
0 + -inf = -inf
1218
+
0 + undef = undef
1219
+
1 + 0 = 1
1220
+
1 + 1 = 2
1221
+
1 + -1 = 0
1222
+
1 + +inf = +inf
1223
+
1 + -inf = -inf
1224
+
1 + undef = undef
1225
+
-1 + 0 = -1
1226
+
-1 + 1 = 0
1227
+
-1 + -1 = -2
1228
+
-1 + +inf = +inf
1229
+
-1 + -inf = -inf
1230
+
-1 + undef = undef
1231
+
+inf + 0 = +inf
1232
+
+inf + 1 = +inf
1233
+
+inf + -1 = +inf
1234
+
+inf + +inf = +inf
1235
+
+inf + -inf = undef
1236
+
+inf + undef = undef
1237
+
-inf + 0 = -inf
1238
+
-inf + 1 = -inf
1239
+
-inf + -1 = -inf
1240
+
-inf + +inf = undef
1241
+
-inf + -inf = -inf
1242
+
-inf + undef = undef
1243
+
undef + 0 = undef
1244
+
undef + 1 = undef
1245
+
undef + -1 = undef
1246
+
undef + +inf = undef
1247
+
undef + -inf = undef
1248
+
undef + undef = undef
1249
+
0 - 0 = 0
1250
+
0 - 1 = -1
1251
+
0 - -1 = 1
1252
+
0 - +inf = -inf
1253
+
0 - -inf = +inf
1254
+
0 - undef = undef
1255
+
1 - 0 = 1
1256
+
1 - 1 = 0
1257
+
1 - -1 = 2
1258
+
1 - +inf = -inf
1259
+
1 - -inf = +inf
1260
+
1 - undef = undef
1261
+
-1 - 0 = -1
1262
+
-1 - 1 = -2
1263
+
-1 - -1 = 0
1264
+
-1 - +inf = -inf
1265
+
-1 - -inf = +inf
1266
+
-1 - undef = undef
1267
+
+inf - 0 = +inf
1268
+
+inf - 1 = +inf
1269
+
+inf - -1 = +inf
1270
+
+inf - +inf = undef
1271
+
+inf - -inf = +inf
1272
+
+inf - undef = undef
1273
+
-inf - 0 = -inf
1274
+
-inf - 1 = -inf
1275
+
-inf - -1 = -inf
1276
+
-inf - +inf = -inf
1277
+
-inf - -inf = undef
1278
+
-inf - undef = undef
1279
+
undef - 0 = undef
1280
+
undef - 1 = undef
1281
+
undef - -1 = undef
1282
+
undef - +inf = undef
1283
+
undef - -inf = undef
1284
+
undef - undef = undef
1285
+
0 * 0 = 0
1286
+
0 * 1 = 0
1287
+
0 * -1 = 0
1288
+
0 * +inf = undef
1289
+
0 * -inf = undef
1290
+
0 * undef = undef
1291
+
1 * 0 = 0
1292
+
1 * 1 = 1
1293
+
1 * -1 = -1
1294
+
1 * +inf = +inf
1295
+
1 * -inf = -inf
1296
+
1 * undef = undef
1297
+
-1 * 0 = 0
1298
+
-1 * 1 = -1
1299
+
-1 * -1 = 1
1300
+
-1 * +inf = -inf
1301
+
-1 * -inf = +inf
1302
+
-1 * undef = undef
1303
+
+inf * 0 = undef
1304
+
+inf * 1 = +inf
1305
+
+inf * -1 = -inf
1306
+
+inf * +inf = +inf
1307
+
+inf * -inf = -inf
1308
+
+inf * undef = undef
1309
+
-inf * 0 = undef
1310
+
-inf * 1 = -inf
1311
+
-inf * -1 = +inf
1312
+
-inf * +inf = -inf
1313
+
-inf * -inf = +inf
1314
+
-inf * undef = undef
1315
+
undef * 0 = undef
1316
+
undef * 1 = undef
1317
+
undef * -1 = undef
1318
+
undef * +inf = undef
1319
+
undef * -inf = undef
1320
+
undef * undef = undef
1321
+
0 / 0 = undef
1322
+
0 / 1 = 0
1323
+
0 / -1 = 0
1324
+
0 / +inf = 0
1325
+
0 / -inf = 0
1326
+
0 / undef = undef
1327
+
1 / 0 = +inf
1328
+
1 / 1 = 1
1329
+
1 / -1 = -1
1330
+
1 / +inf = 0
1331
+
1 / -inf = 0
1332
+
1 / undef = undef
1333
+
-1 / 0 = -inf
1334
+
-1 / 1 = -1
1335
+
-1 / -1 = 1
1336
+
-1 / +inf = 0
1337
+
-1 / -inf = 0
1338
+
-1 / undef = undef
1339
+
+inf / 0 = +inf
1340
+
+inf / 1 = +inf
1341
+
+inf / -1 = -inf
1342
+
+inf / +inf = undef
1343
+
+inf / -inf = undef
1344
+
+inf / undef = undef
1345
+
-inf / 0 = -inf
1346
+
-inf / 1 = -inf
1347
+
-inf / -1 = +inf
1348
+
-inf / +inf = undef
1349
+
-inf / -inf = undef
1350
+
-inf / undef = undef
1351
+
undef / 0 = undef
1352
+
undef / 1 = undef
1353
+
undef / -1 = undef
1354
+
undef / +inf = undef
1355
+
undef / -inf = undef
1356
+
undef / undef = undef
1357
+
0 * 1/ 0 = undef
1358
+
0 * 1/ 1 = 0
1359
+
0 * 1/ -1 = 0
1360
+
0 * 1/ +inf = 0
1361
+
0 * 1/ -inf = 0
1362
+
0 * 1/ undef = undef
1363
+
1 * 1/ 0 = +inf
1364
+
1 * 1/ 1 = 1
1365
+
1 * 1/ -1 = -1
1366
+
1 * 1/ +inf = 0
1367
+
1 * 1/ -inf = 0
1368
+
1 * 1/ undef = undef
1369
+
-1 * 1/ 0 = -inf
1370
+
-1 * 1/ 1 = -1
1371
+
-1 * 1/ -1 = 1
1372
+
-1 * 1/ +inf = 0
1373
+
-1 * 1/ -inf = 0
1374
+
-1 * 1/ undef = undef
1375
+
+inf * 1/ 0 = +inf
1376
+
+inf * 1/ 1 = +inf
1377
+
+inf * 1/ -1 = -inf
1378
+
+inf * 1/ +inf = undef
1379
+
+inf * 1/ -inf = undef
1380
+
+inf * 1/ undef = undef
1381
+
-inf * 1/ 0 = -inf
1382
+
-inf * 1/ 1 = -inf
1383
+
-inf * 1/ -1 = +inf
1384
+
-inf * 1/ +inf = undef
1385
+
-inf * 1/ -inf = undef
1386
+
-inf * 1/ undef = undef
1387
+
undef * 1/ 0 = undef
1388
+
undef * 1/ 1 = undef
1389
+
undef * 1/ -1 = undef
1390
+
undef * 1/ +inf = undef
1391
+
undef * 1/ -inf = undef
1392
+
undef * 1/ undef = undef
1393
+
mul_2exp (1) 0 = 0
1394
+
mul_2exp (1) 1 = 2
1395
+
mul_2exp (1) -1 = -2
1396
+
mul_2exp (1) +inf = +inf
1397
+
mul_2exp (1) -inf = -inf
1398
+
mul_2exp (1) undef = undef
1399
+
mul_2exp (2) 0 = 0
1400
+
mul_2exp (2) 1 = 4
1401
+
mul_2exp (2) -1 = -4
1402
+
mul_2exp (2) +inf = +inf
1403
+
mul_2exp (2) -inf = -inf
1404
+
mul_2exp (2) undef = undef
1405
+
div_2exp (1) 0 = 0
1406
+
div_2exp (1) 1 = 1/2
1407
+
div_2exp (1) -1 = -1/2
1408
+
div_2exp (1) +inf = +inf
1409
+
div_2exp (1) -inf = -inf
1410
+
div_2exp (1) undef = undef
1411
+
div_2exp (2) 0 = 0
1412
+
div_2exp (2) 1 = 1/4
1413
+
div_2exp (2) -1 = -1/4
1414
+
div_2exp (2) +inf = +inf
1415
+
div_2exp (2) -inf = -inf
1416
+
div_2exp (2) undef = undef
1417
+
identity checking 0 0
1418
+
identity checking 0 1
1419
+
identity checking 0 -1
1420
+
identity checking 0 +inf
1421
+
identity checking 0 -inf
1422
+
identity checking 0 undef
1423
+
identity checking 1 0
1424
+
identity checking 1 1
1425
+
identity checking 1 -1
1426
+
identity checking 1 +inf
1427
+
identity checking 1 -inf
1428
+
identity checking 1 undef
1429
+
identity checking -1 0
1430
+
identity checking -1 1
1431
+
identity checking -1 -1
1432
+
identity checking -1 +inf
1433
+
identity checking -1 -inf
1434
+
identity checking -1 undef
1435
+
identity checking +inf 0
1436
+
identity checking +inf 1
1437
+
identity checking +inf -1
1438
+
identity checking +inf +inf
1439
+
identity checking +inf -inf
1440
+
identity checking +inf undef
1441
+
identity checking -inf 0
1442
+
identity checking -inf 1
1443
+
identity checking -inf -1
1444
+
identity checking -inf +inf
1445
+
identity checking -inf -inf
1446
+
identity checking -inf undef
1447
+
identity checking undef 0
1448
+
identity checking undef 1
1449
+
identity checking undef -1
1450
+
identity checking undef +inf
1451
+
identity checking undef -inf
1452
+
identity checking undef undef
+1452
vendor/opam/zarith/tests/zq.output64
+1452
vendor/opam/zarith/tests/zq.output64
···
1
+
0
2
+
= 0
3
+
1
4
+
= 1
5
+
-1
6
+
= -1
7
+
42
8
+
= 42
9
+
1+1
10
+
= 2
11
+
1-1
12
+
= 0
13
+
- 1
14
+
= -1
15
+
0-1
16
+
= -1
17
+
max_int
18
+
= 4611686018427387903
19
+
min_int
20
+
= -4611686018427387904
21
+
-max_int
22
+
= -4611686018427387903
23
+
-min_int
24
+
= 4611686018427387904
25
+
2^300
26
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
27
+
2^120
28
+
= 1329227995784915872903807060280344576
29
+
2^300+2^120
30
+
= 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
31
+
2^300-2^120
32
+
= 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
33
+
2^300+(-(2^120))
34
+
= 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
35
+
2^120-2^300
36
+
= -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
37
+
2^120+(-(2^300))
38
+
= -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
39
+
-(2^120)+(-(2^300))
40
+
= -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
41
+
-(2^120)-2^300
42
+
= -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
43
+
2^300-2^300
44
+
= 0
45
+
2^121
46
+
= 2658455991569831745807614120560689152
47
+
2^121+2^120
48
+
= 3987683987354747618711421180841033728
49
+
2^121-2^120
50
+
= 1329227995784915872903807060280344576
51
+
2^121+(-(2^120))
52
+
= 1329227995784915872903807060280344576
53
+
2^120-2^121
54
+
= -1329227995784915872903807060280344576
55
+
2^120+(-(2^121))
56
+
= -1329227995784915872903807060280344576
57
+
-(2^120)+(-(2^121))
58
+
= -3987683987354747618711421180841033728
59
+
-(2^120)-2^121
60
+
= -3987683987354747618711421180841033728
61
+
2^121+0
62
+
= 2658455991569831745807614120560689152
63
+
2^121-0
64
+
= 2658455991569831745807614120560689152
65
+
0+2^121
66
+
= 2658455991569831745807614120560689152
67
+
0-2^121
68
+
= -2658455991569831745807614120560689152
69
+
2^300+1
70
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
71
+
2^300-1
72
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
73
+
1+2^300
74
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
75
+
1-2^300
76
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
77
+
2^300+(-1)
78
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
79
+
2^300-(-1)
80
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
81
+
(-1)+2^300
82
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
83
+
(-1)-2^300
84
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
85
+
-(2^300)+1
86
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
87
+
-(2^300)-1
88
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
89
+
1+(-(2^300))
90
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
91
+
1-(-(2^300))
92
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
93
+
-(2^300)+(-1)
94
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
95
+
-(2^300)-(-1)
96
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
97
+
(-1)+(-(2^300))
98
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
99
+
(-1)-(-(2^300))
100
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
101
+
max_int+1
102
+
= 4611686018427387904
103
+
min_int-1
104
+
= -4611686018427387905
105
+
-max_int-1
106
+
= -4611686018427387904
107
+
-min_int-1
108
+
= 4611686018427387903
109
+
5! = 120
110
+
12! = 479001600
111
+
15! = 1307674368000
112
+
20! = 2432902008176640000
113
+
25! = 15511210043330985984000000
114
+
50! = 30414093201713378043612608166064768844377641568960512000000000000
115
+
2^300*2^120
116
+
= 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576
117
+
2^120*2^300
118
+
= 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576
119
+
2^300*(-(2^120))
120
+
= -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576
121
+
2^120*(-(2^300))
122
+
= -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576
123
+
-(2^120)*(-(2^300))
124
+
= 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576
125
+
2^121*2^120
126
+
= 3533694129556768659166595001485837031654967793751237916243212402585239552
127
+
2^120*2^121
128
+
= 3533694129556768659166595001485837031654967793751237916243212402585239552
129
+
2^121*0
130
+
= 0
131
+
0*2^121
132
+
= 0
133
+
2^300*1
134
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
135
+
1*2^300
136
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
137
+
2^300*(-1)
138
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
139
+
(-1)*2^300
140
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
141
+
-(2^300)*1
142
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
143
+
1*(-(2^300))
144
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
145
+
-(2^300)*(-1)
146
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
147
+
(-1)*(-(2^300))
148
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
149
+
1*(2^30)
150
+
= 1073741824
151
+
1*(2^62)
152
+
= 4611686018427387904
153
+
(2^30)*(2^30)
154
+
= 1152921504606846976
155
+
(2^62)*(2^62)
156
+
= 21267647932558653966460912964485513216
157
+
0+1
158
+
= 1
159
+
1+1
160
+
= 2
161
+
-1+1
162
+
= 0
163
+
2+1
164
+
= 3
165
+
-2+1
166
+
= -1
167
+
(2^300)+1
168
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
169
+
-(2^300)+1
170
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
171
+
0-1
172
+
= -1
173
+
1-1
174
+
= 0
175
+
-1-1
176
+
= -2
177
+
2-1
178
+
= 1
179
+
-2-1
180
+
= -3
181
+
(2^300)-1
182
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
183
+
-(2^300)-1
184
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
185
+
max_int+1
186
+
= 4611686018427387904
187
+
min_int-1
188
+
= -4611686018427387905
189
+
-max_int-1
190
+
= -4611686018427387904
191
+
-min_int-1
192
+
= 4611686018427387903
193
+
abs(0)
194
+
= 0
195
+
abs(1)
196
+
= 1
197
+
abs(-1)
198
+
= 1
199
+
abs(min_int)
200
+
= 4611686018427387904
201
+
abs(2^300)
202
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
203
+
abs(-(2^300))
204
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
205
+
max_nativeint
206
+
= 9223372036854775807
207
+
max_int32
208
+
= 2147483647
209
+
max_int64
210
+
= 9223372036854775807
211
+
to_int 1
212
+
= true,1
213
+
to_int max_int
214
+
= true,4611686018427387903
215
+
to_int max_nativeint
216
+
= false,ovf
217
+
to_int max_int32
218
+
= true,2147483647
219
+
to_int max_int64
220
+
= false,ovf
221
+
to_int32 1
222
+
= true,1
223
+
to_int32 max_int
224
+
= false,ovf
225
+
to_int32 max_nativeint
226
+
= false,ovf
227
+
to_int32 max_int32
228
+
= true,2147483647
229
+
to_int32 max_int64
230
+
= false,ovf
231
+
to_int64 1
232
+
= true,1
233
+
to_int64 max_int
234
+
= true,4611686018427387903
235
+
to_int64 max_nativeint
236
+
= true,9223372036854775807
237
+
to_int64 max_int32
238
+
= true,2147483647
239
+
to_int64 max_int64
240
+
= true,9223372036854775807
241
+
to_nativeint 1
242
+
= true,1
243
+
to_nativeint max_int
244
+
= true,4611686018427387903
245
+
to_nativeint max_nativeint
246
+
= true,9223372036854775807
247
+
to_nativeint max_int32
248
+
= true,2147483647
249
+
to_nativeint max_int64
250
+
= true,9223372036854775807
251
+
to_int -min_int
252
+
= false,ovf
253
+
to_int -min_nativeint
254
+
= false,ovf
255
+
to_int -min_int32
256
+
= true,2147483648
257
+
to_int -min_int64
258
+
= false,ovf
259
+
to_int32 -min_int
260
+
= false,ovf
261
+
to_int32 -min_nativeint
262
+
= false,ovf
263
+
to_int32 -min_int32
264
+
= false,ovf
265
+
to_int32 -min_int64
266
+
= false,ovf
267
+
to_int64 -min_int
268
+
= true,4611686018427387904
269
+
to_int64 -min_nativeint
270
+
= false,ovf
271
+
to_int64 -min_int32
272
+
= true,2147483648
273
+
to_int64 -min_int64
274
+
= false,ovf
275
+
to_nativeint -min_int
276
+
= true,4611686018427387904
277
+
to_nativeint -min_nativeint
278
+
= false,ovf
279
+
to_nativeint -min_int32
280
+
= true,2147483648
281
+
to_nativeint -min_int64
282
+
= false,ovf
283
+
to_int32_unsigned 1
284
+
= true,1
285
+
to_int32_unsigned -1
286
+
= false,ovf
287
+
to_int32_unsigned max_int
288
+
= false,ovf
289
+
to_int32_unsigned max_nativeint
290
+
= false,ovf
291
+
to_int32_unsigned max_int32
292
+
= true,2147483647
293
+
to_int32_unsigned 2max_int32
294
+
= true,-2
295
+
to_int32_unsigned 3max_int32
296
+
= false,ovf
297
+
to_int32_unsigned max_int64
298
+
= false,ovf
299
+
to_int64_unsigned 1
300
+
= true,1
301
+
to_int64_unsigned -1
302
+
= false,ovf
303
+
to_int64_unsigned max_int
304
+
= true,4611686018427387903
305
+
to_int64_unsigned max_nativeint
306
+
= true,9223372036854775807
307
+
to_int64_unsigned max_int32
308
+
= true,2147483647
309
+
to_int64_unsigned max_int64
310
+
= true,9223372036854775807
311
+
to_int64_unsigned 2max_int64
312
+
= true,-2
313
+
to_int64_unsigned 3max_int64
314
+
= false,ovf
315
+
to_nativeint_unsigned 1
316
+
= true,1
317
+
to_nativeint_unsigned -1
318
+
= false,ovf
319
+
to_nativeint_unsigned max_int
320
+
= true,4611686018427387903
321
+
to_nativeint_unsigned max_nativeint
322
+
= true,9223372036854775807
323
+
to_nativeint_unsigned 2max_nativeint
324
+
= true,-2
325
+
to_nativeint_unsigned max_int32
326
+
= true,2147483647
327
+
to_nativeint_unsigned max_int64
328
+
= true,9223372036854775807
329
+
to_nativeint_unsigned 2max_int64
330
+
= true,-2
331
+
to_nativeint_unsigned 3max_int64
332
+
= false,ovf
333
+
of_int32_unsigned -1
334
+
= 4294967295
335
+
of_int64_unsigned -1
336
+
= 18446744073709551615
337
+
of_nativeint_unsigned -1
338
+
= 18446744073709551615
339
+
of_float 1.
340
+
= 1
341
+
of_float -1.
342
+
= -1
343
+
of_float pi
344
+
= 3
345
+
of_float 2^30
346
+
= 1073741824
347
+
of_float 2^31
348
+
= 2147483648
349
+
of_float 2^32
350
+
= 4294967296
351
+
of_float 2^33
352
+
= 8589934592
353
+
of_float -2^30
354
+
= -1073741824
355
+
of_float -2^31
356
+
= -2147483648
357
+
of_float -2^32
358
+
= -4294967296
359
+
of_float -2^33
360
+
= -8589934592
361
+
of_float 2^61
362
+
= 2305843009213693952
363
+
of_float 2^62
364
+
= 4611686018427387904
365
+
of_float 2^63
366
+
= 9223372036854775808
367
+
of_float 2^64
368
+
= 18446744073709551616
369
+
of_float 2^65
370
+
= 36893488147419103232
371
+
of_float -2^61
372
+
= -2305843009213693952
373
+
of_float -2^62
374
+
= -4611686018427387904
375
+
of_float -2^63
376
+
= -9223372036854775808
377
+
of_float -2^64
378
+
= -18446744073709551616
379
+
of_float -2^65
380
+
= -36893488147419103232
381
+
of_float 2^120
382
+
= 1329227995784915872903807060280344576
383
+
of_float 2^300
384
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
385
+
of_float -2^120
386
+
= -1329227995784915872903807060280344576
387
+
of_float -2^300
388
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
389
+
of_float 0.5
390
+
= 0
391
+
of_float -0.5
392
+
= 0
393
+
of_float 200.5
394
+
= 200
395
+
of_float -200.5
396
+
= -200
397
+
to_float 0
398
+
= OK
399
+
to_float 1
400
+
= OK
401
+
to_float -1
402
+
= OK
403
+
to_float 2^120
404
+
= OK
405
+
to_float -2^120
406
+
= OK
407
+
to_float (2^120-1)
408
+
= OK
409
+
to_float (-2^120+1)
410
+
= OK
411
+
to_float 2^63
412
+
= OK
413
+
to_float -2^63
414
+
= OK
415
+
to_float (2^63-1)
416
+
= OK
417
+
to_float (-2^63-1)
418
+
= OK
419
+
to_float (-2^63+1)
420
+
= OK
421
+
to_float 2^300
422
+
= OK
423
+
to_float -2^300
424
+
= OK
425
+
to_float (2^300-1)
426
+
= OK
427
+
to_float (-2^300+1)
428
+
= OK
429
+
of_string 12
430
+
= 12
431
+
of_string 0x12
432
+
= 18
433
+
of_string 0b10
434
+
= 2
435
+
of_string 0o12
436
+
= 10
437
+
of_string -12
438
+
= -12
439
+
of_string -0x12
440
+
= -18
441
+
of_string -0b10
442
+
= -2
443
+
of_string -0o12
444
+
= -10
445
+
of_string 000123456789012345678901234567890
446
+
= 123456789012345678901234567890
447
+
2^120 / 2^300 (trunc)
448
+
= 0
449
+
max_int / 2 (trunc)
450
+
= 2305843009213693951
451
+
(2^300+1) / 2^120 (trunc)
452
+
= 1532495540865888858358347027150309183618739122183602176
453
+
(-(2^300+1)) / 2^120 (trunc)
454
+
= -1532495540865888858358347027150309183618739122183602176
455
+
(2^300+1) / (-(2^120)) (trunc)
456
+
= -1532495540865888858358347027150309183618739122183602176
457
+
(-(2^300+1)) / (-(2^120)) (trunc)
458
+
= 1532495540865888858358347027150309183618739122183602176
459
+
2^120 / 2^300 (ceil)
460
+
= 1
461
+
max_int / 2 (ceil)
462
+
= 2305843009213693952
463
+
(2^300+1) / 2^120 (ceil)
464
+
= 1532495540865888858358347027150309183618739122183602177
465
+
(-(2^300+1)) / 2^120 (ceil)
466
+
= -1532495540865888858358347027150309183618739122183602176
467
+
(2^300+1) / (-(2^120)) (ceil)
468
+
= -1532495540865888858358347027150309183618739122183602176
469
+
(-(2^300+1)) / (-(2^120)) (ceil)
470
+
= 1532495540865888858358347027150309183618739122183602177
471
+
2^120 / 2^300 (floor)
472
+
= 0
473
+
max_int / 2 (floor)
474
+
= 2305843009213693951
475
+
(2^300+1) / 2^120 (floor)
476
+
= 1532495540865888858358347027150309183618739122183602176
477
+
(-(2^300+1)) / 2^120 (floor)
478
+
= -1532495540865888858358347027150309183618739122183602177
479
+
(2^300+1) / (-(2^120)) (floor)
480
+
= -1532495540865888858358347027150309183618739122183602177
481
+
(-(2^300+1)) / (-(2^120)) (floor)
482
+
= 1532495540865888858358347027150309183618739122183602176
483
+
2^120 % 2^300
484
+
= 1329227995784915872903807060280344576
485
+
max_int % 2
486
+
= 1
487
+
(2^300+1) % 2^120
488
+
= 1
489
+
(-(2^300+1)) % 2^120
490
+
= -1
491
+
(2^300+1) % (-(2^120))
492
+
= 1
493
+
(-(2^300+1)) % (-(2^120))
494
+
= -1
495
+
2^120 /,% 2^300
496
+
= 0, 1329227995784915872903807060280344576
497
+
max_int /,% 2
498
+
= 2305843009213693951, 1
499
+
(2^300+1) /,% 2^120
500
+
= 1532495540865888858358347027150309183618739122183602176, 1
501
+
(-(2^300+1)) /,% 2^120
502
+
= -1532495540865888858358347027150309183618739122183602176, -1
503
+
(2^300+1) /,% (-(2^120))
504
+
= -1532495540865888858358347027150309183618739122183602176, 1
505
+
(-(2^300+1)) /,% (-(2^120))
506
+
= 1532495540865888858358347027150309183618739122183602176, -1
507
+
1 & 2
508
+
= 0
509
+
1 & 2^300
510
+
= 0
511
+
2^120 & 2^300
512
+
= 0
513
+
2^300 & 2^120
514
+
= 0
515
+
2^300 & 2^300
516
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
517
+
2^300 & 0
518
+
= 0
519
+
-2^120 & 2^300
520
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
521
+
2^120 & -2^300
522
+
= 0
523
+
-2^120 & -2^300
524
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
525
+
-2^300 & 2^120
526
+
= 0
527
+
2^300 & -2^120
528
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
529
+
-2^300 & -2^120
530
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
531
+
1 | 2
532
+
= 3
533
+
1 | 2^300
534
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
535
+
2^120 | 2^300
536
+
= 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
537
+
2^300 | 2^120
538
+
= 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
539
+
2^300 | 2^300
540
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
541
+
2^300 | 0
542
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
543
+
-2^120 | 2^300
544
+
= -1329227995784915872903807060280344576
545
+
2^120 | -2^300
546
+
= -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
547
+
-2^120 | -2^300
548
+
= -1329227995784915872903807060280344576
549
+
-2^300 | 2^120
550
+
= -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
551
+
2^300 | -2^120
552
+
= -1329227995784915872903807060280344576
553
+
-2^300 | -2^120
554
+
= -1329227995784915872903807060280344576
555
+
1 ^ 2
556
+
= 3
557
+
1 ^ 2^300
558
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
559
+
2^120 ^ 2^300
560
+
= 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
561
+
2^300 ^ 2^120
562
+
= 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
563
+
2^300 ^ 2^300
564
+
= 0
565
+
2^300 ^ 0
566
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
567
+
-2^120 ^ 2^300
568
+
= -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
569
+
2^120 ^ -2^300
570
+
= -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
571
+
-2^120 ^ -2^300
572
+
= 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
573
+
-2^300 ^ 2^120
574
+
= -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
575
+
2^300 ^ -2^120
576
+
= -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952
577
+
-2^300 ^ -2^120
578
+
= 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800
579
+
~0
580
+
= -1
581
+
~1
582
+
= -2
583
+
~2
584
+
= -3
585
+
~2^300
586
+
= -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377
587
+
~(-1)
588
+
= 0
589
+
~(-2)
590
+
= 1
591
+
~(-(2^300))
592
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375
593
+
0 >> 1
594
+
= 0
595
+
0 >> 100
596
+
= 0
597
+
2 >> 1
598
+
= 1
599
+
2 >> 2
600
+
= 0
601
+
2 >> 100
602
+
= 0
603
+
2^300 >> 1
604
+
= 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688
605
+
2^300 >> 2
606
+
= 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344
607
+
2^300 >> 100
608
+
= 1606938044258990275541962092341162602522202993782792835301376
609
+
2^300 >> 200
610
+
= 1267650600228229401496703205376
611
+
2^300 >> 300
612
+
= 1
613
+
2^300 >> 400
614
+
= 0
615
+
-1 >> 1
616
+
= -1
617
+
-2 >> 1
618
+
= -1
619
+
-2 >> 2
620
+
= -1
621
+
-2 >> 100
622
+
= -1
623
+
-2^300 >> 1
624
+
= -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688
625
+
-2^300 >> 2
626
+
= -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344
627
+
-2^300 >> 100
628
+
= -1606938044258990275541962092341162602522202993782792835301376
629
+
-2^300 >> 200
630
+
= -1267650600228229401496703205376
631
+
-2^300 >> 300
632
+
= -1
633
+
-2^300 >> 400
634
+
= -1
635
+
0 >>0 1
636
+
= 0
637
+
0 >>0 100
638
+
= 0
639
+
2 >>0 1
640
+
= 1
641
+
2 >>0 2
642
+
= 0
643
+
2 >>0 100
644
+
= 0
645
+
2^300 >>0 1
646
+
= 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688
647
+
2^300 >>0 2
648
+
= 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344
649
+
2^300 >>0 100
650
+
= 1606938044258990275541962092341162602522202993782792835301376
651
+
2^300 >>0 200
652
+
= 1267650600228229401496703205376
653
+
2^300 >>0 300
654
+
= 1
655
+
2^300 >>0 400
656
+
= 0
657
+
-1 >>0 1
658
+
= 0
659
+
-2 >>0 1
660
+
= -1
661
+
-2 >>0 2
662
+
= 0
663
+
-2 >>0 100
664
+
= 0
665
+
-2^300 >>0 1
666
+
= -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688
667
+
-2^300 >>0 2
668
+
= -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344
669
+
-2^300 >>0 100
670
+
= -1606938044258990275541962092341162602522202993782792835301376
671
+
-2^300 >>0 200
672
+
= -1267650600228229401496703205376
673
+
-2^300 >>0 300
674
+
= -1
675
+
-2^300 >>0 400
676
+
= 0
677
+
0 << 1
678
+
= 0
679
+
0 << 100
680
+
= 0
681
+
2 << 1
682
+
= 4
683
+
2 << 32
684
+
= 8589934592
685
+
2 << 64
686
+
= 36893488147419103232
687
+
2 << 299
688
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
689
+
2^120 << 1
690
+
= 2658455991569831745807614120560689152
691
+
2^120 << 180
692
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
693
+
compare 1 2
694
+
= -1
695
+
compare 1 1
696
+
= 0
697
+
compare 2 1
698
+
= 1
699
+
compare 2^300 2^120
700
+
= 1
701
+
compare 2^120 2^120
702
+
= 0
703
+
compare 2^120 2^300
704
+
= -1
705
+
compare 2^121 2^120
706
+
= 1
707
+
compare 2^120 2^121
708
+
= -1
709
+
compare 2^300 -2^120
710
+
= 1
711
+
compare 2^120 -2^120
712
+
= 1
713
+
compare 2^120 -2^300
714
+
= 1
715
+
compare -2^300 2^120
716
+
= -1
717
+
compare -2^120 2^120
718
+
= -1
719
+
compare -2^120 2^300
720
+
= -1
721
+
compare -2^300 -2^120
722
+
= -1
723
+
compare -2^120 -2^120
724
+
= 0
725
+
compare -2^120 -2^300
726
+
= 1
727
+
equal 1 2
728
+
= false
729
+
equal 1 1
730
+
= true
731
+
equal 2 1
732
+
= false
733
+
equal 2^300 2^120
734
+
= false
735
+
equal 2^120 2^120
736
+
= true
737
+
equal 2^120 2^300
738
+
= false
739
+
equal 2^121 2^120
740
+
= false
741
+
equal 2^120 2^121
742
+
= false
743
+
equal 2^120 -2^120
744
+
= false
745
+
equal -2^120 2^120
746
+
= false
747
+
equal -2^120 -2^120
748
+
= true
749
+
sign 0
750
+
= 0
751
+
sign 1
752
+
= 1
753
+
sign -1
754
+
= -1
755
+
sign 2^300
756
+
= 1
757
+
sign -2^300
758
+
= -1
759
+
gcd 0 0
760
+
= 0
761
+
gcd 0 -137
762
+
= 137
763
+
gcd 12 27
764
+
= 3
765
+
gcd 27 12
766
+
= 3
767
+
gcd 27 27
768
+
= 27
769
+
gcd -12 27
770
+
= 3
771
+
gcd 12 -27
772
+
= 3
773
+
gcd -12 -27
774
+
= 3
775
+
gcd 0 2^300
776
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
777
+
gcd 2^120 2^300
778
+
= 1329227995784915872903807060280344576
779
+
gcd 2^300 2^120
780
+
= 1329227995784915872903807060280344576
781
+
gcd 0 -2^300
782
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
783
+
gcd 2^120 -2^300
784
+
= 1329227995784915872903807060280344576
785
+
gcd 2^300 -2^120
786
+
= 1329227995784915872903807060280344576
787
+
gcd -2^120 2^300
788
+
= 1329227995784915872903807060280344576
789
+
gcd -2^300 2^120
790
+
= 1329227995784915872903807060280344576
791
+
gcd -2^120 -2^300
792
+
= 1329227995784915872903807060280344576
793
+
gcd -2^300 -2^120
794
+
= 1329227995784915872903807060280344576
795
+
gcdext 12 27
796
+
= 3, -2, 1
797
+
gcdext 27 12
798
+
= 3, 1, -2
799
+
gcdext 27 27
800
+
= 27, 0, 1
801
+
gcdext -12 27
802
+
= 3, 2, 1
803
+
gcdext 12 -27
804
+
= 3, -2, -1
805
+
gcdext -12 -27
806
+
= 3, 2, -1
807
+
gcdext 2^120 2^300
808
+
= 1329227995784915872903807060280344576, 1, 0
809
+
gcdext 2^300 2^120
810
+
= 1329227995784915872903807060280344576, 0, 1
811
+
gcdext 12 0
812
+
= 12, 1, 0
813
+
gcdext 0 27
814
+
= 27, 0, 1
815
+
gcdext -12 0
816
+
= 12, -1, 0
817
+
gcdext 0 -27
818
+
= 27, 0, -1
819
+
gcdext 2^120 0
820
+
= 1329227995784915872903807060280344576, 1, 0
821
+
gcdext 0 2^300
822
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, 1
823
+
gcdext -2^120 0
824
+
= 1329227995784915872903807060280344576, -1, 0
825
+
gcdext 0 -2^300
826
+
= 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, -1
827
+
gcdext 0 0
828
+
= 0, 0, 0
829
+
lcm 0 0 = 0
830
+
lcm 10 12 = 60
831
+
lcm -10 12 = 60
832
+
lcm 10 -12 = 60
833
+
lcm -10 -12 = 60
834
+
lcm 0 12 = 0
835
+
lcm 0 -12 = 0
836
+
lcm 10 0 = 0
837
+
lcm -10 0 = 0
838
+
lcm 2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
839
+
lcm 2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
840
+
lcm -2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
841
+
lcm -2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
842
+
lcm 2^120 0 = 0
843
+
lcm -2^120 0 = 0
844
+
is_odd 0
845
+
= false
846
+
is_odd 1
847
+
= true
848
+
is_odd 2
849
+
= false
850
+
is_odd 3
851
+
= true
852
+
is_odd 2^120
853
+
= false
854
+
is_odd 2^120+1
855
+
= true
856
+
is_odd 2^300
857
+
= false
858
+
is_odd 2^300+1
859
+
= true
860
+
sqrt 0
861
+
= 0
862
+
sqrt 1
863
+
= 1
864
+
sqrt 2
865
+
= 1
866
+
sqrt 2^120
867
+
= 1152921504606846976
868
+
sqrt 2^121
869
+
= 1630477228166597776
870
+
sqrt_rem 0
871
+
= 0, 0
872
+
sqrt_rem 1
873
+
= 1, 0
874
+
sqrt_rem 2
875
+
= 1, 1
876
+
sqrt_rem 2^120
877
+
= 1152921504606846976, 0
878
+
sqrt_rem 2^121
879
+
= 1630477228166597776, 1772969445592542976
880
+
popcount 0
881
+
= 0
882
+
popcount 1
883
+
= 1
884
+
popcount 2
885
+
= 1
886
+
popcount max_int32
887
+
= 31
888
+
popcount 2^120
889
+
= 1
890
+
popcount (2^120-1)
891
+
= 120
892
+
hamdist 0 0
893
+
= 0
894
+
hamdist 0 1
895
+
= 1
896
+
hamdist 0 2^300
897
+
= 1
898
+
hamdist 2^120 2^120
899
+
= 0
900
+
hamdist 2^120 (2^120-1)
901
+
= 121
902
+
hamdist 2^120 2^300
903
+
= 2
904
+
hamdist (2^120-1) (2^300-1)
905
+
= 180
906
+
divisible 42 7
907
+
= true
908
+
divisible 43 7
909
+
= false
910
+
divisible 0 0
911
+
= true
912
+
divisible 0 2^120
913
+
= true
914
+
divisible 2 2^120
915
+
= false
916
+
divisible 2^300 2^120
917
+
= true
918
+
divisible (2^300-1) 32
919
+
= false
920
+
divisible min_int (max_int+1)
921
+
= true
922
+
divisible (max_int+1) min_int
923
+
= true
924
+
hash(2^120)
925
+
= 691199303
926
+
hash(2^121)
927
+
= 382412560
928
+
hash(2^300)
929
+
= 61759632
930
+
2^120 = 2^300
931
+
= false
932
+
2^120 = 2^120
933
+
= true
934
+
2^120 = 2^120
935
+
= true
936
+
2^120 > 2^300
937
+
= false
938
+
2^120 < 2^300
939
+
= true
940
+
2^120 = 1
941
+
= false
942
+
2^120 > 1
943
+
= true
944
+
2^120 < 1
945
+
= false
946
+
-2^120 > 1
947
+
= false
948
+
-2^120 < 1
949
+
= true
950
+
demarshal 2^120, 2^300, 1
951
+
= 1329227995784915872903807060280344576, 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 1
952
+
demarshal -2^120, -2^300, -1
953
+
= -1329227995784915872903807060280344576, -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, -1
954
+
format %i 0 = /0/
955
+
format %i 1 = /1/
956
+
format %i -1 = /-1/
957
+
format %i 2^30 = /1073741824/
958
+
format %i -2^30 = /-1073741824/
959
+
format % i 1 = / 1/
960
+
format %+i 1 = /+1/
961
+
format %x 0 = /0/
962
+
format %x 1 = /1/
963
+
format %x -1 = /-1/
964
+
format %x 2^30 = /40000000/
965
+
format %x -2^30 = /-40000000/
966
+
format %X 0 = /0/
967
+
format %X 1 = /1/
968
+
format %X -1 = /-1/
969
+
format %X 2^30 = /40000000/
970
+
format %X -2^30 = /-40000000/
971
+
format %o 0 = /0/
972
+
format %o 1 = /1/
973
+
format %o -1 = /-1/
974
+
format %o 2^30 = /10000000000/
975
+
format %o -2^30 = /-10000000000/
976
+
format %10i 0 = / 0/
977
+
format %10i 1 = / 1/
978
+
format %10i -1 = / -1/
979
+
format %10i 2^30 = /1073741824/
980
+
format %10i -2^30 = /-1073741824/
981
+
format %-10i 0 = /0 /
982
+
format %-10i 1 = /1 /
983
+
format %-10i -1 = /-1 /
984
+
format %-10i 2^30 = /1073741824/
985
+
format %-10i -2^30 = /-1073741824/
986
+
format %+10i 0 = / +0/
987
+
format %+10i 1 = / +1/
988
+
format %+10i -1 = / -1/
989
+
format %+10i 2^30 = /+1073741824/
990
+
format %+10i -2^30 = /-1073741824/
991
+
format % 10i 0 = / 0/
992
+
format % 10i 1 = / 1/
993
+
format % 10i -1 = / -1/
994
+
format % 10i 2^30 = / 1073741824/
995
+
format % 10i -2^30 = /-1073741824/
996
+
format %010i 0 = /0000000000/
997
+
format %010i 1 = /0000000001/
998
+
format %010i -1 = /-000000001/
999
+
format %010i 2^30 = /1073741824/
1000
+
format %010i -2^30 = /-1073741824/
1001
+
format %#x 0 = /0x0/
1002
+
format %#x 1 = /0x1/
1003
+
format %#x -1 = /-0x1/
1004
+
format %#x 2^30 = /0x40000000/
1005
+
format %#x -2^30 = /-0x40000000/
1006
+
format %#X 0 = /0X0/
1007
+
format %#X 1 = /0X1/
1008
+
format %#X -1 = /-0X1/
1009
+
format %#X 2^30 = /0X40000000/
1010
+
format %#X -2^30 = /-0X40000000/
1011
+
format %#o 0 = /0o0/
1012
+
format %#o 1 = /0o1/
1013
+
format %#o -1 = /-0o1/
1014
+
format %#o 2^30 = /0o10000000000/
1015
+
format %#o -2^30 = /-0o10000000000/
1016
+
format %#10x 0 = / 0x0/
1017
+
format %#10x 1 = / 0x1/
1018
+
format %#10x -1 = / -0x1/
1019
+
format %#10x 2^30 = /0x40000000/
1020
+
format %#10x -2^30 = /-0x40000000/
1021
+
format %#10X 0 = / 0X0/
1022
+
format %#10X 1 = / 0X1/
1023
+
format %#10X -1 = / -0X1/
1024
+
format %#10X 2^30 = /0X40000000/
1025
+
format %#10X -2^30 = /-0X40000000/
1026
+
format %#10o 0 = / 0o0/
1027
+
format %#10o 1 = / 0o1/
1028
+
format %#10o -1 = / -0o1/
1029
+
format %#10o 2^30 = /0o10000000000/
1030
+
format %#10o -2^30 = /-0o10000000000/
1031
+
format %#-10x 0 = /0x0 /
1032
+
format %#-10x 1 = /0x1 /
1033
+
format %#-10x -1 = /-0x1 /
1034
+
format %#-10x 2^30 = /0x40000000/
1035
+
format %#-10x -2^30 = /-0x40000000/
1036
+
format %#-10X 0 = /0X0 /
1037
+
format %#-10X 1 = /0X1 /
1038
+
format %#-10X -1 = /-0X1 /
1039
+
format %#-10X 2^30 = /0X40000000/
1040
+
format %#-10X -2^30 = /-0X40000000/
1041
+
format %#-10o 0 = /0o0 /
1042
+
format %#-10o 1 = /0o1 /
1043
+
format %#-10o -1 = /-0o1 /
1044
+
format %#-10o 2^30 = /0o10000000000/
1045
+
format %#-10o -2^30 = /-0o10000000000/
1046
+
extract 42 0 1 = 0 (passed)
1047
+
extract 42 0 5 = 10 (passed)
1048
+
extract 42 0 32 = 42 (passed)
1049
+
extract 42 0 64 = 42 (passed)
1050
+
extract 42 1 1 = 1 (passed)
1051
+
extract 42 1 5 = 21 (passed)
1052
+
extract 42 1 32 = 21 (passed)
1053
+
extract 42 1 63 = 21 (passed)
1054
+
extract 42 1 64 = 21 (passed)
1055
+
extract 42 1 127 = 21 (passed)
1056
+
extract 42 1 128 = 21 (passed)
1057
+
extract 42 69 12 = 0 (passed)
1058
+
extract -42 0 1 = 0 (passed)
1059
+
extract -42 0 5 = 22 (passed)
1060
+
extract -42 0 32 = 4294967254 (passed)
1061
+
extract -42 0 64 = 18446744073709551574 (passed)
1062
+
extract -42 1 1 = 1 (passed)
1063
+
extract -42 1 5 = 11 (passed)
1064
+
extract -42 1 32 = 4294967275 (passed)
1065
+
extract -42 1 63 = 9223372036854775787 (passed)
1066
+
extract -42 1 64 = 18446744073709551595 (passed)
1067
+
extract -42 1 127 = 170141183460469231731687303715884105707 (passed)
1068
+
extract -42 1 128 = 340282366920938463463374607431768211435 (passed)
1069
+
extract -42 69 12 = 4095 (passed)
1070
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = 1 (passed)
1071
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = 15536040655639606317 (passed)
1072
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = 1 (passed)
1073
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = 19 (passed)
1074
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = 2516587394 (passed)
1075
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = 7690089207107781587 (passed)
1076
+
extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = 9888429935207999867003931753264634841 (passed)
1077
+
signed_extract 42 0 1 = 0 (passed)
1078
+
signed_extract 42 0 5 = 10 (passed)
1079
+
signed_extract 42 0 32 = 42 (passed)
1080
+
signed_extract 42 0 64 = 42 (passed)
1081
+
signed_extract 42 1 1 = -1 (passed)
1082
+
signed_extract 42 1 5 = -11 (passed)
1083
+
signed_extract 42 1 32 = 21 (passed)
1084
+
signed_extract 42 1 63 = 21 (passed)
1085
+
signed_extract 42 1 64 = 21 (passed)
1086
+
signed_extract 42 1 127 = 21 (passed)
1087
+
signed_extract 42 1 128 = 21 (passed)
1088
+
signed_extract 42 69 12 = 0 (passed)
1089
+
signed_extract -42 0 1 = 0 (passed)
1090
+
signed_extract -42 0 5 = -10 (passed)
1091
+
signed_extract -42 0 32 = -42 (passed)
1092
+
signed_extract -42 0 64 = -42 (passed)
1093
+
signed_extract -42 1 1 = -1 (passed)
1094
+
signed_extract -42 1 5 = 11 (passed)
1095
+
signed_extract -42 1 32 = -21 (passed)
1096
+
signed_extract -42 1 63 = -21 (passed)
1097
+
signed_extract -42 1 64 = -21 (passed)
1098
+
signed_extract -42 1 127 = -21 (passed)
1099
+
signed_extract -42 1 128 = -21 (passed)
1100
+
signed_extract -42 69 12 = -1 (passed)
1101
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = -1 (passed)
1102
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = -2910703418069945299 (passed)
1103
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = -1 (passed)
1104
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = -13 (passed)
1105
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = -1778379902 (passed)
1106
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = -1533282829746994221 (passed)
1107
+
signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = -745394031071327116226524728978121767 (passed)
1108
+
to_bits 0
1109
+
=
1110
+
marshal round trip 0
1111
+
= OK
1112
+
to_bits 2
1113
+
= 02 00 00 00 00 00 00 00
1114
+
marshal round trip 2
1115
+
= OK
1116
+
to_bits -2
1117
+
= 02 00 00 00 00 00 00 00
1118
+
marshal round trip -2
1119
+
= OK
1120
+
to_bits 1073741824
1121
+
= 00 00 00 40 00 00 00 00
1122
+
marshal round trip 1073741824
1123
+
= OK
1124
+
to_bits -1073741824
1125
+
= 00 00 00 40 00 00 00 00
1126
+
marshal round trip -1073741824
1127
+
= OK
1128
+
to_bits 4611686018427387904
1129
+
= 00 00 00 00 00 00 00 40
1130
+
marshal round trip 4611686018427387904
1131
+
= OK
1132
+
to_bits -4611686018427387904
1133
+
= 00 00 00 00 00 00 00 40
1134
+
marshal round trip -4611686018427387904
1135
+
= OK
1136
+
to_bits 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
1137
+
= 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 10 00 00
1138
+
marshal round trip 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376
1139
+
= OK
1140
+
to_bits 1329227995784915872903807060280344576
1141
+
= 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01
1142
+
marshal round trip 1329227995784915872903807060280344576
1143
+
= OK
1144
+
to_bits 2658455991569831745807614120560689152
1145
+
= 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 02
1146
+
marshal round trip 2658455991569831745807614120560689152
1147
+
= OK
1148
+
to_bits 4611686018427387903
1149
+
= ff ff ff ff ff ff ff 3f
1150
+
marshal round trip 4611686018427387903
1151
+
= OK
1152
+
to_bits -4611686018427387904
1153
+
= 00 00 00 00 00 00 00 40
1154
+
marshal round trip -4611686018427387904
1155
+
= OK
1156
+
to_bits 2147483647
1157
+
= ff ff ff 7f 00 00 00 00
1158
+
marshal round trip 2147483647
1159
+
= OK
1160
+
to_bits -2147483648
1161
+
= 00 00 00 80 00 00 00 00
1162
+
marshal round trip -2147483648
1163
+
= OK
1164
+
to_bits 9223372036854775807
1165
+
= ff ff ff ff ff ff ff 7f
1166
+
marshal round trip 9223372036854775807
1167
+
= OK
1168
+
to_bits -9223372036854775808
1169
+
= 00 00 00 00 00 00 00 80
1170
+
marshal round trip -9223372036854775808
1171
+
= OK
1172
+
to_bits 9223372036854775807
1173
+
= ff ff ff ff ff ff ff 7f
1174
+
marshal round trip 9223372036854775807
1175
+
= OK
1176
+
to_bits -9223372036854775808
1177
+
= 00 00 00 00 00 00 00 80
1178
+
marshal round trip -9223372036854775808
1179
+
= OK
1180
+
testbit 0 (passed)
1181
+
testbit 1 (passed)
1182
+
testbit -42 (passed)
1183
+
testbit 31415926535897932384626433832795028841971693993751058209749445923078164062862089986 (passed)
1184
+
testbit -2277361236363886404304896 (passed)
1185
+
numbits / trailing_zeros 0 (passed)
1186
+
numbits / trailing_zeros 1 (passed)
1187
+
numbits / trailing_zeros -42 (passed)
1188
+
numbits / trailing_zeros 1511006158790834639735881728 (passed)
1189
+
numbits / trailing_zeros -2277361236363886404304896 (passed)
1190
+
random_bits 45 = 25076743995969
1191
+
random_bits 45 = 33510880286625
1192
+
random_bits 12 = 1263
1193
+
random_int 123456 = 103797
1194
+
random_int 9999999 = 1089068
1195
+
- 0 = 0
1196
+
- 1 = -1
1197
+
- -1 = 1
1198
+
- +inf = -inf
1199
+
- -inf = +inf
1200
+
- undef = undef
1201
+
1/ 0 = +inf
1202
+
1/ 1 = 1
1203
+
1/ -1 = -1
1204
+
1/ +inf = 0
1205
+
1/ -inf = 0
1206
+
1/ undef = undef
1207
+
abs 0 = 0
1208
+
abs 1 = 1
1209
+
abs -1 = 1
1210
+
abs +inf = +inf
1211
+
abs -inf = +inf
1212
+
abs undef = undef
1213
+
0 + 0 = 0
1214
+
0 + 1 = 1
1215
+
0 + -1 = -1
1216
+
0 + +inf = +inf
1217
+
0 + -inf = -inf
1218
+
0 + undef = undef
1219
+
1 + 0 = 1
1220
+
1 + 1 = 2
1221
+
1 + -1 = 0
1222
+
1 + +inf = +inf
1223
+
1 + -inf = -inf
1224
+
1 + undef = undef
1225
+
-1 + 0 = -1
1226
+
-1 + 1 = 0
1227
+
-1 + -1 = -2
1228
+
-1 + +inf = +inf
1229
+
-1 + -inf = -inf
1230
+
-1 + undef = undef
1231
+
+inf + 0 = +inf
1232
+
+inf + 1 = +inf
1233
+
+inf + -1 = +inf
1234
+
+inf + +inf = +inf
1235
+
+inf + -inf = undef
1236
+
+inf + undef = undef
1237
+
-inf + 0 = -inf
1238
+
-inf + 1 = -inf
1239
+
-inf + -1 = -inf
1240
+
-inf + +inf = undef
1241
+
-inf + -inf = -inf
1242
+
-inf + undef = undef
1243
+
undef + 0 = undef
1244
+
undef + 1 = undef
1245
+
undef + -1 = undef
1246
+
undef + +inf = undef
1247
+
undef + -inf = undef
1248
+
undef + undef = undef
1249
+
0 - 0 = 0
1250
+
0 - 1 = -1
1251
+
0 - -1 = 1
1252
+
0 - +inf = -inf
1253
+
0 - -inf = +inf
1254
+
0 - undef = undef
1255
+
1 - 0 = 1
1256
+
1 - 1 = 0
1257
+
1 - -1 = 2
1258
+
1 - +inf = -inf
1259
+
1 - -inf = +inf
1260
+
1 - undef = undef
1261
+
-1 - 0 = -1
1262
+
-1 - 1 = -2
1263
+
-1 - -1 = 0
1264
+
-1 - +inf = -inf
1265
+
-1 - -inf = +inf
1266
+
-1 - undef = undef
1267
+
+inf - 0 = +inf
1268
+
+inf - 1 = +inf
1269
+
+inf - -1 = +inf
1270
+
+inf - +inf = undef
1271
+
+inf - -inf = +inf
1272
+
+inf - undef = undef
1273
+
-inf - 0 = -inf
1274
+
-inf - 1 = -inf
1275
+
-inf - -1 = -inf
1276
+
-inf - +inf = -inf
1277
+
-inf - -inf = undef
1278
+
-inf - undef = undef
1279
+
undef - 0 = undef
1280
+
undef - 1 = undef
1281
+
undef - -1 = undef
1282
+
undef - +inf = undef
1283
+
undef - -inf = undef
1284
+
undef - undef = undef
1285
+
0 * 0 = 0
1286
+
0 * 1 = 0
1287
+
0 * -1 = 0
1288
+
0 * +inf = undef
1289
+
0 * -inf = undef
1290
+
0 * undef = undef
1291
+
1 * 0 = 0
1292
+
1 * 1 = 1
1293
+
1 * -1 = -1
1294
+
1 * +inf = +inf
1295
+
1 * -inf = -inf
1296
+
1 * undef = undef
1297
+
-1 * 0 = 0
1298
+
-1 * 1 = -1
1299
+
-1 * -1 = 1
1300
+
-1 * +inf = -inf
1301
+
-1 * -inf = +inf
1302
+
-1 * undef = undef
1303
+
+inf * 0 = undef
1304
+
+inf * 1 = +inf
1305
+
+inf * -1 = -inf
1306
+
+inf * +inf = +inf
1307
+
+inf * -inf = -inf
1308
+
+inf * undef = undef
1309
+
-inf * 0 = undef
1310
+
-inf * 1 = -inf
1311
+
-inf * -1 = +inf
1312
+
-inf * +inf = -inf
1313
+
-inf * -inf = +inf
1314
+
-inf * undef = undef
1315
+
undef * 0 = undef
1316
+
undef * 1 = undef
1317
+
undef * -1 = undef
1318
+
undef * +inf = undef
1319
+
undef * -inf = undef
1320
+
undef * undef = undef
1321
+
0 / 0 = undef
1322
+
0 / 1 = 0
1323
+
0 / -1 = 0
1324
+
0 / +inf = 0
1325
+
0 / -inf = 0
1326
+
0 / undef = undef
1327
+
1 / 0 = +inf
1328
+
1 / 1 = 1
1329
+
1 / -1 = -1
1330
+
1 / +inf = 0
1331
+
1 / -inf = 0
1332
+
1 / undef = undef
1333
+
-1 / 0 = -inf
1334
+
-1 / 1 = -1
1335
+
-1 / -1 = 1
1336
+
-1 / +inf = 0
1337
+
-1 / -inf = 0
1338
+
-1 / undef = undef
1339
+
+inf / 0 = +inf
1340
+
+inf / 1 = +inf
1341
+
+inf / -1 = -inf
1342
+
+inf / +inf = undef
1343
+
+inf / -inf = undef
1344
+
+inf / undef = undef
1345
+
-inf / 0 = -inf
1346
+
-inf / 1 = -inf
1347
+
-inf / -1 = +inf
1348
+
-inf / +inf = undef
1349
+
-inf / -inf = undef
1350
+
-inf / undef = undef
1351
+
undef / 0 = undef
1352
+
undef / 1 = undef
1353
+
undef / -1 = undef
1354
+
undef / +inf = undef
1355
+
undef / -inf = undef
1356
+
undef / undef = undef
1357
+
0 * 1/ 0 = undef
1358
+
0 * 1/ 1 = 0
1359
+
0 * 1/ -1 = 0
1360
+
0 * 1/ +inf = 0
1361
+
0 * 1/ -inf = 0
1362
+
0 * 1/ undef = undef
1363
+
1 * 1/ 0 = +inf
1364
+
1 * 1/ 1 = 1
1365
+
1 * 1/ -1 = -1
1366
+
1 * 1/ +inf = 0
1367
+
1 * 1/ -inf = 0
1368
+
1 * 1/ undef = undef
1369
+
-1 * 1/ 0 = -inf
1370
+
-1 * 1/ 1 = -1
1371
+
-1 * 1/ -1 = 1
1372
+
-1 * 1/ +inf = 0
1373
+
-1 * 1/ -inf = 0
1374
+
-1 * 1/ undef = undef
1375
+
+inf * 1/ 0 = +inf
1376
+
+inf * 1/ 1 = +inf
1377
+
+inf * 1/ -1 = -inf
1378
+
+inf * 1/ +inf = undef
1379
+
+inf * 1/ -inf = undef
1380
+
+inf * 1/ undef = undef
1381
+
-inf * 1/ 0 = -inf
1382
+
-inf * 1/ 1 = -inf
1383
+
-inf * 1/ -1 = +inf
1384
+
-inf * 1/ +inf = undef
1385
+
-inf * 1/ -inf = undef
1386
+
-inf * 1/ undef = undef
1387
+
undef * 1/ 0 = undef
1388
+
undef * 1/ 1 = undef
1389
+
undef * 1/ -1 = undef
1390
+
undef * 1/ +inf = undef
1391
+
undef * 1/ -inf = undef
1392
+
undef * 1/ undef = undef
1393
+
mul_2exp (1) 0 = 0
1394
+
mul_2exp (1) 1 = 2
1395
+
mul_2exp (1) -1 = -2
1396
+
mul_2exp (1) +inf = +inf
1397
+
mul_2exp (1) -inf = -inf
1398
+
mul_2exp (1) undef = undef
1399
+
mul_2exp (2) 0 = 0
1400
+
mul_2exp (2) 1 = 4
1401
+
mul_2exp (2) -1 = -4
1402
+
mul_2exp (2) +inf = +inf
1403
+
mul_2exp (2) -inf = -inf
1404
+
mul_2exp (2) undef = undef
1405
+
div_2exp (1) 0 = 0
1406
+
div_2exp (1) 1 = 1/2
1407
+
div_2exp (1) -1 = -1/2
1408
+
div_2exp (1) +inf = +inf
1409
+
div_2exp (1) -inf = -inf
1410
+
div_2exp (1) undef = undef
1411
+
div_2exp (2) 0 = 0
1412
+
div_2exp (2) 1 = 1/4
1413
+
div_2exp (2) -1 = -1/4
1414
+
div_2exp (2) +inf = +inf
1415
+
div_2exp (2) -inf = -inf
1416
+
div_2exp (2) undef = undef
1417
+
identity checking 0 0
1418
+
identity checking 0 1
1419
+
identity checking 0 -1
1420
+
identity checking 0 +inf
1421
+
identity checking 0 -inf
1422
+
identity checking 0 undef
1423
+
identity checking 1 0
1424
+
identity checking 1 1
1425
+
identity checking 1 -1
1426
+
identity checking 1 +inf
1427
+
identity checking 1 -inf
1428
+
identity checking 1 undef
1429
+
identity checking -1 0
1430
+
identity checking -1 1
1431
+
identity checking -1 -1
1432
+
identity checking -1 +inf
1433
+
identity checking -1 -inf
1434
+
identity checking -1 undef
1435
+
identity checking +inf 0
1436
+
identity checking +inf 1
1437
+
identity checking +inf -1
1438
+
identity checking +inf +inf
1439
+
identity checking +inf -inf
1440
+
identity checking +inf undef
1441
+
identity checking -inf 0
1442
+
identity checking -inf 1
1443
+
identity checking -inf -1
1444
+
identity checking -inf +inf
1445
+
identity checking -inf -inf
1446
+
identity checking -inf undef
1447
+
identity checking undef 0
1448
+
identity checking undef 1
1449
+
identity checking undef -1
1450
+
identity checking undef +inf
1451
+
identity checking undef -inf
1452
+
identity checking undef undef
+555
vendor/opam/zarith/z.ml
+555
vendor/opam/zarith/z.ml
···
1
+
(**
2
+
Integers.
3
+
4
+
5
+
This file is part of the Zarith library
6
+
http://forge.ocamlcore.org/projects/zarith .
7
+
It is distributed under LGPL 2 licensing, with static linking exception.
8
+
See the LICENSE file included in the distribution.
9
+
10
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
11
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
12
+
a joint laboratory by:
13
+
CNRS (Centre national de la recherche scientifique, France),
14
+
ENS (École normale supérieure, Paris, France),
15
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
16
+
17
+
*)
18
+
19
+
type t
20
+
21
+
exception Overflow
22
+
23
+
external init: unit -> unit = "ml_z_init"
24
+
let _ = init ()
25
+
26
+
let _ = Callback.register_exception "ml_z_overflow" Overflow
27
+
28
+
external is_small_int: t -> bool = "%obj_is_int"
29
+
external unsafe_to_int: t -> int = "%identity"
30
+
external of_int: int -> t = "%identity"
31
+
32
+
external c_neg: t -> t = "ml_z_neg"
33
+
34
+
let neg x =
35
+
if is_small_int x && unsafe_to_int x <> min_int
36
+
then of_int (- unsafe_to_int x)
37
+
else c_neg x
38
+
39
+
external c_add: t -> t -> t = "ml_z_add"
40
+
41
+
let add x y =
42
+
if is_small_int x && is_small_int y then begin
43
+
let z = unsafe_to_int x + unsafe_to_int y in
44
+
(* Overflow check -- Hacker's Delight, section 2.12 *)
45
+
if (z lxor unsafe_to_int x) land (z lxor unsafe_to_int y) >= 0
46
+
then of_int z
47
+
else c_add x y
48
+
end else
49
+
c_add x y
50
+
51
+
external c_sub: t -> t -> t = "ml_z_sub"
52
+
53
+
let sub x y =
54
+
if is_small_int x && is_small_int y then begin
55
+
let z = unsafe_to_int x - unsafe_to_int y in
56
+
(* Overflow check -- Hacker's Delight, section 2.12 *)
57
+
if (unsafe_to_int x lxor unsafe_to_int y)
58
+
land (z lxor unsafe_to_int x) >= 0
59
+
then of_int z
60
+
else c_sub x y
61
+
end else
62
+
c_sub x y
63
+
64
+
external mul_overflows: int -> int -> bool = "ml_z_mul_overflows" [@@noalloc]
65
+
external c_mul: t -> t -> t = "ml_z_mul"
66
+
67
+
let mul x y =
68
+
if is_small_int x && is_small_int y
69
+
&& not (mul_overflows (unsafe_to_int x) (unsafe_to_int y))
70
+
then of_int (unsafe_to_int x * unsafe_to_int y)
71
+
else c_mul x y
72
+
73
+
external c_div: t -> t -> t = "ml_z_div"
74
+
75
+
let div x y =
76
+
if is_small_int y then
77
+
if unsafe_to_int y = -1 then
78
+
neg x
79
+
else if is_small_int x then
80
+
of_int (unsafe_to_int x / unsafe_to_int y)
81
+
else
82
+
c_div x y
83
+
else
84
+
c_div x y
85
+
86
+
external cdiv: t -> t -> t = "ml_z_cdiv"
87
+
external fdiv: t -> t -> t = "ml_z_fdiv"
88
+
89
+
external c_rem: t -> t -> t = "ml_z_rem"
90
+
91
+
let rem x y =
92
+
if is_small_int y then
93
+
if unsafe_to_int y = -1 then
94
+
of_int 0
95
+
else if is_small_int x then
96
+
of_int (unsafe_to_int x mod unsafe_to_int y)
97
+
else
98
+
c_rem x y
99
+
else
100
+
c_rem x y
101
+
102
+
external div_rem: t -> t -> (t * t) = "ml_z_div_rem"
103
+
104
+
external c_divexact: t -> t -> t = "ml_z_divexact"
105
+
106
+
let divexact x y =
107
+
if is_small_int y then
108
+
if unsafe_to_int y = -1 then
109
+
neg x
110
+
else if is_small_int x then
111
+
of_int (unsafe_to_int x / unsafe_to_int y)
112
+
else
113
+
c_divexact x y
114
+
else
115
+
c_divexact x y
116
+
117
+
external c_succ: t -> t = "ml_z_succ"
118
+
119
+
let succ x =
120
+
if is_small_int x && unsafe_to_int x <> max_int
121
+
then of_int (unsafe_to_int x + 1)
122
+
else c_succ x
123
+
124
+
external c_pred: t -> t = "ml_z_pred"
125
+
126
+
let pred x =
127
+
if is_small_int x && unsafe_to_int x <> min_int
128
+
then of_int (unsafe_to_int x - 1)
129
+
else c_pred x
130
+
131
+
external c_abs: t -> t = "ml_z_abs"
132
+
133
+
let abs x =
134
+
if is_small_int x then
135
+
if unsafe_to_int x >= 0 then x
136
+
else if unsafe_to_int x <> min_int then
137
+
of_int (- unsafe_to_int x)
138
+
else
139
+
c_abs x
140
+
else
141
+
c_abs x
142
+
143
+
external c_logand: t -> t -> t = "ml_z_logand"
144
+
145
+
let logand x y =
146
+
if is_small_int x && is_small_int y
147
+
then of_int (unsafe_to_int x land unsafe_to_int y)
148
+
else c_logand x y
149
+
150
+
external c_logor: t -> t -> t = "ml_z_logor"
151
+
152
+
let logor x y =
153
+
if is_small_int x && is_small_int y
154
+
then of_int (unsafe_to_int x lor unsafe_to_int y)
155
+
else c_logor x y
156
+
157
+
external c_logxor: t -> t -> t = "ml_z_logxor"
158
+
159
+
let logxor x y =
160
+
if is_small_int x && is_small_int y
161
+
then of_int (unsafe_to_int x lxor unsafe_to_int y)
162
+
else c_logxor x y
163
+
164
+
external c_lognot: t -> t = "ml_z_lognot"
165
+
166
+
let lognot x =
167
+
if is_small_int x
168
+
then of_int (unsafe_to_int x lxor (-1))
169
+
else c_lognot x
170
+
171
+
external c_shift_left: t -> int -> t = "ml_z_shift_left"
172
+
173
+
let shift_left x y =
174
+
if is_small_int x && y >= 0 && y < Sys.word_size then begin
175
+
let z = unsafe_to_int x lsl y in
176
+
if z asr y = unsafe_to_int x
177
+
then of_int z
178
+
else c_shift_left x y
179
+
end else
180
+
c_shift_left x y
181
+
182
+
external c_shift_right: t -> int -> t = "ml_z_shift_right"
183
+
184
+
let shift_right x y =
185
+
if is_small_int x && y >= 0 then
186
+
of_int
187
+
(unsafe_to_int x asr (if y < Sys.word_size then y else Sys.word_size - 1))
188
+
else
189
+
c_shift_right x y
190
+
191
+
external c_shift_right_trunc: t -> int -> t = "ml_z_shift_right_trunc"
192
+
193
+
let shift_right_trunc x y =
194
+
if is_small_int x && y >= 0 then
195
+
if y >= Sys.word_size then
196
+
of_int 0
197
+
else if unsafe_to_int x >= 0 then
198
+
of_int (unsafe_to_int x lsr y)
199
+
else
200
+
of_int (- ((- unsafe_to_int x) lsr y))
201
+
else
202
+
c_shift_right_trunc x y
203
+
204
+
external of_int32: int32 -> t = "ml_z_of_int32"
205
+
external of_int64: int64 -> t = "ml_z_of_int64"
206
+
external of_nativeint: nativeint -> t = "ml_z_of_nativeint"
207
+
external of_float: float -> t = "ml_z_of_float"
208
+
209
+
let uint32_mask = pred (shift_left (of_int 1) 32)
210
+
let of_int32_unsigned x = logand (of_int32 x) uint32_mask
211
+
212
+
let uint64_mask = pred (shift_left (of_int 1) 64)
213
+
let of_int64_unsigned x = logand (of_int64 x) uint64_mask
214
+
215
+
let uintnat_mask = pred (shift_left (of_int 1) Nativeint.size)
216
+
let of_nativeint_unsigned x = logand (of_nativeint x) uintnat_mask
217
+
218
+
external c_to_int: t -> int = "ml_z_to_int"
219
+
220
+
let to_int x =
221
+
if is_small_int x then unsafe_to_int x else c_to_int x
222
+
223
+
external to_int32: t -> int32 = "ml_z_to_int32"
224
+
external to_int64: t -> int64 = "ml_z_to_int64"
225
+
external to_nativeint: t -> nativeint = "ml_z_to_nativeint"
226
+
external to_int32_unsigned: t -> int32 = "ml_z_to_int32_unsigned"
227
+
external to_int64_unsigned: t -> int64 = "ml_z_to_int64_unsigned"
228
+
external to_nativeint_unsigned: t -> nativeint = "ml_z_to_nativeint_unsigned"
229
+
external format: string -> t -> string = "ml_z_format"
230
+
external of_substring_base: int -> string -> pos:int -> len:int -> t = "ml_z_of_substring_base"
231
+
external compare: t -> t -> int = "ml_z_compare" [@@noalloc]
232
+
external equal: t -> t -> bool = "ml_z_equal" [@@noalloc]
233
+
external sign: t -> int = "ml_z_sign" [@@noalloc]
234
+
external gcd: t -> t -> t = "ml_z_gcd"
235
+
external gcdext_intern: t -> t -> (t * t * bool) = "ml_z_gcdext_intern"
236
+
external sqrt: t -> t = "ml_z_sqrt"
237
+
external sqrt_rem: t -> (t * t) = "ml_z_sqrt_rem"
238
+
external numbits: t -> int = "ml_z_numbits" [@@noalloc]
239
+
external trailing_zeros: t -> int = "ml_z_trailing_zeros" [@@noalloc]
240
+
external popcount: t -> int = "ml_z_popcount"
241
+
external hamdist: t -> t -> int = "ml_z_hamdist"
242
+
external size: t -> int = "ml_z_size" [@@noalloc]
243
+
external fits_int: t -> bool = "ml_z_fits_int" [@@noalloc]
244
+
external fits_int32: t -> bool = "ml_z_fits_int32" [@@noalloc]
245
+
external fits_int64: t -> bool = "ml_z_fits_int64" [@@noalloc]
246
+
external fits_nativeint: t -> bool = "ml_z_fits_nativeint" [@@noalloc]
247
+
external fits_int32_unsigned: t -> bool = "ml_z_fits_int32_unsigned" [@@noalloc]
248
+
external fits_int64_unsigned: t -> bool = "ml_z_fits_int64_unsigned" [@@noalloc]
249
+
external fits_nativeint_unsigned: t -> bool = "ml_z_fits_nativeint_unsigned" [@@noalloc]
250
+
external extract: t -> int -> int -> t = "ml_z_extract"
251
+
external powm: t -> t -> t -> t = "ml_z_powm"
252
+
external pow: t -> int -> t = "ml_z_pow"
253
+
external powm_sec: t -> t -> t -> t = "ml_z_powm_sec"
254
+
external root: t -> int -> t = "ml_z_root"
255
+
external rootrem: t -> int -> t * t = "ml_z_rootrem"
256
+
external invert: t -> t -> t = "ml_z_invert"
257
+
external perfect_power: t -> bool = "ml_z_perfect_power"
258
+
external perfect_square: t -> bool = "ml_z_perfect_square"
259
+
external probab_prime: t -> int -> int = "ml_z_probab_prime"
260
+
external nextprime: t -> t = "ml_z_nextprime"
261
+
let hash: t -> int = Stdlib.Hashtbl.hash
262
+
let seeded_hash: int -> t -> int = Stdlib.Hashtbl.seeded_hash
263
+
external to_bits: t -> string = "ml_z_to_bits"
264
+
external of_bits: string -> t = "ml_z_of_bits"
265
+
266
+
external c_divisible: t -> t -> bool = "ml_z_divisible"
267
+
268
+
let divisible x y =
269
+
if is_small_int x then
270
+
if is_small_int y then
271
+
if unsafe_to_int y = 0
272
+
then unsafe_to_int x = 0
273
+
else (unsafe_to_int x) mod (unsafe_to_int y) = 0
274
+
else
275
+
(* If y divides x, we have |y| <= |x| or x = 0.
276
+
Here, x is small: min_int <= x <= max_int
277
+
and y is not small: y < min_int \/ y > max_int.
278
+
|y| <= |x| is possible only if
279
+
x = min_int and y = -min_int = max_int+1 .
280
+
So, the only two cases where y divides x are
281
+
x = 0 or x = min_int /\ y = -min_int. *)
282
+
unsafe_to_int x = 0 || (unsafe_to_int x = min_int && y = c_neg x)
283
+
else
284
+
c_divisible x y
285
+
286
+
external congruent: t -> t -> t -> bool = "ml_z_congruent"
287
+
external jacobi: t -> t -> int = "ml_z_jacobi"
288
+
external legendre: t -> t -> int = "ml_z_legendre"
289
+
external kronecker: t -> t -> int = "ml_z_kronecker"
290
+
external remove: t -> t -> t * int = "ml_z_remove"
291
+
external fac: int -> t = "ml_z_fac"
292
+
external fac2: int -> t = "ml_z_fac2"
293
+
external facM: int -> int -> t = "ml_z_facM"
294
+
external primorial: int -> t = "ml_z_primorial"
295
+
external bin: t -> int -> t = "ml_z_bin"
296
+
external fib: int -> t = "ml_z_fib"
297
+
external lucnum: int -> t = "ml_z_lucnum"
298
+
299
+
let zero = of_int 0
300
+
let one = of_int 1
301
+
let minus_one = of_int (-1)
302
+
303
+
let min a b = if compare a b <= 0 then a else b
304
+
let max a b = if compare a b >= 0 then a else b
305
+
306
+
let leq a b = compare a b <= 0
307
+
let geq a b = compare a b >= 0
308
+
let lt a b = compare a b < 0
309
+
let gt a b = compare a b > 0
310
+
311
+
let to_string = format "%d"
312
+
313
+
let of_string s = of_substring_base 0 s ~pos:0 ~len:(String.length s)
314
+
let of_substring = of_substring_base 0
315
+
let of_string_base base s = of_substring_base base s ~pos:0 ~len:(String.length s)
316
+
317
+
let ediv_rem a b =
318
+
(* we have a = q * b + r, but [Big_int]'s remainder satisfies 0 <= r < |b|,
319
+
while [Z]'s remainder satisfies -|b| < r < |b| and sign(r) = sign(a)
320
+
*)
321
+
let q,r = div_rem a b in
322
+
if sign r >= 0 then (q,r) else
323
+
if sign b >= 0 then (pred q, add r b)
324
+
else (succ q, sub r b)
325
+
326
+
let ediv a b =
327
+
if sign b >= 0 then fdiv a b else cdiv a b
328
+
329
+
let erem a b =
330
+
let r = rem a b in
331
+
if sign r >= 0 then r else add r (abs b)
332
+
333
+
let gcdext u v =
334
+
match sign u, sign v with
335
+
(* special cases: one argument is null *)
336
+
| 0, 0 -> zero, zero, zero
337
+
| 0, 1 -> v, zero, one
338
+
| 0, -1 -> neg v, zero, minus_one
339
+
| 1, 0 -> u, one, zero
340
+
| -1, 0 -> neg u, minus_one, zero
341
+
| _ ->
342
+
(* general case *)
343
+
let g,s,z = gcdext_intern u v in
344
+
if z then g, s, div (sub g (mul u s)) v
345
+
else g, div (sub g (mul v s)) u, s
346
+
347
+
let lcm u v =
348
+
if u = zero || v = zero then zero
349
+
else
350
+
let g = gcd u v in
351
+
abs (mul (divexact u g) v)
352
+
353
+
external testbit_internal: t -> int -> bool = "ml_z_testbit" [@@noalloc]
354
+
let testbit x n =
355
+
if n >= 0 then testbit_internal x n else invalid_arg "Z.testbit"
356
+
(* The test [n >= 0] is done in Caml rather than in the C stub code
357
+
so that the latter raises no exceptions and can be declared [@@noalloc]. *)
358
+
359
+
let is_odd x = testbit_internal x 0
360
+
let is_even x = not (testbit_internal x 0)
361
+
362
+
external c_extract_small: t -> int -> int -> t
363
+
= "ml_z_extract_small" [@@noalloc]
364
+
external c_extract: t -> int -> int -> t = "ml_z_extract"
365
+
366
+
let extract_internal x o l =
367
+
if is_small_int x then
368
+
(* Fast path *)
369
+
let o = if o >= Sys.int_size then Sys.int_size - 1 else o in
370
+
(* Shift away low "o" bits. If "o" too big, just replicate sign bit. *)
371
+
let z = unsafe_to_int x asr o in
372
+
if l < Sys.int_size then
373
+
(* Extract "l" low bits, if "l" is small enough *)
374
+
of_int (z land ((1 lsl l) - 1))
375
+
else if z >= 0 then
376
+
(* If x >= 0, the extraction of "l" low bits keeps x unchanged. *)
377
+
of_int z
378
+
else
379
+
(* If x < 0, fall through slow path *)
380
+
c_extract x o l
381
+
else if l < Sys.int_size then
382
+
(* Alternative fast path since no allocation is required *)
383
+
c_extract_small x o l
384
+
else
385
+
c_extract x o l
386
+
387
+
let extract x o l =
388
+
if o < 0 then invalid_arg "Z.extract: negative bit offset";
389
+
if l < 1 then invalid_arg "Z.extract: nonpositive bit length";
390
+
extract_internal x o l
391
+
392
+
let signed_extract x o l =
393
+
if o < 0 then invalid_arg "Z.signed_extract: negative bit offset";
394
+
if l < 1 then invalid_arg "Z.signed_extract: nonpositive bit length";
395
+
if testbit x (o + l - 1)
396
+
then lognot (extract (lognot x) o l)
397
+
else extract x o l
398
+
399
+
let log2 x =
400
+
if sign x > 0 then (numbits x) - 1 else invalid_arg "Z.log2"
401
+
let log2up x =
402
+
if sign x > 0 then numbits (pred x) else invalid_arg "Z.log2up"
403
+
404
+
(* Consider a real number [r] such that
405
+
- the integral part of [r] is the bigint [x]
406
+
- 2^54 <= |x| < 2^63
407
+
- the fractional part of [r] is 0 if [exact = true],
408
+
nonzero if [exact = false].
409
+
Then, the following function returns [r] correctly rounded
410
+
according to the current rounding mode of the processor.
411
+
This is an instance of the "round to odd" technique formalized in
412
+
"When double rounding is odd" by S. Boldo and G. Melquiond.
413
+
The claim above is lemma Fappli_IEEE_extra.round_odd_fix
414
+
from the CompCert Coq development. *)
415
+
416
+
let round_to_float x exact =
417
+
let m = to_int64 x in
418
+
(* Unless the fractional part is exactly 0, round m to an odd integer *)
419
+
let m = if exact then m else Int64.logor m 1L in
420
+
(* Then convert m to float, with the current rounding mode. *)
421
+
Int64.to_float m
422
+
423
+
let to_float x =
424
+
if Obj.is_int (Obj.repr x) then
425
+
(* Fast path *)
426
+
float_of_int (Obj.magic x : int)
427
+
else begin
428
+
let n = numbits x in
429
+
if n <= 63 then
430
+
Int64.to_float (to_int64 x)
431
+
else begin
432
+
let n = n - 55 in
433
+
(* Extract top 55 bits of x *)
434
+
let top = shift_right x n in
435
+
(* Check if the other bits are all zero *)
436
+
let exact = equal x (shift_left top n) in
437
+
(* Round to float and apply exponent *)
438
+
ldexp (round_to_float top exact) n
439
+
end
440
+
end
441
+
442
+
(* Formatting *)
443
+
444
+
let print x = print_string (to_string x)
445
+
let output chan x = output_string chan (to_string x)
446
+
let sprint () x = to_string x
447
+
let bprint b x = Buffer.add_string b (to_string x)
448
+
let pp_print f x = Format.pp_print_string f (to_string x)
449
+
450
+
(* Pseudo-random generation *)
451
+
452
+
let rec raw_bits_random ?(rng: Random.State.t option) nbits =
453
+
let rec raw_bits accu n =
454
+
if n >= nbits then (accu, n) else begin
455
+
let i =
456
+
match rng with
457
+
| None -> Random.bits ()
458
+
| Some r -> Random.State.bits r in
459
+
raw_bits (logxor (shift_left accu 30) (of_int i)) (n + 30)
460
+
end in
461
+
raw_bits zero 0
462
+
463
+
let raw_bits_from_bytes ~(fill: bytes -> int -> int -> unit) nbits =
464
+
let nbytes = (nbits + 7) / 8 in
465
+
let buf = Bytes.create nbytes in
466
+
fill buf 0 nbytes;
467
+
(of_bits (Bytes.to_string buf), nbytes * 8)
468
+
469
+
let random_bits_aux (f: int -> t * int) nbits =
470
+
if nbits < 0 then invalid_arg "random_bits: number of bits must be >= 0";
471
+
let (x, _) = f nbits in
472
+
extract x 0 nbits
473
+
474
+
let random_int_aux (f: int -> t * int) bound =
475
+
if sign bound <= 0 then invalid_arg "random_int: bound must be > 0";
476
+
let nbits1 = log2up bound in
477
+
let rec draw () =
478
+
(* The minimal number of random bits we need to draw is nbits1.
479
+
However, in the worst case, rejection (as described below)
480
+
will occur with probability almost 1/2. So, we draw more bits
481
+
than strictly necessary to make rejection much less likely.
482
+
With 4 extra bits, the probability of rejection is less than
483
+
1/32. *)
484
+
let (x, nbits) = f (nbits1 + 4) in
485
+
let y = rem x bound in
486
+
(* We divide the range of x, namely [0 .. 2^nbits), into
487
+
- k intervals of width bound :
488
+
[0 .. bound) [bound.. 2*bound) .. [(k-1) * bound.. k * bound)
489
+
- the remaining numbers: [k * bound .. 2^nbits)
490
+
491
+
k is chosen as large as possible: k = floor (2^nbits / bound).
492
+
493
+
If x falls within the k intervals of width bound,
494
+
y = x mod bound is evenly distributed in [0 .. bound)
495
+
and we can use it as the pseudo-random number.
496
+
If x falls within the [k * bound .. 2^nbits) interval,
497
+
y = x mod bound may not be evenly distributed;
498
+
we reject and draw again.
499
+
500
+
We can decide efficiently whether to reject, as follows.
501
+
Write 2^nbits = k * bound + r and x = q * bound + y,
502
+
with r and y in [0 .. bound).
503
+
If x - y <= 2^nbits - bound, then
504
+
q * bound = x - y <= 2^nbits - bound < 2^nbits - r = k * bound,
505
+
hence q < k and we can accept x.
506
+
Otherwise,
507
+
q * bound = x - y > 2^nbits - bound = (k - 1) * bound + r
508
+
hence q >= k and we must reject x.
509
+
*)
510
+
if leq (sub x y) (sub (shift_left one nbits) bound)
511
+
then y
512
+
else draw () in
513
+
draw ()
514
+
515
+
let random_int ?rng bound =
516
+
random_int_aux (raw_bits_random ?rng) bound
517
+
let random_bits ?rng nbits =
518
+
random_bits_aux (raw_bits_random ?rng) nbits
519
+
520
+
let random_int_gen ~fill bound =
521
+
random_int_aux (raw_bits_from_bytes ~fill) bound
522
+
let random_bits_gen ~fill nbits =
523
+
random_bits_aux (raw_bits_from_bytes ~fill) nbits
524
+
525
+
(* Infix notations *)
526
+
527
+
let (~-) = neg
528
+
let (~+) x = x
529
+
let (+) = add
530
+
let (-) = sub
531
+
let ( * ) = mul
532
+
let (/) = div
533
+
external (/>): t -> t -> t = "ml_z_cdiv"
534
+
external (/<): t -> t -> t = "ml_z_fdiv"
535
+
let (/|) = divexact
536
+
let (mod) = rem
537
+
let (land) = logand
538
+
let (lor) = logor
539
+
let (lxor) = logxor
540
+
let (~!) = lognot
541
+
let (lsl) = shift_left
542
+
let (asr) = shift_right
543
+
external (~$): int -> t = "%identity"
544
+
external ( ** ): t -> int -> t = "ml_z_pow"
545
+
546
+
module Compare = struct
547
+
let (=) = equal
548
+
let (<) = lt
549
+
let (>) = gt
550
+
let (<=) = leq
551
+
let (>=) = geq
552
+
let (<>) a b = not (equal a b)
553
+
end
554
+
555
+
let version = Zarith_version.version
+880
vendor/opam/zarith/z.mli
+880
vendor/opam/zarith/z.mli
···
1
+
(**
2
+
Integers.
3
+
4
+
This modules provides arbitrary-precision integers.
5
+
Small integers internally use a regular OCaml [int].
6
+
When numbers grow too large, we switch transparently to GMP numbers
7
+
([mpn] numbers fully allocated on the OCaml heap).
8
+
9
+
This interface is rather similar to that of [Int32] and [Int64],
10
+
with some additional functions provided natively by GMP
11
+
(GCD, square root, pop-count, etc.).
12
+
13
+
14
+
This file is part of the Zarith library
15
+
http://forge.ocamlcore.org/projects/zarith .
16
+
It is distributed under LGPL 2 licensing, with static linking exception.
17
+
See the LICENSE file included in the distribution.
18
+
19
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
20
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
21
+
a joint laboratory by:
22
+
CNRS (Centre national de la recherche scientifique, France),
23
+
ENS (École normale supérieure, Paris, France),
24
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
25
+
26
+
*)
27
+
28
+
29
+
(** {1 Toplevel} *)
30
+
31
+
(** For an optimal experience with the [ocaml] interactive toplevel,
32
+
the magic commands are:
33
+
34
+
{[
35
+
#load "zarith.cma";;
36
+
#install_printer Z.pp_print;;
37
+
]}
38
+
39
+
Alternatively, using the new [Zarith_top] toplevel module, simply:
40
+
{[
41
+
#require "zarith.top";;
42
+
]}
43
+
*)
44
+
45
+
46
+
47
+
(** {1 Types} *)
48
+
49
+
type t
50
+
(** Type of integers of arbitrary length. *)
51
+
52
+
exception Overflow
53
+
(** Raised by conversion functions when the value cannot be represented in
54
+
the destination type.
55
+
*)
56
+
57
+
(** {1 Construction} *)
58
+
59
+
val zero: t
60
+
(** The number 0. *)
61
+
62
+
val one: t
63
+
(** The number 1. *)
64
+
65
+
val minus_one: t
66
+
(** The number -1. *)
67
+
68
+
external of_int: int -> t = "%identity"
69
+
(** Converts from a base integer. *)
70
+
71
+
external of_int32: int32 -> t = "ml_z_of_int32"
72
+
(** Converts from a 32-bit (signed) integer. *)
73
+
74
+
external of_int64: int64 -> t = "ml_z_of_int64"
75
+
(** Converts from a 64-bit (signed) integer. *)
76
+
77
+
external of_nativeint: nativeint -> t = "ml_z_of_nativeint"
78
+
(** Converts from a native (signed) integer. *)
79
+
80
+
val of_int32_unsigned: int32 -> t
81
+
(** Converts from a 32-bit integer, interpreted as an unsigned integer.
82
+
@since 1.13
83
+
*)
84
+
85
+
val of_int64_unsigned: int64 -> t
86
+
(** Converts from a 64-bit integer, interpreted as an unsigned integer.
87
+
@since 1.13
88
+
*)
89
+
90
+
val of_nativeint_unsigned: nativeint -> t
91
+
(** Converts from a native integer, interpreted as an unsigned integer..
92
+
@since 1.13
93
+
*)
94
+
95
+
external of_float: float -> t = "ml_z_of_float"
96
+
(** Converts from a floating-point value.
97
+
The value is truncated (rounded towards zero).
98
+
Raises [Overflow] on infinity and NaN arguments.
99
+
*)
100
+
101
+
val of_string: string -> t
102
+
(** Converts a string to an integer.
103
+
An optional [-] prefix indicates a negative number, while a [+]
104
+
prefix is ignored.
105
+
An optional prefix [0x], [0o], or [0b] (following the optional [-]
106
+
or [+] prefix) indicates that the number is,
107
+
represented, in hexadecimal, octal, or binary, respectively.
108
+
Otherwise, base 10 is assumed.
109
+
(Unlike C, a lone [0] prefix does not denote octal.)
110
+
Raises an [Invalid_argument] exception if the string is not a
111
+
syntactically correct representation of an integer.
112
+
*)
113
+
114
+
val of_substring : string -> pos:int -> len:int -> t
115
+
(** [of_substring s ~pos ~len] is the same as [of_string (String.sub s
116
+
pos len)]
117
+
@since 1.4
118
+
*)
119
+
120
+
val of_string_base: int -> string -> t
121
+
(** Parses a number represented as a string in the specified base,
122
+
with optional [-] or [+] prefix.
123
+
The base must be between 2 and 16.
124
+
*)
125
+
126
+
external of_substring_base
127
+
: int -> string -> pos:int -> len:int -> t
128
+
= "ml_z_of_substring_base"
129
+
(** [of_substring_base base s ~pos ~len] is the same as [of_string_base
130
+
base (String.sub s pos len)]
131
+
@since 1.4
132
+
*)
133
+
134
+
135
+
(** {1 Basic arithmetic operations} *)
136
+
137
+
val succ: t -> t
138
+
(** Returns its argument plus one. *)
139
+
140
+
val pred: t -> t
141
+
(** Returns its argument minus one. *)
142
+
143
+
val abs: t -> t
144
+
(** Absolute value. *)
145
+
146
+
val neg: t -> t
147
+
(** Unary negation. *)
148
+
149
+
val add: t -> t -> t
150
+
(** Addition. *)
151
+
152
+
val sub: t -> t -> t
153
+
(** Subtraction. *)
154
+
155
+
val mul: t -> t -> t
156
+
(** Multiplication. *)
157
+
158
+
val div: t -> t -> t
159
+
(** Integer division. The result is truncated towards zero
160
+
and obeys the rule of signs.
161
+
Raises [Division_by_zero] if the divisor (second argument) is 0.
162
+
*)
163
+
164
+
val rem: t -> t -> t
165
+
(** Integer remainder. Can raise a [Division_by_zero].
166
+
The result of [rem a b] has the sign of [a], and its absolute value is
167
+
strictly smaller than the absolute value of [b].
168
+
The result satisfies the equality [a = b * div a b + rem a b].
169
+
*)
170
+
171
+
external div_rem: t -> t -> (t * t) = "ml_z_div_rem"
172
+
(** Computes both the integer quotient and the remainder.
173
+
[div_rem a b] is equal to [(div a b, rem a b)].
174
+
Raises [Division_by_zero] if [b = 0].
175
+
*)
176
+
177
+
external cdiv: t -> t -> t = "ml_z_cdiv"
178
+
(** Integer division with rounding towards +oo (ceiling).
179
+
Can raise a [Division_by_zero].
180
+
*)
181
+
182
+
external fdiv: t -> t -> t = "ml_z_fdiv"
183
+
(** Integer division with rounding towards -oo (floor).
184
+
Can raise a [Division_by_zero].
185
+
*)
186
+
187
+
val ediv_rem: t -> t -> (t * t)
188
+
(** Euclidean division and remainder. [ediv_rem a b] returns a pair [(q, r)]
189
+
such that [a = b * q + r] and [0 <= r < |b|].
190
+
Raises [Division_by_zero] if [b = 0].
191
+
*)
192
+
193
+
val ediv: t -> t -> t
194
+
(** Euclidean division. [ediv a b] is equal to [fst (ediv_rem a b)].
195
+
The result satisfies [0 <= a - b * ediv a b < |b|].
196
+
Raises [Division_by_zero] if [b = 0].
197
+
*)
198
+
199
+
val erem: t -> t -> t
200
+
(** Euclidean remainder. [erem a b] is equal to [snd (ediv_rem a b)].
201
+
The result satisfies [0 <= erem a b < |b|] and
202
+
[a = b * ediv a b + erem a b]. Raises [Division_by_zero] if [b = 0].
203
+
*)
204
+
205
+
val divexact: t -> t -> t
206
+
(** [divexact a b] divides [a] by [b], only producing correct result when the
207
+
division is exact, i.e., when [b] evenly divides [a].
208
+
It should be faster than general division.
209
+
Can raise a [Division_by_zero].
210
+
*)
211
+
212
+
val divisible: t -> t -> bool
213
+
(** [divisible a b] returns [true] if [a] is exactly divisible by [b].
214
+
Unlike the other division functions, [b = 0] is accepted
215
+
(only 0 is considered divisible by 0).
216
+
@since 1.10
217
+
*)
218
+
219
+
external congruent: t -> t -> t -> bool = "ml_z_congruent"
220
+
(** [congruent a b c] returns [true] if [a] is congruent to [b] modulo [c].
221
+
Unlike the other division functions, [c = 0] is accepted
222
+
(only equal numbers are considered equal congruent 0).
223
+
@since 1.10
224
+
*)
225
+
226
+
227
+
228
+
229
+
(** {1 Bit-level operations} *)
230
+
231
+
(** For all bit-level operations, negative numbers are considered in 2's
232
+
complement representation, starting with a virtual infinite number of
233
+
1s.
234
+
*)
235
+
236
+
val logand: t -> t -> t
237
+
(** Bitwise logical and. *)
238
+
239
+
val logor: t -> t -> t
240
+
(** Bitwise logical or. *)
241
+
242
+
val logxor: t -> t -> t
243
+
(** Bitwise logical exclusive or. *)
244
+
245
+
val lognot: t -> t
246
+
(** Bitwise logical negation.
247
+
The identity [lognot a]=[-a-1] always hold.
248
+
*)
249
+
250
+
val shift_left: t -> int -> t
251
+
(** Shifts to the left.
252
+
Equivalent to a multiplication by a power of 2.
253
+
The second argument must be nonnegative.
254
+
*)
255
+
256
+
val shift_right: t -> int -> t
257
+
(** Shifts to the right.
258
+
This is an arithmetic shift,
259
+
equivalent to a division by a power of 2 with rounding towards -oo.
260
+
The second argument must be nonnegative.
261
+
*)
262
+
263
+
val shift_right_trunc: t -> int -> t
264
+
(** Shifts to the right, rounding towards 0.
265
+
This is equivalent to a division by a power of 2, with truncation.
266
+
The second argument must be nonnegative.
267
+
*)
268
+
269
+
external numbits: t -> int = "ml_z_numbits" [@@noalloc]
270
+
(** Returns the number of significant bits in the given number.
271
+
If [x] is zero, [numbits x] returns 0. Otherwise,
272
+
[numbits x] returns a positive integer [n] such that
273
+
[2^{n-1} <= |x| < 2^n]. Note that [numbits] is defined
274
+
for negative arguments, and that [numbits (-x) = numbits x].
275
+
@since 1.4
276
+
*)
277
+
278
+
external trailing_zeros: t -> int = "ml_z_trailing_zeros" [@@noalloc]
279
+
(** Returns the number of trailing 0 bits in the given number.
280
+
If [x] is zero, [trailing_zeros x] returns [max_int].
281
+
Otherwise, [trailing_zeros x] returns a nonnegative integer [n]
282
+
which is the largest [n] such that [2^n] divides [x] evenly.
283
+
Note that [trailing_zeros] is defined for negative arguments,
284
+
and that [trailing_zeros (-x) = trailing_zeros x].
285
+
@since 1.4
286
+
*)
287
+
288
+
val testbit: t -> int -> bool
289
+
(** [testbit x n] return the value of bit number [n] in [x]:
290
+
[true] if the bit is 1, [false] if the bit is 0.
291
+
Bits are numbered from 0. Raise [Invalid_argument] if [n]
292
+
is negative.
293
+
@since 1.4
294
+
*)
295
+
296
+
external popcount: t -> int = "ml_z_popcount"
297
+
(** Counts the number of bits set.
298
+
Raises [Overflow] for negative arguments, as those have an infinite
299
+
number of bits set.
300
+
*)
301
+
302
+
external hamdist: t -> t -> int = "ml_z_hamdist"
303
+
(** Counts the number of different bits.
304
+
Raises [Overflow] if the arguments have different signs
305
+
(in which case the distance is infinite).
306
+
*)
307
+
308
+
(** {1 Conversions} *)
309
+
310
+
(** Note that, when converting to an integer type that cannot represent the
311
+
converted value, an [Overflow] exception is raised.
312
+
*)
313
+
314
+
val to_int: t -> int
315
+
(** Converts to a signed OCaml [int].
316
+
Raises an [Overflow] if the value does not fit in a signed OCaml [int]. *)
317
+
318
+
external to_int32: t -> int32 = "ml_z_to_int32"
319
+
(** Converts to a signed 32-bit integer [int32].
320
+
Raises an [Overflow] if the value does not fit in a signed [int32]. *)
321
+
322
+
external to_int64: t -> int64 = "ml_z_to_int64"
323
+
(** Converts to a signed 64-bit integer [int64].
324
+
Raises an [Overflow] if the value does not fit in a signed [int64]. *)
325
+
326
+
external to_nativeint: t -> nativeint = "ml_z_to_nativeint"
327
+
(** Converts to a native signed integer [nativeint].
328
+
Raises an [Overflow] if the value does not fit in a signed [nativeint]. *)
329
+
330
+
external to_int32_unsigned: t -> int32 = "ml_z_to_int32_unsigned"
331
+
(** Converts to an unsigned 32-bit integer.
332
+
The result is stored into an OCaml [int32].
333
+
Beware that most [Int32] operations consider [int32] to a signed type, not unsigned.
334
+
Raises an [Overflow] if the value is negative or does not fit in an unsigned 32-bit integer.
335
+
@since 1.13
336
+
*)
337
+
338
+
external to_int64_unsigned: t -> int64 = "ml_z_to_int64_unsigned"
339
+
(** Converts to an unsigned 64-bit integer.
340
+
The result is stored into an OCaml [int64].
341
+
Beware that most [Int64] operations consider [int64] to a signed type, not unsigned.
342
+
Raises an [Overflow] if the value is negative or does not fit in an unsigned 64-bit integer.
343
+
@since 1.13
344
+
*)
345
+
346
+
external to_nativeint_unsigned: t -> nativeint = "ml_z_to_nativeint_unsigned"
347
+
(** Converts to a native unsigned integer.
348
+
The result is stored into an OCaml [nativeint].
349
+
Beware that most [Nativeint] operations consider [nativeint] to a signed type, not unsigned.
350
+
Raises an [Overflow] if the value is negative or does not fit in an unsigned native integer.
351
+
@since 1.13
352
+
*)
353
+
354
+
val to_float: t -> float
355
+
(** Converts to a floating-point value.
356
+
This function rounds the given integer according to the current
357
+
rounding mode of the processor. In default mode, it returns
358
+
the floating-point number nearest to the given integer,
359
+
breaking ties by rounding to even. *)
360
+
361
+
val to_string: t -> string
362
+
(** Gives a human-readable, decimal string representation of the argument. *)
363
+
364
+
external format: string -> t -> string = "ml_z_format"
365
+
(** Gives a string representation of the argument in the specified
366
+
printf-like format.
367
+
The general specification has the following form:
368
+
369
+
[% \[flags\] \[width\] type]
370
+
371
+
Where the type actually indicates the base:
372
+
373
+
- [i], [d], [u]: decimal
374
+
- [b]: binary
375
+
- [o]: octal
376
+
- [x]: lowercase hexadecimal
377
+
- [X]: uppercase hexadecimal
378
+
379
+
Supported flags are:
380
+
381
+
- [+]: prefix positive numbers with a [+] sign
382
+
- space: prefix positive numbers with a space
383
+
- [-]: left-justify (default is right justification)
384
+
- [0]: pad with zeroes (instead of spaces)
385
+
- [#]: alternate formatting (actually, simply output a literal-like prefix: [0x], [0b], [0o])
386
+
387
+
Unlike the classic [printf], all numbers are signed (even hexadecimal ones),
388
+
there is no precision field, and characters that are not part of the format
389
+
are simply ignored (and not copied in the output).
390
+
*)
391
+
392
+
external fits_int: t -> bool = "ml_z_fits_int" [@@noalloc]
393
+
(** Whether the argument fits in an OCaml signed [int]. *)
394
+
395
+
external fits_int32: t -> bool = "ml_z_fits_int32" [@@noalloc]
396
+
(** Whether the argument fits in a signed [int32]. *)
397
+
398
+
external fits_int64: t -> bool = "ml_z_fits_int64" [@@noalloc]
399
+
(** Whether the argument fits in a signed [int64]. *)
400
+
401
+
external fits_nativeint: t -> bool = "ml_z_fits_nativeint" [@@noalloc]
402
+
(** Whether the argument fits in a signed [nativeint]. *)
403
+
404
+
external fits_int32_unsigned: t -> bool = "ml_z_fits_int32_unsigned" [@@noalloc]
405
+
(** Whether the argument is non-negative and fits in an unsigned [int32].
406
+
@since 1.13
407
+
*)
408
+
409
+
external fits_int64_unsigned: t -> bool = "ml_z_fits_int64_unsigned" [@@noalloc]
410
+
(** Whether the argument is non-negative and fits in an unsigned [int64].
411
+
@since 1.13
412
+
*)
413
+
414
+
external fits_nativeint_unsigned: t -> bool = "ml_z_fits_nativeint_unsigned" [@@noalloc]
415
+
(** Whether the argument is non-negative fits in an unsigned [nativeint].
416
+
@since 1.13
417
+
*)
418
+
419
+
420
+
(** {1 Printing} *)
421
+
422
+
val print: t -> unit
423
+
(** Prints the argument on the standard output. *)
424
+
425
+
val output: out_channel -> t -> unit
426
+
(** Prints the argument on the specified channel.
427
+
Also intended to be used as [%a] format printer in [Printf.printf].
428
+
*)
429
+
430
+
val sprint: unit -> t -> string
431
+
(** To be used as [%a] format printer in [Printf.sprintf]. *)
432
+
433
+
val bprint: Buffer.t -> t -> unit
434
+
(** To be used as [%a] format printer in [Printf.bprintf]. *)
435
+
436
+
val pp_print: Format.formatter -> t -> unit
437
+
(** Prints the argument on the specified formatter.
438
+
Can be used as [%a] format printer in [Format.printf] and as
439
+
argument to [#install_printer] in the top-level.
440
+
*)
441
+
442
+
443
+
(** {1 Ordering} *)
444
+
445
+
external compare: t -> t -> int = "ml_z_compare" [@@noalloc]
446
+
(** Comparison. [compare x y] returns 0 if [x] equals [y],
447
+
-1 if [x] is smaller than [y], and 1 if [x] is greater than [y].
448
+
449
+
Note that Pervasive.compare can be used to compare reliably two integers
450
+
only on OCaml 3.12.1 and later versions.
451
+
*)
452
+
453
+
external equal: t -> t -> bool = "ml_z_equal" [@@noalloc]
454
+
(** Equality test. *)
455
+
456
+
val leq: t -> t -> bool
457
+
(** Less than or equal. *)
458
+
459
+
val geq: t -> t -> bool
460
+
(** Greater than or equal. *)
461
+
462
+
val lt: t -> t -> bool
463
+
(** Less than (and not equal). *)
464
+
465
+
val gt: t -> t -> bool
466
+
(** Greater than (and not equal). *)
467
+
468
+
external sign: t -> int = "ml_z_sign" [@@noalloc]
469
+
(** Returns -1, 0, or 1 when the argument is respectively negative, null, or
470
+
positive.
471
+
*)
472
+
473
+
val min: t -> t -> t
474
+
(** Returns the minimum of its arguments. *)
475
+
476
+
val max: t -> t -> t
477
+
(** Returns the maximum of its arguments. *)
478
+
479
+
val is_even: t -> bool
480
+
(** Returns true if the argument is even (divisible by 2), false if odd.
481
+
@since 1.4
482
+
*)
483
+
484
+
val is_odd: t -> bool
485
+
(** Returns true if the argument is odd, false if even.
486
+
@since 1.4
487
+
*)
488
+
489
+
val hash: t -> int
490
+
(** Hashes a number, producing a small integer.
491
+
The result is consistent with equality:
492
+
if [a] = [b], then [hash a] = [hash b].
493
+
The result is the same as produced by OCaml's generic hash function,
494
+
{!Hashtbl.hash}.
495
+
Together with type {!Z.t}, the function {!Z.hash} makes it possible
496
+
to pass module {!Z} as argument to the functor {!Hashtbl.Make}.
497
+
@before 1.14 a different hash algorithm was used.
498
+
*)
499
+
500
+
val seeded_hash: int -> t -> int
501
+
(** Like {!Z.hash}, but takes a seed as extra argument for diversification.
502
+
The result is the same as produced by OCaml's generic seeded hash function,
503
+
{!Hashtbl.seeded_hash}.
504
+
Together with type {!Z.t}, the function {!Z.hash} makes it possible
505
+
to pass module {!Z} as argument to the functor {!Hashtbl.MakeSeeded}.
506
+
@since 1.14
507
+
*)
508
+
509
+
(** {1 Elementary number theory} *)
510
+
511
+
external gcd: t -> t -> t = "ml_z_gcd"
512
+
(** Greatest common divisor.
513
+
The result is always nonnegative.
514
+
We have [gcd(a,0) = gcd(0,a) = abs(a)], including [gcd(0,0) = 0].
515
+
*)
516
+
517
+
val gcdext: t -> t -> (t * t * t)
518
+
(** [gcdext u v] returns [(g,s,t)] where [g] is the greatest common divisor
519
+
and [g=us+vt].
520
+
[g] is always nonnegative.
521
+
522
+
Note: the function is based on the GMP [mpn_gcdext] function. The exact choice of [s] and [t] such that [g=us+vt] is not specified, as it may vary from a version of GMP to another (it has changed notably in GMP 4.3.0 and 4.3.1).
523
+
*)
524
+
525
+
val lcm: t -> t -> t
526
+
(**
527
+
Least common multiple.
528
+
The result is always nonnegative.
529
+
We have [lcm(a,0) = lcm(0,a) = 0].
530
+
*)
531
+
532
+
external powm: t -> t -> t -> t = "ml_z_powm"
533
+
(** [powm base exp mod] computes [base]^[exp] modulo [mod].
534
+
Negative [exp] are supported, in which case ([base]^-1)^(-[exp]) modulo
535
+
[mod] is computed.
536
+
However, if [exp] is negative but [base] has no inverse modulo [mod], then
537
+
a [Division_by_zero] is raised.
538
+
*)
539
+
540
+
external powm_sec: t -> t -> t -> t = "ml_z_powm_sec"
541
+
(** [powm_sec base exp mod] computes [base]^[exp] modulo [mod].
542
+
Unlike [Z.powm], this function is designed to take the same time
543
+
and have the same cache access patterns for any two same-size
544
+
arguments. Used in cryptographic applications, it provides better
545
+
resistance to side-channel attacks than [Z.powm].
546
+
The exponent [exp] must be positive, and the modulus [mod]
547
+
must be odd. Otherwise, [Invalid_arg] is raised.
548
+
@since 1.4
549
+
*)
550
+
551
+
external invert: t -> t -> t = "ml_z_invert"
552
+
(** [invert base mod] returns the inverse of [base] modulo [mod].
553
+
Raises a [Division_by_zero] if [base] is not invertible modulo [mod].
554
+
*)
555
+
556
+
external probab_prime: t -> int -> int = "ml_z_probab_prime"
557
+
(** [probab_prime x r] returns 0 if [x] is definitely composite,
558
+
1 if [x] is probably prime, and 2 if [x] is definitely prime.
559
+
The [r] argument controls how many Miller-Rabin probabilistic
560
+
primality tests are performed (5 to 10 is a reasonable value).
561
+
*)
562
+
563
+
external nextprime: t -> t = "ml_z_nextprime"
564
+
(** Returns the next prime greater than the argument.
565
+
The result is only prime with very high probability.
566
+
*)
567
+
568
+
external jacobi: t -> t -> int = "ml_z_jacobi"
569
+
(** [jacobi a b] returns the Jacobi symbol [(a/b)].
570
+
@since 1.10 *)
571
+
572
+
external legendre: t -> t -> int = "ml_z_legendre"
573
+
(** [legendre a b] returns the Legendre symbol [(a/b)].
574
+
@since 1.10 *)
575
+
576
+
external kronecker: t -> t -> int = "ml_z_kronecker"
577
+
(** [kronecker a b] returns the Kronecker symbol [(a/b)].
578
+
@since 1.10 *)
579
+
580
+
external remove: t -> t -> t * int = "ml_z_remove"
581
+
(** [remove a b] returns [a] after removing all the occurences of the
582
+
factor [b].
583
+
Also returns how many occurrences were removed.
584
+
@since 1.10 *)
585
+
586
+
external fac: int -> t = "ml_z_fac"
587
+
(** [fac n] returns the factorial of [n] ([n!]).
588
+
Raises an [Invaid_argument] if [n] is non-positive.
589
+
@since 1.10 *)
590
+
591
+
external fac2: int -> t = "ml_z_fac2"
592
+
(** [fac2 n] returns the double factorial of [n] ([n!!]).
593
+
Raises an [Invaid_argument] if [n] is non-positive.
594
+
@since 1.10 *)
595
+
596
+
external facM: int -> int -> t = "ml_z_facM"
597
+
(** [facM n m] returns the [m]-th factorial of [n].
598
+
Raises an [Invaid_argument] if [n] or [m] is non-positive.
599
+
@since 1.10 *)
600
+
601
+
external primorial: int -> t = "ml_z_primorial"
602
+
(** [primorial n] returns the product of all positive prime numbers less
603
+
than or equal to [n].
604
+
Raises an [Invaid_argument] if [n] is non-positive.
605
+
@since 1.10 *)
606
+
607
+
external bin: t -> int -> t = "ml_z_bin"
608
+
(** [bin n k] returns the binomial coefficient [n] over [k].
609
+
Raises an [Invaid_argument] if [k] is non-positive.
610
+
@since 1.10 *)
611
+
612
+
external fib: int -> t = "ml_z_fib"
613
+
(** [fib n] returns the [n]-th Fibonacci number.
614
+
Raises an [Invaid_argument] if [n] is non-positive.
615
+
@since 1.10 *)
616
+
617
+
external lucnum: int -> t = "ml_z_lucnum"
618
+
(** [lucnum n] returns the [n]-th Lucas number.
619
+
Raises an [Invaid_argument] if [n] is non-positive.
620
+
@since 1.10 *)
621
+
622
+
623
+
(** {1 Powers} *)
624
+
625
+
external pow: t -> int -> t = "ml_z_pow"
626
+
(** [pow base exp] raises [base] to the [exp] power.
627
+
[exp] must be nonnegative.
628
+
Note that only exponents fitting in a machine integer are supported, as
629
+
larger exponents would surely make the result's size overflow the
630
+
address space.
631
+
*)
632
+
633
+
external sqrt: t -> t = "ml_z_sqrt"
634
+
(** Returns the square root. The result is truncated (rounded down
635
+
to an integer).
636
+
Raises an [Invalid_argument] on negative arguments.
637
+
*)
638
+
639
+
external sqrt_rem: t -> (t * t) = "ml_z_sqrt_rem"
640
+
(** Returns the square root truncated, and the remainder.
641
+
Raises an [Invalid_argument] on negative arguments.
642
+
*)
643
+
644
+
external root: t -> int -> t = "ml_z_root"
645
+
(** [root x n] computes the [n]-th root of [x].
646
+
[n] must be positive and, if [n] is even, then [x] must be nonnegative.
647
+
Otherwise, an [Invalid_argument] is raised.
648
+
*)
649
+
650
+
external rootrem: t -> int -> t * t = "ml_z_rootrem"
651
+
(** [rootrem x n] computes the [n]-th root of [x] and the remainder
652
+
[x-root**n].
653
+
[n] must be positive and, if [n] is even, then [x] must be nonnegative.
654
+
Otherwise, an [Invalid_argument] is raised.
655
+
@since 1.10 *)
656
+
657
+
external perfect_power: t -> bool = "ml_z_perfect_power"
658
+
(** True if the argument has the form [a^b], with [b>1] *)
659
+
660
+
external perfect_square: t -> bool = "ml_z_perfect_square"
661
+
(** True if the argument has the form [a^2]. *)
662
+
663
+
val log2: t -> int
664
+
(** Returns the base-2 logarithm of its argument, rounded down to
665
+
an integer. If [x] is positive, [log2 x] returns the largest [n]
666
+
such that [2^n <= x]. If [x] is negative or zero, [log2 x] raise
667
+
the [Invalid_argument] exception.
668
+
@since 1.4
669
+
*)
670
+
671
+
val log2up: t -> int
672
+
(** Returns the base-2 logarithm of its argument, rounded up to
673
+
an integer. If [x] is positive, [log2up x] returns the smallest [n]
674
+
such that [x <= 2^n]. If [x] is negative or zero, [log2up x] raise
675
+
the [Invalid_argument] exception.
676
+
@since 1.4
677
+
*)
678
+
679
+
(** {1 Representation} *)
680
+
681
+
external size: t -> int = "ml_z_size" [@@noalloc]
682
+
(** Returns the number of machine words used to represent the number. *)
683
+
684
+
val extract: t -> int -> int -> t
685
+
(** [extract a off len] returns a nonnegative number corresponding to bits
686
+
[off] to [off]+[len]-1 of [a].
687
+
Negative [a] are considered in infinite-length 2's complement
688
+
representation.
689
+
Raises an [Invalid_argument] if [off] is strictly negative, or if [len] is negative or null.
690
+
*)
691
+
692
+
val signed_extract: t -> int -> int -> t
693
+
(** [signed_extract a off len] extracts bits [off] to [off]+[len]-1 of [b],
694
+
as [extract] does, then sign-extends bit [len-1] of the result
695
+
(that is, bit [off + len - 1] of [a]). The result is between
696
+
[- 2{^[len]-1}] (included) and [2{^[len]-1}] (excluded),
697
+
and equal to [extract a off len] modulo [2{^len}].
698
+
Raises an [Invalid_argument] if [off] is strictly negative, or if [len] is negative or null.
699
+
*)
700
+
701
+
external to_bits: t -> string = "ml_z_to_bits"
702
+
(** Returns a binary representation of the argument.
703
+
The string result should be interpreted as a sequence of bytes,
704
+
corresponding to the binary representation of the absolute value of
705
+
the argument in little endian ordering.
706
+
The sign is not stored in the string.
707
+
*)
708
+
709
+
external of_bits: string -> t = "ml_z_of_bits"
710
+
(** Constructs a number from a binary string representation.
711
+
The string is interpreted as a sequence of bytes in little endian order,
712
+
and the result is always positive.
713
+
We have the identity: [of_bits (to_bits x) = abs x].
714
+
However, we can have [to_bits (of_bits s) <> s] due to the presence of
715
+
trailing zeros in s.
716
+
*)
717
+
718
+
(** {1 Pseudo-random number generation} *)
719
+
720
+
val random_int: ?rng: Random.State.t -> t -> t
721
+
(** [random_int bound] returns a random integer between 0 (inclusive)
722
+
and [bound] (exclusive). [bound] must be greater than 0.
723
+
724
+
The source of randomness is the {!Random} module from the OCaml
725
+
standard library. The optional [rng] argument specifies which
726
+
random state to use. If omitted, the default random state for the
727
+
{!Random} module is used.
728
+
729
+
Random numbers produced by this function are not cryptographically
730
+
strong and must not be used in cryptographic or high-security
731
+
contexts. See {!Z.random_int_gen} for an alternative.
732
+
733
+
@since 1.13
734
+
*)
735
+
736
+
val random_bits: ?rng: Random.State.t -> int -> t
737
+
(** [random_bits nbits] returns a random integer between 0 (inclusive)
738
+
and [2{^nbits}] (exclusive). [nbits] must be nonnegative.
739
+
This is a more efficient special case of {!Z.random_int} when the
740
+
bound is a power of two.
741
+
742
+
The source of randomness and the [rng] optional argument are as
743
+
described in {!Z.random_int}.
744
+
745
+
Random numbers produced by this function are not cryptographically
746
+
strong and must not be used in cryptographic or high-security
747
+
contexts. See {!Z.random_bits_gen} for an alternative.
748
+
749
+
@since 1.13
750
+
*)
751
+
752
+
val random_int_gen: fill: (bytes -> int -> int -> unit) -> t -> t
753
+
(** [random_int_gen ~fill bound] returns a random integer between 0 (inclusive)
754
+
and [bound] (exclusive). [bound] must be greater than 0.
755
+
756
+
The [fill] parameter is the source of randomness. It is called
757
+
as [fill buf pos len], and is responsible for drawing [len] random
758
+
bytes and writing them to offsets [pos] to [pos + len - 1] of
759
+
the byte array [buf].
760
+
761
+
Example of use where [/dev/random] provides the random bytes:
762
+
<<
763
+
In_channel.with_open_bin "/dev/random"
764
+
(fun ic -> Z.random_int_gen ~fill:(really_input ic) bound)
765
+
>>
766
+
Example of use where the Cryptokit library provides the random bytes:
767
+
<<
768
+
Z.random_int_gen ~fill:Cryptokit.Random.secure_rng#bytes bound
769
+
>>
770
+
@since 1.13
771
+
*)
772
+
773
+
val random_bits_gen: fill: (bytes -> int -> int -> unit) -> int -> t
774
+
(** [random_bits_gen ~fill nbits] returns a random integer between 0 (inclusive)
775
+
and [2{^nbits}] (exclusive). [nbits] must be nonnegative.
776
+
This is a more efficient special case of {!Z.random_int_gen} when the
777
+
bound is a power of two. The [fill] parameter is as described in
778
+
{!Z.random_int_gen}.
779
+
@since 1.13
780
+
*)
781
+
782
+
(** {1 Prefix and infix operators} *)
783
+
784
+
(**
785
+
Classic (and less classic) prefix and infix [int] operators are
786
+
redefined on [t].
787
+
788
+
This makes it easy to typeset expressions.
789
+
Using OCaml 3.12's local open, you can simply write
790
+
[Z.(~$2 + ~$5 * ~$10)].
791
+
*)
792
+
793
+
val (~-): t -> t
794
+
(** Negation [neg]. *)
795
+
796
+
val (~+): t -> t
797
+
(** Identity. *)
798
+
799
+
val (+): t -> t -> t
800
+
(** Addition [add]. *)
801
+
802
+
val (-): t -> t -> t
803
+
(** Subtraction [sub]. *)
804
+
805
+
val ( * ): t -> t -> t
806
+
(** Multiplication [mul]. *)
807
+
808
+
val (/): t -> t -> t
809
+
(** Truncated division [div]. *)
810
+
811
+
external (/>): t -> t -> t = "ml_z_cdiv"
812
+
(** Ceiling division [cdiv]. *)
813
+
814
+
external (/<): t -> t -> t = "ml_z_fdiv"
815
+
(** Flooring division [fdiv]. *)
816
+
817
+
val (/|): t -> t -> t
818
+
(** Exact division [divexact]. *)
819
+
820
+
val (mod): t -> t -> t
821
+
(** Remainder [rem]. *)
822
+
823
+
val (land): t -> t -> t
824
+
(** Bit-wise logical and [logand]. *)
825
+
826
+
val (lor): t -> t -> t
827
+
(** Bit-wise logical inclusive or [logor]. *)
828
+
829
+
val (lxor): t -> t -> t
830
+
(** Bit-wise logical exclusive or [logxor]. *)
831
+
832
+
val (~!): t -> t
833
+
(** Bit-wise logical negation [lognot]. *)
834
+
835
+
val (lsl): t -> int -> t
836
+
(** Bit-wise shift to the left [shift_left]. *)
837
+
838
+
val (asr): t -> int -> t
839
+
(** Bit-wise shift to the right [shift_right]. *)
840
+
841
+
external (~$): int -> t = "%identity"
842
+
843
+
(** Conversion from [int] [of_int]. *)
844
+
845
+
external ( ** ): t -> int -> t = "ml_z_pow"
846
+
(** Power [pow]. *)
847
+
848
+
module Compare : sig
849
+
850
+
val (=): t -> t -> bool
851
+
(** Same as [equal]. *)
852
+
853
+
val (<): t -> t -> bool
854
+
(** Same as [lt]. *)
855
+
856
+
val (>): t -> t -> bool
857
+
(** Same as [gt]. *)
858
+
859
+
val (<=): t -> t -> bool
860
+
(** Same as [leq]. *)
861
+
862
+
val (>=): t -> t -> bool
863
+
(** Same as [geq]. *)
864
+
865
+
val (<>): t -> t -> bool
866
+
(** [a <> b] is equivalent to [not (equal a b)]. *)
867
+
868
+
end
869
+
870
+
(** {1 Miscellaneous} *)
871
+
872
+
val version: string
873
+
(** Library version.
874
+
@since 1.1
875
+
*)
876
+
877
+
(**/**)
878
+
879
+
(** For internal use in module [Q]. *)
880
+
val round_to_float: t -> bool -> float
+49
vendor/opam/zarith/z_mlgmpidl.ml
+49
vendor/opam/zarith/z_mlgmpidl.ml
···
1
+
(**
2
+
Conversion between Zarith and MLGmpIDL integers and rationals.
3
+
4
+
5
+
This file is part of the Zarith library
6
+
http://forge.ocamlcore.org/projects/zarith .
7
+
It is distributed under LGPL 2 licensing, with static linking exception.
8
+
See the LICENSE file included in the distribution.
9
+
10
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
11
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
12
+
a joint laboratory by:
13
+
CNRS (Centre national de la recherche scientifique, France),
14
+
ENS (École normale supérieure, Paris, France),
15
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
16
+
17
+
*)
18
+
19
+
external mlgmpidl_of_mpz: Mpz.t -> Z.t = "ml_z_mlgmpidl_of_mpz"
20
+
external mlgmpidl_set_mpz: Mpz.t -> Z.t -> unit = "ml_z_mlgmpidl_set_mpz"
21
+
22
+
let z_of_mpz x =
23
+
mlgmpidl_of_mpz x
24
+
25
+
let mpz_of_z x =
26
+
let r = Mpz.init () in
27
+
mlgmpidl_set_mpz r x;
28
+
r
29
+
30
+
let z_of_mpzf x =
31
+
z_of_mpz (Mpzf._mpz x)
32
+
33
+
let mpzf_of_z x =
34
+
Mpzf._mpzf (mpz_of_z x)
35
+
36
+
let q_of_mpq x =
37
+
let n,d = Mpz.init (), Mpz.init () in
38
+
Mpq.get_num n x;
39
+
Mpq.get_den d x;
40
+
Q.make (z_of_mpz n) (z_of_mpz d)
41
+
42
+
let mpq_of_q x =
43
+
Mpq.of_mpz2 (mpz_of_z x.Q.num) (mpz_of_z x.Q.den)
44
+
45
+
let q_of_mpqf x =
46
+
q_of_mpq (Mpqf._mpq x)
47
+
48
+
let mpqf_of_q x =
49
+
Mpqf._mpqf (mpq_of_q x)
+26
vendor/opam/zarith/z_mlgmpidl.mli
+26
vendor/opam/zarith/z_mlgmpidl.mli
···
1
+
(**
2
+
Conversion between Zarith and MLGmpIDL integers and rationals.
3
+
4
+
5
+
This file is part of the Zarith library
6
+
http://forge.ocamlcore.org/projects/zarith .
7
+
It is distributed under LGPL 2 licensing, with static linking exception.
8
+
See the LICENSE file included in the distribution.
9
+
10
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
11
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
12
+
a joint laboratory by:
13
+
CNRS (Centre national de la recherche scientifique, France),
14
+
ENS (École normale supérieure, Paris, France),
15
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
16
+
17
+
*)
18
+
19
+
val z_of_mpz: Mpz.t -> Z.t
20
+
val mpz_of_z: Z.t -> Mpz.t
21
+
val z_of_mpzf: Mpzf.t -> Z.t
22
+
val mpzf_of_z: Z.t -> Mpzf.t
23
+
val q_of_mpq: Mpq.t -> Q.t
24
+
val mpq_of_q: Q.t -> Mpq.t
25
+
val q_of_mpqf: Mpqf.t -> Q.t
26
+
val mpqf_of_q: Q.t -> Mpqf.t
+42
vendor/opam/zarith/zarith.h
+42
vendor/opam/zarith/zarith.h
···
1
+
/**
2
+
Public C interface for Zarith.
3
+
4
+
This is intended for C libraries that wish to convert between mpz_t and
5
+
Z.t objects.
6
+
7
+
8
+
This file is part of the Zarith library
9
+
http://forge.ocamlcore.org/projects/zarith .
10
+
It is distributed under LGPL 2 licensing, with static linking exception.
11
+
See the LICENSE file included in the distribution.
12
+
13
+
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
14
+
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
15
+
a joint laboratory by:
16
+
CNRS (Centre national de la recherche scientifique, France),
17
+
ENS (École normale supérieure, Paris, France),
18
+
INRIA Rocquencourt (Institut national de recherche en informatique, France).
19
+
20
+
*/
21
+
22
+
23
+
/* gmp.h or mpir.h must be included manually before zarith.h */
24
+
25
+
#ifdef __cplusplus
26
+
extern "C" {
27
+
#endif
28
+
29
+
#include <caml/mlvalues.h>
30
+
31
+
/* sets rop to the value in op (limbs are copied) */
32
+
void ml_z_mpz_set_z(mpz_t rop, value op);
33
+
34
+
/* inits and sets rop to the value in op (limbs are copied) */
35
+
void ml_z_mpz_init_set_z(mpz_t rop, value op);
36
+
37
+
/* returns a new z objects equal to op (limbs are copied) */
38
+
value ml_z_from_mpz(mpz_t op);
39
+
40
+
#ifdef __cplusplus
41
+
}
42
+
#endif
+54
vendor/opam/zarith/zarith.opam
+54
vendor/opam/zarith/zarith.opam
···
1
+
opam-version: "2.0"
2
+
name: "zarith"
3
+
version: "1.14"
4
+
maintainer: "Xavier Leroy <xavier.leroy@inria.fr>"
5
+
authors: [
6
+
"Antoine Miné"
7
+
"Xavier Leroy"
8
+
"Pascal Cuoq"
9
+
]
10
+
homepage: "https://github.com/ocaml/Zarith"
11
+
bug-reports: "https://github.com/ocaml/Zarith/issues"
12
+
dev-repo: "git+https://github.com/ocaml/Zarith.git"
13
+
license: "LGPL-2.0-only WITH OCaml-LGPL-linking-exception"
14
+
x-maintenance-intent: ["(latest)"]
15
+
build: [
16
+
["./configure"] {os != "openbsd" & os != "freebsd" & os != "macos"}
17
+
[
18
+
"sh"
19
+
"-exc"
20
+
"LDFLAGS=\"$LDFLAGS -L/usr/local/lib\" CFLAGS=\"$CFLAGS -I/usr/local/include\" ./configure"
21
+
] {os = "openbsd" | os = "freebsd"}
22
+
[
23
+
"sh"
24
+
"-exc"
25
+
"LDFLAGS=\"$LDFLAGS -L/opt/local/lib -L/usr/local/lib\" CFLAGS=\"$CFLAGS -I/opt/local/include -I/usr/local/include\" ./configure"
26
+
] {os = "macos" & os-distribution != "homebrew"}
27
+
[
28
+
"sh"
29
+
"-exc"
30
+
"LDFLAGS=\"$LDFLAGS -L/opt/local/lib -L/usr/local/lib\" CFLAGS=\"$CFLAGS -I/opt/local/include -I/usr/local/include\" ./configure"
31
+
] {os = "macos" & os-distribution = "homebrew" & arch = "x86_64" }
32
+
[
33
+
"sh"
34
+
"-exc"
35
+
"LDFLAGS=\"$LDFLAGS -L/opt/homebrew/lib\" CFLAGS=\"$CFLAGS -I/opt/homebrew/include\" ./configure"
36
+
] {os = "macos" & os-distribution = "homebrew" & arch = "arm64" }
37
+
[make]
38
+
]
39
+
install: [
40
+
[make "install"]
41
+
]
42
+
depends: [
43
+
"ocaml" {>= "4.07.0"}
44
+
"ocamlfind"
45
+
"conf-pkg-config"
46
+
"conf-gmp"
47
+
]
48
+
synopsis:
49
+
"Implements arithmetic and logical operations over arbitrary-precision integers"
50
+
description: """
51
+
The Zarith library implements arithmetic and logical operations over
52
+
arbitrary-precision integers. It uses GMP to efficiently implement
53
+
arithmetic over big integers. Small integers are represented as Caml
54
+
unboxed integers, for speed and space economy."""
+23
vendor/opam/zarith/zarith_top.ml
+23
vendor/opam/zarith/zarith_top.ml
···
1
+
(*
2
+
This file is part of the Zarith library
3
+
http://forge.ocamlcore.org/projects/zarith .
4
+
It is distributed under LGPL 2 licensing, with static linking exception.
5
+
See the LICENSE file included in the distribution.
6
+
7
+
Contributed by Christophe Troestler.
8
+
*)
9
+
10
+
open Printf
11
+
12
+
let eval_string
13
+
?(print_outcome = false) ?(err_formatter = Format.err_formatter) str =
14
+
let lexbuf = Lexing.from_string str in
15
+
let phrase = !Toploop.parse_toplevel_phrase lexbuf in
16
+
Toploop.execute_phrase print_outcome err_formatter phrase
17
+
18
+
let () =
19
+
let printers = ["Z.pp_print"; "Q.pp_print"] in
20
+
let ok = List.fold_left (fun b p ->
21
+
b && eval_string(sprintf "#install_printer %s;;" p))
22
+
true printers in
23
+
if not ok then Format.eprintf "Problem installing ZArith-printers@."
+1
vendor/opam/zarith/zarith_version.ml
+1
vendor/opam/zarith/zarith_version.ml
···
1
+
let version = "1.14"