swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

4
unikernel/duniverse/Zarith/.gitattributes vendored Normal file
View file

@ -0,0 +1,4 @@
# Default behaviour, for if core.autocrlf isn't set
* text=auto
configure text eol=lf

32
unikernel/duniverse/Zarith/.github/workflows/CI.yml vendored Normal file
View file

@ -0,0 +1,32 @@
name: CI
on: [push, pull_request]
jobs:
Ubuntu:
runs-on: ubuntu-latest
steps:
- name: Install packages
run: sudo apt-get install ocaml-nox libgmp-dev
- name: Checkout
uses: actions/checkout@v2
- name: configure tree
run: ./configure
- name: Build
run: make
- name: Run the testsuite
run: make -C tests test
MacOS:
runs-on: macos-latest
steps:
- name: Install packages
run: brew install ocaml ocaml-findlib gmp
- name: Checkout
uses: actions/checkout@v2
- name: configure tree
run: ./configure
- name: Build
run: make
- name: Run the testsuite
run: make -C tests test

49
unikernel/duniverse/Zarith/.github/workflows/build.yml vendored Normal file
View file

@ -0,0 +1,49 @@
name: build
on:
pull_request:
push:
branches:
- master
schedule:
# Prime the caches every Monday
- cron: 0 1 * * MON
jobs:
build:
strategy:
fail-fast: false
matrix:
os:
- ubuntu-latest
- windows-latest
- macos-latest
ocaml-compiler:
- "4.14"
- "5.2"
runs-on: ${{ matrix.os }}
steps:
- name: Checkout code
uses: actions/checkout@v4
- name: Set-up OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v3
with:
ocaml-compiler: ${{ matrix.ocaml-compiler }}
- run: opam install . --with-test --deps-only
- name: configure tree
run: opam exec -- sh ./configure
- name: Build
run: opam exec -- make
- name: Run the testsuite
run: opam exec -- make -C tests test
- run: opam install . --with-test
- run: opam exec -- git diff --exit-code

12
unikernel/duniverse/Zarith/.gitignore vendored Normal file
View file

@ -0,0 +1,12 @@
*.a
*.cm?
*.cmxa
*.cmxs
*.cmti
*.exe
*.byt
*.o
*.so
Makefile
depend
zarith_version.ml

2
unikernel/duniverse/Zarith/.ocamlformat Normal file
View file

@ -0,0 +1,2 @@
version=0.20.1
disable=true

143
unikernel/duniverse/Zarith/Changes Normal file
View file

@ -0,0 +1,143 @@
Release 1.14 (2024-07-10)
- #148, #149: Fail unmarshaling when it would produce non-canonical big ints
- #145, #150: Use standard hash function for `Z.hash` and add `Z.seeded_hash`
- #140, #147: Add fast path for `Z.divisible` on small arguments
Release 1.13 (2023-07-19)
- #113: add conversions to/from small unsigned integers `(to|fits)_(int32|int64|nativeint)_unsigned` [Antoine Miné]
- #128: add functions to pseudo-randomly generate integers [Xavier Leroy]
- #105: add `Big_int.big_int_of_float` [Yishuai Li]
- #90: add fast path to `Z.extract` when extraction leads to a small integer [Frédéric Recoules]
- #137: more precise bounds for of_float conversion to small ints [Antoine Miné]
- #118: fix Z_mlgmpidl interface for mlgmpidl >= 1.2 [Simmo Saan]
- #109: fix typo in `ml_z_mul` function [Bernhard Schommer]
- #108: fix dependency on C evaluation order in `ml_z_remove` [Xavier Clerc]
- #117 #120 #129 #132 #135 #139 #141: configure & build simplifications and fixes [various authors]
- #134: CI testing: add Windows, test both 4.14 and 5.0 [Hugo Heuzard]
Release 1.12 (2021-03-03)
- PR #79: fast path in OCaml (instead of assembly language) [Xavier Leroy]
- PR #94: remove source preprocessing and simplify configuration [Xavier Leroy]
- PR #93: fix parallel build [Guillaume Melquiond]
- PR #92: fix benchmark for subtraction [Guillaume Melquiond]
- Require OCaml 4.04 or later [Xavier Leroy]
- Add CI testing on macOS [Xavier Leroy]
Release 1.11 (2020-11-09)
- Fixes #72, #75, #78: multiple fixes for of_string, support for underscores [hhugo]
- Fix #74: fix Q.to_float for denormal numbers [pascal-cuoq]
- Fix #84: always represent min_int by a tagged integer [xavierleroy]
- muliple fixes for min_int arguments [xavierleroy]
- Improvement #85: optimize the fast paths for comparison and equality tests [xavierleroy]
- Fix #80: ar tool is detected in configure [jsmolic]
Release 1.10 (2020-09-11)
- Improvement #66: added some mpz functions (divisible, congruent, jacobi, legendre, krobecker, remove, fac, primorial, bin, fib, lucnum)
- Improvement #65: Q.of_string now handles decimal point and scientific notation [Ghiles Ziat]
- Fix #60: Z.root now raises an exception for invalid arguments
- Fix #62: raise division by 0 for 0-modulo in powm
- Fix #59: improved abs for negative arguments
- Fix #58: gcd, lcm, gcdext now behave as gmp for negative arguments
- Fix #57: clean compile with safe strings [hhugo]
Release 1.9.1 (2019-08-28) (bugfix):
- Fix configure issue for non-bash sh introduced in #45
- Tweaks to opam file [kit-ty-kate]
Release 1.9 (2019-08-22):
- Issue #50: add opam file, make it easy to "opam publish" new versions
- Issue #38: configure detects 32bit OCaml switch on 64bit host
- Fix #36: change Q.equal, leq, geq comparisons for undef
- Request #47: move infix comparison operators of Z in submodule
avoid shadowing the polymorphic compare [Bernhard Schommer]
- Fix #49: INT_MAX undeclared
- Request #46: add prefixnonocaml option [Et7f3]
- Request #45: fix ocamllibdir/caml/mlvalues.h bug (Cygwin) [Et7f3]
- Fix: attempting to build numbers too large for GMP raises an OCaml exception
instead of crashing with "gmp: overflow in mpz type"
Release 1.8 (2019-03-30):
- Request #20: infix comparison operators for Q and Z [Max Mouratov]
- Request #39: gdc(x,0) = gcd(0,x) = x [Vincent Laporte]
- Request #41: support for upcoming OCaml 4.08 [Daniel Hillerström]
- Issue #17: add package zarith.top with REPL printer [Christophe Troestler]
- Issue #22: wrong stack marking directive in caml_z_x86_64_mingw64.S
[Bernhard Schommer]
- Issue #24: generate and install .cmti files for easy access to documentation
- Issue #25: false alarm in tests/zq.ml owing to unreliable printing
of FP values
- Request #28: better handling of absolute paths in "configure"
Release 1.7 (2017-10-13):
- Issue#14, pull request#15: ARM assembly code was broken.
- Fix tests so that they work even if the legacy Num library is unavailable.
Release 1.6 (2017-09-23):
- On Linux and BSD, keep the stack non-executable.
- Issue#10: clarify documentation of Q.of_string
- Fixed spurious installation error if shared libraries not supported
[Bernhard Schommer]
Release 1.5 (2017-05-26):
- Install all .cmx files, improving performance of clients and
avoiding a warning from OCaml 4.03 and up.
- Z.of_float: fix a bug in the fast path [Richard Jones]
(See https://bugzilla.redhat.com/show_bug.cgi?id=1392247)
- Improve compatibility with OCaml 4.03 and up
[Bernhard Schommer]
- Overflow issue in Z.pow and Z.root with very large exponents (GPR#5)
[Andre Maroneze]
- Added function Q.to_float.
Release 1.4.1 (2015-11-09):
- Fixed ml_z_of_substring_base and Z.of_substring [Thomas Braibant]
- Integrated Opam fix for Perl scripts [Thomas Braibant]
Release 1.4 (2015-11-02):
- Improvements to Q (using divexact) [Bertrand Jeannet]
- Fixed div_2exp bug [Bertrand Jeannet]
- Improvements for divexact [Bertrand Jeannet]
- Added of_substring, with fast path for native integers [Thomas Braibant]
- Added Z.powm_sec (constant-time modular exponentiation)
- Reimplemented Z.to_float, now produces correctly rounded FP numbers
- Added Z.trailing_zeros.
- Added Z.testbit, Z.is_even, Z.is_odd.
- Added Z.numbits, Z.log2 and Z.log2up.
- PR#1467: Z.hash is declared as "noalloc" [François Bobot]
- PR#1451: configure fix [Spiros Eliopoulos]
- PR#1436: disable "(void)" trick for unused variables on Windows [Bernhard Schommer]
- PR#1434: removed dependencies on printf & co when Z_PERFORM_CHECK is 0 [Hannes Mehnert]
- PR#1462: issues with Z.to_float and large numbers.
Release 1.3 (2014-09-03):
- Fixed inefficiencies in asm fast path for ARM.
- Revised detection of NaNs and infinities in Z.of_float
- Suppress the redundant fast paths written in C if a corresponding
fast path exists in asm.
- Use <stdint.h> to ensure compatibility with OCaml 4.02.
- More prudent implementation of Z.of_int, avoids GC problem
with OCaml < 4.02 (PR#6501 in the OCaml bug tracker).
- PR#1429: of_string accepts 'a' in base 10.
- Macro change to avoid compiler warnings on unused variables.
Release 1.2.1 (2013-06-12):
- Install fixes
Release 1.2 (2013-05-19):
- Added fast asm path for ARMv7 processors.
- PR#1192: incorrect behavior of div_2exp
- Issue with aggressive C compiler optimization in the fast path for multiply
- Better support for Windows/Mingw32
Release 1.1 (2012-03-24):
- Various improvements in the asm fast path for i686 and x86_64
- PR#1034: support for static linking of GMP/MPIR
- PR#1046: autodetection of ocamlopt and dynlink
- PR#1048: autodetection of more platforms that we support
- PR#1051: support architectures with strict alignment constraints for
64-bit integers (e.g. Sparc)
- Fixed 1-bit precision loss when converting doubles to rationals
- Improved support for the forthcoming release 4.00 of OCaml
Release 1.0 (2011-08-18):
- First public release

501
unikernel/duniverse/Zarith/LICENSE Normal file
View file

@ -0,0 +1,501 @@
This Library is distributed under the terms of the GNU Library General
Public License version 2 (included below).
As a special exception to the GNU Library General Public License, you
may link, statically or dynamically, a "work that uses the Library"
with a publicly distributed version of the Library to produce an
executable file containing portions of the Library, and distribute
that executable file under terms of your choice, without any of the
additional requirements listed in clause 6 of the GNU Library General
Public License. By "a publicly distributed version of the Library",
we mean either the unmodified Library as distributed by INRIA, or a
modified version of the Library that is distributed under the
conditions defined in clause 3 of the GNU Library General Public
License. This exception does not however invalidate any other reasons
why the executable file might be covered by the GNU Library General
Public License.
----------------------------------------------------------------------
GNU LIBRARY GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1991 Free Software Foundation, Inc.
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
[This is the first released version of the library GPL. It is
numbered 2 because it goes with version 2 of the ordinary GPL.]
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
Licenses are intended to guarantee your freedom to share and change
free software--to make sure the software is free for all its users.
This license, the Library General Public License, applies to some
specially designated Free Software Foundation software, and to any
other libraries whose authors decide to use it. You can use it for
your libraries, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if
you distribute copies of the library, or if you modify it.
For example, if you distribute copies of the library, whether gratis
or for a fee, you must give the recipients all the rights that we gave
you. You must make sure that they, too, receive or can get the source
code. If you link a program with the library, you must provide
complete object files to the recipients so that they can relink them
with the library, after making changes to the library and recompiling
it. And you must show them these terms so they know their rights.
Our method of protecting your rights has two steps: (1) copyright
the library, and (2) offer you this license which gives you legal
permission to copy, distribute and/or modify the library.
Also, for each distributor's protection, we want to make certain
that everyone understands that there is no warranty for this free
library. If the library is modified by someone else and passed on, we
want its recipients to know that what they have is not the original
version, so that any problems introduced by others will not reflect on
the original authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that companies distributing free
software will individually obtain patent licenses, thus in effect
transforming the program into proprietary software. To prevent this,
we have made it clear that any patent must be licensed for everyone's
free use or not licensed at all.
Most GNU software, including some libraries, is covered by the ordinary
GNU General Public License, which was designed for utility programs. This
license, the GNU Library General Public License, applies to certain
designated libraries. This license is quite different from the ordinary
one; be sure to read it in full, and don't assume that anything in it is
the same as in the ordinary license.
The reason we have a separate public license for some libraries is that
they blur the distinction we usually make between modifying or adding to a
program and simply using it. Linking a program with a library, without
changing the library, is in some sense simply using the library, and is
analogous to running a utility program or application program. However, in
a textual and legal sense, the linked executable is a combined work, a
derivative of the original library, and the ordinary General Public License
treats it as such.
Because of this blurred distinction, using the ordinary General
Public License for libraries did not effectively promote software
sharing, because most developers did not use the libraries. We
concluded that weaker conditions might promote sharing better.
However, unrestricted linking of non-free programs would deprive the
users of those programs of all benefit from the free status of the
libraries themselves. This Library General Public License is intended to
permit developers of non-free programs to use free libraries, while
preserving your freedom as a user of such programs to change the free
libraries that are incorporated in them. (We have not seen how to achieve
this as regards changes in header files, but we have achieved it as regards
changes in the actual functions of the Library.) The hope is that this
will lead to faster development of free libraries.
The precise terms and conditions for copying, distribution and
modification follow. Pay close attention to the difference between a
"work based on the library" and a "work that uses the library". The
former contains code derived from the library, while the latter only
works together with the library.
Note that it is possible for a library to be covered by the ordinary
General Public License rather than by this special one.
GNU LIBRARY GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any software library which
contains a notice placed by the copyright holder or other authorized
party saying it may be distributed under the terms of this Library
General Public License (also called "this License"). Each licensee is
addressed as "you".
A "library" means a collection of software functions and/or data
prepared so as to be conveniently linked with application programs
(which use some of those functions and data) to form executables.
The "Library", below, refers to any such software library or work
which has been distributed under these terms. A "work based on the
Library" means either the Library or any derivative work under
copyright law: that is to say, a work containing the Library or a
portion of it, either verbatim or with modifications and/or translated
straightforwardly into another language. (Hereinafter, translation is
included without limitation in the term "modification".)
"Source code" for a work means the preferred form of the work for
making modifications to it. For a library, complete source code means
all the source code for all modules it contains, plus any associated
interface definition files, plus the scripts used to control compilation
and installation of the library.
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running a program using the Library is not restricted, and output from
such a program is covered only if its contents constitute a work based
on the Library (independent of the use of the Library in a tool for
writing it). Whether that is true depends on what the Library does
and what the program that uses the Library does.
1. You may copy and distribute verbatim copies of the Library's
complete source code as you receive it, in any medium, provided that
you conspicuously and appropriately publish on each copy an
appropriate copyright notice and disclaimer of warranty; keep intact
all the notices that refer to this License and to the absence of any
warranty; and distribute a copy of this License along with the
Library.
You may charge a fee for the physical act of transferring a copy,
and you may at your option offer warranty protection in exchange for a
fee.
2. You may modify your copy or copies of the Library or any portion
of it, thus forming a work based on the Library, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) The modified work must itself be a software library.
b) You must cause the files modified to carry prominent notices
stating that you changed the files and the date of any change.
c) You must cause the whole of the work to be licensed at no
charge to all third parties under the terms of this License.
d) If a facility in the modified Library refers to a function or a
table of data to be supplied by an application program that uses
the facility, other than as an argument passed when the facility
is invoked, then you must make a good faith effort to ensure that,
in the event an application does not supply such function or
table, the facility still operates, and performs whatever part of
its purpose remains meaningful.
(For example, a function in a library to compute square roots has
a purpose that is entirely well-defined independent of the
application. Therefore, Subsection 2d requires that any
application-supplied function or table used by this function must
be optional: if the application does not supply it, the square
root function must still compute square roots.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Library,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Library, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote
it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Library.
In addition, mere aggregation of another work not based on the Library
with the Library (or with a work based on the Library) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may opt to apply the terms of the ordinary GNU General Public
License instead of this License to a given copy of the Library. To do
this, you must alter all the notices that refer to this License, so
that they refer to the ordinary GNU General Public License, version 2,
instead of to this License. (If a newer version than version 2 of the
ordinary GNU General Public License has appeared, then you can specify
that version instead if you wish.) Do not make any other change in
these notices.
Once this change is made in a given copy, it is irreversible for
that copy, so the ordinary GNU General Public License applies to all
subsequent copies and derivative works made from that copy.
This option is useful when you wish to copy part of the code of
the Library into a program that is not a library.
4. You may copy and distribute the Library (or a portion or
derivative of it, under Section 2) in object code or executable form
under the terms of Sections 1 and 2 above provided that you accompany
it with the complete corresponding machine-readable source code, which
must be distributed under the terms of Sections 1 and 2 above on a
medium customarily used for software interchange.
If distribution of object code is made by offering access to copy
from a designated place, then offering equivalent access to copy the
source code from the same place satisfies the requirement to
distribute the source code, even though third parties are not
compelled to copy the source along with the object code.
5. A program that contains no derivative of any portion of the
Library, but is designed to work with the Library by being compiled or
linked with it, is called a "work that uses the Library". Such a
work, in isolation, is not a derivative work of the Library, and
therefore falls outside the scope of this License.
However, linking a "work that uses the Library" with the Library
creates an executable that is a derivative of the Library (because it
contains portions of the Library), rather than a "work that uses the
library". The executable is therefore covered by this License.
Section 6 states terms for distribution of such executables.
When a "work that uses the Library" uses material from a header file
that is part of the Library, the object code for the work may be a
derivative work of the Library even though the source code is not.
Whether this is true is especially significant if the work can be
linked without the Library, or if the work is itself a library. The
threshold for this to be true is not precisely defined by law.
If such an object file uses only numerical parameters, data
structure layouts and accessors, and small macros and small inline
functions (ten lines or less in length), then the use of the object
file is unrestricted, regardless of whether it is legally a derivative
work. (Executables containing this object code plus portions of the
Library will still fall under Section 6.)
Otherwise, if the work is a derivative of the Library, you may
distribute the object code for the work under the terms of Section 6.
Any executables containing that work also fall under Section 6,
whether or not they are linked directly with the Library itself.
6. As an exception to the Sections above, you may also compile or
link a "work that uses the Library" with the Library to produce a
work containing portions of the Library, and distribute that work
under terms of your choice, provided that the terms permit
modification of the work for the customer's own use and reverse
engineering for debugging such modifications.
You must give prominent notice with each copy of the work that the
Library is used in it and that the Library and its use are covered by
this License. You must supply a copy of this License. If the work
during execution displays copyright notices, you must include the
copyright notice for the Library among them, as well as a reference
directing the user to the copy of this License. Also, you must do one
of these things:
a) Accompany the work with the complete corresponding
machine-readable source code for the Library including whatever
changes were used in the work (which must be distributed under
Sections 1 and 2 above); and, if the work is an executable linked
with the Library, with the complete machine-readable "work that
uses the Library", as object code and/or source code, so that the
user can modify the Library and then relink to produce a modified
executable containing the modified Library. (It is understood
that the user who changes the contents of definitions files in the
Library will not necessarily be able to recompile the application
to use the modified definitions.)
b) Accompany the work with a written offer, valid for at
least three years, to give the same user the materials
specified in Subsection 6a, above, for a charge no more
than the cost of performing this distribution.
c) If distribution of the work is made by offering access to copy
from a designated place, offer equivalent access to copy the above
specified materials from the same place.
d) Verify that the user has already received a copy of these
materials or that you have already sent this user a copy.
For an executable, the required form of the "work that uses the
Library" must include any data and utility programs needed for
reproducing the executable from it. However, as a special exception,
the source code distributed need not include anything that is normally
distributed (in either source or binary form) with the major
components (compiler, kernel, and so on) of the operating system on
which the executable runs, unless that component itself accompanies
the executable.
It may happen that this requirement contradicts the license
restrictions of other proprietary libraries that do not normally
accompany the operating system. Such a contradiction means you cannot
use both them and the Library together in an executable that you
distribute.
7. You may place library facilities that are a work based on the
Library side-by-side in a single library together with other library
facilities not covered by this License, and distribute such a combined
library, provided that the separate distribution of the work based on
the Library and of the other library facilities is otherwise
permitted, and provided that you do these two things:
a) Accompany the combined library with a copy of the same work
based on the Library, uncombined with any other library
facilities. This must be distributed under the terms of the
Sections above.
b) Give prominent notice with the combined library of the fact
that part of it is a work based on the Library, and explaining
where to find the accompanying uncombined form of the same work.
8. You may not copy, modify, sublicense, link with, or distribute
the Library except as expressly provided under this License. Any
attempt otherwise to copy, modify, sublicense, link with, or
distribute the Library is void, and will automatically terminate your
rights under this License. However, parties who have received copies,
or rights, from you under this License will not have their licenses
terminated so long as such parties remain in full compliance.
9. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Library or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Library (or any work based on the
Library), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Library or works based on it.
10. Each time you redistribute the Library (or any work based on the
Library), the recipient automatically receives a license from the
original licensor to copy, distribute, link with or modify the Library
subject to these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
11. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Library at all. For example, if a patent
license would not permit royalty-free redistribution of the Library by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Library.
If any portion of this section is held invalid or unenforceable under any
particular circumstance, the balance of the section is intended to apply,
and the section as a whole is intended to apply in other circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
12. If the distribution and/or use of the Library is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Library under this License may add
an explicit geographical distribution limitation excluding those countries,
so that distribution is permitted only in or among countries not thus
excluded. In such case, this License incorporates the limitation as if
written in the body of this License.
13. The Free Software Foundation may publish revised and/or new
versions of the Library General Public License from time to time.
Such new versions will be similar in spirit to the present version,
but may differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the Library
specifies a version number of this License which applies to it and
"any later version", you have the option of following the terms and
conditions either of that version or of any later version published by
the Free Software Foundation. If the Library does not specify a
license version number, you may choose any version ever published by
the Free Software Foundation.
14. If you wish to incorporate parts of the Library into other free
programs whose distribution conditions are incompatible with these,
write to the author to ask for permission. For software which is
copyrighted by the Free Software Foundation, write to the Free
Software Foundation; we sometimes make exceptions for this. Our
decision will be guided by the two goals of preserving the free status
of all derivatives of our free software and of promoting the sharing
and reuse of software generally.
NO WARRANTY
15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Libraries
If you develop a new library, and you want it to be of the greatest
possible use to the public, we recommend making it free software that
everyone can redistribute and change. You can do so by permitting
redistribution under these terms (or, alternatively, under the terms of the
ordinary General Public License).
To apply these terms, attach the following notices to the library. It is
safest to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the library's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
MA 02111-1307, USA
Also add information on how to contact you by electronic and paper mail.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the library, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
library `Frob' (a library for tweaking knobs) written by James Random Hacker.
<signature of Ty Coon>, 1 April 1990
Ty Coon, President of Vice
That's all there is to it!

18
unikernel/duniverse/Zarith/META Normal file
View file

@ -0,0 +1,18 @@
description = "Arbitrary precision integers"
requires = ""
version = "1.14"
archive(byte) = "zarith.cma"
archive(native) = "zarith.cmxa"
plugin(byte) = "zarith.cma"
plugin(native) = "zarith.cmxs"
package "top" (
version = "1.13"
description = "ZArith toplevel support"
requires = "zarith"
archive(byte) = "zarith_top.cma"
archive(native) = "zarith_top.cmxa"
plugin(byte) = "zarith_top.cma"
plugin(native) = "zarith_top.cmxs"
exists_if = "zarith_top.cma"
)

129
unikernel/duniverse/Zarith/README.md Normal file
View file

@ -0,0 +1,129 @@
# The Zarith library
## OVERVIEW
This library implements arithmetic and logical operations over
arbitrary-precision integers.
The module is simply named `Z`. Its interface is similar to that of
the `Int32`, `Int64` and `Nativeint` modules from the OCaml standard
library, with some additional functions. See the file `z.mli` for
documentation.
The implementation uses GMP (the GNU Multiple Precision arithmetic
library) to compute over big integers.
However, small integers are represented as unboxed Caml integers, to save
space and improve performance. Big integers are allocated in the Caml heap,
bypassing GMP's memory management and achieving better GC behavior than e.g.
the MLGMP library.
Computations on small integers use a special, faster path (in C or OCaml)
eschewing calls to GMP, while computations on large intergers use the
low-level MPN functions from GMP.
Arbitrary-precision integers can be compared correctly using OCaml's
polymorphic comparison operators (`=`, `<`, `>`, etc.).
Additional features include:
* a module `Q` for rationals, built on top of `Z` (see `q.mli`)
* a compatibility layer `Big_int_Z` that implements the same API as Big_int from the legacy `Num` library, but uses `Z` internally
Support for [js_of_ocaml](https://github.com/ocsigen/js_of_ocaml/) is
provided by [Zarith_stubs_js](https://github.com/janestreet/zarith_stubs_js).
## REQUIREMENTS
* OCaml, version 4.04.0 or later.
* Either the GMP library or the MPIR library, including development files.
* GCC or Clang or a gcc-compatible C compiler and assembler (other compilers may work).
* The Findlib package manager (optional, recommended).
## INSTALLATION
1) First, run the "configure" script by typing:
```
./configure
```
The `configure` script has a few options. Use the `-help` option to get a
list and short description of each option.
2) It creates a Makefile, which can be invoked by:
```
make
```
This builds native and bytecode versions of the library.
3) The libraries are installed by typing:
```
make install
```
or, if you install to a system location but are not an administrator
```
sudo make install
```
If Findlib is detected, it is used to install files.
Otherwise, the files are copied to a `zarith/` subdirectory of the directory
given by `ocamlc -where`.
The libraries are named `zarith.cmxa` and `zarith.cma`, and the Findlib module
is named `zarith`.
Compiling and linking with the library requires passing the `-I +zarith`
option to `ocamlc` / `ocamlopt`, or the `-package zarith` option to `ocamlfind`.
4) (optional, recommended) Test programs are built and run by the additional command
```
make tests
```
(but these are not installed).
5) (optional) HTML API documentation is built (using `ocamldoc`) by the additional command
```
make doc
```
## ONLINE DOCUMENTATION
The documentation for the latest release is hosted on [GitHub Pages](https://antoinemine.github.io/Zarith/doc/latest/index.html).
## LICENSE
This Library is distributed under the terms of the GNU Library General
Public License version 2, with a special exception allowing unconstrained
static linking.
See LICENSE file for details.
## AUTHORS
* Antoine Miné, Sorbonne Université, formerly at ENS Paris.
* Xavier Leroy, Collège de France, formerly at Inria Paris.
* Pascal Cuoq, TrustInSoft.
* Christophe Troestler (toplevel module)
## COPYRIGHT
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
a joint laboratory by:
CNRS (Centre national de la recherche scientifique, France),
ENS (École normale supérieure, Paris, France),
INRIA Rocquencourt (Institut national de recherche en informatique, France).
## CONTENTS
Source files | Description
--------------------|-----------------------------------------
configure | configuration script
z.ml[i] | Z module and implementation for small integers
caml_z.c | C implementation
big_int_z.ml[i] | wrapper to provide a Big_int compatible API to Z
q.ml[i] | rational library, pure OCaml on top of Z
zarith_top.ml | toplevel module to provide pretty-printing
projet.mak | builds Z, Q and the tests
zarith.opam | package description for opam
z_mlgmpidl.ml[i] | conversion between Zarith and MLGMPIDL
tests/ | simple regression tests and benchmarks

144
unikernel/duniverse/Zarith/big_int_Z.ml Normal file
View file

@ -0,0 +1,144 @@
(**
[Big_int] interface for Z module.
This modules provides an interface compatible with [Big_int], but using
[Z] functions internally.
This file is part of the Zarith library
http://forge.ocamlcore.org/projects/zarith .
It is distributed under LGPL 2 licensing, with static linking exception.
See the LICENSE file included in the distribution.
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
a joint laboratory by:
CNRS (Centre national de la recherche scientifique, France),
ENS (École normale supérieure, Paris, France),
INRIA Rocquencourt (Institut national de recherche en informatique, France).
*)
type big_int = Z.t
let zero_big_int = Z.zero
let unit_big_int = Z.one
let minus_big_int = Z.neg
let abs_big_int = Z.abs
let add_big_int = Z.add
let succ_big_int = Z.succ
let add_int_big_int x y = Z.add (Z.of_int x) y
let sub_big_int = Z.sub
let pred_big_int = Z.pred
let mult_big_int = Z.mul
let mult_int_big_int x y = Z.mul (Z.of_int x) y
let square_big_int x = Z.mul x x
let sqrt_big_int = Z.sqrt
let quomod_big_int = Z.ediv_rem
let div_big_int = Z.ediv
let mod_big_int = Z.erem
let gcd_big_int = Z.gcd
let power = Z.pow
let power_big a b =
Z.pow a (Z.to_int b)
let power_int_positive_int a b =
if b < 0 then raise (Invalid_argument "power_int_positive_int");
power (Z.of_int a) b
let power_big_int_positive_int a b =
if b < 0 then raise (Invalid_argument "power_big_int_positive_int");
power a b
let power_int_positive_big_int a b =
if Z.sign b < 0 then raise (Invalid_argument "power_int_positive_big_int");
power_big (Z.of_int a) b
let power_big_int_positive_big_int a b =
if Z.sign b < 0 then raise (Invalid_argument "power_big_int_positive_big_int");
power_big a b
let sign_big_int = Z.sign
let compare_big_int = Z.compare
let eq_big_int = Z.equal
let le_big_int a b = Z.compare a b <= 0
let ge_big_int a b = Z.compare a b >= 0
let lt_big_int a b = Z.compare a b < 0
let gt_big_int a b = Z.compare a b > 0
let max_big_int = Z.max
let min_big_int = Z.min
let num_digits_big_int = Z.size
let string_of_big_int = Z.to_string
let big_int_of_string = Z.of_string
let big_int_of_int = Z.of_int
let is_int_big_int = Z.fits_int
let int_of_big_int x =
try Z.to_int x with Z.Overflow -> failwith "int_of_big_int"
let big_int_of_int32 = Z.of_int32
let big_int_of_nativeint = Z.of_nativeint
let big_int_of_int64 = Z.of_int64
let int32_of_big_int x =
try Z.to_int32 x with Z.Overflow -> failwith "int32_of_big_int"
let nativeint_of_big_int x =
try Z.to_nativeint x with Z.Overflow -> failwith "nativeint_of_big_int"
let int64_of_big_int x =
try Z.to_int64 x with Z.Overflow -> failwith "int64_of_big_int"
let float_of_big_int = Z.to_float
let big_int_of_float = Z.of_float
let and_big_int = Z.logand
let or_big_int = Z.logor
let xor_big_int = Z.logxor
let shift_left_big_int = Z.shift_left
let shift_right_big_int = Z.shift_right
let shift_right_towards_zero_big_int = Z.shift_right_trunc
let extract_big_int = Z.extract

78
unikernel/duniverse/Zarith/big_int_Z.mli Normal file
View file

@ -0,0 +1,78 @@
(**
[Big_int] interface for Z module.
This modules provides an interface compatible with [Big_int], but using
[Z] functions internally.
This file is part of the Zarith library
http://forge.ocamlcore.org/projects/zarith .
It is distributed under LGPL 2 licensing, with static linking exception.
See the LICENSE file included in the distribution.
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
a joint laboratory by:
CNRS (Centre national de la recherche scientifique, France),
ENS (École normale supérieure, Paris, France),
INRIA Rocquencourt (Institut national de recherche en informatique, France).
*)
(* note: generated with ocamlc -i *)
type big_int = Z.t
val zero_big_int : Z.t
val unit_big_int : Z.t
val minus_big_int : Z.t -> Z.t
val abs_big_int : Z.t -> Z.t
val add_big_int : Z.t -> Z.t -> Z.t
val succ_big_int : Z.t -> Z.t
val add_int_big_int : int -> Z.t -> Z.t
val sub_big_int : Z.t -> Z.t -> Z.t
val pred_big_int : Z.t -> Z.t
val mult_big_int : Z.t -> Z.t -> Z.t
val mult_int_big_int : int -> Z.t -> Z.t
val square_big_int : Z.t -> Z.t
val sqrt_big_int : Z.t -> Z.t
val quomod_big_int : Z.t -> Z.t -> Z.t * Z.t
val div_big_int : Z.t -> Z.t -> Z.t
val mod_big_int : Z.t -> Z.t -> Z.t
val gcd_big_int : Z.t -> Z.t -> Z.t
val power : Z.t -> int -> Z.t
val power_big : Z.t -> Z.t -> Z.t
val power_int_positive_int : int -> int -> Z.t
val power_big_int_positive_int : Z.t -> int -> Z.t
val power_int_positive_big_int : int -> Z.t -> Z.t
val power_big_int_positive_big_int : Z.t -> Z.t -> Z.t
val sign_big_int : Z.t -> int
val compare_big_int : Z.t -> Z.t -> int
val eq_big_int : Z.t -> Z.t -> bool
val le_big_int : Z.t -> Z.t -> bool
val ge_big_int : Z.t -> Z.t -> bool
val lt_big_int : Z.t -> Z.t -> bool
val gt_big_int : Z.t -> Z.t -> bool
val max_big_int : Z.t -> Z.t -> Z.t
val min_big_int : Z.t -> Z.t -> Z.t
val num_digits_big_int : Z.t -> int
val string_of_big_int : Z.t -> string
val big_int_of_string : string -> Z.t
val big_int_of_int : int -> Z.t
val is_int_big_int : Z.t -> bool
val int_of_big_int : Z.t -> int
val big_int_of_int32 : int32 -> Z.t
val big_int_of_nativeint : nativeint -> Z.t
val big_int_of_int64 : int64 -> Z.t
val int32_of_big_int : Z.t -> int32
val nativeint_of_big_int : Z.t -> nativeint
val int64_of_big_int : Z.t -> int64
val float_of_big_int : Z.t -> float
val big_int_of_float : float -> Z.t
val and_big_int : Z.t -> Z.t -> Z.t
val or_big_int : Z.t -> Z.t -> Z.t
val xor_big_int : Z.t -> Z.t -> Z.t
val shift_left_big_int : Z.t -> int -> Z.t
val shift_right_big_int : Z.t -> int -> Z.t
val shift_right_towards_zero_big_int : Z.t -> int -> Z.t
val extract_big_int : Z.t -> int -> int -> Z.t

3543
unikernel/duniverse/Zarith/caml_z.c Normal file
View file

File diff suppressed because it is too large Load diff

388
unikernel/duniverse/Zarith/configure vendored Executable file
View file

@ -0,0 +1,388 @@
#! /bin/sh
# configuration script
# This file is part of the Zarith library
# http://forge.ocamlcore.org/projects/zarith .
# It is distributed under LGPL 2 licensing, with static linking exception.
# See the LICENSE file included in the distribution.
#
# Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
# Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
# a joint laboratory by:
# CNRS (Centre national de la recherche scientifique, France),
# ENS (École normale supérieure, Paris, France),
# INRIA Rocquencourt (Institut national de recherche en informatique, France).
# options
installdir='auto'
ocamllibdir='auto'
gmp='auto'
perf='no'
ocaml='ocaml'
ocamlc='ocamlc'
ocamlopt='ocamlopt'
ocamlmklib='ocamlmklib'
ocamldep='ocamldep'
ocamldoc='ocamldoc'
ccinc="$CPPFLAGS"
ldflags="$LDFLAGS"
cclib=''
ccdef=''
mlflags="$OCAMLFLAGS"
mloptflags="$OCAMLOPTFLAGS"
mlinc="$OCAMLINC"
objsuffix="o"
ocamlfind="auto"
# sanitize
LC_ALL=C
export LC_ALL
unset IFS
# help
help()
{
cat <<EOF
usage: configure [options]
where options include:
-installdir dir installation directory
-ocamllibdir dir ocaml library directory
-gmp use GMP library (default if found)
-mpir use MPIR library instead of GMP
-perf enable performance statistics
-prefixnonocaml add for non ocaml tool, e.g. -prefixnonocaml x86_64-w64-mingw32-
Environment variables that affect configuration:
CFLAGS extra flags to pass to the C compiler
CPPFLAGS extra includes, e.g. -I/path/to/gmp/include
LDFLAGS extra link flags, e.g. -L/path/to/gmp/lib
OCAMLFLAGS extra flags to pass to the ocamlc Caml compiler
OCAMLOPTFLAGS extra flags to pass to the ocamlopt Caml compiler
OCAMLINC extra includes to pass to the Caml compilers
EOF
exit
}
# parse arguments
while : ; do
case "$1" in
"")
break;;
-installdir|--installdir)
installdir="$2"
shift;;
-ocamllibdir|--ocamllibdir)
ocamllibdir="$2"
shift;;
-no-ocamlfind|--no-ocamlfind)
ocamlfind="no"
shift;;
-help|--help)
help;;
-gmp|--gmp)
gmp='gmp';;
-mpir|--mpir)
gmp='mpir';;
-perf|--perf)
perf='yes';;
-prefixnonocaml|--prefixnonocaml)
prefixnonocaml="$2"
shift;;
*)
echo "unknown option $1, try -help"
exit 2;;
esac
shift
done
if test "$perf" = "yes"; then ccdef="-DZ_PERF_COUNTER $ccdef"; fi
echo_n()
{
echo "$1" | tr -d '\012'
}
# checking binaries in $PATH
searchbin()
{
if test "x$1" = "x"; then return 0; fi
echo_n "binary $1: "
case "$1" in
/*|./*|../*)
if test -f "$1" && test -x "$1"
then echo "found"; return 1
else echo "not found"; return 0
fi;;
esac
IFS=':'
for i in $PATH
do
if test -z "$i"; then i='.'; fi
if test -f $i/$1 && test -x $i/$1; then echo "found in $i"; unset IFS; return 1; fi
done
echo "not found"
unset IFS
return 0
}
searchbinreq()
{
searchbin $1
if test $? -eq 0; then echo "required program $1 not found"; exit 2; fi
}
# checking includes and libraries
checkinc()
{
echo_n "include $1: "
rm -f tmp.c tmp.o
echo "#include <$1>" > tmp.c
echo "int main() { return 1; }" >> tmp.c
r=1
$CC $ccopt $ccinc -c tmp.c -o tmp.o >/dev/null 2>/dev/null || r=0
if test ! -f tmp.o; then r=0; fi
rm -f tmp.c tmp.o
if test $r -eq 0; then echo "not found"; else echo "found"; fi
return $r
}
checklib()
{
echo_n "library $1: "
rm -f tmp.c tmp.out
echo "int main() { return 1; }" > tmp.c
r=1
$CC $ccopt $ldflags $cclib tmp.c -l$1 -o tmp.out >/dev/null 2>/dev/null || r=0
if test ! -x tmp.out; then r=0; fi
rm -f tmp.c tmp.o tmp.out
if test $r -eq 0; then echo "not found"; else echo "found"; fi
return $r
}
checkcc()
{
echo_n "checking compilation with $cc $ccopt: "
rm -f tmp.c tmp.out
echo "int main() { return 1; }" >> tmp.c
r=1
$CC $ccopt tmp.c -o tmp.out >/dev/null 2>/dev/null || r=0
if test ! -x tmp.out; then r=0; fi
rm -f tmp.c tmp.o tmp.out
if test $r -eq 0; then echo "not working"; else echo "working"; fi
return $r
}
checkcmxalib()
{
echo_n "library $1: "
$ocamlopt $mloptflags $1 -o tmp.out >/dev/null 2>/dev/null || r=0
if test ! -x tmp.out; then r=0; fi
rm -f tmp.out
if test $r -eq 0; then echo "not found"; else echo "found"; fi
return $r
}
# check required programs
searchbinreq $ocaml
searchbinreq $ocamlc
searchbinreq $ocamldep
searchbinreq $ocamlmklib
if searchbin $ocamldoc; then
ocamldoc=''
fi
if test -n "$CC"; then
searchbinreq "$CC"
ccopt="$CFLAGS"
else
ccopt="-O3 -Wall -Wextra $CFLAGS"
fi
# optional native-code generation
hasocamlopt='no'
searchbin $ocamlopt
if test $? -eq 1; then hasocamlopt='yes'; fi
# check C compiler
checkcc
if test $? -eq 0; then
# try again with (almost) no options
ccopt='-O'
checkcc
if test $? -eq 0; then echo "cannot compile and link program"; exit 2; fi
fi
# directories
if test "$ocamllibdir" = "auto"
then ocamllibdir=`ocamlc -where | sed 's/\r$//'`
fi
if test ! -f "$ocamllibdir/caml/mlvalues.h"
then echo "cannot find OCaml libraries in $ocamllibdir"; exit 2; fi
ccinc="-I$ocamllibdir $ccinc"
checkinc "caml/mlvalues.h"
if test $? -eq 0; then echo "cannot include caml/mlvalues.h"; exit 2; fi
# optional dynamic linking
hasdynlink='no'
if test $hasocamlopt = yes
then
checkcmxalib dynlink.cmxa
if test $? -eq 1; then hasdynlink='yes'; fi
fi
# installation method
searchbin ocamlfind
if test $? -eq 1 && test $ocamlfind != "no"; then
instmeth='findlib'
if test "$installdir" = "auto"
then installdir=`ocamlfind printconf destdir`; fi
else
searchbin install
if test $? -eq 1; then instmeth='install'
else echo "no installation method found"; exit 2; fi
if test "$installdir" = "auto"; then installdir="$ocamllibdir"; fi
fi
# detect OCaml's word-size
echo "print_int (Sys.word_size);;" > tmp.ml
wordsize=`ocaml tmp.ml`
echo "OCaml's word size is $wordsize"
rm -f tmp.ml
# check GMP, MPIR
if test "$gmp" = 'gmp' || test "$gmp" = 'auto'; then
if pkg-config gmp 2>/dev/null; then
echo 'package gmp: found'
gmp='OK'
cclib="$cclib $(pkg-config --libs gmp)"
ccinc="$ccinc $(pkg-config --cflags gmp)"
ccdef="-DHAS_GMP $ccdef"
else
checkinc gmp.h
if test $? -eq 1; then
checklib gmp
if test $? -eq 1; then
gmp='OK'
cclib="$cclib -lgmp"
ccdef="-DHAS_GMP $ccdef"
fi
fi
fi
fi
if test "$gmp" = 'mpir' || test "$gmp" = 'auto'; then
checkinc mpir.h
if test $? -eq 1; then
checklib mpir
if test $? -eq 1; then
gmp='OK'
cclib="$cclib -lmpir"
ccdef="-DHAS_MPIR $ccdef"
fi
fi
fi
if test "$gmp" != 'OK'; then echo "cannot find GMP nor MPIR"; exit 2; fi
# OCaml version
ocamlver=`ocamlc -version`
# OCaml version 4.04 or later is required
case "$ocamlver" in
[123].* | 4.0[0123].*)
echo "OCaml version $ocamlver is no longer supported."
echo "OCaml version 4.04.0 or later is required."
exit 2
;;
esac
# -bin-annot available since 4.00.0
echo "OCaml supports -bin-annot to produce documentation"
hasbinannot='yes'
# Changes to C API (the custom_operation struct) since 4.08.0
case "$ocamlver" in
[123].* | 4.0[01234567].* )
echo "Using OCaml legacy C API custom operations"
ccdef="-DZ_OCAML_LEGACY_CUSTOM_OPERATIONS $ccdef"
;;
*)
;;
esac
# dump Makefile
cat > Makefile <<EOF
# generated by ./configure
OCAMLC=$ocamlc
OCAMLOPT=$ocamlopt
OCAMLDEP=$ocamldep
OCAMLMKLIB=$ocamlmklib
OCAMLDOC=$ocamldoc
OCAMLFLAGS=$mlflags
OCAMLOPTFLAGS=$mloptflags
OCAMLINC=$mlinc
CFLAGS=$ccinc $ccdef $ccopt
LIBS=$cclib
LDFLAGS=$ldflags
INSTALLDIR=$installdir
INSTALL=install
OCAMLFIND=ocamlfind
INSTMETH=$instmeth
OBJSUFFIX=$objsuffix
HASOCAMLOPT=$hasocamlopt
HASDYNLINK=$hasdynlink
HASBINANNOT=$hasbinannot
include project.mak
EOF
# dump summary
cat <<EOF
detected configuration:
native-code: $hasocamlopt
dynamic linking: $hasdynlink
defines: $ccdef
includes: $ccinc
libraries: $cclib
linker options: $ldflags
C options: $ccopt
installation path: $installdir
installation method $instmeth
configuration successful!
now type "make" to build
then type "make install" or "sudo make install" to install
EOF

111
unikernel/duniverse/Zarith/configure_env.ml Normal file
View file

@ -0,0 +1,111 @@
(* A simple executable to figure out where is our libgmp.a.
*
* This executable wants to generate an environment which contains:
* - `CC` as the compiler
* - `CFLAGS` and `CPPFLAGS` as C options
* - `LDFLAGS` as options at the link time
*
* If [--with-conf-gmp] (related to the virtual OPAM package [conf-gmp]) is
* set, the script will just set `CC` and compile Zarith with the **host**'s
* `libgmp.a`.
*
* If [--with-gmp=<path>] is set (related to the [gmp] package), Zarith will be
* compile with the location of the [gmp] package. However, [gmp] can be
* located into an OPAM switch (if the <path> is absolute) or a local
* directory. The second case appears when you use [opam monorepo] which pulls
* dependencies into a [duniverse] local directory.
*
* The second case appears for the MirageOS 4.0 support too when we want to use
* a cross-compiled version of `libgmp.a` which should be available into our
* source-tree (compiled by `dune`).
*
* This script wants to help us to compile Zarith in these contexts:
* - as a simple OPAM dependency (which will be installed into a switch)
* - as a dependency brought by [opam monorepo]
* - in the situation where we use [opam monorepo] and the cross-compilation
*)
let always x _ = x
let deadbeef = "\xde\xad\xbe\xef"
let cc = ref deadbeef
let gmp_path = ref deadbeef
let with_conf_gmp = ref false
let dir_sep_char = '/'
let is_relative p = p.[0] <> dir_sep_char
let ( / ) = Filename.concat
let split s =
let min = 0 and max = max_int and sat chr = chr <> dir_sep_char in
if min > max || max = 0 then (s, "") else
let len = String.length s in
let max_idx = len - 1 in
let min_idx = let k = len - max in (if k < 0 then 0 else k) in
let need_idx = max_idx - min in
let rec loop i =
if i >= min_idx && sat s.[i] then loop (i - 1) else
if i > need_idx || i = max_idx then (s, "") else
if i = -1 then ("", s) else
let cut = i + 1 in
String.sub s 0 cut, String.sub s cut (len - cut)
in
loop max_idx
let is_prefix ~affix s =
let len_a = String.length affix in
let len_s = String.length s in
if len_a > len_s then false else
let max_idx_a = len_a - 1 in
let rec loop i =
if i > max_idx_a then true else
if affix.[i] <> s.[i] then false else loop (i + 1)
in
loop 0
let is_prefix ~prefix p =
if not (is_prefix ~affix:prefix p) then false else
let suff_start = String.length prefix in
if prefix.[suff_start - 1] = dir_sep_char then true else
if suff_start = String.length p then (* suffix empty *) true else
p.[suff_start] = dir_sep_char
let spec =
[ "--with-gmp", Arg.Set_string gmp_path, "Location of libgmp.a"
; "--with-conf-gmp", Arg.Set with_conf_gmp, "Use the host's libgmp.a"
; "--cc", Arg.Set_string cc, "C compiler" ]
let usage = Format.asprintf "%s --cc <compiler> [--with-gmp=<path>] [--with-conf-gmp]\n%!" Sys.argv.(0)
let where () = match !gmp_path, !with_conf_gmp with
| gmp_path, _ when gmp_path <> deadbeef ->
let gmp_path, _libgmp_a = split gmp_path in
let cwd = Sys.getcwd () in
if is_relative gmp_path || is_prefix ~prefix:cwd gmp_path
then `Source (cwd / gmp_path)
else `Switch gmp_path
| _, true -> `Host
| _, false -> `Missing
let env = function
| `Source gmp_path when is_relative gmp_path ->
let gmp_path = Sys.getcwd () / gmp_path in
Format.asprintf "CC=\"%s\" LDFLAGS=\"-L%s\" CFLAGS=\"-I%s\" CPPFLAGS=\"-I%s\""
!cc gmp_path gmp_path gmp_path
| `Source gmp_path
| `Switch gmp_path ->
Format.asprintf "CC=\"%s\" LDFLAGS=\"-L%s\" CFLAGS=\"-I%s\" CPPFLAGS=\"-I%s\""
!cc gmp_path gmp_path gmp_path
| `Host ->
Format.asprintf "CC=\"%s\"" !cc
| `Missing -> failwith "Zarith requires gmp."
let () =
Arg.parse spec (always ()) usage ;
if !cc = deadbeef
then ( Format.eprintf "%s%!" usage ; exit 1 ) ;
let where = where () in
let env = env where in
Format.printf "%s%!" env
(* XXX(dinosaure): we must **not** append '\n'. Otherwise,
* we don't set the environment. *)

99
unikernel/duniverse/Zarith/dune Normal file
View file

@ -0,0 +1,99 @@
(env
(dev
(flags
(:standard -w -6-32-39))))
(library
(name zarith)
(public_name zarith)
(modules z q big_int_Z zarith_version)
(wrapped false)
(foreign_stubs
(language c)
(names caml_z)
(flags
:standard
(:include cflags.sexp)))
(c_library_flags
(:include libs.sexp)))
(executable
(name configure_env)
(modules configure_env))
(rule
(target Makefile)
(deps configure env)
(action
(bash
"env %{read:env} ./configure --ocamllibdir %{ocaml-config:standard_library}")))
(rule
(target env)
(action
(copy gmp.%{lib-available:gmp} env)))
(rule
(target gmp.true)
(deps
(:exe configure_env.exe)
%{lib:gmp:libgmp.a}
%{lib:gmp:libgmp.so}
%{lib:gmp:gmp.h})
(action
(with-stdout-to
%{target}
(run %{exe} --cc "%{cc}" --with-gmp=%{lib:gmp:libgmp.a}))))
(rule
(target gmp.false)
(deps
(:exe configure_env.exe))
(action
(with-stdout-to
%{target}
(run %{exe} --cc "%{cc}" --with-conf-gmp))))
(rule
(target cflags.sexp)
(deps Makefile)
(action
(with-stdout-to
%{target}
(progn
(bash "echo -n '('")
(bash "cat Makefile | sed -n -e 's/CFLAGS=//p'")
(bash "echo -n ')'")))))
; Note that the order (LDFLAGS, then LIBS) is important below since
; zarith uses pkg-config to detect gmp, and adds the output to LIBS
; but we like -L ..._build/solo5/duniverse/Zarith/../../../install/solo5/lib/gmp
; first, followed by -L/usr/local/lib -lgmp (from pkg-config)
(rule
(target libs.sexp)
(deps Makefile)
(action
(with-stdout-to
%{target}
(progn
(bash "echo -n '('")
(bash "cat Makefile | sed -n -e 's/LDFLAGS=//p'")
(bash "cat Makefile | sed -n -e 's/LIBS=//p'")
(bash "echo -n ')'")))))
(rule
(deps META)
(action
(with-stdout-to
zarith_version.ml
(progn
(run echo "let")
(bash "grep \"version\" META | head -1")))))
(library
(name zarith_top)
(optional)
(public_name zarith.top)
(modules zarith_top)
(libraries zarith compiler-libs.toplevel))

3
unikernel/duniverse/Zarith/dune-project Normal file
View file

@ -0,0 +1,3 @@
(lang dune 2.8)
(name zarith)
(version df8969d)

158
unikernel/duniverse/Zarith/project.mak Normal file
View file

@ -0,0 +1,158 @@
# This file is part of the Zarith library
# http://forge.ocamlcore.org/projects/zarith .
# It is distributed under LGPL 2 licensing, with static linking exception.
# See the LICENSE file included in the distribution.
#
# Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
# Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
# a joint laboratory by:
# CNRS (Centre national de la recherche scientifique, France),
# ENS (École normale supérieure, Paris, France),
# INRIA Rocquencourt (Institut national de recherche en informatique, France).
ifeq "$(shell $(OCAMLC) -config |grep ccomp_type)" "ccomp_type: msvc"
OBJSUFFIX := obj
LIBSUFFIX := lib
DLLSUFFIX := dll
EXE := .exe
else
OBJSUFFIX := o
LIBSUFFIX := a
ifeq "$(findstring mingw,$(shell $(OCAMLC) -config |grep system))" "mingw"
DLLSUFFIX := dll
EXE := .exe
else
DLLSUFFIX := so
EXE :=
endif
endif
# project files
###############
CSRC = caml_z.c
MLSRC = zarith_version.ml z.ml q.ml big_int_Z.ml
MLISRC = z.mli q.mli big_int_Z.mli
AUTOGEN = zarith_version.ml
CMIOBJ = $(MLISRC:%.mli=%.cmi)
CMXOBJ = $(MLSRC:%.ml=%.cmx)
CMIDOC = $(MLISRC:%.mli=%.cmti)
TOBUILD = zarith.cma libzarith.$(LIBSUFFIX) $(CMIOBJ) zarith_top.cma z.mli
TOINSTALL = $(TOBUILD) zarith.h q.mli big_int_Z.mli
ifeq ($(HASOCAMLOPT),yes)
TOBUILD += zarith.cmxa $(CMXOBJ)
TOINSTALL += zarith.$(LIBSUFFIX)
endif
OCAMLFLAGS += -I +compiler-libs
OCAMLOPTFLAGS += -I +compiler-libs
ifeq ($(HASDYNLINK),yes)
TOBUILD += zarith.cmxs
endif
ifeq ($(HASBINANNOT),yes)
TOINSTALL += $(CMIDOC)
OCAMLFLAGS += -bin-annot
endif
# build targets
###############
all: $(TOBUILD)
tests:
make -C tests test
zarith.cma: $(MLSRC:%.ml=%.cmo)
$(OCAMLMKLIB) -failsafe -o zarith $+ $(LIBS) $(LDFLAGS)
zarith.cmxa: $(MLSRC:%.ml=%.cmx)
$(OCAMLMKLIB) -failsafe -o zarith $+ $(LIBS) $(LDFLAGS)
zarith.cmxs: zarith.cmxa libzarith.$(LIBSUFFIX)
$(OCAMLOPT) -shared -o $@ -I . zarith.cmxa -linkall
libzarith.$(LIBSUFFIX): $(CSRC:%.c=%.$(OBJSUFFIX))
$(OCAMLMKLIB) -failsafe -o zarith $+ $(LIBS) $(LDFLAGS)
zarith_top.cma: zarith_top.cmo
$(OCAMLC) -o $@ -a $<
doc: $(MLISRC)
ifneq ($(OCAMLDOC),)
mkdir -p html
$(OCAMLDOC) -html -d html -charset utf8 $+
else
$(error ocamldoc is required to build the documentation)
endif
zarith_version.ml: META
(echo "let"; grep "version" META | head -1) > zarith_version.ml
# install targets
#################
ifeq ($(INSTMETH),install)
install:
install -d $(INSTALLDIR) $(INSTALLDIR)/zarith $(INSTALLDIR)/stublibs
for i in $(TOINSTALL); do \
if test -f $$i; then $(INSTALL) -m 0644 $$i $(INSTALLDIR)/zarith/$$i; fi; \
done
if test -f dllzarith.$(DLLSUFFIX); then $(INSTALL) -m 0755 dllzarith.$(DLLSUFFIX) $(INSTALLDIR)/stublibs/dllzarith.$(DLLSUFFIX); fi
uninstall:
for i in $(TOINSTALL); do \
rm -f $(INSTALLDIR)/zarith/$$i; \
done
if test -f $(INSTALLDIR)/stublibs/dllzarith.$(DLLSUFFIX); then rm -f $(INSTALLDIR)/stublibs/dllzarith.$(DLLSUFFIX); fi
endif
ifeq ($(INSTMETH),findlib)
install:
$(OCAMLFIND) install -destdir "$(INSTALLDIR)" zarith META $(TOINSTALL) -optional dllzarith.$(DLLSUFFIX)
uninstall:
$(OCAMLFIND) remove -destdir "$(INSTALLDIR)" zarith
endif
# rules
#######
%.cmi: %.mli
$(OCAMLC) $(OCAMLFLAGS) $(OCAMLINC) -c $<
%.cmo: %.ml %.cmi
$(OCAMLC) $(OCAMLFLAGS) $(OCAMLINC) -c $<
%.cmx: %.ml %.cmi
$(OCAMLOPT) $(OCAMLOPTFLAGS) $(OCAMLINC) -c $<
%.cmo: %.ml
$(OCAMLC) $(OCAMLFLAGS) $(OCAMLINC) -c $<
%.cmx: %.ml
$(OCAMLOPT) $(OCAMLOPTFLAGS) $(OCAMLINC) -c $<
%.$(OBJSUFFIX): %.c
$(OCAMLC) -ccopt "$(CFLAGS)" -c $<
clean:
/bin/rm -rf *.$(OBJSUFFIX) *.$(LIBSUFFIX) *.$(DLLSUFFIX) *.cmi *.cmo *.cmx *.cmxa *.cmxs *.cma *.cmt *.cmti *~ \#* depend test $(AUTOGEN) tmp.c depend
make -C tests clean
depend: $(AUTOGEN)
$(OCAMLDEP) $(OCAMLINC) $(MLSRC) $(MLISRC) > depend
include depend
$(CSRC:%.c=%.$(OBJSUFFIX)): zarith.h
.PHONY: clean
.PHONY: tests

574
unikernel/duniverse/Zarith/q.ml Normal file
View file

@ -0,0 +1,574 @@
(**
Rationals.
This file is part of the Zarith library
http://forge.ocamlcore.org/projects/zarith .
It is distributed under LGPL 2 licensing, with static linking exception.
See the LICENSE file included in the distribution.
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
a joint laboratory by:
CNRS (Centre national de la recherche scientifique, France),
ENS (École normale supérieure, Paris, France),
INRIA Rocquencourt (Institut national de recherche en informatique, France).
*)
type t = {
num: Z.t; (** Numerator. *)
den: Z.t; (** Denominator, >= 0 *)
}
(* Type of rationals.
Invariants:
- den is always >= 0;
- num and den have no common factor;
- if den=0, then num is -1, 0 or 1.
- if num=0, then den is -1, 0 or 1.
*)
(* creation *)
(* -------- *)
(* make *)
let mk n d =
{ num = n; den = d; }
(* make and normalize n/d, assuming d > 0 *)
let make_real n d =
if n == Z.zero || d == Z.one then mk n Z.one
else
let g = Z.gcd n d in
if g == Z.one
then mk n d
else mk (Z.divexact n g) (Z.divexact d g)
(* make and normalize any fraction *)
let make n d =
let sd = Z.sign d in
if sd = 0 then mk (Z.of_int (Z.sign n)) Z.zero else
if sd > 0 then make_real n d else
make_real (Z.neg n) (Z.neg d)
let of_bigint n = mk n Z.one
(* n/1 *)
let of_int n = of_bigint (Z.of_int n)
let of_int32 n = of_bigint (Z.of_int32 n)
let of_int64 n = of_bigint (Z.of_int64 n)
let of_nativeint n = of_bigint (Z.of_nativeint n)
let of_ints n d = make (Z.of_int n) (Z.of_int d)
let zero = of_bigint Z.zero
(* 0/1 *)
let one = of_bigint Z.one
(* 1/1 *)
let minus_one = of_bigint Z.minus_one
(* -1/1 *)
let inf = mk Z.one Z.zero
(* 1/0 *)
let minus_inf = mk Z.minus_one Z.zero
(* -1/0 *)
let undef = mk Z.zero Z.zero
(* 0/0 *)
let of_float d =
if d = infinity then inf else
if d = neg_infinity then minus_inf else
if classify_float d = FP_nan then undef else
let m,e = frexp d in
(* put into the form m * 2^e, where m is an integer *)
let m,e = Z.of_float (ldexp m 53), e-53 in
if e >= 0 then of_bigint (Z.shift_left m e)
else make_real m (Z.shift_left Z.one (-e))
(* queries *)
(* ------- *)
type kind =
| ZERO (* 0 *)
| INF (* 1/0 *)
| MINF (* -1/0 *)
| UNDEF (* 0/0 *)
| NZERO (* non-special, non-0 *)
let classify n =
if n.den == Z.zero then
match Z.sign n.num with
| 1 -> INF
| -1 -> MINF
| _ -> UNDEF
else
if n.num == Z.zero
then ZERO
else NZERO
let is_real n = (n.den != Z.zero)
let num x = x.num
let den x = x.den
let sign x = Z.sign x.num
(* sign undef = 0
sign inf = 1
sign -inf = -1
*)
let equal x y =
(Z.equal x.num y.num) && (Z.equal x.den y.den) && (classify x <> UNDEF)
let compare x y =
match classify x, classify y with
| UNDEF,UNDEF | INF,INF | MINF,MINF -> 0
| UNDEF,_ -> -1
| _,UNDEF -> 1
| MINF,_ | _,INF -> -1
| INF,_ | _,MINF -> 1
| _ ->
if x.den = y.den (* implies equality,
especially if immediate value and not a pointer,
in particular in the case den = 1 *)
then Z.compare x.num y.num
else
Z.compare
(Z.mul x.num y.den)
(Z.mul y.num x.den)
let min a b = if compare a b <= 0 then a else b
let max a b = if compare a b >= 0 then a else b
let leq x y =
match classify x, classify y with
| UNDEF,_ | _,UNDEF -> false
| MINF,_ | _,INF -> true
| INF,_ | _,MINF -> false
| _ ->
if x.den = y.den
then Z.leq x.num y.num
else
Z.leq
(Z.mul x.num y.den)
(Z.mul y.num x.den)
let lt x y =
match classify x, classify y with
| UNDEF,_ | _,UNDEF -> false
| INF,_ | _,MINF -> false
| MINF,_ | _,INF -> true
| _ ->
if x.den = y.den
then Z.lt x.num y.num
else
Z.lt
(Z.mul x.num y.den)
(Z.mul y.num x.den)
let geq x y = leq y x
let gt x y = lt y x
let to_string n =
match classify n with
| UNDEF -> "undef"
| INF -> "+inf"
| MINF -> "-inf"
| ZERO -> "0"
| NZERO ->
if Z.equal n.den Z.one then Z.to_string n.num
else (Z.to_string n.num) ^ "/" ^ (Z.to_string n.den)
let to_bigint x = Z.div x.num x.den
(* raises a Division by zero in case x is undefined or infinity *)
let to_int x = Z.to_int (to_bigint x)
let to_int32 x = Z.to_int32 (to_bigint x)
let to_int64 x = Z.to_int64 (to_bigint x)
let to_nativeint x = Z.to_nativeint (to_bigint x)
let to_float x =
match classify x with
| ZERO -> 0.0
| INF -> infinity
| MINF -> neg_infinity
| UNDEF -> nan
| NZERO ->
let p = x.num and q = x.den in
let np = Z.numbits p and nq = Z.numbits q in
if np <= 53 && nq <= 53 then
(* p and q convert to floats exactly; use FP division to get the
correctly-rounded result. *)
Int64.to_float (Z.to_int64 p) /. Int64.to_float (Z.to_int64 q)
else begin
let negat =
if Z.sign p < 0 then -1 else 1
in
(* p is in [2^(np-1), 2^np)
q is in [2^(nq-1), 2^nq)
We define n,p',q' such that p'/q'*2^n=p/q and |p'/q'| is in [1, 2). *)
let n = np - nq in
(* Scaling p/q by 2^n *)
let (p', q') =
if n >= 0
then (p, Z.shift_left q n)
else (Z.shift_left p (-n), q)
in
let (p', n) =
if Z.geq (Z.abs p') q'
then (p', n)
else (Z.shift_left p' 1, pred n)
in
(* If we divided p' by q' now, the resulting quotient would
have one significant digit. *)
let p' = Z.shift_left p' 54 in
(* When we divide p' by q' next, the resulting quotient will
have 55 significant digits. The strategy is:
- First, compute the quotient with 55 significant digits in
round-to-odd, and
- Second, round that number to the number of effective
significant digits we desire for the result, which is 53
for a normal result and less than 53 for a subnormal result.
We cannot afford an intermediate rounding at 53 significant digits
if the end-result is subnormal. See
https://github.com/ocaml/Zarith/issues/29 *)
(* Euclidean division of p' by q' *)
let (quo, rem) = Z.ediv_rem p' q' in
if n <= -1080
then
(* The end result is +0.0 or -0.0 (depending on negat)
or perhaps the next floating-point number of the same
sign (depending on the current rounding mode. *)
ldexp (float_of_int negat) (-1080)
else
let offset =
if n <= -1023
then
(* The end result will be subnormal, add an offset
to make the rounding happen directly at the place
where it should happend.
quo has the form: 1xxxx...
we add: 1000000...
so as to end up with: 101xxxx... *)
Z.shift_left (Z.of_int negat) (55 + (-1023 - n))
else
Z.zero
in
let quo = Z.add offset quo in
let quo =
if Z.sign rem = 0
then quo
else Z.logor Z.one quo (* round to odd *)
in
(* The FPU rounding mode affects the Z.to_float that comes next,
making the rounding computed according to the current FPU rounding
mode. *)
let f = Z.to_float quo in
(* The subtraction that comes next is exact, so that the rounding
mode does not change what it does. *)
let f = f -. (Z.to_float offset)
in
(* ldexp is also exact and unaffected by the rounding mode.
We have made sure that if the end result is going to be subnormal,
then f has exactly the correct number of significant digits for
no rounding to happen here. *)
ldexp f (n - 54)
end
(* operations *)
(* ---------- *)
let neg x =
mk (Z.neg x.num) x.den
(* neg undef = undef
neg inf = -inf
neg -inf = inf
*)
let abs x =
mk (Z.abs x.num) x.den
(* abs undef = undef
abs inf = abs -inf = inf
*)
(* addition or substraction (zaors) of finite numbers *)
let aors zaors x y =
if x.den == y.den then (* implies equality,
especially if immediate value and not a pointer,
in particular in the case den = 1 *)
make_real (zaors x.num y.num) x.den
else
make_real
(zaors
(Z.mul x.num y.den)
(Z.mul y.num x.den))
(Z.mul x.den y.den)
let add x y =
if x.den == Z.zero || y.den == Z.zero then match classify x, classify y with
| ZERO,_ -> y
| _,ZERO -> x
| UNDEF,_ | _,UNDEF -> undef
| INF,MINF | MINF,INF -> undef
| INF,_ | _,INF -> inf
| MINF,_ | _,MINF -> minus_inf
| NZERO,NZERO -> failwith "impossible case"
else
aors Z.add x y
(* undef + x = x + undef = undef
inf + -inf = -inf + inf = undef
inf + x = x + inf = inf
-inf + x = x + -inf = -inf
*)
let sub x y =
if x.den == Z.zero || y.den == Z.zero then match classify x, classify y with
| ZERO,_ -> neg y
| _,ZERO -> x
| UNDEF,_ | _,UNDEF -> undef
| INF,INF | MINF,MINF -> undef
| INF,_ | _,MINF -> inf
| MINF,_ | _,INF -> minus_inf
| NZERO,NZERO -> failwith "impossible case"
else
aors Z.sub x y
(* sub x y = add x (neg y) *)
let mul x y =
if x.den == Z.zero || y.den == Z.zero then
mk
(Z.of_int ((Z.sign x.num) * (Z.sign y.num)))
Z.zero
else
make_real (Z.mul x.num y.num) (Z.mul x.den y.den)
(* undef * x = x * undef = undef
0 * inf = inf * 0 = 0 * -inf = -inf * 0 = undef
inf * x = x * inf = sign x * inf
-inf * x = x * -inf = - sign x * inf
*)
let inv x =
match Z.sign x.num with
| 1 -> mk x.den x.num
| -1 -> mk (Z.neg x.den) (Z.neg x.num)
| _ -> if x.den == Z.zero then undef else inf
(* 1 / undef = undef
1 / inf = 1 / -inf = 0
1 / 0 = inf
note that: inv (inv -inf) = inf <> -inf
*)
let div x y =
if Z.sign y.num >= 0
then mul x (mk y.den y.num)
else mul x (mk (Z.neg y.den) (Z.neg y.num))
(* undef / x = x / undef = undef
0 / 0 = undef
inf / inf = inf / -inf = -inf / inf = -inf / -inf = undef
0 / inf = 0 / -inf = x / inf = x / -inf = 0
inf / x = sign x * inf
-inf / x = - sign x * inf
inf / 0 = inf
-inf / 0 = -inf
x / 0 = sign x * inf
we have div x y = mul x (inv y)
*)
let mul_2exp x n =
if x.den == Z.zero then x
else make_real (Z.shift_left x.num n) x.den
let div_2exp x n =
if x.den == Z.zero then x
else make_real x.num (Z.shift_left x.den n)
type supported_base =
| B2 | B8 | B10 | B16
let int_of_base = function
| B2 -> 2
| B8 -> 8
| B10 -> 10
| B16 -> 16
(* [find_in_string s ~pos ~last pred] find the first index in the string between [pos]
(inclusive) and [last] (exclusive) that satisfy the predicate [pred] *)
let rec find_in_string s ~pos ~last p =
if pos >= last
then None
else if p s.[pos]
then Some pos
else find_in_string s ~pos:(pos + 1) ~last p
(* The current implementation supports plain decimals, decimal points,
scientific notation ('e' or 'E' for base 10 litteral and 'p' or 'P'
for base 16), and fraction of integers (eg. 1/2). In particular it
accepts any numeric literal accepted by OCaml's lexer.
Restrictions:
- exponents in scientific notation should fit on an integer
- scientific notation only available in hexa and decimal (as in OCaml) *)
let of_string =
(* return a boolean (true for negative) and the next offset to read *)
let parse_sign s i j =
if j < i + 1
then false, i
else
match s.[i] with
| '-' -> true , i + 1
| '+' -> false, i + 1
| _ -> false ,i
in
(* return the base and the next offset to read *)
let parse_base s i j =
if j < i + 2
then B10, i
else
match s.[i],s.[i+1] with
| '0',('x'|'X') -> B16, i + 2
| '0',('o'|'O') -> B8, i + 2
| '0',('b'|'B') -> B2, i + 2
| _ -> B10, i
in
let find_exponent_mark = function
| B10 -> (function 'e' | 'E' -> true | _ -> false)
| B16 -> (function 'p' | 'P' -> true | _ -> false)
| B8 | B2 -> (fun _ -> false)
in
let of_scientific_notation s =
let i = 0 in
let j = String.length s in
let sign,i = parse_sign s i j in
let base,i = parse_base s i j in
(* shift left due to the exponent *)
let shift_left, j =
match find_in_string s ~pos:i ~last:j (find_exponent_mark base) with
| None -> 0, j
| Some ei ->
let pos = ei + 1 in
let ez = Z.of_substring_base 10 s ~pos ~len:(j - pos) in
Z.to_int ez, ei
in
(* shift right due to the radix *)
let z, shift_right =
match base with
| B2 | B8 -> Z.of_substring_base (int_of_base base) s ~pos:i ~len:(j - i), 0
| B10 | B16 ->
match find_in_string s ~pos:i ~last:j ((=) '.') with
| None -> Z.of_substring_base (int_of_base base) s ~pos:i ~len:(j - i), 0
| Some k ->
(* shift_right_factor correspond to the shift to apply when we move the decimal
point one position to the left.
0x1.1p1 = 0x11p-3 = 0x0.11p5
1.1e1 = 11e0 = 0.11e2 *)
let shift_right_factor =
match base with
| B10 -> 1
| B16 -> 4
| B2 | B8 -> assert false
in
(* We should only consider actual digits to perform the shift. *)
let num_digits = ref 0 in
for h = k + 1 to j - 1 do
match s.[h] with
| '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' ->
incr num_digits
| '_' -> ()
| _ ->
(* '-' and '+' could wrongly be accepted by Z.of_string_base *)
invalid_arg "Q.of_string: invalid digit"
done;
let first_digit_after_dot =
match find_in_string s ~pos:(k+1) ~last:j ((<>) '_') with
| None -> j
| Some x -> x
in
let shift = !num_digits * shift_right_factor in
let without_dot =
String.sub s i (k-i)
^ (String.sub s first_digit_after_dot (j - first_digit_after_dot))
in
Z.of_string_base (int_of_base base) without_dot, shift
in
let shift = shift_left - shift_right in
let exponent_pow =
match base with
| B10 -> 10
| B16 -> 2
| B8 | B2 -> 1
in
let abs =
if shift < 0 then
make z (Z.pow (Z.of_int exponent_pow) (~- shift))
else
of_bigint (Z.mul z (Z.pow (Z.of_int exponent_pow) shift))
in
if sign
then neg abs
else abs
in
function
| "" -> zero
| "inf" | "+inf" -> inf
| "-inf" -> minus_inf
| "undef" -> undef
| s ->
try
let i = String.index s '/' in
make
(Z.of_substring s ~pos:0 ~len:i)
(Z.of_substring s ~pos:(i+1) ~len:(String.length s-i-1))
with Not_found ->
of_scientific_notation s
(* printing *)
(* -------- *)
let print x = print_string (to_string x)
let output chan x = output_string chan (to_string x)
let sprint () x = to_string x
let bprint b x = Buffer.add_string b (to_string x)
let pp_print f x = Format.pp_print_string f (to_string x)
(* prefix and infix *)
(* ---------------- *)
let (~-) = neg
let (~+) x = x
let (+) = add
let (-) = sub
let ( * ) = mul
let (/) = div
let (lsl) = mul_2exp
let (asr) = div_2exp
let (~$) = of_int
let (//) = of_ints
let (~$$) = of_bigint
let (///) = make
let (=) = equal
let (<) = lt
let (>) = gt
let (<=) = leq
let (>=) = geq
let (<>) a b = not (equal a b)

298
unikernel/duniverse/Zarith/q.mli Normal file
View file

@ -0,0 +1,298 @@
(**
Rationals.
This modules builds arbitrary precision rationals on top of arbitrary
integers from module Z.
This file is part of the Zarith library
http://forge.ocamlcore.org/projects/zarith .
It is distributed under LGPL 2 licensing, with static linking exception.
See the LICENSE file included in the distribution.
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
a joint laboratory by:
CNRS (Centre national de la recherche scientifique, France),
ENS (École normale supérieure, Paris, France),
INRIA Rocquencourt (Institut national de recherche en informatique, France).
*)
(** {1 Types} *)
type t = {
num: Z.t; (** Numerator. *)
den: Z.t; (** Denominator, >= 0 *)
}
(** A rational is represented as a pair numerator/denominator, reduced to
have a non-negative denominator and no common factor.
This form is canonical (enabling polymorphic equality and hashing).
The representation allows three special numbers: [inf] (1/0), [-inf] (-1/0)
and [undef] (0/0).
*)
(** {1 Construction} *)
val make: Z.t -> Z.t -> t
(** [make num den] constructs a new rational equal to [num]/[den].
It takes care of putting the rational in canonical form.
*)
val zero: t
val one: t
val minus_one:t
(** 0, 1, -1. *)
val inf: t
(** 1/0. *)
val minus_inf: t
(** -1/0. *)
val undef: t
(** 0/0. *)
val of_bigint: Z.t -> t
val of_int: int -> t
val of_int32: int32 -> t
val of_int64: int64 -> t
val of_nativeint: nativeint -> t
(** Conversions from various integer types. *)
val of_ints: int -> int -> t
(** Conversion from an [int] numerator and an [int] denominator. *)
val of_float: float -> t
(** Conversion from a [float].
The conversion is exact, and maps NaN to [undef].
*)
val of_string: string -> t
(** Converts a string to a rational. Plain integers, [/] separated
integer ratios (with optional sign), decimal point and scientific
notations are understood.
Additionally, the special [inf], [-inf], and [undef] are
recognized (they can also be typeset respectively as [1/0], [-1/0],
[0/0]). *)
(** {1 Inspection} *)
val num: t -> Z.t
(** Get the numerator. *)
val den: t -> Z.t
(** Get the denominator. *)
(** {1 Testing} *)
type kind =
| ZERO (** 0 *)
| INF (** infinity, i.e. 1/0 *)
| MINF (** minus infinity, i.e. -1/0 *)
| UNDEF (** undefined, i.e., 0/0 *)
| NZERO (** well-defined, non-infinity, non-zero number *)
(** Rationals can be categorized into different kinds, depending mainly on
whether the numerator and/or denominator is null.
*)
val classify: t -> kind
(** Determines the kind of a rational. *)
val is_real: t -> bool
(** Whether the argument is non-infinity and non-undefined. *)
val sign: t -> int
(** Returns 1 if the argument is positive (including inf), -1 if it is
negative (including -inf), and 0 if it is null or undefined.
*)
val compare: t -> t -> int
(** [compare x y] compares [x] to [y] and returns 1 if [x] is strictly
greater that [y], -1 if it is strictly smaller, and 0 if they are
equal.
This is a total ordering.
Infinities are ordered in the natural way, while undefined is considered
the smallest of all: undef = undef < -inf <= -inf < x < inf <= inf.
This is consistent with OCaml's handling of floating-point infinities
and NaN.
OCaml's polymorphic comparison will NOT return a result consistent with
the ordering of rationals.
*)
val equal: t -> t -> bool
(** Equality testing.
Unlike [compare], this follows IEEE semantics: [undef] <> [undef].
*)
val min: t -> t -> t
(** Returns the smallest of its arguments. *)
val max: t -> t -> t
(** Returns the largest of its arguments. *)
val leq: t -> t -> bool
(** Less than or equal. [leq undef undef] returns false. *)
val geq: t -> t -> bool
(** Greater than or equal. [leq undef undef] returns false. *)
val lt: t -> t -> bool
(** Less than (not equal). *)
val gt: t -> t -> bool
(** Greater than (not equal). *)
(** {1 Conversions} *)
val to_bigint: t -> Z.t
val to_int: t -> int
val to_int32: t -> int32
val to_int64: t -> int64
val to_nativeint: t -> nativeint
(** Convert to integer by truncation.
Raises a [Divide_by_zero] if the argument is an infinity or undefined.
Raises a [Z.Overflow] if the result does not fit in the destination
type.
*)
val to_string: t -> string
(** Converts to human-readable, base-10, [/]-separated rational. *)
val to_float: t -> float
(** Converts to a floating-point number, using the current
floating-point rounding mode. With the default rounding mode,
the result is the floating-point number closest to the given
rational; ties break to even mantissa. *)
(** {1 Arithmetic operations} *)
(**
In all operations, the result is [undef] if one argument is [undef].
Other operations can return [undef]: such as [inf]-[inf], [inf]*0, 0/0.
*)
val neg: t -> t
(** Negation. *)
val abs: t -> t
(** Absolute value. *)
val add: t -> t -> t
(** Addition. *)
val sub: t -> t -> t
(** Subtraction. We have [sub x y] = [add x (neg y)]. *)
val mul: t -> t -> t
(** Multiplication. *)
val inv: t -> t
(** Inverse.
Note that [inv 0] is defined, and equals [inf].
*)
val div: t -> t -> t
(** Division.
We have [div x y] = [mul x (inv y)], and [inv x] = [div one x].
*)
val mul_2exp: t -> int -> t
(** [mul_2exp x n] multiplies [x] by 2 to the power of [n]. *)
val div_2exp: t -> int -> t
(** [div_2exp x n] divides [x] by 2 to the power of [n]. *)
(** {1 Printing} *)
val print: t -> unit
(** Prints the argument on the standard output. *)
val output: out_channel -> t -> unit
(** Prints the argument on the specified channel.
Also intended to be used as [%a] format printer in [Printf.printf].
*)
val sprint: unit -> t -> string
(** To be used as [%a] format printer in [Printf.sprintf]. *)
val bprint: Buffer.t -> t -> unit
(** To be used as [%a] format printer in [Printf.bprintf]. *)
val pp_print: Format.formatter -> t -> unit
(** Prints the argument on the specified formatter.
Also intended to be used as [%a] format printer in [Format.printf].
*)
(** {1 Prefix and infix operators} *)
(**
Classic prefix and infix [int] operators are redefined on [t].
*)
val (~-): t -> t
(** Negation [neg]. *)
val (~+): t -> t
(** Identity. *)
val (+): t -> t -> t
(** Addition [add]. *)
val (-): t -> t -> t
(** Subtraction [sub]. *)
val ( * ): t -> t -> t
(** Multiplication [mul]. *)
val (/): t -> t -> t
(** Division [div]. *)
val (lsl): t -> int -> t
(** Multiplication by a power of two [mul_2exp]. *)
val (asr): t -> int -> t
(** Division by a power of two [shift_right]. *)
val (~$): int -> t
(** Conversion from [int]. *)
val (//): int -> int -> t
(** Creates a rational from two [int]s. *)
val (~$$): Z.t -> t
(** Conversion from [Z.t]. *)
val (///): Z.t -> Z.t -> t
(** Creates a rational from two [Z.t]. *)
val (=): t -> t -> bool
(** Same as [equal].
@since 1.8 *)
val (<): t -> t -> bool
(** Same as [lt].
@since 1.8 *)
val (>): t -> t -> bool
(** Same as [gt].
@since 1.8 *)
val (<=): t -> t -> bool
(** Same as [leq].
@since 1.8 *)
val (>=): t -> t -> bool
(** Same as [geq].
@since 1.8 *)
val (<>): t -> t -> bool
(** [a <> b] is equivalent to [not (equal a b)].
@since 1.8 *)

198
unikernel/duniverse/Zarith/tests/bi.ml Normal file
View file

@ -0,0 +1,198 @@
(* stress test, using random and corner cases
compares Big_int_Z, a Big_int compatible interface for Z, to OCaml's
reference Big_int library
This file is part of the Zarith library
http://forge.ocamlcore.org/projects/zarith .
It is distributed under LGPL 2 licensing, with static linking exception.
See the LICENSE file included in the distribution.
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
a joint laboratory by:
CNRS (Centre national de la recherche scientifique, France),
ENS (École normale supérieure, Paris, France),
INRIA Rocquencourt (Institut national de recherche en informatique, France).
*)
module B = Big_int (* reference library *)
module T = Big_int_Z (* tested library *)
(* randomness *)
let _ = Random.init 42
let random_int64 () =
let a,b,c = Random.bits(), Random.bits(), Random.bits () in
let a,b,c = Int64.of_int a, Int64.of_int b, Int64.of_int c in
let a,b,c = Int64.shift_left a 60, Int64.shift_left b 30, c in
Int64.logor a (Int64.logor b c)
let random_int () = Int64.to_int (random_int64 ())
let random_string () =
let l = 1 + Random.int 200 in
let s = Buffer.create l in
let st = if l > 1 && Random.bool () then begin
Buffer.add_char s '-';
1
end else 0 in
for i = st to l - 1 do
Buffer.add_char s (Char.chr (48 + Random.int 10))
done;
Buffer.contents s
(* list utility *)
let list_make n f =
let rec doit i acc = if i < 0 then acc else doit (i-1) ((f i)::acc) in
doit (n-1) []
(* interesting numbers, as big_int *)
let p = (list_make 128 (B.shift_left_big_int B.unit_big_int))
let pn = p @ (List.map B.minus_big_int p)
let g_list =
[B.zero_big_int] @
pn @ (List.map B.succ_big_int pn) @ (List.map B.pred_big_int pn) @
(list_make 128 (fun _ -> B.big_int_of_int (random_int ()))) @
(list_make 128 (fun _ -> B.big_int_of_string (random_string())))
let sh_list = list_make 256 (fun x -> x)
let pow_list = [1;2;3;4;5;6;7;8;9;10;20;55]
(* conversion to Z *)
let g_t_list =
Printf.printf "converting %i numbers\n%!" (List.length g_list);
List.map
(fun g ->
let t = T.big_int_of_string (B.string_of_big_int g) in
let g' = B.big_int_of_string (T.string_of_big_int t) in
if B.compare_big_int g g' <> 0 then failwith (Printf.sprintf "string_of_big_int failure: %s" (B.string_of_big_int g));
g, t
)
g_list
let rec cut_list n l =
if n <= 0 then [] else match l with [] -> [] | h :: t -> h :: cut_list (n-1) t
let small_g_t_list = cut_list 256 g_t_list
(* operator tests *)
let test_un msg filt gf tf =
Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list);
List.iter
(fun (g,t) ->
try
if filt g then (
let g' = gf g and t' = tf t in
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'))
)
with Failure _ -> ()
) g_t_list
let test_bin_gen msg filt gf tf l =
Printf.printf "testing %s on %i x %i numbers\n%!" msg (List.length l) (List.length l);
List.iter
(fun (g1,t1) ->
List.iter
(fun (g2,t2) ->
if filt (g1,g2) then (
let g' = gf g1 g2 and t' = tf t1 t2 in
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'))
)
) l
) l
let test_bin msg filt gf tf = test_bin_gen msg filt gf tf g_t_list
let test_bin_small msg filt gf tf = test_bin_gen msg filt gf tf small_g_t_list
let test_shift msg gf tf =
Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list);
List.iter
(fun s ->
List.iter
(fun (g,t) ->
let g' = gf g s and t' = tf t s in
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'))
) g_t_list
) sh_list
let test_pow msg gf tf =
Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list);
List.iter
(fun s ->
List.iter
(fun (g,t) ->
let g' = gf g s and t' = tf t s in
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'))
) g_t_list
) pow_list
let test_comparison msg gf tf l =
Printf.printf "testing %s on %i x %i numbers\n%!" msg (List.length l) (List.length l);
List.iter
(fun (g1,t1) ->
List.iter
(fun (g2,t2) ->
let g' = gf g1 g2 and t' = tf t1 t2 in
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))
) l
) l
let filt_none _ = true
let filt_pos x = B.sign_big_int x >= 0
let filt_nonzero2 (_,d) = B.sign_big_int d <> 0
let filt_pos2 (x,y) = B.sign_big_int x >= 0 && B.sign_big_int y >= 0
let filt_nonzero22 (x,y) = B.sign_big_int x <> 0 && B.sign_big_int y <> 0
let ffst f x = fst (f x)
let fsnd f x = snd (f x)
let ffst2 f x y = fst (f x y)
let fsnd2 f x y = snd (f x y)
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))
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))
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))
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))
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))
let _ = test_un "minus_big_int" filt_none B.minus_big_int T.minus_big_int
let _ = test_un "abs_big_int" filt_none B.abs_big_int T.abs_big_int
let _ = test_un "succ_big_int"filt_none B.succ_big_int T.succ_big_int
let _ = test_un "pred_big_int" filt_none B.pred_big_int T.pred_big_int
let _ = test_un "sqrt_big_int" filt_pos B.sqrt_big_int T.sqrt_big_int
let _ = test_bin "add_big_int" filt_none B.add_big_int T.add_big_int
let _ = test_bin "sub_big_int" filt_none B.sub_big_int T.sub_big_int
let _ = test_bin "mult_big_int" filt_none B.mult_big_int T.mult_big_int
let _ = test_bin_small "div_big_int" filt_nonzero2 B.div_big_int T.div_big_int
let _ = test_bin_small "quomod_big_int #1" filt_nonzero2 (ffst2 B.quomod_big_int) (ffst2 T.quomod_big_int)
let _ = test_bin_small "quomod_big_int #2" filt_nonzero2 (fsnd2 B.quomod_big_int) (fsnd2 T.quomod_big_int)
let _ = test_bin_small "mod_big_int" filt_nonzero2 B.mod_big_int T.mod_big_int
let _ = test_bin_small "gcd_big_int" filt_nonzero22 B.gcd_big_int T.gcd_big_int
let _ = test_bin "and_big_int" filt_pos2 B.and_big_int T.and_big_int
let _ = test_bin "or_big_int" filt_pos2 B.or_big_int T.or_big_int
let _ = test_bin "xor_big_int" filt_pos2 B.xor_big_int T.xor_big_int
let _ = test_shift "shift_left_big_int" B.shift_left_big_int T.shift_left_big_int
let _ = test_shift "shift_right_big_int" B.shift_right_big_int T.shift_right_big_int
let _ = test_shift "shift_right_towards_zero_big_int" B.shift_right_towards_zero_big_int T.shift_right_towards_zero_big_int
let _ = test_pow "power_big_int_positive_int" B.power_big_int_positive_int T.power_big_int_positive_int
let _ = test_comparison "compare" B.compare_big_int Z.compare g_t_list
let _ = test_comparison "equal" B.eq_big_int Z.equal g_t_list
let _ = test_comparison "lt" B.lt_big_int (fun x y -> x < y) g_t_list
let _ = test_comparison "ge" B.ge_big_int (fun x y -> x >= y) g_t_list
let _ = Printf.printf "All tests passed!\n"

60
unikernel/duniverse/Zarith/tests/chi2.ml Normal file
View file

@ -0,0 +1,60 @@
(* Accumulate [n] samples from function [f] and check the chi-square.
Assumes [f] returns integers in the [0..255] range. *)
let chisquare n f =
let r = 256 in
let freq = Array.make r 0 in
for i = 0 to n - 1 do
let t = f () in freq.(t) <- freq.(t) + 1
done;
let expected = float n /. float r in
let t =
Array.fold_left
(fun s x -> let d = float x -. expected in d *. d +. s)
0.0 freq in
let chi2 = t /. expected in
let degfree = float r -. 1.0 in
(* The degree of freedom is high, so we approximate as a normal
distribution with mean equal to degfree and variance 2 * degfree.
Four sigmas correspond to a 99.9968% confidence interval.
(Without the approximation, the confidence interval seems to be 99.986%.)
*)
chi2 <= degfree +. 4.0 *. sqrt (2.0 *. degfree)
let failed = ref false
let test_base name f =
if not (chisquare 100_000 f) then begin
Printf.printf "%s: suspicious result\n%!" name;
failed := true
end
let test name f =
(* Test the low 8 bits of the result of f *)
test_base name (fun () -> Z.to_int (Z.logand (f ()) (Z.of_int 0xFF)))
let p = Z.of_string "35742549198872617291353508656626642567"
let _ =
test "random_bits 15 (bits 0-7)"
(fun () -> Z.random_bits 15);
test "random_bits 32 (bits 12-19)"
(fun () -> Z.(shift_right (random_bits 32) 12));
test "random_bits 31 (bits 23-30)"
(fun () -> Z.(shift_right (random_bits 31) 23));
test "random_int 2^30 (bits 0-7)"
(fun () -> Z.(random_int (shift_left one 30)));
test "random_int 2^30 (bits 21-28)"
(fun () -> Z.(shift_right (random_int (shift_left one 30)) 21));
test "random_int (256 * p) / p"
(let bound = Z.shift_left p 8 in
fun () -> Z.(div (random_int bound) p));
(* Also test our hash function, why not? *)
test_base "hash (random_int p) (bits 0-7)"
(fun () -> Z.(hash (random_int p)) land 0xFF);
test_base "hash (random_int p) (bits 16-23)"
(fun () -> (Z.(hash (random_int p)) lsr 16) land 0xFF);
exit (if !failed then 2 else 0)

BIN
unikernel/duniverse/Zarith/tests/extern.data32 Normal file
View file

Binary file not shown.

BIN
unikernel/duniverse/Zarith/tests/extern.data64 Normal file
View file

Binary file not shown.

14
unikernel/duniverse/Zarith/tests/extern.ml Normal file
View file

@ -0,0 +1,14 @@
(* Marshal some interesting big integers to the given file *)
let _ =
let file = Sys.argv.(1) in
let oc = open_out_bin file in
for nbits = 16 to 128 do
let x = Z.shift_left Z.one nbits in
output_value oc (Z.pred (Z.neg x));
output_value oc (Z.neg x);
output_value oc (Z.pred x);
output_value oc x
done;
close_out oc

24
unikernel/duniverse/Zarith/tests/intern.ml Normal file
View file

@ -0,0 +1,24 @@
(* Unmarshal big integers from the given file, and report errors *)
open Printf
let expect ic n =
try
let m = (input_value ic : Z.t) in
if Z.equal m n then printf " OK" else printf " Wrong"
with Failure _ ->
printf " Fail"
let _ =
let file = Sys.argv.(1) in
let ic = open_in_bin file in
for nbits = 16 to 128 do
printf "%d:" nbits;
let x = Z.shift_left Z.one nbits in
expect ic (Z.pred (Z.neg x));
expect ic (Z.neg x);
expect ic (Z.pred x);
expect ic x;
print_newline()
done;
close_in ic

113
unikernel/duniverse/Zarith/tests/intern.output3232 Normal file
View file

@ -0,0 +1,113 @@
16: OK OK OK OK
17: OK OK OK OK
18: OK OK OK OK
19: OK OK OK OK
20: OK OK OK OK
21: OK OK OK OK
22: OK OK OK OK
23: OK OK OK OK
24: OK OK OK OK
25: OK OK OK OK
26: OK OK OK OK
27: OK OK OK OK
28: OK OK OK OK
29: OK OK OK OK
30: OK OK OK OK
31: OK OK OK OK
32: OK OK OK OK
33: OK OK OK OK
34: OK OK OK OK
35: OK OK OK OK
36: OK OK OK OK
37: OK OK OK OK
38: OK OK OK OK
39: OK OK OK OK
40: OK OK OK OK
41: OK OK OK OK
42: OK OK OK OK
43: OK OK OK OK
44: OK OK OK OK
45: OK OK OK OK
46: OK OK OK OK
47: OK OK OK OK
48: OK OK OK OK
49: OK OK OK OK
50: OK OK OK OK
51: OK OK OK OK
52: OK OK OK OK
53: OK OK OK OK
54: OK OK OK OK
55: OK OK OK OK
56: OK OK OK OK
57: OK OK OK OK
58: OK OK OK OK
59: OK OK OK OK
60: OK OK OK OK
61: OK OK OK OK
62: OK OK OK OK
63: OK OK OK OK
64: OK OK OK OK
65: OK OK OK OK
66: OK OK OK OK
67: OK OK OK OK
68: OK OK OK OK
69: OK OK OK OK
70: OK OK OK OK
71: OK OK OK OK
72: OK OK OK OK
73: OK OK OK OK
74: OK OK OK OK
75: OK OK OK OK
76: OK OK OK OK
77: OK OK OK OK
78: OK OK OK OK
79: OK OK OK OK
80: OK OK OK OK
81: OK OK OK OK
82: OK OK OK OK
83: OK OK OK OK
84: OK OK OK OK
85: OK OK OK OK
86: OK OK OK OK
87: OK OK OK OK
88: OK OK OK OK
89: OK OK OK OK
90: OK OK OK OK
91: OK OK OK OK
92: OK OK OK OK
93: OK OK OK OK
94: OK OK OK OK
95: OK OK OK OK
96: OK OK OK OK
97: OK OK OK OK
98: OK OK OK OK
99: OK OK OK OK
100: OK OK OK OK
101: OK OK OK OK
102: OK OK OK OK
103: OK OK OK OK
104: OK OK OK OK
105: OK OK OK OK
106: OK OK OK OK
107: OK OK OK OK
108: OK OK OK OK
109: OK OK OK OK
110: OK OK OK OK
111: OK OK OK OK
112: OK OK OK OK
113: OK OK OK OK
114: OK OK OK OK
115: OK OK OK OK
116: OK OK OK OK
117: OK OK OK OK
118: OK OK OK OK
119: OK OK OK OK
120: OK OK OK OK
121: OK OK OK OK
122: OK OK OK OK
123: OK OK OK OK
124: OK OK OK OK
125: OK OK OK OK
126: OK OK OK OK
127: OK OK OK OK
128: OK OK OK OK

113
unikernel/duniverse/Zarith/tests/intern.output3264 Normal file
View file

@ -0,0 +1,113 @@
16: OK OK OK OK
17: OK OK OK OK
18: OK OK OK OK
19: OK OK OK OK
20: OK OK OK OK
21: OK OK OK OK
22: OK OK OK OK
23: OK OK OK OK
24: OK OK OK OK
25: OK OK OK OK
26: OK OK OK OK
27: OK OK OK OK
28: OK OK OK OK
29: OK OK OK OK
30: Fail OK OK Fail
31: Fail Fail Fail Fail
32: Fail Fail Fail Fail
33: Fail Fail Fail Fail
34: Fail Fail Fail Fail
35: Fail Fail Fail Fail
36: Fail Fail Fail Fail
37: Fail Fail Fail Fail
38: Fail Fail Fail Fail
39: Fail Fail Fail Fail
40: Fail Fail Fail Fail
41: Fail Fail Fail Fail
42: Fail Fail Fail Fail
43: Fail Fail Fail Fail
44: Fail Fail Fail Fail
45: Fail Fail Fail Fail
46: Fail Fail Fail Fail
47: Fail Fail Fail Fail
48: Fail Fail Fail Fail
49: Fail Fail Fail Fail
50: Fail Fail Fail Fail
51: Fail Fail Fail Fail
52: Fail Fail Fail Fail
53: Fail Fail Fail Fail
54: Fail Fail Fail Fail
55: Fail Fail Fail Fail
56: Fail Fail Fail Fail
57: Fail Fail Fail Fail
58: Fail Fail Fail Fail
59: Fail Fail Fail Fail
60: Fail Fail Fail Fail
61: Fail Fail Fail Fail
62: OK Fail Fail OK
63: OK OK OK OK
64: OK OK OK OK
65: OK OK OK OK
66: OK OK OK OK
67: OK OK OK OK
68: OK OK OK OK
69: OK OK OK OK
70: OK OK OK OK
71: OK OK OK OK
72: OK OK OK OK
73: OK OK OK OK
74: OK OK OK OK
75: OK OK OK OK
76: OK OK OK OK
77: OK OK OK OK
78: OK OK OK OK
79: OK OK OK OK
80: OK OK OK OK
81: OK OK OK OK
82: OK OK OK OK
83: OK OK OK OK
84: OK OK OK OK
85: OK OK OK OK
86: OK OK OK OK
87: OK OK OK OK
88: OK OK OK OK
89: OK OK OK OK
90: OK OK OK OK
91: OK OK OK OK
92: OK OK OK OK
93: OK OK OK OK
94: OK OK OK OK
95: OK OK OK OK
96: OK OK OK OK
97: OK OK OK OK
98: OK OK OK OK
99: OK OK OK OK
100: OK OK OK OK
101: OK OK OK OK
102: OK OK OK OK
103: OK OK OK OK
104: OK OK OK OK
105: OK OK OK OK
106: OK OK OK OK
107: OK OK OK OK
108: OK OK OK OK
109: OK OK OK OK
110: OK OK OK OK
111: OK OK OK OK
112: OK OK OK OK
113: OK OK OK OK
114: OK OK OK OK
115: OK OK OK OK
116: OK OK OK OK
117: OK OK OK OK
118: OK OK OK OK
119: OK OK OK OK
120: OK OK OK OK
121: OK OK OK OK
122: OK OK OK OK
123: OK OK OK OK
124: OK OK OK OK
125: OK OK OK OK
126: OK OK OK OK
127: OK OK OK OK
128: OK OK OK OK

113
unikernel/duniverse/Zarith/tests/intern.output6432 Normal file
View file

@ -0,0 +1,113 @@
16: OK OK OK OK
17: OK OK OK OK
18: OK OK OK OK
19: OK OK OK OK
20: OK OK OK OK
21: OK OK OK OK
22: OK OK OK OK
23: OK OK OK OK
24: OK OK OK OK
25: OK OK OK OK
26: OK OK OK OK
27: OK OK OK OK
28: OK OK OK OK
29: OK OK OK OK
30: Fail OK OK Fail
31: Fail Fail Fail Fail
32: Fail Fail Fail Fail
33: Fail Fail Fail Fail
34: Fail Fail Fail Fail
35: Fail Fail Fail Fail
36: Fail Fail Fail Fail
37: Fail Fail Fail Fail
38: Fail Fail Fail Fail
39: Fail Fail Fail Fail
40: Fail Fail Fail Fail
41: Fail Fail Fail Fail
42: Fail Fail Fail Fail
43: Fail Fail Fail Fail
44: Fail Fail Fail Fail
45: Fail Fail Fail Fail
46: Fail Fail Fail Fail
47: Fail Fail Fail Fail
48: Fail Fail Fail Fail
49: Fail Fail Fail Fail
50: Fail Fail Fail Fail
51: Fail Fail Fail Fail
52: Fail Fail Fail Fail
53: Fail Fail Fail Fail
54: Fail Fail Fail Fail
55: Fail Fail Fail Fail
56: Fail Fail Fail Fail
57: Fail Fail Fail Fail
58: Fail Fail Fail Fail
59: Fail Fail Fail Fail
60: Fail Fail Fail Fail
61: Fail Fail Fail Fail
62: OK Fail Fail OK
63: OK OK OK OK
64: OK OK OK OK
65: OK OK OK OK
66: OK OK OK OK
67: OK OK OK OK
68: OK OK OK OK
69: OK OK OK OK
70: OK OK OK OK
71: OK OK OK OK
72: OK OK OK OK
73: OK OK OK OK
74: OK OK OK OK
75: OK OK OK OK
76: OK OK OK OK
77: OK OK OK OK
78: OK OK OK OK
79: OK OK OK OK
80: OK OK OK OK
81: OK OK OK OK
82: OK OK OK OK
83: OK OK OK OK
84: OK OK OK OK
85: OK OK OK OK
86: OK OK OK OK
87: OK OK OK OK
88: OK OK OK OK
89: OK OK OK OK
90: OK OK OK OK
91: OK OK OK OK
92: OK OK OK OK
93: OK OK OK OK
94: OK OK OK OK
95: OK OK OK OK
96: OK OK OK OK
97: OK OK OK OK
98: OK OK OK OK
99: OK OK OK OK
100: OK OK OK OK
101: OK OK OK OK
102: OK OK OK OK
103: OK OK OK OK
104: OK OK OK OK
105: OK OK OK OK
106: OK OK OK OK
107: OK OK OK OK
108: OK OK OK OK
109: OK OK OK OK
110: OK OK OK OK
111: OK OK OK OK
112: OK OK OK OK
113: OK OK OK OK
114: OK OK OK OK
115: OK OK OK OK
116: OK OK OK OK
117: OK OK OK OK
118: OK OK OK OK
119: OK OK OK OK
120: OK OK OK OK
121: OK OK OK OK
122: OK OK OK OK
123: OK OK OK OK
124: OK OK OK OK
125: OK OK OK OK
126: OK OK OK OK
127: OK OK OK OK
128: OK OK OK OK

113
unikernel/duniverse/Zarith/tests/intern.output6464 Normal file
View file

@ -0,0 +1,113 @@
16: OK OK OK OK
17: OK OK OK OK
18: OK OK OK OK
19: OK OK OK OK
20: OK OK OK OK
21: OK OK OK OK
22: OK OK OK OK
23: OK OK OK OK
24: OK OK OK OK
25: OK OK OK OK
26: OK OK OK OK
27: OK OK OK OK
28: OK OK OK OK
29: OK OK OK OK
30: OK OK OK OK
31: OK OK OK OK
32: OK OK OK OK
33: OK OK OK OK
34: OK OK OK OK
35: OK OK OK OK
36: OK OK OK OK
37: OK OK OK OK
38: OK OK OK OK
39: OK OK OK OK
40: OK OK OK OK
41: OK OK OK OK
42: OK OK OK OK
43: OK OK OK OK
44: OK OK OK OK
45: OK OK OK OK
46: OK OK OK OK
47: OK OK OK OK
48: OK OK OK OK
49: OK OK OK OK
50: OK OK OK OK
51: OK OK OK OK
52: OK OK OK OK
53: OK OK OK OK
54: OK OK OK OK
55: OK OK OK OK
56: OK OK OK OK
57: OK OK OK OK
58: OK OK OK OK
59: OK OK OK OK
60: OK OK OK OK
61: OK OK OK OK
62: OK OK OK OK
63: OK OK OK OK
64: OK OK OK OK
65: OK OK OK OK
66: OK OK OK OK
67: OK OK OK OK
68: OK OK OK OK
69: OK OK OK OK
70: OK OK OK OK
71: OK OK OK OK
72: OK OK OK OK
73: OK OK OK OK
74: OK OK OK OK
75: OK OK OK OK
76: OK OK OK OK
77: OK OK OK OK
78: OK OK OK OK
79: OK OK OK OK
80: OK OK OK OK
81: OK OK OK OK
82: OK OK OK OK
83: OK OK OK OK
84: OK OK OK OK
85: OK OK OK OK
86: OK OK OK OK
87: OK OK OK OK
88: OK OK OK OK
89: OK OK OK OK
90: OK OK OK OK
91: OK OK OK OK
92: OK OK OK OK
93: OK OK OK OK
94: OK OK OK OK
95: OK OK OK OK
96: OK OK OK OK
97: OK OK OK OK
98: OK OK OK OK
99: OK OK OK OK
100: OK OK OK OK
101: OK OK OK OK
102: OK OK OK OK
103: OK OK OK OK
104: OK OK OK OK
105: OK OK OK OK
106: OK OK OK OK
107: OK OK OK OK
108: OK OK OK OK
109: OK OK OK OK
110: OK OK OK OK
111: OK OK OK OK
112: OK OK OK OK
113: OK OK OK OK
114: OK OK OK OK
115: OK OK OK OK
116: OK OK OK OK
117: OK OK OK OK
118: OK OK OK OK
119: OK OK OK OK
120: OK OK OK OK
121: OK OK OK OK
122: OK OK OK OK
123: OK OK OK OK
124: OK OK OK OK
125: OK OK OK OK
126: OK OK OK OK
127: OK OK OK OK
128: OK OK OK OK

292
unikernel/duniverse/Zarith/tests/ofstring.ml Normal file
View file

@ -0,0 +1,292 @@
let pow2 n =
let rec doit acc n =
if n<=0 then acc else doit (Z.add acc acc) (n-1)
in
doit Z.one n
let p30 = pow2 30
let p62 = pow2 62
let p300 = pow2 300
let p120 = pow2 120
let p121 = pow2 121
let test_of_string_Z () =
let round_trip_Z () =
let round_trip fmt x=
(Z.equal (Z.of_string (Z.format fmt x)) x)
in
let formats = [
"%i"; "%#b"; "%#o"; "%#x"; "%#X";
"%+i"; "%#+b"; "%#+o"; "%#+x"; "%#+X";
"%+0i"; "%#+0b"; "%#+0o"; "%#+0x"; "%#+0X";
] in
let numbers =
let (+) = Z.add in
let l = [p30; p62; p30 + p62; p300; p120; p121] in
l @ (List.map Z.neg l)
in
List.iter
(fun fmt ->
assert
(
List.for_all
(fun x -> round_trip fmt x)
numbers
)
)
formats
in
let fail d f x =
try
ignore (f x);
Printf.printf "%s should fail on %s\n" d x
with _ -> ()
in
let succ d f x y =
try
let z = f x in
if Z.equal z y
then ()
else
Printf.printf
"%s(%s) returned %s, expected %s\n"
d
x
(Z.to_string z)
(Z.to_string y)
with _ ->
Printf.printf "%s failed. Expected %s\n" d (Z.to_string y)
in
let z_and_int_agree s =
let f = try Some (int_of_string s) with _ -> None in
let z = try Some (Z.of_string s) with _ -> None in
match f,z with
| None, None -> ()
| Some i, Some z ->
if not (Z.equal (Z.of_int i) z)
then
Printf.printf
"Z.of_string (%s) returned %s, expected %s\n"
s
(Z.to_string z)
(string_of_int i)
| Some i, None ->
Printf.printf
"Z.of_string (%s) failed, expected %s\n"
s
(string_of_int i)
| None, Some z ->
Printf.printf
"Z.of_string (%s) returned %s, failure expected"
s
(Z.to_string z)
in
round_trip_Z ();
fail "Z.of_string" Z.of_string "0b2";
fail "Z.of_string" Z.of_string "0o8";
fail "Z.of_string" Z.of_string "0xg";
fail "Z.of_string" Z.of_string "0xG";
fail "Z.of_string" Z.of_string "0A";
succ "Z.of_string" Z.of_string "" Z.zero;
succ "Z.of_string" Z.of_string "+" Z.zero;
succ "Z.of_string" Z.of_string "-" Z.zero;
succ "Z.of_string" Z.of_string "0x" Z.zero;
succ "Z.of_string" Z.of_string "0b" Z.zero;
fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:2) "0b2";
fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:2) "0o8";
fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:2) "0xg";
fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:2) "0xG";
fail "Z.of_substring" (Z.of_substring ~pos:1 ~len:1) "0A";
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:0) "+" Z.zero;
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:1) "-+" Z.zero;
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:2)"--1-" (Z.minus_one);
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:2)"--1\000" (Z.minus_one);
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:2)"\000-1\000" (Z.minus_one);
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:1)"00b1" Z.zero;
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:2)"00b1" Z.zero;
succ "Z.of_substring" (Z.of_substring ~pos:1 ~len:3)"00b1" Z.one;
z_and_int_agree "_123";
z_and_int_agree "1_23";
z_and_int_agree "12_3";
z_and_int_agree "123_";
z_and_int_agree "0x_123";
z_and_int_agree "0_123";
let s = Z.format "%#b" p120 in
let n = String.length s in
for i = 0 to n - 3 do
succ "Z.of_substring"
(Z.of_substring ~pos:0 ~len:(n - i))
s
(Z.shift_right p120 i)
done
let _ = test_of_string_Z ()
let test_of_string_Q () =
let round_trip_Q () =
let round_trip fmt x=
let os = Q.of_string (Z.to_string x) in
let ob = Q.of_bigint x in
if Q.equal os ob then
true
else begin
Format.printf "%a not equal to %a\n" Q.pp_print os Q.pp_print ob;
false
end
in
let formats = [
"%i"; "%#b"; "%#o"; "%#x"; "%#X";
"%+i"; "%#+b"; "%#+o"; "%#+x"; "%#+X";
"%+0i"; "%#+0b"; "%#+0o"; "%#+0x"; "%#+0X";
] in
let numbers =
let (+) = Z.add in
let l = [p30; p62; p30 + p62; p300; p120; p121] in
(l @ (List.map Z.neg l))
in
List.iter
(fun fmt ->
assert
(
List.for_all
(fun x -> round_trip fmt x)
numbers
)
)
formats
in
let fail d f x =
try
let s = f x in
Printf.printf "%s should fail on %s. Got %s\n" d x (Q.to_string s)
with _ -> ()
in
let succ d f x y =
try
let z = f x in
if Q.equal z y
then ()
else
Printf.printf
"%s(%s) returned %s, expected %s\n"
d
x
(Q.to_string z)
(Q.to_string y)
with exc ->
Printf.printf "%s failed. Expected %s. Got %s\n" d (Q.to_string y)
(Printexc.to_string exc)
in
let q_and_float_agree s =
let f = try Some (float_of_string s) with _ -> None in
let q = try Some (Q.of_string s) with _ -> None in
match f,q with
| None, None -> ()
| Some f, Some q ->
if not ((Q.to_float q) = f)
then
Printf.printf
"Q.of_string (%s) returned %s, expected %s\n"
s
(Q.to_string q)
(string_of_float f)
| Some f, None ->
Printf.printf
"Q.of_string (%s) failed, expected %s\n"
s
(string_of_float f)
| None, Some q ->
Printf.printf
"Q.of_string (%s) returned %s, failure expected"
s
(Q.to_string q)
in
round_trip_Q ();
fail "Q.of_string" Q.of_string "0b2";
fail "Q.of_string" Q.of_string "0o8";
fail "Q.of_string" Q.of_string "0xg";
fail "Q.of_string" Q.of_string "0xG";
fail "Q.of_string" Q.of_string "0A";
succ "Q.of_string" Q.of_string "" Q.zero;
succ "Q.of_string" Q.of_string "+" Q.zero;
succ "Q.of_string" Q.of_string "-" Q.zero;
succ "Q.of_string" Q.of_string "0x" Q.zero;
succ "Q.of_string" Q.of_string "0X" Q.zero;
succ "Q.of_string" Q.of_string "0o" Q.zero;
succ "Q.of_string" Q.of_string "0O" Q.zero;
succ "Q.of_string" Q.of_string "0b" Q.zero;
succ "Q.of_string" Q.of_string "0B" Q.zero;
succ "Q.of_string" Q.of_string "0b101" (Q.of_string "5");
succ "Q.of_string" Q.of_string "0B101" (Q.of_string "5");
succ "Q.of_string" Q.of_string "0o101" (Q.of_string "65");
succ "Q.of_string" Q.of_string "0O101" (Q.of_string "65");
fail "Q.of_string" Q.of_string "0b2";
fail "Q.of_string" Q.of_string "0o8";
fail "Q.of_string" Q.of_string "0xg";
fail "Q.of_string" Q.of_string "0xG";
fail "Q.of_string" Q.of_string "0A";
fail "Q.of_string" Q.of_string "-0b0.1e1";
fail "Q.of_string" Q.of_string "-0o0.1E1";
fail "Q.of_string" Q.of_string "-0b0.1P1";
fail "Q.of_string" Q.of_string "-0o0.1p1";
fail "Q.of_string" Q.of_string "-0.1P1";
fail "Q.of_string" Q.of_string "-0.1p1";
succ "Q.of_string" Q.of_string "0x1e2" (Q.of_int 482);
succ "Q.of_string" Q.of_string "1e2" (Q.of_int 100);
succ "Q.of_string" Q.of_string "+" Q.zero;
succ "Q.of_string" Q.of_string "-+" Q.zero;
succ "Q.of_string" Q.of_string "-1" Q.minus_one;
succ "Q.of_string" Q.of_string "+0xFF.8" (Q.of_float 255.5);
succ "Q.of_string" Q.of_string "+0xff.8" (Q.of_float 255.5);
succ "Q.of_string" Q.of_string "-0xFF.8" (Q.of_float (-255.5));
succ "Q.of_string" Q.of_string "-0xff.8" (Q.of_float (-255.5));
succ "Q.of_string" Q.of_string "-0.1e1" (Q.of_float (float_of_string "-0.1e1")) ;
succ "Q.of_string" Q.of_string "-0.1E1" (Q.of_float (float_of_string "-0.1E1")) ;
succ "Q.of_string" Q.of_string "-0x0.1P1" (Q.of_float (float_of_string "-0x0.1P1")) ;
succ "Q.of_string" Q.of_string "-0x0.1p1" (Q.of_float (float_of_string "-0x0.1p1")) ;
succ "Q.of_string" Q.of_string "6.674e-11" (Q.of_string "0.00000000006674") ;
q_and_float_agree "-0x0.1p1" ;
q_and_float_agree "-0x0.1P1" ;
q_and_float_agree "-0x0.1p10" ;
q_and_float_agree "-0x0.1p10" ;
q_and_float_agree "1_2.34e03";
q_and_float_agree "12_.34e03";
q_and_float_agree "12._34e03";
q_and_float_agree "12.3_4e03";
q_and_float_agree "12.34_e03";
(* float_of_string accept leading underscores after ( 'e' | 'E'), Q does not. *)
(* q_and_float_agree "12.34e_03"; *)
q_and_float_agree "12.34e0_3";
q_and_float_agree "12.34e03_";
q_and_float_agree "000_001";
q_and_float_agree "001_000";
q_and_float_agree "123.";
(* underscores right after dot are accepted. *)
q_and_float_agree "1._001";
q_and_float_agree "._001";
(* float_of_string doesn't accept strings without digits, Q and Z do (e.g. "+", "-", "0x", "." *)
(* q_and_float_agree "."; *)
(* q_and_float_agree "._"; *)
q_and_float_agree "0.x00a";
q_and_float_agree ".-001";
()
let _ = test_of_string_Q ()

65
unikernel/duniverse/Zarith/tests/pi.ml Normal file
View file

@ -0,0 +1,65 @@
(* Pi digits computed with the streaming algorithm given on pages 4, 6
& 7 of "Unbounded Spigot Algorithms for the Digits of Pi", Jeremy
Gibbons, August 2004. *)
open Printf
let zero = Z.zero
and one = Z.one
and three = Z.of_int 3
and four = Z.of_int 4
and ten = Z.of_int 10
and neg_ten = Z.of_int (-10)
;;
(* Linear Fractional (aka M=F6bius) Transformations *)
module LFT = struct
let floor_ev (q, r, s, t) x =
Z.((q * x + r) / (s * x + t))
let unit = (one, zero, zero, one)
let comp (q, r, s, t) (q', r', s', t') =
Z.(q * q' + r * s', q * r' + r * t',
s * q' + t * s', s * r' + t * t')
end
let next z = LFT.floor_ev z three
let safe z n = (n = LFT.floor_ev z four)
let prod z n = LFT.comp (ten, Z.(neg_ten * n), zero, one) z
let cons z k =
let den = 2 * k + 1 in
LFT.comp z (Z.of_int k, Z.of_int (2 * den), zero, Z.of_int den)
let rec digit k z n row col =
if n > 0 then
let y = next z in
if safe z y then
if col = 10 then (
let row = row + 10 in
printf "\t:%i\n%a" row Z.output y;
digit k (prod z y) (n - 1) row 1
)
else (
printf "%a" Z.output y;
digit k (prod z y) (n - 1) row (col + 1)
)
else digit (k + 1) (cons z k) n row col
else
printf "%*s\t:%i\n" (10 - col) "" (row + col)
let digits n = digit 1 LFT.unit n 0 0
let usage () =
prerr_endline "Usage: pi <number of digits to compute for pi>";
exit 2
let _ =
let args = Sys.argv in
if Array.length args <> 2 then usage () else
digits (int_of_string Sys.argv.(1))

50
unikernel/duniverse/Zarith/tests/pi.output Normal file
View file

@ -0,0 +1,50 @@
3141592653 :10
5897932384 :20
6264338327 :30
9502884197 :40
1693993751 :50
0582097494 :60
4592307816 :70
4062862089 :80
9862803482 :90
5342117067 :100
9821480865 :110
1328230664 :120
7093844609 :130
5505822317 :140
2535940812 :150
8481117450 :160
2841027019 :170
3852110555 :180
9644622948 :190
9549303819 :200
6442881097 :210
5665933446 :220
1284756482 :230
3378678316 :240
5271201909 :250
1456485669 :260
2346034861 :270
0454326648 :280
2133936072 :290
6024914127 :300
3724587006 :310
6063155881 :320
7488152092 :330
0962829254 :340
0917153643 :350
6789259036 :360
0011330530 :370
5488204665 :380
2138414695 :390
1941511609 :400
4330572703 :410
6575959195 :420
3092186117 :430
3819326117 :440
9310511854 :450
8074462379 :460
9627495673 :470
5188575272 :480
4891227938 :490
1830119491 :500

27
unikernel/duniverse/Zarith/tests/setround.c Normal file
View file

@ -0,0 +1,27 @@
/* Auxiliary function to control FP rounding mode. Assumes ISO C99. */
#include <fenv.h>
#include <caml/mlvalues.h>
#ifndef FE_DOWNWARD
#define FE_DOWNWARD (-1)
#endif
#ifndef FE_TONEAREST
#define FE_TONEAREST (-1)
#endif
#ifndef FE_TOWARDZERO
#define FE_TOWARDZERO (-1)
#endif
#ifndef FE_UPWARD
#define FE_UPWARD (-1)
#endif
static int modes[4] = {
FE_DOWNWARD, FE_TONEAREST, FE_TOWARDZERO, FE_UPWARD
};
CAMLprim value caml_ztest_setround(value vmode)
{
int rc = fesetround(modes[Int_val(vmode)]);
return Val_bool(rc == 0);
}

154
unikernel/duniverse/Zarith/tests/timings.ml Normal file
View file

@ -0,0 +1,154 @@
open Printf
(* Timing harness harness *)
let time fn arg =
let start = Sys.time() in
let rec time accu =
let qty = fn arg in
let duration = Sys.time() -. start in
let qty = float qty in
if duration >= 1.0
then duration /. (accu +. qty)
else time (accu +. qty)
in time 0.0
let time_repeat rep fn arg =
time (fun () -> for i = 1 to rep do ignore (fn arg) done; rep) ()
(* Basic arithmetic operations *)
let add (x, y) =
for i = 1 to 50_000_000 do
ignore (Sys.opaque_identity (Z.add x y))
done;
50_000_000
let sub (x, y) =
for i = 1 to 50_000_000 do
ignore (Sys.opaque_identity (Z.sub x y))
done;
50_000_000
let mul (x, y) =
for i = 1 to 50_000_000 do
ignore (Sys.opaque_identity (Z.mul x y))
done;
50_000_000
let div (x, y) =
for i = 1 to 10_000_000 do
ignore (Sys.opaque_identity (Z.div x y))
done;
1_000_000
let shl (x, y) =
for i = 1 to 50_000_000 do
ignore (Sys.opaque_identity (Z.shift_left x y))
done;
50_000_000
let big = Z.pow (Z.of_int 17) 150
let med = Z.pow (Z.of_int 3) 150
let _ =
printf "%.2e add (small, no overflow)\n%!"
(time add (Z.of_int 1, Z.of_int 2));
printf "%.2e add (small, overflow)\n%!"
(time add (Z.of_int max_int, Z.of_int 2));
printf "%.2e add (small, big)\n%!"
(time add (Z.of_int 1, big));
printf "%.2e add (big, big)\n%!"
(time add (big, big));
printf "%.2e sub (small, no overflow)\n%!"
(time sub (Z.of_int 1, Z.of_int 2));
printf "%.2e sub (small, overflow)\n%!"
(time sub (Z.of_int max_int, Z.of_int (-2)));
printf "%.2e sub (big, small)\n%!"
(time sub (big, Z.of_int 1));
printf "%.2e sub (big, big)\n%!"
(time sub (big, big));
printf "%.2e mul (small, no overflow)\n%!"
(time mul (Z.of_int 42, Z.of_int 74));
printf "%.2e mul (small, overflow)\n%!"
(time mul (Z.of_int max_int, Z.of_int 3));
printf "%.2e mul (small, big)\n%!"
(time mul (Z.of_int 3, big));
printf "%.2e mul (medium, medium)\n%!"
(time mul (med, med));
printf "%.2e mul (big, big)\n%!"
(time mul (big, big));
printf "%.2e div (small, small)\n%!"
(time div (Z.of_int 12345678, Z.of_int 443));
printf "%.2e div (big, small)\n%!"
(time div (big, Z.of_int 443));
printf "%.2e div (big, medium)\n%!"
(time div (big, med));
printf "%.2e shl (small, no overflow)\n%!"
(time shl (Z.of_int 3, 10));
printf "%.2e shl (small, overflow)\n%!"
(time shl (Z.of_int max_int, 2));
printf "%.2e shl (big)\n%!"
(time shl (big, 42))
(* Factorial *)
let rec fact_z n =
if n <= 0 then Z.one else Z.mul (Z.of_int n) (fact_z (n-1))
let _ =
printf "%.2e fact 10\n%!"
(time_repeat 1_000_000 fact_z 10);
printf "%.2e fact 40\n%!"
(time_repeat 10_000 fact_z 40);
printf "%.2e fact 200\n%!"
(time_repeat 10_000 fact_z 200)
(* Fibonacci *)
let rec fib_int n =
if n < 2 then 1 else fib_int(n-1) + fib_int(n-2)
let rec fib_natint n =
if n < 2 then 1n else Nativeint.add (fib_natint(n-1)) (fib_natint(n-2))
let rec fib_z n =
if n < 2 then Z.one else Z.add (fib_z(n-1)) (fib_z(n-2))
let fib_arg = 32
let _ =
printf "%.2e fib (int)\n%!"
(time_repeat 100 fib_int fib_arg);
printf "%.2e fib (nativeint)\n%!"
(time_repeat 100 fib_natint fib_arg);
printf "%.2e fib (Z)\n%!"
(time_repeat 100 fib_z fib_arg)
(* Takeushi *)
let rec tak_int (x, y, z) =
if x > y
then tak_int(tak_int (x-1, y, z), tak_int (y-1, z, x), tak_int (z-1, x, y))
else z
let rec tak_natint (x, y, z) =
if x > y
then tak_natint(tak_natint (Nativeint.sub x 1n, y, z),
tak_natint (Nativeint.sub y 1n, z, x),
tak_natint (Nativeint.sub z 1n, x, y))
else z
let rec tak_z (x, y, z) =
if Z.compare x y > 0
then tak_z(tak_z (Z.pred x, y, z),
tak_z (Z.pred y, z, x),
tak_z (Z.pred z, x, y))
else z
let _ =
printf "%.2e tak (int)\n%!"
(time_repeat 1000 tak_int (18,12,6));
printf "%.2e tak (nativeint)\n%!"
(time_repeat 1000 tak_natint (18n,12n,6n));
printf "%.2e tak (Z)\n%!"
(time_repeat 1000 tak_z (Z.of_int 18, Z.of_int 12, Z.of_int 6))

134
unikernel/duniverse/Zarith/tests/tofloat.ml Normal file
View file

@ -0,0 +1,134 @@
(* Testing Z.to_float *)
open Printf
type rounding_mode =
FE_DOWNWARD | FE_TONEAREST | FE_TOWARDZERO | FE_UPWARD
external setround: rounding_mode -> bool = "caml_ztest_setround"
external format_float: string -> float -> string = "caml_format_float"
let hex_of_float f = format_float "%a" f
(* For testing, we use randomly-generated integers of the form
<signed 64-bit integer> * 2^<exponent>
We can predict their FP value by converting the integer part to FP,
then scale by the exponent using ldexp. *)
let test1 (mant: int64) (exp: int) =
let expected = ldexp (Int64.to_float mant) exp in
let actual = Z.to_float (Z.shift_left (Z.of_int64 mant) exp) in
if actual = expected then true else begin
printf "%Ld * 2^%d: expected %s, got %s\n"
mant exp (hex_of_float expected) (hex_of_float actual);
false
end
let rnd64 () =
let m1 = Random.bits() in (* 30 bits *)
let m2 = Random.bits() in (* 30 bits *)
let m3 = Random.bits() in
Int64.(logor (of_int m1)
(logor (shift_left (of_int m2) 30)
(shift_left (of_int m3) 60)))
let testN numrounds =
printf " (%d tests)... %!" numrounds;
let errors = ref 0 in
(* Some random int64 values *)
for i = 1 to numrounds do
let m = Random.int64 Int64.max_int in
if not (test1 m 0) then incr errors;
if not (test1 (Int64.neg m) 0) then incr errors
done;
(* Some random int64 values scaled by some random power of 2 *)
for i = 1 to numrounds do
let m = rnd64() in
let exp = Random.int 1100 in (* sometimes +inf will result *)
if not (test1 m exp) then incr errors
done;
(* Special test close to a rounding point *)
for i = 0 to 15 do
let m = Int64.(add 0xfffffffffffff0L (of_int i)) in
if not (test1 m 32) then incr errors;
if not (test1 (Int64.neg m) 32) then incr errors
done;
if !errors = 0
then printf "passed\n%!"
else printf "FAILED (%d errors)\n%!" !errors
let testQ1 (mant1: int64) (exp1: int) (mant2: int64) (exp2: int) =
let expected =
ldexp (Int64.to_float mant1) exp1 /. ldexp (Int64.to_float mant2) exp2 in
let actual =
Q.to_float (Q.make (Z.shift_left (Z.of_int64 mant1) exp1)
(Z.shift_left (Z.of_int64 mant2) exp2)) in
if compare actual expected = 0 then true else begin
printf "%Ld * 2^%d / %Ld * 2^%d : expected %s, got %s\n"
mant1 exp1 mant2 exp2 (hex_of_float expected) (hex_of_float actual);
false
end
let testQN numrounds =
printf " (%d tests)... %!" numrounds;
let errors = ref 0 in
(* Some special values *)
if not (testQ1 0L 0 1L 0) then incr errors;
if not (testQ1 1L 0 0L 0) then incr errors;
if not (testQ1 (-1L) 0 0L 0) then incr errors;
if not (testQ1 0L 0 0L 0) then incr errors;
(* Some random fractions *)
for i = 1 to numrounds do
let m1 = Random.int64 0x20000000000000L in
let m1 = if Random.bool() then m1 else Int64.neg m1 in
let exp1 = Random.int 500 in
let m2 = Random.int64 0x20000000000000L in
let exp2 = Random.int 500 in
if not (testQ1 m1 exp1 m2 exp2) then incr errors
done;
if !errors = 0
then printf "passed\n%!"
else printf "FAILED (%d errors)\n%!" !errors
let _ =
let numrounds =
if Array.length Sys.argv >= 2
then int_of_string Sys.argv.(1)
else 100_000 in
printf "Default rounding mode (Z)";
testN numrounds;
printf "Default rounding mode (Q)";
testQN numrounds;
if setround FE_TOWARDZERO then begin
printf "Round toward zero (Z)";
testN numrounds;
printf "Round toward zero (Q)";
testQN numrounds
end else begin
printf "Round toward zero not supported, skipping\n"
end;
if setround FE_DOWNWARD then begin
printf "Round downward (Z)";
testN numrounds;
printf "Round downward (Q)";
testQN numrounds
end else begin
printf "Round downward not supported, skipping\n"
end;
if setround FE_UPWARD then begin
printf "Round upward (Z)";
testN numrounds;
printf "Round upward (Q)";
testQN numrounds
end else begin
printf "Round upward not supported, skipping\n"
end;
if setround FE_TONEAREST then begin
printf "Round to nearest (Z)";
testN numrounds;
printf "Round to nearest (Q)";
testQN numrounds
end else begin
printf "Round to nearest not supported, skipping\n"
end

35
unikernel/duniverse/Zarith/tests/tst_extract.ml Normal file
View file

@ -0,0 +1,35 @@
module I = Z
let pr ch x =
output_string ch (I.to_string x);
flush ch
let chk_extract x o l =
let expected =
I.logand (I.shift_right x o) (I.pred (I.shift_left (I.of_int 1) l))
and actual =
I.extract x o l in
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")
let doit () =
let max = 128 in
for l = 1 to max do
if l mod 16 == 0 then Printf.printf "%i/%i\n%!" l max;
for o = 0 to 256 do
for n = 0 to 256 do
let x = I.shift_left I.one n in
chk_extract x o l;
chk_extract (I.mul x x) o l;
chk_extract (I.mul x (I.mul x x)) o l;
chk_extract (I.succ x) o l;
chk_extract (I.pred x) o l;
chk_extract (I.neg (I.mul x x)) o l;
chk_extract (I.neg (I.mul x (I.mul x x))) o l;
chk_extract (I.neg x) o l;
chk_extract (I.neg (I.succ x)) o l;
chk_extract (I.neg (I.pred x)) o l;
done
done
done
let _ = doit ()

920
unikernel/duniverse/Zarith/tests/zq.ml Normal file
View file

@ -0,0 +1,920 @@
(* Simple tests for the Z and Q modules.
This file is part of the Zarith library
http://forge.ocamlcore.org/projects/zarith .
It is distributed under LGPL 2 licensing, with static linking exception.
See the LICENSE file included in the distribution.
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
a joint laboratory by:
CNRS (Centre national de la recherche scientifique, France),
ENS (École normale supérieure, Paris, France),
INRIA Rocquencourt (Institut national de recherche en informatique, France).
*)
(* testing Z *)
module I = Z
let pr ch x =
output_string ch (I.to_string x);
flush ch
let pr2 ch (x,y) =
Printf.fprintf ch "%s, %s" (I.to_string x) (I.to_string y);
flush ch
let pr3 ch (x,y,z) =
Printf.fprintf ch "%s, %s, %s"
(I.to_string x) (I.to_string y) (I.to_string z);
flush ch
let prfloat ch (x,y : float * float) =
if x = y then
Printf.fprintf ch "OK"
else
Printf.fprintf ch "WRONG! (expected %g, got %g)" y x
let prmarshal ch (x,y : I.t * I.t) =
(if I.equal x y then
Printf.fprintf ch "OK"
else
Printf.fprintf ch "WRONG! (expected %a, got %a)" pr y pr x);
flush ch
let pow2 n =
let rec doit acc n =
if n<=0 then acc else doit (I.add acc acc) (n-1)
in
doit I.one n
let fact n =
let rec doit acc n =
if n<=1 then acc
else doit (I.mul acc (I.of_int n)) (n-1)
in
doit I.one n
let pow a b =
let rec doit b =
if b <= 0 then I.one else
let acc = doit (b lsr 1) in
if b land 1 = 1 then I.mul (I.mul acc acc) (I.of_int a)
else I.mul acc acc
in
doit b
let cvt_int x =
(string_of_bool (I.fits_int x))
^","^
(try string_of_int (I.to_int x) with I.Overflow -> "ovf")
let cvt_int32 x =
(string_of_bool (I.fits_int32 x))
^","^
(try Int32.to_string (I.to_int32 x) with I.Overflow -> "ovf")
let cvt_int64 x =
(string_of_bool (I.fits_int64 x))
^","^
(try Int64.to_string (I.to_int64 x) with I.Overflow -> "ovf")
let cvt_nativeint x =
(string_of_bool (I.fits_nativeint x))
^","^
(try Nativeint.to_string (I.to_nativeint x) with I.Overflow -> "ovf")
let cvt_int32_unsigned x =
(string_of_bool (I.fits_int32_unsigned x))
^","^
(try Int32.to_string (I.to_int32_unsigned x) with I.Overflow -> "ovf")
let cvt_int64_unsigned x =
(string_of_bool (I.fits_int64_unsigned x))
^","^
(try Int64.to_string (I.to_int64_unsigned x) with I.Overflow -> "ovf")
let cvt_nativeint_unsigned x =
(string_of_bool (I.fits_nativeint_unsigned x))
^","^
(try Nativeint.to_string (I.to_nativeint_unsigned x) with I.Overflow -> "ovf")
let p2 = I.of_int 2
let p3 = I.of_int 3
let p30 = pow2 30
let p62 = pow2 62
let p300 = pow2 300
let p120 = pow2 120
let p121 = pow2 121
let maxi = I.of_int max_int
let mini = I.of_int min_int
let maxi32 = I.of_int32 Int32.max_int
let mini32 = I.of_int32 Int32.min_int
let maxi64 = I.of_int64 Int64.max_int
let mini64 = I.of_int64 Int64.min_int
let maxni = I.of_nativeint Nativeint.max_int
let minni = I.of_nativeint Nativeint.min_int
let chk_bits x =
Printf.printf "to_bits %a\n =" pr x;
String.iter (fun c -> Printf.printf " %02x" (Char.code c)) (I.to_bits x);
Printf.printf "\n";
assert(I.equal (I.abs x) (I.of_bits (I.to_bits x)));
assert((I.to_bits x) = (I.to_bits (I.neg x)));
Printf.printf "marshal round trip %a\n =" pr x;
let y = Marshal.(from_string (to_string x []) 0) in
Printf.printf " %a\n" prmarshal (y, x)
let chk_extract (x, o, l) =
let expected =
I.logand (I.shift_right x o) (I.pred (I.shift_left (I.of_int 1) l))
and actual =
I.extract x o l in
Printf.printf "extract %a %d %d = %a " pr x o l pr actual;
if I.equal actual expected
then Printf.printf "(passed)\n"
else Printf.printf "(FAILED, expected %a)\n" pr expected
let chk_signed_extract (x, o, l) =
let uns_res = I.extract x o l in
let expected =
if I.compare uns_res (I.shift_left (I.of_int 1) (l-1)) >= 0
then I.sub uns_res (I.shift_left (I.of_int 1) l)
else uns_res in
let actual =
I.signed_extract x o l in
Printf.printf "signed_extract %a %d %d = %a " pr x o l pr actual;
if I.equal actual expected
then Printf.printf "(passed)\n"
else Printf.printf "(FAILED, expected %a)\n" pr expected
let chk_numbits_tz x =
Printf.printf "numbits / trailing_zeros %a " pr x;
let n = I.numbits x and z = I.trailing_zeros x in
if
if I.equal x I.zero then
n = 0 && z = max_int
else
n > 0 && z >= 0 && z < n
&& I.leq (I.shift_left I.one (n-1)) (I.abs x)
&& I.lt (I.abs x) (I.shift_left I.one n)
&& (z = 0 || I.equal (I.extract x 0 z) I.zero)
&& I.testbit x z
then Printf.printf "(passed)\n"
else Printf.printf "(FAILED)\n"
let chk_testbit x =
Printf.printf "testbit %a " pr x;
let n = I.numbits x in
let ok = ref true in
for i = 0 to n + 64 do
let actual = I.testbit x i
and expected = I.extract x i 1 in
if not (I.equal expected (if actual then I.one else I.zero))
then begin Printf.printf "(error on %d) " i; ok := false end
done;
if !ok
then Printf.printf "(passed)\n"
else Printf.printf "(FAILED)\n"
let pr_byte =
let state = ref 0 in
fun () ->
state := (!state * 65793 + 4282663) land 0xFF_FF_FF;
!state lsr 16
let pr_bytes buf pos len =
for i = pos to pos + len - 1 do
Bytes.set_uint8 buf i (pr_byte ())
done
let test_Z() =
Printf.printf "0\n = %a\n" pr I.zero;
Printf.printf "1\n = %a\n" pr I.one;
Printf.printf "-1\n = %a\n" pr I.minus_one;
Printf.printf "42\n = %a\n" pr (I.of_int 42);
Printf.printf "1+1\n = %a\n" pr (I.add I.one I.one);
Printf.printf "1-1\n = %a\n" pr (I.sub I.one I.one);
Printf.printf "- 1\n = %a\n" pr (I.neg I.one);
Printf.printf "0-1\n = %a\n" pr (I.sub I.zero I.one);
Printf.printf "max_int\n = %a\n" pr maxi;
Printf.printf "min_int\n = %a\n" pr mini;
Printf.printf "-max_int\n = %a\n" pr (I.neg maxi);
Printf.printf "-min_int\n = %a\n" pr (I.neg mini);
Printf.printf "2^300\n = %a\n" pr p300;
Printf.printf "2^120\n = %a\n" pr p120;
Printf.printf "2^300+2^120\n = %a\n" pr (I.add p300 p120);
Printf.printf "2^300-2^120\n = %a\n" pr (I.sub p300 p120);
Printf.printf "2^300+(-(2^120))\n = %a\n" pr (I.add p300 (I.neg p120));
Printf.printf "2^120-2^300\n = %a\n" pr (I.sub p120 p300);
Printf.printf "2^120+(-(2^300))\n = %a\n" pr (I.add p120 (I.neg p300));
Printf.printf "-(2^120)+(-(2^300))\n = %a\n" pr (I.add (I.neg p120) (I.neg p300));
Printf.printf "-(2^120)-2^300\n = %a\n" pr (I.sub (I.neg p120) p300);
Printf.printf "2^300-2^300\n = %a\n" pr (I.sub p300 p300);
Printf.printf "2^121\n = %a\n" pr p121;
Printf.printf "2^121+2^120\n = %a\n" pr (I.add p121 p120);
Printf.printf "2^121-2^120\n = %a\n" pr (I.sub p121 p120);
Printf.printf "2^121+(-(2^120))\n = %a\n" pr (I.add p121 (I.neg p120));
Printf.printf "2^120-2^121\n = %a\n" pr (I.sub p120 p121);
Printf.printf "2^120+(-(2^121))\n = %a\n" pr (I.add p120 (I.neg p121));
Printf.printf "-(2^120)+(-(2^121))\n = %a\n" pr (I.add (I.neg p120) (I.neg p121));
Printf.printf "-(2^120)-2^121\n = %a\n" pr (I.sub (I.neg p120) p121);
Printf.printf "2^121+0\n = %a\n" pr (I.add p121 I.zero);
Printf.printf "2^121-0\n = %a\n" pr (I.sub p121 I.zero);
Printf.printf "0+2^121\n = %a\n" pr (I.add I.zero p121);
Printf.printf "0-2^121\n = %a\n" pr (I.sub I.zero p121);
Printf.printf "2^300+1\n = %a\n" pr (I.add p300 I.one);
Printf.printf "2^300-1\n = %a\n" pr (I.sub p300 I.one);
Printf.printf "1+2^300\n = %a\n" pr (I.add I.one p300);
Printf.printf "1-2^300\n = %a\n" pr (I.sub I.one p300);
Printf.printf "2^300+(-1)\n = %a\n" pr (I.add p300 I.minus_one);
Printf.printf "2^300-(-1)\n = %a\n" pr (I.sub p300 I.minus_one);
Printf.printf "(-1)+2^300\n = %a\n" pr (I.add I.minus_one p300);
Printf.printf "(-1)-2^300\n = %a\n" pr (I.sub I.minus_one p300);
Printf.printf "-(2^300)+1\n = %a\n" pr (I.add (I.neg p300) I.one);
Printf.printf "-(2^300)-1\n = %a\n" pr (I.sub (I.neg p300) I.one);
Printf.printf "1+(-(2^300))\n = %a\n" pr (I.add I.one (I.neg p300));
Printf.printf "1-(-(2^300))\n = %a\n" pr (I.sub I.one (I.neg p300));
Printf.printf "-(2^300)+(-1)\n = %a\n" pr (I.add (I.neg p300) I.minus_one);
Printf.printf "-(2^300)-(-1)\n = %a\n" pr (I.sub (I.neg p300) I.minus_one);
Printf.printf "(-1)+(-(2^300))\n = %a\n" pr (I.add I.minus_one (I.neg p300));
Printf.printf "(-1)-(-(2^300))\n = %a\n" pr (I.sub I.minus_one (I.neg p300));
Printf.printf "max_int+1\n = %a\n" pr (I.add maxi I.one);
Printf.printf "min_int-1\n = %a\n" pr (I.sub mini I.one);
Printf.printf "-max_int-1\n = %a\n" pr (I.sub (I.neg maxi) I.one);
Printf.printf "-min_int-1\n = %a\n" pr (I.sub (I.neg mini) I.one);
Printf.printf "5! = %a\n" pr (fact 5);
Printf.printf "12! = %a\n" pr (fact 12);
Printf.printf "15! = %a\n" pr (fact 15);
Printf.printf "20! = %a\n" pr (fact 20);
Printf.printf "25! = %a\n" pr (fact 25);
Printf.printf "50! = %a\n" pr (fact 50);
Printf.printf "2^300*2^120\n = %a\n" pr (I.mul p300 p120);
Printf.printf "2^120*2^300\n = %a\n" pr (I.mul p120 p300);
Printf.printf "2^300*(-(2^120))\n = %a\n" pr (I.mul p300 (I.neg p120));
Printf.printf "2^120*(-(2^300))\n = %a\n" pr (I.mul p120 (I.neg p300));
Printf.printf "-(2^120)*(-(2^300))\n = %a\n" pr (I.mul (I.neg p120) (I.neg p300));
Printf.printf "2^121*2^120\n = %a\n" pr (I.mul p121 p120);
Printf.printf "2^120*2^121\n = %a\n" pr (I.mul p120 p121);
Printf.printf "2^121*0\n = %a\n" pr (I.mul p121 I.zero);
Printf.printf "0*2^121\n = %a\n" pr (I.mul I.zero p121);
Printf.printf "2^300*1\n = %a\n" pr (I.mul p300 I.one);
Printf.printf "1*2^300\n = %a\n" pr (I.mul I.one p300);
Printf.printf "2^300*(-1)\n = %a\n" pr (I.mul p300 I.minus_one);
Printf.printf "(-1)*2^300\n = %a\n" pr (I.mul I.minus_one p300);
Printf.printf "-(2^300)*1\n = %a\n" pr (I.mul (I.neg p300) I.one);
Printf.printf "1*(-(2^300))\n = %a\n" pr (I.mul I.one (I.neg p300));
Printf.printf "-(2^300)*(-1)\n = %a\n" pr (I.mul (I.neg p300) I.minus_one);
Printf.printf "(-1)*(-(2^300))\n = %a\n" pr (I.mul I.minus_one (I.neg p300));
Printf.printf "1*(2^30)\n = %a\n" pr (I.mul I.one p30);
Printf.printf "1*(2^62)\n = %a\n" pr (I.mul I.one p62);
Printf.printf "(2^30)*(2^30)\n = %a\n" pr (I.mul p30 p30);
Printf.printf "(2^62)*(2^62)\n = %a\n" pr (I.mul p62 p62);
Printf.printf "0+1\n = %a\n" pr (I.succ I.zero);
Printf.printf "1+1\n = %a\n" pr (I.succ I.one);
Printf.printf "-1+1\n = %a\n" pr (I.succ I.minus_one);
Printf.printf "2+1\n = %a\n" pr (I.succ p2);
Printf.printf "-2+1\n = %a\n" pr (I.succ (I.neg p2));
Printf.printf "(2^300)+1\n = %a\n" pr (I.succ p300);
Printf.printf "-(2^300)+1\n = %a\n" pr (I.succ (I.neg p300));
Printf.printf "0-1\n = %a\n" pr (I.pred I.zero);
Printf.printf "1-1\n = %a\n" pr (I.pred I.one);
Printf.printf "-1-1\n = %a\n" pr (I.pred I.minus_one);
Printf.printf "2-1\n = %a\n" pr (I.pred p2);
Printf.printf "-2-1\n = %a\n" pr (I.pred (I.neg p2));
Printf.printf "(2^300)-1\n = %a\n" pr (I.pred p300);
Printf.printf "-(2^300)-1\n = %a\n" pr (I.pred (I.neg p300));
Printf.printf "max_int+1\n = %a\n" pr (I.succ maxi);
Printf.printf "min_int-1\n = %a\n" pr (I.pred mini);
Printf.printf "-max_int-1\n = %a\n" pr (I.pred (I.neg maxi));
Printf.printf "-min_int-1\n = %a\n" pr (I.pred (I.neg mini));
Printf.printf "abs(0)\n = %a\n" pr (I.abs I.zero);
Printf.printf "abs(1)\n = %a\n" pr (I.abs I.one);
Printf.printf "abs(-1)\n = %a\n" pr (I.abs I.minus_one);
Printf.printf "abs(min_int)\n = %a\n" pr (I.abs mini);
Printf.printf "abs(2^300)\n = %a\n" pr (I.abs p300);
Printf.printf "abs(-(2^300))\n = %a\n" pr (I.abs (I.neg p300));
Printf.printf "max_nativeint\n = %a\n" pr maxni;
Printf.printf "max_int32\n = %a\n" pr maxi32;
Printf.printf "max_int64\n = %a\n" pr maxi64;
Printf.printf "to_int 1\n = %s\n" (cvt_int I.one);
Printf.printf "to_int max_int\n = %s\n" (cvt_int maxi);
Printf.printf "to_int max_nativeint\n = %s\n" (cvt_int maxni);
Printf.printf "to_int max_int32\n = %s\n" (cvt_int maxi32);
Printf.printf "to_int max_int64\n = %s\n" (cvt_int maxi64);
Printf.printf "to_int32 1\n = %s\n" (cvt_int32 I.one);
Printf.printf "to_int32 max_int\n = %s\n" (cvt_int32 maxi);
Printf.printf "to_int32 max_nativeint\n = %s\n" (cvt_int32 maxni);
Printf.printf "to_int32 max_int32\n = %s\n" (cvt_int32 maxi32);
Printf.printf "to_int32 max_int64\n = %s\n" (cvt_int32 maxi64);
Printf.printf "to_int64 1\n = %s\n" (cvt_int64 I.one);
Printf.printf "to_int64 max_int\n = %s\n" (cvt_int64 maxi);
Printf.printf "to_int64 max_nativeint\n = %s\n" (cvt_int64 maxni);
Printf.printf "to_int64 max_int32\n = %s\n" (cvt_int64 maxi32);
Printf.printf "to_int64 max_int64\n = %s\n" (cvt_int64 maxi64);
Printf.printf "to_nativeint 1\n = %s\n" (cvt_nativeint I.one);
Printf.printf "to_nativeint max_int\n = %s\n" (cvt_nativeint maxi);
Printf.printf "to_nativeint max_nativeint\n = %s\n" (cvt_nativeint maxni);
Printf.printf "to_nativeint max_int32\n = %s\n" (cvt_nativeint maxi32);
Printf.printf "to_nativeint max_int64\n = %s\n" (cvt_nativeint maxi64);
Printf.printf "to_int -min_int\n = %s\n" (cvt_int (I.neg mini));
Printf.printf "to_int -min_nativeint\n = %s\n" (cvt_int (I.neg minni));
Printf.printf "to_int -min_int32\n = %s\n" (cvt_int (I.neg mini32));
Printf.printf "to_int -min_int64\n = %s\n" (cvt_int (I.neg mini64));
Printf.printf "to_int32 -min_int\n = %s\n" (cvt_int32 (I.neg mini));
Printf.printf "to_int32 -min_nativeint\n = %s\n" (cvt_int32 (I.neg minni));
Printf.printf "to_int32 -min_int32\n = %s\n" (cvt_int32 (I.neg mini32));
Printf.printf "to_int32 -min_int64\n = %s\n" (cvt_int32(I.neg mini64));
Printf.printf "to_int64 -min_int\n = %s\n" (cvt_int64 (I.neg mini));
Printf.printf "to_int64 -min_nativeint\n = %s\n" (cvt_int64 (I.neg minni));
Printf.printf "to_int64 -min_int32\n = %s\n" (cvt_int64 (I.neg mini32));
Printf.printf "to_int64 -min_int64\n = %s\n" (cvt_int64 (I.neg mini64));
Printf.printf "to_nativeint -min_int\n = %s\n" (cvt_nativeint (I.neg mini));
Printf.printf "to_nativeint -min_nativeint\n = %s\n" (cvt_nativeint (I.neg minni));
Printf.printf "to_nativeint -min_int32\n = %s\n" (cvt_nativeint (I.neg mini32));
Printf.printf "to_nativeint -min_int64\n = %s\n" (cvt_nativeint (I.neg mini64));
Printf.printf "to_int32_unsigned 1\n = %s\n" (cvt_int32_unsigned I.one);
Printf.printf "to_int32_unsigned -1\n = %s\n" (cvt_int32_unsigned I.minus_one);
Printf.printf "to_int32_unsigned max_int\n = %s\n" (cvt_int32_unsigned maxi);
Printf.printf "to_int32_unsigned max_nativeint\n = %s\n" (cvt_int32_unsigned maxni);
Printf.printf "to_int32_unsigned max_int32\n = %s\n" (cvt_int32_unsigned maxi32);
Printf.printf "to_int32_unsigned 2max_int32\n = %s\n" (cvt_int32_unsigned (I.mul p2 maxi32));
Printf.printf "to_int32_unsigned 3max_int32\n = %s\n" (cvt_int32_unsigned (I.mul p3 maxi32));
Printf.printf "to_int32_unsigned max_int64\n = %s\n" (cvt_int32_unsigned maxi64);
Printf.printf "to_int64_unsigned 1\n = %s\n" (cvt_int64_unsigned I.one);
Printf.printf "to_int64_unsigned -1\n = %s\n" (cvt_int64_unsigned I.minus_one);
Printf.printf "to_int64_unsigned max_int\n = %s\n" (cvt_int64_unsigned maxi);
Printf.printf "to_int64_unsigned max_nativeint\n = %s\n" (cvt_int64_unsigned maxni);
Printf.printf "to_int64_unsigned max_int32\n = %s\n" (cvt_int64_unsigned maxi32);
Printf.printf "to_int64_unsigned max_int64\n = %s\n" (cvt_int64_unsigned maxi64);
Printf.printf "to_int64_unsigned 2max_int64\n = %s\n" (cvt_int64_unsigned (I.mul p2 maxi64));
Printf.printf "to_int64_unsigned 3max_int64\n = %s\n" (cvt_int64_unsigned (I.mul p3 maxi64));
Printf.printf "to_nativeint_unsigned 1\n = %s\n" (cvt_nativeint_unsigned I.one);
Printf.printf "to_nativeint_unsigned -1\n = %s\n" (cvt_nativeint_unsigned I.minus_one);
Printf.printf "to_nativeint_unsigned max_int\n = %s\n" (cvt_nativeint_unsigned maxi);
Printf.printf "to_nativeint_unsigned max_nativeint\n = %s\n" (cvt_nativeint_unsigned maxni);
Printf.printf "to_nativeint_unsigned 2max_nativeint\n = %s\n" (cvt_nativeint_unsigned (I.mul p2 maxni));
Printf.printf "to_nativeint_unsigned max_int32\n = %s\n" (cvt_nativeint_unsigned maxi32);
Printf.printf "to_nativeint_unsigned max_int64\n = %s\n" (cvt_nativeint_unsigned maxi64);
Printf.printf "to_nativeint_unsigned 2max_int64\n = %s\n" (cvt_nativeint_unsigned (I.mul p2 maxi64));
Printf.printf "to_nativeint_unsigned 3max_int64\n = %s\n" (cvt_nativeint_unsigned (I.mul p3 maxi64));
Printf.printf "of_int32_unsigned -1\n = %a\n" pr (I.of_int32_unsigned (-1l));
Printf.printf "of_int64_unsigned -1\n = %a\n" pr (I.of_int64_unsigned (-1L));
Printf.printf "of_nativeint_unsigned -1\n = %a\n" pr (I.of_nativeint_unsigned (-1n));
Printf.printf "of_float 1.\n = %a\n" pr (I.of_float 1.);
Printf.printf "of_float -1.\n = %a\n" pr (I.of_float (-. 1.));
Printf.printf "of_float pi\n = %a\n" pr (I.of_float (2. *. acos 0.));
Printf.printf "of_float 2^30\n = %a\n" pr (I.of_float (ldexp 1. 30));
Printf.printf "of_float 2^31\n = %a\n" pr (I.of_float (ldexp 1. 31));
Printf.printf "of_float 2^32\n = %a\n" pr (I.of_float (ldexp 1. 32));
Printf.printf "of_float 2^33\n = %a\n" pr (I.of_float (ldexp 1. 33));
Printf.printf "of_float -2^30\n = %a\n" pr (I.of_float (-.(ldexp 1. 30)));
Printf.printf "of_float -2^31\n = %a\n" pr (I.of_float (-.(ldexp 1. 31)));
Printf.printf "of_float -2^32\n = %a\n" pr (I.of_float (-.(ldexp 1. 32)));
Printf.printf "of_float -2^33\n = %a\n" pr (I.of_float (-.(ldexp 1. 33)));
Printf.printf "of_float 2^61\n = %a\n" pr (I.of_float (ldexp 1. 61));
Printf.printf "of_float 2^62\n = %a\n" pr (I.of_float (ldexp 1. 62));
Printf.printf "of_float 2^63\n = %a\n" pr (I.of_float (ldexp 1. 63));
Printf.printf "of_float 2^64\n = %a\n" pr (I.of_float (ldexp 1. 64));
Printf.printf "of_float 2^65\n = %a\n" pr (I.of_float (ldexp 1. 65));
Printf.printf "of_float -2^61\n = %a\n" pr (I.of_float (-.(ldexp 1. 61)));
Printf.printf "of_float -2^62\n = %a\n" pr (I.of_float (-.(ldexp 1. 62)));
Printf.printf "of_float -2^63\n = %a\n" pr (I.of_float (-.(ldexp 1. 63)));
Printf.printf "of_float -2^64\n = %a\n" pr (I.of_float (-.(ldexp 1. 64)));
Printf.printf "of_float -2^65\n = %a\n" pr (I.of_float (-.(ldexp 1. 65)));
Printf.printf "of_float 2^120\n = %a\n" pr (I.of_float (ldexp 1. 120));
Printf.printf "of_float 2^300\n = %a\n" pr (I.of_float (ldexp 1. 300));
Printf.printf "of_float -2^120\n = %a\n" pr (I.of_float (-.(ldexp 1. 120)));
Printf.printf "of_float -2^300\n = %a\n" pr (I.of_float (-.(ldexp 1. 300)));
Printf.printf "of_float 0.5\n = %a\n" pr (I.of_float 0.5);
Printf.printf "of_float -0.5\n = %a\n" pr (I.of_float (-. 0.5));
Printf.printf "of_float 200.5\n = %a\n" pr (I.of_float 200.5);
Printf.printf "of_float -200.5\n = %a\n" pr (I.of_float (-. 200.5));
Printf.printf "to_float 0\n = %a\n" prfloat (I.to_float I.zero, 0.0);
Printf.printf "to_float 1\n = %a\n" prfloat (I.to_float I.one, 1.0);
Printf.printf "to_float -1\n = %a\n" prfloat (I.to_float I.minus_one, -1.0);
Printf.printf "to_float 2^120\n = %a\n" prfloat (I.to_float p120, ldexp 1.0 120);
Printf.printf "to_float -2^120\n = %a\n" prfloat (I.to_float (I.neg p120), -. (ldexp 1.0 120));
Printf.printf "to_float (2^120-1)\n = %a\n" prfloat (I.to_float (I.pred p120), ldexp 1.0 120);
Printf.printf "to_float (-2^120+1)\n = %a\n" prfloat (I.to_float (I.succ (I.neg p120)), -. (ldexp 1.0 120));
Printf.printf "to_float 2^63\n = %a\n" prfloat (I.to_float (pow2 63), ldexp 1.0 63);
Printf.printf "to_float -2^63\n = %a\n" prfloat (I.to_float (I.neg (pow2 63)), -. (ldexp 1.0 63));
Printf.printf "to_float (2^63-1)\n = %a\n" prfloat (I.to_float (I.pred (pow2 63)), ldexp 1.0 63);
Printf.printf "to_float (-2^63-1)\n = %a\n" prfloat (I.to_float (I.pred (I.neg (pow2 63))), -. (ldexp 1.0 63));
Printf.printf "to_float (-2^63+1)\n = %a\n" prfloat (I.to_float (I.succ (I.neg (pow2 63))), -. (ldexp 1.0 63));
Printf.printf "to_float 2^300\n = %a\n" prfloat (I.to_float p300, ldexp 1.0 300);
Printf.printf "to_float -2^300\n = %a\n" prfloat (I.to_float (I.neg p300), -. (ldexp 1.0 300));
Printf.printf "to_float (2^300-1)\n = %a\n" prfloat (I.to_float (I.pred p300), ldexp 1.0 300);
Printf.printf "to_float (-2^300+1)\n = %a\n" prfloat (I.to_float (I.succ (I.neg p300)), -. (ldexp 1.0 300));
Printf.printf "of_string 12\n = %a\n" pr (I.of_string "12");
Printf.printf "of_string 0x12\n = %a\n" pr (I.of_string "0x12");
Printf.printf "of_string 0b10\n = %a\n" pr (I.of_string "0b10");
Printf.printf "of_string 0o12\n = %a\n" pr (I.of_string "0o12");
Printf.printf "of_string -12\n = %a\n" pr (I.of_string "-12");
Printf.printf "of_string -0x12\n = %a\n" pr (I.of_string "-0x12");
Printf.printf "of_string -0b10\n = %a\n" pr (I.of_string "-0b10");
Printf.printf "of_string -0o12\n = %a\n" pr (I.of_string "-0o12");
Printf.printf "of_string 000123456789012345678901234567890\n = %a\n" pr (I.of_string "000123456789012345678901234567890");
Printf.printf "2^120 / 2^300 (trunc)\n = %a\n" pr (I.div p120 p300);
Printf.printf "max_int / 2 (trunc)\n = %a\n" pr (I.div maxi p2);
Printf.printf "(2^300+1) / 2^120 (trunc)\n = %a\n" pr (I.div (I.succ p300) p120);
Printf.printf "(-(2^300+1)) / 2^120 (trunc)\n = %a\n" pr (I.div (I.neg (I.succ p300)) p120);
Printf.printf "(2^300+1) / (-(2^120)) (trunc)\n = %a\n" pr (I.div (I.succ p300) (I.neg p120));
Printf.printf "(-(2^300+1)) / (-(2^120)) (trunc)\n = %a\n" pr (I.div (I.neg (I.succ p300)) (I.neg p120));
Printf.printf "2^120 / 2^300 (ceil)\n = %a\n" pr (I.cdiv p120 p300);
Printf.printf "max_int / 2 (ceil)\n = %a\n" pr (I.cdiv maxi p2);
Printf.printf "(2^300+1) / 2^120 (ceil)\n = %a\n" pr (I.cdiv (I.succ p300) p120);
Printf.printf "(-(2^300+1)) / 2^120 (ceil)\n = %a\n" pr (I.cdiv (I.neg (I.succ p300)) p120);
Printf.printf "(2^300+1) / (-(2^120)) (ceil)\n = %a\n" pr (I.cdiv (I.succ p300) (I.neg p120));
Printf.printf "(-(2^300+1)) / (-(2^120)) (ceil)\n = %a\n" pr (I.cdiv (I.neg (I.succ p300)) (I.neg p120));
Printf.printf "2^120 / 2^300 (floor)\n = %a\n" pr (I.fdiv p120 p300);
Printf.printf "max_int / 2 (floor)\n = %a\n" pr (I.fdiv maxi p2);
Printf.printf "(2^300+1) / 2^120 (floor)\n = %a\n" pr (I.fdiv (I.succ p300) p120);
Printf.printf "(-(2^300+1)) / 2^120 (floor)\n = %a\n" pr (I.fdiv (I.neg (I.succ p300)) p120);
Printf.printf "(2^300+1) / (-(2^120)) (floor)\n = %a\n" pr (I.fdiv (I.succ p300) (I.neg p120));
Printf.printf "(-(2^300+1)) / (-(2^120)) (floor)\n = %a\n" pr (I.fdiv (I.neg (I.succ p300)) (I.neg p120));
Printf.printf "2^120 %% 2^300\n = %a\n" pr (I.rem p120 p300);
Printf.printf "max_int %% 2\n = %a\n" pr (I.rem maxi p2);
Printf.printf "(2^300+1) %% 2^120\n = %a\n" pr (I.rem (I.succ p300) p120);
Printf.printf "(-(2^300+1)) %% 2^120\n = %a\n" pr (I.rem (I.neg (I.succ p300)) p120);
Printf.printf "(2^300+1) %% (-(2^120))\n = %a\n" pr (I.rem (I.succ p300) (I.neg p120));
Printf.printf "(-(2^300+1)) %% (-(2^120))\n = %a\n" pr (I.rem (I.neg (I.succ p300)) (I.neg p120));
Printf.printf "2^120 /,%% 2^300\n = %a\n" pr2 (I.div_rem p120 p300);
Printf.printf "max_int /,%% 2\n = %a\n" pr2 (I.div_rem maxi p2);
Printf.printf "(2^300+1) /,%% 2^120\n = %a\n" pr2 (I.div_rem (I.succ p300) p120);
Printf.printf "(-(2^300+1)) /,%% 2^120\n = %a\n" pr2 (I.div_rem (I.neg (I.succ p300)) p120);
Printf.printf "(2^300+1) /,%% (-(2^120))\n = %a\n" pr2 (I.div_rem (I.succ p300) (I.neg p120));
Printf.printf "(-(2^300+1)) /,%% (-(2^120))\n = %a\n" pr2 (I.div_rem (I.neg (I.succ p300)) (I.neg p120));
Printf.printf "1 & 2\n = %a\n" pr (I.logand I.one p2);
Printf.printf "1 & 2^300\n = %a\n" pr (I.logand I.one p300);
Printf.printf "2^120 & 2^300\n = %a\n" pr (I.logand p120 p300);
Printf.printf "2^300 & 2^120\n = %a\n" pr (I.logand p300 p120);
Printf.printf "2^300 & 2^300\n = %a\n" pr (I.logand p300 p300);
Printf.printf "2^300 & 0\n = %a\n" pr (I.logand p300 I.zero);
Printf.printf "-2^120 & 2^300\n = %a\n" pr (I.logand (I.neg p120) p300);
Printf.printf " 2^120 & -2^300\n = %a\n" pr (I.logand p120 (I.neg p300));
Printf.printf "-2^120 & -2^300\n = %a\n" pr (I.logand (I.neg p120) (I.neg p300));
Printf.printf "-2^300 & 2^120\n = %a\n" pr (I.logand (I.neg p300) p120);
Printf.printf " 2^300 & -2^120\n = %a\n" pr (I.logand p300 (I.neg p120));
Printf.printf "-2^300 & -2^120\n = %a\n" pr (I.logand (I.neg p300) (I.neg p120));
Printf.printf "1 | 2\n = %a\n" pr (I.logor I.one p2);
Printf.printf "1 | 2^300\n = %a\n" pr (I.logor I.one p300);
Printf.printf "2^120 | 2^300\n = %a\n" pr (I.logor p120 p300);
Printf.printf "2^300 | 2^120\n = %a\n" pr (I.logor p300 p120);
Printf.printf "2^300 | 2^300\n = %a\n" pr (I.logor p300 p300);
Printf.printf "2^300 | 0\n = %a\n" pr (I.logor p300 I.zero);
Printf.printf "-2^120 | 2^300\n = %a\n" pr (I.logor (I.neg p120) p300);
Printf.printf " 2^120 | -2^300\n = %a\n" pr (I.logor p120 (I.neg p300));
Printf.printf "-2^120 | -2^300\n = %a\n" pr (I.logor (I.neg p120) (I.neg p300));
Printf.printf "-2^300 | 2^120\n = %a\n" pr (I.logor (I.neg p300) p120);
Printf.printf " 2^300 | -2^120\n = %a\n" pr (I.logor p300 (I.neg p120));
Printf.printf "-2^300 | -2^120\n = %a\n" pr (I.logor (I.neg p300) (I.neg p120));
Printf.printf "1 ^ 2\n = %a\n" pr (I.logxor I.one p2);
Printf.printf "1 ^ 2^300\n = %a\n" pr (I.logxor I.one p300);
Printf.printf "2^120 ^ 2^300\n = %a\n" pr (I.logxor p120 p300);
Printf.printf "2^300 ^ 2^120\n = %a\n" pr (I.logxor p300 p120);
Printf.printf "2^300 ^ 2^300\n = %a\n" pr (I.logxor p300 p300);
Printf.printf "2^300 ^ 0\n = %a\n" pr (I.logxor p300 I.zero);
Printf.printf "-2^120 ^ 2^300\n = %a\n" pr (I.logxor (I.neg p120) p300);
Printf.printf " 2^120 ^ -2^300\n = %a\n" pr (I.logxor p120 (I.neg p300));
Printf.printf "-2^120 ^ -2^300\n = %a\n" pr (I.logxor (I.neg p120) (I.neg p300));
Printf.printf "-2^300 ^ 2^120\n = %a\n" pr (I.logxor (I.neg p300) p120);
Printf.printf " 2^300 ^ -2^120\n = %a\n" pr (I.logxor p300 (I.neg p120));
Printf.printf "-2^300 ^ -2^120\n = %a\n" pr (I.logxor (I.neg p300) (I.neg p120));
Printf.printf "~0\n = %a\n" pr (I.lognot I.zero);
Printf.printf "~1\n = %a\n" pr (I.lognot I.one);
Printf.printf "~2\n = %a\n" pr (I.lognot p2);
Printf.printf "~2^300\n = %a\n" pr (I.lognot p300);
Printf.printf "~(-1)\n = %a\n" pr (I.lognot I.minus_one);
Printf.printf "~(-2)\n = %a\n" pr (I.lognot (I.neg p2));
Printf.printf "~(-(2^300))\n = %a\n" pr (I.lognot (I.neg p300));
Printf.printf "0 >> 1\n = %a\n" pr (I.shift_right I.zero 1);
Printf.printf "0 >> 100\n = %a\n" pr (I.shift_right I.zero 100);
Printf.printf "2 >> 1\n = %a\n" pr (I.shift_right p2 1);
Printf.printf "2 >> 2\n = %a\n" pr (I.shift_right p2 2);
Printf.printf "2 >> 100\n = %a\n" pr (I.shift_right p2 100);
Printf.printf "2^300 >> 1\n = %a\n" pr (I.shift_right p300 1);
Printf.printf "2^300 >> 2\n = %a\n" pr (I.shift_right p300 2);
Printf.printf "2^300 >> 100\n = %a\n" pr (I.shift_right p300 100);
Printf.printf "2^300 >> 200\n = %a\n" pr (I.shift_right p300 200);
Printf.printf "2^300 >> 300\n = %a\n" pr (I.shift_right p300 300);
Printf.printf "2^300 >> 400\n = %a\n" pr (I.shift_right p300 400);
Printf.printf "-1 >> 1\n = %a\n" pr (I.shift_right I.minus_one 1);
Printf.printf "-2 >> 1\n = %a\n" pr (I.shift_right (I.neg p2) 1);
Printf.printf "-2 >> 2\n = %a\n" pr (I.shift_right (I.neg p2) 2);
Printf.printf "-2 >> 100\n = %a\n" pr (I.shift_right (I.neg p2) 100);
Printf.printf "-2^300 >> 1\n = %a\n" pr (I.shift_right (I.neg p300) 1);
Printf.printf "-2^300 >> 2\n = %a\n" pr (I.shift_right (I.neg p300) 2);
Printf.printf "-2^300 >> 100\n = %a\n" pr (I.shift_right (I.neg p300) 100);
Printf.printf "-2^300 >> 200\n = %a\n" pr (I.shift_right (I.neg p300) 200);
Printf.printf "-2^300 >> 300\n = %a\n" pr (I.shift_right (I.neg p300) 300);
Printf.printf "-2^300 >> 400\n = %a\n" pr (I.shift_right (I.neg p300) 400);
Printf.printf "0 >>0 1\n = %a\n" pr (I.shift_right_trunc I.zero 1);
Printf.printf "0 >>0 100\n = %a\n" pr (I.shift_right_trunc I.zero 100);
Printf.printf "2 >>0 1\n = %a\n" pr (I.shift_right_trunc p2 1);
Printf.printf "2 >>0 2\n = %a\n" pr (I.shift_right_trunc p2 2);
Printf.printf "2 >>0 100\n = %a\n" pr (I.shift_right_trunc p2 100);
Printf.printf "2^300 >>0 1\n = %a\n" pr (I.shift_right_trunc p300 1);
Printf.printf "2^300 >>0 2\n = %a\n" pr (I.shift_right_trunc p300 2);
Printf.printf "2^300 >>0 100\n = %a\n" pr (I.shift_right_trunc p300 100);
Printf.printf "2^300 >>0 200\n = %a\n" pr (I.shift_right_trunc p300 200);
Printf.printf "2^300 >>0 300\n = %a\n" pr (I.shift_right_trunc p300 300);
Printf.printf "2^300 >>0 400\n = %a\n" pr (I.shift_right_trunc p300 400);
Printf.printf "-1 >>0 1\n = %a\n" pr (I.shift_right_trunc I.minus_one 1);
Printf.printf "-2 >>0 1\n = %a\n" pr (I.shift_right_trunc (I.neg p2) 1);
Printf.printf "-2 >>0 2\n = %a\n" pr (I.shift_right_trunc (I.neg p2) 2);
Printf.printf "-2 >>0 100\n = %a\n" pr (I.shift_right_trunc (I.neg p2) 100);
Printf.printf "-2^300 >>0 1\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 1);
Printf.printf "-2^300 >>0 2\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 2);
Printf.printf "-2^300 >>0 100\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 100);
Printf.printf "-2^300 >>0 200\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 200);
Printf.printf "-2^300 >>0 300\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 300);
Printf.printf "-2^300 >>0 400\n = %a\n" pr (I.shift_right_trunc (I.neg p300) 400);
Printf.printf "0 << 1\n = %a\n" pr (I.shift_left I.zero 1);
Printf.printf "0 << 100\n = %a\n" pr (I.shift_left I.zero 100);
Printf.printf "2 << 1\n = %a\n" pr (I.shift_left p2 1);
Printf.printf "2 << 32\n = %a\n" pr (I.shift_left p2 32);
Printf.printf "2 << 64\n = %a\n" pr (I.shift_left p2 64);
Printf.printf "2 << 299\n = %a\n" pr (I.shift_left p2 299);
Printf.printf "2^120 << 1\n = %a\n" pr (I.shift_left p120 1);
Printf.printf "2^120 << 180\n = %a\n" pr (I.shift_left p120 180);
Printf.printf "compare 1 2\n = %i\n" (I.compare I.one p2);
Printf.printf "compare 1 1\n = %i\n" (I.compare I.one I.one);
Printf.printf "compare 2 1\n = %i\n" (I.compare p2 I.one);
Printf.printf "compare 2^300 2^120\n = %i\n" (I.compare p300 p120);
Printf.printf "compare 2^120 2^120\n = %i\n" (I.compare p120 p120);
Printf.printf "compare 2^120 2^300\n = %i\n" (I.compare p120 p300);
Printf.printf "compare 2^121 2^120\n = %i\n" (I.compare p121 p120);
Printf.printf "compare 2^120 2^121\n = %i\n" (I.compare p120 p121);
Printf.printf "compare 2^300 -2^120\n = %i\n" (I.compare p300 (I.neg p120));
Printf.printf "compare 2^120 -2^120\n = %i\n" (I.compare p120 (I.neg p120));
Printf.printf "compare 2^120 -2^300\n = %i\n" (I.compare p120 (I.neg p300));
Printf.printf "compare -2^300 2^120\n = %i\n" (I.compare (I.neg p300) p120);
Printf.printf "compare -2^120 2^120\n = %i\n" (I.compare (I.neg p120) p120);
Printf.printf "compare -2^120 2^300\n = %i\n" (I.compare (I.neg p120) p300);
Printf.printf "compare -2^300 -2^120\n = %i\n" (I.compare (I.neg p300) (I.neg p120));
Printf.printf "compare -2^120 -2^120\n = %i\n" (I.compare (I.neg p120) (I.neg p120));
Printf.printf "compare -2^120 -2^300\n = %i\n" (I.compare (I.neg p120) (I.neg p300));
Printf.printf "equal 1 2\n = %B\n" (I.equal I.one p2);
Printf.printf "equal 1 1\n = %B\n" (I.equal I.one I.one);
Printf.printf "equal 2 1\n = %B\n" (I.equal p2 I.one);
Printf.printf "equal 2^300 2^120\n = %B\n" (I.equal p300 p120);
Printf.printf "equal 2^120 2^120\n = %B\n" (I.equal p120 p120);
Printf.printf "equal 2^120 2^300\n = %B\n" (I.equal p120 p300);
Printf.printf "equal 2^121 2^120\n = %B\n" (I.equal p121 p120);
Printf.printf "equal 2^120 2^121\n = %B\n" (I.equal p120 p121);
Printf.printf "equal 2^120 -2^120\n = %B\n" (I.equal p120 (I.neg p120));
Printf.printf "equal -2^120 2^120\n = %B\n" (I.equal (I.neg p120) p120);
Printf.printf "equal -2^120 -2^120\n = %B\n" (I.equal (I.neg p120) (I.neg p120));
Printf.printf "sign 0\n = %i\n" (I.sign I.zero);
Printf.printf "sign 1\n = %i\n" (I.sign I.one);
Printf.printf "sign -1\n = %i\n" (I.sign I.minus_one);
Printf.printf "sign 2^300\n = %i\n" (I.sign p300);
Printf.printf "sign -2^300\n = %i\n" (I.sign (I.neg p300));
Printf.printf "gcd 0 0\n = %a\n" pr (I.gcd I.zero I.zero);
Printf.printf "gcd 0 -137\n = %a\n" pr (I.gcd (I.of_int 0) (I.of_int (-137)));
Printf.printf "gcd 12 27\n = %a\n" pr (I.gcd (I.of_int 12) (I.of_int 27));
Printf.printf "gcd 27 12\n = %a\n" pr (I.gcd (I.of_int 27) (I.of_int 12));
Printf.printf "gcd 27 27\n = %a\n" pr (I.gcd (I.of_int 27) (I.of_int 27));
Printf.printf "gcd -12 27\n = %a\n" pr (I.gcd (I.of_int (-12)) (I.of_int 27));
Printf.printf "gcd 12 -27\n = %a\n" pr (I.gcd (I.of_int 12) (I.of_int (-27)));
Printf.printf "gcd -12 -27\n = %a\n" pr (I.gcd (I.of_int (-12)) (I.of_int (-27)));
Printf.printf "gcd 0 2^300\n = %a\n" pr (I.gcd (I.of_int 0) p300);
Printf.printf "gcd 2^120 2^300\n = %a\n" pr (I.gcd p120 p300);
Printf.printf "gcd 2^300 2^120\n = %a\n" pr (I.gcd p300 p120);
Printf.printf "gcd 0 -2^300\n = %a\n" pr (I.gcd (I.of_int 0) (I.neg p300));
Printf.printf "gcd 2^120 -2^300\n = %a\n" pr (I.gcd p120 (I.neg p300));
Printf.printf "gcd 2^300 -2^120\n = %a\n" pr (I.gcd p300 (I.neg p120));
Printf.printf "gcd -2^120 2^300\n = %a\n" pr (I.gcd (I.neg p120) p300);
Printf.printf "gcd -2^300 2^120\n = %a\n" pr (I.gcd (I.neg p300) p120);
Printf.printf "gcd -2^120 -2^300\n = %a\n" pr (I.gcd (I.neg p120) (I.neg p300));
Printf.printf "gcd -2^300 -2^120\n = %a\n" pr (I.gcd (I.neg p300) (I.neg p120));
Printf.printf "gcdext 12 27\n = %a\n" pr3 (I.gcdext (I.of_int 12) (I.of_int 27));
Printf.printf "gcdext 27 12\n = %a\n" pr3 (I.gcdext (I.of_int 27) (I.of_int 12));
Printf.printf "gcdext 27 27\n = %a\n" pr3 (I.gcdext (I.of_int 27) (I.of_int 27));
Printf.printf "gcdext -12 27\n = %a\n" pr3 (I.gcdext (I.of_int (-12)) (I.of_int 27));
Printf.printf "gcdext 12 -27\n = %a\n" pr3 (I.gcdext (I.of_int 12) (I.of_int (-27)));
Printf.printf "gcdext -12 -27\n = %a\n" pr3 (I.gcdext (I.of_int (-12)) (I.of_int (-27)));
Printf.printf "gcdext 2^120 2^300\n = %a\n" pr3 (I.gcdext p120 p300);
Printf.printf "gcdext 2^300 2^120\n = %a\n" pr3 (I.gcdext p300 p120);
Printf.printf "gcdext 12 0\n = %a\n" pr3 (I.gcdext (I.of_int 12) I.zero);
Printf.printf "gcdext 0 27\n = %a\n" pr3 (I.gcdext I.zero (I.of_int 27));
Printf.printf "gcdext -12 0\n = %a\n" pr3 (I.gcdext (I.of_int (-12)) I.zero);
Printf.printf "gcdext 0 -27\n = %a\n" pr3 (I.gcdext I.zero (I.of_int (-27)));
Printf.printf "gcdext 2^120 0\n = %a\n" pr3 (I.gcdext p120 I.zero);
Printf.printf "gcdext 0 2^300\n = %a\n" pr3 (I.gcdext I.zero p300);
Printf.printf "gcdext -2^120 0\n = %a\n" pr3 (I.gcdext (I.neg p120) I.zero);
Printf.printf "gcdext 0 -2^300\n = %a\n" pr3 (I.gcdext I.zero (I.neg p300));
Printf.printf "gcdext 0 0\n = %a\n" pr3 (I.gcdext I.zero I.zero);
Printf.printf "lcm 0 0 = %a\n" pr (I.lcm I.zero I.zero);
Printf.printf "lcm 10 12 = %a\n" pr (I.lcm (I.of_int 10) (I.of_int 12));
Printf.printf "lcm -10 12 = %a\n" pr (I.lcm (I.of_int (-10)) (I.of_int 12));
Printf.printf "lcm 10 -12 = %a\n" pr (I.lcm (I.of_int 10) (I.of_int (-12)));
Printf.printf "lcm -10 -12 = %a\n" pr (I.lcm (I.of_int (-10)) (I.of_int (-12)));
Printf.printf "lcm 0 12 = %a\n" pr (I.lcm I.zero (I.of_int 12));
Printf.printf "lcm 0 -12 = %a\n" pr (I.lcm I.zero (I.of_int (-12)));
Printf.printf "lcm 10 0 = %a\n" pr (I.lcm (I.of_int 10) I.zero);
Printf.printf "lcm -10 0 = %a\n" pr (I.lcm (I.of_int (-10)) I.zero);
Printf.printf "lcm 2^120 2^300 = %a\n" pr (I.lcm p120 p300);
Printf.printf "lcm 2^120 -2^300 = %a\n" pr (I.lcm p120 (I.neg p300));
Printf.printf "lcm -2^120 2^300 = %a\n" pr (I.lcm (I.neg p120) p300);
Printf.printf "lcm -2^120 -2^300 = %a\n" pr (I.lcm (I.neg p120) (I.neg p300));
Printf.printf "lcm 2^120 0 = %a\n" pr (I.lcm p120 I.zero);
Printf.printf "lcm -2^120 0 = %a\n" pr (I.lcm (I.neg p120) I.zero);
Printf.printf "is_odd 0\n = %b\n" (I.is_odd (Z.of_int 0));
Printf.printf "is_odd 1\n = %b\n" (I.is_odd (Z.of_int 1));
Printf.printf "is_odd 2\n = %b\n" (I.is_odd (Z.of_int 2));
Printf.printf "is_odd 3\n = %b\n" (I.is_odd (Z.of_int 3));
Printf.printf "is_odd 2^120\n = %b\n" (I.is_odd p120);
Printf.printf "is_odd 2^120+1\n = %b\n" (I.is_odd (Z.succ p120));
Printf.printf "is_odd 2^300\n = %b\n" (I.is_odd p300);
Printf.printf "is_odd 2^300+1\n = %b\n" (I.is_odd (Z.succ p300));
Printf.printf "sqrt 0\n = %a\n" pr (I.sqrt I.zero);
Printf.printf "sqrt 1\n = %a\n" pr (I.sqrt I.one);
Printf.printf "sqrt 2\n = %a\n" pr (I.sqrt p2);
Printf.printf "sqrt 2^120\n = %a\n" pr (I.sqrt p120);
Printf.printf "sqrt 2^121\n = %a\n" pr (I.sqrt p121);
Printf.printf "sqrt_rem 0\n = %a\n" pr2 (I.sqrt_rem I.zero);
Printf.printf "sqrt_rem 1\n = %a\n" pr2 (I.sqrt_rem I.one);
Printf.printf "sqrt_rem 2\n = %a\n" pr2 (I.sqrt_rem p2);
Printf.printf "sqrt_rem 2^120\n = %a\n" pr2 (I.sqrt_rem p120);
Printf.printf "sqrt_rem 2^121\n = %a\n" pr2 (I.sqrt_rem p121);
Printf.printf "popcount 0\n = %i\n" (I.popcount I.zero);
Printf.printf "popcount 1\n = %i\n" (I.popcount I.one);
Printf.printf "popcount 2\n = %i\n" (I.popcount p2);
Printf.printf "popcount max_int32\n = %i\n" (I.popcount maxi32);
Printf.printf "popcount 2^120\n = %i\n" (I.popcount p120);
Printf.printf "popcount (2^120-1)\n = %i\n" (I.popcount (I.pred p120));
Printf.printf "hamdist 0 0\n = %i\n" (I.hamdist I.zero I.zero);
Printf.printf "hamdist 0 1\n = %i\n" (I.hamdist I.zero I.one);
Printf.printf "hamdist 0 2^300\n = %i\n" (I.hamdist I.zero p300);
Printf.printf "hamdist 2^120 2^120\n = %i\n" (I.hamdist p120 p120);
Printf.printf "hamdist 2^120 (2^120-1)\n = %i\n" (I.hamdist p120 (I.pred p120));
Printf.printf "hamdist 2^120 2^300\n = %i\n" (I.hamdist p120 p300);
Printf.printf "hamdist (2^120-1) (2^300-1)\n = %i\n" (I.hamdist (I.pred p120) (I.pred p300));
Printf.printf "divisible 42 7\n = %B\n" (I.divisible (I.of_int 42) (I.of_int 7));
Printf.printf "divisible 43 7\n = %B\n" (I.divisible (I.of_int 43) (I.of_int 7));
Printf.printf "divisible 0 0\n = %B\n" (I.divisible I.zero I.zero);
Printf.printf "divisible 0 2^120\n = %B\n" (I.divisible I.zero p120);
Printf.printf "divisible 2 2^120\n = %B\n" (I.divisible (I.of_int 2) p120);
Printf.printf "divisible 2^300 2^120\n = %B\n" (I.divisible p300 p120);
Printf.printf "divisible (2^300-1) 32\n = %B\n" (I.divisible (I.pred p300) (I.of_int 32));
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)));
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));
(* always 0 when not using custom blocks *)
Printf.printf "hash(2^120)\n = %i\n" (Hashtbl.hash p120);
Printf.printf "hash(2^121)\n = %i\n" (Hashtbl.hash p121);
Printf.printf "hash(2^300)\n = %i\n" (Hashtbl.hash p300);
(* fails if not using custom blocks *)
Printf.printf "2^120 = 2^300\n = %B\n" (p120 = p300);
Printf.printf "2^120 = 2^120\n = %B\n" (p120 = p120);
Printf.printf "2^120 = 2^120\n = %B\n" (p120 = (pow2 120));
Printf.printf "2^120 > 2^300\n = %B\n" (p120 > p300);
Printf.printf "2^120 < 2^300\n = %B\n" (p120 < p300);
Printf.printf "2^120 = 1\n = %B\n" (p120 = I.one);
(* In OCaml < 3.12.1, the order is not consistent with integers when
comparing mpn_ and ints with OCaml's polymorphic compare operator.
In OCaml >= 3.12.1, the results are consistent.
*)
Printf.printf "2^120 > 1\n = %B\n" (p120 > I.one);
Printf.printf "2^120 < 1\n = %B\n" (p120 < I.one);
Printf.printf "-2^120 > 1\n = %B\n" ((I.neg p120) > I.one);
Printf.printf "-2^120 < 1\n = %B\n" ((I.neg p120) < I.one);
Printf.printf "demarshal 2^120, 2^300, 1\n = %a\n" pr3
(Marshal.from_string (Marshal.to_string (p120,p300,I.one) []) 0);
Printf.printf "demarshal -2^120, -2^300, -1\n = %a\n" pr3
(Marshal.from_string (Marshal.to_string (I.neg p120,I.neg p300,I.minus_one) []) 0);
Printf.printf "format %%i 0 = /%s/\n" (I.format "%i" I.zero);
Printf.printf "format %%i 1 = /%s/\n" (I.format "%i" I.one);
Printf.printf "format %%i -1 = /%s/\n" (I.format "%i" I.minus_one);
Printf.printf "format %%i 2^30 = /%s/\n" (I.format "%i" p30);
Printf.printf "format %%i -2^30 = /%s/\n" (I.format "%i" (I.neg p30));
Printf.printf "format %% i 1 = /%s/\n" (I.format "% i" I.one);
Printf.printf "format %%+i 1 = /%s/\n" (I.format "%+i" I.one);
Printf.printf "format %%x 0 = /%s/\n" (I.format "%x" I.zero);
Printf.printf "format %%x 1 = /%s/\n" (I.format "%x" I.one);
Printf.printf "format %%x -1 = /%s/\n" (I.format "%x" I.minus_one);
Printf.printf "format %%x 2^30 = /%s/\n" (I.format "%x" p30);
Printf.printf "format %%x -2^30 = /%s/\n" (I.format "%x" (I.neg p30));
Printf.printf "format %%X 0 = /%s/\n" (I.format "%X" I.zero);
Printf.printf "format %%X 1 = /%s/\n" (I.format "%X" I.one);
Printf.printf "format %%X -1 = /%s/\n" (I.format "%X" I.minus_one);
Printf.printf "format %%X 2^30 = /%s/\n" (I.format "%X" p30);
Printf.printf "format %%X -2^30 = /%s/\n" (I.format "%X" (I.neg p30));
Printf.printf "format %%o 0 = /%s/\n" (I.format "%o" I.zero);
Printf.printf "format %%o 1 = /%s/\n" (I.format "%o" I.one);
Printf.printf "format %%o -1 = /%s/\n" (I.format "%o" I.minus_one);
Printf.printf "format %%o 2^30 = /%s/\n" (I.format "%o" p30);
Printf.printf "format %%o -2^30 = /%s/\n" (I.format "%o" (I.neg p30));
Printf.printf "format %%10i 0 = /%s/\n" (I.format "%10i" I.zero);
Printf.printf "format %%10i 1 = /%s/\n" (I.format "%10i" I.one);
Printf.printf "format %%10i -1 = /%s/\n" (I.format "%10i" I.minus_one);
Printf.printf "format %%10i 2^30 = /%s/\n" (I.format "%10i" p30);
Printf.printf "format %%10i -2^30 = /%s/\n" (I.format "%10i" (I.neg p30));
Printf.printf "format %%-10i 0 = /%s/\n" (I.format "%-10i" I.zero);
Printf.printf "format %%-10i 1 = /%s/\n" (I.format "%-10i" I.one);
Printf.printf "format %%-10i -1 = /%s/\n" (I.format "%-10i" I.minus_one);
Printf.printf "format %%-10i 2^30 = /%s/\n" (I.format "%-10i" p30);
Printf.printf "format %%-10i -2^30 = /%s/\n" (I.format "%-10i" (I.neg p30));
Printf.printf "format %%+10i 0 = /%s/\n" (I.format "%+10i" I.zero);
Printf.printf "format %%+10i 1 = /%s/\n" (I.format "%+10i" I.one);
Printf.printf "format %%+10i -1 = /%s/\n" (I.format "%+10i" I.minus_one);
Printf.printf "format %%+10i 2^30 = /%s/\n" (I.format "%+10i" p30);
Printf.printf "format %%+10i -2^30 = /%s/\n" (I.format "%+10i" (I.neg p30));
Printf.printf "format %% 10i 0 = /%s/\n" (I.format "% 10i" I.zero);
Printf.printf "format %% 10i 1 = /%s/\n" (I.format "% 10i" I.one);
Printf.printf "format %% 10i -1 = /%s/\n" (I.format "% 10i" I.minus_one);
Printf.printf "format %% 10i 2^30 = /%s/\n" (I.format "% 10i" p30);
Printf.printf "format %% 10i -2^30 = /%s/\n" (I.format "% 10i" (I.neg p30));
Printf.printf "format %%010i 0 = /%s/\n" (I.format "%010i" I.zero);
Printf.printf "format %%010i 1 = /%s/\n" (I.format "%010i" I.one);
Printf.printf "format %%010i -1 = /%s/\n" (I.format "%010i" I.minus_one);
Printf.printf "format %%010i 2^30 = /%s/\n" (I.format "%010i" p30);
Printf.printf "format %%010i -2^30 = /%s/\n" (I.format "%010i" (I.neg p30));
Printf.printf "format %%#x 0 = /%s/\n" (I.format "%#x" I.zero);
Printf.printf "format %%#x 1 = /%s/\n" (I.format "%#x" I.one);
Printf.printf "format %%#x -1 = /%s/\n" (I.format "%#x" I.minus_one);
Printf.printf "format %%#x 2^30 = /%s/\n" (I.format "%#x" p30);
Printf.printf "format %%#x -2^30 = /%s/\n" (I.format "%#x" (I.neg p30));
Printf.printf "format %%#X 0 = /%s/\n" (I.format "%#X" I.zero);
Printf.printf "format %%#X 1 = /%s/\n" (I.format "%#X" I.one);
Printf.printf "format %%#X -1 = /%s/\n" (I.format "%#X" I.minus_one);
Printf.printf "format %%#X 2^30 = /%s/\n" (I.format "%#X" p30);
Printf.printf "format %%#X -2^30 = /%s/\n" (I.format "%#X" (I.neg p30));
Printf.printf "format %%#o 0 = /%s/\n" (I.format "%#o" I.zero);
Printf.printf "format %%#o 1 = /%s/\n" (I.format "%#o" I.one);
Printf.printf "format %%#o -1 = /%s/\n" (I.format "%#o" I.minus_one);
Printf.printf "format %%#o 2^30 = /%s/\n" (I.format "%#o" p30);
Printf.printf "format %%#o -2^30 = /%s/\n" (I.format "%#o" (I.neg p30));
Printf.printf "format %%#10x 0 = /%s/\n" (I.format "%#10x" I.zero);
Printf.printf "format %%#10x 1 = /%s/\n" (I.format "%#10x" I.one);
Printf.printf "format %%#10x -1 = /%s/\n" (I.format "%#10x" I.minus_one);
Printf.printf "format %%#10x 2^30 = /%s/\n" (I.format "%#10x" p30);
Printf.printf "format %%#10x -2^30 = /%s/\n" (I.format "%#10x" (I.neg p30));
Printf.printf "format %%#10X 0 = /%s/\n" (I.format "%#10X" I.zero);
Printf.printf "format %%#10X 1 = /%s/\n" (I.format "%#10X" I.one);
Printf.printf "format %%#10X -1 = /%s/\n" (I.format "%#10X" I.minus_one);
Printf.printf "format %%#10X 2^30 = /%s/\n" (I.format "%#10X" p30);
Printf.printf "format %%#10X -2^30 = /%s/\n" (I.format "%#10X" (I.neg p30));
Printf.printf "format %%#10o 0 = /%s/\n" (I.format "%#10o" I.zero);
Printf.printf "format %%#10o 1 = /%s/\n" (I.format "%#10o" I.one);
Printf.printf "format %%#10o -1 = /%s/\n" (I.format "%#10o" I.minus_one);
Printf.printf "format %%#10o 2^30 = /%s/\n" (I.format "%#10o" p30);
Printf.printf "format %%#10o -2^30 = /%s/\n" (I.format "%#10o" (I.neg p30));
Printf.printf "format %%#-10x 0 = /%s/\n" (I.format "%#-10x" I.zero);
Printf.printf "format %%#-10x 1 = /%s/\n" (I.format "%#-10x" I.one);
Printf.printf "format %%#-10x -1 = /%s/\n" (I.format "%#-10x" I.minus_one);
Printf.printf "format %%#-10x 2^30 = /%s/\n" (I.format "%#-10x" p30);
Printf.printf "format %%#-10x -2^30 = /%s/\n" (I.format "%#-10x" (I.neg p30));
Printf.printf "format %%#-10X 0 = /%s/\n" (I.format "%#-10X" I.zero);
Printf.printf "format %%#-10X 1 = /%s/\n" (I.format "%#-10X" I.one);
Printf.printf "format %%#-10X -1 = /%s/\n" (I.format "%#-10X" I.minus_one);
Printf.printf "format %%#-10X 2^30 = /%s/\n" (I.format "%#-10X" p30);
Printf.printf "format %%#-10X -2^30 = /%s/\n" (I.format "%#-10X" (I.neg p30));
Printf.printf "format %%#-10o 0 = /%s/\n" (I.format "%#-10o" I.zero);
Printf.printf "format %%#-10o 1 = /%s/\n" (I.format "%#-10o" I.one);
Printf.printf "format %%#-10o -1 = /%s/\n" (I.format "%#-10o" I.minus_one);
Printf.printf "format %%#-10o 2^30 = /%s/\n" (I.format "%#-10o" p30);
Printf.printf "format %%#-10o -2^30 = /%s/\n" (I.format "%#-10o" (I.neg p30));
let extract_testdata =
let a = I.of_int 42
and b = I.of_int (-42)
and c = I.of_string "3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701" in
[a,0,1; a,0,5; a,0,32; a,0,64;
a,1,1; a,1,5; a,1,32; a,1,63; a,1,64; a,1,127; a,1,128;
a,69,12;
b,0,1; b,0,5; b,0,32; b,0,64;
b,1,1; b,1,5; b,1,32; b,1,63; b,1,64; b,1,127; b,1,128;
b,69,12;
c,0,1; c,0,64; c,128,1; c,128,5; c,131,32; c,175,63; c,277,123] in
List.iter chk_extract extract_testdata;
List.iter chk_signed_extract extract_testdata;
chk_bits I.zero;
chk_bits p2;
chk_bits (I.neg p2);
chk_bits p30;
chk_bits (I.neg p30);
chk_bits p62;
chk_bits (I.neg p62);
chk_bits p300;
chk_bits p120;
chk_bits p121;
chk_bits maxi;
chk_bits mini;
chk_bits maxi32;
chk_bits mini32;
chk_bits maxi64;
chk_bits mini64;
chk_bits maxni;
chk_bits minni;
List.iter chk_testbit [
I.zero; I.one; I.of_int (-42);
I.of_string "31415926535897932384626433832795028841971693993751058209749445923078164062862089986";
I.neg (I.shift_left (I.of_int 123456) 64);
];
List.iter chk_numbits_tz [
I.zero; I.one; I.of_int (-42);
I.shift_left (I.of_int 9999) 77;
I.neg (I.shift_left (I.of_int 123456) 64);
];
Printf.printf "random_bits 45 = %a\n"
pr (I.random_bits_gen ~fill:pr_bytes 45);
Printf.printf "random_bits 45 = %a\n"
pr (I.random_bits_gen ~fill:pr_bytes 45);
Printf.printf "random_bits 12 = %a\n"
pr (I.random_bits_gen ~fill:pr_bytes 12);
Printf.printf "random_int 123456 = %a\n"
pr (I.random_int_gen ~fill:pr_bytes (I.of_int 123456));
Printf.printf "random_int 9999999 = %a\n"
pr (I.random_int_gen ~fill:pr_bytes (I.of_int 9999999));
()
(* testing Q *)
(* gcd extended to: gcd x 0 = gcd 0 x = 0 *)
let gcd2 a b =
if Z.sign a = 0 then b
else if Z.sign b = 0 then a
else Z.gcd a b
(* check invariant *)
let check x =
assert (Z.sign x.Q.den >= 0);
assert (Z.compare (gcd2 x.Q.num x.Q.den) Z.one <= 0)
let t_list = [Q.zero;Q.one;Q.minus_one;Q.inf;Q.minus_inf;Q.undef]
let test1 msg op =
List.iter
(fun x ->
let r = op x in
check r;
Printf.printf "%s %s = %s\n" msg (Q.to_string x) (Q.to_string r)
) t_list
let test2 msg op =
List.iter
(fun x ->
List.iter
(fun y ->
let r = op x y in
check r;
Printf.printf "%s %s %s = %s\n" (Q.to_string x) msg (Q.to_string y) (Q.to_string r)
) t_list
) t_list
let test_Q () =
let _ = List.iter check t_list in
let _ = test1 "-" Q.neg in
let _ = test1 "1/" Q.inv in
let _ = test1 "abs" Q.abs in
let _ = test2 "+" Q.add in
let _ = test2 "-" Q.sub in
let _ = test2 "*" Q.mul in
let _ = test2 "/" Q.div in
let _ = test2 "* 1/" (fun a b -> Q.mul a (Q.inv b)) in
let _ = test1 "mul_2exp (1) " (fun a -> Q.mul_2exp a 1) in
let _ = test1 "mul_2exp (2) " (fun a -> Q.mul_2exp a 2) in
let _ = test1 "div_2exp (1) " (fun a -> Q.div_2exp a 1) in
let _ = test1 "div_2exp (2) " (fun a -> Q.div_2exp a 2) in
(* check simple identitites *)
List.iter
(fun x ->
assert (0 = Q.compare x (Q.div_2exp (Q.mul_2exp x 2) 2));
assert (0 = Q.compare x (Q.mul_2exp (Q.div_2exp x 2) 2));
List.iter
(fun y ->
Printf.printf "identity checking %s %s\n" (Q.to_string x) (Q.to_string y);
assert (0 = Q.compare (Q.add x y) (Q.add y x));
assert (0 = Q.compare (Q.sub x y) (Q.neg (Q.sub y x)));
assert (0 = Q.compare (Q.sub x y) (Q.add x (Q.neg y)));
assert (0 = Q.compare (Q.mul x y) (Q.mul y x));
assert (0 = Q.compare (Q.div x y) (Q.mul x (Q.inv y)));
) t_list
) t_list;
assert (Q.compare Q.undef Q.undef = 0);
assert (not (Q.equal Q.undef Q.undef));
assert (not (Q.lt Q.undef Q.undef));
assert (not (Q.leq Q.undef Q.undef));
assert (not (Q.gt Q.undef Q.undef));
assert (not (Q.geq Q.undef Q.undef))
(* main *)
let _ = test_Z()
let _ = test_Q()

1452
unikernel/duniverse/Zarith/tests/zq.output32 Normal file
View file

File diff suppressed because it is too large Load diff

1452
unikernel/duniverse/Zarith/tests/zq.output64 Normal file
View file

File diff suppressed because it is too large Load diff

555
unikernel/duniverse/Zarith/z.ml Normal file
View file

@ -0,0 +1,555 @@
(**
Integers.
This file is part of the Zarith library
http://forge.ocamlcore.org/projects/zarith .
It is distributed under LGPL 2 licensing, with static linking exception.
See the LICENSE file included in the distribution.
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
a joint laboratory by:
CNRS (Centre national de la recherche scientifique, France),
ENS (École normale supérieure, Paris, France),
INRIA Rocquencourt (Institut national de recherche en informatique, France).
*)
type t
exception Overflow
external init: unit -> unit = "ml_z_init"
let _ = init ()
let _ = Callback.register_exception "ml_z_overflow" Overflow
external is_small_int: t -> bool = "%obj_is_int"
external unsafe_to_int: t -> int = "%identity"
external of_int: int -> t = "%identity"
external c_neg: t -> t = "ml_z_neg"
let neg x =
if is_small_int x && unsafe_to_int x <> min_int
then of_int (- unsafe_to_int x)
else c_neg x
external c_add: t -> t -> t = "ml_z_add"
let add x y =
if is_small_int x && is_small_int y then begin
let z = unsafe_to_int x + unsafe_to_int y in
(* Overflow check -- Hacker's Delight, section 2.12 *)
if (z lxor unsafe_to_int x) land (z lxor unsafe_to_int y) >= 0
then of_int z
else c_add x y
end else
c_add x y
external c_sub: t -> t -> t = "ml_z_sub"
let sub x y =
if is_small_int x && is_small_int y then begin
let z = unsafe_to_int x - unsafe_to_int y in
(* Overflow check -- Hacker's Delight, section 2.12 *)
if (unsafe_to_int x lxor unsafe_to_int y)
land (z lxor unsafe_to_int x) >= 0
then of_int z
else c_sub x y
end else
c_sub x y
external mul_overflows: int -> int -> bool = "ml_z_mul_overflows" [@@noalloc]
external c_mul: t -> t -> t = "ml_z_mul"
let mul x y =
if is_small_int x && is_small_int y
&& not (mul_overflows (unsafe_to_int x) (unsafe_to_int y))
then of_int (unsafe_to_int x * unsafe_to_int y)
else c_mul x y
external c_div: t -> t -> t = "ml_z_div"
let div x y =
if is_small_int y then
if unsafe_to_int y = -1 then
neg x
else if is_small_int x then
of_int (unsafe_to_int x / unsafe_to_int y)
else
c_div x y
else
c_div x y
external cdiv: t -> t -> t = "ml_z_cdiv"
external fdiv: t -> t -> t = "ml_z_fdiv"
external c_rem: t -> t -> t = "ml_z_rem"
let rem x y =
if is_small_int y then
if unsafe_to_int y = -1 then
of_int 0
else if is_small_int x then
of_int (unsafe_to_int x mod unsafe_to_int y)
else
c_rem x y
else
c_rem x y
external div_rem: t -> t -> (t * t) = "ml_z_div_rem"
external c_divexact: t -> t -> t = "ml_z_divexact"
let divexact x y =
if is_small_int y then
if unsafe_to_int y = -1 then
neg x
else if is_small_int x then
of_int (unsafe_to_int x / unsafe_to_int y)
else
c_divexact x y
else
c_divexact x y
external c_succ: t -> t = "ml_z_succ"
let succ x =
if is_small_int x && unsafe_to_int x <> max_int
then of_int (unsafe_to_int x + 1)
else c_succ x
external c_pred: t -> t = "ml_z_pred"
let pred x =
if is_small_int x && unsafe_to_int x <> min_int
then of_int (unsafe_to_int x - 1)
else c_pred x
external c_abs: t -> t = "ml_z_abs"
let abs x =
if is_small_int x then
if unsafe_to_int x >= 0 then x
else if unsafe_to_int x <> min_int then
of_int (- unsafe_to_int x)
else
c_abs x
else
c_abs x
external c_logand: t -> t -> t = "ml_z_logand"
let logand x y =
if is_small_int x && is_small_int y
then of_int (unsafe_to_int x land unsafe_to_int y)
else c_logand x y
external c_logor: t -> t -> t = "ml_z_logor"
let logor x y =
if is_small_int x && is_small_int y
then of_int (unsafe_to_int x lor unsafe_to_int y)
else c_logor x y
external c_logxor: t -> t -> t = "ml_z_logxor"
let logxor x y =
if is_small_int x && is_small_int y
then of_int (unsafe_to_int x lxor unsafe_to_int y)
else c_logxor x y
external c_lognot: t -> t = "ml_z_lognot"
let lognot x =
if is_small_int x
then of_int (unsafe_to_int x lxor (-1))
else c_lognot x
external c_shift_left: t -> int -> t = "ml_z_shift_left"
let shift_left x y =
if is_small_int x && y >= 0 && y < Sys.word_size then begin
let z = unsafe_to_int x lsl y in
if z asr y = unsafe_to_int x
then of_int z
else c_shift_left x y
end else
c_shift_left x y
external c_shift_right: t -> int -> t = "ml_z_shift_right"
let shift_right x y =
if is_small_int x && y >= 0 then
of_int
(unsafe_to_int x asr (if y < Sys.word_size then y else Sys.word_size - 1))
else
c_shift_right x y
external c_shift_right_trunc: t -> int -> t = "ml_z_shift_right_trunc"
let shift_right_trunc x y =
if is_small_int x && y >= 0 then
if y >= Sys.word_size then
of_int 0
else if unsafe_to_int x >= 0 then
of_int (unsafe_to_int x lsr y)
else
of_int (- ((- unsafe_to_int x) lsr y))
else
c_shift_right_trunc x y
external of_int32: int32 -> t = "ml_z_of_int32"
external of_int64: int64 -> t = "ml_z_of_int64"
external of_nativeint: nativeint -> t = "ml_z_of_nativeint"
external of_float: float -> t = "ml_z_of_float"
let uint32_mask = pred (shift_left (of_int 1) 32)
let of_int32_unsigned x = logand (of_int32 x) uint32_mask
let uint64_mask = pred (shift_left (of_int 1) 64)
let of_int64_unsigned x = logand (of_int64 x) uint64_mask
let uintnat_mask = pred (shift_left (of_int 1) Nativeint.size)
let of_nativeint_unsigned x = logand (of_nativeint x) uintnat_mask
external c_to_int: t -> int = "ml_z_to_int"
let to_int x =
if is_small_int x then unsafe_to_int x else c_to_int x
external to_int32: t -> int32 = "ml_z_to_int32"
external to_int64: t -> int64 = "ml_z_to_int64"
external to_nativeint: t -> nativeint = "ml_z_to_nativeint"
external to_int32_unsigned: t -> int32 = "ml_z_to_int32_unsigned"
external to_int64_unsigned: t -> int64 = "ml_z_to_int64_unsigned"
external to_nativeint_unsigned: t -> nativeint = "ml_z_to_nativeint_unsigned"
external format: string -> t -> string = "ml_z_format"
external of_substring_base: int -> string -> pos:int -> len:int -> t = "ml_z_of_substring_base"
external compare: t -> t -> int = "ml_z_compare" [@@noalloc]
external equal: t -> t -> bool = "ml_z_equal" [@@noalloc]
external sign: t -> int = "ml_z_sign" [@@noalloc]
external gcd: t -> t -> t = "ml_z_gcd"
external gcdext_intern: t -> t -> (t * t * bool) = "ml_z_gcdext_intern"
external sqrt: t -> t = "ml_z_sqrt"
external sqrt_rem: t -> (t * t) = "ml_z_sqrt_rem"
external numbits: t -> int = "ml_z_numbits" [@@noalloc]
external trailing_zeros: t -> int = "ml_z_trailing_zeros" [@@noalloc]
external popcount: t -> int = "ml_z_popcount"
external hamdist: t -> t -> int = "ml_z_hamdist"
external size: t -> int = "ml_z_size" [@@noalloc]
external fits_int: t -> bool = "ml_z_fits_int" [@@noalloc]
external fits_int32: t -> bool = "ml_z_fits_int32" [@@noalloc]
external fits_int64: t -> bool = "ml_z_fits_int64" [@@noalloc]
external fits_nativeint: t -> bool = "ml_z_fits_nativeint" [@@noalloc]
external fits_int32_unsigned: t -> bool = "ml_z_fits_int32_unsigned" [@@noalloc]
external fits_int64_unsigned: t -> bool = "ml_z_fits_int64_unsigned" [@@noalloc]
external fits_nativeint_unsigned: t -> bool = "ml_z_fits_nativeint_unsigned" [@@noalloc]
external extract: t -> int -> int -> t = "ml_z_extract"
external powm: t -> t -> t -> t = "ml_z_powm"
external pow: t -> int -> t = "ml_z_pow"
external powm_sec: t -> t -> t -> t = "ml_z_powm_sec"
external root: t -> int -> t = "ml_z_root"
external rootrem: t -> int -> t * t = "ml_z_rootrem"
external invert: t -> t -> t = "ml_z_invert"
external perfect_power: t -> bool = "ml_z_perfect_power"
external perfect_square: t -> bool = "ml_z_perfect_square"
external probab_prime: t -> int -> int = "ml_z_probab_prime"
external nextprime: t -> t = "ml_z_nextprime"
let hash: t -> int = Stdlib.Hashtbl.hash
let seeded_hash: int -> t -> int = Stdlib.Hashtbl.seeded_hash
external to_bits: t -> string = "ml_z_to_bits"
external of_bits: string -> t = "ml_z_of_bits"
external c_divisible: t -> t -> bool = "ml_z_divisible"
let divisible x y =
if is_small_int x then
if is_small_int y then
if unsafe_to_int y = 0
then unsafe_to_int x = 0
else (unsafe_to_int x) mod (unsafe_to_int y) = 0
else
(* If y divides x, we have |y| <= |x| or x = 0.
Here, x is small: min_int <= x <= max_int
and y is not small: y < min_int \/ y > max_int.
|y| <= |x| is possible only if
x = min_int and y = -min_int = max_int+1 .
So, the only two cases where y divides x are
x = 0 or x = min_int /\ y = -min_int. *)
unsafe_to_int x = 0 || (unsafe_to_int x = min_int && y = c_neg x)
else
c_divisible x y
external congruent: t -> t -> t -> bool = "ml_z_congruent"
external jacobi: t -> t -> int = "ml_z_jacobi"
external legendre: t -> t -> int = "ml_z_legendre"
external kronecker: t -> t -> int = "ml_z_kronecker"
external remove: t -> t -> t * int = "ml_z_remove"
external fac: int -> t = "ml_z_fac"
external fac2: int -> t = "ml_z_fac2"
external facM: int -> int -> t = "ml_z_facM"
external primorial: int -> t = "ml_z_primorial"
external bin: t -> int -> t = "ml_z_bin"
external fib: int -> t = "ml_z_fib"
external lucnum: int -> t = "ml_z_lucnum"
let zero = of_int 0
let one = of_int 1
let minus_one = of_int (-1)
let min a b = if compare a b <= 0 then a else b
let max a b = if compare a b >= 0 then a else b
let leq a b = compare a b <= 0
let geq a b = compare a b >= 0
let lt a b = compare a b < 0
let gt a b = compare a b > 0
let to_string = format "%d"
let of_string s = of_substring_base 0 s ~pos:0 ~len:(String.length s)
let of_substring = of_substring_base 0
let of_string_base base s = of_substring_base base s ~pos:0 ~len:(String.length s)
let ediv_rem a b =
(* we have a = q * b + r, but [Big_int]'s remainder satisfies 0 <= r < |b|,
while [Z]'s remainder satisfies -|b| < r < |b| and sign(r) = sign(a)
*)
let q,r = div_rem a b in
if sign r >= 0 then (q,r) else
if sign b >= 0 then (pred q, add r b)
else (succ q, sub r b)
let ediv a b =
if sign b >= 0 then fdiv a b else cdiv a b
let erem a b =
let r = rem a b in
if sign r >= 0 then r else add r (abs b)
let gcdext u v =
match sign u, sign v with
(* special cases: one argument is null *)
| 0, 0 -> zero, zero, zero
| 0, 1 -> v, zero, one
| 0, -1 -> neg v, zero, minus_one
| 1, 0 -> u, one, zero
| -1, 0 -> neg u, minus_one, zero
| _ ->
(* general case *)
let g,s,z = gcdext_intern u v in
if z then g, s, div (sub g (mul u s)) v
else g, div (sub g (mul v s)) u, s
let lcm u v =
if u = zero || v = zero then zero
else
let g = gcd u v in
abs (mul (divexact u g) v)
external testbit_internal: t -> int -> bool = "ml_z_testbit" [@@noalloc]
let testbit x n =
if n >= 0 then testbit_internal x n else invalid_arg "Z.testbit"
(* The test [n >= 0] is done in Caml rather than in the C stub code
so that the latter raises no exceptions and can be declared [@@noalloc]. *)
let is_odd x = testbit_internal x 0
let is_even x = not (testbit_internal x 0)
external c_extract_small: t -> int -> int -> t
= "ml_z_extract_small" [@@noalloc]
external c_extract: t -> int -> int -> t = "ml_z_extract"
let extract_internal x o l =
if is_small_int x then
(* Fast path *)
let o = if o >= Sys.int_size then Sys.int_size - 1 else o in
(* Shift away low "o" bits. If "o" too big, just replicate sign bit. *)
let z = unsafe_to_int x asr o in
if l < Sys.int_size then
(* Extract "l" low bits, if "l" is small enough *)
of_int (z land ((1 lsl l) - 1))
else if z >= 0 then
(* If x >= 0, the extraction of "l" low bits keeps x unchanged. *)
of_int z
else
(* If x < 0, fall through slow path *)
c_extract x o l
else if l < Sys.int_size then
(* Alternative fast path since no allocation is required *)
c_extract_small x o l
else
c_extract x o l
let extract x o l =
if o < 0 then invalid_arg "Z.extract: negative bit offset";
if l < 1 then invalid_arg "Z.extract: nonpositive bit length";
extract_internal x o l
let signed_extract x o l =
if o < 0 then invalid_arg "Z.signed_extract: negative bit offset";
if l < 1 then invalid_arg "Z.signed_extract: nonpositive bit length";
if testbit x (o + l - 1)
then lognot (extract (lognot x) o l)
else extract x o l
let log2 x =
if sign x > 0 then (numbits x) - 1 else invalid_arg "Z.log2"
let log2up x =
if sign x > 0 then numbits (pred x) else invalid_arg "Z.log2up"
(* Consider a real number [r] such that
- the integral part of [r] is the bigint [x]
- 2^54 <= |x| < 2^63
- the fractional part of [r] is 0 if [exact = true],
nonzero if [exact = false].
Then, the following function returns [r] correctly rounded
according to the current rounding mode of the processor.
This is an instance of the "round to odd" technique formalized in
"When double rounding is odd" by S. Boldo and G. Melquiond.
The claim above is lemma Fappli_IEEE_extra.round_odd_fix
from the CompCert Coq development. *)
let round_to_float x exact =
let m = to_int64 x in
(* Unless the fractional part is exactly 0, round m to an odd integer *)
let m = if exact then m else Int64.logor m 1L in
(* Then convert m to float, with the current rounding mode. *)
Int64.to_float m
let to_float x =
if Obj.is_int (Obj.repr x) then
(* Fast path *)
float_of_int (Obj.magic x : int)
else begin
let n = numbits x in
if n <= 63 then
Int64.to_float (to_int64 x)
else begin
let n = n - 55 in
(* Extract top 55 bits of x *)
let top = shift_right x n in
(* Check if the other bits are all zero *)
let exact = equal x (shift_left top n) in
(* Round to float and apply exponent *)
ldexp (round_to_float top exact) n
end
end
(* Formatting *)
let print x = print_string (to_string x)
let output chan x = output_string chan (to_string x)
let sprint () x = to_string x
let bprint b x = Buffer.add_string b (to_string x)
let pp_print f x = Format.pp_print_string f (to_string x)
(* Pseudo-random generation *)
let rec raw_bits_random ?(rng: Random.State.t option) nbits =
let rec raw_bits accu n =
if n >= nbits then (accu, n) else begin
let i =
match rng with
| None -> Random.bits ()
| Some r -> Random.State.bits r in
raw_bits (logxor (shift_left accu 30) (of_int i)) (n + 30)
end in
raw_bits zero 0
let raw_bits_from_bytes ~(fill: bytes -> int -> int -> unit) nbits =
let nbytes = (nbits + 7) / 8 in
let buf = Bytes.create nbytes in
fill buf 0 nbytes;
(of_bits (Bytes.to_string buf), nbytes * 8)
let random_bits_aux (f: int -> t * int) nbits =
if nbits < 0 then invalid_arg "random_bits: number of bits must be >= 0";
let (x, _) = f nbits in
extract x 0 nbits
let random_int_aux (f: int -> t * int) bound =
if sign bound <= 0 then invalid_arg "random_int: bound must be > 0";
let nbits1 = log2up bound in
let rec draw () =
(* The minimal number of random bits we need to draw is nbits1.
However, in the worst case, rejection (as described below)
will occur with probability almost 1/2. So, we draw more bits
than strictly necessary to make rejection much less likely.
With 4 extra bits, the probability of rejection is less than
1/32. *)
let (x, nbits) = f (nbits1 + 4) in
let y = rem x bound in
(* We divide the range of x, namely [0 .. 2^nbits), into
- k intervals of width bound :
[0 .. bound) [bound.. 2*bound) .. [(k-1) * bound.. k * bound)
- the remaining numbers: [k * bound .. 2^nbits)
k is chosen as large as possible: k = floor (2^nbits / bound).
If x falls within the k intervals of width bound,
y = x mod bound is evenly distributed in [0 .. bound)
and we can use it as the pseudo-random number.
If x falls within the [k * bound .. 2^nbits) interval,
y = x mod bound may not be evenly distributed;
we reject and draw again.
We can decide efficiently whether to reject, as follows.
Write 2^nbits = k * bound + r and x = q * bound + y,
with r and y in [0 .. bound).
If x - y <= 2^nbits - bound, then
q * bound = x - y <= 2^nbits - bound < 2^nbits - r = k * bound,
hence q < k and we can accept x.
Otherwise,
q * bound = x - y > 2^nbits - bound = (k - 1) * bound + r
hence q >= k and we must reject x.
*)
if leq (sub x y) (sub (shift_left one nbits) bound)
then y
else draw () in
draw ()
let random_int ?rng bound =
random_int_aux (raw_bits_random ?rng) bound
let random_bits ?rng nbits =
random_bits_aux (raw_bits_random ?rng) nbits
let random_int_gen ~fill bound =
random_int_aux (raw_bits_from_bytes ~fill) bound
let random_bits_gen ~fill nbits =
random_bits_aux (raw_bits_from_bytes ~fill) nbits
(* Infix notations *)
let (~-) = neg
let (~+) x = x
let (+) = add
let (-) = sub
let ( * ) = mul
let (/) = div
external (/>): t -> t -> t = "ml_z_cdiv"
external (/<): t -> t -> t = "ml_z_fdiv"
let (/|) = divexact
let (mod) = rem
let (land) = logand
let (lor) = logor
let (lxor) = logxor
let (~!) = lognot
let (lsl) = shift_left
let (asr) = shift_right
external (~$): int -> t = "%identity"
external ( ** ): t -> int -> t = "ml_z_pow"
module Compare = struct
let (=) = equal
let (<) = lt
let (>) = gt
let (<=) = leq
let (>=) = geq
let (<>) a b = not (equal a b)
end
let version = Zarith_version.version

880
unikernel/duniverse/Zarith/z.mli Normal file
View file

@ -0,0 +1,880 @@
(**
Integers.
This modules provides arbitrary-precision integers.
Small integers internally use a regular OCaml [int].
When numbers grow too large, we switch transparently to GMP numbers
([mpn] numbers fully allocated on the OCaml heap).
This interface is rather similar to that of [Int32] and [Int64],
with some additional functions provided natively by GMP
(GCD, square root, pop-count, etc.).
This file is part of the Zarith library
http://forge.ocamlcore.org/projects/zarith .
It is distributed under LGPL 2 licensing, with static linking exception.
See the LICENSE file included in the distribution.
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
a joint laboratory by:
CNRS (Centre national de la recherche scientifique, France),
ENS (École normale supérieure, Paris, France),
INRIA Rocquencourt (Institut national de recherche en informatique, France).
*)
(** {1 Toplevel} *)
(** For an optimal experience with the [ocaml] interactive toplevel,
the magic commands are:
{[
#load "zarith.cma";;
#install_printer Z.pp_print;;
]}
Alternatively, using the new [Zarith_top] toplevel module, simply:
{[
#require "zarith.top";;
]}
*)
(** {1 Types} *)
type t
(** Type of integers of arbitrary length. *)
exception Overflow
(** Raised by conversion functions when the value cannot be represented in
the destination type.
*)
(** {1 Construction} *)
val zero: t
(** The number 0. *)
val one: t
(** The number 1. *)
val minus_one: t
(** The number -1. *)
external of_int: int -> t = "%identity"
(** Converts from a base integer. *)
external of_int32: int32 -> t = "ml_z_of_int32"
(** Converts from a 32-bit (signed) integer. *)
external of_int64: int64 -> t = "ml_z_of_int64"
(** Converts from a 64-bit (signed) integer. *)
external of_nativeint: nativeint -> t = "ml_z_of_nativeint"
(** Converts from a native (signed) integer. *)
val of_int32_unsigned: int32 -> t
(** Converts from a 32-bit integer, interpreted as an unsigned integer.
@since 1.13
*)
val of_int64_unsigned: int64 -> t
(** Converts from a 64-bit integer, interpreted as an unsigned integer.
@since 1.13
*)
val of_nativeint_unsigned: nativeint -> t
(** Converts from a native integer, interpreted as an unsigned integer..
@since 1.13
*)
external of_float: float -> t = "ml_z_of_float"
(** Converts from a floating-point value.
The value is truncated (rounded towards zero).
Raises [Overflow] on infinity and NaN arguments.
*)
val of_string: string -> t
(** Converts a string to an integer.
An optional [-] prefix indicates a negative number, while a [+]
prefix is ignored.
An optional prefix [0x], [0o], or [0b] (following the optional [-]
or [+] prefix) indicates that the number is,
represented, in hexadecimal, octal, or binary, respectively.
Otherwise, base 10 is assumed.
(Unlike C, a lone [0] prefix does not denote octal.)
Raises an [Invalid_argument] exception if the string is not a
syntactically correct representation of an integer.
*)
val of_substring : string -> pos:int -> len:int -> t
(** [of_substring s ~pos ~len] is the same as [of_string (String.sub s
pos len)]
@since 1.4
*)
val of_string_base: int -> string -> t
(** Parses a number represented as a string in the specified base,
with optional [-] or [+] prefix.
The base must be between 2 and 16.
*)
external of_substring_base
: int -> string -> pos:int -> len:int -> t
= "ml_z_of_substring_base"
(** [of_substring_base base s ~pos ~len] is the same as [of_string_base
base (String.sub s pos len)]
@since 1.4
*)
(** {1 Basic arithmetic operations} *)
val succ: t -> t
(** Returns its argument plus one. *)
val pred: t -> t
(** Returns its argument minus one. *)
val abs: t -> t
(** Absolute value. *)
val neg: t -> t
(** Unary negation. *)
val add: t -> t -> t
(** Addition. *)
val sub: t -> t -> t
(** Subtraction. *)
val mul: t -> t -> t
(** Multiplication. *)
val div: t -> t -> t
(** Integer division. The result is truncated towards zero
and obeys the rule of signs.
Raises [Division_by_zero] if the divisor (second argument) is 0.
*)
val rem: t -> t -> t
(** Integer remainder. Can raise a [Division_by_zero].
The result of [rem a b] has the sign of [a], and its absolute value is
strictly smaller than the absolute value of [b].
The result satisfies the equality [a = b * div a b + rem a b].
*)
external div_rem: t -> t -> (t * t) = "ml_z_div_rem"
(** Computes both the integer quotient and the remainder.
[div_rem a b] is equal to [(div a b, rem a b)].
Raises [Division_by_zero] if [b = 0].
*)
external cdiv: t -> t -> t = "ml_z_cdiv"
(** Integer division with rounding towards +oo (ceiling).
Can raise a [Division_by_zero].
*)
external fdiv: t -> t -> t = "ml_z_fdiv"
(** Integer division with rounding towards -oo (floor).
Can raise a [Division_by_zero].
*)
val ediv_rem: t -> t -> (t * t)
(** Euclidean division and remainder. [ediv_rem a b] returns a pair [(q, r)]
such that [a = b * q + r] and [0 <= r < |b|].
Raises [Division_by_zero] if [b = 0].
*)
val ediv: t -> t -> t
(** Euclidean division. [ediv a b] is equal to [fst (ediv_rem a b)].
The result satisfies [0 <= a - b * ediv a b < |b|].
Raises [Division_by_zero] if [b = 0].
*)
val erem: t -> t -> t
(** Euclidean remainder. [erem a b] is equal to [snd (ediv_rem a b)].
The result satisfies [0 <= erem a b < |b|] and
[a = b * ediv a b + erem a b]. Raises [Division_by_zero] if [b = 0].
*)
val divexact: t -> t -> t
(** [divexact a b] divides [a] by [b], only producing correct result when the
division is exact, i.e., when [b] evenly divides [a].
It should be faster than general division.
Can raise a [Division_by_zero].
*)
val divisible: t -> t -> bool
(** [divisible a b] returns [true] if [a] is exactly divisible by [b].
Unlike the other division functions, [b = 0] is accepted
(only 0 is considered divisible by 0).
@since 1.10
*)
external congruent: t -> t -> t -> bool = "ml_z_congruent"
(** [congruent a b c] returns [true] if [a] is congruent to [b] modulo [c].
Unlike the other division functions, [c = 0] is accepted
(only equal numbers are considered equal congruent 0).
@since 1.10
*)
(** {1 Bit-level operations} *)
(** For all bit-level operations, negative numbers are considered in 2's
complement representation, starting with a virtual infinite number of
1s.
*)
val logand: t -> t -> t
(** Bitwise logical and. *)
val logor: t -> t -> t
(** Bitwise logical or. *)
val logxor: t -> t -> t
(** Bitwise logical exclusive or. *)
val lognot: t -> t
(** Bitwise logical negation.
The identity [lognot a]=[-a-1] always hold.
*)
val shift_left: t -> int -> t
(** Shifts to the left.
Equivalent to a multiplication by a power of 2.
The second argument must be nonnegative.
*)
val shift_right: t -> int -> t
(** Shifts to the right.
This is an arithmetic shift,
equivalent to a division by a power of 2 with rounding towards -oo.
The second argument must be nonnegative.
*)
val shift_right_trunc: t -> int -> t
(** Shifts to the right, rounding towards 0.
This is equivalent to a division by a power of 2, with truncation.
The second argument must be nonnegative.
*)
external numbits: t -> int = "ml_z_numbits" [@@noalloc]
(** Returns the number of significant bits in the given number.
If [x] is zero, [numbits x] returns 0. Otherwise,
[numbits x] returns a positive integer [n] such that
[2^{n-1} <= |x| < 2^n]. Note that [numbits] is defined
for negative arguments, and that [numbits (-x) = numbits x].
@since 1.4
*)
external trailing_zeros: t -> int = "ml_z_trailing_zeros" [@@noalloc]
(** Returns the number of trailing 0 bits in the given number.
If [x] is zero, [trailing_zeros x] returns [max_int].
Otherwise, [trailing_zeros x] returns a nonnegative integer [n]
which is the largest [n] such that [2^n] divides [x] evenly.
Note that [trailing_zeros] is defined for negative arguments,
and that [trailing_zeros (-x) = trailing_zeros x].
@since 1.4
*)
val testbit: t -> int -> bool
(** [testbit x n] return the value of bit number [n] in [x]:
[true] if the bit is 1, [false] if the bit is 0.
Bits are numbered from 0. Raise [Invalid_argument] if [n]
is negative.
@since 1.4
*)
external popcount: t -> int = "ml_z_popcount"
(** Counts the number of bits set.
Raises [Overflow] for negative arguments, as those have an infinite
number of bits set.
*)
external hamdist: t -> t -> int = "ml_z_hamdist"
(** Counts the number of different bits.
Raises [Overflow] if the arguments have different signs
(in which case the distance is infinite).
*)
(** {1 Conversions} *)
(** Note that, when converting to an integer type that cannot represent the
converted value, an [Overflow] exception is raised.
*)
val to_int: t -> int
(** Converts to a signed OCaml [int].
Raises an [Overflow] if the value does not fit in a signed OCaml [int]. *)
external to_int32: t -> int32 = "ml_z_to_int32"
(** Converts to a signed 32-bit integer [int32].
Raises an [Overflow] if the value does not fit in a signed [int32]. *)
external to_int64: t -> int64 = "ml_z_to_int64"
(** Converts to a signed 64-bit integer [int64].
Raises an [Overflow] if the value does not fit in a signed [int64]. *)
external to_nativeint: t -> nativeint = "ml_z_to_nativeint"
(** Converts to a native signed integer [nativeint].
Raises an [Overflow] if the value does not fit in a signed [nativeint]. *)
external to_int32_unsigned: t -> int32 = "ml_z_to_int32_unsigned"
(** Converts to an unsigned 32-bit integer.
The result is stored into an OCaml [int32].
Beware that most [Int32] operations consider [int32] to a signed type, not unsigned.
Raises an [Overflow] if the value is negative or does not fit in an unsigned 32-bit integer.
@since 1.13
*)
external to_int64_unsigned: t -> int64 = "ml_z_to_int64_unsigned"
(** Converts to an unsigned 64-bit integer.
The result is stored into an OCaml [int64].
Beware that most [Int64] operations consider [int64] to a signed type, not unsigned.
Raises an [Overflow] if the value is negative or does not fit in an unsigned 64-bit integer.
@since 1.13
*)
external to_nativeint_unsigned: t -> nativeint = "ml_z_to_nativeint_unsigned"
(** Converts to a native unsigned integer.
The result is stored into an OCaml [nativeint].
Beware that most [Nativeint] operations consider [nativeint] to a signed type, not unsigned.
Raises an [Overflow] if the value is negative or does not fit in an unsigned native integer.
@since 1.13
*)
val to_float: t -> float
(** Converts to a floating-point value.
This function rounds the given integer according to the current
rounding mode of the processor. In default mode, it returns
the floating-point number nearest to the given integer,
breaking ties by rounding to even. *)
val to_string: t -> string
(** Gives a human-readable, decimal string representation of the argument. *)
external format: string -> t -> string = "ml_z_format"
(** Gives a string representation of the argument in the specified
printf-like format.
The general specification has the following form:
[% \[flags\] \[width\] type]
Where the type actually indicates the base:
- [i], [d], [u]: decimal
- [b]: binary
- [o]: octal
- [x]: lowercase hexadecimal
- [X]: uppercase hexadecimal
Supported flags are:
- [+]: prefix positive numbers with a [+] sign
- space: prefix positive numbers with a space
- [-]: left-justify (default is right justification)
- [0]: pad with zeroes (instead of spaces)
- [#]: alternate formatting (actually, simply output a literal-like prefix: [0x], [0b], [0o])
Unlike the classic [printf], all numbers are signed (even hexadecimal ones),
there is no precision field, and characters that are not part of the format
are simply ignored (and not copied in the output).
*)
external fits_int: t -> bool = "ml_z_fits_int" [@@noalloc]
(** Whether the argument fits in an OCaml signed [int]. *)
external fits_int32: t -> bool = "ml_z_fits_int32" [@@noalloc]
(** Whether the argument fits in a signed [int32]. *)
external fits_int64: t -> bool = "ml_z_fits_int64" [@@noalloc]
(** Whether the argument fits in a signed [int64]. *)
external fits_nativeint: t -> bool = "ml_z_fits_nativeint" [@@noalloc]
(** Whether the argument fits in a signed [nativeint]. *)
external fits_int32_unsigned: t -> bool = "ml_z_fits_int32_unsigned" [@@noalloc]
(** Whether the argument is non-negative and fits in an unsigned [int32].
@since 1.13
*)
external fits_int64_unsigned: t -> bool = "ml_z_fits_int64_unsigned" [@@noalloc]
(** Whether the argument is non-negative and fits in an unsigned [int64].
@since 1.13
*)
external fits_nativeint_unsigned: t -> bool = "ml_z_fits_nativeint_unsigned" [@@noalloc]
(** Whether the argument is non-negative fits in an unsigned [nativeint].
@since 1.13
*)
(** {1 Printing} *)
val print: t -> unit
(** Prints the argument on the standard output. *)
val output: out_channel -> t -> unit
(** Prints the argument on the specified channel.
Also intended to be used as [%a] format printer in [Printf.printf].
*)
val sprint: unit -> t -> string
(** To be used as [%a] format printer in [Printf.sprintf]. *)
val bprint: Buffer.t -> t -> unit
(** To be used as [%a] format printer in [Printf.bprintf]. *)
val pp_print: Format.formatter -> t -> unit
(** Prints the argument on the specified formatter.
Can be used as [%a] format printer in [Format.printf] and as
argument to [#install_printer] in the top-level.
*)
(** {1 Ordering} *)
external compare: t -> t -> int = "ml_z_compare" [@@noalloc]
(** Comparison. [compare x y] returns 0 if [x] equals [y],
-1 if [x] is smaller than [y], and 1 if [x] is greater than [y].
Note that Pervasive.compare can be used to compare reliably two integers
only on OCaml 3.12.1 and later versions.
*)
external equal: t -> t -> bool = "ml_z_equal" [@@noalloc]
(** Equality test. *)
val leq: t -> t -> bool
(** Less than or equal. *)
val geq: t -> t -> bool
(** Greater than or equal. *)
val lt: t -> t -> bool
(** Less than (and not equal). *)
val gt: t -> t -> bool
(** Greater than (and not equal). *)
external sign: t -> int = "ml_z_sign" [@@noalloc]
(** Returns -1, 0, or 1 when the argument is respectively negative, null, or
positive.
*)
val min: t -> t -> t
(** Returns the minimum of its arguments. *)
val max: t -> t -> t
(** Returns the maximum of its arguments. *)
val is_even: t -> bool
(** Returns true if the argument is even (divisible by 2), false if odd.
@since 1.4
*)
val is_odd: t -> bool
(** Returns true if the argument is odd, false if even.
@since 1.4
*)
val hash: t -> int
(** Hashes a number, producing a small integer.
The result is consistent with equality:
if [a] = [b], then [hash a] = [hash b].
The result is the same as produced by OCaml's generic hash function,
{!Hashtbl.hash}.
Together with type {!Z.t}, the function {!Z.hash} makes it possible
to pass module {!Z} as argument to the functor {!Hashtbl.Make}.
@before 1.14 a different hash algorithm was used.
*)
val seeded_hash: int -> t -> int
(** Like {!Z.hash}, but takes a seed as extra argument for diversification.
The result is the same as produced by OCaml's generic seeded hash function,
{!Hashtbl.seeded_hash}.
Together with type {!Z.t}, the function {!Z.hash} makes it possible
to pass module {!Z} as argument to the functor {!Hashtbl.MakeSeeded}.
@since 1.14
*)
(** {1 Elementary number theory} *)
external gcd: t -> t -> t = "ml_z_gcd"
(** Greatest common divisor.
The result is always nonnegative.
We have [gcd(a,0) = gcd(0,a) = abs(a)], including [gcd(0,0) = 0].
*)
val gcdext: t -> t -> (t * t * t)
(** [gcdext u v] returns [(g,s,t)] where [g] is the greatest common divisor
and [g=us+vt].
[g] is always nonnegative.
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).
*)
val lcm: t -> t -> t
(**
Least common multiple.
The result is always nonnegative.
We have [lcm(a,0) = lcm(0,a) = 0].
*)
external powm: t -> t -> t -> t = "ml_z_powm"
(** [powm base exp mod] computes [base]^[exp] modulo [mod].
Negative [exp] are supported, in which case ([base]^-1)^(-[exp]) modulo
[mod] is computed.
However, if [exp] is negative but [base] has no inverse modulo [mod], then
a [Division_by_zero] is raised.
*)
external powm_sec: t -> t -> t -> t = "ml_z_powm_sec"
(** [powm_sec base exp mod] computes [base]^[exp] modulo [mod].
Unlike [Z.powm], this function is designed to take the same time
and have the same cache access patterns for any two same-size
arguments. Used in cryptographic applications, it provides better
resistance to side-channel attacks than [Z.powm].
The exponent [exp] must be positive, and the modulus [mod]
must be odd. Otherwise, [Invalid_arg] is raised.
@since 1.4
*)
external invert: t -> t -> t = "ml_z_invert"
(** [invert base mod] returns the inverse of [base] modulo [mod].
Raises a [Division_by_zero] if [base] is not invertible modulo [mod].
*)
external probab_prime: t -> int -> int = "ml_z_probab_prime"
(** [probab_prime x r] returns 0 if [x] is definitely composite,
1 if [x] is probably prime, and 2 if [x] is definitely prime.
The [r] argument controls how many Miller-Rabin probabilistic
primality tests are performed (5 to 10 is a reasonable value).
*)
external nextprime: t -> t = "ml_z_nextprime"
(** Returns the next prime greater than the argument.
The result is only prime with very high probability.
*)
external jacobi: t -> t -> int = "ml_z_jacobi"
(** [jacobi a b] returns the Jacobi symbol [(a/b)].
@since 1.10 *)
external legendre: t -> t -> int = "ml_z_legendre"
(** [legendre a b] returns the Legendre symbol [(a/b)].
@since 1.10 *)
external kronecker: t -> t -> int = "ml_z_kronecker"
(** [kronecker a b] returns the Kronecker symbol [(a/b)].
@since 1.10 *)
external remove: t -> t -> t * int = "ml_z_remove"
(** [remove a b] returns [a] after removing all the occurences of the
factor [b].
Also returns how many occurrences were removed.
@since 1.10 *)
external fac: int -> t = "ml_z_fac"
(** [fac n] returns the factorial of [n] ([n!]).
Raises an [Invaid_argument] if [n] is non-positive.
@since 1.10 *)
external fac2: int -> t = "ml_z_fac2"
(** [fac2 n] returns the double factorial of [n] ([n!!]).
Raises an [Invaid_argument] if [n] is non-positive.
@since 1.10 *)
external facM: int -> int -> t = "ml_z_facM"
(** [facM n m] returns the [m]-th factorial of [n].
Raises an [Invaid_argument] if [n] or [m] is non-positive.
@since 1.10 *)
external primorial: int -> t = "ml_z_primorial"
(** [primorial n] returns the product of all positive prime numbers less
than or equal to [n].
Raises an [Invaid_argument] if [n] is non-positive.
@since 1.10 *)
external bin: t -> int -> t = "ml_z_bin"
(** [bin n k] returns the binomial coefficient [n] over [k].
Raises an [Invaid_argument] if [k] is non-positive.
@since 1.10 *)
external fib: int -> t = "ml_z_fib"
(** [fib n] returns the [n]-th Fibonacci number.
Raises an [Invaid_argument] if [n] is non-positive.
@since 1.10 *)
external lucnum: int -> t = "ml_z_lucnum"
(** [lucnum n] returns the [n]-th Lucas number.
Raises an [Invaid_argument] if [n] is non-positive.
@since 1.10 *)
(** {1 Powers} *)
external pow: t -> int -> t = "ml_z_pow"
(** [pow base exp] raises [base] to the [exp] power.
[exp] must be nonnegative.
Note that only exponents fitting in a machine integer are supported, as
larger exponents would surely make the result's size overflow the
address space.
*)
external sqrt: t -> t = "ml_z_sqrt"
(** Returns the square root. The result is truncated (rounded down
to an integer).
Raises an [Invalid_argument] on negative arguments.
*)
external sqrt_rem: t -> (t * t) = "ml_z_sqrt_rem"
(** Returns the square root truncated, and the remainder.
Raises an [Invalid_argument] on negative arguments.
*)
external root: t -> int -> t = "ml_z_root"
(** [root x n] computes the [n]-th root of [x].
[n] must be positive and, if [n] is even, then [x] must be nonnegative.
Otherwise, an [Invalid_argument] is raised.
*)
external rootrem: t -> int -> t * t = "ml_z_rootrem"
(** [rootrem x n] computes the [n]-th root of [x] and the remainder
[x-root**n].
[n] must be positive and, if [n] is even, then [x] must be nonnegative.
Otherwise, an [Invalid_argument] is raised.
@since 1.10 *)
external perfect_power: t -> bool = "ml_z_perfect_power"
(** True if the argument has the form [a^b], with [b>1] *)
external perfect_square: t -> bool = "ml_z_perfect_square"
(** True if the argument has the form [a^2]. *)
val log2: t -> int
(** Returns the base-2 logarithm of its argument, rounded down to
an integer. If [x] is positive, [log2 x] returns the largest [n]
such that [2^n <= x]. If [x] is negative or zero, [log2 x] raise
the [Invalid_argument] exception.
@since 1.4
*)
val log2up: t -> int
(** Returns the base-2 logarithm of its argument, rounded up to
an integer. If [x] is positive, [log2up x] returns the smallest [n]
such that [x <= 2^n]. If [x] is negative or zero, [log2up x] raise
the [Invalid_argument] exception.
@since 1.4
*)
(** {1 Representation} *)
external size: t -> int = "ml_z_size" [@@noalloc]
(** Returns the number of machine words used to represent the number. *)
val extract: t -> int -> int -> t
(** [extract a off len] returns a nonnegative number corresponding to bits
[off] to [off]+[len]-1 of [a].
Negative [a] are considered in infinite-length 2's complement
representation.
Raises an [Invalid_argument] if [off] is strictly negative, or if [len] is negative or null.
*)
val signed_extract: t -> int -> int -> t
(** [signed_extract a off len] extracts bits [off] to [off]+[len]-1 of [b],
as [extract] does, then sign-extends bit [len-1] of the result
(that is, bit [off + len - 1] of [a]). The result is between
[- 2{^[len]-1}] (included) and [2{^[len]-1}] (excluded),
and equal to [extract a off len] modulo [2{^len}].
Raises an [Invalid_argument] if [off] is strictly negative, or if [len] is negative or null.
*)
external to_bits: t -> string = "ml_z_to_bits"
(** Returns a binary representation of the argument.
The string result should be interpreted as a sequence of bytes,
corresponding to the binary representation of the absolute value of
the argument in little endian ordering.
The sign is not stored in the string.
*)
external of_bits: string -> t = "ml_z_of_bits"
(** Constructs a number from a binary string representation.
The string is interpreted as a sequence of bytes in little endian order,
and the result is always positive.
We have the identity: [of_bits (to_bits x) = abs x].
However, we can have [to_bits (of_bits s) <> s] due to the presence of
trailing zeros in s.
*)
(** {1 Pseudo-random number generation} *)
val random_int: ?rng: Random.State.t -> t -> t
(** [random_int bound] returns a random integer between 0 (inclusive)
and [bound] (exclusive). [bound] must be greater than 0.
The source of randomness is the {!Random} module from the OCaml
standard library. The optional [rng] argument specifies which
random state to use. If omitted, the default random state for the
{!Random} module is used.
Random numbers produced by this function are not cryptographically
strong and must not be used in cryptographic or high-security
contexts. See {!Z.random_int_gen} for an alternative.
@since 1.13
*)
val random_bits: ?rng: Random.State.t -> int -> t
(** [random_bits nbits] returns a random integer between 0 (inclusive)
and [2{^nbits}] (exclusive). [nbits] must be nonnegative.
This is a more efficient special case of {!Z.random_int} when the
bound is a power of two.
The source of randomness and the [rng] optional argument are as
described in {!Z.random_int}.
Random numbers produced by this function are not cryptographically
strong and must not be used in cryptographic or high-security
contexts. See {!Z.random_bits_gen} for an alternative.
@since 1.13
*)
val random_int_gen: fill: (bytes -> int -> int -> unit) -> t -> t
(** [random_int_gen ~fill bound] returns a random integer between 0 (inclusive)
and [bound] (exclusive). [bound] must be greater than 0.
The [fill] parameter is the source of randomness. It is called
as [fill buf pos len], and is responsible for drawing [len] random
bytes and writing them to offsets [pos] to [pos + len - 1] of
the byte array [buf].
Example of use where [/dev/random] provides the random bytes:
<<
In_channel.with_open_bin "/dev/random"
(fun ic -> Z.random_int_gen ~fill:(really_input ic) bound)
>>
Example of use where the Cryptokit library provides the random bytes:
<<
Z.random_int_gen ~fill:Cryptokit.Random.secure_rng#bytes bound
>>
@since 1.13
*)
val random_bits_gen: fill: (bytes -> int -> int -> unit) -> int -> t
(** [random_bits_gen ~fill nbits] returns a random integer between 0 (inclusive)
and [2{^nbits}] (exclusive). [nbits] must be nonnegative.
This is a more efficient special case of {!Z.random_int_gen} when the
bound is a power of two. The [fill] parameter is as described in
{!Z.random_int_gen}.
@since 1.13
*)
(** {1 Prefix and infix operators} *)
(**
Classic (and less classic) prefix and infix [int] operators are
redefined on [t].
This makes it easy to typeset expressions.
Using OCaml 3.12's local open, you can simply write
[Z.(~$2 + ~$5 * ~$10)].
*)
val (~-): t -> t
(** Negation [neg]. *)
val (~+): t -> t
(** Identity. *)
val (+): t -> t -> t
(** Addition [add]. *)
val (-): t -> t -> t
(** Subtraction [sub]. *)
val ( * ): t -> t -> t
(** Multiplication [mul]. *)
val (/): t -> t -> t
(** Truncated division [div]. *)
external (/>): t -> t -> t = "ml_z_cdiv"
(** Ceiling division [cdiv]. *)
external (/<): t -> t -> t = "ml_z_fdiv"
(** Flooring division [fdiv]. *)
val (/|): t -> t -> t
(** Exact division [divexact]. *)
val (mod): t -> t -> t
(** Remainder [rem]. *)
val (land): t -> t -> t
(** Bit-wise logical and [logand]. *)
val (lor): t -> t -> t
(** Bit-wise logical inclusive or [logor]. *)
val (lxor): t -> t -> t
(** Bit-wise logical exclusive or [logxor]. *)
val (~!): t -> t
(** Bit-wise logical negation [lognot]. *)
val (lsl): t -> int -> t
(** Bit-wise shift to the left [shift_left]. *)
val (asr): t -> int -> t
(** Bit-wise shift to the right [shift_right]. *)
external (~$): int -> t = "%identity"
(** Conversion from [int] [of_int]. *)
external ( ** ): t -> int -> t = "ml_z_pow"
(** Power [pow]. *)
module Compare : sig
val (=): t -> t -> bool
(** Same as [equal]. *)
val (<): t -> t -> bool
(** Same as [lt]. *)
val (>): t -> t -> bool
(** Same as [gt]. *)
val (<=): t -> t -> bool
(** Same as [leq]. *)
val (>=): t -> t -> bool
(** Same as [geq]. *)
val (<>): t -> t -> bool
(** [a <> b] is equivalent to [not (equal a b)]. *)
end
(** {1 Miscellaneous} *)
val version: string
(** Library version.
@since 1.1
*)
(**/**)
(** For internal use in module [Q]. *)
val round_to_float: t -> bool -> float

49
unikernel/duniverse/Zarith/z_mlgmpidl.ml Normal file
View file

@ -0,0 +1,49 @@
(**
Conversion between Zarith and MLGmpIDL integers and rationals.
This file is part of the Zarith library
http://forge.ocamlcore.org/projects/zarith .
It is distributed under LGPL 2 licensing, with static linking exception.
See the LICENSE file included in the distribution.
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
a joint laboratory by:
CNRS (Centre national de la recherche scientifique, France),
ENS (École normale supérieure, Paris, France),
INRIA Rocquencourt (Institut national de recherche en informatique, France).
*)
external mlgmpidl_of_mpz: Mpz.t -> Z.t = "ml_z_mlgmpidl_of_mpz"
external mlgmpidl_set_mpz: Mpz.t -> Z.t -> unit = "ml_z_mlgmpidl_set_mpz"
let z_of_mpz x =
mlgmpidl_of_mpz x
let mpz_of_z x =
let r = Mpz.init () in
mlgmpidl_set_mpz r x;
r
let z_of_mpzf x =
z_of_mpz (Mpzf._mpz x)
let mpzf_of_z x =
Mpzf._mpzf (mpz_of_z x)
let q_of_mpq x =
let n,d = Mpz.init (), Mpz.init () in
Mpq.get_num n x;
Mpq.get_den d x;
Q.make (z_of_mpz n) (z_of_mpz d)
let mpq_of_q x =
Mpq.of_mpz2 (mpz_of_z x.Q.num) (mpz_of_z x.Q.den)
let q_of_mpqf x =
q_of_mpq (Mpqf._mpq x)
let mpqf_of_q x =
Mpqf._mpqf (mpq_of_q x)

26
unikernel/duniverse/Zarith/z_mlgmpidl.mli Normal file
View file

@ -0,0 +1,26 @@
(**
Conversion between Zarith and MLGmpIDL integers and rationals.
This file is part of the Zarith library
http://forge.ocamlcore.org/projects/zarith .
It is distributed under LGPL 2 licensing, with static linking exception.
See the LICENSE file included in the distribution.
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
a joint laboratory by:
CNRS (Centre national de la recherche scientifique, France),
ENS (École normale supérieure, Paris, France),
INRIA Rocquencourt (Institut national de recherche en informatique, France).
*)
val z_of_mpz: Mpz.t -> Z.t
val mpz_of_z: Z.t -> Mpz.t
val z_of_mpzf: Mpzf.t -> Z.t
val mpzf_of_z: Z.t -> Mpzf.t
val q_of_mpq: Mpq.t -> Q.t
val mpq_of_q: Q.t -> Mpq.t
val q_of_mpqf: Mpqf.t -> Q.t
val mpqf_of_q: Q.t -> Mpqf.t

42
unikernel/duniverse/Zarith/zarith.h Normal file
View file

@ -0,0 +1,42 @@
/**
Public C interface for Zarith.
This is intended for C libraries that wish to convert between mpz_t and
Z.t objects.
This file is part of the Zarith library
http://forge.ocamlcore.org/projects/zarith .
It is distributed under LGPL 2 licensing, with static linking exception.
See the LICENSE file included in the distribution.
Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
a joint laboratory by:
CNRS (Centre national de la recherche scientifique, France),
ENS (École normale supérieure, Paris, France),
INRIA Rocquencourt (Institut national de recherche en informatique, France).
*/
/* gmp.h or mpir.h must be included manually before zarith.h */
#ifdef __cplusplus
extern "C" {
#endif
#include <caml/mlvalues.h>
/* sets rop to the value in op (limbs are copied) */
void ml_z_mpz_set_z(mpz_t rop, value op);
/* inits and sets rop to the value in op (limbs are copied) */
void ml_z_mpz_init_set_z(mpz_t rop, value op);
/* returns a new z objects equal to op (limbs are copied) */
value ml_z_from_mpz(mpz_t op);
#ifdef __cplusplus
}
#endif

29
unikernel/duniverse/Zarith/zarith.opam Normal file
View file

@ -0,0 +1,29 @@
version: "release-1.14-1-gdf8969d"
opam-version: "2.0"
maintainer: "Xavier Leroy <xavier.leroy@inria.fr>"
authors: [
"Antoine Miné"
"Xavier Leroy"
"Pascal Cuoq"
]
homepage: "https://github.com/mirage/Zarith"
bug-reports: "https://github.com/mirage/Zarith/issues"
dev-repo: "git+https://github.com/mirage/Zarith.git"
license: "LGPL-2.0-only WITH OCaml-LGPL-linking-exception"
build: [
["dune" "build" "-p" "zarith" ]
]
depends: [
"ocaml" {>= "4.07.0"}
"dune" {>= "2.8"}
("gmp" | "conf-gmp" )
]
conflicts: [ "gmp" {< "6.2.1-5"} ]
synopsis:
"Implements arithmetic and logical operations over arbitrary-precision integers"
description: """
The Zarith library implements arithmetic and logical operations over
arbitrary-precision integers. It uses GMP to efficiently implement
arithmetic over big integers. Small integers are represented as Caml
unboxed integers, for speed and space economy."""
tags: ["cross-compile"]

23
unikernel/duniverse/Zarith/zarith_top.ml Normal file
View file

@ -0,0 +1,23 @@
(*
This file is part of the Zarith library
http://forge.ocamlcore.org/projects/zarith .
It is distributed under LGPL 2 licensing, with static linking exception.
See the LICENSE file included in the distribution.
Contributed by Christophe Troestler.
*)
open Printf
let eval_string
?(print_outcome = false) ?(err_formatter = Format.err_formatter) str =
let lexbuf = Lexing.from_string str in
let phrase = !Toploop.parse_toplevel_phrase lexbuf in
Toploop.execute_phrase print_outcome err_formatter phrase
let () =
let printers = ["Z.pp_print"; "Q.pp_print"] in
let ok = List.fold_left (fun b p ->
b && eval_string(sprintf "#install_printer %s;;" p))
true printers in
if not ok then Format.eprintf "Problem installing ZArith-printers@."