diff options
author | Oleg Grenrus <oleg.grenrus@iki.fi> | 2021-05-26 05:03:52 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-12-12 12:52:18 -0500 |
commit | 31bf380f3925d72a3369978d28d02aaae31f75ef (patch) | |
tree | 38afd6818f3f4661c7ec2f560bd249b3408e021a | |
parent | 93783e6a8765e1410d0a14fd5249a995c6759308 (diff) | |
download | haskell-31bf380f3925d72a3369978d28d02aaae31f75ef.tar.gz |
Use HasCallStack and error in GHC.List and .NonEmpty
In addition to providing stack traces, the scary HasCallStack will
hopefully make people think whether they want to use these functions,
i.e. act as a documentation hint that something weird might happen.
A single metric increased, which doesn't visibly
use any method with `HasCallStack`.
-------------------------
Metric Decrease:
T9630
Metric Decrease:
T19695
T9630
-------------------------
-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’)) |