1 files changed, 22 insertions, 19 deletions

diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs
index 3408538568..677d0fe7c1 100644
--- a/libraries/base/GHC/List.hs
+++ b/libraries/base/GHC/List.hs
@@ -42,6 +42,7 @@ import Data.Maybe
 import GHC.Base
 import GHC.Num (Num(..))
 import GHC.Num.Integer (Integer)
+import GHC.Stack.Types (HasCallStack)
 
 infixl 9  !!
 infix  4 `elem`, `notElem`
@@ -72,12 +73,12 @@ infix  4 `elem`, `notElem`
 --
 -- WARNING: This function is partial. You can use case-matching, 'uncons' or
 -- 'listToMaybe' instead.
-head                    :: [a] -> a
+head                    :: HasCallStack => [a] -> a
 head (x:_)              =  x
 head []                 =  badHead
 {-# NOINLINE [1] head #-}
 
-badHead :: a
+badHead :: HasCallStack => a
 badHead = errorEmptyList "head"
 
 -- This rule is useful in cases like
@@ -119,7 +120,7 @@ uncons (x:xs)           = Just (x, xs)
 --
 -- WARNING: This function is partial. You can use case-matching or 'uncons'
 -- instead.
-tail                    :: [a] -> [a]
+tail                    :: HasCallStack => [a] -> [a]
 tail (_:xs)             =  xs
 tail []                 =  errorEmptyList "tail"
 
@@ -135,7 +136,7 @@ tail []                 =  errorEmptyList "tail"
 --
 -- WARNING: This function is partial. You can use 'reverse' with case-matching,
 -- 'uncons' or 'listToMaybe' instead.
-last                    :: [a] -> a
+last                    :: HasCallStack => [a] -> a
 #if defined(USE_REPORT_PRELUDE)
 last [x]                =  x
 last (_:xs)             =  last xs
@@ -148,7 +149,7 @@ last xs = foldl (\_ x -> x) lastError xs
 {-# INLINE last #-}
 -- The inline pragma is required to make GHC remember the implementation via
 -- foldl.
-lastError :: a
+lastError :: HasCallStack => a
 lastError = errorEmptyList "last"
 #endif
 
@@ -164,7 +165,7 @@ lastError = errorEmptyList "last"
 --
 -- WARNING: This function is partial. You can use 'reverse' with case-matching
 -- or 'uncons' instead.
-init                    :: [a] -> [a]
+init                    :: HasCallStack => [a] -> [a]
 #if defined(USE_REPORT_PRELUDE)
 init [x]                =  []
 init (x:xs)             =  x : init xs
@@ -382,12 +383,12 @@ to make the desired list fusion robust.
 -- True
 -- >>> foldl1 (+) [1..]
 -- * Hangs forever *
-foldl1                  :: (a -> a -> a) -> [a] -> a
+foldl1                  :: HasCallStack => (a -> a -> a) -> [a] -> a
 foldl1 f (x:xs)         =  foldl f x xs
 foldl1 _ []             =  errorEmptyList "foldl1"
 
 -- | A strict version of 'foldl1'.
-foldl1'                  :: (a -> a -> a) -> [a] -> a
+foldl1'                  :: HasCallStack => (a -> a -> a) -> [a] -> a
 foldl1' f (x:xs)         =  foldl' f x xs
 foldl1' _ []             =  errorEmptyList "foldl1'"
 
@@ -601,7 +602,7 @@ foldr' f z0 xs = foldl f' id xs z0
 -- True
 -- >>> force $ foldr1 (+) [1..]
 -- *** Exception: stack overflow
-foldr1                  :: (a -> a -> a) -> [a] -> a
+foldr1                  :: HasCallStack => (a -> a -> a) -> [a] -> a
 foldr1 f = go
   where go [x]            =  x
         go (x:xs)         =  f x (go xs)
@@ -707,7 +708,7 @@ scanr1 f (x:xs)         =  f x q : qs
 -- 55
 -- >>> maximum [1..]
 -- * Hangs forever *
-maximum                 :: (Ord a) => [a] -> a
+maximum                 :: (Ord a, HasCallStack) => [a] -> a
 {-# INLINABLE maximum #-}
 maximum []              =  errorEmptyList "maximum"
 maximum xs              =  foldl1' max xs
@@ -731,7 +732,7 @@ maximum xs              =  foldl1' max xs
 -- -89
 -- >>> minimum [1..]
 -- * Hangs forever *
-minimum                 :: (Ord a) => [a] -> a
+minimum                 :: (Ord a, HasCallStack) => [a] -> a
 {-# INLINABLE minimum #-}
 minimum []              =  errorEmptyList "minimum"
 minimum xs              =  foldl1' min xs
@@ -836,7 +837,7 @@ replicate n x           =  take n (repeat x)
 -- [42,42,42,42,42,42,42,42,42,42...
 -- >>> take 20 $ cycle [2, 5, 7]
 -- [2,5,7,2,5,7,2,5,7,2,5,7...
-cycle                   :: [a] -> [a]
+cycle                   :: HasCallStack => [a] -> [a]
 cycle []                = errorEmptyList "cycle"
 cycle xs                = xs' where xs' = xs ++ xs'
 
@@ -1345,23 +1346,25 @@ concat = foldr (++) []
 -- WARNING: This function is partial. You can use <'atMay'
 -- https://hackage.haskell.org/package/safe-0.3.19/docs/Safe.html#v:atMay>
 -- instead.
-(!!)                    :: [a] -> Int -> a
 #if defined(USE_REPORT_PRELUDE)
+(!!)                    :: [a] -> Int -> a
 xs     !! n | n < 0 =  errorWithoutStackTrace "Prelude.!!: negative index"
 []     !! _         =  errorWithoutStackTrace "Prelude.!!: index too large"
 (x:_)  !! 0         =  x
 (_:xs) !! n         =  xs !! (n-1)
+-- Prelude version is without HasCallStack to avoid building linear one
 #else
+(!!)                    :: HasCallStack => [a] -> Int -> a
 
 -- We don't really want the errors to inline with (!!).
 -- We may want to fuss around a bit with NOINLINE, and
 -- if so we should be careful not to trip up known-bottom
 -- optimizations.
-tooLarge :: Int -> a
-tooLarge _ = errorWithoutStackTrace (prel_list_str ++ "!!: index too large")
+tooLarge :: HasCallStack => Int -> a
+tooLarge _ = error (prel_list_str ++ "!!: index too large")
 
-negIndex :: a
-negIndex = errorWithoutStackTrace $ prel_list_str ++ "!!: negative index"
+negIndex :: HasCallStack => a
+negIndex = error $ prel_list_str ++ "!!: negative index"
 
 {-# INLINABLE (!!) #-}
 xs !! n
@@ -1633,9 +1636,9 @@ unzip3   =  foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
 -- Common up near identical calls to `error' to reduce the number
 -- constant strings created when compiled:
 
-errorEmptyList :: String -> a
+errorEmptyList :: HasCallStack => String -> a
 errorEmptyList fun =
-  errorWithoutStackTrace (prel_list_str ++ fun ++ ": empty list")
+  error (prel_list_str ++ fun ++ ": empty list")
 
 prel_list_str :: String
 prel_list_str = "Prelude."