From 3f7ebc5855e97c8374bedd8e8144fc62c0583d64 Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Fri, 6 Dec 2024 13:42:14 +0100
Subject: [PATCH] Merge ghc-bignum into ghc-internal (#24453)

First step towards merging ghc-bignum and ghc-prim into ghc-internal.

After this patch, ghc-bignum is deprecated and is just a shallow package
reexporting modules from ghc-internal and base. Use those directly
instead.

Move `gmp` submodule into ghc-internal directory.
---
 .gitmodules                                   |   2 +-
 compiler/GHC/Builtin/Names.hs                 |   9 +-
 compiler/GHC/Core/Opt/Simplify/Utils.hs       |   4 +-
 compiler/GHC/CoreToStg/Prep.hs                |   2 +-
 compiler/GHC/Driver/Config/Core/Rules.hs      |   5 +-
 compiler/GHC/Tc/Gen/Default.hs                |   4 +-
 compiler/GHC/Tc/Utils/Env.hs                  |   2 +-
 compiler/GHC/Unit/Types.hs                    |   9 +-
 hadrian/src/CommandLine.hs                    |   2 +-
 hadrian/src/Rules/Gmp.hs                      |  16 +-
 hadrian/src/Rules/Library.hs                  |   4 +-
 hadrian/src/Rules/Register.hs                 |   6 +-
 hadrian/src/Rules/SourceDist.hs               |   1 -
 hadrian/src/Settings/Packages.hs              |  26 +-
 libraries/base/base.cabal.in                  |   8 +-
 libraries/base/src/GHC/Num/BigNat.hs          |   6 +
 libraries/base/src/GHC/Num/Integer.hs         |   6 +
 libraries/base/src/GHC/Num/Natural.hs         |   6 +
 libraries/ghc-bignum/.gitignore               |  14 -
 libraries/ghc-bignum/Dummy.hs                 |   5 +
 libraries/ghc-bignum/Setup.hs                 |   6 -
 libraries/ghc-bignum/aclocal.m4               |  44 --
 libraries/ghc-bignum/changelog.md             |   6 +
 libraries/ghc-bignum/config.mk.in             |  17 -
 libraries/ghc-bignum/configure.ac             | 123 ----
 libraries/ghc-bignum/ghc-bignum.buildinfo.in  |   5 -
 libraries/ghc-bignum/ghc-bignum.cabal         | 129 +----
 libraries/ghc-bignum/install-sh               | 527 ------------------
 libraries/ghc-internal/.gitignore             |   4 +-
 libraries/ghc-internal/aclocal.m4             |  45 ++
 .../bignum-backend.rst}                       |  17 +-
 .../cbits/gmp_wrappers.c                      |   0
 libraries/ghc-internal/configure.ac           | 105 +++-
 .../ghc-internal/ghc-internal.buildinfo.in    |   9 +-
 libraries/ghc-internal/ghc-internal.cabal.in  |  83 ++-
 .../GMP.rst => ghc-internal/gmp-backend.rst}  |  26 +-
 .../gmp/ghc-gmp.h                             |   0
 .../gmp/gmp-tarballs                          |   0
 .../include/HsIntegerGmp.h.in                 |   2 +-
 .../include/WordSize.h                        |   0
 .../ghc-internal/src/GHC/Internal/Base.hs     |   2 +-
 .../src/GHC/Internal/Bignum}/Backend.hs       |   6 +-
 .../src/GHC/Internal/Bignum}/Backend/Check.hs |  14 +-
 .../src/GHC/Internal/Bignum}/Backend/FFI.hs   |  12 +-
 .../src/GHC/Internal/Bignum}/Backend/GMP.hs   |  12 +-
 .../GHC/Internal/Bignum}/Backend/Native.hs    |  20 +-
 .../GHC/Internal/Bignum}/Backend/Selected.hs  |  10 +-
 .../src/GHC/Internal/Bignum}/BigNat.hs        |  16 +-
 .../src/GHC/Internal/Bignum}/BigNat.hs-boot   |   6 +-
 .../src/GHC/Internal/Bignum}/Integer.hs       |  14 +-
 .../src/GHC/Internal/Bignum}/Integer.hs-boot  |   6 +-
 .../src/GHC/Internal/Bignum}/Natural.hs       |   8 +-
 .../src/GHC/Internal/Bignum}/Natural.hs-boot  |   6 +-
 .../src/GHC/Internal/Bignum}/Primitives.hs    |   2 +-
 .../src/GHC/Internal/Bignum}/WordArray.hs     |   4 +-
 .../ghc-internal/src/GHC/Internal/Enum.hs     |   2 +-
 .../ghc-internal/src/GHC/Internal/Float.hs    |   4 +-
 .../src/GHC/Internal/Float/ConversionUtils.hs |   2 +-
 .../src/GHC/Internal/Float/RealFracMethods.hs |   2 +-
 .../ghc-internal/src/GHC/Internal/Generics.hs |   2 +-
 .../ghc-internal/src/GHC/Internal/Integer.hs  |   4 +-
 .../src/GHC/Internal/Integer/Logarithms.hs    |   6 +-
 .../ghc-internal/src/GHC/Internal/List.hs     |   2 +-
 .../ghc-internal/src/GHC/Internal/Natural.hs  |  10 +-
 .../ghc-internal/src/GHC/Internal/Num.hs      |   8 +-
 .../ghc-internal/src/GHC/Internal/Num.hs-boot |   2 +-
 .../src/GHC/Internal/Numeric/Natural.hs       |   2 +-
 .../ghc-internal/src/GHC/Internal/Real.hs     |   2 +-
 .../src/GHC/Internal/Real.hs-boot             |   2 +-
 .../ghc-internal/src/GHC/Internal/TypeNats.hs |   4 +-
 .../src/GHC/Internal/TypeNats/Internal.hs     |   2 +-
 libraries/integer-gmp/integer-gmp.cabal       |   1 -
 .../src/GHC/Integer/GMP/Internals.hs          |   8 +-
 testsuite/driver/testlib.py                   |   3 -
 testsuite/tests/ado/T13242a.stderr            |  18 +-
 testsuite/tests/ado/all.T                     |   2 +-
 .../tests/default/DefaultImportFail01.stderr  |   2 +-
 .../tests/default/DefaultImportFail02.stderr  |   2 +-
 .../tests/default/DefaultImportFail03.stderr  |   2 +-
 .../tests/default/DefaultImportFail04.stderr  |   2 +-
 .../tests/default/DefaultImportFail05.stderr  |   2 +-
 testsuite/tests/driver/T20604/T20604.stdout   |   5 +-
 .../ghci.debugger/scripts/break006.stderr     |   2 +-
 testsuite/tests/ghci/scripts/T9181.stdout     |  55 +-
 .../indexed-types/should_fail/T12522a.stderr  |   2 +-
 .../interface-stability/base-exports.stdout   | 396 ++++++-------
 ...se-exports.stdout-javascript-unknown-ghcjs | 396 ++++++-------
 .../base-exports.stdout-mingw32               | 396 ++++++-------
 .../base-exports.stdout-ws-32                 | 396 ++++++-------
 .../ghc-experimental-exports.stdout           |   8 +-
 .../ghc-experimental-exports.stdout-mingw32   |   8 +-
 .../template-haskell-exports.stdout           |  40 +-
 .../should_fail/T18888_datakinds.stderr       |   4 +-
 .../numeric/should_compile/T14170.stdout      |   2 +-
 .../numeric/should_compile/T14465.stdout      |   6 +-
 .../numeric/should_compile/T19892.stderr      |   6 +-
 .../should_fail/overloadedlistsfail01.stderr  |   2 +-
 .../should_fail/RecordDotSyntaxFail11.stderr  |   2 +-
 testsuite/tests/perf/size/all.T               |   2 -
 testsuite/tests/quotes/T18263.stderr          |   2 +-
 testsuite/tests/quotes/TH_localname.stderr    |   2 +-
 testsuite/tests/safeHaskell/check/pkg01/all.T |   2 +-
 .../should_compile/OpaqueNoCastWW.stderr      |   6 +-
 .../simplCore/should_compile/T15445.stderr    |   2 +-
 .../simplCore/should_compile/T21286.stderr    |  12 +-
 .../simplCore/should_compile/T22428.stderr    |  15 +-
 .../simplCore/should_compile/T23083.stderr    |   8 +-
 .../simplCore/should_compile/T8832.stdout     |   2 +-
 testsuite/tests/th/T15360b.stderr             |   4 +-
 testsuite/tests/th/T16980.stderr              |   4 +-
 testsuite/tests/th/T2222.stderr               |   2 +-
 testsuite/tests/th/TH_tuple1.stdout           |  20 +-
 testsuite/tests/th/all.T                      |   2 +-
 .../typecheck/should_compile/T22141a.stderr   |   4 +-
 .../typecheck/should_compile/T22141b.stderr   |   4 +-
 .../typecheck/should_compile/T22141e.stderr   |   4 +-
 .../tests/typecheck/should_fail/T5095.stderr  |   6 +-
 .../tests/typecheck/should_fail/T7279.stderr  |   2 +-
 .../TyAppPat_PatternBindingExistential.stderr |   2 +-
 .../UnliftedNewtypesFamilyKindFail1.stderr    |   6 +-
 .../UnliftedNewtypesFamilyKindFail2.stderr    |   6 +-
 .../typecheck/should_fail/tcfail072.stderr    |   6 +-
 .../should_compile/T22326_th_pprint1.stderr   |   4 +-
 .../should_compile/T23739_th_pprint1.stderr   |   2 +-
 124 files changed, 1409 insertions(+), 1969 deletions(-)
 create mode 100644 libraries/base/src/GHC/Num/BigNat.hs
 create mode 100644 libraries/base/src/GHC/Num/Integer.hs
 create mode 100644 libraries/base/src/GHC/Num/Natural.hs
 delete mode 100644 libraries/ghc-bignum/.gitignore
 create mode 100644 libraries/ghc-bignum/Dummy.hs
 delete mode 100644 libraries/ghc-bignum/Setup.hs
 delete mode 100644 libraries/ghc-bignum/aclocal.m4
 delete mode 100644 libraries/ghc-bignum/config.mk.in
 delete mode 100644 libraries/ghc-bignum/configure.ac
 delete mode 100644 libraries/ghc-bignum/ghc-bignum.buildinfo.in
 delete mode 100755 libraries/ghc-bignum/install-sh
 rename libraries/{ghc-bignum/README.rst => ghc-internal/bignum-backend.rst} (83%)
 rename libraries/{ghc-bignum => ghc-internal}/cbits/gmp_wrappers.c (100%)
 rename libraries/{ghc-bignum/GMP.rst => ghc-internal/gmp-backend.rst} (74%)
 rename libraries/{ghc-bignum => ghc-internal}/gmp/ghc-gmp.h (100%)
 rename libraries/{ghc-bignum => ghc-internal}/gmp/gmp-tarballs (100%)
 rename libraries/{ghc-bignum => ghc-internal}/include/HsIntegerGmp.h.in (90%)
 rename libraries/{ghc-bignum => ghc-internal}/include/WordSize.h (100%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/Backend.hs (51%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/Backend/Check.hs (97%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/Backend/FFI.hs (98%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/Backend/GMP.hs (98%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/Backend/Native.hs (98%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/Backend/Selected.hs (51%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/BigNat.hs (99%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/BigNat.hs-boot (83%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/Integer.hs (99%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/Integer.hs-boot (87%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/Natural.hs (99%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/Natural.hs-boot (81%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/Primitives.hs (99%)
 rename libraries/{ghc-bignum/src/GHC/Num => ghc-internal/src/GHC/Internal/Bignum}/WordArray.hs (99%)

diff --git a/.gitmodules b/.gitmodules
index 42062eaa332..46f1db3e7cc 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -104,7 +104,7 @@
 	url = https://gitlab.haskell.org/ghc/libffi-tarballs.git
 	ignore = untracked
 [submodule "gmp-tarballs"]
-	path = libraries/ghc-bignum/gmp/gmp-tarballs
+	path = libraries/ghc-internal/gmp/gmp-tarballs
 	url = https://gitlab.haskell.org/ghc/gmp-tarballs.git
 [submodule "libraries/exceptions"]
 	path = libraries/exceptions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 371585039f7..c85aff6e72e 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -574,9 +574,9 @@ gHC_INTERNAL_CONTROL_MONAD_ZIP :: Module
 gHC_INTERNAL_CONTROL_MONAD_ZIP  = mkGhcInternalModule (fsLit "GHC.Internal.Control.Monad.Zip")
 
 gHC_INTERNAL_NUM_INTEGER, gHC_INTERNAL_NUM_NATURAL, gHC_INTERNAL_NUM_BIGNAT :: Module
-gHC_INTERNAL_NUM_INTEGER            = mkBignumModule (fsLit "GHC.Num.Integer")
-gHC_INTERNAL_NUM_NATURAL            = mkBignumModule (fsLit "GHC.Num.Natural")
-gHC_INTERNAL_NUM_BIGNAT             = mkBignumModule (fsLit "GHC.Num.BigNat")
+gHC_INTERNAL_NUM_INTEGER            = mkGhcInternalModule (fsLit "GHC.Internal.Bignum.Integer")
+gHC_INTERNAL_NUM_NATURAL            = mkGhcInternalModule (fsLit "GHC.Internal.Bignum.Natural")
+gHC_INTERNAL_NUM_BIGNAT             = mkGhcInternalModule (fsLit "GHC.Internal.Bignum.BigNat")
 
 gHC_INTERNAL_BASE, gHC_INTERNAL_ENUM,
     gHC_INTERNAL_GHCI, gHC_INTERNAL_GHCI_HELPERS, gHC_CSTRING, gHC_INTERNAL_DATA_STRING,
@@ -686,9 +686,6 @@ mAIN_NAME      = mkModuleNameFS (fsLit "Main")
 mkPrimModule :: FastString -> Module
 mkPrimModule m = mkModule primUnit (mkModuleNameFS m)
 
-mkBignumModule :: FastString -> Module
-mkBignumModule m = mkModule bignumUnit (mkModuleNameFS m)
-
 mkGhcInternalModule :: FastString -> Module
 mkGhcInternalModule m = mkGhcInternalModule_ (mkModuleNameFS m)
 
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index 8963f29e11d..e07dd57a30b 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -872,7 +872,7 @@ wrappers created by CPR, exactly case (4) above.  Without this limitation I
 got too much fruitless inlining, which led to regressions (#22317 is an example).
 
 A good example of a function where this 'small incentive' is important is
-GHC.Num.Integer where we ended up with calls like this:
+GHC.Internal.Bignum.Integer where we ended up with calls like this:
      case (integerSignum a b) of r -> ...
 but were failing to inline integerSignum, even though it always returns
 a single constructor, so it is very helpful to inline it. There is also an
@@ -1068,7 +1068,7 @@ interstingArg returns
    (a) NonTrivArg for an arg with an OtherCon [] unfolding
    (b) ValueArg for an arg with an OtherCon [c1,c2..] unfolding.
 
-Reason for (a): I found (in the GHC.Num.Integer library) that I was
+Reason for (a): I found (in the GHC.Internal.Bignum.Integer module) that I was
 inlining a pretty big function when all we knew was that its arguments
 were evaluated, nothing more.  That in turn make the enclosing function
 too big to inline elsewhere.
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index 785d79cc060..10cc135e38d 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -2741,7 +2741,7 @@ cpeBigNatLit env i = assert (i >= 0) $ do
   let
     platform = cp_platform (cpe_config env)
 
-    -- Per the documentation in GHC.Num.BigNat, a BigNat# is:
+    -- Per the documentation in GHC.Internal.Bignum.BigNat, a BigNat# is:
     --   "Represented as an array of limbs (Word#) stored in
     --   little-endian order (Word# themselves use machine order)."
     --
diff --git a/compiler/GHC/Driver/Config/Core/Rules.hs b/compiler/GHC/Driver/Config/Core/Rules.hs
index a1fc572b415..e6d455932a4 100644
--- a/compiler/GHC/Driver/Config/Core/Rules.hs
+++ b/compiler/GHC/Driver/Config/Core/Rules.hs
@@ -9,7 +9,7 @@ import GHC.Driver.DynFlags ( DynFlags, gopt, targetPlatform, homeUnitId_ )
 
 import GHC.Core.Rules.Config
 
-import GHC.Unit.Types     ( primUnitId, bignumUnitId )
+import GHC.Unit.Types     ( primUnitId )
 
 -- | Initialize RuleOpts from DynFlags
 initRuleOpts :: DynFlags -> RuleOpts
@@ -17,7 +17,6 @@ initRuleOpts dflags = RuleOpts
   { roPlatform                = targetPlatform dflags
   , roNumConstantFolding      = gopt Opt_NumConstantFolding dflags
   , roExcessRationalPrecision = gopt Opt_ExcessPrecision dflags
-    -- disable bignum rules in ghc-prim and ghc-bignum itself
+    -- disable bignum rules in ghc-prim
   , roBignumRules             = homeUnitId_ dflags /= primUnitId
-                                && homeUnitId_ dflags /= bignumUnitId
   }
diff --git a/compiler/GHC/Tc/Gen/Default.hs b/compiler/GHC/Tc/Gen/Default.hs
index 4764663416d..fd64ba7eddc 100644
--- a/compiler/GHC/Tc/Gen/Default.hs
+++ b/compiler/GHC/Tc/Gen/Default.hs
@@ -28,7 +28,7 @@ import GHC.Builtin.Names
 import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults (..), defaultEnv )
 import GHC.Types.Error
 import GHC.Types.SrcLoc
-import GHC.Unit.Types (Module, bignumUnit, ghcInternalUnit, moduleUnit, primUnit)
+import GHC.Unit.Types (Module, ghcInternalUnit, moduleUnit, primUnit)
 import GHC.Utils.Misc (fstOf3, sndOf3)
 import GHC.Utils.Outputable
 import qualified GHC.LanguageExtensions as LangExt
@@ -151,7 +151,7 @@ tcDefaults decls
         ; tcg_env <- getGblEnv
         ; let extra_clss = deflt_str ++ deflt_interactive
               here = tcg_mod tcg_env
-              is_internal_unit = moduleUnit here `elem` [bignumUnit, ghcInternalUnit, primUnit]
+              is_internal_unit = moduleUnit here `elem` [ghcInternalUnit, primUnit]
         ; decls' <- case (is_internal_unit, decls) of
             -- Some internal GHC modules contain @default ()@ to declare that no defaults can take place
             -- in the module.
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index fa9481d9c4d..a1d6cb79edb 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -930,7 +930,7 @@ tcGetDefaultTys
         ; defaults <- getDeclaredDefaultTys -- User-supplied defaults
         ; this_module <- tcg_mod <$> getGblEnv
         ; let this_unit = moduleUnit this_module
-              is_internal_unit = this_unit `elem` [bignumUnit, ghcInternalUnit, primUnit]
+              is_internal_unit = this_unit `elem` [ghcInternalUnit, primUnit]
         ; if is_internal_unit
              -- see Note [Default class defaults]
           then return (defaults, extended_defaults)
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index 169bec82d91..2f55e018b11 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -61,7 +61,6 @@ module GHC.Unit.Types
 
      -- * Wired-in units
    , primUnitId
-   , bignumUnitId
    , ghcInternalUnitId
    , rtsUnitId
    , mainUnitId
@@ -69,7 +68,6 @@ module GHC.Unit.Types
    , interactiveUnitId
 
    , primUnit
-   , bignumUnit
    , ghcInternalUnit
    , rtsUnit
    , mainUnit
@@ -596,21 +594,19 @@ Make sure you change 'GHC.Unit.State.findWiredInUnits' if you add an entry here.
 
 -}
 
-bignumUnitId, primUnitId, ghcInternalUnitId, rtsUnitId,
+primUnitId, ghcInternalUnitId, rtsUnitId,
   mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId
 
-bignumUnit, primUnit, ghcInternalUnit, rtsUnit,
+primUnit, ghcInternalUnit, rtsUnit,
   mainUnit, thisGhcUnit, interactiveUnit :: Unit
 
 primUnitId        = UnitId (fsLit "ghc-prim")
-bignumUnitId      = UnitId (fsLit "ghc-bignum")
 ghcInternalUnitId = UnitId (fsLit "ghc-internal")
 rtsUnitId         = UnitId (fsLit "rts")
 thisGhcUnitId     = UnitId (fsLit cProjectUnitId) -- See Note [GHC's Unit Id]
 interactiveUnitId = UnitId (fsLit "interactive")
 
 primUnit          = RealUnit (Definite primUnitId)
-bignumUnit        = RealUnit (Definite bignumUnitId)
 ghcInternalUnit   = RealUnit (Definite ghcInternalUnitId)
 rtsUnit           = RealUnit (Definite rtsUnitId)
 thisGhcUnit       = RealUnit (Definite thisGhcUnitId)
@@ -628,7 +624,6 @@ isInteractiveModule mod = moduleUnit mod == interactiveUnit
 wiredInUnitIds :: [UnitId]
 wiredInUnitIds =
    [ primUnitId
-   , bignumUnitId
    , ghcInternalUnitId
    , rtsUnitId
    ]
diff --git a/hadrian/src/CommandLine.hs b/hadrian/src/CommandLine.hs
index 98ee5a3b28b..c5a6afd92d6 100644
--- a/hadrian/src/CommandLine.hs
+++ b/hadrian/src/CommandLine.hs
@@ -278,7 +278,7 @@ optDescrs =
     , Option [] ["skip-depends"] (NoArg readSkipDepends)
       "Skip rebuilding dependency information."
     , Option [] ["bignum"] (OptArg readBignum "BACKEND")
-      "Select ghc-bignum backend: native, gmp (default), check-gmp, ffi."
+      "Select bignum backend: native, gmp (default), check-gmp (gmp compared to native), ffi."
     , Option [] ["progress-info"] (ReqArg readProgressInfo "STYLE")
       "Progress info style (None, Brief, Normal or Unicorn)."
     , Option [] ["docs"] (ReqArg readDocsArg "TARGET")
diff --git a/hadrian/src/Rules/Gmp.hs b/hadrian/src/Rules/Gmp.hs
index 7e31ae72f99..162ffe65227 100644
--- a/hadrian/src/Rules/Gmp.hs
+++ b/hadrian/src/Rules/Gmp.hs
@@ -23,9 +23,9 @@ gmpObjects s = do
     then return []
     else do
       -- Indirectly ensure object creation
-      let ctx = vanillaContext s ghcBignum
-      ghcBignumPath <- buildPath ctx
-      need [ghcBignumPath -/- "include/ghc-gmp.h"]
+      let ctx = vanillaContext s ghcInternal
+      ghcInternalPath <- buildPath ctx
+      need [ghcInternalPath -/- "include/ghc-gmp.h"]
 
       gmpPath <- gmpIntreePath s
       map (unifyPath . (gmpPath -/-)) <$>
@@ -54,13 +54,13 @@ gmpRules = do
     let
       -- Path to libraries/integer-gmp/gmp in the source tree
       gmpBase :: FilePath
-      gmpBase = pkgPath ghcBignum -/- "gmp"
+      gmpBase = pkgPath ghcInternal -/- "gmp"
 
     -- Build in-tree gmp if necessary
-    -- Produce: ghc-bignum/build/include/ghc-gmp.h
+    -- Produce: ghc-internal/build/include/ghc-gmp.h
     --   In-tree: copy gmp.h from in-tree build
     --   External: copy ghc-gmp.h from base sources
-    root -/- "stage*/libraries/ghc-bignum/build/include/ghc-gmp.h" %> \header -> do
+    root -/- "stage*/libraries/ghc-internal/build/include/ghc-gmp.h" %> \header -> do
         let includeP   = takeDirectory header
             buildP     = takeDirectory includeP
             packageP   = takeDirectory buildP
@@ -85,13 +85,13 @@ gmpRules = do
 
         let
           -- parse a path of the form "//stage*/gmp/xxx" and returns a vanilla
-          -- context from it for ghc-bignum package.
+          -- context from it for ghc-internal package.
           makeGmpPathContext gmpP = do
                let
                    stageP   = takeDirectory gmpP
                    stageS   = takeFileName stageP
                stage <- parsePath parseStage "<stage>" stageS
-               pure (vanillaContext stage ghcBignum)
+               pure (vanillaContext stage ghcInternal)
 
           gmpPath = root -/- "stage*/gmp"
 
diff --git a/hadrian/src/Rules/Library.hs b/hadrian/src/Rules/Library.hs
index 8f95ec28c2b..1aa19fc2fd2 100644
--- a/hadrian/src/Rules/Library.hs
+++ b/hadrian/src/Rules/Library.hs
@@ -207,10 +207,10 @@ jsObjects context = do
 
 -- | Return extra object files needed to build the given library context. The
 -- resulting list is currently non-empty only when the package from the
--- 'Context' is @ghc-bignum@ built with in-tree GMP backend.
+-- 'Context' is @ghc-internal@ built with in-tree GMP backend.
 extraObjects :: Context -> Action [FilePath]
 extraObjects context
-    | package context == ghcBignum = do
+    | package context == ghcInternal = do
          interpretInContext context getBignumBackend >>= \case
             "gmp" -> gmpObjects (stage context)
             _     -> return []
diff --git a/hadrian/src/Rules/Register.hs b/hadrian/src/Rules/Register.hs
index 6679b3e83ee..f9150db49cb 100644
--- a/hadrian/src/Rules/Register.hs
+++ b/hadrian/src/Rules/Register.hs
@@ -48,7 +48,7 @@ configurePackageRules = do
         let pkg = unsafeFindPackageByPath path
         let ctx = Context stage pkg vanilla Inplace
         buildP <- buildPath ctx
-        when (pkg == ghcBignum) $ do
+        when (pkg == ghcInternal) $ do
           isGmp <- (== "gmp") <$> interpretInContext ctx getBignumBackend
           when isGmp $
             need [buildP -/- "include/ghc-gmp.h"]
@@ -174,7 +174,7 @@ buildConfFinal rs context@Context {..} _conf = do
         need headers
 
     -- we need to generate this file for GMP
-    when (package == ghcBignum) $ do
+    when (package == ghcInternal) $ do
         bignum <- interpretInContext context getBignumBackend
         when (bignum == "gmp") $
             need [path -/- "include/ghc-gmp.h"]
@@ -219,7 +219,7 @@ buildConfInplace rs context@Context {..} _conf = do
              ]
 
     -- we need to generate this file for GMP
-    when (package == ghcBignum) $ do
+    when (package == ghcInternal) $ do
         bignum <- interpretInContext context getBignumBackend
         when (bignum == "gmp") $
             need [path -/- "include/ghc-gmp.h"]
diff --git a/hadrian/src/Rules/SourceDist.hs b/hadrian/src/Rules/SourceDist.hs
index 7f3dbeec441..c418b08b54f 100644
--- a/hadrian/src/Rules/SourceDist.hs
+++ b/hadrian/src/Rules/SourceDist.hs
@@ -147,7 +147,6 @@ prepareTree dest = do
       , pkgPath rts -/- "ghcautoconf.h.autoconf.in"
       , pkgPath process -/- "include" -/- "HsProcessConfig.h.in"
       , pkgPath process -/- "configure"
-      , pkgPath ghcBignum -/- "configure"
       , pkgPath ghcInternal -/- "configure"
       , pkgPath ghcInternal -/- "include" -/- "HsBaseConfig.h.in"
       , pkgPath directory -/- "configure"
diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs
index 1425b9798a0..47bbad542d7 100644
--- a/hadrian/src/Settings/Packages.hs
+++ b/hadrian/src/Settings/Packages.hs
@@ -39,11 +39,9 @@ packageArgs = do
     mconcat
         --------------------------------- base ---------------------------------
         [ package base ? mconcat
-          [ builder (Cabal Flags) ? notStage0 `cabalFlag` (pkgName ghcBignum)
-
-          -- This fixes the 'unknown symbol stat' issue.
-          -- See: https://github.com/snowleopard/hadrian/issues/259.
-          , builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ]
+          [ -- This fixes the 'unknown symbol stat' issue.
+            -- See: https://github.com/snowleopard/hadrian/issues/259.
+            builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ]
 
         --------------------------------- cabal --------------------------------
         -- Cabal is a large library and slow to compile. Moreover, we build it
@@ -232,8 +230,8 @@ packageArgs = do
         , package hsc2hs ?
           builder (Cabal Flags) ? arg "in-ghc-tree"
 
-        ------------------------------ ghc-bignum ------------------------------
-        , ghcBignumArgs
+        ------------------------------ ghc-internal ------------------------------
+        , ghcInternalArgs
 
         ---------------------------------- rts ---------------------------------
         , package rts ? rtsPackageArgs -- RTS deserves a separate function
@@ -253,8 +251,8 @@ packageArgs = do
 
         ]
 
-ghcBignumArgs :: Args
-ghcBignumArgs = package ghcBignum ? do
+ghcInternalArgs :: Args
+ghcInternalArgs = package ghcInternal ? do
     -- These are only used for non-in-tree builds.
     librariesGmp <- getSetting GmpLibDir
     includesGmp <- getSetting GmpIncludeDir
@@ -263,11 +261,11 @@ ghcBignumArgs = package ghcBignum ? do
     check   <- getBignumCheck
 
     mconcat
-          [ -- select BigNum backend
-            builder (Cabal Flags) ? arg backend
+          [ -- select bignum backend
+            builder (Cabal Flags) ? arg ("bignum-" <> backend)
 
           , -- check the selected backend against native backend
-            builder (Cabal Flags) ? check `cabalFlag` "check"
+            builder (Cabal Flags) ? check `cabalFlag` "bignum-check"
 
             -- backend specific
           , case backend of
@@ -275,7 +273,7 @@ ghcBignumArgs = package ghcBignum ? do
                    [ builder (Cabal Setup) ? mconcat
 
                        -- enable GMP backend: configure script will produce
-                       -- `ghc-bignum.buildinfo` and `include/HsIntegerGmp.h`
+                       -- `ghc-internal.buildinfo` and `include/HsIntegerGmp.h`
                      [ arg "--configure-option=--with-gmp"
 
                        -- enable in-tree support: don't depend on external "gmp"
@@ -286,7 +284,7 @@ ghcBignumArgs = package ghcBignum ? do
                      , flag GmpFrameworkPref ?
                        arg "--configure-option=--with-gmp-framework-preferred"
 
-                       -- Ensure that the ghc-bignum package registration includes
+                       -- Ensure that the ghc-internal package registration includes
                        -- knowledge of the system gmp's library and include directories.
                      , notM (flag GmpInTree) ? cabalExtraDirs includesGmp librariesGmp
                      ]
diff --git a/libraries/base/base.cabal.in b/libraries/base/base.cabal.in
index b5208d87c58..b5e017d5771 100644
--- a/libraries/base/base.cabal.in
+++ b/libraries/base/base.cabal.in
@@ -220,6 +220,9 @@ Library
         , GHC.MVar
         , GHC.Natural
         , GHC.Num
+        , GHC.Num.Integer
+        , GHC.Num.Natural
+        , GHC.Num.BigNat
         , GHC.OldList
         , GHC.OverloadedLabels
         , GHC.Profiling
@@ -274,11 +277,6 @@ Library
           -- TODO: remove
         , GHC.IOPort
 
-    reexported-modules:
-          GHC.Num.Integer
-        , GHC.Num.Natural
-        , GHC.Num.BigNat
-
     if os(windows)
         exposed-modules:
               GHC.IO.Encoding.CodePage.API
diff --git a/libraries/base/src/GHC/Num/BigNat.hs b/libraries/base/src/GHC/Num/BigNat.hs
new file mode 100644
index 00000000000..3422a5dbc6a
--- /dev/null
+++ b/libraries/base/src/GHC/Num/BigNat.hs
@@ -0,0 +1,6 @@
+module GHC.Num.BigNat
+  ( module GHC.Internal.Bignum.BigNat
+  )
+where
+
+import GHC.Internal.Bignum.BigNat
diff --git a/libraries/base/src/GHC/Num/Integer.hs b/libraries/base/src/GHC/Num/Integer.hs
new file mode 100644
index 00000000000..59d3248f79f
--- /dev/null
+++ b/libraries/base/src/GHC/Num/Integer.hs
@@ -0,0 +1,6 @@
+module GHC.Num.Integer
+  ( module GHC.Internal.Bignum.Integer
+  )
+where
+
+import GHC.Internal.Bignum.Integer
diff --git a/libraries/base/src/GHC/Num/Natural.hs b/libraries/base/src/GHC/Num/Natural.hs
new file mode 100644
index 00000000000..bd1c93988a1
--- /dev/null
+++ b/libraries/base/src/GHC/Num/Natural.hs
@@ -0,0 +1,6 @@
+module GHC.Num.Natural
+  ( module GHC.Internal.Bignum.Natural
+  )
+where
+
+import GHC.Internal.Bignum.Natural
diff --git a/libraries/ghc-bignum/.gitignore b/libraries/ghc-bignum/.gitignore
deleted file mode 100644
index 3f3fc661447..00000000000
--- a/libraries/ghc-bignum/.gitignore
+++ /dev/null
@@ -1,14 +0,0 @@
-/GNUmakefile
-/autom4te.cache/
-/config.log
-/config.status
-/configure
-/dist-install/
-/ghc.mk
-/gmp/config.mk
-/include/HsIntegerGmp.h
-/integer-gmp.buildinfo
-
-/gmp/gmp.h
-/gmp/gmpbuild
-/include/ghc-gmp.h
diff --git a/libraries/ghc-bignum/Dummy.hs b/libraries/ghc-bignum/Dummy.hs
new file mode 100644
index 00000000000..85a7e5f5712
--- /dev/null
+++ b/libraries/ghc-bignum/Dummy.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module Dummy where
+
+import GHC.Internal.Bignum.Integer ()
+  -- See Note [Tracking dependencies on primitives] in GHC.Internal.Base
diff --git a/libraries/ghc-bignum/Setup.hs b/libraries/ghc-bignum/Setup.hs
deleted file mode 100644
index 54f57d6f118..00000000000
--- a/libraries/ghc-bignum/Setup.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Main (main) where
-
-import Distribution.Simple
-
-main :: IO ()
-main = defaultMainWithHooks autoconfUserHooks
diff --git a/libraries/ghc-bignum/aclocal.m4 b/libraries/ghc-bignum/aclocal.m4
deleted file mode 100644
index be248615f58..00000000000
--- a/libraries/ghc-bignum/aclocal.m4
+++ /dev/null
@@ -1,44 +0,0 @@
-
-dnl--------------------------------------------------------------------
-dnl * Check whether this machine has gmp/gmp3 installed
-dnl--------------------------------------------------------------------
-
-AC_DEFUN([LOOK_FOR_GMP_LIB],[
-    if test "$HaveFrameworkGMP" = "NO"
-    then
-        AC_CHECK_LIB([gmp],  [__gmpz_powm],
-                     [HaveLibGmp=YES; GMP_LIBS=gmp])
-        if test "$HaveLibGmp" = "NO"
-        then
-            AC_CHECK_LIB([gmp3], [__gmpz_powm],
-                         [HaveLibGmp=YES; GMP_LIBS=gmp3])
-        fi
-        if test "$HaveLibGmp" = "YES"
-        then
-            AC_CHECK_LIB([$GMP_LIBS], [__gmpz_powm_sec],
-                         [HaveSecurePowm=1])
-        fi
-    fi
-])
-
-dnl--------------------------------------------------------------------
-dnl * Mac OS X only: check for GMP.framework
-dnl--------------------------------------------------------------------
-
-AC_DEFUN([LOOK_FOR_GMP_FRAMEWORK],[
-    if test "$HaveLibGmp" = "NO"
-    then
-        case $target_os in
-        darwin*)
-            AC_MSG_CHECKING([for GMP.framework])
-            save_libs="$LIBS"
-            LIBS="-framework GMP"
-            AC_TRY_LINK_FUNC(__gmpz_powm_sec,
-                             [HaveFrameworkGMP=YES; GMP_FRAMEWORK=GMP])
-            LIBS="$save_libs"
-            AC_MSG_RESULT([$HaveFrameworkGMP])
-            ;;
-        esac
-    fi
-])
-
diff --git a/libraries/ghc-bignum/changelog.md b/libraries/ghc-bignum/changelog.md
index 6816783dca8..4bdd45b7d84 100644
--- a/libraries/ghc-bignum/changelog.md
+++ b/libraries/ghc-bignum/changelog.md
@@ -1,5 +1,11 @@
 # Changelog for `ghc-bignum` package
 
+## 1.4
+
+- `ghc-bignum`'s implementation has been merged into `ghc-internal`.
+  Downstream users should import `GHC.Num.{Integer,Natural,BigNat}` stable
+  modules from `base` instead.
+
 ## 1.3
 
 - Expose backendName
diff --git a/libraries/ghc-bignum/config.mk.in b/libraries/ghc-bignum/config.mk.in
deleted file mode 100644
index 8478314ab14..00000000000
--- a/libraries/ghc-bignum/config.mk.in
+++ /dev/null
@@ -1,17 +0,0 @@
-# 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/
-
-ifeq "$(HaveLibGmp)" ""
- HaveLibGmp = @HaveLibGmp@
-endif
-
-ifeq "$(HaveFrameworkGMP)" ""
- HaveFrameworkGMP = @HaveFrameworkGMP@
-endif
-
-GMP_FORCE_INTREE = @GMP_FORCE_INTREE@
-GMP_PREFER_FRAMEWORK = @GMP_PREFER_FRAMEWORK@
-GMP_INCLUDE_DIRS = @GMP_INCLUDE_DIRS@
-GMP_LIB_DIRS = @GMP_LIB_DIRS@
-
diff --git a/libraries/ghc-bignum/configure.ac b/libraries/ghc-bignum/configure.ac
deleted file mode 100644
index 4ae9e64044c..00000000000
--- a/libraries/ghc-bignum/configure.ac
+++ /dev/null
@@ -1,123 +0,0 @@
-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])
-
-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],
-  [AS_HELP_STRING([--with-gmp],
-    [Enable GMP backend])],
-    [GMP_ENABLED=YES],
-    [GMP_ENABLED=NO])
-
-AC_ARG_WITH([gmp-includes],
-  [AS_HELP_STRING([--with-gmp-includes],
-    [directory containing gmp.h])],
-    [GMP_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval"],
-    [GMP_INCLUDE_DIRS=])
-
-AC_ARG_WITH([gmp-libraries],
-  [AS_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],
-  [AS_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],
-  [AS_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/ghc-bignum/ghc-bignum.buildinfo.in b/libraries/ghc-bignum/ghc-bignum.buildinfo.in
deleted file mode 100644
index 805a425a198..00000000000
--- a/libraries/ghc-bignum/ghc-bignum.buildinfo.in
+++ /dev/null
@@ -1,5 +0,0 @@
-include-dirs: @GMP_INCLUDE_DIRS@
-extra-lib-dirs: @GMP_LIB_DIRS@
-extra-libraries: @GMP_LIBS@
-frameworks: @GMP_FRAMEWORK@
-install-includes: HsIntegerGmp.h ghc-gmp.h
diff --git a/libraries/ghc-bignum/ghc-bignum.cabal b/libraries/ghc-bignum/ghc-bignum.cabal
index b17ae6abf24..6e569848d53 100644
--- a/libraries/ghc-bignum/ghc-bignum.cabal
+++ b/libraries/ghc-bignum/ghc-bignum.cabal
@@ -1,6 +1,6 @@
 cabal-version:       2.0
 name:                ghc-bignum
-version:             1.3
+version:             1.4
 synopsis:            GHC BigNum library
 license:             BSD3
 license-file:        LICENSE
@@ -8,22 +8,15 @@ author:              Sylvain Henry
 maintainer:          libraries@haskell.org
 bug-reports:         https://gitlab.haskell.org/ghc/ghc/issues/new
 category:            Numeric, Algebra, GHC
-build-type:          Configure
+build-type:          Simple
 description:
-    This package provides the low-level implementation of the standard
+    This package used to provide the low-level implementation of the standard
     'BigNat', 'Natural' and 'Integer' types.
+    Use `base:GHC.Num.{Integer,Natural,BigNat}` instead or other modules from
+    `ghc-internal`.
 
 extra-source-files:
-    aclocal.m4
-    cbits/gmp_wrappers.c
     changelog.md
-    configure
-    configure.ac
-    config.mk.in
-    include/WordSize.h
-    include/HsIntegerGmp.h.in
-    install-sh
-    ghc-bignum.buildinfo.in
 
 source-repository head
     type:     git
@@ -31,95 +24,29 @@ source-repository head
     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
-    CPP
-    ExplicitForAll
-    GHCForeignImportPrim
-    MagicHash
-    NegativeLiterals
-    NoImplicitPrelude
-    UnboxedTuples
-    UnliftedFFITypes
-    ForeignFunctionInterface
-
   build-depends:
-    ghc-prim >= 0.5.1.0 && < 0.12
-
-  hs-source-dirs: src/
-  include-dirs: include/
-  ghc-options: -Wall
-  cc-options: -std=c99 -Wall
-
-  ghc-options:
-    -- 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".
-    -this-unit-id ghc-bignum
-
-    -- See Note [ghc-bignum and error symbols]
-    -fno-catch-nonexhaustive-cases
-
-  if flag(gmp)
-      cpp-options: -DBIGNUM_GMP
-      other-modules:
-         GHC.Num.Backend.GMP
-      c-sources:
-         cbits/gmp_wrappers.c
-
-  if flag(ffi)
-      cpp-options: -DBIGNUM_FFI
-      other-modules:
-         GHC.Num.Backend.FFI
-
-  if flag(native)
-      cpp-options: -DBIGNUM_NATIVE
-
-  if flag(check)
-      cpp-options: -DBIGNUM_CHECK
-      other-modules:
-         GHC.Num.Backend.Check
-
-
-  exposed-modules:
-    GHC.Num.Primitives
-    GHC.Num.WordArray
-    GHC.Num.BigNat
-    GHC.Num.Backend
-    GHC.Num.Backend.Selected
-    GHC.Num.Backend.Native
-    GHC.Num.Natural
-    GHC.Num.Integer
+      base
+    , ghc-internal
+
+  other-modules:
+    -- dummy module to make Hadrian/GHC build a valid library...
+    Dummy
+  reexported-modules:
+    -- reexport from ghc-internal
+      GHC.Internal.Bignum.Primitives       as GHC.Num.Primitives
+    , GHC.Internal.Bignum.WordArray        as GHC.Num.WordArray
+    , GHC.Internal.Bignum.Backend          as GHC.Num.Backend
+    , GHC.Internal.Bignum.Backend.Selected as GHC.Num.Backend.Selected
+    , GHC.Internal.Bignum.Backend.Native   as GHC.Num.Backend.Native
+    -- reexport from base
+    -- We can't reexport these modules from ghc-internal otherwise we get
+    -- ambiguity between:
+    --   ghc-bignum:GHC.Num.X
+    --   base:GHC.Num.X
+    -- we should probably just deprecate ghc-bignum and encourage users to use
+    -- exports from base instead.
+    , GHC.Num.BigNat
+    , GHC.Num.Natural
+    , GHC.Num.Integer
diff --git a/libraries/ghc-bignum/install-sh b/libraries/ghc-bignum/install-sh
deleted file mode 100755
index 377bb8687ff..00000000000
--- a/libraries/ghc-bignum/install-sh
+++ /dev/null
@@ -1,527 +0,0 @@
-#!/bin/sh
-# install - install a program, script, or datafile
-
-scriptversion=2011-11-20.07; # UTC
-
-# This originates from X11R5 (mit/util/scripts/install.sh), which was
-# later released in X11R6 (xc/config/util/install.sh) with the
-# following copyright and license.
-#
-# Copyright (C) 1994 X Consortium
-#
-# Permission is hereby granted, free of charge, to any person obtaining a copy
-# of this software and associated documentation files (the "Software"), to
-# deal in the Software without restriction, including without limitation the
-# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-# sell copies of the Software, and to permit persons to whom the Software is
-# furnished to do so, subject to the following conditions:
-#
-# The above copyright notice and this permission notice shall be included in
-# all copies or substantial portions of the Software.
-#
-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
-# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
-# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
-# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-#
-# Except as contained in this notice, the name of the X Consortium shall not
-# be used in advertising or otherwise to promote the sale, use or other deal-
-# ings in this Software without prior written authorization from the X Consor-
-# tium.
-#
-#
-# FSF changes to this file are in the public domain.
-#
-# Calling this script install-sh is preferred over install.sh, to prevent
-# 'make' implicit rules from creating a file called install from it
-# when there is no Makefile.
-#
-# This script is compatible with the BSD install script, but was written
-# from scratch.
-
-nl='
-'
-IFS=" ""	$nl"
-
-# set DOITPROG to echo to test this script
-
-# Don't use :- since 4.3BSD and earlier shells don't like it.
-doit=${DOITPROG-}
-if test -z "$doit"; then
-  doit_exec=exec
-else
-  doit_exec=$doit
-fi
-
-# Put in absolute file names if you don't have them in your path;
-# or use environment vars.
-
-chgrpprog=${CHGRPPROG-chgrp}
-chmodprog=${CHMODPROG-chmod}
-chownprog=${CHOWNPROG-chown}
-cmpprog=${CMPPROG-cmp}
-cpprog=${CPPROG-cp}
-mkdirprog=${MKDIRPROG-mkdir}
-mvprog=${MVPROG-mv}
-rmprog=${RMPROG-rm}
-stripprog=${STRIPPROG-strip}
-
-posix_glob='?'
-initialize_posix_glob='
-  test "$posix_glob" != "?" || {
-    if (set -f) 2>/dev/null; then
-      posix_glob=
-    else
-      posix_glob=:
-    fi
-  }
-'
-
-posix_mkdir=
-
-# Desired mode of installed file.
-mode=0755
-
-chgrpcmd=
-chmodcmd=$chmodprog
-chowncmd=
-mvcmd=$mvprog
-rmcmd="$rmprog -f"
-stripcmd=
-
-src=
-dst=
-dir_arg=
-dst_arg=
-
-copy_on_change=false
-no_target_directory=
-
-usage="\
-Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
-   or: $0 [OPTION]... SRCFILES... DIRECTORY
-   or: $0 [OPTION]... -t DIRECTORY SRCFILES...
-   or: $0 [OPTION]... -d DIRECTORIES...
-
-In the 1st form, copy SRCFILE to DSTFILE.
-In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
-In the 4th, create DIRECTORIES.
-
-Options:
-     --help     display this help and exit.
-     --version  display version info and exit.
-
-  -c            (ignored)
-  -C            install only if different (preserve the last data modification time)
-  -d            create directories instead of installing files.
-  -g GROUP      $chgrpprog installed files to GROUP.
-  -m MODE       $chmodprog installed files to MODE.
-  -o USER       $chownprog installed files to USER.
-  -s            $stripprog installed files.
-  -t DIRECTORY  install into DIRECTORY.
-  -T            report an error if DSTFILE is a directory.
-
-Environment variables override the default commands:
-  CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
-  RMPROG STRIPPROG
-"
-
-while test $# -ne 0; do
-  case $1 in
-    -c) ;;
-
-    -C) copy_on_change=true;;
-
-    -d) dir_arg=true;;
-
-    -g) chgrpcmd="$chgrpprog $2"
-	shift;;
-
-    --help) echo "$usage"; exit $?;;
-
-    -m) mode=$2
-	case $mode in
-	  *' '* | *'	'* | *'
-'*	  | *'*'* | *'?'* | *'['*)
-	    echo "$0: invalid mode: $mode" >&2
-	    exit 1;;
-	esac
-	shift;;
-
-    -o) chowncmd="$chownprog $2"
-	shift;;
-
-    -s) stripcmd=$stripprog;;
-
-    -t) dst_arg=$2
-	# Protect names problematic for 'test' and other utilities.
-	case $dst_arg in
-	  -* | [=\(\)!]) dst_arg=./$dst_arg;;
-	esac
-	shift;;
-
-    -T) no_target_directory=true;;
-
-    --version) echo "$0 $scriptversion"; exit $?;;
-
-    --)	shift
-	break;;
-
-    -*)	echo "$0: invalid option: $1" >&2
-	exit 1;;
-
-    *)  break;;
-  esac
-  shift
-done
-
-if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
-  # When -d is used, all remaining arguments are directories to create.
-  # When -t is used, the destination is already specified.
-  # Otherwise, the last argument is the destination.  Remove it from $@.
-  for arg
-  do
-    if test -n "$dst_arg"; then
-      # $@ is not empty: it contains at least $arg.
-      set fnord "$@" "$dst_arg"
-      shift # fnord
-    fi
-    shift # arg
-    dst_arg=$arg
-    # Protect names problematic for 'test' and other utilities.
-    case $dst_arg in
-      -* | [=\(\)!]) dst_arg=./$dst_arg;;
-    esac
-  done
-fi
-
-if test $# -eq 0; then
-  if test -z "$dir_arg"; then
-    echo "$0: no input file specified." >&2
-    exit 1
-  fi
-  # It's OK to call 'install-sh -d' without argument.
-  # This can happen when creating conditional directories.
-  exit 0
-fi
-
-if test -z "$dir_arg"; then
-  do_exit='(exit $ret); exit $ret'
-  trap "ret=129; $do_exit" 1
-  trap "ret=130; $do_exit" 2
-  trap "ret=141; $do_exit" 13
-  trap "ret=143; $do_exit" 15
-
-  # Set umask so as not to create temps with too-generous modes.
-  # However, 'strip' requires both read and write access to temps.
-  case $mode in
-    # Optimize common cases.
-    *644) cp_umask=133;;
-    *755) cp_umask=22;;
-
-    *[0-7])
-      if test -z "$stripcmd"; then
-	u_plus_rw=
-      else
-	u_plus_rw='% 200'
-      fi
-      cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
-    *)
-      if test -z "$stripcmd"; then
-	u_plus_rw=
-      else
-	u_plus_rw=,u+rw
-      fi
-      cp_umask=$mode$u_plus_rw;;
-  esac
-fi
-
-for src
-do
-  # Protect names problematic for 'test' and other utilities.
-  case $src in
-    -* | [=\(\)!]) src=./$src;;
-  esac
-
-  if test -n "$dir_arg"; then
-    dst=$src
-    dstdir=$dst
-    test -d "$dstdir"
-    dstdir_status=$?
-  else
-
-    # Waiting for this to be detected by the "$cpprog $src $dsttmp" command
-    # might cause directories to be created, which would be especially bad
-    # if $src (and thus $dsttmp) contains '*'.
-    if test ! -f "$src" && test ! -d "$src"; then
-      echo "$0: $src does not exist." >&2
-      exit 1
-    fi
-
-    if test -z "$dst_arg"; then
-      echo "$0: no destination specified." >&2
-      exit 1
-    fi
-    dst=$dst_arg
-
-    # If destination is a directory, append the input filename; won't work
-    # if double slashes aren't ignored.
-    if test -d "$dst"; then
-      if test -n "$no_target_directory"; then
-	echo "$0: $dst_arg: Is a directory" >&2
-	exit 1
-      fi
-      dstdir=$dst
-      dst=$dstdir/`basename "$src"`
-      dstdir_status=0
-    else
-      # Prefer dirname, but fall back on a substitute if dirname fails.
-      dstdir=`
-	(dirname "$dst") 2>/dev/null ||
-	expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
-	     X"$dst" : 'X\(//\)[^/]' \| \
-	     X"$dst" : 'X\(//\)$' \| \
-	     X"$dst" : 'X\(/\)' \| . 2>/dev/null ||
-	echo X"$dst" |
-	    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
-		   s//\1/
-		   q
-		 }
-		 /^X\(\/\/\)[^/].*/{
-		   s//\1/
-		   q
-		 }
-		 /^X\(\/\/\)$/{
-		   s//\1/
-		   q
-		 }
-		 /^X\(\/\).*/{
-		   s//\1/
-		   q
-		 }
-		 s/.*/./; q'
-      `
-
-      test -d "$dstdir"
-      dstdir_status=$?
-    fi
-  fi
-
-  obsolete_mkdir_used=false
-
-  if test $dstdir_status != 0; then
-    case $posix_mkdir in
-      '')
-	# Create intermediate dirs using mode 755 as modified by the umask.
-	# This is like FreeBSD 'install' as of 1997-10-28.
-	umask=`umask`
-	case $stripcmd.$umask in
-	  # Optimize common cases.
-	  *[2367][2367]) mkdir_umask=$umask;;
-	  .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;
-
-	  *[0-7])
-	    mkdir_umask=`expr $umask + 22 \
-	      - $umask % 100 % 40 + $umask % 20 \
-	      - $umask % 10 % 4 + $umask % 2
-	    `;;
-	  *) mkdir_umask=$umask,go-w;;
-	esac
-
-	# With -d, create the new directory with the user-specified mode.
-	# Otherwise, rely on $mkdir_umask.
-	if test -n "$dir_arg"; then
-	  mkdir_mode=-m$mode
-	else
-	  mkdir_mode=
-	fi
-
-	posix_mkdir=false
-	case $umask in
-	  *[123567][0-7][0-7])
-	    # POSIX mkdir -p sets u+wx bits regardless of umask, which
-	    # is incompatible with FreeBSD 'install' when (umask & 300) != 0.
-	    ;;
-	  *)
-	    tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
-	    trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0
-
-	    if (umask $mkdir_umask &&
-		exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1
-	    then
-	      if test -z "$dir_arg" || {
-		   # Check for POSIX incompatibilities with -m.
-		   # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
-		   # other-writable bit of parent directory when it shouldn't.
-		   # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
-		   ls_ld_tmpdir=`ls -ld "$tmpdir"`
-		   case $ls_ld_tmpdir in
-		     d????-?r-*) different_mode=700;;
-		     d????-?--*) different_mode=755;;
-		     *) false;;
-		   esac &&
-		   $mkdirprog -m$different_mode -p -- "$tmpdir" && {
-		     ls_ld_tmpdir_1=`ls -ld "$tmpdir"`
-		     test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
-		   }
-		 }
-	      then posix_mkdir=:
-	      fi
-	      rmdir "$tmpdir/d" "$tmpdir"
-	    else
-	      # Remove any dirs left behind by ancient mkdir implementations.
-	      rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null
-	    fi
-	    trap '' 0;;
-	esac;;
-    esac
-
-    if
-      $posix_mkdir && (
-	umask $mkdir_umask &&
-	$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
-      )
-    then :
-    else
-
-      # The umask is ridiculous, or mkdir does not conform to POSIX,
-      # or it failed possibly due to a race condition.  Create the
-      # directory the slow way, step by step, checking for races as we go.
-
-      case $dstdir in
-	/*) prefix='/';;
-	[-=\(\)!]*) prefix='./';;
-	*)  prefix='';;
-      esac
-
-      eval "$initialize_posix_glob"
-
-      oIFS=$IFS
-      IFS=/
-      $posix_glob set -f
-      set fnord $dstdir
-      shift
-      $posix_glob set +f
-      IFS=$oIFS
-
-      prefixes=
-
-      for d
-      do
-	test X"$d" = X && continue
-
-	prefix=$prefix$d
-	if test -d "$prefix"; then
-	  prefixes=
-	else
-	  if $posix_mkdir; then
-	    (umask=$mkdir_umask &&
-	     $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
-	    # Don't fail if two instances are running concurrently.
-	    test -d "$prefix" || exit 1
-	  else
-	    case $prefix in
-	      *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
-	      *) qprefix=$prefix;;
-	    esac
-	    prefixes="$prefixes '$qprefix'"
-	  fi
-	fi
-	prefix=$prefix/
-      done
-
-      if test -n "$prefixes"; then
-	# Don't fail if two instances are running concurrently.
-	(umask $mkdir_umask &&
-	 eval "\$doit_exec \$mkdirprog $prefixes") ||
-	  test -d "$dstdir" || exit 1
-	obsolete_mkdir_used=true
-      fi
-    fi
-  fi
-
-  if test -n "$dir_arg"; then
-    { test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
-    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
-    { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
-      test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
-  else
-
-    # Make a couple of temp file names in the proper directory.
-    dsttmp=$dstdir/_inst.$$_
-    rmtmp=$dstdir/_rm.$$_
-
-    # Trap to clean up those temp files at exit.
-    trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
-
-    # Copy the file name to the temp name.
-    (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
-
-    # and set any options; do chmod last to preserve setuid bits.
-    #
-    # If any of these fail, we abort the whole thing.  If we want to
-    # ignore errors from any of these, just make sure not to ignore
-    # errors from the above "$doit $cpprog $src $dsttmp" command.
-    #
-    { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
-    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
-    { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
-    { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
-
-    # If -C, don't bother to copy if it wouldn't change the file.
-    if $copy_on_change &&
-       old=`LC_ALL=C ls -dlL "$dst"	2>/dev/null` &&
-       new=`LC_ALL=C ls -dlL "$dsttmp"	2>/dev/null` &&
-
-       eval "$initialize_posix_glob" &&
-       $posix_glob set -f &&
-       set X $old && old=:$2:$4:$5:$6 &&
-       set X $new && new=:$2:$4:$5:$6 &&
-       $posix_glob set +f &&
-
-       test "$old" = "$new" &&
-       $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
-    then
-      rm -f "$dsttmp"
-    else
-      # Rename the file to the real destination.
-      $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
-
-      # The rename failed, perhaps because mv can't rename something else
-      # to itself, or perhaps because mv is so ancient that it does not
-      # support -f.
-      {
-	# Now remove or move aside any old file at destination location.
-	# We try this two ways since rm can't unlink itself on some
-	# systems and the destination file might be busy for other
-	# reasons.  In this case, the final cleanup might fail but the new
-	# file should still install successfully.
-	{
-	  test ! -f "$dst" ||
-	  $doit $rmcmd -f "$dst" 2>/dev/null ||
-	  { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
-	    { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
-	  } ||
-	  { echo "$0: cannot unlink or rename $dst" >&2
-	    (exit 1); exit 1
-	  }
-	} &&
-
-	# Now rename the file to the real destination.
-	$doit $mvcmd "$dsttmp" "$dst"
-      }
-    fi || exit 1
-
-    trap '' 0
-  fi
-done
-
-# Local variables:
-# eval: (add-hook 'write-file-hooks 'time-stamp)
-# time-stamp-start: "scriptversion="
-# time-stamp-format: "%:y-%02m-%02d.%02H"
-# time-stamp-time-zone: "UTC"
-# time-stamp-end: "; # UTC"
-# End:
diff --git a/libraries/ghc-internal/.gitignore b/libraries/ghc-internal/.gitignore
index c7521d6fb0d..0e033f9c85d 100644
--- a/libraries/ghc-internal/.gitignore
+++ b/libraries/ghc-internal/.gitignore
@@ -10,12 +10,12 @@
 # Specific generated files
 /GNUmakefile
 /autom4te.cache/
-/base.buildinfo
+/ghc-internal.buildinfo
 /config.log
 /config.status
 /configure
 /dist-install/
-/ghc.mk
 /include/EventConfig.h
 /include/HsBaseConfig.h
 /include/HsBaseConfig.h.in
+/include/HsIntegerGmp.h
diff --git a/libraries/ghc-internal/aclocal.m4 b/libraries/ghc-internal/aclocal.m4
index ca796b3efc8..8a2e3ecee0a 100644
--- a/libraries/ghc-internal/aclocal.m4
+++ b/libraries/ghc-internal/aclocal.m4
@@ -293,3 +293,48 @@ AC_DEFUN([FP_CHECK_ENVIRON],
     #include <unistd.h>
   ])
 ])
+
+
+dnl--------------------------------------------------------------------
+dnl * Check whether this machine has gmp/gmp3 installed
+dnl--------------------------------------------------------------------
+
+AC_DEFUN([LOOK_FOR_GMP_LIB],[
+    if test "$HaveFrameworkGMP" = "NO"
+    then
+        AC_CHECK_LIB([gmp],  [__gmpz_powm],
+                     [HaveLibGmp=YES; GMP_LIBS=gmp])
+        if test "$HaveLibGmp" = "NO"
+        then
+            AC_CHECK_LIB([gmp3], [__gmpz_powm],
+                         [HaveLibGmp=YES; GMP_LIBS=gmp3])
+        fi
+        if test "$HaveLibGmp" = "YES"
+        then
+            AC_CHECK_LIB([$GMP_LIBS], [__gmpz_powm_sec],
+                         [HaveSecurePowm=1])
+        fi
+    fi
+])
+
+dnl--------------------------------------------------------------------
+dnl * Mac OS X only: check for GMP.framework
+dnl--------------------------------------------------------------------
+
+AC_DEFUN([LOOK_FOR_GMP_FRAMEWORK],[
+    if test "$HaveLibGmp" = "NO"
+    then
+        case $target_os in
+        darwin*)
+            AC_MSG_CHECKING([for GMP.framework])
+            save_libs="$LIBS"
+            LIBS="-framework GMP"
+            AC_TRY_LINK_FUNC(__gmpz_powm_sec,
+                             [HaveFrameworkGMP=YES; GMP_FRAMEWORK=GMP])
+            LIBS="$save_libs"
+            AC_MSG_RESULT([$HaveFrameworkGMP])
+            ;;
+        esac
+    fi
+])
+
diff --git a/libraries/ghc-bignum/README.rst b/libraries/ghc-internal/bignum-backend.rst
similarity index 83%
rename from libraries/ghc-bignum/README.rst
rename to libraries/ghc-internal/bignum-backend.rst
index 83e9fe85465..a7178e58c85 100644
--- a/libraries/ghc-bignum/README.rst
+++ b/libraries/ghc-internal/bignum-backend.rst
@@ -1,8 +1,9 @@
-GHC BIGNUM LIBRARY
+GHC Bignum backend
 ==================
 
-This package contains the implementation of the infinite precision integral
-types ("big numbers/bignum"):
+ghc-internal contains the implementation of the infinite precision integral
+types ("big numbers/bignum") that were previously provided by ghc-bignum (and by
+integer-gmp/integer-simple before that):
    
 * 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
@@ -59,14 +60,15 @@ 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.:
+ghc-bignum used to be below the `base` package and `base` used to provide the
+`patError` wired-in function. 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)
+then GHC would 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!
@@ -79,3 +81,6 @@ cases are:
                 IS y -> ...
                 IN y -> ...
        ...
+
+This might not be required anymore now that ghc-bignum has been merged with
+ghc-internal and that `patError` has been moved from `base` to ghc-internal.
diff --git a/libraries/ghc-bignum/cbits/gmp_wrappers.c b/libraries/ghc-internal/cbits/gmp_wrappers.c
similarity index 100%
rename from libraries/ghc-bignum/cbits/gmp_wrappers.c
rename to libraries/ghc-internal/cbits/gmp_wrappers.c
diff --git a/libraries/ghc-internal/configure.ac b/libraries/ghc-internal/configure.ac
index 4eda0cd9d7b..b87652f61d2 100644
--- a/libraries/ghc-internal/configure.ac
+++ b/libraries/ghc-internal/configure.ac
@@ -132,6 +132,109 @@ AC_ARG_WITH([iconv-libraries],
 AC_SUBST(ICONV_INCLUDE_DIRS)
 AC_SUBST(ICONV_LIB_DIRS)
 
+dnl--------------------------------------------------------------------
+dnl * Deal with arguments telling us gmp is somewhere odd
+dnl--------------------------------------------------------------------
+
+AC_ARG_WITH([gmp],
+  [AS_HELP_STRING([--with-gmp],
+    [Enable GMP backend])],
+    [GMP_ENABLED=YES],
+    [GMP_ENABLED=NO])
+
+AC_ARG_WITH([gmp-includes],
+  [AS_HELP_STRING([--with-gmp-includes],
+    [directory containing gmp.h])],
+    [GMP_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval"],
+    [GMP_INCLUDE_DIRS=])
+
+AC_ARG_WITH([gmp-libraries],
+  [AS_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],
+  [AS_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],
+  [AS_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
+
+   GMP_INSTALL_INCLUDES="HsIntegerGmp.h ghc-gmp.h"
+fi
+
+
+AC_SUBST(GMP_INCLUDE_DIRS)
+AC_SUBST(GMP_LIBS)
+AC_SUBST(GMP_LIB_DIRS)
+AC_SUBST(GMP_FRAMEWORK)
+AC_SUBST(GMP_INSTALL_INCLUDES)
+AC_SUBST(HaveLibGmp)
+AC_SUBST(HaveFrameworkGMP)
+AC_SUBST(HaveSecurePowm)
+AC_SUBST(UseIntreeGmp)
+AC_SUBST(GhcGmpVerMj)
+AC_SUBST(GhcGmpVerMi)
+AC_SUBST(GhcGmpVerPl)
 
 # Compute offsets/sizes used by jsbits/base.js
 if test "$host" = "javascript-ghcjs"
@@ -305,6 +408,6 @@ AC_CHECK_TYPE([struct MD5Context], [], [AC_MSG_ERROR([internal error])], [#inclu
 AC_CHECK_SIZEOF([struct MD5Context], [], [#include "include/md5.h"])
 
 AC_SUBST(EXTRA_LIBS)
-AC_CONFIG_FILES([ghc-internal.buildinfo])
+AC_CONFIG_FILES([ghc-internal.buildinfo include/HsIntegerGmp.h])
 
 AC_OUTPUT
diff --git a/libraries/ghc-internal/ghc-internal.buildinfo.in b/libraries/ghc-internal/ghc-internal.buildinfo.in
index ddf1bad57de..77677620162 100644
--- a/libraries/ghc-internal/ghc-internal.buildinfo.in
+++ b/libraries/ghc-internal/ghc-internal.buildinfo.in
@@ -1,4 +1,5 @@
-extra-lib-dirs: @ICONV_LIB_DIRS@
-extra-libraries: @EXTRA_LIBS@
-include-dirs: @ICONV_INCLUDE_DIRS@
-install-includes: HsBaseConfig.h EventConfig.h
+extra-lib-dirs: @ICONV_LIB_DIRS@ @GMP_LIB_DIRS@
+extra-libraries: @EXTRA_LIBS@ @GMP_LIBS@
+include-dirs: @ICONV_INCLUDE_DIRS@ @GMP_INCLUDE_DIRS@
+frameworks: @GMP_FRAMEWORK@
+install-includes: HsBaseConfig.h EventConfig.h @GMP_INSTALL_INCLUDES@
diff --git a/libraries/ghc-internal/ghc-internal.cabal.in b/libraries/ghc-internal/ghc-internal.cabal.in
index db2660c76ec..bbaf5668899 100644
--- a/libraries/ghc-internal/ghc-internal.cabal.in
+++ b/libraries/ghc-internal/ghc-internal.cabal.in
@@ -31,6 +31,7 @@ extra-source-files:
     aclocal.m4
     ghc-internal.buildinfo.in
     CHANGELOG.md
+    cbits/gmp_wrappers.c
     configure
     configure.ac
     include/CTypes.h
@@ -40,6 +41,8 @@ extra-source-files:
     include/md5.h
     include/fs.h
     include/winio_structs.h
+    include/WordSize.h
+    include/HsIntegerGmp.h.in
     install-sh
 
 source-repository head
@@ -47,6 +50,27 @@ source-repository head
     location: https://gitlab.haskell.org/ghc/ghc.git
     subdir:   libraries/base
 
+Flag bignum-native
+    Description: Enable native Haskell bignum backend
+    Manual: True
+    Default: False
+
+Flag bignum-ffi
+    Description: Enable FFI bignum backend
+    Manual: True
+    Default: False
+
+Flag bignum-gmp
+    Description: Enable GMP bignum backend
+    Manual: True
+    Default: False
+
+Flag bignum-check
+    Description: Validate results of the enabled backend against native backend.
+    Manual: True
+    Default: False
+
+
 Library
     default-language: Haskell2010
     default-extensions:
@@ -92,7 +116,6 @@ Library
     build-depends:
         rts == 1.0.*,
         ghc-prim >= 0.11 && < 0.12,
-        ghc-bignum >= 1.0 && < 2.0
 
     exposed-modules:
         GHC.Internal.ClosureTypes
@@ -302,10 +325,7 @@ Library
         GHC.Internal.IOPort
 
     reexported-modules:
-          GHC.Num.Integer
-        , GHC.Num.Natural
-        , GHC.Num.BigNat
-        , GHC.Tuple
+        GHC.Tuple
 
     other-modules:
         GHC.Internal.Data.Typeable.Internal
@@ -333,6 +353,59 @@ Library
         GHC.Internal.Unicode.Version
         GHC.Internal.System.Environment.ExecutablePath
 
+
+    ----------------------------------------
+    -- Bignum configuration
+    ----------------------------------------
+    -- check that at least one backend is enabled
+    if !flag(bignum-native) && !flag(bignum-gmp) && !flag(bignum-ffi)
+      buildable: False
+
+    -- check that at most one flag is set
+    if flag(bignum-native) && (flag(bignum-gmp) || flag(bignum-ffi))
+      buildable: False
+    if flag(bignum-gmp) && flag(bignum-ffi)
+      buildable: False
+
+    ghc-options:
+      -- See Note [ghc-bignum and error symbols]
+      -fno-catch-nonexhaustive-cases
+
+    if flag(bignum-gmp)
+        cpp-options: -DBIGNUM_GMP
+        other-modules:
+           GHC.Internal.Bignum.Backend.GMP
+        c-sources:
+           cbits/gmp_wrappers.c
+
+    if flag(bignum-ffi)
+        cpp-options: -DBIGNUM_FFI
+        other-modules:
+           GHC.Internal.Bignum.Backend.FFI
+
+    if flag(bignum-native)
+        cpp-options: -DBIGNUM_NATIVE
+
+    if flag(bignum-check)
+        cpp-options: -DBIGNUM_CHECK
+        other-modules:
+           GHC.Internal.Bignum.Backend.Check
+
+    exposed-modules:
+      GHC.Internal.Bignum.Primitives
+      GHC.Internal.Bignum.WordArray
+      GHC.Internal.Bignum.BigNat
+      GHC.Internal.Bignum.Backend
+      GHC.Internal.Bignum.Backend.Selected
+      GHC.Internal.Bignum.Backend.Native
+      GHC.Internal.Bignum.Natural
+      GHC.Internal.Bignum.Integer
+
+    -- some other properties related to bignum are set via the
+    -- ghc-internal.buildinfo file generated by this package's configure script
+    ----------------------------------------
+
+
     if !arch(javascript)
       c-sources:
           cbits/DarwinUtils.c
diff --git a/libraries/ghc-bignum/GMP.rst b/libraries/ghc-internal/gmp-backend.rst
similarity index 74%
rename from libraries/ghc-bignum/GMP.rst
rename to libraries/ghc-internal/gmp-backend.rst
index cfdd31235d7..a25bea3c81f 100644
--- a/libraries/ghc-bignum/GMP.rst
+++ b/libraries/ghc-internal/gmp-backend.rst
@@ -1,18 +1,18 @@
 GMP
 ===
 
-ghc-bignum's GMP backend depends on the external GMP library (gmplib.org). The
+ghc-internal'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
-``ghc-bignum`` is a boot package that is part of GHC's *binary* distribution.
+``ghc-internal`` 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 ``ghc-bignum``, but:
+A solution would be to always link GMP statically with ``ghc-internal``, 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 ghc-bignum
+   3. it passes these objects as "extra" objects when it links ghc-internal
 
 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).
@@ -51,14 +51,14 @@ GMP is linked:
   --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 ghc-bignum package is configured: in the
+These options are then used when ghc-internal package is configured: in the
 .cabal file, we can see the field ``build-type: Configure``, meaning that the
-``configure`` script in ``libraries/ghc-bignum/`` is executed during the setup
+``configure`` script in ``libraries/ghc-internal/`` is executed during the setup
 phase of the package.
 
-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``.
+This script is responsible of creating ``ghc-internal.buildinfo`` (from
+``ghc-internal.buildinfo.in``). The fields contained in this file are
+merged with the ones already defined in ``ghc-internal.cabal``.
 
 See
 https://www.haskell.org/cabal/users-guide/developing-packages.html#system-dependent-parameters.
@@ -66,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 ghc-bignum package
+When GMP is statically linked (in-tree build), a user of the ghc-internal 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 ``ghc-bignum/include/ghc-gmp.h``. As you
-can see in ``ghc-bignum.buildinfo[.in]``, ``ghc-gmp.h`` is installed as a
+``ghc.h`` header from the in-tree build to ``ghc-internal/include/ghc-gmp.h``. As you
+can see in ``ghc-internal.buildinfo[.in]``, ``ghc-gmp.h`` is installed as a
 header (``install-includes`` field).
 
 While the commit that introduced it (a9a0dd34dcdfb7309f57bda88435acca14ec54d5)
@@ -78,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
-ghc-bignum package.
+ghc-internal package.
diff --git a/libraries/ghc-bignum/gmp/ghc-gmp.h b/libraries/ghc-internal/gmp/ghc-gmp.h
similarity index 100%
rename from libraries/ghc-bignum/gmp/ghc-gmp.h
rename to libraries/ghc-internal/gmp/ghc-gmp.h
diff --git a/libraries/ghc-bignum/gmp/gmp-tarballs b/libraries/ghc-internal/gmp/gmp-tarballs
similarity index 100%
rename from libraries/ghc-bignum/gmp/gmp-tarballs
rename to libraries/ghc-internal/gmp/gmp-tarballs
diff --git a/libraries/ghc-bignum/include/HsIntegerGmp.h.in b/libraries/ghc-internal/include/HsIntegerGmp.h.in
similarity index 90%
rename from libraries/ghc-bignum/include/HsIntegerGmp.h.in
rename to libraries/ghc-internal/include/HsIntegerGmp.h.in
index 063817cc15e..5fd69705e7c 100644
--- a/libraries/ghc-bignum/include/HsIntegerGmp.h.in
+++ b/libraries/ghc-internal/include/HsIntegerGmp.h.in
@@ -1,6 +1,6 @@
 #pragma once
 
-/* Whether GMP is embedded into ghc-bignum */
+/* Whether GMP is embedded into ghc-internal */
 #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-internal/include/WordSize.h
similarity index 100%
rename from libraries/ghc-bignum/include/WordSize.h
rename to libraries/ghc-internal/include/WordSize.h
diff --git a/libraries/ghc-internal/src/GHC/Internal/Base.hs b/libraries/ghc-internal/src/GHC/Internal/Base.hs
index 55e66c0bf2a..99f503c3690 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Base.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Base.hs
@@ -442,7 +442,7 @@ W4:
 
 W5:
   If no explicit "default" declaration is present, the assumed
-  "default (Integer, Double)" creates a dependency on GHC.Num.Integer
+  "default (Integer, Double)" creates a dependency on GHC.Internal.Bignum.Integer
   for the Integer type if defaulting is ever attempted during
   type-checking.  (This doesn't apply to hs-boot files, which can't
   be given "default" declarations anyway.)
diff --git a/libraries/ghc-bignum/src/GHC/Num/Backend.hs b/libraries/ghc-internal/src/GHC/Internal/Bignum/Backend.hs
similarity index 51%
rename from libraries/ghc-bignum/src/GHC/Num/Backend.hs
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/Backend.hs
index 285be2a7037..390229ac2e7 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Backend.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/Backend.hs
@@ -2,14 +2,14 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -- | Selected backend
-module GHC.Num.Backend
+module GHC.Internal.Bignum.Backend
    ( module Backend
    )
 where
 
 #if defined(BIGNUM_CHECK)
-import GHC.Num.Backend.Check    as Backend
+import GHC.Internal.Bignum.Backend.Check    as Backend
 #else
-import GHC.Num.Backend.Selected as Backend
+import GHC.Internal.Bignum.Backend.Selected as Backend
 #endif
 
diff --git a/libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs b/libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Check.hs
similarity index 97%
rename from libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Check.hs
index 00930a62bfd..6a239cb3ede 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Check.hs
@@ -10,17 +10,17 @@
 {-# OPTIONS_GHC -Wno-name-shadowing #-}
 
 -- | Check Native implementation against another backend
-module GHC.Num.Backend.Check where
+module GHC.Internal.Bignum.Backend.Check where
 
 import GHC.CString
 import GHC.Prim
 import GHC.Types
-import GHC.Num.WordArray
-import GHC.Num.Primitives
-import {-# SOURCE #-} GHC.Num.Integer
-import {-# SOURCE #-} GHC.Num.Natural
-import qualified GHC.Num.Backend.Native   as Native
-import qualified GHC.Num.Backend.Selected as Other
+import GHC.Internal.Bignum.WordArray
+import GHC.Internal.Bignum.Primitives
+import {-# SOURCE #-} GHC.Internal.Bignum.Integer
+import {-# SOURCE #-} GHC.Internal.Bignum.Natural
+import qualified GHC.Internal.Bignum.Backend.Native   as Native
+import qualified GHC.Internal.Bignum.Backend.Selected as Other
 
 #if defined(BIGNUM_NATIVE)
 #error You can't validate Native backend against itself. Choose another backend (e.g. gmp, ffi)
diff --git a/libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs b/libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/FFI.hs
similarity index 98%
rename from libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/FFI.hs
index 7ac8207b717..df2b0675d8a 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/FFI.hs
@@ -13,15 +13,15 @@
 -- 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.Backend.FFI where
+module GHC.Internal.Bignum.Backend.FFI where
 
 import GHC.Prim
 import GHC.Types
-import GHC.Num.WordArray
-import GHC.Num.Primitives
-import qualified GHC.Num.Backend.Native as Native
-import {-# SOURCE #-} GHC.Num.Natural
-import {-# SOURCE #-} GHC.Num.Integer
+import GHC.Internal.Bignum.WordArray
+import GHC.Internal.Bignum.Primitives
+import qualified GHC.Internal.Bignum.Backend.Native as Native
+import {-# SOURCE #-} GHC.Internal.Bignum.Natural
+import {-# SOURCE #-} GHC.Internal.Bignum.Integer
 
 -- See W1 of Note [Tracking dependencies on primitives] in GHC.Internal.Base
 -- (This module uses the empty tuple () and string literals.)
diff --git a/libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs b/libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/GMP.hs
similarity index 98%
rename from libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/GMP.hs
index 589e1763469..54412038bf8 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/GMP.hs
@@ -16,19 +16,19 @@
 --
 -- This has been adapted from the legacy `integer-gmp` package written by
 -- Herbert Valerio Riedel.
-module GHC.Num.Backend.GMP where
+module GHC.Internal.Bignum.Backend.GMP where
 
 #include "MachDeps.h"
 #include "WordSize.h"
 
-import GHC.Num.WordArray
-import GHC.Num.Primitives
+import GHC.Internal.Bignum.WordArray
+import GHC.Internal.Bignum.Primitives
 import GHC.Prim
 import GHC.Types
 import GHC.Magic (runRW#)
-import {-# SOURCE #-} GHC.Num.Integer
-import {-# SOURCE #-} GHC.Num.BigNat
-import {-# SOURCE #-} GHC.Num.Natural
+import {-# SOURCE #-} GHC.Internal.Bignum.Integer
+import {-# SOURCE #-} GHC.Internal.Bignum.BigNat
+import {-# SOURCE #-} GHC.Internal.Bignum.Natural
 
 -- See W1 of Note [Tracking dependencies on primitives] in GHC.Internal.Base
 -- (This module uses the empty tuple () and string literals.)
diff --git a/libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs b/libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs
similarity index 98%
rename from libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs
index 8b378661fbc..b557b19f802 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs
@@ -9,22 +9,22 @@
 {-# LANGUAGE BinaryLiterals #-}
 {-# OPTIONS_GHC -Wno-name-shadowing #-}
 
-module GHC.Num.Backend.Native where
+module GHC.Internal.Bignum.Backend.Native where
 
 #include "MachDeps.h"
 #include "WordSize.h"
 
 #if defined(BIGNUM_NATIVE) || defined(BIGNUM_CHECK) || defined(BIGNUM_FFI)
-import {-# SOURCE #-} GHC.Num.BigNat
-import {-# SOURCE #-} GHC.Num.Natural
-import {-# SOURCE #-} GHC.Num.Integer
+import {-# SOURCE #-} GHC.Internal.Bignum.BigNat
+import {-# SOURCE #-} GHC.Internal.Bignum.Natural
+import {-# SOURCE #-} GHC.Internal.Bignum.Integer
 #else
-import GHC.Num.BigNat
-import GHC.Num.Natural
-import GHC.Num.Integer
+import GHC.Internal.Bignum.BigNat
+import GHC.Internal.Bignum.Natural
+import GHC.Internal.Bignum.Integer
 #endif
-import GHC.Num.WordArray
-import GHC.Num.Primitives
+import GHC.Internal.Bignum.WordArray
+import GHC.Internal.Bignum.Primitives
 import GHC.Prim
 import GHC.Types
 
@@ -657,7 +657,7 @@ bignat_gcd_word a b = bignat_gcd_word_word b (bigNatRemWord# a b)
 -- 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.
+-- GHC.Internal.Bignum.Primitives.
 bignat_gcd_word_word
    :: Word#
    -> Word#
diff --git a/libraries/ghc-bignum/src/GHC/Num/Backend/Selected.hs b/libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Selected.hs
similarity index 51%
rename from libraries/ghc-bignum/src/GHC/Num/Backend/Selected.hs
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Selected.hs
index f0ffd862206..98d0a509c18 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Backend/Selected.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Selected.hs
@@ -3,21 +3,21 @@
 
 -- | Selected backend
 --
--- We need this module in addition to GHC.Num.Backend to avoid module loops with
+-- We need this module in addition to GHC.Internal.Bignum.Backend to avoid module loops with
 -- Check backend.
-module GHC.Num.Backend.Selected
+module GHC.Internal.Bignum.Backend.Selected
    ( module Backend
    )
 where
 
 #if defined(BIGNUM_NATIVE)
-import GHC.Num.Backend.Native as Backend
+import GHC.Internal.Bignum.Backend.Native as Backend
 
 #elif defined(BIGNUM_FFI)
-import GHC.Num.Backend.FFI as Backend
+import GHC.Internal.Bignum.Backend.FFI as Backend
 
 #elif defined(BIGNUM_GMP)
-import GHC.Num.Backend.GMP as Backend
+import GHC.Internal.Bignum.Backend.GMP as Backend
 
 #else
 #error Undefined BigNum backend. Use a flag to select it (e.g. gmp, native, ffi)`
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs b/libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs
similarity index 99%
rename from libraries/ghc-bignum/src/GHC/Num/BigNat.hs
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs
index c7f8afa0275..c72f3c19631 100644
--- a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs
@@ -12,7 +12,7 @@
 {-# OPTIONS_GHC -Wno-name-shadowing #-}
 
 -- | Multi-precision natural
-module GHC.Num.BigNat where
+module GHC.Internal.Bignum.BigNat where
 
 #include "MachDeps.h"
 #include "WordSize.h"
@@ -21,9 +21,9 @@ import GHC.Prim
 import GHC.Types
 import GHC.Classes
 import GHC.Magic
-import GHC.Num.Primitives
-import GHC.Num.WordArray
-import GHC.Num.Backend
+import GHC.Internal.Bignum.Primitives
+import GHC.Internal.Bignum.WordArray
+import GHC.Internal.Bignum.Backend
 
 default ()
 
@@ -101,7 +101,7 @@ bigNatOne# _ = case bigNatOne of
 raiseDivZero_BigNat :: (# #) -> BigNat#
 raiseDivZero_BigNat _ = case raiseDivZero of
    !_ -> bigNatZero# (# #)
-   -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives
+   -- see Note [ghc-bignum exceptions] in GHC.Internal.Bignum.Primitives
 
 -- | Indicate if a bigNat is zero
 bigNatIsZero :: BigNat# -> Bool
@@ -541,7 +541,7 @@ bigNatSubUnsafe a b
                (# s', _  #) -> case raiseUnderflow of
                                  !_ -> s'
                                  -- see Note [ghc-bignum exceptions] in
-                                 -- GHC.Num.Primitives
+                                 -- GHC.Internal.Bignum.Primitives
 
 -- | Subtract two BigNat
 bigNatSub :: BigNat# -> BigNat# -> (# (# #) | BigNat# #)
@@ -606,7 +606,7 @@ bigNatQuotRemWord# :: BigNat# -> Word# -> (# BigNat#, Word# #)
 bigNatQuotRemWord# a b
    | 0## <- b = case raiseDivZero of
                   !_ -> (# bigNatZero# (# #), 0## #)
-                  -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives
+                  -- see Note [ghc-bignum exceptions] in GHC.Internal.Bignum.Primitives
    | 1## <- b = (# a, 0## #)
    | isTrue# (bigNatSize# a ==# 1#)
    , a0 <- indexWordArray# a 0#
@@ -634,7 +634,7 @@ bigNatQuotRem# :: BigNat# -> BigNat# -> (# BigNat#, BigNat# #)
 bigNatQuotRem# a b
    | bigNatIsZero b          = case raiseDivZero of
                                  !_ -> (# bigNatZero# (# #), bigNatZero# (# #) #)
-                                 -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives
+                                 -- see Note [ghc-bignum exceptions] in GHC.Internal.Bignum.Primitives
    | bigNatIsZero a          = (# bigNatZero# (# #), bigNatZero# (# #) #)
    | bigNatIsOne b           = (# a                , bigNatZero# (# #) #)
    | LT <- cmp               = (# bigNatZero# (# #), a #)
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot b/libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs-boot
similarity index 83%
rename from libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs-boot
index a62c07406d4..997c78a863d 100644
--- a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs-boot
@@ -2,10 +2,10 @@
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE UnboxedTuples #-}
 
-module GHC.Num.BigNat where
+module GHC.Internal.Bignum.BigNat where
 
-import GHC.Num.WordArray
-import GHC.Num.Primitives
+import GHC.Internal.Bignum.WordArray
+import GHC.Internal.Bignum.Primitives
 import GHC.Prim
 
 type BigNat# = WordArray#
diff --git a/libraries/ghc-bignum/src/GHC/Num/Integer.hs b/libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs
similarity index 99%
rename from libraries/ghc-bignum/src/GHC/Num/Integer.hs
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs
index 4084bab5568..253e5d5b826 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Integer.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs
@@ -9,7 +9,7 @@
 {-# LANGUAGE LambdaCase #-}
 
 -- |
--- Module      :  GHC.Num.Integer
+-- Module      :  GHC.Internal.Bignum.Integer
 -- Copyright   :  (c) Sylvain Henry 2019,
 --                (c) Herbert Valerio Riedel 2014
 -- License     :  BSD3
@@ -20,7 +20,7 @@
 --
 -- The 'Integer' type.
 
-module GHC.Num.Integer
+module GHC.Internal.Bignum.Integer
     ( Integer(..)
     , integerCheck
     , integerCheck#
@@ -153,10 +153,10 @@ import GHC.Prim
 import GHC.Types
 import GHC.Classes
 import GHC.Magic
-import GHC.Num.Primitives
-import GHC.Num.BigNat
-import GHC.Num.Natural
-import qualified GHC.Num.Backend as Backend
+import GHC.Internal.Bignum.Primitives
+import GHC.Internal.Bignum.BigNat
+import GHC.Internal.Bignum.Natural
+import qualified GHC.Internal.Bignum.Backend as Backend
 
 default ()
 
@@ -920,7 +920,7 @@ integerQuotRem# !n      (IS 1#) = (# n, IS 0# #) -- Note [Bangs in Integer funct
 integerQuotRem# !n     (IS -1#) = let !q = integerNegate n in (# q, (IS 0#) #)
 integerQuotRem# !_      (IS 0#) = case raiseDivZero of
                                     !_ -> (# IS 0#, IS 0# #)
-                                    -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives
+                                    -- see Note [ghc-bignum exceptions] in GHC.Internal.Bignum.Primitives
 integerQuotRem# (IS 0#) _       = (# IS 0#, IS 0# #)
 integerQuotRem# (IS n#) (IS d#) = case quotRemInt# n# d# of
     (# q#, r# #) -> (# IS q#, IS r# #)
diff --git a/libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot b/libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs-boot
similarity index 87%
rename from libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs-boot
index 80ecd36a349..580df9b6327 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs-boot
@@ -2,12 +2,12 @@
 {-# LANGUAGE UnboxedTuples #-}
 {-# LANGUAGE MagicHash #-}
 
-module GHC.Num.Integer where
+module GHC.Internal.Bignum.Integer where
 
 import GHC.Types
 import GHC.Prim
-import {-# SOURCE #-} GHC.Num.BigNat
-import {-# SOURCE #-} GHC.Num.Natural
+import {-# SOURCE #-} GHC.Internal.Bignum.BigNat
+import {-# SOURCE #-} GHC.Internal.Bignum.Natural
 
 data Integer
 
diff --git a/libraries/ghc-bignum/src/GHC/Num/Natural.hs b/libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs
similarity index 99%
rename from libraries/ghc-bignum/src/GHC/Num/Natural.hs
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs
index 8473e14d44f..9db3507a01a 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Natural.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs
@@ -8,7 +8,7 @@
 #include "MachDeps.h"
 #include "WordSize.h"
 
-module GHC.Num.Natural
+module GHC.Internal.Bignum.Natural
     ( Natural(..)
     , naturalCheck#
     , naturalCheck
@@ -116,8 +116,8 @@ import GHC.Prim
 import GHC.Types
 import GHC.Classes
 
-import GHC.Num.BigNat
-import GHC.Num.Primitives
+import GHC.Internal.Bignum.BigNat
+import GHC.Internal.Bignum.Primitives
 
 default ()
 
@@ -712,7 +712,7 @@ naturalFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of
 
 
 -- See Note [Optimising conversions between numeric types]
--- in GHC.Num.Integer
+-- in GHC.Internal.Bignum.Integer
 {-# RULES
 "Word# -> Natural -> Word#"
   forall x. naturalToWord# (NS x) = x
diff --git a/libraries/ghc-bignum/src/GHC/Num/Natural.hs-boot b/libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs-boot
similarity index 81%
rename from libraries/ghc-bignum/src/GHC/Num/Natural.hs-boot
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs-boot
index f902323f2a4..e2775d4a250 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Natural.hs-boot
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs-boot
@@ -1,10 +1,10 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE MagicHash #-}
 
-module GHC.Num.Natural where
+module GHC.Internal.Bignum.Natural where
 
-import {-# SOURCE #-} GHC.Num.BigNat
-import GHC.Num.Primitives
+import {-# SOURCE #-} GHC.Internal.Bignum.BigNat
+import GHC.Internal.Bignum.Primitives
 import GHC.Prim
 import GHC.Types
 
diff --git a/libraries/ghc-bignum/src/GHC/Num/Primitives.hs b/libraries/ghc-internal/src/GHC/Internal/Bignum/Primitives.hs
similarity index 99%
rename from libraries/ghc-bignum/src/GHC/Num/Primitives.hs
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/Primitives.hs
index 98a5af3e3de..c34c56ae99b 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Primitives.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/Primitives.hs
@@ -13,7 +13,7 @@
 {-# LANGUAGE BinaryLiterals #-}
 {-# OPTIONS_GHC -fexpose-all-unfoldings #-}
 
-module GHC.Num.Primitives
+module GHC.Internal.Bignum.Primitives
    (
    -- * Bool#
    Bool#
diff --git a/libraries/ghc-bignum/src/GHC/Num/WordArray.hs b/libraries/ghc-internal/src/GHC/Internal/Bignum/WordArray.hs
similarity index 99%
rename from libraries/ghc-bignum/src/GHC/Num/WordArray.hs
rename to libraries/ghc-internal/src/GHC/Internal/Bignum/WordArray.hs
index e9ed752f64d..5004d038e29 100644
--- a/libraries/ghc-bignum/src/GHC/Num/WordArray.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Bignum/WordArray.hs
@@ -10,12 +10,12 @@
 {-# LANGUAGE KindSignatures #-}
 {-# OPTIONS_GHC -Wno-name-shadowing #-}
 
-module GHC.Num.WordArray where
+module GHC.Internal.Bignum.WordArray where
 
 import GHC.Prim
 import GHC.Magic
 import GHC.Types
-import GHC.Num.Primitives
+import GHC.Internal.Bignum.Primitives
 
 #include "MachDeps.h"
 #include "WordSize.h"
diff --git a/libraries/ghc-internal/src/GHC/Internal/Enum.hs b/libraries/ghc-internal/src/GHC/Internal/Enum.hs
index 1fe38b399bc..7f90462df63 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Enum.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Enum.hs
@@ -39,7 +39,7 @@ where
 
 import GHC.Internal.Base hiding ( many )
 import GHC.Internal.Char
-import GHC.Num.Integer
+import GHC.Internal.Bignum.Integer
 import GHC.Internal.Num
 import GHC.Internal.Show
 import GHC.Tuple (Solo (..))
diff --git a/libraries/ghc-internal/src/GHC/Internal/Float.hs b/libraries/ghc-internal/src/GHC/Internal/Float.hs
index 94fb6dd7683..f3432fef938 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Float.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Float.hs
@@ -176,7 +176,7 @@ import GHC.Internal.Word
 import GHC.Internal.Arr
 import GHC.Internal.Float.RealFracMethods
 import GHC.Internal.Float.ConversionUtils
-import GHC.Num.BigNat
+import GHC.Internal.Bignum.BigNat
 
 infixr 8  **
 
@@ -1796,7 +1796,7 @@ castDoubleToWord64 :: Double -> Word64
 castDoubleToWord64 (D# d#) = W64# (castDoubleToWord64# d#)
 
 -- See Note [Optimising conversions between numeric types]
--- in GHC.Num.Integer
+-- in GHC.Internal.Bignum.Integer
 {-# RULES
 
 "Int# -> Integer -> Float#"
diff --git a/libraries/ghc-internal/src/GHC/Internal/Float/ConversionUtils.hs b/libraries/ghc-internal/src/GHC/Internal/Float/ConversionUtils.hs
index 586b48245fe..14ec0b9b672 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Float/ConversionUtils.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Float/ConversionUtils.hs
@@ -22,7 +22,7 @@
 module GHC.Internal.Float.ConversionUtils ( elimZerosInteger, elimZerosInt# ) where
 
 import GHC.Internal.Base
-import GHC.Num.Integer
+import GHC.Internal.Bignum.Integer
 
 default ()
 
diff --git a/libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs b/libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
index e81b2b8a838..01071f95694 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
@@ -59,7 +59,7 @@ module GHC.Internal.Float.RealFracMethods
     , int2Float
     ) where
 
-import GHC.Num.Integer
+import GHC.Internal.Bignum.Integer
 
 import GHC.Internal.Base hiding (uncheckedIShiftRA64#, uncheckedIShiftL64#)
 import GHC.Internal.Num () -- instance Num Integer
diff --git a/libraries/ghc-internal/src/GHC/Internal/Generics.hs b/libraries/ghc-internal/src/GHC/Internal/Generics.hs
index 3a013ca216d..13463853a27 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Generics.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Generics.hs
@@ -733,7 +733,7 @@ module GHC.Internal.Generics  (
 import GHC.Internal.Data.Either     ( Either (..) )
 import GHC.Internal.Data.Maybe      ( Maybe(..), fromMaybe )
 import GHC.Internal.Data.Ord        ( Down(..) )
-import GHC.Num.Integer ( Integer, integerToInt )
+import GHC.Internal.Bignum.Integer ( Integer, integerToInt )
 import GHC.Prim        ( Addr#, Char#, Double#, Float#, Int#, Word# )
 import GHC.Internal.Ptr         ( Ptr(..) )
 import GHC.Types
diff --git a/libraries/ghc-internal/src/GHC/Internal/Integer.hs b/libraries/ghc-internal/src/GHC/Internal/Integer.hs
index ca4b4f5cec9..830e7fb4814 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Integer.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Integer.hs
@@ -57,8 +57,8 @@ module GHC.Internal.Integer (
     hashInteger,
     ) where
 
-import GHC.Num.Integer (Integer)
-import qualified GHC.Num.Integer as I
+import GHC.Internal.Bignum.Integer (Integer)
+import qualified GHC.Internal.Bignum.Integer as I
 import GHC.Prim
 import GHC.Types
 
diff --git a/libraries/ghc-internal/src/GHC/Internal/Integer/Logarithms.hs b/libraries/ghc-internal/src/GHC/Internal/Integer/Logarithms.hs
index 42f845da3b3..e8e4cb67ffb 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Integer/Logarithms.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Integer/Logarithms.hs
@@ -9,9 +9,9 @@ module GHC.Internal.Integer.Logarithms
    )
 where
 
-import qualified GHC.Num.Primitives as N
-import qualified GHC.Num.Integer    as N
-import GHC.Num.Integer (Integer)
+import qualified GHC.Internal.Bignum.Primitives as N
+import qualified GHC.Internal.Bignum.Integer    as N
+import GHC.Internal.Bignum.Integer (Integer)
 import GHC.Prim
 
 wordLog2# :: Word# -> Int#
diff --git a/libraries/ghc-internal/src/GHC/Internal/List.hs b/libraries/ghc-internal/src/GHC/Internal/List.hs
index 5ef00c026ed..cfc5def03df 100644
--- a/libraries/ghc-internal/src/GHC/Internal/List.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/List.hs
@@ -46,7 +46,7 @@ module GHC.Internal.List (
 import GHC.Internal.Data.Maybe
 import GHC.Internal.Base
 import GHC.Internal.Num (Num(..))
-import GHC.Num.Integer (Integer)
+import GHC.Internal.Bignum.Integer (Integer)
 import GHC.Internal.Stack.Types (HasCallStack)
 
 infixl 9  !?, !!
diff --git a/libraries/ghc-internal/src/GHC/Internal/Natural.hs b/libraries/ghc-internal/src/GHC/Internal/Natural.hs
index 1eed1f1621c..5f27a9b8831 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Natural.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Natural.hs
@@ -49,11 +49,11 @@ where
 import GHC.Prim
 import GHC.Types
 import GHC.Internal.Maybe
-import GHC.Num.Natural (Natural)
-import GHC.Num.Integer (Integer)
-import qualified GHC.Num.BigNat  as B
-import qualified GHC.Num.Natural as N
-import qualified GHC.Num.Integer as I
+import GHC.Internal.Bignum.Natural (Natural)
+import GHC.Internal.Bignum.Integer (Integer)
+import qualified GHC.Internal.Bignum.BigNat  as B
+import qualified GHC.Internal.Bignum.Natural as N
+import qualified GHC.Internal.Bignum.Integer as I
 
 {-# COMPLETE NatS#, NatJ# #-}
 
diff --git a/libraries/ghc-internal/src/GHC/Internal/Num.hs b/libraries/ghc-internal/src/GHC/Internal/Num.hs
index 531291c7297..1f9f6c7a44a 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Num.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Num.hs
@@ -21,8 +21,8 @@ module GHC.Internal.Num
    ( Num(..)
    , subtract
    , quotRemInteger
-   , module GHC.Num.Integer
-   , module GHC.Num.Natural
+   , module GHC.Internal.Bignum.Integer
+   , module GHC.Internal.Bignum.Natural
     -- reexported for backward compatibility
    , module GHC.Internal.Natural
    , module GHC.Internal.Integer
@@ -35,8 +35,8 @@ import qualified GHC.Internal.Natural
 import qualified GHC.Internal.Integer
 
 import GHC.Internal.Base
-import GHC.Num.Integer
-import GHC.Num.Natural
+import GHC.Internal.Bignum.Integer
+import GHC.Internal.Bignum.Natural
 
 infixl 7  *
 infixl 6  +, -
diff --git a/libraries/ghc-internal/src/GHC/Internal/Num.hs-boot b/libraries/ghc-internal/src/GHC/Internal/Num.hs-boot
index 31a998a3318..bbd24e3ab0d 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Num.hs-boot
+++ b/libraries/ghc-internal/src/GHC/Internal/Num.hs-boot
@@ -5,7 +5,7 @@ module GHC.Internal.Num (Num (..)) where
 -- For why this file exists
 -- See Note [Semigroup stimes cycle] in GHC.Internal.Base
 
-import GHC.Num.Integer (Integer)
+import GHC.Internal.Bignum.Integer (Integer)
 
 infixl 7  *
 infixl 6  +, -
diff --git a/libraries/ghc-internal/src/GHC/Internal/Numeric/Natural.hs b/libraries/ghc-internal/src/GHC/Internal/Numeric/Natural.hs
index 796803fb2dd..5b119e78096 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Numeric/Natural.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Numeric/Natural.hs
@@ -22,5 +22,5 @@ module GHC.Internal.Numeric.Natural
     , minusNaturalMaybe
     ) where
 
-import GHC.Num.Natural
+import GHC.Internal.Bignum.Natural
 import GHC.Internal.Natural (minusNaturalMaybe)
diff --git a/libraries/ghc-internal/src/GHC/Internal/Real.hs b/libraries/ghc-internal/src/GHC/Internal/Real.hs
index fd09275b8ed..7855911de3b 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Real.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Real.hs
@@ -96,7 +96,7 @@ import {-# SOURCE #-} GHC.Internal.Exception( divZeroException, overflowExceptio
                                    , underflowException
                                    , ratioZeroDenomException )
 
-import GHC.Num.BigNat (gcdInt,gcdWord)
+import GHC.Internal.Bignum.BigNat (gcdInt,gcdWord)
 
 infixr 8  ^, ^^
 infixl 7  /, `quot`, `rem`, `div`, `mod`
diff --git a/libraries/ghc-internal/src/GHC/Internal/Real.hs-boot b/libraries/ghc-internal/src/GHC/Internal/Real.hs-boot
index bb4d65c309a..d8deb058883 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Real.hs-boot
+++ b/libraries/ghc-internal/src/GHC/Internal/Real.hs-boot
@@ -6,7 +6,7 @@ module GHC.Internal.Real (Integral (..)) where
 -- See Note [Semigroup stimes cycle] in GHC.Internal.Base
 
 import GHC.Classes (Ord)
-import GHC.Num.Integer (Integer)
+import GHC.Internal.Bignum.Integer (Integer)
 
 import {-# SOURCE #-} GHC.Internal.Num (Num)
 import {-# SOURCE #-} GHC.Internal.Enum (Enum)
diff --git a/libraries/ghc-internal/src/GHC/Internal/TypeNats.hs b/libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
index 788acfe2ae7..910a395dc60 100644
--- a/libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
@@ -28,7 +28,7 @@ for working with type-level naturals should be defined in a separate library.
 
 module GHC.Internal.TypeNats
   ( -- * Nat Kind
-    Natural -- declared in GHC.Num.Natural in package ghc-bignum
+    Natural -- declared in GHC.Internal.Bignum.Natural
   , Nat
     -- * Linking type and value level
   , KnownNat(natSing), natVal, natVal'
@@ -57,7 +57,7 @@ module GHC.Internal.TypeNats
 import GHC.Internal.Base( Eq(..), Functor(..), Ord(..), WithDict(..), (.), otherwise
                , Void, errorWithoutStackTrace, (++))
 import GHC.Types
-import GHC.Num.Natural(Natural)
+import GHC.Internal.Bignum.Natural(Natural)
 import GHC.Internal.Show(Show(..), appPrec, appPrec1, showParen, showString)
 import GHC.Internal.Read(Read(..))
 import GHC.Prim(Proxy#)
diff --git a/libraries/ghc-internal/src/GHC/Internal/TypeNats/Internal.hs b/libraries/ghc-internal/src/GHC/Internal/TypeNats/Internal.hs
index 4bae1f146b4..198fee43649 100644
--- a/libraries/ghc-internal/src/GHC/Internal/TypeNats/Internal.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/TypeNats/Internal.hs
@@ -33,7 +33,7 @@ module GHC.Internal.TypeNats.Internal
   ) where
 
 import GHC.Internal.Base(Ordering)
-import GHC.Num.Natural(Natural)
+import GHC.Internal.Bignum.Natural(Natural)
 
 -- | Comparison of type-level naturals, as a function.
 --
diff --git a/libraries/integer-gmp/integer-gmp.cabal b/libraries/integer-gmp/integer-gmp.cabal
index a00960031b1..7ad236db041 100644
--- a/libraries/integer-gmp/integer-gmp.cabal
+++ b/libraries/integer-gmp/integer-gmp.cabal
@@ -35,7 +35,6 @@ library
   build-depends:
       base >= 4.11 && < 5
     , ghc-prim
-    , ghc-bignum
     , ghc-internal
 
   exposed-modules:
diff --git a/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs b/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
index f9fc22ef94e..21a7545bc69 100644
--- a/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
+++ b/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs
@@ -128,10 +128,10 @@ module GHC.Integer.GMP.Internals
 
 import GHC.Internal.Integer
 import GHC.Internal.Natural
-import GHC.Num.Integer (Integer(..))
-import qualified GHC.Num.Integer as I
-import qualified GHC.Num.BigNat as B
-import qualified GHC.Num.Primitives as P
+import GHC.Internal.Bignum.Integer (Integer(..))
+import qualified GHC.Internal.Bignum.Integer as I
+import qualified GHC.Internal.Bignum.BigNat as B
+import qualified GHC.Internal.Bignum.Primitives as P
 import GHC.Types
 import GHC.Prim
 import GHC.Exts (runRW#)
diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py
index 1b244bf51c5..5cc174403f4 100644
--- a/testsuite/driver/testlib.py
+++ b/testsuite/driver/testlib.py
@@ -2945,9 +2945,6 @@ def normalise_errmsg(s: str) -> str:
     s = re.sub('hpc-[0-9.]+', 'hpc', s)
     s = re.sub('ghc-pkg-[0-9.]+', 'ghc-pkg', s)
 
-    # Error messages sometimes contain ghc-bignum implementation package
-    s = re.sub('ghc-bignum-[0-9.]+', 'ghc-bignum-<VERSION>', s)
-
     # Error messages sometimes contain these blurbs which can vary
     # spuriously depending upon build configuration (e.g. based on bignum
     # backend)
diff --git a/testsuite/tests/ado/T13242a.stderr b/testsuite/tests/ado/T13242a.stderr
index 8d24d47249d..dcac458709b 100644
--- a/testsuite/tests/ado/T13242a.stderr
+++ b/testsuite/tests/ado/T13242a.stderr
@@ -1,12 +1,11 @@
-
 T13242a.hs:10:5: error: [GHC-46956]
     • Couldn't match expected type ‘a0’ with actual type ‘a’
-    • because type variable ‘a’ would escape its scope
-    This (rigid, skolem) type variable is bound by
-      a pattern with constructor: A :: forall a. Eq a => a -> T,
-      in a pattern binding in
-           a 'do' block
-      at T13242a.hs:10:3-5
+        because type variable ‘a’ would escape its scope
+      This (rigid, skolem) type variable is bound by
+        a pattern with constructor: A :: forall a. Eq a => a -> T,
+        in a pattern binding in
+             a 'do' block
+        at T13242a.hs:10:3-5
     • In the expression:
         do A x <- undefined
            _ <- return 'a'
@@ -27,9 +26,9 @@ T13242a.hs:13:13: error: [GHC-39999]
       Probable fix: use a type annotation to specify what ‘a0’ should be.
       Potentially matching instances:
         instance Eq Ordering -- Defined in ‘GHC.Classes’
-        instance Eq Integer -- Defined in ‘GHC.Num.Integer’
+        instance Eq Integer -- Defined in ‘GHC.Internal.Bignum.Integer’
         ...plus 23 others
-        ...plus five instances involving out-of-scope types
+        ...plus six instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In a stmt of a 'do' block: return (x == x)
       In the expression:
@@ -43,3 +42,4 @@ T13242a.hs:13:13: error: [GHC-39999]
                  _ <- return 'a'
                  _ <- return 'b'
                  return (x == x)
+
diff --git a/testsuite/tests/ado/all.T b/testsuite/tests/ado/all.T
index 182b1aa6199..1cfd17ec0eb 100644
--- a/testsuite/tests/ado/all.T
+++ b/testsuite/tests/ado/all.T
@@ -1,7 +1,7 @@
 test('ado001', normal, compile_and_run, [''])
 test('ado002', normal, compile_fail, [''])
 test('ado003', normal, compile_fail, [''])
-test('ado004', normalise_version('ghc-internal','base','ghc-prim','ghc-bignum'), compile, [''])
+test('ado004', normalise_version('ghc-internal','base','ghc-prim'), compile, [''])
 test('ado005', normal, compile_fail, [''])
 test('ado006', normal, compile, [''])
 test('ado007', normal, compile, [''])
diff --git a/testsuite/tests/default/DefaultImportFail01.stderr b/testsuite/tests/default/DefaultImportFail01.stderr
index 3366c135a15..2a0f935f313 100644
--- a/testsuite/tests/default/DefaultImportFail01.stderr
+++ b/testsuite/tests/default/DefaultImportFail01.stderr
@@ -1,6 +1,5 @@
 [1 of 3] Compiling NonExportMonoidSum ( NonExportMonoidSum.hs, NonExportMonoidSum.o )
 [2 of 3] Compiling Main             ( DefaultImportFail01.hs, DefaultImportFail01.o )
-
 DefaultImportFail01.hs:5:8: error: [GHC-39999]
     • Ambiguous type variable ‘a0’ arising from a use of ‘print’
       prevents the constraint ‘(Show a0)’ from being solved.
@@ -28,3 +27,4 @@ DefaultImportFail01.hs:5:14: error: [GHC-39999]
     • In the first argument of ‘print’, namely ‘mempty’
       In the expression: print mempty
       In an equation for ‘main’: main = print mempty
+
diff --git a/testsuite/tests/default/DefaultImportFail02.stderr b/testsuite/tests/default/DefaultImportFail02.stderr
index 6efec9f9bb1..9c848bc9936 100644
--- a/testsuite/tests/default/DefaultImportFail02.stderr
+++ b/testsuite/tests/default/DefaultImportFail02.stderr
@@ -1,7 +1,6 @@
 [1 of 4] Compiling ExportMonoidProduct ( ExportMonoidProduct.hs, ExportMonoidProduct.o )
 [2 of 4] Compiling ExportMonoidSum  ( ExportMonoidSum.hs, ExportMonoidSum.o )
 [3 of 4] Compiling Main             ( DefaultImportFail02.hs, DefaultImportFail02.o )
-
 DefaultImportFail02.hs:6:8: error: [GHC-39999]
     • Ambiguous type variable ‘a0’ arising from a use of ‘print’
       prevents the constraint ‘(Show a0)’ from being solved.
@@ -29,3 +28,4 @@ DefaultImportFail02.hs:6:14: error: [GHC-39999]
     • In the first argument of ‘print’, namely ‘mempty’
       In the expression: print mempty
       In an equation for ‘main’: main = print mempty
+
diff --git a/testsuite/tests/default/DefaultImportFail03.stderr b/testsuite/tests/default/DefaultImportFail03.stderr
index de0acb35b4c..334b3926fdb 100644
--- a/testsuite/tests/default/DefaultImportFail03.stderr
+++ b/testsuite/tests/default/DefaultImportFail03.stderr
@@ -1,7 +1,6 @@
 [1 of 4] Compiling ExportMonoidSum  ( ExportMonoidSum.hs, ExportMonoidSum.o )
 [2 of 4] Compiling UnExportMonoidSum ( UnExportMonoidSum.hs, UnExportMonoidSum.o )
 [3 of 4] Compiling Main             ( DefaultImportFail03.hs, DefaultImportFail03.o )
-
 DefaultImportFail03.hs:5:8: error: [GHC-39999]
     • Ambiguous type variable ‘a0’ arising from a use of ‘print’
       prevents the constraint ‘(Show a0)’ from being solved.
@@ -29,3 +28,4 @@ DefaultImportFail03.hs:5:14: error: [GHC-39999]
     • In the first argument of ‘print’, namely ‘mempty’
       In the expression: print mempty
       In an equation for ‘main’: main = print mempty
+
diff --git a/testsuite/tests/default/DefaultImportFail04.stderr b/testsuite/tests/default/DefaultImportFail04.stderr
index 108db97694b..d51c577d678 100644
--- a/testsuite/tests/default/DefaultImportFail04.stderr
+++ b/testsuite/tests/default/DefaultImportFail04.stderr
@@ -1,7 +1,6 @@
 [1 of 4] Compiling ExportShowSum    ( ExportShowSum.hs, ExportShowSum.o )
 [2 of 4] Compiling ReExportShowSumModule ( ReExportShowSumModule.hs, ReExportShowSumModule.o )
 [3 of 4] Compiling Main             ( DefaultImportFail04.hs, DefaultImportFail04.o )
-
 DefaultImportFail04.hs:6:8: error: [GHC-39999]
     • Ambiguous type variable ‘a0’ arising from a use of ‘print’
       prevents the constraint ‘(Show a0)’ from being solved.
@@ -29,3 +28,4 @@ DefaultImportFail04.hs:6:14: error: [GHC-39999]
     • In the first argument of ‘print’, namely ‘mempty’
       In the expression: print mempty
       In an equation for ‘main’: main = print mempty
+
diff --git a/testsuite/tests/default/DefaultImportFail05.stderr b/testsuite/tests/default/DefaultImportFail05.stderr
index 35c2a81a5ac..a40b4f6c63c 100644
--- a/testsuite/tests/default/DefaultImportFail05.stderr
+++ b/testsuite/tests/default/DefaultImportFail05.stderr
@@ -1,7 +1,6 @@
 [1 of 4] Compiling ExportMonoidProduct ( ExportMonoidProduct.hs, ExportMonoidProduct.o )
 [2 of 4] Compiling ExportShowSum    ( ExportShowSum.hs, ExportShowSum.o )
 [3 of 4] Compiling Main             ( DefaultImportFail05.hs, DefaultImportFail05.o )
-
 DefaultImportFail05.hs:6:8: error: [GHC-39999]
     • Ambiguous type variable ‘a0’ arising from a use of ‘print’
       prevents the constraint ‘(Show a0)’ from being solved.
@@ -29,3 +28,4 @@ DefaultImportFail05.hs:6:14: error: [GHC-39999]
     • In the first argument of ‘print’, namely ‘mempty’
       In the expression: print mempty
       In an equation for ‘main’: main = print mempty
+
diff --git a/testsuite/tests/driver/T20604/T20604.stdout b/testsuite/tests/driver/T20604/T20604.stdout
index 59e41d640c7..195b1ad0a1c 100644
--- a/testsuite/tests/driver/T20604/T20604.stdout
+++ b/testsuite/tests/driver/T20604/T20604.stdout
@@ -1,5 +1,4 @@
 A1
 A
-addDependentFile "/home/teo/git/ghc/_build/stage1/lib/../lib/x86_64-linux-ghc-9.11.20240508/libHSghc-prim-0.11.0-inplace-ghc9.11.20240508.so" a63ccfcae8455a0abc22cfbd2ee0fee4
-addDependentFile "/home/teo/git/ghc/_build/stage1/lib/../lib/x86_64-linux-ghc-9.11.20240508/libHSghc-bignum-1.3-inplace-ghc9.11.20240508.so" fe8ae214b210d7ae50739f9b74c6d3bc
-addDependentFile "/home/teo/git/ghc/_build/stage1/lib/../lib/x86_64-linux-ghc-9.11.20240508/libHSghc-internal-9.1001.0-inplace-ghc9.11.20240508.so" cce9e35d3fb6c65a080cdb8a570f3caf
+addDependentFile "/home/hsyl20/projects/ghc/merge-root-libs/_build/stage1/lib/../lib/x86_64-linux-ghc-9.13.20241206/libHSghc-prim-0.11.0-inplace-ghc9.13.20241206.so" eb2f485440020aa72d9405ee2f412f28
+addDependentFile "/home/hsyl20/projects/ghc/merge-root-libs/_build/stage1/lib/../lib/x86_64-linux-ghc-9.13.20241206/libHSghc-internal-9.1300.0-inplace-ghc9.13.20241206.so" 1518b20f7a86f9851d924e1da640c1b3
diff --git a/testsuite/tests/ghci.debugger/scripts/break006.stderr b/testsuite/tests/ghci.debugger/scripts/break006.stderr
index 5df68406b87..5fc2c0f2dc5 100644
--- a/testsuite/tests/ghci.debugger/scripts/break006.stderr
+++ b/testsuite/tests/ghci.debugger/scripts/break006.stderr
@@ -1,4 +1,3 @@
-
 <interactive>:4:1: error: [GHC-39999]
     • No instance for ‘Show a’ arising from a use of ‘print’
       Cannot resolve unknown runtime type ‘a’
@@ -24,3 +23,4 @@
         ...plus 13 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In a stmt of an interactive GHCi command: print it
+
diff --git a/testsuite/tests/ghci/scripts/T9181.stdout b/testsuite/tests/ghci/scripts/T9181.stdout
index 13314fd84f5..92ef0455420 100644
--- a/testsuite/tests/ghci/scripts/T9181.stdout
+++ b/testsuite/tests/ghci/scripts/T9181.stdout
@@ -1,11 +1,14 @@
-type (GHC.Internal.TypeNats.*) :: GHC.Num.Natural.Natural
-                                  -> GHC.Num.Natural.Natural -> GHC.Num.Natural.Natural
+type (GHC.Internal.TypeNats.*) :: GHC.Internal.Bignum.Natural.Natural
+                                  -> GHC.Internal.Bignum.Natural.Natural
+                                  -> GHC.Internal.Bignum.Natural.Natural
 type family (GHC.Internal.TypeNats.*) a b
-type (GHC.Internal.TypeNats.+) :: GHC.Num.Natural.Natural
-                                  -> GHC.Num.Natural.Natural -> GHC.Num.Natural.Natural
+type (GHC.Internal.TypeNats.+) :: GHC.Internal.Bignum.Natural.Natural
+                                  -> GHC.Internal.Bignum.Natural.Natural
+                                  -> GHC.Internal.Bignum.Natural.Natural
 type family (GHC.Internal.TypeNats.+) a b
-type (GHC.Internal.TypeNats.-) :: GHC.Num.Natural.Natural
-                                  -> GHC.Num.Natural.Natural -> GHC.Num.Natural.Natural
+type (GHC.Internal.TypeNats.-) :: GHC.Internal.Bignum.Natural.Natural
+                                  -> GHC.Internal.Bignum.Natural.Natural
+                                  -> GHC.Internal.Bignum.Natural.Natural
 type family (GHC.Internal.TypeNats.-) a b
 type (GHC.Internal.Data.Type.Ord.<=) :: forall {t}.
                                         t -> t -> Constraint
@@ -21,13 +24,13 @@ type GHC.Internal.TypeLits.AppendSymbol :: GHC.Types.Symbol
                                            -> GHC.Types.Symbol -> GHC.Types.Symbol
 type family GHC.Internal.TypeLits.AppendSymbol a b
 type GHC.Internal.TypeLits.CharToNat :: Char
-                                        -> GHC.Num.Natural.Natural
+                                        -> GHC.Internal.Bignum.Natural.Natural
 type family GHC.Internal.TypeLits.CharToNat a
 type GHC.Internal.TypeLits.Internal.CmpChar :: Char
                                                -> Char -> Ordering
 type family GHC.Internal.TypeLits.Internal.CmpChar a b
-type GHC.Internal.TypeNats.Internal.CmpNat :: GHC.Num.Natural.Natural
-                                              -> GHC.Num.Natural.Natural -> Ordering
+type GHC.Internal.TypeNats.Internal.CmpNat :: GHC.Internal.Bignum.Natural.Natural
+                                              -> GHC.Internal.Bignum.Natural.Natural -> Ordering
 type family GHC.Internal.TypeNats.Internal.CmpNat a b
 type GHC.Internal.TypeLits.Internal.CmpSymbol :: GHC.Types.Symbol
                                                  -> GHC.Types.Symbol -> Ordering
@@ -35,8 +38,9 @@ type family GHC.Internal.TypeLits.Internal.CmpSymbol a b
 type GHC.Internal.TypeLits.ConsSymbol :: Char
                                          -> GHC.Types.Symbol -> GHC.Types.Symbol
 type family GHC.Internal.TypeLits.ConsSymbol a b
-type GHC.Internal.TypeNats.Div :: GHC.Num.Natural.Natural
-                                  -> GHC.Num.Natural.Natural -> GHC.Num.Natural.Natural
+type GHC.Internal.TypeNats.Div :: GHC.Internal.Bignum.Natural.Natural
+                                  -> GHC.Internal.Bignum.Natural.Natural
+                                  -> GHC.Internal.Bignum.Natural.Natural
 type family GHC.Internal.TypeNats.Div a b
 type GHC.Internal.TypeError.ErrorMessage :: *
 data GHC.Internal.TypeError.ErrorMessage
@@ -62,21 +66,23 @@ type GHC.Internal.TypeLits.KnownSymbol :: GHC.Types.Symbol
 class GHC.Internal.TypeLits.KnownSymbol n where
   GHC.Internal.TypeLits.symbolSing :: GHC.Internal.TypeLits.SSymbol n
   {-# MINIMAL symbolSing #-}
-type GHC.Internal.TypeNats.Log2 :: GHC.Num.Natural.Natural
-                                   -> GHC.Num.Natural.Natural
+type GHC.Internal.TypeNats.Log2 :: GHC.Internal.Bignum.Natural.Natural
+                                   -> GHC.Internal.Bignum.Natural.Natural
 type family GHC.Internal.TypeNats.Log2 a
-type GHC.Internal.TypeNats.Mod :: GHC.Num.Natural.Natural
-                                  -> GHC.Num.Natural.Natural -> GHC.Num.Natural.Natural
+type GHC.Internal.TypeNats.Mod :: GHC.Internal.Bignum.Natural.Natural
+                                  -> GHC.Internal.Bignum.Natural.Natural
+                                  -> GHC.Internal.Bignum.Natural.Natural
 type family GHC.Internal.TypeNats.Mod a b
 type GHC.Internal.TypeNats.Nat :: *
-type GHC.Internal.TypeNats.Nat = GHC.Num.Natural.Natural
-type GHC.Internal.TypeLits.NatToChar :: GHC.Num.Natural.Natural
+type GHC.Internal.TypeNats.Nat =
+  GHC.Internal.Bignum.Natural.Natural
+type GHC.Internal.TypeLits.NatToChar :: GHC.Internal.Bignum.Natural.Natural
                                         -> Char
 type family GHC.Internal.TypeLits.NatToChar a
-type GHC.Num.Natural.Natural :: *
-data GHC.Num.Natural.Natural
-  = GHC.Num.Natural.NS GHC.Prim.Word#
-  | GHC.Num.Natural.NB GHC.Prim.ByteArray#
+type GHC.Internal.Bignum.Natural.Natural :: *
+data GHC.Internal.Bignum.Natural.Natural
+  = GHC.Internal.Bignum.Natural.NS GHC.Prim.Word#
+  | GHC.Internal.Bignum.Natural.NB GHC.Prim.ByteArray#
 type role GHC.Internal.Data.Type.Ord.OrderingI nominal nominal
 type GHC.Internal.Data.Type.Ord.OrderingI :: forall {k}.
                                              k -> k -> *
@@ -105,7 +111,7 @@ pattern GHC.Internal.TypeNats.SNat
 type role GHC.Internal.TypeNats.SNat nominal
 type GHC.Internal.TypeNats.SNat :: GHC.Internal.TypeNats.Nat -> *
 newtype GHC.Internal.TypeNats.SNat n
-  = GHC.Internal.TypeNats.UnsafeSNat_ GHC.Num.Natural.Natural
+  = GHC.Internal.TypeNats.UnsafeSNat_ GHC.Internal.Bignum.Natural.Natural
 pattern GHC.Internal.TypeLits.SSymbol
   :: () =>
      GHC.Internal.TypeLits.KnownSymbol s =>
@@ -137,8 +143,9 @@ type family GHC.Internal.TypeError.TypeError a where
 type GHC.Internal.TypeLits.UnconsSymbol :: GHC.Types.Symbol
                                            -> Maybe (Char, GHC.Types.Symbol)
 type family GHC.Internal.TypeLits.UnconsSymbol a
-type (GHC.Internal.TypeNats.^) :: GHC.Num.Natural.Natural
-                                  -> GHC.Num.Natural.Natural -> GHC.Num.Natural.Natural
+type (GHC.Internal.TypeNats.^) :: GHC.Internal.Bignum.Natural.Natural
+                                  -> GHC.Internal.Bignum.Natural.Natural
+                                  -> GHC.Internal.Bignum.Natural.Natural
 type family (GHC.Internal.TypeNats.^) a b
 GHC.Internal.TypeLits.charVal ::
   GHC.Internal.TypeLits.KnownChar n => proxy n -> Char
diff --git a/testsuite/tests/indexed-types/should_fail/T12522a.stderr b/testsuite/tests/indexed-types/should_fail/T12522a.stderr
index 992b8d6ab2e..413c4a75390 100644
--- a/testsuite/tests/indexed-types/should_fail/T12522a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T12522a.stderr
@@ -1,4 +1,3 @@
-
 T12522a.hs:23:26: error: [GHC-39999]
     • Ambiguous type variable ‘a0’ arising from a use of ‘show’
       prevents the constraint ‘(Show a0)’ from being solved.
@@ -15,3 +14,4 @@ T12522a.hs:23:26: error: [GHC-39999]
     • In the first argument of ‘(++)’, namely ‘show n’
       In the second argument of ‘($)’, namely ‘show n ++ s’
       In the expression: I $ show n ++ s
+
diff --git a/testsuite/tests/interface-stability/base-exports.stdout b/testsuite/tests/interface-stability/base-exports.stdout
index ec496de2668..d81206959e7 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout
+++ b/testsuite/tests/interface-stability/base-exports.stdout
@@ -835,7 +835,7 @@ module Data.Data where
   type Constr :: *
   data Constr = ...
   type ConstrRep :: *
-  data ConstrRep = AlgConstr ConIndex | IntConstr GHC.Num.Integer.Integer | FloatConstr GHC.Internal.Real.Rational | CharConstr GHC.Types.Char
+  data ConstrRep = AlgConstr ConIndex | IntConstr GHC.Internal.Bignum.Integer.Integer | FloatConstr GHC.Internal.Real.Rational | CharConstr GHC.Types.Char
   type Data :: * -> Constraint
   class Typeable a => Data a where
     gfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> a -> c a
@@ -1010,10 +1010,10 @@ module Data.Fixed where
   data E9
   type role Fixed phantom
   type Fixed :: forall k. k -> *
-  newtype Fixed a = MkFixed GHC.Num.Integer.Integer
+  newtype Fixed a = MkFixed GHC.Internal.Bignum.Integer.Integer
   type HasResolution :: forall k. k -> Constraint
   class HasResolution @k a where
-    resolution :: forall (p :: k -> *). p a -> GHC.Num.Integer.Integer
+    resolution :: forall (p :: k -> *). p a -> GHC.Internal.Bignum.Integer.Integer
     {-# MINIMAL resolution #-}
   type Micro :: *
   type Micro = Fixed E6
@@ -1582,7 +1582,7 @@ module Data.Ratio where
   type Ratio :: * -> *
   data Ratio a = ...
   type Rational :: *
-  type Rational = Ratio GHC.Num.Integer.Integer
+  type Rational = Ratio GHC.Internal.Bignum.Integer.Integer
   approxRational :: forall a. GHC.Internal.Real.RealFrac a => a -> a -> Rational
   denominator :: forall a. Ratio a -> a
   numerator :: forall a. Ratio a -> a
@@ -7148,11 +7148,11 @@ module GHC.Float where
     {-# MINIMAL pi, exp, log, sin, cos, asin, acos, atan, sinh, cosh, asinh, acosh, atanh #-}
   type RealFloat :: * -> Constraint
   class (GHC.Internal.Real.RealFrac a, Floating a) => RealFloat a where
-    floatRadix :: a -> GHC.Num.Integer.Integer
+    floatRadix :: a -> GHC.Internal.Bignum.Integer.Integer
     floatDigits :: a -> GHC.Types.Int
     floatRange :: a -> (GHC.Types.Int, GHC.Types.Int)
-    decodeFloat :: a -> (GHC.Num.Integer.Integer, GHC.Types.Int)
-    encodeFloat :: GHC.Num.Integer.Integer -> GHC.Types.Int -> a
+    decodeFloat :: a -> (GHC.Internal.Bignum.Integer.Integer, GHC.Types.Int)
+    encodeFloat :: GHC.Internal.Bignum.Integer.Integer -> GHC.Types.Int -> a
     exponent :: a -> GHC.Types.Int
     significand :: a -> a
     scaleFloat :: GHC.Types.Int -> a -> a
@@ -7200,30 +7200,30 @@ module GHC.Float where
   expFloat :: Float -> Float
   expm1Double :: Double -> Double
   expm1Float :: Float -> Float
-  expt :: GHC.Num.Integer.Integer -> GHC.Types.Int -> GHC.Num.Integer.Integer
-  expts :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer
-  expts10 :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer
+  expt :: GHC.Internal.Bignum.Integer.Integer -> GHC.Types.Int -> GHC.Internal.Bignum.Integer.Integer
+  expts :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Internal.Bignum.Integer.Integer
+  expts10 :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Internal.Bignum.Integer.Integer
   fabsDouble :: Double -> Double
   fabsFloat :: Float -> Float
   float2Double :: Float -> Double
   float2Int :: Float -> GHC.Types.Int
-  floatToDigits :: forall a. RealFloat a => GHC.Num.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
+  floatToDigits :: forall a. RealFloat a => GHC.Internal.Bignum.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
   floorDouble :: forall b. GHC.Internal.Real.Integral b => Double -> b
   floorFloat :: forall b. GHC.Internal.Real.Integral b => Float -> b
   formatRealFloat :: forall a. RealFloat a => FFFormat -> GHC.Internal.Maybe.Maybe GHC.Types.Int -> a -> GHC.Internal.Base.String
   formatRealFloatAlt :: forall a. RealFloat a => FFFormat -> GHC.Internal.Maybe.Maybe GHC.Types.Int -> GHC.Types.Bool -> a -> GHC.Internal.Base.String
   fromRat :: forall a. RealFloat a => GHC.Internal.Real.Rational -> a
   fromRat' :: forall a. RealFloat a => GHC.Internal.Real.Rational -> a
-  fromRat'' :: forall a. RealFloat a => GHC.Types.Int -> GHC.Types.Int -> GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> a
+  fromRat'' :: forall a. RealFloat a => GHC.Types.Int -> GHC.Types.Int -> GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> a
   geDouble :: Double -> Double -> GHC.Types.Bool
   geFloat :: Float -> Float -> GHC.Types.Bool
   gtDouble :: Double -> Double -> GHC.Types.Bool
   gtFloat :: Float -> Float -> GHC.Types.Bool
   int2Double :: GHC.Types.Int -> Double
   int2Float :: GHC.Types.Int -> Float
-  integerToBinaryFloat' :: forall a. RealFloat a => GHC.Num.Integer.Integer -> a
-  integerToDouble# :: GHC.Num.Integer.Integer -> Double#
-  integerToFloat# :: GHC.Num.Integer.Integer -> Float#
+  integerToBinaryFloat' :: forall a. RealFloat a => GHC.Internal.Bignum.Integer.Integer -> a
+  integerToDouble# :: GHC.Internal.Bignum.Integer.Integer -> Double#
+  integerToFloat# :: GHC.Internal.Bignum.Integer.Integer -> Float#
   isDoubleDenormalized :: Double -> GHC.Types.Int
   isDoubleFinite :: Double -> GHC.Types.Int
   isDoubleInfinite :: Double -> GHC.Types.Int
@@ -7248,8 +7248,8 @@ module GHC.Float where
   minExpt :: GHC.Types.Int
   minusDouble :: Double -> Double -> Double
   minusFloat :: Float -> Float -> Float
-  naturalToDouble# :: GHC.Num.Natural.Natural -> Double#
-  naturalToFloat# :: GHC.Num.Natural.Natural -> Float#
+  naturalToDouble# :: GHC.Internal.Bignum.Natural.Natural -> Double#
+  naturalToFloat# :: GHC.Internal.Bignum.Natural.Natural -> Float#
   negateDouble :: Double -> Double
   negateFloat :: Float -> Float
   plusDouble :: Double -> Double -> Double
@@ -7258,12 +7258,12 @@ module GHC.Float where
   powerFloat :: Float -> Float -> Float
   properFractionDouble :: forall b. GHC.Internal.Real.Integral b => Double -> (b, Double)
   properFractionFloat :: forall b. GHC.Internal.Real.Integral b => Float -> (b, Float)
-  rationalToDouble :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> Double
-  rationalToFloat :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> Float
+  rationalToDouble :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> Double
+  rationalToFloat :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> Float
   roundDouble :: forall b. GHC.Internal.Real.Integral b => Double -> b
   roundFloat :: forall b. GHC.Internal.Real.Integral b => Float -> b
   roundTo :: GHC.Types.Int -> GHC.Types.Int -> [GHC.Types.Int] -> (GHC.Types.Int, [GHC.Types.Int])
-  roundingMode# :: GHC.Num.Integer.Integer -> GHC.Prim.Int# -> GHC.Prim.Int#
+  roundingMode# :: GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int# -> GHC.Prim.Int#
   showFloat :: forall a. RealFloat a => a -> GHC.Internal.Show.ShowS
   showSignedFloat :: forall a. RealFloat a => (a -> GHC.Internal.Show.ShowS) -> GHC.Types.Int -> a -> GHC.Internal.Show.ShowS
   sinDouble :: Double -> Double
@@ -7289,33 +7289,33 @@ module GHC.Float where
 
 module GHC.Float.ConversionUtils where
   -- Safety: Safe
-  elimZerosInt# :: GHC.Prim.Int# -> GHC.Prim.Int# -> (# GHC.Num.Integer.Integer, GHC.Prim.Int# #)
-  elimZerosInteger :: GHC.Num.Integer.Integer -> GHC.Prim.Int# -> (# GHC.Num.Integer.Integer, GHC.Prim.Int# #)
+  elimZerosInt# :: GHC.Prim.Int# -> GHC.Prim.Int# -> (# GHC.Internal.Bignum.Integer.Integer, GHC.Prim.Int# #)
+  elimZerosInteger :: GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int# -> (# GHC.Internal.Bignum.Integer.Integer, GHC.Prim.Int# #)
 
 module GHC.Float.RealFracMethods where
   -- Safety: Safe
   ceilingDoubleInt :: GHC.Types.Double -> GHC.Types.Int
-  ceilingDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
+  ceilingDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
   ceilingFloatInt :: GHC.Types.Float -> GHC.Types.Int
-  ceilingFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
+  ceilingFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
   double2Int :: GHC.Types.Double -> GHC.Types.Int
   float2Int :: GHC.Types.Float -> GHC.Types.Int
   floorDoubleInt :: GHC.Types.Double -> GHC.Types.Int
-  floorDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
+  floorDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
   floorFloatInt :: GHC.Types.Float -> GHC.Types.Int
-  floorFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
+  floorFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
   int2Double :: GHC.Types.Int -> GHC.Types.Double
   int2Float :: GHC.Types.Int -> GHC.Types.Float
   properFractionDoubleInt :: GHC.Types.Double -> (GHC.Types.Int, GHC.Types.Double)
-  properFractionDoubleInteger :: GHC.Types.Double -> (GHC.Num.Integer.Integer, GHC.Types.Double)
+  properFractionDoubleInteger :: GHC.Types.Double -> (GHC.Internal.Bignum.Integer.Integer, GHC.Types.Double)
   properFractionFloatInt :: GHC.Types.Float -> (GHC.Types.Int, GHC.Types.Float)
-  properFractionFloatInteger :: GHC.Types.Float -> (GHC.Num.Integer.Integer, GHC.Types.Float)
+  properFractionFloatInteger :: GHC.Types.Float -> (GHC.Internal.Bignum.Integer.Integer, GHC.Types.Float)
   roundDoubleInt :: GHC.Types.Double -> GHC.Types.Int
-  roundDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
+  roundDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
   roundFloatInt :: GHC.Types.Float -> GHC.Types.Int
-  roundFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
-  truncateDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
-  truncateFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
+  roundFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
+  truncateDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
+  truncateFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
 
 module GHC.Foreign where
   -- Safety: Safe
@@ -7613,10 +7613,10 @@ module GHC.IO.Device where
     close :: a -> GHC.Types.IO ()
     isTerminal :: a -> GHC.Types.IO GHC.Types.Bool
     isSeekable :: a -> GHC.Types.IO GHC.Types.Bool
-    seek :: a -> SeekMode -> GHC.Num.Integer.Integer -> GHC.Types.IO GHC.Num.Integer.Integer
-    tell :: a -> GHC.Types.IO GHC.Num.Integer.Integer
-    getSize :: a -> GHC.Types.IO GHC.Num.Integer.Integer
-    setSize :: a -> GHC.Num.Integer.Integer -> GHC.Types.IO ()
+    seek :: a -> SeekMode -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
+    tell :: a -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
+    getSize :: a -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
+    setSize :: a -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO ()
     setEcho :: a -> GHC.Types.Bool -> GHC.Types.IO ()
     getEcho :: a -> GHC.Types.IO GHC.Types.Bool
     setRaw :: a -> GHC.Types.Bool -> GHC.Types.IO ()
@@ -7844,7 +7844,7 @@ module GHC.IO.Handle where
   type Handle :: *
   data Handle = ...
   type HandlePosition :: *
-  type HandlePosition = GHC.Num.Integer.Integer
+  type HandlePosition = GHC.Internal.Bignum.Integer.Integer
   type HandlePosn :: *
   data HandlePosn = HandlePosn Handle HandlePosition
   type LockMode :: *
@@ -7859,7 +7859,7 @@ module GHC.IO.Handle where
   hClose_help :: GHC.Internal.IO.Handle.Types.Handle__ -> GHC.Types.IO (GHC.Internal.IO.Handle.Types.Handle__, GHC.Internal.Maybe.Maybe GHC.Internal.Exception.Type.SomeException)
   hDuplicate :: Handle -> GHC.Types.IO Handle
   hDuplicateTo :: Handle -> Handle -> GHC.Types.IO ()
-  hFileSize :: Handle -> GHC.Types.IO GHC.Num.Integer.Integer
+  hFileSize :: Handle -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
   hFlush :: Handle -> GHC.Types.IO ()
   hFlushAll :: Handle -> GHC.Types.IO ()
   hGetBuf :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Int
@@ -7885,16 +7885,16 @@ module GHC.IO.Handle where
   hPutBufNonBlocking :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Int
   hPutChar :: Handle -> GHC.Types.Char -> GHC.Types.IO ()
   hPutStr :: Handle -> GHC.Internal.Base.String -> GHC.Types.IO ()
-  hSeek :: Handle -> SeekMode -> GHC.Num.Integer.Integer -> GHC.Types.IO ()
+  hSeek :: Handle -> SeekMode -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO ()
   hSetBinaryMode :: Handle -> GHC.Types.Bool -> GHC.Types.IO ()
   hSetBuffering :: Handle -> BufferMode -> GHC.Types.IO ()
   hSetEcho :: Handle -> GHC.Types.Bool -> GHC.Types.IO ()
   hSetEncoding :: Handle -> GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Types.IO ()
-  hSetFileSize :: Handle -> GHC.Num.Integer.Integer -> GHC.Types.IO ()
+  hSetFileSize :: Handle -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO ()
   hSetNewlineMode :: Handle -> NewlineMode -> GHC.Types.IO ()
   hSetPosn :: HandlePosn -> GHC.Types.IO ()
   hShow :: Handle -> GHC.Types.IO GHC.Internal.Base.String
-  hTell :: Handle -> GHC.Types.IO GHC.Num.Integer.Integer
+  hTell :: Handle -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
   hTryLock :: Handle -> LockMode -> GHC.Types.IO GHC.Types.Bool
   hWaitForInput :: Handle -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Bool
   isEOF :: GHC.Types.IO GHC.Types.Bool
@@ -8228,8 +8228,8 @@ module GHC.Integer where
 
 module GHC.Integer.Logarithms where
   -- Safety: None
-  integerLog2# :: GHC.Num.Integer.Integer -> GHC.Prim.Int#
-  integerLogBase# :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> GHC.Prim.Int#
+  integerLog2# :: GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int#
+  integerLogBase# :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int#
   wordLog2# :: GHC.Prim.Word# -> GHC.Prim.Int#
 
 module GHC.IsList where
@@ -8344,7 +8344,7 @@ module GHC.Maybe where
 module GHC.Natural where
   -- Safety: Safe
   type BigNat :: *
-  data BigNat = BN# {unBigNat :: GHC.Num.BigNat.BigNat#}
+  data BigNat = BN# {unBigNat :: GHC.Internal.Bignum.BigNat.BigNat#}
   pattern NatJ# :: BigNat -> Natural
   pattern NatS# :: GHC.Prim.Word# -> Natural
   type Natural :: *
@@ -8357,8 +8357,8 @@ module GHC.Natural where
   minusNatural :: Natural -> Natural -> Natural
   minusNaturalMaybe :: Natural -> Natural -> GHC.Internal.Maybe.Maybe Natural
   mkNatural :: [GHC.Types.Word] -> Natural
-  naturalFromInteger :: GHC.Num.Integer.Integer -> Natural
-  naturalToInteger :: Natural -> GHC.Num.Integer.Integer
+  naturalFromInteger :: GHC.Internal.Bignum.Integer.Integer -> Natural
+  naturalToInteger :: Natural -> GHC.Internal.Bignum.Integer.Integer
   naturalToWord :: Natural -> GHC.Types.Word
   naturalToWordMaybe :: Natural -> GHC.Internal.Maybe.Maybe GHC.Types.Word
   negateNatural :: Natural -> Natural
@@ -8400,7 +8400,7 @@ module GHC.Num where
   integerBit :: GHC.Types.Word -> Integer
   integerBit# :: GHC.Prim.Word# -> Integer
   integerCheck :: Integer -> GHC.Types.Bool
-  integerCheck# :: Integer -> GHC.Num.Primitives.Bool#
+  integerCheck# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerCompare :: Integer -> Integer -> GHC.Types.Ordering
   integerComplement :: Integer -> Integer
   integerDecodeDouble# :: GHC.Prim.Double# -> (# Integer, GHC.Prim.Int# #)
@@ -8411,14 +8411,14 @@ module GHC.Num where
   integerEncodeDouble# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Double#
   integerEncodeFloat# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Float#
   integerEq :: Integer -> Integer -> GHC.Types.Bool
-  integerEq# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
-  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Integer
-  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
-  integerFromBigNat# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatNeg# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Num.BigNat.BigNat# -> Integer
-  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> Integer
-  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerEq# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
+  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Integer
+  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatNeg# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> Integer
+  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
   integerFromInt :: GHC.Types.Int -> Integer
   integerFromInt# :: GHC.Prim.Int# -> Integer
   integerFromInt64# :: GHC.Prim.Int64# -> Integer
@@ -8433,17 +8433,17 @@ module GHC.Num where
   integerGcde :: Integer -> Integer -> (Integer, Integer, Integer)
   integerGcde# :: Integer -> Integer -> (# Integer, Integer, Integer #)
   integerGe :: Integer -> Integer -> GHC.Types.Bool
-  integerGe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerGt :: Integer -> Integer -> GHC.Types.Bool
-  integerGt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsNegative :: Integer -> GHC.Types.Bool
-  integerIsNegative# :: Integer -> GHC.Num.Primitives.Bool#
+  integerIsNegative# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsOne :: Integer -> GHC.Types.Bool
   integerIsPowerOf2# :: Integer -> (# (# #) | GHC.Prim.Word# #)
   integerIsZero :: Integer -> GHC.Types.Bool
   integerLcm :: Integer -> Integer -> Integer
   integerLe :: Integer -> Integer -> GHC.Types.Bool
-  integerLe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerLog2 :: Integer -> GHC.Types.Word
   integerLog2# :: Integer -> GHC.Prim.Word#
   integerLogBase :: Integer -> Integer -> GHC.Types.Word
@@ -8451,11 +8451,11 @@ module GHC.Num where
   integerLogBaseWord :: GHC.Types.Word -> Integer -> GHC.Types.Word
   integerLogBaseWord# :: GHC.Prim.Word# -> Integer -> GHC.Prim.Word#
   integerLt :: Integer -> Integer -> GHC.Types.Bool
-  integerLt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerMod :: Integer -> Integer -> Integer
   integerMul :: Integer -> Integer -> Integer
   integerNe :: Integer -> Integer -> GHC.Types.Bool
-  integerNe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerNe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerNegate :: Integer -> Integer
   integerOne :: Integer
   integerOr :: Integer -> Integer -> Integer
@@ -8476,16 +8476,16 @@ module GHC.Num where
   integerSqr :: Integer -> Integer
   integerSub :: Integer -> Integer -> Integer
   integerTestBit :: Integer -> GHC.Types.Word -> GHC.Types.Bool
-  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  integerToBigNatClamp# :: Integer -> GHC.Num.BigNat.BigNat#
-  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Num.BigNat.BigNat# #)
+  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToBigNatClamp# :: Integer -> GHC.Internal.Bignum.BigNat.BigNat#
+  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Internal.Bignum.BigNat.BigNat# #)
   integerToInt :: Integer -> GHC.Types.Int
   integerToInt# :: Integer -> GHC.Prim.Int#
   integerToInt64# :: Integer -> GHC.Prim.Int64#
-  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   integerToNatural :: Integer -> Natural
   integerToNaturalClamp :: Integer -> Natural
   integerToNaturalThrow :: Integer -> Natural
@@ -8500,7 +8500,7 @@ module GHC.Num where
   naturalBit :: GHC.Types.Word -> Natural
   naturalBit# :: GHC.Prim.Word# -> Natural
   naturalCheck :: Natural -> GHC.Types.Bool
-  naturalCheck# :: Natural -> GHC.Num.Primitives.Bool#
+  naturalCheck# :: Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalClearBit :: Natural -> GHC.Types.Word -> Natural
   naturalClearBit# :: Natural -> GHC.Prim.Word# -> Natural
   naturalCompare :: Natural -> Natural -> GHC.Types.Ordering
@@ -8509,26 +8509,26 @@ module GHC.Num where
   naturalEncodeDouble# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Double#
   naturalEncodeFloat# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Float#
   naturalEq :: Natural -> Natural -> GHC.Types.Bool
-  naturalEq# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
-  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Natural
-  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
-  naturalFromBigNat# :: GHC.Num.BigNat.BigNat# -> Natural
-  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalEq# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Natural
+  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Natural
+  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
   naturalFromWord :: GHC.Types.Word -> Natural
   naturalFromWord# :: GHC.Prim.Word# -> Natural
   naturalFromWord2# :: GHC.Prim.Word# -> GHC.Prim.Word# -> Natural
   naturalFromWordList :: [GHC.Types.Word] -> Natural
   naturalGcd :: Natural -> Natural -> Natural
   naturalGe :: Natural -> Natural -> GHC.Types.Bool
-  naturalGe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalGt :: Natural -> Natural -> GHC.Types.Bool
-  naturalGt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalIsOne :: Natural -> GHC.Types.Bool
   naturalIsPowerOf2# :: Natural -> (# (# #) | GHC.Prim.Word# #)
   naturalIsZero :: Natural -> GHC.Types.Bool
   naturalLcm :: Natural -> Natural -> Natural
   naturalLe :: Natural -> Natural -> GHC.Types.Bool
-  naturalLe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalLog2 :: Natural -> GHC.Types.Word
   naturalLog2# :: Natural -> GHC.Prim.Word#
   naturalLogBase :: Natural -> Natural -> GHC.Types.Word
@@ -8536,10 +8536,10 @@ module GHC.Num where
   naturalLogBaseWord :: GHC.Types.Word -> Natural -> GHC.Types.Word
   naturalLogBaseWord# :: GHC.Prim.Word# -> Natural -> GHC.Prim.Word#
   naturalLt :: Natural -> Natural -> GHC.Types.Bool
-  naturalLt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalMul :: Natural -> Natural -> Natural
   naturalNe :: Natural -> Natural -> GHC.Types.Bool
-  naturalNe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalNe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalNegate :: Natural -> Natural
   naturalOne :: Natural
   naturalOr :: Natural -> Natural -> Natural
@@ -8563,11 +8563,11 @@ module GHC.Num where
   naturalSubThrow :: Natural -> Natural -> Natural
   naturalSubUnsafe :: Natural -> Natural -> Natural
   naturalTestBit :: Natural -> GHC.Types.Word -> GHC.Types.Bool
-  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  naturalToBigNat# :: Natural -> GHC.Num.BigNat.BigNat#
-  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalToBigNat# :: Natural -> GHC.Internal.Bignum.BigNat.BigNat#
+  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   naturalToWord :: Natural -> GHC.Types.Word
   naturalToWord# :: Natural -> GHC.Prim.Word#
   naturalToWordClamp :: Natural -> GHC.Types.Word
@@ -8583,7 +8583,7 @@ module GHC.Num.BigNat where
   type BigNat :: *
   data BigNat = BN# {unBigNat :: BigNat#}
   type BigNat# :: GHC.Types.UnliftedType
-  type BigNat# = GHC.Num.WordArray.WordArray#
+  type BigNat# = GHC.Internal.Bignum.WordArray.WordArray#
   bigNatAdd :: BigNat# -> BigNat# -> BigNat#
   bigNatAddWord :: BigNat# -> GHC.Types.Word -> BigNat#
   bigNatAddWord# :: BigNat# -> GHC.Prim.Word# -> BigNat#
@@ -8595,7 +8595,7 @@ module GHC.Num.BigNat where
   bigNatBit :: GHC.Types.Word -> BigNat#
   bigNatBit# :: GHC.Prim.Word# -> BigNat#
   bigNatCheck :: BigNat# -> GHC.Types.Bool
-  bigNatCheck# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatCheck# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatClearBit# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatCompare :: BigNat# -> BigNat# -> GHC.Types.Ordering
   bigNatCompareWord :: BigNat# -> GHC.Types.Word -> GHC.Types.Ordering
@@ -8607,48 +8607,48 @@ module GHC.Num.BigNat where
   bigNatCtzWord# :: BigNat# -> GHC.Prim.Word#
   bigNatEncodeDouble# :: BigNat# -> GHC.Prim.Int# -> GHC.Prim.Double#
   bigNatEq :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatEq# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
-  bigNatEqWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
+  bigNatEq# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
+  bigNatEqWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatFromAbsInt# :: GHC.Prim.Int# -> BigNat#
-  bigNatFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
+  bigNatFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromAddrBE# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromAddrLE# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
-  bigNatFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
+  bigNatFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromByteArrayBE# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromByteArrayLE# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromWord :: GHC.Types.Word -> BigNat#
   bigNatFromWord# :: GHC.Prim.Word# -> BigNat#
   bigNatFromWord2# :: GHC.Prim.Word# -> GHC.Prim.Word# -> BigNat#
   bigNatFromWord64# :: GHC.Prim.Word64# -> BigNat#
-  bigNatFromWordArray :: GHC.Num.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat
-  bigNatFromWordArray# :: GHC.Num.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat#
+  bigNatFromWordArray :: GHC.Internal.Bignum.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat
+  bigNatFromWordArray# :: GHC.Internal.Bignum.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat#
   bigNatFromWordList :: [GHC.Types.Word] -> BigNat#
-  bigNatFromWordList# :: [GHC.Types.Word] -> GHC.Num.WordArray.WordArray#
+  bigNatFromWordList# :: [GHC.Types.Word] -> GHC.Internal.Bignum.WordArray.WordArray#
   bigNatFromWordListUnsafe :: [GHC.Types.Word] -> BigNat#
   bigNatGcd :: BigNat# -> BigNat# -> BigNat#
   bigNatGcdWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Prim.Word#
   bigNatGe :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatGe# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatGe# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatGt :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatGt# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatGt# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatGtWord :: BigNat# -> GHC.Types.Word -> GHC.Types.Bool
-  bigNatGtWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
+  bigNatGtWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatIndex :: BigNat# -> GHC.Prim.Int# -> GHC.Types.Word
   bigNatIndex# :: BigNat# -> GHC.Prim.Int# -> GHC.Prim.Word#
   bigNatIsOne :: BigNat# -> GHC.Types.Bool
-  bigNatIsOne# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatIsOne# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatIsPowerOf2# :: BigNat# -> (# (# #) | GHC.Prim.Word# #)
   bigNatIsTwo :: BigNat# -> GHC.Types.Bool
-  bigNatIsTwo# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatIsTwo# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatIsZero :: BigNat# -> GHC.Types.Bool
-  bigNatIsZero# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatIsZero# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatLcm :: BigNat# -> BigNat# -> BigNat#
   bigNatLcmWord# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatLcmWordWord# :: GHC.Prim.Word# -> GHC.Prim.Word# -> BigNat#
   bigNatLe :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatLe# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatLe# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatLeWord :: BigNat# -> GHC.Types.Word -> GHC.Types.Bool
-  bigNatLeWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
+  bigNatLeWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatLog2 :: BigNat# -> GHC.Types.Word
   bigNatLog2# :: BigNat# -> GHC.Prim.Word#
   bigNatLogBase :: BigNat# -> BigNat# -> GHC.Types.Word
@@ -8656,12 +8656,12 @@ module GHC.Num.BigNat where
   bigNatLogBaseWord :: GHC.Types.Word -> BigNat# -> GHC.Types.Word
   bigNatLogBaseWord# :: GHC.Prim.Word# -> BigNat# -> GHC.Prim.Word#
   bigNatLt :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatLt# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatLt# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatMul :: BigNat# -> BigNat# -> BigNat#
   bigNatMulWord :: BigNat# -> GHC.Types.Word -> BigNat#
   bigNatMulWord# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatNe :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatNe# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatNe# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatOne :: BigNat
   bigNatOne# :: (# #) -> BigNat#
   bigNatOr :: BigNat# -> BigNat# -> BigNat#
@@ -8695,14 +8695,14 @@ module GHC.Num.BigNat where
   bigNatSubWordUnsafe :: BigNat# -> GHC.Types.Word -> BigNat#
   bigNatSubWordUnsafe# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatTestBit :: BigNat# -> GHC.Types.Word -> GHC.Types.Bool
-  bigNatTestBit# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  bigNatToAddr :: BigNat# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  bigNatToAddr# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  bigNatTestBit# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  bigNatToAddr :: BigNat# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  bigNatToAddr# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToAddrBE# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToAddrLE# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToInt :: BigNat# -> GHC.Types.Int
   bigNatToInt# :: BigNat# -> GHC.Prim.Int#
-  bigNatToMutableByteArray# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  bigNatToMutableByteArray# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToMutableByteArrayBE# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToMutableByteArrayLE# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToWord :: BigNat# -> GHC.Types.Word
@@ -8731,7 +8731,7 @@ module GHC.Num.Integer where
   integerBit :: GHC.Types.Word -> Integer
   integerBit# :: GHC.Prim.Word# -> Integer
   integerCheck :: Integer -> GHC.Types.Bool
-  integerCheck# :: Integer -> GHC.Num.Primitives.Bool#
+  integerCheck# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerCompare :: Integer -> Integer -> GHC.Types.Ordering
   integerComplement :: Integer -> Integer
   integerDecodeDouble# :: GHC.Prim.Double# -> (# Integer, GHC.Prim.Int# #)
@@ -8742,18 +8742,18 @@ module GHC.Num.Integer where
   integerEncodeDouble# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Double#
   integerEncodeFloat# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Float#
   integerEq :: Integer -> Integer -> GHC.Types.Bool
-  integerEq# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
-  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Integer
-  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
-  integerFromBigNat# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatNeg# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Num.BigNat.BigNat# -> Integer
-  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> Integer
-  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerEq# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
+  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Integer
+  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatNeg# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> Integer
+  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
   integerFromInt :: GHC.Types.Int -> Integer
   integerFromInt# :: GHC.Prim.Int# -> Integer
   integerFromInt64# :: GHC.Prim.Int64# -> Integer
-  integerFromNatural :: GHC.Num.Natural.Natural -> Integer
+  integerFromNatural :: GHC.Internal.Bignum.Natural.Natural -> Integer
   integerFromWord :: GHC.Types.Word -> Integer
   integerFromWord# :: GHC.Prim.Word# -> Integer
   integerFromWord64# :: GHC.Prim.Word64# -> Integer
@@ -8764,17 +8764,17 @@ module GHC.Num.Integer where
   integerGcde :: Integer -> Integer -> (Integer, Integer, Integer)
   integerGcde# :: Integer -> Integer -> (# Integer, Integer, Integer #)
   integerGe :: Integer -> Integer -> GHC.Types.Bool
-  integerGe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerGt :: Integer -> Integer -> GHC.Types.Bool
-  integerGt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsNegative :: Integer -> GHC.Types.Bool
-  integerIsNegative# :: Integer -> GHC.Num.Primitives.Bool#
+  integerIsNegative# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsOne :: Integer -> GHC.Types.Bool
   integerIsPowerOf2# :: Integer -> (# (# #) | GHC.Prim.Word# #)
   integerIsZero :: Integer -> GHC.Types.Bool
   integerLcm :: Integer -> Integer -> Integer
   integerLe :: Integer -> Integer -> GHC.Types.Bool
-  integerLe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerLog2 :: Integer -> GHC.Types.Word
   integerLog2# :: Integer -> GHC.Prim.Word#
   integerLogBase :: Integer -> Integer -> GHC.Types.Word
@@ -8782,20 +8782,20 @@ module GHC.Num.Integer where
   integerLogBaseWord :: GHC.Types.Word -> Integer -> GHC.Types.Word
   integerLogBaseWord# :: GHC.Prim.Word# -> Integer -> GHC.Prim.Word#
   integerLt :: Integer -> Integer -> GHC.Types.Bool
-  integerLt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerMod :: Integer -> Integer -> Integer
   integerMul :: Integer -> Integer -> Integer
   integerNe :: Integer -> Integer -> GHC.Types.Bool
-  integerNe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerNe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerNegate :: Integer -> Integer
   integerOne :: Integer
   integerOr :: Integer -> Integer -> Integer
   integerPopCount# :: Integer -> GHC.Prim.Int#
-  integerPowMod# :: Integer -> Integer -> GHC.Num.Natural.Natural -> (# GHC.Num.Natural.Natural | () #)
+  integerPowMod# :: Integer -> Integer -> GHC.Internal.Bignum.Natural.Natural -> (# GHC.Internal.Bignum.Natural.Natural | () #)
   integerQuot :: Integer -> Integer -> Integer
   integerQuotRem :: Integer -> Integer -> (Integer, Integer)
   integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #)
-  integerRecipMod# :: Integer -> GHC.Num.Natural.Natural -> (# GHC.Num.Natural.Natural | () #)
+  integerRecipMod# :: Integer -> GHC.Internal.Bignum.Natural.Natural -> (# GHC.Internal.Bignum.Natural.Natural | () #)
   integerRem :: Integer -> Integer -> Integer
   integerShiftL :: Integer -> GHC.Types.Word -> Integer
   integerShiftL# :: Integer -> GHC.Prim.Word# -> Integer
@@ -8807,19 +8807,19 @@ module GHC.Num.Integer where
   integerSqr :: Integer -> Integer
   integerSub :: Integer -> Integer -> Integer
   integerTestBit :: Integer -> GHC.Types.Word -> GHC.Types.Bool
-  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  integerToBigNatClamp# :: Integer -> GHC.Num.BigNat.BigNat#
-  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Num.BigNat.BigNat# #)
+  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToBigNatClamp# :: Integer -> GHC.Internal.Bignum.BigNat.BigNat#
+  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Internal.Bignum.BigNat.BigNat# #)
   integerToInt :: Integer -> GHC.Types.Int
   integerToInt# :: Integer -> GHC.Prim.Int#
   integerToInt64# :: Integer -> GHC.Prim.Int64#
-  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  integerToNatural :: Integer -> GHC.Num.Natural.Natural
-  integerToNaturalClamp :: Integer -> GHC.Num.Natural.Natural
-  integerToNaturalThrow :: Integer -> GHC.Num.Natural.Natural
+  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToNatural :: Integer -> GHC.Internal.Bignum.Natural.Natural
+  integerToNaturalClamp :: Integer -> GHC.Internal.Bignum.Natural.Natural
+  integerToNaturalThrow :: Integer -> GHC.Internal.Bignum.Natural.Natural
   integerToWord :: Integer -> GHC.Types.Word
   integerToWord# :: Integer -> GHC.Prim.Word#
   integerToWord64# :: Integer -> GHC.Prim.Word64#
@@ -8836,7 +8836,7 @@ module GHC.Num.Natural where
   naturalBit :: GHC.Types.Word -> Natural
   naturalBit# :: GHC.Prim.Word# -> Natural
   naturalCheck :: Natural -> GHC.Types.Bool
-  naturalCheck# :: Natural -> GHC.Num.Primitives.Bool#
+  naturalCheck# :: Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalClearBit :: Natural -> GHC.Types.Word -> Natural
   naturalClearBit# :: Natural -> GHC.Prim.Word# -> Natural
   naturalCompare :: Natural -> Natural -> GHC.Types.Ordering
@@ -8845,26 +8845,26 @@ module GHC.Num.Natural where
   naturalEncodeDouble# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Double#
   naturalEncodeFloat# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Float#
   naturalEq :: Natural -> Natural -> GHC.Types.Bool
-  naturalEq# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
-  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Natural
-  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
-  naturalFromBigNat# :: GHC.Num.BigNat.BigNat# -> Natural
-  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalEq# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Natural
+  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Natural
+  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
   naturalFromWord :: GHC.Types.Word -> Natural
   naturalFromWord# :: GHC.Prim.Word# -> Natural
   naturalFromWord2# :: GHC.Prim.Word# -> GHC.Prim.Word# -> Natural
   naturalFromWordList :: [GHC.Types.Word] -> Natural
   naturalGcd :: Natural -> Natural -> Natural
   naturalGe :: Natural -> Natural -> GHC.Types.Bool
-  naturalGe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalGt :: Natural -> Natural -> GHC.Types.Bool
-  naturalGt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalIsOne :: Natural -> GHC.Types.Bool
   naturalIsPowerOf2# :: Natural -> (# (# #) | GHC.Prim.Word# #)
   naturalIsZero :: Natural -> GHC.Types.Bool
   naturalLcm :: Natural -> Natural -> Natural
   naturalLe :: Natural -> Natural -> GHC.Types.Bool
-  naturalLe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalLog2 :: Natural -> GHC.Types.Word
   naturalLog2# :: Natural -> GHC.Prim.Word#
   naturalLogBase :: Natural -> Natural -> GHC.Types.Word
@@ -8872,10 +8872,10 @@ module GHC.Num.Natural where
   naturalLogBaseWord :: GHC.Types.Word -> Natural -> GHC.Types.Word
   naturalLogBaseWord# :: GHC.Prim.Word# -> Natural -> GHC.Prim.Word#
   naturalLt :: Natural -> Natural -> GHC.Types.Bool
-  naturalLt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalMul :: Natural -> Natural -> Natural
   naturalNe :: Natural -> Natural -> GHC.Types.Bool
-  naturalNe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalNe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalNegate :: Natural -> Natural
   naturalOne :: Natural
   naturalOr :: Natural -> Natural -> Natural
@@ -8899,11 +8899,11 @@ module GHC.Num.Natural where
   naturalSubThrow :: Natural -> Natural -> Natural
   naturalSubUnsafe :: Natural -> Natural -> Natural
   naturalTestBit :: Natural -> GHC.Types.Word -> GHC.Types.Bool
-  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  naturalToBigNat# :: Natural -> GHC.Num.BigNat.BigNat#
-  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalToBigNat# :: Natural -> GHC.Internal.Bignum.BigNat.BigNat#
+  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   naturalToWord :: Natural -> GHC.Types.Word
   naturalToWord# :: Natural -> GHC.Prim.Word#
   naturalToWordClamp :: Natural -> GHC.Types.Word
@@ -9210,12 +9210,12 @@ module GHC.Real where
     mod :: a -> a -> a
     quotRem :: a -> a -> (a, a)
     divMod :: a -> a -> (a, a)
-    toInteger :: a -> GHC.Num.Integer.Integer
+    toInteger :: a -> GHC.Internal.Bignum.Integer.Integer
     {-# MINIMAL quotRem, toInteger #-}
   type Ratio :: * -> *
   data Ratio a = !a :% !a
   type Rational :: *
-  type Rational = Ratio GHC.Num.Integer.Integer
+  type Rational = Ratio GHC.Internal.Bignum.Integer.Integer
   type Real :: * -> Constraint
   class (GHC.Internal.Num.Num a, GHC.Classes.Ord a) => Real a where
     toRational :: a -> Rational
@@ -9243,9 +9243,9 @@ module GHC.Real where
   integralEnumFromThenTo :: forall a. Integral a => a -> a -> a -> [a]
   integralEnumFromTo :: forall a. Integral a => a -> a -> [a]
   lcm :: forall a. Integral a => a -> a -> a
-  mkRationalBase10 :: Rational -> GHC.Num.Integer.Integer -> Rational
-  mkRationalBase2 :: Rational -> GHC.Num.Integer.Integer -> Rational
-  mkRationalWithExponentBase :: Rational -> GHC.Num.Integer.Integer -> FractionalExponentBase -> Rational
+  mkRationalBase10 :: Rational -> GHC.Internal.Bignum.Integer.Integer -> Rational
+  mkRationalBase2 :: Rational -> GHC.Internal.Bignum.Integer.Integer -> Rational
+  mkRationalWithExponentBase :: Rational -> GHC.Internal.Bignum.Integer.Integer -> FractionalExponentBase -> Rational
   notANumber :: Rational
   numerator :: forall a. Ratio a -> a
   numericEnumFrom :: forall a. Fractional a => a -> [a]
@@ -9655,15 +9655,15 @@ module GHC.TypeLits where
   decideNat :: forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *) (proxy2 :: Nat -> *). (KnownNat a, KnownNat b) => proxy1 a -> proxy2 b -> GHC.Internal.Data.Either.Either ((a GHC.Internal.Data.Type.Equality.:~: b) -> GHC.Internal.Base.Void) (a GHC.Internal.Data.Type.Equality.:~: b)
   decideSymbol :: forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *) (proxy2 :: Symbol -> *). (KnownSymbol a, KnownSymbol b) => proxy1 a -> proxy2 b -> GHC.Internal.Data.Either.Either ((a GHC.Internal.Data.Type.Equality.:~: b) -> GHC.Internal.Base.Void) (a GHC.Internal.Data.Type.Equality.:~: b)
   fromSChar :: forall (c :: GHC.Types.Char). SChar c -> GHC.Types.Char
-  fromSNat :: forall (n :: Nat). SNat n -> GHC.Num.Integer.Integer
+  fromSNat :: forall (n :: Nat). SNat n -> GHC.Internal.Bignum.Integer.Integer
   fromSSymbol :: forall (s :: Symbol). SSymbol s -> GHC.Internal.Base.String
-  natVal :: forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> GHC.Num.Integer.Integer
-  natVal' :: forall (n :: Nat). KnownNat n => GHC.Prim.Proxy# n -> GHC.Num.Integer.Integer
+  natVal :: forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> GHC.Internal.Bignum.Integer.Integer
+  natVal' :: forall (n :: Nat). KnownNat n => GHC.Prim.Proxy# n -> GHC.Internal.Bignum.Integer.Integer
   sameChar :: forall (a :: GHC.Types.Char) (b :: GHC.Types.Char) (proxy1 :: GHC.Types.Char -> *) (proxy2 :: GHC.Types.Char -> *). (KnownChar a, KnownChar b) => proxy1 a -> proxy2 b -> GHC.Internal.Maybe.Maybe (a GHC.Internal.Data.Type.Equality.:~: b)
   sameNat :: forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *) (proxy2 :: Nat -> *). (KnownNat a, KnownNat b) => proxy1 a -> proxy2 b -> GHC.Internal.Maybe.Maybe (a GHC.Internal.Data.Type.Equality.:~: b)
   sameSymbol :: forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *) (proxy2 :: Symbol -> *). (KnownSymbol a, KnownSymbol b) => proxy1 a -> proxy2 b -> GHC.Internal.Maybe.Maybe (a GHC.Internal.Data.Type.Equality.:~: b)
   someCharVal :: GHC.Types.Char -> SomeChar
-  someNatVal :: GHC.Num.Integer.Integer -> GHC.Internal.Maybe.Maybe SomeNat
+  someNatVal :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Maybe.Maybe SomeNat
   someSymbolVal :: GHC.Internal.Base.String -> SomeSymbol
   symbolVal :: forall (n :: Symbol) (proxy :: Symbol -> *). KnownSymbol n => proxy n -> GHC.Internal.Base.String
   symbolVal' :: forall (n :: Symbol). KnownSymbol n => GHC.Prim.Proxy# n -> GHC.Internal.Base.String
@@ -9671,7 +9671,7 @@ module GHC.TypeLits where
   withKnownNat :: forall (n :: Nat) (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). SNat n -> (KnownNat n => r) -> r
   withKnownSymbol :: forall (s :: Symbol) (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). SSymbol s -> (KnownSymbol s => r) -> r
   withSomeSChar :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Types.Char -> (forall (c :: GHC.Types.Char). SChar c -> r) -> r
-  withSomeSNat :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Num.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
+  withSomeSNat :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Bignum.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
   withSomeSSymbol :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Base.String -> (forall (s :: Symbol). SSymbol s -> r) -> r
 
 module GHC.TypeLits.Internal where
@@ -9861,7 +9861,7 @@ module Numeric where
     log1pexp :: a -> a
     log1mexp :: a -> a
     {-# MINIMAL pi, exp, log, sin, cos, asin, acos, atan, sinh, cosh, asinh, acosh, atanh #-}
-  floatToDigits :: forall a. GHC.Internal.Float.RealFloat a => GHC.Num.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
+  floatToDigits :: forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Bignum.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
   fromRat :: forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Rational -> a
   lexDigits :: GHC.Internal.Text.ParserCombinators.ReadP.ReadS GHC.Internal.Base.String
   readBin :: forall a. (GHC.Classes.Eq a, GHC.Internal.Num.Num a) => GHC.Internal.Text.ParserCombinators.ReadP.ReadS a
@@ -10214,8 +10214,8 @@ module Prelude where
 
 module System.CPUTime where
   -- Safety: Trustworthy
-  cpuTimePrecision :: GHC.Num.Integer.Integer
-  getCPUTime :: GHC.Types.IO GHC.Num.Integer.Integer
+  cpuTimePrecision :: GHC.Internal.Bignum.Integer.Integer
+  getCPUTime :: GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
 
 module System.Console.GetOpt where
   -- Safety: Safe
@@ -10295,7 +10295,7 @@ module System.IO where
   getContents' :: IO GHC.Internal.Base.String
   getLine :: IO GHC.Internal.Base.String
   hClose :: Handle -> IO ()
-  hFileSize :: Handle -> IO GHC.Num.Integer.Integer
+  hFileSize :: Handle -> IO GHC.Internal.Bignum.Integer.Integer
   hFlush :: Handle -> IO ()
   hGetBuf :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> IO GHC.Types.Int
   hGetBufNonBlocking :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> IO GHC.Types.Int
@@ -10323,16 +10323,16 @@ module System.IO where
   hPutStr :: Handle -> GHC.Internal.Base.String -> IO ()
   hPutStrLn :: Handle -> GHC.Internal.Base.String -> IO ()
   hReady :: Handle -> IO GHC.Types.Bool
-  hSeek :: Handle -> SeekMode -> GHC.Num.Integer.Integer -> IO ()
+  hSeek :: Handle -> SeekMode -> GHC.Internal.Bignum.Integer.Integer -> IO ()
   hSetBinaryMode :: Handle -> GHC.Types.Bool -> IO ()
   hSetBuffering :: Handle -> BufferMode -> IO ()
   hSetEcho :: Handle -> GHC.Types.Bool -> IO ()
   hSetEncoding :: Handle -> TextEncoding -> IO ()
-  hSetFileSize :: Handle -> GHC.Num.Integer.Integer -> IO ()
+  hSetFileSize :: Handle -> GHC.Internal.Bignum.Integer.Integer -> IO ()
   hSetNewlineMode :: Handle -> NewlineMode -> IO ()
   hSetPosn :: HandlePosn -> IO ()
   hShow :: Handle -> IO GHC.Internal.Base.String
-  hTell :: Handle -> IO GHC.Num.Integer.Integer
+  hTell :: Handle -> IO GHC.Internal.Bignum.Integer.Integer
   hWaitForInput :: Handle -> GHC.Types.Int -> IO GHC.Types.Bool
   interact :: (GHC.Internal.Base.String -> GHC.Internal.Base.String) -> IO ()
   isEOF :: IO GHC.Types.Bool
@@ -10560,7 +10560,7 @@ module System.Posix.Internals where
   const_vmin :: GHC.Internal.Foreign.C.Types.CInt
   const_vtime :: GHC.Internal.Foreign.C.Types.CInt
   dEFAULT_BUFFER_SIZE :: GHC.Types.Int
-  fdFileSize :: FD -> GHC.Types.IO GHC.Num.Integer.Integer
+  fdFileSize :: FD -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
   fdGetMode :: FD -> GHC.Types.IO GHC.Internal.IO.IOMode.IOMode
   fdStat :: FD -> GHC.Types.IO (GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
   fdType :: FD -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
@@ -10726,7 +10726,7 @@ module Text.Printf where
   errorShortFormat :: forall a. a
   formatChar :: GHC.Types.Char -> FieldFormatter
   formatInt :: forall a. (GHC.Internal.Real.Integral a, GHC.Internal.Enum.Bounded a) => a -> FieldFormatter
-  formatInteger :: GHC.Num.Integer.Integer -> FieldFormatter
+  formatInteger :: GHC.Internal.Bignum.Integer.Integer -> FieldFormatter
   formatRealFloat :: forall a. GHC.Internal.Float.RealFloat a => a -> FieldFormatter
   formatString :: forall a. IsChar a => [a] -> FieldFormatter
   hPrintf :: forall r. HPrintfType r => GHC.Internal.IO.Handle.Types.Handle -> GHC.Internal.Base.String -> r
@@ -10788,8 +10788,8 @@ module Text.Read.Lex where
   isSymbolChar :: GHC.Types.Char -> GHC.Types.Bool
   lex :: GHC.Internal.Text.ParserCombinators.ReadP.ReadP Lexeme
   lexChar :: GHC.Internal.Text.ParserCombinators.ReadP.ReadP GHC.Types.Char
-  numberToFixed :: GHC.Num.Integer.Integer -> Number -> GHC.Internal.Maybe.Maybe (GHC.Num.Integer.Integer, GHC.Num.Integer.Integer)
-  numberToInteger :: Number -> GHC.Internal.Maybe.Maybe GHC.Num.Integer.Integer
+  numberToFixed :: GHC.Internal.Bignum.Integer.Integer -> Number -> GHC.Internal.Maybe.Maybe (GHC.Internal.Bignum.Integer.Integer, GHC.Internal.Bignum.Integer.Integer)
+  numberToInteger :: Number -> GHC.Internal.Maybe.Maybe GHC.Internal.Bignum.Integer.Integer
   numberToRangedRational :: (GHC.Types.Int, GHC.Types.Int) -> Number -> GHC.Internal.Maybe.Maybe GHC.Internal.Real.Rational
   numberToRational :: Number -> GHC.Internal.Real.Rational
   readBinP :: forall a. (GHC.Classes.Eq a, GHC.Internal.Num.Num a) => GHC.Internal.Text.ParserCombinators.ReadP.ReadP a
@@ -11025,9 +11025,9 @@ instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int16 -- Defined in ‘Te
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int32 -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int64 -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int8 -- Defined in ‘Text.Printf’
-instance [safe] Text.Printf.PrintfArg GHC.Num.Integer.Integer -- Defined in ‘Text.Printf’
+instance [safe] Text.Printf.PrintfArg GHC.Internal.Bignum.Integer.Integer -- Defined in ‘Text.Printf’
 instance [safe] forall c. Text.Printf.IsChar c => Text.Printf.PrintfArg [c] -- Defined in ‘Text.Printf’
-instance [safe] Text.Printf.PrintfArg GHC.Num.Natural.Natural -- Defined in ‘Text.Printf’
+instance [safe] Text.Printf.PrintfArg GHC.Internal.Bignum.Natural.Natural -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Types.Word -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Word.Word16 -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Word.Word32 -- Defined in ‘Text.Printf’
@@ -11281,8 +11281,8 @@ instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Bits.Bits (GHC.Inter
 instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Bits.Bits (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance GHC.Internal.Bits.Bits GHC.Types.Bool -- Defined in ‘GHC.Internal.Bits’
 instance GHC.Internal.Bits.Bits GHC.Types.Int -- Defined in ‘GHC.Internal.Bits’
-instance GHC.Internal.Bits.Bits GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Bits’
-instance GHC.Internal.Bits.Bits GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Bits’
+instance GHC.Internal.Bits.Bits GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Bits’
+instance GHC.Internal.Bits.Bits GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bits’
 instance GHC.Internal.Bits.Bits GHC.Types.Word -- Defined in ‘GHC.Internal.Bits’
 instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Bits.Bits (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.Functor.Identity’
 instance GHC.Internal.Bits.Bits GHC.Internal.Int.Int16 -- Defined in ‘GHC.Internal.Int’
@@ -11438,11 +11438,11 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Int.Int32 -- Defined in ‘GHC
 instance GHC.Internal.Data.Data.Data GHC.Internal.Int.Int64 -- Defined in ‘GHC.Internal.Data.Data’
 instance GHC.Internal.Data.Data.Data GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.Data.Data’
 instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Data.Data’
-instance GHC.Internal.Data.Data.Data GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Data.Data’
+instance GHC.Internal.Data.Data.Data GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Monoid.Last a) -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data [a] -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.Data.Data’
-instance GHC.Internal.Data.Data.Data GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Data.Data’
+instance GHC.Internal.Data.Data.Data GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Data.Data’
 instance GHC.Internal.Data.Data.Data GHC.Types.Ordering -- Defined in ‘GHC.Internal.Data.Data’
 instance forall p. GHC.Internal.Data.Data.Data p => GHC.Internal.Data.Data.Data (GHC.Internal.Generics.Par1 p) -- Defined in ‘GHC.Internal.Data.Data’
@@ -11629,9 +11629,9 @@ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Inter
 instance GHC.Internal.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Internal.Enum’
-instance GHC.Internal.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Enum GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Internal.Enum’
-instance GHC.Internal.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Enum GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Internal.Enum’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (Solo a) -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum () -- Defined in ‘GHC.Internal.Enum’
@@ -11975,8 +11975,8 @@ instance GHC.Internal.Ix.Ix GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.
 instance GHC.Internal.Ix.Ix GHC.Types.Bool -- Defined in ‘GHC.Internal.Ix’
 instance GHC.Internal.Ix.Ix GHC.Types.Char -- Defined in ‘GHC.Internal.Ix’
 instance GHC.Internal.Ix.Ix GHC.Types.Int -- Defined in ‘GHC.Internal.Ix’
-instance GHC.Internal.Ix.Ix GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Ix’
-instance GHC.Internal.Ix.Ix GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Ix’
+instance GHC.Internal.Ix.Ix GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Ix’
+instance GHC.Internal.Ix.Ix GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Ix’
 instance GHC.Internal.Ix.Ix GHC.Types.Ordering -- Defined in ‘GHC.Internal.Ix’
 instance forall a. GHC.Internal.Ix.Ix a => GHC.Internal.Ix.Ix (Solo a) -- Defined in ‘GHC.Internal.Ix’
 instance forall a1 a2 a3 a4 a5 a6 a7 a8 a9 aA. (GHC.Internal.Ix.Ix a1, GHC.Internal.Ix.Ix a2, GHC.Internal.Ix.Ix a3, GHC.Internal.Ix.Ix a4, GHC.Internal.Ix.Ix a5, GHC.Internal.Ix.Ix a6, GHC.Internal.Ix.Ix a7, GHC.Internal.Ix.Ix a8, GHC.Internal.Ix.Ix a9, GHC.Internal.Ix.Ix aA) => GHC.Internal.Ix.Ix (a1, a2, a3, a4, a5, a6, a7, a8, a9, aA) -- Defined in ‘GHC.Internal.Ix’
@@ -12081,8 +12081,8 @@ instance GHC.Internal.Num.Num GHC.Internal.Foreign.C.Types.CWchar -- Defined in
 instance GHC.Internal.Num.Num GHC.Types.Double -- Defined in ‘GHC.Internal.Float’
 instance GHC.Internal.Num.Num GHC.Types.Float -- Defined in ‘GHC.Internal.Float’
 instance GHC.Internal.Num.Num GHC.Types.Int -- Defined in ‘GHC.Internal.Num’
-instance GHC.Internal.Num.Num GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Num’
-instance GHC.Internal.Num.Num GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Num’
+instance GHC.Internal.Num.Num GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Num’
+instance GHC.Internal.Num.Num GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Num’
 instance GHC.Internal.Num.Num GHC.Types.Word -- Defined in ‘GHC.Internal.Num’
 instance forall k a (b :: k). GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’
@@ -12098,11 +12098,11 @@ instance GHC.Internal.Read.Read GHC.Types.Double -- Defined in ‘GHC.Internal.R
 instance GHC.Internal.Read.Read GHC.Types.Float -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Types.Int -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Read’
+instance GHC.Internal.Read.Read GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Read’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read [a] -- Defined in ‘GHC.Internal.Read’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Read’
+instance GHC.Internal.Read.Read GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Read’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Types.Ordering -- Defined in ‘GHC.Internal.Read’
 instance forall a. (GHC.Internal.Real.Integral a, GHC.Internal.Read.Read a) => GHC.Internal.Read.Read (GHC.Internal.Real.Ratio a) -- Defined in ‘GHC.Internal.Read’
@@ -12233,8 +12233,8 @@ instance GHC.Internal.Real.Integral GHC.Internal.Int.Int32 -- Defined in ‘GHC.
 instance GHC.Internal.Real.Integral GHC.Internal.Int.Int64 -- Defined in ‘GHC.Internal.Int’
 instance GHC.Internal.Real.Integral GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.Int’
 instance GHC.Internal.Real.Integral GHC.Types.Int -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Integral GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Integral GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Integral GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Integral GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Integral GHC.Types.Word -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Integral GHC.Internal.Word.Word16 -- Defined in ‘GHC.Internal.Word’
 instance GHC.Internal.Real.Integral GHC.Internal.Word.Word32 -- Defined in ‘GHC.Internal.Word’
@@ -12272,8 +12272,8 @@ instance GHC.Internal.Real.Real GHC.Internal.Int.Int64 -- Defined in ‘GHC.Inte
 instance GHC.Internal.Real.Real GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.Int’
 instance forall a. GHC.Internal.Real.Real a => GHC.Internal.Real.Real (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
 instance GHC.Internal.Real.Real GHC.Types.Int -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Real GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Real GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Real GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Real GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Real’
 instance forall a. GHC.Internal.Real.Integral a => GHC.Internal.Real.Real (GHC.Internal.Real.Ratio a) -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Real GHC.Types.Word -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Real GHC.Internal.Word.Word16 -- Defined in ‘GHC.Internal.Word’
@@ -12365,13 +12365,13 @@ instance GHC.Internal.Show.Show GHC.Types.Bool -- Defined in ‘GHC.Internal.Sho
 instance GHC.Internal.Show.Show GHC.Internal.Stack.Types.CallStack -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Char -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Int -- Defined in ‘GHC.Internal.Show’
-instance GHC.Internal.Show.Show GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Show’
+instance GHC.Internal.Show.Show GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.KindRep -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Levity -- Defined in ‘GHC.Internal.Show’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show [a] -- Defined in ‘GHC.Internal.Show’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Module -- Defined in ‘GHC.Internal.Show’
-instance GHC.Internal.Show.Show GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Show’
+instance GHC.Internal.Show.Show GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Show’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Ordering -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.RuntimeRep -- Defined in ‘GHC.Internal.Show’
@@ -12740,9 +12740,9 @@ instance GHC.Classes.Eq GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘G
 instance forall i e. GHC.Classes.Eq (GHC.Internal.IOArray.IOArray i e) -- Defined in ‘GHC.Internal.IOArray’
 instance forall a. GHC.Classes.Eq (GHC.Internal.IOPort.IOPort a) -- Defined in ‘GHC.Internal.IOPort’
 instance GHC.Classes.Eq GHC.Internal.InfoProv.Types.InfoProv -- Defined in ‘GHC.Internal.InfoProv.Types’
-instance GHC.Classes.Eq GHC.Num.Integer.Integer -- Defined in ‘GHC.Num.Integer’
-instance GHC.Classes.Eq GHC.Num.BigNat.BigNat -- Defined in ‘GHC.Num.BigNat’
-instance GHC.Classes.Eq GHC.Num.Natural.Natural -- Defined in ‘GHC.Num.Natural’
+instance GHC.Classes.Eq GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Bignum.Integer’
+instance GHC.Classes.Eq GHC.Internal.Bignum.BigNat.BigNat -- Defined in ‘GHC.Internal.Bignum.BigNat’
+instance GHC.Classes.Eq GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’
 instance GHC.Classes.Eq GHC.Internal.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.Internal.RTS.Flags’
 instance forall a. GHC.Classes.Eq (GHC.Internal.StableName.StableName a) -- Defined in ‘GHC.Internal.StableName’
 instance GHC.Classes.Eq GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’
@@ -12896,9 +12896,9 @@ instance GHC.Classes.Ord GHC.Internal.IO.Handle.Types.BufferMode -- Defined in 
 instance GHC.Classes.Ord GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
 instance GHC.Classes.Ord GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
 instance GHC.Classes.Ord GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
-instance GHC.Classes.Ord GHC.Num.Integer.Integer -- Defined in ‘GHC.Num.Integer’
-instance GHC.Classes.Ord GHC.Num.BigNat.BigNat -- Defined in ‘GHC.Num.BigNat’
-instance GHC.Classes.Ord GHC.Num.Natural.Natural -- Defined in ‘GHC.Num.Natural’
+instance GHC.Classes.Ord GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Bignum.Integer’
+instance GHC.Classes.Ord GHC.Internal.Bignum.BigNat.BigNat -- Defined in ‘GHC.Internal.Bignum.BigNat’
+instance GHC.Classes.Ord GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’
 instance forall (n :: GHC.Internal.TypeNats.Nat). GHC.Classes.Ord (GHC.Internal.TypeNats.SNat n) -- Defined in ‘GHC.Internal.TypeNats’
 instance GHC.Classes.Ord GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
 instance forall (c :: GHC.Types.Char). GHC.Classes.Ord (GHC.Internal.TypeLits.SChar c) -- Defined in ‘GHC.Internal.TypeLits’
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
index 4526d5f7a56..0d984793d8e 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
+++ b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
@@ -835,7 +835,7 @@ module Data.Data where
   type Constr :: *
   data Constr = ...
   type ConstrRep :: *
-  data ConstrRep = AlgConstr ConIndex | IntConstr GHC.Num.Integer.Integer | FloatConstr GHC.Internal.Real.Rational | CharConstr GHC.Types.Char
+  data ConstrRep = AlgConstr ConIndex | IntConstr GHC.Internal.Bignum.Integer.Integer | FloatConstr GHC.Internal.Real.Rational | CharConstr GHC.Types.Char
   type Data :: * -> Constraint
   class Typeable a => Data a where
     gfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> a -> c a
@@ -1010,10 +1010,10 @@ module Data.Fixed where
   data E9
   type role Fixed phantom
   type Fixed :: forall k. k -> *
-  newtype Fixed a = MkFixed GHC.Num.Integer.Integer
+  newtype Fixed a = MkFixed GHC.Internal.Bignum.Integer.Integer
   type HasResolution :: forall k. k -> Constraint
   class HasResolution @k a where
-    resolution :: forall (p :: k -> *). p a -> GHC.Num.Integer.Integer
+    resolution :: forall (p :: k -> *). p a -> GHC.Internal.Bignum.Integer.Integer
     {-# MINIMAL resolution #-}
   type Micro :: *
   type Micro = Fixed E6
@@ -1582,7 +1582,7 @@ module Data.Ratio where
   type Ratio :: * -> *
   data Ratio a = ...
   type Rational :: *
-  type Rational = Ratio GHC.Num.Integer.Integer
+  type Rational = Ratio GHC.Internal.Bignum.Integer.Integer
   approxRational :: forall a. GHC.Internal.Real.RealFrac a => a -> a -> Rational
   denominator :: forall a. Ratio a -> a
   numerator :: forall a. Ratio a -> a
@@ -7117,11 +7117,11 @@ module GHC.Float where
     {-# MINIMAL pi, exp, log, sin, cos, asin, acos, atan, sinh, cosh, asinh, acosh, atanh #-}
   type RealFloat :: * -> Constraint
   class (GHC.Internal.Real.RealFrac a, Floating a) => RealFloat a where
-    floatRadix :: a -> GHC.Num.Integer.Integer
+    floatRadix :: a -> GHC.Internal.Bignum.Integer.Integer
     floatDigits :: a -> GHC.Types.Int
     floatRange :: a -> (GHC.Types.Int, GHC.Types.Int)
-    decodeFloat :: a -> (GHC.Num.Integer.Integer, GHC.Types.Int)
-    encodeFloat :: GHC.Num.Integer.Integer -> GHC.Types.Int -> a
+    decodeFloat :: a -> (GHC.Internal.Bignum.Integer.Integer, GHC.Types.Int)
+    encodeFloat :: GHC.Internal.Bignum.Integer.Integer -> GHC.Types.Int -> a
     exponent :: a -> GHC.Types.Int
     significand :: a -> a
     scaleFloat :: GHC.Types.Int -> a -> a
@@ -7169,30 +7169,30 @@ module GHC.Float where
   expFloat :: Float -> Float
   expm1Double :: Double -> Double
   expm1Float :: Float -> Float
-  expt :: GHC.Num.Integer.Integer -> GHC.Types.Int -> GHC.Num.Integer.Integer
-  expts :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer
-  expts10 :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer
+  expt :: GHC.Internal.Bignum.Integer.Integer -> GHC.Types.Int -> GHC.Internal.Bignum.Integer.Integer
+  expts :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Internal.Bignum.Integer.Integer
+  expts10 :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Internal.Bignum.Integer.Integer
   fabsDouble :: Double -> Double
   fabsFloat :: Float -> Float
   float2Double :: Float -> Double
   float2Int :: Float -> GHC.Types.Int
-  floatToDigits :: forall a. RealFloat a => GHC.Num.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
+  floatToDigits :: forall a. RealFloat a => GHC.Internal.Bignum.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
   floorDouble :: forall b. GHC.Internal.Real.Integral b => Double -> b
   floorFloat :: forall b. GHC.Internal.Real.Integral b => Float -> b
   formatRealFloat :: forall a. RealFloat a => FFFormat -> GHC.Internal.Maybe.Maybe GHC.Types.Int -> a -> GHC.Internal.Base.String
   formatRealFloatAlt :: forall a. RealFloat a => FFFormat -> GHC.Internal.Maybe.Maybe GHC.Types.Int -> GHC.Types.Bool -> a -> GHC.Internal.Base.String
   fromRat :: forall a. RealFloat a => GHC.Internal.Real.Rational -> a
   fromRat' :: forall a. RealFloat a => GHC.Internal.Real.Rational -> a
-  fromRat'' :: forall a. RealFloat a => GHC.Types.Int -> GHC.Types.Int -> GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> a
+  fromRat'' :: forall a. RealFloat a => GHC.Types.Int -> GHC.Types.Int -> GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> a
   geDouble :: Double -> Double -> GHC.Types.Bool
   geFloat :: Float -> Float -> GHC.Types.Bool
   gtDouble :: Double -> Double -> GHC.Types.Bool
   gtFloat :: Float -> Float -> GHC.Types.Bool
   int2Double :: GHC.Types.Int -> Double
   int2Float :: GHC.Types.Int -> Float
-  integerToBinaryFloat' :: forall a. RealFloat a => GHC.Num.Integer.Integer -> a
-  integerToDouble# :: GHC.Num.Integer.Integer -> Double#
-  integerToFloat# :: GHC.Num.Integer.Integer -> Float#
+  integerToBinaryFloat' :: forall a. RealFloat a => GHC.Internal.Bignum.Integer.Integer -> a
+  integerToDouble# :: GHC.Internal.Bignum.Integer.Integer -> Double#
+  integerToFloat# :: GHC.Internal.Bignum.Integer.Integer -> Float#
   isDoubleDenormalized :: Double -> GHC.Types.Int
   isDoubleFinite :: Double -> GHC.Types.Int
   isDoubleInfinite :: Double -> GHC.Types.Int
@@ -7217,8 +7217,8 @@ module GHC.Float where
   minExpt :: GHC.Types.Int
   minusDouble :: Double -> Double -> Double
   minusFloat :: Float -> Float -> Float
-  naturalToDouble# :: GHC.Num.Natural.Natural -> Double#
-  naturalToFloat# :: GHC.Num.Natural.Natural -> Float#
+  naturalToDouble# :: GHC.Internal.Bignum.Natural.Natural -> Double#
+  naturalToFloat# :: GHC.Internal.Bignum.Natural.Natural -> Float#
   negateDouble :: Double -> Double
   negateFloat :: Float -> Float
   plusDouble :: Double -> Double -> Double
@@ -7227,12 +7227,12 @@ module GHC.Float where
   powerFloat :: Float -> Float -> Float
   properFractionDouble :: forall b. GHC.Internal.Real.Integral b => Double -> (b, Double)
   properFractionFloat :: forall b. GHC.Internal.Real.Integral b => Float -> (b, Float)
-  rationalToDouble :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> Double
-  rationalToFloat :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> Float
+  rationalToDouble :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> Double
+  rationalToFloat :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> Float
   roundDouble :: forall b. GHC.Internal.Real.Integral b => Double -> b
   roundFloat :: forall b. GHC.Internal.Real.Integral b => Float -> b
   roundTo :: GHC.Types.Int -> GHC.Types.Int -> [GHC.Types.Int] -> (GHC.Types.Int, [GHC.Types.Int])
-  roundingMode# :: GHC.Num.Integer.Integer -> GHC.Prim.Int# -> GHC.Prim.Int#
+  roundingMode# :: GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int# -> GHC.Prim.Int#
   showFloat :: forall a. RealFloat a => a -> GHC.Internal.Show.ShowS
   showSignedFloat :: forall a. RealFloat a => (a -> GHC.Internal.Show.ShowS) -> GHC.Types.Int -> a -> GHC.Internal.Show.ShowS
   sinDouble :: Double -> Double
@@ -7258,33 +7258,33 @@ module GHC.Float where
 
 module GHC.Float.ConversionUtils where
   -- Safety: Safe
-  elimZerosInt# :: GHC.Prim.Int# -> GHC.Prim.Int# -> (# GHC.Num.Integer.Integer, GHC.Prim.Int# #)
-  elimZerosInteger :: GHC.Num.Integer.Integer -> GHC.Prim.Int# -> (# GHC.Num.Integer.Integer, GHC.Prim.Int# #)
+  elimZerosInt# :: GHC.Prim.Int# -> GHC.Prim.Int# -> (# GHC.Internal.Bignum.Integer.Integer, GHC.Prim.Int# #)
+  elimZerosInteger :: GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int# -> (# GHC.Internal.Bignum.Integer.Integer, GHC.Prim.Int# #)
 
 module GHC.Float.RealFracMethods where
   -- Safety: Safe
   ceilingDoubleInt :: GHC.Types.Double -> GHC.Types.Int
-  ceilingDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
+  ceilingDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
   ceilingFloatInt :: GHC.Types.Float -> GHC.Types.Int
-  ceilingFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
+  ceilingFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
   double2Int :: GHC.Types.Double -> GHC.Types.Int
   float2Int :: GHC.Types.Float -> GHC.Types.Int
   floorDoubleInt :: GHC.Types.Double -> GHC.Types.Int
-  floorDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
+  floorDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
   floorFloatInt :: GHC.Types.Float -> GHC.Types.Int
-  floorFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
+  floorFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
   int2Double :: GHC.Types.Int -> GHC.Types.Double
   int2Float :: GHC.Types.Int -> GHC.Types.Float
   properFractionDoubleInt :: GHC.Types.Double -> (GHC.Types.Int, GHC.Types.Double)
-  properFractionDoubleInteger :: GHC.Types.Double -> (GHC.Num.Integer.Integer, GHC.Types.Double)
+  properFractionDoubleInteger :: GHC.Types.Double -> (GHC.Internal.Bignum.Integer.Integer, GHC.Types.Double)
   properFractionFloatInt :: GHC.Types.Float -> (GHC.Types.Int, GHC.Types.Float)
-  properFractionFloatInteger :: GHC.Types.Float -> (GHC.Num.Integer.Integer, GHC.Types.Float)
+  properFractionFloatInteger :: GHC.Types.Float -> (GHC.Internal.Bignum.Integer.Integer, GHC.Types.Float)
   roundDoubleInt :: GHC.Types.Double -> GHC.Types.Int
-  roundDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
+  roundDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
   roundFloatInt :: GHC.Types.Float -> GHC.Types.Int
-  roundFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
-  truncateDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
-  truncateFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
+  roundFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
+  truncateDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
+  truncateFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
 
 module GHC.Foreign where
   -- Safety: Safe
@@ -7582,10 +7582,10 @@ module GHC.IO.Device where
     close :: a -> GHC.Types.IO ()
     isTerminal :: a -> GHC.Types.IO GHC.Types.Bool
     isSeekable :: a -> GHC.Types.IO GHC.Types.Bool
-    seek :: a -> SeekMode -> GHC.Num.Integer.Integer -> GHC.Types.IO GHC.Num.Integer.Integer
-    tell :: a -> GHC.Types.IO GHC.Num.Integer.Integer
-    getSize :: a -> GHC.Types.IO GHC.Num.Integer.Integer
-    setSize :: a -> GHC.Num.Integer.Integer -> GHC.Types.IO ()
+    seek :: a -> SeekMode -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
+    tell :: a -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
+    getSize :: a -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
+    setSize :: a -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO ()
     setEcho :: a -> GHC.Types.Bool -> GHC.Types.IO ()
     getEcho :: a -> GHC.Types.IO GHC.Types.Bool
     setRaw :: a -> GHC.Types.Bool -> GHC.Types.IO ()
@@ -7813,7 +7813,7 @@ module GHC.IO.Handle where
   type Handle :: *
   data Handle = ...
   type HandlePosition :: *
-  type HandlePosition = GHC.Num.Integer.Integer
+  type HandlePosition = GHC.Internal.Bignum.Integer.Integer
   type HandlePosn :: *
   data HandlePosn = HandlePosn Handle HandlePosition
   type LockMode :: *
@@ -7828,7 +7828,7 @@ module GHC.IO.Handle where
   hClose_help :: GHC.Internal.IO.Handle.Types.Handle__ -> GHC.Types.IO (GHC.Internal.IO.Handle.Types.Handle__, GHC.Internal.Maybe.Maybe GHC.Internal.Exception.Type.SomeException)
   hDuplicate :: Handle -> GHC.Types.IO Handle
   hDuplicateTo :: Handle -> Handle -> GHC.Types.IO ()
-  hFileSize :: Handle -> GHC.Types.IO GHC.Num.Integer.Integer
+  hFileSize :: Handle -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
   hFlush :: Handle -> GHC.Types.IO ()
   hFlushAll :: Handle -> GHC.Types.IO ()
   hGetBuf :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Int
@@ -7854,16 +7854,16 @@ module GHC.IO.Handle where
   hPutBufNonBlocking :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Int
   hPutChar :: Handle -> GHC.Types.Char -> GHC.Types.IO ()
   hPutStr :: Handle -> GHC.Internal.Base.String -> GHC.Types.IO ()
-  hSeek :: Handle -> SeekMode -> GHC.Num.Integer.Integer -> GHC.Types.IO ()
+  hSeek :: Handle -> SeekMode -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO ()
   hSetBinaryMode :: Handle -> GHC.Types.Bool -> GHC.Types.IO ()
   hSetBuffering :: Handle -> BufferMode -> GHC.Types.IO ()
   hSetEcho :: Handle -> GHC.Types.Bool -> GHC.Types.IO ()
   hSetEncoding :: Handle -> GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Types.IO ()
-  hSetFileSize :: Handle -> GHC.Num.Integer.Integer -> GHC.Types.IO ()
+  hSetFileSize :: Handle -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO ()
   hSetNewlineMode :: Handle -> NewlineMode -> GHC.Types.IO ()
   hSetPosn :: HandlePosn -> GHC.Types.IO ()
   hShow :: Handle -> GHC.Types.IO GHC.Internal.Base.String
-  hTell :: Handle -> GHC.Types.IO GHC.Num.Integer.Integer
+  hTell :: Handle -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
   hTryLock :: Handle -> LockMode -> GHC.Types.IO GHC.Types.Bool
   hWaitForInput :: Handle -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Bool
   isEOF :: GHC.Types.IO GHC.Types.Bool
@@ -8197,8 +8197,8 @@ module GHC.Integer where
 
 module GHC.Integer.Logarithms where
   -- Safety: None
-  integerLog2# :: GHC.Num.Integer.Integer -> GHC.Prim.Int#
-  integerLogBase# :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> GHC.Prim.Int#
+  integerLog2# :: GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int#
+  integerLogBase# :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int#
   wordLog2# :: GHC.Prim.Word# -> GHC.Prim.Int#
 
 module GHC.IsList where
@@ -11386,7 +11386,7 @@ module GHC.Maybe where
 module GHC.Natural where
   -- Safety: Safe
   type BigNat :: *
-  data BigNat = BN# {unBigNat :: GHC.Num.BigNat.BigNat#}
+  data BigNat = BN# {unBigNat :: GHC.Internal.Bignum.BigNat.BigNat#}
   pattern NatJ# :: BigNat -> Natural
   pattern NatS# :: GHC.Prim.Word# -> Natural
   type Natural :: *
@@ -11399,8 +11399,8 @@ module GHC.Natural where
   minusNatural :: Natural -> Natural -> Natural
   minusNaturalMaybe :: Natural -> Natural -> GHC.Internal.Maybe.Maybe Natural
   mkNatural :: [GHC.Types.Word] -> Natural
-  naturalFromInteger :: GHC.Num.Integer.Integer -> Natural
-  naturalToInteger :: Natural -> GHC.Num.Integer.Integer
+  naturalFromInteger :: GHC.Internal.Bignum.Integer.Integer -> Natural
+  naturalToInteger :: Natural -> GHC.Internal.Bignum.Integer.Integer
   naturalToWord :: Natural -> GHC.Types.Word
   naturalToWordMaybe :: Natural -> GHC.Internal.Maybe.Maybe GHC.Types.Word
   negateNatural :: Natural -> Natural
@@ -11442,7 +11442,7 @@ module GHC.Num where
   integerBit :: GHC.Types.Word -> Integer
   integerBit# :: GHC.Prim.Word# -> Integer
   integerCheck :: Integer -> GHC.Types.Bool
-  integerCheck# :: Integer -> GHC.Num.Primitives.Bool#
+  integerCheck# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerCompare :: Integer -> Integer -> GHC.Types.Ordering
   integerComplement :: Integer -> Integer
   integerDecodeDouble# :: GHC.Prim.Double# -> (# Integer, GHC.Prim.Int# #)
@@ -11453,14 +11453,14 @@ module GHC.Num where
   integerEncodeDouble# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Double#
   integerEncodeFloat# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Float#
   integerEq :: Integer -> Integer -> GHC.Types.Bool
-  integerEq# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
-  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Integer
-  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
-  integerFromBigNat# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatNeg# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Num.BigNat.BigNat# -> Integer
-  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> Integer
-  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerEq# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
+  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Integer
+  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatNeg# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> Integer
+  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
   integerFromInt :: GHC.Types.Int -> Integer
   integerFromInt# :: GHC.Prim.Int# -> Integer
   integerFromInt64# :: GHC.Prim.Int64# -> Integer
@@ -11475,17 +11475,17 @@ module GHC.Num where
   integerGcde :: Integer -> Integer -> (Integer, Integer, Integer)
   integerGcde# :: Integer -> Integer -> (# Integer, Integer, Integer #)
   integerGe :: Integer -> Integer -> GHC.Types.Bool
-  integerGe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerGt :: Integer -> Integer -> GHC.Types.Bool
-  integerGt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsNegative :: Integer -> GHC.Types.Bool
-  integerIsNegative# :: Integer -> GHC.Num.Primitives.Bool#
+  integerIsNegative# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsOne :: Integer -> GHC.Types.Bool
   integerIsPowerOf2# :: Integer -> (# (# #) | GHC.Prim.Word# #)
   integerIsZero :: Integer -> GHC.Types.Bool
   integerLcm :: Integer -> Integer -> Integer
   integerLe :: Integer -> Integer -> GHC.Types.Bool
-  integerLe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerLog2 :: Integer -> GHC.Types.Word
   integerLog2# :: Integer -> GHC.Prim.Word#
   integerLogBase :: Integer -> Integer -> GHC.Types.Word
@@ -11493,11 +11493,11 @@ module GHC.Num where
   integerLogBaseWord :: GHC.Types.Word -> Integer -> GHC.Types.Word
   integerLogBaseWord# :: GHC.Prim.Word# -> Integer -> GHC.Prim.Word#
   integerLt :: Integer -> Integer -> GHC.Types.Bool
-  integerLt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerMod :: Integer -> Integer -> Integer
   integerMul :: Integer -> Integer -> Integer
   integerNe :: Integer -> Integer -> GHC.Types.Bool
-  integerNe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerNe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerNegate :: Integer -> Integer
   integerOne :: Integer
   integerOr :: Integer -> Integer -> Integer
@@ -11518,16 +11518,16 @@ module GHC.Num where
   integerSqr :: Integer -> Integer
   integerSub :: Integer -> Integer -> Integer
   integerTestBit :: Integer -> GHC.Types.Word -> GHC.Types.Bool
-  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  integerToBigNatClamp# :: Integer -> GHC.Num.BigNat.BigNat#
-  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Num.BigNat.BigNat# #)
+  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToBigNatClamp# :: Integer -> GHC.Internal.Bignum.BigNat.BigNat#
+  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Internal.Bignum.BigNat.BigNat# #)
   integerToInt :: Integer -> GHC.Types.Int
   integerToInt# :: Integer -> GHC.Prim.Int#
   integerToInt64# :: Integer -> GHC.Prim.Int64#
-  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   integerToNatural :: Integer -> Natural
   integerToNaturalClamp :: Integer -> Natural
   integerToNaturalThrow :: Integer -> Natural
@@ -11542,7 +11542,7 @@ module GHC.Num where
   naturalBit :: GHC.Types.Word -> Natural
   naturalBit# :: GHC.Prim.Word# -> Natural
   naturalCheck :: Natural -> GHC.Types.Bool
-  naturalCheck# :: Natural -> GHC.Num.Primitives.Bool#
+  naturalCheck# :: Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalClearBit :: Natural -> GHC.Types.Word -> Natural
   naturalClearBit# :: Natural -> GHC.Prim.Word# -> Natural
   naturalCompare :: Natural -> Natural -> GHC.Types.Ordering
@@ -11551,26 +11551,26 @@ module GHC.Num where
   naturalEncodeDouble# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Double#
   naturalEncodeFloat# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Float#
   naturalEq :: Natural -> Natural -> GHC.Types.Bool
-  naturalEq# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
-  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Natural
-  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
-  naturalFromBigNat# :: GHC.Num.BigNat.BigNat# -> Natural
-  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalEq# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Natural
+  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Natural
+  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
   naturalFromWord :: GHC.Types.Word -> Natural
   naturalFromWord# :: GHC.Prim.Word# -> Natural
   naturalFromWord2# :: GHC.Prim.Word# -> GHC.Prim.Word# -> Natural
   naturalFromWordList :: [GHC.Types.Word] -> Natural
   naturalGcd :: Natural -> Natural -> Natural
   naturalGe :: Natural -> Natural -> GHC.Types.Bool
-  naturalGe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalGt :: Natural -> Natural -> GHC.Types.Bool
-  naturalGt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalIsOne :: Natural -> GHC.Types.Bool
   naturalIsPowerOf2# :: Natural -> (# (# #) | GHC.Prim.Word# #)
   naturalIsZero :: Natural -> GHC.Types.Bool
   naturalLcm :: Natural -> Natural -> Natural
   naturalLe :: Natural -> Natural -> GHC.Types.Bool
-  naturalLe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalLog2 :: Natural -> GHC.Types.Word
   naturalLog2# :: Natural -> GHC.Prim.Word#
   naturalLogBase :: Natural -> Natural -> GHC.Types.Word
@@ -11578,10 +11578,10 @@ module GHC.Num where
   naturalLogBaseWord :: GHC.Types.Word -> Natural -> GHC.Types.Word
   naturalLogBaseWord# :: GHC.Prim.Word# -> Natural -> GHC.Prim.Word#
   naturalLt :: Natural -> Natural -> GHC.Types.Bool
-  naturalLt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalMul :: Natural -> Natural -> Natural
   naturalNe :: Natural -> Natural -> GHC.Types.Bool
-  naturalNe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalNe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalNegate :: Natural -> Natural
   naturalOne :: Natural
   naturalOr :: Natural -> Natural -> Natural
@@ -11605,11 +11605,11 @@ module GHC.Num where
   naturalSubThrow :: Natural -> Natural -> Natural
   naturalSubUnsafe :: Natural -> Natural -> Natural
   naturalTestBit :: Natural -> GHC.Types.Word -> GHC.Types.Bool
-  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  naturalToBigNat# :: Natural -> GHC.Num.BigNat.BigNat#
-  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalToBigNat# :: Natural -> GHC.Internal.Bignum.BigNat.BigNat#
+  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   naturalToWord :: Natural -> GHC.Types.Word
   naturalToWord# :: Natural -> GHC.Prim.Word#
   naturalToWordClamp :: Natural -> GHC.Types.Word
@@ -11625,7 +11625,7 @@ module GHC.Num.BigNat where
   type BigNat :: *
   data BigNat = BN# {unBigNat :: BigNat#}
   type BigNat# :: GHC.Types.UnliftedType
-  type BigNat# = GHC.Num.WordArray.WordArray#
+  type BigNat# = GHC.Internal.Bignum.WordArray.WordArray#
   bigNatAdd :: BigNat# -> BigNat# -> BigNat#
   bigNatAddWord :: BigNat# -> GHC.Types.Word -> BigNat#
   bigNatAddWord# :: BigNat# -> GHC.Prim.Word# -> BigNat#
@@ -11637,7 +11637,7 @@ module GHC.Num.BigNat where
   bigNatBit :: GHC.Types.Word -> BigNat#
   bigNatBit# :: GHC.Prim.Word# -> BigNat#
   bigNatCheck :: BigNat# -> GHC.Types.Bool
-  bigNatCheck# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatCheck# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatClearBit# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatCompare :: BigNat# -> BigNat# -> GHC.Types.Ordering
   bigNatCompareWord :: BigNat# -> GHC.Types.Word -> GHC.Types.Ordering
@@ -11649,48 +11649,48 @@ module GHC.Num.BigNat where
   bigNatCtzWord# :: BigNat# -> GHC.Prim.Word#
   bigNatEncodeDouble# :: BigNat# -> GHC.Prim.Int# -> GHC.Prim.Double#
   bigNatEq :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatEq# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
-  bigNatEqWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
+  bigNatEq# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
+  bigNatEqWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatFromAbsInt# :: GHC.Prim.Int# -> BigNat#
-  bigNatFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
+  bigNatFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromAddrBE# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromAddrLE# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
-  bigNatFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
+  bigNatFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromByteArrayBE# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromByteArrayLE# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromWord :: GHC.Types.Word -> BigNat#
   bigNatFromWord# :: GHC.Prim.Word# -> BigNat#
   bigNatFromWord2# :: GHC.Prim.Word# -> GHC.Prim.Word# -> BigNat#
   bigNatFromWord64# :: GHC.Prim.Word64# -> BigNat#
-  bigNatFromWordArray :: GHC.Num.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat
-  bigNatFromWordArray# :: GHC.Num.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat#
+  bigNatFromWordArray :: GHC.Internal.Bignum.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat
+  bigNatFromWordArray# :: GHC.Internal.Bignum.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat#
   bigNatFromWordList :: [GHC.Types.Word] -> BigNat#
-  bigNatFromWordList# :: [GHC.Types.Word] -> GHC.Num.WordArray.WordArray#
+  bigNatFromWordList# :: [GHC.Types.Word] -> GHC.Internal.Bignum.WordArray.WordArray#
   bigNatFromWordListUnsafe :: [GHC.Types.Word] -> BigNat#
   bigNatGcd :: BigNat# -> BigNat# -> BigNat#
   bigNatGcdWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Prim.Word#
   bigNatGe :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatGe# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatGe# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatGt :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatGt# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatGt# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatGtWord :: BigNat# -> GHC.Types.Word -> GHC.Types.Bool
-  bigNatGtWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
+  bigNatGtWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatIndex :: BigNat# -> GHC.Prim.Int# -> GHC.Types.Word
   bigNatIndex# :: BigNat# -> GHC.Prim.Int# -> GHC.Prim.Word#
   bigNatIsOne :: BigNat# -> GHC.Types.Bool
-  bigNatIsOne# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatIsOne# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatIsPowerOf2# :: BigNat# -> (# (# #) | GHC.Prim.Word# #)
   bigNatIsTwo :: BigNat# -> GHC.Types.Bool
-  bigNatIsTwo# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatIsTwo# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatIsZero :: BigNat# -> GHC.Types.Bool
-  bigNatIsZero# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatIsZero# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatLcm :: BigNat# -> BigNat# -> BigNat#
   bigNatLcmWord# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatLcmWordWord# :: GHC.Prim.Word# -> GHC.Prim.Word# -> BigNat#
   bigNatLe :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatLe# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatLe# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatLeWord :: BigNat# -> GHC.Types.Word -> GHC.Types.Bool
-  bigNatLeWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
+  bigNatLeWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatLog2 :: BigNat# -> GHC.Types.Word
   bigNatLog2# :: BigNat# -> GHC.Prim.Word#
   bigNatLogBase :: BigNat# -> BigNat# -> GHC.Types.Word
@@ -11698,12 +11698,12 @@ module GHC.Num.BigNat where
   bigNatLogBaseWord :: GHC.Types.Word -> BigNat# -> GHC.Types.Word
   bigNatLogBaseWord# :: GHC.Prim.Word# -> BigNat# -> GHC.Prim.Word#
   bigNatLt :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatLt# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatLt# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatMul :: BigNat# -> BigNat# -> BigNat#
   bigNatMulWord :: BigNat# -> GHC.Types.Word -> BigNat#
   bigNatMulWord# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatNe :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatNe# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatNe# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatOne :: BigNat
   bigNatOne# :: (# #) -> BigNat#
   bigNatOr :: BigNat# -> BigNat# -> BigNat#
@@ -11737,14 +11737,14 @@ module GHC.Num.BigNat where
   bigNatSubWordUnsafe :: BigNat# -> GHC.Types.Word -> BigNat#
   bigNatSubWordUnsafe# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatTestBit :: BigNat# -> GHC.Types.Word -> GHC.Types.Bool
-  bigNatTestBit# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  bigNatToAddr :: BigNat# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  bigNatToAddr# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  bigNatTestBit# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  bigNatToAddr :: BigNat# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  bigNatToAddr# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToAddrBE# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToAddrLE# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToInt :: BigNat# -> GHC.Types.Int
   bigNatToInt# :: BigNat# -> GHC.Prim.Int#
-  bigNatToMutableByteArray# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  bigNatToMutableByteArray# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToMutableByteArrayBE# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToMutableByteArrayLE# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToWord :: BigNat# -> GHC.Types.Word
@@ -11773,7 +11773,7 @@ module GHC.Num.Integer where
   integerBit :: GHC.Types.Word -> Integer
   integerBit# :: GHC.Prim.Word# -> Integer
   integerCheck :: Integer -> GHC.Types.Bool
-  integerCheck# :: Integer -> GHC.Num.Primitives.Bool#
+  integerCheck# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerCompare :: Integer -> Integer -> GHC.Types.Ordering
   integerComplement :: Integer -> Integer
   integerDecodeDouble# :: GHC.Prim.Double# -> (# Integer, GHC.Prim.Int# #)
@@ -11784,18 +11784,18 @@ module GHC.Num.Integer where
   integerEncodeDouble# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Double#
   integerEncodeFloat# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Float#
   integerEq :: Integer -> Integer -> GHC.Types.Bool
-  integerEq# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
-  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Integer
-  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
-  integerFromBigNat# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatNeg# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Num.BigNat.BigNat# -> Integer
-  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> Integer
-  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerEq# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
+  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Integer
+  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatNeg# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> Integer
+  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
   integerFromInt :: GHC.Types.Int -> Integer
   integerFromInt# :: GHC.Prim.Int# -> Integer
   integerFromInt64# :: GHC.Prim.Int64# -> Integer
-  integerFromNatural :: GHC.Num.Natural.Natural -> Integer
+  integerFromNatural :: GHC.Internal.Bignum.Natural.Natural -> Integer
   integerFromWord :: GHC.Types.Word -> Integer
   integerFromWord# :: GHC.Prim.Word# -> Integer
   integerFromWord64# :: GHC.Prim.Word64# -> Integer
@@ -11806,17 +11806,17 @@ module GHC.Num.Integer where
   integerGcde :: Integer -> Integer -> (Integer, Integer, Integer)
   integerGcde# :: Integer -> Integer -> (# Integer, Integer, Integer #)
   integerGe :: Integer -> Integer -> GHC.Types.Bool
-  integerGe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerGt :: Integer -> Integer -> GHC.Types.Bool
-  integerGt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsNegative :: Integer -> GHC.Types.Bool
-  integerIsNegative# :: Integer -> GHC.Num.Primitives.Bool#
+  integerIsNegative# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsOne :: Integer -> GHC.Types.Bool
   integerIsPowerOf2# :: Integer -> (# (# #) | GHC.Prim.Word# #)
   integerIsZero :: Integer -> GHC.Types.Bool
   integerLcm :: Integer -> Integer -> Integer
   integerLe :: Integer -> Integer -> GHC.Types.Bool
-  integerLe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerLog2 :: Integer -> GHC.Types.Word
   integerLog2# :: Integer -> GHC.Prim.Word#
   integerLogBase :: Integer -> Integer -> GHC.Types.Word
@@ -11824,20 +11824,20 @@ module GHC.Num.Integer where
   integerLogBaseWord :: GHC.Types.Word -> Integer -> GHC.Types.Word
   integerLogBaseWord# :: GHC.Prim.Word# -> Integer -> GHC.Prim.Word#
   integerLt :: Integer -> Integer -> GHC.Types.Bool
-  integerLt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerMod :: Integer -> Integer -> Integer
   integerMul :: Integer -> Integer -> Integer
   integerNe :: Integer -> Integer -> GHC.Types.Bool
-  integerNe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerNe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerNegate :: Integer -> Integer
   integerOne :: Integer
   integerOr :: Integer -> Integer -> Integer
   integerPopCount# :: Integer -> GHC.Prim.Int#
-  integerPowMod# :: Integer -> Integer -> GHC.Num.Natural.Natural -> (# GHC.Num.Natural.Natural | () #)
+  integerPowMod# :: Integer -> Integer -> GHC.Internal.Bignum.Natural.Natural -> (# GHC.Internal.Bignum.Natural.Natural | () #)
   integerQuot :: Integer -> Integer -> Integer
   integerQuotRem :: Integer -> Integer -> (Integer, Integer)
   integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #)
-  integerRecipMod# :: Integer -> GHC.Num.Natural.Natural -> (# GHC.Num.Natural.Natural | () #)
+  integerRecipMod# :: Integer -> GHC.Internal.Bignum.Natural.Natural -> (# GHC.Internal.Bignum.Natural.Natural | () #)
   integerRem :: Integer -> Integer -> Integer
   integerShiftL :: Integer -> GHC.Types.Word -> Integer
   integerShiftL# :: Integer -> GHC.Prim.Word# -> Integer
@@ -11849,19 +11849,19 @@ module GHC.Num.Integer where
   integerSqr :: Integer -> Integer
   integerSub :: Integer -> Integer -> Integer
   integerTestBit :: Integer -> GHC.Types.Word -> GHC.Types.Bool
-  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  integerToBigNatClamp# :: Integer -> GHC.Num.BigNat.BigNat#
-  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Num.BigNat.BigNat# #)
+  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToBigNatClamp# :: Integer -> GHC.Internal.Bignum.BigNat.BigNat#
+  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Internal.Bignum.BigNat.BigNat# #)
   integerToInt :: Integer -> GHC.Types.Int
   integerToInt# :: Integer -> GHC.Prim.Int#
   integerToInt64# :: Integer -> GHC.Prim.Int64#
-  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  integerToNatural :: Integer -> GHC.Num.Natural.Natural
-  integerToNaturalClamp :: Integer -> GHC.Num.Natural.Natural
-  integerToNaturalThrow :: Integer -> GHC.Num.Natural.Natural
+  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToNatural :: Integer -> GHC.Internal.Bignum.Natural.Natural
+  integerToNaturalClamp :: Integer -> GHC.Internal.Bignum.Natural.Natural
+  integerToNaturalThrow :: Integer -> GHC.Internal.Bignum.Natural.Natural
   integerToWord :: Integer -> GHC.Types.Word
   integerToWord# :: Integer -> GHC.Prim.Word#
   integerToWord64# :: Integer -> GHC.Prim.Word64#
@@ -11878,7 +11878,7 @@ module GHC.Num.Natural where
   naturalBit :: GHC.Types.Word -> Natural
   naturalBit# :: GHC.Prim.Word# -> Natural
   naturalCheck :: Natural -> GHC.Types.Bool
-  naturalCheck# :: Natural -> GHC.Num.Primitives.Bool#
+  naturalCheck# :: Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalClearBit :: Natural -> GHC.Types.Word -> Natural
   naturalClearBit# :: Natural -> GHC.Prim.Word# -> Natural
   naturalCompare :: Natural -> Natural -> GHC.Types.Ordering
@@ -11887,26 +11887,26 @@ module GHC.Num.Natural where
   naturalEncodeDouble# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Double#
   naturalEncodeFloat# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Float#
   naturalEq :: Natural -> Natural -> GHC.Types.Bool
-  naturalEq# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
-  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Natural
-  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
-  naturalFromBigNat# :: GHC.Num.BigNat.BigNat# -> Natural
-  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalEq# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Natural
+  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Natural
+  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
   naturalFromWord :: GHC.Types.Word -> Natural
   naturalFromWord# :: GHC.Prim.Word# -> Natural
   naturalFromWord2# :: GHC.Prim.Word# -> GHC.Prim.Word# -> Natural
   naturalFromWordList :: [GHC.Types.Word] -> Natural
   naturalGcd :: Natural -> Natural -> Natural
   naturalGe :: Natural -> Natural -> GHC.Types.Bool
-  naturalGe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalGt :: Natural -> Natural -> GHC.Types.Bool
-  naturalGt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalIsOne :: Natural -> GHC.Types.Bool
   naturalIsPowerOf2# :: Natural -> (# (# #) | GHC.Prim.Word# #)
   naturalIsZero :: Natural -> GHC.Types.Bool
   naturalLcm :: Natural -> Natural -> Natural
   naturalLe :: Natural -> Natural -> GHC.Types.Bool
-  naturalLe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalLog2 :: Natural -> GHC.Types.Word
   naturalLog2# :: Natural -> GHC.Prim.Word#
   naturalLogBase :: Natural -> Natural -> GHC.Types.Word
@@ -11914,10 +11914,10 @@ module GHC.Num.Natural where
   naturalLogBaseWord :: GHC.Types.Word -> Natural -> GHC.Types.Word
   naturalLogBaseWord# :: GHC.Prim.Word# -> Natural -> GHC.Prim.Word#
   naturalLt :: Natural -> Natural -> GHC.Types.Bool
-  naturalLt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalMul :: Natural -> Natural -> Natural
   naturalNe :: Natural -> Natural -> GHC.Types.Bool
-  naturalNe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalNe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalNegate :: Natural -> Natural
   naturalOne :: Natural
   naturalOr :: Natural -> Natural -> Natural
@@ -11941,11 +11941,11 @@ module GHC.Num.Natural where
   naturalSubThrow :: Natural -> Natural -> Natural
   naturalSubUnsafe :: Natural -> Natural -> Natural
   naturalTestBit :: Natural -> GHC.Types.Word -> GHC.Types.Bool
-  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  naturalToBigNat# :: Natural -> GHC.Num.BigNat.BigNat#
-  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalToBigNat# :: Natural -> GHC.Internal.Bignum.BigNat.BigNat#
+  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   naturalToWord :: Natural -> GHC.Types.Word
   naturalToWord# :: Natural -> GHC.Prim.Word#
   naturalToWordClamp :: Natural -> GHC.Types.Word
@@ -12252,12 +12252,12 @@ module GHC.Real where
     mod :: a -> a -> a
     quotRem :: a -> a -> (a, a)
     divMod :: a -> a -> (a, a)
-    toInteger :: a -> GHC.Num.Integer.Integer
+    toInteger :: a -> GHC.Internal.Bignum.Integer.Integer
     {-# MINIMAL quotRem, toInteger #-}
   type Ratio :: * -> *
   data Ratio a = !a :% !a
   type Rational :: *
-  type Rational = Ratio GHC.Num.Integer.Integer
+  type Rational = Ratio GHC.Internal.Bignum.Integer.Integer
   type Real :: * -> Constraint
   class (GHC.Internal.Num.Num a, GHC.Classes.Ord a) => Real a where
     toRational :: a -> Rational
@@ -12285,9 +12285,9 @@ module GHC.Real where
   integralEnumFromThenTo :: forall a. Integral a => a -> a -> a -> [a]
   integralEnumFromTo :: forall a. Integral a => a -> a -> [a]
   lcm :: forall a. Integral a => a -> a -> a
-  mkRationalBase10 :: Rational -> GHC.Num.Integer.Integer -> Rational
-  mkRationalBase2 :: Rational -> GHC.Num.Integer.Integer -> Rational
-  mkRationalWithExponentBase :: Rational -> GHC.Num.Integer.Integer -> FractionalExponentBase -> Rational
+  mkRationalBase10 :: Rational -> GHC.Internal.Bignum.Integer.Integer -> Rational
+  mkRationalBase2 :: Rational -> GHC.Internal.Bignum.Integer.Integer -> Rational
+  mkRationalWithExponentBase :: Rational -> GHC.Internal.Bignum.Integer.Integer -> FractionalExponentBase -> Rational
   notANumber :: Rational
   numerator :: forall a. Ratio a -> a
   numericEnumFrom :: forall a. Fractional a => a -> [a]
@@ -12697,15 +12697,15 @@ module GHC.TypeLits where
   decideNat :: forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *) (proxy2 :: Nat -> *). (KnownNat a, KnownNat b) => proxy1 a -> proxy2 b -> GHC.Internal.Data.Either.Either ((a GHC.Internal.Data.Type.Equality.:~: b) -> GHC.Internal.Base.Void) (a GHC.Internal.Data.Type.Equality.:~: b)
   decideSymbol :: forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *) (proxy2 :: Symbol -> *). (KnownSymbol a, KnownSymbol b) => proxy1 a -> proxy2 b -> GHC.Internal.Data.Either.Either ((a GHC.Internal.Data.Type.Equality.:~: b) -> GHC.Internal.Base.Void) (a GHC.Internal.Data.Type.Equality.:~: b)
   fromSChar :: forall (c :: GHC.Types.Char). SChar c -> GHC.Types.Char
-  fromSNat :: forall (n :: Nat). SNat n -> GHC.Num.Integer.Integer
+  fromSNat :: forall (n :: Nat). SNat n -> GHC.Internal.Bignum.Integer.Integer
   fromSSymbol :: forall (s :: Symbol). SSymbol s -> GHC.Internal.Base.String
-  natVal :: forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> GHC.Num.Integer.Integer
-  natVal' :: forall (n :: Nat). KnownNat n => GHC.Prim.Proxy# n -> GHC.Num.Integer.Integer
+  natVal :: forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> GHC.Internal.Bignum.Integer.Integer
+  natVal' :: forall (n :: Nat). KnownNat n => GHC.Prim.Proxy# n -> GHC.Internal.Bignum.Integer.Integer
   sameChar :: forall (a :: GHC.Types.Char) (b :: GHC.Types.Char) (proxy1 :: GHC.Types.Char -> *) (proxy2 :: GHC.Types.Char -> *). (KnownChar a, KnownChar b) => proxy1 a -> proxy2 b -> GHC.Internal.Maybe.Maybe (a GHC.Internal.Data.Type.Equality.:~: b)
   sameNat :: forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *) (proxy2 :: Nat -> *). (KnownNat a, KnownNat b) => proxy1 a -> proxy2 b -> GHC.Internal.Maybe.Maybe (a GHC.Internal.Data.Type.Equality.:~: b)
   sameSymbol :: forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *) (proxy2 :: Symbol -> *). (KnownSymbol a, KnownSymbol b) => proxy1 a -> proxy2 b -> GHC.Internal.Maybe.Maybe (a GHC.Internal.Data.Type.Equality.:~: b)
   someCharVal :: GHC.Types.Char -> SomeChar
-  someNatVal :: GHC.Num.Integer.Integer -> GHC.Internal.Maybe.Maybe SomeNat
+  someNatVal :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Maybe.Maybe SomeNat
   someSymbolVal :: GHC.Internal.Base.String -> SomeSymbol
   symbolVal :: forall (n :: Symbol) (proxy :: Symbol -> *). KnownSymbol n => proxy n -> GHC.Internal.Base.String
   symbolVal' :: forall (n :: Symbol). KnownSymbol n => GHC.Prim.Proxy# n -> GHC.Internal.Base.String
@@ -12713,7 +12713,7 @@ module GHC.TypeLits where
   withKnownNat :: forall (n :: Nat) (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). SNat n -> (KnownNat n => r) -> r
   withKnownSymbol :: forall (s :: Symbol) (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). SSymbol s -> (KnownSymbol s => r) -> r
   withSomeSChar :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Types.Char -> (forall (c :: GHC.Types.Char). SChar c -> r) -> r
-  withSomeSNat :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Num.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
+  withSomeSNat :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Bignum.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
   withSomeSSymbol :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Base.String -> (forall (s :: Symbol). SSymbol s -> r) -> r
 
 module GHC.TypeLits.Internal where
@@ -12903,7 +12903,7 @@ module Numeric where
     log1pexp :: a -> a
     log1mexp :: a -> a
     {-# MINIMAL pi, exp, log, sin, cos, asin, acos, atan, sinh, cosh, asinh, acosh, atanh #-}
-  floatToDigits :: forall a. GHC.Internal.Float.RealFloat a => GHC.Num.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
+  floatToDigits :: forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Bignum.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
   fromRat :: forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Rational -> a
   lexDigits :: GHC.Internal.Text.ParserCombinators.ReadP.ReadS GHC.Internal.Base.String
   readBin :: forall a. (GHC.Classes.Eq a, GHC.Internal.Num.Num a) => GHC.Internal.Text.ParserCombinators.ReadP.ReadS a
@@ -13256,8 +13256,8 @@ module Prelude where
 
 module System.CPUTime where
   -- Safety: Trustworthy
-  cpuTimePrecision :: GHC.Num.Integer.Integer
-  getCPUTime :: GHC.Types.IO GHC.Num.Integer.Integer
+  cpuTimePrecision :: GHC.Internal.Bignum.Integer.Integer
+  getCPUTime :: GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
 
 module System.Console.GetOpt where
   -- Safety: Safe
@@ -13337,7 +13337,7 @@ module System.IO where
   getContents' :: IO GHC.Internal.Base.String
   getLine :: IO GHC.Internal.Base.String
   hClose :: Handle -> IO ()
-  hFileSize :: Handle -> IO GHC.Num.Integer.Integer
+  hFileSize :: Handle -> IO GHC.Internal.Bignum.Integer.Integer
   hFlush :: Handle -> IO ()
   hGetBuf :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> IO GHC.Types.Int
   hGetBufNonBlocking :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> IO GHC.Types.Int
@@ -13365,16 +13365,16 @@ module System.IO where
   hPutStr :: Handle -> GHC.Internal.Base.String -> IO ()
   hPutStrLn :: Handle -> GHC.Internal.Base.String -> IO ()
   hReady :: Handle -> IO GHC.Types.Bool
-  hSeek :: Handle -> SeekMode -> GHC.Num.Integer.Integer -> IO ()
+  hSeek :: Handle -> SeekMode -> GHC.Internal.Bignum.Integer.Integer -> IO ()
   hSetBinaryMode :: Handle -> GHC.Types.Bool -> IO ()
   hSetBuffering :: Handle -> BufferMode -> IO ()
   hSetEcho :: Handle -> GHC.Types.Bool -> IO ()
   hSetEncoding :: Handle -> TextEncoding -> IO ()
-  hSetFileSize :: Handle -> GHC.Num.Integer.Integer -> IO ()
+  hSetFileSize :: Handle -> GHC.Internal.Bignum.Integer.Integer -> IO ()
   hSetNewlineMode :: Handle -> NewlineMode -> IO ()
   hSetPosn :: HandlePosn -> IO ()
   hShow :: Handle -> IO GHC.Internal.Base.String
-  hTell :: Handle -> IO GHC.Num.Integer.Integer
+  hTell :: Handle -> IO GHC.Internal.Bignum.Integer.Integer
   hWaitForInput :: Handle -> GHC.Types.Int -> IO GHC.Types.Bool
   interact :: (GHC.Internal.Base.String -> GHC.Internal.Base.String) -> IO ()
   isEOF :: IO GHC.Types.Bool
@@ -13601,7 +13601,7 @@ module System.Posix.Internals where
   const_vmin :: GHC.Internal.Foreign.C.Types.CInt
   const_vtime :: GHC.Internal.Foreign.C.Types.CInt
   dEFAULT_BUFFER_SIZE :: GHC.Types.Int
-  fdFileSize :: FD -> GHC.Types.IO GHC.Num.Integer.Integer
+  fdFileSize :: FD -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
   fdGetMode :: FD -> GHC.Types.IO GHC.Internal.IO.IOMode.IOMode
   fdStat :: FD -> GHC.Types.IO (GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
   fdType :: FD -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
@@ -13767,7 +13767,7 @@ module Text.Printf where
   errorShortFormat :: forall a. a
   formatChar :: GHC.Types.Char -> FieldFormatter
   formatInt :: forall a. (GHC.Internal.Real.Integral a, GHC.Internal.Enum.Bounded a) => a -> FieldFormatter
-  formatInteger :: GHC.Num.Integer.Integer -> FieldFormatter
+  formatInteger :: GHC.Internal.Bignum.Integer.Integer -> FieldFormatter
   formatRealFloat :: forall a. GHC.Internal.Float.RealFloat a => a -> FieldFormatter
   formatString :: forall a. IsChar a => [a] -> FieldFormatter
   hPrintf :: forall r. HPrintfType r => GHC.Internal.IO.Handle.Types.Handle -> GHC.Internal.Base.String -> r
@@ -13829,8 +13829,8 @@ module Text.Read.Lex where
   isSymbolChar :: GHC.Types.Char -> GHC.Types.Bool
   lex :: GHC.Internal.Text.ParserCombinators.ReadP.ReadP Lexeme
   lexChar :: GHC.Internal.Text.ParserCombinators.ReadP.ReadP GHC.Types.Char
-  numberToFixed :: GHC.Num.Integer.Integer -> Number -> GHC.Internal.Maybe.Maybe (GHC.Num.Integer.Integer, GHC.Num.Integer.Integer)
-  numberToInteger :: Number -> GHC.Internal.Maybe.Maybe GHC.Num.Integer.Integer
+  numberToFixed :: GHC.Internal.Bignum.Integer.Integer -> Number -> GHC.Internal.Maybe.Maybe (GHC.Internal.Bignum.Integer.Integer, GHC.Internal.Bignum.Integer.Integer)
+  numberToInteger :: Number -> GHC.Internal.Maybe.Maybe GHC.Internal.Bignum.Integer.Integer
   numberToRangedRational :: (GHC.Types.Int, GHC.Types.Int) -> Number -> GHC.Internal.Maybe.Maybe GHC.Internal.Real.Rational
   numberToRational :: Number -> GHC.Internal.Real.Rational
   readBinP :: forall a. (GHC.Classes.Eq a, GHC.Internal.Num.Num a) => GHC.Internal.Text.ParserCombinators.ReadP.ReadP a
@@ -14066,9 +14066,9 @@ instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int16 -- Defined in ‘Te
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int32 -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int64 -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int8 -- Defined in ‘Text.Printf’
-instance [safe] Text.Printf.PrintfArg GHC.Num.Integer.Integer -- Defined in ‘Text.Printf’
+instance [safe] Text.Printf.PrintfArg GHC.Internal.Bignum.Integer.Integer -- Defined in ‘Text.Printf’
 instance [safe] forall c. Text.Printf.IsChar c => Text.Printf.PrintfArg [c] -- Defined in ‘Text.Printf’
-instance [safe] Text.Printf.PrintfArg GHC.Num.Natural.Natural -- Defined in ‘Text.Printf’
+instance [safe] Text.Printf.PrintfArg GHC.Internal.Bignum.Natural.Natural -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Types.Word -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Word.Word16 -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Word.Word32 -- Defined in ‘Text.Printf’
@@ -14316,8 +14316,8 @@ instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Bits.Bits (GHC.Inter
 instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Bits.Bits (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance GHC.Internal.Bits.Bits GHC.Types.Bool -- Defined in ‘GHC.Internal.Bits’
 instance GHC.Internal.Bits.Bits GHC.Types.Int -- Defined in ‘GHC.Internal.Bits’
-instance GHC.Internal.Bits.Bits GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Bits’
-instance GHC.Internal.Bits.Bits GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Bits’
+instance GHC.Internal.Bits.Bits GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Bits’
+instance GHC.Internal.Bits.Bits GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bits’
 instance GHC.Internal.Bits.Bits GHC.Types.Word -- Defined in ‘GHC.Internal.Bits’
 instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Bits.Bits (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.Functor.Identity’
 instance GHC.Internal.Bits.Bits GHC.Internal.Int.Int16 -- Defined in ‘GHC.Internal.Int’
@@ -14473,11 +14473,11 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Int.Int32 -- Defined in ‘GHC
 instance GHC.Internal.Data.Data.Data GHC.Internal.Int.Int64 -- Defined in ‘GHC.Internal.Data.Data’
 instance GHC.Internal.Data.Data.Data GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.Data.Data’
 instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Data.Data’
-instance GHC.Internal.Data.Data.Data GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Data.Data’
+instance GHC.Internal.Data.Data.Data GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Monoid.Last a) -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data [a] -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.Data.Data’
-instance GHC.Internal.Data.Data.Data GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Data.Data’
+instance GHC.Internal.Data.Data.Data GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Data.Data’
 instance GHC.Internal.Data.Data.Data GHC.Types.Ordering -- Defined in ‘GHC.Internal.Data.Data’
 instance forall p. GHC.Internal.Data.Data.Data p => GHC.Internal.Data.Data.Data (GHC.Internal.Generics.Par1 p) -- Defined in ‘GHC.Internal.Data.Data’
@@ -14664,9 +14664,9 @@ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Inter
 instance GHC.Internal.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Internal.Enum’
-instance GHC.Internal.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Enum GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Internal.Enum’
-instance GHC.Internal.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Enum GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Internal.Enum’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (Solo a) -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum () -- Defined in ‘GHC.Internal.Enum’
@@ -15012,8 +15012,8 @@ instance GHC.Internal.Ix.Ix GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.
 instance GHC.Internal.Ix.Ix GHC.Types.Bool -- Defined in ‘GHC.Internal.Ix’
 instance GHC.Internal.Ix.Ix GHC.Types.Char -- Defined in ‘GHC.Internal.Ix’
 instance GHC.Internal.Ix.Ix GHC.Types.Int -- Defined in ‘GHC.Internal.Ix’
-instance GHC.Internal.Ix.Ix GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Ix’
-instance GHC.Internal.Ix.Ix GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Ix’
+instance GHC.Internal.Ix.Ix GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Ix’
+instance GHC.Internal.Ix.Ix GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Ix’
 instance GHC.Internal.Ix.Ix GHC.Types.Ordering -- Defined in ‘GHC.Internal.Ix’
 instance forall a. GHC.Internal.Ix.Ix a => GHC.Internal.Ix.Ix (Solo a) -- Defined in ‘GHC.Internal.Ix’
 instance forall a1 a2 a3 a4 a5 a6 a7 a8 a9 aA. (GHC.Internal.Ix.Ix a1, GHC.Internal.Ix.Ix a2, GHC.Internal.Ix.Ix a3, GHC.Internal.Ix.Ix a4, GHC.Internal.Ix.Ix a5, GHC.Internal.Ix.Ix a6, GHC.Internal.Ix.Ix a7, GHC.Internal.Ix.Ix a8, GHC.Internal.Ix.Ix a9, GHC.Internal.Ix.Ix aA) => GHC.Internal.Ix.Ix (a1, a2, a3, a4, a5, a6, a7, a8, a9, aA) -- Defined in ‘GHC.Internal.Ix’
@@ -15118,8 +15118,8 @@ instance GHC.Internal.Num.Num GHC.Internal.Foreign.C.Types.CWchar -- Defined in
 instance GHC.Internal.Num.Num GHC.Types.Double -- Defined in ‘GHC.Internal.Float’
 instance GHC.Internal.Num.Num GHC.Types.Float -- Defined in ‘GHC.Internal.Float’
 instance GHC.Internal.Num.Num GHC.Types.Int -- Defined in ‘GHC.Internal.Num’
-instance GHC.Internal.Num.Num GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Num’
-instance GHC.Internal.Num.Num GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Num’
+instance GHC.Internal.Num.Num GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Num’
+instance GHC.Internal.Num.Num GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Num’
 instance GHC.Internal.Num.Num GHC.Types.Word -- Defined in ‘GHC.Internal.Num’
 instance forall k a (b :: k). GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’
@@ -15135,11 +15135,11 @@ instance GHC.Internal.Read.Read GHC.Types.Double -- Defined in ‘GHC.Internal.R
 instance GHC.Internal.Read.Read GHC.Types.Float -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Types.Int -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Read’
+instance GHC.Internal.Read.Read GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Read’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read [a] -- Defined in ‘GHC.Internal.Read’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Read’
+instance GHC.Internal.Read.Read GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Read’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Types.Ordering -- Defined in ‘GHC.Internal.Read’
 instance forall a. (GHC.Internal.Real.Integral a, GHC.Internal.Read.Read a) => GHC.Internal.Read.Read (GHC.Internal.Real.Ratio a) -- Defined in ‘GHC.Internal.Read’
@@ -15270,8 +15270,8 @@ instance GHC.Internal.Real.Integral GHC.Internal.Int.Int32 -- Defined in ‘GHC.
 instance GHC.Internal.Real.Integral GHC.Internal.Int.Int64 -- Defined in ‘GHC.Internal.Int’
 instance GHC.Internal.Real.Integral GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.Int’
 instance GHC.Internal.Real.Integral GHC.Types.Int -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Integral GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Integral GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Integral GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Integral GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Integral GHC.Types.Word -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Integral GHC.Internal.Word.Word16 -- Defined in ‘GHC.Internal.Word’
 instance GHC.Internal.Real.Integral GHC.Internal.Word.Word32 -- Defined in ‘GHC.Internal.Word’
@@ -15309,8 +15309,8 @@ instance GHC.Internal.Real.Real GHC.Internal.Int.Int64 -- Defined in ‘GHC.Inte
 instance GHC.Internal.Real.Real GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.Int’
 instance forall a. GHC.Internal.Real.Real a => GHC.Internal.Real.Real (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
 instance GHC.Internal.Real.Real GHC.Types.Int -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Real GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Real GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Real GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Real GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Real’
 instance forall a. GHC.Internal.Real.Integral a => GHC.Internal.Real.Real (GHC.Internal.Real.Ratio a) -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Real GHC.Types.Word -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Real GHC.Internal.Word.Word16 -- Defined in ‘GHC.Internal.Word’
@@ -15402,13 +15402,13 @@ instance GHC.Internal.Show.Show GHC.Types.Bool -- Defined in ‘GHC.Internal.Sho
 instance GHC.Internal.Show.Show GHC.Internal.Stack.Types.CallStack -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Char -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Int -- Defined in ‘GHC.Internal.Show’
-instance GHC.Internal.Show.Show GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Show’
+instance GHC.Internal.Show.Show GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.KindRep -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Levity -- Defined in ‘GHC.Internal.Show’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show [a] -- Defined in ‘GHC.Internal.Show’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Module -- Defined in ‘GHC.Internal.Show’
-instance GHC.Internal.Show.Show GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Show’
+instance GHC.Internal.Show.Show GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Show’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Ordering -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.RuntimeRep -- Defined in ‘GHC.Internal.Show’
@@ -15766,10 +15766,10 @@ instance GHC.Classes.Eq GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘G
 instance forall i e. GHC.Classes.Eq (GHC.Internal.IOArray.IOArray i e) -- Defined in ‘GHC.Internal.IOArray’
 instance forall a. GHC.Classes.Eq (GHC.Internal.IOPort.IOPort a) -- Defined in ‘GHC.Internal.IOPort’
 instance GHC.Classes.Eq GHC.Internal.InfoProv.Types.InfoProv -- Defined in ‘GHC.Internal.InfoProv.Types’
-instance GHC.Classes.Eq GHC.Num.Integer.Integer -- Defined in ‘GHC.Num.Integer’
+instance GHC.Classes.Eq GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Bignum.Integer’
 instance GHC.Classes.Eq GHC.Internal.JS.Foreign.Callback.OnBlocked -- Defined in ‘GHC.Internal.JS.Foreign.Callback’
-instance GHC.Classes.Eq GHC.Num.BigNat.BigNat -- Defined in ‘GHC.Num.BigNat’
-instance GHC.Classes.Eq GHC.Num.Natural.Natural -- Defined in ‘GHC.Num.Natural’
+instance GHC.Classes.Eq GHC.Internal.Bignum.BigNat.BigNat -- Defined in ‘GHC.Internal.Bignum.BigNat’
+instance GHC.Classes.Eq GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’
 instance GHC.Classes.Eq GHC.Internal.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.Internal.RTS.Flags’
 instance forall a. GHC.Classes.Eq (GHC.Internal.StableName.StableName a) -- Defined in ‘GHC.Internal.StableName’
 instance GHC.Classes.Eq GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’
@@ -15923,9 +15923,9 @@ instance GHC.Classes.Ord GHC.Internal.IO.Handle.Types.BufferMode -- Defined in 
 instance GHC.Classes.Ord GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
 instance GHC.Classes.Ord GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
 instance GHC.Classes.Ord GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
-instance GHC.Classes.Ord GHC.Num.Integer.Integer -- Defined in ‘GHC.Num.Integer’
-instance GHC.Classes.Ord GHC.Num.BigNat.BigNat -- Defined in ‘GHC.Num.BigNat’
-instance GHC.Classes.Ord GHC.Num.Natural.Natural -- Defined in ‘GHC.Num.Natural’
+instance GHC.Classes.Ord GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Bignum.Integer’
+instance GHC.Classes.Ord GHC.Internal.Bignum.BigNat.BigNat -- Defined in ‘GHC.Internal.Bignum.BigNat’
+instance GHC.Classes.Ord GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’
 instance forall (n :: GHC.Internal.TypeNats.Nat). GHC.Classes.Ord (GHC.Internal.TypeNats.SNat n) -- Defined in ‘GHC.Internal.TypeNats’
 instance GHC.Classes.Ord GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
 instance forall (c :: GHC.Types.Char). GHC.Classes.Ord (GHC.Internal.TypeLits.SChar c) -- Defined in ‘GHC.Internal.TypeLits’
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-mingw32 b/testsuite/tests/interface-stability/base-exports.stdout-mingw32
index a04e62a7c65..a8bb1cca469 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-mingw32
+++ b/testsuite/tests/interface-stability/base-exports.stdout-mingw32
@@ -835,7 +835,7 @@ module Data.Data where
   type Constr :: *
   data Constr = ...
   type ConstrRep :: *
-  data ConstrRep = AlgConstr ConIndex | IntConstr GHC.Num.Integer.Integer | FloatConstr GHC.Internal.Real.Rational | CharConstr GHC.Types.Char
+  data ConstrRep = AlgConstr ConIndex | IntConstr GHC.Internal.Bignum.Integer.Integer | FloatConstr GHC.Internal.Real.Rational | CharConstr GHC.Types.Char
   type Data :: * -> Constraint
   class Typeable a => Data a where
     gfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> a -> c a
@@ -1010,10 +1010,10 @@ module Data.Fixed where
   data E9
   type role Fixed phantom
   type Fixed :: forall k. k -> *
-  newtype Fixed a = MkFixed GHC.Num.Integer.Integer
+  newtype Fixed a = MkFixed GHC.Internal.Bignum.Integer.Integer
   type HasResolution :: forall k. k -> Constraint
   class HasResolution @k a where
-    resolution :: forall (p :: k -> *). p a -> GHC.Num.Integer.Integer
+    resolution :: forall (p :: k -> *). p a -> GHC.Internal.Bignum.Integer.Integer
     {-# MINIMAL resolution #-}
   type Micro :: *
   type Micro = Fixed E6
@@ -1582,7 +1582,7 @@ module Data.Ratio where
   type Ratio :: * -> *
   data Ratio a = ...
   type Rational :: *
-  type Rational = Ratio GHC.Num.Integer.Integer
+  type Rational = Ratio GHC.Internal.Bignum.Integer.Integer
   approxRational :: forall a. GHC.Internal.Real.RealFrac a => a -> a -> Rational
   denominator :: forall a. Ratio a -> a
   numerator :: forall a. Ratio a -> a
@@ -7297,11 +7297,11 @@ module GHC.Float where
     {-# MINIMAL pi, exp, log, sin, cos, asin, acos, atan, sinh, cosh, asinh, acosh, atanh #-}
   type RealFloat :: * -> Constraint
   class (GHC.Internal.Real.RealFrac a, Floating a) => RealFloat a where
-    floatRadix :: a -> GHC.Num.Integer.Integer
+    floatRadix :: a -> GHC.Internal.Bignum.Integer.Integer
     floatDigits :: a -> GHC.Types.Int
     floatRange :: a -> (GHC.Types.Int, GHC.Types.Int)
-    decodeFloat :: a -> (GHC.Num.Integer.Integer, GHC.Types.Int)
-    encodeFloat :: GHC.Num.Integer.Integer -> GHC.Types.Int -> a
+    decodeFloat :: a -> (GHC.Internal.Bignum.Integer.Integer, GHC.Types.Int)
+    encodeFloat :: GHC.Internal.Bignum.Integer.Integer -> GHC.Types.Int -> a
     exponent :: a -> GHC.Types.Int
     significand :: a -> a
     scaleFloat :: GHC.Types.Int -> a -> a
@@ -7349,30 +7349,30 @@ module GHC.Float where
   expFloat :: Float -> Float
   expm1Double :: Double -> Double
   expm1Float :: Float -> Float
-  expt :: GHC.Num.Integer.Integer -> GHC.Types.Int -> GHC.Num.Integer.Integer
-  expts :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer
-  expts10 :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer
+  expt :: GHC.Internal.Bignum.Integer.Integer -> GHC.Types.Int -> GHC.Internal.Bignum.Integer.Integer
+  expts :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Internal.Bignum.Integer.Integer
+  expts10 :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Internal.Bignum.Integer.Integer
   fabsDouble :: Double -> Double
   fabsFloat :: Float -> Float
   float2Double :: Float -> Double
   float2Int :: Float -> GHC.Types.Int
-  floatToDigits :: forall a. RealFloat a => GHC.Num.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
+  floatToDigits :: forall a. RealFloat a => GHC.Internal.Bignum.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
   floorDouble :: forall b. GHC.Internal.Real.Integral b => Double -> b
   floorFloat :: forall b. GHC.Internal.Real.Integral b => Float -> b
   formatRealFloat :: forall a. RealFloat a => FFFormat -> GHC.Internal.Maybe.Maybe GHC.Types.Int -> a -> GHC.Internal.Base.String
   formatRealFloatAlt :: forall a. RealFloat a => FFFormat -> GHC.Internal.Maybe.Maybe GHC.Types.Int -> GHC.Types.Bool -> a -> GHC.Internal.Base.String
   fromRat :: forall a. RealFloat a => GHC.Internal.Real.Rational -> a
   fromRat' :: forall a. RealFloat a => GHC.Internal.Real.Rational -> a
-  fromRat'' :: forall a. RealFloat a => GHC.Types.Int -> GHC.Types.Int -> GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> a
+  fromRat'' :: forall a. RealFloat a => GHC.Types.Int -> GHC.Types.Int -> GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> a
   geDouble :: Double -> Double -> GHC.Types.Bool
   geFloat :: Float -> Float -> GHC.Types.Bool
   gtDouble :: Double -> Double -> GHC.Types.Bool
   gtFloat :: Float -> Float -> GHC.Types.Bool
   int2Double :: GHC.Types.Int -> Double
   int2Float :: GHC.Types.Int -> Float
-  integerToBinaryFloat' :: forall a. RealFloat a => GHC.Num.Integer.Integer -> a
-  integerToDouble# :: GHC.Num.Integer.Integer -> Double#
-  integerToFloat# :: GHC.Num.Integer.Integer -> Float#
+  integerToBinaryFloat' :: forall a. RealFloat a => GHC.Internal.Bignum.Integer.Integer -> a
+  integerToDouble# :: GHC.Internal.Bignum.Integer.Integer -> Double#
+  integerToFloat# :: GHC.Internal.Bignum.Integer.Integer -> Float#
   isDoubleDenormalized :: Double -> GHC.Types.Int
   isDoubleFinite :: Double -> GHC.Types.Int
   isDoubleInfinite :: Double -> GHC.Types.Int
@@ -7397,8 +7397,8 @@ module GHC.Float where
   minExpt :: GHC.Types.Int
   minusDouble :: Double -> Double -> Double
   minusFloat :: Float -> Float -> Float
-  naturalToDouble# :: GHC.Num.Natural.Natural -> Double#
-  naturalToFloat# :: GHC.Num.Natural.Natural -> Float#
+  naturalToDouble# :: GHC.Internal.Bignum.Natural.Natural -> Double#
+  naturalToFloat# :: GHC.Internal.Bignum.Natural.Natural -> Float#
   negateDouble :: Double -> Double
   negateFloat :: Float -> Float
   plusDouble :: Double -> Double -> Double
@@ -7407,12 +7407,12 @@ module GHC.Float where
   powerFloat :: Float -> Float -> Float
   properFractionDouble :: forall b. GHC.Internal.Real.Integral b => Double -> (b, Double)
   properFractionFloat :: forall b. GHC.Internal.Real.Integral b => Float -> (b, Float)
-  rationalToDouble :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> Double
-  rationalToFloat :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> Float
+  rationalToDouble :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> Double
+  rationalToFloat :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> Float
   roundDouble :: forall b. GHC.Internal.Real.Integral b => Double -> b
   roundFloat :: forall b. GHC.Internal.Real.Integral b => Float -> b
   roundTo :: GHC.Types.Int -> GHC.Types.Int -> [GHC.Types.Int] -> (GHC.Types.Int, [GHC.Types.Int])
-  roundingMode# :: GHC.Num.Integer.Integer -> GHC.Prim.Int# -> GHC.Prim.Int#
+  roundingMode# :: GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int# -> GHC.Prim.Int#
   showFloat :: forall a. RealFloat a => a -> GHC.Internal.Show.ShowS
   showSignedFloat :: forall a. RealFloat a => (a -> GHC.Internal.Show.ShowS) -> GHC.Types.Int -> a -> GHC.Internal.Show.ShowS
   sinDouble :: Double -> Double
@@ -7438,33 +7438,33 @@ module GHC.Float where
 
 module GHC.Float.ConversionUtils where
   -- Safety: Safe
-  elimZerosInt# :: GHC.Prim.Int# -> GHC.Prim.Int# -> (# GHC.Num.Integer.Integer, GHC.Prim.Int# #)
-  elimZerosInteger :: GHC.Num.Integer.Integer -> GHC.Prim.Int# -> (# GHC.Num.Integer.Integer, GHC.Prim.Int# #)
+  elimZerosInt# :: GHC.Prim.Int# -> GHC.Prim.Int# -> (# GHC.Internal.Bignum.Integer.Integer, GHC.Prim.Int# #)
+  elimZerosInteger :: GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int# -> (# GHC.Internal.Bignum.Integer.Integer, GHC.Prim.Int# #)
 
 module GHC.Float.RealFracMethods where
   -- Safety: Safe
   ceilingDoubleInt :: GHC.Types.Double -> GHC.Types.Int
-  ceilingDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
+  ceilingDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
   ceilingFloatInt :: GHC.Types.Float -> GHC.Types.Int
-  ceilingFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
+  ceilingFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
   double2Int :: GHC.Types.Double -> GHC.Types.Int
   float2Int :: GHC.Types.Float -> GHC.Types.Int
   floorDoubleInt :: GHC.Types.Double -> GHC.Types.Int
-  floorDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
+  floorDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
   floorFloatInt :: GHC.Types.Float -> GHC.Types.Int
-  floorFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
+  floorFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
   int2Double :: GHC.Types.Int -> GHC.Types.Double
   int2Float :: GHC.Types.Int -> GHC.Types.Float
   properFractionDoubleInt :: GHC.Types.Double -> (GHC.Types.Int, GHC.Types.Double)
-  properFractionDoubleInteger :: GHC.Types.Double -> (GHC.Num.Integer.Integer, GHC.Types.Double)
+  properFractionDoubleInteger :: GHC.Types.Double -> (GHC.Internal.Bignum.Integer.Integer, GHC.Types.Double)
   properFractionFloatInt :: GHC.Types.Float -> (GHC.Types.Int, GHC.Types.Float)
-  properFractionFloatInteger :: GHC.Types.Float -> (GHC.Num.Integer.Integer, GHC.Types.Float)
+  properFractionFloatInteger :: GHC.Types.Float -> (GHC.Internal.Bignum.Integer.Integer, GHC.Types.Float)
   roundDoubleInt :: GHC.Types.Double -> GHC.Types.Int
-  roundDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
+  roundDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
   roundFloatInt :: GHC.Types.Float -> GHC.Types.Int
-  roundFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
-  truncateDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
-  truncateFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
+  roundFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
+  truncateDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
+  truncateFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
 
 module GHC.Foreign where
   -- Safety: Safe
@@ -7762,10 +7762,10 @@ module GHC.IO.Device where
     close :: a -> GHC.Types.IO ()
     isTerminal :: a -> GHC.Types.IO GHC.Types.Bool
     isSeekable :: a -> GHC.Types.IO GHC.Types.Bool
-    seek :: a -> SeekMode -> GHC.Num.Integer.Integer -> GHC.Types.IO GHC.Num.Integer.Integer
-    tell :: a -> GHC.Types.IO GHC.Num.Integer.Integer
-    getSize :: a -> GHC.Types.IO GHC.Num.Integer.Integer
-    setSize :: a -> GHC.Num.Integer.Integer -> GHC.Types.IO ()
+    seek :: a -> SeekMode -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
+    tell :: a -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
+    getSize :: a -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
+    setSize :: a -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO ()
     setEcho :: a -> GHC.Types.Bool -> GHC.Types.IO ()
     getEcho :: a -> GHC.Types.IO GHC.Types.Bool
     setRaw :: a -> GHC.Types.Bool -> GHC.Types.IO ()
@@ -8014,7 +8014,7 @@ module GHC.IO.Handle where
   type Handle :: *
   data Handle = ...
   type HandlePosition :: *
-  type HandlePosition = GHC.Num.Integer.Integer
+  type HandlePosition = GHC.Internal.Bignum.Integer.Integer
   type HandlePosn :: *
   data HandlePosn = HandlePosn Handle HandlePosition
   type LockMode :: *
@@ -8029,7 +8029,7 @@ module GHC.IO.Handle where
   hClose_help :: GHC.Internal.IO.Handle.Types.Handle__ -> GHC.Types.IO (GHC.Internal.IO.Handle.Types.Handle__, GHC.Internal.Maybe.Maybe GHC.Internal.Exception.Type.SomeException)
   hDuplicate :: Handle -> GHC.Types.IO Handle
   hDuplicateTo :: Handle -> Handle -> GHC.Types.IO ()
-  hFileSize :: Handle -> GHC.Types.IO GHC.Num.Integer.Integer
+  hFileSize :: Handle -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
   hFlush :: Handle -> GHC.Types.IO ()
   hFlushAll :: Handle -> GHC.Types.IO ()
   hGetBuf :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Int
@@ -8055,16 +8055,16 @@ module GHC.IO.Handle where
   hPutBufNonBlocking :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Int
   hPutChar :: Handle -> GHC.Types.Char -> GHC.Types.IO ()
   hPutStr :: Handle -> GHC.Internal.Base.String -> GHC.Types.IO ()
-  hSeek :: Handle -> SeekMode -> GHC.Num.Integer.Integer -> GHC.Types.IO ()
+  hSeek :: Handle -> SeekMode -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO ()
   hSetBinaryMode :: Handle -> GHC.Types.Bool -> GHC.Types.IO ()
   hSetBuffering :: Handle -> BufferMode -> GHC.Types.IO ()
   hSetEcho :: Handle -> GHC.Types.Bool -> GHC.Types.IO ()
   hSetEncoding :: Handle -> GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Types.IO ()
-  hSetFileSize :: Handle -> GHC.Num.Integer.Integer -> GHC.Types.IO ()
+  hSetFileSize :: Handle -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO ()
   hSetNewlineMode :: Handle -> NewlineMode -> GHC.Types.IO ()
   hSetPosn :: HandlePosn -> GHC.Types.IO ()
   hShow :: Handle -> GHC.Types.IO GHC.Internal.Base.String
-  hTell :: Handle -> GHC.Types.IO GHC.Num.Integer.Integer
+  hTell :: Handle -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
   hTryLock :: Handle -> LockMode -> GHC.Types.IO GHC.Types.Bool
   hWaitForInput :: Handle -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Bool
   isEOF :: GHC.Types.IO GHC.Types.Bool
@@ -8452,8 +8452,8 @@ module GHC.Integer where
 
 module GHC.Integer.Logarithms where
   -- Safety: None
-  integerLog2# :: GHC.Num.Integer.Integer -> GHC.Prim.Int#
-  integerLogBase# :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> GHC.Prim.Int#
+  integerLog2# :: GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int#
+  integerLogBase# :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int#
   wordLog2# :: GHC.Prim.Word# -> GHC.Prim.Int#
 
 module GHC.IsList where
@@ -8568,7 +8568,7 @@ module GHC.Maybe where
 module GHC.Natural where
   -- Safety: Safe
   type BigNat :: *
-  data BigNat = BN# {unBigNat :: GHC.Num.BigNat.BigNat#}
+  data BigNat = BN# {unBigNat :: GHC.Internal.Bignum.BigNat.BigNat#}
   pattern NatJ# :: BigNat -> Natural
   pattern NatS# :: GHC.Prim.Word# -> Natural
   type Natural :: *
@@ -8581,8 +8581,8 @@ module GHC.Natural where
   minusNatural :: Natural -> Natural -> Natural
   minusNaturalMaybe :: Natural -> Natural -> GHC.Internal.Maybe.Maybe Natural
   mkNatural :: [GHC.Types.Word] -> Natural
-  naturalFromInteger :: GHC.Num.Integer.Integer -> Natural
-  naturalToInteger :: Natural -> GHC.Num.Integer.Integer
+  naturalFromInteger :: GHC.Internal.Bignum.Integer.Integer -> Natural
+  naturalToInteger :: Natural -> GHC.Internal.Bignum.Integer.Integer
   naturalToWord :: Natural -> GHC.Types.Word
   naturalToWordMaybe :: Natural -> GHC.Internal.Maybe.Maybe GHC.Types.Word
   negateNatural :: Natural -> Natural
@@ -8624,7 +8624,7 @@ module GHC.Num where
   integerBit :: GHC.Types.Word -> Integer
   integerBit# :: GHC.Prim.Word# -> Integer
   integerCheck :: Integer -> GHC.Types.Bool
-  integerCheck# :: Integer -> GHC.Num.Primitives.Bool#
+  integerCheck# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerCompare :: Integer -> Integer -> GHC.Types.Ordering
   integerComplement :: Integer -> Integer
   integerDecodeDouble# :: GHC.Prim.Double# -> (# Integer, GHC.Prim.Int# #)
@@ -8635,14 +8635,14 @@ module GHC.Num where
   integerEncodeDouble# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Double#
   integerEncodeFloat# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Float#
   integerEq :: Integer -> Integer -> GHC.Types.Bool
-  integerEq# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
-  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Integer
-  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
-  integerFromBigNat# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatNeg# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Num.BigNat.BigNat# -> Integer
-  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> Integer
-  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerEq# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
+  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Integer
+  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatNeg# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> Integer
+  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
   integerFromInt :: GHC.Types.Int -> Integer
   integerFromInt# :: GHC.Prim.Int# -> Integer
   integerFromInt64# :: GHC.Prim.Int64# -> Integer
@@ -8657,17 +8657,17 @@ module GHC.Num where
   integerGcde :: Integer -> Integer -> (Integer, Integer, Integer)
   integerGcde# :: Integer -> Integer -> (# Integer, Integer, Integer #)
   integerGe :: Integer -> Integer -> GHC.Types.Bool
-  integerGe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerGt :: Integer -> Integer -> GHC.Types.Bool
-  integerGt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsNegative :: Integer -> GHC.Types.Bool
-  integerIsNegative# :: Integer -> GHC.Num.Primitives.Bool#
+  integerIsNegative# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsOne :: Integer -> GHC.Types.Bool
   integerIsPowerOf2# :: Integer -> (# (# #) | GHC.Prim.Word# #)
   integerIsZero :: Integer -> GHC.Types.Bool
   integerLcm :: Integer -> Integer -> Integer
   integerLe :: Integer -> Integer -> GHC.Types.Bool
-  integerLe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerLog2 :: Integer -> GHC.Types.Word
   integerLog2# :: Integer -> GHC.Prim.Word#
   integerLogBase :: Integer -> Integer -> GHC.Types.Word
@@ -8675,11 +8675,11 @@ module GHC.Num where
   integerLogBaseWord :: GHC.Types.Word -> Integer -> GHC.Types.Word
   integerLogBaseWord# :: GHC.Prim.Word# -> Integer -> GHC.Prim.Word#
   integerLt :: Integer -> Integer -> GHC.Types.Bool
-  integerLt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerMod :: Integer -> Integer -> Integer
   integerMul :: Integer -> Integer -> Integer
   integerNe :: Integer -> Integer -> GHC.Types.Bool
-  integerNe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerNe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerNegate :: Integer -> Integer
   integerOne :: Integer
   integerOr :: Integer -> Integer -> Integer
@@ -8700,16 +8700,16 @@ module GHC.Num where
   integerSqr :: Integer -> Integer
   integerSub :: Integer -> Integer -> Integer
   integerTestBit :: Integer -> GHC.Types.Word -> GHC.Types.Bool
-  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  integerToBigNatClamp# :: Integer -> GHC.Num.BigNat.BigNat#
-  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Num.BigNat.BigNat# #)
+  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToBigNatClamp# :: Integer -> GHC.Internal.Bignum.BigNat.BigNat#
+  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Internal.Bignum.BigNat.BigNat# #)
   integerToInt :: Integer -> GHC.Types.Int
   integerToInt# :: Integer -> GHC.Prim.Int#
   integerToInt64# :: Integer -> GHC.Prim.Int64#
-  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   integerToNatural :: Integer -> Natural
   integerToNaturalClamp :: Integer -> Natural
   integerToNaturalThrow :: Integer -> Natural
@@ -8724,7 +8724,7 @@ module GHC.Num where
   naturalBit :: GHC.Types.Word -> Natural
   naturalBit# :: GHC.Prim.Word# -> Natural
   naturalCheck :: Natural -> GHC.Types.Bool
-  naturalCheck# :: Natural -> GHC.Num.Primitives.Bool#
+  naturalCheck# :: Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalClearBit :: Natural -> GHC.Types.Word -> Natural
   naturalClearBit# :: Natural -> GHC.Prim.Word# -> Natural
   naturalCompare :: Natural -> Natural -> GHC.Types.Ordering
@@ -8733,26 +8733,26 @@ module GHC.Num where
   naturalEncodeDouble# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Double#
   naturalEncodeFloat# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Float#
   naturalEq :: Natural -> Natural -> GHC.Types.Bool
-  naturalEq# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
-  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Natural
-  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
-  naturalFromBigNat# :: GHC.Num.BigNat.BigNat# -> Natural
-  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalEq# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Natural
+  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Natural
+  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
   naturalFromWord :: GHC.Types.Word -> Natural
   naturalFromWord# :: GHC.Prim.Word# -> Natural
   naturalFromWord2# :: GHC.Prim.Word# -> GHC.Prim.Word# -> Natural
   naturalFromWordList :: [GHC.Types.Word] -> Natural
   naturalGcd :: Natural -> Natural -> Natural
   naturalGe :: Natural -> Natural -> GHC.Types.Bool
-  naturalGe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalGt :: Natural -> Natural -> GHC.Types.Bool
-  naturalGt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalIsOne :: Natural -> GHC.Types.Bool
   naturalIsPowerOf2# :: Natural -> (# (# #) | GHC.Prim.Word# #)
   naturalIsZero :: Natural -> GHC.Types.Bool
   naturalLcm :: Natural -> Natural -> Natural
   naturalLe :: Natural -> Natural -> GHC.Types.Bool
-  naturalLe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalLog2 :: Natural -> GHC.Types.Word
   naturalLog2# :: Natural -> GHC.Prim.Word#
   naturalLogBase :: Natural -> Natural -> GHC.Types.Word
@@ -8760,10 +8760,10 @@ module GHC.Num where
   naturalLogBaseWord :: GHC.Types.Word -> Natural -> GHC.Types.Word
   naturalLogBaseWord# :: GHC.Prim.Word# -> Natural -> GHC.Prim.Word#
   naturalLt :: Natural -> Natural -> GHC.Types.Bool
-  naturalLt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalMul :: Natural -> Natural -> Natural
   naturalNe :: Natural -> Natural -> GHC.Types.Bool
-  naturalNe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalNe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalNegate :: Natural -> Natural
   naturalOne :: Natural
   naturalOr :: Natural -> Natural -> Natural
@@ -8787,11 +8787,11 @@ module GHC.Num where
   naturalSubThrow :: Natural -> Natural -> Natural
   naturalSubUnsafe :: Natural -> Natural -> Natural
   naturalTestBit :: Natural -> GHC.Types.Word -> GHC.Types.Bool
-  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  naturalToBigNat# :: Natural -> GHC.Num.BigNat.BigNat#
-  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalToBigNat# :: Natural -> GHC.Internal.Bignum.BigNat.BigNat#
+  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   naturalToWord :: Natural -> GHC.Types.Word
   naturalToWord# :: Natural -> GHC.Prim.Word#
   naturalToWordClamp :: Natural -> GHC.Types.Word
@@ -8807,7 +8807,7 @@ module GHC.Num.BigNat where
   type BigNat :: *
   data BigNat = BN# {unBigNat :: BigNat#}
   type BigNat# :: GHC.Types.UnliftedType
-  type BigNat# = GHC.Num.WordArray.WordArray#
+  type BigNat# = GHC.Internal.Bignum.WordArray.WordArray#
   bigNatAdd :: BigNat# -> BigNat# -> BigNat#
   bigNatAddWord :: BigNat# -> GHC.Types.Word -> BigNat#
   bigNatAddWord# :: BigNat# -> GHC.Prim.Word# -> BigNat#
@@ -8819,7 +8819,7 @@ module GHC.Num.BigNat where
   bigNatBit :: GHC.Types.Word -> BigNat#
   bigNatBit# :: GHC.Prim.Word# -> BigNat#
   bigNatCheck :: BigNat# -> GHC.Types.Bool
-  bigNatCheck# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatCheck# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatClearBit# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatCompare :: BigNat# -> BigNat# -> GHC.Types.Ordering
   bigNatCompareWord :: BigNat# -> GHC.Types.Word -> GHC.Types.Ordering
@@ -8831,48 +8831,48 @@ module GHC.Num.BigNat where
   bigNatCtzWord# :: BigNat# -> GHC.Prim.Word#
   bigNatEncodeDouble# :: BigNat# -> GHC.Prim.Int# -> GHC.Prim.Double#
   bigNatEq :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatEq# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
-  bigNatEqWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
+  bigNatEq# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
+  bigNatEqWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatFromAbsInt# :: GHC.Prim.Int# -> BigNat#
-  bigNatFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
+  bigNatFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromAddrBE# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromAddrLE# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
-  bigNatFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
+  bigNatFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromByteArrayBE# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromByteArrayLE# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromWord :: GHC.Types.Word -> BigNat#
   bigNatFromWord# :: GHC.Prim.Word# -> BigNat#
   bigNatFromWord2# :: GHC.Prim.Word# -> GHC.Prim.Word# -> BigNat#
   bigNatFromWord64# :: GHC.Prim.Word64# -> BigNat#
-  bigNatFromWordArray :: GHC.Num.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat
-  bigNatFromWordArray# :: GHC.Num.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat#
+  bigNatFromWordArray :: GHC.Internal.Bignum.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat
+  bigNatFromWordArray# :: GHC.Internal.Bignum.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat#
   bigNatFromWordList :: [GHC.Types.Word] -> BigNat#
-  bigNatFromWordList# :: [GHC.Types.Word] -> GHC.Num.WordArray.WordArray#
+  bigNatFromWordList# :: [GHC.Types.Word] -> GHC.Internal.Bignum.WordArray.WordArray#
   bigNatFromWordListUnsafe :: [GHC.Types.Word] -> BigNat#
   bigNatGcd :: BigNat# -> BigNat# -> BigNat#
   bigNatGcdWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Prim.Word#
   bigNatGe :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatGe# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatGe# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatGt :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatGt# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatGt# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatGtWord :: BigNat# -> GHC.Types.Word -> GHC.Types.Bool
-  bigNatGtWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
+  bigNatGtWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatIndex :: BigNat# -> GHC.Prim.Int# -> GHC.Types.Word
   bigNatIndex# :: BigNat# -> GHC.Prim.Int# -> GHC.Prim.Word#
   bigNatIsOne :: BigNat# -> GHC.Types.Bool
-  bigNatIsOne# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatIsOne# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatIsPowerOf2# :: BigNat# -> (# (# #) | GHC.Prim.Word# #)
   bigNatIsTwo :: BigNat# -> GHC.Types.Bool
-  bigNatIsTwo# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatIsTwo# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatIsZero :: BigNat# -> GHC.Types.Bool
-  bigNatIsZero# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatIsZero# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatLcm :: BigNat# -> BigNat# -> BigNat#
   bigNatLcmWord# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatLcmWordWord# :: GHC.Prim.Word# -> GHC.Prim.Word# -> BigNat#
   bigNatLe :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatLe# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatLe# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatLeWord :: BigNat# -> GHC.Types.Word -> GHC.Types.Bool
-  bigNatLeWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
+  bigNatLeWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatLog2 :: BigNat# -> GHC.Types.Word
   bigNatLog2# :: BigNat# -> GHC.Prim.Word#
   bigNatLogBase :: BigNat# -> BigNat# -> GHC.Types.Word
@@ -8880,12 +8880,12 @@ module GHC.Num.BigNat where
   bigNatLogBaseWord :: GHC.Types.Word -> BigNat# -> GHC.Types.Word
   bigNatLogBaseWord# :: GHC.Prim.Word# -> BigNat# -> GHC.Prim.Word#
   bigNatLt :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatLt# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatLt# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatMul :: BigNat# -> BigNat# -> BigNat#
   bigNatMulWord :: BigNat# -> GHC.Types.Word -> BigNat#
   bigNatMulWord# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatNe :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatNe# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatNe# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatOne :: BigNat
   bigNatOne# :: (# #) -> BigNat#
   bigNatOr :: BigNat# -> BigNat# -> BigNat#
@@ -8919,14 +8919,14 @@ module GHC.Num.BigNat where
   bigNatSubWordUnsafe :: BigNat# -> GHC.Types.Word -> BigNat#
   bigNatSubWordUnsafe# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatTestBit :: BigNat# -> GHC.Types.Word -> GHC.Types.Bool
-  bigNatTestBit# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  bigNatToAddr :: BigNat# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  bigNatToAddr# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  bigNatTestBit# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  bigNatToAddr :: BigNat# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  bigNatToAddr# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToAddrBE# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToAddrLE# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToInt :: BigNat# -> GHC.Types.Int
   bigNatToInt# :: BigNat# -> GHC.Prim.Int#
-  bigNatToMutableByteArray# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  bigNatToMutableByteArray# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToMutableByteArrayBE# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToMutableByteArrayLE# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToWord :: BigNat# -> GHC.Types.Word
@@ -8955,7 +8955,7 @@ module GHC.Num.Integer where
   integerBit :: GHC.Types.Word -> Integer
   integerBit# :: GHC.Prim.Word# -> Integer
   integerCheck :: Integer -> GHC.Types.Bool
-  integerCheck# :: Integer -> GHC.Num.Primitives.Bool#
+  integerCheck# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerCompare :: Integer -> Integer -> GHC.Types.Ordering
   integerComplement :: Integer -> Integer
   integerDecodeDouble# :: GHC.Prim.Double# -> (# Integer, GHC.Prim.Int# #)
@@ -8966,18 +8966,18 @@ module GHC.Num.Integer where
   integerEncodeDouble# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Double#
   integerEncodeFloat# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Float#
   integerEq :: Integer -> Integer -> GHC.Types.Bool
-  integerEq# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
-  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Integer
-  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
-  integerFromBigNat# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatNeg# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Num.BigNat.BigNat# -> Integer
-  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> Integer
-  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerEq# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
+  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Integer
+  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatNeg# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> Integer
+  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
   integerFromInt :: GHC.Types.Int -> Integer
   integerFromInt# :: GHC.Prim.Int# -> Integer
   integerFromInt64# :: GHC.Prim.Int64# -> Integer
-  integerFromNatural :: GHC.Num.Natural.Natural -> Integer
+  integerFromNatural :: GHC.Internal.Bignum.Natural.Natural -> Integer
   integerFromWord :: GHC.Types.Word -> Integer
   integerFromWord# :: GHC.Prim.Word# -> Integer
   integerFromWord64# :: GHC.Prim.Word64# -> Integer
@@ -8988,17 +8988,17 @@ module GHC.Num.Integer where
   integerGcde :: Integer -> Integer -> (Integer, Integer, Integer)
   integerGcde# :: Integer -> Integer -> (# Integer, Integer, Integer #)
   integerGe :: Integer -> Integer -> GHC.Types.Bool
-  integerGe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerGt :: Integer -> Integer -> GHC.Types.Bool
-  integerGt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsNegative :: Integer -> GHC.Types.Bool
-  integerIsNegative# :: Integer -> GHC.Num.Primitives.Bool#
+  integerIsNegative# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsOne :: Integer -> GHC.Types.Bool
   integerIsPowerOf2# :: Integer -> (# (# #) | GHC.Prim.Word# #)
   integerIsZero :: Integer -> GHC.Types.Bool
   integerLcm :: Integer -> Integer -> Integer
   integerLe :: Integer -> Integer -> GHC.Types.Bool
-  integerLe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerLog2 :: Integer -> GHC.Types.Word
   integerLog2# :: Integer -> GHC.Prim.Word#
   integerLogBase :: Integer -> Integer -> GHC.Types.Word
@@ -9006,20 +9006,20 @@ module GHC.Num.Integer where
   integerLogBaseWord :: GHC.Types.Word -> Integer -> GHC.Types.Word
   integerLogBaseWord# :: GHC.Prim.Word# -> Integer -> GHC.Prim.Word#
   integerLt :: Integer -> Integer -> GHC.Types.Bool
-  integerLt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerMod :: Integer -> Integer -> Integer
   integerMul :: Integer -> Integer -> Integer
   integerNe :: Integer -> Integer -> GHC.Types.Bool
-  integerNe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerNe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerNegate :: Integer -> Integer
   integerOne :: Integer
   integerOr :: Integer -> Integer -> Integer
   integerPopCount# :: Integer -> GHC.Prim.Int#
-  integerPowMod# :: Integer -> Integer -> GHC.Num.Natural.Natural -> (# GHC.Num.Natural.Natural | () #)
+  integerPowMod# :: Integer -> Integer -> GHC.Internal.Bignum.Natural.Natural -> (# GHC.Internal.Bignum.Natural.Natural | () #)
   integerQuot :: Integer -> Integer -> Integer
   integerQuotRem :: Integer -> Integer -> (Integer, Integer)
   integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #)
-  integerRecipMod# :: Integer -> GHC.Num.Natural.Natural -> (# GHC.Num.Natural.Natural | () #)
+  integerRecipMod# :: Integer -> GHC.Internal.Bignum.Natural.Natural -> (# GHC.Internal.Bignum.Natural.Natural | () #)
   integerRem :: Integer -> Integer -> Integer
   integerShiftL :: Integer -> GHC.Types.Word -> Integer
   integerShiftL# :: Integer -> GHC.Prim.Word# -> Integer
@@ -9031,19 +9031,19 @@ module GHC.Num.Integer where
   integerSqr :: Integer -> Integer
   integerSub :: Integer -> Integer -> Integer
   integerTestBit :: Integer -> GHC.Types.Word -> GHC.Types.Bool
-  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  integerToBigNatClamp# :: Integer -> GHC.Num.BigNat.BigNat#
-  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Num.BigNat.BigNat# #)
+  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToBigNatClamp# :: Integer -> GHC.Internal.Bignum.BigNat.BigNat#
+  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Internal.Bignum.BigNat.BigNat# #)
   integerToInt :: Integer -> GHC.Types.Int
   integerToInt# :: Integer -> GHC.Prim.Int#
   integerToInt64# :: Integer -> GHC.Prim.Int64#
-  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  integerToNatural :: Integer -> GHC.Num.Natural.Natural
-  integerToNaturalClamp :: Integer -> GHC.Num.Natural.Natural
-  integerToNaturalThrow :: Integer -> GHC.Num.Natural.Natural
+  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToNatural :: Integer -> GHC.Internal.Bignum.Natural.Natural
+  integerToNaturalClamp :: Integer -> GHC.Internal.Bignum.Natural.Natural
+  integerToNaturalThrow :: Integer -> GHC.Internal.Bignum.Natural.Natural
   integerToWord :: Integer -> GHC.Types.Word
   integerToWord# :: Integer -> GHC.Prim.Word#
   integerToWord64# :: Integer -> GHC.Prim.Word64#
@@ -9060,7 +9060,7 @@ module GHC.Num.Natural where
   naturalBit :: GHC.Types.Word -> Natural
   naturalBit# :: GHC.Prim.Word# -> Natural
   naturalCheck :: Natural -> GHC.Types.Bool
-  naturalCheck# :: Natural -> GHC.Num.Primitives.Bool#
+  naturalCheck# :: Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalClearBit :: Natural -> GHC.Types.Word -> Natural
   naturalClearBit# :: Natural -> GHC.Prim.Word# -> Natural
   naturalCompare :: Natural -> Natural -> GHC.Types.Ordering
@@ -9069,26 +9069,26 @@ module GHC.Num.Natural where
   naturalEncodeDouble# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Double#
   naturalEncodeFloat# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Float#
   naturalEq :: Natural -> Natural -> GHC.Types.Bool
-  naturalEq# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
-  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Natural
-  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
-  naturalFromBigNat# :: GHC.Num.BigNat.BigNat# -> Natural
-  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalEq# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Natural
+  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Natural
+  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
   naturalFromWord :: GHC.Types.Word -> Natural
   naturalFromWord# :: GHC.Prim.Word# -> Natural
   naturalFromWord2# :: GHC.Prim.Word# -> GHC.Prim.Word# -> Natural
   naturalFromWordList :: [GHC.Types.Word] -> Natural
   naturalGcd :: Natural -> Natural -> Natural
   naturalGe :: Natural -> Natural -> GHC.Types.Bool
-  naturalGe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalGt :: Natural -> Natural -> GHC.Types.Bool
-  naturalGt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalIsOne :: Natural -> GHC.Types.Bool
   naturalIsPowerOf2# :: Natural -> (# (# #) | GHC.Prim.Word# #)
   naturalIsZero :: Natural -> GHC.Types.Bool
   naturalLcm :: Natural -> Natural -> Natural
   naturalLe :: Natural -> Natural -> GHC.Types.Bool
-  naturalLe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalLog2 :: Natural -> GHC.Types.Word
   naturalLog2# :: Natural -> GHC.Prim.Word#
   naturalLogBase :: Natural -> Natural -> GHC.Types.Word
@@ -9096,10 +9096,10 @@ module GHC.Num.Natural where
   naturalLogBaseWord :: GHC.Types.Word -> Natural -> GHC.Types.Word
   naturalLogBaseWord# :: GHC.Prim.Word# -> Natural -> GHC.Prim.Word#
   naturalLt :: Natural -> Natural -> GHC.Types.Bool
-  naturalLt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalMul :: Natural -> Natural -> Natural
   naturalNe :: Natural -> Natural -> GHC.Types.Bool
-  naturalNe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalNe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalNegate :: Natural -> Natural
   naturalOne :: Natural
   naturalOr :: Natural -> Natural -> Natural
@@ -9123,11 +9123,11 @@ module GHC.Num.Natural where
   naturalSubThrow :: Natural -> Natural -> Natural
   naturalSubUnsafe :: Natural -> Natural -> Natural
   naturalTestBit :: Natural -> GHC.Types.Word -> GHC.Types.Bool
-  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  naturalToBigNat# :: Natural -> GHC.Num.BigNat.BigNat#
-  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalToBigNat# :: Natural -> GHC.Internal.Bignum.BigNat.BigNat#
+  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   naturalToWord :: Natural -> GHC.Types.Word
   naturalToWord# :: Natural -> GHC.Prim.Word#
   naturalToWordClamp :: Natural -> GHC.Types.Word
@@ -9434,12 +9434,12 @@ module GHC.Real where
     mod :: a -> a -> a
     quotRem :: a -> a -> (a, a)
     divMod :: a -> a -> (a, a)
-    toInteger :: a -> GHC.Num.Integer.Integer
+    toInteger :: a -> GHC.Internal.Bignum.Integer.Integer
     {-# MINIMAL quotRem, toInteger #-}
   type Ratio :: * -> *
   data Ratio a = !a :% !a
   type Rational :: *
-  type Rational = Ratio GHC.Num.Integer.Integer
+  type Rational = Ratio GHC.Internal.Bignum.Integer.Integer
   type Real :: * -> Constraint
   class (GHC.Internal.Num.Num a, GHC.Classes.Ord a) => Real a where
     toRational :: a -> Rational
@@ -9467,9 +9467,9 @@ module GHC.Real where
   integralEnumFromThenTo :: forall a. Integral a => a -> a -> a -> [a]
   integralEnumFromTo :: forall a. Integral a => a -> a -> [a]
   lcm :: forall a. Integral a => a -> a -> a
-  mkRationalBase10 :: Rational -> GHC.Num.Integer.Integer -> Rational
-  mkRationalBase2 :: Rational -> GHC.Num.Integer.Integer -> Rational
-  mkRationalWithExponentBase :: Rational -> GHC.Num.Integer.Integer -> FractionalExponentBase -> Rational
+  mkRationalBase10 :: Rational -> GHC.Internal.Bignum.Integer.Integer -> Rational
+  mkRationalBase2 :: Rational -> GHC.Internal.Bignum.Integer.Integer -> Rational
+  mkRationalWithExponentBase :: Rational -> GHC.Internal.Bignum.Integer.Integer -> FractionalExponentBase -> Rational
   notANumber :: Rational
   numerator :: forall a. Ratio a -> a
   numericEnumFrom :: forall a. Fractional a => a -> [a]
@@ -9879,15 +9879,15 @@ module GHC.TypeLits where
   decideNat :: forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *) (proxy2 :: Nat -> *). (KnownNat a, KnownNat b) => proxy1 a -> proxy2 b -> GHC.Internal.Data.Either.Either ((a GHC.Internal.Data.Type.Equality.:~: b) -> GHC.Internal.Base.Void) (a GHC.Internal.Data.Type.Equality.:~: b)
   decideSymbol :: forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *) (proxy2 :: Symbol -> *). (KnownSymbol a, KnownSymbol b) => proxy1 a -> proxy2 b -> GHC.Internal.Data.Either.Either ((a GHC.Internal.Data.Type.Equality.:~: b) -> GHC.Internal.Base.Void) (a GHC.Internal.Data.Type.Equality.:~: b)
   fromSChar :: forall (c :: GHC.Types.Char). SChar c -> GHC.Types.Char
-  fromSNat :: forall (n :: Nat). SNat n -> GHC.Num.Integer.Integer
+  fromSNat :: forall (n :: Nat). SNat n -> GHC.Internal.Bignum.Integer.Integer
   fromSSymbol :: forall (s :: Symbol). SSymbol s -> GHC.Internal.Base.String
-  natVal :: forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> GHC.Num.Integer.Integer
-  natVal' :: forall (n :: Nat). KnownNat n => GHC.Prim.Proxy# n -> GHC.Num.Integer.Integer
+  natVal :: forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> GHC.Internal.Bignum.Integer.Integer
+  natVal' :: forall (n :: Nat). KnownNat n => GHC.Prim.Proxy# n -> GHC.Internal.Bignum.Integer.Integer
   sameChar :: forall (a :: GHC.Types.Char) (b :: GHC.Types.Char) (proxy1 :: GHC.Types.Char -> *) (proxy2 :: GHC.Types.Char -> *). (KnownChar a, KnownChar b) => proxy1 a -> proxy2 b -> GHC.Internal.Maybe.Maybe (a GHC.Internal.Data.Type.Equality.:~: b)
   sameNat :: forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *) (proxy2 :: Nat -> *). (KnownNat a, KnownNat b) => proxy1 a -> proxy2 b -> GHC.Internal.Maybe.Maybe (a GHC.Internal.Data.Type.Equality.:~: b)
   sameSymbol :: forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *) (proxy2 :: Symbol -> *). (KnownSymbol a, KnownSymbol b) => proxy1 a -> proxy2 b -> GHC.Internal.Maybe.Maybe (a GHC.Internal.Data.Type.Equality.:~: b)
   someCharVal :: GHC.Types.Char -> SomeChar
-  someNatVal :: GHC.Num.Integer.Integer -> GHC.Internal.Maybe.Maybe SomeNat
+  someNatVal :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Maybe.Maybe SomeNat
   someSymbolVal :: GHC.Internal.Base.String -> SomeSymbol
   symbolVal :: forall (n :: Symbol) (proxy :: Symbol -> *). KnownSymbol n => proxy n -> GHC.Internal.Base.String
   symbolVal' :: forall (n :: Symbol). KnownSymbol n => GHC.Prim.Proxy# n -> GHC.Internal.Base.String
@@ -9895,7 +9895,7 @@ module GHC.TypeLits where
   withKnownNat :: forall (n :: Nat) (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). SNat n -> (KnownNat n => r) -> r
   withKnownSymbol :: forall (s :: Symbol) (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). SSymbol s -> (KnownSymbol s => r) -> r
   withSomeSChar :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Types.Char -> (forall (c :: GHC.Types.Char). SChar c -> r) -> r
-  withSomeSNat :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Num.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
+  withSomeSNat :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Bignum.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
   withSomeSSymbol :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Base.String -> (forall (s :: Symbol). SSymbol s -> r) -> r
 
 module GHC.TypeLits.Internal where
@@ -10147,7 +10147,7 @@ module Numeric where
     log1pexp :: a -> a
     log1mexp :: a -> a
     {-# MINIMAL pi, exp, log, sin, cos, asin, acos, atan, sinh, cosh, asinh, acosh, atanh #-}
-  floatToDigits :: forall a. GHC.Internal.Float.RealFloat a => GHC.Num.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
+  floatToDigits :: forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Bignum.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
   fromRat :: forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Rational -> a
   lexDigits :: GHC.Internal.Text.ParserCombinators.ReadP.ReadS GHC.Internal.Base.String
   readBin :: forall a. (GHC.Classes.Eq a, GHC.Internal.Num.Num a) => GHC.Internal.Text.ParserCombinators.ReadP.ReadS a
@@ -10500,8 +10500,8 @@ module Prelude where
 
 module System.CPUTime where
   -- Safety: Trustworthy
-  cpuTimePrecision :: GHC.Num.Integer.Integer
-  getCPUTime :: GHC.Types.IO GHC.Num.Integer.Integer
+  cpuTimePrecision :: GHC.Internal.Bignum.Integer.Integer
+  getCPUTime :: GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
 
 module System.Console.GetOpt where
   -- Safety: Safe
@@ -10581,7 +10581,7 @@ module System.IO where
   getContents' :: IO GHC.Internal.Base.String
   getLine :: IO GHC.Internal.Base.String
   hClose :: Handle -> IO ()
-  hFileSize :: Handle -> IO GHC.Num.Integer.Integer
+  hFileSize :: Handle -> IO GHC.Internal.Bignum.Integer.Integer
   hFlush :: Handle -> IO ()
   hGetBuf :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> IO GHC.Types.Int
   hGetBufNonBlocking :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> IO GHC.Types.Int
@@ -10609,16 +10609,16 @@ module System.IO where
   hPutStr :: Handle -> GHC.Internal.Base.String -> IO ()
   hPutStrLn :: Handle -> GHC.Internal.Base.String -> IO ()
   hReady :: Handle -> IO GHC.Types.Bool
-  hSeek :: Handle -> SeekMode -> GHC.Num.Integer.Integer -> IO ()
+  hSeek :: Handle -> SeekMode -> GHC.Internal.Bignum.Integer.Integer -> IO ()
   hSetBinaryMode :: Handle -> GHC.Types.Bool -> IO ()
   hSetBuffering :: Handle -> BufferMode -> IO ()
   hSetEcho :: Handle -> GHC.Types.Bool -> IO ()
   hSetEncoding :: Handle -> TextEncoding -> IO ()
-  hSetFileSize :: Handle -> GHC.Num.Integer.Integer -> IO ()
+  hSetFileSize :: Handle -> GHC.Internal.Bignum.Integer.Integer -> IO ()
   hSetNewlineMode :: Handle -> NewlineMode -> IO ()
   hSetPosn :: HandlePosn -> IO ()
   hShow :: Handle -> IO GHC.Internal.Base.String
-  hTell :: Handle -> IO GHC.Num.Integer.Integer
+  hTell :: Handle -> IO GHC.Internal.Bignum.Integer.Integer
   hWaitForInput :: Handle -> GHC.Types.Int -> IO GHC.Types.Bool
   interact :: (GHC.Internal.Base.String -> GHC.Internal.Base.String) -> IO ()
   isEOF :: IO GHC.Types.Bool
@@ -10832,7 +10832,7 @@ module System.Posix.Internals where
   const_vmin :: GHC.Internal.Foreign.C.Types.CInt
   const_vtime :: GHC.Internal.Foreign.C.Types.CInt
   dEFAULT_BUFFER_SIZE :: GHC.Types.Int
-  fdFileSize :: FD -> GHC.Types.IO GHC.Num.Integer.Integer
+  fdFileSize :: FD -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
   fdGetMode :: FD -> GHC.Types.IO GHC.Internal.IO.IOMode.IOMode
   fdStat :: FD -> GHC.Types.IO (GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
   fdType :: FD -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
@@ -10994,7 +10994,7 @@ module Text.Printf where
   errorShortFormat :: forall a. a
   formatChar :: GHC.Types.Char -> FieldFormatter
   formatInt :: forall a. (GHC.Internal.Real.Integral a, GHC.Internal.Enum.Bounded a) => a -> FieldFormatter
-  formatInteger :: GHC.Num.Integer.Integer -> FieldFormatter
+  formatInteger :: GHC.Internal.Bignum.Integer.Integer -> FieldFormatter
   formatRealFloat :: forall a. GHC.Internal.Float.RealFloat a => a -> FieldFormatter
   formatString :: forall a. IsChar a => [a] -> FieldFormatter
   hPrintf :: forall r. HPrintfType r => GHC.Internal.IO.Handle.Types.Handle -> GHC.Internal.Base.String -> r
@@ -11056,8 +11056,8 @@ module Text.Read.Lex where
   isSymbolChar :: GHC.Types.Char -> GHC.Types.Bool
   lex :: GHC.Internal.Text.ParserCombinators.ReadP.ReadP Lexeme
   lexChar :: GHC.Internal.Text.ParserCombinators.ReadP.ReadP GHC.Types.Char
-  numberToFixed :: GHC.Num.Integer.Integer -> Number -> GHC.Internal.Maybe.Maybe (GHC.Num.Integer.Integer, GHC.Num.Integer.Integer)
-  numberToInteger :: Number -> GHC.Internal.Maybe.Maybe GHC.Num.Integer.Integer
+  numberToFixed :: GHC.Internal.Bignum.Integer.Integer -> Number -> GHC.Internal.Maybe.Maybe (GHC.Internal.Bignum.Integer.Integer, GHC.Internal.Bignum.Integer.Integer)
+  numberToInteger :: Number -> GHC.Internal.Maybe.Maybe GHC.Internal.Bignum.Integer.Integer
   numberToRangedRational :: (GHC.Types.Int, GHC.Types.Int) -> Number -> GHC.Internal.Maybe.Maybe GHC.Internal.Real.Rational
   numberToRational :: Number -> GHC.Internal.Real.Rational
   readBinP :: forall a. (GHC.Classes.Eq a, GHC.Internal.Num.Num a) => GHC.Internal.Text.ParserCombinators.ReadP.ReadP a
@@ -11293,9 +11293,9 @@ instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int16 -- Defined in ‘Te
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int32 -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int64 -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int8 -- Defined in ‘Text.Printf’
-instance [safe] Text.Printf.PrintfArg GHC.Num.Integer.Integer -- Defined in ‘Text.Printf’
+instance [safe] Text.Printf.PrintfArg GHC.Internal.Bignum.Integer.Integer -- Defined in ‘Text.Printf’
 instance [safe] forall c. Text.Printf.IsChar c => Text.Printf.PrintfArg [c] -- Defined in ‘Text.Printf’
-instance [safe] Text.Printf.PrintfArg GHC.Num.Natural.Natural -- Defined in ‘Text.Printf’
+instance [safe] Text.Printf.PrintfArg GHC.Internal.Bignum.Natural.Natural -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Types.Word -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Word.Word16 -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Word.Word32 -- Defined in ‘Text.Printf’
@@ -11545,8 +11545,8 @@ instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Bits.Bits (GHC.Inter
 instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Bits.Bits (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance GHC.Internal.Bits.Bits GHC.Types.Bool -- Defined in ‘GHC.Internal.Bits’
 instance GHC.Internal.Bits.Bits GHC.Types.Int -- Defined in ‘GHC.Internal.Bits’
-instance GHC.Internal.Bits.Bits GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Bits’
-instance GHC.Internal.Bits.Bits GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Bits’
+instance GHC.Internal.Bits.Bits GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Bits’
+instance GHC.Internal.Bits.Bits GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bits’
 instance GHC.Internal.Bits.Bits GHC.Types.Word -- Defined in ‘GHC.Internal.Bits’
 instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Bits.Bits (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.Functor.Identity’
 instance GHC.Internal.Bits.Bits GHC.Internal.Int.Int16 -- Defined in ‘GHC.Internal.Int’
@@ -11702,11 +11702,11 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Int.Int32 -- Defined in ‘GHC
 instance GHC.Internal.Data.Data.Data GHC.Internal.Int.Int64 -- Defined in ‘GHC.Internal.Data.Data’
 instance GHC.Internal.Data.Data.Data GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.Data.Data’
 instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Data.Data’
-instance GHC.Internal.Data.Data.Data GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Data.Data’
+instance GHC.Internal.Data.Data.Data GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Monoid.Last a) -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data [a] -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.Data.Data’
-instance GHC.Internal.Data.Data.Data GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Data.Data’
+instance GHC.Internal.Data.Data.Data GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Data.Data’
 instance GHC.Internal.Data.Data.Data GHC.Types.Ordering -- Defined in ‘GHC.Internal.Data.Data’
 instance forall p. GHC.Internal.Data.Data.Data p => GHC.Internal.Data.Data.Data (GHC.Internal.Generics.Par1 p) -- Defined in ‘GHC.Internal.Data.Data’
@@ -11893,9 +11893,9 @@ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Inter
 instance GHC.Internal.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Internal.Enum’
-instance GHC.Internal.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Enum GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Internal.Enum’
-instance GHC.Internal.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Enum GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Internal.Enum’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (Solo a) -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum () -- Defined in ‘GHC.Internal.Enum’
@@ -12252,8 +12252,8 @@ instance GHC.Internal.Ix.Ix GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.
 instance GHC.Internal.Ix.Ix GHC.Types.Bool -- Defined in ‘GHC.Internal.Ix’
 instance GHC.Internal.Ix.Ix GHC.Types.Char -- Defined in ‘GHC.Internal.Ix’
 instance GHC.Internal.Ix.Ix GHC.Types.Int -- Defined in ‘GHC.Internal.Ix’
-instance GHC.Internal.Ix.Ix GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Ix’
-instance GHC.Internal.Ix.Ix GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Ix’
+instance GHC.Internal.Ix.Ix GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Ix’
+instance GHC.Internal.Ix.Ix GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Ix’
 instance GHC.Internal.Ix.Ix GHC.Types.Ordering -- Defined in ‘GHC.Internal.Ix’
 instance forall a. GHC.Internal.Ix.Ix a => GHC.Internal.Ix.Ix (Solo a) -- Defined in ‘GHC.Internal.Ix’
 instance forall a1 a2 a3 a4 a5 a6 a7 a8 a9 aA. (GHC.Internal.Ix.Ix a1, GHC.Internal.Ix.Ix a2, GHC.Internal.Ix.Ix a3, GHC.Internal.Ix.Ix a4, GHC.Internal.Ix.Ix a5, GHC.Internal.Ix.Ix a6, GHC.Internal.Ix.Ix a7, GHC.Internal.Ix.Ix a8, GHC.Internal.Ix.Ix a9, GHC.Internal.Ix.Ix aA) => GHC.Internal.Ix.Ix (a1, a2, a3, a4, a5, a6, a7, a8, a9, aA) -- Defined in ‘GHC.Internal.Ix’
@@ -12358,8 +12358,8 @@ instance GHC.Internal.Num.Num GHC.Internal.Foreign.C.Types.CWchar -- Defined in
 instance GHC.Internal.Num.Num GHC.Types.Double -- Defined in ‘GHC.Internal.Float’
 instance GHC.Internal.Num.Num GHC.Types.Float -- Defined in ‘GHC.Internal.Float’
 instance GHC.Internal.Num.Num GHC.Types.Int -- Defined in ‘GHC.Internal.Num’
-instance GHC.Internal.Num.Num GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Num’
-instance GHC.Internal.Num.Num GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Num’
+instance GHC.Internal.Num.Num GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Num’
+instance GHC.Internal.Num.Num GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Num’
 instance GHC.Internal.Num.Num GHC.Types.Word -- Defined in ‘GHC.Internal.Num’
 instance forall k a (b :: k). GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’
@@ -12375,11 +12375,11 @@ instance GHC.Internal.Read.Read GHC.Types.Double -- Defined in ‘GHC.Internal.R
 instance GHC.Internal.Read.Read GHC.Types.Float -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Types.Int -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Read’
+instance GHC.Internal.Read.Read GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Read’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read [a] -- Defined in ‘GHC.Internal.Read’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Read’
+instance GHC.Internal.Read.Read GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Read’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Types.Ordering -- Defined in ‘GHC.Internal.Read’
 instance forall a. (GHC.Internal.Real.Integral a, GHC.Internal.Read.Read a) => GHC.Internal.Read.Read (GHC.Internal.Real.Ratio a) -- Defined in ‘GHC.Internal.Read’
@@ -12511,8 +12511,8 @@ instance GHC.Internal.Real.Integral GHC.Internal.Int.Int32 -- Defined in ‘GHC.
 instance GHC.Internal.Real.Integral GHC.Internal.Int.Int64 -- Defined in ‘GHC.Internal.Int’
 instance GHC.Internal.Real.Integral GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.Int’
 instance GHC.Internal.Real.Integral GHC.Types.Int -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Integral GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Integral GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Integral GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Integral GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Integral GHC.Types.Word -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Integral GHC.Internal.Word.Word16 -- Defined in ‘GHC.Internal.Word’
 instance GHC.Internal.Real.Integral GHC.Internal.Word.Word32 -- Defined in ‘GHC.Internal.Word’
@@ -12550,8 +12550,8 @@ instance GHC.Internal.Real.Real GHC.Internal.Int.Int64 -- Defined in ‘GHC.Inte
 instance GHC.Internal.Real.Real GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.Int’
 instance forall a. GHC.Internal.Real.Real a => GHC.Internal.Real.Real (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
 instance GHC.Internal.Real.Real GHC.Types.Int -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Real GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Real GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Real GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Real GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Real’
 instance forall a. GHC.Internal.Real.Integral a => GHC.Internal.Real.Real (GHC.Internal.Real.Ratio a) -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Real GHC.Types.Word -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Real GHC.Internal.Word.Word16 -- Defined in ‘GHC.Internal.Word’
@@ -12643,13 +12643,13 @@ instance GHC.Internal.Show.Show GHC.Types.Bool -- Defined in ‘GHC.Internal.Sho
 instance GHC.Internal.Show.Show GHC.Internal.Stack.Types.CallStack -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Char -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Int -- Defined in ‘GHC.Internal.Show’
-instance GHC.Internal.Show.Show GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Show’
+instance GHC.Internal.Show.Show GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.KindRep -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Levity -- Defined in ‘GHC.Internal.Show’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show [a] -- Defined in ‘GHC.Internal.Show’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Module -- Defined in ‘GHC.Internal.Show’
-instance GHC.Internal.Show.Show GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Show’
+instance GHC.Internal.Show.Show GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Show’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Ordering -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.RuntimeRep -- Defined in ‘GHC.Internal.Show’
@@ -13016,9 +13016,9 @@ instance GHC.Classes.Eq GHC.Internal.IO.Windows.Handle.TempFileOptions -- Define
 instance forall i e. GHC.Classes.Eq (GHC.Internal.IOArray.IOArray i e) -- Defined in ‘GHC.Internal.IOArray’
 instance forall a. GHC.Classes.Eq (GHC.Internal.IOPort.IOPort a) -- Defined in ‘GHC.Internal.IOPort’
 instance GHC.Classes.Eq GHC.Internal.InfoProv.Types.InfoProv -- Defined in ‘GHC.Internal.InfoProv.Types’
-instance GHC.Classes.Eq GHC.Num.Integer.Integer -- Defined in ‘GHC.Num.Integer’
-instance GHC.Classes.Eq GHC.Num.BigNat.BigNat -- Defined in ‘GHC.Num.BigNat’
-instance GHC.Classes.Eq GHC.Num.Natural.Natural -- Defined in ‘GHC.Num.Natural’
+instance GHC.Classes.Eq GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Bignum.Integer’
+instance GHC.Classes.Eq GHC.Internal.Bignum.BigNat.BigNat -- Defined in ‘GHC.Internal.Bignum.BigNat’
+instance GHC.Classes.Eq GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’
 instance GHC.Classes.Eq GHC.Internal.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.Internal.RTS.Flags’
 instance forall a. GHC.Classes.Eq (GHC.Internal.StableName.StableName a) -- Defined in ‘GHC.Internal.StableName’
 instance GHC.Classes.Eq GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’
@@ -13174,9 +13174,9 @@ instance GHC.Classes.Ord GHC.Internal.IO.Handle.Types.BufferMode -- Defined in 
 instance GHC.Classes.Ord GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
 instance GHC.Classes.Ord GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
 instance GHC.Classes.Ord GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
-instance GHC.Classes.Ord GHC.Num.Integer.Integer -- Defined in ‘GHC.Num.Integer’
-instance GHC.Classes.Ord GHC.Num.BigNat.BigNat -- Defined in ‘GHC.Num.BigNat’
-instance GHC.Classes.Ord GHC.Num.Natural.Natural -- Defined in ‘GHC.Num.Natural’
+instance GHC.Classes.Ord GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Bignum.Integer’
+instance GHC.Classes.Ord GHC.Internal.Bignum.BigNat.BigNat -- Defined in ‘GHC.Internal.Bignum.BigNat’
+instance GHC.Classes.Ord GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’
 instance forall (n :: GHC.Internal.TypeNats.Nat). GHC.Classes.Ord (GHC.Internal.TypeNats.SNat n) -- Defined in ‘GHC.Internal.TypeNats’
 instance GHC.Classes.Ord GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
 instance forall (c :: GHC.Types.Char). GHC.Classes.Ord (GHC.Internal.TypeLits.SChar c) -- Defined in ‘GHC.Internal.TypeLits’
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-ws-32 b/testsuite/tests/interface-stability/base-exports.stdout-ws-32
index cf78e36fb7b..4d862cb7077 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-ws-32
+++ b/testsuite/tests/interface-stability/base-exports.stdout-ws-32
@@ -835,7 +835,7 @@ module Data.Data where
   type Constr :: *
   data Constr = ...
   type ConstrRep :: *
-  data ConstrRep = AlgConstr ConIndex | IntConstr GHC.Num.Integer.Integer | FloatConstr GHC.Internal.Real.Rational | CharConstr GHC.Types.Char
+  data ConstrRep = AlgConstr ConIndex | IntConstr GHC.Internal.Bignum.Integer.Integer | FloatConstr GHC.Internal.Real.Rational | CharConstr GHC.Types.Char
   type Data :: * -> Constraint
   class Typeable a => Data a where
     gfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> a -> c a
@@ -1010,10 +1010,10 @@ module Data.Fixed where
   data E9
   type role Fixed phantom
   type Fixed :: forall k. k -> *
-  newtype Fixed a = MkFixed GHC.Num.Integer.Integer
+  newtype Fixed a = MkFixed GHC.Internal.Bignum.Integer.Integer
   type HasResolution :: forall k. k -> Constraint
   class HasResolution @k a where
-    resolution :: forall (p :: k -> *). p a -> GHC.Num.Integer.Integer
+    resolution :: forall (p :: k -> *). p a -> GHC.Internal.Bignum.Integer.Integer
     {-# MINIMAL resolution #-}
   type Micro :: *
   type Micro = Fixed E6
@@ -1582,7 +1582,7 @@ module Data.Ratio where
   type Ratio :: * -> *
   data Ratio a = ...
   type Rational :: *
-  type Rational = Ratio GHC.Num.Integer.Integer
+  type Rational = Ratio GHC.Internal.Bignum.Integer.Integer
   approxRational :: forall a. GHC.Internal.Real.RealFrac a => a -> a -> Rational
   denominator :: forall a. Ratio a -> a
   numerator :: forall a. Ratio a -> a
@@ -7148,11 +7148,11 @@ module GHC.Float where
     {-# MINIMAL pi, exp, log, sin, cos, asin, acos, atan, sinh, cosh, asinh, acosh, atanh #-}
   type RealFloat :: * -> Constraint
   class (GHC.Internal.Real.RealFrac a, Floating a) => RealFloat a where
-    floatRadix :: a -> GHC.Num.Integer.Integer
+    floatRadix :: a -> GHC.Internal.Bignum.Integer.Integer
     floatDigits :: a -> GHC.Types.Int
     floatRange :: a -> (GHC.Types.Int, GHC.Types.Int)
-    decodeFloat :: a -> (GHC.Num.Integer.Integer, GHC.Types.Int)
-    encodeFloat :: GHC.Num.Integer.Integer -> GHC.Types.Int -> a
+    decodeFloat :: a -> (GHC.Internal.Bignum.Integer.Integer, GHC.Types.Int)
+    encodeFloat :: GHC.Internal.Bignum.Integer.Integer -> GHC.Types.Int -> a
     exponent :: a -> GHC.Types.Int
     significand :: a -> a
     scaleFloat :: GHC.Types.Int -> a -> a
@@ -7200,30 +7200,30 @@ module GHC.Float where
   expFloat :: Float -> Float
   expm1Double :: Double -> Double
   expm1Float :: Float -> Float
-  expt :: GHC.Num.Integer.Integer -> GHC.Types.Int -> GHC.Num.Integer.Integer
-  expts :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer
-  expts10 :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer
+  expt :: GHC.Internal.Bignum.Integer.Integer -> GHC.Types.Int -> GHC.Internal.Bignum.Integer.Integer
+  expts :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Internal.Bignum.Integer.Integer
+  expts10 :: GHC.Internal.Arr.Array GHC.Types.Int GHC.Internal.Bignum.Integer.Integer
   fabsDouble :: Double -> Double
   fabsFloat :: Float -> Float
   float2Double :: Float -> Double
   float2Int :: Float -> GHC.Types.Int
-  floatToDigits :: forall a. RealFloat a => GHC.Num.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
+  floatToDigits :: forall a. RealFloat a => GHC.Internal.Bignum.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
   floorDouble :: forall b. GHC.Internal.Real.Integral b => Double -> b
   floorFloat :: forall b. GHC.Internal.Real.Integral b => Float -> b
   formatRealFloat :: forall a. RealFloat a => FFFormat -> GHC.Internal.Maybe.Maybe GHC.Types.Int -> a -> GHC.Internal.Base.String
   formatRealFloatAlt :: forall a. RealFloat a => FFFormat -> GHC.Internal.Maybe.Maybe GHC.Types.Int -> GHC.Types.Bool -> a -> GHC.Internal.Base.String
   fromRat :: forall a. RealFloat a => GHC.Internal.Real.Rational -> a
   fromRat' :: forall a. RealFloat a => GHC.Internal.Real.Rational -> a
-  fromRat'' :: forall a. RealFloat a => GHC.Types.Int -> GHC.Types.Int -> GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> a
+  fromRat'' :: forall a. RealFloat a => GHC.Types.Int -> GHC.Types.Int -> GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> a
   geDouble :: Double -> Double -> GHC.Types.Bool
   geFloat :: Float -> Float -> GHC.Types.Bool
   gtDouble :: Double -> Double -> GHC.Types.Bool
   gtFloat :: Float -> Float -> GHC.Types.Bool
   int2Double :: GHC.Types.Int -> Double
   int2Float :: GHC.Types.Int -> Float
-  integerToBinaryFloat' :: forall a. RealFloat a => GHC.Num.Integer.Integer -> a
-  integerToDouble# :: GHC.Num.Integer.Integer -> Double#
-  integerToFloat# :: GHC.Num.Integer.Integer -> Float#
+  integerToBinaryFloat' :: forall a. RealFloat a => GHC.Internal.Bignum.Integer.Integer -> a
+  integerToDouble# :: GHC.Internal.Bignum.Integer.Integer -> Double#
+  integerToFloat# :: GHC.Internal.Bignum.Integer.Integer -> Float#
   isDoubleDenormalized :: Double -> GHC.Types.Int
   isDoubleFinite :: Double -> GHC.Types.Int
   isDoubleInfinite :: Double -> GHC.Types.Int
@@ -7248,8 +7248,8 @@ module GHC.Float where
   minExpt :: GHC.Types.Int
   minusDouble :: Double -> Double -> Double
   minusFloat :: Float -> Float -> Float
-  naturalToDouble# :: GHC.Num.Natural.Natural -> Double#
-  naturalToFloat# :: GHC.Num.Natural.Natural -> Float#
+  naturalToDouble# :: GHC.Internal.Bignum.Natural.Natural -> Double#
+  naturalToFloat# :: GHC.Internal.Bignum.Natural.Natural -> Float#
   negateDouble :: Double -> Double
   negateFloat :: Float -> Float
   plusDouble :: Double -> Double -> Double
@@ -7258,12 +7258,12 @@ module GHC.Float where
   powerFloat :: Float -> Float -> Float
   properFractionDouble :: forall b. GHC.Internal.Real.Integral b => Double -> (b, Double)
   properFractionFloat :: forall b. GHC.Internal.Real.Integral b => Float -> (b, Float)
-  rationalToDouble :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> Double
-  rationalToFloat :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> Float
+  rationalToDouble :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> Double
+  rationalToFloat :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> Float
   roundDouble :: forall b. GHC.Internal.Real.Integral b => Double -> b
   roundFloat :: forall b. GHC.Internal.Real.Integral b => Float -> b
   roundTo :: GHC.Types.Int -> GHC.Types.Int -> [GHC.Types.Int] -> (GHC.Types.Int, [GHC.Types.Int])
-  roundingMode# :: GHC.Num.Integer.Integer -> GHC.Prim.Int# -> GHC.Prim.Int#
+  roundingMode# :: GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int# -> GHC.Prim.Int#
   showFloat :: forall a. RealFloat a => a -> GHC.Internal.Show.ShowS
   showSignedFloat :: forall a. RealFloat a => (a -> GHC.Internal.Show.ShowS) -> GHC.Types.Int -> a -> GHC.Internal.Show.ShowS
   sinDouble :: Double -> Double
@@ -7289,33 +7289,33 @@ module GHC.Float where
 
 module GHC.Float.ConversionUtils where
   -- Safety: Safe
-  elimZerosInt# :: GHC.Prim.Int# -> GHC.Prim.Int# -> (# GHC.Num.Integer.Integer, GHC.Prim.Int# #)
-  elimZerosInteger :: GHC.Num.Integer.Integer -> GHC.Prim.Int# -> (# GHC.Num.Integer.Integer, GHC.Prim.Int# #)
+  elimZerosInt# :: GHC.Prim.Int# -> GHC.Prim.Int# -> (# GHC.Internal.Bignum.Integer.Integer, GHC.Prim.Int# #)
+  elimZerosInteger :: GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int# -> (# GHC.Internal.Bignum.Integer.Integer, GHC.Prim.Int# #)
 
 module GHC.Float.RealFracMethods where
   -- Safety: Safe
   ceilingDoubleInt :: GHC.Types.Double -> GHC.Types.Int
-  ceilingDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
+  ceilingDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
   ceilingFloatInt :: GHC.Types.Float -> GHC.Types.Int
-  ceilingFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
+  ceilingFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
   double2Int :: GHC.Types.Double -> GHC.Types.Int
   float2Int :: GHC.Types.Float -> GHC.Types.Int
   floorDoubleInt :: GHC.Types.Double -> GHC.Types.Int
-  floorDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
+  floorDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
   floorFloatInt :: GHC.Types.Float -> GHC.Types.Int
-  floorFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
+  floorFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
   int2Double :: GHC.Types.Int -> GHC.Types.Double
   int2Float :: GHC.Types.Int -> GHC.Types.Float
   properFractionDoubleInt :: GHC.Types.Double -> (GHC.Types.Int, GHC.Types.Double)
-  properFractionDoubleInteger :: GHC.Types.Double -> (GHC.Num.Integer.Integer, GHC.Types.Double)
+  properFractionDoubleInteger :: GHC.Types.Double -> (GHC.Internal.Bignum.Integer.Integer, GHC.Types.Double)
   properFractionFloatInt :: GHC.Types.Float -> (GHC.Types.Int, GHC.Types.Float)
-  properFractionFloatInteger :: GHC.Types.Float -> (GHC.Num.Integer.Integer, GHC.Types.Float)
+  properFractionFloatInteger :: GHC.Types.Float -> (GHC.Internal.Bignum.Integer.Integer, GHC.Types.Float)
   roundDoubleInt :: GHC.Types.Double -> GHC.Types.Int
-  roundDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
+  roundDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
   roundFloatInt :: GHC.Types.Float -> GHC.Types.Int
-  roundFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
-  truncateDoubleInteger :: GHC.Types.Double -> GHC.Num.Integer.Integer
-  truncateFloatInteger :: GHC.Types.Float -> GHC.Num.Integer.Integer
+  roundFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
+  truncateDoubleInteger :: GHC.Types.Double -> GHC.Internal.Bignum.Integer.Integer
+  truncateFloatInteger :: GHC.Types.Float -> GHC.Internal.Bignum.Integer.Integer
 
 module GHC.Foreign where
   -- Safety: Safe
@@ -7613,10 +7613,10 @@ module GHC.IO.Device where
     close :: a -> GHC.Types.IO ()
     isTerminal :: a -> GHC.Types.IO GHC.Types.Bool
     isSeekable :: a -> GHC.Types.IO GHC.Types.Bool
-    seek :: a -> SeekMode -> GHC.Num.Integer.Integer -> GHC.Types.IO GHC.Num.Integer.Integer
-    tell :: a -> GHC.Types.IO GHC.Num.Integer.Integer
-    getSize :: a -> GHC.Types.IO GHC.Num.Integer.Integer
-    setSize :: a -> GHC.Num.Integer.Integer -> GHC.Types.IO ()
+    seek :: a -> SeekMode -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
+    tell :: a -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
+    getSize :: a -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
+    setSize :: a -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO ()
     setEcho :: a -> GHC.Types.Bool -> GHC.Types.IO ()
     getEcho :: a -> GHC.Types.IO GHC.Types.Bool
     setRaw :: a -> GHC.Types.Bool -> GHC.Types.IO ()
@@ -7844,7 +7844,7 @@ module GHC.IO.Handle where
   type Handle :: *
   data Handle = ...
   type HandlePosition :: *
-  type HandlePosition = GHC.Num.Integer.Integer
+  type HandlePosition = GHC.Internal.Bignum.Integer.Integer
   type HandlePosn :: *
   data HandlePosn = HandlePosn Handle HandlePosition
   type LockMode :: *
@@ -7859,7 +7859,7 @@ module GHC.IO.Handle where
   hClose_help :: GHC.Internal.IO.Handle.Types.Handle__ -> GHC.Types.IO (GHC.Internal.IO.Handle.Types.Handle__, GHC.Internal.Maybe.Maybe GHC.Internal.Exception.Type.SomeException)
   hDuplicate :: Handle -> GHC.Types.IO Handle
   hDuplicateTo :: Handle -> Handle -> GHC.Types.IO ()
-  hFileSize :: Handle -> GHC.Types.IO GHC.Num.Integer.Integer
+  hFileSize :: Handle -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
   hFlush :: Handle -> GHC.Types.IO ()
   hFlushAll :: Handle -> GHC.Types.IO ()
   hGetBuf :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Int
@@ -7885,16 +7885,16 @@ module GHC.IO.Handle where
   hPutBufNonBlocking :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Int
   hPutChar :: Handle -> GHC.Types.Char -> GHC.Types.IO ()
   hPutStr :: Handle -> GHC.Internal.Base.String -> GHC.Types.IO ()
-  hSeek :: Handle -> SeekMode -> GHC.Num.Integer.Integer -> GHC.Types.IO ()
+  hSeek :: Handle -> SeekMode -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO ()
   hSetBinaryMode :: Handle -> GHC.Types.Bool -> GHC.Types.IO ()
   hSetBuffering :: Handle -> BufferMode -> GHC.Types.IO ()
   hSetEcho :: Handle -> GHC.Types.Bool -> GHC.Types.IO ()
   hSetEncoding :: Handle -> GHC.Internal.IO.Encoding.Types.TextEncoding -> GHC.Types.IO ()
-  hSetFileSize :: Handle -> GHC.Num.Integer.Integer -> GHC.Types.IO ()
+  hSetFileSize :: Handle -> GHC.Internal.Bignum.Integer.Integer -> GHC.Types.IO ()
   hSetNewlineMode :: Handle -> NewlineMode -> GHC.Types.IO ()
   hSetPosn :: HandlePosn -> GHC.Types.IO ()
   hShow :: Handle -> GHC.Types.IO GHC.Internal.Base.String
-  hTell :: Handle -> GHC.Types.IO GHC.Num.Integer.Integer
+  hTell :: Handle -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
   hTryLock :: Handle -> LockMode -> GHC.Types.IO GHC.Types.Bool
   hWaitForInput :: Handle -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Bool
   isEOF :: GHC.Types.IO GHC.Types.Bool
@@ -8228,8 +8228,8 @@ module GHC.Integer where
 
 module GHC.Integer.Logarithms where
   -- Safety: None
-  integerLog2# :: GHC.Num.Integer.Integer -> GHC.Prim.Int#
-  integerLogBase# :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> GHC.Prim.Int#
+  integerLog2# :: GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int#
+  integerLogBase# :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer -> GHC.Prim.Int#
   wordLog2# :: GHC.Prim.Word# -> GHC.Prim.Int#
 
 module GHC.IsList where
@@ -8344,7 +8344,7 @@ module GHC.Maybe where
 module GHC.Natural where
   -- Safety: Safe
   type BigNat :: *
-  data BigNat = BN# {unBigNat :: GHC.Num.BigNat.BigNat#}
+  data BigNat = BN# {unBigNat :: GHC.Internal.Bignum.BigNat.BigNat#}
   pattern NatJ# :: BigNat -> Natural
   pattern NatS# :: GHC.Prim.Word# -> Natural
   type Natural :: *
@@ -8357,8 +8357,8 @@ module GHC.Natural where
   minusNatural :: Natural -> Natural -> Natural
   minusNaturalMaybe :: Natural -> Natural -> GHC.Internal.Maybe.Maybe Natural
   mkNatural :: [GHC.Types.Word] -> Natural
-  naturalFromInteger :: GHC.Num.Integer.Integer -> Natural
-  naturalToInteger :: Natural -> GHC.Num.Integer.Integer
+  naturalFromInteger :: GHC.Internal.Bignum.Integer.Integer -> Natural
+  naturalToInteger :: Natural -> GHC.Internal.Bignum.Integer.Integer
   naturalToWord :: Natural -> GHC.Types.Word
   naturalToWordMaybe :: Natural -> GHC.Internal.Maybe.Maybe GHC.Types.Word
   negateNatural :: Natural -> Natural
@@ -8400,7 +8400,7 @@ module GHC.Num where
   integerBit :: GHC.Types.Word -> Integer
   integerBit# :: GHC.Prim.Word# -> Integer
   integerCheck :: Integer -> GHC.Types.Bool
-  integerCheck# :: Integer -> GHC.Num.Primitives.Bool#
+  integerCheck# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerCompare :: Integer -> Integer -> GHC.Types.Ordering
   integerComplement :: Integer -> Integer
   integerDecodeDouble# :: GHC.Prim.Double# -> (# Integer, GHC.Prim.Int# #)
@@ -8411,14 +8411,14 @@ module GHC.Num where
   integerEncodeDouble# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Double#
   integerEncodeFloat# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Float#
   integerEq :: Integer -> Integer -> GHC.Types.Bool
-  integerEq# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
-  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Integer
-  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
-  integerFromBigNat# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatNeg# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Num.BigNat.BigNat# -> Integer
-  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> Integer
-  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerEq# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
+  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Integer
+  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatNeg# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> Integer
+  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
   integerFromInt :: GHC.Types.Int -> Integer
   integerFromInt# :: GHC.Prim.Int# -> Integer
   integerFromInt64# :: GHC.Prim.Int64# -> Integer
@@ -8433,17 +8433,17 @@ module GHC.Num where
   integerGcde :: Integer -> Integer -> (Integer, Integer, Integer)
   integerGcde# :: Integer -> Integer -> (# Integer, Integer, Integer #)
   integerGe :: Integer -> Integer -> GHC.Types.Bool
-  integerGe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerGt :: Integer -> Integer -> GHC.Types.Bool
-  integerGt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsNegative :: Integer -> GHC.Types.Bool
-  integerIsNegative# :: Integer -> GHC.Num.Primitives.Bool#
+  integerIsNegative# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsOne :: Integer -> GHC.Types.Bool
   integerIsPowerOf2# :: Integer -> (# (# #) | GHC.Prim.Word# #)
   integerIsZero :: Integer -> GHC.Types.Bool
   integerLcm :: Integer -> Integer -> Integer
   integerLe :: Integer -> Integer -> GHC.Types.Bool
-  integerLe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerLog2 :: Integer -> GHC.Types.Word
   integerLog2# :: Integer -> GHC.Prim.Word#
   integerLogBase :: Integer -> Integer -> GHC.Types.Word
@@ -8451,11 +8451,11 @@ module GHC.Num where
   integerLogBaseWord :: GHC.Types.Word -> Integer -> GHC.Types.Word
   integerLogBaseWord# :: GHC.Prim.Word# -> Integer -> GHC.Prim.Word#
   integerLt :: Integer -> Integer -> GHC.Types.Bool
-  integerLt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerMod :: Integer -> Integer -> Integer
   integerMul :: Integer -> Integer -> Integer
   integerNe :: Integer -> Integer -> GHC.Types.Bool
-  integerNe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerNe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerNegate :: Integer -> Integer
   integerOne :: Integer
   integerOr :: Integer -> Integer -> Integer
@@ -8476,16 +8476,16 @@ module GHC.Num where
   integerSqr :: Integer -> Integer
   integerSub :: Integer -> Integer -> Integer
   integerTestBit :: Integer -> GHC.Types.Word -> GHC.Types.Bool
-  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  integerToBigNatClamp# :: Integer -> GHC.Num.BigNat.BigNat#
-  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Num.BigNat.BigNat# #)
+  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToBigNatClamp# :: Integer -> GHC.Internal.Bignum.BigNat.BigNat#
+  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Internal.Bignum.BigNat.BigNat# #)
   integerToInt :: Integer -> GHC.Types.Int
   integerToInt# :: Integer -> GHC.Prim.Int#
   integerToInt64# :: Integer -> GHC.Prim.Int64#
-  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   integerToNatural :: Integer -> Natural
   integerToNaturalClamp :: Integer -> Natural
   integerToNaturalThrow :: Integer -> Natural
@@ -8500,7 +8500,7 @@ module GHC.Num where
   naturalBit :: GHC.Types.Word -> Natural
   naturalBit# :: GHC.Prim.Word# -> Natural
   naturalCheck :: Natural -> GHC.Types.Bool
-  naturalCheck# :: Natural -> GHC.Num.Primitives.Bool#
+  naturalCheck# :: Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalClearBit :: Natural -> GHC.Types.Word -> Natural
   naturalClearBit# :: Natural -> GHC.Prim.Word# -> Natural
   naturalCompare :: Natural -> Natural -> GHC.Types.Ordering
@@ -8509,26 +8509,26 @@ module GHC.Num where
   naturalEncodeDouble# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Double#
   naturalEncodeFloat# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Float#
   naturalEq :: Natural -> Natural -> GHC.Types.Bool
-  naturalEq# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
-  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Natural
-  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
-  naturalFromBigNat# :: GHC.Num.BigNat.BigNat# -> Natural
-  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalEq# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Natural
+  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Natural
+  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
   naturalFromWord :: GHC.Types.Word -> Natural
   naturalFromWord# :: GHC.Prim.Word# -> Natural
   naturalFromWord2# :: GHC.Prim.Word# -> GHC.Prim.Word# -> Natural
   naturalFromWordList :: [GHC.Types.Word] -> Natural
   naturalGcd :: Natural -> Natural -> Natural
   naturalGe :: Natural -> Natural -> GHC.Types.Bool
-  naturalGe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalGt :: Natural -> Natural -> GHC.Types.Bool
-  naturalGt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalIsOne :: Natural -> GHC.Types.Bool
   naturalIsPowerOf2# :: Natural -> (# (# #) | GHC.Prim.Word# #)
   naturalIsZero :: Natural -> GHC.Types.Bool
   naturalLcm :: Natural -> Natural -> Natural
   naturalLe :: Natural -> Natural -> GHC.Types.Bool
-  naturalLe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalLog2 :: Natural -> GHC.Types.Word
   naturalLog2# :: Natural -> GHC.Prim.Word#
   naturalLogBase :: Natural -> Natural -> GHC.Types.Word
@@ -8536,10 +8536,10 @@ module GHC.Num where
   naturalLogBaseWord :: GHC.Types.Word -> Natural -> GHC.Types.Word
   naturalLogBaseWord# :: GHC.Prim.Word# -> Natural -> GHC.Prim.Word#
   naturalLt :: Natural -> Natural -> GHC.Types.Bool
-  naturalLt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalMul :: Natural -> Natural -> Natural
   naturalNe :: Natural -> Natural -> GHC.Types.Bool
-  naturalNe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalNe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalNegate :: Natural -> Natural
   naturalOne :: Natural
   naturalOr :: Natural -> Natural -> Natural
@@ -8563,11 +8563,11 @@ module GHC.Num where
   naturalSubThrow :: Natural -> Natural -> Natural
   naturalSubUnsafe :: Natural -> Natural -> Natural
   naturalTestBit :: Natural -> GHC.Types.Word -> GHC.Types.Bool
-  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  naturalToBigNat# :: Natural -> GHC.Num.BigNat.BigNat#
-  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalToBigNat# :: Natural -> GHC.Internal.Bignum.BigNat.BigNat#
+  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   naturalToWord :: Natural -> GHC.Types.Word
   naturalToWord# :: Natural -> GHC.Prim.Word#
   naturalToWordClamp :: Natural -> GHC.Types.Word
@@ -8583,7 +8583,7 @@ module GHC.Num.BigNat where
   type BigNat :: *
   data BigNat = BN# {unBigNat :: BigNat#}
   type BigNat# :: GHC.Types.UnliftedType
-  type BigNat# = GHC.Num.WordArray.WordArray#
+  type BigNat# = GHC.Internal.Bignum.WordArray.WordArray#
   bigNatAdd :: BigNat# -> BigNat# -> BigNat#
   bigNatAddWord :: BigNat# -> GHC.Types.Word -> BigNat#
   bigNatAddWord# :: BigNat# -> GHC.Prim.Word# -> BigNat#
@@ -8595,7 +8595,7 @@ module GHC.Num.BigNat where
   bigNatBit :: GHC.Types.Word -> BigNat#
   bigNatBit# :: GHC.Prim.Word# -> BigNat#
   bigNatCheck :: BigNat# -> GHC.Types.Bool
-  bigNatCheck# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatCheck# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatClearBit# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatCompare :: BigNat# -> BigNat# -> GHC.Types.Ordering
   bigNatCompareWord :: BigNat# -> GHC.Types.Word -> GHC.Types.Ordering
@@ -8607,48 +8607,48 @@ module GHC.Num.BigNat where
   bigNatCtzWord# :: BigNat# -> GHC.Prim.Word#
   bigNatEncodeDouble# :: BigNat# -> GHC.Prim.Int# -> GHC.Prim.Double#
   bigNatEq :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatEq# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
-  bigNatEqWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
+  bigNatEq# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
+  bigNatEqWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatFromAbsInt# :: GHC.Prim.Int# -> BigNat#
-  bigNatFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
+  bigNatFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromAddrBE# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromAddrLE# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
-  bigNatFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
+  bigNatFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromByteArrayBE# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromByteArrayLE# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, BigNat# #)
   bigNatFromWord :: GHC.Types.Word -> BigNat#
   bigNatFromWord# :: GHC.Prim.Word# -> BigNat#
   bigNatFromWord2# :: GHC.Prim.Word# -> GHC.Prim.Word# -> BigNat#
   bigNatFromWord64# :: GHC.Prim.Word64# -> BigNat#
-  bigNatFromWordArray :: GHC.Num.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat
-  bigNatFromWordArray# :: GHC.Num.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat#
+  bigNatFromWordArray :: GHC.Internal.Bignum.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat
+  bigNatFromWordArray# :: GHC.Internal.Bignum.WordArray.WordArray# -> GHC.Prim.Word# -> BigNat#
   bigNatFromWordList :: [GHC.Types.Word] -> BigNat#
-  bigNatFromWordList# :: [GHC.Types.Word] -> GHC.Num.WordArray.WordArray#
+  bigNatFromWordList# :: [GHC.Types.Word] -> GHC.Internal.Bignum.WordArray.WordArray#
   bigNatFromWordListUnsafe :: [GHC.Types.Word] -> BigNat#
   bigNatGcd :: BigNat# -> BigNat# -> BigNat#
   bigNatGcdWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Prim.Word#
   bigNatGe :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatGe# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatGe# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatGt :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatGt# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatGt# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatGtWord :: BigNat# -> GHC.Types.Word -> GHC.Types.Bool
-  bigNatGtWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
+  bigNatGtWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatIndex :: BigNat# -> GHC.Prim.Int# -> GHC.Types.Word
   bigNatIndex# :: BigNat# -> GHC.Prim.Int# -> GHC.Prim.Word#
   bigNatIsOne :: BigNat# -> GHC.Types.Bool
-  bigNatIsOne# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatIsOne# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatIsPowerOf2# :: BigNat# -> (# (# #) | GHC.Prim.Word# #)
   bigNatIsTwo :: BigNat# -> GHC.Types.Bool
-  bigNatIsTwo# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatIsTwo# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatIsZero :: BigNat# -> GHC.Types.Bool
-  bigNatIsZero# :: BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatIsZero# :: BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatLcm :: BigNat# -> BigNat# -> BigNat#
   bigNatLcmWord# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatLcmWordWord# :: GHC.Prim.Word# -> GHC.Prim.Word# -> BigNat#
   bigNatLe :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatLe# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatLe# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatLeWord :: BigNat# -> GHC.Types.Word -> GHC.Types.Bool
-  bigNatLeWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
+  bigNatLeWord# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatLog2 :: BigNat# -> GHC.Types.Word
   bigNatLog2# :: BigNat# -> GHC.Prim.Word#
   bigNatLogBase :: BigNat# -> BigNat# -> GHC.Types.Word
@@ -8656,12 +8656,12 @@ module GHC.Num.BigNat where
   bigNatLogBaseWord :: GHC.Types.Word -> BigNat# -> GHC.Types.Word
   bigNatLogBaseWord# :: GHC.Prim.Word# -> BigNat# -> GHC.Prim.Word#
   bigNatLt :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatLt# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatLt# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatMul :: BigNat# -> BigNat# -> BigNat#
   bigNatMulWord :: BigNat# -> GHC.Types.Word -> BigNat#
   bigNatMulWord# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatNe :: BigNat# -> BigNat# -> GHC.Types.Bool
-  bigNatNe# :: BigNat# -> BigNat# -> GHC.Num.Primitives.Bool#
+  bigNatNe# :: BigNat# -> BigNat# -> GHC.Internal.Bignum.Primitives.Bool#
   bigNatOne :: BigNat
   bigNatOne# :: (# #) -> BigNat#
   bigNatOr :: BigNat# -> BigNat# -> BigNat#
@@ -8695,14 +8695,14 @@ module GHC.Num.BigNat where
   bigNatSubWordUnsafe :: BigNat# -> GHC.Types.Word -> BigNat#
   bigNatSubWordUnsafe# :: BigNat# -> GHC.Prim.Word# -> BigNat#
   bigNatTestBit :: BigNat# -> GHC.Types.Word -> GHC.Types.Bool
-  bigNatTestBit# :: BigNat# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  bigNatToAddr :: BigNat# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  bigNatToAddr# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  bigNatTestBit# :: BigNat# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  bigNatToAddr :: BigNat# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  bigNatToAddr# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToAddrBE# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToAddrLE# :: forall s. BigNat# -> GHC.Prim.Addr# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToInt :: BigNat# -> GHC.Types.Int
   bigNatToInt# :: BigNat# -> GHC.Prim.Int#
-  bigNatToMutableByteArray# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  bigNatToMutableByteArray# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToMutableByteArrayBE# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToMutableByteArrayLE# :: forall s. BigNat# -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   bigNatToWord :: BigNat# -> GHC.Types.Word
@@ -8731,7 +8731,7 @@ module GHC.Num.Integer where
   integerBit :: GHC.Types.Word -> Integer
   integerBit# :: GHC.Prim.Word# -> Integer
   integerCheck :: Integer -> GHC.Types.Bool
-  integerCheck# :: Integer -> GHC.Num.Primitives.Bool#
+  integerCheck# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerCompare :: Integer -> Integer -> GHC.Types.Ordering
   integerComplement :: Integer -> Integer
   integerDecodeDouble# :: GHC.Prim.Double# -> (# Integer, GHC.Prim.Int# #)
@@ -8742,18 +8742,18 @@ module GHC.Num.Integer where
   integerEncodeDouble# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Double#
   integerEncodeFloat# :: Integer -> GHC.Prim.Int# -> GHC.Prim.Float#
   integerEq :: Integer -> Integer -> GHC.Types.Bool
-  integerEq# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
-  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Integer
-  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
-  integerFromBigNat# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatNeg# :: GHC.Num.BigNat.BigNat# -> Integer
-  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Num.BigNat.BigNat# -> Integer
-  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> Integer
-  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerEq# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
+  integerFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Integer
+  integerFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
+  integerFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatNeg# :: GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromBigNatSign# :: GHC.Prim.Int# -> GHC.Internal.Bignum.BigNat.BigNat# -> Integer
+  integerFromByteArray :: GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> Integer
+  integerFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Integer #)
   integerFromInt :: GHC.Types.Int -> Integer
   integerFromInt# :: GHC.Prim.Int# -> Integer
   integerFromInt64# :: GHC.Prim.Int64# -> Integer
-  integerFromNatural :: GHC.Num.Natural.Natural -> Integer
+  integerFromNatural :: GHC.Internal.Bignum.Natural.Natural -> Integer
   integerFromWord :: GHC.Types.Word -> Integer
   integerFromWord# :: GHC.Prim.Word# -> Integer
   integerFromWord64# :: GHC.Prim.Word64# -> Integer
@@ -8764,17 +8764,17 @@ module GHC.Num.Integer where
   integerGcde :: Integer -> Integer -> (Integer, Integer, Integer)
   integerGcde# :: Integer -> Integer -> (# Integer, Integer, Integer #)
   integerGe :: Integer -> Integer -> GHC.Types.Bool
-  integerGe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerGt :: Integer -> Integer -> GHC.Types.Bool
-  integerGt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerGt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsNegative :: Integer -> GHC.Types.Bool
-  integerIsNegative# :: Integer -> GHC.Num.Primitives.Bool#
+  integerIsNegative# :: Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerIsOne :: Integer -> GHC.Types.Bool
   integerIsPowerOf2# :: Integer -> (# (# #) | GHC.Prim.Word# #)
   integerIsZero :: Integer -> GHC.Types.Bool
   integerLcm :: Integer -> Integer -> Integer
   integerLe :: Integer -> Integer -> GHC.Types.Bool
-  integerLe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerLog2 :: Integer -> GHC.Types.Word
   integerLog2# :: Integer -> GHC.Prim.Word#
   integerLogBase :: Integer -> Integer -> GHC.Types.Word
@@ -8782,20 +8782,20 @@ module GHC.Num.Integer where
   integerLogBaseWord :: GHC.Types.Word -> Integer -> GHC.Types.Word
   integerLogBaseWord# :: GHC.Prim.Word# -> Integer -> GHC.Prim.Word#
   integerLt :: Integer -> Integer -> GHC.Types.Bool
-  integerLt# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerLt# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerMod :: Integer -> Integer -> Integer
   integerMul :: Integer -> Integer -> Integer
   integerNe :: Integer -> Integer -> GHC.Types.Bool
-  integerNe# :: Integer -> Integer -> GHC.Num.Primitives.Bool#
+  integerNe# :: Integer -> Integer -> GHC.Internal.Bignum.Primitives.Bool#
   integerNegate :: Integer -> Integer
   integerOne :: Integer
   integerOr :: Integer -> Integer -> Integer
   integerPopCount# :: Integer -> GHC.Prim.Int#
-  integerPowMod# :: Integer -> Integer -> GHC.Num.Natural.Natural -> (# GHC.Num.Natural.Natural | () #)
+  integerPowMod# :: Integer -> Integer -> GHC.Internal.Bignum.Natural.Natural -> (# GHC.Internal.Bignum.Natural.Natural | () #)
   integerQuot :: Integer -> Integer -> Integer
   integerQuotRem :: Integer -> Integer -> (Integer, Integer)
   integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #)
-  integerRecipMod# :: Integer -> GHC.Num.Natural.Natural -> (# GHC.Num.Natural.Natural | () #)
+  integerRecipMod# :: Integer -> GHC.Internal.Bignum.Natural.Natural -> (# GHC.Internal.Bignum.Natural.Natural | () #)
   integerRem :: Integer -> Integer -> Integer
   integerShiftL :: Integer -> GHC.Types.Word -> Integer
   integerShiftL# :: Integer -> GHC.Prim.Word# -> Integer
@@ -8807,19 +8807,19 @@ module GHC.Num.Integer where
   integerSqr :: Integer -> Integer
   integerSub :: Integer -> Integer -> Integer
   integerTestBit :: Integer -> GHC.Types.Word -> GHC.Types.Bool
-  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  integerToBigNatClamp# :: Integer -> GHC.Num.BigNat.BigNat#
-  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Num.BigNat.BigNat# #)
+  integerTestBit# :: Integer -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  integerToAddr :: Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToAddr# :: forall s. Integer -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToBigNatClamp# :: Integer -> GHC.Internal.Bignum.BigNat.BigNat#
+  integerToBigNatSign# :: Integer -> (# GHC.Prim.Int#, GHC.Internal.Bignum.BigNat.BigNat# #)
   integerToInt :: Integer -> GHC.Types.Int
   integerToInt# :: Integer -> GHC.Prim.Int#
   integerToInt64# :: Integer -> GHC.Prim.Int64#
-  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  integerToNatural :: Integer -> GHC.Num.Natural.Natural
-  integerToNaturalClamp :: Integer -> GHC.Num.Natural.Natural
-  integerToNaturalThrow :: Integer -> GHC.Num.Natural.Natural
+  integerToMutableByteArray :: Integer -> GHC.Prim.MutableByteArray# GHC.Prim.RealWorld -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  integerToMutableByteArray# :: forall s. Integer -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  integerToNatural :: Integer -> GHC.Internal.Bignum.Natural.Natural
+  integerToNaturalClamp :: Integer -> GHC.Internal.Bignum.Natural.Natural
+  integerToNaturalThrow :: Integer -> GHC.Internal.Bignum.Natural.Natural
   integerToWord :: Integer -> GHC.Types.Word
   integerToWord# :: Integer -> GHC.Prim.Word#
   integerToWord64# :: Integer -> GHC.Prim.Word64#
@@ -8836,7 +8836,7 @@ module GHC.Num.Natural where
   naturalBit :: GHC.Types.Word -> Natural
   naturalBit# :: GHC.Prim.Word# -> Natural
   naturalCheck :: Natural -> GHC.Types.Bool
-  naturalCheck# :: Natural -> GHC.Num.Primitives.Bool#
+  naturalCheck# :: Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalClearBit :: Natural -> GHC.Types.Word -> Natural
   naturalClearBit# :: Natural -> GHC.Prim.Word# -> Natural
   naturalCompare :: Natural -> Natural -> GHC.Types.Ordering
@@ -8845,26 +8845,26 @@ module GHC.Num.Natural where
   naturalEncodeDouble# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Double#
   naturalEncodeFloat# :: Natural -> GHC.Prim.Int# -> GHC.Prim.Float#
   naturalEq :: Natural -> Natural -> GHC.Types.Bool
-  naturalEq# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
-  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO Natural
-  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
-  naturalFromBigNat# :: GHC.Num.BigNat.BigNat# -> Natural
-  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalEq# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalFromAddr :: GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO Natural
+  naturalFromAddr# :: forall s. GHC.Prim.Word# -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
+  naturalFromBigNat# :: GHC.Internal.Bignum.BigNat.BigNat# -> Natural
+  naturalFromByteArray# :: forall s. GHC.Prim.Word# -> GHC.Prim.ByteArray# -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, Natural #)
   naturalFromWord :: GHC.Types.Word -> Natural
   naturalFromWord# :: GHC.Prim.Word# -> Natural
   naturalFromWord2# :: GHC.Prim.Word# -> GHC.Prim.Word# -> Natural
   naturalFromWordList :: [GHC.Types.Word] -> Natural
   naturalGcd :: Natural -> Natural -> Natural
   naturalGe :: Natural -> Natural -> GHC.Types.Bool
-  naturalGe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalGt :: Natural -> Natural -> GHC.Types.Bool
-  naturalGt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalGt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalIsOne :: Natural -> GHC.Types.Bool
   naturalIsPowerOf2# :: Natural -> (# (# #) | GHC.Prim.Word# #)
   naturalIsZero :: Natural -> GHC.Types.Bool
   naturalLcm :: Natural -> Natural -> Natural
   naturalLe :: Natural -> Natural -> GHC.Types.Bool
-  naturalLe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalLog2 :: Natural -> GHC.Types.Word
   naturalLog2# :: Natural -> GHC.Prim.Word#
   naturalLogBase :: Natural -> Natural -> GHC.Types.Word
@@ -8872,10 +8872,10 @@ module GHC.Num.Natural where
   naturalLogBaseWord :: GHC.Types.Word -> Natural -> GHC.Types.Word
   naturalLogBaseWord# :: GHC.Prim.Word# -> Natural -> GHC.Prim.Word#
   naturalLt :: Natural -> Natural -> GHC.Types.Bool
-  naturalLt# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalLt# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalMul :: Natural -> Natural -> Natural
   naturalNe :: Natural -> Natural -> GHC.Types.Bool
-  naturalNe# :: Natural -> Natural -> GHC.Num.Primitives.Bool#
+  naturalNe# :: Natural -> Natural -> GHC.Internal.Bignum.Primitives.Bool#
   naturalNegate :: Natural -> Natural
   naturalOne :: Natural
   naturalOr :: Natural -> Natural -> Natural
@@ -8899,11 +8899,11 @@ module GHC.Num.Natural where
   naturalSubThrow :: Natural -> Natural -> Natural
   naturalSubUnsafe :: Natural -> Natural -> Natural
   naturalTestBit :: Natural -> GHC.Types.Word -> GHC.Types.Bool
-  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool#
-  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
-  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
-  naturalToBigNat# :: Natural -> GHC.Num.BigNat.BigNat#
-  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Num.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalTestBit# :: Natural -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool#
+  naturalToAddr :: Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Types.IO GHC.Types.Word
+  naturalToAddr# :: forall s. Natural -> GHC.Prim.Addr# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
+  naturalToBigNat# :: Natural -> GHC.Internal.Bignum.BigNat.BigNat#
+  naturalToMutableByteArray# :: forall s. Natural -> GHC.Prim.MutableByteArray# s -> GHC.Prim.Word# -> GHC.Internal.Bignum.Primitives.Bool# -> GHC.Prim.State# s -> (# GHC.Prim.State# s, GHC.Prim.Word# #)
   naturalToWord :: Natural -> GHC.Types.Word
   naturalToWord# :: Natural -> GHC.Prim.Word#
   naturalToWordClamp :: Natural -> GHC.Types.Word
@@ -9210,12 +9210,12 @@ module GHC.Real where
     mod :: a -> a -> a
     quotRem :: a -> a -> (a, a)
     divMod :: a -> a -> (a, a)
-    toInteger :: a -> GHC.Num.Integer.Integer
+    toInteger :: a -> GHC.Internal.Bignum.Integer.Integer
     {-# MINIMAL quotRem, toInteger #-}
   type Ratio :: * -> *
   data Ratio a = !a :% !a
   type Rational :: *
-  type Rational = Ratio GHC.Num.Integer.Integer
+  type Rational = Ratio GHC.Internal.Bignum.Integer.Integer
   type Real :: * -> Constraint
   class (GHC.Internal.Num.Num a, GHC.Classes.Ord a) => Real a where
     toRational :: a -> Rational
@@ -9243,9 +9243,9 @@ module GHC.Real where
   integralEnumFromThenTo :: forall a. Integral a => a -> a -> a -> [a]
   integralEnumFromTo :: forall a. Integral a => a -> a -> [a]
   lcm :: forall a. Integral a => a -> a -> a
-  mkRationalBase10 :: Rational -> GHC.Num.Integer.Integer -> Rational
-  mkRationalBase2 :: Rational -> GHC.Num.Integer.Integer -> Rational
-  mkRationalWithExponentBase :: Rational -> GHC.Num.Integer.Integer -> FractionalExponentBase -> Rational
+  mkRationalBase10 :: Rational -> GHC.Internal.Bignum.Integer.Integer -> Rational
+  mkRationalBase2 :: Rational -> GHC.Internal.Bignum.Integer.Integer -> Rational
+  mkRationalWithExponentBase :: Rational -> GHC.Internal.Bignum.Integer.Integer -> FractionalExponentBase -> Rational
   notANumber :: Rational
   numerator :: forall a. Ratio a -> a
   numericEnumFrom :: forall a. Fractional a => a -> [a]
@@ -9655,15 +9655,15 @@ module GHC.TypeLits where
   decideNat :: forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *) (proxy2 :: Nat -> *). (KnownNat a, KnownNat b) => proxy1 a -> proxy2 b -> GHC.Internal.Data.Either.Either ((a GHC.Internal.Data.Type.Equality.:~: b) -> GHC.Internal.Base.Void) (a GHC.Internal.Data.Type.Equality.:~: b)
   decideSymbol :: forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *) (proxy2 :: Symbol -> *). (KnownSymbol a, KnownSymbol b) => proxy1 a -> proxy2 b -> GHC.Internal.Data.Either.Either ((a GHC.Internal.Data.Type.Equality.:~: b) -> GHC.Internal.Base.Void) (a GHC.Internal.Data.Type.Equality.:~: b)
   fromSChar :: forall (c :: GHC.Types.Char). SChar c -> GHC.Types.Char
-  fromSNat :: forall (n :: Nat). SNat n -> GHC.Num.Integer.Integer
+  fromSNat :: forall (n :: Nat). SNat n -> GHC.Internal.Bignum.Integer.Integer
   fromSSymbol :: forall (s :: Symbol). SSymbol s -> GHC.Internal.Base.String
-  natVal :: forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> GHC.Num.Integer.Integer
-  natVal' :: forall (n :: Nat). KnownNat n => GHC.Prim.Proxy# n -> GHC.Num.Integer.Integer
+  natVal :: forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> GHC.Internal.Bignum.Integer.Integer
+  natVal' :: forall (n :: Nat). KnownNat n => GHC.Prim.Proxy# n -> GHC.Internal.Bignum.Integer.Integer
   sameChar :: forall (a :: GHC.Types.Char) (b :: GHC.Types.Char) (proxy1 :: GHC.Types.Char -> *) (proxy2 :: GHC.Types.Char -> *). (KnownChar a, KnownChar b) => proxy1 a -> proxy2 b -> GHC.Internal.Maybe.Maybe (a GHC.Internal.Data.Type.Equality.:~: b)
   sameNat :: forall (a :: Nat) (b :: Nat) (proxy1 :: Nat -> *) (proxy2 :: Nat -> *). (KnownNat a, KnownNat b) => proxy1 a -> proxy2 b -> GHC.Internal.Maybe.Maybe (a GHC.Internal.Data.Type.Equality.:~: b)
   sameSymbol :: forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *) (proxy2 :: Symbol -> *). (KnownSymbol a, KnownSymbol b) => proxy1 a -> proxy2 b -> GHC.Internal.Maybe.Maybe (a GHC.Internal.Data.Type.Equality.:~: b)
   someCharVal :: GHC.Types.Char -> SomeChar
-  someNatVal :: GHC.Num.Integer.Integer -> GHC.Internal.Maybe.Maybe SomeNat
+  someNatVal :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Maybe.Maybe SomeNat
   someSymbolVal :: GHC.Internal.Base.String -> SomeSymbol
   symbolVal :: forall (n :: Symbol) (proxy :: Symbol -> *). KnownSymbol n => proxy n -> GHC.Internal.Base.String
   symbolVal' :: forall (n :: Symbol). KnownSymbol n => GHC.Prim.Proxy# n -> GHC.Internal.Base.String
@@ -9671,7 +9671,7 @@ module GHC.TypeLits where
   withKnownNat :: forall (n :: Nat) (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). SNat n -> (KnownNat n => r) -> r
   withKnownSymbol :: forall (s :: Symbol) (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). SSymbol s -> (KnownSymbol s => r) -> r
   withSomeSChar :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Types.Char -> (forall (c :: GHC.Types.Char). SChar c -> r) -> r
-  withSomeSNat :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Num.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
+  withSomeSNat :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Bignum.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
   withSomeSSymbol :: forall (rep :: GHC.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Base.String -> (forall (s :: Symbol). SSymbol s -> r) -> r
 
 module GHC.TypeLits.Internal where
@@ -9861,7 +9861,7 @@ module Numeric where
     log1pexp :: a -> a
     log1mexp :: a -> a
     {-# MINIMAL pi, exp, log, sin, cos, asin, acos, atan, sinh, cosh, asinh, acosh, atanh #-}
-  floatToDigits :: forall a. GHC.Internal.Float.RealFloat a => GHC.Num.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
+  floatToDigits :: forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Bignum.Integer.Integer -> a -> ([GHC.Types.Int], GHC.Types.Int)
   fromRat :: forall a. GHC.Internal.Float.RealFloat a => GHC.Internal.Real.Rational -> a
   lexDigits :: GHC.Internal.Text.ParserCombinators.ReadP.ReadS GHC.Internal.Base.String
   readBin :: forall a. (GHC.Classes.Eq a, GHC.Internal.Num.Num a) => GHC.Internal.Text.ParserCombinators.ReadP.ReadS a
@@ -10214,8 +10214,8 @@ module Prelude where
 
 module System.CPUTime where
   -- Safety: Trustworthy
-  cpuTimePrecision :: GHC.Num.Integer.Integer
-  getCPUTime :: GHC.Types.IO GHC.Num.Integer.Integer
+  cpuTimePrecision :: GHC.Internal.Bignum.Integer.Integer
+  getCPUTime :: GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
 
 module System.Console.GetOpt where
   -- Safety: Safe
@@ -10295,7 +10295,7 @@ module System.IO where
   getContents' :: IO GHC.Internal.Base.String
   getLine :: IO GHC.Internal.Base.String
   hClose :: Handle -> IO ()
-  hFileSize :: Handle -> IO GHC.Num.Integer.Integer
+  hFileSize :: Handle -> IO GHC.Internal.Bignum.Integer.Integer
   hFlush :: Handle -> IO ()
   hGetBuf :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> IO GHC.Types.Int
   hGetBufNonBlocking :: forall a. Handle -> GHC.Internal.Ptr.Ptr a -> GHC.Types.Int -> IO GHC.Types.Int
@@ -10323,16 +10323,16 @@ module System.IO where
   hPutStr :: Handle -> GHC.Internal.Base.String -> IO ()
   hPutStrLn :: Handle -> GHC.Internal.Base.String -> IO ()
   hReady :: Handle -> IO GHC.Types.Bool
-  hSeek :: Handle -> SeekMode -> GHC.Num.Integer.Integer -> IO ()
+  hSeek :: Handle -> SeekMode -> GHC.Internal.Bignum.Integer.Integer -> IO ()
   hSetBinaryMode :: Handle -> GHC.Types.Bool -> IO ()
   hSetBuffering :: Handle -> BufferMode -> IO ()
   hSetEcho :: Handle -> GHC.Types.Bool -> IO ()
   hSetEncoding :: Handle -> TextEncoding -> IO ()
-  hSetFileSize :: Handle -> GHC.Num.Integer.Integer -> IO ()
+  hSetFileSize :: Handle -> GHC.Internal.Bignum.Integer.Integer -> IO ()
   hSetNewlineMode :: Handle -> NewlineMode -> IO ()
   hSetPosn :: HandlePosn -> IO ()
   hShow :: Handle -> IO GHC.Internal.Base.String
-  hTell :: Handle -> IO GHC.Num.Integer.Integer
+  hTell :: Handle -> IO GHC.Internal.Bignum.Integer.Integer
   hWaitForInput :: Handle -> GHC.Types.Int -> IO GHC.Types.Bool
   interact :: (GHC.Internal.Base.String -> GHC.Internal.Base.String) -> IO ()
   isEOF :: IO GHC.Types.Bool
@@ -10560,7 +10560,7 @@ module System.Posix.Internals where
   const_vmin :: GHC.Internal.Foreign.C.Types.CInt
   const_vtime :: GHC.Internal.Foreign.C.Types.CInt
   dEFAULT_BUFFER_SIZE :: GHC.Types.Int
-  fdFileSize :: FD -> GHC.Types.IO GHC.Num.Integer.Integer
+  fdFileSize :: FD -> GHC.Types.IO GHC.Internal.Bignum.Integer.Integer
   fdGetMode :: FD -> GHC.Types.IO GHC.Internal.IO.IOMode.IOMode
   fdStat :: FD -> GHC.Types.IO (GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
   fdType :: FD -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
@@ -10726,7 +10726,7 @@ module Text.Printf where
   errorShortFormat :: forall a. a
   formatChar :: GHC.Types.Char -> FieldFormatter
   formatInt :: forall a. (GHC.Internal.Real.Integral a, GHC.Internal.Enum.Bounded a) => a -> FieldFormatter
-  formatInteger :: GHC.Num.Integer.Integer -> FieldFormatter
+  formatInteger :: GHC.Internal.Bignum.Integer.Integer -> FieldFormatter
   formatRealFloat :: forall a. GHC.Internal.Float.RealFloat a => a -> FieldFormatter
   formatString :: forall a. IsChar a => [a] -> FieldFormatter
   hPrintf :: forall r. HPrintfType r => GHC.Internal.IO.Handle.Types.Handle -> GHC.Internal.Base.String -> r
@@ -10788,8 +10788,8 @@ module Text.Read.Lex where
   isSymbolChar :: GHC.Types.Char -> GHC.Types.Bool
   lex :: GHC.Internal.Text.ParserCombinators.ReadP.ReadP Lexeme
   lexChar :: GHC.Internal.Text.ParserCombinators.ReadP.ReadP GHC.Types.Char
-  numberToFixed :: GHC.Num.Integer.Integer -> Number -> GHC.Internal.Maybe.Maybe (GHC.Num.Integer.Integer, GHC.Num.Integer.Integer)
-  numberToInteger :: Number -> GHC.Internal.Maybe.Maybe GHC.Num.Integer.Integer
+  numberToFixed :: GHC.Internal.Bignum.Integer.Integer -> Number -> GHC.Internal.Maybe.Maybe (GHC.Internal.Bignum.Integer.Integer, GHC.Internal.Bignum.Integer.Integer)
+  numberToInteger :: Number -> GHC.Internal.Maybe.Maybe GHC.Internal.Bignum.Integer.Integer
   numberToRangedRational :: (GHC.Types.Int, GHC.Types.Int) -> Number -> GHC.Internal.Maybe.Maybe GHC.Internal.Real.Rational
   numberToRational :: Number -> GHC.Internal.Real.Rational
   readBinP :: forall a. (GHC.Classes.Eq a, GHC.Internal.Num.Num a) => GHC.Internal.Text.ParserCombinators.ReadP.ReadP a
@@ -11025,9 +11025,9 @@ instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int16 -- Defined in ‘Te
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int32 -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int64 -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Int.Int8 -- Defined in ‘Text.Printf’
-instance [safe] Text.Printf.PrintfArg GHC.Num.Integer.Integer -- Defined in ‘Text.Printf’
+instance [safe] Text.Printf.PrintfArg GHC.Internal.Bignum.Integer.Integer -- Defined in ‘Text.Printf’
 instance [safe] forall c. Text.Printf.IsChar c => Text.Printf.PrintfArg [c] -- Defined in ‘Text.Printf’
-instance [safe] Text.Printf.PrintfArg GHC.Num.Natural.Natural -- Defined in ‘Text.Printf’
+instance [safe] Text.Printf.PrintfArg GHC.Internal.Bignum.Natural.Natural -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Types.Word -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Word.Word16 -- Defined in ‘Text.Printf’
 instance [safe] Text.Printf.PrintfArg GHC.Internal.Word.Word32 -- Defined in ‘Text.Printf’
@@ -11281,8 +11281,8 @@ instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Bits.Bits (GHC.Inter
 instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Bits.Bits (GHC.Internal.Data.Bits.Xor a) -- Defined in ‘GHC.Internal.Data.Bits’
 instance GHC.Internal.Bits.Bits GHC.Types.Bool -- Defined in ‘GHC.Internal.Bits’
 instance GHC.Internal.Bits.Bits GHC.Types.Int -- Defined in ‘GHC.Internal.Bits’
-instance GHC.Internal.Bits.Bits GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Bits’
-instance GHC.Internal.Bits.Bits GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Bits’
+instance GHC.Internal.Bits.Bits GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Bits’
+instance GHC.Internal.Bits.Bits GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bits’
 instance GHC.Internal.Bits.Bits GHC.Types.Word -- Defined in ‘GHC.Internal.Bits’
 instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Bits.Bits (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.Functor.Identity’
 instance GHC.Internal.Bits.Bits GHC.Internal.Int.Int16 -- Defined in ‘GHC.Internal.Int’
@@ -11438,11 +11438,11 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Int.Int32 -- Defined in ‘GHC
 instance GHC.Internal.Data.Data.Data GHC.Internal.Int.Int64 -- Defined in ‘GHC.Internal.Data.Data’
 instance GHC.Internal.Data.Data.Data GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.Data.Data’
 instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Data.Data’
-instance GHC.Internal.Data.Data.Data GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Data.Data’
+instance GHC.Internal.Data.Data.Data GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Monoid.Last a) -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data [a] -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.Data.Data’
-instance GHC.Internal.Data.Data.Data GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Data.Data’
+instance GHC.Internal.Data.Data.Data GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Data.Data’
 instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Data.Data’
 instance GHC.Internal.Data.Data.Data GHC.Types.Ordering -- Defined in ‘GHC.Internal.Data.Data’
 instance forall p. GHC.Internal.Data.Data.Data p => GHC.Internal.Data.Data.Data (GHC.Internal.Generics.Par1 p) -- Defined in ‘GHC.Internal.Data.Data’
@@ -11629,9 +11629,9 @@ instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (GHC.Inter
 instance GHC.Internal.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Internal.Enum’
-instance GHC.Internal.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Enum GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Internal.Enum’
-instance GHC.Internal.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Enum’
+instance GHC.Internal.Enum.Enum GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Internal.Enum’
 instance forall a. GHC.Internal.Enum.Enum a => GHC.Internal.Enum.Enum (Solo a) -- Defined in ‘GHC.Internal.Enum’
 instance GHC.Internal.Enum.Enum () -- Defined in ‘GHC.Internal.Enum’
@@ -11975,8 +11975,8 @@ instance GHC.Internal.Ix.Ix GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.
 instance GHC.Internal.Ix.Ix GHC.Types.Bool -- Defined in ‘GHC.Internal.Ix’
 instance GHC.Internal.Ix.Ix GHC.Types.Char -- Defined in ‘GHC.Internal.Ix’
 instance GHC.Internal.Ix.Ix GHC.Types.Int -- Defined in ‘GHC.Internal.Ix’
-instance GHC.Internal.Ix.Ix GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Ix’
-instance GHC.Internal.Ix.Ix GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Ix’
+instance GHC.Internal.Ix.Ix GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Ix’
+instance GHC.Internal.Ix.Ix GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Ix’
 instance GHC.Internal.Ix.Ix GHC.Types.Ordering -- Defined in ‘GHC.Internal.Ix’
 instance forall a. GHC.Internal.Ix.Ix a => GHC.Internal.Ix.Ix (Solo a) -- Defined in ‘GHC.Internal.Ix’
 instance forall a1 a2 a3 a4 a5 a6 a7 a8 a9 aA. (GHC.Internal.Ix.Ix a1, GHC.Internal.Ix.Ix a2, GHC.Internal.Ix.Ix a3, GHC.Internal.Ix.Ix a4, GHC.Internal.Ix.Ix a5, GHC.Internal.Ix.Ix a6, GHC.Internal.Ix.Ix a7, GHC.Internal.Ix.Ix a8, GHC.Internal.Ix.Ix a9, GHC.Internal.Ix.Ix aA) => GHC.Internal.Ix.Ix (a1, a2, a3, a4, a5, a6, a7, a8, a9, aA) -- Defined in ‘GHC.Internal.Ix’
@@ -12081,8 +12081,8 @@ instance GHC.Internal.Num.Num GHC.Internal.Foreign.C.Types.CWchar -- Defined in
 instance GHC.Internal.Num.Num GHC.Types.Double -- Defined in ‘GHC.Internal.Float’
 instance GHC.Internal.Num.Num GHC.Types.Float -- Defined in ‘GHC.Internal.Float’
 instance GHC.Internal.Num.Num GHC.Types.Int -- Defined in ‘GHC.Internal.Num’
-instance GHC.Internal.Num.Num GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Num’
-instance GHC.Internal.Num.Num GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Num’
+instance GHC.Internal.Num.Num GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Num’
+instance GHC.Internal.Num.Num GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Num’
 instance GHC.Internal.Num.Num GHC.Types.Word -- Defined in ‘GHC.Internal.Num’
 instance forall k a (b :: k). GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.Functor.Const’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’
@@ -12098,11 +12098,11 @@ instance GHC.Internal.Read.Read GHC.Types.Double -- Defined in ‘GHC.Internal.R
 instance GHC.Internal.Read.Read GHC.Types.Float -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Internal.Unicode.GeneralCategory -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Types.Int -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Read’
+instance GHC.Internal.Read.Read GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Internal.Text.Read.Lex.Lexeme -- Defined in ‘GHC.Internal.Read’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read [a] -- Defined in ‘GHC.Internal.Read’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.Read’
-instance GHC.Internal.Read.Read GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Read’
+instance GHC.Internal.Read.Read GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Read’
 instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Read’
 instance GHC.Internal.Read.Read GHC.Types.Ordering -- Defined in ‘GHC.Internal.Read’
 instance forall a. (GHC.Internal.Real.Integral a, GHC.Internal.Read.Read a) => GHC.Internal.Read.Read (GHC.Internal.Real.Ratio a) -- Defined in ‘GHC.Internal.Read’
@@ -12233,8 +12233,8 @@ instance GHC.Internal.Real.Integral GHC.Internal.Int.Int32 -- Defined in ‘GHC.
 instance GHC.Internal.Real.Integral GHC.Internal.Int.Int64 -- Defined in ‘GHC.Internal.Int’
 instance GHC.Internal.Real.Integral GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.Int’
 instance GHC.Internal.Real.Integral GHC.Types.Int -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Integral GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Integral GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Integral GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Integral GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Integral GHC.Types.Word -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Integral GHC.Internal.Word.Word16 -- Defined in ‘GHC.Internal.Word’
 instance GHC.Internal.Real.Integral GHC.Internal.Word.Word32 -- Defined in ‘GHC.Internal.Word’
@@ -12272,8 +12272,8 @@ instance GHC.Internal.Real.Real GHC.Internal.Int.Int64 -- Defined in ‘GHC.Inte
 instance GHC.Internal.Real.Real GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.Int’
 instance forall a. GHC.Internal.Real.Real a => GHC.Internal.Real.Real (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
 instance GHC.Internal.Real.Real GHC.Types.Int -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Real GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Real’
-instance GHC.Internal.Real.Real GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Real GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Real’
+instance GHC.Internal.Real.Real GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Real’
 instance forall a. GHC.Internal.Real.Integral a => GHC.Internal.Real.Real (GHC.Internal.Real.Ratio a) -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Real GHC.Types.Word -- Defined in ‘GHC.Internal.Real’
 instance GHC.Internal.Real.Real GHC.Internal.Word.Word16 -- Defined in ‘GHC.Internal.Word’
@@ -12365,13 +12365,13 @@ instance GHC.Internal.Show.Show GHC.Types.Bool -- Defined in ‘GHC.Internal.Sho
 instance GHC.Internal.Show.Show GHC.Internal.Stack.Types.CallStack -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Char -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Int -- Defined in ‘GHC.Internal.Show’
-instance GHC.Internal.Show.Show GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.Show’
+instance GHC.Internal.Show.Show GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.KindRep -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Levity -- Defined in ‘GHC.Internal.Show’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show [a] -- Defined in ‘GHC.Internal.Show’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Module -- Defined in ‘GHC.Internal.Show’
-instance GHC.Internal.Show.Show GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.Show’
+instance GHC.Internal.Show.Show GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Show’
 instance forall a. GHC.Internal.Show.Show a => GHC.Internal.Show.Show (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.Ordering -- Defined in ‘GHC.Internal.Show’
 instance GHC.Internal.Show.Show GHC.Types.RuntimeRep -- Defined in ‘GHC.Internal.Show’
@@ -12740,9 +12740,9 @@ instance GHC.Classes.Eq GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘G
 instance forall i e. GHC.Classes.Eq (GHC.Internal.IOArray.IOArray i e) -- Defined in ‘GHC.Internal.IOArray’
 instance forall a. GHC.Classes.Eq (GHC.Internal.IOPort.IOPort a) -- Defined in ‘GHC.Internal.IOPort’
 instance GHC.Classes.Eq GHC.Internal.InfoProv.Types.InfoProv -- Defined in ‘GHC.Internal.InfoProv.Types’
-instance GHC.Classes.Eq GHC.Num.Integer.Integer -- Defined in ‘GHC.Num.Integer’
-instance GHC.Classes.Eq GHC.Num.BigNat.BigNat -- Defined in ‘GHC.Num.BigNat’
-instance GHC.Classes.Eq GHC.Num.Natural.Natural -- Defined in ‘GHC.Num.Natural’
+instance GHC.Classes.Eq GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Bignum.Integer’
+instance GHC.Classes.Eq GHC.Internal.Bignum.BigNat.BigNat -- Defined in ‘GHC.Internal.Bignum.BigNat’
+instance GHC.Classes.Eq GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’
 instance GHC.Classes.Eq GHC.Internal.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.Internal.RTS.Flags’
 instance forall a. GHC.Classes.Eq (GHC.Internal.StableName.StableName a) -- Defined in ‘GHC.Internal.StableName’
 instance GHC.Classes.Eq GHC.Internal.Stack.CloneStack.StackEntry -- Defined in ‘GHC.Internal.Stack.CloneStack’
@@ -12896,9 +12896,9 @@ instance GHC.Classes.Ord GHC.Internal.IO.Handle.Types.BufferMode -- Defined in 
 instance GHC.Classes.Ord GHC.Internal.IO.Handle.Types.Newline -- Defined in ‘GHC.Internal.IO.Handle.Types’
 instance GHC.Classes.Ord GHC.Internal.IO.Handle.Types.NewlineMode -- Defined in ‘GHC.Internal.IO.Handle.Types’
 instance GHC.Classes.Ord GHC.Internal.IO.IOMode.IOMode -- Defined in ‘GHC.Internal.IO.IOMode’
-instance GHC.Classes.Ord GHC.Num.Integer.Integer -- Defined in ‘GHC.Num.Integer’
-instance GHC.Classes.Ord GHC.Num.BigNat.BigNat -- Defined in ‘GHC.Num.BigNat’
-instance GHC.Classes.Ord GHC.Num.Natural.Natural -- Defined in ‘GHC.Num.Natural’
+instance GHC.Classes.Ord GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.Bignum.Integer’
+instance GHC.Classes.Ord GHC.Internal.Bignum.BigNat.BigNat -- Defined in ‘GHC.Internal.Bignum.BigNat’
+instance GHC.Classes.Ord GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.Bignum.Natural’
 instance forall (n :: GHC.Internal.TypeNats.Nat). GHC.Classes.Ord (GHC.Internal.TypeNats.SNat n) -- Defined in ‘GHC.Internal.TypeNats’
 instance GHC.Classes.Ord GHC.Internal.TypeNats.SomeNat -- Defined in ‘GHC.Internal.TypeNats’
 instance forall (c :: GHC.Types.Char). GHC.Classes.Ord (GHC.Internal.TypeLits.SChar c) -- Defined in ‘GHC.Internal.TypeLits’
diff --git a/testsuite/tests/interface-stability/ghc-experimental-exports.stdout b/testsuite/tests/interface-stability/ghc-experimental-exports.stdout
index 5beef7b57e1..07856374080 100644
--- a/testsuite/tests/interface-stability/ghc-experimental-exports.stdout
+++ b/testsuite/tests/interface-stability/ghc-experimental-exports.stdout
@@ -6311,14 +6311,14 @@ module GHC.TypeLits.Experimental where
   appendSSymbol :: forall (a :: GHC.Types.Symbol) (b :: GHC.Types.Symbol). GHC.Internal.TypeLits.SSymbol a -> GHC.Internal.TypeLits.SSymbol b -> GHC.Internal.TypeLits.SSymbol (GHC.Internal.TypeLits.AppendSymbol a b)
   consSSymbol :: forall (a :: GHC.Types.Char) (b :: GHC.Types.Symbol). GHC.Internal.TypeLits.SChar a -> GHC.Internal.TypeLits.SSymbol b -> GHC.Internal.TypeLits.SSymbol (GHC.Internal.TypeLits.ConsSymbol a b)
   sCharToSNat :: forall (a :: GHC.Types.Char). GHC.Internal.TypeLits.SChar a -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeLits.CharToNat a)
-  sNatToSChar :: forall (n :: GHC.Num.Natural.Natural). (n GHC.Internal.Data.Type.Ord.<= 1114111) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeLits.SChar (GHC.Internal.TypeLits.NatToChar n)
+  sNatToSChar :: forall (n :: GHC.Internal.Bignum.Natural.Natural). (n GHC.Internal.Data.Type.Ord.<= 1114111) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeLits.SChar (GHC.Internal.TypeLits.NatToChar n)
 
 module GHC.TypeNats.Experimental where
   -- Safety: None
-  divSNat :: forall (m :: GHC.Num.Natural.Natural) (n :: GHC.Internal.TypeNats.Nat). (1 GHC.Internal.Data.Type.Ord.<= m) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeNats.Div n m)
-  log2SNat :: forall (n :: GHC.Num.Natural.Natural). (1 GHC.Internal.Data.Type.Ord.<= n) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeNats.Log2 n)
+  divSNat :: forall (m :: GHC.Internal.Bignum.Natural.Natural) (n :: GHC.Internal.TypeNats.Nat). (1 GHC.Internal.Data.Type.Ord.<= m) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeNats.Div n m)
+  log2SNat :: forall (n :: GHC.Internal.Bignum.Natural.Natural). (1 GHC.Internal.Data.Type.Ord.<= n) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeNats.Log2 n)
   minusSNat :: forall (m :: GHC.Internal.TypeNats.Nat) (n :: GHC.Internal.TypeNats.Nat). (m GHC.Internal.Data.Type.Ord.<= n) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (n GHC.Internal.TypeNats.- m)
-  modSNat :: forall (m :: GHC.Num.Natural.Natural) (n :: GHC.Internal.TypeNats.Nat). (1 GHC.Internal.Data.Type.Ord.<= m) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeNats.Mod n m)
+  modSNat :: forall (m :: GHC.Internal.Bignum.Natural.Natural) (n :: GHC.Internal.TypeNats.Nat). (1 GHC.Internal.Data.Type.Ord.<= m) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeNats.Mod n m)
   plusSNat :: forall (n :: GHC.Internal.TypeNats.Nat) (m :: GHC.Internal.TypeNats.Nat). GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (n GHC.Internal.TypeNats.+ m)
   powerSNat :: forall (n :: GHC.Internal.TypeNats.Nat) (m :: GHC.Internal.TypeNats.Nat). GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (n GHC.Internal.TypeNats.^ m)
   timesSNat :: forall (n :: GHC.Internal.TypeNats.Nat) (m :: GHC.Internal.TypeNats.Nat). GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (n GHC.Internal.TypeNats.* m)
diff --git a/testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 b/testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
index 18157cf3ee4..ec2478315d1 100644
--- a/testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
+++ b/testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
@@ -6314,14 +6314,14 @@ module GHC.TypeLits.Experimental where
   appendSSymbol :: forall (a :: GHC.Types.Symbol) (b :: GHC.Types.Symbol). GHC.Internal.TypeLits.SSymbol a -> GHC.Internal.TypeLits.SSymbol b -> GHC.Internal.TypeLits.SSymbol (GHC.Internal.TypeLits.AppendSymbol a b)
   consSSymbol :: forall (a :: GHC.Types.Char) (b :: GHC.Types.Symbol). GHC.Internal.TypeLits.SChar a -> GHC.Internal.TypeLits.SSymbol b -> GHC.Internal.TypeLits.SSymbol (GHC.Internal.TypeLits.ConsSymbol a b)
   sCharToSNat :: forall (a :: GHC.Types.Char). GHC.Internal.TypeLits.SChar a -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeLits.CharToNat a)
-  sNatToSChar :: forall (n :: GHC.Num.Natural.Natural). (n GHC.Internal.Data.Type.Ord.<= 1114111) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeLits.SChar (GHC.Internal.TypeLits.NatToChar n)
+  sNatToSChar :: forall (n :: GHC.Internal.Bignum.Natural.Natural). (n GHC.Internal.Data.Type.Ord.<= 1114111) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeLits.SChar (GHC.Internal.TypeLits.NatToChar n)
 
 module GHC.TypeNats.Experimental where
   -- Safety: None
-  divSNat :: forall (m :: GHC.Num.Natural.Natural) (n :: GHC.Internal.TypeNats.Nat). (1 GHC.Internal.Data.Type.Ord.<= m) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeNats.Div n m)
-  log2SNat :: forall (n :: GHC.Num.Natural.Natural). (1 GHC.Internal.Data.Type.Ord.<= n) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeNats.Log2 n)
+  divSNat :: forall (m :: GHC.Internal.Bignum.Natural.Natural) (n :: GHC.Internal.TypeNats.Nat). (1 GHC.Internal.Data.Type.Ord.<= m) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeNats.Div n m)
+  log2SNat :: forall (n :: GHC.Internal.Bignum.Natural.Natural). (1 GHC.Internal.Data.Type.Ord.<= n) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeNats.Log2 n)
   minusSNat :: forall (m :: GHC.Internal.TypeNats.Nat) (n :: GHC.Internal.TypeNats.Nat). (m GHC.Internal.Data.Type.Ord.<= n) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (n GHC.Internal.TypeNats.- m)
-  modSNat :: forall (m :: GHC.Num.Natural.Natural) (n :: GHC.Internal.TypeNats.Nat). (1 GHC.Internal.Data.Type.Ord.<= m) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeNats.Mod n m)
+  modSNat :: forall (m :: GHC.Internal.Bignum.Natural.Natural) (n :: GHC.Internal.TypeNats.Nat). (1 GHC.Internal.Data.Type.Ord.<= m) => GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (GHC.Internal.TypeNats.Mod n m)
   plusSNat :: forall (n :: GHC.Internal.TypeNats.Nat) (m :: GHC.Internal.TypeNats.Nat). GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (n GHC.Internal.TypeNats.+ m)
   powerSNat :: forall (n :: GHC.Internal.TypeNats.Nat) (m :: GHC.Internal.TypeNats.Nat). GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (n GHC.Internal.TypeNats.^ m)
   timesSNat :: forall (n :: GHC.Internal.TypeNats.Nat) (m :: GHC.Internal.TypeNats.Nat). GHC.Internal.TypeNats.SNat n -> GHC.Internal.TypeNats.SNat m -> GHC.Internal.TypeNats.SNat (n GHC.Internal.TypeNats.* m)
diff --git a/testsuite/tests/interface-stability/template-haskell-exports.stdout b/testsuite/tests/interface-stability/template-haskell-exports.stdout
index 08608d4c66d..fd47c5e4cd4 100644
--- a/testsuite/tests/interface-stability/template-haskell-exports.stdout
+++ b/testsuite/tests/interface-stability/template-haskell-exports.stdout
@@ -304,7 +304,7 @@ module Language.Haskell.TH where
   type KindQ :: *
   type KindQ = Q Kind
   type Lit :: *
-  data Lit = CharL GHC.Types.Char | StringL GHC.Internal.Base.String | IntegerL GHC.Num.Integer.Integer | RationalL GHC.Internal.Real.Rational | IntPrimL GHC.Num.Integer.Integer | WordPrimL GHC.Num.Integer.Integer | FloatPrimL GHC.Internal.Real.Rational | DoublePrimL GHC.Internal.Real.Rational | StringPrimL [GHC.Internal.Word.Word8] | BytesPrimL GHC.Internal.TH.Syntax.Bytes | CharPrimL GHC.Types.Char
+  data Lit = CharL GHC.Types.Char | StringL GHC.Internal.Base.String | IntegerL GHC.Internal.Bignum.Integer.Integer | RationalL GHC.Internal.Real.Rational | IntPrimL GHC.Internal.Bignum.Integer.Integer | WordPrimL GHC.Internal.Bignum.Integer.Integer | FloatPrimL GHC.Internal.Real.Rational | DoublePrimL GHC.Internal.Real.Rational | StringPrimL [GHC.Internal.Word.Word8] | BytesPrimL GHC.Internal.TH.Syntax.Bytes | CharPrimL GHC.Types.Char
   type Loc :: *
   data Loc = Loc {loc_filename :: GHC.Internal.Base.String, loc_package :: GHC.Internal.Base.String, loc_module :: GHC.Internal.Base.String, loc_start :: GHC.Internal.TH.Syntax.CharPos, loc_end :: GHC.Internal.TH.Syntax.CharPos}
   type Match :: *
@@ -399,7 +399,7 @@ module Language.Haskell.TH where
   type TExpQ :: forall (r :: GHC.Types.RuntimeRep). TYPE r -> *
   type TExpQ a = Q (TExp a)
   type TyLit :: *
-  data TyLit = NumTyLit GHC.Num.Integer.Integer | StrTyLit GHC.Internal.Base.String | CharTyLit GHC.Types.Char
+  data TyLit = NumTyLit GHC.Internal.Bignum.Integer.Integer | StrTyLit GHC.Internal.Base.String | CharTyLit GHC.Types.Char
   type TyLitQ :: *
   type TyLitQ = Q TyLit
   type TySynEqn :: *
@@ -526,8 +526,8 @@ module Language.Haskell.TH where
   injectivityAnn :: Name -> [Name] -> GHC.Internal.TH.Lib.InjectivityAnn
   instanceD :: forall (m :: * -> *). Quote m => m Cxt -> m Type -> [m Dec] -> m Dec
   instanceWithOverlapD :: forall (m :: * -> *). Quote m => GHC.Internal.Maybe.Maybe Overlap -> m Cxt -> m Type -> [m Dec] -> m Dec
-  intPrimL :: GHC.Num.Integer.Integer -> Lit
-  integerL :: GHC.Num.Integer.Integer -> Lit
+  intPrimL :: GHC.Internal.Bignum.Integer.Integer -> Lit
+  integerL :: GHC.Internal.Bignum.Integer.Integer -> Lit
   interruptible :: Safety
   invisP :: forall (m :: * -> *). Quote m => m Type -> m Pat
   isExtEnabled :: Extension -> Q GHC.Types.Bool
@@ -586,7 +586,7 @@ module Language.Haskell.TH where
   normalG :: forall (m :: * -> *). Quote m => m Exp -> m Guard
   normalGE :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m (Guard, Exp)
   notStrict :: forall (m :: * -> *). Quote m => m Strict
-  numTyLit :: forall (m :: * -> *). Quote m => GHC.Num.Integer.Integer -> m TyLit
+  numTyLit :: forall (m :: * -> *). Quote m => GHC.Internal.Bignum.Integer.Integer -> m TyLit
   openTypeFamilyD :: forall (m :: * -> *). Quote m => Name -> [TyVarBndr BndrVis] -> FamilyResultSig -> GHC.Internal.Maybe.Maybe InjectivityAnn -> m Dec
   parS :: forall (m :: * -> *). Quote m => [[m Stmt]] -> m Stmt
   parensE :: forall (m :: * -> *). Quote m => m Exp -> m Exp
@@ -725,7 +725,7 @@ module Language.Haskell.TH where
   wildP :: forall (m :: * -> *). Quote m => m Pat
   withDecDoc :: GHC.Internal.Base.String -> Q Dec -> Q Dec
   withDecsDoc :: GHC.Internal.Base.String -> Q [Dec] -> Q [Dec]
-  wordPrimL :: GHC.Num.Integer.Integer -> Lit
+  wordPrimL :: GHC.Internal.Bignum.Integer.Integer -> Lit
 
 module Language.Haskell.TH.CodeDo where
   -- Safety: Safe-Inferred
@@ -1050,8 +1050,8 @@ module Language.Haskell.TH.Lib where
   injectivityAnn :: GHC.Internal.TH.Syntax.Name -> [GHC.Internal.TH.Syntax.Name] -> GHC.Internal.TH.Lib.InjectivityAnn
   instanceD :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Cxt -> m GHC.Internal.TH.Syntax.Type -> [m GHC.Internal.TH.Syntax.Dec] -> m GHC.Internal.TH.Syntax.Dec
   instanceWithOverlapD :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => GHC.Internal.Maybe.Maybe Overlap -> m GHC.Internal.TH.Syntax.Cxt -> m GHC.Internal.TH.Syntax.Type -> [m GHC.Internal.TH.Syntax.Dec] -> m GHC.Internal.TH.Syntax.Dec
-  intPrimL :: GHC.Num.Integer.Integer -> GHC.Internal.TH.Syntax.Lit
-  integerL :: GHC.Num.Integer.Integer -> GHC.Internal.TH.Syntax.Lit
+  intPrimL :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.TH.Syntax.Lit
+  integerL :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.TH.Syntax.Lit
   interruptible :: GHC.Internal.TH.Syntax.Safety
   invisP :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Type -> m GHC.Internal.TH.Syntax.Pat
   isStrict :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Strict
@@ -1096,7 +1096,7 @@ module Language.Haskell.TH.Lib where
   normalG :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Exp -> m GHC.Internal.TH.Syntax.Guard
   normalGE :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Exp -> m GHC.Internal.TH.Syntax.Exp -> m (GHC.Internal.TH.Syntax.Guard, GHC.Internal.TH.Syntax.Exp)
   notStrict :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Strict
-  numTyLit :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => GHC.Num.Integer.Integer -> m GHC.Internal.TH.Syntax.TyLit
+  numTyLit :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => GHC.Internal.Bignum.Integer.Integer -> m GHC.Internal.TH.Syntax.TyLit
   openTypeFamilyD :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => GHC.Internal.TH.Syntax.Name -> [GHC.Internal.TH.Syntax.TyVarBndr GHC.Internal.TH.Syntax.BndrVis] -> GHC.Internal.TH.Syntax.FamilyResultSig -> GHC.Internal.Maybe.Maybe GHC.Internal.TH.Syntax.InjectivityAnn -> m GHC.Internal.TH.Syntax.Dec
   parS :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => [[m GHC.Internal.TH.Syntax.Stmt]] -> m GHC.Internal.TH.Syntax.Stmt
   parensE :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Exp -> m GHC.Internal.TH.Syntax.Exp
@@ -1207,7 +1207,7 @@ module Language.Haskell.TH.Lib where
   wildP :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Pat
   withDecDoc :: GHC.Internal.Base.String -> GHC.Internal.TH.Syntax.Q GHC.Internal.TH.Syntax.Dec -> GHC.Internal.TH.Syntax.Q GHC.Internal.TH.Syntax.Dec
   withDecsDoc :: GHC.Internal.Base.String -> GHC.Internal.TH.Syntax.Q [GHC.Internal.TH.Syntax.Dec] -> GHC.Internal.TH.Syntax.Q [GHC.Internal.TH.Syntax.Dec]
-  wordPrimL :: GHC.Num.Integer.Integer -> GHC.Internal.TH.Syntax.Lit
+  wordPrimL :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.TH.Syntax.Lit
 
 module Language.Haskell.TH.Lib.Internal where
   -- Safety: Safe
@@ -1389,8 +1389,8 @@ module Language.Haskell.TH.Lib.Internal where
   injectivityAnn :: GHC.Internal.TH.Syntax.Name -> [GHC.Internal.TH.Syntax.Name] -> InjectivityAnn
   instanceD :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Cxt -> m GHC.Internal.TH.Syntax.Type -> [m GHC.Internal.TH.Syntax.Dec] -> m GHC.Internal.TH.Syntax.Dec
   instanceWithOverlapD :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => GHC.Internal.Maybe.Maybe GHC.Internal.TH.Syntax.Overlap -> m GHC.Internal.TH.Syntax.Cxt -> m GHC.Internal.TH.Syntax.Type -> [m GHC.Internal.TH.Syntax.Dec] -> m GHC.Internal.TH.Syntax.Dec
-  intPrimL :: GHC.Num.Integer.Integer -> GHC.Internal.TH.Syntax.Lit
-  integerL :: GHC.Num.Integer.Integer -> GHC.Internal.TH.Syntax.Lit
+  intPrimL :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.TH.Syntax.Lit
+  integerL :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.TH.Syntax.Lit
   interruptible :: GHC.Internal.TH.Syntax.Safety
   invisP :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Type -> m GHC.Internal.TH.Syntax.Pat
   isStrict :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Strict
@@ -1434,7 +1434,7 @@ module Language.Haskell.TH.Lib.Internal where
   normalG :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Exp -> m GHC.Internal.TH.Syntax.Guard
   normalGE :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Exp -> m GHC.Internal.TH.Syntax.Exp -> m (GHC.Internal.TH.Syntax.Guard, GHC.Internal.TH.Syntax.Exp)
   notStrict :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Strict
-  numTyLit :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => GHC.Num.Integer.Integer -> m GHC.Internal.TH.Syntax.TyLit
+  numTyLit :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => GHC.Internal.Bignum.Integer.Integer -> m GHC.Internal.TH.Syntax.TyLit
   openTypeFamilyD :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => GHC.Internal.TH.Syntax.Name -> [m (GHC.Internal.TH.Syntax.TyVarBndr GHC.Internal.TH.Syntax.BndrVis)] -> m GHC.Internal.TH.Syntax.FamilyResultSig -> GHC.Internal.Maybe.Maybe InjectivityAnn -> m GHC.Internal.TH.Syntax.Dec
   orP :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => GHC.Internal.Base.NonEmpty (m GHC.Internal.TH.Syntax.Pat) -> m GHC.Internal.TH.Syntax.Pat
   parS :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => [[m GHC.Internal.TH.Syntax.Stmt]] -> m GHC.Internal.TH.Syntax.Stmt
@@ -1549,7 +1549,7 @@ module Language.Haskell.TH.Lib.Internal where
   wildP :: forall (m :: * -> *). GHC.Internal.TH.Syntax.Quote m => m GHC.Internal.TH.Syntax.Pat
   withDecDoc :: GHC.Internal.Base.String -> GHC.Internal.TH.Syntax.Q GHC.Internal.TH.Syntax.Dec -> GHC.Internal.TH.Syntax.Q GHC.Internal.TH.Syntax.Dec
   withDecsDoc :: GHC.Internal.Base.String -> GHC.Internal.TH.Syntax.Q [GHC.Internal.TH.Syntax.Dec] -> GHC.Internal.TH.Syntax.Q [GHC.Internal.TH.Syntax.Dec]
-  wordPrimL :: GHC.Num.Integer.Integer -> GHC.Internal.TH.Syntax.Lit
+  wordPrimL :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.TH.Syntax.Lit
 
 module Language.Haskell.TH.Ppr where
   -- Safety: Safe
@@ -1674,7 +1674,7 @@ module Language.Haskell.TH.PprLib where
   hcat :: [Doc] -> Doc
   hsep :: [Doc] -> Doc
   int :: GHC.Types.Int -> Doc
-  integer :: GHC.Num.Integer.Integer -> Doc
+  integer :: GHC.Internal.Bignum.Integer.Integer -> Doc
   isEmpty :: Doc -> PprM GHC.Types.Bool
   lbrace :: Doc
   lbrack :: Doc
@@ -1983,7 +1983,7 @@ module Language.Haskell.TH.Syntax where
     liftTyped :: forall (m :: * -> *). Quote m => t -> Code m t
     {-# MINIMAL liftTyped #-}
   type Lit :: *
-  data Lit = CharL GHC.Types.Char | StringL GHC.Internal.Base.String | IntegerL GHC.Num.Integer.Integer | RationalL GHC.Internal.Real.Rational | IntPrimL GHC.Num.Integer.Integer | WordPrimL GHC.Num.Integer.Integer | FloatPrimL GHC.Internal.Real.Rational | DoublePrimL GHC.Internal.Real.Rational | StringPrimL [GHC.Internal.Word.Word8] | BytesPrimL Bytes | CharPrimL GHC.Types.Char
+  data Lit = CharL GHC.Types.Char | StringL GHC.Internal.Base.String | IntegerL GHC.Internal.Bignum.Integer.Integer | RationalL GHC.Internal.Real.Rational | IntPrimL GHC.Internal.Bignum.Integer.Integer | WordPrimL GHC.Internal.Bignum.Integer.Integer | FloatPrimL GHC.Internal.Real.Rational | DoublePrimL GHC.Internal.Real.Rational | StringPrimL [GHC.Internal.Word.Word8] | BytesPrimL Bytes | CharPrimL GHC.Types.Char
   type Loc :: *
   data Loc = Loc {loc_filename :: GHC.Internal.Base.String, loc_package :: GHC.Internal.Base.String, loc_module :: GHC.Internal.Base.String, loc_start :: CharPos, loc_end :: CharPos}
   type Match :: *
@@ -2093,7 +2093,7 @@ module Language.Haskell.TH.Syntax where
   type TExp :: forall (r :: GHC.Types.RuntimeRep). TYPE r -> *
   newtype TExp a = TExp {unType :: Exp}
   type TyLit :: *
-  data TyLit = NumTyLit GHC.Num.Integer.Integer | StrTyLit GHC.Internal.Base.String | CharTyLit GHC.Types.Char
+  data TyLit = NumTyLit GHC.Internal.Bignum.Integer.Integer | StrTyLit GHC.Internal.Base.String | CharTyLit GHC.Types.Char
   type TySynEqn :: *
   data TySynEqn = TySynEqn (GHC.Internal.Maybe.Maybe [TyVarBndr ()]) Type Type
   type TyVarBndr :: * -> *
@@ -2103,7 +2103,7 @@ module Language.Haskell.TH.Syntax where
   type TypeFamilyHead :: *
   data TypeFamilyHead = TypeFamilyHead Name [TyVarBndr BndrVis] FamilyResultSig (GHC.Internal.Maybe.Maybe InjectivityAnn)
   type Uniq :: *
-  type Uniq = GHC.Num.Integer.Integer
+  type Uniq = GHC.Internal.Bignum.Integer.Integer
   type Unlifted :: *
   type Unlifted = GHC.Types.Bool
   type VarBangType :: *
@@ -2481,7 +2481,7 @@ instance GHC.Internal.TH.Lift.Lift GHC.Internal.Int.Int16 -- Defined in ‘GHC.I
 instance GHC.Internal.TH.Lift.Lift GHC.Internal.Int.Int32 -- Defined in ‘GHC.Internal.TH.Lift’
 instance GHC.Internal.TH.Lift.Lift GHC.Internal.Int.Int64 -- Defined in ‘GHC.Internal.TH.Lift’
 instance GHC.Internal.TH.Lift.Lift GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.TH.Lift’
-instance GHC.Internal.TH.Lift.Lift GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.Bignum.Integer.Integer -- Defined in ‘GHC.Internal.TH.Lift’
 instance forall a. GHC.Internal.TH.Lift.Lift a => GHC.Internal.TH.Lift.Lift [a] -- Defined in ‘GHC.Internal.TH.Lift’
 instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Lit -- Defined in ‘GHC.Internal.TH.Lift’
 instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Loc -- Defined in ‘GHC.Internal.TH.Lift’
@@ -2494,7 +2494,7 @@ instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.NameFlavour -- Defined
 instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.NameIs -- Defined in ‘GHC.Internal.TH.Lift’
 instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.NameSpace -- Defined in ‘GHC.Internal.TH.Lift’
 instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.NamespaceSpecifier -- Defined in ‘GHC.Internal.TH.Lift’
-instance GHC.Internal.TH.Lift.Lift GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.Bignum.Natural.Natural -- Defined in ‘GHC.Internal.TH.Lift’
 instance forall a. GHC.Internal.TH.Lift.Lift a => GHC.Internal.TH.Lift.Lift (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.TH.Lift’
 instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.OccName -- Defined in ‘GHC.Internal.TH.Lift’
 instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Overlap -- Defined in ‘GHC.Internal.TH.Lift’
diff --git a/testsuite/tests/linear/should_fail/T18888_datakinds.stderr b/testsuite/tests/linear/should_fail/T18888_datakinds.stderr
index 1771d39cb53..f788b498d26 100644
--- a/testsuite/tests/linear/should_fail/T18888_datakinds.stderr
+++ b/testsuite/tests/linear/should_fail/T18888_datakinds.stderr
@@ -1,5 +1,5 @@
-
 T18888_datakinds.hs:5:9: error: [GHC-83865]
     • Expected kind ‘GHC.Types.Multiplicity’,
-        but ‘001’ has kind ‘GHC.Num.Natural.Natural’
+        but ‘001’ has kind ‘GHC.Internal.Bignum.Natural.Natural’
     • In the type signature: f :: a %001 -> b
+
diff --git a/testsuite/tests/numeric/should_compile/T14170.stdout b/testsuite/tests/numeric/should_compile/T14170.stdout
index 197cccc422d..91ad64397f9 100644
--- a/testsuite/tests/numeric/should_compile/T14170.stdout
+++ b/testsuite/tests/numeric/should_compile/T14170.stdout
@@ -50,7 +50,7 @@ foo :: Integer
  Unf=Unf{Src=<vanilla>, TopLvl=True,
          Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=IF_ARGS [] 10 10}]
-foo = GHC.Num.Integer.IS 0#
+foo = GHC.Internal.Bignum.Integer.IS 0#
 
 
 
diff --git a/testsuite/tests/numeric/should_compile/T14465.stdout b/testsuite/tests/numeric/should_compile/T14465.stdout
index afac0e2c944..4f78fdc87c3 100644
--- a/testsuite/tests/numeric/should_compile/T14465.stdout
+++ b/testsuite/tests/numeric/should_compile/T14465.stdout
@@ -9,7 +9,7 @@ ten :: Natural
  Unf=Unf{Src=<vanilla>, TopLvl=True,
          Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=IF_ARGS [] 10 10}]
-ten = GHC.Num.Natural.NS 10##
+ten = GHC.Internal.Bignum.Natural.NS 10##
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 M.$trModule4 :: GHC.Prim.Addr#
@@ -67,7 +67,7 @@ twoTimesTwo :: Natural
  Unf=Unf{Src=<vanilla>, TopLvl=True,
          Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=IF_ARGS [] 10 10}]
-twoTimesTwo = GHC.Num.Natural.NS 4##
+twoTimesTwo = GHC.Internal.Bignum.Natural.NS 4##
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 M.one1 :: Natural
@@ -75,7 +75,7 @@ M.one1 :: Natural
  Unf=Unf{Src=<vanilla>, TopLvl=True,
          Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=IF_ARGS [] 10 10}]
-M.one1 = GHC.Num.Natural.NS 1##
+M.one1 = GHC.Internal.Bignum.Natural.NS 1##
 
 -- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0}
 plusOne :: Natural -> Natural
diff --git a/testsuite/tests/numeric/should_compile/T19892.stderr b/testsuite/tests/numeric/should_compile/T19892.stderr
index 499cc9ece96..a168814b075 100644
--- a/testsuite/tests/numeric/should_compile/T19892.stderr
+++ b/testsuite/tests/numeric/should_compile/T19892.stderr
@@ -1,4 +1,4 @@
-Rule fired: Int# -> Integer -> Word# (GHC.Num.Integer)
+Rule fired: Int# -> Integer -> Word# (GHC.Internal.Bignum.Integer)
 Rule fired: Word# -> Int# -> Word# (GHC.Prim.Ext)
-Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
-Rule fired: Word# -> Natural -> Word# (GHC.Num.Natural)
+Rule fired: Int# -> Integer -> Int# (GHC.Internal.Bignum.Integer)
+Rule fired: Word# -> Natural -> Word# (GHC.Internal.Bignum.Natural)
diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr
index 39fc7a24c8f..4406b61f8ee 100644
--- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr
+++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr
@@ -1,4 +1,3 @@
-
 overloadedlistsfail01.hs:5:8: error: [GHC-39999]
     • Ambiguous type variable ‘a0’ arising from a use of ‘print’
       prevents the constraint ‘(Show a0)’ from being solved.
@@ -40,3 +39,4 @@ overloadedlistsfail01.hs:5:15: error: [GHC-39999]
     • In the expression: 1
       In the first argument of ‘print’, namely ‘[1]’
       In the expression: print [1]
+
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr
index b3693eed41d..9f5324bbbab 100644
--- a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr
@@ -1,4 +1,3 @@
-
 RecordDotSyntaxFail11.hs:8:3: error: [GHC-39999]
     • Ambiguous type variable ‘a0’ arising from a use of ‘print’
       prevents the constraint ‘(Show a0)’ from being solved.
@@ -22,3 +21,4 @@ RecordDotSyntaxFail11.hs:8:11: error: [GHC-39999]
       In the expression:
         do let a = ...
            print $ (.foo.bar.baz) a
+
diff --git a/testsuite/tests/perf/size/all.T b/testsuite/tests/perf/size/all.T
index f78daec38c8..4c45cb4d11f 100644
--- a/testsuite/tests/perf/size/all.T
+++ b/testsuite/tests/perf/size/all.T
@@ -29,7 +29,6 @@ test('containers_dir'      ,[collect_size_ghc_pkg(size_acceptance_threshold , 'c
 test('deepseq_dir'         ,[collect_size_ghc_pkg(size_acceptance_threshold , 'deepseq')]         , static_stats , [] )
 test('directory_dir'       ,[collect_size_ghc_pkg(size_acceptance_threshold , 'directory')]       , static_stats , [] )
 test('exceptions_dir'      ,[collect_size_ghc_pkg(size_acceptance_threshold , 'exceptions')]      , static_stats , [] )
-test('ghc_bignum_dir'      ,[collect_size_ghc_pkg(size_acceptance_threshold , 'ghc-bignum')]      , static_stats , [] )
 test('ghc_boot_dir'        ,[collect_size_ghc_pkg(size_acceptance_threshold , 'ghc-boot')]        , static_stats , [] )
 test('ghc_boot_th_dir'     ,[collect_size_ghc_pkg(size_acceptance_threshold , 'ghc-boot-th')]     , static_stats , [] )
 test('ghc_compact_dir'     ,[collect_size_ghc_pkg(size_acceptance_threshold , 'ghc-compact')]     , static_stats , [] )
@@ -70,7 +69,6 @@ test('deepseq_so'         ,[req_dynamic_ghc, js_skip, windows_skip, collect_obje
 test('directory_so'       ,[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "directory")]        , static_stats, [] )
 test('exceptions_so'      ,[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "exceptions")]       , static_stats, [] )
 test('filepath_so'        ,[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "filepath")]         , static_stats, [] )
-test('ghc_bignum_so'      ,[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "ghc-bignum")]       , static_stats, [] )
 test('ghc_boot_so'        ,[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "ghc-boot")]         , static_stats, [] )
 test('ghc_boot_th_so'     ,[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "ghc-boot-th")]      , static_stats, [] )
 test('ghc_experimental_so',[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "ghc-experimental")] , static_stats, [] )
diff --git a/testsuite/tests/quotes/T18263.stderr b/testsuite/tests/quotes/T18263.stderr
index f8a7aab4154..a5fae6536d3 100644
--- a/testsuite/tests/quotes/T18263.stderr
+++ b/testsuite/tests/quotes/T18263.stderr
@@ -1 +1 @@
-VarI T18263.x (ConT GHC.Num.Integer.Integer) Nothing
+VarI T18263.x (ConT GHC.Internal.Bignum.Integer.Integer) Nothing
diff --git a/testsuite/tests/quotes/TH_localname.stderr b/testsuite/tests/quotes/TH_localname.stderr
index 35fa83e8f0a..6ec68363b54 100644
--- a/testsuite/tests/quotes/TH_localname.stderr
+++ b/testsuite/tests/quotes/TH_localname.stderr
@@ -15,7 +15,7 @@ TH_localname.hs:3:11: error: [GHC-39999]
         instance GHC.Internal.TH.Lift.Lift Integer
           -- Defined in ‘GHC.Internal.TH.Lift’
         ...plus 15 others
-        ...plus 12 instances involving out-of-scope types
+        ...plus 71 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the expression: GHC.Internal.TH.Lift.lift y
       In the expression:
diff --git a/testsuite/tests/safeHaskell/check/pkg01/all.T b/testsuite/tests/safeHaskell/check/pkg01/all.T
index 2bb99e54eae..efed46eb6e0 100644
--- a/testsuite/tests/safeHaskell/check/pkg01/all.T
+++ b/testsuite/tests/safeHaskell/check/pkg01/all.T
@@ -29,7 +29,7 @@ make_args = 'VANILLA=' + vanilla + ' PROF=' + prof + ' DYN=' + dyn
 test('safePkg01',
      [extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']),
       normalise_errmsg_fun(ignoreLdOutput, normalise_errmsg),
-      normalise_version('ghc-internal', "array", "ghc-bignum", "bytestring",
+      normalise_version('ghc-internal', "array", "bytestring",
                         "base", "deepseq", "ghc-prim"),
       normalise_fun(normalise_errmsg),
       js_broken(22349)],
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
index a1094471bfd..a856c62f0cd 100644
--- a/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
@@ -76,14 +76,16 @@ $krep1 :: GHC.Types.KindRep
 [GblId, Unf=OtherCon []]
 $krep1
   = GHC.Types.KindRepTyConApp
-      GHC.Num.Integer.$tcInteger (GHC.Types.[] @GHC.Types.KindRep)
+      GHC.Internal.Bignum.Integer.$tcInteger
+      (GHC.Types.[] @GHC.Types.KindRep)
 
 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 $krep2 :: GHC.Types.KindRep
 [GblId, Unf=OtherCon []]
 $krep2
   = GHC.Types.KindRepTyConApp
-      GHC.Num.Natural.$tcNatural (GHC.Types.[] @GHC.Types.KindRep)
+      GHC.Internal.Bignum.Natural.$tcNatural
+      (GHC.Types.[] @GHC.Types.KindRep)
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 $krep3 :: GHC.Types.KindRep
diff --git a/testsuite/tests/simplCore/should_compile/T15445.stderr b/testsuite/tests/simplCore/should_compile/T15445.stderr
index e7bdb18ac63..7aab8340496 100644
--- a/testsuite/tests/simplCore/should_compile/T15445.stderr
+++ b/testsuite/tests/simplCore/should_compile/T15445.stderr
@@ -1,6 +1,6 @@
 Rule fired: Class op + (BUILTIN)
 Rule fired: Class op fromInteger (BUILTIN)
-Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
+Rule fired: Int# -> Integer -> Int# (GHC.Internal.Bignum.Integer)
 Rule fired: USPEC plusTwoRec @Int (T15445a)
 Rule fired: USPEC $fShowList @Int (GHC.Internal.Show)
 Rule fired: Class op >> (BUILTIN)
diff --git a/testsuite/tests/simplCore/should_compile/T21286.stderr b/testsuite/tests/simplCore/should_compile/T21286.stderr
index a9621e7c9b0..1109fdb7ba9 100644
--- a/testsuite/tests/simplCore/should_compile/T21286.stderr
+++ b/testsuite/tests/simplCore/should_compile/T21286.stderr
@@ -2,14 +2,14 @@
 [2 of 2] Compiling T21286           ( T21286.hs, T21286.o )
 Rule fired: Class op + (BUILTIN)
 Rule fired: Class op fromInteger (BUILTIN)
-Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
+Rule fired: Int# -> Integer -> Int# (GHC.Internal.Bignum.Integer)
 Rule fired: Class op fromInteger (BUILTIN)
-Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
-Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
-Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
+Rule fired: Int# -> Integer -> Int# (GHC.Internal.Bignum.Integer)
+Rule fired: Int# -> Integer -> Int# (GHC.Internal.Bignum.Integer)
+Rule fired: Int# -> Integer -> Int# (GHC.Internal.Bignum.Integer)
 Rule fired: SPEC/T21286 g @Int (T21286)
-Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
-Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
+Rule fired: Int# -> Integer -> Int# (GHC.Internal.Bignum.Integer)
+Rule fired: Int# -> Integer -> Int# (GHC.Internal.Bignum.Integer)
 Rule fired: SPEC/T21286 g @Int (T21286)
 Rule fired: ==# (BUILTIN)
 Rule fired: tagToEnum# (BUILTIN)
diff --git a/testsuite/tests/simplCore/should_compile/T22428.stderr b/testsuite/tests/simplCore/should_compile/T22428.stderr
index 97bdfacd4ae..7016daff6c0 100644
--- a/testsuite/tests/simplCore/should_compile/T22428.stderr
+++ b/testsuite/tests/simplCore/should_compile/T22428.stderr
@@ -9,7 +9,7 @@ T22428.f1 :: Integer
  Unf=Unf{Src=<vanilla>, TopLvl=True,
          Value=True, ConLike=True, WorkFree=True, Expandable=True,
          Guidance=IF_ARGS [] 10 10}]
-T22428.f1 = GHC.Num.Integer.IS 1#
+T22428.f1 = GHC.Internal.Bignum.Integer.IS 1#
 
 -- RHS size: {terms: 28, types: 10, coercions: 0, joins: 1/1}
 f :: Integer -> Integer -> Integer
@@ -31,15 +31,16 @@ f = \ (x :: Integer) (y :: Integer) ->
                  Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False)}]
         go (ds :: Integer)
           = case ds of x1 {
-              GHC.Num.Integer.IS x2 ->
+              GHC.Internal.Bignum.Integer.IS x2 ->
                 case x2 of {
-                  __DEFAULT -> jump go (GHC.Num.Integer.integerSub x1 T22428.f1);
+                  __DEFAULT ->
+                    jump go (GHC.Internal.Bignum.Integer.integerSub x1 T22428.f1);
                   0# -> x
                 };
-              GHC.Num.Integer.IP x2 ->
-                jump go (GHC.Num.Integer.integerSub x1 T22428.f1);
-              GHC.Num.Integer.IN x2 ->
-                jump go (GHC.Num.Integer.integerSub x1 T22428.f1)
+              GHC.Internal.Bignum.Integer.IP x2 ->
+                jump go (GHC.Internal.Bignum.Integer.integerSub x1 T22428.f1);
+              GHC.Internal.Bignum.Integer.IN x2 ->
+                jump go (GHC.Internal.Bignum.Integer.integerSub x1 T22428.f1)
             }; } in
       jump go y
 
diff --git a/testsuite/tests/simplCore/should_compile/T23083.stderr b/testsuite/tests/simplCore/should_compile/T23083.stderr
index 089e3d57af3..32001515293 100644
--- a/testsuite/tests/simplCore/should_compile/T23083.stderr
+++ b/testsuite/tests/simplCore/should_compile/T23083.stderr
@@ -8,14 +8,14 @@ Result size of CorePrep = {terms: 34, types: 34, coercions: 0, joins: 0/1}
 (T23083.$$) = \ (@a) (@b) (f [Occ=Once1!] :: a -> b) (x [Occ=Once1] :: a) -> f x
 
 -- RHS size: {terms: 12, types: 12, coercions: 0, joins: 0/1}
-T23083.g :: ((GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer) -> (GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer
+T23083.g :: ((GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer) -> GHC.Internal.Bignum.Integer.Integer) -> (GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer) -> GHC.Internal.Bignum.Integer.Integer
 [GblId, Arity=2, Str=<1C(1,L)><ML>, Unf=OtherCon []]
 T23083.g
-  = \ (f [Occ=Once1!] :: (GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer) (h [Occ=OnceL1] :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) ->
+  = \ (f [Occ=Once1!] :: (GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer) -> GHC.Internal.Bignum.Integer.Integer) (h [Occ=OnceL1] :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer) ->
       let {
-        sat [Occ=Once1] :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer
+        sat [Occ=Once1] :: GHC.Internal.Bignum.Integer.Integer -> GHC.Internal.Bignum.Integer.Integer
         [LclId, Unf=OtherCon []]
-        sat = \ (eta [Occ=Once1] :: GHC.Num.Integer.Integer) -> case h of h1 [Occ=Once1] { __DEFAULT -> T23083.$$ @GHC.Num.Integer.Integer @GHC.Num.Integer.Integer h1 eta } } in
+        sat = \ (eta [Occ=Once1] :: GHC.Internal.Bignum.Integer.Integer) -> case h of h1 [Occ=Once1] { __DEFAULT -> T23083.$$ @GHC.Internal.Bignum.Integer.Integer @GHC.Internal.Bignum.Integer.Integer h1 eta } } in
       f sat
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
diff --git a/testsuite/tests/simplCore/should_compile/T8832.stdout b/testsuite/tests/simplCore/should_compile/T8832.stdout
index 040d14d4529..250f62288c7 100644
--- a/testsuite/tests/simplCore/should_compile/T8832.stdout
+++ b/testsuite/tests/simplCore/should_compile/T8832.stdout
@@ -8,4 +8,4 @@ w8 = GHC.Internal.Word.W8# 0#Word8
 w16 = GHC.Internal.Word.W16# 0#Word16
 w32 = GHC.Internal.Word.W32# 0#Word32
 w64 = GHC.Internal.Word.W64# 0#Word64
-z = GHC.Num.Integer.IS 0#
+z = GHC.Internal.Bignum.Integer.IS 0#
diff --git a/testsuite/tests/th/T15360b.stderr b/testsuite/tests/th/T15360b.stderr
index f3e9f3c4272..f44cbe7ceaf 100644
--- a/testsuite/tests/th/T15360b.stderr
+++ b/testsuite/tests/th/T15360b.stderr
@@ -1,4 +1,3 @@
-
 T15360b.hs:10:13: error: [GHC-83865]
     • Expected kind ‘* -> k3’, but ‘Type’ has kind ‘*’
     • In the first argument of ‘Proxy’, namely ‘(Type Double)’
@@ -6,7 +5,7 @@ T15360b.hs:10:13: error: [GHC-83865]
 
 T15360b.hs:13:13: error: [GHC-83865]
     • Expected kind ‘* -> k2’,
-        but ‘1’ has kind ‘GHC.Num.Natural.Natural’
+        but ‘1’ has kind ‘GHC.Internal.Bignum.Natural.Natural’
     • In the first argument of ‘Proxy’, namely ‘(1 Int)’
       In the type signature: y :: Proxy (1 Int)
 
@@ -19,3 +18,4 @@ T15360b.hs:19:13: error: [GHC-83865]
     • Expected kind ‘* -> k0’, but ‘'[]’ has kind ‘[a0]’
     • In the first argument of ‘Proxy’, namely ‘('[] Int)’
       In the type signature: w :: Proxy ('[] Int)
+
diff --git a/testsuite/tests/th/T16980.stderr b/testsuite/tests/th/T16980.stderr
index f11ae5774bc..61c599ff69a 100644
--- a/testsuite/tests/th/T16980.stderr
+++ b/testsuite/tests/th/T16980.stderr
@@ -1,2 +1,2 @@
-T16980.aNumber :: GHC.Num.Integer.Integer
-ConT GHC.Num.Integer.Integer
+T16980.aNumber :: GHC.Internal.Bignum.Integer.Integer
+ConT GHC.Internal.Bignum.Integer.Integer
diff --git a/testsuite/tests/th/T2222.stderr b/testsuite/tests/th/T2222.stderr
index 5ec25101d4d..ce48cbd8474 100644
--- a/testsuite/tests/th/T2222.stderr
+++ b/testsuite/tests/th/T2222.stderr
@@ -1,4 +1,4 @@
-inside b: GHC.Num.Integer.Integer
+inside b: GHC.Internal.Bignum.Integer.Integer
 inside d: GHC.Types.Bool
 type of c: GHC.Types.Bool
 inside f: GHC.Types.Bool
diff --git a/testsuite/tests/th/TH_tuple1.stdout b/testsuite/tests/th/TH_tuple1.stdout
index cf588e49403..b44c28bb5a8 100644
--- a/testsuite/tests/th/TH_tuple1.stdout
+++ b/testsuite/tests/th/TH_tuple1.stdout
@@ -1,10 +1,10 @@
-SigE (AppE (AppE (ConE GHC.Tuple.(,)) (LitE (IntegerL 1))) (LitE (IntegerL 2))) (AppT (AppT (ConT GHC.Tuple.Tuple2) (ConT GHC.Num.Integer.Integer)) (ConT GHC.Num.Integer.Integer))
-GHC.Tuple.(,) 1 2 :: GHC.Tuple.Tuple2 GHC.Num.Integer.Integer
-                                      GHC.Num.Integer.Integer
-SigE (AppE (ConE GHC.Tuple.MkSolo) (LitE (IntegerL 1))) (AppT (ConT GHC.Tuple.Solo) (ConT GHC.Num.Integer.Integer))
-GHC.Tuple.MkSolo 1 :: GHC.Tuple.Solo GHC.Num.Integer.Integer
-SigE (AppE (AppE (ConE GHC.Types.(#,#)) (LitE (IntegerL 1))) (LitE (IntegerL 2))) (AppT (AppT (ConT GHC.Types.Tuple2#) (ConT GHC.Num.Integer.Integer)) (ConT GHC.Num.Integer.Integer))
-GHC.Types.(#,#) 1 2 :: GHC.Types.Tuple2# GHC.Num.Integer.Integer
-                                         GHC.Num.Integer.Integer
-SigE (AppE (ConE GHC.Types.MkSolo#) (LitE (IntegerL 1))) (AppT (ConT GHC.Types.Solo#) (ConT GHC.Num.Integer.Integer))
-GHC.Types.MkSolo# 1 :: GHC.Types.Solo# GHC.Num.Integer.Integer
+SigE (AppE (AppE (ConE GHC.Tuple.(,)) (LitE (IntegerL 1))) (LitE (IntegerL 2))) (AppT (AppT (ConT GHC.Tuple.Tuple2) (ConT GHC.Internal.Bignum.Integer.Integer)) (ConT GHC.Internal.Bignum.Integer.Integer))
+GHC.Tuple.(,) 1 2 :: GHC.Tuple.Tuple2 GHC.Internal.Bignum.Integer.Integer
+                                      GHC.Internal.Bignum.Integer.Integer
+SigE (AppE (ConE GHC.Tuple.MkSolo) (LitE (IntegerL 1))) (AppT (ConT GHC.Tuple.Solo) (ConT GHC.Internal.Bignum.Integer.Integer))
+GHC.Tuple.MkSolo 1 :: GHC.Tuple.Solo GHC.Internal.Bignum.Integer.Integer
+SigE (AppE (AppE (ConE GHC.Types.(#,#)) (LitE (IntegerL 1))) (LitE (IntegerL 2))) (AppT (AppT (ConT GHC.Types.Tuple2#) (ConT GHC.Internal.Bignum.Integer.Integer)) (ConT GHC.Internal.Bignum.Integer.Integer))
+GHC.Types.(#,#) 1 2 :: GHC.Types.Tuple2# GHC.Internal.Bignum.Integer.Integer
+                                         GHC.Internal.Bignum.Integer.Integer
+SigE (AppE (ConE GHC.Types.MkSolo#) (LitE (IntegerL 1))) (AppT (ConT GHC.Types.Solo#) (ConT GHC.Internal.Bignum.Integer.Integer))
+GHC.Types.MkSolo# 1 :: GHC.Types.Solo# GHC.Internal.Bignum.Integer.Integer
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 2d77279000e..fb3c114a242 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -266,7 +266,7 @@ test('T8028', [], multimod_compile, ['T8028', '-v0 ' + config.ghc_th_way_flags])
 test('TH_Roles1', normal, compile_fail, ['-v0'])
 test('TH_Roles2', normalise_version('ghc-internal', 'array', 'base', 'deepseq', 'ghc-prim',
                                     'ghc-boot', 'ghc-boot-th',
-                                    'ghc-bignum', 'pretty', 'template-haskell',
+                                    'pretty', 'template-haskell',
                                     'binary', 'bytestring', 'containers'
                                     ), compile, ['-v0 -ddump-tc -dsuppress-uniques'])
 test('TH_Roles3', normal, compile, ['-v0 -dsuppress-uniques'])
diff --git a/testsuite/tests/typecheck/should_compile/T22141a.stderr b/testsuite/tests/typecheck/should_compile/T22141a.stderr
index da32796ad37..9386d6bbea8 100644
--- a/testsuite/tests/typecheck/should_compile/T22141a.stderr
+++ b/testsuite/tests/typecheck/should_compile/T22141a.stderr
@@ -1,8 +1,8 @@
-
 T22141a.hs:8:1: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
-    • An occurrence of ‘GHC.Num.Natural.Natural’ in a kind requires DataKinds.
+    • An occurrence of ‘GHC.Internal.Bignum.Natural.Natural’ in a kind requires DataKinds.
       Future versions of GHC will turn this warning into an error.
     • In the expansion of type synonym ‘Nat’
       In the data type declaration for ‘Vector’
     Suggested fix:
       Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
+
diff --git a/testsuite/tests/typecheck/should_compile/T22141b.stderr b/testsuite/tests/typecheck/should_compile/T22141b.stderr
index 338591bc784..97ad8d26e0f 100644
--- a/testsuite/tests/typecheck/should_compile/T22141b.stderr
+++ b/testsuite/tests/typecheck/should_compile/T22141b.stderr
@@ -1,9 +1,9 @@
-
 T22141b.hs:10:1: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
-    • An occurrence of ‘GHC.Num.Natural.Natural’ in a kind requires DataKinds.
+    • An occurrence of ‘GHC.Internal.Bignum.Natural.Natural’ in a kind requires DataKinds.
       Future versions of GHC will turn this warning into an error.
     • In the expansion of type synonym ‘Nat’
       In the expansion of type synonym ‘MyNat’
       In the data type declaration for ‘Vector’
     Suggested fix:
       Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
+
diff --git a/testsuite/tests/typecheck/should_compile/T22141e.stderr b/testsuite/tests/typecheck/should_compile/T22141e.stderr
index 453397c7425..a4e0913a2b9 100644
--- a/testsuite/tests/typecheck/should_compile/T22141e.stderr
+++ b/testsuite/tests/typecheck/should_compile/T22141e.stderr
@@ -1,4 +1,3 @@
-
 T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
     • An occurrence of ‘42’ in a kind requires DataKinds.
       Future versions of GHC will turn this warning into an error.
@@ -8,7 +7,7 @@ T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
       Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
 
 T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
-    • An occurrence of ‘GHC.Num.Natural.Natural’ in a kind requires DataKinds.
+    • An occurrence of ‘GHC.Internal.Bignum.Natural.Natural’ in a kind requires DataKinds.
       Future versions of GHC will turn this warning into an error.
     • In a standalone kind signature for ‘D’: Proxy T -> Type
     Suggested fix:
@@ -20,3 +19,4 @@ T22141e.hs:8:11: warning: [GHC-68567] [-Wdata-kinds-tc (in -Wdefault)]
     • In a standalone kind signature for ‘D’: Proxy T -> Type
     Suggested fix:
       Perhaps you intended to use the ‘DataKinds’ extension (implied by ‘UnliftedDatatypes’)
+
diff --git a/testsuite/tests/typecheck/should_fail/T5095.stderr b/testsuite/tests/typecheck/should_fail/T5095.stderr
index 1c8d03a69ff..98da7b02477 100644
--- a/testsuite/tests/typecheck/should_fail/T5095.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5095.stderr
@@ -1,16 +1,16 @@
-
 T5095.hs:9:11: error: [GHC-43085]
     • Overlapping instances for Eq a arising from a use of ‘==’
       Matching instance:
         instance [overlappable] Show a => Eq a -- Defined at T5095.hs:5:31
       Potentially matching instances:
         instance Eq Ordering -- Defined in ‘GHC.Classes’
-        instance Eq Integer -- Defined in ‘GHC.Num.Integer’
+        instance Eq Integer -- Defined in ‘GHC.Internal.Bignum.Integer’
         ...plus 23 others
-        ...plus four instances involving out-of-scope types
+        ...plus five instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
       (The choice depends on the instantiation of ‘a’
        To pick the first instance above, use IncoherentInstances
        when compiling the other instance declarations)
     • In the expression: x == y
       In an equation for ‘f’: f x y = x == y
+
diff --git a/testsuite/tests/typecheck/should_fail/T7279.stderr b/testsuite/tests/typecheck/should_fail/T7279.stderr
index f36a13f8446..16db2225a7e 100644
--- a/testsuite/tests/typecheck/should_fail/T7279.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7279.stderr
@@ -1,4 +1,3 @@
-
 T7279.hs:6:10: error: [GHC-39999]
     • Could not deduce ‘Show b0’
       from the context: (Eq a, Show b)
@@ -15,3 +14,4 @@ T7279.hs:6:10: error: [GHC-39999]
     • In the ambiguity check for an instance declaration
       To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
       In the instance declaration for ‘Eq (T a)’
+
diff --git a/testsuite/tests/typecheck/should_fail/TyAppPat_PatternBindingExistential.stderr b/testsuite/tests/typecheck/should_fail/TyAppPat_PatternBindingExistential.stderr
index c047bd9fc95..4ac707c1883 100644
--- a/testsuite/tests/typecheck/should_fail/TyAppPat_PatternBindingExistential.stderr
+++ b/testsuite/tests/typecheck/should_fail/TyAppPat_PatternBindingExistential.stderr
@@ -1,4 +1,3 @@
-
 TyAppPat_PatternBindingExistential.hs:10:1: error: [GHC-48361]
     • Binding type variables is not allowed in pattern bindings
     • In the pattern: Some @a x
@@ -29,3 +28,4 @@ TyAppPat_PatternBindingExistential.hs:13:3: error: [GHC-39999]
     • In a stmt of a 'do' block: print (x :: a)
       In the expression: do print (x :: a)
       In an equation for ‘main’: main = do print (x :: a)
+
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail1.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail1.stderr
index 19f1bad5564..b52b7b5b57d 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail1.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail1.stderr
@@ -1,5 +1,7 @@
-
 UnliftedNewtypesFamilyKindFail1.hs:11:31: error: [GHC-83865]
-    • Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’
+    • Expected a type,
+      but ‘5’ has kind
+      ‘GHC.Internal.Bignum.Natural.Natural’
     • In the kind ‘5’
       In the data family declaration for ‘DF’
+
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr
index e97ea2aa55c..48b93da383e 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr
@@ -1,5 +1,7 @@
-
 UnliftedNewtypesFamilyKindFail2.hs:12:20: error: [GHC-83865]
-    • Expected a type, but ‘5’ has kind ‘GHC.Num.Natural.Natural’
+    • Expected a type,
+      but ‘5’ has kind
+      ‘GHC.Internal.Bignum.Natural.Natural’
     • In the first argument of ‘F’, namely ‘5’
       In the newtype instance declaration for ‘F’
+
diff --git a/testsuite/tests/typecheck/should_fail/tcfail072.stderr b/testsuite/tests/typecheck/should_fail/tcfail072.stderr
index d4bea865295..b5c1357a79f 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail072.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail072.stderr
@@ -1,4 +1,3 @@
-
 tcfail072.hs:23:13: error: [GHC-39999]
     • Could not deduce ‘Ord p0’ arising from a use of ‘g’
       from the context: (Ord p, Ord q)
@@ -8,9 +7,10 @@ tcfail072.hs:23:13: error: [GHC-39999]
       The type variable ‘p0’ is ambiguous
       Potentially matching instances:
         instance Ord Ordering -- Defined in ‘GHC.Classes’
-        instance Ord Integer -- Defined in ‘GHC.Num.Integer’
+        instance Ord Integer -- Defined in ‘GHC.Internal.Bignum.Integer’
         ...plus 23 others
-        ...plus two instances involving out-of-scope types
+        ...plus three instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the expression: g A
       In an equation for ‘g’: g (B _ _) = g A
+
diff --git a/testsuite/tests/vdq-rta/should_compile/T22326_th_pprint1.stderr b/testsuite/tests/vdq-rta/should_compile/T22326_th_pprint1.stderr
index 373f250dabd..938ab286a99 100644
--- a/testsuite/tests/vdq-rta/should_compile/T22326_th_pprint1.stderr
+++ b/testsuite/tests/vdq-rta/should_compile/T22326_th_pprint1.stderr
@@ -1,5 +1,5 @@
-f_0 :: GHC.Num.Integer.Integer ->
+f_0 :: GHC.Internal.Bignum.Integer.Integer ->
        forall a_1 -> GHC.Internal.Num.Num a_1 => a_1
 f_0 n_2 (type _) = GHC.Internal.Num.fromInteger n_2
 x_3 = 42 `f_0` (type GHC.Types.Double)
-n_4 = f_0 42 (type GHC.Num.Integer.Integer)
+n_4 = f_0 42 (type GHC.Internal.Bignum.Integer.Integer)
diff --git a/testsuite/tests/vdq-rta/should_compile/T23739_th_pprint1.stderr b/testsuite/tests/vdq-rta/should_compile/T23739_th_pprint1.stderr
index 53207639c5a..51f69c1eae4 100644
--- a/testsuite/tests/vdq-rta/should_compile/T23739_th_pprint1.stderr
+++ b/testsuite/tests/vdq-rta/should_compile/T23739_th_pprint1.stderr
@@ -1,3 +1,3 @@
-f_0 :: GHC.Num.Integer.Integer ->
+f_0 :: GHC.Internal.Bignum.Integer.Integer ->
        forall a_1 -> GHC.Internal.Num.Num a_1 => a_1
 f_0 n_2 t_3 = GHC.Internal.Num.fromInteger @t_3 n_2
-- 
GitLab