diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2021-06-01 13:15:29 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2021-06-17 10:04:06 +0100 |
| commit | 228aa3144f1281d8c8f4deef0d4e667211a93bfa (patch) | |
| tree | 315394247a4487042dc1ebf7b14987ce0329a595 | |
| parent | ece22d672317e32f6dddeaadc0a2c2581249f79b (diff) | |
| download | haskell-wip/T19890.tar.gz | |
Improve pretty-printing of coercionswip/T19890
With -dsuppress-coercions, it's still good to be able to see the
type of the coercion. This patch prints the type. Maybe we should
have a flag to control this too.
| -rw-r--r-- | compiler/GHC/Core/Ppr.hs | 2 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T14978.stdout | 2 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T18013.stderr | 30 |
3 files changed, 28 insertions, 6 deletions
diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs index cec4814441..cc3159d646 100644 --- a/compiler/GHC/Core/Ppr.hs +++ b/compiler/GHC/Core/Ppr.hs @@ -169,7 +169,7 @@ noParens pp = pp pprOptCo :: Coercion -> SDoc -- Print a coercion optionally; i.e. honouring -dsuppress-coercions pprOptCo co = sdocOption sdocSuppressCoercions $ \case - True -> angleBrackets (text "Co:" <> int (coercionSize co)) + True -> angleBrackets (text "Co:" <> int (coercionSize co)) <+> dcolon <+> ppr (coercionType co) False -> parens $ sep [ppr co, dcolon <+> ppr (coercionType co)] ppr_id_occ :: (SDoc -> SDoc) -> Id -> SDoc diff --git a/testsuite/tests/simplCore/should_compile/T14978.stdout b/testsuite/tests/simplCore/should_compile/T14978.stdout index 8faf80b1cb..b688da3bd7 100644 --- a/testsuite/tests/simplCore/should_compile/T14978.stdout +++ b/testsuite/tests/simplCore/should_compile/T14978.stdout @@ -1,2 +1,2 @@ foo :: Goof Int -foo = T14978.Goof @Int @~<Co:1> +foo = T14978.Goof @Int @~<Co:1> :: Int GHC.Prim.~# Int diff --git a/testsuite/tests/simplCore/should_compile/T18013.stderr b/testsuite/tests/simplCore/should_compile/T18013.stderr index 70998aecf8..45f9900830 100644 --- a/testsuite/tests/simplCore/should_compile/T18013.stderr +++ b/testsuite/tests/simplCore/should_compile/T18013.stderr @@ -155,14 +155,25 @@ mapMaybeRule [InlPrag=[2]] Nothing -> (# s1, T18013a.Result @s @(Maybe b) ww (GHC.Maybe.Nothing @b) #); Just x [Occ=Once1] -> - case ((ww1 s2 x) `cast` <Co:4>) s1 of + case ((ww1 s2 x) + `cast` <Co:4> :: IO (Result s b) + ~R# (GHC.Prim.State# GHC.Prim.RealWorld + -> (# GHC.Prim.State# GHC.Prim.RealWorld, + Result s b #))) + s1 + of { (# ipv [Occ=Once1], ipv1 [Occ=Once1!] #) -> case ipv1 of { Result t2 [Occ=Once1] c1 [Occ=Once1] -> (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) } } }) - `cast` <Co:13>) + `cast` <Co:13> :: (s + -> Maybe a + -> GHC.Prim.State# GHC.Prim.RealWorld + -> (# GHC.Prim.State# GHC.Prim.RealWorld, + Result s (Maybe b) #)) + ~R# (s -> Maybe a -> IO (Result s (Maybe b)))) }}] mapMaybeRule = \ (@a) (@b) (w :: Rule IO a b) -> @@ -183,13 +194,24 @@ mapMaybeRule case a1 of { Nothing -> (# s1, lvl #); Just x -> - case ((ww1 s2 x) `cast` <Co:4>) s1 of { (# ipv, ipv1 #) -> + case ((ww1 s2 x) + `cast` <Co:4> :: IO (Result s b) + ~R# (GHC.Prim.State# GHC.Prim.RealWorld + -> (# GHC.Prim.State# GHC.Prim.RealWorld, + Result s b #))) + s1 + of + { (# ipv, ipv1 #) -> case ipv1 of { Result t2 c1 -> (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) } } }) - `cast` <Co:13>) + `cast` <Co:13> :: (s + -> Maybe a + -> GHC.Prim.State# GHC.Prim.RealWorld + -> (# GHC.Prim.State# GHC.Prim.RealWorld, Result s (Maybe b) #)) + ~R# (s -> Maybe a -> IO (Result s (Maybe b)))) } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} |