Built-in Natural literals in Core

Add support for built-in Natural literals in Core.

- Replace MachInt,MachWord, LitInteger, etc. with a single LitNumber
  constructor with a LitNumType field
- Support built-in Natural literals
- Add desugar warning for negative literals
- Move Maybe(..) from GHC.Base to GHC.Maybe for module dependency
  reasons

This patch introduces only a few rules for Natural literals (compared
to Integer's rules). Factorization of the built-in rules for numeric
literals will be done in another patch as this one is already big to
review.

Test Plan:
  validate
  test build with integer-simple

Reviewers: hvr, bgamari, goldfire, Bodigrim, simonmar

Reviewed By: bgamari

Subscribers: phadej, simonpj, RyanGlScott, carter, hsyl20, rwbarton,
thomie

GHC Trac Issues: #14170, #14465

Differential Revision: https://phabricator.haskell.org/D4212

22 files changed, 945 insertions, 611 deletions

diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs
index 1fc388040c..60edf78dea 100644
--- a/libraries/base/Data/Bits.hs
+++ b/libraries/base/Data/Bits.hs
@@ -536,6 +536,74 @@ instance Bits Integer where
    bitSize _  = errorWithoutStackTrace "Data.Bits.bitSize(Integer)"
    isSigned _ = True
 
+#if defined(MIN_VERSION_integer_gmp)
+-- | @since 4.8.0
+instance Bits Natural where
+   (.&.) = andNatural
+   (.|.) = orNatural
+   xor = xorNatural
+   complement _ = errorWithoutStackTrace
+                    "Bits.complement: Natural complement undefined"
+   shift x i
+     | i >= 0    = shiftLNatural x i
+     | otherwise = shiftRNatural x (negate i)
+   testBit x i   = testBitNatural x i
+   zeroBits      = wordToNaturalBase 0##
+   clearBit x i  = x `xor` (bit i .&. x)
+
+   bit (I# i#) = bitNatural i#
+   popCount x  = popCountNatural x
+
+   rotate x i = shift x i   -- since an Natural never wraps around
+
+   bitSizeMaybe _ = Nothing
+   bitSize _  = errorWithoutStackTrace "Data.Bits.bitSize(Natural)"
+   isSigned _ = False
+#else
+-- | @since 4.8.0.0
+instance Bits Natural where
+  Natural n .&. Natural m = Natural (n .&. m)
+  {-# INLINE (.&.) #-}
+  Natural n .|. Natural m = Natural (n .|. m)
+  {-# INLINE (.|.) #-}
+  xor (Natural n) (Natural m) = Natural (xor n m)
+  {-# INLINE xor #-}
+  complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"
+  {-# INLINE complement #-}
+  shift (Natural n) = Natural . shift n
+  {-# INLINE shift #-}
+  rotate (Natural n) = Natural . rotate n
+  {-# INLINE rotate #-}
+  bit = Natural . bit
+  {-# INLINE bit #-}
+  setBit (Natural n) = Natural . setBit n
+  {-# INLINE setBit #-}
+  clearBit (Natural n) = Natural . clearBit n
+  {-# INLINE clearBit #-}
+  complementBit (Natural n) = Natural . complementBit n
+  {-# INLINE complementBit #-}
+  testBit (Natural n) = testBit n
+  {-# INLINE testBit #-}
+  bitSizeMaybe _ = Nothing
+  {-# INLINE bitSizeMaybe #-}
+  bitSize = errorWithoutStackTrace "Natural: bitSize"
+  {-# INLINE bitSize #-}
+  isSigned _ = False
+  {-# INLINE isSigned #-}
+  shiftL (Natural n) = Natural . shiftL n
+  {-# INLINE shiftL #-}
+  shiftR (Natural n) = Natural . shiftR n
+  {-# INLINE shiftR #-}
+  rotateL (Natural n) = Natural . rotateL n
+  {-# INLINE rotateL #-}
+  rotateR (Natural n) = Natural . rotateR n
+  {-# INLINE rotateR #-}
+  popCount (Natural n) = popCount n
+  {-# INLINE popCount #-}
+  zeroBits = Natural 0
+
+#endif
+
 -----------------------------------------------------------------------------
 
 -- | Attempt to convert an 'Integral' type @a@ to an 'Integral' type @b@ using
diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs
index 8154433044..194df08003 100644
--- a/libraries/base/Data/Data.hs
+++ b/libraries/base/Data/Data.hs
@@ -126,7 +126,6 @@ import Data.Version( Version(..) )
 import GHC.Base hiding (Any, IntRep, FloatRep)
 import GHC.List
 import GHC.Num
-import GHC.Natural
 import GHC.Read
 import GHC.Show
 import Text.Read( reads )
diff --git a/libraries/base/GHC/Arr.hs b/libraries/base/GHC/Arr.hs
index 8dbda6f7cf..af16355bc1 100644
--- a/libraries/base/GHC/Arr.hs
+++ b/libraries/base/GHC/Arr.hs
@@ -240,6 +240,15 @@ instance  Ix Integer  where
     inRange (m,n) i     =  m <= i && i <= n
 
 ----------------------------------------------------------------------
+-- | @since 4.8.0.0
+instance Ix Natural where
+    range (m,n) = [m..n]
+    inRange (m,n) i = m <= i && i <= n
+    unsafeIndex (m,_) i = fromIntegral (i-m)
+    index b i | inRange b i = unsafeIndex b i
+              | otherwise   = indexError b i "Natural"
+
+----------------------------------------------------------------------
 -- | @since 2.01
 instance Ix Bool where -- as derived
     {-# INLINE range #-}
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs
index b8f984c440..4953a7d58c 100644
--- a/libraries/base/GHC/Base.hs
+++ b/libraries/base/GHC/Base.hs
@@ -117,7 +117,8 @@ module GHC.Base
         module GHC.Types,
         module GHC.Prim,        -- Re-export GHC.Prim and [boot] GHC.Err,
                                 -- to avoid lots of people having to
-        module GHC.Err          -- import it explicitly
+        module GHC.Err,         -- import it explicitly
+        module GHC.Maybe
   )
         where
 
@@ -127,10 +128,12 @@ import GHC.CString
 import GHC.Magic
 import GHC.Prim
 import GHC.Err
+import GHC.Maybe
 import {-# SOURCE #-} GHC.IO (failIO,mplusIO)
 
-import GHC.Tuple ()     -- Note [Depend on GHC.Tuple]
-import GHC.Integer ()   -- Note [Depend on GHC.Integer]
+import GHC.Tuple ()              -- Note [Depend on GHC.Tuple]
+import GHC.Integer ()            -- Note [Depend on GHC.Integer]
+import GHC.Natural ()            -- Note [Depend on GHC.Natural]
 
 -- for 'class Semigroup'
 import {-# SOURCE #-} GHC.Real (Integral)
@@ -182,6 +185,10 @@ Similarly, tuple syntax (or ()) creates an implicit dependency on
 GHC.Tuple, so we use the same rule as for Integer --- see Note [Depend on
 GHC.Integer] --- to explain this to the build system.  We make GHC.Base
 depend on GHC.Tuple, and everything else depends on GHC.Base or Prelude.
+
+Note [Depend on GHC.Natural]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+Similar to GHC.Integer.
 -}
 
 #if 0
@@ -202,21 +209,6 @@ build = errorWithoutStackTrace "urk"
 foldr = errorWithoutStackTrace "urk"
 #endif
 
--- | The 'Maybe' type encapsulates an optional value.  A value of type
--- @'Maybe' a@ either contains a value of type @a@ (represented as @'Just' a@),
--- or it is empty (represented as 'Nothing').  Using 'Maybe' is a good way to
--- deal with errors or exceptional cases without resorting to drastic
--- measures such as 'error'.
---
--- The 'Maybe' type is also a monad.  It is a simple kind of error
--- monad, where all errors are represented by 'Nothing'.  A richer
--- error monad can be built using the 'Data.Either.Either' type.
---
-data  Maybe a  =  Nothing | Just a
-  deriving ( Eq  -- ^ @since 2.01
-           , Ord -- ^ @since 2.01
-           )
-
 infixr 6 <>
 
 -- | The class of semigroups (types with an associative binary operation).
diff --git a/libraries/base/GHC/Base.hs-boot b/libraries/base/GHC/Base.hs-boot
index ca85b49147..64e6365525 100644
--- a/libraries/base/GHC/Base.hs-boot
+++ b/libraries/base/GHC/Base.hs-boot
@@ -1,10 +1,9 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module GHC.Base where
+module GHC.Base (Maybe, Semigroup, Monoid) where
 
+import GHC.Maybe (Maybe)
 import GHC.Types ()
 
 class Semigroup a
 class Monoid a
-
-data Maybe a = Nothing | Just a
diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs
index feb45854d2..234ccb3ba2 100644
--- a/libraries/base/GHC/Enum.hs
+++ b/libraries/base/GHC/Enum.hs
@@ -877,6 +877,79 @@ dn_list x0 delta lim = go (x0 :: Integer)
                         go x | x < lim   = []
                              | otherwise = x : go (x+delta)
 
+------------------------------------------------------------------------
+-- Natural
+------------------------------------------------------------------------
+
+#if defined(MIN_VERSION_integer_gmp)
+-- | @since 4.8.0.0
+instance Enum Natural where
+    succ n = n `plusNatural`  wordToNaturalBase 1##
+    pred n = n `minusNatural` wordToNaturalBase 1##
+
+    toEnum = intToNatural
+
+    fromEnum (NatS# w)
+      | i >= 0    = i
+      | otherwise = errorWithoutStackTrace "fromEnum: out of Int range"
+      where
+        i = I# (word2Int# w)
+    fromEnum n = fromEnum (naturalToInteger n)
+
+    enumFrom x        = enumDeltaNatural      x (wordToNaturalBase 1##)
+    enumFromThen x y
+      | x <= y        = enumDeltaNatural      x (y-x)
+      | otherwise     = enumNegDeltaToNatural x (x-y) (wordToNaturalBase 0##)
+
+    enumFromTo x lim  = enumDeltaToNatural    x (wordToNaturalBase 1##) lim
+    enumFromThenTo x y lim
+      | x <= y        = enumDeltaToNatural    x (y-x) lim
+      | otherwise     = enumNegDeltaToNatural x (x-y) lim
+
+-- Helpers for 'Enum Natural'; TODO: optimise & make fusion work
+
+enumDeltaNatural :: Natural -> Natural -> [Natural]
+enumDeltaNatural !x d = x : enumDeltaNatural (x+d) d
+
+enumDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
+enumDeltaToNatural x0 delta lim = go x0
+  where
+    go x | x > lim   = []
+         | otherwise = x : go (x+delta)
+
+enumNegDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
+enumNegDeltaToNatural x0 ndelta lim = go x0
+  where
+    go x | x < lim     = []
+         | x >= ndelta = x : go (x-ndelta)
+         | otherwise   = [x]
+
+#else
+
+-- | @since 4.8.0.0
+instance Enum Natural where
+  pred (Natural 0) = errorWithoutStackTrace "Natural.pred: 0"
+  pred (Natural n) = Natural (pred n)
+  {-# INLINE pred #-}
+  succ (Natural n) = Natural (succ n)
+  {-# INLINE succ #-}
+  fromEnum (Natural n) = fromEnum n
+  {-# INLINE fromEnum #-}
+  toEnum n | n < 0     = errorWithoutStackTrace "Natural.toEnum: negative"
+           | otherwise = Natural (toEnum n)
+  {-# INLINE toEnum #-}
+
+  enumFrom     = coerce (enumFrom     :: Integer -> [Integer])
+  enumFromThen x y
+    | x <= y    = coerce (enumFromThen :: Integer -> Integer -> [Integer]) x y
+    | otherwise = enumFromThenTo x y (wordToNaturalBase 0##)
+
+  enumFromTo   = coerce (enumFromTo   :: Integer -> Integer -> [Integer])
+  enumFromThenTo
+    = coerce (enumFromThenTo :: Integer -> Integer -> Integer -> [Integer])
+
+#endif
+
 -- Instances from GHC.Types
 
 -- | @since 4.10.0.0
diff --git a/libraries/base/GHC/Err.hs b/libraries/base/GHC/Err.hs
index a48fb10a86..1f1ad903ae 100644
--- a/libraries/base/GHC/Err.hs
+++ b/libraries/base/GHC/Err.hs
@@ -27,8 +27,8 @@ import GHC.CString ()
 import GHC.Types (Char, RuntimeRep)
 import GHC.Stack.Types
 import GHC.Prim
-import GHC.Integer ()   -- Make sure Integer is compiled first
-                        -- because GHC depends on it in a wired-in way
+import GHC.Integer ()   -- Make sure Integer and Natural are compiled first
+import GHC.Natural ()   -- because GHC depends on it in a wired-in way
                         -- so the build system doesn't see the dependency
 import {-# SOURCE #-} GHC.Exception
   ( errorCallWithCallStackException
diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs
index f966b3fd5e..3b32e230e8 100644
--- a/libraries/base/GHC/Exception.hs
+++ b/libraries/base/GHC/Exception.hs
@@ -23,21 +23,17 @@
 -----------------------------------------------------------------------------
 
 module GHC.Exception
-       ( Exception(..)    -- Class
+       ( module GHC.Exception.Type
        , throw
-       , SomeException(..), ErrorCall(..,ErrorCall), ArithException(..)
-       , divZeroException, overflowException, ratioZeroDenomException
-       , underflowException
-       , errorCallException, errorCallWithCallStackException
+       , ErrorCall(..,ErrorCall)
+       , errorCallException
+       , errorCallWithCallStackException
          -- re-export CallStack and SrcLoc from GHC.Types
        , CallStack, fromCallSiteList, getCallStack, prettyCallStack
        , prettyCallStackLines, showCCSStack
        , SrcLoc(..), prettySrcLoc
        ) where
 
-import Data.Maybe
-import Data.Typeable (Typeable, cast)
-   -- loop: Data.Typeable -> GHC.Err -> GHC.Exception
 import GHC.Base
 import GHC.Show
 import GHC.Stack.Types
@@ -45,124 +41,7 @@ import GHC.OldList
 import GHC.Prim
 import GHC.IO.Unsafe
 import {-# SOURCE #-} GHC.Stack.CCS
-
-{- |
-The @SomeException@ type is the root of the exception type hierarchy.
-When an exception of type @e@ is thrown, behind the scenes it is
-encapsulated in a @SomeException@.
--}
-data SomeException = forall e . Exception e => SomeException e
-
--- | @since 3.0
-instance Show SomeException where
-    showsPrec p (SomeException e) = showsPrec p e
-
-{- |
-Any type that you wish to throw or catch as an exception must be an
-instance of the @Exception@ class. The simplest case is a new exception
-type directly below the root:
-
-> data MyException = ThisException | ThatException
->     deriving Show
->
-> instance Exception MyException
-
-The default method definitions in the @Exception@ class do what we need
-in this case. You can now throw and catch @ThisException@ and
-@ThatException@ as exceptions:
-
-@
-*Main> throw ThisException \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MyException))
-Caught ThisException
-@
-
-In more complicated examples, you may wish to define a whole hierarchy
-of exceptions:
-
-> ---------------------------------------------------------------------
-> -- Make the root exception type for all the exceptions in a compiler
->
-> data SomeCompilerException = forall e . Exception e => SomeCompilerException e
->
-> instance Show SomeCompilerException where
->     show (SomeCompilerException e) = show e
->
-> instance Exception SomeCompilerException
->
-> compilerExceptionToException :: Exception e => e -> SomeException
-> compilerExceptionToException = toException . SomeCompilerException
->
-> compilerExceptionFromException :: Exception e => SomeException -> Maybe e
-> compilerExceptionFromException x = do
->     SomeCompilerException a <- fromException x
->     cast a
->
-> ---------------------------------------------------------------------
-> -- Make a subhierarchy for exceptions in the frontend of the compiler
->
-> data SomeFrontendException = forall e . Exception e => SomeFrontendException e
->
-> instance Show SomeFrontendException where
->     show (SomeFrontendException e) = show e
->
-> instance Exception SomeFrontendException where
->     toException = compilerExceptionToException
->     fromException = compilerExceptionFromException
->
-> frontendExceptionToException :: Exception e => e -> SomeException
-> frontendExceptionToException = toException . SomeFrontendException
->
-> frontendExceptionFromException :: Exception e => SomeException -> Maybe e
-> frontendExceptionFromException x = do
->     SomeFrontendException a <- fromException x
->     cast a
->
-> ---------------------------------------------------------------------
-> -- Make an exception type for a particular frontend compiler exception
->
-> data MismatchedParentheses = MismatchedParentheses
->     deriving Show
->
-> instance Exception MismatchedParentheses where
->     toException   = frontendExceptionToException
->     fromException = frontendExceptionFromException
-
-We can now catch a @MismatchedParentheses@ exception as
-@MismatchedParentheses@, @SomeFrontendException@ or
-@SomeCompilerException@, but not other types, e.g. @IOException@:
-
-@
-*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MismatchedParentheses))
-Caught MismatchedParentheses
-*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeFrontendException))
-Caught MismatchedParentheses
-*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeCompilerException))
-Caught MismatchedParentheses
-*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: IOException))
-*** Exception: MismatchedParentheses
-@
-
--}
-class (Typeable e, Show e) => Exception e where
-    toException   :: e -> SomeException
-    fromException :: SomeException -> Maybe e
-
-    toException = SomeException
-    fromException (SomeException e) = cast e
-
-    -- | Render this exception value in a human-friendly manner.
-    --
-    -- Default implementation: @'show'@.
-    --
-    -- @since 4.8.0.0
-    displayException :: e -> String
-    displayException = show
-
--- | @since 3.0
-instance Exception SomeException where
-    toException se = se
-    fromException = Just
-    displayException (SomeException e) = displayException e
+import GHC.Exception.Type
 
 -- | Throw an exception.  Exceptions may be thrown from purely
 -- functional code, but may only be caught within the 'IO' monad.
@@ -236,33 +115,3 @@ prettyCallStackLines cs = case getCallStack cs of
        : map (("  " ++) . prettyCallSite) stk
   where
     prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc
-
--- |Arithmetic exceptions.
-data ArithException
-  = Overflow
-  | Underflow
-  | LossOfPrecision
-  | DivideByZero
-  | Denormal
-  | RatioZeroDenominator -- ^ @since 4.6.0.0
-  deriving ( Eq  -- ^ @since 3.0
-           , Ord -- ^ @since 3.0
-           )
-
-divZeroException, overflowException, ratioZeroDenomException, underflowException  :: SomeException
-divZeroException        = toException DivideByZero
-overflowException       = toException Overflow
-ratioZeroDenomException = toException RatioZeroDenominator
-underflowException      = toException Underflow
-
--- | @since 4.0.0.0
-instance Exception ArithException
-
--- | @since 4.0.0.0
-instance Show ArithException where
-  showsPrec _ Overflow        = showString "arithmetic overflow"
-  showsPrec _ Underflow       = showString "arithmetic underflow"
-  showsPrec _ LossOfPrecision = showString "loss of precision"
-  showsPrec _ DivideByZero    = showString "divide by zero"
-  showsPrec _ Denormal        = showString "denormal"
-  showsPrec _ RatioZeroDenominator = showString "Ratio has zero denominator"
diff --git a/libraries/base/GHC/Exception.hs-boot b/libraries/base/GHC/Exception.hs-boot
index d539dd4962..4507b20790 100644
--- a/libraries/base/GHC/Exception.hs-boot
+++ b/libraries/base/GHC/Exception.hs-boot
@@ -24,17 +24,15 @@ well-behaved, non-bottom values.  The clients use 'raise#'
 to get a visibly-bottom value.
 -}
 
-module GHC.Exception ( SomeException, errorCallException,
-                       errorCallWithCallStackException,
-                       divZeroException, overflowException, ratioZeroDenomException,
-                       underflowException
-    ) where
+module GHC.Exception
+  ( module GHC.Exception.Type
+  , errorCallException
+  , errorCallWithCallStackException
+  ) where
+
+import {-# SOURCE #-} GHC.Exception.Type
 import GHC.Types ( Char )
 import GHC.Stack.Types ( CallStack )
 
-data SomeException
-divZeroException, overflowException, ratioZeroDenomException  :: SomeException
-underflowException :: SomeException
-
 errorCallException :: [Char] -> SomeException
 errorCallWithCallStackException :: [Char] -> CallStack -> SomeException
diff --git a/libraries/base/GHC/Exception/Type.hs b/libraries/base/GHC/Exception/Type.hs
new file mode 100644
index 0000000000..6c3eb49ff9
--- /dev/null
+++ b/libraries/base/GHC/Exception/Type.hs
@@ -0,0 +1,183 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude
+           , ExistentialQuantification
+           , MagicHash
+           , RecordWildCards
+           , PatternSynonyms
+  #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Exception.Type
+-- Copyright   :  (c) The University of Glasgow, 1998-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- Exceptions and exception-handling functions.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Exception.Type
+       ( Exception(..)    -- Class
+       , SomeException(..), ArithException(..)
+       , divZeroException, overflowException, ratioZeroDenomException
+       , underflowException
+       ) where
+
+import Data.Maybe
+import Data.Typeable (Typeable, cast)
+   -- loop: Data.Typeable -> GHC.Err -> GHC.Exception
+import GHC.Base
+import GHC.Show
+
+{- |
+The @SomeException@ type is the root of the exception type hierarchy.
+When an exception of type @e@ is thrown, behind the scenes it is
+encapsulated in a @SomeException@.
+-}
+data SomeException = forall e . Exception e => SomeException e
+
+-- | @since 3.0
+instance Show SomeException where
+    showsPrec p (SomeException e) = showsPrec p e
+
+{- |
+Any type that you wish to throw or catch as an exception must be an
+instance of the @Exception@ class. The simplest case is a new exception
+type directly below the root:
+
+> data MyException = ThisException | ThatException
+>     deriving Show
+>
+> instance Exception MyException
+
+The default method definitions in the @Exception@ class do what we need
+in this case. You can now throw and catch @ThisException@ and
+@ThatException@ as exceptions:
+
+@
+*Main> throw ThisException \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MyException))
+Caught ThisException
+@
+
+In more complicated examples, you may wish to define a whole hierarchy
+of exceptions:
+
+> ---------------------------------------------------------------------
+> -- Make the root exception type for all the exceptions in a compiler
+>
+> data SomeCompilerException = forall e . Exception e => SomeCompilerException e
+>
+> instance Show SomeCompilerException where
+>     show (SomeCompilerException e) = show e
+>
+> instance Exception SomeCompilerException
+>
+> compilerExceptionToException :: Exception e => e -> SomeException
+> compilerExceptionToException = toException . SomeCompilerException
+>
+> compilerExceptionFromException :: Exception e => SomeException -> Maybe e
+> compilerExceptionFromException x = do
+>     SomeCompilerException a <- fromException x
+>     cast a
+>
+> ---------------------------------------------------------------------
+> -- Make a subhierarchy for exceptions in the frontend of the compiler
+>
+> data SomeFrontendException = forall e . Exception e => SomeFrontendException e
+>
+> instance Show SomeFrontendException where
+>     show (SomeFrontendException e) = show e
+>
+> instance Exception SomeFrontendException where
+>     toException = compilerExceptionToException
+>     fromException = compilerExceptionFromException
+>
+> frontendExceptionToException :: Exception e => e -> SomeException
+> frontendExceptionToException = toException . SomeFrontendException
+>
+> frontendExceptionFromException :: Exception e => SomeException -> Maybe e
+> frontendExceptionFromException x = do
+>     SomeFrontendException a <- fromException x
+>     cast a
+>
+> ---------------------------------------------------------------------
+> -- Make an exception type for a particular frontend compiler exception
+>
+> data MismatchedParentheses = MismatchedParentheses
+>     deriving Show
+>
+> instance Exception MismatchedParentheses where
+>     toException   = frontendExceptionToException
+>     fromException = frontendExceptionFromException
+
+We can now catch a @MismatchedParentheses@ exception as
+@MismatchedParentheses@, @SomeFrontendException@ or
+@SomeCompilerException@, but not other types, e.g. @IOException@:
+
+@
+*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MismatchedParentheses))
+Caught MismatchedParentheses
+*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeFrontendException))
+Caught MismatchedParentheses
+*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeCompilerException))
+Caught MismatchedParentheses
+*Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: IOException))
+*** Exception: MismatchedParentheses
+@
+
+-}
+class (Typeable e, Show e) => Exception e where
+    toException   :: e -> SomeException
+    fromException :: SomeException -> Maybe e
+
+    toException = SomeException
+    fromException (SomeException e) = cast e
+
+    -- | Render this exception value in a human-friendly manner.
+    --
+    -- Default implementation: @'show'@.
+    --
+    -- @since 4.8.0.0
+    displayException :: e -> String
+    displayException = show
+
+-- | @since 3.0
+instance Exception SomeException where
+    toException se = se
+    fromException = Just
+    displayException (SomeException e) = displayException e
+
+-- |Arithmetic exceptions.
+data ArithException
+  = Overflow
+  | Underflow
+  | LossOfPrecision
+  | DivideByZero
+  | Denormal
+  | RatioZeroDenominator -- ^ @since 4.6.0.0
+  deriving ( Eq  -- ^ @since 3.0
+           , Ord -- ^ @since 3.0
+           )
+
+divZeroException, overflowException, ratioZeroDenomException, underflowException  :: SomeException
+divZeroException        = toException DivideByZero
+overflowException       = toException Overflow
+ratioZeroDenomException = toException RatioZeroDenominator
+underflowException      = toException Underflow
+
+-- | @since 4.0.0.0
+instance Exception ArithException
+
+-- | @since 4.0.0.0
+instance Show ArithException where
+  showsPrec _ Overflow        = showString "arithmetic overflow"
+  showsPrec _ Underflow       = showString "arithmetic underflow"
+  showsPrec _ LossOfPrecision = showString "loss of precision"
+  showsPrec _ DivideByZero    = showString "divide by zero"
+  showsPrec _ Denormal        = showString "denormal"
+  showsPrec _ RatioZeroDenominator = showString "Ratio has zero denominator"
diff --git a/libraries/base/GHC/Exception/Type.hs-boot b/libraries/base/GHC/Exception/Type.hs-boot
new file mode 100644
index 0000000000..1b4f0c0d81
--- /dev/null
+++ b/libraries/base/GHC/Exception/Type.hs-boot
@@ -0,0 +1,16 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.Exception.Type
+  ( SomeException
+  , divZeroException
+  , overflowException
+  , ratioZeroDenomException
+  , underflowException
+  ) where
+
+import GHC.Types ()
+
+data SomeException
+divZeroException, overflowException,
+  ratioZeroDenomException, underflowException :: SomeException
diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs
index ad2a872c39..9bc161105d 100644
--- a/libraries/base/GHC/Int.hs
+++ b/libraries/base/GHC/Int.hs
@@ -1082,6 +1082,36 @@ instance Ix Int64 where
     unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
     inRange (m,n) i     = m <= i && i <= n
 
+-------------------------------------------------------------------------------
+
+{-# RULES
+"fromIntegral/Natural->Int8"
+    fromIntegral = (fromIntegral :: Int -> Int8)    . naturalToInt
+"fromIntegral/Natural->Int16"
+    fromIntegral = (fromIntegral :: Int -> Int16)   . naturalToInt
+"fromIntegral/Natural->Int32"
+    fromIntegral = (fromIntegral :: Int -> Int32)   . naturalToInt
+  #-}
+
+{-# RULES
+"fromIntegral/Int8->Natural"
+    fromIntegral = intToNatural  . (fromIntegral :: Int8  -> Int)
+"fromIntegral/Int16->Natural"
+    fromIntegral = intToNatural  . (fromIntegral :: Int16 -> Int)
+"fromIntegral/Int32->Natural"
+    fromIntegral = intToNatural  . (fromIntegral :: Int32 -> Int)
+  #-}
+
+#if WORD_SIZE_IN_BITS == 64
+-- these RULES are valid for Word==Word64 & Int==Int64
+{-# RULES
+"fromIntegral/Natural->Int64"
+    fromIntegral = (fromIntegral :: Int -> Int64) . naturalToInt
+"fromIntegral/Int64->Natural"
+    fromIntegral = intToNatural . (fromIntegral :: Int64 -> Int)
+  #-}
+#endif
+
 
 {- Note [Order of tests]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/libraries/base/GHC/Maybe.hs b/libraries/base/GHC/Maybe.hs
new file mode 100644
index 0000000000..9fcf8b717d
--- /dev/null
+++ b/libraries/base/GHC/Maybe.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Maybe type
+module GHC.Maybe
+   ( Maybe (..)
+   )
+where
+
+import GHC.Integer () -- for build order
+import GHC.Classes
+
+default ()
+
+-------------------------------------------------------------------------------
+-- Maybe type
+-------------------------------------------------------------------------------
+
+-- | The 'Maybe' type encapsulates an optional value.  A value of type
+-- @'Maybe' a@ either contains a value of type @a@ (represented as @'Just' a@),
+-- or it is empty (represented as 'Nothing').  Using 'Maybe' is a good way to
+-- deal with errors or exceptional cases without resorting to drastic
+-- measures such as 'error'.
+--
+-- The 'Maybe' type is also a monad.  It is a simple kind of error
+-- monad, where all errors are represented by 'Nothing'.  A richer
+-- error monad can be built using the 'Data.Either.Either' type.
+--
+data  Maybe a  =  Nothing | Just a
+  deriving ( Eq  -- ^ @since 2.01
+           , Ord -- ^ @since 2.01
+           )
diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs
index 32cf2d2579..db8d8b883b 100644
--- a/libraries/base/GHC/Natural.hs
+++ b/libraries/base/GHC/Natural.hs
@@ -1,12 +1,8 @@
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MagicHash #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE Unsafe #-}
-
-{-# OPTIONS_HADDOCK not-home #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -34,38 +30,76 @@ module GHC.Natural
       -- (i.e. which constructors are available) depends on the
       -- 'Integer' backend used!
       Natural(..)
+    , mkNatural
     , isValidNatural
+      -- * Arithmetic
+    , plusNatural
+    , minusNatural
+    , minusNaturalMaybe
+    , timesNatural
+    , negateNatural
+    , signumNatural
+    , quotRemNatural
+    , quotNatural
+    , remNatural
+#if defined(MIN_VERSION_integer_gmp)
+    , gcdNatural
+    , lcmNatural
+#endif
+      -- * Bits
+    , andNatural
+    , orNatural
+    , xorNatural
+    , bitNatural
+    , testBitNatural
+#if defined(MIN_VERSION_integer_gmp)
+    , popCountNatural
+#endif
+    , shiftLNatural
+    , shiftRNatural
       -- * Conversions
+    , naturalToInteger
+    , naturalToWord
+    , naturalToInt
     , naturalFromInteger
     , wordToNatural
+    , intToNatural
     , naturalToWordMaybe
-      -- * Checked subtraction
-    , minusNaturalMaybe
+    , wordToNatural#
+    , wordToNaturalBase
       -- * Modular arithmetic
     , powModNatural
     ) where
 
 #include "MachDeps.h"
 
-import GHC.Arr
-import GHC.Base
-import {-# SOURCE #-} GHC.Exception (underflowException)
+import GHC.Classes
+import GHC.Maybe
+import GHC.Types
+import GHC.Prim
+import {-# SOURCE #-} GHC.Exception.Type (underflowException, divZeroException)
 #if defined(MIN_VERSION_integer_gmp)
 import GHC.Integer.GMP.Internals
-import Data.Word
-import Data.Int
+#else
+import GHC.Integer
 #endif
-import GHC.Num
-import GHC.Real
-import GHC.Read
-import GHC.Show
-import GHC.Enum
-import GHC.List
-
-import Data.Bits
 
 default ()
 
+-- Most high-level operations need to be marked `NOINLINE` as
+-- otherwise GHC doesn't recognize them and fails to apply constant
+-- folding to `Natural`-typed expression.
+--
+-- To this end, the CPP hack below allows to write the pseudo-pragma
+--
+--   {-# CONSTANT_FOLDED plusNatural #-}
+--
+-- which is simply expanded into a
+--
+--   {-# NOINLINE plusNatural #-}
+--
+#define CONSTANT_FOLDED NOINLINE
+
 -------------------------------------------------------------------------------
 -- Arithmetic underflow
 -------------------------------------------------------------------------------
@@ -77,6 +111,10 @@ default ()
 underflowError :: a
 underflowError = raise# underflowException
 
+{-# NOINLINE divZeroError #-}
+divZeroError :: a
+divZeroError = raise# divZeroException
+
 -------------------------------------------------------------------------------
 -- Natural type
 -------------------------------------------------------------------------------
@@ -117,107 +155,32 @@ data Natural = NatS#                 GmpLimb# -- ^ in @[0, maxBound::Word]@
 isValidNatural :: Natural -> Bool
 isValidNatural (NatS# _)  = True
 isValidNatural (NatJ# bn) = isTrue# (isValidBigNat# bn)
-                            && I# (sizeofBigNat# bn) > 0
-
-{-# RULES
-"fromIntegral/Natural->Natural"  fromIntegral = id :: Natural -> Natural
-"fromIntegral/Natural->Integer"  fromIntegral = toInteger :: Natural->Integer
-"fromIntegral/Natural->Word"     fromIntegral = naturalToWord
-"fromIntegral/Natural->Word8"
-    fromIntegral = (fromIntegral :: Word -> Word8)  . naturalToWord
-"fromIntegral/Natural->Word16"
-    fromIntegral = (fromIntegral :: Word -> Word16) . naturalToWord
-"fromIntegral/Natural->Word32"
-    fromIntegral = (fromIntegral :: Word -> Word32) . naturalToWord
-"fromIntegral/Natural->Int8"
-    fromIntegral = (fromIntegral :: Int -> Int8)    . naturalToInt
-"fromIntegral/Natural->Int16"
-    fromIntegral = (fromIntegral :: Int -> Int16)   . naturalToInt
-"fromIntegral/Natural->Int32"
-    fromIntegral = (fromIntegral :: Int -> Int32)   . naturalToInt
-  #-}
-
-{-# RULES
-"fromIntegral/Word->Natural"     fromIntegral = wordToNatural
-"fromIntegral/Word8->Natural"
-    fromIntegral = wordToNatural . (fromIntegral :: Word8  -> Word)
-"fromIntegral/Word16->Natural"
-    fromIntegral = wordToNatural . (fromIntegral :: Word16 -> Word)
-"fromIntegral/Word32->Natural"
-    fromIntegral = wordToNatural . (fromIntegral :: Word32 -> Word)
-"fromIntegral/Int->Natural"     fromIntegral = intToNatural
-"fromIntegral/Int8->Natural"
-    fromIntegral = intToNatural  . (fromIntegral :: Int8  -> Int)
-"fromIntegral/Int16->Natural"
-    fromIntegral = intToNatural  . (fromIntegral :: Int16 -> Int)
-"fromIntegral/Int32->Natural"
-    fromIntegral = intToNatural  . (fromIntegral :: Int32 -> Int)
-  #-}
-
-#if WORD_SIZE_IN_BITS == 64
--- these RULES are valid for Word==Word64 & Int==Int64
-{-# RULES
-"fromIntegral/Natural->Word64"
-    fromIntegral = (fromIntegral :: Word -> Word64) . naturalToWord
-"fromIntegral/Natural->Int64"
-    fromIntegral = (fromIntegral :: Int -> Int64) . naturalToInt
-"fromIntegral/Word64->Natural"
-    fromIntegral = wordToNatural . (fromIntegral :: Word64 -> Word)
-"fromIntegral/Int64->Natural"
-    fromIntegral = intToNatural . (fromIntegral :: Int64 -> Int)
-  #-}
-#endif
-
--- | @since 4.8.0.0
-instance Show Natural where
-    showsPrec p (NatS# w#)  = showsPrec p (W# w#)
-    showsPrec p (NatJ# bn)  = showsPrec p (Jp# bn)
-
--- | @since 4.8.0.0
-instance Read Natural where
-    readsPrec d = map (\(n, s) -> (fromInteger n, s))
-                  . filter ((>= 0) . (\(x,_)->x)) . readsPrec d
-
--- | @since 4.8.0.0
-instance Num Natural where
-    fromInteger          = naturalFromInteger
+                            && isTrue# (sizeofBigNat# bn ># 0#)
 
-    (+) = plusNatural
-    (*) = timesNatural
-    (-) = minusNatural
+signumNatural :: Natural -> Natural
+signumNatural (NatS# 0##) = NatS# 0##
+signumNatural _           = NatS# 1##
+{-# CONSTANT_FOLDED signumNatural #-}
 
-    abs                  = id
-
-    signum (NatS# 0##)   = NatS# 0##
-    signum _             = NatS# 1##
-
-    negate (NatS# 0##)   = NatS# 0##
-    negate _             = underflowError
+negateNatural :: Natural -> Natural
+negateNatural (NatS# 0##) = NatS# 0##
+negateNatural _           = underflowError
+{-# CONSTANT_FOLDED negateNatural #-}
 
 -- | @since 4.10.0.0
 naturalFromInteger :: Integer -> Natural
-naturalFromInteger (S# i#) | I# i# >= 0  = NatS# (int2Word# i#)
-naturalFromInteger (Jp# bn)              = bigNatToNatural bn
-naturalFromInteger _                     = underflowError
-{-# INLINE naturalFromInteger #-}
-
--- | @since 4.8.0.0
-instance Real Natural where
-    toRational (NatS# w)  = toRational (W# w)
-    toRational (NatJ# bn) = toRational (Jp# bn)
-
-#if OPTIMISE_INTEGER_GCD_LCM
-{-# RULES
-"gcd/Natural->Natural->Natural" gcd = gcdNatural
-"lcm/Natural->Natural->Natural" lcm = lcmNatural
-  #-}
+naturalFromInteger (S# i#)
+  | isTrue# (i# >=# 0#)     = NatS# (int2Word# i#)
+naturalFromInteger (Jp# bn) = bigNatToNatural bn
+naturalFromInteger _        = underflowError
+{-# CONSTANT_FOLDED naturalFromInteger #-}
 
 -- | Compute greatest common divisor.
 gcdNatural :: Natural -> Natural -> Natural
 gcdNatural (NatS# 0##) y       = y
 gcdNatural x       (NatS# 0##) = x
-gcdNatural (NatS# 1##) _       = (NatS# 1##)
-gcdNatural _       (NatS# 1##) = (NatS# 1##)
+gcdNatural (NatS# 1##) _       = NatS# 1##
+gcdNatural _       (NatS# 1##) = NatS# 1##
 gcdNatural (NatJ# x) (NatJ# y) = bigNatToNatural (gcdBigNat x y)
 gcdNatural (NatJ# x) (NatS# y) = NatS# (gcdBigNatWord x y)
 gcdNatural (NatS# x) (NatJ# y) = NatS# (gcdBigNatWord y x)
@@ -225,162 +188,107 @@ gcdNatural (NatS# x) (NatS# y) = NatS# (gcdWord x y)
 
 -- | compute least common multiplier.
 lcmNatural :: Natural -> Natural -> Natural
-lcmNatural (NatS# 0##) _ = (NatS# 0##)
-lcmNatural _ (NatS# 0##) = (NatS# 0##)
+lcmNatural (NatS# 0##) _ = NatS# 0##
+lcmNatural _ (NatS# 0##) = NatS# 0##
 lcmNatural (NatS# 1##) y = y
 lcmNatural x (NatS# 1##) = x
-lcmNatural x y           = (x `quot` (gcdNatural x y)) * y
-
-#endif
-
--- | @since 4.8.0.0
-instance Enum Natural where
-    succ n = n `plusNatural`  NatS# 1##
-    pred n = n `minusNatural` NatS# 1##
-
-    toEnum = intToNatural
-
-    fromEnum (NatS# w) | i >= 0 = i
-      where
-        i = fromIntegral (W# w)
-    fromEnum _ = errorWithoutStackTrace "fromEnum: out of Int range"
-
-    enumFrom x        = enumDeltaNatural      x (NatS# 1##)
-    enumFromThen x y
-      | x <= y        = enumDeltaNatural      x (y-x)
-      | otherwise     = enumNegDeltaToNatural x (x-y) (NatS# 0##)
-
-    enumFromTo x lim  = enumDeltaToNatural    x (NatS# 1##) lim
-    enumFromThenTo x y lim
-      | x <= y        = enumDeltaToNatural    x (y-x) lim
-      | otherwise     = enumNegDeltaToNatural x (x-y) lim
-
-----------------------------------------------------------------------------
--- Helpers for 'Enum Natural'; TODO: optimise & make fusion work
-
-enumDeltaNatural :: Natural -> Natural -> [Natural]
-enumDeltaNatural !x d = x : enumDeltaNatural (x+d) d
-
-enumDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
-enumDeltaToNatural x0 delta lim = go x0
-  where
-    go x | x > lim   = []
-         | otherwise = x : go (x+delta)
-
-enumNegDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
-enumNegDeltaToNatural x0 ndelta lim = go x0
-  where
-    go x | x < lim     = []
-         | x >= ndelta = x : go (x-ndelta)
-         | otherwise   = [x]
+lcmNatural x y           = (x `quotNatural` (gcdNatural x y)) `timesNatural` y
 
 ----------------------------------------------------------------------------
 
--- | @since 4.8.0.0
-instance Integral Natural where
-    toInteger (NatS# w)  = wordToInteger w
-    toInteger (NatJ# bn) = Jp# bn
-
-    divMod = quotRem
-    div    = quot
-    mod    = rem
-
-    quotRem _ (NatS# 0##) = divZeroError
-    quotRem n (NatS# 1##) = (n,NatS# 0##)
-    quotRem n@(NatS# _) (NatJ# _) = (NatS# 0##, n)
-    quotRem (NatS# n) (NatS# d) = case quotRem (W# n) (W# d) of
-        (q,r) -> (wordToNatural q, wordToNatural r)
-    quotRem (NatJ# n) (NatS# d) = case quotRemBigNatWord n d of
-        (# q,r #) -> (bigNatToNatural q, NatS# r)
-    quotRem (NatJ# n) (NatJ# d) = case quotRemBigNat n d of
-        (# q,r #) -> (bigNatToNatural q, bigNatToNatural r)
-
-    quot _       (NatS# 0##) = divZeroError
-    quot n       (NatS# 1##) = n
-    quot (NatS# _) (NatJ# _) = NatS# 0##
-    quot (NatS# n) (NatS# d) = wordToNatural (quot (W# n) (W# d))
-    quot (NatJ# n) (NatS# d) = bigNatToNatural (quotBigNatWord n d)
-    quot (NatJ# n) (NatJ# d) = bigNatToNatural (quotBigNat n d)
-
-    rem _         (NatS# 0##) = divZeroError
-    rem _         (NatS# 1##) = NatS# 0##
-    rem n@(NatS# _) (NatJ# _) = n
-    rem   (NatS# n) (NatS# d) = wordToNatural (rem (W# n) (W# d))
-    rem   (NatJ# n) (NatS# d) = NatS# (remBigNatWord n d)
-    rem   (NatJ# n) (NatJ# d) = bigNatToNatural (remBigNat n d)
-
--- | @since 4.8.0.0
-instance Ix Natural where
-    range (m,n) = [m..n]
-    inRange (m,n) i = m <= i && i <= n
-    unsafeIndex (m,_) i = fromIntegral (i-m)
-    index b i | inRange b i = unsafeIndex b i
-              | otherwise   = indexError b i "Natural"
-
-
--- | @since 4.8.0.0
-instance Bits Natural where
-    NatS# n .&. NatS# m = wordToNatural (W# n .&. W# m)
-    NatS# n .&. NatJ# m = wordToNatural (W# n .&. W# (bigNatToWord m))
-    NatJ# n .&. NatS# m = wordToNatural (W# (bigNatToWord n) .&. W# m)
-    NatJ# n .&. NatJ# m = bigNatToNatural (andBigNat n m)
-
-    NatS# n .|. NatS# m = wordToNatural (W# n .|. W# m)
-    NatS# n .|. NatJ# m = NatJ# (orBigNat (wordToBigNat n) m)
-    NatJ# n .|. NatS# m = NatJ# (orBigNat n (wordToBigNat m))
-    NatJ# n .|. NatJ# m = NatJ# (orBigNat n m)
-
-    NatS# n `xor` NatS# m = wordToNatural (W# n `xor` W# m)
-    NatS# n `xor` NatJ# m = NatJ# (xorBigNat (wordToBigNat n) m)
-    NatJ# n `xor` NatS# m = NatJ# (xorBigNat n (wordToBigNat m))
-    NatJ# n `xor` NatJ# m = bigNatToNatural (xorBigNat n m)
-
-    complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"
-
-    bitSizeMaybe _ = Nothing
-    bitSize = errorWithoutStackTrace "Natural: bitSize"
-    isSigned _ = False
-
-    bit i@(I# i#) | i < finiteBitSize (0::Word) = wordToNatural (bit i)
-                  | otherwise                   = NatJ# (bitBigNat i#)
-
-    testBit (NatS# w) i = testBit (W# w) i
-    testBit (NatJ# bn) (I# i#) = testBitBigNat bn i#
-
-    clearBit n@(NatS# w#) i
-        | i < finiteBitSize (0::Word) = let !(W# w2#) = clearBit (W# w#) i in NatS# w2#
-        | otherwise                   = n
-    clearBit (NatJ# bn) (I# i#) = bigNatToNatural (clearBitBigNat bn i#)
-
-    setBit (NatS# w#) i@(I# i#)
-        | i < finiteBitSize (0::Word) = let !(W# w2#) = setBit (W# w#) i in NatS# w2#
-        | otherwise                   = bigNatToNatural (setBitBigNat (wordToBigNat w#) i#)
-    setBit (NatJ# bn) (I# i#) = bigNatToNatural (setBitBigNat bn i#)
-
-    complementBit (NatS# w#) i@(I# i#)
-        | i < finiteBitSize (0::Word) = let !(W# w2#) = complementBit (W# w#) i in NatS# w2#
-        | otherwise                   = bigNatToNatural (setBitBigNat (wordToBigNat w#) i#)
-    complementBit (NatJ# bn) (I# i#) = bigNatToNatural (complementBitBigNat bn i#)
-
-    shiftL n           0 = n
-    shiftL (NatS# 0##) _ = NatS# 0##
-    shiftL (NatS# 1##) i = bit i
-    shiftL (NatS# w) (I# i#)
-        = bigNatToNatural $ shiftLBigNat (wordToBigNat w) i#
-    shiftL (NatJ# bn) (I# i#)
-        = bigNatToNatural $ shiftLBigNat bn i#
-
-    shiftR n          0       = n
-    shiftR (NatS# w)  i       = wordToNatural $ shiftR (W# w) i
-    shiftR (NatJ# bn) (I# i#) = bigNatToNatural (shiftRBigNat bn i#)
-
-    rotateL = shiftL
-    rotateR = shiftR
-
-    popCount (NatS# w)  = popCount (W# w)
-    popCount (NatJ# bn) = I# (popCountBigNat bn)
-
-    zeroBits = NatS# 0##
+quotRemNatural :: Natural -> Natural -> (Natural, Natural)
+quotRemNatural _ (NatS# 0##) = divZeroError
+quotRemNatural n (NatS# 1##) = (n,NatS# 0##)
+quotRemNatural n@(NatS# _) (NatJ# _) = (NatS# 0##, n)
+quotRemNatural (NatS# n) (NatS# d) = case quotRemWord# n d of
+    (# q, r #) -> (NatS# q, NatS# r)
+quotRemNatural (NatJ# n) (NatS# d) = case quotRemBigNatWord n d of
+    (# q, r #) -> (bigNatToNatural q, NatS# r)
+quotRemNatural (NatJ# n) (NatJ# d) = case quotRemBigNat n d of
+    (# q, r #) -> (bigNatToNatural q, bigNatToNatural r)
+{-# CONSTANT_FOLDED quotRemNatural #-}
+
+quotNatural :: Natural -> Natural -> Natural
+quotNatural _       (NatS# 0##) = divZeroError
+quotNatural n       (NatS# 1##) = n
+quotNatural (NatS# _) (NatJ# _) = NatS# 0##
+quotNatural (NatS# n) (NatS# d) = NatS# (quotWord# n d)
+quotNatural (NatJ# n) (NatS# d) = bigNatToNatural (quotBigNatWord n d)
+quotNatural (NatJ# n) (NatJ# d) = bigNatToNatural (quotBigNat n d)
+{-# CONSTANT_FOLDED quotNatural #-}
+
+remNatural :: Natural -> Natural -> Natural
+remNatural _         (NatS# 0##) = divZeroError
+remNatural _         (NatS# 1##) = NatS# 0##
+remNatural n@(NatS# _) (NatJ# _) = n
+remNatural   (NatS# n) (NatS# d) = NatS# (remWord# n d)
+remNatural   (NatJ# n) (NatS# d) = NatS# (remBigNatWord n d)
+remNatural   (NatJ# n) (NatJ# d) = bigNatToNatural (remBigNat n d)
+{-# CONSTANT_FOLDED remNatural #-}
+
+-- | @since 4.X.0.0
+naturalToInteger :: Natural -> Integer
+naturalToInteger (NatS# w)  = wordToInteger w
+naturalToInteger (NatJ# bn) = Jp# bn
+{-# CONSTANT_FOLDED naturalToInteger #-}
+
+andNatural :: Natural -> Natural -> Natural
+andNatural (NatS# n) (NatS# m) = NatS# (n `and#` m)
+andNatural (NatS# n) (NatJ# m) = NatS# (n `and#` bigNatToWord m)
+andNatural (NatJ# n) (NatS# m) = NatS# (bigNatToWord n `and#` m)
+andNatural (NatJ# n) (NatJ# m) = bigNatToNatural (andBigNat n m)
+{-# CONSTANT_FOLDED andNatural #-}
+
+orNatural :: Natural -> Natural -> Natural
+orNatural (NatS# n) (NatS# m) = NatS# (n `or#` m)
+orNatural (NatS# n) (NatJ# m) = NatJ# (orBigNat (wordToBigNat n) m)
+orNatural (NatJ# n) (NatS# m) = NatJ# (orBigNat n (wordToBigNat m))
+orNatural (NatJ# n) (NatJ# m) = NatJ# (orBigNat n m)
+{-# CONSTANT_FOLDED orNatural #-}
+
+xorNatural :: Natural -> Natural -> Natural
+xorNatural (NatS# n) (NatS# m) = NatS# (n `xor#` m)
+xorNatural (NatS# n) (NatJ# m) = NatJ# (xorBigNat (wordToBigNat n) m)
+xorNatural (NatJ# n) (NatS# m) = NatJ# (xorBigNat n (wordToBigNat m))
+xorNatural (NatJ# n) (NatJ# m) = bigNatToNatural (xorBigNat n m)
+{-# CONSTANT_FOLDED xorNatural #-}
+
+bitNatural :: Int# -> Natural
+bitNatural i#
+  | isTrue# (i# <# WORD_SIZE_IN_BITS#) = NatS# (1## `uncheckedShiftL#` i#)
+  | True                               = NatJ# (bitBigNat i#)
+{-# CONSTANT_FOLDED bitNatural #-}
+
+testBitNatural :: Natural -> Int -> Bool
+testBitNatural (NatS# w) (I# i#)
+  | isTrue# (i# <# WORD_SIZE_IN_BITS#) =
+      isTrue# ((w `and#` (1## `uncheckedShiftL#` i#)) `neWord#` 0##)
+  | True                               = False
+testBitNatural (NatJ# bn) (I# i#)      = testBitBigNat bn i#
+{-# CONSTANT_FOLDED testBitNatural #-}
+
+popCountNatural :: Natural -> Int
+popCountNatural (NatS# w)  = I# (word2Int# (popCnt# w))
+popCountNatural (NatJ# bn) = I# (popCountBigNat bn)
+{-# CONSTANT_FOLDED popCountNatural #-}
+
+shiftLNatural :: Natural -> Int -> Natural
+shiftLNatural n           (I# 0#) = n
+shiftLNatural (NatS# 0##) _       = NatS# 0##
+shiftLNatural (NatS# 1##) (I# i#) = bitNatural i#
+shiftLNatural (NatS# w) (I# i#)
+    = bigNatToNatural (shiftLBigNat (wordToBigNat w) i#)
+shiftLNatural (NatJ# bn) (I# i#)
+    = bigNatToNatural (shiftLBigNat bn i#)
+{-# CONSTANT_FOLDED shiftLNatural #-}
+
+shiftRNatural :: Natural -> Int -> Natural
+shiftRNatural n          (I# 0#) = n
+shiftRNatural (NatS# w)  (I# i#)
+      | isTrue# (i# >=# WORD_SIZE_IN_BITS#) = NatS# 0##
+      | True = NatS# (w `uncheckedShiftRL#` i#)
+shiftRNatural (NatJ# bn) (I# i#) = bigNatToNatural (shiftRBigNat bn i#)
+{-# CONSTANT_FOLDED shiftRNatural #-}
 
 ----------------------------------------------------------------------------
 
@@ -395,6 +303,7 @@ plusNatural (NatS# x) (NatS# y)
 plusNatural (NatS# x) (NatJ# y) = NatJ# (plusBigNatWord y x)
 plusNatural (NatJ# x) (NatS# y) = NatJ# (plusBigNatWord x y)
 plusNatural (NatJ# x) (NatJ# y) = NatJ# (plusBigNat     x y)
+{-# CONSTANT_FOLDED plusNatural #-}
 
 -- | 'Natural' multiplication
 timesNatural :: Natural -> Natural -> Natural
@@ -405,10 +314,11 @@ timesNatural (NatS# 1##) y         = y
 timesNatural (NatS# x) (NatS# y) = case timesWord2# x y of
     (# 0##, 0## #) -> NatS# 0##
     (# 0##, xy  #) -> NatS# xy
-    (# h  , l   #) -> NatJ# $ wordToBigNat2 h l
-timesNatural (NatS# x) (NatJ# y) = NatJ# $ timesBigNatWord y x
-timesNatural (NatJ# x) (NatS# y) = NatJ# $ timesBigNatWord x y
-timesNatural (NatJ# x) (NatJ# y) = NatJ# $ timesBigNat     x y
+    (# h  , l   #) -> NatJ# (wordToBigNat2 h l)
+timesNatural (NatS# x) (NatJ# y) = NatJ# (timesBigNatWord y x)
+timesNatural (NatJ# x) (NatS# y) = NatJ# (timesBigNatWord x y)
+timesNatural (NatJ# x) (NatJ# y) = NatJ# (timesBigNat     x y)
+{-# CONSTANT_FOLDED timesNatural #-}
 
 -- | 'Natural' subtraction. May @'throw' 'Underflow'@.
 minusNatural :: Natural -> Natural -> Natural
@@ -418,9 +328,10 @@ minusNatural (NatS# x) (NatS# y) = case subWordC# x y of
     _           -> underflowError
 minusNatural (NatS# _) (NatJ# _) = underflowError
 minusNatural (NatJ# x) (NatS# y)
-    = bigNatToNatural $ minusBigNatWord x y
+    = bigNatToNatural (minusBigNatWord x y)
 minusNatural (NatJ# x) (NatJ# y)
-    = bigNatToNatural $ minusBigNat     x y
+    = bigNatToNatural (minusBigNat     x y)
+{-# CONSTANT_FOLDED minusNatural #-}
 
 -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.
 --
@@ -430,13 +341,12 @@ minusNaturalMaybe x         (NatS# 0##) = Just x
 minusNaturalMaybe (NatS# x) (NatS# y) = case subWordC# x y of
     (# l, 0# #) -> Just (NatS# l)
     _           -> Nothing
-  where
 minusNaturalMaybe (NatS# _) (NatJ# _) = Nothing
 minusNaturalMaybe (NatJ# x) (NatS# y)
-    = Just $ bigNatToNatural $ minusBigNatWord x y
+    = Just (bigNatToNatural (minusBigNatWord x y))
 minusNaturalMaybe (NatJ# x) (NatJ# y)
   | isTrue# (isNullBigNat# res) = Nothing
-  | otherwise = Just (bigNatToNatural res)
+  | True                        = Just (bigNatToNatural res)
   where
     res = minusBigNat x y
 
@@ -446,18 +356,12 @@ bigNatToNatural :: BigNat -> Natural
 bigNatToNatural bn
   | isTrue# (sizeofBigNat# bn ==# 1#) = NatS# (bigNatToWord bn)
   | isTrue# (isNullBigNat# bn)        = underflowError
-  | otherwise                         = NatJ# bn
+  | True                              = NatJ# bn
 
 naturalToBigNat :: Natural -> BigNat
 naturalToBigNat (NatS# w#) = wordToBigNat w#
 naturalToBigNat (NatJ# bn) = bn
 
--- | Convert 'Int' to 'Natural'.
--- Throws 'Underflow' when passed a negative 'Int'.
-intToNatural :: Int -> Natural
-intToNatural i | i<0 = underflowError
-intToNatural (I# i#) = NatS# (int2Word# i#)
-
 naturalToWord :: Natural -> Word
 naturalToWord (NatS# w#) = W# w#
 naturalToWord (NatJ# bn) = W# (bigNatToWord bn)
@@ -466,6 +370,23 @@ naturalToInt :: Natural -> Int
 naturalToInt (NatS# w#) = I# (word2Int# w#)
 naturalToInt (NatJ# bn) = I# (bigNatToInt bn)
 
+----------------------------------------------------------------------------
+
+-- | Convert a Word# into a Natural
+--
+-- Built-in rule ensures that applications of this function to literal Word# are
+-- lifted into Natural literals.
+wordToNatural# :: Word# -> Natural
+wordToNatural# w# = NatS# w#
+{-# CONSTANT_FOLDED wordToNatural# #-}
+
+-- | Convert a Word# into a Natural
+--
+-- In base we can't use wordToNatural# as built-in rules transform some of them
+-- into Natural literals. Use this function instead.
+wordToNaturalBase :: Word# -> Natural
+wordToNaturalBase w# = NatS# w#
+
 #else /* !defined(MIN_VERSION_integer_gmp) */
 ----------------------------------------------------------------------------
 -- Use wrapped 'Integer' as fallback; taken from Edward Kmett's nats package
@@ -477,156 +398,141 @@ naturalToInt (NatJ# bn) = I# (bigNatToInt bn)
 --
 -- @since 4.8.0.0
 newtype Natural = Natural Integer -- ^ __Invariant__: non-negative 'Integer'
-                deriving (Eq,Ord,Ix)
+                  deriving (Eq,Ord)
+
 
 -- | Test whether all internal invariants are satisfied by 'Natural' value
 --
 -- This operation is mostly useful for test-suites and/or code which
--- constructs 'Integer' values directly.
+-- constructs 'Natural' values directly.
 --
 -- @since 4.8.0.0
 isValidNatural :: Natural -> Bool
-isValidNatural (Natural i) = i >= 0
-
--- | @since 4.8.0.0
-instance Read Natural where
-    readsPrec d = map (\(n, s) -> (Natural n, s))
-                  . filter ((>= 0) . (\(x,_)->x)) . readsPrec d
-
--- | @since 4.8.0.0
-instance Show Natural where
-    showsPrec d (Natural i) = showsPrec d i
-
--- | @since 4.8.0.0
-instance Num Natural where
-  Natural n + Natural m = Natural (n + m)
-  {-# INLINE (+) #-}
-  Natural n * Natural m = Natural (n * m)
-  {-# INLINE (*) #-}
-  Natural n - Natural m | result < 0 = underflowError
-                        | otherwise  = Natural result
-    where result = n - m
-  {-# INLINE (-) #-}
-  abs (Natural n) = Natural n
-  {-# INLINE abs #-}
-  signum (Natural n) = Natural (signum n)
-  {-# INLINE signum #-}
-  fromInteger = naturalFromInteger
-  {-# INLINE fromInteger #-}
+isValidNatural (Natural i) = i >= wordToInteger 0##
+
+-- | Convert a Word# into a Natural
+--
+-- Built-in rule ensures that applications of this function to literal Word# are
+-- lifted into Natural literals.
+wordToNatural# :: Word# -> Natural
+wordToNatural# w## = Natural (wordToInteger w##)
+{-# CONSTANT_FOLDED wordToNatural# #-}
+
+-- | Convert a Word# into a Natural
+--
+-- In base we can't use wordToNatural# as built-in rules transform some of them
+-- into Natural literals. Use this function instead.
+wordToNaturalBase :: Word# -> Natural
+wordToNaturalBase w## = Natural (wordToInteger w##)
 
 -- | @since 4.10.0.0
 naturalFromInteger :: Integer -> Natural
 naturalFromInteger n
-  | n >= 0 = Natural n
-  | otherwise = underflowError
+  | n >= wordToInteger 0## = Natural n
+  | True                   = underflowError
 {-# INLINE naturalFromInteger #-}
 
 -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.
 --
 -- @since 4.8.0.0
 minusNaturalMaybe :: Natural -> Natural -> Maybe Natural
-minusNaturalMaybe x y
-  | x >= y    = Just (x - y)
-  | otherwise = Nothing
-
--- | @since 4.8.0.0
-instance Bits Natural where
-  Natural n .&. Natural m = Natural (n .&. m)
-  {-# INLINE (.&.) #-}
-  Natural n .|. Natural m = Natural (n .|. m)
-  {-# INLINE (.|.) #-}
-  xor (Natural n) (Natural m) = Natural (xor n m)
-  {-# INLINE xor #-}
-  complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"
-  {-# INLINE complement #-}
-  shift (Natural n) = Natural . shift n
-  {-# INLINE shift #-}
-  rotate (Natural n) = Natural . rotate n
-  {-# INLINE rotate #-}
-  bit = Natural . bit
-  {-# INLINE bit #-}
-  setBit (Natural n) = Natural . setBit n
-  {-# INLINE setBit #-}
-  clearBit (Natural n) = Natural . clearBit n
-  {-# INLINE clearBit #-}
-  complementBit (Natural n) = Natural . complementBit n
-  {-# INLINE complementBit #-}
-  testBit (Natural n) = testBit n
-  {-# INLINE testBit #-}
-  bitSizeMaybe _ = Nothing
-  {-# INLINE bitSizeMaybe #-}
-  bitSize = errorWithoutStackTrace "Natural: bitSize"
-  {-# INLINE bitSize #-}
-  isSigned _ = False
-  {-# INLINE isSigned #-}
-  shiftL (Natural n) = Natural . shiftL n
-  {-# INLINE shiftL #-}
-  shiftR (Natural n) = Natural . shiftR n
-  {-# INLINE shiftR #-}
-  rotateL (Natural n) = Natural . rotateL n
-  {-# INLINE rotateL #-}
-  rotateR (Natural n) = Natural . rotateR n
-  {-# INLINE rotateR #-}
-  popCount (Natural n) = popCount n
-  {-# INLINE popCount #-}
-  zeroBits = Natural 0
-
--- | @since 4.8.0.0
-instance Real Natural where
-  toRational (Natural a) = toRational a
-  {-# INLINE toRational #-}
-
--- | @since 4.8.0.0
-instance Enum Natural where
-  pred (Natural 0) = errorWithoutStackTrace "Natural.pred: 0"
-  pred (Natural n) = Natural (pred n)
-  {-# INLINE pred #-}
-  succ (Natural n) = Natural (succ n)
-  {-# INLINE succ #-}
-  fromEnum (Natural n) = fromEnum n
-  {-# INLINE fromEnum #-}
-  toEnum n | n < 0     = errorWithoutStackTrace "Natural.toEnum: negative"
-           | otherwise = Natural (toEnum n)
-  {-# INLINE toEnum #-}
-
-  enumFrom     = coerce (enumFrom     :: Integer -> [Integer])
-  enumFromThen x y
-    | x <= y    = coerce (enumFromThen :: Integer -> Integer -> [Integer]) x y
-    | otherwise = enumFromThenTo x y 0
-
-  enumFromTo   = coerce (enumFromTo   :: Integer -> Integer -> [Integer])
-  enumFromThenTo
-    = coerce (enumFromThenTo :: Integer -> Integer -> Integer -> [Integer])
-
--- | @since 4.8.0.0
-instance Integral Natural where
-  quot (Natural a) (Natural b) = Natural (quot a b)
-  {-# INLINE quot #-}
-  rem (Natural a) (Natural b) = Natural (rem a b)
-  {-# INLINE rem #-}
-  div (Natural a) (Natural b) = Natural (div a b)
-  {-# INLINE div #-}
-  mod (Natural a) (Natural b) = Natural (mod a b)
-  {-# INLINE mod #-}
-  divMod (Natural a) (Natural b) = (Natural q, Natural r)
-    where (q,r) = divMod a b
-  {-# INLINE divMod #-}
-  quotRem (Natural a) (Natural b) = (Natural q, Natural r)
-    where (q,r) = quotRem a b
-  {-# INLINE quotRem #-}
-  toInteger (Natural a) = a
-  {-# INLINE toInteger #-}
+minusNaturalMaybe (Natural x) (Natural y)
+  | x >= y  = Just (Natural (x `minusInteger` y))
+  | True    = Nothing
+
+shiftLNatural :: Natural -> Int -> Natural
+shiftLNatural (Natural n) (I# i) = Natural (n `shiftLInteger` i)
+{-# CONSTANT_FOLDED shiftLNatural #-}
+
+shiftRNatural :: Natural -> Int -> Natural
+shiftRNatural (Natural n) (I# i) = Natural (n `shiftRInteger` i)
+{-# CONSTANT_FOLDED shiftRNatural #-}
+
+plusNatural :: Natural -> Natural -> Natural
+plusNatural (Natural x) (Natural y) = Natural (x `plusInteger` y)
+{-# CONSTANT_FOLDED plusNatural #-}
+
+minusNatural :: Natural -> Natural -> Natural
+minusNatural (Natural x) (Natural y) = Natural (x `minusInteger` y)
+{-# CONSTANT_FOLDED minusNatural #-}
+
+timesNatural :: Natural -> Natural -> Natural
+timesNatural (Natural x) (Natural y) = Natural (x `timesInteger` y)
+{-# CONSTANT_FOLDED timesNatural #-}
+
+orNatural :: Natural -> Natural -> Natural
+orNatural (Natural x) (Natural y) = Natural (x `orInteger` y)
+{-# CONSTANT_FOLDED orNatural #-}
+
+xorNatural :: Natural -> Natural -> Natural
+xorNatural (Natural x) (Natural y) = Natural (x `xorInteger` y)
+{-# CONSTANT_FOLDED xorNatural #-}
+
+andNatural :: Natural -> Natural -> Natural
+andNatural (Natural x) (Natural y) = Natural (x `andInteger` y)
+{-# CONSTANT_FOLDED andNatural #-}
+
+naturalToInt :: Natural -> Int
+naturalToInt (Natural i) = I# (integerToInt i)
+
+naturalToWord :: Natural -> Word
+naturalToWord (Natural i) = W# (integerToWord i)
+
+naturalToInteger :: Natural -> Integer
+naturalToInteger (Natural i) = i
+{-# CONSTANT_FOLDED naturalToInteger #-}
+
+testBitNatural :: Natural -> Int -> Bool
+testBitNatural (Natural n) (I# i) = testBitInteger n i
+{-# CONSTANT_FOLDED testBitNatural #-}
+
+bitNatural :: Int# -> Natural
+bitNatural i#
+  | isTrue# (i# <# WORD_SIZE_IN_BITS#) = wordToNaturalBase (1## `uncheckedShiftL#` i#)
+  | True                               = Natural (1 `shiftLInteger` i#)
+{-# CONSTANT_FOLDED bitNatural #-}
+
+quotNatural :: Natural -> Natural -> Natural
+quotNatural n@(Natural x) (Natural y)
+   | y == wordToInteger 0## = divZeroError
+   | y == wordToInteger 1## = n
+   | True                   = Natural (x `quotInteger` y)
+{-# CONSTANT_FOLDED quotNatural #-}
+
+remNatural :: Natural -> Natural -> Natural
+remNatural (Natural x) (Natural y)
+   | y == wordToInteger 0## = divZeroError
+   | y == wordToInteger 1## = wordToNaturalBase 0##
+   | True                   = Natural (x `remInteger` y)
+{-# CONSTANT_FOLDED remNatural #-}
+
+quotRemNatural :: Natural -> Natural -> (Natural, Natural)
+quotRemNatural n@(Natural x) (Natural y)
+   | y == wordToInteger 0## = divZeroError
+   | y == wordToInteger 1## = (n,wordToNaturalBase 0##)
+   | True                   = case quotRemInteger x y of
+      (# k, r #) -> (Natural k, Natural r)
+{-# CONSTANT_FOLDED quotRemNatural #-}
+
+signumNatural :: Natural -> Natural
+signumNatural (Natural x)
+   | x == wordToInteger 0## = wordToNaturalBase 0##
+   | True                   = wordToNaturalBase 1##
+{-# CONSTANT_FOLDED signumNatural #-}
+
+negateNatural :: Natural -> Natural
+negateNatural (Natural x)
+   | x == wordToInteger 0## = wordToNaturalBase 0##
+   | True                   = underflowError
+{-# CONSTANT_FOLDED negateNatural #-}
+
 #endif
 
 -- | Construct 'Natural' from 'Word' value.
 --
 -- @since 4.8.0.0
 wordToNatural :: Word -> Natural
-#if defined(MIN_VERSION_integer_gmp)
-wordToNatural (W# w#) = NatS# w#
-#else
-wordToNatural w = Natural (fromIntegral w)
-#endif
+wordToNatural (W# w#) = wordToNatural# w#
 
 -- | Try downcasting 'Natural' to 'Word' value.
 -- Returns 'Nothing' if value doesn't fit in 'Word'.
@@ -638,10 +544,10 @@ naturalToWordMaybe (NatS# w#) = Just (W# w#)
 naturalToWordMaybe (NatJ# _)  = Nothing
 #else
 naturalToWordMaybe (Natural i)
-  | i <= maxw  = Just (fromIntegral i)
-  | otherwise  = Nothing
+  | i < maxw  = Just (W# (integerToWord i))
+  | True      = Nothing
   where
-    maxw = toInteger (maxBound :: Word)
+    maxw = 1 `shiftLInteger` WORD_SIZE_IN_BITS#
 #endif
 
 -- | \"@'powModNatural' /b/ /e/ /m/@\" computes base @/b/@ raised to
@@ -662,18 +568,38 @@ powModNatural b           e           (NatJ# m)
   = bigNatToNatural (powModBigNat (naturalToBigNat b) (naturalToBigNat e) m)
 #else
 -- Portable reference fallback implementation
-powModNatural _ _ 0 = divZeroError
-powModNatural _ _ 1 = 0
-powModNatural _ 0 _ = 1
-powModNatural 0 _ _ = 0
-powModNatural 1 _ _ = 1
-powModNatural b0 e0 m = go b0 e0 1
+powModNatural (Natural b0) (Natural e0) (Natural m)
+   | m  == wordToInteger 0## = divZeroError
+   | m  == wordToInteger 1## = wordToNaturalBase 0##
+   | e0 == wordToInteger 0## = wordToNaturalBase 1##
+   | b0 == wordToInteger 0## = wordToNaturalBase 0##
+   | b0 == wordToInteger 1## = wordToNaturalBase 1##
+   | True    = go b0 e0 (wordToInteger 1##)
   where
     go !b e !r
-      | odd e     = go b' e' (r*b `mod` m)
-      | e == 0    = r
-      | otherwise = go b' e' r
+      | e `testBitInteger` 0#  = go b' e' ((r `timesInteger` b) `modInteger` m)
+      | e == wordToInteger 0## = naturalFromInteger r
+      | True                   = go b' e' r
       where
-        b' = b*b `mod` m
-        e' = e   `unsafeShiftR` 1 -- slightly faster than "e `div` 2"
+        b' = (b `timesInteger` b) `modInteger` m
+        e' = e `shiftRInteger` 1# -- slightly faster than "e `div` 2"
 #endif
+
+
+-- | Construct 'Natural' value from list of 'Word's.
+--
+-- This function is used by GHC for constructing 'Natural' literals.
+mkNatural :: [Word]  -- ^ value expressed in 32 bit chunks, least
+                     --   significant first
+          -> Natural
+mkNatural [] = wordToNaturalBase 0##
+mkNatural (W# i : is') = wordToNaturalBase (i `and#` 0xffffffff##) `orNatural`
+                         shiftLNatural (mkNatural is') 31
+{-# CONSTANT_FOLDED mkNatural #-}
+
+-- | Convert 'Int' to 'Natural'.
+-- Throws 'Underflow' when passed a negative 'Int'.
+intToNatural :: Int -> Natural
+intToNatural (I# i#)
+  | isTrue# (i# <# 0#) = underflowError
+  | True               = wordToNaturalBase (int2Word# i#)
diff --git a/libraries/base/GHC/Num.hs b/libraries/base/GHC/Num.hs
index fd98c19f20..795e74a4af 100644
--- a/libraries/base/GHC/Num.hs
+++ b/libraries/base/GHC/Num.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-}
 {-# OPTIONS_HADDOCK hide #-}
 
 -----------------------------------------------------------------------------
@@ -16,10 +16,17 @@
 --
 -----------------------------------------------------------------------------
 
-module GHC.Num (module GHC.Num, module GHC.Integer) where
+
+module GHC.Num (module GHC.Num, module GHC.Integer, module GHC.Natural) where
+
+#include "MachDeps.h"
 
 import GHC.Base
 import GHC.Integer
+import GHC.Natural
+#if !defined(MIN_VERSION_integer_gmp)
+import {-# SOURCE #-} GHC.Exception.Type (underflowException)
+#endif
 
 infixl 7  *
 infixl 6  +, -
@@ -100,3 +107,35 @@ instance  Num Integer  where
 
     abs = absInteger
     signum = signumInteger
+
+#if defined(MIN_VERSION_integer_gmp)
+-- | @since 4.8.0.0
+instance  Num Natural  where
+    (+) = plusNatural
+    (-) = minusNatural
+    (*) = timesNatural
+    negate      = negateNatural
+    fromInteger = naturalFromInteger
+
+    abs = id
+    signum = signumNatural
+
+#else
+-- | @since 4.8.0.0
+instance Num Natural where
+  Natural n + Natural m = Natural (n + m)
+  {-# INLINE (+) #-}
+  Natural n * Natural m = Natural (n * m)
+  {-# INLINE (*) #-}
+  Natural n - Natural m
+      | m > n     = raise# underflowException
+      | otherwise = Natural (n - m)
+  {-# INLINE (-) #-}
+  abs (Natural n) = Natural n
+  {-# INLINE abs #-}
+  signum (Natural n) = Natural (signum n)
+  {-# INLINE signum #-}
+  fromInteger = naturalFromInteger
+  {-# INLINE fromInteger #-}
+
+#endif
diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs
index f7870a2df1..ef9d8df2e5 100644
--- a/libraries/base/GHC/Read.hs
+++ b/libraries/base/GHC/Read.hs
@@ -72,6 +72,7 @@ import GHC.Show
 import GHC.Base
 import GHC.Arr
 import GHC.Word
+import GHC.List (filter)
 
 
 -- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with
@@ -616,6 +617,19 @@ instance Read Integer where
   readListPrec = readListPrecDefault
   readList     = readListDefault
 
+
+#if defined(MIN_VERSION_integer_gmp)
+-- | @since 4.8.0.0
+instance Read Natural where
+  readsPrec d = map (\(n, s) -> (fromInteger n, s))
+                  . filter ((>= 0) . (\(x,_)->x)) . readsPrec d
+#else
+-- | @since 4.8.0.0
+instance Read Natural where
+    readsPrec d = map (\(n, s) -> (Natural n, s))
+                  . filter ((>= 0) . (\(x,_)->x)) . readsPrec d
+#endif
+
 -- | @since 2.01
 instance Read Float where
   readPrec     = readNumber convertFrac
diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs
index 7f2ecd0dc5..f88666af40 100644
--- a/libraries/base/GHC/Real.hs
+++ b/libraries/base/GHC/Real.hs
@@ -20,12 +20,16 @@
 
 module GHC.Real where
 
+#include "MachDeps.h"
+
 import GHC.Base
 import GHC.Num
 import GHC.List
 import GHC.Enum
 import GHC.Show
-import {-# SOURCE #-} GHC.Exception( divZeroException, overflowException, ratioZeroDenomException )
+import {-# SOURCE #-} GHC.Exception( divZeroException, overflowException
+                                   , underflowException
+                                   , ratioZeroDenomException )
 
 #if defined(OPTIMISE_INTEGER_GCD_LCM)
 # if defined(MIN_VERSION_integer_gmp)
@@ -61,6 +65,11 @@ ratioZeroDenominatorError = raise# ratioZeroDenomException
 overflowError :: a
 overflowError = raise# overflowException
 
+{-# NOINLINE underflowError #-}
+underflowError :: a
+underflowError = raise# underflowException
+
+
 --------------------------------------------------------------
 -- The Ratio and Rational types
 --------------------------------------------------------------
@@ -376,6 +385,18 @@ instance Integral Word where
 instance  Real Integer  where
     toRational x        =  x :% 1
 
+#if defined(MIN_VERSION_integer_gmp)
+-- | @since 4.8.0.0
+instance Real Natural where
+    toRational (NatS# w)  = toRational (W# w)
+    toRational (NatJ# bn) = toRational (Jp# bn)
+#else
+-- | @since 4.8.0.0
+instance Real Natural where
+  toRational (Natural a) = toRational a
+  {-# INLINE toRational #-}
+#endif
+
 -- Note [Integer division constant folding]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
@@ -418,6 +439,39 @@ instance  Integral Integer where
     n `quotRem` d = case n `quotRemInteger` d of
                       (# q, r #) -> (q, r)
 
+#if defined(MIN_VERSION_integer_gmp)
+-- | @since 4.8.0.0
+instance Integral Natural where
+    toInteger = naturalToInteger
+
+    divMod = quotRemNatural
+    div    = quotNatural
+    mod    = remNatural
+
+    quotRem = quotRemNatural
+    quot    = quotNatural
+    rem     = remNatural
+#else
+-- | @since 4.8.0.0
+instance Integral Natural where
+  quot (Natural a) (Natural b) = Natural (quot a b)
+  {-# INLINE quot #-}
+  rem (Natural a) (Natural b) = Natural (rem a b)
+  {-# INLINE rem #-}
+  div (Natural a) (Natural b) = Natural (div a b)
+  {-# INLINE div #-}
+  mod (Natural a) (Natural b) = Natural (mod a b)
+  {-# INLINE mod #-}
+  divMod (Natural a) (Natural b) = (Natural q, Natural r)
+    where (q,r) = divMod a b
+  {-# INLINE divMod #-}
+  quotRem (Natural a) (Natural b) = (Natural q, Natural r)
+    where (q,r) = quotRem a b
+  {-# INLINE quotRem #-}
+  toInteger (Natural a) = a
+  {-# INLINE toInteger #-}
+#endif
+
 --------------------------------------------------------------
 -- Instances for @Ratio@
 --------------------------------------------------------------
@@ -506,6 +560,17 @@ fromIntegral = fromInteger . toInteger
 "fromIntegral/Word->Word" fromIntegral = id :: Word -> Word
     #-}
 
+{-# RULES
+"fromIntegral/Natural->Natural"  fromIntegral = id :: Natural -> Natural
+"fromIntegral/Natural->Integer"  fromIntegral = toInteger :: Natural->Integer
+"fromIntegral/Natural->Word"     fromIntegral = naturalToWord
+  #-}
+
+{-# RULES
+"fromIntegral/Word->Natural"     fromIntegral = wordToNatural
+"fromIntegral/Int->Natural"     fromIntegral = intToNatural
+  #-}
+
 -- | general coercion to fractional types
 realToFrac :: (Real a, Fractional b) => a -> b
 {-# NOINLINE [1] realToFrac #-}
@@ -698,6 +763,8 @@ lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 "gcd/Int->Int->Int"             gcd = gcdInt'
 "gcd/Integer->Integer->Integer" gcd = gcdInteger
 "lcm/Integer->Integer->Integer" lcm = lcmInteger
+"gcd/Natural->Natural->Natural" gcd = gcdNatural
+"lcm/Natural->Natural->Natural" lcm = lcmNatural
  #-}
 
 gcdInt' :: Int -> Int -> Int
diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs
index 798dff9891..a41bf81cb3 100644
--- a/libraries/base/GHC/Show.hs
+++ b/libraries/base/GHC/Show.hs
@@ -479,6 +479,13 @@ instance Show Integer where
         | otherwise = integerToString n r
     showList = showList__ (showsPrec 0)
 
+-- | @since 4.8.0.0
+instance Show Natural where
+#if defined(MIN_VERSION_integer_gmp)
+    showsPrec p (NatS# w#) = showsPrec p (W# w#)
+#endif
+    showsPrec p i          = showsPrec p (naturalToInteger i)
+
 -- Divide and conquer implementation of string conversion
 integerToString :: Integer -> String -> String
 integerToString n0 cs0
diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs
index d40342c9de..4c8a106ae5 100644
--- a/libraries/base/GHC/Stack/Types.hs
+++ b/libraries/base/GHC/Stack/Types.hs
@@ -53,6 +53,7 @@ import GHC.Types (Char, Int)
 -- Make implicit dependency known to build system
 import GHC.Tuple ()
 import GHC.Integer ()
+import GHC.Natural ()
 
 ----------------------------------------------------------------------
 -- Explicit call-stacks built via ImplicitParams
diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs
index 1df9d14693..18cc4dbcc4 100644
--- a/libraries/base/GHC/Word.hs
+++ b/libraries/base/GHC/Word.hs
@@ -972,3 +972,33 @@ byteSwap64 (W64# w#) = W64# (byteSwap64# w#)
 byteSwap64 :: Word64 -> Word64
 byteSwap64 (W64# w#) = W64# (byteSwap# w#)
 #endif
+
+-------------------------------------------------------------------------------
+
+{-# RULES
+"fromIntegral/Natural->Word8"
+    fromIntegral = (fromIntegral :: Word -> Word8)  . naturalToWord
+"fromIntegral/Natural->Word16"
+    fromIntegral = (fromIntegral :: Word -> Word16) . naturalToWord
+"fromIntegral/Natural->Word32"
+    fromIntegral = (fromIntegral :: Word -> Word32) . naturalToWord
+  #-}
+
+{-# RULES
+"fromIntegral/Word8->Natural"
+    fromIntegral = wordToNatural . (fromIntegral :: Word8  -> Word)
+"fromIntegral/Word16->Natural"
+    fromIntegral = wordToNatural . (fromIntegral :: Word16 -> Word)
+"fromIntegral/Word32->Natural"
+    fromIntegral = wordToNatural . (fromIntegral :: Word32 -> Word)
+  #-}
+
+#if WORD_SIZE_IN_BITS == 64
+-- these RULES are valid for Word==Word64
+{-# RULES
+"fromIntegral/Natural->Word64"
+    fromIntegral = (fromIntegral :: Word -> Word64) . naturalToWord
+"fromIntegral/Word64->Natural"
+    fromIntegral = wordToNatural . (fromIntegral :: Word64 -> Word)
+  #-}
+#endif
diff --git a/libraries/base/Unsafe/Coerce.hs b/libraries/base/Unsafe/Coerce.hs
index df1c109e0e..d9a7977e43 100644
--- a/libraries/base/Unsafe/Coerce.hs
+++ b/libraries/base/Unsafe/Coerce.hs
@@ -32,6 +32,7 @@
 module Unsafe.Coerce (unsafeCoerce) where
 
 import GHC.Integer () -- for build ordering
+import GHC.Natural () -- for build ordering
 import GHC.Prim (unsafeCoerce#)
 
 local_id :: a -> a
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index 1d439be322..dbeec3388d 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -219,6 +219,7 @@ Library
         GHC.Environment
         GHC.Err
         GHC.Exception
+        GHC.Exception.Type
         GHC.ExecutionStack
         GHC.ExecutionStack.Internal
         GHC.Exts
@@ -258,6 +259,7 @@ Library
         GHC.IORef
         GHC.Int
         GHC.List
+        GHC.Maybe
         GHC.MVar
         GHC.Natural
         GHC.Num