diff --git a/Data/IntMap/Internal.hs b/Data/IntMap/Internal.hs
index 9b30673cc..6ec442565 100644
--- a/Data/IntMap/Internal.hs
+++ b/Data/IntMap/Internal.hs
@@ -331,6 +331,10 @@ import qualified Control.Category as Category
 import Data.Coerce
 #endif
 
+#if __GLASGOW_HASKELL__ >= 800
+import GHC.Stack (HasCallStack)
+#endif
+
 
 -- A "Nat" is a natural machine word (an unsigned Int)
 type Nat = Word
@@ -390,8 +394,20 @@ bitmapOf x = shiftLL 1 (x .&. IntSet.suffixBitMask)
 -- > fromList [(5,'a'), (3,'b')] ! 1    Error: element not in the map
 -- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'
 
+#if __GLASGOW_HASKELL__ >= 800
+(!) :: HasCallStack => IntMap a -> Key -> a
+#else
 (!) :: IntMap a -> Key -> a
-(!) m k = find k m
+#endif
+(!) m0 !k = go m0
+  where
+    go (Bin p m l r) | nomatch k p m = not_found
+                     | zero k m  = go l
+                     | otherwise = go r
+    go (Tip kx x) | k == kx   = x
+                  | otherwise = not_found
+    go Nil = not_found
+    not_found = error ("IntMap.!: key " ++ show k ++ " is not an element of the map")
 
 -- | /O(min(n,W))/. Find the value at a key.
 -- Returns 'Nothing' when the element can not be found.
@@ -583,19 +599,6 @@ lookup !k = go
     go Nil = Nothing
 
 
--- See Note: Local 'go' functions and capturing]
-find :: Key -> IntMap a -> a
-find !k = go
-  where
-    go (Bin p m l r) | nomatch k p m = not_found
-                     | zero k m  = go l
-                     | otherwise = go r
-    go (Tip kx x) | k == kx   = x
-                  | otherwise = not_found
-    go Nil = not_found
-
-    not_found = error ("IntMap.!: key " ++ show k ++ " is not an element of the map")
-
 -- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@
 -- returns the value at key @k@ or returns @def@ when the key is not an
 -- element of the map.
@@ -2169,11 +2172,19 @@ minView :: IntMap a -> Maybe (a, IntMap a)
 minView t = liftM (first snd) (minViewWithKey t)
 
 -- | /O(min(n,W))/. Delete and find the maximal element.
+#if __GLASGOW_HASKELL__ >= 800
+deleteFindMax :: HasCallStack => IntMap a -> ((Key, a), IntMap a)
+#else
 deleteFindMax :: IntMap a -> ((Key, a), IntMap a)
+#endif
 deleteFindMax = fromMaybe (error "deleteFindMax: empty map has no maximal element") . maxViewWithKey
 
 -- | /O(min(n,W))/. Delete and find the minimal element.
+#if __GLASGOW_HASKELL__ >= 800
+deleteFindMin :: HasCallStack => IntMap a -> ((Key, a), IntMap a)
+#else
 deleteFindMin :: IntMap a -> ((Key, a), IntMap a)
+#endif
 deleteFindMin = fromMaybe (error "deleteFindMin: empty map has no minimal element") . minViewWithKey
 
 -- | /O(min(n,W))/. The minimal key of the map. Returns 'Nothing' if the map is empty.
@@ -2188,7 +2199,11 @@ lookupMin (Bin _ m l r)
           go Nil            = Nothing
 
 -- | /O(min(n,W))/. The minimal key of the map. Calls 'error' if the map is empty.
+#if __GLASGOW_HASKELL__ >= 800
+findMin :: HasCallStack => IntMap a -> (Key, a)
+#else
 findMin :: IntMap a -> (Key, a)
+#endif
 findMin t
   | Just r <- lookupMin t = r
   | otherwise = error "findMin: empty map has no minimal element"
@@ -2205,7 +2220,11 @@ lookupMax (Bin _ m l r)
           go Nil            = Nothing
 
 -- | /O(min(n,W))/. The maximal key of the map. Calls 'error' if the map is empty.
+#if __GLASGOW_HASKELL__ >= 800
+findMax :: HasCallStack => IntMap a -> (Key, a)
+#else
 findMax :: IntMap a -> (Key, a)
+#endif
 findMax t
   | Just r <- lookupMax t = r
   | otherwise = error "findMax: empty map has no maximal element"
diff --git a/Data/IntSet/Internal.hs b/Data/IntSet/Internal.hs
index 48f27b9bb..4186aa9e7 100644
--- a/Data/IntSet/Internal.hs
+++ b/Data/IntSet/Internal.hs
@@ -216,6 +216,9 @@ import qualified GHC.Exts as GHCExts
 import GHC.Prim (indexInt8OffAddr#)
 #endif
 
+#if __GLASGOW_HASKELL__ >= 800
+import GHC.Stack (HasCallStack)
+#endif
 
 infixl 9 \\{-This comment teaches CPP correct behaviour -}
 
@@ -793,18 +796,30 @@ minView t =
 -- | /O(min(n,W))/. Delete and find the minimal element.
 --
 -- > deleteFindMin set = (findMin set, deleteMin set)
+#if __GLASGOW_HASKELL__ >= 800
+deleteFindMin :: HasCallStack => IntSet -> (Key, IntSet)
+#else
 deleteFindMin :: IntSet -> (Key, IntSet)
+#endif
 deleteFindMin = fromMaybe (error "deleteFindMin: empty set has no minimal element") . minView
 
 -- | /O(min(n,W))/. Delete and find the maximal element.
 --
 -- > deleteFindMax set = (findMax set, deleteMax set)
+#if __GLASGOW_HASKELL__ >= 800
+deleteFindMax :: HasCallStack => IntSet -> (Key, IntSet)
+#else
 deleteFindMax :: IntSet -> (Key, IntSet)
+#endif
 deleteFindMax = fromMaybe (error "deleteFindMax: empty set has no maximal element") . maxView
 
 
 -- | /O(min(n,W))/. The minimal element of the set.
+#if __GLASGOW_HASKELL__ >= 800
+findMin :: HasCallStack => IntSet -> Key
+#else
 findMin :: IntSet -> Key
+#endif
 findMin Nil = error "findMin: empty set has no minimal element"
 findMin (Tip kx bm) = kx + lowestBitSet bm
 findMin (Bin _ m l r)
@@ -815,7 +830,11 @@ findMin (Bin _ m l r)
           find Nil            = error "findMin Nil"
 
 -- | /O(min(n,W))/. The maximal element of a set.
+#if __GLASGOW_HASKELL__ >= 800
+findMax :: HasCallStack => IntSet -> Key
+#else
 findMax :: IntSet -> Key
+#endif
 findMax Nil = error "findMax: empty set has no maximal element"
 findMax (Tip kx bm) = kx + highestBitSet bm
 findMax (Bin _ m l r)
diff --git a/Data/Map/Internal.hs b/Data/Map/Internal.hs
index e35e0433e..033e8d247 100644
--- a/Data/Map/Internal.hs
+++ b/Data/Map/Internal.hs
@@ -411,6 +411,9 @@ import qualified Control.Category as Category
 import Data.Coerce
 #endif
 
+#if __GLASGOW_HASKELL__ >= 800
+import GHC.Stack (HasCallStack)
+#endif
 
 {--------------------------------------------------------------------
   Operators
@@ -423,8 +426,18 @@ infixl 9 !,!?,\\ --
 -- > fromList [(5,'a'), (3,'b')] ! 1    Error: element not in the map
 -- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'
 
+#if __GLASGOW_HASKELL__ >= 800
+(!) :: (HasCallStack, Ord k) => Map k a -> k -> a
+#else
 (!) :: Ord k => Map k a -> k -> a
-(!) m k = find k m
+#endif
+(!) m !k = go m
+  where
+    go Tip = error "Map.!: given key is not an element in the map"
+    go (Bin _ kx x l r) = case compare k kx of
+      LT -> go l
+      GT -> go r
+      EQ -> x
 #if __GLASGOW_HASKELL__
 {-# INLINE (!) #-}
 #endif
@@ -602,22 +615,6 @@ notMember k m = not $ member k m
 {-# INLINE notMember #-}
 #endif
 
--- | /O(log n)/. Find the value at a key.
--- Calls 'error' when the element can not be found.
-find :: Ord k => k -> Map k a -> a
-find = go
-  where
-    go !_ Tip = error "Map.!: given key is not an element in the map"
-    go k (Bin _ kx x l r) = case compare k kx of
-      LT -> go k l
-      GT -> go k r
-      EQ -> x
-#if __GLASGOW_HASKELL__
-{-# INLINABLE find #-}
-#else
-{-# INLINE find #-}
-#endif
-
 -- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns
 -- the value at key @k@ or returns default value @def@
 -- when the key is not in the map.
@@ -1433,7 +1430,11 @@ alterFYoneda = go
 -- > findIndex 6 (fromList [(5,"a"), (3,"b")])    Error: element is not in the map
 
 -- See Note: Type of local 'go' function
+#if __GLASGOW_HASKELL__ >= 800
+findIndex :: (HasCallStack, Ord k) => k -> Map k a -> Int
+#else
 findIndex :: Ord k => k -> Map k a -> Int
+#endif
 findIndex = go 0
   where
     go :: Ord k => Int -> k -> Map k a -> Int
@@ -1477,6 +1478,18 @@ lookupIndex = go 0
 -- > elemAt 1 (fromList [(5,"a"), (3,"b")]) == (5, "a")
 -- > elemAt 2 (fromList [(5,"a"), (3,"b")])    Error: index out of range
 
+#if __GLASGOW_HASKELL__ >= 800
+elemAt :: HasCallStack => Int -> Map k a -> (k,a)
+elemAt = go where
+  go !_ Tip = error "Map.elemAt: index out of range"
+  go i (Bin _ kx x l r)
+    = case compare i sizeL of
+        LT -> elemAt i l
+        GT -> elemAt (i-sizeL-1) r
+        EQ -> (kx,x)
+    where
+      sizeL = size l
+#else
 elemAt :: Int -> Map k a -> (k,a)
 elemAt !_ Tip = error "Map.elemAt: index out of range"
 elemAt i (Bin _ kx x l r)
@@ -1486,6 +1499,7 @@ elemAt i (Bin _ kx x l r)
       EQ -> (kx,x)
   where
     sizeL = size l
+#endif
 
 -- | Take a given number of entries in key order, beginning
 -- with the smallest keys.
@@ -1566,6 +1580,21 @@ splitAt i0 m0
 -- > updateAt (\_ _  -> Nothing)  2    (fromList [(5,"a"), (3,"b")])    Error: index out of range
 -- > updateAt (\_ _  -> Nothing)  (-1) (fromList [(5,"a"), (3,"b")])    Error: index out of range
 
+#if __GLASGOW_HASKELL__ >= 800
+updateAt :: HasCallStack => (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
+updateAt = go where
+  go f !i t =
+    case t of
+      Tip -> error "Map.updateAt: index out of range"
+      Bin sx kx x l r -> case compare i sizeL of
+        LT -> balanceR kx x (go f i l) r
+        GT -> balanceL kx x l (go f (i-sizeL-1) r)
+        EQ -> case f kx x of
+                Just x' -> Bin sx kx x' l r
+                Nothing -> glue l r
+        where
+          sizeL = size l
+#else
 updateAt :: (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
 updateAt f !i t =
   case t of
@@ -1578,6 +1607,7 @@ updateAt f !i t =
               Nothing -> glue l r
       where
         sizeL = size l
+#endif
 
 -- | /O(log n)/. Delete the element at /index/, i.e. by its zero-based index in
 -- the sequence sorted by keys. If the /index/ is out of range (less than zero,
@@ -1588,6 +1618,19 @@ updateAt f !i t =
 -- > deleteAt 2 (fromList [(5,"a"), (3,"b")])     Error: index out of range
 -- > deleteAt (-1) (fromList [(5,"a"), (3,"b")])  Error: index out of range
 
+#if __GLASGOW_HASKELL__ >= 800
+deleteAt :: HasCallStack => Int -> Map k a -> Map k a
+deleteAt = go where
+  go !i t =
+    case t of
+      Tip -> error "Map.deleteAt: index out of range"
+      Bin _ kx x l r -> case compare i sizeL of
+        LT -> balanceR kx x (go i l) r
+        GT -> balanceL kx x l (go (i-sizeL-1) r)
+        EQ -> glue l r
+        where
+          sizeL = size l
+#else
 deleteAt :: Int -> Map k a -> Map k a
 deleteAt !i t =
   case t of
@@ -1598,6 +1641,7 @@ deleteAt !i t =
       EQ -> glue l r
       where
         sizeL = size l
+#endif
 
 
 {--------------------------------------------------------------------
@@ -1624,7 +1668,11 @@ lookupMin (Bin _ k x l _) = Just $! lookupMinSure k x l
 -- > findMin (fromList [(5,"a"), (3,"b")]) == (3,"b")
 -- > findMin empty                            Error: empty map has no minimal element
 
+#if __GLASGOW_HASKELL__ >= 800
+findMin :: HasCallStack => Map k a -> (k,a)
+#else
 findMin :: Map k a -> (k,a)
+#endif
 findMin t
   | Just r <- lookupMin t = r
   | otherwise = error "Map.findMin: empty map has no minimal element"
@@ -1649,7 +1697,11 @@ lookupMax :: Map k a -> Maybe (k, a)
 lookupMax Tip = Nothing
 lookupMax (Bin _ k x _ r) = Just $! lookupMaxSure k x r
 
+#if __GLASGOW_HASKELL__ >= 800
+findMax :: HasCallStack => Map k a -> (k,a)
+#else
 findMax :: Map k a -> (k,a)
+#endif
 findMax t
   | Just r <- lookupMax t = r
   | otherwise = error "Map.findMax: empty map has no maximal element"
@@ -3866,7 +3918,11 @@ maxViewSure = go
 -- > deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((3,"b"), fromList[(5,"a"), (10,"c")])
 -- > deleteFindMin                                            Error: can not return the minimal element of an empty map
 
+#if __GLASGOW_HASKELL__ >= 800
+deleteFindMin :: HasCallStack => Map k a -> ((k,a),Map k a)
+#else
 deleteFindMin :: Map k a -> ((k,a),Map k a)
+#endif
 deleteFindMin t = case minViewWithKey t of
   Nothing -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip)
   Just res -> res
@@ -3876,7 +3932,11 @@ deleteFindMin t = case minViewWithKey t of
 -- > deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((10,"c"), fromList [(3,"b"), (5,"a")])
 -- > deleteFindMax empty                                      Error: can not return the maximal element of an empty map
 
+#if __GLASGOW_HASKELL__ >= 800
+deleteFindMax :: HasCallStack => Map k a -> ((k,a),Map k a)
+#else
 deleteFindMax :: Map k a -> ((k,a),Map k a)
+#endif
 deleteFindMax t = case maxViewWithKey t of
   Nothing -> (error "Map.deleteFindMax: can not return the maximal element of an empty map", Tip)
   Just res -> res
diff --git a/Data/Map/Strict/Internal.hs b/Data/Map/Strict/Internal.hs
index 4fc3eb797..1624c09ca 100644
--- a/Data/Map/Strict/Internal.hs
+++ b/Data/Map/Strict/Internal.hs
@@ -418,6 +418,10 @@ import Data.Coerce
 import Data.Functor.Identity (Identity (..))
 #endif
 
+#if __GLASGOW_HASKELL__ >= 800
+import GHC.Stack (HasCallStack)
+#endif
+
 
 -- $strictness
 --
@@ -881,6 +885,21 @@ atKeyIdentity k f t = Identity $ atKeyPlain Strict k (coerce f) t
 -- > updateAt (\_ _  -> Nothing)  2    (fromList [(5,"a"), (3,"b")])    Error: index out of range
 -- > updateAt (\_ _  -> Nothing)  (-1) (fromList [(5,"a"), (3,"b")])    Error: index out of range
 
+#if __GLASGOW_HASKELL__ >= 800
+updateAt :: HasCallStack => (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
+updateAt = go where
+  go f i t = i `seq`
+    case t of
+      Tip -> error "Map.updateAt: index out of range"
+      Bin sx kx x l r -> case compare i sizeL of
+        LT -> balanceR kx x (go f i l) r
+        GT -> balanceL kx x l (go f (i-sizeL-1) r)
+        EQ -> case f kx x of
+                Just x' -> x' `seq` Bin sx kx x' l r
+                Nothing -> glue l r
+        where
+          sizeL = size l
+#else
 updateAt :: (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
 updateAt f i t = i `seq`
   case t of
@@ -893,6 +912,7 @@ updateAt f i t = i `seq`
               Nothing -> glue l r
       where
         sizeL = size l
+#endif
 
 {--------------------------------------------------------------------
   Minimal, Maximal
diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index fc787015e..1442be50e 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -265,6 +265,10 @@ import Control.Monad.Zip (MonadZip (..))
 #endif
 import Control.Monad.Fix (MonadFix (..), fix)
 
+#if __GLASGOW_HASKELL__ >= 800
+import GHC.Stack (HasCallStack)
+#endif
+
 default ()
 
 -- We define our own copy here, for Monoid only, even though this
@@ -449,7 +453,11 @@ instance MonadFix Seq where
 -- This is just like the instance for lists, but we can take advantage of
 -- constant-time length and logarithmic-time indexing to speed things up.
 -- Using fromFunction, we make this about as lazy as we can.
+#if __GLASGOW_HASKELL__ >= 800
+mfixSeq :: HasCallStack => (a -> Seq a) -> Seq a
+#else
 mfixSeq :: (a -> Seq a) -> Seq a
+#endif
 mfixSeq f = fromFunction (length (f err)) (\k -> fix (\xk -> f xk `index` k))
   where
     err = error "mfix for Data.Sequence.Seq applied to strict function"
@@ -1224,7 +1232,11 @@ singleton       :: a -> Seq a
 singleton x     =  Seq (Single (Elem x))
 
 -- | \( O(\log n) \). @replicate n x@ is a sequence consisting of @n@ copies of @x@.
+#if __GLASGOW_HASKELL__ >= 800
+replicate       :: HasCallStack => Int -> a -> Seq a
+#else
 replicate       :: Int -> a -> Seq a
+#endif
 replicate n x
   | n >= 0      = runIdentity (replicateA n (Identity x))
   | otherwise   = error "replicate takes a nonnegative integer argument"
@@ -1233,7 +1245,11 @@ replicate n x
 -- \( O(\log n) \) calls to 'liftA2' and 'pure'.
 --
 -- > replicateA n x = sequenceA (replicate n x)
+#if __GLASGOW_HASKELL__ >= 800
+replicateA :: (HasCallStack, Applicative f) => Int -> f a -> f (Seq a)
+#else
 replicateA :: Applicative f => Int -> f a -> f (Seq a)
+#endif
 replicateA n x
   | n >= 0      = Seq <$> applicativeTree n 1 (Elem <$> x)
   | otherwise   = error "replicateA takes a nonnegative integer argument"
@@ -1246,7 +1262,11 @@ replicateA n x
 -- For @base >= 4.8.0@ and @containers >= 0.5.11@, 'replicateM'
 -- is a synonym for 'replicateA'.
 #if MIN_VERSION_base(4,8,0)
+#if __GLASGOW_HASKELL__ >= 800
+replicateM :: (HasCallStack, Applicative m) => Int -> m a -> m (Seq a)
+#else
 replicateM :: Applicative m => Int -> m a -> m (Seq a)
+#endif
 replicateM = replicateA
 #else
 replicateM :: Monad m => Int -> m a -> m (Seq a)
@@ -1266,7 +1286,11 @@ replicateM n x
 -- @replicate k () *> xs@.
 --
 -- @since 0.5.8
+#if __GLASGOW_HASKELL__ >= 800
+cycleTaking :: HasCallStack => Int -> Seq a -> Seq a
+#else
 cycleTaking :: Int -> Seq a -> Seq a
+#endif
 cycleTaking n !_xs | n <= 0 = empty
 cycleTaking _n xs  | null xs = error "cycleTaking cannot take a positive number of elements from an empty cycle."
 cycleTaking n xs = cycleNTimes reps xs >< take final xs
@@ -1677,7 +1701,11 @@ unfoldl f = unfoldl' empty
 -- to a seed value.
 --
 -- > iterateN n f x = fromList (Prelude.take n (Prelude.iterate f x))
+#if __GLASGOW_HASKELL__ >= 800
+iterateN :: HasCallStack => Int -> (a -> a) -> a -> Seq a
+#else
 iterateN :: Int -> (a -> a) -> a -> Seq a
+#endif
 iterateN n f x
   | n >= 0      = replicateA n (State (\ y -> (f y, y))) `execState` x
   | otherwise   = error "iterateN takes a nonnegative integer argument"
@@ -1858,7 +1886,11 @@ scanl f z0 xs = z0 <| snd (mapAccumL (\ x z -> let x' = f x z in (x', x')) z0 xs
 -- | 'scanl1' is a variant of 'scanl' that has no starting value argument:
 --
 -- > scanl1 f (fromList [x1, x2, ...]) = fromList [x1, x1 `f` x2, ...]
+#if __GLASGOW_HASKELL__ >= 800
+scanl1 :: HasCallStack => (a -> a -> a) -> Seq a -> Seq a
+#else
 scanl1 :: (a -> a -> a) -> Seq a -> Seq a
+#endif
 scanl1 f xs = case viewl xs of
     EmptyL          -> error "scanl1 takes a nonempty sequence as an argument"
     x :< xs'        -> scanl f x xs'
@@ -1868,7 +1900,11 @@ scanr :: (a -> b -> b) -> b -> Seq a -> Seq b
 scanr f z0 xs = snd (mapAccumR (\ z x -> let z' = f x z in (z', z')) z0 xs) |> z0
 
 -- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
+#if __GLASGOW_HASKELL__ >= 800
+scanr1 :: HasCallStack => (a -> a -> a) -> Seq a -> Seq a
+#else
 scanr1 :: (a -> a -> a) -> Seq a -> Seq a
+#endif
 scanr1 f xs = case viewr xs of
     EmptyR          -> error "scanr1 takes a nonempty sequence as an argument"
     xs' :> x        -> scanr f x xs'
@@ -1886,7 +1922,11 @@ scanr1 f xs = case viewr xs of
 -- element until the result is forced. It can therefore lead to a space
 -- leak if the result is stored, unforced, in another structure. To retrieve
 -- an element immediately without forcing it, use 'lookup' or '(!?)'.
+#if __GLASGOW_HASKELL__ >= 800
+index           :: HasCallStack => Seq a -> Int -> a
+#else
 index           :: Seq a -> Int -> a
+#endif
 index (Seq xs) i
   -- See note on unsigned arithmetic in splitAt
   | fromIntegral i < (fromIntegral (size xs) :: Word) = case lookupTree i xs of
@@ -2852,7 +2892,11 @@ valid.
 -- sequence into a sequence.
 --
 -- @since 0.5.6.2
+#if __GLASGOW_HASKELL__ >= 800
+fromFunction :: HasCallStack => Int -> (Int -> a) -> Seq a
+#else
 fromFunction :: Int -> (Int -> a) -> Seq a
+#endif
 fromFunction len f | len < 0 = error "Data.Sequence.fromFunction called with negative len"
                    | len == 0 = empty
                    | otherwise = Seq $ create (lift_elem f) 1 0 len
@@ -3430,7 +3474,11 @@ splitSuffixN i s pr m (Four a b c d)
 -- \( O \Bigl( \bigl(\frac{n}{c} - 1\bigr) (\log (c + 1)) + 1 \Bigr) \)
 --
 -- @since 0.5.8
+#if __GLASGOW_HASKELL__ >= 800
+chunksOf :: HasCallStack => Int -> Seq a -> Seq (Seq a)
+#else
 chunksOf :: Int -> Seq a -> Seq (Seq a)
+#endif
 chunksOf n xs | n <= 0 =
   if null xs
     then empty
diff --git a/Data/Set/Internal.hs b/Data/Set/Internal.hs
index c000392a6..38adc77d4 100644
--- a/Data/Set/Internal.hs
+++ b/Data/Set/Internal.hs
@@ -259,6 +259,10 @@ import Text.Read ( readPrec, Read (..), Lexeme (..), parens, prec
 import Data.Data
 #endif
 
+#if __GLASGOW_HASKELL__ >= 800
+import GHC.Stack (HasCallStack)
+#endif
+
 
 {--------------------------------------------------------------------
   Operators
@@ -644,7 +648,11 @@ lookupMin Tip = Nothing
 lookupMin (Bin _ x l _) = Just $! lookupMinSure x l
 
 -- | /O(log n)/. The minimal element of a set.
+#if MIN_VERSION_base(4,9,0)
+findMin :: HasCallStack => Set a -> a
+#else
 findMin :: Set a -> a
+#endif
 findMin t
   | Just r <- lookupMin t = r
   | otherwise = error "Set.findMin: empty set has no minimal element"
@@ -662,7 +670,11 @@ lookupMax Tip = Nothing
 lookupMax (Bin _ x _ r) = Just $! lookupMaxSure x r
 
 -- | /O(log n)/. The maximal element of a set.
+#if __GLASGOW_HASKELL__ >= 800
+findMax :: HasCallStack => Set a -> a
+#else
 findMax :: Set a -> a
+#endif
 findMax t
   | Just r <- lookupMax t = r
   | otherwise = error "Set.findMax: empty set has no maximal element"
@@ -1188,7 +1200,11 @@ splitMember x (Bin _ y l r)
 -- @since 0.5.4
 
 -- See Note: Type of local 'go' function
+#if __GLASGOW_HASKELL__ >= 800
+findIndex :: (HasCallStack, Ord a) => a -> Set a -> Int
+#else
 findIndex :: Ord a => a -> Set a -> Int
+#endif
 findIndex = go 0
   where
     go :: Ord a => Int -> a -> Set a -> Int
@@ -1236,6 +1252,18 @@ lookupIndex = go 0
 --
 -- @since 0.5.4
 
+#if __GLASGOW_HASKELL__ >= 800
+elemAt :: HasCallStack => Int -> Set a -> a
+elemAt = go where
+  go !_ Tip = error "Set.elemAt: index out of range"
+  go i (Bin _ x l r)
+    = case compare i sizeL of
+        LT -> go i l
+        GT -> go (i-sizeL-1) r
+        EQ -> x
+    where
+      sizeL = size l
+#else
 elemAt :: Int -> Set a -> a
 elemAt !_ Tip = error "Set.elemAt: index out of range"
 elemAt i (Bin _ x l r)
@@ -1245,6 +1273,7 @@ elemAt i (Bin _ x l r)
       EQ -> x
   where
     sizeL = size l
+#endif
 
 -- | /O(log n)/. Delete the element at /index/, i.e. by its zero-based index in
 -- the sorted sequence of elements. If the /index/ is out of range (less than zero,
@@ -1257,6 +1286,19 @@ elemAt i (Bin _ x l r)
 --
 -- @since 0.5.4
 
+#if __GLASGOW_HASKELL__ >= 800
+deleteAt :: HasCallStack => Int -> Set a -> Set a
+deleteAt = go where
+  go !i t =
+    case t of
+      Tip -> error "Set.deleteAt: index out of range"
+      Bin _ x l r -> case compare i sizeL of
+        LT -> balanceR x (go i l) r
+        GT -> balanceL x l (go (i-sizeL-1) r)
+        EQ -> glue l r
+        where
+          sizeL = size l
+#else
 deleteAt :: Int -> Set a -> Set a
 deleteAt !i t =
   case t of
@@ -1267,6 +1309,7 @@ deleteAt !i t =
       EQ -> glue l r
       where
         sizeL = size l
+#endif
 
 -- | Take a given number of elements in order, beginning
 -- with the smallest ones.
@@ -1464,7 +1507,11 @@ glue l@(Bin sl xl ll lr) r@(Bin sr xr rl rr)
 --
 -- > deleteFindMin set = (findMin set, deleteMin set)
 
+#if __GLASGOW_HASKELL__ >= 800
+deleteFindMin :: HasCallStack => Set a -> (a,Set a)
+#else
 deleteFindMin :: Set a -> (a,Set a)
+#endif
 deleteFindMin t
   | Just r <- minView t = r
   | otherwise = (error "Set.deleteFindMin: can not return the minimal element of an empty set", Tip)
@@ -1472,7 +1519,11 @@ deleteFindMin t
 -- | /O(log n)/. Delete and find the maximal element.
 --
 -- > deleteFindMax set = (findMax set, deleteMax set)
+#if __GLASGOW_HASKELL__ >= 800
+deleteFindMax :: HasCallStack => Set a -> (a,Set a)
+#else
 deleteFindMax :: Set a -> (a,Set a)
+#endif
 deleteFindMax t
   | Just r <- maxView t = r
   | otherwise = (error "Set.deleteFindMax: can not return the maximal element of an empty set", Tip)