diff options
| -rw-r--r-- | libraries/base/Data/List/NonEmpty.hs | 9 | ||||
| -rw-r--r-- | libraries/base/GHC/Err.hs | 16 | ||||
| -rw-r--r-- | libraries/base/GHC/List.hs | 41 | ||||
| -rw-r--r-- | libraries/base/changelog.md | 4 | ||||
| -rw-r--r-- | testsuite/tests/ghci.debugger/scripts/break009.stdout | 5 | ||||
| -rw-r--r-- | testsuite/tests/ghci.debugger/scripts/print027.stdout | 4 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/T10501.stderr | 5 | ||||
| -rw-r--r-- | testsuite/tests/plugins/test-hole-plugin.stderr | 8 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T20103.stderr | 76 | ||||
| -rw-r--r-- | testsuite/tests/th/TH_exn2.stderr | 4 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr | 28 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr | 12 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/holes.stderr | 12 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/holes3.stderr | 12 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr | 20 |
15 files changed, 170 insertions, 86 deletions
diff --git a/libraries/base/Data/List/NonEmpty.hs b/libraries/base/Data/List/NonEmpty.hs index 84e909a25a..c2689ce662 100644 --- a/libraries/base/Data/List/NonEmpty.hs +++ b/libraries/base/Data/List/NonEmpty.hs @@ -110,6 +110,7 @@ import Data.Function (on) import qualified Data.List as List import Data.Ord (comparing) import GHC.Base (NonEmpty(..)) +import GHC.Stack.Types (HasCallStack) infixr 5 <| @@ -194,9 +195,9 @@ sort = lift List.sort -- | Converts a normal list to a 'NonEmpty' stream. -- -- Raises an error if given an empty list. -fromList :: [a] -> NonEmpty a +fromList :: HasCallStack => [a] -> NonEmpty a fromList (a:as) = a :| as -fromList [] = errorWithoutStackTrace "NonEmpty.fromList: empty list" +fromList [] = error "NonEmpty.fromList: empty list" -- | Convert a stream to a normal list efficiently. toList :: NonEmpty a -> [a] @@ -401,11 +402,11 @@ isPrefixOf (y:ys) (x :| xs) = (y == x) && List.isPrefixOf ys xs -- @n@. Note that the head of the stream has index 0. -- -- /Beware/: a negative or out-of-bounds index will cause an error. -(!!) :: NonEmpty a -> Int -> a +(!!) :: HasCallStack => NonEmpty a -> Int -> a (!!) ~(x :| xs) n | n == 0 = x | n > 0 = xs List.!! (n - 1) - | otherwise = errorWithoutStackTrace "NonEmpty.!! negative argument" + | otherwise = error "NonEmpty.!! negative index" infixl 9 !! -- | The 'zip' function takes two streams and returns a stream of diff --git a/libraries/base/GHC/Err.hs b/libraries/base/GHC/Err.hs index 07d263bf7d..c3e21eeee2 100644 --- a/libraries/base/GHC/Err.hs +++ b/libraries/base/GHC/Err.hs @@ -54,16 +54,12 @@ errorWithoutStackTrace s = raise# (errorCallException s) -- a partial stack trace, containing the call-site of each function -- with a HasCallStack constraint. -- --- In base, however, the only functions that have such constraints are --- error and undefined, so the stack traces from partial functions in --- base will never contain a call-site in user code. Instead we'll --- usually just get the actual call to error. Base functions already --- have a good habit of providing detailed error messages, including the --- name of the offending partial function, so the partial stack-trace --- does not provide any extra information, just noise. Thus, we export --- the callstack-aware error, but within base we use the --- errorWithoutStackTrace variant for more hygienic error messages. - +-- In base, error and undefined were the only functions that had such +-- constraint. Errors like "Prelude.!!: negative index" are good, yet if the +-- code base contains dozens of !! applications (including dependencies, +-- which code is not as easily accessible), pinpointing the bad call is +-- where the stack trace would help. Therefore we annotate most calls to +-- error, so users have a chance to get a better idea. -- | A special case of 'error'. -- It is expected that compilers will recognize this and insert error 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." diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 52f6a56d0c..6c9bd23184 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -29,6 +29,10 @@ * `GHC.Exts` now re-exports `Multiplicity` and `MultMul`. + * A large number of partial functions in `Data.List` and `Data.List.NonEmpty` now + have an HasCallStack constraint. Hopefully providing better error messages in case + they are used in unexpected ways. + ## 4.16.0.0 *Nov 2021* * The unary tuple type, `Solo`, is now exported by `Data.Tuple`. diff --git a/testsuite/tests/ghci.debugger/scripts/break009.stdout b/testsuite/tests/ghci.debugger/scripts/break009.stdout index ab09ffa7c1..277fd16bac 100644 --- a/testsuite/tests/ghci.debugger/scripts/break009.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break009.stdout @@ -2,3 +2,8 @@ Breakpoint 0 activated at Test6.hs:5:8-11 Stopped in Main.main, Test6.hs:5:8-11 _result :: a = _ *** Exception: Prelude.head: empty list +CallStack (from HasCallStack): + error, called at libraries/base/GHC/List.hs:1590:3 in base:GHC.List + errorEmptyList, called at libraries/base/GHC/List.hs:74:11 in base:GHC.List + badHead, called at libraries/base/GHC/List.hs:70:28 in base:GHC.List + head, called at Test6.hs:1:8 in main:Main diff --git a/testsuite/tests/ghci.debugger/scripts/print027.stdout b/testsuite/tests/ghci.debugger/scripts/print027.stdout index 9426ba8365..c0e9e3712d 100644 --- a/testsuite/tests/ghci.debugger/scripts/print027.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print027.stdout @@ -1,6 +1,6 @@ + = (_t1::Num a => a -> a -> a) print = (_t2::Show a => a -> IO ()) log = (_t3::Floating a => a -> a) -head = (_t4::[a] -> a) -tail = (_t5::[a] -> [a]) +head = (_t4::GHC.Stack.Types.HasCallStack => [a] -> a) +tail = (_t5::GHC.Stack.Types.HasCallStack => [a] -> [a]) fst = (_t6::(a, b) -> a) diff --git a/testsuite/tests/ghci/scripts/T10501.stderr b/testsuite/tests/ghci/scripts/T10501.stderr index 669b72bf45..9d41d0f211 100644 --- a/testsuite/tests/ghci/scripts/T10501.stderr +++ b/testsuite/tests/ghci/scripts/T10501.stderr @@ -1,4 +1,9 @@ *** Exception: Prelude.head: empty list +CallStack (from HasCallStack): + error, called at libraries/base/GHC/List.hs:1590:3 in base:GHC.List + errorEmptyList, called at libraries/base/GHC/List.hs:74:11 in base:GHC.List + badHead, called at libraries/base/GHC/List.hs:70:28 in base:GHC.List + head, called at <interactive>:1:10 in interactive:Ghci1 *** Exception: Prelude.undefined CallStack (from HasCallStack): undefined, called at <interactive>:1:17 in interactive:Ghci1 diff --git a/testsuite/tests/plugins/test-hole-plugin.stderr b/testsuite/tests/plugins/test-hole-plugin.stderr index 109736fa78..9e9b01b726 100644 --- a/testsuite/tests/plugins/test-hole-plugin.stderr +++ b/testsuite/tests/plugins/test-hole-plugin.stderr @@ -19,7 +19,7 @@ test-hole-plugin.hs:13:5: warning: [-Wtyped-holes (in -Wdefault)] i :: [Int] -> Int g :: [Int] -> Int h :: [Int] -> Int - head :: forall a. [a] -> a + head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits) test-hole-plugin.hs:14:5: warning: [-Wtyped-holes (in -Wdefault)] @@ -34,7 +34,7 @@ test-hole-plugin.hs:14:5: warning: [-Wtyped-holes (in -Wdefault)] minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a length :: forall (t :: * -> *) a. Foldable t => t a -> Int - last :: forall a. [a] -> a + last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits) test-hole-plugin.hs:15:5: warning: [-Wtyped-holes (in -Wdefault)] @@ -44,8 +44,8 @@ test-hole-plugin.hs:15:5: warning: [-Wtyped-holes (in -Wdefault)] • Relevant bindings include g :: [Int] -> Int (bound at test-hole-plugin.hs:15:1) Valid hole fits include - head :: forall a. [a] -> a - last :: forall a. [a] -> a + head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a + last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a test-hole-plugin.hs:16:5: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _only_Prelude :: [Int] -> Int diff --git a/testsuite/tests/simplCore/should_compile/T20103.stderr b/testsuite/tests/simplCore/should_compile/T20103.stderr index 251a3e60fa..485d2d4617 100644 --- a/testsuite/tests/simplCore/should_compile/T20103.stderr +++ b/testsuite/tests/simplCore/should_compile/T20103.stderr @@ -1,22 +1,22 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 98, types: 59, coercions: 14, joins: 0/0} + = {terms: 136, types: 88, coercions: 25, joins: 0/0} -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} lvl :: Int [GblId, Unf=OtherCon []] -lvl = GHC.Types.I# 12# +lvl = GHC.Types.I# 28# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} lvl1 :: Int [GblId, Unf=OtherCon []] -lvl1 = GHC.Types.I# 7# +lvl1 = GHC.Types.I# 6# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} lvl2 :: Int [GblId, Unf=OtherCon []] -lvl2 = GHC.Types.I# 9# +lvl2 = GHC.Types.I# 24# -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} lvl3 :: GHC.Prim.Addr# @@ -60,18 +60,60 @@ lvl7 = GHC.Stack.Types.SrcLoc lvl6 lvl5 lvl4 lvl1 lvl2 lvl1 lvl -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} lvl8 :: GHC.Prim.Addr# [GblId, Unf=OtherCon []] -lvl8 = "foo"# +lvl8 = "head"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} lvl9 :: [Char] [GblId] lvl9 = GHC.CString.unpackCString# lvl8 +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl10 :: Int +[GblId, Unf=OtherCon []] +lvl10 = GHC.Types.I# 12# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl11 :: Int +[GblId, Unf=OtherCon []] +lvl11 = GHC.Types.I# 7# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl12 :: Int +[GblId, Unf=OtherCon []] +lvl12 = GHC.Types.I# 9# + +-- RHS size: {terms: 8, types: 0, coercions: 0, joins: 0/0} +lvl13 :: SrcLoc +[GblId, Unf=OtherCon []] +lvl13 + = GHC.Stack.Types.SrcLoc lvl6 lvl5 lvl4 lvl11 lvl12 lvl11 lvl10 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +lvl14 :: GHC.Prim.Addr# +[GblId, Unf=OtherCon []] +lvl14 = "foo"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl15 :: [Char] +[GblId] +lvl15 = GHC.CString.unpackCString# lvl14 + +-- RHS size: {terms: 6, types: 5, coercions: 4, joins: 0/0} +lvl16 :: CallStack -> ([Char], SrcLoc) +[GblId, Arity=1, Str=<S>b, Cpr=b, Unf=OtherCon []] +lvl16 + = \ (wild1 :: CallStack) -> + GHC.List.head1 + @([Char], SrcLoc) + ((GHC.Stack.Types.PushCallStack lvl9 lvl7 wild1) + `cast` (Sym (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N) + :: CallStack ~R# (?callStack::CallStack))) + Rec { --- RHS size: {terms: 36, types: 29, coercions: 14, joins: 0/0} +-- RHS size: {terms: 44, types: 41, coercions: 21, joins: 0/0} T20103.$wfoo [InlPrag=[2], Occ=LoopBreaker] :: HasCallStack => GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Str=<1L><1L>, Unf=OtherCon []] +[GblId, Arity=2, Str=<SL><1L>, Unf=OtherCon []] T20103.$wfoo = \ ($dIP :: HasCallStack) (ww :: GHC.Prim.Int#) -> case ww of ds { @@ -82,7 +124,7 @@ T20103.$wfoo of wild1 { __DEFAULT -> T20103.$wfoo - ((GHC.Stack.Types.PushCallStack lvl9 lvl7 wild1) + ((GHC.Stack.Types.PushCallStack lvl15 lvl13 wild1) `cast` (Sym (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N) :: CallStack ~R# (?callStack::CallStack))) (GHC.Prim.-# ds 1#); @@ -99,7 +141,21 @@ T20103.$wfoo `cast` (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N :: (?callStack::CallStack) ~R# CallStack)) of { - [] -> case GHC.List.badHead of wild1 { }; + [] -> + case $dIP + `cast` (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N + :: (?callStack::CallStack) ~R# CallStack) + of wild1 { + __DEFAULT -> case lvl16 wild1 of wild2 { }; + GHC.Stack.Types.FreezeCallStack ds1 -> + case GHC.List.head1 + @([Char], SrcLoc) + (wild1 + `cast` (Sym (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N) + :: CallStack ~R# (?callStack::CallStack))) + of wild2 { + } + }; : x ds1 -> case x of { (x1, ds2) -> GHC.List.$wlenAcc @Char x1 0# } } } @@ -109,7 +165,7 @@ end Rec } foo [InlPrag=[2]] :: HasCallStack => Int -> Int [GblId, Arity=2, - Str=<1L><1P(1L)>, + Str=<SL><1!P(1L)>, Cpr=1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, diff --git a/testsuite/tests/th/TH_exn2.stderr b/testsuite/tests/th/TH_exn2.stderr index 582928c08b..9d9205056c 100644 --- a/testsuite/tests/th/TH_exn2.stderr +++ b/testsuite/tests/th/TH_exn2.stderr @@ -2,5 +2,9 @@ TH_exn2.hs:1:1: error: Exception when trying to run compile-time code: Prelude.tail: empty list +CallStack (from HasCallStack): + error, called at libraries/base/GHC/List.hs:1590:3 in base:GHC.List + errorEmptyList, called at libraries/base/GHC/List.hs:114:28 in base:GHC.List + tail, called at TH_exn2.hs:10:17 in main:TH Code: (do ds <- [d| |] return (tail ds)) diff --git a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr index 61ed517535..62886f3bf7 100644 --- a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr +++ b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr @@ -8,8 +8,8 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] Valid hole fits include f :: [Integer] -> Integer g :: [Integer] -> Integer - head :: forall a. [a] -> a - last :: forall a. [a] -> a + head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a + last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a @@ -86,9 +86,9 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] id (_ :: t0 -> [Integer] -> Integer) (_ :: t0) where id :: forall a. a -> a head (_ :: [t0 -> [Integer] -> Integer]) (_ :: t0) - where head :: forall a. [a] -> a + where head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a last (_ :: [t0 -> [Integer] -> Integer]) (_ :: t0) - where last :: forall a. [a] -> a + where last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a fst (_ :: (t0 -> [Integer] -> Integer, b2)) (_ :: t0) where fst :: forall a b. (a, b) -> a snd (_ :: (a2, t0 -> [Integer] -> Integer)) (_ :: t0) @@ -96,13 +96,15 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] id (_ :: [Integer] -> Integer) where id :: forall a. a -> a head (_ :: [[Integer] -> Integer]) - where head :: forall a. [a] -> a + where head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a last (_ :: [[Integer] -> Integer]) - where last :: forall a. [a] -> a + where last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a asTypeOf (_ :: [Integer] -> Integer) (_ :: [Integer] -> Integer) where asTypeOf :: forall a. a -> a -> a (!!) (_ :: [[Integer] -> Integer]) (_ :: Int) - where (!!) :: forall a. [a] -> Int -> a + where (!!) :: forall a. + GHC.Stack.Types.HasCallStack => + [a] -> Int -> a fst (_ :: ([Integer] -> Integer, b0)) where fst :: forall a b. (a, b) -> a snd (_ :: (a0, [Integer] -> Integer)) @@ -204,9 +206,9 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] id (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0) where id :: forall a. a -> a head (_ :: [t0 -> Integer -> [Integer] -> Integer]) (_ :: t0) - where head :: forall a. [a] -> a + where head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a last (_ :: [t0 -> Integer -> [Integer] -> Integer]) (_ :: t0) - where last :: forall a. [a] -> a + where last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a fst (_ :: (t0 -> Integer -> [Integer] -> Integer, b2)) (_ :: t0) where fst :: forall a b. (a, b) -> a snd (_ :: (a2, t0 -> Integer -> [Integer] -> Integer)) (_ :: t0) @@ -214,14 +216,16 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] id (_ :: Integer -> [Integer] -> Integer) where id :: forall a. a -> a head (_ :: [Integer -> [Integer] -> Integer]) - where head :: forall a. [a] -> a + where head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a last (_ :: [Integer -> [Integer] -> Integer]) - where last :: forall a. [a] -> a + where last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a asTypeOf (_ :: Integer -> [Integer] -> Integer) (_ :: Integer -> [Integer] -> Integer) where asTypeOf :: forall a. a -> a -> a (!!) (_ :: [Integer -> [Integer] -> Integer]) (_ :: Int) - where (!!) :: forall a. [a] -> Int -> a + where (!!) :: forall a. + GHC.Stack.Types.HasCallStack => + [a] -> Int -> a fst (_ :: (Integer -> [Integer] -> Integer, b0)) where fst :: forall a b. (a, b) -> a snd (_ :: (a0, Integer -> [Integer] -> Integer)) diff --git a/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr index 3cc66588f0..5696a16781 100644 --- a/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr +++ b/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr @@ -11,8 +11,8 @@ constraint_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] Constraints include Ord a (from constraint_hole_fits.hs:3:1-22) Valid hole fits include g :: [a] -> a - head :: forall a. [a] -> a - last :: forall a. [a] -> a + head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a + last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a Valid refinement hole fits include @@ -45,10 +45,12 @@ constraint_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] id (_ :: [a] -> a) where id :: forall a. a -> a head (_ :: [[a] -> a]) - where head :: forall a. [a] -> a + where head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a last (_ :: [[a] -> a]) - where last :: forall a. [a] -> a + where last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a asTypeOf (_ :: [a] -> a) (_ :: [a] -> a) where asTypeOf :: forall a. a -> a -> a (!!) (_ :: [[a] -> a]) (_ :: Int) - where (!!) :: forall a. [a] -> Int -> a + where (!!) :: forall a. + GHC.Stack.Types.HasCallStack => + [a] -> Int -> a diff --git a/testsuite/tests/typecheck/should_compile/holes.stderr b/testsuite/tests/typecheck/should_compile/holes.stderr index 1e19fa85ba..cde126e969 100644 --- a/testsuite/tests/typecheck/should_compile/holes.stderr +++ b/testsuite/tests/typecheck/should_compile/holes.stderr @@ -95,15 +95,15 @@ holes.hs:11:15: warning: [-Wtyped-holes (in -Wdefault)] id :: forall a. a -> a until :: forall a. (a -> Bool) -> (a -> a) -> a -> a ioError :: forall a. IOError -> IO a - (!!) :: forall a. [a] -> Int -> a + (!!) :: forall a. GHC.Stack.Types.HasCallStack => [a] -> Int -> a break :: forall a. (a -> Bool) -> [a] -> ([a], [a]) - cycle :: forall a. [a] -> [a] + cycle :: forall a. GHC.Stack.Types.HasCallStack => [a] -> [a] drop :: forall a. Int -> [a] -> [a] dropWhile :: forall a. (a -> Bool) -> [a] -> [a] - head :: forall a. [a] -> a - init :: forall a. [a] -> [a] + head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a + init :: forall a. GHC.Stack.Types.HasCallStack => [a] -> [a] iterate :: forall a. (a -> a) -> a -> [a] - last :: forall a. [a] -> a + last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a repeat :: forall a. a -> [a] replicate :: forall a. Int -> a -> [a] reverse :: forall a. [a] -> [a] @@ -111,7 +111,7 @@ holes.hs:11:15: warning: [-Wtyped-holes (in -Wdefault)] scanr1 :: forall a. (a -> a -> a) -> [a] -> [a] span :: forall a. (a -> Bool) -> [a] -> ([a], [a]) splitAt :: forall a. Int -> [a] -> ([a], [a]) - tail :: forall a. [a] -> [a] + tail :: forall a. GHC.Stack.Types.HasCallStack => [a] -> [a] take :: forall a. Int -> [a] -> [a] takeWhile :: forall a. (a -> Bool) -> [a] -> [a] subtract :: forall a. Num a => a -> a -> a diff --git a/testsuite/tests/typecheck/should_compile/holes3.stderr b/testsuite/tests/typecheck/should_compile/holes3.stderr index 448f89009e..4dec2c57a5 100644 --- a/testsuite/tests/typecheck/should_compile/holes3.stderr +++ b/testsuite/tests/typecheck/should_compile/holes3.stderr @@ -98,15 +98,15 @@ holes3.hs:11:15: error: id :: forall a. a -> a until :: forall a. (a -> Bool) -> (a -> a) -> a -> a ioError :: forall a. IOError -> IO a - (!!) :: forall a. [a] -> Int -> a + (!!) :: forall a. GHC.Stack.Types.HasCallStack => [a] -> Int -> a break :: forall a. (a -> Bool) -> [a] -> ([a], [a]) - cycle :: forall a. [a] -> [a] + cycle :: forall a. GHC.Stack.Types.HasCallStack => [a] -> [a] drop :: forall a. Int -> [a] -> [a] dropWhile :: forall a. (a -> Bool) -> [a] -> [a] - head :: forall a. [a] -> a - init :: forall a. [a] -> [a] + head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a + init :: forall a. GHC.Stack.Types.HasCallStack => [a] -> [a] iterate :: forall a. (a -> a) -> a -> [a] - last :: forall a. [a] -> a + last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a repeat :: forall a. a -> [a] replicate :: forall a. Int -> a -> [a] reverse :: forall a. [a] -> [a] @@ -114,7 +114,7 @@ holes3.hs:11:15: error: scanr1 :: forall a. (a -> a -> a) -> [a] -> [a] span :: forall a. (a -> Bool) -> [a] -> ([a], [a]) splitAt :: forall a. Int -> [a] -> ([a], [a]) - tail :: forall a. [a] -> [a] + tail :: forall a. GHC.Stack.Types.HasCallStack => [a] -> [a] take :: forall a. Int -> [a] -> [a] takeWhile :: forall a. (a -> Bool) -> [a] -> [a] subtract :: forall a. Num a => a -> a -> a diff --git a/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr index 80249908b8..6084e6aa0f 100644 --- a/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr +++ b/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr @@ -7,11 +7,11 @@ refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] Valid hole fits include f :: [Integer] -> Integer (bound at refinement_hole_fits.hs:4:1) g :: [Integer] -> Integer (bound at refinement_hole_fits.hs:7:1) - head :: forall a. [a] -> a + head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a with head @Integer (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 (and originally defined in ‘GHC.List’)) - last :: forall a. [a] -> a + last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a with last @Integer (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 (and originally defined in ‘GHC.List’)) @@ -95,12 +95,12 @@ refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 (and originally defined in ‘GHC.Base’)) head (_ :: [[Integer] -> Integer]) - where head :: forall a. [a] -> a + where head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a with head @([Integer] -> Integer) (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 (and originally defined in ‘GHC.List’)) last (_ :: [[Integer] -> Integer]) - where last :: forall a. [a] -> a + where last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a with last @([Integer] -> Integer) (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 (and originally defined in ‘GHC.List’)) @@ -110,7 +110,9 @@ refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 (and originally defined in ‘GHC.Base’)) (!!) (_ :: [[Integer] -> Integer]) (_ :: Int) - where (!!) :: forall a. [a] -> Int -> a + where (!!) :: forall a. + GHC.Stack.Types.HasCallStack => + [a] -> Int -> a with (!!) @([Integer] -> Integer) (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 (and originally defined in ‘GHC.List’)) @@ -194,12 +196,12 @@ refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 (and originally defined in ‘GHC.Base’)) head (_ :: [Integer -> [Integer] -> Integer]) - where head :: forall a. [a] -> a + where head :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a with head @(Integer -> [Integer] -> Integer) (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 (and originally defined in ‘GHC.List’)) last (_ :: [Integer -> [Integer] -> Integer]) - where last :: forall a. [a] -> a + where last :: forall a. GHC.Stack.Types.HasCallStack => [a] -> a with last @(Integer -> [Integer] -> Integer) (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 (and originally defined in ‘GHC.List’)) @@ -210,7 +212,9 @@ refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 (and originally defined in ‘GHC.Base’)) (!!) (_ :: [Integer -> [Integer] -> Integer]) (_ :: Int) - where (!!) :: forall a. [a] -> Int -> a + where (!!) :: forall a. + GHC.Stack.Types.HasCallStack => + [a] -> Int -> a with (!!) @(Integer -> [Integer] -> Integer) (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 (and originally defined in ‘GHC.List’)) |