diff --git a/Data/Primitive/Array.hs b/Data/Primitive/Array.hs
index e8a581251fc5dc254e8de3ba60b7f20675f0cd27..3370f61bbb9d8f3c7080a061a450367e62a572d9 100644
--- a/Data/Primitive/Array.hs
+++ b/Data/Primitive/Array.hs
@@ -52,9 +52,6 @@ import qualified GHC.ST as GHCST
 import qualified Data.Foldable as F
 import Data.Semigroup
 import Data.Functor.Identity
-#if !MIN_VERSION_base(4,10,0)
-import GHC.Base (runRW#)
-#endif
 
 import Text.Read (Read (..), parens, prec)
 import Text.ParserCombinators.ReadPrec (ReadPrec)
@@ -799,14 +796,7 @@ instance Read a => Read (Array a) where
 
 -- | @since 0.6.4.0
 instance Read1 Array where
-#if MIN_VERSION_base(4,10,0)
   liftReadPrec = arrayLiftReadPrec
-#else
-  -- This is just the default implementation of liftReadsPrec, but
-  -- it is not present in older versions of base.
-  liftReadsPrec rp rl = RdPrc.readPrec_to_S $
-    arrayLiftReadPrec (RdPrc.readS_to_Prec rp) (RdPrc.readS_to_Prec (const rl))
-#endif
 
 -- Note [Forgiving Array Read Instance]
 -- We're really forgiving here. We accept
diff --git a/Data/Primitive/ByteArray.hs b/Data/Primitive/ByteArray.hs
index e6abdba5f1b4b0eb3fe7e10df986e118d28d621e..0d19895d5c0cd342ae4e620d62c898bb9b995fcf 100644
--- a/Data/Primitive/ByteArray.hs
+++ b/Data/Primitive/ByteArray.hs
@@ -75,9 +75,7 @@ import Control.Monad.ST
 import Data.Primitive.Types
 import Data.Proxy
 
-#if MIN_VERSION_base(4,10,0)
 import qualified GHC.ST as GHCST
-#endif
 
 import Data.Word ( Word8 )
 #if __GLASGOW_HASKELL__ >= 802
@@ -640,7 +638,6 @@ cloneMutableByteArray src off n = do
 runByteArray
   :: (forall s. ST s (MutableByteArray s))
   -> ByteArray
-#if MIN_VERSION_base(4,10,0) /* In new GHCs, runRW# is available. */
 runByteArray m = ByteArray (runByteArray# m)
 
 runByteArray#
@@ -652,9 +649,6 @@ runByteArray# m = case runRW# $ \s ->
 
 unST :: ST s a -> State# s -> (# State# s, a #)
 unST (GHCST.ST f) = f
-#else /* In older GHCs, runRW# is not available. */
-runByteArray m = runST $ m >>= unsafeFreezeByteArray
-#endif
 
 -- Create an uninitialized array of the given size in bytes, apply the function
 -- to it, and freeze the result.
diff --git a/Data/Primitive/PrimArray.hs b/Data/Primitive/PrimArray.hs
index 9a2f761f0c840ab4051baaa7d0872ef719ef159e..5200f66fc5c953dc10876af5f515c1d7d8644fa3 100644
--- a/Data/Primitive/PrimArray.hs
+++ b/Data/Primitive/PrimArray.hs
@@ -125,9 +125,7 @@ import Control.Monad.ST
 import qualified Data.List as L
 import qualified Data.Primitive.ByteArray as PB
 import qualified Data.Primitive.Types as PT
-#if MIN_VERSION_base(4,10,0)
 import qualified GHC.ST as GHCST
-#endif
 import Language.Haskell.TH.Syntax (Lift (..))
 
 import Data.Semigroup
@@ -1144,7 +1142,6 @@ cloneMutablePrimArray src off n = do
 runPrimArray
   :: (forall s. ST s (MutablePrimArray s a))
   -> PrimArray a
-#if MIN_VERSION_base(4,10,0) /* In new GHCs, runRW# is available. */
 runPrimArray m = PrimArray (runPrimArray# m)
 
 runPrimArray#
@@ -1156,9 +1153,6 @@ runPrimArray# m = case runRW# $ \s ->
 
 unST :: ST s a -> State# s -> (# State# s, a #)
 unST (GHCST.ST f) = f
-#else /* In older GHCs, runRW# is not available. */
-runPrimArray m = runST $ m >>= unsafeFreezePrimArray
-#endif
 
 -- | Create an uninitialized array of the given length, apply the function to
 -- it, and freeze the result.
diff --git a/Data/Primitive/SmallArray.hs b/Data/Primitive/SmallArray.hs
index cf3d1dab0afc30c9ce5b329caeb43bedca9a0b72..b33833afba5532112b77214e81479fa8209fd65d 100644
--- a/Data/Primitive/SmallArray.hs
+++ b/Data/Primitive/SmallArray.hs
@@ -88,9 +88,6 @@ import Data.Semigroup
 import Text.ParserCombinators.ReadP
 import Text.ParserCombinators.ReadPrec (ReadPrec)
 import qualified Text.ParserCombinators.ReadPrec as RdPrc
-#if !MIN_VERSION_base(4,10,0)
-import GHC.Base (runRW#)
-#endif
 
 import Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..), Read1(..))
 import Language.Haskell.TH.Syntax (Lift(..))
@@ -892,14 +889,7 @@ instance Read a => Read (SmallArray a) where
 
 -- | @since 0.6.4.0
 instance Read1 SmallArray where
-#if MIN_VERSION_base(4,10,0)
   liftReadPrec = smallArrayLiftReadPrec
-#else
-  -- This is just the default implementation of liftReadsPrec, but
-  -- it is not present in older versions of base.
-  liftReadsPrec rp rl = RdPrc.readPrec_to_S $
-    smallArrayLiftReadPrec (RdPrc.readS_to_Prec rp) (RdPrc.readS_to_Prec (const rl))
-#endif
 
 smallArrayDataType :: DataType
 smallArrayDataType =
diff --git a/Data/Primitive/Types.hs b/Data/Primitive/Types.hs
index 4bfcea9dceb3b84a73f3eb65592e09fc5a0f027e..cec5c68fb3c950009f22597e44c08aec505b0881 100644
--- a/Data/Primitive/Types.hs
+++ b/Data/Primitive/Types.hs
@@ -410,9 +410,7 @@ deriving instance Prim CWchar
 deriving instance Prim CSigAtomic
 deriving instance Prim CLLong
 deriving instance Prim CULLong
-#if MIN_VERSION_base(4,10,0)
 deriving instance Prim CBool
-#endif
 deriving instance Prim CIntPtr
 deriving instance Prim CUIntPtr
 deriving instance Prim CIntMax
diff --git a/primitive.cabal b/primitive.cabal
index 9f5df216ffd552457cf1f78b5e0a1c46e8515479..eea258f7a9d7cb3d0935ae428058e09fff5e4af9 100644
--- a/primitive.cabal
+++ b/primitive.cabal
@@ -87,7 +87,6 @@ test-suite test-qc
   type: exitcode-stdio-1.0
   build-depends: base
                , base-orphans
-               , ghc-prim
                , primitive
                , quickcheck-classes-base >= 0.6 && <0.7
                , QuickCheck >= 2.13 && < 2.16
diff --git a/test/Main.hs b/test/Main.hs
index 8e813cff5a6e85b1e0c221c46164cd70f9efb77f..f85ba63d32c07b0a3a5b9b0f3eb406960e186d9b 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -32,7 +32,6 @@ import PrimLaws (primLaws)
 
 import Data.Functor.Identity (Identity(..))
 import qualified Data.Monoid as Monoid
-import Data.Ord (Down(..))
 import Data.Semigroup (stimes, stimesMonoid)
 import qualified Data.Semigroup as Semigroup
 #if !(MIN_VERSION_base(4,11,0))