Implement #15993

6 files changed, 800 insertions, 648 deletions

diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs
index 89702105eb..f1345e5e93 100644
--- a/libraries/base/Data/Bits.hs
+++ b/libraries/base/Data/Bits.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -48,670 +50,100 @@ module Data.Bits (
   bitDefault,
   testBitDefault,
   popCountDefault,
-  toIntegralSized
- ) where
-
--- Defines the @Bits@ class containing bit-based operations.
--- See library document for details on the semantics of the
--- individual operations.
+  toIntegralSized,
+  oneBits,
 
-#include "MachDeps.h"
+  And(..), Ior(..), Xor(..), Iff(..)
+ ) where
 
-import Data.Maybe
-import GHC.Num
 import GHC.Base
-import GHC.Real
-
-infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
-infixl 7 .&.
-infixl 6 `xor`
-infixl 5 .|.
+import GHC.Bits
+import GHC.Enum
+import GHC.Read
+import GHC.Show
 
-{-# DEPRECATED bitSize "Use 'bitSizeMaybe' or 'finiteBitSize' instead" #-} -- deprecated in 7.8
-
--- | The 'Bits' class defines bitwise operations over integral types.
+-- | A more concise version of 'complement zeroBits'.
 --
--- * Bits are numbered from 0 with bit 0 being the least
---   significant bit.
-class Eq a => Bits a where
-    {-# MINIMAL (.&.), (.|.), xor, complement,
-                (shift | (shiftL, shiftR)),
-                (rotate | (rotateL, rotateR)),
-                bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-}
-
-    -- | Bitwise \"and\"
-    (.&.) :: a -> a -> a
-
-    -- | Bitwise \"or\"
-    (.|.) :: a -> a -> a
-
-    -- | Bitwise \"xor\"
-    xor :: a -> a -> a
-
-    {-| Reverse all the bits in the argument -}
-    complement        :: a -> a
-
-    {-| @'shift' x i@ shifts @x@ left by @i@ bits if @i@ is positive,
-        or right by @-i@ bits otherwise.
-        Right shifts perform sign extension on signed number types;
-        i.e. they fill the top bits with 1 if the @x@ is negative
-        and with 0 otherwise.
-
-        An instance can define either this unified 'shift' or 'shiftL' and
-        'shiftR', depending on which is more convenient for the type in
-        question. -}
-    shift             :: a -> Int -> a
-
-    x `shift`   i | i<0       = x `shiftR` (-i)
-                  | i>0       = x `shiftL` i
-                  | otherwise = x
-
-    {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
-        or right by @-i@ bits otherwise.
-
-        For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
-
-        An instance can define either this unified 'rotate' or 'rotateL' and
-        'rotateR', depending on which is more convenient for the type in
-        question. -}
-    rotate            :: a -> Int -> a
-
-    x `rotate`  i | i<0       = x `rotateR` (-i)
-                  | i>0       = x `rotateL` i
-                  | otherwise = x
-
-    {-
-    -- Rotation can be implemented in terms of two shifts, but care is
-    -- needed for negative values.  This suggested implementation assumes
-    -- 2's-complement arithmetic.  It is commented out because it would
-    -- require an extra context (Ord a) on the signature of 'rotate'.
-    x `rotate`  i | i<0 && isSigned x && x<0
-                         = let left = i+bitSize x in
-                           ((x `shift` i) .&. complement ((-1) `shift` left))
-                           .|. (x `shift` left)
-                  | i<0  = (x `shift` i) .|. (x `shift` (i+bitSize x))
-                  | i==0 = x
-                  | i>0  = (x `shift` i) .|. (x `shift` (i-bitSize x))
-    -}
-
-    -- | 'zeroBits' is the value with all bits unset.
-    --
-    -- The following laws ought to hold (for all valid bit indices @/n/@):
-    --
-    --   * @'clearBit' 'zeroBits' /n/ == 'zeroBits'@
-    --   * @'setBit'   'zeroBits' /n/ == 'bit' /n/@
-    --   * @'testBit'  'zeroBits' /n/ == False@
-    --   * @'popCount' 'zeroBits'   == 0@
-    --
-    -- This method uses @'clearBit' ('bit' 0) 0@ as its default
-    -- implementation (which ought to be equivalent to 'zeroBits' for
-    -- types which possess a 0th bit).
-    --
-    -- @since 4.7.0.0
-    zeroBits :: a
-    zeroBits = clearBit (bit 0) 0
-
-    -- | @bit /i/@ is a value with the @/i/@th bit set and all other bits clear.
-    --
-    -- Can be implemented using `bitDefault' if @a@ is also an
-    -- instance of 'Num'.
-    --
-    -- See also 'zeroBits'.
-    bit               :: Int -> a
-
-    -- | @x \`setBit\` i@ is the same as @x .|. bit i@
-    setBit            :: a -> Int -> a
-
-    -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
-    clearBit          :: a -> Int -> a
-
-    -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
-    complementBit     :: a -> Int -> a
-
-    {-| @x \`testBit\` i@ is the same as @x .&. bit n /= 0@
-
-        In other words it returns True if the bit at offset @n
-        is set.
-
-        Can be implemented using `testBitDefault' if @a@ is also an
-        instance of 'Num'.
-        -}
-    testBit           :: a -> Int -> Bool
-
-    {-| Return the number of bits in the type of the argument.  The actual
-        value of the argument is ignored.  Returns Nothing
-        for types that do not have a fixed bitsize, like 'Integer'.
-
-        @since 4.7.0.0
-        -}
-    bitSizeMaybe      :: a -> Maybe Int
-
-    {-| Return the number of bits in the type of the argument.  The actual
-        value of the argument is ignored.  The function 'bitSize' is
-        undefined for types that do not have a fixed bitsize, like 'Integer'.
-
-        Default implementation based upon 'bitSizeMaybe' provided since
-        4.12.0.0.
-        -}
-    bitSize           :: a -> Int
-    bitSize b = fromMaybe (error "bitSize is undefined") (bitSizeMaybe b)
-
-    {-| Return 'True' if the argument is a signed type.  The actual
-        value of the argument is ignored -}
-    isSigned          :: a -> Bool
-
-    {-# INLINE setBit #-}
-    {-# INLINE clearBit #-}
-    {-# INLINE complementBit #-}
-    x `setBit` i        = x .|. bit i
-    x `clearBit` i      = x .&. complement (bit i)
-    x `complementBit` i = x `xor` bit i
-
-    {-| Shift the argument left by the specified number of bits
-        (which must be non-negative). Some instances may throw an
-        'Control.Exception.Overflow' exception if given a negative input.
-
-        An instance can define either this and 'shiftR' or the unified
-        'shift', depending on which is more convenient for the type in
-        question. -}
-    shiftL            :: a -> Int -> a
-    {-# INLINE shiftL #-}
-    x `shiftL`  i = x `shift`  i
-
-    {-| Shift the argument left by the specified number of bits.  The
-        result is undefined for negative shift amounts and shift amounts
-        greater or equal to the 'bitSize'.
-
-        Defaults to 'shiftL' unless defined explicitly by an instance.
-
-        @since 4.5.0.0 -}
-    unsafeShiftL            :: a -> Int -> a
-    {-# INLINE unsafeShiftL #-}
-    x `unsafeShiftL` i = x `shiftL` i
-
-    {-| Shift the first argument right by the specified number of bits. The
-        result is undefined for negative shift amounts and shift amounts
-        greater or equal to the 'bitSize'. Some instances may throw an
-        'Control.Exception.Overflow' exception if given a negative input.
-
-        Right shifts perform sign extension on signed number types;
-        i.e. they fill the top bits with 1 if the @x@ is negative
-        and with 0 otherwise.
-
-        An instance can define either this and 'shiftL' or the unified
-        'shift', depending on which is more convenient for the type in
-        question. -}
-    shiftR            :: a -> Int -> a
-    {-# INLINE shiftR #-}
-    x `shiftR`  i = x `shift`  (-i)
-
-    {-| Shift the first argument right by the specified number of bits, which
-        must be non-negative and smaller than the number of bits in the type.
-
-        Right shifts perform sign extension on signed number types;
-        i.e. they fill the top bits with 1 if the @x@ is negative
-        and with 0 otherwise.
-
-        Defaults to 'shiftR' unless defined explicitly by an instance.
-
-        @since 4.5.0.0 -}
-    unsafeShiftR            :: a -> Int -> a
-    {-# INLINE unsafeShiftR #-}
-    x `unsafeShiftR` i = x `shiftR` i
-
-    {-| Rotate the argument left by the specified number of bits
-        (which must be non-negative).
-
-        An instance can define either this and 'rotateR' or the unified
-        'rotate', depending on which is more convenient for the type in
-        question. -}
-    rotateL           :: a -> Int -> a
-    {-# INLINE rotateL #-}
-    x `rotateL` i = x `rotate` i
-
-    {-| Rotate the argument right by the specified number of bits
-        (which must be non-negative).
-
-        An instance can define either this and 'rotateL' or the unified
-        'rotate', depending on which is more convenient for the type in
-        question. -}
-    rotateR           :: a -> Int -> a
-    {-# INLINE rotateR #-}
-    x `rotateR` i = x `rotate` (-i)
-
-    {-| Return the number of set bits in the argument.  This number is
-        known as the population count or the Hamming weight.
-
-        Can be implemented using `popCountDefault' if @a@ is also an
-        instance of 'Num'.
-
-        @since 4.5.0.0 -}
-    popCount          :: a -> Int
-
--- |The 'FiniteBits' class denotes types with a finite, fixed number of bits.
---
--- @since 4.7.0.0
-class Bits b => FiniteBits b where
-    -- | Return the number of bits in the type of the argument.
-    -- The actual value of the argument is ignored. Moreover, 'finiteBitSize'
-    -- is total, in contrast to the deprecated 'bitSize' function it replaces.
-    --
-    -- @
-    -- 'finiteBitSize' = 'bitSize'
-    -- 'bitSizeMaybe' = 'Just' . 'finiteBitSize'
-    -- @
-    --
-    -- @since 4.7.0.0
-    finiteBitSize :: b -> Int
-
-    -- | Count number of zero bits preceding the most significant set bit.
-    --
-    -- @
-    -- 'countLeadingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a)
-    -- @
-    --
-    -- 'countLeadingZeros' can be used to compute log base 2 via
-    --
-    -- @
-    -- logBase2 x = 'finiteBitSize' x - 1 - 'countLeadingZeros' x
-    -- @
-    --
-    -- Note: The default implementation for this method is intentionally
-    -- naive. However, the instances provided for the primitive
-    -- integral types are implemented using CPU specific machine
-    -- instructions.
-    --
-    -- @since 4.8.0.0
-    countLeadingZeros :: b -> Int
-    countLeadingZeros x = (w-1) - go (w-1)
-      where
-        go i | i < 0       = i -- no bit set
-             | testBit x i = i
-             | otherwise   = go (i-1)
-
-        w = finiteBitSize x
-
-    -- | Count number of zero bits following the least significant set bit.
-    --
-    -- @
-    -- 'countTrailingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a)
-    -- 'countTrailingZeros' . 'negate' = 'countTrailingZeros'
-    -- @
-    --
-    -- The related
-    -- <http://en.wikipedia.org/wiki/Find_first_set find-first-set operation>
-    -- can be expressed in terms of 'countTrailingZeros' as follows
-    --
-    -- @
-    -- findFirstSet x = 1 + 'countTrailingZeros' x
-    -- @
-    --
-    -- Note: The default implementation for this method is intentionally
-    -- naive. However, the instances provided for the primitive
-    -- integral types are implemented using CPU specific machine
-    -- instructions.
-    --
-    -- @since 4.8.0.0
-    countTrailingZeros :: b -> Int
-    countTrailingZeros x = go 0
-      where
-        go i | i >= w      = i
-             | testBit x i = i
-             | otherwise   = go (i+1)
-
-        w = finiteBitSize x
-
-
--- The defaults below are written with lambdas so that e.g.
---     bit = bitDefault
--- is fully applied, so inlining will happen
-
--- | Default implementation for 'bit'.
+-- >>> complement zeroBits :: Word == oneBits :: Word
+-- True
 --
--- Note that: @bitDefault i = 1 `shiftL` i@
+-- >>> complement oneBits :: Word == zeroBits :: Word
+-- True
 --
--- @since 4.6.0.0
-bitDefault :: (Bits a, Num a) => Int -> a
-bitDefault = \i -> 1 `shiftL` i
-{-# INLINE bitDefault #-}
+-- @since 4.16
+oneBits :: (Bits a) => a
+oneBits = complement zeroBits
+{-# INLINE oneBits #-}
 
--- | Default implementation for 'testBit'.
+-- | Monoid under bitwise AND.
 --
--- Note that: @testBitDefault x i = (x .&. bit i) /= 0@
+-- >>> getAnd (And 0xab <> And 0x12) :: Word8
+-- 2
 --
--- @since 4.6.0.0
-testBitDefault ::  (Bits a, Num a) => a -> Int -> Bool
-testBitDefault = \x i -> (x .&. bit i) /= 0
-{-# INLINE testBitDefault #-}
+-- @since 4.16
+newtype And a = And { getAnd :: a }
+  deriving newtype (Bounded, Enum, Bits, FiniteBits, Eq)
+  deriving stock (Show, Read)
 
--- | Default implementation for 'popCount'.
---
--- This implementation is intentionally naive. Instances are expected to provide
--- an optimized implementation for their size.
---
--- @since 4.6.0.0
-popCountDefault :: (Bits a, Num a) => a -> Int
-popCountDefault = go 0
- where
-   go !c 0 = c
-   go c w = go (c+1) (w .&. (w - 1)) -- clear the least significant
-{-# INLINABLE popCountDefault #-}
+-- | @since 4.16
+instance (Bits a) => Semigroup (And a) where
+  And x <> And y = And (x .&. y)
 
+-- | @since 4.16
+instance (Bits a) => Monoid (And a) where
+  mempty = And oneBits
 
--- | Interpret 'Bool' as 1-bit bit-field
+-- | Monoid under bitwise inclusive OR.
 --
---  @since 4.7.0.0
-instance Bits Bool where
-    (.&.) = (&&)
-
-    (.|.) = (||)
-
-    xor = (/=)
-
-    complement = not
-
-    shift x 0 = x
-    shift _ _ = False
-
-    rotate x _ = x
-
-    bit 0 = True
-    bit _ = False
-
-    testBit x 0 = x
-    testBit _ _ = False
-
-    bitSizeMaybe _ = Just 1
-
-    bitSize _ = 1
-
-    isSigned _ = False
-
-    popCount False = 0
-    popCount True  = 1
-
--- | @since 4.7.0.0
-instance FiniteBits Bool where
-    finiteBitSize _ = 1
-    countTrailingZeros x = if x then 0 else 1
-    countLeadingZeros  x = if x then 0 else 1
-
--- | @since 2.01
-instance Bits Int where
-    {-# INLINE shift #-}
-    {-# INLINE bit #-}
-    {-# INLINE testBit #-}
-    -- We want popCnt# to be inlined in user code so that `ghc -msse4.2`
-    -- can compile it down to a popcnt instruction without an extra function call
-    {-# INLINE popCount #-}
-
-    zeroBits = 0
-
-    bit     = bitDefault
-
-    testBit = testBitDefault
-
-    (I# x#) .&.   (I# y#)          = I# (x# `andI#` y#)
-    (I# x#) .|.   (I# y#)          = I# (x# `orI#`  y#)
-    (I# x#) `xor` (I# y#)          = I# (x# `xorI#` y#)
-    complement (I# x#)             = I# (notI# x#)
-    (I# x#) `shift` (I# i#)
-        | isTrue# (i# >=# 0#)      = I# (x# `iShiftL#` i#)
-        | otherwise                = I# (x# `iShiftRA#` negateInt# i#)
-    (I# x#) `shiftL` (I# i#)
-        | isTrue# (i# >=# 0#)      = I# (x# `iShiftL#` i#)
-        | otherwise                = overflowError
-    (I# x#) `unsafeShiftL` (I# i#) = I# (x# `uncheckedIShiftL#` i#)
-    (I# x#) `shiftR` (I# i#)
-        | isTrue# (i# >=# 0#)      = I# (x# `iShiftRA#` i#)
-        | otherwise                = overflowError
-    (I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#)
-
-    {-# INLINE rotate #-}       -- See Note [Constant folding for rotate]
-    (I# x#) `rotate` (I# i#) =
-        I# ((x# `uncheckedIShiftL#` i'#) `orI#` (x# `uncheckedIShiftRL#` (wsib -# i'#)))
-      where
-        !i'# = i# `andI#` (wsib -# 1#)
-        !wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
-    bitSizeMaybe i         = Just (finiteBitSize i)
-    bitSize i              = finiteBitSize i
-
-    popCount (I# x#) = I# (word2Int# (popCnt# (int2Word# x#)))
-
-    isSigned _             = True
-
--- | @since 4.6.0.0
-instance FiniteBits Int where
-    finiteBitSize _ = WORD_SIZE_IN_BITS
-    countLeadingZeros  (I# x#) = I# (word2Int# (clz# (int2Word# x#)))
-    {-# INLINE countLeadingZeros #-}
-    countTrailingZeros (I# x#) = I# (word2Int# (ctz# (int2Word# x#)))
-    {-# INLINE countTrailingZeros #-}
-
--- | @since 2.01
-instance Bits Word where
-    {-# INLINE shift #-}
-    {-# INLINE bit #-}
-    {-# INLINE testBit #-}
-    {-# INLINE popCount #-}
-
-    (W# x#) .&.   (W# y#)    = W# (x# `and#` y#)
-    (W# x#) .|.   (W# y#)    = W# (x# `or#`  y#)
-    (W# x#) `xor` (W# y#)    = W# (x# `xor#` y#)
-    complement (W# x#)       = W# (not# x#)
-    (W# x#) `shift` (I# i#)
-        | isTrue# (i# >=# 0#)      = W# (x# `shiftL#` i#)
-        | otherwise                = W# (x# `shiftRL#` negateInt# i#)
-    (W# x#) `shiftL` (I# i#)
-        | isTrue# (i# >=# 0#)      = W# (x# `shiftL#` i#)
-        | otherwise                = overflowError
-    (W# x#) `unsafeShiftL` (I# i#) = W# (x# `uncheckedShiftL#` i#)
-    (W# x#) `shiftR` (I# i#)
-        | isTrue# (i# >=# 0#)      = W# (x# `shiftRL#` i#)
-        | otherwise                = overflowError
-    (W# x#) `unsafeShiftR` (I# i#) = W# (x# `uncheckedShiftRL#` i#)
-    (W# x#) `rotate` (I# i#)
-        | isTrue# (i'# ==# 0#) = W# x#
-        | otherwise  = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#)))
-        where
-        !i'# = i# `andI#` (wsib -# 1#)
-        !wsib = WORD_SIZE_IN_BITS#  {- work around preprocessor problem (??) -}
-    bitSizeMaybe i           = Just (finiteBitSize i)
-    bitSize i                = finiteBitSize i
-    isSigned _               = False
-    popCount (W# x#)         = I# (word2Int# (popCnt# x#))
-    bit                      = bitDefault
-    testBit                  = testBitDefault
-
--- | @since 4.6.0.0
-instance FiniteBits Word where
-    finiteBitSize _ = WORD_SIZE_IN_BITS
-    countLeadingZeros  (W# x#) = I# (word2Int# (clz# x#))
-    {-# INLINE countLeadingZeros #-}
-    countTrailingZeros (W# x#) = I# (word2Int# (ctz# x#))
-    {-# INLINE countTrailingZeros #-}
-
--- | @since 2.01
-instance Bits Integer where
-   (.&.)      = integerAnd
-   (.|.)      = integerOr
-   xor        = integerXor
-   complement = integerComplement
-   unsafeShiftR x i = integerShiftR x (fromIntegral i)
-   unsafeShiftL x i = integerShiftL x (fromIntegral i)
-   shiftR x i@(I# i#)
-      | isTrue# (i# >=# 0#) = unsafeShiftR x i
-      | otherwise           = overflowError
-   shiftL x i@(I# i#)
-      | isTrue# (i# >=# 0#) = unsafeShiftL x i
-      | otherwise           = overflowError
-   shift x i | i >= 0    = integerShiftL x (fromIntegral i)
-             | otherwise = integerShiftR x (fromIntegral (negate i))
-   testBit x i = integerTestBit x (fromIntegral i)
-   zeroBits    = integerZero
-
-   bit (I# i)  = integerBit# (int2Word# i)
-   popCount x  = I# (integerPopCount# x)
-
-   rotate x i = shift x i   -- since an Integer never wraps around
-
-   bitSizeMaybe _ = Nothing
-   bitSize _  = errorWithoutStackTrace "Data.Bits.bitSize(Integer)"
-   isSigned _ = True
-
--- | @since 4.8.0
-instance Bits Natural where
-   (.&.)         = naturalAnd
-   (.|.)         = naturalOr
-   xor           = naturalXor
-   complement _  = errorWithoutStackTrace
-                    "Bits.complement: Natural complement undefined"
-   unsafeShiftR x i = naturalShiftR x (fromIntegral i)
-   unsafeShiftL x i = naturalShiftL x (fromIntegral i)
-   shiftR x i@(I# i#)
-      | isTrue# (i# >=# 0#) = unsafeShiftR x i
-      | otherwise           = overflowError
-   shiftL x i@(I# i#)
-      | isTrue# (i# >=# 0#) = unsafeShiftL x i
-      | otherwise           = overflowError
-   shift x i
-     | i >= 0    = naturalShiftL x (fromIntegral i)
-     | otherwise = naturalShiftR x (fromIntegral (negate i))
-   testBit x i   = naturalTestBit x (fromIntegral i)
-   zeroBits      = naturalZero
-   clearBit x i  = x `xor` (bit i .&. x)
-
-   bit (I# i)  = naturalBit# (int2Word# i)
-   popCount x  = I# (word2Int# (naturalPopCount# x))
-
-   rotate x i = shift x i   -- since an Natural never wraps around
+-- >>> getIor (Ior 0xab <> Ior 0x12) :: Word8
+-- 187
+--
+-- @since 4.16
+newtype Ior a = Ior { getIor :: a }
+  deriving newtype (Bounded, Enum, Bits, FiniteBits, Eq)
+  deriving stock (Show, Read)
 
-   bitSizeMaybe _ = Nothing
-   bitSize _  = errorWithoutStackTrace "Data.Bits.bitSize(Natural)"
-   isSigned _ = False
+-- | @since 4.16
+instance (Bits a) => Semigroup (Ior a) where
+  Ior x <> Ior y = Ior (x .|. y)
 
------------------------------------------------------------------------------
+-- | @since 4.16
+instance (Bits a) => Monoid (Ior a) where
+  mempty = Ior zeroBits
 
--- | Attempt to convert an 'Integral' type @a@ to an 'Integral' type @b@ using
--- the size of the types as measured by 'Bits' methods.
+-- | Monoid under bitwise XOR.
 --
--- A simpler version of this function is:
+-- >>> getXor (Xor 0xab <> 0x12) :: Word8
+-- 185
 --
--- > toIntegral :: (Integral a, Integral b) => a -> Maybe b
--- > toIntegral x
--- >   | toInteger x == y = Just (fromInteger y)
--- >   | otherwise        = Nothing
--- >   where
--- >     y = toInteger x
---
--- This version requires going through 'Integer', which can be inefficient.
--- However, @toIntegralSized@ is optimized to allow GHC to statically determine
--- the relative type sizes (as measured by 'bitSizeMaybe' and 'isSigned') and
--- avoid going through 'Integer' for many types. (The implementation uses
--- 'fromIntegral', which is itself optimized with rules for @base@ types but may
--- go through 'Integer' for some type pairs.)
---
--- @since 4.8.0.0
-
-toIntegralSized :: (Integral a, Integral b, Bits a, Bits b) => a -> Maybe b
-toIntegralSized x                 -- See Note [toIntegralSized optimization]
-  | maybe True (<= x) yMinBound
-  , maybe True (x <=) yMaxBound = Just y
-  | otherwise                   = Nothing
-  where
-    y = fromIntegral x
+-- @since 4.16
+newtype Xor a = Xor { getXor :: a }
+  deriving newtype (Bounded, Enum, Bits, FiniteBits, Eq)
+  deriving stock (Show, Read)
 
-    xWidth = bitSizeMaybe x
-    yWidth = bitSizeMaybe y
+-- | @since 4.16
+instance (Bits a) => Semigroup (Xor a) where
+  Xor x <> Xor y = Xor (x `xor` y)
 
-    yMinBound
-      | isBitSubType x y = Nothing
-      | isSigned x, not (isSigned y) = Just 0
-      | isSigned x, isSigned y
-      , Just yW <- yWidth = Just (negate $ bit (yW-1)) -- Assumes sub-type
-      | otherwise = Nothing
+-- | @since 4.16
+instance (Bits a) => Monoid (Xor a) where
+  mempty = Xor zeroBits
 
-    yMaxBound
-      | isBitSubType x y = Nothing
-      | isSigned x, not (isSigned y)
-      , Just xW <- xWidth, Just yW <- yWidth
-      , xW <= yW+1 = Nothing -- Max bound beyond a's domain
-      | Just yW <- yWidth = if isSigned y
-                            then Just (bit (yW-1)-1)
-                            else Just (bit yW-1)
-      | otherwise = Nothing
-{-# INLINABLE toIntegralSized #-}
-
--- | 'True' if the size of @a@ is @<=@ the size of @b@, where size is measured
--- by 'bitSizeMaybe' and 'isSigned'.
-isBitSubType :: (Bits a, Bits b) => a -> b -> Bool
-isBitSubType x y
-  -- Reflexive
-  | xWidth == yWidth, xSigned == ySigned = True
-
-  -- Every integer is a subset of 'Integer'
-  | ySigned, Nothing == yWidth                  = True
-  | not xSigned, not ySigned, Nothing == yWidth = True
-
-  -- Sub-type relations between fixed-with types
-  | xSigned == ySigned,   Just xW <- xWidth, Just yW <- yWidth = xW <= yW
-  | not xSigned, ySigned, Just xW <- xWidth, Just yW <- yWidth = xW <  yW
-
-  | otherwise = False
-  where
-    xWidth  = bitSizeMaybe x
-    xSigned = isSigned     x
-
-    yWidth  = bitSizeMaybe y
-    ySigned = isSigned     y
-{-# INLINE isBitSubType #-}
-
-{-      Note [Constant folding for rotate]
-        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The INLINE on the Int instance of rotate enables it to be constant
-folded.  For example:
-     sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
-goes to:
-   Main.$wfold =
-     \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
-       case ww1_sOb of wild_XM {
-         __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
-         10000000 -> ww_sO7
-whereas before it was left as a call to $wrotate.
-
-All other Bits instances seem to inline well enough on their
-own to enable constant folding; for example 'shift':
-     sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
- goes to:
-     Main.$wfold =
-       \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
-         case ww1_sOf of wild_XM {
-           __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);
-           10000000 -> ww_sOb
-         }
--}
-
--- Note [toIntegralSized optimization]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- The code in 'toIntegralSized' relies on GHC optimizing away statically
--- decidable branches.
---
--- If both integral types are statically known, GHC will be able optimize the
--- code significantly (for @-O1@ and better).
---
--- For instance (as of GHC 7.8.1) the following definitions:
+-- | Monoid under bitwise \'equality\'; defined as @1@ if the corresponding
+-- bits match, and @0@ otherwise.
 --
--- > w16_to_i32 = toIntegralSized :: Word16 -> Maybe Int32
--- >
--- > i16_to_w16 = toIntegralSized :: Int16 -> Maybe Word16
+-- >>> getIff (Iff 0xab <> Iff 0x12) :: Word8
+-- 70
 --
--- are translated into the following (simplified) /GHC Core/ language:
---
--- > w16_to_i32 = \x -> Just (case x of _ { W16# x# -> I32# (word2Int# x#) })
--- >
--- > i16_to_w16 = \x -> case eta of _
--- >   { I16# b1 -> case tagToEnum# (<=# 0 b1) of _
--- >       { False -> Nothing
--- >       ; True -> Just (W16# (narrow16Word# (int2Word# b1)))
--- >       }
--- >   }
+-- @since 4.16
+newtype Iff a = Iff { getIff :: a }
+  deriving newtype (Bounded, Enum, Bits, FiniteBits, Eq)
+  deriving stock (Show, Read)
+
+-- | @since 4.16
+instance (Bits a) => Semigroup (Iff a) where
+  Iff x <> Iff y = Iff . complement $ (x `xor` y)
+
+-- | @since 4.16
+instance (Bits a) => Monoid (Iff a) where
+  mempty = Iff oneBits
diff --git a/libraries/base/GHC/Bits.hs b/libraries/base/GHC/Bits.hs
new file mode 100644
index 0000000000..d0703e223f
--- /dev/null
+++ b/libraries/base/GHC/Bits.hs
@@ -0,0 +1,719 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Bits
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This module defines bitwise operations for signed and unsigned
+-- integers.  Instances of the class 'Bits' for the 'Int' and
+-- 'Integer' types are available from this module, and instances for
+-- explicitly sized integral types are available from the
+-- "Data.Int" and "Data.Word" modules.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Bits (
+  Bits(
+    (.&.), (.|.), xor,
+    complement,
+    shift,
+    rotate,
+    zeroBits,
+    bit,
+    setBit,
+    clearBit,
+    complementBit,
+    testBit,
+    bitSizeMaybe,
+    bitSize,
+    isSigned,
+    shiftL, shiftR,
+    unsafeShiftL, unsafeShiftR,
+    rotateL, rotateR,
+    popCount
+  ),
+  FiniteBits(
+    finiteBitSize,
+    countLeadingZeros,
+    countTrailingZeros
+  ),
+
+  bitDefault,
+  testBitDefault,
+  popCountDefault,
+  toIntegralSized,
+ ) where
+
+-- Defines the @Bits@ class containing bit-based operations.
+-- See library document for details on the semantics of the
+-- individual operations.
+
+#include "MachDeps.h"
+
+import Data.Maybe
+import GHC.Num
+import GHC.Base
+import GHC.Real
+
+infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
+infixl 7 .&.
+infixl 6 `xor`
+infixl 5 .|.
+
+{-# DEPRECATED bitSize "Use 'bitSizeMaybe' or 'finiteBitSize' instead" #-} -- deprecated in 7.8
+
+-- | The 'Bits' class defines bitwise operations over integral types.
+--
+-- * Bits are numbered from 0 with bit 0 being the least
+--   significant bit.
+class Eq a => Bits a where
+    {-# MINIMAL (.&.), (.|.), xor, complement,
+                (shift | (shiftL, shiftR)),
+                (rotate | (rotateL, rotateR)),
+                bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-}
+
+    -- | Bitwise \"and\"
+    (.&.) :: a -> a -> a
+
+    -- | Bitwise \"or\"
+    (.|.) :: a -> a -> a
+
+    -- | Bitwise \"xor\"
+    xor :: a -> a -> a
+
+    {-| Reverse all the bits in the argument -}
+    complement        :: a -> a
+
+    {-| @'shift' x i@ shifts @x@ left by @i@ bits if @i@ is positive,
+        or right by @-i@ bits otherwise.
+        Right shifts perform sign extension on signed number types;
+        i.e. they fill the top bits with 1 if the @x@ is negative
+        and with 0 otherwise.
+
+        An instance can define either this unified 'shift' or 'shiftL' and
+        'shiftR', depending on which is more convenient for the type in
+        question. -}
+    shift             :: a -> Int -> a
+
+    x `shift`   i | i<0       = x `shiftR` (-i)
+                  | i>0       = x `shiftL` i
+                  | otherwise = x
+
+    {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
+        or right by @-i@ bits otherwise.
+
+        For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
+
+        An instance can define either this unified 'rotate' or 'rotateL' and
+        'rotateR', depending on which is more convenient for the type in
+        question. -}
+    rotate            :: a -> Int -> a
+
+    x `rotate`  i | i<0       = x `rotateR` (-i)
+                  | i>0       = x `rotateL` i
+                  | otherwise = x
+
+    {-
+    -- Rotation can be implemented in terms of two shifts, but care is
+    -- needed for negative values.  This suggested implementation assumes
+    -- 2's-complement arithmetic.  It is commented out because it would
+    -- require an extra context (Ord a) on the signature of 'rotate'.
+    x `rotate`  i | i<0 && isSigned x && x<0
+                         = let left = i+bitSize x in
+                           ((x `shift` i) .&. complement ((-1) `shift` left))
+                           .|. (x `shift` left)
+                  | i<0  = (x `shift` i) .|. (x `shift` (i+bitSize x))
+                  | i==0 = x
+                  | i>0  = (x `shift` i) .|. (x `shift` (i-bitSize x))
+    -}
+
+    -- | 'zeroBits' is the value with all bits unset.
+    --
+    -- The following laws ought to hold (for all valid bit indices @/n/@):
+    --
+    --   * @'clearBit' 'zeroBits' /n/ == 'zeroBits'@
+    --   * @'setBit'   'zeroBits' /n/ == 'bit' /n/@
+    --   * @'testBit'  'zeroBits' /n/ == False@
+    --   * @'popCount' 'zeroBits'   == 0@
+    --
+    -- This method uses @'clearBit' ('bit' 0) 0@ as its default
+    -- implementation (which ought to be equivalent to 'zeroBits' for
+    -- types which possess a 0th bit).
+    --
+    -- @since 4.7.0.0
+    zeroBits :: a
+    zeroBits = clearBit (bit 0) 0
+
+    -- | @bit /i/@ is a value with the @/i/@th bit set and all other bits clear.
+    --
+    -- Can be implemented using `bitDefault' if @a@ is also an
+    -- instance of 'Num'.
+    --
+    -- See also 'zeroBits'.
+    bit               :: Int -> a
+
+    -- | @x \`setBit\` i@ is the same as @x .|. bit i@
+    setBit            :: a -> Int -> a
+
+    -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
+    clearBit          :: a -> Int -> a
+
+    -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
+    complementBit     :: a -> Int -> a
+
+    {-| @x \`testBit\` i@ is the same as @x .&. bit n /= 0@
+
+        In other words it returns True if the bit at offset @n
+        is set.
+
+        Can be implemented using `testBitDefault' if @a@ is also an
+        instance of 'Num'.
+        -}
+    testBit           :: a -> Int -> Bool
+
+    {-| Return the number of bits in the type of the argument.  The actual
+        value of the argument is ignored.  Returns Nothing
+        for types that do not have a fixed bitsize, like 'Integer'.
+
+        @since 4.7.0.0
+        -}
+    bitSizeMaybe      :: a -> Maybe Int
+
+    {-| Return the number of bits in the type of the argument.  The actual
+        value of the argument is ignored.  The function 'bitSize' is
+        undefined for types that do not have a fixed bitsize, like 'Integer'.
+
+        Default implementation based upon 'bitSizeMaybe' provided since
+        4.12.0.0.
+        -}
+    bitSize           :: a -> Int
+    bitSize b = fromMaybe (error "bitSize is undefined") (bitSizeMaybe b)
+
+    {-| Return 'True' if the argument is a signed type.  The actual
+        value of the argument is ignored -}
+    isSigned          :: a -> Bool
+
+    {-# INLINE setBit #-}
+    {-# INLINE clearBit #-}
+    {-# INLINE complementBit #-}
+    x `setBit` i        = x .|. bit i
+    x `clearBit` i      = x .&. complement (bit i)
+    x `complementBit` i = x `xor` bit i
+
+    {-| Shift the argument left by the specified number of bits
+        (which must be non-negative). Some instances may throw an
+        'Control.Exception.Overflow' exception if given a negative input.
+
+        An instance can define either this and 'shiftR' or the unified
+        'shift', depending on which is more convenient for the type in
+        question. -}
+    shiftL            :: a -> Int -> a
+    {-# INLINE shiftL #-}
+    x `shiftL`  i = x `shift`  i
+
+    {-| Shift the argument left by the specified number of bits.  The
+        result is undefined for negative shift amounts and shift amounts
+        greater or equal to the 'bitSize'.
+
+        Defaults to 'shiftL' unless defined explicitly by an instance.
+
+        @since 4.5.0.0 -}
+    unsafeShiftL            :: a -> Int -> a
+    {-# INLINE unsafeShiftL #-}
+    x `unsafeShiftL` i = x `shiftL` i
+
+    {-| Shift the first argument right by the specified number of bits. The
+        result is undefined for negative shift amounts and shift amounts
+        greater or equal to the 'bitSize'. Some instances may throw an
+        'Control.Exception.Overflow' exception if given a negative input.
+
+        Right shifts perform sign extension on signed number types;
+        i.e. they fill the top bits with 1 if the @x@ is negative
+        and with 0 otherwise.
+
+        An instance can define either this and 'shiftL' or the unified
+        'shift', depending on which is more convenient for the type in
+        question. -}
+    shiftR            :: a -> Int -> a
+    {-# INLINE shiftR #-}
+    x `shiftR`  i = x `shift`  (-i)
+
+    {-| Shift the first argument right by the specified number of bits, which
+        must be non-negative and smaller than the number of bits in the type.
+
+        Right shifts perform sign extension on signed number types;
+        i.e. they fill the top bits with 1 if the @x@ is negative
+        and with 0 otherwise.
+
+        Defaults to 'shiftR' unless defined explicitly by an instance.
+
+        @since 4.5.0.0 -}
+    unsafeShiftR            :: a -> Int -> a
+    {-# INLINE unsafeShiftR #-}
+    x `unsafeShiftR` i = x `shiftR` i
+
+    {-| Rotate the argument left by the specified number of bits
+        (which must be non-negative).
+
+        An instance can define either this and 'rotateR' or the unified
+        'rotate', depending on which is more convenient for the type in
+        question. -}
+    rotateL           :: a -> Int -> a
+    {-# INLINE rotateL #-}
+    x `rotateL` i = x `rotate` i
+
+    {-| Rotate the argument right by the specified number of bits
+        (which must be non-negative).
+
+        An instance can define either this and 'rotateL' or the unified
+        'rotate', depending on which is more convenient for the type in
+        question. -}
+    rotateR           :: a -> Int -> a
+    {-# INLINE rotateR #-}
+    x `rotateR` i = x `rotate` (-i)
+
+    {-| Return the number of set bits in the argument.  This number is
+        known as the population count or the Hamming weight.
+
+        Can be implemented using `popCountDefault' if @a@ is also an
+        instance of 'Num'.
+
+        @since 4.5.0.0 -}
+    popCount          :: a -> Int
+
+-- |The 'FiniteBits' class denotes types with a finite, fixed number of bits.
+--
+-- @since 4.7.0.0
+class Bits b => FiniteBits b where
+    -- | Return the number of bits in the type of the argument.
+    -- The actual value of the argument is ignored. Moreover, 'finiteBitSize'
+    -- is total, in contrast to the deprecated 'bitSize' function it replaces.
+    --
+    -- @
+    -- 'finiteBitSize' = 'bitSize'
+    -- 'bitSizeMaybe' = 'Just' . 'finiteBitSize'
+    -- @
+    --
+    -- @since 4.7.0.0
+    finiteBitSize :: b -> Int
+
+    -- | Count number of zero bits preceding the most significant set bit.
+    --
+    -- @
+    -- 'countLeadingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a)
+    -- @
+    --
+    -- 'countLeadingZeros' can be used to compute log base 2 via
+    --
+    -- @
+    -- logBase2 x = 'finiteBitSize' x - 1 - 'countLeadingZeros' x
+    -- @
+    --
+    -- Note: The default implementation for this method is intentionally
+    -- naive. However, the instances provided for the primitive
+    -- integral types are implemented using CPU specific machine
+    -- instructions.
+    --
+    -- @since 4.8.0.0
+    countLeadingZeros :: b -> Int
+    countLeadingZeros x = (w-1) - go (w-1)
+      where
+        go i | i < 0       = i -- no bit set
+             | testBit x i = i
+             | otherwise   = go (i-1)
+
+        w = finiteBitSize x
+
+    -- | Count number of zero bits following the least significant set bit.
+    --
+    -- @
+    -- 'countTrailingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a)
+    -- 'countTrailingZeros' . 'negate' = 'countTrailingZeros'
+    -- @
+    --
+    -- The related
+    -- <http://en.wikipedia.org/wiki/Find_first_set find-first-set operation>
+    -- can be expressed in terms of 'countTrailingZeros' as follows
+    --
+    -- @
+    -- findFirstSet x = 1 + 'countTrailingZeros' x
+    -- @
+    --
+    -- Note: The default implementation for this method is intentionally
+    -- naive. However, the instances provided for the primitive
+    -- integral types are implemented using CPU specific machine
+    -- instructions.
+    --
+    -- @since 4.8.0.0
+    countTrailingZeros :: b -> Int
+    countTrailingZeros x = go 0
+      where
+        go i | i >= w      = i
+             | testBit x i = i
+             | otherwise   = go (i+1)
+
+        w = finiteBitSize x
+
+
+-- The defaults below are written with lambdas so that e.g.
+--     bit = bitDefault
+-- is fully applied, so inlining will happen
+
+-- | Default implementation for 'bit'.
+--
+-- Note that: @bitDefault i = 1 `shiftL` i@
+--
+-- @since 4.6.0.0
+bitDefault :: (Bits a, Num a) => Int -> a
+bitDefault = \i -> 1 `shiftL` i
+{-# INLINE bitDefault #-}
+
+-- | Default implementation for 'testBit'.
+--
+-- Note that: @testBitDefault x i = (x .&. bit i) /= 0@
+--
+-- @since 4.6.0.0
+testBitDefault ::  (Bits a, Num a) => a -> Int -> Bool
+testBitDefault = \x i -> (x .&. bit i) /= 0
+{-# INLINE testBitDefault #-}
+
+-- | Default implementation for 'popCount'.
+--
+-- This implementation is intentionally naive. Instances are expected to provide
+-- an optimized implementation for their size.
+--
+-- @since 4.6.0.0
+popCountDefault :: (Bits a, Num a) => a -> Int
+popCountDefault = go 0
+ where
+   go !c 0 = c
+   go c w = go (c+1) (w .&. (w - 1)) -- clear the least significant
+{-# INLINABLE popCountDefault #-}
+
+-- | Interpret 'Bool' as 1-bit bit-field
+--
+--  @since 4.7.0.0
+instance Bits Bool where
+    (.&.) = (&&)
+
+    (.|.) = (||)
+
+    xor = (/=)
+
+    complement = not
+
+    shift x 0 = x
+    shift _ _ = False
+
+    rotate x _ = x
+
+    bit 0 = True
+    bit _ = False
+
+    testBit x 0 = x
+    testBit _ _ = False
+
+    bitSizeMaybe _ = Just 1
+
+    bitSize _ = 1
+
+    isSigned _ = False
+
+    popCount False = 0
+    popCount True  = 1
+
+-- | @since 4.7.0.0
+instance FiniteBits Bool where
+    finiteBitSize _ = 1
+    countTrailingZeros x = if x then 0 else 1
+    countLeadingZeros  x = if x then 0 else 1
+
+-- | @since 2.01
+instance Bits Int where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+    -- We want popCnt# to be inlined in user code so that `ghc -msse4.2`
+    -- can compile it down to a popcnt instruction without an extra function call
+    {-# INLINE popCount #-}
+
+    zeroBits = 0
+
+    bit     = bitDefault
+
+    testBit = testBitDefault
+
+    (I# x#) .&.   (I# y#)          = I# (x# `andI#` y#)
+    (I# x#) .|.   (I# y#)          = I# (x# `orI#`  y#)
+    (I# x#) `xor` (I# y#)          = I# (x# `xorI#` y#)
+    complement (I# x#)             = I# (notI# x#)
+    (I# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#)      = I# (x# `iShiftL#` i#)
+        | otherwise                = I# (x# `iShiftRA#` negateInt# i#)
+    (I# x#) `shiftL` (I# i#)
+        | isTrue# (i# >=# 0#)      = I# (x# `iShiftL#` i#)
+        | otherwise                = overflowError
+    (I# x#) `unsafeShiftL` (I# i#) = I# (x# `uncheckedIShiftL#` i#)
+    (I# x#) `shiftR` (I# i#)
+        | isTrue# (i# >=# 0#)      = I# (x# `iShiftRA#` i#)
+        | otherwise                = overflowError
+    (I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#)
+
+    {-# INLINE rotate #-}       -- See Note [Constant folding for rotate]
+    (I# x#) `rotate` (I# i#) =
+        I# ((x# `uncheckedIShiftL#` i'#) `orI#` (x# `uncheckedIShiftRL#` (wsib -# i'#)))
+      where
+        !i'# = i# `andI#` (wsib -# 1#)
+        !wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
+    bitSizeMaybe i         = Just (finiteBitSize i)
+    bitSize i              = finiteBitSize i
+
+    popCount (I# x#) = I# (word2Int# (popCnt# (int2Word# x#)))
+
+    isSigned _             = True
+
+-- | @since 4.6.0.0
+instance FiniteBits Int where
+    finiteBitSize _ = WORD_SIZE_IN_BITS
+    countLeadingZeros  (I# x#) = I# (word2Int# (clz# (int2Word# x#)))
+    {-# INLINE countLeadingZeros #-}
+    countTrailingZeros (I# x#) = I# (word2Int# (ctz# (int2Word# x#)))
+    {-# INLINE countTrailingZeros #-}
+
+-- | @since 2.01
+instance Bits Word where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+    {-# INLINE popCount #-}
+
+    (W# x#) .&.   (W# y#)    = W# (x# `and#` y#)
+    (W# x#) .|.   (W# y#)    = W# (x# `or#`  y#)
+    (W# x#) `xor` (W# y#)    = W# (x# `xor#` y#)
+    complement (W# x#)       = W# (not# x#)
+    (W# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#)      = W# (x# `shiftL#` i#)
+        | otherwise                = W# (x# `shiftRL#` negateInt# i#)
+    (W# x#) `shiftL` (I# i#)
+        | isTrue# (i# >=# 0#)      = W# (x# `shiftL#` i#)
+        | otherwise                = overflowError
+    (W# x#) `unsafeShiftL` (I# i#) = W# (x# `uncheckedShiftL#` i#)
+    (W# x#) `shiftR` (I# i#)
+        | isTrue# (i# >=# 0#)      = W# (x# `shiftRL#` i#)
+        | otherwise                = overflowError
+    (W# x#) `unsafeShiftR` (I# i#) = W# (x# `uncheckedShiftRL#` i#)
+    (W# x#) `rotate` (I# i#)
+        | isTrue# (i'# ==# 0#) = W# x#
+        | otherwise  = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#)))
+        where
+        !i'# = i# `andI#` (wsib -# 1#)
+        !wsib = WORD_SIZE_IN_BITS#  {- work around preprocessor problem (??) -}
+    bitSizeMaybe i           = Just (finiteBitSize i)
+    bitSize i                = finiteBitSize i
+    isSigned _               = False
+    popCount (W# x#)         = I# (word2Int# (popCnt# x#))
+    bit                      = bitDefault
+    testBit                  = testBitDefault
+
+-- | @since 4.6.0.0
+instance FiniteBits Word where
+    finiteBitSize _ = WORD_SIZE_IN_BITS
+    countLeadingZeros  (W# x#) = I# (word2Int# (clz# x#))
+    {-# INLINE countLeadingZeros #-}
+    countTrailingZeros (W# x#) = I# (word2Int# (ctz# x#))
+    {-# INLINE countTrailingZeros #-}
+
+-- | @since 2.01
+instance Bits Integer where
+   (.&.)      = integerAnd
+   (.|.)      = integerOr
+   xor        = integerXor
+   complement = integerComplement
+   unsafeShiftR x i = integerShiftR x (fromIntegral i)
+   unsafeShiftL x i = integerShiftL x (fromIntegral i)
+   shiftR x i@(I# i#)
+      | isTrue# (i# >=# 0#) = unsafeShiftR x i
+      | otherwise           = overflowError
+   shiftL x i@(I# i#)
+      | isTrue# (i# >=# 0#) = unsafeShiftL x i
+      | otherwise           = overflowError
+   shift x i | i >= 0    = integerShiftL x (fromIntegral i)
+             | otherwise = integerShiftR x (fromIntegral (negate i))
+   testBit x i = integerTestBit x (fromIntegral i)
+   zeroBits    = integerZero
+
+   bit (I# i)  = integerBit# (int2Word# i)
+   popCount x  = I# (integerPopCount# x)
+
+   rotate x i = shift x i   -- since an Integer never wraps around
+
+   bitSizeMaybe _ = Nothing
+   bitSize _  = errorWithoutStackTrace "Data.Bits.bitSize(Integer)"
+   isSigned _ = True
+
+-- | @since 4.8.0
+instance Bits Natural where
+   (.&.)         = naturalAnd
+   (.|.)         = naturalOr
+   xor           = naturalXor
+   complement _  = errorWithoutStackTrace
+                    "Bits.complement: Natural complement undefined"
+   unsafeShiftR x i = naturalShiftR x (fromIntegral i)
+   unsafeShiftL x i = naturalShiftL x (fromIntegral i)
+   shiftR x i@(I# i#)
+      | isTrue# (i# >=# 0#) = unsafeShiftR x i
+      | otherwise           = overflowError
+   shiftL x i@(I# i#)
+      | isTrue# (i# >=# 0#) = unsafeShiftL x i
+      | otherwise           = overflowError
+   shift x i
+     | i >= 0    = naturalShiftL x (fromIntegral i)
+     | otherwise = naturalShiftR x (fromIntegral (negate i))
+   testBit x i   = naturalTestBit x (fromIntegral i)
+   zeroBits      = naturalZero
+   clearBit x i  = x `xor` (bit i .&. x)
+
+   bit (I# i)  = naturalBit# (int2Word# i)
+   popCount x  = I# (word2Int# (naturalPopCount# x))
+
+   rotate x i = shift x i   -- since an Natural never wraps around
+
+   bitSizeMaybe _ = Nothing
+   bitSize _  = errorWithoutStackTrace "Data.Bits.bitSize(Natural)"
+   isSigned _ = False
+
+-----------------------------------------------------------------------------
+
+-- | Attempt to convert an 'Integral' type @a@ to an 'Integral' type @b@ using
+-- the size of the types as measured by 'Bits' methods.
+--
+-- A simpler version of this function is:
+--
+-- > toIntegral :: (Integral a, Integral b) => a -> Maybe b
+-- > toIntegral x
+-- >   | toInteger x == y = Just (fromInteger y)
+-- >   | otherwise        = Nothing
+-- >   where
+-- >     y = toInteger x
+--
+-- This version requires going through 'Integer', which can be inefficient.
+-- However, @toIntegralSized@ is optimized to allow GHC to statically determine
+-- the relative type sizes (as measured by 'bitSizeMaybe' and 'isSigned') and
+-- avoid going through 'Integer' for many types. (The implementation uses
+-- 'fromIntegral', which is itself optimized with rules for @base@ types but may
+-- go through 'Integer' for some type pairs.)
+--
+-- @since 4.8.0.0
+
+toIntegralSized :: (Integral a, Integral b, Bits a, Bits b) => a -> Maybe b
+toIntegralSized x                 -- See Note [toIntegralSized optimization]
+  | maybe True (<= x) yMinBound
+  , maybe True (x <=) yMaxBound = Just y
+  | otherwise                   = Nothing
+  where
+    y = fromIntegral x
+
+    xWidth = bitSizeMaybe x
+    yWidth = bitSizeMaybe y
+
+    yMinBound
+      | isBitSubType x y = Nothing
+      | isSigned x, not (isSigned y) = Just 0
+      | isSigned x, isSigned y
+      , Just yW <- yWidth = Just (negate $ bit (yW-1)) -- Assumes sub-type
+      | otherwise = Nothing
+
+    yMaxBound
+      | isBitSubType x y = Nothing
+      | isSigned x, not (isSigned y)
+      , Just xW <- xWidth, Just yW <- yWidth
+      , xW <= yW+1 = Nothing -- Max bound beyond a's domain
+      | Just yW <- yWidth = if isSigned y
+                            then Just (bit (yW-1)-1)
+                            else Just (bit yW-1)
+      | otherwise = Nothing
+{-# INLINABLE toIntegralSized #-}
+
+-- | 'True' if the size of @a@ is @<=@ the size of @b@, where size is measured
+-- by 'bitSizeMaybe' and 'isSigned'.
+isBitSubType :: (Bits a, Bits b) => a -> b -> Bool
+isBitSubType x y
+  -- Reflexive
+  | xWidth == yWidth, xSigned == ySigned = True
+
+  -- Every integer is a subset of 'Integer'
+  | ySigned, Nothing == yWidth                  = True
+  | not xSigned, not ySigned, Nothing == yWidth = True
+
+  -- Sub-type relations between fixed-with types
+  | xSigned == ySigned,   Just xW <- xWidth, Just yW <- yWidth = xW <= yW
+  | not xSigned, ySigned, Just xW <- xWidth, Just yW <- yWidth = xW <  yW
+
+  | otherwise = False
+  where
+    xWidth  = bitSizeMaybe x
+    xSigned = isSigned     x
+
+    yWidth  = bitSizeMaybe y
+    ySigned = isSigned     y
+{-# INLINE isBitSubType #-}
+
+{-      Note [Constant folding for rotate]
+        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The INLINE on the Int instance of rotate enables it to be constant
+folded.  For example:
+     sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
+goes to:
+   Main.$wfold =
+     \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
+       case ww1_sOb of wild_XM {
+         __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
+         10000000 -> ww_sO7
+whereas before it was left as a call to $wrotate.
+
+All other Bits instances seem to inline well enough on their
+own to enable constant folding; for example 'shift':
+     sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
+ goes to:
+     Main.$wfold =
+       \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
+         case ww1_sOf of wild_XM {
+           __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);
+           10000000 -> ww_sOb
+         }
+-}
+
+-- Note [toIntegralSized optimization]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The code in 'toIntegralSized' relies on GHC optimizing away statically
+-- decidable branches.
+--
+-- If both integral types are statically known, GHC will be able optimize the
+-- code significantly (for @-O1@ and better).
+--
+-- For instance (as of GHC 7.8.1) the following definitions:
+--
+-- > w16_to_i32 = toIntegralSized :: Word16 -> Maybe Int32
+-- >
+-- > i16_to_w16 = toIntegralSized :: Int16 -> Maybe Word16
+--
+-- are translated into the following (simplified) /GHC Core/ language:
+--
+-- > w16_to_i32 = \x -> Just (case x of _ { W16# x# -> I32# (word2Int# x#) })
+-- >
+-- > i16_to_w16 = \x -> case eta of _
+-- >   { I16# b1 -> case tagToEnum# (<=# 0 b1) of _
+-- >       { False -> Nothing
+-- >       ; True -> Just (W16# (narrow16Word# (int2Word# b1)))
+-- >       }
+-- >   }
diff --git a/libraries/base/GHC/Float.hs b/libraries/base/GHC/Float.hs
index e25319214d..eae6edb253 100644
--- a/libraries/base/GHC/Float.hs
+++ b/libraries/base/GHC/Float.hs
@@ -55,8 +55,8 @@ module GHC.Float
 
 import Data.Maybe
 
-import Data.Bits
 import GHC.Base
+import GHC.Bits
 import GHC.List
 import GHC.Enum
 import GHC.Show
diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs
index 4ff2cc4837..02dcdfcd1a 100644
--- a/libraries/base/GHC/Word.hs
+++ b/libraries/base/GHC/Word.hs
@@ -46,7 +46,6 @@ module GHC.Word (
     eqWord64, neWord64, gtWord64, geWord64, ltWord64, leWord64
     ) where
 
-import Data.Bits
 import Data.Maybe
 
 #if WORD_SIZE_IN_BITS < 64
@@ -54,6 +53,7 @@ import GHC.IntWord64
 #endif
 
 import GHC.Base
+import GHC.Bits
 import GHC.Enum
 import GHC.Num
 import GHC.Real
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index 36642abea4..ac5cb24814 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -188,6 +188,7 @@ Library
         Foreign.Storable
         GHC.Arr
         GHC.Base
+        GHC.Bits
         GHC.ByteOrder
         GHC.Char
         GHC.Clock
diff --git a/testsuite/tests/ghci/scripts/ghci064.stdout b/testsuite/tests/ghci/scripts/ghci064.stdout
index 9190a68e67..d527dde6c4 100644
--- a/testsuite/tests/ghci/scripts/ghci064.stdout
+++ b/testsuite/tests/ghci/scripts/ghci064.stdout
@@ -40,8 +40,8 @@ instance Bounded Bool -- Defined in ‘GHC.Enum’
 instance GHC.Generics.Generic Bool -- Defined in ‘GHC.Generics’
 instance GHC.Ix.Ix Bool -- Defined in ‘GHC.Ix’
 instance GHC.Generics.SingKind Bool -- Defined in ‘GHC.Generics’
-instance Data.Bits.Bits Bool -- Defined in ‘Data.Bits’
-instance Data.Bits.FiniteBits Bool -- Defined in ‘Data.Bits’
+instance GHC.Bits.Bits Bool -- Defined in ‘GHC.Bits’
+instance GHC.Bits.FiniteBits Bool -- Defined in ‘GHC.Bits’
 instance Functor ((,) Int) -- Defined in ‘GHC.Base’
 instance Foldable ((,) Int) -- Defined in ‘Data.Foldable’
 instance Traversable ((,) Int) -- Defined in ‘Data.Traversable’