diff --git a/.gitmodules b/.gitmodules
index 79b5622ce93aec2d76713ac56f3789f69ea5745b..c44e7335e59ee32416d773af952585712021336b 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -105,7 +105,7 @@
url = https://gitlab.haskell.org/ghc/libffi-tarballs.git
ignore = untracked
[submodule "gmp-tarballs"]
- path = libraries/integer-gmp/gmp/gmp-tarballs
+ path = libraries/ghc-bignum/gmp/gmp-tarballs
url = https://gitlab.haskell.org/ghc/gmp-tarballs.git
[submodule "libraries/exceptions"]
path = libraries/exceptions
diff --git a/docs/users_guide/extending_ghc.rst b/docs/users_guide/extending_ghc.rst
index b44038e02c31cdbdfa0e1d54cdf5a55ffe19e55b..a5ba52e88e71930a911712ca9dc6f5ddb3aa27c2 100644
--- a/docs/users_guide/extending_ghc.rst
+++ b/docs/users_guide/extending_ghc.rst
@@ -854,7 +854,7 @@ When you compile a simple module that contains Template Haskell splice
a = ()
-$(return [])
+ $(return [])
with the compiler flags ``-fplugin SourcePlugin`` it will give the following
output:
@@ -865,16 +865,12 @@ output:
module A where
a = ()
$(return [])
- interface loaded: Prelude
- interface loaded: GHC.Float
- interface loaded: GHC.Base
+ typeCheckPlugin (rn): a = ()
interface loaded: Language.Haskell.TH.Lib.Internal
- interface loaded: Language.Haskell.TH.Syntax
- interface loaded: GHC.Types
meta: return []
- interface loaded: GHC.Integer.Type
typeCheckPlugin (rn):
- Just a = ()
+ typeCheckPlugin (rn):
+ Nothing
typeCheckPlugin (tc):
{$trModule = Module (TrNameS "main"#) (TrNameS "A"#), a = ()}
diff --git a/libraries/integer-gmp/.gitignore b/libraries/ghc-bignum/.gitignore
similarity index 100%
rename from libraries/integer-gmp/.gitignore
rename to libraries/ghc-bignum/.gitignore
diff --git a/libraries/integer-gmp/README.rst b/libraries/ghc-bignum/GMP.rst
similarity index 67%
rename from libraries/integer-gmp/README.rst
rename to libraries/ghc-bignum/GMP.rst
index e5f19279d95502fe4c6f2b586ea17cbfd8342eb6..cfdd31235d7b2ce445a8c4ea6705d8241135c472 100644
--- a/libraries/integer-gmp/README.rst
+++ b/libraries/ghc-bignum/GMP.rst
@@ -1,18 +1,18 @@
GMP
===
-integer-gmp depends on the external GMP library (gmplib.org). The latter
-provides a header ("gmp.h") and a library to link with.
+ghc-bignum's GMP backend depends on the external GMP library (gmplib.org). The
+latter provides a header ("gmp.h") and a library to link with.
Linking
-------
Sadly we can't just put a ``extra-libraries: gmp`` field in the Cabal file because
-``integer-gmp`` is a boot package that is part of GHC's *binary* distribution.
+``ghc-bignum`` is a boot package that is part of GHC's *binary* distribution.
It means that it won't be rebuilt on each user platform. In particular it can be
used in an environment that doesn't provide GMP.
-A solution would be to always link GMP statically with ``integer-gmp``, but:
+A solution would be to always link GMP statically with ``ghc-bignum``, but:
1. GMP's license is LPGL while GHC's license is BSD
@@ -32,7 +32,7 @@ As Cabal can't statically link an external library with a Haskell library,
GHC's build system uses a hack:
1. it builds libgmp.a
2. it extracts the objects (.o) from it
- 3. it passes these objects as "extra" objects when it links integer-gmp
+ 3. it passes these objects as "extra" objects when it links ghc-bignum
Note that these objects must be built as position independent code (PIC) because
they end up being used in statically and dynamically linked code (cf #17799).
@@ -45,19 +45,20 @@ GMP is linked:
.. code::
+ --with-gmp enable GMP backend
--with-gmp-includes directory containing gmp.h
--with-gmp-libraries directory containing gmp library
--with-intree-gmp force using the in-tree GMP
--with-gmp-framework-preferred on OSX, prefer the GMP framework to the gmp lib
-These options are then used when integer-gmp package is configured: in the
+These options are then used when ghc-bignum package is configured: in the
.cabal file, we can see the field ``build-type: Configure``, meaning that the
-``configure`` script in ``libraries/integer-gmp/`` is executed during the setup
+``configure`` script in ``libraries/ghc-bignum/`` is executed during the setup
phase of the package.
-This script is responsible of creating ``integer-gmp.buildinfo`` (from
-``integer-gmp.buildinfo.in``). The fields contained in this file are
-merged with the ones already defined in ``integer-gmp.cabal``.
+This script is responsible of creating ``ghc-bignum.buildinfo`` (from
+``ghc-bignum.buildinfo.in``). The fields contained in this file are
+merged with the ones already defined in ``ghc-bignum.cabal``.
See
https://www.haskell.org/cabal/users-guide/developing-packages.html#system-dependent-parameters.
@@ -65,10 +66,10 @@ https://www.haskell.org/cabal/users-guide/developing-packages.html#system-depend
Headers
-------
-When GMP is statically linked (in-tree build), a user of the integer-gmp package
+When GMP is statically linked (in-tree build), a user of the ghc-bignum package
can't have access to the "gmp.h" header file. So GHC's build system copies the
-``ghc.h`` header from the in-tree build to ``integer-gmp/include/ghc-gmp.h``. As you
-can see in ``integer-gmp.buildinfo[.in]``, ``ghc-gmp.h`` is installed as a
+``ghc.h`` header from the in-tree build to ``ghc-bignum/include/ghc-gmp.h``. As you
+can see in ``ghc-bignum.buildinfo[.in]``, ``ghc-gmp.h`` is installed as a
header (``install-includes`` field).
While the commit that introduced it (a9a0dd34dcdfb7309f57bda88435acca14ec54d5)
@@ -77,4 +78,4 @@ doesn't document it, it's probably to get access to other GMP functions.
Note that when in-tree GMP build isn't used, ``ghc-gmp.h`` only contains
``#include <gmp.h>``. Hence it imports the header from the HOST platform, which
may not be exactly the same as the one used on the BUILD platform to build the
-integer-gmp package.
+ghc-bignum package.
diff --git a/libraries/ghc-bignum/LICENSE b/libraries/ghc-bignum/LICENSE
new file mode 100644
index 0000000000000000000000000000000000000000..c282c942ff72d0919a4abc184d41f3e3a0f671e2
--- /dev/null
+++ b/libraries/ghc-bignum/LICENSE
@@ -0,0 +1,31 @@
+The Glasgow Haskell Compiler License
+
+Copyright 2020, The University Court of the University of Glasgow.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
diff --git a/libraries/ghc-bignum/README.rst b/libraries/ghc-bignum/README.rst
new file mode 100644
index 0000000000000000000000000000000000000000..83e9fe85465d2bc819455ea17967ba430dc9440f
--- /dev/null
+++ b/libraries/ghc-bignum/README.rst
@@ -0,0 +1,81 @@
+GHC BIGNUM LIBRARY
+==================
+
+This package contains the implementation of the infinite precision integral
+types ("big numbers/bignum"):
+
+* BigNat: a positive natural represented as an array of Word# in memory
+* Natural: a positive natural represented either by a Word# or by a BigNat
+* Integer: a signed integer represented either by an Int# or in sign-magnitude
+ representation where the magnitude is represented by a BigNat
+
+Natural and Integer have each two representations:
+
+* a small one: Word# or Int# respectively
+* a large one: based on BigNat
+
+The small representation is used when the number fits in it. We do this because
+GHC is very good at optimizing codes which use Word#/Int# representations
+(e.g. storing the number in registers instead of in memory).
+
+Backends
+--------
+
+Several backends providing the implementation of some BigNat operations are
+supported:
+
+* GMP: based on the `GNU Multiple Precision Arithmetic library
+ <https://gmplib.org/>`_ library (adapted from the legacy integer-gmp package)
+
+* Native: a pure Haskell implementation written from scratch by Sylvain Henry.
+ It replaces the previous pure Haskell implementation provided by the
+ integer-simple package. The major difference is that it uses a much more
+ efficient memory representation (integer-simple was based on Haskell lists)
+ and that it allows a lot more code sharing between the different backends than
+ was previously possible between integer-gmp and integer-simple.
+
+* FFI: an implementation that relies on external FFI calls. This backend can be
+ useful:
+
+ * for alternative GHC backends that target non native platforms (JavaScript,
+ JVM, etc.): the backend can dynamically match and rewrite the FFI calls in
+ order to call the appropriate platform specific BigNum API.
+
+ * to test new native backends: just tweak the ghc-bignum build to link with
+ the native library providing the implementation of the FFI calls
+
+ Note that the FFI backend module contains the description of the interface
+ that needs to be implemented by every backend.
+
+This package has been designed to make the implementation of new backends
+relatively easy. Previously you had to implement the whole Integer/Natural
+interface, to create a new package, etc. Now everything is well contained and
+you only have to implement a small part of the BigNat interface. If you want to
+try to implement a new backend, you don't have to implement the whole interface
+upfront as you can always use the implementation provided by the Native backend
+as a fall back.
+
+
+Avoiding `patError`
+-------------------
+
+ghc-bignum is below `base` package. Hence if we use the natural set of
+definitions for functions, e.g.:
+
+ integerXor (IS x) y = ...
+ integerXor x (IS y) = ...
+ integerXor ...
+
+then GHC may not be smart enough (especially when compiling with -O0)
+to see that all the cases are handled, and will thus insert calls to
+`base:Control.Exception.Base.patError`. But we are below `base` in the
+package hierarchy, so this causes link failure!
+
+We therefore help GHC out, by being more explicit about what all the
+cases are:
+
+ integerXor a b = case a of
+ IS x -> case b of
+ IS y -> ...
+ IN y -> ...
+ ...
diff --git a/libraries/integer-gmp/Setup.hs b/libraries/ghc-bignum/Setup.hs
similarity index 100%
rename from libraries/integer-gmp/Setup.hs
rename to libraries/ghc-bignum/Setup.hs
diff --git a/libraries/integer-gmp/aclocal.m4 b/libraries/ghc-bignum/aclocal.m4
similarity index 100%
rename from libraries/integer-gmp/aclocal.m4
rename to libraries/ghc-bignum/aclocal.m4
diff --git a/libraries/integer-gmp/cbits/wrappers.c b/libraries/ghc-bignum/cbits/gmp_wrappers.c
similarity index 99%
rename from libraries/integer-gmp/cbits/wrappers.c
rename to libraries/ghc-bignum/cbits/gmp_wrappers.c
index ef1bdead2f1123b3f9cfe0746ff7789b8d96b4e6..cbcf768391f535451c6186c8cf81525256baa28a 100644
--- a/libraries/integer-gmp/cbits/wrappers.c
+++ b/libraries/ghc-bignum/cbits/gmp_wrappers.c
@@ -1,5 +1,5 @@
/*
- * `integer-gmp` GMP FFI wrappers
+ * `ghc-bignum` GMP FFI wrappers
*
* Copyright (c) 2014, Herbert Valerio Riedel <hvr@gnu.org>
*
diff --git a/libraries/ghc-bignum/changelog.md b/libraries/ghc-bignum/changelog.md
new file mode 100644
index 0000000000000000000000000000000000000000..4106aec218cd57762be67114e7d253bd4328cf9d
--- /dev/null
+++ b/libraries/ghc-bignum/changelog.md
@@ -0,0 +1 @@
+# Changelog for `ghc-bignum` package
diff --git a/libraries/integer-gmp/config.guess b/libraries/ghc-bignum/config.guess
similarity index 100%
rename from libraries/integer-gmp/config.guess
rename to libraries/ghc-bignum/config.guess
diff --git a/libraries/integer-gmp/config.mk.in b/libraries/ghc-bignum/config.mk.in
similarity index 84%
rename from libraries/integer-gmp/config.mk.in
rename to libraries/ghc-bignum/config.mk.in
index 2556326b2d0a9268ce6c5f8c4e41081b7340ed0b..8478314ab14d673a7dc14519700da8e64d0ddbb0 100644
--- a/libraries/integer-gmp/config.mk.in
+++ b/libraries/ghc-bignum/config.mk.in
@@ -1,4 +1,4 @@
-# NB: This file lives in the top-level integer-gmp folder, and not in
+# NB: This file lives in the top-level ghc-bignum folder, and not in
# the gmp subfolder, because of #14972, where we MUST NOT create a
# folder named 'gmp' in dist/build/
diff --git a/libraries/integer-gmp/config.sub b/libraries/ghc-bignum/config.sub
similarity index 100%
rename from libraries/integer-gmp/config.sub
rename to libraries/ghc-bignum/config.sub
diff --git a/libraries/ghc-bignum/configure.ac b/libraries/ghc-bignum/configure.ac
new file mode 100644
index 0000000000000000000000000000000000000000..1c658fdb70431eaf707a73184f52e44b904ec692
--- /dev/null
+++ b/libraries/ghc-bignum/configure.ac
@@ -0,0 +1,127 @@
+AC_PREREQ(2.69)
+AC_INIT([GHC BigNum library], [1.0], [libraries@haskell.org], [ghc-bignum])
+
+# Safety check: Ensure that we are in the correct source directory.
+AC_CONFIG_SRCDIR([cbits/gmp_wrappers.c])
+
+AC_CANONICAL_TARGET
+
+AC_PROG_CC
+dnl make extensions visible to allow feature-tests to detect them lateron
+AC_USE_SYSTEM_EXTENSIONS
+
+
+dnl--------------------------------------------------------------------
+dnl * Deal with arguments telling us gmp is somewhere odd
+dnl--------------------------------------------------------------------
+
+AC_ARG_WITH([gmp],
+ [AC_HELP_STRING([--with-gmp],
+ [Enable GMP backend])],
+ [GMP_ENABLED=YES],
+ [GMP_ENABLED=NO])
+
+AC_ARG_WITH([gmp-includes],
+ [AC_HELP_STRING([--with-gmp-includes],
+ [directory containing gmp.h])],
+ [GMP_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval"],
+ [GMP_INCLUDE_DIRS=])
+
+AC_ARG_WITH([gmp-libraries],
+ [AC_HELP_STRING([--with-gmp-libraries],
+ [directory containing gmp library])],
+ [GMP_LIB_DIRS=$withval; LDFLAGS="-L$withval"],
+ [GMP_LIB_DIRS=])
+
+AC_ARG_WITH([gmp-framework-preferred],
+ [AC_HELP_STRING([--with-gmp-framework-preferred],
+ [on OSX, prefer the GMP framework to the gmp lib])],
+ [GMP_PREFER_FRAMEWORK=YES],
+ [GMP_PREFER_FRAMEWORK=NO])
+
+AC_ARG_WITH([intree-gmp],
+ [AC_HELP_STRING([--with-intree-gmp],
+ [force using the in-tree GMP])],
+ [GMP_FORCE_INTREE=YES],
+ [GMP_FORCE_INTREE=NO])
+
+if test "$GMP_ENABLED" = "YES"
+then
+
+dnl--------------------------------------------------------------------
+dnl * Detect gmp
+dnl--------------------------------------------------------------------
+
+ HaveLibGmp=NO
+ GMP_LIBS=
+ HaveFrameworkGMP=NO
+ GMP_FRAMEWORK=
+ HaveSecurePowm=0
+
+ if test "$GMP_FORCE_INTREE" != "YES"
+ then
+ if test "$GMP_PREFER_FRAMEWORK" = "YES"
+ then
+ LOOK_FOR_GMP_FRAMEWORK
+ LOOK_FOR_GMP_LIB
+ else
+ LOOK_FOR_GMP_LIB
+ LOOK_FOR_GMP_FRAMEWORK
+ fi
+ fi
+
+ AC_MSG_CHECKING([whether to use in-tree GMP])
+ if test "$HaveFrameworkGMP" = "YES" || test "$HaveLibGmp" = "YES"
+ then
+ AC_MSG_RESULT([no])
+ UseIntreeGmp=0
+ AC_CHECK_HEADER([gmp.h], , [AC_MSG_ERROR([Cannot find gmp.h])])
+
+ AC_MSG_CHECKING([GMP version])
+ AC_COMPUTE_INT(GhcGmpVerMj, __GNU_MP_VERSION, [#include <gmp.h>],
+ AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION]))
+ AC_COMPUTE_INT(GhcGmpVerMi, __GNU_MP_VERSION_MINOR, [#include <gmp.h>],
+ AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_MINOR]))
+ AC_COMPUTE_INT(GhcGmpVerPl, __GNU_MP_VERSION_PATCHLEVEL, [#include <gmp.h>],
+ AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_PATCHLEVEL]))
+ AC_MSG_RESULT([$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl])
+
+ else
+ AC_MSG_RESULT([yes])
+ UseIntreeGmp=1
+ HaveSecurePowm=1
+
+ AC_MSG_CHECKING([GMP version])
+ GhcGmpVerMj=6
+ GhcGmpVerMi=1
+ GhcGmpVerPl=2
+ AC_MSG_RESULT([$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl])
+ fi
+
+
+dnl--------------------------------------------------------------------
+dnl * Make sure we got some form of gmp
+dnl--------------------------------------------------------------------
+
+ AC_SUBST(GMP_INCLUDE_DIRS)
+ AC_SUBST(GMP_LIBS)
+ AC_SUBST(GMP_LIB_DIRS)
+ AC_SUBST(GMP_FRAMEWORK)
+ AC_SUBST(HaveLibGmp)
+ AC_SUBST(HaveFrameworkGMP)
+ AC_SUBST(HaveSecurePowm)
+ AC_SUBST(UseIntreeGmp)
+ AC_SUBST(GhcGmpVerMj)
+ AC_SUBST(GhcGmpVerMi)
+ AC_SUBST(GhcGmpVerPl)
+
+ AC_CONFIG_FILES([ghc-bignum.buildinfo include/HsIntegerGmp.h])
+fi
+
+AC_CONFIG_FILES([config.mk])
+
+dnl--------------------------------------------------------------------
+dnl * Generate output files
+dnl--------------------------------------------------------------------
+
+AC_OUTPUT
diff --git a/libraries/integer-gmp/integer-gmp.buildinfo.in b/libraries/ghc-bignum/ghc-bignum.buildinfo.in
similarity index 100%
rename from libraries/integer-gmp/integer-gmp.buildinfo.in
rename to libraries/ghc-bignum/ghc-bignum.buildinfo.in
diff --git a/libraries/ghc-bignum/ghc-bignum.cabal b/libraries/ghc-bignum/ghc-bignum.cabal
new file mode 100644
index 0000000000000000000000000000000000000000..3234450b5f3172d6a1b17248adfc06e090e61cb1
--- /dev/null
+++ b/libraries/ghc-bignum/ghc-bignum.cabal
@@ -0,0 +1,124 @@
+cabal-version: 2.0
+name: ghc-bignum
+version: 1.0
+synopsis: GHC BigNum library
+license: BSD3
+license-file: LICENSE
+author: Sylvain Henry
+maintainer: libraries@haskell.org
+bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new
+category: Numeric, Algebra, GHC
+build-type: Configure
+description:
+ This package provides the low-level implementation of the standard
+ 'BigNat', 'Natural' and 'Integer' types.
+
+extra-source-files:
+ aclocal.m4
+ cbits/gmp_wrappers.c
+ changelog.md
+ config.guess
+ config.sub
+ configure
+ configure.ac
+ config.mk.in
+ install-sh
+ ghc-bignum.buildinfo.in
+
+source-repository head
+ type: git
+ location: https://gitlab.haskell.org/ghc/ghc.git
+ subdir: libraries/ghc-bignum
+
+
+Flag Native
+ Description: Enable native backend
+ Manual: True
+ Default: False
+
+Flag FFI
+ Description: Enable FFI backend
+ Manual: True
+ Default: False
+
+Flag GMP
+ Description: Enable GMP backend
+ Manual: True
+ Default: False
+
+Flag Check
+ Description: Validate results of the enabled backend against native backend.
+ Manual: True
+ Default: False
+
+library
+
+ -- check that at least one flag is set
+ if !flag(native) && !flag(gmp) && !flag(ffi)
+ buildable: False
+
+ -- check that at most one flag is set
+ if flag(native) && (flag(gmp) || flag(ffi))
+ buildable: False
+ if flag(gmp) && flag(ffi)
+ buildable: False
+
+ default-language: Haskell2010
+ other-extensions:
+ BangPatterns
+ CApiFFI
+ CPP
+ DeriveDataTypeable
+ ExplicitForAll
+ GHCForeignImportPrim
+ MagicHash
+ NegativeLiterals
+ NoImplicitPrelude
+ StandaloneDeriving
+ UnboxedTuples
+ UnliftedFFITypes
+ ForeignFunctionInterface
+
+ build-depends:
+ ghc-prim >= 0.5.1.0 && < 0.7
+
+ hs-source-dirs: src/
+ include-dirs: include/
+ ghc-options: -Wall
+ cc-options: -std=c99 -Wall
+
+ -- GHC has wired-in IDs from the ghc-bignum package. Hence the unit-id
+ -- of the package should not contain the version: i.e. it must be
+ -- "ghc-bignum" and not "ghc-bignum-1.0".
+ ghc-options: -this-unit-id ghc-bignum
+
+ include-dirs: include
+
+ if flag(gmp)
+ cpp-options: -DBIGNUM_GMP
+ other-modules:
+ GHC.Num.BigNat.GMP
+ c-sources:
+ cbits/gmp_wrappers.c
+
+ if flag(ffi)
+ cpp-options: -DBIGNUM_FFI
+ other-modules:
+ GHC.Num.BigNat.FFI
+
+ if flag(native)
+ cpp-options: -DBIGNUM_NATIVE
+
+ if flag(check)
+ cpp-options: -DBIGNUM_CHECK
+ other-modules:
+ GHC.Num.BigNat.Check
+
+
+ exposed-modules:
+ GHC.Num.Primitives
+ GHC.Num.WordArray
+ GHC.Num.BigNat
+ GHC.Num.BigNat.Native
+ GHC.Num.Natural
+ GHC.Num.Integer
diff --git a/libraries/integer-gmp/gmp/ghc-gmp.h b/libraries/ghc-bignum/gmp/ghc-gmp.h
similarity index 100%
rename from libraries/integer-gmp/gmp/ghc-gmp.h
rename to libraries/ghc-bignum/gmp/ghc-gmp.h
diff --git a/libraries/integer-gmp/gmp/ghc.mk b/libraries/ghc-bignum/gmp/ghc.mk
similarity index 61%
rename from libraries/integer-gmp/gmp/ghc.mk
rename to libraries/ghc-bignum/gmp/ghc.mk
index 9fb13ecb794fd1df46abb1392fb82e29e6895e4b..fd2798770ea3668a459dcca44c67e9b490ee1cb5 100644
--- a/libraries/integer-gmp/gmp/ghc.mk
+++ b/libraries/ghc-bignum/gmp/ghc.mk
@@ -16,8 +16,8 @@
# which causes problems for Debian.
ifneq "$(BINDIST)" "YES"
-GMP_TARBALL := $(wildcard libraries/integer-gmp/gmp/gmp-tarballs/gmp*.tar.bz2)
-GMP_DIR := $(patsubst libraries/integer-gmp/gmp/gmp-tarballs/%-nodoc.tar.bz2,%,$(GMP_TARBALL))
+GMP_TARBALL := $(wildcard libraries/ghc-bignum/gmp/gmp-tarballs/gmp*.tar.bz2)
+GMP_DIR := $(patsubst libraries/ghc-bignum/gmp/gmp-tarballs/%-nodoc.tar.bz2,%,$(GMP_TARBALL))
ifeq "$(GMP_TARBALL)" ""
$(error "GMP tarball is missing; you may need to run 'git submodule update --init'.")
@@ -26,28 +26,28 @@ endif
ifneq "$(NO_CLEAN_GMP)" "YES"
$(eval $(call clean-target,gmp,,\
- libraries/integer-gmp/include/ghc-gmp.h \
- libraries/integer-gmp/gmp/libgmp.a \
- libraries/integer-gmp/gmp/gmp.h \
- libraries/integer-gmp/gmp/gmpbuild \
- libraries/integer-gmp/gmp/$(GMP_DIR)))
+ libraries/ghc-bignum/include/ghc-gmp.h \
+ libraries/ghc-bignum/gmp/libgmp.a \
+ libraries/ghc-bignum/gmp/gmp.h \
+ libraries/ghc-bignum/gmp/gmpbuild \
+ libraries/ghc-bignum/gmp/$(GMP_DIR)))
clean : clean_gmp
.PHONY: clean_gmp
clean_gmp:
- $(call removeTrees,libraries/integer-gmp/gmp/objs)
- $(call removeTrees,libraries/integer-gmp/gmp/gmpbuild)
+ $(call removeTrees,libraries/ghc-bignum/gmp/objs)
+ $(call removeTrees,libraries/ghc-bignum/gmp/gmpbuild)
endif
ifeq "$(GMP_PREFER_FRAMEWORK)" "YES"
-libraries/integer-gmp_CONFIGURE_OPTS += --with-gmp-framework-preferred
+libraries/ghc-bignum_CONFIGURE_OPTS += --with-gmp-framework-preferred
endif
ifneq "$(CLEANING)" "YES"
# Hack. The file config.mk doesn't exist yet after running ./configure in
# the toplevel (ghc) directory. To let some toplevel make commands such as
# sdist go through, right after ./configure, don't consider this an error.
--include libraries/integer-gmp/dist-install/build/config.mk
+-include libraries/ghc-bignum/dist-install/build/config.mk
endif
gmp_CC_OPTS += $(addprefix -I,$(GMP_INCLUDE_DIRS))
@@ -67,7 +67,7 @@ endif
# In a bindist, we don't want to know whether /this/ machine has gmp,
# but whether the machine the bindist was built on had gmp.
ifeq "$(BINDIST)" "YES"
-ifeq "$(wildcard libraries/integer-gmp/gmp/libgmp.a)" ""
+ifeq "$(wildcard libraries/ghc-bignum/gmp/libgmp.a)" ""
HaveLibGmp = YES
HaveFrameworkGMP = YES
else
@@ -89,21 +89,21 @@ libraries/integer-gmp/cbits/wrappers.c: libraries/integer-gmp/include/ghc-gmp.h
ifeq "$(UseIntreeGmp)" "YES"
# Copy header from in-tree build (gmp.h => ghc-gmp.h)
-libraries/integer-gmp/include/ghc-gmp.h: libraries/integer-gmp/gmp/gmp.h
+libraries/ghc-bignum/include/ghc-gmp.h: libraries/ghc-bignum/gmp/gmp.h
$(CP) $< $@
# Link in-tree GMP objects
-libraries/integer-gmp_dist-install_EXTRA_OBJS += libraries/integer-gmp/gmp/objs/*.o
+libraries/ghc-bignum_dist-install_EXTRA_OBJS += libraries/ghc-bignum/gmp/objs/*.o
else
# Copy header from source tree
-libraries/integer-gmp/include/ghc-gmp.h: libraries/integer-gmp/gmp/ghc-gmp.h
+libraries/ghc-bignum/include/ghc-gmp.h: libraries/ghc-bignum/gmp/ghc-gmp.h
$(CP) $< $@
endif
-libraries/integer-gmp_dist-install_EXTRA_CC_OPTS += $(gmp_CC_OPTS)
+libraries/ghc-bignum_dist-install_EXTRA_CC_OPTS += $(gmp_CC_OPTS)
ifneq "$(CLEANING)" "YES"
# When running `make clean` before `./configure`, CC_STAGE1 is undefined.
@@ -115,25 +115,25 @@ else
CCX = $(CC_STAGE1)
endif
-libraries/integer-gmp/gmp/libgmp.a libraries/integer-gmp/gmp/gmp.h:
- $(RM) -rf libraries/integer-gmp/gmp/$(GMP_DIR) libraries/integer-gmp/gmp/gmpbuild libraries/integer-gmp/gmp/objs
- cat $(GMP_TARBALL) | $(BZIP2_CMD) -d | { cd libraries/integer-gmp/gmp && $(TAR_CMD) -xf - ; }
- mv libraries/integer-gmp/gmp/$(GMP_DIR) libraries/integer-gmp/gmp/gmpbuild
- cd libraries/integer-gmp/gmp && $(PATCH_CMD) -p0 < gmpsrc.patch
- chmod +x libraries/integer-gmp/gmp/ln
+libraries/ghc-bignum/gmp/libgmp.a libraries/ghc-bignum/gmp/gmp.h:
+ $(RM) -rf libraries/ghc-bignum/gmp/$(GMP_DIR) libraries/ghc-bignum/gmp/gmpbuild libraries/ghc-bignum/gmp/objs
+ cat $(GMP_TARBALL) | $(BZIP2_CMD) -d | { cd libraries/ghc-bignum/gmp && $(TAR_CMD) -xf - ; }
+ mv libraries/ghc-bignum/gmp/$(GMP_DIR) libraries/ghc-bignum/gmp/gmpbuild
+ cd libraries/ghc-bignum/gmp && $(PATCH_CMD) -p0 < gmpsrc.patch
+ chmod +x libraries/ghc-bignum/gmp/ln
# Note: We must pass `TARGETPLATFORM` to the `--host` argument of GMP's
# `./configure`, not `HOSTPLATFORM`: the 'host' on which GMP will
# run is the 'target' platform of the compiler we're building.
- cd libraries/integer-gmp/gmp/gmpbuild; \
+ cd libraries/ghc-bignum/gmp/gmpbuild; \
CC=$(CCX) CXX=$(CCX) NM=$(NM) AR=$(AR_STAGE1) ./configure \
--enable-shared=no --with-pic=yes \
--host=$(TARGETPLATFORM) --build=$(BUILDPLATFORM)
- $(MAKE) -C libraries/integer-gmp/gmp/gmpbuild MAKEFLAGS=
- $(CP) libraries/integer-gmp/gmp/gmpbuild/gmp.h libraries/integer-gmp/gmp/
- $(CP) libraries/integer-gmp/gmp/gmpbuild/.libs/libgmp.a libraries/integer-gmp/gmp/
- $(MKDIRHIER) libraries/integer-gmp/gmp/objs
- cd libraries/integer-gmp/gmp/objs && $(AR_STAGE1) x ../libgmp.a
- $(RANLIB_CMD) libraries/integer-gmp/gmp/libgmp.a
+ $(MAKE) -C libraries/ghc-bignum/gmp/gmpbuild MAKEFLAGS=
+ $(CP) libraries/ghc-bignum/gmp/gmpbuild/gmp.h libraries/ghc-bignum/gmp/
+ $(CP) libraries/ghc-bignum/gmp/gmpbuild/.libs/libgmp.a libraries/ghc-bignum/gmp/
+ $(MKDIRHIER) libraries/ghc-bignum/gmp/objs
+ cd libraries/ghc-bignum/gmp/objs && $(AR_STAGE1) x ../libgmp.a
+ $(RANLIB_CMD) libraries/ghc-bignum/gmp/libgmp.a
endif # CLEANING
diff --git a/libraries/integer-gmp/gmp/gmp-tarballs b/libraries/ghc-bignum/gmp/gmp-tarballs
similarity index 100%
rename from libraries/integer-gmp/gmp/gmp-tarballs
rename to libraries/ghc-bignum/gmp/gmp-tarballs
diff --git a/libraries/integer-gmp/gmp/gmpsrc.patch b/libraries/ghc-bignum/gmp/gmpsrc.patch
similarity index 100%
rename from libraries/integer-gmp/gmp/gmpsrc.patch
rename to libraries/ghc-bignum/gmp/gmpsrc.patch
diff --git a/libraries/integer-gmp/gmp/ln b/libraries/ghc-bignum/gmp/ln
similarity index 100%
rename from libraries/integer-gmp/gmp/ln
rename to libraries/ghc-bignum/gmp/ln
diff --git a/libraries/integer-gmp/include/HsIntegerGmp.h.in b/libraries/ghc-bignum/include/HsIntegerGmp.h.in
similarity index 90%
rename from libraries/integer-gmp/include/HsIntegerGmp.h.in
rename to libraries/ghc-bignum/include/HsIntegerGmp.h.in
index 08ff8dff5f639c4e5c2a706a166a8419bac45e4d..063817cc15e4a55eaf37042065aae20e578a45b0 100644
--- a/libraries/integer-gmp/include/HsIntegerGmp.h.in
+++ b/libraries/ghc-bignum/include/HsIntegerGmp.h.in
@@ -1,6 +1,6 @@
#pragma once
-/* Whether GMP is embedded into integer-gmp */
+/* Whether GMP is embedded into ghc-bignum */
#define GHC_GMP_INTREE @UseIntreeGmp@
/* The following values denote the GMP version used during GHC build-time */
diff --git a/libraries/ghc-bignum/include/WordSize.h b/libraries/ghc-bignum/include/WordSize.h
new file mode 100644
index 0000000000000000000000000000000000000000..cd52f93764ccb029d9c0457d39a527eb426766ae
--- /dev/null
+++ b/libraries/ghc-bignum/include/WordSize.h
@@ -0,0 +1,32 @@
+#include "MachDeps.h"
+
+#if WORD_SIZE_IN_BITS == 64
+
+# define WORD_SIZE_IN_BYTES 8
+# define WORD_SIZE_BYTES_SHIFT 3
+# define WORD_SIZE_BYTES_MASK 0b111
+# define WORD_SIZE_BITS_SHIFT 6
+# define WORD_SIZE_BITS_MASK 0b111111
+# define WORD_MAXBOUND 0xffffffffffffffff
+# define INT_MINBOUND -0x8000000000000000
+# define INT_MAXBOUND 0x7fffffffffffffff
+# define ABS_INT_MINBOUND 0x8000000000000000
+# define SQRT_INT_MAXBOUND 0xb504f333
+
+#elif WORD_SIZE_IN_BITS == 32
+
+# define WORD_SIZE_IN_BYTES 4
+# define WORD_SIZE_BYTES_SHIFT 2
+# define WORD_SIZE_BYTES_MASK 0b11
+# define WORD_SIZE_BITS_SHIFT 5
+# define WORD_SIZE_BITS_MASK 0b11111
+# define WORD_MAXBOUND 0xffffffff
+# define INT_MINBOUND -0x80000000
+# define INT_MAXBOUND 0x7fffffff
+# define ABS_INT_MINBOUND 0x80000000
+# define SQRT_INT_MAXBOUND 0xb504
+
+#else
+# error unsupported WORD_SIZE_IN_BITS config
+#endif
+
diff --git a/libraries/integer-gmp/install-sh b/libraries/ghc-bignum/install-sh
similarity index 100%
rename from libraries/integer-gmp/install-sh
rename to libraries/ghc-bignum/install-sh
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
new file mode 100644
index 0000000000000000000000000000000000000000..5d0a9919f5295b7b239c50c6294e4978ba8c98c7
--- /dev/null
+++ b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
@@ -0,0 +1,1509 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE BinaryLiterals #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
+-- | Multi-precision natural
+module GHC.Num.BigNat where
+
+#include "MachDeps.h"
+#include "WordSize.h"
+
+import GHC.Prim
+import GHC.Types
+import GHC.Classes
+import GHC.Magic
+import GHC.Num.Primitives
+import GHC.Num.WordArray
+
+#if WORD_SIZE_IN_BITS < 64
+import GHC.IntWord64
+#endif
+
+#if defined(BIGNUM_CHECK)
+import GHC.Num.BigNat.Check
+
+#elif defined(BIGNUM_NATIVE)
+import GHC.Num.BigNat.Native
+
+#elif defined(BIGNUM_FFI)
+import GHC.Num.BigNat.FFI
+
+#elif defined(BIGNUM_GMP)
+import GHC.Num.BigNat.GMP
+
+#else
+#error Undefined BigNat backend. Use a flag to select it (e.g. gmp, native, ffi)`
+#endif
+
+default ()
+
+-- | A BigNat
+--
+-- Represented as an array of limbs (Word#) stored in little-endian order (Word#
+-- themselves use machine order).
+--
+-- Invariant (canonical representation): higher Word# is non-zero.
+-- As a consequence, zero is represented with a WordArray# whose size is 0.
+type BigNat = WordArray# -- we use a type-alias to make Integer/Natural easier to wire-in
+
+-- | Check that the BigNat is valid
+bigNatCheck# :: BigNat -> Bool#
+bigNatCheck# bn
+ | 0# <- bigNatSize# bn = 1#
+ | 0## <- bigNatIndex# bn (bigNatSize# bn -# 1#) = 0#
+ | True = 1#
+
+-- | Check that the BigNat is valid
+bigNatCheck :: BigNat -> Bool
+bigNatCheck bn = isTrue# (bigNatCheck# bn)
+
+-- | Number of words in the BigNat
+bigNatSize :: BigNat -> Word
+bigNatSize bn = W# (int2Word# (bigNatSize# bn))
+
+-- | Number of words in the BigNat
+bigNatSize# :: BigNat -> Int#
+bigNatSize# ba = wordArraySize# ba
+
+-- Note [Why Void#?]
+-- ~~~~~~~~~~~~~~~~~
+--
+-- We can't have top-level BigNat for now because they are unlifted ByteArray#
+-- (see #17521). So we use functions that take an empty argument Void# that
+-- will be discarded at compile time.
+
+data BigNatW = BigNatW BigNat
+
+{-# NOINLINE bigNatZeroW #-}
+bigNatZeroW :: BigNatW
+bigNatZeroW = BigNatW (withNewWordArray# 0# (\_ s -> s))
+
+{-# NOINLINE bigNatOneW #-}
+bigNatOneW :: BigNatW
+bigNatOneW = BigNatW (bigNatFromWord# 1##)
+
+-- | BigNat Zero
+bigNatZero :: Void# -> BigNat -- cf Note [Why Void#?]
+bigNatZero _ = case bigNatZeroW of
+ BigNatW w -> w
+
+-- | BigNat one
+bigNatOne :: Void# -> BigNat -- cf Note [Why Void#?]
+bigNatOne _ = case bigNatOneW of
+ BigNatW w -> w
+
+-- | Indicate if a bigNat is zero
+bigNatIsZero :: BigNat -> Bool
+bigNatIsZero bn = isTrue# (bigNatIsZero# bn)
+
+-- | Indicate if a bigNat is zero
+bigNatIsZero# :: BigNat -> Bool#
+bigNatIsZero# ba = wordArraySize# ba ==# 0#
+
+-- | Indicate if a bigNat is one
+bigNatIsOne :: BigNat -> Bool
+bigNatIsOne bn = isTrue# (bigNatIsOne# bn)
+
+-- | Indicate if a bigNat is one
+bigNatIsOne# :: BigNat -> Bool#
+bigNatIsOne# ba =
+ wordArraySize# ba ==# 1#
+ &&# indexWordArray# ba 0# `eqWord#` 1##
+
+-- | Indicate if a bigNat is two
+bigNatIsTwo :: BigNat -> Bool
+bigNatIsTwo bn = isTrue# (bigNatIsTwo# bn)
+
+-- | Indicate if a bigNat is two
+bigNatIsTwo# :: BigNat -> Bool#
+bigNatIsTwo# ba =
+ wordArraySize# ba ==# 1#
+ &&# indexWordArray# ba 0# `eqWord#` 2##
+
+-- | Indicate if the value is a power of two and which one
+bigNatIsPowerOf2# :: BigNat -> (# () | Word# #)
+bigNatIsPowerOf2# a
+ | bigNatIsZero a = (# () | #)
+ | True = case wordIsPowerOf2# msw of
+ (# () | #) -> (# () | #)
+ (# | c #) -> case checkAllZeroes (imax -# 1#) of
+ 0# -> (# () | #)
+ _ -> (# | c `plusWord#`
+ (int2Word# imax `uncheckedShiftL#` WORD_SIZE_BITS_SHIFT#) #)
+ where
+ msw = bigNatIndex# a imax
+ sz = bigNatSize# a
+ imax = sz -# 1#
+ checkAllZeroes i
+ | isTrue# (i <# 0#) = 1#
+ | True = case bigNatIndex# a i of
+ 0## -> checkAllZeroes (i -# 1#)
+ _ -> 0#
+
+-- | Return the Word# at the given index
+bigNatIndex# :: BigNat -> Int# -> Word#
+bigNatIndex# x i = indexWordArray# x i
+
+-- | Return the Word# at the given index
+bigNatIndex :: BigNat -> Int# -> Word
+bigNatIndex bn i = W# (bigNatIndex# bn i)
+
+-------------------------------------------------
+-- Conversion
+-------------------------------------------------
+
+-- | Create a BigNat from a Word
+bigNatFromWord :: Word -> BigNat
+bigNatFromWord (W# w) = bigNatFromWord# w
+
+-- | Create a BigNat from a Word
+bigNatFromWord# :: Word# -> BigNat
+bigNatFromWord# 0## = bigNatZero void#
+bigNatFromWord# w = wordArrayFromWord# w
+
+-- | Convert a list of non-zero Words (most-significant first) into a BigNat
+bigNatFromWordList :: [Word] -> BigNat
+bigNatFromWordList (W# 0##:xs) = bigNatFromWordList xs
+bigNatFromWordList xs = bigNatFromWordListUnsafe xs
+
+-- | Convert a list of non-zero Words (most-significant first) into a BigNat
+bigNatFromWordList# :: [Word] -> WordArray#
+{-# NOINLINE bigNatFromWordList# #-}
+bigNatFromWordList# xs = bigNatFromWordList xs
+
+-- | Return the absolute value of the Int# in a BigNat
+bigNatFromAbsInt# :: Int# -> BigNat
+bigNatFromAbsInt# i = bigNatFromWord# (wordFromAbsInt# i)
+
+-- | Convert a list of non-zero Words (most-significant first) into a BigNat.
+-- Don't remove most-significant zero words
+bigNatFromWordListUnsafe :: [Word] -> BigNat
+bigNatFromWordListUnsafe [] = bigNatZero void#
+bigNatFromWordListUnsafe xs =
+ let
+ length i [] = i
+ length i (_:ys) = length (i +# 1#) ys
+ !lxs = length 0# xs
+ writeWordList _mwa _i [] s = s
+ writeWordList mwa i (W# w:ws) s =
+ case mwaWrite# mwa i w s of
+ s1 -> writeWordList mwa (i -# 1#) ws s1
+ in withNewWordArray# lxs \mwa ->
+ writeWordList mwa (lxs -# 1#) xs
+
+-- | Convert a BigNat into a list of non-zero Words (most-significant first)
+bigNatToWordList :: BigNat -> [Word]
+bigNatToWordList bn = go (bigNatSize# bn)
+ where
+ go 0# = []
+ go n = bigNatIndex bn (n -# 1#) : go (n -# 1#)
+
+
+-- | Convert two Word# (most-significant first) into a BigNat
+bigNatFromWord2# :: Word# -> Word# -> BigNat
+bigNatFromWord2# 0## 0## = bigNatZero void#
+bigNatFromWord2# 0## n = bigNatFromWord# n
+bigNatFromWord2# w1 w2 = wordArrayFromWord2# w1 w2
+
+-- | Convert a BigNat into a Word#
+bigNatToWord# :: BigNat -> Word#
+bigNatToWord# a
+ | bigNatIsZero a = 0##
+ | True = bigNatIndex# a 0#
+
+-- | Convert a BigNat into a Word# if it fits
+bigNatToWordMaybe# :: BigNat -> (# Word# | () #)
+bigNatToWordMaybe# a
+ | bigNatIsZero a = (# 0## | #)
+ | isTrue# (bigNatSize# a ># 1#) = (# | () #)
+ | True = (# bigNatIndex# a 0# | #)
+
+-- | Convert a BigNat into a Word
+bigNatToWord :: BigNat -> Word
+bigNatToWord bn = W# (bigNatToWord# bn)
+
+-- | Convert a BigNat into a Int#
+bigNatToInt# :: BigNat -> Int#
+bigNatToInt# a
+ | bigNatIsZero a = 0#
+ | True = indexIntArray# a 0#
+
+-- | Convert a BigNat into a Int
+bigNatToInt :: BigNat -> Int
+bigNatToInt bn = I# (bigNatToInt# bn)
+
+#if WORD_SIZE_IN_BITS == 32
+
+-- | Convert a Word64# into a BigNat on 32-bit architectures
+bigNatFromWord64# :: Word64# -> BigNat
+bigNatFromWord64# w64 = bigNatFromWord2# wh# wl#
+ where
+ wh# = word64ToWord# (uncheckedShiftRL64# w64 32#)
+ wl# = word64ToWord# w64
+
+-- | Convert a BigNat into a Word64# on 32-bit architectures
+bigNatToWord64# :: BigNat -> Word64#
+bigNatToWord64# b
+ | bigNatIsZero b = wordToWord64# 0##
+ | wl <- wordToWord64# (bigNatToWord# b)
+ = if isTrue# (bigNatSize# b ># 1#)
+ then
+ let wh = wordToWord64# (bigNatIndex# b 1#)
+ in uncheckedShiftL64# wh 32# `or64#` wl
+ else wl
+
+#endif
+
+-- | Encode (# BigNat mantissa, Int# exponent #) into a Double#
+bigNatEncodeDouble# :: BigNat -> Int# -> Double#
+bigNatEncodeDouble# a e
+ | bigNatIsZero a
+ = word2Double# 0## -- FIXME: isn't it NaN on 0# exponent?
+
+ | True
+ = inline bignat_encode_double a e
+
+-------------------------------------------------
+-- Predicates
+-------------------------------------------------
+
+-- | Test if a BigNat is greater than a Word
+bigNatGtWord# :: BigNat -> Word# -> Bool#
+bigNatGtWord# bn w =
+ notB# (bigNatIsZero# bn)
+ &&# ( bigNatSize# bn ># 1#
+ ||# bigNatIndex# bn 0# `gtWord#` w
+ )
+
+-- | Test if a BigNat is equal to a Word
+bigNatEqWord# :: BigNat -> Word# -> Bool#
+bigNatEqWord# bn w
+ | 0## <- w
+ = bigNatIsZero# bn
+
+ | isTrue# (bigNatSize# bn ==# 1#)
+ = bigNatIndex# bn 0# `eqWord#` w
+
+ | True
+ = 0#
+
+-- | Test if a BigNat is greater than a Word
+bigNatGtWord :: BigNat -> Word -> Bool
+bigNatGtWord bn (W# w) = isTrue# (bigNatGtWord# bn w)
+
+-- | Test if a BigNat is lower than or equal to a Word
+bigNatLeWord# :: BigNat -> Word# -> Bool#
+bigNatLeWord# bn w = notB# (bigNatGtWord# bn w)
+
+-- | Test if a BigNat is lower than or equal to a Word
+bigNatLeWord :: BigNat -> Word -> Bool
+bigNatLeWord bn (W# w) = isTrue# (bigNatLeWord# bn w)
+
+-- | Equality test for BigNat
+bigNatEq# :: BigNat -> BigNat -> Bool#
+bigNatEq# wa wb
+ | isTrue# (wordArraySize# wa /=# wordArraySize# wb) = 0#
+ | isTrue# (wordArraySize# wa ==# 0#) = 1#
+ | True = inline bignat_compare wa wb ==# 0#
+
+-- | Equality test for BigNat
+bigNatEq :: BigNat -> BigNat -> Bool
+bigNatEq a b = isTrue# (bigNatEq# a b)
+
+-- | Inequality test for BigNat
+bigNatNe# :: BigNat -> BigNat -> Bool#
+bigNatNe# a b = notB# (bigNatEq# a b)
+
+-- | Equality test for BigNat
+bigNatNe :: BigNat -> BigNat -> Bool
+bigNatNe a b = isTrue# (bigNatNe# a b)
+
+-- | Compare a BigNat and a Word#
+bigNatCompareWord# :: BigNat -> Word# -> Ordering
+bigNatCompareWord# a b
+ | bigNatIsZero a = cmpW# 0## b
+ | isTrue# (wordArraySize# a ># 1#) = GT
+ | True
+ = cmpW# (indexWordArray# a 1#) b
+
+-- | Compare a BigNat and a Word
+bigNatCompareWord :: BigNat -> Word -> Ordering
+bigNatCompareWord a (W# b) = bigNatCompareWord# a b
+
+-- | Compare two BigNat
+bigNatCompare :: BigNat -> BigNat -> Ordering
+bigNatCompare a b =
+ let
+ szA = wordArraySize# a
+ szB = wordArraySize# b
+ in if
+ | isTrue# (szA ># szB) -> GT
+ | isTrue# (szA <# szB) -> LT
+ | isTrue# (szA ==# 0#) -> EQ
+ | True -> compareInt# (inline bignat_compare a b) 0#
+
+
+-- | Predicate: a < b
+bigNatLt :: BigNat -> BigNat -> Bool
+bigNatLt a b = bigNatCompare a b == LT
+
+-------------------------------------------------
+-- Addition
+-------------------------------------------------
+
+-- | Add a bigNat and a Word#
+bigNatAddWord# :: BigNat -> Word# -> BigNat
+bigNatAddWord# a b
+ | 0## <- b
+ = a
+
+ | bigNatIsZero a
+ = bigNatFromWord# b
+
+ | True
+ = withNewWordArrayTrimed# (wordArraySize# a +# 1#) \mwa s ->
+ inline bignat_add_word mwa a b s
+
+-- | Add a bigNat and a Word
+bigNatAddWord :: BigNat -> Word -> BigNat
+bigNatAddWord a (W# b) = bigNatAddWord# a b
+
+-- | Add two bigNats
+bigNatAdd :: BigNat -> BigNat -> BigNat
+bigNatAdd a b
+ | bigNatIsZero a = b
+ | bigNatIsZero b = a
+ | True =
+ let
+ !szA = wordArraySize# a
+ !szB = wordArraySize# b
+ !szMax = maxI# szA szB
+ !sz = szMax +# 1# -- for the potential carry
+ in withNewWordArrayTrimed# sz \mwa s ->
+ inline bignat_add mwa a b s
+
+-------------------------------------------------
+-- Multiplication
+-------------------------------------------------
+
+-- | Multiply a BigNat by a Word#
+bigNatMulWord# :: BigNat -> Word# -> BigNat
+bigNatMulWord# a w
+ | 0## <- w = bigNatZero void#
+ | 1## <- w = a
+ | bigNatIsZero a = bigNatZero void#
+ | bigNatIsOne a = bigNatFromWord# w
+ | isTrue# (bigNatSize# a ==# 1#)
+ = case timesWord2# (bigNatIndex# a 0#) w of
+ (# h, l #) -> bigNatFromWord2# h l
+ | True = withNewWordArrayTrimed# (bigNatSize# a +# 1#) \mwa s ->
+ inline bignat_mul_word mwa a w s
+
+-- | Multiply a BigNAt by a Word
+bigNatMulWord :: BigNat -> Word -> BigNat
+bigNatMulWord a (W# w) = bigNatMulWord# a w
+
+-- | Square a BigNat
+bigNatSqr :: BigNat -> BigNat
+bigNatSqr a = bigNatMul a a
+ -- This can be replaced by a backend primitive in the future (e.g. to use
+ -- GMP's mpn_sqr)
+
+-- | Multiplication (classical algorithm)
+bigNatMul :: BigNat -> BigNat -> BigNat
+bigNatMul a b
+ | bigNatSize b > bigNatSize a = bigNatMul b a -- optimize loops
+ | bigNatIsZero a = a
+ | bigNatIsZero b = b
+ | bigNatIsOne a = b
+ | bigNatIsOne b = a
+ | True =
+ let
+ !szA = wordArraySize# a
+ !szB = wordArraySize# b
+ !sz = szA +# szB
+ in withNewWordArrayTrimed# sz \mwa s->
+ inline bignat_mul mwa a b s
+
+
+-------------------------------------------------
+-- Subtraction
+-------------------------------------------------
+
+-- | Subtract a Word# from a BigNat
+--
+-- The BigNat must be bigger than the Word#.
+bigNatSubWordUnsafe# :: BigNat -> Word# -> BigNat
+bigNatSubWordUnsafe# x y
+ | 0## <- y = x
+ | True = withNewWordArrayTrimed# sz \mwa -> go mwa y 0#
+ where
+ !sz = wordArraySize# x
+
+ go mwa carry i s
+ | isTrue# (i >=# sz)
+ = s
+
+ | 0## <- carry
+ = mwaArrayCopy# mwa i x i (sz -# i) s
+
+ | True
+ = case subWordC# (indexWordArray# x i) carry of
+ (# l, c #) -> case mwaWrite# mwa i l s of
+ s1 -> go mwa (int2Word# c) (i +# 1#) s1
+
+-- | Subtract a Word# from a BigNat
+--
+-- The BigNat must be bigger than the Word#.
+bigNatSubWordUnsafe :: BigNat -> Word -> BigNat
+bigNatSubWordUnsafe x (W# y) = bigNatSubWordUnsafe# x y
+
+-- | Subtract a Word# from a BigNat
+bigNatSubWord# :: BigNat -> Word# -> (# () | BigNat #)
+bigNatSubWord# a b
+ | 0## <- b = (# | a #)
+ | bigNatIsZero a = (# () | #)
+ | True
+ = withNewWordArrayTrimedMaybe# (bigNatSize# a) \mwa s ->
+ inline bignat_sub_word mwa a b s
+
+
+-- | Subtract two BigNat (don't check if a >= b)
+bigNatSubUnsafe :: BigNat -> BigNat -> BigNat
+bigNatSubUnsafe a b
+ | bigNatIsZero b = a
+ | True =
+ let szA = wordArraySize# a
+ in withNewWordArrayTrimed# szA \mwa s->
+ case inline bignat_sub mwa a b s of
+ (# s', 0# #) -> s'
+ (# s', _ #) -> case underflow of _ -> s'
+
+-- | Subtract two BigNat
+bigNatSub :: BigNat -> BigNat -> (# () | BigNat #)
+bigNatSub a b
+ | bigNatIsZero b = (# | a #)
+ | isTrue# (bigNatSize# a <# bigNatSize# b)
+ = (# () | #)
+
+ | True
+ = withNewWordArrayTrimedMaybe# (bigNatSize# a) \mwa s ->
+ inline bignat_sub mwa a b s
+
+
+-------------------------------------------------
+-- Division
+-------------------------------------------------
+
+-- | Divide a BigNat by a Word, return the quotient
+--
+-- Require:
+-- b /= 0
+bigNatQuotWord# :: BigNat -> Word# -> BigNat
+bigNatQuotWord# a b
+ | 1## <- b = a
+ | 0## <- b = case divByZero of _ -> bigNatZero void#
+ | True =
+ let
+ sz = wordArraySize# a
+ in withNewWordArrayTrimed# sz \mwq s ->
+ inline bignat_quot_word mwq a b s
+
+-- | Divide a BigNat by a Word, return the quotient
+--
+-- Require:
+-- b /= 0
+bigNatQuotWord :: BigNat -> Word -> BigNat
+bigNatQuotWord a (W# b) = bigNatQuotWord# a b
+
+-- | Divide a BigNat by a Word, return the remainder
+--
+-- Require:
+-- b /= 0
+bigNatRemWord# :: BigNat -> Word# -> Word#
+bigNatRemWord# a b
+ | 0## <- b = 1## `remWord#` 0##
+ | 1## <- b = 0##
+ | bigNatIsZero a = 0##
+ | True = inline bignat_rem_word a b
+
+-- | Divide a BigNat by a Word, return the remainder
+--
+-- Require:
+-- b /= 0
+bigNatRemWord :: BigNat -> Word -> Word
+bigNatRemWord a (W# b) = W# (bigNatRemWord# a b)
+
+-- | QuotRem a BigNat by a Word
+--
+-- Require:
+-- b /= 0
+bigNatQuotRemWord# :: BigNat -> Word# -> (# BigNat, Word# #)
+bigNatQuotRemWord# a b
+ | 0## <- b = case divByZero of _ -> (# bigNatZero void#, 0## #)
+ | 1## <- b = (# a, 0## #)
+ | isTrue# (bigNatSize# a ==# 1#)
+ , a0 <- indexWordArray# a 0#
+ = case compareWord# a0 b of
+ LT -> (# bigNatZero void#, a0 #)
+ EQ -> (# bigNatOne void#, 0## #)
+ GT -> case quotRemWord# a0 b of
+ (# q, r #) -> (# bigNatFromWord# q, r #)
+ | True =
+ let
+ sz = wordArraySize# a
+ io s =
+ case newWordArray# sz s of { (# s1, mwq #) ->
+ case inline bignat_quotrem_word mwq a b s1 of { (# s2, r #) ->
+ case mwaTrimZeroes# mwq s2 of { s3 ->
+ case unsafeFreezeByteArray# mwq s3 of { (# s4, wq #) ->
+ (# s4, (# wq, r #) #)
+ }}}}
+ in case runRW# io of
+ (# _, (# wq,r #) #) -> (# wq, r #)
+
+
+-- | BigNat division returning (quotient,remainder)
+bigNatQuotRem# :: BigNat -> BigNat -> (# BigNat,BigNat #)
+bigNatQuotRem# a b
+ | bigNatIsZero b = case divByZero of _ -> (# bigNatZero void#, bigNatZero void# #)
+ | bigNatIsZero a = (# bigNatZero void#, bigNatZero void# #)
+ | bigNatIsOne b = (# a , bigNatZero void# #)
+ | LT <- cmp = (# bigNatZero void#, a #)
+ | EQ <- cmp = (# bigNatOne void#, bigNatZero void# #)
+ | isTrue# (szB ==# 1#) = case bigNatQuotRemWord# a (bigNatIndex# b 0#) of
+ (# q, r #) -> (# q, bigNatFromWord# r #)
+
+ | True = withNewWordArray2Trimed# szQ szR \mwq mwr s ->
+ inline bignat_quotrem mwq mwr a b s
+ where
+ cmp = bigNatCompare a b
+ szA = wordArraySize# a
+ szB = wordArraySize# b
+ szQ = 1# +# szA -# szB
+ szR = szB
+
+
+-- | BigNat division returning quotient
+bigNatQuot :: BigNat -> BigNat -> BigNat
+bigNatQuot a b
+ | bigNatIsZero b = case divByZero of _ -> bigNatZero void#
+ | bigNatIsZero a = bigNatZero void#
+ | bigNatIsOne b = a
+ | LT <- cmp = bigNatZero void#
+ | EQ <- cmp = bigNatOne void#
+ | isTrue# (szB ==# 1#) = bigNatQuotWord# a (bigNatIndex# b 0#)
+ | True = withNewWordArrayTrimed# szQ \mwq s ->
+ inline bignat_quot mwq a b s
+ where
+ cmp = bigNatCompare a b
+ szA = wordArraySize# a
+ szB = wordArraySize# b
+ szQ = 1# +# szA -# szB
+
+-- | BigNat division returning remainder
+bigNatRem :: BigNat -> BigNat -> BigNat
+bigNatRem a b
+ | bigNatIsZero b = case divByZero of _ -> bigNatZero void#
+ | bigNatIsZero a = bigNatZero void#
+ | bigNatIsOne b = bigNatZero void#
+ | LT <- cmp = a
+ | EQ <- cmp = bigNatZero void#
+ | isTrue# (szB ==# 1#) = case bigNatRemWord# a (bigNatIndex# b 0#) of
+ r -> bigNatFromWord# r
+ | True = withNewWordArrayTrimed# szR \mwr s ->
+ inline bignat_rem mwr a b s
+ where
+ cmp = bigNatCompare a b
+ szB = wordArraySize# b
+ szR = szB
+
+-------------------------------------------------
+-- GCD / LCM
+-------------------------------------------------
+
+-- Word#/Int# GCDs shouldn't be here in BigNat. However GMP provides a very fast
+-- implementation so we keep this here at least until we get a native Haskell
+-- implementation as fast as GMP's one. Note that these functions are used in
+-- `base` (e.g. in GHC.Real)
+
+-- | Greatest common divisor between two Word#
+gcdWord# :: Word# -> Word# -> Word#
+gcdWord# = bignat_gcd_word_word
+
+-- | Greatest common divisor between two Word
+gcdWord :: Word -> Word -> Word
+gcdWord (W# x) (W# y) = W# (gcdWord# x y)
+
+-- | Greatest common divisor between two Int#
+--
+-- __Warning__: result may become negative if (at least) one argument
+-- is 'minBound'
+gcdInt# :: Int# -> Int# -> Int#
+gcdInt# x y = word2Int# (gcdWord# (wordFromAbsInt# x) (wordFromAbsInt# y))
+
+-- | Greatest common divisor between two Int
+--
+-- __Warning__: result may become negative if (at least) one argument
+-- is 'minBound'
+gcdInt :: Int -> Int -> Int
+gcdInt (I# x) (I# y) = I# (gcdInt# x y)
+
+-- | Greatest common divisor
+bigNatGcd :: BigNat -> BigNat -> BigNat
+bigNatGcd a b
+ | bigNatIsZero a = b
+ | bigNatIsZero b = a
+ | bigNatIsOne a = a
+ | bigNatIsOne b = b
+ | True
+ = case (# bigNatSize# a, bigNatSize# b #) of
+ (# 1#, 1# #) -> bigNatFromWord# (gcdWord# (bigNatIndex# a 0#)
+ (bigNatIndex# b 0#))
+ (# 1#, _ #) -> bigNatFromWord# (bigNatGcdWord# b (bigNatIndex# a 0#))
+ (# _ , 1# #) -> bigNatFromWord# (bigNatGcdWord# a (bigNatIndex# b 0#))
+ _ ->
+ let
+ go wx wy = -- wx > wy
+ withNewWordArrayTrimed# (wordArraySize# wy) \mwr s ->
+ bignat_gcd mwr wx wy s
+ in case bigNatCompare a b of
+ EQ -> a
+ LT -> go b a
+ GT -> go a b
+
+-- | Greatest common divisor
+bigNatGcdWord# :: BigNat -> Word# -> Word#
+bigNatGcdWord# a b
+ | bigNatIsZero a = 0##
+ | 0## <- b = 0##
+ | bigNatIsOne a = 1##
+ | 1## <- b = 1##
+ | True = case bigNatCompareWord# a b of
+ EQ -> b
+ _ -> bignat_gcd_word a b
+
+-- | Least common multiple
+bigNatLcm :: BigNat -> BigNat -> BigNat
+bigNatLcm a b
+ | bigNatIsZero a = bigNatZero void#
+ | bigNatIsZero b = bigNatZero void#
+ | bigNatIsOne a = b
+ | bigNatIsOne b = a
+ | True
+ = case (# bigNatSize# a, bigNatSize# b #) of
+ (# 1#, 1# #) -> bigNatLcmWordWord# (bigNatIndex# a 0#) (bigNatIndex# b 0#)
+ (# 1#, _ #) -> bigNatLcmWord# b (bigNatIndex# a 0#)
+ (# _ , 1# #) -> bigNatLcmWord# a (bigNatIndex# b 0#)
+ _ -> (a `bigNatQuot` (a `bigNatGcd` b)) `bigNatMul` b
+ -- TODO: use extended GCD to get a's factor directly
+
+-- | Least common multiple with a Word#
+bigNatLcmWord# :: BigNat -> Word# -> BigNat
+bigNatLcmWord# a b
+ | bigNatIsZero a = bigNatZero void#
+ | 0## <- b = bigNatZero void#
+ | bigNatIsOne a = bigNatFromWord# b
+ | 1## <- b = a
+ | 1# <- bigNatSize# a = bigNatLcmWordWord# (bigNatIndex# a 0#) b
+ | True
+ = (a `bigNatQuotWord#` (a `bigNatGcdWord#` b)) `bigNatMulWord#` b
+ -- TODO: use extended GCD to get a's factor directly
+
+-- | Least common multiple between two Word#
+bigNatLcmWordWord# :: Word# -> Word# -> BigNat
+bigNatLcmWordWord# a b
+ | 0## <- a = bigNatZero void#
+ | 0## <- b = bigNatZero void#
+ | 1## <- a = bigNatFromWord# b
+ | 1## <- b = bigNatFromWord# a
+ | True = case (a `quotWord#` (a `gcdWord#` b)) `timesWord2#` b of
+ -- TODO: use extended GCD to get a's factor directly
+ (# h, l #) -> bigNatFromWord2# h l
+
+
+-------------------------------------------------
+-- Bitwise operations
+-------------------------------------------------
+
+-- | Bitwise OR
+bigNatOr :: BigNat -> BigNat -> BigNat
+bigNatOr a b
+ | bigNatIsZero a = b
+ | bigNatIsZero b = a
+ | True = withNewWordArray# sz \mwa s ->
+ inline bignat_or mwa a b s
+ where
+ !szA = wordArraySize# a
+ !szB = wordArraySize# b
+ !sz = maxI# szA szB
+
+-- | Bitwise OR with Word#
+bigNatOrWord# :: BigNat -> Word# -> BigNat
+bigNatOrWord# a b
+ | bigNatIsZero a = bigNatFromWord# b
+ | 0## <- b = a
+ | True =
+ let sz = wordArraySize# a
+ in withNewWordArray# sz \mwa s ->
+ case mwaArrayCopy# mwa 1# a 1# (sz -# 1#) s of
+ s' -> mwaWrite# mwa 0# (indexWordArray# a 0# `or#` b) s'
+
+-- | Bitwise AND
+bigNatAnd :: BigNat -> BigNat -> BigNat
+bigNatAnd a b
+ | bigNatIsZero a = a
+ | bigNatIsZero b = b
+ | True = withNewWordArrayTrimed# sz \mwa s ->
+ inline bignat_and mwa a b s
+ where
+ !szA = wordArraySize# a
+ !szB = wordArraySize# b
+ !sz = minI# szA szB
+
+-- | Bitwise ANDNOT
+bigNatAndNot :: BigNat -> BigNat -> BigNat
+bigNatAndNot a b
+ | bigNatIsZero a = a
+ | bigNatIsZero b = a
+ | True = withNewWordArrayTrimed# szA \mwa s ->
+ inline bignat_and_not mwa a b s
+ where
+ !szA = wordArraySize# a
+
+-- | Bitwise AND with Word#
+bigNatAndWord# :: BigNat -> Word# -> BigNat
+bigNatAndWord# a b
+ | bigNatIsZero a = a
+ | True = bigNatFromWord# (indexWordArray# a 0# `and#` b)
+
+-- | Bitwise ANDNOT with Word#
+bigNatAndNotWord# :: BigNat -> Word# -> BigNat
+bigNatAndNotWord# a b
+ | bigNatIsZero a = a
+ | szA <- bigNatSize# a
+ = withNewWordArray# szA \mwa s ->
+ -- duplicate higher limbs
+ case mwaArrayCopy# mwa 1# a 1# (szA -# 1#) s of
+ s' -> writeWordArray# mwa 0#
+ (indexWordArray# a 0# `and#` not# b) s'
+
+-- | Bitwise AND with Int#
+bigNatAndInt# :: BigNat -> Int# -> BigNat
+bigNatAndInt# a b
+ | bigNatIsZero a = a
+ | isTrue# (b >=# 0#) = bigNatAndWord# a (int2Word# b)
+ | szA <- bigNatSize# a
+ = withNewWordArray# szA \mwa s ->
+ -- duplicate higher limbs (because of sign-extension of b)
+ case mwaArrayCopy# mwa 1# a 1# (szA -# 1#) s of
+ s' -> writeWordArray# mwa 0#
+ (indexWordArray# a 0# `and#` int2Word# b) s'
+
+
+-- | Bitwise XOR
+bigNatXor :: BigNat -> BigNat -> BigNat
+bigNatXor a b
+ | bigNatIsZero a = b
+ | bigNatIsZero b = a
+ | True = withNewWordArrayTrimed# sz \mwa s ->
+ inline bignat_xor mwa a b s
+ where
+ !szA = wordArraySize# a
+ !szB = wordArraySize# b
+ !sz = maxI# szA szB
+
+-- | Bitwise XOR with Word#
+bigNatXorWord# :: BigNat -> Word# -> BigNat
+bigNatXorWord# a b
+ | bigNatIsZero a = bigNatFromWord# b
+ | 0## <- b = a
+ | True =
+ let
+ sz = wordArraySize# a
+ in withNewWordArray# sz \mwa s ->
+ case mwaArrayCopy# mwa 1# a 1# (sz -# 1#) s of
+ s' -> mwaWrite# mwa 0# (indexWordArray# a 0# `xor#` b) s'
+
+-- | PopCount for BigNat
+bigNatPopCount :: BigNat -> Word
+bigNatPopCount a = W# (bigNatPopCount# a)
+
+-- | PopCount for BigNat
+bigNatPopCount# :: BigNat -> Word#
+bigNatPopCount# a
+ | bigNatIsZero a = 0##
+ | True = inline bignat_popcount a
+
+-- | Bit shift right
+bigNatShiftR# :: BigNat -> Word# -> BigNat
+bigNatShiftR# a n
+ | 0## <- n
+ = a
+
+ | isTrue# (wordArraySize# a ==# 0#)
+ = a
+
+ | nw <- word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
+ , isTrue# (nw >=# wordArraySize# a)
+ = bigNatZero void#
+
+ | True
+ = let
+ !szA = wordArraySize# a
+ !nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
+ !sz = szA -# nw
+ in withNewWordArrayTrimed# sz \mwa s ->
+ inline bignat_shiftr mwa a n s
+
+-- | Bit shift right (two's complement)
+bigNatShiftRNeg# :: BigNat -> Word# -> BigNat
+bigNatShiftRNeg# a n
+ | 0## <- n
+ = a
+
+ | isTrue# (wordArraySize# a ==# 0#)
+ = a
+
+ | nw <- word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
+ , isTrue# (nw >=# wordArraySize# a)
+ = bigNatZero void#
+
+ | True
+ = let
+ !szA = wordArraySize# a
+ !nw = (word2Int# n -# 1#) `uncheckedIShiftRL#` WORD_SIZE_BITS_SHIFT#
+ !sz = szA -# nw
+ in withNewWordArrayTrimed# sz \mwa s ->
+ inline bignat_shiftr_neg mwa a n s
+
+
+-- | Bit shift right
+bigNatShiftR :: BigNat -> Word -> BigNat
+bigNatShiftR a (W# n) = bigNatShiftR# a n
+
+-- | Bit shift left
+bigNatShiftL :: BigNat -> Word -> BigNat
+bigNatShiftL a (W# n) = bigNatShiftL# a n
+
+-- | Bit shift left
+bigNatShiftL# :: BigNat -> Word# -> BigNat
+bigNatShiftL# a n
+ | 0## <- n
+ = a
+
+ | isTrue# (wordArraySize# a ==# 0#)
+ = a
+
+ | True
+ = let
+ !szA = wordArraySize# a
+ !nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
+ !nb = word2Int# (n `and#` WORD_SIZE_BITS_MASK##)
+ !sz = szA +# nw +# (nb /=# 0#)
+
+ in withNewWordArrayTrimed# sz \mwa s ->
+ inline bignat_shiftl mwa a n s
+
+
+-- | BigNat bit test
+bigNatTestBit# :: BigNat -> Word# -> Bool#
+bigNatTestBit# a n =
+ let
+ !sz = wordArraySize# a
+ !nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
+ !nb = n `and#` WORD_SIZE_BITS_MASK##
+ in if
+ | isTrue# (nw >=# sz) -> 0#
+ | True -> testBitW# (indexWordArray# a nw) nb
+
+-- | BigNat bit test
+bigNatTestBit :: BigNat -> Word -> Bool
+bigNatTestBit a (W# n) = isTrue# (bigNatTestBit# a n)
+
+
+-- | Return a BigNat whose bit `i` is the only one set.
+--
+-- Specialized version of `bigNatShiftL (bigNatFromWord# 1##)`
+--
+bigNatBit# :: Word# -> BigNat
+bigNatBit# i
+ | 0## <- i = bigNatOne void#
+ | True =
+ let
+ !nw = word2Int# (i `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
+ !nb = word2Int# (i `and#` WORD_SIZE_BITS_MASK##)
+ !sz = nw +# 1#
+ !v = 1## `uncheckedShiftL#` nb
+ in withNewWordArray# sz \mwa s ->
+ -- clear the array
+ case mwaFill# mwa 0## 0## (int2Word# sz) s of
+ -- set the bit in the most-significant word
+ s2 -> mwaWrite# mwa (sz -# 1#) v s2
+
+-- | Return a BigNat whose bit `i` is the only one set.
+--
+-- Specialized version of `bigNatShiftL (bigNatFromWord# 1##)`
+--
+bigNatBit :: Word -> BigNat
+bigNatBit (W# i) = bigNatBit# i
+
+-- | BigNat clear bit
+bigNatClearBit# :: BigNat -> Word# -> BigNat
+bigNatClearBit# a n
+ -- check the range validity and the current bit value
+ | isTrue# (bigNatTestBit# a n ==# 0#) = a
+ | True
+ = let
+ !sz = wordArraySize# a
+ !nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
+ !nb = word2Int# (n `and#` WORD_SIZE_BITS_MASK##)
+ !nv = bigNatIndex# a nw `xor#` bitW# nb
+ in if
+ | isTrue# (sz ==# 1#)
+ -> bigNatFromWord# nv
+
+ -- special case, operating on most-significant Word
+ | 0## <- nv
+ , isTrue# (nw +# 1# ==# sz)
+ -> case sz -# (waClzAt a (sz -# 2#) +# 1#) of
+ 0# -> bigNatZero void#
+ nsz -> withNewWordArray# nsz \mwa s ->
+ mwaArrayCopy# mwa 0# a 0# nsz s
+
+ | True ->
+ withNewWordArray# sz \mwa s ->
+ case mwaArrayCopy# mwa 0# a 0# sz s of
+ s' -> writeWordArray# mwa nw nv s'
+
+-- | BigNat set bit
+bigNatSetBit# :: BigNat -> Word# -> BigNat
+bigNatSetBit# a n
+ -- check the current bit value
+ | isTrue# (bigNatTestBit# a n) = a
+ | True
+ = let
+ !sz = wordArraySize# a
+ !nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
+ !nb = word2Int# (n `and#` WORD_SIZE_BITS_MASK##)
+ d = nw +# 1# -# sz
+ in if
+ -- result BigNat will have more limbs
+ | isTrue# (d ># 0#)
+ -> withNewWordArray# (nw +# 1#) \mwa s ->
+ case mwaArrayCopy# mwa 0# a 0# sz s of
+ s' -> case mwaFill# mwa 0## (int2Word# sz) (int2Word# (d -# 1#)) s' of
+ s'' -> writeWordArray# mwa nw (bitW# nb) s''
+
+ | nv <- bigNatIndex# a nw `or#` bitW# nb
+ -> withNewWordArray# sz \mwa s ->
+ case mwaArrayCopy# mwa 0# a 0# sz s of
+ s' -> writeWordArray# mwa nw nv s'
+
+-- | Reverse the given bit
+bigNatComplementBit# :: BigNat -> Word# -> BigNat
+bigNatComplementBit# bn i
+ | isTrue# (bigNatTestBit# bn i) = bigNatClearBit# bn i
+ | True = bigNatSetBit# bn i
+
+-------------------------------------------------
+-- Log operations
+-------------------------------------------------
+
+-- | Base 2 logarithm
+bigNatLog2# :: BigNat -> Word#
+bigNatLog2# a
+ | bigNatIsZero a = 0##
+ | True =
+ let i = int2Word# (bigNatSize# a) `minusWord#` 1##
+ in wordLog2# (bigNatIndex# a (word2Int# i))
+ `plusWord#` (i `uncheckedShiftL#` WORD_SIZE_BITS_SHIFT#)
+
+-- | Base 2 logarithm
+bigNatLog2 :: BigNat -> Word
+bigNatLog2 a = W# (bigNatLog2# a)
+
+-- | Logarithm for an arbitrary base
+bigNatLogBase# :: BigNat -> BigNat -> Word#
+bigNatLogBase# base a
+ | bigNatIsZero base || bigNatIsOne base
+ = case unexpectedValue of _ -> 0##
+
+ | 1# <- bigNatSize# base
+ , 2## <- bigNatIndex# base 0#
+ = bigNatLog2# a
+
+ -- TODO: optimize log base power of 2 (256, etc.)
+
+ | True
+ = case go base of (# _, e' #) -> e'
+ where
+ go pw = if a `bigNatLt` pw
+ then (# a, 0## #)
+ else case go (bigNatSqr pw) of
+ (# q, e #) -> if q `bigNatLt` pw
+ then (# q, 2## `timesWord#` e #)
+ else (# q `bigNatQuot` pw
+ , (2## `timesWord#` e) `plusWord#` 1## #)
+
+-- | Logarithm for an arbitrary base
+bigNatLogBase :: BigNat -> BigNat -> Word
+bigNatLogBase base a = W# (bigNatLogBase# base a)
+
+-- | Logarithm for an arbitrary base
+bigNatLogBaseWord# :: Word# -> BigNat -> Word#
+bigNatLogBaseWord# base a
+ | 0## <- base = case unexpectedValue of _ -> 0##
+ | 1## <- base = case unexpectedValue of _ -> 0##
+ | 2## <- base = bigNatLog2# a
+ -- TODO: optimize log base power of 2 (256, etc.)
+ | True = bigNatLogBase# (bigNatFromWord# base) a
+
+-- | Logarithm for an arbitrary base
+bigNatLogBaseWord :: Word -> BigNat -> Word
+bigNatLogBaseWord (W# base) a = W# (bigNatLogBaseWord# base a)
+
+-------------------------------------------------
+-- Various
+-------------------------------------------------
+
+-- | Compute the number of digits of the BigNat in the given base.
+--
+-- `base` must be > 1
+bigNatSizeInBase# :: Word# -> BigNat -> Word#
+bigNatSizeInBase# base a
+ | isTrue# (base `leWord#` 1##)
+ = case unexpectedValue of _ -> 0##
+
+ | bigNatIsZero a
+ = 0##
+
+ | True
+ = bigNatLogBaseWord# base a `plusWord#` 1##
+
+-- | Compute the number of digits of the BigNat in the given base.
+--
+-- `base` must be > 1
+bigNatSizeInBase :: Word -> BigNat -> Word
+bigNatSizeInBase (W# w) a = W# (bigNatSizeInBase# w a)
+
+-------------------------------------------------
+-- PowMod
+-------------------------------------------------
+
+-- Word# powMod shouldn't be here in BigNat. However GMP provides a very fast
+-- implementation so we keep this here at least until we get a native Haskell
+-- implementation as fast as GMP's one.
+
+powModWord# :: Word# -> Word# -> Word# -> Word#
+powModWord# = bignat_powmod_words
+
+
+-- | \"@'bigNatPowModWord#' /b/ /e/ /m/@\" computes base @/b/@ raised to
+-- exponent @/e/@ modulo @/m/@.
+bigNatPowModWord# :: BigNat -> BigNat -> Word# -> Word#
+bigNatPowModWord# !_ !_ 0## = case divByZero of _ -> 0##
+bigNatPowModWord# _ _ 1## = 0##
+bigNatPowModWord# b e m
+ | bigNatIsZero e = 1##
+ | bigNatIsZero b = 0##
+ | bigNatIsOne b = 1##
+ | True = bignat_powmod_word b e m
+
+-- | \"@'bigNatPowMod' /b/ /e/ /m/@\" computes base @/b/@ raised to
+-- exponent @/e/@ modulo @/m/@.
+bigNatPowMod :: BigNat -> BigNat -> BigNat -> BigNat
+bigNatPowMod !b !e !m
+ | (# m' | #) <- bigNatToWordMaybe# m
+ = bigNatFromWord# (bigNatPowModWord# b e m')
+ | bigNatIsZero m = case divByZero of _ -> bigNatZero void#
+ | bigNatIsOne m = bigNatFromWord# 0##
+ | bigNatIsZero e = bigNatFromWord# 1##
+ | bigNatIsZero b = bigNatFromWord# 0##
+ | bigNatIsOne b = bigNatFromWord# 1##
+ | True = withNewWordArrayTrimed# (bigNatSize# m) \mwa s ->
+ inline bignat_powmod mwa b e m s
+
+-- | Return count of trailing zero bits
+--
+-- Return 0 for zero BigNat
+bigNatCtz# :: BigNat -> Word#
+bigNatCtz# a
+ | bigNatIsZero a = 0##
+ | True = go 0# 0##
+ where
+ go i c = case indexWordArray# a i of
+ 0## -> go (i +# 1#) (c `plusWord#` WORD_SIZE_IN_BITS##)
+ w -> ctz# w `plusWord#` c
+
+-- | Return count of trailing zero bits
+--
+-- Return 0 for zero BigNat
+bigNatCtz :: BigNat -> Word
+bigNatCtz a = W# (bigNatCtz# a)
+
+
+-- | Return count of trailing zero words
+--
+-- Return 0 for zero BigNat
+bigNatCtzWord# :: BigNat -> Word#
+bigNatCtzWord# a
+ | bigNatIsZero a = 0##
+ | True = go 0# 0##
+ where
+ go i c = case indexWordArray# a i of
+ 0## -> go (i +# 1#) (c `plusWord#` 1##)
+ _ -> c
+
+-- | Return count of trailing zero words
+--
+-- Return 0 for zero BigNat
+bigNatCtzWord :: BigNat -> Word
+bigNatCtzWord a = W# (bigNatCtzWord# a)
+
+-------------------------------------------------
+-- Export to memory
+-------------------------------------------------
+
+-- | Write a BigNat in base-256 little-endian representation and return the
+-- number of bytes written.
+--
+-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes
+-- written in advance. In case of @/i/ == 0@, the function will write and report
+-- zero bytes written.
+bigNatToAddrLE# :: BigNat -> Addr# -> State# s -> (# State# s, Word# #)
+bigNatToAddrLE# a addr s0
+ | isTrue# (sz ==# 0#) = (# s0, 0## #)
+ | True = case writeMSB s0 of
+ (# s1, k #) -> case go 0# s1 of
+ s2 -> (# s2, k `plusWord#` (int2Word# li `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) #)
+ where
+ !sz = wordArraySize# a
+ !li = sz -# 1#
+
+ writeMSB = wordToAddrLE# (indexWordArray# a li)
+ (addr `plusAddr#` (li `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#))
+
+ go i s
+ | isTrue# (i <# li)
+ , off <- i `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#
+ , w <- indexWordArray# a i
+ = case wordWriteAddrLE# w (addr `plusAddr#` off) s of
+ s -> go (i +# 1#) s
+
+ | True
+ = s
+
+-- | Write a BigNat in base-256 big-endian representation and return the
+-- number of bytes written.
+--
+-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes
+-- written in advance. In case of @/i/ == 0@, the function will write and report
+-- zero bytes written.
+bigNatToAddrBE# :: BigNat -> Addr# -> State# s -> (# State# s, Word# #)
+bigNatToAddrBE# a addr s0
+ | isTrue# (sz ==# 0#) = (# s0, 0## #)
+ | msw <- indexWordArray# a (sz -# 1#)
+ = case wordToAddrBE# msw addr s0 of
+ (# s1, k #) -> case go (sz -# 1#) (addr `plusAddr#` word2Int# k) s1 of
+ s2 -> (# s2, k `plusWord#` (int2Word# (sz -# 1#) `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) #)
+ where
+ sz = wordArraySize# a
+
+ go i adr s
+ | 0# <- i
+ = s
+
+ | w <- indexWordArray# a (i -# 1#)
+ = case wordWriteAddrBE# w adr s of
+ s' -> go (i -# 1#)
+ (adr `plusAddr#` WORD_SIZE_IN_BYTES# ) s'
+
+
+-- | Write a BigNat in base-256 representation and return the
+-- number of bytes written.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes
+-- written in advance. In case of @/i/ == 0@, the function will write and report
+-- zero bytes written.
+bigNatToAddr# :: BigNat -> Addr# -> Bool# -> State# s -> (# State# s, Word# #)
+bigNatToAddr# a addr 0# s = bigNatToAddrLE# a addr s
+bigNatToAddr# a addr _ s = bigNatToAddrBE# a addr s
+
+-- | Write a BigNat in base-256 representation and return the
+-- number of bytes written.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes
+-- written in advance. In case of @/i/ == 0@, the function will write and report
+-- zero bytes written.
+bigNatToAddr :: BigNat -> Addr# -> Bool# -> IO Word
+bigNatToAddr a addr e = IO \s -> case bigNatToAddr# a addr e s of
+ (# s', w #) -> (# s', W# w #)
+
+
+
+-------------------------------------------------
+-- Import from memory
+-------------------------------------------------
+
+-- | Read a BigNat in base-256 little-endian representation from an Addr#.
+--
+-- The size is given in bytes.
+--
+-- Higher limbs equal to 0 are automatically trimed.
+bigNatFromAddrLE# :: Word# -> Addr# -> State# s -> (# State# s, BigNat #)
+bigNatFromAddrLE# 0## _ s = (# s, bigNatZero void# #)
+bigNatFromAddrLE# sz addr s =
+ let
+ !nw = sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT#
+ !nb = sz `and#` WORD_SIZE_BYTES_MASK##
+
+ readMSB mwa s
+ | 0## <- nb
+ = s
+
+ | off <- word2Int# (nw `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#)
+ = case wordFromAddrLE# nb (addr `plusAddr#` off) s of
+ (# s, w #) -> mwaWrite# mwa (word2Int# nw) w s
+
+ go mwa i s
+ | isTrue# (i ==# word2Int# nw)
+ = s
+
+ | off <- i `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#
+ = case wordFromAddrLE# WORD_SIZE_IN_BYTES## (addr `plusAddr#` off) s of
+ (# s, w #) -> case mwaWrite# mwa i w s of
+ s -> go mwa (i +# 1#) s
+
+ in case newWordArray# (word2Int# nw +# (word2Int# nb /=# 0#)) s of
+ (# s, mwa #) -> case readMSB mwa s of
+ s -> case go mwa 0# s of
+ s -> case mwaTrimZeroes# mwa s of
+ s -> unsafeFreezeByteArray# mwa s
+
+-- | Read a BigNat in base-256 big-endian representation from an Addr#.
+--
+-- The size is given in bytes.
+--
+-- Null higher limbs are automatically trimed.
+bigNatFromAddrBE# :: Word# -> Addr# -> State# s -> (# State# s, BigNat #)
+bigNatFromAddrBE# 0## _ s = (# s, bigNatZero void# #)
+bigNatFromAddrBE# sz addr s =
+ let
+ !nw = word2Int# (sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT#)
+ !nb = sz `and#` WORD_SIZE_BYTES_MASK##
+
+ goMSB mwa s
+ | 0## <- nb
+ = s
+
+ | True
+ = case wordFromAddrBE# nb addr s of
+ (# s, w #) -> mwaWrite# mwa nw w s
+
+ go mwa i s
+ | isTrue# (i ==# nw)
+ = s
+
+ | k <- nw -# 1# -# i
+ , off <- (k `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#) +# word2Int# nb
+ = case wordFromAddrBE# WORD_SIZE_IN_BYTES## (addr `plusAddr#` off) s of
+ (# s, w #) -> case mwaWrite# mwa i w s of
+ s -> go mwa (i +# 1#) s
+
+ in case newWordArray# (nw +# (word2Int# nb /=# 0#)) s of
+ (# s, mwa #) -> case goMSB mwa s of
+ s -> case go mwa 0# s of
+ s -> case mwaTrimZeroes# mwa s of
+ s -> unsafeFreezeByteArray# mwa s
+
+-- | Read a BigNat in base-256 representation from an Addr#.
+--
+-- The size is given in bytes.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- Null higher limbs are automatically trimed.
+bigNatFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, BigNat #)
+bigNatFromAddr# sz addr 0# s = bigNatFromAddrLE# sz addr s
+bigNatFromAddr# sz addr _ s = bigNatFromAddrBE# sz addr s
+
+-------------------------------------------------
+-- Export to ByteArray
+-------------------------------------------------
+
+-- | Write a BigNat in base-256 little-endian representation and return the
+-- number of bytes written.
+--
+-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes
+-- written in advance. In case of @/i/ == 0@, the function will write and report
+-- zero bytes written.
+bigNatToMutableByteArrayLE# :: BigNat -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #)
+bigNatToMutableByteArrayLE# a mba moff s0
+ | isTrue# (sz ==# 0#) = (# s0, 0## #)
+ | True = case writeMSB s0 of
+ (# s1, k #) -> case go 0# s1 of
+ s2 -> (# s2, k `plusWord#` (int2Word# li `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) #)
+ where
+ !sz = wordArraySize# a
+ !li = sz -# 1#
+
+ writeMSB = wordToMutableByteArrayLE# (indexWordArray# a li)
+ mba (moff `plusWord#` int2Word# (li `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#))
+
+ go i s
+ | isTrue# (i <# li)
+ , off <- int2Word# i `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#
+ , w <- indexWordArray# a i
+ = case wordWriteMutableByteArrayLE# w mba (moff `plusWord#` off) s of
+ s -> go (i +# 1#) s
+
+ | True
+ = s
+
+-- | Write a BigNat in base-256 big-endian representation and return the
+-- number of bytes written.
+--
+-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes
+-- written in advance. In case of @/i/ == 0@, the function will write and report
+-- zero bytes written.
+bigNatToMutableByteArrayBE# :: BigNat -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #)
+bigNatToMutableByteArrayBE# a mba moff s0
+ | isTrue# (sz ==# 0#) = (# s0, 0## #)
+ | msw <- indexWordArray# a (sz -# 1#)
+ = case wordToMutableByteArrayBE# msw mba moff s0 of
+ (# s1, k #) -> case go (sz -# 1#) k s1 of
+ s2 -> (# s2, k `plusWord#` (int2Word# (sz -# 1#) `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) #)
+ where
+ sz = wordArraySize# a
+
+ go i c s
+ | 0# <- i
+ = s
+
+ | w <- indexWordArray# a (i -# 1#)
+ = case wordWriteMutableByteArrayBE# w mba (moff `plusWord#` c) s of
+ s' -> go (i -# 1#)
+ (c `plusWord#` WORD_SIZE_IN_BYTES## ) s'
+
+
+-- | Write a BigNat in base-256 representation and return the
+-- number of bytes written.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes
+-- written in advance. In case of @/i/ == 0@, the function will write and report
+-- zero bytes written.
+bigNatToMutableByteArray# :: BigNat -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #)
+bigNatToMutableByteArray# a mba off 0# s = bigNatToMutableByteArrayLE# a mba off s
+bigNatToMutableByteArray# a mba off _ s = bigNatToMutableByteArrayBE# a mba off s
+
+-------------------------------------------------
+-- Import from ByteArray
+-------------------------------------------------
+
+-- | Read a BigNat in base-256 little-endian representation from a ByteArray#.
+--
+-- The size is given in bytes.
+--
+-- Null higher limbs are automatically trimed.
+bigNatFromByteArrayLE# :: Word# -> ByteArray# -> Word# -> State# s -> (# State# s, BigNat #)
+bigNatFromByteArrayLE# 0## _ _ s = (# s, bigNatZero void# #)
+bigNatFromByteArrayLE# sz ba moff s =
+ let
+ !nw = sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT#
+ !nb = sz `and#` WORD_SIZE_BYTES_MASK##
+
+ readMSB mwa s
+ | 0## <- nb
+ = s
+
+ | off <- nw `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#
+ = case wordFromByteArrayLE# nb ba (moff `plusWord#` off) of
+ w -> mwaWrite# mwa (word2Int# nw) w s
+
+ go mwa i s
+ | isTrue# (i `eqWord#` nw)
+ = s
+
+ | off <- i `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#
+ = case wordFromByteArrayLE# WORD_SIZE_IN_BYTES## ba (moff `plusWord#` off) of
+ w -> case mwaWrite# mwa (word2Int# i) w s of
+ s -> go mwa (i `plusWord#` 1##) s
+
+ in case newWordArray# (word2Int# nw +# (word2Int# nb /=# 0#)) s of
+ (# s, mwa #) -> case readMSB mwa s of
+ s -> case go mwa 0## s of
+ s -> case mwaTrimZeroes# mwa s of
+ s -> unsafeFreezeByteArray# mwa s
+
+-- | Read a BigNat in base-256 big-endian representation from a ByteArray#.
+--
+-- The size is given in bytes.
+--
+-- Null higher limbs are automatically trimed.
+bigNatFromByteArrayBE# :: Word# -> ByteArray# -> Word# -> State# s -> (# State# s, BigNat #)
+bigNatFromByteArrayBE# 0## _ _ s = (# s, bigNatZero void# #)
+bigNatFromByteArrayBE# sz ba moff s =
+ let
+ !nw = sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT#
+ !nb = sz `and#` WORD_SIZE_BYTES_MASK##
+
+ goMSB mwa s
+ | 0## <- nb
+ = s
+
+ | True
+ = case wordFromByteArrayBE# nb ba moff of
+ w -> mwaWrite# mwa (word2Int# nw) w s
+
+ go mwa i s
+ | isTrue# (i `eqWord#` nw)
+ = s
+
+ | k <- nw `minusWord#` 1## `minusWord#` i
+ , off <- (k `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) `plusWord#` nb
+ = case wordFromByteArrayBE# WORD_SIZE_IN_BYTES## ba (moff `plusWord#` off) of
+ w -> case mwaWrite# mwa (word2Int# i) w s of
+ s -> go mwa (i `plusWord#` 1##) s
+
+ in case newWordArray# (word2Int# nw +# (word2Int# nb /=# 0#)) s of
+ (# s, mwa #) -> case goMSB mwa s of
+ s -> case go mwa 0## s of
+ s -> case mwaTrimZeroes# mwa s of
+ s -> unsafeFreezeByteArray# mwa s
+
+-- | Read a BigNat in base-256 representation from a ByteArray#.
+--
+-- The size is given in bytes.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- Null higher limbs are automatically trimed.
+bigNatFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, BigNat #)
+bigNatFromByteArray# sz ba off 0# s = bigNatFromByteArrayLE# sz ba off s
+bigNatFromByteArray# sz ba off _ s = bigNatFromByteArrayBE# sz ba off s
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot
new file mode 100644
index 0000000000000000000000000000000000000000..5c325d074fc3d1166d0ba64d4e1abcd855ab705a
--- /dev/null
+++ b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot
@@ -0,0 +1,19 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module GHC.Num.BigNat where
+
+import GHC.Num.WordArray
+import GHC.Prim
+
+type BigNat = WordArray#
+
+bigNatSubUnsafe :: BigNat -> BigNat -> BigNat
+bigNatMulWord# :: BigNat -> Word# -> BigNat
+bigNatRem :: BigNat -> BigNat -> BigNat
+bigNatRemWord# :: BigNat -> Word# -> Word#
+bigNatShiftR# :: BigNat -> Word# -> BigNat
+bigNatShiftL# :: BigNat -> Word# -> BigNat
+bigNatCtz# :: BigNat -> Word#
+bigNatCtzWord# :: BigNat -> Word#
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs
new file mode 100644
index 0000000000000000000000000000000000000000..aad7d903ff8d6243cb665adfbeffe1600c8156fd
--- /dev/null
+++ b/libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs
@@ -0,0 +1,456 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE GHCForeignImportPrim #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE NegativeLiterals #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file #-}
+
+-- | Check Native implementation against another backend
+module GHC.Num.BigNat.Check where
+
+import GHC.Prim
+import GHC.Types
+import GHC.Num.WordArray
+import GHC.Num.Primitives
+import qualified GHC.Num.BigNat.Native as Native
+
+#if defined(BIGNUM_NATIVE)
+#error You can't validate Native backed against itself. Choose another backend (e.g. gmp, ffi)
+
+#elif defined(BIGNUM_FFI)
+import qualified GHC.Num.BigNat.FFI as Other
+
+#elif defined(BIGNUM_GMP)
+import qualified GHC.Num.BigNat.GMP as Other
+
+#else
+#error Undefined BigNat backend. Use a flag to select it (e.g. gmp, native, ffi)`
+#endif
+
+default ()
+
+bignat_compare
+ :: WordArray#
+ -> WordArray#
+ -> Int#
+bignat_compare a b =
+ let
+ gr = Other.bignat_compare a b
+ nr = Native.bignat_compare a b
+ in case gr ==# nr of
+ 0# -> case unexpectedValue of I# x -> x
+ _ -> gr
+
+mwaCompare
+ :: MutableWordArray# s
+ -> MutableWordArray# s
+ -> State# s
+ -> (# State# s, Bool# #)
+mwaCompare mwa mwb s =
+ case mwaSize# mwa s of
+ (# s, szA #) -> case mwaSize# mwb s of
+ (# s, szB #) -> case szA ==# szB of
+ 0# -> (# s, 0# #)
+ _ -> let
+ go i s
+ | isTrue# (i <# 0#) = (# s, 1# #)
+ | True =
+ case readWordArray# mwa i s of
+ (# s, a #) -> case readWordArray# mwb i s of
+ (# s, b #) -> case a `eqWord#` b of
+ 0# -> (# s, 0# #)
+ _ -> go (i -# 1#) s
+ in go (szA -# 1#) s
+
+mwaCompareOp
+ :: MutableWordArray# s
+ -> (MutableWordArray# s -> State# s -> State# s)
+ -> (MutableWordArray# s -> State# s -> State# s)
+ -> State# s
+ -> State# s
+mwaCompareOp mwa f g s =
+ case mwaSize# mwa s of { (# s, sz #) ->
+ case newWordArray# sz s of { (# s, mwb #) ->
+ case f mwa s of { s ->
+ case g mwb s of { s ->
+ case mwaTrimZeroes# mwa s of { s ->
+ case mwaTrimZeroes# mwb s of { s ->
+ case mwaCompare mwa mwb s of
+ (# s, 0# #) -> case unexpectedValue of _ -> s
+ (# s, _ #) -> s
+ }}}}}}
+
+mwaCompareOp2
+ :: MutableWordArray# s
+ -> MutableWordArray# s
+ -> (MutableWordArray# s -> MutableWordArray# s -> State# s -> State# s)
+ -> (MutableWordArray# s -> MutableWordArray# s -> State# s -> State# s)
+ -> State# s
+ -> State# s
+mwaCompareOp2 mwa mwb f g s =
+ case mwaSize# mwa s of { (# s, szA #) ->
+ case mwaSize# mwb s of { (# s, szB #) ->
+ case newWordArray# szA s of { (# s, mwa' #) ->
+ case newWordArray# szB s of { (# s, mwb' #) ->
+ case f mwa mwb s of { s ->
+ case g mwa' mwb' s of { s ->
+ case mwaTrimZeroes# mwa s of { s ->
+ case mwaTrimZeroes# mwb s of { s ->
+ case mwaTrimZeroes# mwa' s of { s ->
+ case mwaTrimZeroes# mwb' s of { s ->
+ case mwaCompare mwa mwa' s of { (# s, ba #) ->
+ case mwaCompare mwb mwb' s of { (# s, bb #) ->
+ case ba &&# bb of
+ 0# -> case unexpectedValue of _ -> s
+ _ -> s
+ }}}}}}}}}}}}
+
+mwaCompareOpBool
+ :: MutableWordArray# s
+ -> (MutableWordArray# s -> State# s -> (#State# s, Bool# #))
+ -> (MutableWordArray# s -> State# s -> (#State# s, Bool# #))
+ -> State# s
+ -> (# State# s, Bool# #)
+mwaCompareOpBool mwa f g s =
+ case mwaSize# mwa s of { (# s, sz #) ->
+ case newWordArray# sz s of { (# s, mwb #) ->
+ case f mwa s of { (# s, ra #) ->
+ case g mwb s of { (# s, rb #) ->
+ case ra ==# rb of
+ 0# -> case unexpectedValue of _ -> (# s, ra #)
+ _ -> case (ra ==# 1#) of -- don't compare MWAs if overflow signaled!
+ 1# -> (# s, ra #)
+ _ -> case mwaTrimZeroes# mwa s of { s ->
+ case mwaTrimZeroes# mwb s of { s ->
+ case mwaCompare mwa mwb s of
+ (# s, 0# #) -> case unexpectedValue of _ -> (# s, ra #)
+ _ -> (# s, ra #)
+ }}}}}}
+
+mwaCompareOpWord
+ :: MutableWordArray# s
+ -> (MutableWordArray# s -> State# s -> (#State# s, Word# #))
+ -> (MutableWordArray# s -> State# s -> (#State# s, Word# #))
+ -> State# s
+ -> (# State# s, Word# #)
+mwaCompareOpWord mwa f g s =
+ case mwaSize# mwa s of { (# s, sz #) ->
+ case newWordArray# sz s of { (# s, mwb #) ->
+ case f mwa s of { (# s, ra #) ->
+ case g mwb s of { (# s, rb #) ->
+ case mwaTrimZeroes# mwa s of { s ->
+ case mwaTrimZeroes# mwb s of { s ->
+ case mwaCompare mwa mwb s of
+ (# s, b #) -> case b &&# (ra `eqWord#` rb) of
+ 0# -> case unexpectedValue of _ -> (# s, ra #)
+ _ -> (# s, ra #)
+ }}}}}}
+
+bignat_add
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_add mwa wa wb
+ = mwaCompareOp mwa
+ (\m -> Other.bignat_add m wa wb)
+ (\m -> Native.bignat_add m wa wb)
+
+bignat_add_word
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_add_word mwa wa b
+ = mwaCompareOp mwa
+ (\m -> Other.bignat_add_word m wa b)
+ (\m -> Native.bignat_add_word m wa b)
+
+bignat_mul_word
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_mul_word mwa wa b
+ = mwaCompareOp mwa
+ (\m -> Other.bignat_mul_word m wa b)
+ (\m -> Native.bignat_mul_word m wa b)
+
+bignat_sub
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> (# State# RealWorld, Bool# #)
+bignat_sub mwa wa wb
+ = mwaCompareOpBool mwa
+ (\m -> Other.bignat_sub m wa wb)
+ (\m -> Native.bignat_sub m wa wb)
+
+bignat_sub_word
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> (# State# RealWorld, Bool# #)
+bignat_sub_word mwa wa b
+ = mwaCompareOpBool mwa
+ (\m -> Other.bignat_sub_word m wa b)
+ (\m -> Native.bignat_sub_word m wa b)
+
+bignat_mul
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_mul mwa wa wb
+ = mwaCompareOp mwa
+ (\m -> Other.bignat_mul m wa wb)
+ (\m -> Native.bignat_mul m wa wb)
+
+bignat_popcount :: WordArray# -> Word#
+bignat_popcount wa =
+ let
+ gr = Other.bignat_popcount wa
+ nr = Native.bignat_popcount wa
+ in case gr `eqWord#` nr of
+ 0# -> 1## `quotWord#` 0##
+ _ -> gr
+
+bignat_shiftl
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_shiftl mwa wa n
+ = mwaCompareOp mwa
+ (\m -> Other.bignat_shiftl m wa n)
+ (\m -> Native.bignat_shiftl m wa n)
+
+bignat_shiftr
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_shiftr mwa wa n
+ = mwaCompareOp mwa
+ (\m -> Other.bignat_shiftr m wa n)
+ (\m -> Native.bignat_shiftr m wa n)
+
+bignat_shiftr_neg
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_shiftr_neg mwa wa n
+ = mwaCompareOp mwa
+ (\m -> Other.bignat_shiftr_neg m wa n)
+ (\m -> Native.bignat_shiftr_neg m wa n)
+
+bignat_or
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_or mwa wa wb
+ = mwaCompareOp mwa
+ (\m -> Other.bignat_or m wa wb)
+ (\m -> Native.bignat_or m wa wb)
+
+bignat_xor
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_xor mwa wa wb
+ = mwaCompareOp mwa
+ (\m -> Other.bignat_xor m wa wb)
+ (\m -> Native.bignat_xor m wa wb)
+
+bignat_and
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_and mwa wa wb
+ = mwaCompareOp mwa
+ (\m -> Other.bignat_and m wa wb)
+ (\m -> Native.bignat_and m wa wb)
+
+bignat_and_not
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_and_not mwa wa wb
+ = mwaCompareOp mwa
+ (\m -> Other.bignat_and_not m wa wb)
+ (\m -> Native.bignat_and_not m wa wb)
+
+bignat_quotrem
+ :: MutableWordArray# RealWorld
+ -> MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_quotrem mwq mwr wa wb
+ = mwaCompareOp2 mwq mwr
+ (\m1 m2 -> Other.bignat_quotrem m1 m2 wa wb)
+ (\m1 m2 -> Native.bignat_quotrem m1 m2 wa wb)
+
+bignat_quot
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_quot mwq wa wb
+ = mwaCompareOp mwq
+ (\m -> Other.bignat_quot m wa wb)
+ (\m -> Native.bignat_quot m wa wb)
+
+bignat_rem
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_rem mwr wa wb
+ = mwaCompareOp mwr
+ (\m -> Other.bignat_rem m wa wb)
+ (\m -> Native.bignat_rem m wa wb)
+
+bignat_quotrem_word
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> (# State# RealWorld, Word# #)
+bignat_quotrem_word mwq wa b
+ = mwaCompareOpWord mwq
+ (\m -> Other.bignat_quotrem_word m wa b)
+ (\m -> Native.bignat_quotrem_word m wa b)
+
+bignat_quot_word
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_quot_word mwq wa b
+ = mwaCompareOp mwq
+ (\m -> Other.bignat_quot_word m wa b)
+ (\m -> Native.bignat_quot_word m wa b)
+
+bignat_rem_word
+ :: WordArray#
+ -> Word#
+ -> Word#
+bignat_rem_word wa b =
+ let
+ gr = Other.bignat_rem_word wa b
+ nr = Native.bignat_rem_word wa b
+ in case gr `eqWord#` nr of
+ 1# -> gr
+ _ -> case unexpectedValue of
+ W# e -> e
+
+bignat_gcd
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_gcd mwr wa wb
+ = mwaCompareOp mwr
+ (\m -> Other.bignat_gcd m wa wb)
+ (\m -> Native.bignat_gcd m wa wb)
+
+bignat_gcd_word
+ :: WordArray#
+ -> Word#
+ -> Word#
+bignat_gcd_word wa b =
+ let
+ gr = Other.bignat_gcd_word wa b
+ nr = Native.bignat_gcd_word wa b
+ in case gr `eqWord#` nr of
+ 1# -> gr
+ _ -> case unexpectedValue of
+ W# e -> e
+
+bignat_gcd_word_word
+ :: Word#
+ -> Word#
+ -> Word#
+bignat_gcd_word_word a b =
+ let
+ gr = Other.bignat_gcd_word_word a b
+ nr = Native.bignat_gcd_word_word a b
+ in case gr `eqWord#` nr of
+ 1# -> gr
+ _ -> case unexpectedValue of
+ W# e -> e
+
+bignat_encode_double :: WordArray# -> Int# -> Double#
+bignat_encode_double a e =
+ let
+ gr = Other.bignat_encode_double a e
+ nr = Native.bignat_encode_double a e
+ in case gr ==## nr of
+ 1# -> gr
+ _ -> case unexpectedValue of
+ _ -> gr
+
+bignat_powmod_word :: WordArray# -> WordArray# -> Word# -> Word#
+bignat_powmod_word b e m =
+ let
+ gr = Other.bignat_powmod_word b e m
+ nr = Native.bignat_powmod_word b e m
+ in case gr `eqWord#` nr of
+ 1# -> gr
+ _ -> case unexpectedValue of
+ W# e -> e
+
+bignat_powmod
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_powmod r b e m
+ = mwaCompareOp r
+ (\r' -> Other.bignat_powmod r' b e m)
+ (\r' -> Native.bignat_powmod r' b e m)
+
+bignat_powmod_words
+ :: Word#
+ -> Word#
+ -> Word#
+ -> Word#
+bignat_powmod_words b e m =
+ let
+ gr = Other.bignat_powmod_words b e m
+ nr = Native.bignat_powmod_words b e m
+ in case gr `eqWord#` nr of
+ 1# -> gr
+ _ -> case unexpectedValue of
+ W# e -> e
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs
new file mode 100644
index 0000000000000000000000000000000000000000..3ef2f7046cb081d89d49fb942c6d820596b6e097
--- /dev/null
+++ b/libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs
@@ -0,0 +1,581 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE GHCForeignImportPrim #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE NegativeLiterals #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+-- | External BigNat backend that directly call FFI operations.
+--
+-- This backend can be useful for specific compilers such as GHCJS or Asterius
+-- that replace bignat foreign calls with calls to the native platform bignat
+-- library (e.g. JavaScript's BigInt). You can also link an extra object
+-- providing the implementation.
+module GHC.Num.BigNat.FFI where
+
+import GHC.Prim
+import GHC.Types
+import GHC.Num.WordArray
+import GHC.Num.Primitives
+
+default ()
+
+-- | Compare two non-zero BigNat of the same length
+--
+-- Return:
+-- < 0 ==> LT
+-- == 0 ==> EQ
+-- > 0 ==> GT
+bignat_compare
+ :: WordArray#
+ -> WordArray#
+ -> Int#
+bignat_compare = ghc_bignat_compare
+
+foreign import ccall unsafe ghc_bignat_compare
+ :: WordArray#
+ -> WordArray#
+ -> Int#
+
+-- | Add two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: max (size a, size b) + 1
+--
+-- The potential 0 most-significant Word (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
+bignat_add
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_add mwa wa wb s
+ = ioVoid (ghc_bignat_add mwa wa wb) s
+
+foreign import ccall unsafe ghc_bignat_add
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> IO ()
+
+-- | Add a non-zero BigNat and a non-zero Word#
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a + 1
+--
+-- The potential 0 most-significant Word (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
+bignat_add_word
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_add_word mwa wa b s =
+ ioVoid (ghc_bignat_add_word mwa wa b) s
+
+foreign import ccall unsafe ghc_bignat_add_word
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> Word#
+ -> IO ()
+
+-- | Multiply a non-zero BigNat and a non-zero Word#
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a + 1
+--
+-- The potential 0 most-significant Word (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
+bignat_mul_word
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_mul_word mwa wa b s =
+ ioVoid (ghc_bignat_mul_word mwa wa b) s
+
+foreign import ccall unsafe ghc_bignat_mul_word
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> Word#
+ -> IO ()
+
+-- | Sub two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+--
+-- Return True to indicate overflow.
+bignat_sub
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> (# State# RealWorld, Bool# #)
+bignat_sub mwa wa wb s = ioBool (ghc_bignat_sub mwa wa wb) s
+
+foreign import ccall unsafe ghc_bignat_sub
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> IO Bool
+
+-- | Sub a non-zero word from a non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+--
+-- Return True to indicate overflow.
+bignat_sub_word
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> (# State# RealWorld, Bool# #)
+bignat_sub_word mwa wa b s = ioBool (ghc_bignat_sub_word mwa wa b) s
+
+foreign import ccall unsafe ghc_bignat_sub_word
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> Word#
+ -> IO Bool
+
+-- | Multiply two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a+size b
+--
+-- The potential 0 most-significant Word (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
+bignat_mul
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_mul mwa wa wb s = ioVoid (ghc_bignat_mul mwa wa wb) s
+
+foreign import ccall unsafe ghc_bignat_mul
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> IO ()
+
+-- | PopCount of a non-zero BigNat
+bignat_popcount :: WordArray# -> Word#
+bignat_popcount = ghc_bignat_popcount
+
+foreign import ccall unsafe ghc_bignat_popcount
+ :: WordArray#
+ -> Word#
+
+-- | Left-shift a non-zero BigNat by a non-zero amount of bits
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a + required new limbs
+--
+-- The potential 0 most-significant Word (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
+bignat_shiftl
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_shiftl mwa wa n s = ioVoid (ghc_bignat_shiftl mwa wa n) s
+
+foreign import ccall unsafe ghc_bignat_shiftl
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> IO ()
+
+-- | Right-shift a non-zero BigNat by a non-zero amount of bits
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: required limbs
+--
+-- The potential 0 most-significant Word (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
+bignat_shiftr
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_shiftr mwa wa n s = ioVoid (ghc_bignat_shiftr mwa wa n) s
+
+foreign import ccall unsafe ghc_bignat_shiftr
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> IO ()
+
+-- | Right-shift a non-zero BigNat by a non-zero amount of bits by first
+-- converting it into its two's complement representation and then again after
+-- the arithmetic shift.
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: required limbs
+--
+-- The potential 0 most-significant Words (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
+bignat_shiftr_neg
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_shiftr_neg mwa wa n s = ioVoid (ghc_bignat_shiftr_neg mwa wa n) s
+
+foreign import ccall unsafe ghc_bignat_shiftr_neg
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> IO ()
+
+
+-- | OR two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: max (size a, size b)
+bignat_or
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_or #-}
+bignat_or mwa wa wb s = ioVoid (ghc_bignat_or mwa wa wb) s
+
+foreign import ccall unsafe ghc_bignat_or
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> IO ()
+
+-- | XOR two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: max (size a, size b)
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+bignat_xor
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_xor #-}
+bignat_xor mwa wa wb s = ioVoid (ghc_bignat_xor mwa wa wb) s
+
+foreign import ccall unsafe ghc_bignat_xor
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> IO ()
+
+-- | AND two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: min (size a, size b)
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+bignat_and
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_and #-}
+bignat_and mwa wa wb s = ioVoid (ghc_bignat_and mwa wa wb) s
+
+foreign import ccall unsafe ghc_bignat_and
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> IO ()
+
+-- | ANDNOT two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+bignat_and_not
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_and_not #-}
+bignat_and_not mwa wa wb s = ioVoid (ghc_bignat_and_not mwa wa wb) s
+
+foreign import ccall unsafe ghc_bignat_and_not
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> IO ()
+
+-- | QuotRem of two non-zero BigNat
+--
+-- Result quotient and remainder are to be stored in the MutableWordArray#.
+-- The first one (quotient) has size: size(A)-size(B)+1
+-- The second one (remainder) has size: size(b)
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+bignat_quotrem
+ :: MutableWordArray# RealWorld -- ^ Quotient
+ -> MutableWordArray# RealWorld -- ^ Remainder
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_quotrem mwq mwr wa wb s =
+ ioVoid (ghc_bignat_quotrem mwq mwr wa wb) s
+
+foreign import ccall unsafe ghc_bignat_quotrem
+ :: MutableWordArray# RealWorld
+ -> MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> IO ()
+
+-- | Quotient of two non-zero BigNat
+--
+-- Result quotient is to be stored in the MutableWordArray#.
+-- The latter has size: size(A)-size(B)+1
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+bignat_quot
+ :: MutableWordArray# RealWorld -- ^ Quotient
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_quot mwq wa wb s =
+ ioVoid (ghc_bignat_quot mwq wa wb) s
+
+foreign import ccall unsafe ghc_bignat_quot
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> IO ()
+
+-- | Remainder of two non-zero BigNat
+--
+-- Result remainder is to be stored in the MutableWordArray#.
+-- The latter has size: size(B)
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+bignat_rem
+ :: MutableWordArray# RealWorld -- ^ Quotient
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_rem mwr wa wb s =
+ ioVoid (ghc_bignat_rem mwr wa wb) s
+
+foreign import ccall unsafe ghc_bignat_rem
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> IO ()
+
+-- | QuotRem of a non-zero BigNat and a non-zero Word
+--
+-- Result quotient is to be stored in the MutableWordArray#.
+-- The latter has size: size(A)
+--
+-- The remainder is returned.
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+bignat_quotrem_word
+ :: MutableWordArray# RealWorld -- ^ Quotient
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> (# State# RealWorld, Word# #)
+bignat_quotrem_word mwq wa b s =
+ ioWord# (ghc_bignat_quotrem_word mwq wa b) s
+
+foreign import ccall unsafe ghc_bignat_quotrem_word
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> IO Word
+
+-- | Quot of a non-zero BigNat and a non-zero Word
+--
+-- Result quotient is to be stored in the MutableWordArray#.
+-- The latter has size: size(A)
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+bignat_quot_word
+ :: MutableWordArray# RealWorld -- ^ Quotient
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_quot_word mwq wa b s =
+ ioVoid (ghc_bignat_quot_word mwq wa b) s
+
+foreign import ccall unsafe ghc_bignat_quot_word
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> IO ()
+
+-- | Remainder of a non-zero BigNat and a non-zero Word
+--
+-- The remainder is returned.
+bignat_rem_word
+ :: WordArray#
+ -> Word#
+ -> Word#
+bignat_rem_word = ghc_bignat_rem_word
+
+foreign import ccall unsafe ghc_bignat_rem_word
+ :: WordArray#
+ -> Word#
+ -> Word#
+
+
+-- | Greatest common divisor (GCD) of two non-zero and non-one BigNat
+--
+-- Result GCD is to be stored in the MutableWordArray#.
+-- The latter has size: size(B)
+-- The first WordArray# is greater than the second WordArray#.
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+bignat_gcd
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_gcd mwr wa wb s =
+ ioVoid (ghc_bignat_gcd mwr wa wb) s
+
+foreign import ccall unsafe ghc_bignat_gcd
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> IO ()
+
+-- | Greatest common divisor (GCD) of a non-zero/non-one BigNat and a
+-- non-zero/non-one Word#
+--
+-- Result GCD is returned
+bignat_gcd_word
+ :: WordArray#
+ -> Word#
+ -> Word#
+bignat_gcd_word = ghc_bignat_gcd_word
+
+foreign import ccall unsafe ghc_bignat_gcd_word
+ :: WordArray#
+ -> Word#
+ -> Word#
+
+-- | Greatest common divisor (GCD) of two Word#
+--
+-- Result GCD is returned
+bignat_gcd_word_word
+ :: Word#
+ -> Word#
+ -> Word#
+bignat_gcd_word_word = ghc_bignat_gcd_word_word
+
+foreign import ccall unsafe ghc_bignat_gcd_word_word
+ :: Word#
+ -> Word#
+ -> Word#
+
+-- | Encode (# BigNat mantissa, Int# exponent #) into a Double#
+bignat_encode_double :: WordArray# -> Int# -> Double#
+bignat_encode_double = ghc_bignat_encode_double
+
+foreign import ccall unsafe ghc_bignat_encode_double
+ :: WordArray#
+ -> Int#
+ -> Double#
+
+-- | \"@'bignat_powmod_word' /b/ /e/ /m/@\" computes base @/b/@ raised to
+-- exponent @/e/@ modulo @/m/@.
+--
+-- b > 1
+-- e > 0
+-- m > 1
+bignat_powmod_word :: WordArray# -> WordArray# -> Word# -> Word#
+bignat_powmod_word = ghc_bignat_powmod_word
+
+foreign import ccall unsafe ghc_bignat_powmod_word
+ :: WordArray# -> WordArray# -> Word# -> Word#
+
+-- | \"@'bignat_powmod' r /b/ /e/ /m/@\" computes base @/b/@ raised to
+-- exponent @/e/@ modulo @/m/@.
+--
+-- b > 1
+-- e > 0
+-- m > 1
+--
+-- Result is to be stored in the MutableWordArray# (which size is equal to the
+-- one of m).
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+bignat_powmod
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_powmod r b e m s =
+ ioVoid (ghc_bignat_powmod r b e m) s
+
+foreign import ccall unsafe ghc_bignat_powmod
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> WordArray#
+ -> IO ()
+
+-- | \"@'bignat_powmod' /b/ /e/ /m/@\" computes base @/b/@ raised to
+-- exponent @/e/@ modulo @/m/@.
+--
+-- b > 1
+-- e > 0
+-- m > 1
+bignat_powmod_words
+ :: Word#
+ -> Word#
+ -> Word#
+ -> Word#
+bignat_powmod_words = ghc_bignat_powmod_words
+
+foreign import ccall unsafe ghc_bignat_powmod_words
+ :: Word# -> Word# -> Word# -> Word#
+
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs
new file mode 100644
index 0000000000000000000000000000000000000000..cb1fe500d9cfcf069353aed9f7f9ffbd8471d9ec
--- /dev/null
+++ b/libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs
@@ -0,0 +1,498 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GHCForeignImportPrim #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE NegativeLiterals #-}
+{-# LANGUAGE BlockArguments #-}
+
+-- | Backend based on the GNU GMP library.
+--
+-- This has been adapted from the legacy `integer-gmp` package written by
+-- Herbert Valerio Riedel.
+module GHC.Num.BigNat.GMP where
+
+#include "MachDeps.h"
+#include "WordSize.h"
+
+import GHC.Num.WordArray
+import GHC.Num.Primitives
+import GHC.Prim
+import GHC.Types
+
+default ()
+
+----------------------------------------------------------------------------
+-- type definitions
+
+-- NB: all code assumes GMP_LIMB_BITS == WORD_SIZE_IN_BITS
+-- The C99 code in cbits/gmp_wrappers.c will fail to compile if this doesn't hold
+
+-- | Type representing a GMP Limb
+type GmpLimb = Word -- actually, 'CULong'
+type GmpLimb# = Word#
+
+-- | Count of 'GmpLimb's, must be positive (unless specified otherwise).
+type GmpSize = Int -- actually, a 'CLong'
+type GmpSize# = Int#
+
+narrowGmpSize# :: Int# -> Int#
+#if SIZEOF_LONG == SIZEOF_HSWORD
+narrowGmpSize# x = x
+#elif (SIZEOF_LONG == 4) && (SIZEOF_HSWORD == 8)
+-- On IL32P64 (i.e. Win64), we have to be careful with CLong not being
+-- 64bit. This is mostly an issue on values returned from C functions
+-- due to sign-extension.
+narrowGmpSize# = narrow32Int#
+#endif
+
+narrowCInt# :: Int# -> Int#
+narrowCInt# = narrow32Int#
+
+bignat_compare :: WordArray# -> WordArray# -> Int#
+bignat_compare x y = narrowCInt# (c_mpn_cmp x y (wordArraySize# x))
+
+bignat_add
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_add #-}
+bignat_add mwa wa wb s
+ -- weird GMP requirement
+ | isTrue# (wordArraySize# wb ># wordArraySize# wa)
+ = bignat_add mwa wb wa s
+
+ | True
+ = do
+ case ioWord# (c_mpn_add mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of
+ (# s', c #) -> mwaWriteMostSignificant mwa c s'
+
+bignat_add_word
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_add_word #-}
+bignat_add_word mwa wa b s = do
+ case ioWord# (c_mpn_add_1 mwa wa (wordArraySize# wa) b) s of
+ (# s', c #) -> mwaWriteMostSignificant mwa c s'
+
+bignat_sub
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> (# State# RealWorld, Bool# #)
+{-# INLINE bignat_sub #-}
+bignat_sub mwa wa wb s =
+ case ioWord# (c_mpn_sub mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of
+ (# s', 0## #) -> (# s', 0# #)
+ (# s', _ #) -> (# s', 1# #)
+
+bignat_sub_word
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> (# State# RealWorld, Bool# #)
+{-# INLINE bignat_sub_word #-}
+bignat_sub_word mwa wa b s =
+ case ioWord# (c_mpn_sub_1 mwa wa (wordArraySize# wa) b) s of
+ (# s', 0## #) -> (# s', 0# #)
+ (# s', _ #) -> (# s', 1# #)
+
+bignat_mul
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_mul #-}
+bignat_mul mwa wa wb s = do
+ case ioWord# (c_mpn_mul mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of
+ (# s', _msl #) -> s' -- we don't care about the most-significant
+ -- limb. The caller shrink the mwa if
+ -- necessary anyway.
+
+bignat_mul_word
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_mul_word #-}
+bignat_mul_word mwa wa b s =
+ case ioWord# (c_mpn_mul_1 mwa wa (wordArraySize# wa) b) s of
+ (# s', c #) -> mwaWriteMostSignificant mwa c s'
+
+bignat_popcount :: WordArray# -> Word#
+{-# INLINE bignat_popcount #-}
+bignat_popcount wa = c_mpn_popcount wa (wordArraySize# wa)
+
+
+bignat_shiftl
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_shiftl #-}
+bignat_shiftl mwa wa n s =
+ case ioWord# (c_mpn_lshift mwa wa (wordArraySize# wa) n) s of
+ (# s', _msl #) -> s' -- we don't care about the most-significant
+ -- limb. The caller shrink the mwa if
+ -- necessary anyway.
+
+bignat_shiftr
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_shiftr #-}
+bignat_shiftr mwa wa n s =
+ case ioWord# (c_mpn_rshift mwa wa (wordArraySize# wa) n) s of
+ (# s', _msl #) -> s' -- we don't care about the most-significant
+ -- limb. The caller shrink the mwa if
+ -- necessary anyway.
+
+bignat_or
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_or #-}
+bignat_or mwa wa wb s1
+ | isTrue# (szA >=# szB) = go wa szA wb szB s1
+ | True = go wb szB wa szA s1
+ where
+ !szA = wordArraySize# wa
+ !szB = wordArraySize# wb
+ -- nx >= ny
+ go wx nx wy ny s = case ioVoid (c_mpn_ior_n mwa wx wy ny) s of
+ s' -> mwaArrayCopy# mwa ny wx ny (nx -# ny) s'
+
+bignat_xor
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_xor #-}
+bignat_xor mwa wa wb s1
+ | isTrue# (szA >=# szB) = go wa szA wb szB s1
+ | True = go wb szB wa szA s1
+ where
+ !szA = wordArraySize# wa
+ !szB = wordArraySize# wb
+ -- nx >= ny
+ go wx nx wy ny s = case ioVoid (c_mpn_xor_n mwa wx wy ny) s of
+ s' -> mwaArrayCopy# mwa ny wx ny (nx -# ny) s'
+
+bignat_and
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_and #-}
+bignat_and mwa wa wb s = ioVoid (c_mpn_and_n mwa wa wb sz) s
+ where
+ !szA = wordArraySize# wa
+ !szB = wordArraySize# wb
+ !sz = minI# szA szB
+
+bignat_and_not
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+{-# INLINE bignat_and_not #-}
+bignat_and_not mwa wa wb s =
+ case ioVoid (c_mpn_andn_n mwa wa wb n) s of
+ s' -> mwaArrayCopy# mwa szB wa szB (szA -# szB) s'
+ where
+ !szA = wordArraySize# wa
+ !szB = wordArraySize# wb
+ !n = minI# szA szB
+
+bignat_quotrem
+ :: MutableWordArray# RealWorld
+ -> MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_quotrem mwq mwr wa wb s =
+ ioVoid (c_mpn_tdiv_qr mwq mwr 0# wa szA wb szB) s
+ where
+ szA = wordArraySize# wa
+ szB = wordArraySize# wb
+
+bignat_quot
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_quot mwq wa wb s =
+ ioVoid (c_mpn_tdiv_q mwq wa szA wb szB) s
+ where
+ szA = wordArraySize# wa
+ szB = wordArraySize# wb
+
+bignat_rem
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_rem mwr wa wb s =
+ ioVoid (c_mpn_tdiv_r mwr wa szA wb szB) s
+ where
+ szA = wordArraySize# wa
+ szB = wordArraySize# wb
+
+bignat_quotrem_word
+ :: MutableWordArray# RealWorld -- ^ Quotient
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> (# State# RealWorld, Word# #)
+bignat_quotrem_word mwq wa b s =
+ ioWord# (c_mpn_divrem_1 mwq 0# wa szA b) s
+ where
+ szA = wordArraySize# wa
+
+bignat_quot_word
+ :: MutableWordArray# RealWorld -- ^ Quotient
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_quot_word mwq wa b s =
+ case bignat_quotrem_word mwq wa b s of
+ (# s', _ #) -> s'
+
+bignat_rem_word
+ :: WordArray#
+ -> Word#
+ -> Word#
+bignat_rem_word wa b =
+ c_mpn_mod_1 wa (wordArraySize# wa) b
+
+
+bignat_gcd
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_gcd mwr wa wb s =
+ -- wa > wb
+ case ioInt# (c_mpn_gcd# mwr wa (wordArraySize# wa) wb (wordArraySize# wb)) s of
+ (# s', sz #) -> mwaSetSize# mwr (narrowGmpSize# sz) s'
+
+bignat_gcd_word
+ :: WordArray#
+ -> Word#
+ -> Word#
+bignat_gcd_word wa b = c_mpn_gcd_1# wa (wordArraySize# wa) b
+
+bignat_gcd_word_word
+ :: Word#
+ -> Word#
+ -> Word#
+bignat_gcd_word_word = integer_gmp_gcd_word
+
+
+bignat_encode_double :: WordArray# -> Int# -> Double#
+bignat_encode_double wa e = c_mpn_get_d wa (wordArraySize# wa) e
+
+bignat_shiftr_neg
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_shiftr_neg mwa wa n s =
+ ioVoid (c_mpn_rshift_2c mwa wa (wordArraySize# wa) n) s
+
+bignat_powmod_word
+ :: WordArray#
+ -> WordArray#
+ -> Word#
+ -> Word#
+bignat_powmod_word b e m =
+ integer_gmp_powm1# b (wordArraySize# b) e (wordArraySize# e) m
+
+bignat_powmod_words
+ :: Word#
+ -> Word#
+ -> Word#
+ -> Word#
+bignat_powmod_words = integer_gmp_powm_word
+
+bignat_powmod
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_powmod r b e m s =
+ ioVoid (integer_gmp_powm# r b (wordArraySize# b) e (wordArraySize# e) m (wordArraySize# m)) s
+
+
+----------------------------------------------------------------------
+-- FFI ccall imports
+
+foreign import ccall unsafe "integer_gmp_gcd_word"
+ integer_gmp_gcd_word :: GmpLimb# -> GmpLimb# -> GmpLimb#
+
+foreign import ccall unsafe "integer_gmp_mpn_gcd_1"
+ c_mpn_gcd_1# :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb#
+
+foreign import ccall unsafe "integer_gmp_mpn_gcd"
+ c_mpn_gcd# :: MutableByteArray# s -> ByteArray# -> GmpSize#
+ -> ByteArray# -> GmpSize# -> IO GmpSize
+
+foreign import ccall unsafe "integer_gmp_gcdext"
+ integer_gmp_gcdext# :: MutableByteArray# s -> MutableByteArray# s
+ -> ByteArray# -> GmpSize#
+ -> ByteArray# -> GmpSize# -> IO GmpSize
+
+-- mp_limb_t mpn_add_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,
+-- mp_limb_t s2limb)
+foreign import ccall unsafe "gmp.h __gmpn_add_1"
+ c_mpn_add_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#
+ -> IO GmpLimb
+
+-- mp_limb_t mpn_sub_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,
+-- mp_limb_t s2limb)
+foreign import ccall unsafe "gmp.h __gmpn_sub_1"
+ c_mpn_sub_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#
+ -> IO GmpLimb
+
+-- mp_limb_t mpn_mul_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,
+-- mp_limb_t s2limb)
+foreign import ccall unsafe "gmp.h __gmpn_mul_1"
+ c_mpn_mul_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#
+ -> IO GmpLimb
+
+-- mp_limb_t mpn_add (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,
+-- const mp_limb_t *s2p, mp_size_t s2n)
+foreign import ccall unsafe "gmp.h __gmpn_add"
+ c_mpn_add :: MutableByteArray# s -> ByteArray# -> GmpSize#
+ -> ByteArray# -> GmpSize# -> IO GmpLimb
+
+-- mp_limb_t mpn_sub (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,
+-- const mp_limb_t *s2p, mp_size_t s2n)
+foreign import ccall unsafe "gmp.h __gmpn_sub"
+ c_mpn_sub :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
+ -> GmpSize# -> IO GmpLimb
+
+-- mp_limb_t mpn_mul (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,
+-- const mp_limb_t *s2p, mp_size_t s2n)
+foreign import ccall unsafe "gmp.h __gmpn_mul"
+ c_mpn_mul :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
+ -> GmpSize# -> IO GmpLimb
+
+-- int mpn_cmp (const mp_limb_t *s1p, const mp_limb_t *s2p, mp_size_t n)
+foreign import ccall unsafe "gmp.h __gmpn_cmp"
+ c_mpn_cmp :: ByteArray# -> ByteArray# -> GmpSize# -> Int#
+
+-- void mpn_tdiv_qr (mp_limb_t *qp, mp_limb_t *rp, mp_size_t qxn,
+-- const mp_limb_t *np, mp_size_t nn,
+-- const mp_limb_t *dp, mp_size_t dn)
+foreign import ccall unsafe "gmp.h __gmpn_tdiv_qr"
+ c_mpn_tdiv_qr :: MutableByteArray# s -> MutableByteArray# s -> GmpSize#
+ -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# -> IO ()
+
+foreign import ccall unsafe "integer_gmp_mpn_tdiv_q"
+ c_mpn_tdiv_q :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
+ -> GmpSize# -> IO ()
+
+foreign import ccall unsafe "integer_gmp_mpn_tdiv_r"
+ c_mpn_tdiv_r :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
+ -> GmpSize# -> IO ()
+
+-- mp_limb_t mpn_divrem_1 (mp_limb_t *r1p, mp_size_t qxn, mp_limb_t *s2p,
+-- mp_size_t s2n, mp_limb_t s3limb)
+foreign import ccall unsafe "gmp.h __gmpn_divrem_1"
+ c_mpn_divrem_1 :: MutableByteArray# s -> GmpSize# -> ByteArray# -> GmpSize#
+ -> GmpLimb# -> IO GmpLimb
+
+-- mp_limb_t mpn_mod_1 (const mp_limb_t *s1p, mp_size_t s1n, mp_limb_t s2limb)
+foreign import ccall unsafe "gmp.h __gmpn_mod_1"
+ c_mpn_mod_1 :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb#
+
+-- mp_limb_t integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[],
+-- mp_size_t sn, mp_bitcnt_t count)
+foreign import ccall unsafe "integer_gmp_mpn_rshift"
+ c_mpn_rshift :: MutableByteArray# s -> ByteArray# -> GmpSize# -> Word#
+ -> IO GmpLimb
+
+-- mp_limb_t integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[],
+-- mp_size_t sn, mp_bitcnt_t count)
+foreign import ccall unsafe "integer_gmp_mpn_rshift_2c"
+ c_mpn_rshift_2c :: MutableByteArray# s -> ByteArray# -> GmpSize# -> Word#
+ -> IO GmpLimb
+
+-- mp_limb_t integer_gmp_mpn_lshift (mp_limb_t rp[], const mp_limb_t sp[],
+-- mp_size_t sn, mp_bitcnt_t count)
+foreign import ccall unsafe "integer_gmp_mpn_lshift"
+ c_mpn_lshift :: MutableByteArray# s -> ByteArray# -> GmpSize# -> Word#
+ -> IO GmpLimb
+
+-- void mpn_and_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
+-- mp_size_t n)
+foreign import ccall unsafe "integer_gmp_mpn_and_n"
+ c_mpn_and_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
+ -> IO ()
+
+-- void mpn_andn_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
+-- mp_size_t n)
+foreign import ccall unsafe "integer_gmp_mpn_andn_n"
+ c_mpn_andn_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
+ -> IO ()
+
+-- void mpn_ior_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
+-- mp_size_t n)
+foreign import ccall unsafe "integer_gmp_mpn_ior_n"
+ c_mpn_ior_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
+ -> IO ()
+
+-- void mpn_xor_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
+-- mp_size_t n)
+foreign import ccall unsafe "integer_gmp_mpn_xor_n"
+ c_mpn_xor_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
+ -> IO ()
+
+-- mp_bitcnt_t mpn_popcount (const mp_limb_t *s1p, mp_size_t n)
+foreign import ccall unsafe "gmp.h __gmpn_popcount"
+ c_mpn_popcount :: ByteArray# -> GmpSize# -> Word#
+
+-- double integer_gmp_mpn_get_d (const mp_limb_t sp[], const mp_size_t sn)
+foreign import ccall unsafe "integer_gmp_mpn_get_d"
+ c_mpn_get_d :: ByteArray# -> GmpSize# -> Int# -> Double#
+
+foreign import ccall unsafe "integer_gmp_powm"
+ integer_gmp_powm# :: MutableByteArray# RealWorld
+ -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#
+ -> ByteArray# -> GmpSize# -> IO GmpSize
+
+foreign import ccall unsafe "integer_gmp_powm_word"
+ integer_gmp_powm_word :: GmpLimb# -> GmpLimb# -> GmpLimb# -> GmpLimb#
+
+foreign import ccall unsafe "integer_gmp_powm1"
+ integer_gmp_powm1# :: ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#
+ -> GmpLimb# -> GmpLimb#
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs
new file mode 100644
index 0000000000000000000000000000000000000000..a25b36eaec8b7e25c2d58e0ef0051658d6404ef7
--- /dev/null
+++ b/libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs
@@ -0,0 +1,719 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE NegativeLiterals #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE BinaryLiterals #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
+module GHC.Num.BigNat.Native where
+
+#include "MachDeps.h"
+#include "WordSize.h"
+
+#if defined(BIGNUM_NATIVE) || defined(BIGNUM_CHECK)
+import {-# SOURCE #-} GHC.Num.BigNat
+import {-# SOURCE #-} GHC.Num.Natural
+#else
+import GHC.Num.BigNat
+import GHC.Num.Natural
+#endif
+import GHC.Num.WordArray
+import GHC.Num.Primitives
+import GHC.Prim
+import GHC.Types
+
+default ()
+
+count_words_bits :: Word# -> (# Word#, Word# #)
+count_words_bits n = (# nw, nb #)
+ where
+ nw = n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#
+ nb = n `and#` WORD_SIZE_BITS_MASK##
+
+count_words_bits_int :: Word# -> (# Int#, Int# #)
+count_words_bits_int n = case count_words_bits n of
+ (# nw, nb #) -> (# word2Int# nw, word2Int# nb #)
+
+bignat_compare :: WordArray# -> WordArray# -> Int#
+bignat_compare wa wb = go (sz -# 1#)
+ where
+ sz = wordArraySize# wa
+ go i
+ | isTrue# (i <# 0#) = 0#
+ | a <- indexWordArray# wa i
+ , b <- indexWordArray# wb i
+ = if | isTrue# (a `eqWord#` b) -> go (i -# 1#)
+ | isTrue# (a `gtWord#` b) -> 1#
+ | True -> -1#
+
+bignat_add
+ :: MutableWordArray# s -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> State# s
+ -> State# s
+bignat_add mwa wa wb = addABc 0# 0##
+ where
+ !szA = wordArraySize# wa
+ !szB = wordArraySize# wb
+ !szMin = minI# szA szB
+
+ -- we have four cases:
+ -- 1) we have a digit in A and in B + a potential carry
+ -- => perform triple addition
+ -- => result in (carry,word)
+ -- 2) we have a digit only in A or B and a carry
+ -- => perform double addition from a single array
+ -- => result in (carry,word)
+ -- 3) we have a digit only in A or B and no carry
+ -- => perform array copy and shrink the array
+ -- 4) We only have a potential carry
+ -- => write the carry or shrink the array
+
+ addABc i carry s
+ | isTrue# (i <# szMin) =
+ let
+ !(# carry', r #) = plusWord3#
+ (indexWordArray# wa i)
+ (indexWordArray# wb i)
+ carry
+ in case mwaWrite# mwa i r s of
+ s' -> addABc (i +# 1#) carry' s'
+
+ | isTrue# ((i ==# szA) &&# (i ==# szB))
+ = mwaWriteOrShrink mwa carry i s
+
+ | isTrue# (i ==# szA)
+ = addAoBc wb i carry s
+
+ | True
+ = addAoBc wa i carry s
+
+ addAoBc wab i carry s
+ | isTrue# (i ==# wordArraySize# wab)
+ = mwaWriteOrShrink mwa carry i s
+
+ | 0## <- carry
+ = -- copy the remaining words and remove the word allocated for the
+ -- potential carry
+ case mwaArrayCopy# mwa i wab i (wordArraySize# wab -# i) s of
+ s' -> mwaShrink# mwa 1# s'
+
+ | True
+ = let !(# carry', r #) = plusWord2# (indexWordArray# wab i) carry
+ in case mwaWrite# mwa i r s of
+ s' -> addAoBc wab (i +# 1#) carry' s'
+
+bignat_add_word
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_add_word mwa wa b s = mwaInitArrayPlusWord mwa wa b s
+
+bignat_sub_word
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> (# State# RealWorld, Bool# #)
+bignat_sub_word mwa wa b = go b 0#
+ where
+ !sz = wordArraySize# wa
+ go carry i s
+ | isTrue# (i >=# sz)
+ = (# s, carry `neWord#` 0## #)
+
+ | 0## <- carry
+ = case mwaArrayCopy# mwa i wa i (sz -# i) s of
+ s' -> (# s', 0# #)
+
+ | True
+ = case subWordC# (indexWordArray# wa i) carry of
+ (# 0##, 0# #)
+ | isTrue# (i ==# sz) -> case mwaShrink# mwa 1# s of
+ s' -> (# s', 0# #)
+
+ (# l , c #) -> case mwaWrite# mwa i l s of
+ s1 -> go (int2Word# c) (i +# 1#) s1
+
+bignat_mul_word
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> Word#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_mul_word mwa wa b = go 0# 0##
+ where
+ !szA = wordArraySize# wa
+ go i carry s
+ | isTrue# (i ==# szA) = mwaWriteOrShrink mwa carry i s
+ | True =
+ let
+ ai = indexWordArray# wa i
+ !(# carry', r #) = plusWord12# carry (timesWord2# ai b)
+ in case mwaWrite# mwa i r s of
+ s' -> go (i +# 1#) carry' s'
+
+
+bignat_mul
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_mul mwa wa wb s1 =
+ -- initialize the resulting WordArray
+ case mwaFill# mwa 0## 0## (int2Word# sz) s1 of
+ s' -> mulEachB ctzB s' -- loop on b Words
+ where
+ !szA = wordArraySize# wa
+ !szB = wordArraySize# wb
+ !sz = szA +# szB
+
+ !ctzA = word2Int# (bigNatCtzWord# wa)
+ !ctzB = word2Int# (bigNatCtzWord# wb)
+
+ -- multiply a single bj Word# to the whole wa WordArray
+ mul bj j i carry s
+ | isTrue# (i ==# szA)
+ -- write the carry
+ = mwaAddInplaceWord# mwa (i +# j) carry s
+
+ | True = let
+ ai = indexWordArray# wa i
+ !(# c',r' #) = timesWord2# ai bj
+ !(# c'',r #) = plusWord2# r' carry
+ carry' = plusWord# c' c''
+ in case mwaAddInplaceWord# mwa (i +# j) r s of
+ s' -> mul bj j (i +# 1#) carry' s'
+
+ -- for each bj in wb, call `mul bj wa`
+ mulEachB i s
+ | isTrue# (i ==# szB) = s
+ | True = case indexWordArray# wb i of
+ -- detect bj == 0## and skip the loop
+ 0## -> mulEachB (i +# 1#) s
+ bi -> case mul bi i ctzA 0## s of
+ s' -> mulEachB (i +# 1#) s'
+
+bignat_sub
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> (# State# RealWorld, Bool# #)
+bignat_sub mwa wa wb s =
+ -- initialize the resulting WordArray
+ -- Note: we could avoid the copy by subtracting the first non-zero
+ -- less-significant word of b...
+ case mwaArrayCopy# mwa 0# wa 0# (wordArraySize# wa) s of
+ s' -> mwaSubInplaceArray mwa 0# wb s'
+
+bignat_popcount :: WordArray# -> Word#
+bignat_popcount wa = go 0# 0##
+ where
+ !sz = wordArraySize# wa
+ go i c
+ | isTrue# (i ==# sz) = c
+ | True = go (i +# 1#) (c `plusWord#` popCnt# (indexWordArray# wa i))
+
+bignat_shiftl
+ :: MutableWordArray# s
+ -> WordArray#
+ -> Word#
+ -> State# s
+ -> State# s
+bignat_shiftl mwa wa n s1 =
+ -- set the lower words to 0
+ case mwaFill# mwa 0## 0## (int2Word# nw) s1 of
+ s2 -> if
+ | 0# <- nb -> mwaArrayCopy# mwa nw wa 0# szA s2
+ | True -> mwaBitShift 0# 0## s2
+ where
+ !szA = wordArraySize# wa
+ !(# nw, nb #) = count_words_bits_int n
+ !sh = WORD_SIZE_IN_BITS# -# nb
+
+ -- Bit granularity (c is the carry from the previous shift)
+ mwaBitShift i c s
+ -- write the carry
+ | isTrue# (i ==# szA)
+ = mwaWriteOrShrink mwa c (i +# nw) s
+
+ | True =
+ let
+ !ai = indexWordArray# wa i
+ !v = c `or#` (ai `uncheckedShiftL#` nb)
+ !c' = ai `uncheckedShiftRL#` sh
+ in case mwaWrite# mwa (i +# nw) v s of
+ s' -> mwaBitShift (i +# 1#) c' s'
+
+
+bignat_shiftr
+ :: MutableWordArray# s
+ -> WordArray#
+ -> Word#
+ -> State# s
+ -> State# s
+bignat_shiftr mwa wa n s1
+ | isTrue# (nb ==# 0#) = mwaArrayCopy# mwa 0# wa nw sz s1
+ | True = mwaBitShift (sz -# 1#) 0## s1
+ where
+ !szA = wordArraySize# wa
+ !(# nw, nb #) = count_words_bits_int n
+ !sz = szA -# nw
+ !sh = WORD_SIZE_IN_BITS# -# nb
+
+ -- Bit granularity (c is the carry from the previous shift)
+ mwaBitShift i c s
+ | isTrue# (i <# 0#) = s
+ | True =
+ let
+ !ai = indexWordArray# wa (i +# nw)
+ !v = c `or#` (ai `uncheckedShiftRL#` nb)
+ !c' = ai `uncheckedShiftL#` sh
+ in case mwaWrite# mwa i v s of
+ s' -> mwaBitShift (i -# 1#) c' s'
+
+bignat_shiftr_neg
+ :: MutableWordArray# s
+ -> WordArray#
+ -> Word#
+ -> State# s
+ -> State# s
+bignat_shiftr_neg mwa wa n s1
+ -- initialize higher limb
+ = case mwaWrite# mwa (szA -# 1#) 0## s1 of
+ s2 -> case bignat_shiftr mwa wa n s2 of
+ s3 -> if nz_shifted_out
+ -- round if non-zero bits were shifted out
+ then mwaAddInplaceWord# mwa 0# 1## s3
+ else s3
+ where
+ !szA = wordArraySize# wa
+ !(# nw, nb #) = count_words_bits_int n
+
+ -- non-zero bits are shifted out?
+ nz_shifted_out
+ -- test nb bits
+ | isTrue# (
+ (nb /=# 0#)
+ &&# (indexWordArray# wa nw `uncheckedShiftL#`
+ (WORD_SIZE_IN_BITS# -# nb) `neWord#` 0##))
+ = True
+ -- test nw words
+ | True
+ = let
+ go j
+ | isTrue# (j ==# nw) = False
+ | isTrue# (indexWordArray# wa j `neWord#` 0##) = True
+ | True = go (j +# 1#)
+ in go 0#
+
+
+bignat_or
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_or mwa wa wb s1
+ | isTrue# (szA >=# szB) = go wa szA wb szB s1
+ | True = go wb szB wa szA s1
+ where
+ !szA = wordArraySize# wa
+ !szB = wordArraySize# wb
+ -- nx >= ny
+ go wx nx wy ny s =
+ case mwaInitArrayBinOp mwa wx wy or# s of
+ s' -> mwaArrayCopy# mwa ny wx ny (nx -# ny) s'
+
+bignat_xor
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_xor mwa wa wb s1
+ | isTrue# (szA >=# szB) = go wa szA wb szB s1
+ | True = go wb szB wa szA s1
+ where
+ !szA = wordArraySize# wa
+ !szB = wordArraySize# wb
+ -- nx >= ny
+ go wx nx wy ny s =
+ case mwaInitArrayBinOp mwa wx wy xor# s of
+ s' -> mwaArrayCopy# mwa ny wx ny (nx -# ny) s'
+
+bignat_and
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_and mwa wa wb s = mwaInitArrayBinOp mwa wa wb and# s
+
+bignat_and_not
+ :: MutableWordArray# RealWorld -- ^ Result
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_and_not mwa wa wb s =
+ case mwaInitArrayBinOp mwa wa wb (\x y -> x `and#` not# y) s of
+ s' -> mwaArrayCopy# mwa szB wa szB (szA -# szB) s'
+ where
+ !szA = wordArraySize# wa
+ !szB = wordArraySize# wb
+
+bignat_quotrem
+ :: MutableWordArray# s
+ -> MutableWordArray# s
+ -> WordArray#
+ -> WordArray#
+ -> State# s
+ -> State# s
+bignat_quotrem mwq mwr uwa uwb s0 =
+ -- Normalization consists in left-shifting bits in B and A so that the
+ -- most-significant bit of the most-significant word of B is 1. It makes
+ -- quotient prediction much more efficient as we only use the two most
+ -- significant words of A and the most significant word of B to make the
+ -- prediction.
+
+ -- we will left-shift A and B of "clzb" bits for normalization
+ let !clzb = clz# (indexWordArray# uwb (wordArraySize# uwb -# 1#))
+
+ -- we use a single array initially containing A (normalized) and
+ -- returning the remainder (normalized): mnwa (for "mutable normalized
+ -- wordarray A")
+ --
+ -- We allocate it here with an additionnal Word compared to A because
+ -- normalizing can left shift at most (N-1) bits (on N-bit arch).
+ in case newWordArray# (wordArraySize# uwa +# 1#) s0 of { (# s1, mnwa #) ->
+
+ -- normalized A in mnwa
+ let normalizeA s = case mwaWrite# mnwa (wordArraySize# uwa) 0## s of -- init potential carry
+ s -> case bignat_shiftl mnwa uwa clzb s of -- left shift
+ s -> mwaTrimZeroes# mnwa s -- remove null carry if any
+ in case normalizeA s1 of { s2 ->
+
+ -- normalize B. We don't do it in a MutableWordArray because it will remain
+ -- constant during the whole computation.
+ let !nwb = bigNatShiftL# uwb clzb in
+
+ -- perform quotrem on normalized inputs
+ case bignat_quotrem_normalized mwq mnwa nwb s2 of { s3 ->
+
+ -- denormalize the remainder now stored in mnwa. We just have to right shift
+ -- of "clzb" bits. We copy the result into "mwr" array.
+ let denormalizeR s = case mwaTrimZeroes# mnwa s of
+ s -> case unsafeFreezeByteArray# mnwa s of
+ (# s, wr #) -> case mwaSetSize# mwr (wordArraySize# wr) s of
+ s -> case bignat_shiftr mwr wr clzb s of
+ s -> mwaTrimZeroes# mwr s
+ in denormalizeR s3
+ }}}
+
+
+
+bignat_quot
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_quot mwq wa wb s =
+ -- allocate a temporary array for the remainder and call quotrem
+ case newWordArray# (wordArraySize# wb) s of
+ (# s, mwr #) -> bignat_quotrem mwq mwr wa wb s
+
+bignat_rem
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_rem mwr wa wb s =
+ -- allocate a temporary array for the quotient and call quotrem
+ -- (we could avoid allocating it as it is not used to compute the result but
+ -- it would require non trivial modification of bignat_quotrem)
+ case newWordArray# szQ s of
+ (# s, mwq #) -> bignat_quotrem mwq mwr wa wb s
+ where
+ szA = wordArraySize# wa
+ szB = wordArraySize# wb
+ szQ = 1# +# szA -# szB
+
+-- | Perform quotRem on normalized inputs:
+-- * highest bit of B is set
+-- * A is trimmed
+-- * A >= B
+-- * B > 1
+bignat_quotrem_normalized
+ :: MutableWordArray# s
+ -> MutableWordArray# s
+ -> WordArray#
+ -> State# s
+ -> State# s
+bignat_quotrem_normalized mwq mwa b s0 =
+
+ -- n is the size of B
+ let !n = wordArraySize# b
+
+ -- m+n is the size of A (m >= 0)
+ in case mwaSize# mwa s0 of { (# s1, szA #) ->
+ let !m = szA -# n in
+
+ -- Definitions:
+ -- MSW(x) is the most-significant word of x
+ -- MSB(x) the most-significant bit of x
+
+ -- We first compute MSW(Q). Thanks to the normalization of B, MSW(Q) can
+ -- only be 0 or 1 so we only have to perform a prefix comparison to compute
+ -- MSW(Q).
+ --
+ -- Proof MSW(Q) < 2:
+ -- * MSB(MSW(B)) = 1 thanks to normalization.
+ -- * MSW(B) * MSW(Q) <= MSW(A) by definition
+ -- * suppose MSW(Q) >= 2:
+ -- MSW(B) * MSW(Q) >= MSW(B) << 1 { MSW(Q) >= 2 }
+ -- > MAX_WORD_VALUE { MSB(MSW(B)) = 1 }
+ -- > MSW(A) { MSW(A) <= MAX_WORD_VALUE }
+ -- contradiction.
+ --
+ -- If A >= (B << m words)
+ -- then Qm = 1
+ -- A := A - (B << m words)
+ -- else Qm = 0
+ -- A unchanged
+ let computeQm s = case mwaTrimCompare m mwa b s of
+ (# s, LT #) -> (# s, 0## #)
+ (# s, _ #) -> (# s, 1## #)
+
+ updateQj j qj qjb s = case mwaWrite# mwq j qj s of -- write Qj
+ s | 0## <- qj -> s
+ | True -> case mwaSubInplaceArray mwa j qjb s of -- subtract (qjB << j words)
+ (# s, _ #) -> s
+
+ -- update the highest word of Q
+ updateQm s = case computeQm s of
+ (# s, qm #) -> updateQj m qm b s
+
+ -- the size of Q is szA+szB+1 BEFORE normalization. Normalization may add
+ -- an additional higher word to A.
+ -- * If A has an additional limb:
+ -- * MSW(A) < MSW(B). Because MSB(MSW(A)) can't be set (it would
+ -- mean that we shifted a whole word, which we didn't)
+ -- * hence MSW(Q) = 0 but we don't have to write it (and we mustn't)
+ -- because of the size of Q
+ -- * If A has no additional limb:
+ -- * We have to check if MSW(A) >= MSW(B) and to adjust A and MSW(Q)
+ -- accordingly
+ --
+ -- We detect if A has an additional limb by comparing the size of Q with m
+ updateQmMaybe s = case mwaSize# mwq s of
+ (# s, szQ #) | isTrue# (m <# szQ) -> updateQm s
+ | True -> s
+
+ in case updateQmMaybe s1 of { s2 ->
+
+
+ -- main loop: for j from (m-1) downto 0
+ -- We estimate a one Word quotient qj:
+ -- e1e0 <- a(n+j)a(n+j-1) `div` b(n-1)
+ -- qj | e1 == 0 = e0
+ -- | otherwise = maxBound
+ -- We loop until we find the real quotient:
+ -- while (A < ((qj*B) << j words)) qj--
+ -- We update A and Qj:
+ -- Qj := qj
+ -- A := A - (qj*B << j words)
+
+ let bmsw = wordArrayLast# b -- most significant word of B
+
+ estimateQj j s =
+ case mwaRead# mwa (n +# j) s of
+ (# s, a1 #) -> case mwaRead# mwa (n +# j -# 1#) s of
+ (# s, a0 #) -> case quotRemWord3# (# a1, a0 #) bmsw of
+ (# (# 0##, qj #), _ #) -> (# s, qj #)
+ (# (# _, _ #), _ #) -> (# s, WORD_MAXBOUND## #)
+
+ -- we perform the qj*B multiplication once and then we subtract B from
+ -- qj*B as much as needed until (qj'*B << j words) <= A
+ findRealQj j qj s = findRealQj' j qj (bigNatMulWord# b qj) s
+
+ findRealQj' j qj qjB s = case mwaTrimCompare j mwa qjB s of
+ (# s, LT #) -> findRealQj' j (qj `minusWord#` 1##) (bigNatSubUnsafe qjB b) s
+ -- TODO: we could do the sub inplace to
+ -- reduce allocations
+ (# s, _ #) -> (# s, qj, qjB #)
+
+ loop j s = case estimateQj j s of
+ (# s, qj #) -> case findRealQj j qj s of
+ (# s, qj, qjB #) -> case updateQj j qj qjB s of
+ s | 0# <- j -> s
+ | True -> loop (j -# 1#) s
+
+
+ in if | 0# <- m -> s2
+ | True -> loop (m -# 1#) s2
+ }}
+
+bignat_quotrem_word
+ :: MutableWordArray# s -- ^ Quotient
+ -> WordArray#
+ -> Word#
+ -> State# s
+ -> (# State# s, Word# #)
+bignat_quotrem_word mwq wa b s = go (sz -# 1#) 0## s
+ where
+ sz = wordArraySize# wa
+ go i r s
+ | isTrue# (i <# 0#) = (# s, r #)
+ | True =
+ let
+ ai = indexWordArray# wa i
+ !(# q,r' #) = quotRemWord2# r ai b
+ in case mwaWrite# mwq i q s of
+ s' -> go (i -# 1#) r' s'
+
+bignat_quot_word
+ :: MutableWordArray# s -- ^ Quotient
+ -> WordArray#
+ -> Word#
+ -> State# s
+ -> State# s
+bignat_quot_word mwq wa b s = go (sz -# 1#) 0## s
+ where
+ sz = wordArraySize# wa
+ go i r s
+ | isTrue# (i <# 0#) = s
+ | True =
+ let
+ ai = indexWordArray# wa i
+ !(# q,r' #) = quotRemWord2# r ai b
+ in case mwaWrite# mwq i q s of
+ s' -> go (i -# 1#) r' s'
+
+bignat_rem_word
+ :: WordArray#
+ -> Word#
+ -> Word#
+bignat_rem_word wa b = go (sz -# 1#) 0##
+ where
+ sz = wordArraySize# wa
+ go i r
+ | isTrue# (i <# 0#) = r
+ | True =
+ let
+ ai = indexWordArray# wa i
+ !(# _,r' #) = quotRemWord2# r ai b
+ in go (i -# 1#) r'
+
+
+bignat_gcd
+ :: MutableWordArray# s
+ -> WordArray#
+ -> WordArray#
+ -> State# s
+ -> State# s
+bignat_gcd mwr = go
+ where
+ go wmax wmin s
+ | isTrue# (wordArraySize# wmin ==# 0#)
+ = mwaInitCopyShrink# mwr wmax s
+
+ | True
+ = let
+ wmax' = wmin
+ !wmin' = bigNatRem wmax wmin
+ in go wmax' wmin' s
+
+bignat_gcd_word
+ :: WordArray#
+ -> Word#
+ -> Word#
+bignat_gcd_word a b = bignat_gcd_word_word b (bigNatRemWord# a b)
+
+-- | This operation doesn't really belongs here, but GMP's one is much faster
+-- than this simple implementation (basic Euclid algorithm).
+--
+-- Ideally we should make an implementation as fast as GMP's one and put it into
+-- GHC.Num.Primitives.
+bignat_gcd_word_word
+ :: Word#
+ -> Word#
+ -> Word#
+bignat_gcd_word_word a 0## = a
+bignat_gcd_word_word a b = bignat_gcd_word_word b (a `remWord#` b)
+
+bignat_encode_double :: WordArray# -> Int# -> Double#
+bignat_encode_double wa e0 = go 0.0## e0 0#
+ where
+ sz = wordArraySize# wa
+ go acc e i
+ | isTrue# (i >=# sz) = acc
+ | True
+ = go (acc +## wordEncodeDouble# (indexWordArray# wa i) e)
+ (e +# WORD_SIZE_IN_BITS#) -- FIXME: we assume that e doesn't overflow...
+ (i +# 1#)
+
+bignat_powmod_word :: WordArray# -> WordArray# -> Word# -> Word#
+bignat_powmod_word b0 e0 m = go (naturalFromBigNat b0) (naturalFromBigNat e0) (naturalFromWord# 1##)
+ where
+ go !b e !r
+ | isTrue# (e `naturalTestBit#` 0##)
+ = go b' e' ((r `naturalMul` b) `naturalRem` m')
+
+ | naturalIsZero e
+ = naturalToWord# r
+
+ | True
+ = go b' e' r
+ where
+ b' = (b `naturalMul` b) `naturalRem` m'
+ m' = naturalFromWord# m
+ e' = e `naturalShiftR#` 1## -- slightly faster than "e `div` 2"
+
+bignat_powmod
+ :: MutableWordArray# RealWorld
+ -> WordArray#
+ -> WordArray#
+ -> WordArray#
+ -> State# RealWorld
+ -> State# RealWorld
+bignat_powmod r b0 e0 m s = mwaInitCopyShrink# r r' s
+ where
+ !r' = go (naturalFromBigNat b0)
+ (naturalFromBigNat e0)
+ (naturalFromWord# 1##)
+
+ go !b e !r
+ | isTrue# (e `naturalTestBit#` 0##)
+ = go b' e' ((r `naturalMul` b) `naturalRem` m')
+
+ | naturalIsZero e
+ = naturalToBigNat r
+
+ | True
+ = go b' e' r
+ where
+ b' = (b `naturalMul` b) `naturalRem` m'
+ m' = naturalFromBigNat m
+ e' = e `naturalShiftR#` 1## -- slightly faster than "e `div` 2"
+
+bignat_powmod_words
+ :: Word#
+ -> Word#
+ -> Word#
+ -> Word#
+bignat_powmod_words b e m =
+ bignat_powmod_word (wordArrayFromWord# b)
+ (wordArrayFromWord# e)
+ m
diff --git a/libraries/ghc-bignum/src/GHC/Num/Integer.hs b/libraries/ghc-bignum/src/GHC/Num/Integer.hs
new file mode 100644
index 0000000000000000000000000000000000000000..b4f6ee0c5473c59a1234999982f504a1c7369683
--- /dev/null
+++ b/libraries/ghc-bignum/src/GHC/Num/Integer.hs
@@ -0,0 +1,1169 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE NegativeLiterals #-}
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE BlockArguments #-}
+
+-- |
+-- Module : GHC.Num.Integer
+-- Copyright : (c) Sylvain Henry 2019,
+-- (c) Herbert Valerio Riedel 2014
+-- License : BSD3
+--
+-- Maintainer : sylvain@haskus.fr
+-- Stability : provisional
+-- Portability : non-portable (GHC Extensions)
+--
+-- The 'Integer' type.
+
+module GHC.Num.Integer where
+
+#include "MachDeps.h"
+#include "WordSize.h"
+
+import GHC.Prim
+import GHC.Types
+import GHC.Classes
+import GHC.Magic
+import GHC.Num.Primitives
+import GHC.Num.BigNat
+import GHC.Num.Natural
+
+#if WORD_SIZE_IN_BITS < 64
+import GHC.IntWord64
+#endif
+
+default ()
+
+-- | Arbitrary precision integers. In contrast with fixed-size integral types
+-- such as 'Int', the 'Integer' type represents the entire infinite range of
+-- integers.
+--
+-- Integers are stored in a kind of sign-magnitude form, hence do not expect
+-- two's complement form when using bit operations.
+--
+-- If the value is small (fit into an 'Int'), 'IS' constructor is used.
+-- Otherwise 'IP' and 'IN' constructors are used to store a 'BigNat'
+-- representing respectively the positive or the negative value magnitude.
+--
+-- Invariant: 'IP' and 'IN' are used iff value doesn't fit in 'IS'
+data Integer
+ = IS !Int# -- ^ iff value in @[minBound::'Int', maxBound::'Int']@ range
+ | IP !BigNat -- ^ iff value in @]maxBound::'Int', +inf[@ range
+ | IN !BigNat -- ^ iff value in @]-inf, minBound::'Int'[@ range
+
+
+-- | Check Integer invariants
+integerCheck# :: Integer -> Bool#
+integerCheck# (IS _) = 1#
+integerCheck# (IP bn) = bigNatCheck# bn &&# (bn `bigNatGtWord#` INT_MAXBOUND##)
+integerCheck# (IN bn) = bigNatCheck# bn &&# (bn `bigNatGtWord#` ABS_INT_MINBOUND##)
+
+-- | Check Integer invariants
+integerCheck :: Integer -> Bool
+integerCheck i = isTrue# (integerCheck# i)
+
+-- | Integer Zero
+integerZero :: Integer
+integerZero = IS 0#
+
+-- | Integer One
+integerOne :: Integer
+integerOne = IS 1#
+
+---------------------------------------------------------------------
+-- Conversions
+---------------------------------------------------------------------
+
+-- | Create a positive Integer from a BigNat
+integerFromBigNat :: BigNat -> Integer
+integerFromBigNat !bn
+ | bigNatIsZero bn
+ = integerZero
+
+ | isTrue# (bn `bigNatLeWord#` INT_MAXBOUND##)
+ = IS (word2Int# (bigNatIndex# bn 0#))
+
+ | True
+ = IP bn
+
+-- | Create a negative Integer from a BigNat
+integerFromBigNatNeg :: BigNat -> Integer
+integerFromBigNatNeg !bn
+ | bigNatIsZero bn
+ = integerZero
+
+ | 1# <- bigNatSize# bn
+ , i <- negateInt# (word2Int# (bigNatIndex# bn 0#))
+ , isTrue# (i <=# 0#)
+ = IS i
+
+ | True
+ = IN bn
+
+-- | Create an Integer from a sign-bit and a BigNat
+integerFromBigNatSign :: Int# -> BigNat -> Integer
+integerFromBigNatSign !sign !bn
+ | 0# <- sign
+ = integerFromBigNat bn
+
+ | True
+ = integerFromBigNatNeg bn
+
+-- | Convert an Integer into a BigNat.
+--
+-- Return 0 for negative Integers.
+integerToBigNatClamp :: Integer -> BigNat
+integerToBigNatClamp (IP x) = x
+integerToBigNatClamp (IS x)
+ | isTrue# (x >=# 0#) = bigNatFromWord# (int2Word# x)
+integerToBigNatClamp _ = bigNatZero void#
+
+-- | Create an Integer from an Int#
+integerFromInt# :: Int# -> Integer
+integerFromInt# i = IS i
+
+-- | Create an Integer from an Int
+integerFromInt :: Int -> Integer
+integerFromInt (I# i) = IS i
+
+-- | Truncates 'Integer' to least-significant 'Int#'
+integerToInt# :: Integer -> Int#
+{-# NOINLINE integerToInt# #-}
+integerToInt# (IS i) = i
+integerToInt# (IP b) = word2Int# (bigNatToWord# b)
+integerToInt# (IN b) = negateInt# (word2Int# (bigNatToWord# b))
+
+-- | Truncates 'Integer' to least-significant 'Int#'
+integerToInt :: Integer -> Int
+integerToInt i = I# (integerToInt# i)
+
+-- | Convert a Word# into an Integer
+integerFromWord# :: Word# -> Integer
+{-# NOINLINE integerFromWord# #-}
+integerFromWord# w
+ | i <- word2Int# w
+ , isTrue# (i >=# 0#)
+ = IS i
+
+ | True
+ = IP (bigNatFromWord# w)
+
+-- | Convert a Word into an Integer
+integerFromWord :: Word -> Integer
+integerFromWord (W# w) = integerFromWord# w
+
+-- | Create a negative Integer with the given Word magnitude
+integerFromWordNeg# :: Word# -> Integer
+integerFromWordNeg# w
+ | isTrue# (w `leWord#` ABS_INT_MINBOUND##)
+ = IS (negateInt# (word2Int# w))
+
+ | True
+ = IN (bigNatFromWord# w)
+
+-- | Create an Integer from a sign and a Word magnitude
+integerFromWordSign# :: Int# -> Word# -> Integer
+integerFromWordSign# 0# w = integerFromWord# w
+integerFromWordSign# _ w = integerFromWordNeg# w
+
+-- | Truncate an Integer into a Word
+integerToWord# :: Integer -> Word#
+{-# NOINLINE integerToWord# #-}
+integerToWord# (IS i) = int2Word# i
+integerToWord# (IP bn) = bigNatToWord# bn
+integerToWord# (IN bn) = int2Word# (negateInt# (word2Int# (bigNatToWord# bn)))
+
+-- | Truncate an Integer into a Word
+integerToWord :: Integer -> Word
+integerToWord !i = W# (integerToWord# i)
+
+-- | Convert a Natural into an Integer
+integerFromNatural :: Natural -> Integer
+{-# NOINLINE integerFromNatural #-}
+integerFromNatural (NS x) = integerFromWord# x
+integerFromNatural (NB x) = integerFromBigNat x
+
+-- | Convert a list of Word into an Integer
+integerFromWordList :: Bool -> [Word] -> Integer
+integerFromWordList True ws = integerFromBigNatNeg (bigNatFromWordList ws)
+integerFromWordList False ws = integerFromBigNat (bigNatFromWordList ws)
+
+-- | Convert a Integer into a Natural
+--
+-- Return 0 for negative Integers.
+integerToNaturalClamp :: Integer -> Natural
+{-# NOINLINE integerToNaturalClamp #-}
+integerToNaturalClamp (IS x)
+ | isTrue# (x <# 0#) = naturalZero
+ | True = naturalFromWord# (int2Word# x)
+integerToNaturalClamp (IP x) = naturalFromBigNat x
+integerToNaturalClamp (IN _) = naturalZero
+
+-- | Convert a Integer into a Natural
+--
+-- Return absolute value
+integerToNatural :: Integer -> Natural
+{-# NOINLINE integerToNatural #-}
+integerToNatural (IS x) = naturalFromWord# (wordFromAbsInt# x)
+integerToNatural (IP x) = naturalFromBigNat x
+integerToNatural (IN x) = naturalFromBigNat x
+
+---------------------------------------------------------------------
+-- Predicates
+---------------------------------------------------------------------
+
+-- | Negative predicate
+integerIsNegative# :: Integer -> Bool#
+integerIsNegative# (IS i#) = i# <# 0#
+integerIsNegative# (IP _) = 0#
+integerIsNegative# (IN _) = 1#
+
+-- | Negative predicate
+integerIsNegative :: Integer -> Bool
+integerIsNegative !i = isTrue# (integerIsNegative# i)
+
+-- | Zero predicate
+integerIsZero :: Integer -> Bool
+integerIsZero (IS 0#) = True
+integerIsZero _ = False
+
+-- | Not-equal predicate.
+integerNe :: Integer -> Integer -> Bool
+integerNe !x !y = isTrue# (integerNe# x y)
+
+-- | Equal predicate.
+integerEq :: Integer -> Integer -> Bool
+integerEq !x !y = isTrue# (integerEq# x y)
+
+-- | Lower-or-equal predicate.
+integerLe :: Integer -> Integer -> Bool
+integerLe !x !y = isTrue# (integerLe# x y)
+
+-- | Lower predicate.
+integerLt :: Integer -> Integer -> Bool
+integerLt !x !y = isTrue# (integerLt# x y)
+
+-- | Greater predicate.
+integerGt :: Integer -> Integer -> Bool
+integerGt !x !y = isTrue# (integerGt# x y)
+
+-- | Greater-or-equal predicate.
+integerGe :: Integer -> Integer -> Bool
+integerGe !x !y = isTrue# (integerGe# x y)
+
+-- | Equal predicate.
+integerEq# :: Integer -> Integer -> Bool#
+{-# NOINLINE integerEq# #-}
+integerEq# (IS x) (IS y) = x ==# y
+integerEq# (IN x) (IN y) = bigNatEq# x y
+integerEq# (IP x) (IP y) = bigNatEq# x y
+integerEq# _ _ = 0#
+
+-- | Not-equal predicate.
+integerNe# :: Integer -> Integer -> Bool#
+{-# NOINLINE integerNe# #-}
+integerNe# (IS x) (IS y) = x /=# y
+integerNe# (IN x) (IN y) = bigNatNe# x y
+integerNe# (IP x) (IP y) = bigNatNe# x y
+integerNe# _ _ = 1#
+
+-- | Greater predicate.
+integerGt# :: Integer -> Integer -> Bool#
+{-# NOINLINE integerGt# #-}
+integerGt# (IS x) (IS y) = x ># y
+integerGt# x y | GT <- integerCompare x y = 1#
+integerGt# _ _ = 0#
+
+-- | Lower-or-equal predicate.
+integerLe# :: Integer -> Integer -> Bool#
+{-# NOINLINE integerLe# #-}
+integerLe# (IS x) (IS y) = x <=# y
+integerLe# x y | GT <- integerCompare x y = 0#
+integerLe# _ _ = 1#
+
+-- | Lower predicate.
+integerLt# :: Integer -> Integer -> Bool#
+{-# NOINLINE integerLt# #-}
+integerLt# (IS x) (IS y) = x <# y
+integerLt# x y | LT <- integerCompare x y = 1#
+integerLt# _ _ = 0#
+
+-- | Greater-or-equal predicate.
+integerGe# :: Integer -> Integer -> Bool#
+{-# NOINLINE integerGe# #-}
+integerGe# (IS x) (IS y) = x >=# y
+integerGe# x y | LT <- integerCompare x y = 0#
+integerGe# _ _ = 1#
+
+instance Eq Integer where
+ (==) = integerEq
+ (/=) = integerNe
+
+-- | Compare two Integer
+integerCompare :: Integer -> Integer -> Ordering
+{-# NOINLINE integerCompare #-}
+integerCompare (IS x) (IS y) = compareInt# x y
+integerCompare (IP x) (IP y) = bigNatCompare x y
+integerCompare (IN x) (IN y) = bigNatCompare y x
+integerCompare (IS _) (IP _) = LT
+integerCompare (IS _) (IN _) = GT
+integerCompare (IP _) (IS _) = GT
+integerCompare (IN _) (IS _) = LT
+integerCompare (IP _) (IN _) = GT
+integerCompare (IN _) (IP _) = LT
+
+instance Ord Integer where
+ compare = integerCompare
+
+---------------------------------------------------------------------
+-- Operations
+---------------------------------------------------------------------
+
+-- | Subtract one 'Integer' from another.
+integerSub :: Integer -> Integer -> Integer
+{-# NOINLINE integerSub #-}
+integerSub !x (IS 0#) = x
+integerSub (IS x#) (IS y#)
+ = case subIntC# x# y# of
+ (# z#, 0# #) -> IS z#
+ (# 0#, _ #) -> IN (bigNatFromWord2# 1## 0##)
+ (# z#, _ #)
+ | isTrue# (z# ># 0#)
+ -> IN (bigNatFromWord# ( (int2Word# (negateInt# z#))))
+ | True
+ -> IP (bigNatFromWord# ( (int2Word# z#)))
+integerSub (IS x#) (IP y)
+ | isTrue# (x# >=# 0#)
+ = integerFromBigNatNeg (bigNatSubWordUnsafe# y (int2Word# x#))
+ | True
+ = IN (bigNatAddWord# y (int2Word# (negateInt# x#)))
+integerSub (IS x#) (IN y)
+ | isTrue# (x# >=# 0#)
+ = IP (bigNatAddWord# y (int2Word# x#))
+ | True
+ = integerFromBigNat (bigNatSubWordUnsafe# y (int2Word# (negateInt# x#)))
+integerSub (IP x) (IP y)
+ = case bigNatCompare x y of
+ LT -> integerFromBigNatNeg (bigNatSubUnsafe y x)
+ EQ -> IS 0#
+ GT -> integerFromBigNat (bigNatSubUnsafe x y)
+integerSub (IP x) (IN y) = IP (bigNatAdd x y)
+integerSub (IN x) (IP y) = IN (bigNatAdd x y)
+integerSub (IN x) (IN y)
+ = case bigNatCompare x y of
+ LT -> integerFromBigNat (bigNatSubUnsafe y x)
+ EQ -> IS 0#
+ GT -> integerFromBigNatNeg (bigNatSubUnsafe x y)
+integerSub (IP x) (IS y#)
+ | isTrue# (y# >=# 0#)
+ = integerFromBigNat (bigNatSubWordUnsafe# x (int2Word# y#))
+ | True
+ = IP (bigNatAddWord# x (int2Word# (negateInt# y#)))
+integerSub (IN x) (IS y#)
+ | isTrue# (y# >=# 0#)
+ = IN (bigNatAddWord# x (int2Word# y#))
+ | True
+ = integerFromBigNatNeg (bigNatSubWordUnsafe# x (int2Word# (negateInt# y#)))
+
+-- | Add two 'Integer's
+integerAdd :: Integer -> Integer -> Integer
+{-# NOINLINE integerAdd #-}
+integerAdd !x (IS 0#) = x
+integerAdd (IS 0#) y = y
+integerAdd (IS x#) (IS y#)
+ = case addIntC# x# y# of
+ (# z#, 0# #) -> IS z#
+ (# 0#, _ #) -> IN (bigNatFromWord2# 1## 0##) -- 2*minBound::Int
+ (# z#, _ #)
+ | isTrue# (z# ># 0#) -> IN (bigNatFromWord# ( (int2Word# (negateInt# z#))))
+ | True -> IP (bigNatFromWord# ( (int2Word# z#)))
+integerAdd y@(IS _) x = integerAdd x y
+integerAdd (IP x) (IP y) = IP (bigNatAdd x y)
+integerAdd (IN x) (IN y) = IN (bigNatAdd x y)
+integerAdd (IP x) (IS y#) -- edge-case: @(maxBound+1) + minBound == 0@
+ | isTrue# (y# >=# 0#) = IP (bigNatAddWord# x (int2Word# y#))
+ | True = integerFromBigNat (bigNatSubWordUnsafe# x (int2Word#
+ (negateInt# y#)))
+integerAdd (IN x) (IS y#) -- edge-case: @(minBound-1) + maxBound == -2@
+ | isTrue# (y# >=# 0#) = integerFromBigNatNeg (bigNatSubWordUnsafe# x (int2Word# y#))
+ | True = IN (bigNatAddWord# x (int2Word# (negateInt# y#)))
+integerAdd y@(IN _) x@(IP _) = integerAdd x y
+integerAdd (IP x) (IN y)
+ = case bigNatCompare x y of
+ LT -> integerFromBigNatNeg (bigNatSubUnsafe y x)
+ EQ -> IS 0#
+ GT -> integerFromBigNat (bigNatSubUnsafe x y)
+
+-- | Multiply two 'Integer's
+integerMul :: Integer -> Integer -> Integer
+{-# NOINLINE integerMul #-}
+integerMul !_ (IS 0#) = IS 0#
+integerMul (IS 0#) _ = IS 0#
+integerMul x (IS 1#) = x
+integerMul (IS 1#) y = y
+integerMul x (IS -1#) = integerNegate x
+integerMul (IS -1#) y = integerNegate y
+#if __GLASGOW_HASKELL__ < 809
+integerMul (IS x) (IS y) = case mulIntMayOflo# x y of
+ 0# -> IS (x *# y)
+ _ -> case (# isTrue# (x >=# 0#), isTrue# (y >=# 0#) #) of
+ (# False, False #) -> case timesWord2# (int2Word# (negateInt# x))
+ (int2Word# (negateInt# y)) of
+ (# 0##,l #) -> integerFromWord# l
+ (# h ,l #) -> IP (bigNatFromWord2# h l)
+
+ (# True, False #) -> case timesWord2# (int2Word# x)
+ (int2Word# (negateInt# y)) of
+ (# 0##,l #) -> integerFromWordNeg# l
+ (# h ,l #) -> IN (bigNatFromWord2# h l)
+
+ (# False, True #) -> case timesWord2# (int2Word# (negateInt# x))
+ (int2Word# y) of
+ (# 0##,l #) -> integerFromWordNeg# l
+ (# h ,l #) -> IN (bigNatFromWord2# h l)
+
+ (# True, True #) -> case timesWord2# (int2Word# x)
+ (int2Word# y) of
+ (# 0##,l #) -> integerFromWord# l
+ (# h ,l #) -> IP (bigNatFromWord2# h l)
+#else
+integerMul (IS x) (IS y) = case timesInt2# x y of
+ (# 0#, _h, l #) -> IS l
+ (# _ , h, l #)
+ | isTrue# (h >=# 0#)
+ -> IP (bigNatFromWord2# (int2Word# h) (int2Word# l))
+ | True
+ -> let
+ -- two's complement of a two-word negative Int:
+ -- l' = complement l + 1
+ -- h' = complement h + carry
+ !(# l',c #) = addWordC# (not# (int2Word# l)) 1##
+ !h' = int2Word# c `plusWord#` not# (int2Word# h)
+ in IN (bigNatFromWord2# h' l')
+#endif
+integerMul x@(IS _) y = integerMul y x
+integerMul (IP x) (IP y) = IP (bigNatMul x y)
+integerMul (IP x) (IN y) = IN (bigNatMul x y)
+integerMul (IP x) (IS y)
+ | isTrue# (y >=# 0#) = IP (bigNatMulWord# x (int2Word# y))
+ | True = IN (bigNatMulWord# x (int2Word# (negateInt# y)))
+integerMul (IN x) (IN y) = IP (bigNatMul x y)
+integerMul (IN x) (IP y) = IN (bigNatMul x y)
+integerMul (IN x) (IS y)
+ | isTrue# (y >=# 0#) = IN (bigNatMulWord# x (int2Word# y))
+ | True = IP (bigNatMulWord# x (int2Word# (negateInt# y)))
+
+-- | Negate 'Integer'.
+--
+-- One edge-case issue to take into account is that Int's range is not
+-- symmetric around 0. I.e. @minBound+maxBound = -1@
+--
+-- IP is used iff n > maxBound::Int
+-- IN is used iff n < minBound::Int
+integerNegate :: Integer -> Integer
+{-# NOINLINE integerNegate #-}
+integerNegate (IN b) = IP b
+integerNegate (IS INT_MINBOUND#) = IP (bigNatFromWord# ABS_INT_MINBOUND##)
+integerNegate (IS i) = IS (negateInt# i)
+integerNegate (IP b)
+ | isTrue# (bigNatEqWord# b ABS_INT_MINBOUND##) = IS INT_MINBOUND#
+ | True = IN b
+
+
+-- | Compute absolute value of an 'Integer'
+integerAbs :: Integer -> Integer
+{-# NOINLINE integerAbs #-}
+integerAbs (IN i) = IP i
+integerAbs n@(IP _) = n
+integerAbs n@(IS i)
+ | isTrue# (i >=# 0#) = n
+ | INT_MINBOUND# <- i = IP (bigNatFromWord# ABS_INT_MINBOUND##)
+ | True = IS (negateInt# i)
+
+
+-- | Return @-1@, @0@, and @1@ depending on whether argument is
+-- negative, zero, or positive, respectively
+integerSignum :: Integer -> Integer
+{-# NOINLINE integerSignum #-}
+integerSignum !j = IS (integerSignum# j)
+
+-- | Return @-1#@, @0#@, and @1#@ depending on whether argument is
+-- negative, zero, or positive, respectively
+integerSignum# :: Integer -> Int#
+{-# NOINLINE integerSignum# #-}
+integerSignum# (IN _) = -1#
+integerSignum# (IS i#) = sgnI# i#
+integerSignum# (IP _ ) = 1#
+
+-- | Count number of set bits. For negative arguments returns
+-- the negated population count of the absolute value.
+integerPopCount# :: Integer -> Int#
+{-# NOINLINE integerPopCount# #-}
+integerPopCount# (IS i)
+ | isTrue# (i >=# 0#) = word2Int# (popCntI# i)
+ | True = negateInt# (word2Int# (popCntI# (negateInt# i)))
+integerPopCount# (IP bn) = word2Int# (bigNatPopCount# bn)
+integerPopCount# (IN bn) = negateInt# (word2Int# (bigNatPopCount# bn))
+
+-- | Positive 'Integer' for which only /n/-th bit is set
+integerBit# :: Word# -> Integer
+{-# NOINLINE integerBit# #-}
+integerBit# i
+ | isTrue# (i `ltWord#` (WORD_SIZE_IN_BITS## `minusWord#` 1##))
+ = IS (uncheckedIShiftL# 1# (word2Int# i))
+
+ | True = IP (bigNatBit# i)
+
+-- | 'Integer' for which only /n/-th bit is set
+integerBit :: Word -> Integer
+integerBit (W# i) = integerBit# i
+
+-- | Test if /n/-th bit is set.
+--
+-- Fake 2's complement for negative values (might be slow)
+integerTestBit# :: Integer -> Word# -> Bool#
+{-# NOINLINE integerTestBit# #-}
+integerTestBit# (IS x) i
+ | isTrue# (i `ltWord#` WORD_SIZE_IN_BITS##)
+ = testBitI# x i
+ | True
+ = x <# 0#
+integerTestBit# (IP x) i = bigNatTestBit# x i
+integerTestBit# (IN x) i
+ | isTrue# (iw >=# n)
+ = 1#
+ -- if all the limbs j with j < iw are null, then we have to consider the
+ -- carry of the 2's complement convertion. Otherwise we just have to return
+ -- the inverse of the bit test
+ | allZ iw = testBitW# (xi `minusWord#` 1##) ib ==# 0#
+ | True = testBitW# xi ib ==# 0#
+ where
+ !xi = bigNatIndex# x iw
+ !n = bigNatSize# x
+ !iw = word2Int# (i `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
+ !ib = i `and#` WORD_SIZE_BITS_MASK##
+
+ allZ 0# = True
+ allZ j | isTrue# (bigNatIndex# x (j -# 1#) `eqWord#` 0##) = allZ (j -# 1#)
+ | True = False
+
+-- | Test if /n/-th bit is set. For negative Integers it tests the n-th bit of
+-- the negated argument.
+--
+-- Fake 2's complement for negative values (might be slow)
+integerTestBit :: Integer -> Word -> Bool
+integerTestBit !i (W# n) = isTrue# (integerTestBit# i n)
+
+-- | Shift-right operation
+--
+-- Fake 2's complement for negative values (might be slow)
+integerShiftR# :: Integer -> Word# -> Integer
+{-# NOINLINE integerShiftR# #-}
+integerShiftR# !x 0## = x
+integerShiftR# (IS i) n = IS (iShiftRA# i (word2Int# n))
+ where
+ iShiftRA# a b
+ | isTrue# (b >=# WORD_SIZE_IN_BITS#) = (a <# 0#) *# (-1#)
+ | True = a `uncheckedIShiftRA#` b
+integerShiftR# (IP bn) n = integerFromBigNat (bigNatShiftR# bn n)
+integerShiftR# (IN bn) n =
+ case integerFromBigNatNeg (bigNatShiftRNeg# bn n) of
+ IS 0# -> IS -1#
+ r -> r
+
+-- | Shift-right operation
+--
+-- Fake 2's complement for negative values (might be slow)
+integerShiftR :: Integer -> Word -> Integer
+integerShiftR !x (W# w) = integerShiftR# x w
+
+-- | Shift-left operation
+integerShiftL# :: Integer -> Word# -> Integer
+{-# NOINLINE integerShiftL# #-}
+integerShiftL# !x 0## = x
+integerShiftL# (IS 0#) _ = IS 0#
+integerShiftL# (IS 1#) n = integerBit# n
+integerShiftL# (IS i) n
+ | isTrue# (i >=# 0#) = integerFromBigNat (bigNatShiftL# (bigNatFromWord# (int2Word# i)) n)
+ | True = integerFromBigNatNeg (bigNatShiftL# (bigNatFromWord# (int2Word# (negateInt# i))) n)
+integerShiftL# (IP bn) n = IP (bigNatShiftL# bn n)
+integerShiftL# (IN bn) n = IN (bigNatShiftL# bn n)
+
+-- | Shift-left operation
+--
+-- Remember that bits are stored in sign-magnitude form, hence the behavior of
+-- negative Integers is different from negative Int's behavior.
+integerShiftL :: Integer -> Word -> Integer
+integerShiftL !x (W# w) = integerShiftL# x w
+
+-- | Bitwise OR operation
+--
+-- Fake 2's complement for negative values (might be slow)
+integerOr :: Integer -> Integer -> Integer
+{-# NOINLINE integerOr #-}
+integerOr a b = case a of
+ IS 0# -> b
+ IS -1# -> IS -1#
+ IS x -> case b of
+ IS 0# -> a
+ IS -1# -> IS -1#
+ IS y -> IS (orI# x y)
+ IP y
+ | isTrue# (x >=# 0#) -> integerFromBigNat (bigNatOrWord# y (int2Word# x))
+ | True -> integerFromBigNatNeg
+ (bigNatAddWord#
+ (bigNatAndNot -- use De Morgan's laws
+ (bigNatFromWord#
+ (int2Word# (negateInt# x) `minusWord#` 1##))
+ y)
+ 1##)
+ IN y
+ | isTrue# (x >=# 0#) -> integerFromBigNatNeg
+ (bigNatAddWord#
+ (bigNatAndNotWord# -- use De Morgan's laws
+ (bigNatSubWordUnsafe# y 1##)
+ (int2Word# x))
+ 1##)
+ | True -> integerFromBigNatNeg
+ (bigNatAddWord#
+ (bigNatAndWord# -- use De Morgan's laws
+ (bigNatSubWordUnsafe# y 1##)
+ (int2Word# (negateInt# x) `minusWord#` 1##))
+ 1##)
+ IP x -> case b of
+ IS _ -> integerOr b a
+ IP y -> integerFromBigNat (bigNatOr x y)
+ IN y -> integerFromBigNatNeg
+ (bigNatAddWord#
+ (bigNatAndNot -- use De Morgan's laws
+ (bigNatSubWordUnsafe# y 1##)
+ x)
+ 1##)
+ IN x -> case b of
+ IS _ -> integerOr b a
+ IN y -> integerFromBigNatNeg
+ (bigNatAddWord#
+ (bigNatAnd -- use De Morgan's laws
+ (bigNatSubWordUnsafe# x 1##)
+ (bigNatSubWordUnsafe# y 1##))
+ 1##)
+ IP y -> integerFromBigNatNeg
+ (bigNatAddWord#
+ (bigNatAndNot -- use De Morgan's laws
+ (bigNatSubWordUnsafe# x 1##)
+ y)
+ 1##)
+
+
+-- | Bitwise XOR operation
+--
+-- Fake 2's complement for negative values (might be slow)
+integerXor :: Integer -> Integer -> Integer
+{-# NOINLINE integerXor #-}
+integerXor a b = case a of
+ IS 0# -> b
+ IS -1# -> integerComplement b
+ IS x -> case b of
+ IS 0# -> a
+ IS -1# -> integerComplement a
+ IS y -> IS (xorI# x y)
+ IP y
+ | isTrue# (x >=# 0#) -> integerFromBigNat (bigNatXorWord# y (int2Word# x))
+ | True -> integerFromBigNatNeg
+ (bigNatAddWord#
+ (bigNatXorWord#
+ y
+ (int2Word# (negateInt# x) `minusWord#` 1##))
+ 1##)
+ IN y
+ | isTrue# (x >=# 0#) -> integerFromBigNatNeg
+ (bigNatAddWord#
+ (bigNatXorWord#
+ (bigNatSubWordUnsafe# y 1##)
+ (int2Word# x))
+ 1##)
+ | True -> integerFromBigNat
+ (bigNatXorWord# -- xor (not x) (not y) = xor x y
+ (bigNatSubWordUnsafe# y 1##)
+ (int2Word# (negateInt# x) `minusWord#` 1##))
+ IP x -> case b of
+ IS _ -> integerXor b a
+ IP y -> integerFromBigNat (bigNatXor x y)
+ IN y -> integerFromBigNatNeg
+ (bigNatAddWord#
+ (bigNatXor
+ x
+ (bigNatSubWordUnsafe# y 1##))
+ 1##)
+ IN x -> case b of
+ IS _ -> integerXor b a
+ IN y -> integerFromBigNat
+ (bigNatXor -- xor (not x) (not y) = xor x y
+ (bigNatSubWordUnsafe# x 1##)
+ (bigNatSubWordUnsafe# y 1##))
+ IP y -> integerFromBigNatNeg
+ (bigNatAddWord#
+ (bigNatXor
+ y
+ (bigNatSubWordUnsafe# x 1##))
+ 1##)
+
+
+
+-- | Bitwise AND operation
+--
+-- Fake 2's complement for negative values (might be slow)
+integerAnd :: Integer -> Integer -> Integer
+{-# NOINLINE integerAnd #-}
+integerAnd a b = case a of
+ IS 0# -> IS 0#
+ IS -1# -> b
+ IS x -> case b of
+ IS 0# -> IS 0#
+ IS -1# -> a
+ IS y -> IS (andI# x y)
+ IP y -> integerFromBigNat (bigNatAndInt# y x)
+ IN y
+ | isTrue# (x >=# 0#) -> integerFromWord# (int2Word# x `andNot#` (indexWordArray# y 0# `minusWord#` 1##))
+ | True -> integerFromBigNatNeg
+ (bigNatAddWord#
+ (bigNatOrWord# -- use De Morgan's laws
+ (bigNatSubWordUnsafe# y 1##)
+ (wordFromAbsInt# x `minusWord#` 1##))
+ 1##)
+ IP x -> case b of
+ IS _ -> integerAnd b a
+ IP y -> integerFromBigNat (bigNatAnd x y)
+ IN y -> integerFromBigNat (bigNatAndNot x (bigNatSubWordUnsafe# y 1##))
+ IN x -> case b of
+ IS _ -> integerAnd b a
+ IN y -> integerFromBigNatNeg
+ (bigNatAddWord#
+ (bigNatOr -- use De Morgan's laws
+ (bigNatSubWordUnsafe# x 1##)
+ (bigNatSubWordUnsafe# y 1##))
+ 1##)
+ IP y -> integerFromBigNat (bigNatAndNot y (bigNatSubWordUnsafe# x 1##))
+
+
+
+-- | Binary complement of the
+integerComplement :: Integer -> Integer
+{-# NOINLINE integerComplement #-}
+integerComplement (IS x) = IS (notI# x)
+integerComplement (IP x) = IN (bigNatAddWord# x 1##)
+integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##)
+
+
+-- | Simultaneous 'integerQuot' and 'integerRem'.
+--
+-- Divisor must be non-zero otherwise the GHC runtime will terminate
+-- with a division-by-zero fault.
+integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #)
+{-# NOINLINE integerQuotRem# #-}
+integerQuotRem# !n (IS 1#) = (# n, IS 0# #)
+integerQuotRem# !n (IS -1#) = let !q = integerNegate n in (# q, (IS 0#) #)
+integerQuotRem# !_ (IS 0#) = (# divByZero, divByZero #)
+integerQuotRem# (IS 0#) _ = (# IS 0#, IS 0# #)
+integerQuotRem# (IS n#) (IS d#) = case quotRemInt# n# d# of
+ (# q#, r# #) -> (# IS q#, IS r# #)
+integerQuotRem# (IP n) (IP d) = case bigNatQuotRem# n d of
+ (# q, r #) -> (# integerFromBigNat q, integerFromBigNat r #)
+integerQuotRem# (IP n) (IN d) = case bigNatQuotRem# n d of
+ (# q, r #) -> (# integerFromBigNatNeg q, integerFromBigNat r #)
+integerQuotRem# (IN n) (IN d) = case bigNatQuotRem# n d of
+ (# q, r #) -> (# integerFromBigNat q, integerFromBigNatNeg r #)
+integerQuotRem# (IN n) (IP d) = case bigNatQuotRem# n d of
+ (# q, r #) -> (# integerFromBigNatNeg q, integerFromBigNatNeg r #)
+integerQuotRem# (IP n) (IS d#)
+ | isTrue# (d# >=# 0#) = case bigNatQuotRemWord# n (int2Word# d#) of
+ (# q, r# #) -> (# integerFromBigNat q, integerFromWord# r# #)
+ | True = case bigNatQuotRemWord# n (int2Word# (negateInt# d#)) of
+ (# q, r# #) -> (# integerFromBigNatNeg q, integerFromWord# r# #)
+integerQuotRem# (IN n) (IS d#)
+ | isTrue# (d# >=# 0#) = case bigNatQuotRemWord# n (int2Word# d#) of
+ (# q, r# #) -> (# integerFromBigNatNeg q, integerFromWordNeg# r# #)
+ | True = case bigNatQuotRemWord# n (int2Word# (negateInt# d#)) of
+ (# q, r# #) -> (# integerFromBigNat q, integerFromWordNeg# r# #)
+integerQuotRem# n@(IS _) (IN _) = (# IS 0#, n #) -- since @n < d@
+integerQuotRem# n@(IS n#) (IP d) -- need to account for (IS minBound)
+ | isTrue# (n# ># 0#) = (# IS 0#, n #)
+ | isTrue# (bigNatGtWord# d (int2Word# (negateInt# n#))) = (# IS 0#, n #)
+ | True {- abs(n) == d -} = (# IS -1#, IS 0# #)
+
+-- | Simultaneous 'integerQuot' and 'integerRem'.
+--
+-- Divisor must be non-zero otherwise the GHC runtime will terminate
+-- with a division-by-zero fault.
+integerQuotRem :: Integer -> Integer -> (Integer, Integer)
+integerQuotRem !x !y = case integerQuotRem# x y of
+ (# q, r #) -> (q, r)
+
+
+integerQuot :: Integer -> Integer -> Integer
+{-# NOINLINE integerQuot #-}
+integerQuot !n (IS 1#) = n
+integerQuot !n (IS -1#) = integerNegate n
+integerQuot !_ (IS 0#) = divByZero
+integerQuot (IS 0#) _ = IS 0#
+integerQuot (IS n#) (IS d#) = IS (quotInt# n# d#)
+integerQuot (IP n) (IS d#)
+ | isTrue# (d# >=# 0#) = integerFromBigNat (bigNatQuotWord# n (int2Word# d#))
+ | True = integerFromBigNatNeg (bigNatQuotWord# n
+ (int2Word# (negateInt# d#)))
+integerQuot (IN n) (IS d#)
+ | isTrue# (d# >=# 0#) = integerFromBigNatNeg (bigNatQuotWord# n (int2Word# d#))
+ | True = integerFromBigNat (bigNatQuotWord# n
+ (int2Word# (negateInt# d#)))
+integerQuot (IP n) (IP d) = integerFromBigNat (bigNatQuot n d)
+integerQuot (IP n) (IN d) = integerFromBigNatNeg (bigNatQuot n d)
+integerQuot (IN n) (IP d) = integerFromBigNatNeg (bigNatQuot n d)
+integerQuot (IN n) (IN d) = integerFromBigNat (bigNatQuot n d)
+integerQuot n d = case integerQuotRem# n d of (# q, _ #) -> q
+
+integerRem :: Integer -> Integer -> Integer
+{-# NOINLINE integerRem #-}
+integerRem !_ (IS 1#) = IS 0#
+integerRem _ (IS -1#) = IS 0#
+integerRem _ (IS 0#) = IS (remInt# 0# 0#)
+integerRem (IS 0#) _ = IS 0#
+integerRem (IS n#) (IS d#) = IS (remInt# n# d#)
+integerRem (IP n) (IS d#)
+ = integerFromWord# (bigNatRemWord# n (int2Word# (absI# d#)))
+integerRem (IN n) (IS d#)
+ = integerFromWordNeg# (bigNatRemWord# n (int2Word# (absI# d#)))
+integerRem (IP n) (IP d) = integerFromBigNat (bigNatRem n d)
+integerRem (IP n) (IN d) = integerFromBigNat (bigNatRem n d)
+integerRem (IN n) (IP d) = integerFromBigNatNeg (bigNatRem n d)
+integerRem (IN n) (IN d) = integerFromBigNatNeg (bigNatRem n d)
+integerRem n d = case integerQuotRem# n d of (# _, r #) -> r
+
+
+-- | Simultaneous 'integerDiv' and 'integerMod'.
+--
+-- Divisor must be non-zero otherwise the GHC runtime will terminate
+-- with a division-by-zero fault.
+integerDivMod# :: Integer -> Integer -> (# Integer, Integer #)
+{-# NOINLINE integerDivMod# #-}
+integerDivMod# !n !d
+ | isTrue# (integerSignum# r ==# negateInt# (integerSignum# d))
+ = let !q' = integerAdd q (IS -1#) -- TODO: optimize
+ !r' = integerAdd r d
+ in (# q', r' #)
+ | True = qr
+ where
+ !qr@(# q, r #) = integerQuotRem# n d
+
+-- | Simultaneous 'integerDiv' and 'integerMod'.
+--
+-- Divisor must be non-zero otherwise the GHC runtime will terminate
+-- with a division-by-zero fault.
+integerDivMod :: Integer -> Integer -> (Integer, Integer)
+integerDivMod !n !d = case integerDivMod# n d of
+ (# q,r #) -> (q,r)
+
+
+integerDiv :: Integer -> Integer -> Integer
+{-# NOINLINE integerDiv #-}
+integerDiv !n !d
+ -- same-sign ops can be handled by more efficient 'integerQuot'
+ | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerQuot n d
+ | True = case integerDivMod# n d of (# q, _ #) -> q
+
+
+integerMod :: Integer -> Integer -> Integer
+{-# NOINLINE integerMod #-}
+integerMod !n !d
+ -- same-sign ops can be handled by more efficient 'integerRem'
+ | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerRem n d
+ | True = case integerDivMod# n d of (# _, r #) -> r
+
+-- | Compute greatest common divisor.
+integerGcd :: Integer -> Integer -> Integer
+{-# NOINLINE integerGcd #-}
+integerGcd (IS 0#) !b = integerAbs b
+integerGcd a (IS 0#) = integerAbs a
+integerGcd (IS 1#) _ = IS 1#
+integerGcd (IS -1#) _ = IS 1#
+integerGcd _ (IS 1#) = IS 1#
+integerGcd _ (IS -1#) = IS 1#
+integerGcd (IS a) (IS b) = integerFromWord# (gcdWord#
+ (int2Word# (absI# a))
+ (int2Word# (absI# b)))
+integerGcd a@(IS _) b = integerGcd b a
+integerGcd (IN a) b = integerGcd (IP a) b
+integerGcd (IP a) (IP b) = integerFromBigNat (bigNatGcd a b)
+integerGcd (IP a) (IN b) = integerFromBigNat (bigNatGcd a b)
+integerGcd (IP a) (IS b) = integerFromWord# (bigNatGcdWord# a (int2Word# (absI# b)))
+
+-- | Compute least common multiple.
+integerLcm :: Integer -> Integer -> Integer
+{-# NOINLINE integerLcm #-}
+integerLcm (IS 0#) !_ = IS 0#
+integerLcm (IS 1#) b = integerAbs b
+integerLcm (IS -1#) b = integerAbs b
+integerLcm _ (IS 0#) = IS 0#
+integerLcm a (IS 1#) = integerAbs a
+integerLcm a (IS -1#) = integerAbs a
+integerLcm a b = (aa `integerQuot` (aa `integerGcd` ab)) `integerMul` ab
+ where -- TODO: use extended GCD to get a's factor directly
+ aa = integerAbs a
+ ab = integerAbs b
+
+-- | Square a Integer
+integerSqr :: Integer -> Integer
+integerSqr !a = integerMul a a
+
+
+-- | Base 2 logarithm (floor)
+--
+-- For numbers <= 0, return 0
+integerLog2# :: Integer -> Word#
+integerLog2# (IS i)
+ | isTrue# (i <=# 0#) = 0##
+ | True = wordLog2# (int2Word# i)
+integerLog2# (IN _) = 0##
+integerLog2# (IP b) = bigNatLog2# b
+
+-- | Base 2 logarithm (floor)
+--
+-- For numbers <= 0, return 0
+integerLog2 :: Integer -> Word
+integerLog2 !i = W# (integerLog2# i)
+
+-- | Logarithm (floor) for an arbitrary base
+--
+-- For numbers <= 0, return 0
+integerLogBaseWord# :: Word# -> Integer -> Word#
+integerLogBaseWord# base !i
+ | integerIsNegative i = 0##
+ | True = naturalLogBaseWord# base (integerToNatural i)
+
+-- | Logarithm (floor) for an arbitrary base
+--
+-- For numbers <= 0, return 0
+integerLogBaseWord :: Word -> Integer -> Word
+integerLogBaseWord (W# base) !i = W# (integerLogBaseWord# base i)
+
+-- | Logarithm (floor) for an arbitrary base
+--
+-- For numbers <= 0, return 0
+integerLogBase# :: Integer -> Integer -> Word#
+integerLogBase# !base !i
+ | integerIsNegative i = 0##
+ | True = naturalLogBase# (integerToNatural base)
+ (integerToNatural i)
+
+-- | Logarithm (floor) for an arbitrary base
+--
+-- For numbers <= 0, return 0
+integerLogBase :: Integer -> Integer -> Word
+integerLogBase !base !i = W# (integerLogBase# base i)
+
+-- | Indicate if the value is a power of two and which one
+integerIsPowerOf2# :: Integer -> (# () | Word# #)
+integerIsPowerOf2# (IS i)
+ | isTrue# (i <=# 0#) = (# () | #)
+ | True = wordIsPowerOf2# (int2Word# i)
+integerIsPowerOf2# (IN _) = (# () | #)
+integerIsPowerOf2# (IP w) = bigNatIsPowerOf2# w
+
+#if WORD_SIZE_IN_BITS == 32
+
+-- | Convert an Int64# into an Integer on 32-bit architectures
+integerFromInt64# :: Int64# -> Integer
+{-# NOINLINE integerFromInt64# #-}
+integerFromInt64# !i
+ | isTrue# ((i `leInt64#` intToInt64# 0x7FFFFFFF#)
+ &&# (i `geInt64#` intToInt64# -0x80000000#))
+ = IS (int64ToInt# i)
+
+ | isTrue# (i `geInt64#` intToInt64# 0#)
+ = IP (bigNatFromWord64# (int64ToWord64# i))
+
+ | True
+ = IN (bigNatFromWord64# (int64ToWord64# (negateInt64# i)))
+
+-- | Convert a Word64# into an Integer on 32-bit architectures
+integerFromWord64# :: Word64# -> Integer
+{-# NOINLINE integerFromWord64# #-}
+integerFromWord64# !w
+ | isTrue# (w `leWord64#` wordToWord64# 0x7FFFFFFF##)
+ = IS (int64ToInt# (word64ToInt64# w))
+ | True
+ = IP (bigNatFromWord64# w)
+
+-- | Convert an Integer into an Int64# on 32-bit architectures
+integerToInt64# :: Integer -> Int64#
+{-# NOINLINE integerToInt64# #-}
+integerToInt64# (IS i) = intToInt64# i
+integerToInt64# (IP b) = word64ToInt64# (bigNatToWord64# b)
+integerToInt64# (IN b) = negateInt64# (word64ToInt64# (bigNatToWord64# b))
+
+-- | Convert an Integer into a Word64# on 32-bit architectures
+integerToWord64# :: Integer -> Word64#
+{-# NOINLINE integerToWord64# #-}
+integerToWord64# (IS i) = int64ToWord64# (intToInt64# i)
+integerToWord64# (IP b) = bigNatToWord64# b
+integerToWord64# (IN b) = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64# b)))
+
+#else
+
+-- | Convert an Int64# into an Integer on 64-bit architectures
+integerFromInt64# :: Int# -> Integer
+integerFromInt64# !x = IS x
+
+#endif
+
+----------------------------------------------------------------------------
+-- Conversions to/from floating point
+----------------------------------------------------------------------------
+
+-- | Decode a Double# into (# Integer mantissa, Int# exponent #)
+integerDecodeDouble# :: Double# -> (# Integer, Int# #)
+{-# NOINLINE integerDecodeDouble# #-}
+integerDecodeDouble# !x = case decodeDouble_Int64# x of
+ (# m, e #) -> (# integerFromInt64# m, e #)
+
+-- | Decode a Double# into (# Integer mantissa, Int# exponent #)
+integerDecodeDouble :: Double -> (Integer, Int)
+integerDecodeDouble (D# x) = case integerDecodeDouble# x of
+ (# m, e #) -> (m, I# e)
+
+-- | Encode (# Integer mantissa, Int# exponent #) into a Double#
+integerEncodeDouble# :: Integer -> Int# -> Double#
+{-# NOINLINE integerEncodeDouble# #-}
+integerEncodeDouble# (IS i) 0# = int2Double# i
+integerEncodeDouble# (IS i) e = intEncodeDouble# i e
+integerEncodeDouble# (IP b) e = bigNatEncodeDouble# b e
+integerEncodeDouble# (IN b) e = negateDouble# (bigNatEncodeDouble# b e)
+
+-- | Encode (Integer mantissa, Int exponent) into a Double
+integerEncodeDouble :: Integer -> Int -> Double
+integerEncodeDouble !m (I# e) = D# (integerEncodeDouble# m e)
+
+-- | Encode an Integer (mantissa) into a Double#
+integerToDouble# :: Integer -> Double#
+{-# NOINLINE integerToDouble# #-}
+integerToDouble# !i = integerEncodeDouble# i 0#
+
+-- | Encode an Integer (mantissa) into a Float#
+integerToFloat# :: Integer -> Float#
+{-# NOINLINE integerToFloat# #-}
+integerToFloat# !i = integerEncodeFloat# i 0#
+
+-- | Encode (# Integer mantissa, Int# exponent #) into a Float#
+--
+-- TODO: Not sure if it's worth to write 'Float' optimized versions here
+integerEncodeFloat# :: Integer -> Int# -> Float#
+{-# NOINLINE integerEncodeFloat# #-}
+integerEncodeFloat# !m 0# = double2Float# (integerToDouble# m)
+integerEncodeFloat# !m e = double2Float# (integerEncodeDouble# m e)
+
+-- | Compute the number of digits of the Integer (without the sign) in the given base.
+--
+-- `base` must be > 1
+integerSizeInBase# :: Word# -> Integer -> Word#
+integerSizeInBase# base (IS i) = wordSizeInBase# base (int2Word# (absI# i))
+integerSizeInBase# base (IP n) = bigNatSizeInBase# base n
+integerSizeInBase# base (IN n) = bigNatSizeInBase# base n
+
+-- | Write an 'Integer' (without sign) to @/addr/@ in base-256 representation
+-- and return the number of bytes written.
+--
+-- The endianness is selected with the Bool# parameter: write most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+integerToAddr# :: Integer -> Addr# -> Bool# -> State# s -> (# State# s, Word# #)
+integerToAddr# (IS i) = wordToAddr# (int2Word# (absI# i))
+integerToAddr# (IP n) = bigNatToAddr# n
+integerToAddr# (IN n) = bigNatToAddr# n
+
+-- | Write an 'Integer' (without sign) to @/addr/@ in base-256 representation
+-- and return the number of bytes written.
+--
+-- The endianness is selected with the Bool# parameter: write most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+integerToAddr :: Integer -> Addr# -> Bool# -> IO Word
+integerToAddr a addr e = IO \s -> case integerToAddr# a addr e s of
+ (# s', w #) -> (# s', W# w #)
+
+-- | Read an 'Integer' (without sign) in base-256 representation from an Addr#.
+--
+-- The size is given in bytes.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- Null higher limbs are automatically trimed.
+integerFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, Integer #)
+integerFromAddr# sz addr e s =
+ case bigNatFromAddr# sz addr e s of
+ (# s', n #) -> (# s', integerFromBigNat n #)
+
+-- | Read an 'Integer' (without sign) in base-256 representation from an Addr#.
+--
+-- The size is given in bytes.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- Null higher limbs are automatically trimed.
+integerFromAddr :: Word# -> Addr# -> Bool# -> IO Integer
+integerFromAddr sz addr e = IO (integerFromAddr# sz addr e)
+
+
+
+-- | Write an 'Integer' (without sign) in base-256 representation and return the
+-- number of bytes written.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+integerToMutableByteArray# :: Integer -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #)
+integerToMutableByteArray# (IS i) = wordToMutableByteArray# (int2Word# (absI# i))
+integerToMutableByteArray# (IP a) = bigNatToMutableByteArray# a
+integerToMutableByteArray# (IN a) = bigNatToMutableByteArray# a
+
+-- | Write an 'Integer' (without sign) in base-256 representation and return the
+-- number of bytes written.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+integerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Bool# -> IO Word
+integerToMutableByteArray i mba w e = IO \s -> case integerToMutableByteArray# i mba w e s of
+ (# s', r #) -> (# s', W# r #)
+
+-- | Read an 'Integer' (without sign) in base-256 representation from a ByteArray#.
+--
+-- The size is given in bytes.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- Null higher limbs are automatically trimed.
+integerFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, Integer #)
+integerFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of
+ (# s', a #) -> (# s', integerFromBigNat a #)
+
+-- | Read an 'Integer' (without sign) in base-256 representation from a ByteArray#.
+--
+-- The size is given in bytes.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- Null higher limbs are automatically trimed.
+integerFromByteArray :: Word# -> ByteArray# -> Word# -> Bool# -> Integer
+integerFromByteArray sz ba off e = case runRW# (integerFromByteArray# sz ba off e) of
+ (# _, i #) -> i
diff --git a/libraries/ghc-bignum/src/GHC/Num/Natural.hs b/libraries/ghc-bignum/src/GHC/Num/Natural.hs
new file mode 100644
index 0000000000000000000000000000000000000000..1adb02181dc31374df3571b8be9a1bc75c026c88
--- /dev/null
+++ b/libraries/ghc-bignum/src/GHC/Num/Natural.hs
@@ -0,0 +1,557 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BlockArguments #-}
+
+#include "MachDeps.h"
+#include "WordSize.h"
+
+module GHC.Num.Natural where
+
+import GHC.Prim
+import GHC.Types
+import GHC.Classes
+
+import GHC.Num.BigNat
+import GHC.Num.Primitives
+
+default ()
+
+-- | Natural number
+--
+-- Invariant: numbers <= WORD_MAXBOUND use the `NS` constructor
+data Natural
+ = NS !Word#
+ | NB !BigNat
+
+instance Eq Natural where
+ (==) = naturalEq
+ (/=) = naturalNe
+
+instance Ord Natural where
+ compare = naturalCompare
+
+
+-- | Check Natural invariants
+naturalCheck# :: Natural -> Bool#
+naturalCheck# (NS _) = 1#
+naturalCheck# (NB bn) = bigNatCheck# bn &&# bigNatSize# bn ># 1#
+
+-- | Check Natural invariants
+naturalCheck :: Natural -> Bool
+naturalCheck !n = isTrue# (naturalCheck# n)
+
+-- | Zero Natural
+naturalZero :: Natural
+naturalZero = NS 0##
+
+-- | One Natural
+naturalOne :: Natural
+naturalOne = NS 1##
+
+-- | Test Zero Natural
+naturalIsZero :: Natural -> Bool
+naturalIsZero (NS 0##) = True
+naturalIsZero _ = False
+
+-- | Test One Natural
+naturalIsOne :: Natural -> Bool
+naturalIsOne (NS 1##) = True
+naturalIsOne _ = False
+
+-- | Indicate if the value is a power of two and which one
+naturalIsPowerOf2# :: Natural -> (# () | Word# #)
+naturalIsPowerOf2# (NS w) = wordIsPowerOf2# w
+naturalIsPowerOf2# (NB w) = bigNatIsPowerOf2# w
+
+-- | Create a Natural from a BigNat (respect the invariants)
+naturalFromBigNat :: BigNat -> Natural
+naturalFromBigNat x = case bigNatSize# x of
+ 0# -> naturalZero
+ 1# -> NS (bigNatIndex# x 0#)
+ _ -> NB x
+
+-- | Convert a Natural into a BigNat
+naturalToBigNat :: Natural -> BigNat
+naturalToBigNat (NS w) = bigNatFromWord# w
+naturalToBigNat (NB bn) = bn
+
+-- | Create a Natural from a Word#
+naturalFromWord# :: Word# -> Natural
+{-# NOINLINE naturalFromWord# #-}
+naturalFromWord# x = NS x
+
+-- | Convert two Word# (most-significant first) into a Natural
+naturalFromWord2# :: Word# -> Word# -> Natural
+naturalFromWord2# 0## 0## = naturalZero
+naturalFromWord2# 0## n = NS n
+naturalFromWord2# w1 w2 = NB (bigNatFromWord2# w2 w1)
+
+-- | Create a Natural from a Word
+naturalFromWord :: Word -> Natural
+naturalFromWord (W# x) = NS x
+
+-- | Create a Natural from a list of Word
+naturalFromWordList :: [Word] -> Natural
+naturalFromWordList xs = naturalFromBigNat (bigNatFromWordList xs)
+
+-- | Convert the lower bits of a Natural into a Word#
+naturalToWord# :: Natural -> Word#
+{-# NOINLINE naturalToWord# #-}
+naturalToWord# (NS x) = x
+naturalToWord# (NB b) = bigNatIndex# b 0#
+
+-- | Convert the lower bits of a Natural into a Word
+naturalToWord :: Natural -> Word
+naturalToWord !n = W# (naturalToWord# n)
+
+
+-- | Try downcasting 'Natural' to 'Word' value.
+-- Returns '()' if value doesn't fit in 'Word'.
+naturalToWordMaybe# :: Natural -> (# Word# | () #)
+naturalToWordMaybe# (NS w) = (# w | #)
+naturalToWordMaybe# _ = (# | () #)
+
+-- | Create a Natural from an Int# (unsafe: silently converts negative values
+-- into positive ones)
+naturalFromIntUnsafe# :: Int# -> Natural
+naturalFromIntUnsafe# !i = NS (int2Word# i)
+
+-- | Create a Natural from an Int (unsafe: silently converts negative values
+-- into positive ones)
+naturalFromIntUnsafe :: Int -> Natural
+naturalFromIntUnsafe (I# i) = naturalFromIntUnsafe# i
+
+-- | Create a Natural from an Int#
+--
+-- Throws 'Control.Exception.Underflow' when passed a negative 'Int'.
+naturalFromIntThrow# :: Int# -> Natural
+naturalFromIntThrow# i
+ | isTrue# (i <# 0#) = case underflow of _ -> NS 0##
+ | True = naturalFromIntUnsafe# i
+
+-- | Create a Natural from an Int
+--
+-- Throws 'Control.Exception.Underflow' when passed a negative 'Int'.
+naturalFromIntThrow :: Int -> Natural
+naturalFromIntThrow (I# i) = naturalFromIntThrow# i
+
+-- | Create an Int# from a Natural (can overflow the int and give a negative
+-- number)
+naturalToInt# :: Natural -> Int#
+naturalToInt# !n = word2Int# (naturalToWord# n)
+
+-- | Create an Int# from a Natural (can overflow the int and give a negative
+-- number)
+naturalToInt :: Natural -> Int
+naturalToInt !n = I# (naturalToInt# n)
+
+-- | Create a Natural from an Int#
+--
+-- Underflow exception if Int# is negative
+naturalFromInt# :: Int# -> Natural
+naturalFromInt# !i
+ | isTrue# (i >=# 0#) = NS (int2Word# i)
+ | True = case underflow of _ -> NS 0##
+
+-- | Create a Natural from an Int
+--
+-- Underflow exception if Int# is negative
+naturalFromInt :: Int -> Natural
+naturalFromInt (I# i) = naturalFromInt# i
+
+-- | Encode (# Natural mantissa, Int# exponent #) into a Double#
+naturalEncodeDouble# :: Natural -> Int# -> Double#
+naturalEncodeDouble# (NS w) 0# = word2Double# w
+naturalEncodeDouble# (NS w) e = wordEncodeDouble# w e
+naturalEncodeDouble# (NB b) e = bigNatEncodeDouble# b e
+
+-- | Encode a Natural (mantissa) into a Double#
+naturalToDouble# :: Natural -> Double#
+naturalToDouble# !n = naturalEncodeDouble# n 0#
+
+-- | Encode an Natural (mantissa) into a Float#
+naturalToFloat# :: Natural -> Float#
+naturalToFloat# !i = naturalEncodeFloat# i 0#
+
+-- | Encode (# Natural mantissa, Int# exponent #) into a Float#
+--
+-- TODO: Not sure if it's worth to write 'Float' optimized versions here
+naturalEncodeFloat# :: Natural -> Int# -> Float#
+naturalEncodeFloat# !m 0# = double2Float# (naturalToDouble# m)
+naturalEncodeFloat# !m e = double2Float# (naturalEncodeDouble# m e)
+
+-- | Equality test for Natural
+naturalEq# :: Natural -> Natural -> Bool#
+naturalEq# (NS x) (NS y) = x `eqWord#` y
+naturalEq# (NB x) (NB y) = bigNatEq# x y
+naturalEq# _ _ = 0#
+
+-- | Equality test for Natural
+naturalEq :: Natural -> Natural -> Bool
+naturalEq !x !y = isTrue# (naturalEq# x y)
+
+-- | Inequality test for Natural
+naturalNe# :: Natural -> Natural -> Bool#
+naturalNe# (NS x) (NS y) = x `neWord#` y
+naturalNe# (NB x) (NB y) = bigNatNe# x y
+naturalNe# _ _ = 1#
+
+-- | Inequality test for Natural
+naturalNe :: Natural -> Natural -> Bool
+naturalNe !x !y = isTrue# (naturalNe# x y)
+
+-- | Compare two Natural
+naturalCompare :: Natural -> Natural -> Ordering
+naturalCompare (NS x) (NS y) = compare (W# x) (W# y)
+naturalCompare (NB x) (NB y) = bigNatCompare x y
+naturalCompare (NS _) (NB _) = LT
+naturalCompare (NB _) (NS _) = GT
+
+-- | PopCount for Natural
+naturalPopCount# :: Natural -> Word#
+naturalPopCount# (NS x) = popCnt# x
+naturalPopCount# (NB x) = bigNatPopCount# x
+
+-- | PopCount for Natural
+naturalPopCount :: Natural -> Word
+naturalPopCount (NS x) = W# (popCnt# x)
+naturalPopCount (NB x) = bigNatPopCount x
+
+-- | Right shift for Natural
+naturalShiftR# :: Natural -> Word# -> Natural
+naturalShiftR# (NS x) n = NS (x `shiftRW#` n)
+naturalShiftR# (NB x) n = naturalFromBigNat (x `bigNatShiftR#` n)
+
+-- | Right shift for Natural
+naturalShiftR :: Natural -> Word -> Natural
+naturalShiftR x (W# n) = naturalShiftR# x n
+
+-- | Left shift
+naturalShiftL# :: Natural -> Word# -> Natural
+naturalShiftL# (NS x) n
+ | isTrue# (clz# x `geWord#` n) = NS (x `uncheckedShiftL#` word2Int# n)
+ | True = NB (bigNatFromWord# x `bigNatShiftL#` n)
+naturalShiftL# (NB x) n = NB (x `bigNatShiftL#` n)
+
+-- | Left shift
+naturalShiftL :: Natural -> Word -> Natural
+naturalShiftL !x (W# n) = naturalShiftL# x n
+
+-- | Add two naturals
+naturalAdd :: Natural -> Natural -> Natural
+{-# NOINLINE naturalAdd #-}
+naturalAdd (NS x) (NB y) = NB (bigNatAddWord# y x)
+naturalAdd (NB x) (NS y) = NB (bigNatAddWord# x y)
+naturalAdd (NB x) (NB y) = NB (bigNatAdd x y)
+naturalAdd (NS x) (NS y) =
+ case addWordC# x y of
+ (# l,0# #) -> NS l
+ (# l,c #) -> NB (bigNatFromWord2# (int2Word# c) l)
+
+-- | Sub two naturals
+naturalSub :: Natural -> Natural -> (# () | Natural #)
+{-# NOINLINE naturalSub #-}
+naturalSub (NS _) (NB _) = (# () | #)
+naturalSub (NB x) (NS y) = (# | naturalFromBigNat (bigNatSubWordUnsafe# x y) #)
+naturalSub (NS x) (NS y) =
+ case subWordC# x y of
+ (# l,0# #) -> (# | NS l #)
+ (# _,_ #) -> (# () | #)
+naturalSub (NB x) (NB y) =
+ case bigNatSub x y of
+ (# () | #) -> (# () | #)
+ (# | z #) -> (# | naturalFromBigNat z #)
+
+-- | Sub two naturals
+--
+-- Throw an Underflow exception if x < y
+naturalSubThrow :: Natural -> Natural -> Natural
+naturalSubThrow (NS _) (NB _) = case underflow of _ -> NS 0##
+naturalSubThrow (NB x) (NS y) = naturalFromBigNat (bigNatSubWordUnsafe# x y)
+naturalSubThrow (NS x) (NS y) =
+ case subWordC# x y of
+ (# l,0# #) -> NS l
+ (# _,_ #) -> case underflow of _ -> NS 0##
+naturalSubThrow (NB x) (NB y) =
+ case bigNatSub x y of
+ (# () | #) -> case underflow of _ -> NS 0##
+ (# | z #) -> naturalFromBigNat z
+
+-- | Sub two naturals
+--
+-- Unsafe: don't check that x >= y
+-- Undefined results if it happens
+naturalSubUnsafe :: Natural -> Natural -> Natural
+{-# NOINLINE naturalSubUnsafe #-}
+naturalSubUnsafe (NS x) (NS y) = NS (minusWord# x y)
+naturalSubUnsafe (NS _) (NB _) = naturalZero
+naturalSubUnsafe (NB x) (NS y) = naturalFromBigNat (bigNatSubWordUnsafe# x y)
+naturalSubUnsafe (NB x) (NB y) =
+ case bigNatSub x y of
+ (# () | #) -> naturalZero
+ (# | z #) -> naturalFromBigNat z
+
+-- | Multiplication
+naturalMul :: Natural -> Natural -> Natural
+{-# NOINLINE naturalMul #-}
+naturalMul a b = case a of
+ NS 0## -> NS 0##
+ NS 1## -> b
+ NS x -> case b of
+ NS 0## -> NS 0##
+ NS 1## -> a
+ NS y -> case timesWord2# x y of
+ (# h,l #) -> naturalFromWord2# h l
+ NB y -> NB (bigNatMulWord# y x)
+ NB x -> case b of
+ NS 0## -> NS 0##
+ NS 1## -> a
+ NS y -> NB (bigNatMulWord# x y)
+ NB y -> NB (bigNatMul x y)
+
+-- | Square a Natural
+naturalSqr :: Natural -> Natural
+naturalSqr !a = naturalMul a a
+
+-- | Signum for Natural
+naturalSignum :: Natural -> Natural
+naturalSignum (NS 0##) = NS 0##
+naturalSignum _ = NS 1##
+
+-- | Negate for Natural
+naturalNegate :: Natural -> Natural
+{-# NOINLINE naturalNegate #-}
+naturalNegate (NS 0##) = NS 0##
+naturalNegate _ = case underflow of _ -> NS 0##
+
+-- | Return division quotient and remainder
+--
+-- Division by zero is handled by BigNat
+naturalQuotRem# :: Natural -> Natural -> (# Natural, Natural #)
+{-# NOINLINE naturalQuotRem# #-}
+naturalQuotRem# (NS n) (NS d) = case quotRemWord# n d of
+ (# q, r #) -> (# NS q, NS r #)
+naturalQuotRem# (NB n) (NS d) = case bigNatQuotRemWord# n d of
+ (# q, r #) -> (# naturalFromBigNat q, NS r #)
+naturalQuotRem# (NS n) (NB d) = case bigNatQuotRem# (bigNatFromWord# n) d of
+ (# q, r #) -> (# naturalFromBigNat q, naturalFromBigNat r #)
+naturalQuotRem# (NB n) (NB d) = case bigNatQuotRem# n d of
+ (# q, r #) -> (# naturalFromBigNat q, naturalFromBigNat r #)
+
+-- | Return division quotient and remainder
+naturalQuotRem :: Natural -> Natural -> (Natural, Natural)
+naturalQuotRem !n !d = case naturalQuotRem# n d of
+ (# q, r #) -> (q,r)
+
+-- | Return division quotient
+naturalQuot :: Natural -> Natural -> Natural
+{-# NOINLINE naturalQuot #-}
+naturalQuot (NS n) (NS d) = case quotWord# n d of
+ q -> NS q
+naturalQuot (NB n) (NS d) = case bigNatQuotWord# n d of
+ q -> naturalFromBigNat q
+naturalQuot (NS n) (NB d) = case bigNatQuot (bigNatFromWord# n) d of
+ q -> naturalFromBigNat q
+naturalQuot (NB n) (NB d) = case bigNatQuot n d of
+ q -> naturalFromBigNat q
+
+-- | Return division remainder
+naturalRem :: Natural -> Natural -> Natural
+{-# NOINLINE naturalRem #-}
+naturalRem (NS n) (NS d) = case remWord# n d of
+ r -> NS r
+naturalRem (NB n) (NS d) = case bigNatRemWord# n d of
+ r -> NS r
+naturalRem (NS n) (NB d) = case bigNatRem (bigNatFromWord# n) d of
+ r -> naturalFromBigNat r
+naturalRem (NB n) (NB d) = case bigNatRem n d of
+ r -> naturalFromBigNat r
+
+naturalAnd :: Natural -> Natural -> Natural
+naturalAnd (NS n) (NS m) = NS (n `and#` m)
+naturalAnd (NS n) (NB m) = NS (n `and#` bigNatToWord# m)
+naturalAnd (NB n) (NS m) = NS (bigNatToWord# n `and#` m)
+naturalAnd (NB n) (NB m) = naturalFromBigNat (bigNatAnd n m)
+
+naturalAndNot :: Natural -> Natural -> Natural
+naturalAndNot (NS n) (NS m) = NS (n `and#` not# m)
+naturalAndNot (NS n) (NB m) = NS (n `and#` not# (bigNatToWord# m))
+naturalAndNot (NB n) (NS m) = NS (bigNatToWord# n `and#` not# m)
+naturalAndNot (NB n) (NB m) = naturalFromBigNat (bigNatAndNot n m)
+
+naturalOr :: Natural -> Natural -> Natural
+naturalOr (NS n) (NS m) = NS (n `or#` m)
+naturalOr (NS n) (NB m) = NB (bigNatOrWord# m n)
+naturalOr (NB n) (NS m) = NB (bigNatOrWord# n m)
+naturalOr (NB n) (NB m) = NB (bigNatOr n m)
+
+naturalXor :: Natural -> Natural -> Natural
+naturalXor (NS n) (NS m) = NS (n `xor#` m)
+naturalXor (NS n) (NB m) = NB (bigNatXorWord# m n)
+naturalXor (NB n) (NS m) = NB (bigNatXorWord# n m)
+naturalXor (NB n) (NB m) = naturalFromBigNat (bigNatXor n m)
+
+naturalTestBit# :: Natural -> Word# -> Bool#
+naturalTestBit# (NS w) i = (i `ltWord#` WORD_SIZE_IN_BITS##) &&#
+ ((w `and#` (1## `uncheckedShiftL#` word2Int# i)) `neWord#` 0##)
+naturalTestBit# (NB bn) i = bigNatTestBit# bn i
+
+naturalTestBit :: Natural -> Word -> Bool
+naturalTestBit !n (W# i) = isTrue# (naturalTestBit# n i)
+
+naturalBit# :: Word# -> Natural
+naturalBit# i
+ | isTrue# (i `ltWord#` WORD_SIZE_IN_BITS##) = NS (1## `uncheckedShiftL#` word2Int# i)
+ | True = NB (bigNatBit# i)
+
+naturalBit :: Word -> Natural
+naturalBit (W# i) = naturalBit# i
+
+-- | Compute greatest common divisor.
+naturalGcd :: Natural -> Natural -> Natural
+naturalGcd (NS 0##) !y = y
+naturalGcd x (NS 0##) = x
+naturalGcd (NS 1##) _ = NS 1##
+naturalGcd _ (NS 1##) = NS 1##
+naturalGcd (NB x) (NB y) = naturalFromBigNat (bigNatGcd x y)
+naturalGcd (NB x) (NS y) = NS (bigNatGcdWord# x y)
+naturalGcd (NS x) (NB y) = NS (bigNatGcdWord# y x)
+naturalGcd (NS x) (NS y) = NS (gcdWord# x y)
+
+-- | Compute least common multiple.
+naturalLcm :: Natural -> Natural -> Natural
+naturalLcm (NS 0##) !_ = NS 0##
+naturalLcm _ (NS 0##) = NS 0##
+naturalLcm (NS 1##) y = y
+naturalLcm x (NS 1##) = x
+naturalLcm (NS a ) (NS b ) = naturalFromBigNat (bigNatLcmWordWord# a b)
+naturalLcm (NB a ) (NS b ) = naturalFromBigNat (bigNatLcmWord# a b)
+naturalLcm (NS a ) (NB b ) = naturalFromBigNat (bigNatLcmWord# b a)
+naturalLcm (NB a ) (NB b ) = naturalFromBigNat (bigNatLcm a b)
+
+-- | Base 2 logarithm
+naturalLog2# :: Natural -> Word#
+naturalLog2# (NS w) = wordLog2# w
+naturalLog2# (NB b) = bigNatLog2# b
+
+-- | Base 2 logarithm
+naturalLog2 :: Natural -> Word
+naturalLog2 !n = W# (naturalLog2# n)
+
+-- | Logarithm for an arbitrary base
+naturalLogBaseWord# :: Word# -> Natural -> Word#
+naturalLogBaseWord# base (NS a) = wordLogBase# base a
+naturalLogBaseWord# base (NB a) = bigNatLogBaseWord# base a
+
+-- | Logarithm for an arbitrary base
+naturalLogBaseWord :: Word -> Natural -> Word
+naturalLogBaseWord (W# base) !a = W# (naturalLogBaseWord# base a)
+
+-- | Logarithm for an arbitrary base
+naturalLogBase# :: Natural -> Natural -> Word#
+naturalLogBase# (NS base) !a = naturalLogBaseWord# base a
+naturalLogBase# (NB _ ) (NS _) = 0##
+naturalLogBase# (NB base) (NB a) = bigNatLogBase# base a
+
+-- | Logarithm for an arbitrary base
+naturalLogBase :: Natural -> Natural -> Word
+naturalLogBase !base !a = W# (naturalLogBase# base a)
+
+-- | \"@'naturalPowMod' /b/ /e/ /m/@\" computes base @/b/@ raised to
+-- exponent @/e/@ modulo @/m/@.
+naturalPowMod :: Natural -> Natural -> Natural -> Natural
+naturalPowMod !_ !_ (NS 0##) = case divByZero of _ -> naturalZero
+naturalPowMod _ _ (NS 1##) = NS 0##
+naturalPowMod _ (NS 0##) _ = NS 1##
+naturalPowMod (NS 0##) _ _ = NS 0##
+naturalPowMod (NS 1##) _ _ = NS 1##
+naturalPowMod (NS b) (NS e) (NS m) = NS (powModWord# b e m)
+naturalPowMod b e (NS m) = NS (bigNatPowModWord#
+ (naturalToBigNat b)
+ (naturalToBigNat e)
+ m)
+naturalPowMod b e (NB m) = naturalFromBigNat
+ (bigNatPowMod (naturalToBigNat b)
+ (naturalToBigNat e)
+ m)
+
+-- | Compute the number of digits of the Natural in the given base.
+--
+-- `base` must be > 1
+naturalSizeInBase# :: Word# -> Natural -> Word#
+naturalSizeInBase# base (NS w) = wordSizeInBase# base w
+naturalSizeInBase# base (NB n) = bigNatSizeInBase# base n
+
+-- | Write a 'Natural' to @/addr/@ in base-256 representation and return the
+-- number of bytes written.
+--
+-- The endianness is selected with the Bool# parameter: write most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+naturalToAddr# :: Natural -> Addr# -> Bool# -> State# s -> (# State# s, Word# #)
+naturalToAddr# (NS i) = wordToAddr# i
+naturalToAddr# (NB n) = bigNatToAddr# n
+
+-- | Write a 'Natural' to @/addr/@ in base-256 representation and return the
+-- number of bytes written.
+--
+-- The endianness is selected with the Bool# parameter: write most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+naturalToAddr :: Natural -> Addr# -> Bool# -> IO Word
+naturalToAddr a addr e = IO \s -> case naturalToAddr# a addr e s of
+ (# s', w #) -> (# s', W# w #)
+
+
+-- | Read a Natural in base-256 representation from an Addr#.
+--
+-- The size is given in bytes.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- Null higher limbs are automatically trimed.
+naturalFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, Natural #)
+naturalFromAddr# sz addr e s =
+ case bigNatFromAddr# sz addr e s of
+ (# s', n #) -> (# s', naturalFromBigNat n #)
+
+-- | Read a Natural in base-256 representation from an Addr#.
+--
+-- The size is given in bytes.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- Null higher limbs are automatically trimed.
+naturalFromAddr :: Word# -> Addr# -> Bool# -> IO Natural
+naturalFromAddr sz addr e = IO (naturalFromAddr# sz addr e)
+
+
+-- | Write a Natural in base-256 representation and return the
+-- number of bytes written.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+naturalToMutableByteArray# :: Natural -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #)
+naturalToMutableByteArray# (NS w) = wordToMutableByteArray# w
+naturalToMutableByteArray# (NB a) = bigNatToMutableByteArray# a
+
+-- | Read a Natural in base-256 representation from a ByteArray#.
+--
+-- The size is given in bytes.
+--
+-- The endianness is selected with the Bool# parameter: most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- Null higher limbs are automatically trimed.
+naturalFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, Natural #)
+naturalFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of
+ (# s', a #) -> (# s', naturalFromBigNat a #)
diff --git a/libraries/ghc-bignum/src/GHC/Num/Natural.hs-boot b/libraries/ghc-bignum/src/GHC/Num/Natural.hs-boot
new file mode 100644
index 0000000000000000000000000000000000000000..28cf5d17712b8320d7a98c36a41464042ed65331
--- /dev/null
+++ b/libraries/ghc-bignum/src/GHC/Num/Natural.hs-boot
@@ -0,0 +1,23 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE MagicHash #-}
+
+module GHC.Num.Natural where
+
+import {-# SOURCE #-} GHC.Num.BigNat
+import GHC.Num.Primitives
+import GHC.Prim
+import GHC.Types
+
+data Natural
+ = NS !Word#
+ | NB !BigNat
+
+naturalToWord# :: Natural -> Word#
+naturalFromWord# :: Word# -> Natural
+naturalToBigNat :: Natural -> BigNat
+naturalFromBigNat :: BigNat -> Natural
+naturalMul :: Natural -> Natural -> Natural
+naturalRem :: Natural -> Natural -> Natural
+naturalIsZero :: Natural -> Bool
+naturalShiftR# :: Natural -> Word# -> Natural
+naturalTestBit# :: Natural -> Word# -> Bool#
diff --git a/libraries/ghc-bignum/src/GHC/Num/Primitives.hs b/libraries/ghc-bignum/src/GHC/Num/Primitives.hs
new file mode 100644
index 0000000000000000000000000000000000000000..2c1a0b69554c3f441fd0252855edadbb9dbd7b3d
--- /dev/null
+++ b/libraries/ghc-bignum/src/GHC/Num/Primitives.hs
@@ -0,0 +1,623 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE NegativeLiterals #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE BinaryLiterals #-}
+{-# OPTIONS_GHC -fexpose-all-unfoldings #-}
+
+module GHC.Num.Primitives
+ (
+ -- * Bool#
+ Bool#
+ , (&&#)
+ , (||#)
+ , notB#
+ -- * Int#
+ , testBitI#
+ , minI#
+ , maxI#
+ , sgnI#
+ , absI#
+ , cmpI#
+ , intEncodeDouble#
+ , popCntI#
+ -- * Word#
+ , andNot#
+ , cmpW#
+ , bitW#
+ , maxW#
+ , minW#
+ , testBitW#
+ , shiftRW#
+ , plusWord3#
+ , plusWord12#
+ , quotRemWord3#
+ , wordFromAbsInt#
+ , wordLog2#
+ , wordLogBase#
+ , wordSizeInBase#
+ , wordIsPowerOf2#
+ , wordEncodeDouble#
+ , wordReverseBits#
+ , wordReverseBits32#
+ , wordReverseBytes#
+ -- ** Addr import/export
+ , wordFromAddr#
+ , wordFromAddrLE#
+ , wordFromAddrBE#
+ , wordToAddr#
+ , wordToAddrLE#
+ , wordToAddrBE#
+ , wordWriteAddrLE#
+ , wordWriteAddrBE#
+ -- ** ByteArray import/export
+ , wordFromByteArray#
+ , wordFromByteArrayLE#
+ , wordFromByteArrayBE#
+ , wordToMutableByteArray#
+ , wordToMutableByteArrayLE#
+ , wordToMutableByteArrayBE#
+ , wordWriteMutableByteArrayLE#
+ , wordWriteMutableByteArrayBE#
+ -- * Exception
+ , underflow
+ , divByZero
+ , unexpectedValue
+ -- * IO
+ , ioWord#
+ , ioInt#
+ , ioVoid
+ , ioBool
+ )
+where
+
+#include "MachDeps.h"
+#include "WordSize.h"
+
+-- Required for WORDS_BIGENDIAN
+#include <ghcautoconf.h>
+
+#if (__GLASGOW_HASKELL__ < 811)
+import GHC.Magic
+#endif
+
+import GHC.Prim
+import GHC.Types
+import GHC.Tuple () -- See Note [Depend on GHC.Tuple] in GHC.Base
+
+default ()
+
+----------------------------------
+-- Bool#
+----------------------------------
+
+type Bool# = Int#
+
+(&&#) :: Bool# -> Bool# -> Bool#
+(&&#) = andI#
+
+(||#) :: Bool# -> Bool# -> Bool#
+(||#) = orI#
+
+notB# :: Bool# -> Bool#
+notB# x = x `xorI#` 1#
+
+infixr 3 &&#
+infixr 2 ||#
+
+
+----------------------------------
+-- Int#
+----------------------------------
+
+-- | Branchless `abs`
+absI# :: Int# -> Int#
+absI# i# = (i# `xorI#` nsign) -# nsign
+ where
+ -- nsign = negateInt# (i# <# 0#)
+ nsign = uncheckedIShiftRA# i# (WORD_SIZE_IN_BITS# -# 1#)
+
+-- | Branchless `signum`
+sgnI# :: Int# -> Int#
+sgnI# x# = (x# ># 0#) -# (x# <# 0#)
+
+-- | Population count
+popCntI# :: Int# -> Word#
+popCntI# i = popCnt# (int2Word# i)
+
+-- | Branchless comparison
+cmpI# :: Int# -> Int# -> Int#
+cmpI# x# y# = (x# ># y#) -# (x# <# y#)
+
+testBitI# :: Int# -> Word# -> Bool#
+testBitI# x i = ((uncheckedIShiftL# 1# (word2Int# i)) `andI#` x) /=# 0#
+
+minI# :: Int# -> Int# -> Int#
+minI# x y | isTrue# (x <=# y) = x
+ | True = y
+
+maxI# :: Int# -> Int# -> Int#
+maxI# x y | isTrue# (x >=# y) = x
+ | True = y
+
+-- | Encode (# Int# mantissa, Int# exponent #) into a Double#.
+--
+-- (provided by GHC's RTS)
+foreign import ccall unsafe "__int_encodeDouble"
+ intEncodeDouble# :: Int# -> Int# -> Double#
+
+----------------------------------
+-- Word#
+----------------------------------
+
+andNot# :: Word# -> Word# -> Word#
+andNot# x y = x `and#` (not# y)
+
+cmpW# :: Word# -> Word# -> Ordering
+{-# INLINE cmpW# #-}
+cmpW# x# y#
+ | isTrue# (x# `ltWord#` y#) = LT
+ | isTrue# (x# `eqWord#` y#) = EQ
+ | True = GT
+
+-- | Return the absolute value of the Int# in a Word#
+wordFromAbsInt# :: Int# -> Word#
+wordFromAbsInt# i
+ | isTrue# (i >=# 0#) = int2Word# i
+ | True = int2Word# (negateInt# i)
+
+minW# :: Word# -> Word# -> Word#
+minW# x# y# | isTrue# (x# `leWord#` y#) = x#
+ | True = y#
+
+maxW# :: Word# -> Word# -> Word#
+maxW# x# y# | isTrue# (x# `gtWord#` y#) = x#
+ | True = y#
+
+bitW# :: Int# -> Word#
+bitW# k = 1## `uncheckedShiftL#` k
+
+testBitW# :: Word# -> Word# -> Bool#
+testBitW# w k = w `and#` (1## `uncheckedShiftL#` word2Int# k) `neWord#` 0##
+
+-- | Safe right shift for Word#
+shiftRW# :: Word# -> Word# -> Word#
+shiftRW# a b
+ | isTrue# (b `geWord#` WORD_SIZE_IN_BITS##) = 0##
+ | True = a `uncheckedShiftRL#` (word2Int# b)
+
+-- | (h,l) <- a + (hb,lb)
+plusWord12# :: Word# -> (# Word#,Word# #) -> (# Word#,Word# #)
+{-# INLINABLE plusWord12# #-}
+plusWord12# a0 (# b1,b0 #) = (# m1, m0 #)
+ where
+ !(# t, m0 #) = plusWord2# a0 b0
+ !m1 = plusWord# t b1
+
+-- | Add 3 values together
+plusWord3# :: Word# -> Word# -> Word# -> (# Word#, Word# #)
+{-# INLINABLE plusWord3# #-}
+plusWord3# a b c = (# r1, r0 #)
+ where
+ !(# t1, t0 #) = plusWord2# a b
+ !(# t2, r0 #) = plusWord2# t0 c
+ !r1 = plusWord# t1 t2
+
+
+-- | 2-by-1 large division
+--
+-- Requires:
+-- b0 /= 0
+-- a1 >= b0 (not required, but if not q1=0)
+quotRemWord3# :: (# Word#,Word# #) -> Word# -> (# (# Word#,Word# #),Word# #)
+quotRemWord3# (# a1,a0 #) b0 = (# (# q1, q0 #), r0 #)
+ where
+ !(# q1, r' #) = quotRemWord# a1 b0
+ !(# q0, r0 #) = quotRemWord2# r' a0 b0
+
+
+
+-- | Encode (# Word# mantissa, Int# exponent #) into a Double#.
+--
+-- (provided by GHC's RTS)
+foreign import ccall unsafe "__word_encodeDouble"
+ wordEncodeDouble# :: Word# -> Int# -> Double#
+
+-- | Compute base-2 log of 'Word#'
+--
+-- This is internally implemented as count-leading-zeros machine instruction.
+wordLog2# :: Word# -> Word#
+wordLog2# w = (WORD_SIZE_IN_BITS## `minusWord#` 1##) `minusWord#` (clz# w)
+
+-- | Logarithm for an arbitrary base
+wordLogBase# :: Word# -> Word# -> Word#
+wordLogBase# base a
+ | isTrue# (base `leWord#` 1##)
+ = case unexpectedValue of _ -> 0##
+
+ | 2## <- base
+ = wordLog2# a
+
+ | True
+ = case go base of (# _, e' #) -> e'
+ where
+ goSqr pw = case timesWord2# pw pw of
+ (# 0##, l #) -> go l
+ (# _ , _ #) -> (# a, 0## #)
+ go pw = if isTrue# (a `ltWord#` pw)
+ then (# a, 0## #)
+ else case goSqr pw of
+ (# q, e #) -> if isTrue# (q `ltWord#` pw)
+ then (# q, 2## `timesWord#` e #)
+ else (# q `quotWord#` pw
+ , 2## `timesWord#` e `plusWord#` 1## #)
+
+wordSizeInBase# :: Word# -> Word# -> Word#
+wordSizeInBase# _ 0## = 0##
+wordSizeInBase# base w = 1## `plusWord#` wordLogBase# base w
+
+-- | Indicate if the value is a power of two and which one
+wordIsPowerOf2# :: Word# -> (# () | Word# #)
+wordIsPowerOf2# w
+ | isTrue# (popCnt# w `neWord#` 1##) = (# () | #)
+ | True = (# | ctz# w #)
+
+-- | Reverse bytes in a Word#
+wordReverseBytes# :: Word# -> Word#
+wordReverseBytes# x0 = r
+ where
+#if WORD_SIZE_IN_BITS == 64
+ x1 = ((x0 `and#` 0x00FF00FF00FF00FF##) `uncheckedShiftL#` 8#) `or#` ((x0 `and#` 0xFF00FF00FF00FF00##) `uncheckedShiftRL#` 8#)
+ x2 = ((x1 `and#` 0x0000FFFF0000FFFF##) `uncheckedShiftL#` 16#) `or#` ((x1 `and#` 0xFFFF0000FFFF0000##) `uncheckedShiftRL#` 16#)
+ r = ((x2 `and#` 0x00000000FFFFFFFF##) `uncheckedShiftL#` 32#) `or#` ((x2 `and#` 0xFFFFFFFF00000000##) `uncheckedShiftRL#` 32#)
+#else
+ x1 = ((x0 `and#` 0x00FF00FF##) `uncheckedShiftL#` 8#) `or#` ((x0 `and#` 0xFF00FF00##) `uncheckedShiftRL#` 8#)
+ r = ((x1 `and#` 0x0000FFFF##) `uncheckedShiftL#` 16#) `or#` ((x1 `and#` 0xFFFF0000##) `uncheckedShiftRL#` 16#)
+#endif
+
+
+-- | Reverse bits in a Word#
+wordReverseBits# :: Word# -> Word#
+wordReverseBits# x0 = r
+ where
+#if WORD_SIZE_IN_BITS == 64
+ x1 = ((x0 `and#` 0x5555555555555555##) `uncheckedShiftL#` 1#) `or#` ((x0 `and#` 0xAAAAAAAAAAAAAAAA##) `uncheckedShiftRL#` 1#)
+ x2 = ((x1 `and#` 0x3333333333333333##) `uncheckedShiftL#` 2#) `or#` ((x1 `and#` 0xCCCCCCCCCCCCCCCC##) `uncheckedShiftRL#` 2#)
+ x3 = ((x2 `and#` 0x0F0F0F0F0F0F0F0F##) `uncheckedShiftL#` 4#) `or#` ((x2 `and#` 0xF0F0F0F0F0F0F0F0##) `uncheckedShiftRL#` 4#)
+ x4 = ((x3 `and#` 0x00FF00FF00FF00FF##) `uncheckedShiftL#` 8#) `or#` ((x3 `and#` 0xFF00FF00FF00FF00##) `uncheckedShiftRL#` 8#)
+ x5 = ((x4 `and#` 0x0000FFFF0000FFFF##) `uncheckedShiftL#` 16#) `or#` ((x4 `and#` 0xFFFF0000FFFF0000##) `uncheckedShiftRL#` 16#)
+ r = ((x5 `and#` 0x00000000FFFFFFFF##) `uncheckedShiftL#` 32#) `or#` ((x5 `and#` 0xFFFFFFFF00000000##) `uncheckedShiftRL#` 32#)
+#else
+ x1 = ((x0 `and#` 0x55555555##) `uncheckedShiftL#` 1#) `or#` ((x0 `and#` 0xAAAAAAAA##) `uncheckedShiftRL#` 1#)
+ x2 = ((x1 `and#` 0x33333333##) `uncheckedShiftL#` 2#) `or#` ((x1 `and#` 0xCCCCCCCC##) `uncheckedShiftRL#` 2#)
+ x3 = ((x2 `and#` 0x0F0F0F0F##) `uncheckedShiftL#` 4#) `or#` ((x2 `and#` 0xF0F0F0F0##) `uncheckedShiftRL#` 4#)
+ x4 = ((x3 `and#` 0x00FF00FF##) `uncheckedShiftL#` 8#) `or#` ((x3 `and#` 0xFF00FF00##) `uncheckedShiftRL#` 8#)
+ r = ((x4 `and#` 0x0000FFFF##) `uncheckedShiftL#` 16#) `or#` ((x4 `and#` 0xFFFF0000##) `uncheckedShiftRL#` 16#)
+#endif
+
+-- | Reverse bits in the Word32 subwords composing a Word#
+wordReverseBits32# :: Word# -> Word#
+#if WORD_SIZE_IN_BITS == 64
+wordReverseBits32# x0 = r
+ where
+ x1 = ((x0 `and#` 0x5555555555555555##) `uncheckedShiftL#` 1#) `or#` ((x0 `and#` 0xAAAAAAAAAAAAAAAA##) `uncheckedShiftRL#` 1#)
+ x2 = ((x1 `and#` 0x3333333333333333##) `uncheckedShiftL#` 2#) `or#` ((x1 `and#` 0xCCCCCCCCCCCCCCCC##) `uncheckedShiftRL#` 2#)
+ x3 = ((x2 `and#` 0x0F0F0F0F0F0F0F0F##) `uncheckedShiftL#` 4#) `or#` ((x2 `and#` 0xF0F0F0F0F0F0F0F0##) `uncheckedShiftRL#` 4#)
+ x4 = ((x3 `and#` 0x00FF00FF00FF00FF##) `uncheckedShiftL#` 8#) `or#` ((x3 `and#` 0xFF00FF00FF00FF00##) `uncheckedShiftRL#` 8#)
+ r = ((x4 `and#` 0x0000FFFF0000FFFF##) `uncheckedShiftL#` 16#) `or#` ((x4 `and#` 0xFFFF0000FFFF0000##) `uncheckedShiftRL#` 16#)
+#else
+wordReverseBits32# x0 = wordReverseBits# x0
+#endif
+
+
+-- | Write a Word to @/addr/@ in base-256 little-endian representation and
+-- return the number of bytes written.
+wordToAddrLE# :: Word# -> Addr# -> State# s -> (# State# s, Word# #)
+wordToAddrLE# x addr = go x 0#
+ where
+ go w c s
+ | 0## <- w
+ = (# s, int2Word# c #)
+
+ | True
+ = case writeWord8OffAddr# addr c (w `and#` 0xFF##) s of
+ s' -> go (w `uncheckedShiftRL#` 8#) (c +# 1#) s'
+
+-- | Write a Word to @/addr/@ in base-256 big-endian representation and
+-- return the number of bytes written.
+wordToAddrBE# :: Word# -> Addr# -> State# s -> (# State# s, Word# #)
+wordToAddrBE# w addr = go 0# (WORD_SIZE_IN_BITS# -# clz)
+ where
+ !clz = word2Int# (clz# w `and#` (not# 0b0111##)) -- keep complete bytes
+
+ go c sh s
+ | 0# <- sh
+ = (# s, int2Word# c #)
+
+ | True
+ , w' <- (w `uncheckedShiftRL#` (sh -# 8#)) `and#` 0xFF##
+ = case writeWord8OffAddr# addr c w' s of
+ s' -> go (c +# 1#) (sh -# 8#) s'
+
+-- | Write a Word to @/addr/@ in base-256 representation and
+-- return the number of bytes written.
+--
+-- The endianness is selected with the Bool# parameter: write most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+wordToAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, Word# #)
+wordToAddr# a addr 0# s = wordToAddrLE# a addr s
+wordToAddr# a addr _ s = wordToAddrBE# a addr s
+
+
+-- | Read a Word from @/addr/@ in base-256 little-endian representation.
+--
+-- @'n' is the number of bytes to read.
+wordFromAddrLE# :: Word# -> Addr# -> State# s -> (# State# s, Word# #)
+wordFromAddrLE# n addr s
+ -- Optimize when we read a full word
+ | WORD_SIZE_IN_BYTES## <- n
+ = case readWordOffAddr# addr 0# s of
+#if defined(WORDS_BIGENDIAN)
+ (# s', w #) -> (# s', wordReverseBytes# w #)
+#else
+ (# s', w #) -> (# s', w #)
+#endif
+
+wordFromAddrLE# n addr s0 = go 0## 0# s0
+ where
+ go w c s
+ | isTrue# (c ==# word2Int# n)
+ = (# s, w #)
+
+ | True
+ = case readWord8OffAddr# addr c s of
+ (# s', b #) -> go (w `or#` (b `uncheckedShiftL#` (c `uncheckedIShiftL#` 3#)))
+ (c +# 1#)
+ s'
+
+-- | Read a Word from @/addr/@ in base-256 big-endian representation.
+--
+-- @'n' is the number of bytes to read.
+wordFromAddrBE# :: Word# -> Addr# -> State# s -> (# State# s, Word# #)
+wordFromAddrBE# n addr s
+ -- Optimize when we read a full word
+ | WORD_SIZE_IN_BYTES## <- n
+ = case readWordOffAddr# addr 0# s of
+#if defined(WORDS_BIGENDIAN)
+ (# s', w #) -> (# s', w #)
+#else
+ (# s', w #) -> (# s', wordReverseBytes# w #)
+#endif
+
+wordFromAddrBE# n addr s0 = go 0## 0# s0
+ where
+ go w c s
+ | isTrue# (c ==# word2Int# n)
+ = (# s, w #)
+
+ | True
+ = case readWord8OffAddr# addr c s of
+ (# s', b #) -> go ((w `uncheckedShiftL#` 8#) `or#` b)
+ (c +# 1#)
+ s'
+
+-- | Read a Word from @/addr/@ in base-256 representation.
+--
+-- @'n' is the number of bytes to read.
+--
+-- The endianness is selected with the Bool# parameter: write most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+wordFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, Word# #)
+wordFromAddr# a addr 0# s = wordFromAddrLE# a addr s
+wordFromAddr# a addr _ s = wordFromAddrBE# a addr s
+
+
+
+-- | Write a full word with little-endian encoding
+wordWriteAddrLE# :: Word# -> Addr# -> State# s -> State# s
+wordWriteAddrLE# w addr = writeWordOffAddr# addr 0#
+#if defined(WORDS_BIGENDIAN)
+ (wordReverseBytes# w)
+#else
+ w
+#endif
+
+-- | Write a full word with little-endian encoding
+wordWriteAddrBE# :: Word# -> Addr# -> State# s -> State# s
+wordWriteAddrBE# w addr = writeWordOffAddr# addr 0#
+#if defined(WORDS_BIGENDIAN)
+ w
+#else
+ (wordReverseBytes# w)
+#endif
+
+-- | Write a Word to @/MutableByteArray/@ in base-256 little-endian
+-- representation and return the number of bytes written.
+--
+-- The offset is in bytes.
+wordToMutableByteArrayLE# :: Word# -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #)
+wordToMutableByteArrayLE# x mba off = go x 0#
+ where
+ go w c s
+ | 0## <- w
+ = (# s, int2Word# c #)
+
+ | True
+ = case writeWord8Array# mba (word2Int# off +# c) (w `and#` 0xFF##) s of
+ s' -> go (w `uncheckedShiftRL#` 8#) (c +# 1#) s'
+
+-- | Write a Word to @/MutableByteArray/@ in base-256 big-endian representation and
+-- return the number of bytes written.
+--
+-- The offset is in bytes.
+wordToMutableByteArrayBE# :: Word# -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #)
+wordToMutableByteArrayBE# w mba off = go 0# (WORD_SIZE_IN_BITS# -# clz)
+ where
+ !clz = word2Int# (clz# w `and#` (not# 0b0111##)) -- keep complete bytes
+
+ go c sh s
+ | 0# <- sh
+ = (# s, int2Word# c #)
+
+ | True
+ , w' <- (w `uncheckedShiftRL#` (sh -# 8#)) `and#` 0xFF##
+ = case writeWord8Array# mba (word2Int# off +# c) w' s of
+ s' -> go (c +# 1#) (sh -# 8#) s'
+
+-- | Write a Word to @/MutableByteArray/@ in base-256 representation and
+-- return the number of bytes written.
+--
+-- The endianness is selected with the Bool# parameter: write most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+--
+-- The offset is in bytes.
+wordToMutableByteArray# :: Word# -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #)
+wordToMutableByteArray# a mba off 0# s = wordToMutableByteArrayLE# a mba off s
+wordToMutableByteArray# a mba off _ s = wordToMutableByteArrayBE# a mba off s
+
+-- | Write a full word with little-endian encoding
+wordWriteMutableByteArrayLE# :: Word# -> MutableByteArray# s -> Word# -> State# s -> State# s
+wordWriteMutableByteArrayLE# w mba off = writeWord8ArrayAsWord# mba (word2Int# off)
+#if defined(WORDS_BIGENDIAN)
+ (wordReverseBytes# w)
+#else
+ w
+#endif
+
+-- | Write a full word with little-endian encoding
+wordWriteMutableByteArrayBE# :: Word# -> MutableByteArray# s -> Word# -> State# s -> State# s
+wordWriteMutableByteArrayBE# w mba off = writeWord8ArrayAsWord# mba (word2Int# off)
+#if defined(WORDS_BIGENDIAN)
+ w
+#else
+ (wordReverseBytes# w)
+#endif
+
+-- | Read a Word from @/ByteArray/@ in base-256 little-endian representation.
+--
+-- @'n' is the number of bytes to read.
+wordFromByteArrayLE# :: Word# -> ByteArray# -> Word# -> Word#
+wordFromByteArrayLE# n ba off =
+ case n of
+ -- Optimize when we read a full word
+ WORD_SIZE_IN_BYTES## -> case indexWord8ArrayAsWord# ba (word2Int# off) of
+#if defined(WORDS_BIGENDIAN)
+ w -> wordReverseBytes# w
+#else
+ w -> w
+#endif
+
+ _ -> let
+ go w c
+ | isTrue# (c ==# word2Int# n)
+ = w
+
+ | True
+ = case indexWord8Array# ba (word2Int# off +# c) of
+ b -> go (w `or#` (b `uncheckedShiftL#` (c `uncheckedIShiftL#` 3#)))
+ (c +# 1#)
+ in go 0## 0#
+
+-- | Read a Word from @/ByteArray/@ in base-256 big-endian representation.
+--
+-- @'n' is the number of bytes to read.
+wordFromByteArrayBE# :: Word# -> ByteArray# -> Word# -> Word#
+wordFromByteArrayBE# n ba off
+ -- Optimize when we read a full word
+ | WORD_SIZE_IN_BYTES## <- n
+ = case indexWord8ArrayAsWord# ba (word2Int# off) of
+#if defined(WORDS_BIGENDIAN)
+ w -> w
+#else
+ w -> wordReverseBytes# w
+#endif
+
+wordFromByteArrayBE# n ba off = go 0## 0#
+ where
+ go w c
+ | isTrue# (c ==# word2Int# n)
+ = w
+
+ | True
+ = case indexWord8Array# ba (word2Int# off +# c) of
+ b -> go ((w `uncheckedShiftL#` 8#) `or#` b) (c +# 1#)
+
+-- | Read a Word from @/ByteArray/@ in base-256 representation.
+--
+-- @'n' is the number of bytes to read.
+--
+-- The endianness is selected with the Bool# parameter: write most significant
+-- byte first (big-endian) if @1#@ or least significant byte first
+-- (little-endian) if @0#@.
+wordFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> Word#
+wordFromByteArray# a ba off 0# = wordFromByteArrayLE# a ba off
+wordFromByteArray# a ba off _ = wordFromByteArrayBE# a ba off
+
+----------------------------------
+-- IO
+----------------------------------
+
+ioVoid :: IO a -> State# RealWorld -> State# RealWorld
+ioVoid (IO io) s = case io s of
+ (# s', _ #) -> s'
+
+ioWord# :: IO Word -> State# RealWorld -> (# State# RealWorld, Word# #)
+ioWord# (IO io) s = case io s of
+ (# s', W# w #) -> (# s', w #)
+
+ioInt# :: IO Int -> State# RealWorld -> (# State# RealWorld, Int# #)
+ioInt# (IO io) s = case io s of
+ (# s', I# i #) -> (# s', i #)
+
+ioBool :: IO Bool -> State# RealWorld -> (# State# RealWorld, Bool# #)
+ioBool (IO io) s = case io s of
+ (# s', False #) -> (# s', 0# #)
+ (# s', True #) -> (# s', 1# #)
+
+
+----------------------------------
+-- Exception
+----------------------------------
+
+#if (__GLASGOW_HASKELL__ >= 811)
+
+underflow :: a
+underflow = raiseUnderflow# void#
+
+divByZero :: a
+divByZero = raiseDivZero# void#
+
+unexpectedValue :: a
+unexpectedValue = raiseOverflow# void#
+
+#else
+
+-- Before GHC 8.11 we use the exception trick taken from #14664
+exception :: a
+exception = runRW# \s ->
+ case atomicLoop s of
+ (# _, a #) -> a
+ where
+ atomicLoop s = atomically# atomicLoop s
+
+underflow :: a
+underflow = exception
+
+divByZero :: a
+divByZero = exception
+
+unexpectedValue :: a
+unexpectedValue = exception
+
+#endif
diff --git a/libraries/ghc-bignum/src/GHC/Num/WordArray.hs b/libraries/ghc-bignum/src/GHC/Num/WordArray.hs
new file mode 100644
index 0000000000000000000000000000000000000000..78c450b55ea31a0c38522e9e0acf2c108787db16
--- /dev/null
+++ b/libraries/ghc-bignum/src/GHC/Num/WordArray.hs
@@ -0,0 +1,432 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
+module GHC.Num.WordArray where
+
+import GHC.Prim
+import GHC.Magic
+import GHC.Types
+import GHC.Num.Primitives
+
+#include "MachDeps.h"
+#include "WordSize.h"
+
+default ()
+
+-- | Unlifted array of Word
+type WordArray# = ByteArray#
+type MutableWordArray# = MutableByteArray#
+
+data WordArray = WordArray WordArray#
+data MutableWordArray s = MutableWordArray (MutableWordArray# s)
+
+-- | Convert limb count into byte count
+wordsToBytes# :: Int# -> Int#
+wordsToBytes# i = i `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#
+
+-- | Convert byte count into limb count
+bytesToWords# :: Int# -> Int#
+bytesToWords# i = i `uncheckedIShiftRL#` WORD_SIZE_BYTES_SHIFT#
+
+
+-- | Create a new WordArray# of the given size (*in Word#*) and apply the
+-- action to it before returning it frozen
+withNewWordArray#
+ :: Int# -- ^ Size in Word
+ -> (MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld)
+ -> WordArray#
+withNewWordArray# sz act = case runRW# io of (# _, a #) -> a
+ where
+ io s =
+ case newWordArray# sz s of { (# s, mwa #) ->
+ case act mwa s of { s ->
+ unsafeFreezeByteArray# mwa s
+ }}
+
+-- | Create two new WordArray# of the given sizes (*in Word#*) and apply the
+-- action to them before returning them frozen
+withNewWordArray2#
+ :: Int# -- ^ Size in Word
+ -> Int# -- ^ Ditto
+ -> (MutableWordArray# RealWorld
+ -> MutableWordArray# RealWorld
+ -> State# RealWorld
+ -> State# RealWorld)
+ -> (# WordArray#, WordArray# #)
+withNewWordArray2# sz1 sz2 act = case runRW# io of (# _, a #) -> a
+ where
+ io s =
+ case newWordArray# sz1 s of { (# s, mwa1 #) ->
+ case newWordArray# sz2 s of { (# s, mwa2 #) ->
+ case act mwa1 mwa2 s of { s ->
+ case unsafeFreezeByteArray# mwa1 s of { (# s, wa1 #) ->
+ case unsafeFreezeByteArray# mwa2 s of { (# s, wa2 #) ->
+ (# s, (# wa1, wa2 #) #)
+ }}}}}
+
+-- | Create a new WordArray#
+newWordArray# :: Int# -> State# s -> (# State# s, MutableWordArray# s #)
+newWordArray# sz s = newByteArray# (wordsToBytes# sz) s
+
+-- | Create a new WordArray# of the given size (*in Word#*), apply the action to
+-- it, trim its most significant zeroes, then return it frozen
+withNewWordArrayTrimed#
+ :: Int# -- ^ Size in Word
+ -> (MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld)
+ -> WordArray#
+withNewWordArrayTrimed# sz act = withNewWordArray# sz \mwa s ->
+ case act mwa s of
+ s' -> mwaTrimZeroes# mwa s'
+
+-- | Create two new WordArray# of the given sizes (*in Word#*), apply the action
+-- to them, trim their most significant zeroes, then return them frozen
+withNewWordArray2Trimed#
+ :: Int# -- ^ Size in Word
+ -> Int# -- ^ Ditto
+ -> (MutableWordArray# RealWorld
+ -> MutableWordArray# RealWorld
+ -> State# RealWorld
+ -> State# RealWorld)
+ -> (# WordArray#, WordArray# #)
+withNewWordArray2Trimed# sz1 sz2 act = withNewWordArray2# sz1 sz2 \mwa1 mwa2 s ->
+ case act mwa1 mwa2 s of
+ s' -> case mwaTrimZeroes# mwa1 s' of
+ s'' -> mwaTrimZeroes# mwa2 s''
+
+-- | Create a new WordArray# of the given size (*in Word#*), apply the action to
+-- it. If the action returns true#, trim its most significant zeroes, then
+-- return it frozen. Otherwise, return ().
+withNewWordArrayTrimedMaybe#
+ :: Int# -- ^ Size in Word
+ -> (MutableWordArray# RealWorld -> State# RealWorld -> (# State# RealWorld, Bool# #))
+ -> (# () | WordArray# #)
+withNewWordArrayTrimedMaybe# sz act = case runRW# io of (# _, a #) -> a
+ where
+ io s =
+ case newWordArray# sz s of
+ (# s, mwa #) -> case act mwa s of
+ (# s, 0# #) -> (# s, (# () | #) #)
+ (# s, _ #) -> case mwaTrimZeroes# mwa s of
+ s -> case unsafeFreezeByteArray# mwa s of
+ (# s, ba #) -> (# s, (# | ba #) #)
+
+-- | Create a WordArray# from two Word#
+--
+-- `byteArrayFromWord2# msw lsw = lsw:msw`
+wordArrayFromWord2# :: Word# -> Word# -> WordArray#
+wordArrayFromWord2# msw lsw =
+ withNewWordArray# 2# \mwa s ->
+ case mwaWrite# mwa 0# lsw s of
+ s -> mwaWrite# mwa 1# msw s
+
+-- | Create a WordArray# from one Word#
+wordArrayFromWord# :: Word# -> WordArray#
+wordArrayFromWord# w =
+ withNewWordArray# 1# \mwa s ->
+ mwaWrite# mwa 0# w s
+
+-- | Word array size
+wordArraySize# :: WordArray# -> Int#
+wordArraySize# ba = bytesToWords# (sizeofByteArray# ba)
+
+
+-- | Equality test for WordArray#
+
+-- | Get size in Words
+mwaSize# :: MutableWordArray# s-> State# s -> (# State# s, Int# #)
+mwaSize# mba s = case getSizeofMutableByteArray# mba s of
+ (# s2, sz #) -> (# s2, bytesToWords# sz #)
+
+-- | Get the last Word (must be non empty!)
+wordArrayLast# :: WordArray# -> Word#
+wordArrayLast# a = indexWordArray# a (wordArraySize# a -# 1#)
+
+-- | Copy Words from a WordArray
+--
+-- Don't do anything if the number of words to copy is <= 0
+mwaArrayCopy# :: MutableByteArray# s -> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
+mwaArrayCopy# dst dstIdx src srcIdx n s
+ | isTrue# (n <=# 0#) = s
+ | True = copyByteArray#
+ src (wordsToBytes# srcIdx)
+ dst (wordsToBytes# dstIdx)
+ (wordsToBytes# n) s
+
+-- | Shrink last words of a WordArray
+mwaShrink# :: MutableByteArray# s -> Int# -> State# s -> State# s
+mwaShrink# _mwa 0# s = s
+mwaShrink# mwa i s =
+ case mwaSize# mwa s of
+ (# s, n #) -> shrinkMutableByteArray# mwa (wordsToBytes# (n -# i)) s
+
+-- | Set size
+mwaSetSize# :: MutableByteArray# s -> Int# -> State# s -> State# s
+mwaSetSize# mwa n s = shrinkMutableByteArray# mwa (wordsToBytes# n) s
+
+-- | Copy the WordArray into the MWA and shrink the size of MWA to the one of
+-- the WordArray
+mwaInitCopyShrink# :: MutableByteArray# s -> WordArray# -> State# s -> State# s
+mwaInitCopyShrink# mwa wa s =
+ case mwaArrayCopy# mwa 0# wa 0# (wordArraySize# wa) s of
+ s -> mwaSetSize# mwa (wordArraySize# wa) s
+
+-- | Trim ending zeroes
+mwaTrimZeroes# :: MutableByteArray# s -> State# s -> State# s
+mwaTrimZeroes# mwa s1 =
+ case mwaClz mwa s1 of
+ (# s2, 0# #) -> s2
+ (# s2, c #) -> mwaShrink# mwa c s2
+
+-- | Count leading zero Words
+mwaClz :: MutableWordArray# s -> State# s -> (# State# s, Int# #)
+mwaClz mwa s1 = case mwaSize# mwa s1 of
+ (# s2,sz #) -> mwaClzAt mwa (sz -# 1#) s2
+
+-- | Count leading zero Words starting at given position
+mwaClzAt :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Int# #)
+mwaClzAt mwa = go 0#
+ where
+ go c i s
+ | isTrue# (i <# 0#) = (# s, c #)
+ | True = case readWordArray# mwa i s of
+ (# s', 0## #) -> go (c +# 1#) (i -# 1#) s'
+ (# s', _ #) -> (# s', c #)
+
+-- | Count leading zero Words starting at given position
+waClzAt :: WordArray# -> Int# -> Int#
+waClzAt wa = go 0#
+ where
+ go c i
+ | isTrue# (i <# 0#)
+ = c
+
+ | 0## <- indexWordArray# wa i
+ = go (c +# 1#) (i -# 1#)
+
+ | True
+ = c
+
+-- | Compare the most signiciant limbs of a and b. The comparison stops (i.e.
+-- returns EQ) when there isn't enough lims in a or b to perform another
+-- comparison.
+wordArrayCompareMSWords :: WordArray# -> WordArray# -> Ordering
+wordArrayCompareMSWords wa wb
+ | 0# <- szA
+ , 0# <- szB
+ = EQ
+
+ | 0# <- szA
+ = LT
+
+ | 0# <- szB
+ = GT
+
+ | True
+ = go (szA -# 1#) (szB -# 1#)
+ where
+ szA = wordArraySize# wa
+ szB = wordArraySize# wb
+
+ go i j
+ | isTrue# (i <# 0#) = EQ
+ | isTrue# (j <# 0#) = EQ
+ | True =
+ let
+ a = indexWordArray# wa i
+ b = indexWordArray# wb j
+ in if | isTrue# (a `gtWord#` b) -> GT
+ | isTrue# (b `gtWord#` a) -> LT
+ | True -> go (i -# 1#) (j -# 1#)
+
+
+-- | Compute MutableWordArray <- WordArray + Word
+--
+-- The MutableWordArray may not be initialized and will be erased anyway.
+--
+-- Input: Size(MutableWordArray) = Size(WordArray) + 1
+-- Output: Size(MutableWordArray) = Size(WordArray) [+ 1]
+mwaInitArrayPlusWord :: MutableWordArray# s -> WordArray# -> Word# -> State# s -> State#s
+mwaInitArrayPlusWord mwa wa = go 0#
+ where
+ sz = wordArraySize# wa
+ go i carry s
+ | isTrue# (i ># sz) = s
+ | isTrue# (i ==# sz) = mwaWriteOrShrink mwa carry i s
+ | 0## <- carry = -- copy higher remaining words and shrink the mwa
+ case mwaArrayCopy# mwa i wa i (sz -# i) s of
+ s2 -> mwaShrink# mwa 1# s2
+ | True = let !(# l,c #) = addWordC# (indexWordArray# wa i) carry
+ in case mwaWrite# mwa i l s of
+ s2 -> go (i +# 1#) (int2Word# c) s2
+
+-- | Write the most-significant Word:
+-- * if it is 0: shrink the array of 1 Word
+-- * otherwise: write it
+mwaWriteOrShrink :: MutableWordArray# s -> Word# -> Int# -> State# s -> State# s
+mwaWriteOrShrink mwa 0## _i s = mwaShrink# mwa 1# s
+mwaWriteOrShrink mwa w i s = mwaWrite# mwa i w s
+
+-- | Compute the index of the most-significant Word and write it.
+mwaWriteMostSignificant :: MutableWordArray# s -> Word# -> State# s -> State# s
+mwaWriteMostSignificant mwa w s =
+ case mwaSize# mwa s of
+ (# s', sz #) -> mwaWriteOrShrink mwa w (sz -# 1#) s'
+
+-- | MutableWordArray <- zipWith op wa1 wa2
+--
+-- Required output: Size(MutableWordArray) = min Size(wa1) Size(wa2)
+mwaInitArrayBinOp :: MutableWordArray# s -> WordArray# -> WordArray# -> (Word# -> Word# -> Word#) -> State# s -> State#s
+mwaInitArrayBinOp mwa wa wb op s = go 0# s
+ where
+ !sz = minI# (wordArraySize# wa) (wordArraySize# wb)
+ go i s'
+ | isTrue# (i ==# sz) = s'
+ | True =
+ case indexWordArray# wa i `op` indexWordArray# wb i of
+ v -> case mwaWrite# mwa i v s' of
+ s'' -> go (i +# 1#) s''
+
+-- | Write an element of the MutableWordArray
+mwaWrite# :: MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
+mwaWrite# = writeWordArray#
+
+-- | Fill some part of a MutableWordArray with the given Word#
+mwaFill# :: MutableWordArray# s -> Word# -> Word# -> Word# -> State# s -> State# s
+mwaFill# _ _ _ 0## s = s
+mwaFill# mwa v off n s = case mwaWrite# mwa (word2Int# off) v s of
+ s' -> mwaFill# mwa v (off `plusWord#` 1##) (n `minusWord#` 1##) s'
+
+-- | Add Word# inplace (a the specified offset) in the mwa with carry propagation.
+mwaAddInplaceWord# :: MutableWordArray# d -> Int# -> Word# -> State# d -> State# d
+mwaAddInplaceWord# _ _ 0## s = s
+mwaAddInplaceWord# mwa i y s = case readWordArray# mwa i s of
+ (# s1, x #) -> let !(# h,l #) = plusWord2# x y
+ in case mwaWrite# mwa i l s1 of
+ s2 -> mwaAddInplaceWord# mwa (i +# 1#) h s2
+
+-- | Sub Word# inplace (at the specified offset) in the mwa with carry
+-- propagation.
+--
+-- Return True# on overflow
+mwaSubInplaceWord#
+ :: MutableWordArray# d
+ -> Int#
+ -> Word#
+ -> State# d
+ -> (# State# d, Bool# #)
+mwaSubInplaceWord# mwa ii iw s1 = case mwaSize# mwa s1 of
+ (# is, sz #) ->
+ let
+ go _ 0## s = (# s, 0# #) -- no overflow
+ go i y s
+ | isTrue# (i >=# sz) = (# s, 1# #) -- overflow
+ | True = case readWordArray# mwa i s of
+ (# s1, x #) -> let !(# l,h #) = subWordC# x y
+ in case mwaWrite# mwa i l s1 of
+ s2 -> go (i +# 1#) (int2Word# h) s2
+ in go ii iw is
+
+
+-- | Trim `a` of `k` less significant limbs and then compare the result with `b`
+--
+-- "mwa" doesn't need to be trimmed
+mwaTrimCompare :: Int# -> MutableWordArray# s -> WordArray# -> State# s -> (# State# s, Ordering #)
+mwaTrimCompare k mwa wb s1
+ | (# s, szA #) <- mwaSize# mwa s1
+ , szB <- wordArraySize# wb
+ =
+ let
+ go i s
+ | isTrue# (i <# 0#) = (# s, EQ #)
+ | True = case readWordArray# mwa (i +# k) s of
+ (# s2, ai #) ->
+ let bi = if isTrue# (i >=# szB)
+ then 0##
+ else indexWordArray# wb i
+ in if | isTrue# (ai `gtWord#` bi) -> (# s2, GT #)
+ | isTrue# (bi `gtWord#` ai) -> (# s2, LT #)
+ | True -> go (i -# 1#) s2
+
+ szTrimA = szA -# k
+
+ in if | isTrue# (szTrimA <# szB) -> (# s, LT #)
+ | True -> go (szA -# k -# 1#) s
+
+
+-- | Sub array inplace (at the specified offset) in the mwa with carry propagation.
+--
+-- We don't trim the resulting array!
+--
+-- Return True# on overflow.
+mwaSubInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> (# State# d, Bool# #)
+mwaSubInplaceArray mwa off wb = go (wordArraySize# wb -# 1#)
+ where
+ go i s
+ | isTrue# (i <# 0#) = (# s, 0# #) -- no overflow
+ | True
+ = case mwaSubInplaceWord# mwa (off +# i) (indexWordArray# wb i) s of
+ (# s2, 0# #) -> go (i -# 1#) s2
+ (# s2, _ #) -> (# s2, 1# #) -- overflow
+
+-- | Add array inplace (a the specified offset) in the mwa with carry propagation.
+--
+-- Upper bound of the result mutable aray is not checked against overflow.
+mwaAddInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> State# d
+mwaAddInplaceArray mwa off wb = go 0# 0##
+ where
+ !maxi = wordArraySize# wb
+ go i c s
+ | isTrue# (i ==# maxi) = mwaAddInplaceWord# mwa (i +# off) c s
+ | True
+ = case readWordArray# mwa (i +# off) s of
+ (# s, v #) -> case plusWord3# v (indexWordArray# wb i) c of
+ (# c', v' #) -> case writeWordArray# mwa (i +# off) v' s of
+ s -> go (i +# 1#) c' s
+
+-- | Sub array inplace (at the specified offset) in the mwa with carry propagation.
+--
+-- We don't trim the resulting array!
+--
+-- Return True# on overflow.
+mwaSubInplaceMutableArray :: MutableWordArray# d -> Int# -> MutableWordArray# d -> State# d -> (# State# d, Bool# #)
+mwaSubInplaceMutableArray mwa off mwb s0 =
+ case mwaSize# mwb s0 of
+ (# s1, szB #) -> go (szB -# 1#) s1
+ where
+ go i s
+ | isTrue# (i <# 0#) = (# s, 0# #) -- no overflow
+ | True
+ = case readWordArray# mwb i s of
+ (# s1, bi #) -> case mwaSubInplaceWord# mwa (off +# i) bi s1 of
+ (# s2, 0# #) -> go (i -# 1#) s2
+ (# s2, _ #) -> (# s2, 1# #) -- overflow
+
+-- | Sub an array inplace and then trim zeroes
+--
+-- Don't check overflow. The caller must ensure that a>=b
+mwaSubInplaceArrayTrim :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> State# d
+mwaSubInplaceArrayTrim mwa off wb s =
+ case mwaSubInplaceArray mwa off wb s of
+ (# s', _ #) -> mwaTrimZeroes# mwa s'
+
+
+-- | Read an indexed Word in the MutableWordArray. If the index is out-of-bound,
+-- return zero.
+mwaReadOrZero :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #)
+mwaReadOrZero mwa i s = case mwaSize# mwa s of
+ (# s2, sz #)
+ | isTrue# (i >=# sz) -> (# s2, 0## #)
+ | isTrue# (i <# 0#) -> (# s2, 0## #)
+ | True -> readWordArray# mwa i s2
+
+mwaRead# :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #)
+mwaRead# = readWordArray#
diff --git a/libraries/ghc-boot/GHC/Platform.hs b/libraries/ghc-boot/GHC/Platform.hs
index 69978387aeb4aaeba2257725b9e6e13f8fa9f150..6c1be925122bfb2dbdf2c1ea42804fdbb52ef519 100644
--- a/libraries/ghc-boot/GHC/Platform.hs
+++ b/libraries/ghc-boot/GHC/Platform.hs
@@ -29,13 +29,11 @@ module GHC.Platform
, platformInIntRange
, platformInWordRange
, PlatformMisc(..)
- , IntegerLibrary(..)
, stringEncodeArch
, stringEncodeOS
, SseVersion (..)
, BmiVersion (..)
-)
-
+ )
where
import Prelude -- See Note [Why do we import Prelude here?]
@@ -292,8 +290,6 @@ osSubsectionsViaSymbols _ = False
data PlatformMisc = PlatformMisc
{ -- TODO Recalculate string from richer info?
platformMisc_targetPlatformString :: String
- , platformMisc_integerLibrary :: String
- , platformMisc_integerLibraryType :: IntegerLibrary
, platformMisc_ghcWithInterpreter :: Bool
, platformMisc_ghcWithNativeCodeGen :: Bool
, platformMisc_ghcWithSMP :: Bool
@@ -309,11 +305,6 @@ data PlatformMisc = PlatformMisc
, platformMisc_llvmTarget :: String
}
-data IntegerLibrary
- = IntegerGMP
- | IntegerSimple
- deriving (Read, Show, Eq)
-
-- | Minimum representable Int value for the given platform
platformMinInt :: Platform -> Integer
platformMinInt p = case platformWordSize p of
diff --git a/libraries/integer-gmp/changelog.md b/libraries/integer-gmp/changelog.md
index 9ff56e104c072a1f2ec534513a69f39f795845c9..51f7d0cf21d8cda0ca2ed768e2e41c12d7708119 100644
--- a/libraries/integer-gmp/changelog.md
+++ b/libraries/integer-gmp/changelog.md
@@ -1,5 +1,10 @@
# Changelog for [`integer-gmp` package](http://hackage.haskell.org/package/integer-gmp)
+## 1.1 *2020*
+
+ * integer-gmp is now a shallow backward compatibility package on top of
+ ghc-bignum
+
## 1.0.3.0 *January 2019*
* Bundled with GHC 8.10.1
diff --git a/libraries/integer-gmp/configure.ac b/libraries/integer-gmp/configure.ac
deleted file mode 100644
index 1ccd48e6982fbb7d033eaa302e48e5a6f24ebaa7..0000000000000000000000000000000000000000
--- a/libraries/integer-gmp/configure.ac
+++ /dev/null
@@ -1,115 +0,0 @@
-AC_PREREQ(2.69)
-AC_INIT([Haskell integer (GMP)], [1.0], [libraries@haskell.org], [integer])
-
-# Safety check: Ensure that we are in the correct source directory.
-AC_CONFIG_SRCDIR([cbits/wrappers.c])
-
-AC_CANONICAL_TARGET
-
-AC_PROG_CC
-dnl make extensions visible to allow feature-tests to detect them lateron
-AC_USE_SYSTEM_EXTENSIONS
-
-
-dnl--------------------------------------------------------------------
-dnl * Deal with arguments telling us gmp is somewhere odd
-dnl--------------------------------------------------------------------
-
-AC_ARG_WITH([gmp-includes],
- [AC_HELP_STRING([--with-gmp-includes],
- [directory containing gmp.h])],
- [GMP_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval"],
- [GMP_INCLUDE_DIRS=])
-
-AC_ARG_WITH([gmp-libraries],
- [AC_HELP_STRING([--with-gmp-libraries],
- [directory containing gmp library])],
- [GMP_LIB_DIRS=$withval; LDFLAGS="-L$withval"],
- [GMP_LIB_DIRS=])
-
-AC_ARG_WITH([gmp-framework-preferred],
- [AC_HELP_STRING([--with-gmp-framework-preferred],
- [on OSX, prefer the GMP framework to the gmp lib])],
- [GMP_PREFER_FRAMEWORK=YES],
- [GMP_PREFER_FRAMEWORK=NO])
-
-AC_ARG_WITH([intree-gmp],
- [AC_HELP_STRING([--with-intree-gmp],
- [force using the in-tree GMP])],
- [GMP_FORCE_INTREE=YES],
- [GMP_FORCE_INTREE=NO])
-
-dnl--------------------------------------------------------------------
-dnl * Detect gmp
-dnl--------------------------------------------------------------------
-
-HaveLibGmp=NO
-GMP_LIBS=
-HaveFrameworkGMP=NO
-GMP_FRAMEWORK=
-HaveSecurePowm=0
-
-if test "$GMP_FORCE_INTREE" != "YES"
-then
- if test "$GMP_PREFER_FRAMEWORK" = "YES"
- then
- LOOK_FOR_GMP_FRAMEWORK
- LOOK_FOR_GMP_LIB
- else
- LOOK_FOR_GMP_LIB
- LOOK_FOR_GMP_FRAMEWORK
- fi
-fi
-
-AC_MSG_CHECKING([whether to use in-tree GMP])
-if test "$HaveFrameworkGMP" = "YES" || test "$HaveLibGmp" = "YES"
-then
- AC_MSG_RESULT([no])
- UseIntreeGmp=0
- AC_CHECK_HEADER([gmp.h], , [AC_MSG_ERROR([Cannot find gmp.h])])
-
- AC_MSG_CHECKING([GMP version])
- AC_COMPUTE_INT(GhcGmpVerMj, __GNU_MP_VERSION, [#include <gmp.h>],
- AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION]))
- AC_COMPUTE_INT(GhcGmpVerMi, __GNU_MP_VERSION_MINOR, [#include <gmp.h>],
- AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_MINOR]))
- AC_COMPUTE_INT(GhcGmpVerPl, __GNU_MP_VERSION_PATCHLEVEL, [#include <gmp.h>],
- AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_PATCHLEVEL]))
- AC_MSG_RESULT([$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl])
-
-else
- AC_MSG_RESULT([yes])
- UseIntreeGmp=1
- HaveSecurePowm=1
-
- AC_MSG_CHECKING([GMP version])
- GhcGmpVerMj=5
- GhcGmpVerMi=0
- GhcGmpVerPl=4
- AC_MSG_RESULT([$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl])
-fi
-
-
-dnl--------------------------------------------------------------------
-dnl * Make sure we got some form of gmp
-dnl--------------------------------------------------------------------
-
-AC_SUBST(GMP_INCLUDE_DIRS)
-AC_SUBST(GMP_LIBS)
-AC_SUBST(GMP_LIB_DIRS)
-AC_SUBST(GMP_FRAMEWORK)
-AC_SUBST(HaveLibGmp)
-AC_SUBST(HaveFrameworkGMP)
-AC_SUBST(HaveSecurePowm)
-AC_SUBST(UseIntreeGmp)
-AC_SUBST(GhcGmpVerMj)
-AC_SUBST(GhcGmpVerMi)
-AC_SUBST(GhcGmpVerPl)
-
-AC_CONFIG_FILES([integer-gmp.buildinfo config.mk include/HsIntegerGmp.h])
-
-dnl--------------------------------------------------------------------
-dnl * Generate output files
-dnl--------------------------------------------------------------------
-
-AC_OUTPUT
diff --git a/libraries/integer-gmp/ghc.mk b/libraries/integer-gmp/ghc.mk
new file mode 100644
index 0000000000000000000000000000000000000000..cd8a1d89e8de2a9ba3f20481732bef2df68ba27d
--- /dev/null
+++ b/libraries/integer-gmp/ghc.mk
@@ -0,0 +1,5 @@
+libraries/integer-gmp_PACKAGE = integer-gmp
+libraries/integer-gmp_dist-install_GROUP = libraries
+$(if $(filter integer-gmp,$(PACKAGES_STAGE0)),$(eval $(call build-package,libraries/integer-gmp,dist-boot,0)))
+$(if $(filter integer-gmp,$(PACKAGES_STAGE1)),$(eval $(call build-package,libraries/integer-gmp,dist-install,1)))
+$(if $(filter integer-gmp,$(PACKAGES_STAGE2)),$(eval $(call build-package,libraries/integer-gmp,dist-install,2)))
diff --git a/libraries/integer-gmp/integer-gmp.cabal b/libraries/integer-gmp/integer-gmp.cabal
index 77e98180c2cad7bd09d8e5173202c29f34ff3aaa..4092b828fdf19ef4df3256573bc587a0600f8498 100644
--- a/libraries/integer-gmp/integer-gmp.cabal
+++ b/libraries/integer-gmp/integer-gmp.cabal
@@ -1,6 +1,6 @@
cabal-version: 2.0
name: integer-gmp
-version: 1.0.3.0
+version: 1.1
synopsis: Integer library based on GMP
license: BSD3
@@ -8,74 +8,24 @@ license-file: LICENSE
author: Herbert Valerio Riedel
maintainer: hvr@gnu.org
category: Numeric, Algebra
-build-type: Configure
+build-type: Simple
description:
- This package provides the low-level implementation of the standard
- 'Integer' type based on the
+ This package used to provide an implementation of the standard 'Integer'
+ type based on the
<http://gmplib.org/ GNU Multiple Precision Arithmetic Library (GMP)>.
.
- This package provides access to the internal representation of
- 'Integer' as well as primitive operations with no proper error
- handling, and should only be used directly with the utmost care.
-
-extra-source-files:
- aclocal.m4
- cbits/wrappers.c
- changelog.md
- config.guess
- config.sub
- configure
- configure.ac
- config.mk.in
- include/HsIntegerGmp.h.in
- install-sh
- integer-gmp.buildinfo.in
-
--- NB: Many of these tmp files no longer ever actually get plopped in
--- the root directory post Cabal 2.4, thanks to a change that causes
--- autoconf/configure to get run inside the dist directory.
-extra-tmp-files:
- autom4te.cache
- config.log
- config.status
- config.mk
- integer-gmp.buildinfo
- include/HsIntegerGmp.h
+ It is now deprecated in favor of the 'ghc-bignum' package.
+ .
+ Its purpose is to provide backward compatibility for codes directly
+ depending on the `integer-gmp` package.
library
default-language: Haskell2010
- other-extensions:
- BangPatterns
- CApiFFI
- CPP
- DeriveDataTypeable
- ExplicitForAll
- GHCForeignImportPrim
- MagicHash
- NegativeLiterals
- NoImplicitPrelude
- RebindableSyntax
- StandaloneDeriving
- UnboxedTuples
- UnliftedFFITypes
- build-depends: ghc-prim >= 0.5.1.0 && < 0.7
hs-source-dirs: src/
- -- We need to set the unit ID to integer-wired-in
- -- (without a version number) as it's magic.
- -- See Note [The integer library] in PrelNames
- ghc-options: -this-unit-id integer-wired-in -Wall
- cc-options: -std=c99 -Wall
-
- include-dirs: include
- c-sources:
- cbits/wrappers.c
+ ghc-options: -Wall
+ build-depends:
+ base >= 4.11 && < 5
+ , ghc-prim
exposed-modules:
- GHC.Integer
- GHC.Integer.Logarithms
- GHC.Integer.Logarithms.Internals
-
GHC.Integer.GMP.Internals
-
- other-modules:
- GHC.Integer.Type
diff --git a/libraries/integer-gmp/src/GHC/Integer.hs b/libraries/integer-gmp/src/GHC/Integer.hs
deleted file mode 100644
index 6a0d16d5537c21223b89670769eb0b7c1a9876c7..0000000000000000000000000000000000000000
--- a/libraries/integer-gmp/src/GHC/Integer.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-#include "MachDeps.h"
-
--- |
--- Module : GHC.Integer.Type
--- Copyright : (c) Herbert Valerio Riedel 2014
--- License : BSD3
---
--- Maintainer : ghc-devs@haskell.org
--- Stability : provisional
--- Portability : non-portable (GHC Extensions)
---
--- The 'Integer' type.
---
--- This module exposes the /portable/ 'Integer' API. See
--- "GHC.Integer.GMP.Internals" for the @integer-gmp@-specific internal
--- representation of 'Integer' as well as optimized GMP-specific
--- operations.
-
-module GHC.Integer (
- Integer,
-
- -- * Construct 'Integer's
- mkInteger, smallInteger, wordToInteger,
-#if WORD_SIZE_IN_BITS < 64
- word64ToInteger, int64ToInteger,
-#endif
- -- * Conversion to other integral types
- integerToWord, integerToInt,
-#if WORD_SIZE_IN_BITS < 64
- integerToWord64, integerToInt64,
-#endif
-
- -- * Helpers for 'RealFloat' type-class operations
- encodeFloatInteger, floatFromInteger,
- encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,
-
- -- * Arithmetic operations
- plusInteger, minusInteger, timesInteger, negateInteger,
- absInteger, signumInteger,
-
- divModInteger, divInteger, modInteger,
- quotRemInteger, quotInteger, remInteger,
-
- -- * Comparison predicates
- eqInteger, neqInteger, leInteger, gtInteger, ltInteger, geInteger,
- compareInteger,
-
- -- ** 'Int#'-boolean valued versions of comparison predicates
- --
- -- | These operations return @0#@ and @1#@ instead of 'False' and
- -- 'True' respectively. See
- -- <https://gitlab.haskell.org/ghc/ghc/wikis/prim-bool PrimBool wiki-page>
- -- for more details
- eqInteger#, neqInteger#, leInteger#, gtInteger#, ltInteger#, geInteger#,
-
-
- -- * Bit-operations
- andInteger, orInteger, xorInteger,
-
- complementInteger,
- shiftLInteger, shiftRInteger, testBitInteger,
-
- popCountInteger, bitInteger,
-
- -- * Hashing
- hashInteger,
- ) where
-
-import GHC.Integer.Type
-
-default ()
diff --git a/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs b/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
index 6eb88bd9437928d7b137cf8c3a09500d9c4344ef..3af21e7e7486dcf70977057cb2313d2b4f003505 100644
--- a/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
+++ b/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
@@ -1,13 +1,10 @@
{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE UnliftedFFITypes #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE CPP #-}
-{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
#include "MachDeps.h"
@@ -20,20 +17,9 @@
-- Stability : provisional
-- Portability : non-portable (GHC Extensions)
--
--- This modules provides access to the 'Integer' constructors and
--- exposes some highly optimized GMP-operations.
---
--- Note that since @integer-gmp@ does not depend on `base`, error
--- reporting via exceptions, 'error', or 'undefined' is not
--- available. Instead, the low-level functions will crash the runtime
--- if called with invalid arguments.
---
--- See also
--- <https://gitlab.haskell.org/ghc/ghc/wikis/commentary/libraries/integer GHC Commentary: Libraries/Integer>.
-
module GHC.Integer.GMP.Internals
( -- * The 'Integer' type
- Integer(..)
+ Integer (S#,Jn#,Jp#)
, isValidInteger#
-- ** Basic 'Integer' operations
@@ -42,12 +28,8 @@ module GHC.Integer.GMP.Internals
-- ** Additional 'Integer' operations
, gcdInteger
- , gcdExtInteger
, lcmInteger
, sqrInteger
- , powModInteger
- , powModSecInteger
- , recipModInteger
-- ** Additional conversion operations to 'Integer'
, wordToNegInteger
@@ -60,305 +42,73 @@ module GHC.Integer.GMP.Internals
, GmpLimb, GmpLimb#
, GmpSize, GmpSize#
- -- **
-
- , isValidBigNat#
- , sizeofBigNat#
- , zeroBigNat
- , oneBigNat
- , nullBigNat
-
- -- ** Conversions to/from 'BigNat'
-
- , byteArrayToBigNat#
- , wordToBigNat
- , wordToBigNat2
- , bigNatToInt
- , bigNatToWord
- , indexBigNat#
-
- -- ** 'BigNat' arithmetic operations
- , plusBigNat
- , plusBigNatWord
- , minusBigNat
- , minusBigNatWord
- , timesBigNat
- , timesBigNatWord
- , sqrBigNat
-
- , quotRemBigNat
- , quotRemBigNatWord
- , quotBigNatWord
- , quotBigNat
- , remBigNat
- , remBigNatWord
-
- , gcdBigNat
- , gcdBigNatWord
-
- , powModBigNat
- , powModBigNatWord
-
- , recipModBigNat
-
- -- ** 'BigNat' logic operations
- , shiftRBigNat
- , shiftLBigNat
- , testBitBigNat
- , clearBitBigNat
- , complementBitBigNat
- , setBitBigNat
- , andBigNat
- , xorBigNat
- , popCountBigNat
- , orBigNat
- , bitBigNat
-
- -- ** 'BigNat' comparison predicates
- , isZeroBigNat
- , isNullBigNat#
-
- , compareBigNatWord
- , compareBigNat
- , eqBigNatWord
- , eqBigNatWord#
- , eqBigNat
- , eqBigNat#
- , gtBigNatWord#
-
- -- * Miscellaneous GMP-provided operations
- , gcdInt
- , gcdWord
- , powModWord
- , recipModWord
-
- -- * Primality tests
- , testPrimeInteger
- , testPrimeBigNat
- , testPrimeWord#
-
- , nextPrimeInteger
- , nextPrimeBigNat
- , nextPrimeWord#
-
- -- * Import/export functions
- -- ** Compute size of serialisation
- , sizeInBaseBigNat
- , sizeInBaseInteger
- , sizeInBaseWord#
-
- -- ** Export
- , exportBigNatToAddr
- , exportIntegerToAddr
- , exportWordToAddr
-
- , exportBigNatToMutableByteArray
- , exportIntegerToMutableByteArray
- , exportWordToMutableByteArray
-
- -- ** Import
-
- , importBigNatFromAddr
- , importIntegerFromAddr
-
- , importBigNatFromByteArray
- , importIntegerFromByteArray
) where
-import GHC.Integer.Type
import GHC.Integer
-import GHC.Prim
+import GHC.Natural
+import GHC.Num.Integer (Integer(..))
+import qualified GHC.Num.Integer as I
import GHC.Types
+import GHC.Prim
-default ()
-
-
--- | Compute number of digits (without sign) in given @/base/@.
---
--- This function wraps @mpz_sizeinbase()@ which has some
--- implementation pecularities to take into account:
---
--- * \"@'sizeInBaseInteger' 0 /base/ = 1@\"
--- (see also comment in 'exportIntegerToMutableByteArray').
---
--- * This function is only defined if @/base/ >= 2#@ and @/base/ <= 256#@
--- (Note: the documentation claims that only @/base/ <= 62#@ is
--- supported, however the actual implementation supports up to base 256).
---
--- * If @/base/@ is a power of 2, the result will be exact. In other
--- cases (e.g. for @/base/ = 10#@), the result /may/ be 1 digit too large
--- sometimes.
---
--- * \"@'sizeInBaseInteger' /i/ 2#@\" can be used to determine the most
--- significant bit of @/i/@.
---
--- @since 0.5.1.0
-sizeInBaseInteger :: Integer -> Int# -> Word#
-sizeInBaseInteger (S# i#) = sizeInBaseWord# (int2Word# (absI# i#))
-sizeInBaseInteger (Jp# bn) = sizeInBaseBigNat bn
-sizeInBaseInteger (Jn# bn) = sizeInBaseBigNat bn
-
--- | Version of 'sizeInBaseInteger' operating on 'BigNat'
---
--- @since 1.0.0.0
-sizeInBaseBigNat :: BigNat -> Int# -> Word#
-sizeInBaseBigNat bn@(BN# ba#) = c_mpn_sizeinbase# ba# (sizeofBigNat# bn)
-
-foreign import ccall unsafe "integer_gmp_mpn_sizeinbase"
- c_mpn_sizeinbase# :: ByteArray# -> GmpSize# -> Int# -> Word#
-
--- | Version of 'sizeInBaseInteger' operating on 'Word#'
---
--- @since 1.0.0.0
-foreign import ccall unsafe "integer_gmp_mpn_sizeinbase1"
- sizeInBaseWord# :: Word# -> Int# -> Word#
-
--- | Dump 'Integer' (without sign) to @/addr/@ in base-256 representation.
---
--- @'exportIntegerToAddr' /i/ /addr/ /e/@
---
--- See description of 'exportIntegerToMutableByteArray' for more details.
---
--- @since 1.0.0.0
-exportIntegerToAddr :: Integer -> Addr# -> Int# -> IO Word
-exportIntegerToAddr (S# i#) = exportWordToAddr (W# (int2Word# (absI# i#)))
-exportIntegerToAddr (Jp# bn) = exportBigNatToAddr bn
-exportIntegerToAddr (Jn# bn) = exportBigNatToAddr bn
-
--- | Version of 'exportIntegerToAddr' operating on 'BigNat's.
-exportBigNatToAddr :: BigNat -> Addr# -> Int# -> IO Word
-exportBigNatToAddr bn@(BN# ba#) addr e
- = c_mpn_exportToAddr# ba# (sizeofBigNat# bn) addr 0# e
-
-foreign import ccall unsafe "integer_gmp_mpn_export"
- c_mpn_exportToAddr# :: ByteArray# -> GmpSize# -> Addr# -> Int# -> Int#
- -> IO Word
-
--- | Version of 'exportIntegerToAddr' operating on 'Word's.
-exportWordToAddr :: Word -> Addr# -> Int# -> IO Word
-exportWordToAddr (W# w#) addr
- = c_mpn_export1ToAddr# w# addr 0# -- TODO: we don't calling GMP for that
+{-# COMPLETE S#, Jp#, Jn# #-}
-foreign import ccall unsafe "integer_gmp_mpn_export1"
- c_mpn_export1ToAddr# :: GmpLimb# -> Addr# -> Int# -> Int#
- -> IO Word
+{-# DEPRECATED S# "Use IS constructor instead" #-}
+pattern S# :: Int# -> Integer
+pattern S# i = IS i
--- | Dump 'Integer' (without sign) to mutable byte-array in base-256
--- representation.
---
--- The call
---
--- @'exportIntegerToMutableByteArray' /i/ /mba/ /offset/ /msbf/@
---
--- writes
---
--- * the 'Integer' @/i/@
---
--- * into the 'MutableByteArray#' @/mba/@ starting at @/offset/@
---
--- * with most significant byte first if @msbf@ is @1#@ or least
--- significant byte first if @msbf@ is @0#@, and
---
--- * returns number of bytes written.
---
--- Use \"@'sizeInBaseInteger' /i/ 256#@\" to compute the exact number of
--- bytes written in advance for @/i/ /= 0@. In case of @/i/ == 0@,
--- 'exportIntegerToMutableByteArray' will write and report zero bytes
--- written, whereas 'sizeInBaseInteger' report one byte.
---
--- It's recommended to avoid calling 'exportIntegerToMutableByteArray' for small
--- integers as this function would currently convert those to big
--- integers in msbf to call @mpz_export()@.
---
--- @since 1.0.0.0
-exportIntegerToMutableByteArray :: Integer -> MutableByteArray# RealWorld
- -> Word# -> Int# -> IO Word
-exportIntegerToMutableByteArray (S# i#)
- = exportWordToMutableByteArray (W# (int2Word# (absI# i#)))
-exportIntegerToMutableByteArray (Jp# bn) = exportBigNatToMutableByteArray bn
-exportIntegerToMutableByteArray (Jn# bn) = exportBigNatToMutableByteArray bn
+fromBN# :: BigNat -> ByteArray#
+fromBN# (BN# x) = x
--- | Version of 'exportIntegerToMutableByteArray' operating on 'BigNat's.
---
--- @since 1.0.0.0
-exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word#
- -> Int# -> IO Word
-exportBigNatToMutableByteArray bn@(BN# ba#)
- = c_mpn_exportToMutableByteArray# ba# (sizeofBigNat# bn)
+fromIP :: Integer -> (# () | BigNat #)
+fromIP (IP x) = (# | BN# x #)
+fromIP _ = (# () | #)
-foreign import ccall unsafe "integer_gmp_mpn_export"
- c_mpn_exportToMutableByteArray# :: ByteArray# -> GmpSize#
- -> MutableByteArray# RealWorld -> Word#
- -> Int# -> IO Word
+fromIN :: Integer -> (# () | BigNat #)
+fromIN (IN x) = (# | BN# x #)
+fromIN _ = (# () | #)
--- | Version of 'exportIntegerToMutableByteArray' operating on 'Word's.
---
--- @since 1.0.0.0
-exportWordToMutableByteArray :: Word -> MutableByteArray# RealWorld -> Word#
- -> Int# -> IO Word
-exportWordToMutableByteArray (W# w#) = c_mpn_export1ToMutableByteArray# w#
+{-# DEPRECATED Jp# "Use IP constructor instead" #-}
+pattern Jp# :: BigNat -> Integer
+pattern Jp# i <- (fromIP -> (# | i #))
+ where
+ Jp# i = IP (fromBN# i)
-foreign import ccall unsafe "integer_gmp_mpn_export1"
- c_mpn_export1ToMutableByteArray# :: GmpLimb# -> MutableByteArray# RealWorld
- -> Word# -> Int# -> IO Word
+{-# DEPRECATED Jn# "Use IN constructor instead" #-}
+pattern Jn# :: BigNat -> Integer
+pattern Jn# i <- (fromIN -> (# | i #))
+ where
+ Jn# i = IN (fromBN# i)
+{-# DEPRECATED isValidInteger# "Use integerCheck# instead" #-}
+isValidInteger# :: Integer -> Int#
+isValidInteger# = I.integerCheck#
--- | Probalistic Miller-Rabin primality test.
---
--- \"@'testPrimeInteger' /n/ /k/@\" determines whether @/n/@ is prime
--- and returns one of the following results:
---
--- * @2#@ is returned if @/n/@ is definitely prime,
---
--- * @1#@ if @/n/@ is a /probable prime/, or
---
--- * @0#@ if @/n/@ is definitely not a prime.
---
--- The @/k/@ argument controls how many test rounds are performed for
--- determining a /probable prime/. For more details, see
--- <http://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fprobab_005fprime_005fp-360 GMP documentation for `mpz_probab_prime_p()`>.
---
--- @since 0.5.1.0
-{-# NOINLINE testPrimeInteger #-}
-testPrimeInteger :: Integer -> Int# -> Int#
-testPrimeInteger (S# i#) = testPrimeWord# (int2Word# (absI# i#))
-testPrimeInteger (Jp# n) = testPrimeBigNat n
-testPrimeInteger (Jn# n) = testPrimeBigNat n
+{-# DEPRECATED gcdInteger "Use integerGcd instead" #-}
+gcdInteger :: Integer -> Integer -> Integer
+gcdInteger = I.integerGcd
--- | Version of 'testPrimeInteger' operating on 'BigNat's
---
--- @since 1.0.0.0
-testPrimeBigNat :: BigNat -> Int# -> Int#
-testPrimeBigNat bn@(BN# ba#) = c_integer_gmp_test_prime# ba# (sizeofBigNat# bn)
+{-# DEPRECATED lcmInteger "Use integerLcm instead" #-}
+lcmInteger :: Integer -> Integer -> Integer
+lcmInteger = I.integerLcm
-foreign import ccall unsafe "integer_gmp_test_prime"
- c_integer_gmp_test_prime# :: ByteArray# -> GmpSize# -> Int# -> Int#
+{-# DEPRECATED sqrInteger "Use integerSqr instead" #-}
+sqrInteger :: Integer -> Integer
+sqrInteger = I.integerSqr
--- | Version of 'testPrimeInteger' operating on 'Word#'s
---
--- @since 1.0.0.0
-foreign import ccall unsafe "integer_gmp_test_prime1"
- testPrimeWord# :: GmpLimb# -> Int# -> Int#
+{-# DEPRECATED wordToNegInteger "Use integerFromWordNeg# instead" #-}
+wordToNegInteger :: Word# -> Integer
+wordToNegInteger = I.integerFromWordNeg#
+{-# DEPRECATED bigNatToInteger "Use integerFromBigNat instead" #-}
+bigNatToInteger :: BigNat -> Integer
+bigNatToInteger (BN# i) = I.integerFromBigNat i
--- | Compute next prime greater than @/n/@ probalistically.
---
--- According to the GMP documentation, the underlying function
--- @mpz_nextprime()@ \"uses a probabilistic algorithm to identify
--- primes. For practical purposes it's adequate, the chance of a
--- composite passing will be extremely small.\"
---
--- @since 0.5.1.0
-{-# NOINLINE nextPrimeInteger #-}
-nextPrimeInteger :: Integer -> Integer
-nextPrimeInteger (S# i#)
- | isTrue# (i# ># 1#) = wordToInteger (nextPrimeWord# (int2Word# i#))
- | True = S# 2#
-nextPrimeInteger (Jp# bn) = Jp# (nextPrimeBigNat bn)
-nextPrimeInteger (Jn# _) = S# 2#
+{-# DEPRECATED bigNatToNegInteger "Use integerFromBigNatNeg instead" #-}
+bigNatToNegInteger :: BigNat -> Integer
+bigNatToNegInteger (BN# i) = I.integerFromBigNatNeg i
--- | Version of 'nextPrimeInteger' operating on 'Word#'s
---
--- @since 1.0.0.0
-foreign import ccall unsafe "integer_gmp_next_prime1"
- nextPrimeWord# :: GmpLimb# -> GmpLimb#
+type GmpLimb = Word
+type GmpLimb# = Word#
+type GmpSize = Int
+type GmpSize# = Int#
diff --git a/libraries/integer-gmp/src/GHC/Integer/Logarithms.hs b/libraries/integer-gmp/src/GHC/Integer/Logarithms.hs
deleted file mode 100644
index 76467e18a7b718c11a1e8ca405fa74856e54e9ee..0000000000000000000000000000000000000000
--- a/libraries/integer-gmp/src/GHC/Integer/Logarithms.hs
+++ /dev/null
@@ -1,74 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE UnliftedFFITypes #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE BangPatterns #-}
-
-module GHC.Integer.Logarithms
- ( wordLog2#
- , integerLog2#
- , integerLogBase#
- ) where
-
-#include "MachDeps.h"
-
-#if WORD_SIZE_IN_BITS == 32
-# define LD_WORD_SIZE_IN_BITS 5
-#elif WORD_SIZE_IN_BITS == 64
-# define LD_WORD_SIZE_IN_BITS 6
-#else
-# error unsupported WORD_SIZE_IN_BITS
-#endif
-
-import GHC.Integer.Type
-
-import GHC.Prim
-
-default ()
-
--- | Calculate the integer logarithm for an arbitrary base.
---
--- The base must be greater than @1@, the second argument, the number
--- whose logarithm is sought, shall be positive, otherwise the
--- result is meaningless.
---
--- The following property holds
---
--- @base ^ 'integerLogBase#' base m <= m < base ^('integerLogBase#' base m + 1)@
---
--- for @base > 1@ and @m > 0@.
---
--- Note: Internally uses 'integerLog2#' for base 2
-integerLogBase# :: Integer -> Integer -> Int#
-integerLogBase# (S# 2#) m = integerLog2# m
-integerLogBase# b m = e'
- where
- !(# _, e' #) = go b
-
- go pw | m `ltInteger` pw = (# m, 0# #)
- go pw = case go (sqrInteger pw) of
- (# q, e #) | q `ltInteger` pw -> (# q, 2# *# e #)
- (# q, e #) -> (# q `quotInteger` pw, 2# *# e +# 1# #)
-
-
--- | Calculate the integer base 2 logarithm of an 'Integer'. The
--- calculation is more efficient than for the general case, on
--- platforms with 32- or 64-bit words much more efficient.
---
--- The argument must be strictly positive, that condition is /not/ checked.
-integerLog2# :: Integer -> Int#
-integerLog2# (S# i#) = wordLog2# (int2Word# i#)
-integerLog2# (Jn# _) = -1#
-integerLog2# (Jp# bn) = go (s -# 1#)
- where
- s = sizeofBigNat# bn
- go i = case indexBigNat# bn i of
- 0## -> go (i -# 1#)
- w -> wordLog2# w +# (uncheckedIShiftL# i LD_WORD_SIZE_IN_BITS#)
-
--- | Compute base-2 log of 'Word#'
---
--- This is internally implemented as count-leading-zeros machine instruction.
-wordLog2# :: Word# -> Int#
-wordLog2# w# = (WORD_SIZE_IN_BITS# -# 1#) -# (word2Int# (clz# w#))
diff --git a/libraries/integer-gmp/src/GHC/Integer/Logarithms/Internals.hs b/libraries/integer-gmp/src/GHC/Integer/Logarithms/Internals.hs
deleted file mode 100644
index 5f50c79e41853d448258bfd4b110e9eceb8b1bd5..0000000000000000000000000000000000000000
--- a/libraries/integer-gmp/src/GHC/Integer/Logarithms/Internals.hs
+++ /dev/null
@@ -1,118 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE CPP #-}
-
-{-# OPTIONS_HADDOCK not-home #-}
-
-#include "MachDeps.h"
-
-#if WORD_SIZE_IN_BITS == 32
-# define WSHIFT 5
-# define MMASK 31
-#elif WORD_SIZE_IN_BITS == 64
-# define WSHIFT 6
-# define MMASK 63
-#else
-# error unsupported WORD_SIZE_IN_BITS
-#endif
-
--- | Fast 'Integer' logarithms to base 2. 'integerLog2#' and
--- 'wordLog2#' are of general usefulness, the others are only needed
--- for a fast implementation of 'fromRational'. Since they are needed
--- in "GHC.Float", we must expose this module, but it should not show
--- up in the docs.
---
--- See https://gitlab.haskell.org/ghc/ghc/issues/5122
--- for the origin of the code in this module
-module GHC.Integer.Logarithms.Internals
- ( wordLog2#
- , integerLog2IsPowerOf2#
- , integerLog2#
- , roundingMode#
- ) where
-
-import GHC.Integer.Type
-import GHC.Integer.Logarithms
-
-import GHC.Types
-import GHC.Prim
-
-default ()
-
--- | Extended version of 'integerLog2#'
---
--- Assumption: Integer is strictly positive
---
--- First component of result is @log2 n@, second is @0#@ iff /n/ is a
--- power of two.
-integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
--- The power of 2 test is n&(n-1) == 0, thus powers of 2
--- are indicated bythe second component being zero.
-integerLog2IsPowerOf2# (S# i#) = case int2Word# i# of
- w -> (# wordLog2# w, word2Int# (w `and#` (w `minusWord#` 1##)) #)
-integerLog2IsPowerOf2# (Jn# _) = (# -1#, -1# #)
--- Find the log2 as above, test whether that word is a power
--- of 2, if so, check whether only zero bits follow.
-integerLog2IsPowerOf2# (Jp# bn) = check (s -# 1#)
- where
- s = sizeofBigNat# bn
- check :: Int# -> (# Int#, Int# #)
- check i = case indexBigNat# bn i of
- 0## -> check (i -# 1#)
- w -> (# wordLog2# w +# (uncheckedIShiftL# i WSHIFT#)
- , case w `and#` (w `minusWord#` 1##) of
- 0## -> test (i -# 1#)
- _ -> 1# #)
- test :: Int# -> Int#
- test i = if isTrue# (i <# 0#)
- then 0#
- else case indexBigNat# bn i of
- 0## -> test (i -# 1#)
- _ -> 1#
-
-
--- Assumption: Integer and Int# are strictly positive, Int# is less
--- than logBase 2 of Integer, otherwise havoc ensues.
--- Used only for the numerator in fromRational when the denominator
--- is a power of 2.
--- The Int# argument is log2 n minus the number of bits in the mantissa
--- of the target type, i.e. the index of the first non-integral bit in
--- the quotient.
---
--- 0# means round down (towards zero)
--- 1# means we have a half-integer, round to even
--- 2# means round up (away from zero)
-roundingMode# :: Integer -> Int# -> Int#
-roundingMode# (S# i#) t =
- case int2Word# i# `and#` ((uncheckedShiftL# 2## t) `minusWord#` 1##) of
- k -> case uncheckedShiftL# 1## t of
- c -> if isTrue# (c `gtWord#` k)
- then 0#
- else if isTrue# (c `ltWord#` k)
- then 2#
- else 1#
-
-roundingMode# (Jn# bn) t = roundingMode# (Jp# bn) t -- dummy
-roundingMode# (Jp# bn) t =
- case word2Int# (int2Word# t `and#` MMASK##) of
- j -> -- index of relevant bit in word
- case uncheckedIShiftRA# t WSHIFT# of
- k -> -- index of relevant word
- case indexBigNat# bn k `and#`
- ((uncheckedShiftL# 2## j) `minusWord#` 1##) of
- r ->
- case uncheckedShiftL# 1## j of
- c -> if isTrue# (c `gtWord#` r)
- then 0#
- else if isTrue# (c `ltWord#` r)
-
-
- then 2#
- else test (k -# 1#)
- where
- test i = if isTrue# (i <# 0#)
- then 1#
- else case indexBigNat# bn i of
- 0## -> test (i -# 1#)
- _ -> 2#
diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs
deleted file mode 100644
index cc9408982843a615bda81d1a47df64832dc2122c..0000000000000000000000000000000000000000
--- a/libraries/integer-gmp/src/GHC/Integer/Type.hs
+++ /dev/null
@@ -1,2202 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE GHCForeignImportPrim #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE UnliftedFFITypes #-}
-{-# LANGUAGE RebindableSyntax #-}
-{-# LANGUAGE NegativeLiterals #-}
-{-# LANGUAGE ExplicitForAll #-}
-
--- |
--- Module : GHC.Integer.Type
--- Copyright : (c) Herbert Valerio Riedel 2014
--- License : BSD3
---
--- Maintainer : ghc-devs@haskell.org
--- Stability : provisional
--- Portability : non-portable (GHC Extensions)
---
--- GHC needs this module to be named "GHC.Integer.Type" and provide
--- all the low-level 'Integer' operations.
-
-module GHC.Integer.Type where
-
-#include "MachDeps.h"
-#include "HsIntegerGmp.h"
-
--- Sanity check as CPP defines are implicitly 0-valued when undefined
-#if !(defined(SIZEOF_LONG) && defined(SIZEOF_HSWORD) \
- && defined(WORD_SIZE_IN_BITS))
-# error missing defines
-#endif
-
-import GHC.Classes
-import GHC.Magic
-import GHC.Prim
-import GHC.Types
-#if WORD_SIZE_IN_BITS < 64
-import GHC.IntWord64
-#endif
-
-default ()
-
--- Most high-level operations need to be marked `NOINLINE` as
--- otherwise GHC doesn't recognize them and fails to apply constant
--- folding to `Integer`-typed expression.
---
--- To this end, the CPP hack below allows to write the pseudo-pragma
---
--- {-# CONSTANT_FOLDED plusInteger #-}
---
--- which is simply expanded into a
---
--- {-# NOINLINE plusInteger #-}
---
-#define CONSTANT_FOLDED NOINLINE
-
-----------------------------------------------------------------------------
--- type definitions
-
--- NB: all code assumes GMP_LIMB_BITS == WORD_SIZE_IN_BITS
--- The C99 code in cbits/wrappers.c will fail to compile if this doesn't hold
-
--- | Type representing a GMP Limb
-type GmpLimb = Word -- actually, 'CULong'
-type GmpLimb# = Word#
-
--- | Count of 'GmpLimb's, must be positive (unless specified otherwise).
-type GmpSize = Int -- actually, a 'CLong'
-type GmpSize# = Int#
-
-narrowGmpSize# :: Int# -> Int#
-#if SIZEOF_LONG == SIZEOF_HSWORD
-narrowGmpSize# x = x
-#elif (SIZEOF_LONG == 4) && (SIZEOF_HSWORD == 8)
--- On IL32P64 (i.e. Win64), we have to be careful with CLong not being
--- 64bit. This is mostly an issue on values returned from C functions
--- due to sign-extension.
-narrowGmpSize# = narrow32Int#
-#endif
-
-
-type GmpBitCnt = Word -- actually, 'CULong'
-type GmpBitCnt# = Word# -- actually, 'CULong'
-
--- Pseudo FFI CType
-type CInt = Int
-type CInt# = Int#
-
-narrowCInt# :: Int# -> Int#
-narrowCInt# = narrow32Int#
-
--- | Bits in a 'GmpLimb'. Same as @WORD_SIZE_IN_BITS@.
-gmpLimbBits :: Word -- 8 `shiftL` gmpLimbShift
-gmpLimbBits = W# WORD_SIZE_IN_BITS##
-
-#if WORD_SIZE_IN_BITS == 64
-# define GMP_LIMB_SHIFT 3
-# define GMP_LIMB_BYTES 8
-# define GMP_LIMB_BITS 64
-# define INT_MINBOUND -0x8000000000000000
-# define INT_MAXBOUND 0x7fffffffffffffff
-# define ABS_INT_MINBOUND 0x8000000000000000
-# define SQRT_INT_MAXBOUND 0xb504f333
-#elif WORD_SIZE_IN_BITS == 32
-# define GMP_LIMB_SHIFT 2
-# define GMP_LIMB_BYTES 4
-# define GMP_LIMB_BITS 32
-# define INT_MINBOUND -0x80000000
-# define INT_MAXBOUND 0x7fffffff
-# define ABS_INT_MINBOUND 0x80000000
-# define SQRT_INT_MAXBOUND 0xb504
-#else
-# error unsupported WORD_SIZE_IN_BITS config
-#endif
-
--- | Type representing /raw/ arbitrary-precision Naturals
---
--- This is common type used by 'Natural' and 'Integer'. As this type
--- consists of a single constructor wrapping a 'ByteArray#' it can be
--- unpacked.
---
--- Essential invariants:
---
--- - 'ByteArray#' size is an exact multiple of 'Word#' size
--- - limbs are stored in least-significant-limb-first order,
--- - the most-significant limb must be non-zero, except for
--- - @0@ which is represented as a 1-limb.
-data BigNat = BN# ByteArray#
-
-instance Eq BigNat where
- (==) = eqBigNat
-
-instance Ord BigNat where
- compare = compareBigNat
-
--- [Implementation notes]
---
--- Invariant: 'Jn#' and 'Jp#' are used iff value doesn't fit in 'S#'
---
--- Useful properties resulting from the invariants:
---
--- - @abs ('S#' _) <= abs ('Jp#' _)@
--- - @abs ('S#' _) < abs ('Jn#' _)@
-
--- | Arbitrary precision integers. In contrast with fixed-size integral types
--- such as 'Int', the 'Integer' type represents the entire infinite range of
--- integers.
---
--- For more information about this type's representation, see the comments in
--- its implementation.
-data Integer = S# !Int#
- -- ^ iff value in @[minBound::'Int', maxBound::'Int']@ range
- | Jp# {-# UNPACK #-} !BigNat
- -- ^ iff value in @]maxBound::'Int', +inf[@ range
- | Jn# {-# UNPACK #-} !BigNat
- -- ^ iff value in @]-inf, minBound::'Int'[@ range
-
--- NOTE: the above representation is baked into the GHCi debugger in
--- GHC.Runtime.Heap.Inspect. If you change it here, fixes
--- will be required over there too. Tests for this are in
--- testsuite/tests/ghci.debugger.
-
--- TODO: experiment with different constructor-ordering
-
-instance Eq Integer where
- (==) = eqInteger
- (/=) = neqInteger
-
-instance Ord Integer where
- compare = compareInteger
- (>) = gtInteger
- (>=) = geInteger
- (<) = ltInteger
- (<=) = leInteger
-
-----------------------------------------------------------------------------
-
--- | Construct 'Integer' value from list of 'Int's.
---
--- This function is used by GHC for constructing 'Integer' literals.
-mkInteger :: Bool -- ^ sign of integer ('True' if non-negative)
- -> [Int] -- ^ absolute value expressed in 31 bit chunks, least
- -- significant first (ideally these would be machine-word
- -- 'Word's rather than 31-bit truncated 'Int's)
- -> Integer
-mkInteger nonNegative is
- | nonNegative = f is
- | True = negateInteger (f is)
- where
- f [] = S# 0#
- f (I# i : is') = smallInteger (i `andI#` 0x7fffffff#) `orInteger`
- shiftLInteger (f is') 31#
-{-# CONSTANT_FOLDED mkInteger #-}
-
--- | Test whether all internal invariants are satisfied by 'Integer' value
---
--- Returns @1#@ if valid, @0#@ otherwise.
---
--- This operation is mostly useful for test-suites and/or code which
--- constructs 'Integer' values directly.
-isValidInteger# :: Integer -> Int#
-isValidInteger# (S# _) = 1#
-isValidInteger# (Jp# bn)
- = isValidBigNat# bn `andI#` (bn `gtBigNatWord#` INT_MAXBOUND##)
-isValidInteger# (Jn# bn)
- = isValidBigNat# bn `andI#` (bn `gtBigNatWord#` ABS_INT_MINBOUND##)
-
--- | Should rather be called @intToInteger@
-smallInteger :: Int# -> Integer
-smallInteger i# = S# i#
-{-# CONSTANT_FOLDED smallInteger #-}
-
-----------------------------------------------------------------------------
--- Int64/Word64 specific primitives
-
-#if WORD_SIZE_IN_BITS < 64
-int64ToInteger :: Int64# -> Integer
-int64ToInteger i
- | isTrue# (i `leInt64#` intToInt64# 0x7FFFFFFF#)
- , isTrue# (i `geInt64#` intToInt64# -0x80000000#)
- = S# (int64ToInt# i)
- | isTrue# (i `geInt64#` intToInt64# 0#)
- = Jp# (word64ToBigNat (int64ToWord64# i))
- | True
- = Jn# (word64ToBigNat (int64ToWord64# (negateInt64# i)))
-{-# CONSTANT_FOLDED int64ToInteger #-}
-
-word64ToInteger :: Word64# -> Integer
-word64ToInteger w
- | isTrue# (w `leWord64#` wordToWord64# 0x7FFFFFFF##)
- = S# (int64ToInt# (word64ToInt64# w))
- | True
- = Jp# (word64ToBigNat w)
-{-# CONSTANT_FOLDED word64ToInteger #-}
-
-integerToInt64 :: Integer -> Int64#
-integerToInt64 (S# i#) = intToInt64# i#
-integerToInt64 (Jp# bn) = word64ToInt64# (bigNatToWord64 bn)
-integerToInt64 (Jn# bn) = negateInt64# (word64ToInt64# (bigNatToWord64 bn))
-{-# CONSTANT_FOLDED integerToInt64 #-}
-
-integerToWord64 :: Integer -> Word64#
-integerToWord64 (S# i#) = int64ToWord64# (intToInt64# i#)
-integerToWord64 (Jp# bn) = bigNatToWord64 bn
-integerToWord64 (Jn# bn)
- = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64 bn)))
-{-# CONSTANT_FOLDED integerToWord64 #-}
-
-#if GMP_LIMB_BITS == 32
-word64ToBigNat :: Word64# -> BigNat
-word64ToBigNat w64 = wordToBigNat2 wh# wl#
- where
- wh# = word64ToWord# (uncheckedShiftRL64# w64 32#)
- wl# = word64ToWord# w64
-
-bigNatToWord64 :: BigNat -> Word64#
-bigNatToWord64 bn
- | isTrue# (sizeofBigNat# bn ># 1#)
- = let wh# = wordToWord64# (indexBigNat# bn 1#)
- in uncheckedShiftL64# wh# 32# `or64#` wl#
- | True = wl#
- where
- wl# = wordToWord64# (bigNatToWord bn)
-#endif
-#endif
-
--- End of Int64/Word64 specific primitives
-----------------------------------------------------------------------------
-
--- | Truncates 'Integer' to least-significant 'Int#'
-integerToInt :: Integer -> Int#
-integerToInt (S# i#) = i#
-integerToInt (Jp# bn) = bigNatToInt bn
-integerToInt (Jn# bn) = negateInt# (bigNatToInt bn)
-{-# CONSTANT_FOLDED integerToInt #-}
-
-hashInteger :: Integer -> Int#
-hashInteger = integerToInt -- emulating what integer-{simple,gmp} already do
-
-integerToWord :: Integer -> Word#
-integerToWord (S# i#) = int2Word# i#
-integerToWord (Jp# bn) = bigNatToWord bn
-integerToWord (Jn# bn) = int2Word# (negateInt# (bigNatToInt bn))
-{-# CONSTANT_FOLDED integerToWord #-}
-
-wordToInteger :: Word# -> Integer
-wordToInteger w#
- | isTrue# (i# >=# 0#) = S# i#
- | True = Jp# (wordToBigNat w#)
- where
- i# = word2Int# w#
-{-# CONSTANT_FOLDED wordToInteger #-}
-
-wordToNegInteger :: Word# -> Integer
-wordToNegInteger w#
- | isTrue# (i# <=# 0#) = S# i#
- | True = Jn# (wordToBigNat w#)
- where
- i# = negateInt# (word2Int# w#)
-
--- we could almost auto-derive Ord if it wasn't for the Jn#-Jn# case
-compareInteger :: Integer -> Integer -> Ordering
-compareInteger (Jn# x) (Jn# y) = compareBigNat y x
-compareInteger (S# x) (S# y) = compareInt# x y
-compareInteger (Jp# x) (Jp# y) = compareBigNat x y
-compareInteger (Jn# _) _ = LT
-compareInteger (S# _) (Jp# _) = LT
-compareInteger (S# _) (Jn# _) = GT
-compareInteger (Jp# _) _ = GT
-{-# CONSTANT_FOLDED compareInteger #-}
-
-isNegInteger# :: Integer -> Int#
-isNegInteger# (S# i#) = i# <# 0#
-isNegInteger# (Jp# _) = 0#
-isNegInteger# (Jn# _) = 1#
-
--- | Not-equal predicate.
-neqInteger :: Integer -> Integer -> Bool
-neqInteger x y = isTrue# (neqInteger# x y)
-
-eqInteger, leInteger, ltInteger, gtInteger, geInteger
- :: Integer -> Integer -> Bool
-eqInteger x y = isTrue# (eqInteger# x y)
-leInteger x y = isTrue# (leInteger# x y)
-ltInteger x y = isTrue# (ltInteger# x y)
-gtInteger x y = isTrue# (gtInteger# x y)
-geInteger x y = isTrue# (geInteger# x y)
-
-eqInteger#, neqInteger#, leInteger#, ltInteger#, gtInteger#, geInteger#
- :: Integer -> Integer -> Int#
-eqInteger# (S# x#) (S# y#) = x# ==# y#
-eqInteger# (Jn# x) (Jn# y) = eqBigNat# x y
-eqInteger# (Jp# x) (Jp# y) = eqBigNat# x y
-eqInteger# _ _ = 0#
-{-# CONSTANT_FOLDED eqInteger# #-}
-
-neqInteger# (S# x#) (S# y#) = x# /=# y#
-neqInteger# (Jn# x) (Jn# y) = neqBigNat# x y
-neqInteger# (Jp# x) (Jp# y) = neqBigNat# x y
-neqInteger# _ _ = 1#
-{-# CONSTANT_FOLDED neqInteger# #-}
-
-
-gtInteger# (S# x#) (S# y#) = x# ># y#
-gtInteger# x y | inline compareInteger x y == GT = 1#
-gtInteger# _ _ = 0#
-{-# CONSTANT_FOLDED gtInteger# #-}
-
-leInteger# (S# x#) (S# y#) = x# <=# y#
-leInteger# x y | inline compareInteger x y /= GT = 1#
-leInteger# _ _ = 0#
-{-# CONSTANT_FOLDED leInteger# #-}
-
-ltInteger# (S# x#) (S# y#) = x# <# y#
-ltInteger# x y | inline compareInteger x y == LT = 1#
-ltInteger# _ _ = 0#
-{-# CONSTANT_FOLDED ltInteger# #-}
-
-geInteger# (S# x#) (S# y#) = x# >=# y#
-geInteger# x y | inline compareInteger x y /= LT = 1#
-geInteger# _ _ = 0#
-{-# CONSTANT_FOLDED geInteger# #-}
-
--- | Compute absolute value of an 'Integer'
-absInteger :: Integer -> Integer
-absInteger (Jn# n) = Jp# n
-absInteger (S# INT_MINBOUND#) = Jp# (wordToBigNat ABS_INT_MINBOUND##)
-absInteger (S# i#) | isTrue# (i# <# 0#) = S# (negateInt# i#)
-absInteger i@(S# _) = i
-absInteger i@(Jp# _) = i
-{-# CONSTANT_FOLDED absInteger #-}
-
--- | Return @-1@, @0@, and @1@ depending on whether argument is
--- negative, zero, or positive, respectively
-signumInteger :: Integer -> Integer
-signumInteger j = S# (signumInteger# j)
-{-# CONSTANT_FOLDED signumInteger #-}
-
--- | Return @-1#@, @0#@, and @1#@ depending on whether argument is
--- negative, zero, or positive, respectively
-signumInteger# :: Integer -> Int#
-signumInteger# (Jn# _) = -1#
-signumInteger# (S# i#) = sgnI# i#
-signumInteger# (Jp# _ ) = 1#
-
--- | Negate 'Integer'
-negateInteger :: Integer -> Integer
-negateInteger (Jn# n) = Jp# n
-negateInteger (S# INT_MINBOUND#) = Jp# (wordToBigNat ABS_INT_MINBOUND##)
-negateInteger (S# i#) = S# (negateInt# i#)
-negateInteger (Jp# bn)
- | isTrue# (eqBigNatWord# bn ABS_INT_MINBOUND##) = S# INT_MINBOUND#
- | True = Jn# bn
-{-# CONSTANT_FOLDED negateInteger #-}
-
--- one edge-case issue to take into account is that Int's range is not
--- symmetric around 0. I.e. @minBound+maxBound = -1@
---
--- Jp# is used iff n > maxBound::Int
--- Jn# is used iff n < minBound::Int
-
--- | Add two 'Integer's
-plusInteger :: Integer -> Integer -> Integer
-plusInteger x (S# 0#) = x
-plusInteger (S# 0#) y = y
-plusInteger (S# x#) (S# y#)
- = case addIntC# x# y# of
- (# z#, 0# #) -> S# z#
- (# 0#, _ #) -> Jn# (wordToBigNat2 1## 0##) -- 2*minBound::Int
- (# z#, _ #)
- | isTrue# (z# ># 0#) -> Jn# (wordToBigNat ( (int2Word# (negateInt# z#))))
- | True -> Jp# (wordToBigNat ( (int2Word# z#)))
-plusInteger y@(S# _) x = plusInteger x y
--- no S# as first arg from here on
-plusInteger (Jp# x) (Jp# y) = Jp# (plusBigNat x y)
-plusInteger (Jn# x) (Jn# y) = Jn# (plusBigNat x y)
-plusInteger (Jp# x) (S# y#) -- edge-case: @(maxBound+1) + minBound == 0@
- | isTrue# (y# >=# 0#) = Jp# (plusBigNatWord x (int2Word# y#))
- | True = bigNatToInteger (minusBigNatWord x (int2Word#
- (negateInt# y#)))
-plusInteger (Jn# x) (S# y#) -- edge-case: @(minBound-1) + maxBound == -2@
- | isTrue# (y# >=# 0#) = bigNatToNegInteger (minusBigNatWord x (int2Word# y#))
- | True = Jn# (plusBigNatWord x (int2Word# (negateInt# y#)))
-plusInteger y@(Jn# _) x@(Jp# _) = plusInteger x y
-plusInteger (Jp# x) (Jn# y)
- = case compareBigNat x y of
- LT -> bigNatToNegInteger (minusBigNat y x)
- EQ -> S# 0#
- GT -> bigNatToInteger (minusBigNat x y)
-{-# CONSTANT_FOLDED plusInteger #-}
-
--- | Subtract one 'Integer' from another.
-minusInteger :: Integer -> Integer -> Integer
-minusInteger x (S# 0#) = x
-minusInteger (S# x#) (S# y#)
- = case subIntC# x# y# of
- (# z#, 0# #) -> S# z#
- (# 0#, _ #) -> Jn# (wordToBigNat2 1## 0##)
- (# z#, _ #)
- | isTrue# (z# ># 0#) -> Jn# (wordToBigNat ( (int2Word# (negateInt# z#))))
- | True -> Jp# (wordToBigNat ( (int2Word# z#)))
-minusInteger (S# x#) (Jp# y)
- | isTrue# (x# >=# 0#) = bigNatToNegInteger (minusBigNatWord y (int2Word# x#))
- | True = Jn# (plusBigNatWord y (int2Word# (negateInt# x#)))
-minusInteger (S# x#) (Jn# y)
- | isTrue# (x# >=# 0#) = Jp# (plusBigNatWord y (int2Word# x#))
- | True = bigNatToInteger (minusBigNatWord y (int2Word#
- (negateInt# x#)))
-minusInteger (Jp# x) (Jp# y)
- = case compareBigNat x y of
- LT -> bigNatToNegInteger (minusBigNat y x)
- EQ -> S# 0#
- GT -> bigNatToInteger (minusBigNat x y)
-minusInteger (Jp# x) (Jn# y) = Jp# (plusBigNat x y)
-minusInteger (Jn# x) (Jp# y) = Jn# (plusBigNat x y)
-minusInteger (Jn# x) (Jn# y)
- = case compareBigNat x y of
- LT -> bigNatToInteger (minusBigNat y x)
- EQ -> S# 0#
- GT -> bigNatToNegInteger (minusBigNat x y)
-minusInteger (Jp# x) (S# y#)
- | isTrue# (y# >=# 0#) = bigNatToInteger (minusBigNatWord x (int2Word# y#))
- | True = Jp# (plusBigNatWord x (int2Word# (negateInt# y#)))
-minusInteger (Jn# x) (S# y#)
- | isTrue# (y# >=# 0#) = Jn# (plusBigNatWord x (int2Word# y#))
- | True = bigNatToNegInteger (minusBigNatWord x
- (int2Word# (negateInt# y#)))
-{-# CONSTANT_FOLDED minusInteger #-}
-
--- | Multiply two 'Integer's
-timesInteger :: Integer -> Integer -> Integer
-timesInteger !_ (S# 0#) = S# 0#
-timesInteger (S# 0#) _ = S# 0#
-timesInteger x (S# 1#) = x
-timesInteger (S# 1#) y = y
-timesInteger x (S# -1#) = negateInteger x
-timesInteger (S# -1#) y = negateInteger y
-timesInteger (S# x#) (S# y#) = case timesInt2# x# y# of
- (# 0#, _h, l #) -> S# l
- (# _ , h, l #) -> int2ToInteger h l
-timesInteger x@(S# _) y = timesInteger y x
--- no S# as first arg from here on
-timesInteger (Jp# x) (Jp# y) = Jp# (timesBigNat x y)
-timesInteger (Jp# x) (Jn# y) = Jn# (timesBigNat x y)
-timesInteger (Jp# x) (S# y#)
- | isTrue# (y# >=# 0#) = Jp# (timesBigNatWord x (int2Word# y#))
- | True = Jn# (timesBigNatWord x (int2Word# (negateInt# y#)))
-timesInteger (Jn# x) (Jn# y) = Jp# (timesBigNat x y)
-timesInteger (Jn# x) (Jp# y) = Jn# (timesBigNat x y)
-timesInteger (Jn# x) (S# y#)
- | isTrue# (y# >=# 0#) = Jn# (timesBigNatWord x (int2Word# y#))
- | True = Jp# (timesBigNatWord x (int2Word# (negateInt# y#)))
-{-# CONSTANT_FOLDED timesInteger #-}
-
--- | Square 'Integer'
-sqrInteger :: Integer -> Integer
-sqrInteger (S# INT_MINBOUND#) = timesInt2Integer INT_MINBOUND# INT_MINBOUND#
-sqrInteger (S# j#) | isTrue# (absI# j# <=# SQRT_INT_MAXBOUND#) = S# (j# *# j#)
-sqrInteger (S# j#) = timesInt2Integer j# j#
-sqrInteger (Jp# bn) = Jp# (sqrBigNat bn)
-sqrInteger (Jn# bn) = Jp# (sqrBigNat bn)
-
--- | Convert two Int# (resp. high and low bits of a double-word Int#) into an
--- Integer
---
--- Warning: currently it doesn't handle the case where high=minBound and low=0
--- (i.e. high:low = 100......00 = minBound for a double-word Int)
-int2ToInteger :: Int# -> Int# -> Integer
-int2ToInteger h l
- | isTrue# (h <# 0#) =
- case addWordC# (not# (int2Word# l)) 1## of -- two's complement...
- (# lw,c #) -> Jn# (wordToBigNat2
- -- add the carry to the high word
- (int2Word# c `plusWord#` not# (int2Word# h))
- lw
- )
- | True = Jp# (wordToBigNat2 (int2Word# h) (int2Word# l))
-
--- | Construct 'Integer' from the product of two 'Int#'s
-timesInt2Integer :: Int# -> Int# -> Integer
-timesInt2Integer x# y# = case (# isTrue# (x# >=# 0#), isTrue# (y# >=# 0#) #) of
- (# False, False #) -> case timesWord2# (int2Word# (negateInt# x#))
- (int2Word# (negateInt# y#)) of
- (# 0##,l #) -> inline wordToInteger l
- (# h ,l #) -> Jp# (wordToBigNat2 h l)
-
- (# True, False #) -> case timesWord2# (int2Word# x#)
- (int2Word# (negateInt# y#)) of
- (# 0##,l #) -> wordToNegInteger l
- (# h ,l #) -> Jn# (wordToBigNat2 h l)
-
- (# False, True #) -> case timesWord2# (int2Word# (negateInt# x#))
- (int2Word# y#) of
- (# 0##,l #) -> wordToNegInteger l
- (# h ,l #) -> Jn# (wordToBigNat2 h l)
-
- (# True, True #) -> case timesWord2# (int2Word# x#)
- (int2Word# y#) of
- (# 0##,l #) -> inline wordToInteger l
- (# h ,l #) -> Jp# (wordToBigNat2 h l)
-
-bigNatToInteger :: BigNat -> Integer
-bigNatToInteger bn
- | isTrue# ((sizeofBigNat# bn ==# 1#) `andI#` (i# >=# 0#)) = S# i#
- | True = Jp# bn
- where
- i# = word2Int# (bigNatToWord bn)
-
-bigNatToNegInteger :: BigNat -> Integer
-bigNatToNegInteger bn
- | isTrue# ((sizeofBigNat# bn ==# 1#) `andI#` (i# <=# 0#)) = S# i#
- | True = Jn# bn
- where
- i# = negateInt# (word2Int# (bigNatToWord bn))
-
--- | Count number of set bits. For negative arguments returns negative
--- population count of negated argument.
-popCountInteger :: Integer -> Int#
-popCountInteger (S# i#)
- | isTrue# (i# >=# 0#) = popCntI# i#
- | True = negateInt# (popCntI# (negateInt# i#))
-popCountInteger (Jp# bn) = popCountBigNat bn
-popCountInteger (Jn# bn) = negateInt# (popCountBigNat bn)
-{-# CONSTANT_FOLDED popCountInteger #-}
-
--- | 'Integer' for which only /n/-th bit is set. Undefined behaviour
--- for negative /n/ values.
-bitInteger :: Int# -> Integer
-bitInteger i#
- | isTrue# (i# <# (GMP_LIMB_BITS# -# 1#)) = S# (uncheckedIShiftL# 1# i#)
- | True = Jp# (bitBigNat i#)
-{-# CONSTANT_FOLDED bitInteger #-}
-
--- | Test if /n/-th bit is set.
-testBitInteger :: Integer -> Int# -> Bool
-testBitInteger !_ n# | isTrue# (n# <# 0#) = False
-testBitInteger (S# i#) n#
- | isTrue# (n# <# GMP_LIMB_BITS#) = isTrue# (((uncheckedIShiftL# 1# n#)
- `andI#` i#) /=# 0#)
- | True = isTrue# (i# <# 0#)
-testBitInteger (Jp# bn) n = testBitBigNat bn n
-testBitInteger (Jn# bn) n = testBitNegBigNat bn n
-{-# CONSTANT_FOLDED testBitInteger #-}
-
--- | Bitwise @NOT@ operation
-complementInteger :: Integer -> Integer
-complementInteger (S# i#) = S# (notI# i#)
-complementInteger (Jp# bn) = Jn# (plusBigNatWord bn 1##)
-complementInteger (Jn# bn) = Jp# (minusBigNatWord bn 1##)
-{-# CONSTANT_FOLDED complementInteger #-}
-
--- | Arithmetic shift-right operation
---
--- Even though the shift-amount is expressed as `Int#`, the result is
--- undefined for negative shift-amounts.
-shiftRInteger :: Integer -> Int# -> Integer
-shiftRInteger x 0# = x
-shiftRInteger (S# i#) n# = S# (iShiftRA# i# n#)
- where
- iShiftRA# a b
- | isTrue# (b >=# WORD_SIZE_IN_BITS#) = (a <# 0#) *# (-1#)
- | True = a `uncheckedIShiftRA#` b
-shiftRInteger (Jp# bn) n# = bigNatToInteger (shiftRBigNat bn n#)
-shiftRInteger (Jn# bn) n#
- = case bigNatToNegInteger (shiftRNegBigNat bn n#) of
- S# 0# -> S# -1#
- r -> r
-{-# CONSTANT_FOLDED shiftRInteger #-}
-
--- | Shift-left operation
---
--- Even though the shift-amount is expressed as `Int#`, the result is
--- undefined for negative shift-amounts.
-shiftLInteger :: Integer -> Int# -> Integer
-shiftLInteger x 0# = x
-shiftLInteger (S# 0#) _ = S# 0#
-shiftLInteger (S# 1#) n# = bitInteger n#
-shiftLInteger (S# i#) n#
- | isTrue# (i# >=# 0#) = bigNatToInteger (shiftLBigNat
- (wordToBigNat (int2Word# i#)) n#)
- | True = bigNatToNegInteger (shiftLBigNat
- (wordToBigNat (int2Word#
- (negateInt# i#))) n#)
-shiftLInteger (Jp# bn) n# = Jp# (shiftLBigNat bn n#)
-shiftLInteger (Jn# bn) n# = Jn# (shiftLBigNat bn n#)
-{-# CONSTANT_FOLDED shiftLInteger #-}
-
--- | Bitwise OR operation
-orInteger :: Integer -> Integer -> Integer
--- short-cuts
-orInteger (S# 0#) y = y
-orInteger x (S# 0#) = x
-orInteger (S# -1#) _ = S# -1#
-orInteger _ (S# -1#) = S# -1#
--- base-cases
-orInteger (S# x#) (S# y#) = S# (orI# x# y#)
-orInteger (Jp# x) (Jp# y) = Jp# (orBigNat x y)
-orInteger (Jn# x) (Jn# y)
- = bigNatToNegInteger (plusBigNatWord (andBigNat
- (minusBigNatWord x 1##)
- (minusBigNatWord y 1##)) 1##)
-orInteger x@(Jn# _) y@(Jp# _) = orInteger y x -- retry with swapped args
-orInteger (Jp# x) (Jn# y)
- = bigNatToNegInteger (plusBigNatWord (andnBigNat (minusBigNatWord y 1##) x)
- 1##)
--- TODO/FIXpromotion-hack
-orInteger x@(S# _) y = orInteger (unsafePromote x) y
-orInteger x y {- S# -}= orInteger x (unsafePromote y)
-{-# CONSTANT_FOLDED orInteger #-}
-
--- | Bitwise XOR operation
-xorInteger :: Integer -> Integer -> Integer
--- short-cuts
-xorInteger (S# 0#) y = y
-xorInteger x (S# 0#) = x
--- TODO: (S# -1) cases
--- base-cases
-xorInteger (S# x#) (S# y#) = S# (xorI# x# y#)
-xorInteger (Jp# x) (Jp# y) = bigNatToInteger (xorBigNat x y)
-xorInteger (Jn# x) (Jn# y)
- = bigNatToInteger (xorBigNat (minusBigNatWord x 1##)
- (minusBigNatWord y 1##))
-xorInteger x@(Jn# _) y@(Jp# _) = xorInteger y x -- retry with swapped args
-xorInteger (Jp# x) (Jn# y)
- = bigNatToNegInteger (plusBigNatWord (xorBigNat x (minusBigNatWord y 1##))
- 1##)
--- TODO/FIXME promotion-hack
-xorInteger x@(S# _) y = xorInteger (unsafePromote x) y
-xorInteger x y {- S# -} = xorInteger x (unsafePromote y)
-{-# CONSTANT_FOLDED xorInteger #-}
-
--- | Bitwise AND operation
-andInteger :: Integer -> Integer -> Integer
--- short-cuts
-andInteger (S# 0#) !_ = S# 0#
-andInteger _ (S# 0#) = S# 0#
-andInteger (S# -1#) y = y
-andInteger x (S# -1#) = x
--- base-cases
-andInteger (S# x#) (S# y#) = S# (andI# x# y#)
-andInteger (Jp# x) (Jp# y) = bigNatToInteger (andBigNat x y)
-andInteger (Jn# x) (Jn# y)
- = bigNatToNegInteger (plusBigNatWord (orBigNat (minusBigNatWord x 1##)
- (minusBigNatWord y 1##)) 1##)
-andInteger x@(Jn# _) y@(Jp# _) = andInteger y x
-andInteger (Jp# x) (Jn# y)
- = bigNatToInteger (andnBigNat x (minusBigNatWord y 1##))
--- TODO/FIXME promotion-hack
-andInteger x@(S# _) y = andInteger (unsafePromote x) y
-andInteger x y {- S# -}= andInteger x (unsafePromote y)
-{-# CONSTANT_FOLDED andInteger #-}
-
--- HACK warning! breaks invariant on purpose
-unsafePromote :: Integer -> Integer
-unsafePromote (S# x#)
- | isTrue# (x# >=# 0#) = Jp# (wordToBigNat (int2Word# x#))
- | True = Jn# (wordToBigNat (int2Word# (negateInt# x#)))
-unsafePromote x = x
-
--- | Simultaneous 'quotInteger' and 'remInteger'.
---
--- Divisor must be non-zero otherwise the GHC runtime will terminate
--- with a division-by-zero fault.
-quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)
-quotRemInteger n (S# 1#) = (# n, S# 0# #)
-quotRemInteger n (S# -1#) = let !q = negateInteger n in (# q, (S# 0#) #)
-quotRemInteger !_ (S# 0#) = (# S# (quotInt# 0# 0#),S# (remInt# 0# 0#) #)
-quotRemInteger (S# 0#) _ = (# S# 0#, S# 0# #)
-quotRemInteger (S# n#) (S# d#) = case quotRemInt# n# d# of
- (# q#, r# #) -> (# S# q#, S# r# #)
-quotRemInteger (Jp# n) (Jp# d) = case quotRemBigNat n d of
- (# q, r #) -> (# bigNatToInteger q, bigNatToInteger r #)
-quotRemInteger (Jp# n) (Jn# d) = case quotRemBigNat n d of
- (# q, r #) -> (# bigNatToNegInteger q, bigNatToInteger r #)
-quotRemInteger (Jn# n) (Jn# d) = case quotRemBigNat n d of
- (# q, r #) -> (# bigNatToInteger q, bigNatToNegInteger r #)
-quotRemInteger (Jn# n) (Jp# d) = case quotRemBigNat n d of
- (# q, r #) -> (# bigNatToNegInteger q, bigNatToNegInteger r #)
-quotRemInteger (Jp# n) (S# d#)
- | isTrue# (d# >=# 0#) = case quotRemBigNatWord n (int2Word# d#) of
- (# q, r# #) -> (# bigNatToInteger q, inline wordToInteger r# #)
- | True = case quotRemBigNatWord n (int2Word# (negateInt# d#)) of
- (# q, r# #) -> (# bigNatToNegInteger q, inline wordToInteger r# #)
-quotRemInteger (Jn# n) (S# d#)
- | isTrue# (d# >=# 0#) = case quotRemBigNatWord n (int2Word# d#) of
- (# q, r# #) -> (# bigNatToNegInteger q, wordToNegInteger r# #)
- | True = case quotRemBigNatWord n (int2Word# (negateInt# d#)) of
- (# q, r# #) -> (# bigNatToInteger q, wordToNegInteger r# #)
-quotRemInteger n@(S# _) (Jn# _) = (# S# 0#, n #) -- since @n < d@
-quotRemInteger n@(S# n#) (Jp# d) -- need to account for (S# minBound)
- | isTrue# (n# ># 0#) = (# S# 0#, n #)
- | isTrue# (gtBigNatWord# d (int2Word# (negateInt# n#))) = (# S# 0#, n #)
- | True {- abs(n) == d -} = (# S# -1#, S# 0# #)
-{-# CONSTANT_FOLDED quotRemInteger #-}
-
-
-quotInteger :: Integer -> Integer -> Integer
-quotInteger n (S# 1#) = n
-quotInteger n (S# -1#) = negateInteger n
-quotInteger !_ (S# 0#) = S# (quotInt# 0# 0#)
-quotInteger (S# 0#) _ = S# 0#
-quotInteger (S# n#) (S# d#) = S# (quotInt# n# d#)
-quotInteger (Jp# n) (S# d#)
- | isTrue# (d# >=# 0#) = bigNatToInteger (quotBigNatWord n (int2Word# d#))
- | True = bigNatToNegInteger (quotBigNatWord n
- (int2Word# (negateInt# d#)))
-quotInteger (Jn# n) (S# d#)
- | isTrue# (d# >=# 0#) = bigNatToNegInteger (quotBigNatWord n (int2Word# d#))
- | True = bigNatToInteger (quotBigNatWord n
- (int2Word# (negateInt# d#)))
-quotInteger (Jp# n) (Jp# d) = bigNatToInteger (quotBigNat n d)
-quotInteger (Jp# n) (Jn# d) = bigNatToNegInteger (quotBigNat n d)
-quotInteger (Jn# n) (Jp# d) = bigNatToNegInteger (quotBigNat n d)
-quotInteger (Jn# n) (Jn# d) = bigNatToInteger (quotBigNat n d)
--- handle remaining non-allocating cases
-quotInteger n d = case inline quotRemInteger n d of (# q, _ #) -> q
-{-# CONSTANT_FOLDED quotInteger #-}
-
-remInteger :: Integer -> Integer -> Integer
-remInteger !_ (S# 1#) = S# 0#
-remInteger _ (S# -1#) = S# 0#
-remInteger _ (S# 0#) = S# (remInt# 0# 0#)
-remInteger (S# 0#) _ = S# 0#
-remInteger (S# n#) (S# d#) = S# (remInt# n# d#)
-remInteger (Jp# n) (S# d#)
- = wordToInteger (remBigNatWord n (int2Word# (absI# d#)))
-remInteger (Jn# n) (S# d#)
- = wordToNegInteger (remBigNatWord n (int2Word# (absI# d#)))
-remInteger (Jp# n) (Jp# d) = bigNatToInteger (remBigNat n d)
-remInteger (Jp# n) (Jn# d) = bigNatToInteger (remBigNat n d)
-remInteger (Jn# n) (Jp# d) = bigNatToNegInteger (remBigNat n d)
-remInteger (Jn# n) (Jn# d) = bigNatToNegInteger (remBigNat n d)
--- handle remaining non-allocating cases
-remInteger n d = case inline quotRemInteger n d of (# _, r #) -> r
-{-# CONSTANT_FOLDED remInteger #-}
-
--- | Simultaneous 'divInteger' and 'modInteger'.
---
--- Divisor must be non-zero otherwise the GHC runtime will terminate
--- with a division-by-zero fault.
-divModInteger :: Integer -> Integer -> (# Integer, Integer #)
-divModInteger n d
- | isTrue# (signumInteger# r ==# negateInt# (signumInteger# d))
- = let !q' = plusInteger q (S# -1#) -- TODO: optimize
- !r' = plusInteger r d
- in (# q', r' #)
- | True = qr
- where
- !qr@(# q, r #) = quotRemInteger n d
-{-# CONSTANT_FOLDED divModInteger #-}
-
-divInteger :: Integer -> Integer -> Integer
--- same-sign ops can be handled by more efficient 'quotInteger'
-divInteger n d | isTrue# (isNegInteger# n ==# isNegInteger# d) = quotInteger n d
-divInteger n d = case inline divModInteger n d of (# q, _ #) -> q
-{-# CONSTANT_FOLDED divInteger #-}
-
-modInteger :: Integer -> Integer -> Integer
--- same-sign ops can be handled by more efficient 'remInteger'
-modInteger n d | isTrue# (isNegInteger# n ==# isNegInteger# d) = remInteger n d
-modInteger n d = case inline divModInteger n d of (# _, r #) -> r
-{-# CONSTANT_FOLDED modInteger #-}
-
--- | Compute greatest common divisor.
-gcdInteger :: Integer -> Integer -> Integer
-gcdInteger (S# 0#) b = absInteger b
-gcdInteger a (S# 0#) = absInteger a
-gcdInteger (S# 1#) _ = S# 1#
-gcdInteger (S# -1#) _ = S# 1#
-gcdInteger _ (S# 1#) = S# 1#
-gcdInteger _ (S# -1#) = S# 1#
-gcdInteger (S# a#) (S# b#)
- = wordToInteger (gcdWord# (int2Word# (absI# a#)) (int2Word# (absI# b#)))
-gcdInteger a@(S# _) b = gcdInteger b a
-gcdInteger (Jn# a) b = gcdInteger (Jp# a) b
-gcdInteger (Jp# a) (Jp# b) = bigNatToInteger (gcdBigNat a b)
-gcdInteger (Jp# a) (Jn# b) = bigNatToInteger (gcdBigNat a b)
-gcdInteger (Jp# a) (S# b#)
- = wordToInteger (gcdBigNatWord a (int2Word# (absI# b#)))
-{-# CONSTANT_FOLDED gcdInteger #-}
-
--- | Compute least common multiple.
-lcmInteger :: Integer -> Integer -> Integer
-lcmInteger (S# 0#) !_ = S# 0#
-lcmInteger (S# 1#) b = absInteger b
-lcmInteger (S# -1#) b = absInteger b
-lcmInteger _ (S# 0#) = S# 0#
-lcmInteger a (S# 1#) = absInteger a
-lcmInteger a (S# -1#) = absInteger a
-lcmInteger a b = (aa `quotInteger` (aa `gcdInteger` ab)) `timesInteger` ab
- where
- aa = absInteger a
- ab = absInteger b
-{-# CONSTANT_FOLDED lcmInteger #-}
-
--- | Compute greatest common divisor.
---
--- __Warning__: result may become negative if (at least) one argument
--- is 'minBound'
-gcdInt :: Int# -> Int# -> Int#
-gcdInt x# y#
- = word2Int# (gcdWord# (int2Word# (absI# x#)) (int2Word# (absI# y#)))
-
--- | Compute greatest common divisor.
---
--- @since 1.0.0.0
-gcdWord :: Word# -> Word# -> Word#
-gcdWord = gcdWord#
-
-----------------------------------------------------------------------------
--- BigNat operations
-
-compareBigNat :: BigNat -> BigNat -> Ordering
-compareBigNat x@(BN# x#) y@(BN# y#)
- | isTrue# (nx# ==# ny#)
- = compareInt# (narrowCInt# (c_mpn_cmp x# y# nx#)) 0#
- | isTrue# (nx# <# ny#) = LT
- | True = GT
- where
- nx# = sizeofBigNat# x
- ny# = sizeofBigNat# y
-
-compareBigNatWord :: BigNat -> GmpLimb# -> Ordering
-compareBigNatWord bn w#
- | isTrue# (sizeofBigNat# bn ==# 1#) = cmpW# (bigNatToWord bn) w#
- | True = GT
-
-gtBigNatWord# :: BigNat -> GmpLimb# -> Int#
-gtBigNatWord# bn w#
- = (sizeofBigNat# bn ># 1#) `orI#` (bigNatToWord bn `gtWord#` w#)
-
-eqBigNat :: BigNat -> BigNat -> Bool
-eqBigNat x y = isTrue# (eqBigNat# x y)
-
-eqBigNat# :: BigNat -> BigNat -> Int#
-eqBigNat# x@(BN# x#) y@(BN# y#)
- | isTrue# (nx# ==# ny#) = c_mpn_cmp x# y# nx# ==# 0#
- | True = 0#
- where
- nx# = sizeofBigNat# x
- ny# = sizeofBigNat# y
-
-neqBigNat# :: BigNat -> BigNat -> Int#
-neqBigNat# x@(BN# x#) y@(BN# y#)
- | isTrue# (nx# ==# ny#) = c_mpn_cmp x# y# nx# /=# 0#
- | True = 1#
- where
- nx# = sizeofBigNat# x
- ny# = sizeofBigNat# y
-
-eqBigNatWord :: BigNat -> GmpLimb# -> Bool
-eqBigNatWord bn w# = isTrue# (eqBigNatWord# bn w#)
-
-eqBigNatWord# :: BigNat -> GmpLimb# -> Int#
-eqBigNatWord# bn w#
- = (sizeofBigNat# bn ==# 1#) `andI#` (bigNatToWord bn `eqWord#` w#)
-
-
--- | Same as @'indexBigNat#' bn 0\#@
-bigNatToWord :: BigNat -> Word#
-bigNatToWord bn = indexBigNat# bn 0#
-
--- | Equivalent to @'word2Int#' . 'bigNatToWord'@
-bigNatToInt :: BigNat -> Int#
-bigNatToInt (BN# ba#) = indexIntArray# ba# 0#
-
--- | CAF representing the value @0 :: BigNat@
-zeroBigNat :: BigNat
-zeroBigNat = runS $ do
- mbn <- newBigNat# 1#
- _ <- svoid (writeBigNat# mbn 0# 0##)
- unsafeFreezeBigNat# mbn
-{-# NOINLINE zeroBigNat #-}
-
--- | Test if 'BigNat' value is equal to zero.
-isZeroBigNat :: BigNat -> Bool
-isZeroBigNat bn = eqBigNatWord bn 0##
-
--- | CAF representing the value @1 :: BigNat@
-oneBigNat :: BigNat
-oneBigNat = runS $ do
- mbn <- newBigNat# 1#
- _ <- svoid (writeBigNat# mbn 0# 1##)
- unsafeFreezeBigNat# mbn
-{-# NOINLINE oneBigNat #-}
-
-czeroBigNat :: BigNat
-czeroBigNat = runS $ do
- mbn <- newBigNat# 1#
- _ <- svoid (writeBigNat# mbn 0# (not# 0##))
- unsafeFreezeBigNat# mbn
-{-# NOINLINE czeroBigNat #-}
-
--- | Special 0-sized bigNat returned in case of arithmetic underflow
---
--- This is currently only returned by the following operations:
---
--- - 'minusBigNat'
--- - 'minusBigNatWord'
---
--- Other operations such as 'quotBigNat' may return 'nullBigNat' as
--- well as a dummy/place-holder value instead of 'undefined' since we
--- can't throw exceptions. But that behaviour should not be relied
--- upon.
---
--- NB: @isValidBigNat# nullBigNat@ is false
-nullBigNat :: BigNat
-nullBigNat = runS (newBigNat# 0# >>= unsafeFreezeBigNat#)
-{-# NOINLINE nullBigNat #-}
-
--- | Test for special 0-sized 'BigNat' representing underflows.
-isNullBigNat# :: BigNat -> Int#
-isNullBigNat# (BN# ba#) = sizeofByteArray# ba# ==# 0#
-
--- | Construct 1-limb 'BigNat' from 'Word#'
-wordToBigNat :: Word# -> BigNat
-wordToBigNat 0## = zeroBigNat
-wordToBigNat 1## = oneBigNat
-wordToBigNat w#
- | isTrue# (not# w# `eqWord#` 0##) = czeroBigNat
- | True = runS $ do
- mbn <- newBigNat# 1#
- _ <- svoid (writeBigNat# mbn 0# w#)
- unsafeFreezeBigNat# mbn
-
--- | Construct BigNat from 2 limbs.
--- The first argument is the most-significant limb.
-wordToBigNat2 :: Word# -> Word# -> BigNat
-wordToBigNat2 0## lw# = wordToBigNat lw#
-wordToBigNat2 hw# lw# = runS $ do
- mbn <- newBigNat# 2#
- _ <- svoid (writeBigNat# mbn 0# lw#)
- _ <- svoid (writeBigNat# mbn 1# hw#)
- unsafeFreezeBigNat# mbn
-
-plusBigNat :: BigNat -> BigNat -> BigNat
-plusBigNat x y
- | isTrue# (eqBigNatWord# x 0##) = y
- | isTrue# (eqBigNatWord# y 0##) = x
- | isTrue# (nx# >=# ny#) = go x nx# y ny#
- | True = go y ny# x nx#
- where
- go (BN# a#) na# (BN# b#) nb# = runS $ do
- mbn@(MBN# mba#) <- newBigNat# na#
- (W# c#) <- liftIO (c_mpn_add mba# a# na# b# nb#)
- case c# of
- 0## -> unsafeFreezeBigNat# mbn
- _ -> unsafeSnocFreezeBigNat# mbn c#
-
- nx# = sizeofBigNat# x
- ny# = sizeofBigNat# y
-
-plusBigNatWord :: BigNat -> GmpLimb# -> BigNat
-plusBigNatWord x 0## = x
-plusBigNatWord x@(BN# x#) y# = runS $ do
- mbn@(MBN# mba#) <- newBigNat# nx#
- (W# c#) <- liftIO (c_mpn_add_1 mba# x# nx# y#)
- case c# of
- 0## -> unsafeFreezeBigNat# mbn
- _ -> unsafeSnocFreezeBigNat# mbn c#
- where
- nx# = sizeofBigNat# x
-
--- | Returns 'nullBigNat' (see 'isNullBigNat#') in case of underflow
-minusBigNat :: BigNat -> BigNat -> BigNat
-minusBigNat x@(BN# x#) y@(BN# y#)
- | isZeroBigNat y = x
- | isTrue# (nx# >=# ny#) = runS $ do
- mbn@(MBN# mba#) <- newBigNat# nx#
- (W# b#) <- liftIO (c_mpn_sub mba# x# nx# y# ny#)
- case b# of
- 0## -> unsafeRenormFreezeBigNat# mbn
- _ -> return nullBigNat
-
- | True = nullBigNat
- where
- nx# = sizeofBigNat# x
- ny# = sizeofBigNat# y
-
--- | Returns 'nullBigNat' (see 'isNullBigNat#') in case of underflow
-minusBigNatWord :: BigNat -> GmpLimb# -> BigNat
-minusBigNatWord x 0## = x
-minusBigNatWord x@(BN# x#) y# = runS $ do
- mbn@(MBN# mba#) <- newBigNat# nx#
- (W# b#) <- liftIO $ c_mpn_sub_1 mba# x# nx# y#
- case b# of
- 0## -> unsafeRenormFreezeBigNat# mbn
- _ -> return nullBigNat
- where
- nx# = sizeofBigNat# x
-
-
-timesBigNat :: BigNat -> BigNat -> BigNat
-timesBigNat x y
- | isZeroBigNat x = zeroBigNat
- | isZeroBigNat y = zeroBigNat
- | isTrue# (nx# >=# ny#) = go x nx# y ny#
- | True = go y ny# x nx#
- where
- go (BN# a#) na# (BN# b#) nb# = runS $ do
- let n# = nx# +# ny#
- mbn@(MBN# mba#) <- newBigNat# n#
- (W# msl#) <- liftIO (c_mpn_mul mba# a# na# b# nb#)
- case msl# of
- 0## -> unsafeShrinkFreezeBigNat# mbn (n# -# 1#)
- _ -> unsafeFreezeBigNat# mbn
-
- nx# = sizeofBigNat# x
- ny# = sizeofBigNat# y
-
--- | Square 'BigNat'
-sqrBigNat :: BigNat -> BigNat
-sqrBigNat x
- | isZeroBigNat x = zeroBigNat
- -- TODO: 1-limb BigNats below sqrt(maxBound::GmpLimb)
-sqrBigNat x = timesBigNat x x -- TODO: mpn_sqr
-
-timesBigNatWord :: BigNat -> GmpLimb# -> BigNat
-timesBigNatWord !_ 0## = zeroBigNat
-timesBigNatWord x 1## = x
-timesBigNatWord x@(BN# x#) y#
- | isTrue# (nx# ==# 1#) =
- let !(# !h#, !l# #) = timesWord2# (bigNatToWord x) y#
- in wordToBigNat2 h# l#
- | True = runS $ do
- mbn@(MBN# mba#) <- newBigNat# nx#
- (W# msl#) <- liftIO (c_mpn_mul_1 mba# x# nx# y#)
- case msl# of
- 0## -> unsafeFreezeBigNat# mbn
- _ -> unsafeSnocFreezeBigNat# mbn msl#
-
- where
- nx# = sizeofBigNat# x
-
--- | Specialised version of
---
--- > bitBigNat = shiftLBigNat (wordToBigNat 1##)
---
--- avoiding a few redundant allocations
-bitBigNat :: Int# -> BigNat
-bitBigNat i#
- | isTrue# (i# <# 0#) = zeroBigNat -- or maybe 'nullBigNat'?
- | isTrue# (i# ==# 0#) = oneBigNat
- | True = runS $ do
- mbn@(MBN# mba#) <- newBigNat# (li# +# 1#)
- -- FIXME: do we really need to zero-init MBAs returned by 'newByteArray#'?
- -- clear all limbs (except for the most-significant limb)
- _ <- svoid (clearWordArray# mba# 0# li#)
- -- set single bit in most-significant limb
- _ <- svoid (writeBigNat# mbn li# (uncheckedShiftL# 1## bi#))
- unsafeFreezeBigNat# mbn
- where
- !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#
-
-testBitBigNat :: BigNat -> Int# -> Bool
-testBitBigNat bn i#
- | isTrue# (i# <# 0#) = False
- | isTrue# (li# <# nx#) = isTrue# (testBitWord# (indexBigNat# bn li#) bi#)
- | True = False
- where
- !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#
- nx# = sizeofBigNat# bn
-
-testBitNegBigNat :: BigNat -> Int# -> Bool
-testBitNegBigNat bn i#
- | isTrue# (i# <# 0#) = False
- | isTrue# (li# >=# nx#) = True
- | allZ li# = isTrue# ((testBitWord#
- (indexBigNat# bn li# `minusWord#` 1##) bi#) ==# 0#)
- | True = isTrue# ((testBitWord# (indexBigNat# bn li#) bi#) ==# 0#)
- where
- !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#
- nx# = sizeofBigNat# bn
-
- allZ 0# = True
- allZ j | isTrue# (indexBigNat# bn (j -# 1#) `eqWord#` 0##) = allZ (j -# 1#)
- | True = False
-
-
-clearBitBigNat :: BigNat -> Int# -> BigNat
-clearBitBigNat bn i#
- | not (inline testBitBigNat bn i#) = bn
- | isTrue# (nx# ==# 1#) = wordToBigNat (bigNatToWord bn `xor#` bitWord# bi#)
- | isTrue# (li# +# 1# ==# nx#) = -- special case, operating on most-sig limb
- case indexBigNat# bn li# `xor#` bitWord# bi# of
- 0## -> do -- most-sig limb became zero -> result has less limbs
- case fmssl bn (li# -# 1#) of
- 0# -> zeroBigNat
- n# -> runS $ do
- mbn <- newBigNat# n#
- _ <- copyWordArray bn 0# mbn 0# n#
- unsafeFreezeBigNat# mbn
- newlimb# -> runS $ do -- no shrinking
- mbn <- newBigNat# nx#
- _ <- copyWordArray bn 0# mbn 0# li#
- _ <- svoid (writeBigNat# mbn li# newlimb#)
- unsafeFreezeBigNat# mbn
-
- | True = runS $ do
- mbn <- newBigNat# nx#
- _ <- copyWordArray bn 0# mbn 0# nx#
- let newlimb# = indexBigNat# bn li# `xor#` bitWord# bi#
- _ <- svoid (writeBigNat# mbn li# newlimb#)
- unsafeFreezeBigNat# mbn
-
- where
- !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#
- nx# = sizeofBigNat# bn
-
-
-
-setBitBigNat :: BigNat -> Int# -> BigNat
-setBitBigNat bn i#
- | inline testBitBigNat bn i# = bn
- | isTrue# (d# ># 0#) = runS $ do -- result BigNat will have more limbs
- mbn@(MBN# mba#) <- newBigNat# (li# +# 1#)
- _ <- copyWordArray bn 0# mbn 0# nx#
- _ <- svoid (clearWordArray# mba# nx# (d# -# 1#))
- _ <- svoid (writeBigNat# mbn li# (bitWord# bi#))
- unsafeFreezeBigNat# mbn
-
- | True = runS $ do
- mbn <- newBigNat# nx#
- _ <- copyWordArray bn 0# mbn 0# nx#
- _ <- svoid (writeBigNat# mbn li# (indexBigNat# bn li#
- `or#` bitWord# bi#))
- unsafeFreezeBigNat# mbn
-
- where
- !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#
- nx# = sizeofBigNat# bn
- d# = li# +# 1# -# nx#
-
-
-complementBitBigNat :: BigNat -> Int# -> BigNat
-complementBitBigNat bn i#
- | testBitBigNat bn i# = clearBitBigNat bn i#
- | True = setBitBigNat bn i#
-
-popCountBigNat :: BigNat -> Int#
-popCountBigNat bn@(BN# ba#) = word2Int# (c_mpn_popcount ba# (sizeofBigNat# bn))
-
-
-shiftLBigNat :: BigNat -> Int# -> BigNat
-shiftLBigNat x 0# = x
-shiftLBigNat x _ | isZeroBigNat x = zeroBigNat
-shiftLBigNat x@(BN# xba#) n# = runS $ do
- ymbn@(MBN# ymba#) <- newBigNat# yn#
- W# ymsl <- liftIO (c_mpn_lshift ymba# xba# xn# (int2Word# n#))
- case ymsl of
- 0## -> unsafeShrinkFreezeBigNat# ymbn (yn# -# 1#)
- _ -> unsafeFreezeBigNat# ymbn
- where
- xn# = sizeofBigNat# x
- yn# = xn# +# nlimbs# +# (nbits# /=# 0#)
- !(# nlimbs#, nbits# #) = quotRemInt# n# GMP_LIMB_BITS#
-
-
-
-shiftRBigNat :: BigNat -> Int# -> BigNat
-shiftRBigNat x 0# = x
-shiftRBigNat x _ | isZeroBigNat x = zeroBigNat
-shiftRBigNat x@(BN# xba#) n#
- | isTrue# (nlimbs# >=# xn#) = zeroBigNat
- | True = runS $ do
- ymbn@(MBN# ymba#) <- newBigNat# yn#
- W# ymsl <- liftIO (c_mpn_rshift ymba# xba# xn# (int2Word# n#))
- case ymsl of
- 0## -> unsafeRenormFreezeBigNat# ymbn -- may shrink more than one
- _ -> unsafeFreezeBigNat# ymbn
- where
- xn# = sizeofBigNat# x
- yn# = xn# -# nlimbs#
- nlimbs# = quotInt# n# GMP_LIMB_BITS#
-
-shiftRNegBigNat :: BigNat -> Int# -> BigNat
-shiftRNegBigNat x 0# = x
-shiftRNegBigNat x _ | isZeroBigNat x = zeroBigNat
-shiftRNegBigNat x@(BN# xba#) n#
- | isTrue# (nlimbs# >=# xn#) = zeroBigNat
- | True = runS $ do
- ymbn@(MBN# ymba#) <- newBigNat# yn#
- W# ymsl <- liftIO (c_mpn_rshift_2c ymba# xba# xn# (int2Word# n#))
- case ymsl of
- 0## -> unsafeRenormFreezeBigNat# ymbn -- may shrink more than one
- _ -> unsafeFreezeBigNat# ymbn
- where
- xn# = sizeofBigNat# x
- yn# = xn# -# nlimbs#
- nlimbs# = quotInt# (n# -# 1#) GMP_LIMB_BITS#
-
-
-orBigNat :: BigNat -> BigNat -> BigNat
-orBigNat x@(BN# x#) y@(BN# y#)
- | isZeroBigNat x = y
- | isZeroBigNat y = x
- | isTrue# (nx# >=# ny#) = runS (ior' x# nx# y# ny#)
- | True = runS (ior' y# ny# x# nx#)
- where
- ior' a# na# b# nb# = do -- na >= nb
- mbn@(MBN# mba#) <- newBigNat# na#
- _ <- liftIO (c_mpn_ior_n mba# a# b# nb#)
- _ <- case isTrue# (na# ==# nb#) of
- False -> svoid (copyWordArray# a# nb# mba# nb# (na# -# nb#))
- True -> return ()
- unsafeFreezeBigNat# mbn
-
- nx# = sizeofBigNat# x
- ny# = sizeofBigNat# y
-
-
-xorBigNat :: BigNat -> BigNat -> BigNat
-xorBigNat x@(BN# x#) y@(BN# y#)
- | isZeroBigNat x = y
- | isZeroBigNat y = x
- | isTrue# (nx# >=# ny#) = runS (xor' x# nx# y# ny#)
- | True = runS (xor' y# ny# x# nx#)
- where
- xor' a# na# b# nb# = do -- na >= nb
- mbn@(MBN# mba#) <- newBigNat# na#
- _ <- liftIO (c_mpn_xor_n mba# a# b# nb#)
- case isTrue# (na# ==# nb#) of
- False -> do _ <- svoid (copyWordArray# a# nb# mba# nb# (na# -# nb#))
- unsafeFreezeBigNat# mbn
- True -> unsafeRenormFreezeBigNat# mbn
-
- nx# = sizeofBigNat# x
- ny# = sizeofBigNat# y
-
--- | aka @\x y -> x .&. (complement y)@
-andnBigNat :: BigNat -> BigNat -> BigNat
-andnBigNat x@(BN# x#) y@(BN# y#)
- | isZeroBigNat x = zeroBigNat
- | isZeroBigNat y = x
- | True = runS $ do
- mbn@(MBN# mba#) <- newBigNat# nx#
- _ <- liftIO (c_mpn_andn_n mba# x# y# n#)
- _ <- case isTrue# (nx# ==# n#) of
- False -> svoid (copyWordArray# x# n# mba# n# (nx# -# n#))
- True -> return ()
- unsafeRenormFreezeBigNat# mbn
- where
- n# | isTrue# (nx# <# ny#) = nx#
- | True = ny#
- nx# = sizeofBigNat# x
- ny# = sizeofBigNat# y
-
-
-andBigNat :: BigNat -> BigNat -> BigNat
-andBigNat x@(BN# x#) y@(BN# y#)
- | isZeroBigNat x = zeroBigNat
- | isZeroBigNat y = zeroBigNat
- | True = runS $ do
- mbn@(MBN# mba#) <- newBigNat# n#
- _ <- liftIO (c_mpn_and_n mba# x# y# n#)
- unsafeRenormFreezeBigNat# mbn
- where
- n# | isTrue# (nx# <# ny#) = nx#
- | True = ny#
- nx# = sizeofBigNat# x
- ny# = sizeofBigNat# y
-
--- | If divisor is zero, @(\# 'nullBigNat', 'nullBigNat' \#)@ is returned
-quotRemBigNat :: BigNat -> BigNat -> (# BigNat,BigNat #)
-quotRemBigNat n@(BN# nba#) d@(BN# dba#)
- | isZeroBigNat d = (# nullBigNat, nullBigNat #)
- | eqBigNatWord d 1## = (# n, zeroBigNat #)
- | n < d = (# zeroBigNat, n #)
- | True = case runS go of (!q,!r) -> (# q, r #)
- where
- nn# = sizeofBigNat# n
- dn# = sizeofBigNat# d
- qn# = 1# +# nn# -# dn#
- rn# = dn#
-
- go = do
- qmbn@(MBN# qmba#) <- newBigNat# qn#
- rmbn@(MBN# rmba#) <- newBigNat# rn#
-
- _ <- liftIO (c_mpn_tdiv_qr qmba# rmba# 0# nba# nn# dba# dn#)
-
- q <- unsafeRenormFreezeBigNat# qmbn
- r <- unsafeRenormFreezeBigNat# rmbn
- return (q, r)
-
-quotBigNat :: BigNat -> BigNat -> BigNat
-quotBigNat n@(BN# nba#) d@(BN# dba#)
- | isZeroBigNat d = nullBigNat
- | eqBigNatWord d 1## = n
- | n < d = zeroBigNat
- | True = runS $ do
- let nn# = sizeofBigNat# n
- let dn# = sizeofBigNat# d
- let qn# = 1# +# nn# -# dn#
- qmbn@(MBN# qmba#) <- newBigNat# qn#
- _ <- liftIO (c_mpn_tdiv_q qmba# nba# nn# dba# dn#)
- unsafeRenormFreezeBigNat# qmbn
-
-remBigNat :: BigNat -> BigNat -> BigNat
-remBigNat n@(BN# nba#) d@(BN# dba#)
- | isZeroBigNat d = nullBigNat
- | eqBigNatWord d 1## = zeroBigNat
- | n < d = n
- | True = runS $ do
- let nn# = sizeofBigNat# n
- let dn# = sizeofBigNat# d
- rmbn@(MBN# rmba#) <- newBigNat# dn#
- _ <- liftIO (c_mpn_tdiv_r rmba# nba# nn# dba# dn#)
- unsafeRenormFreezeBigNat# rmbn
-
--- | Note: Result of div/0 undefined
-quotRemBigNatWord :: BigNat -> GmpLimb# -> (# BigNat, GmpLimb# #)
-quotRemBigNatWord !_ 0## = (# nullBigNat, 0## #)
-quotRemBigNatWord n 1## = (# n, 0## #)
-quotRemBigNatWord n@(BN# nba#) d# = case compareBigNatWord n d# of
- LT -> (# zeroBigNat, bigNatToWord n #)
- EQ -> (# oneBigNat, 0## #)
- GT -> case runS go of (!q,!(W# r#)) -> (# q, r# #) -- TODO: handle word/word
- where
- go = do
- let nn# = sizeofBigNat# n
- qmbn@(MBN# qmba#) <- newBigNat# nn#
- r <- liftIO (c_mpn_divrem_1 qmba# 0# nba# nn# d#)
- q <- unsafeRenormFreezeBigNat# qmbn
- return (q,r)
-
-quotBigNatWord :: BigNat -> GmpLimb# -> BigNat
-quotBigNatWord n d# = case inline quotRemBigNatWord n d# of (# q, _ #) -> q
-
--- | div/0 not checked
-remBigNatWord :: BigNat -> GmpLimb# -> Word#
-remBigNatWord n@(BN# nba#) d# = c_mpn_mod_1 nba# (sizeofBigNat# n) d#
-
-gcdBigNatWord :: BigNat -> Word# -> Word#
-gcdBigNatWord bn@(BN# ba#) = c_mpn_gcd_1# ba# (sizeofBigNat# bn)
-
-gcdBigNat :: BigNat -> BigNat -> BigNat
-gcdBigNat x@(BN# x#) y@(BN# y#)
- | isZeroBigNat x = y
- | isZeroBigNat y = x
- | isTrue# (nx# >=# ny#) = runS (gcd' x# nx# y# ny#)
- | True = runS (gcd' y# ny# x# nx#)
- where
- gcd' a# na# b# nb# = do -- na >= nb
- mbn@(MBN# mba#) <- newBigNat# nb#
- I# rn'# <- liftIO (c_mpn_gcd# mba# a# na# b# nb#)
- let rn# = narrowGmpSize# rn'#
- case isTrue# (rn# ==# nb#) of
- False -> unsafeShrinkFreezeBigNat# mbn rn#
- True -> unsafeFreezeBigNat# mbn
-
- nx# = sizeofBigNat# x
- ny# = sizeofBigNat# y
-
--- | Extended euclidean algorithm.
---
--- For @/a/@ and @/b/@, compute their greatest common divisor @/g/@
--- and the coefficient @/s/@ satisfying @/a//s/ + /b//t/ = /g/@.
---
--- @since 0.5.1.0
-{-# NOINLINE gcdExtInteger #-}
-gcdExtInteger :: Integer -> Integer -> (# Integer, Integer #)
-gcdExtInteger a b = case gcdExtSBigNat a' b' of
- (# g, s #) -> let !g' = bigNatToInteger g
- !s' = sBigNatToInteger s
- in (# g', s' #)
- where
- a' = integerToSBigNat a
- b' = integerToSBigNat b
-
--- internal helper
-gcdExtSBigNat :: SBigNat -> SBigNat -> (# BigNat, SBigNat #)
-gcdExtSBigNat x y = case runS go of (g,s) -> (# g, s #)
- where
- go = do
- g@(MBN# g#) <- newBigNat# gn0#
- -- According to https://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fgcdext
- -- abs(s) < abs(y) / (2 g)
- s@(MBN# s#) <- newBigNat# (absI# yn#)
- I# ssn_# <- liftIO (integer_gmp_gcdext# s# g# x# xn# y# yn#)
- let ssn# = narrowGmpSize# ssn_#
- sn# = absI# ssn#
- s' <- unsafeShrinkFreezeBigNat# s sn#
- g' <- unsafeRenormFreezeBigNat# g
- case isTrue# (ssn# >=# 0#) of
- False -> return ( g', NegBN s' )
- True -> return ( g', PosBN s' )
-
- !(BN# x#) = absSBigNat x
- !(BN# y#) = absSBigNat y
- xn# = ssizeofSBigNat# x
- yn# = ssizeofSBigNat# y
-
- gn0# = minI# (absI# xn#) (absI# yn#)
-
-----------------------------------------------------------------------------
--- modular exponentiation
-
--- | \"@'powModInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to
--- exponent @/e/@ modulo @abs(/m/)@.
---
--- Negative exponents are supported if an inverse modulo @/m/@
--- exists.
---
--- __Warning__: It's advised to avoid calling this primitive with
--- negative exponents unless it is guaranteed the inverse exists, as
--- failure to do so will likely cause program abortion due to a
--- divide-by-zero fault. See also 'recipModInteger'.
---
--- Future versions of @integer_gmp@ may not support negative @/e/@
--- values anymore.
---
--- @since 0.5.1.0
-{-# NOINLINE powModInteger #-}
-powModInteger :: Integer -> Integer -> Integer -> Integer
-powModInteger (S# b#) (S# e#) (S# m#)
- | isTrue# (b# >=# 0#), isTrue# (e# >=# 0#)
- = wordToInteger (powModWord (int2Word# b#) (int2Word# e#)
- (int2Word# (absI# m#)))
-powModInteger b e m = case m of
- (S# m#) -> wordToInteger (powModSBigNatWord b' e' (int2Word# (absI# m#)))
- (Jp# m') -> bigNatToInteger (powModSBigNat b' e' m')
- (Jn# m') -> bigNatToInteger (powModSBigNat b' e' m')
- where
- b' = integerToSBigNat b
- e' = integerToSBigNat e
-
--- | \"@'powModSecInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to
--- exponent @/e/@ modulo @/m/@. It is required that @/e/ >= 0@ and
--- @/m/@ is odd.
---
--- This is a \"secure\" variant of 'powModInteger' using the
--- @mpz_powm_sec()@ function which is designed to be resilient to side
--- channel attacks and is therefore intended for cryptographic
--- applications.
---
--- This primitive is only available when the underlying GMP library
--- supports it (GMP >= 5). Otherwise, it internally falls back to
--- @'powModInteger'@, and a warning will be emitted when used.
---
--- @since 1.0.2.0
-{-# NOINLINE powModSecInteger #-}
-powModSecInteger :: Integer -> Integer -> Integer -> Integer
-powModSecInteger b e m = bigNatToInteger (powModSecSBigNat b' e' m')
- where
- b' = integerToSBigNat b
- e' = integerToSBigNat e
- m' = absSBigNat (integerToSBigNat m)
-
-#if HAVE_SECURE_POWM == 0
-{-# WARNING powModSecInteger "The underlying GMP library does not support a secure version of powModInteger which is side-channel resistant - you need at least GMP version 5 to support this" #-}
-#endif
-
--- | Version of 'powModInteger' operating on 'BigNat's
---
--- @since 1.0.0.0
-powModBigNat :: BigNat -> BigNat -> BigNat -> BigNat
-powModBigNat b e m = inline powModSBigNat (PosBN b) (PosBN e) m
-
--- | Version of 'powModInteger' for 'Word#'-sized moduli
---
--- @since 1.0.0.0
-powModBigNatWord :: BigNat -> BigNat -> GmpLimb# -> GmpLimb#
-powModBigNatWord b e m# = inline powModSBigNatWord (PosBN b) (PosBN e) m#
-
--- | Version of 'powModInteger' operating on 'Word#'s
---
--- @since 1.0.0.0
-foreign import ccall unsafe "integer_gmp_powm_word"
- powModWord :: GmpLimb# -> GmpLimb# -> GmpLimb# -> GmpLimb#
-
--- internal non-exported helper
-powModSBigNat :: SBigNat -> SBigNat -> BigNat -> BigNat
-powModSBigNat b e m@(BN# m#) = runS $ do
- r@(MBN# r#) <- newBigNat# mn#
- I# rn_# <- liftIO (integer_gmp_powm# r# b# bn# e# en# m# mn#)
- let rn# = narrowGmpSize# rn_#
- case isTrue# (rn# ==# mn#) of
- False -> unsafeShrinkFreezeBigNat# r rn#
- True -> unsafeFreezeBigNat# r
- where
- !(BN# b#) = absSBigNat b
- !(BN# e#) = absSBigNat e
- bn# = ssizeofSBigNat# b
- en# = ssizeofSBigNat# e
- mn# = sizeofBigNat# m
-
-foreign import ccall unsafe "integer_gmp_powm"
- integer_gmp_powm# :: MutableByteArray# RealWorld
- -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#
- -> ByteArray# -> GmpSize# -> IO GmpSize
-
--- internal non-exported helper
-powModSBigNatWord :: SBigNat -> SBigNat -> GmpLimb# -> GmpLimb#
-powModSBigNatWord b e m# = integer_gmp_powm1# b# bn# e# en# m#
- where
- !(BN# b#) = absSBigNat b
- !(BN# e#) = absSBigNat e
- bn# = ssizeofSBigNat# b
- en# = ssizeofSBigNat# e
-
-foreign import ccall unsafe "integer_gmp_powm1"
- integer_gmp_powm1# :: ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#
- -> GmpLimb# -> GmpLimb#
-
--- internal non-exported helper
-powModSecSBigNat :: SBigNat -> SBigNat -> BigNat -> BigNat
-powModSecSBigNat b e m@(BN# m#) = runS $ do
- r@(MBN# r#) <- newBigNat# mn#
- I# rn_# <- liftIO (integer_gmp_powm_sec# r# b# bn# e# en# m# mn#)
- let rn# = narrowGmpSize# rn_#
- case isTrue# (rn# ==# mn#) of
- False -> unsafeShrinkFreezeBigNat# r rn#
- True -> unsafeFreezeBigNat# r
- where
- !(BN# b#) = absSBigNat b
- !(BN# e#) = absSBigNat e
- bn# = ssizeofSBigNat# b
- en# = ssizeofSBigNat# e
- mn# = sizeofBigNat# m
-
-foreign import ccall unsafe "integer_gmp_powm_sec"
- integer_gmp_powm_sec# :: MutableByteArray# RealWorld
- -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#
- -> ByteArray# -> GmpSize# -> IO GmpSize
-
-
--- | \"@'recipModInteger' /x/ /m/@\" computes the inverse of @/x/@ modulo @/m/@. If
--- the inverse exists, the return value @/y/@ will satisfy @0 < /y/ <
--- abs(/m/)@, otherwise the result is @0@.
---
--- @since 0.5.1.0
-{-# NOINLINE recipModInteger #-}
-recipModInteger :: Integer -> Integer -> Integer
-recipModInteger (S# x#) (S# m#)
- | isTrue# (x# >=# 0#)
- = wordToInteger (recipModWord (int2Word# x#) (int2Word# (absI# m#)))
-recipModInteger x m = bigNatToInteger (recipModSBigNat x' m')
- where
- x' = integerToSBigNat x
- m' = absSBigNat (integerToSBigNat m)
-
--- | Version of 'recipModInteger' operating on 'BigNat's
---
--- @since 1.0.0.0
-recipModBigNat :: BigNat -> BigNat -> BigNat
-recipModBigNat x m = inline recipModSBigNat (PosBN x) m
-
--- | Version of 'recipModInteger' operating on 'Word#'s
---
--- @since 1.0.0.0
-foreign import ccall unsafe "integer_gmp_invert_word"
- recipModWord :: GmpLimb# -> GmpLimb# -> GmpLimb#
-
--- internal non-exported helper
-recipModSBigNat :: SBigNat -> BigNat -> BigNat
-recipModSBigNat x m@(BN# m#) = runS $ do
- r@(MBN# r#) <- newBigNat# mn#
- I# rn_# <- liftIO (integer_gmp_invert# r# x# xn# m# mn#)
- let rn# = narrowGmpSize# rn_#
- case isTrue# (rn# ==# mn#) of
- False -> unsafeShrinkFreezeBigNat# r rn#
- True -> unsafeFreezeBigNat# r
- where
- !(BN# x#) = absSBigNat x
- xn# = ssizeofSBigNat# x
- mn# = sizeofBigNat# m
-
-foreign import ccall unsafe "integer_gmp_invert"
- integer_gmp_invert# :: MutableByteArray# RealWorld
- -> ByteArray# -> GmpSize#
- -> ByteArray# -> GmpSize# -> IO GmpSize
-
-----------------------------------------------------------------------------
--- Conversions to/from floating point
-
-decodeDoubleInteger :: Double# -> (# Integer, Int# #)
--- decodeDoubleInteger 0.0## = (# S# 0#, 0# #)
-#if WORD_SIZE_IN_BITS == 64
-decodeDoubleInteger x = case decodeDouble_Int64# x of
- (# m#, e# #) -> (# S# m#, e# #)
-#elif WORD_SIZE_IN_BITS == 32
-decodeDoubleInteger x = case decodeDouble_Int64# x of
- (# m#, e# #) -> (# int64ToInteger m#, e# #)
-#endif
-{-# CONSTANT_FOLDED decodeDoubleInteger #-}
-
--- provided by GHC's RTS
-foreign import ccall unsafe "__int_encodeDouble"
- int_encodeDouble# :: Int# -> Int# -> Double#
-
-encodeDoubleInteger :: Integer -> Int# -> Double#
-encodeDoubleInteger (S# m#) 0# = int2Double# m#
-encodeDoubleInteger (S# m#) e# = int_encodeDouble# m# e#
-encodeDoubleInteger (Jp# bn@(BN# bn#)) e#
- = c_mpn_get_d bn# (sizeofBigNat# bn) e#
-encodeDoubleInteger (Jn# bn@(BN# bn#)) e#
- = c_mpn_get_d bn# (negateInt# (sizeofBigNat# bn)) e#
-{-# CONSTANT_FOLDED encodeDoubleInteger #-}
-
--- double integer_gmp_mpn_get_d (const mp_limb_t sp[], const mp_size_t sn)
-foreign import ccall unsafe "integer_gmp_mpn_get_d"
- c_mpn_get_d :: ByteArray# -> GmpSize# -> Int# -> Double#
-
-doubleFromInteger :: Integer -> Double#
-doubleFromInteger (S# m#) = int2Double# m#
-doubleFromInteger (Jp# bn@(BN# bn#))
- = c_mpn_get_d bn# (sizeofBigNat# bn) 0#
-doubleFromInteger (Jn# bn@(BN# bn#))
- = c_mpn_get_d bn# (negateInt# (sizeofBigNat# bn)) 0#
-{-# CONSTANT_FOLDED doubleFromInteger #-}
-
--- TODO: Not sure if it's worth to write 'Float' optimized versions here
-floatFromInteger :: Integer -> Float#
-floatFromInteger i = double2Float# (doubleFromInteger i)
-
-encodeFloatInteger :: Integer -> Int# -> Float#
-encodeFloatInteger m e = double2Float# (encodeDoubleInteger m e)
-
-----------------------------------------------------------------------------
--- FFI ccall imports
-
-foreign import ccall unsafe "integer_gmp_gcd_word"
- gcdWord# :: GmpLimb# -> GmpLimb# -> GmpLimb#
-
-foreign import ccall unsafe "integer_gmp_mpn_gcd_1"
- c_mpn_gcd_1# :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb#
-
-foreign import ccall unsafe "integer_gmp_mpn_gcd"
- c_mpn_gcd# :: MutableByteArray# s -> ByteArray# -> GmpSize#
- -> ByteArray# -> GmpSize# -> IO GmpSize
-
-foreign import ccall unsafe "integer_gmp_gcdext"
- integer_gmp_gcdext# :: MutableByteArray# s -> MutableByteArray# s
- -> ByteArray# -> GmpSize#
- -> ByteArray# -> GmpSize# -> IO GmpSize
-
--- mp_limb_t mpn_add_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,
--- mp_limb_t s2limb)
-foreign import ccall unsafe "gmp.h __gmpn_add_1"
- c_mpn_add_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#
- -> IO GmpLimb
-
--- mp_limb_t mpn_sub_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,
--- mp_limb_t s2limb)
-foreign import ccall unsafe "gmp.h __gmpn_sub_1"
- c_mpn_sub_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#
- -> IO GmpLimb
-
--- mp_limb_t mpn_mul_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,
--- mp_limb_t s2limb)
-foreign import ccall unsafe "gmp.h __gmpn_mul_1"
- c_mpn_mul_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#
- -> IO GmpLimb
-
--- mp_limb_t mpn_add (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,
--- const mp_limb_t *s2p, mp_size_t s2n)
-foreign import ccall unsafe "gmp.h __gmpn_add"
- c_mpn_add :: MutableByteArray# s -> ByteArray# -> GmpSize#
- -> ByteArray# -> GmpSize# -> IO GmpLimb
-
--- mp_limb_t mpn_sub (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,
--- const mp_limb_t *s2p, mp_size_t s2n)
-foreign import ccall unsafe "gmp.h __gmpn_sub"
- c_mpn_sub :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
- -> GmpSize# -> IO GmpLimb
-
--- mp_limb_t mpn_mul (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,
--- const mp_limb_t *s2p, mp_size_t s2n)
-foreign import ccall unsafe "gmp.h __gmpn_mul"
- c_mpn_mul :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
- -> GmpSize# -> IO GmpLimb
-
--- int mpn_cmp (const mp_limb_t *s1p, const mp_limb_t *s2p, mp_size_t n)
-foreign import ccall unsafe "gmp.h __gmpn_cmp"
- c_mpn_cmp :: ByteArray# -> ByteArray# -> GmpSize# -> CInt#
-
--- void mpn_tdiv_qr (mp_limb_t *qp, mp_limb_t *rp, mp_size_t qxn,
--- const mp_limb_t *np, mp_size_t nn,
--- const mp_limb_t *dp, mp_size_t dn)
-foreign import ccall unsafe "gmp.h __gmpn_tdiv_qr"
- c_mpn_tdiv_qr :: MutableByteArray# s -> MutableByteArray# s -> GmpSize#
- -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# -> IO ()
-
-foreign import ccall unsafe "integer_gmp_mpn_tdiv_q"
- c_mpn_tdiv_q :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
- -> GmpSize# -> IO ()
-
-foreign import ccall unsafe "integer_gmp_mpn_tdiv_r"
- c_mpn_tdiv_r :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
- -> GmpSize# -> IO ()
-
--- mp_limb_t mpn_divrem_1 (mp_limb_t *r1p, mp_size_t qxn, mp_limb_t *s2p,
--- mp_size_t s2n, mp_limb_t s3limb)
-foreign import ccall unsafe "gmp.h __gmpn_divrem_1"
- c_mpn_divrem_1 :: MutableByteArray# s -> GmpSize# -> ByteArray# -> GmpSize#
- -> GmpLimb# -> IO GmpLimb
-
--- mp_limb_t mpn_mod_1 (const mp_limb_t *s1p, mp_size_t s1n, mp_limb_t s2limb)
-foreign import ccall unsafe "gmp.h __gmpn_mod_1"
- c_mpn_mod_1 :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb#
-
--- mp_limb_t integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[],
--- mp_size_t sn, mp_bitcnt_t count)
-foreign import ccall unsafe "integer_gmp_mpn_rshift"
- c_mpn_rshift :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpBitCnt#
- -> IO GmpLimb
-
--- mp_limb_t integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[],
--- mp_size_t sn, mp_bitcnt_t count)
-foreign import ccall unsafe "integer_gmp_mpn_rshift_2c"
- c_mpn_rshift_2c :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpBitCnt#
- -> IO GmpLimb
-
--- mp_limb_t integer_gmp_mpn_lshift (mp_limb_t rp[], const mp_limb_t sp[],
--- mp_size_t sn, mp_bitcnt_t count)
-foreign import ccall unsafe "integer_gmp_mpn_lshift"
- c_mpn_lshift :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpBitCnt#
- -> IO GmpLimb
-
--- void mpn_and_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
--- mp_size_t n)
-foreign import ccall unsafe "integer_gmp_mpn_and_n"
- c_mpn_and_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
- -> IO ()
-
--- void mpn_andn_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
--- mp_size_t n)
-foreign import ccall unsafe "integer_gmp_mpn_andn_n"
- c_mpn_andn_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
- -> IO ()
-
--- void mpn_ior_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
--- mp_size_t n)
-foreign import ccall unsafe "integer_gmp_mpn_ior_n"
- c_mpn_ior_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
- -> IO ()
-
--- void mpn_xor_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
--- mp_size_t n)
-foreign import ccall unsafe "integer_gmp_mpn_xor_n"
- c_mpn_xor_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
- -> IO ()
-
--- mp_bitcnt_t mpn_popcount (const mp_limb_t *s1p, mp_size_t n)
-foreign import ccall unsafe "gmp.h __gmpn_popcount"
- c_mpn_popcount :: ByteArray# -> GmpSize# -> GmpBitCnt#
-
-----------------------------------------------------------------------------
--- BigNat-wrapped ByteArray#-primops
-
--- | Return number of limbs contained in 'BigNat'.
---
--- The result is always @>= 1@ since even zero is encoded with 1 limb.
-sizeofBigNat# :: BigNat -> GmpSize#
-sizeofBigNat# (BN# x#)
- = sizeofByteArray# x# `uncheckedIShiftRL#` GMP_LIMB_SHIFT#
-
-data MutBigNat s = MBN# !(MutableByteArray# s)
-
-getSizeofMutBigNat# :: MutBigNat s -> State# s -> (# State# s, GmpSize# #)
---getSizeofMutBigNat# :: MutBigNat s -> S s GmpSize#
-getSizeofMutBigNat# (MBN# x#) s =
- case getSizeofMutableByteArray# x# s of
- (# s', n# #) -> (# s', n# `uncheckedIShiftRL#` GMP_LIMB_SHIFT# #)
-
-newBigNat# :: GmpSize# -> S s (MutBigNat s)
-newBigNat# limbs# s =
- case newByteArray# (limbs# `uncheckedIShiftL#` GMP_LIMB_SHIFT#) s of
- (# s', mba# #) -> (# s', MBN# mba# #)
-
-writeBigNat# :: MutBigNat s -> GmpSize# -> GmpLimb# -> State# s -> State# s
-writeBigNat# (MBN# mba#) = writeWordArray# mba#
-
--- | Extract /n/-th (0-based) limb in 'BigNat'.
--- /n/ must be less than size as reported by 'sizeofBigNat#'.
-indexBigNat# :: BigNat -> GmpSize# -> GmpLimb#
-indexBigNat# (BN# ba#) = indexWordArray# ba#
-
-unsafeFreezeBigNat# :: MutBigNat s -> S s BigNat
-unsafeFreezeBigNat# (MBN# mba#) s = case unsafeFreezeByteArray# mba# s of
- (# s', ba# #) -> (# s', BN# ba# #)
-
-resizeMutBigNat# :: MutBigNat s -> GmpSize# -> S s (MutBigNat s)
-resizeMutBigNat# (MBN# mba0#) nsz# s
- | isTrue# (bsz# ==# n#) = (# s', MBN# mba0# #)
- | True =
- case resizeMutableByteArray# mba0# bsz# s' of
- (# s'', mba# #) -> (# s'', MBN# mba# #)
- where
- bsz# = nsz# `uncheckedIShiftL#` GMP_LIMB_SHIFT#
- !(# s', n# #) = getSizeofMutableByteArray# mba0# s
-
-shrinkMutBigNat# :: MutBigNat s -> GmpSize# -> State# s -> State# s
-shrinkMutBigNat# (MBN# mba0#) nsz# s
- | isTrue# (bsz# ==# n#) = s' -- no-op
- | True = shrinkMutableByteArray# mba0# bsz# s'
- where
- bsz# = nsz# `uncheckedIShiftL#` GMP_LIMB_SHIFT#
- !(# s', n# #) = getSizeofMutableByteArray# mba0# s
-
-unsafeSnocFreezeBigNat# :: MutBigNat s -> GmpLimb# -> S s BigNat
-unsafeSnocFreezeBigNat# mbn0@(MBN# mba0#) limb# s = go s'
- where
- n# = nb0# `uncheckedIShiftRL#` GMP_LIMB_SHIFT#
- !(# s', nb0# #) = getSizeofMutableByteArray# mba0# s
- go = do
- (MBN# mba#) <- resizeMutBigNat# mbn0 (n# +# 1#)
- _ <- svoid (writeWordArray# mba# n# limb#)
- unsafeFreezeBigNat# (MBN# mba#)
-
--- | May shrink underlying 'ByteArray#' if needed to satisfy BigNat invariant
-unsafeRenormFreezeBigNat# :: MutBigNat s -> S s BigNat
-unsafeRenormFreezeBigNat# mbn s
- | isTrue# (n0# ==# 0#) = (# s'', nullBigNat #)
- | isTrue# (n# ==# 0#) = (# s'', zeroBigNat #)
- | isTrue# (n# ==# n0#) = (unsafeFreezeBigNat# mbn) s''
- | True = (unsafeShrinkFreezeBigNat# mbn n#) s''
- where
- !(# s', n0# #) = getSizeofMutBigNat# mbn s
- !(# s'', n# #) = normSizeofMutBigNat'# mbn n0# s'
-
--- | Shrink MBN
-unsafeShrinkFreezeBigNat# :: MutBigNat s -> GmpSize# -> S s BigNat
-unsafeShrinkFreezeBigNat# x@(MBN# xmba) 1#
- = \s -> case readWordArray# xmba 0# s of
- (# s', w# #) -> freezeOneLimb w# s'
- where
- freezeOneLimb 0## = return zeroBigNat
- freezeOneLimb 1## = return oneBigNat
- freezeOneLimb w# | isTrue# (not# w# `eqWord#` 0##) = return czeroBigNat
- freezeOneLimb _ = do
- _ <- svoid (shrinkMutBigNat# x 1#)
- unsafeFreezeBigNat# x
-unsafeShrinkFreezeBigNat# x y# = do
- _ <- svoid (shrinkMutBigNat# x y#)
- unsafeFreezeBigNat# x
-
-
-copyWordArray# :: ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int#
- -> State# s -> State# s
-copyWordArray# src src_ofs dst dst_ofs len
- = copyByteArray# src (src_ofs `uncheckedIShiftL#` GMP_LIMB_SHIFT#)
- dst (dst_ofs `uncheckedIShiftL#` GMP_LIMB_SHIFT#)
- (len `uncheckedIShiftL#` GMP_LIMB_SHIFT#)
-
-copyWordArray :: BigNat -> Int# -> MutBigNat s -> Int# -> Int# -> S s ()
-copyWordArray (BN# ba#) ofs_ba# (MBN# mba#) ofs_mba# len#
- = svoid (copyWordArray# ba# ofs_ba# mba# ofs_mba# len#)
-
-clearWordArray# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
-clearWordArray# mba ofs len
- = setByteArray# mba (ofs `uncheckedIShiftL#` GMP_LIMB_SHIFT#)
- (len `uncheckedIShiftL#` GMP_LIMB_SHIFT#) 0#
-
--- | Version of 'normSizeofMutBigNat'#' which scans all allocated 'MutBigNat#'
-normSizeofMutBigNat# :: MutBigNat s -> State# s -> (# State# s, Int# #)
-normSizeofMutBigNat# mbn@(MBN# mba) s = normSizeofMutBigNat'# mbn sz# s'
- where
- !(# s', n# #) = getSizeofMutableByteArray# mba s
- sz# = n# `uncheckedIShiftRA#` GMP_LIMB_SHIFT#
-
--- | Find most-significant non-zero limb and return its index-position
--- plus one. Start scanning downward from the initial limb-size
--- (i.e. start-index plus one) given as second argument.
---
--- NB: The 'normSizeofMutBigNat' of 'zeroBigNat' would be @0#@
-normSizeofMutBigNat'# :: MutBigNat s -> GmpSize#
- -> State# s -> (# State# s, GmpSize# #)
-normSizeofMutBigNat'# (MBN# mba) = go
- where
- go 0# s = (# s, 0# #)
- go i0# s = case readWordArray# mba (i0# -# 1#) s of
- (# s', 0## #) -> go (i0# -# 1#) s'
- (# s', _ #) -> (# s', i0# #)
-
--- | Construct 'BigNat' from existing 'ByteArray#' containing /n/
--- 'GmpLimb's in least-significant-first order.
---
--- If possible 'ByteArray#', will be used directly (i.e. shared
--- /without/ cloning the 'ByteArray#' into a newly allocated one)
---
--- Note: size parameter (times @sizeof(GmpLimb)@) must be less or
--- equal to its 'sizeofByteArray#'.
-byteArrayToBigNat# :: ByteArray# -> GmpSize# -> BigNat
-byteArrayToBigNat# ba# n0#
- | isTrue# (n# ==# 0#) = zeroBigNat
- | isTrue# (baszr# ==# 0#) -- i.e. ba# is multiple of limb-size
- , isTrue# (baszq# ==# n#) = (BN# ba#)
- | True = runS $ \s ->
- let !(# s', mbn@(MBN# mba#) #) = newBigNat# n# s
- !(# s'', ba_sz# #) = getSizeofMutableByteArray# mba# s'
- go = do _ <- svoid (copyByteArray# ba# 0# mba# 0# ba_sz# )
- unsafeFreezeBigNat# mbn
- in go s''
- where
- !(# baszq#, baszr# #) = quotRemInt# (sizeofByteArray# ba#) GMP_LIMB_BYTES#
-
- n# = fmssl (BN# ba#) (n0# -# 1#)
-
--- | Read 'Integer' (without sign) from memory location at @/addr/@ in
--- base-256 representation.
---
--- @'importIntegerFromAddr' /addr/ /size/ /msbf/@
---
--- See description of 'importIntegerFromByteArray' for more details.
---
--- @since 1.0.0.0
-importIntegerFromAddr :: Addr# -> Word# -> Int# -> IO Integer
-importIntegerFromAddr addr len msbf = IO $ do
- bn <- liftIO (importBigNatFromAddr addr len msbf)
- return (bigNatToInteger bn)
-
--- | Version of 'importIntegerFromAddr' constructing a 'BigNat'
-importBigNatFromAddr :: Addr# -> Word# -> Int# -> IO BigNat
-importBigNatFromAddr _ 0## _ = IO (\s -> (# s, zeroBigNat #))
-importBigNatFromAddr addr len0 1# = IO $ do -- MSBF
- W# ofs <- liftIO (c_scan_nzbyte_addr addr 0## len0)
- let len = len0 `minusWord#` ofs
- addr' = addr `plusAddr#` (word2Int# ofs)
- importBigNatFromAddr# addr' len 1#
-importBigNatFromAddr addr len0 _ = IO $ do -- LSBF
- W# len <- liftIO (c_rscan_nzbyte_addr addr 0## len0)
- importBigNatFromAddr# addr len 0#
-
-foreign import ccall unsafe "integer_gmp_scan_nzbyte"
- c_scan_nzbyte_addr :: Addr# -> Word# -> Word# -> IO Word
-
-foreign import ccall unsafe "integer_gmp_rscan_nzbyte"
- c_rscan_nzbyte_addr :: Addr# -> Word# -> Word# -> IO Word
-
--- | Helper for 'importBigNatFromAddr'
-importBigNatFromAddr# :: Addr# -> Word# -> Int# -> S RealWorld BigNat
-importBigNatFromAddr# _ 0## _ = return zeroBigNat
-importBigNatFromAddr# addr len msbf = do
- mbn@(MBN# mba#) <- newBigNat# n#
- () <- liftIO (c_mpn_import_addr mba# addr 0## len msbf)
- unsafeFreezeBigNat# mbn
- where
- -- n = ceiling(len / SIZEOF_HSWORD), i.e. number of limbs required
- n# = (word2Int# len +# (SIZEOF_HSWORD# -# 1#)) `quotInt#` SIZEOF_HSWORD#
-
-foreign import ccall unsafe "integer_gmp_mpn_import"
- c_mpn_import_addr :: MutableByteArray# RealWorld -> Addr# -> Word# -> Word#
- -> Int# -> IO ()
-
--- | Read 'Integer' (without sign) from byte-array in base-256 representation.
---
--- The call
---
--- @'importIntegerFromByteArray' /ba/ /offset/ /size/ /msbf/@
---
--- reads
---
--- * @/size/@ bytes from the 'ByteArray#' @/ba/@ starting at @/offset/@
---
--- * with most significant byte first if @/msbf/@ is @1#@ or least
--- significant byte first if @/msbf/@ is @0#@, and
---
--- * returns a new 'Integer'
---
--- @since 1.0.0.0
-importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer
-importIntegerFromByteArray ba ofs len msbf
- = bigNatToInteger (importBigNatFromByteArray ba ofs len msbf)
-
--- | Version of 'importIntegerFromByteArray' constructing a 'BigNat'
-importBigNatFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> BigNat
-importBigNatFromByteArray _ _ 0## _ = zeroBigNat
-importBigNatFromByteArray ba ofs0 len0 1# = runS $ do -- MSBF
- W# ofs <- liftIO (c_scan_nzbyte_bytearray ba ofs0 len0)
- let len = (len0 `plusWord#` ofs0) `minusWord#` ofs
- importBigNatFromByteArray# ba ofs len 1#
-importBigNatFromByteArray ba ofs len0 _ = runS $ do -- LSBF
- W# len <- liftIO (c_rscan_nzbyte_bytearray ba ofs len0)
- importBigNatFromByteArray# ba ofs len 0#
-
-foreign import ccall unsafe "integer_gmp_scan_nzbyte"
- c_scan_nzbyte_bytearray :: ByteArray# -> Word# -> Word# -> IO Word
-
-foreign import ccall unsafe "integer_gmp_rscan_nzbyte"
- c_rscan_nzbyte_bytearray :: ByteArray# -> Word# -> Word# -> IO Word
-
--- | Helper for 'importBigNatFromByteArray'
-importBigNatFromByteArray# :: ByteArray# -> Word# -> Word# -> Int#
- -> S RealWorld BigNat
-importBigNatFromByteArray# _ _ 0## _ = return zeroBigNat
-importBigNatFromByteArray# ba ofs len msbf = do
- mbn@(MBN# mba#) <- newBigNat# n#
- () <- liftIO (c_mpn_import_bytearray mba# ba ofs len msbf)
- unsafeFreezeBigNat# mbn
- where
- -- n = ceiling(len / SIZEOF_HSWORD), i.e. number of limbs required
- n# = (word2Int# len +# (SIZEOF_HSWORD# -# 1#)) `quotInt#` SIZEOF_HSWORD#
-
-foreign import ccall unsafe "integer_gmp_mpn_import"
- c_mpn_import_bytearray :: MutableByteArray# RealWorld -> ByteArray# -> Word#
- -> Word# -> Int# -> IO ()
-
--- | Test whether all internal invariants are satisfied by 'BigNat' value
---
--- Returns @1#@ if valid, @0#@ otherwise.
---
--- This operation is mostly useful for test-suites and/or code which
--- constructs 'Integer' values directly.
-isValidBigNat# :: BigNat -> Int#
-isValidBigNat# (BN# ba#)
- = (szq# ># 0#) `andI#` (szr# ==# 0#) `andI#` isNorm#
- where
- isNorm#
- | isTrue# (szq# ># 1#) = (indexWordArray# ba# (szq# -# 1#)) `neWord#` 0##
- | True = 1#
-
- sz# = sizeofByteArray# ba#
-
- !(# szq#, szr# #) = quotRemInt# sz# GMP_LIMB_BYTES#
-
--- | Version of 'nextPrimeInteger' operating on 'BigNat's
---
--- @since 1.0.0.0
-nextPrimeBigNat :: BigNat -> BigNat
-nextPrimeBigNat bn@(BN# ba#) = runS $ do
- mbn@(MBN# mba#) <- newBigNat# n#
- (W# c#) <- liftIO (nextPrime# mba# ba# n#)
- case c# of
- 0## -> unsafeFreezeBigNat# mbn
- _ -> unsafeSnocFreezeBigNat# mbn c#
- where
- n# = sizeofBigNat# bn
-
-foreign import ccall unsafe "integer_gmp_next_prime"
- nextPrime# :: MutableByteArray# RealWorld -> ByteArray# -> GmpSize#
- -> IO GmpLimb
-
-----------------------------------------------------------------------------
--- monadic combinators for low-level state threading
-
-type S s a = State# s -> (# State# s, a #)
-
-infixl 1 >>=
-infixl 1 >>
-infixr 0 $
-
-{-# INLINE ($) #-}
-($) :: (a -> b) -> a -> b
-f $ x = f x
-
-{-# INLINE (>>=) #-}
-(>>=) :: S s a -> (a -> S s b) -> S s b
-(>>=) m k = \s -> case m s of (# s', a #) -> k a s'
-
-{-# INLINE (>>) #-}
-(>>) :: S s a -> S s b -> S s b
-(>>) m k = \s -> case m s of (# s', _ #) -> k s'
-
-{-# INLINE svoid #-}
-svoid :: (State# s -> State# s) -> S s ()
-svoid m0 = \s -> case m0 s of s' -> (# s', () #)
-
-{-# INLINE return #-}
-return :: a -> S s a
-return a = \s -> (# s, a #)
-
-{-# INLINE liftIO #-}
-liftIO :: IO a -> S RealWorld a
-liftIO (IO m) = m
-
--- NB: equivalent of GHC.IO.unsafeDupablePerformIO, see notes there
-runS :: S RealWorld a -> a
-runS m = case runRW# m of (# _, a #) -> a
-
--- stupid hack
-fail :: [Char] -> S s a
-fail s = return (raise# s)
-
-----------------------------------------------------------------------------
-
--- | Internal helper type for "signed" 'BigNat's
---
--- This is a useful abstraction for operations which support negative
--- mp_size_t arguments.
-data SBigNat = NegBN !BigNat | PosBN !BigNat
-
--- | Absolute value of 'SBigNat'
-absSBigNat :: SBigNat -> BigNat
-absSBigNat (NegBN bn) = bn
-absSBigNat (PosBN bn) = bn
-
--- | /Signed/ limb count. Negative sizes denote negative integers
-ssizeofSBigNat# :: SBigNat -> GmpSize#
-ssizeofSBigNat# (NegBN bn) = negateInt# (sizeofBigNat# bn)
-ssizeofSBigNat# (PosBN bn) = sizeofBigNat# bn
-
--- | Construct 'SBigNat' from 'Int#' value
-intToSBigNat# :: Int# -> SBigNat
-intToSBigNat# 0# = PosBN zeroBigNat
-intToSBigNat# 1# = PosBN oneBigNat
-intToSBigNat# (-1#) = NegBN oneBigNat
-intToSBigNat# i# | isTrue# (i# ># 0#) = PosBN (wordToBigNat (int2Word# i#))
- | True = NegBN (wordToBigNat (int2Word# (negateInt# i#)))
-
--- | Convert 'Integer' into 'SBigNat'
-integerToSBigNat :: Integer -> SBigNat
-integerToSBigNat (S# i#) = intToSBigNat# i#
-integerToSBigNat (Jp# bn) = PosBN bn
-integerToSBigNat (Jn# bn) = NegBN bn
-
--- | Convert 'SBigNat' into 'Integer'
-sBigNatToInteger :: SBigNat -> Integer
-sBigNatToInteger (NegBN bn) = bigNatToNegInteger bn
-sBigNatToInteger (PosBN bn) = bigNatToInteger bn
-
-----------------------------------------------------------------------------
--- misc helpers, some of these should rather be primitives exported by ghc-prim
-
-cmpW# :: Word# -> Word# -> Ordering
-cmpW# x# y#
- | isTrue# (x# `ltWord#` y#) = LT
- | isTrue# (x# `eqWord#` y#) = EQ
- | True = GT
-{-# INLINE cmpW# #-}
-
-bitWord# :: Int# -> Word#
-bitWord# = uncheckedShiftL# 1##
-{-# INLINE bitWord# #-}
-
-testBitWord# :: Word# -> Int# -> Int#
-testBitWord# w# i# = (bitWord# i# `and#` w#) `neWord#` 0##
-{-# INLINE testBitWord# #-}
-
-popCntI# :: Int# -> Int#
-popCntI# i# = word2Int# (popCnt# (int2Word# i#))
-{-# INLINE popCntI# #-}
-
--- branchless version
-absI# :: Int# -> Int#
-absI# i# = (i# `xorI#` nsign) -# nsign
- where
- -- nsign = negateInt# (i# <# 0#)
- nsign = uncheckedIShiftRA# i# (WORD_SIZE_IN_BITS# -# 1#)
-
--- branchless version
-sgnI# :: Int# -> Int#
-sgnI# x# = (x# ># 0#) -# (x# <# 0#)
-
-cmpI# :: Int# -> Int# -> Int#
-cmpI# x# y# = (x# ># y#) -# (x# <# y#)
-
-minI# :: Int# -> Int# -> Int#
-minI# x# y# | isTrue# (x# <=# y#) = x#
- | True = y#
-
--- find most-sig set limb, starting at given index
-fmssl :: BigNat -> Int# -> Int#
-fmssl !bn i0# = go i0#
- where
- go i# | isTrue# (i# <# 0#) = 0#
- | isTrue# (neWord# (indexBigNat# bn i#) 0##) = i# +# 1#
- | True = go (i# -# 1#)