HEAD-only Core Lint error with bifunctors-5.5.7 (Type of case alternatives not the same as the annotation on case)
Originally observed on a head.hackage
build here.
The following code, reduced from the bifunctors-5.5.7
library, will produce a Core Lint error when compiled with HEAD
+ -O
:
module Bug where
f :: p b d -> (a -> b) -> (c -> d) -> p a c -> p b d
f = const . const . const
{-# INLINE f #-}
$ ~/Software/ghc5/inplace/bin/ghc-stage2 -O -fforce-recomp -dcore-lint Bug.hs
[1 of 1] Compiling Bug ( Bug.hs, Bug.o )
*** Core Lint errors : in result of Simplifier ***
Bug.hs:3:1: warning:
The type of this binder doesn't match the type of its RHS: x_av5
Binder's type: (c_agU -> d_agS)
-> p_agQ a_agT c_agU -> p_agQ b_agR d_agS
Rhs type: (c_agU -> d_agS)
-> (c_agU -> d_agS) -> p_agQ a_agT c_agU -> p_agQ b_agR d_agS
In the RHS of f :: forall (p :: * -> * -> *) b d a c.
p b d -> (a -> b) -> (c -> d) -> p a c -> p b d
In the unfolding of f :: forall (p :: * -> * -> *) b d a c.
p b d -> (a -> b) -> (c -> d) -> p a c -> p b d
In the body of lambda with binder p_agQ :: * -> * -> *
In the body of lambda with binder b_agR :: *
In the body of lambda with binder d_agS :: *
In the body of lambda with binder a_agT :: *
In the body of lambda with binder c_agU :: *
In the body of lambda with binder x_av2 :: p_agQ b_agR d_agS
In the body of lambda with binder eta_B3 :: a_agT -> b_agR
In the body of lambda with binder eta_B2 :: c_agU -> d_agS
In the body of lambda with binder eta_B1 :: p_agQ a_agT c_agU
In the body of letrec with binders x_X2 :: p_agQ a_agT c_agU
-> p_agQ b_agR d_agS
Substitution: [TCvSubst
In scope: InScope {p_agQ b_agR d_agS a_agT c_agU}
Type env: [agQ :-> p_agQ, agR :-> b_agR, agS :-> d_agS,
agT :-> a_agT, agU :-> c_agU]
Co env: []]
*** Offending Program ***
g_sv8
:: forall {d} {b} {p :: * -> * -> *} {c} {a}.
p b d -> (c -> d) -> p a c -> p b d
[LclId,
Arity=3,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=True)}]
g_sv8
= \ (@d_agS)
(@b_agR)
(@(p_agQ :: * -> * -> *))
(@c_agU)
(@a_agT)
(x_X1 :: p_agQ b_agR d_agS)
(eta_B2 :: c_agU -> d_agS)
(eta_B1 :: p_agQ a_agT c_agU) ->
let {
x_av5 :: p_agQ a_agT c_agU -> p_agQ b_agR d_agS
[LclId, Arity=1]
x_av5 = \ _ [Occ=Dead] -> x_X1 } in
x_av5 eta_B1
f [InlPrag=INLINE (sat-args=0)]
:: forall (p :: * -> * -> *) b d a c.
p b d -> (a -> b) -> (c -> d) -> p a c -> p b d
[LclIdX,
Arity=4,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)
Tmpl= \ (@(p_agQ :: * -> * -> *))
(@b_agR)
(@d_agS)
(@a_agT)
(@c_agU)
(x_av2 [Occ=OnceL] :: p_agQ b_agR d_agS)
_ [Occ=Dead]
(eta_B2 [Occ=Once] :: c_agU -> d_agS)
(eta_B1 [Occ=Once] :: p_agQ a_agT c_agU) ->
let {
x_X2 [Occ=Once] :: p_agQ a_agT c_agU -> p_agQ b_agR d_agS
[LclId, Arity=1]
x_X2 = \ _ [Occ=Dead] -> x_av2 } in
let {
x_av5 [Occ=Once!T[2]]
:: (c_agU -> d_agS) -> p_agQ a_agT c_agU -> p_agQ b_agR d_agS
[LclId, Arity=2]
x_av5 = \ _ [Occ=Dead, OS=OneShot] -> x_X2 } in
x_av5 eta_B2 eta_B1}]
f = \ (@(p_agQ :: * -> * -> *))
(@b_agR)
(@d_agS)
(@a_agT)
(@c_agU)
(x_X1 :: p_agQ b_agR d_agS)
(eta_B3 :: a_agT -> b_agR)
(eta_B2 :: c_agU -> d_agS)
(eta_B1 :: p_agQ a_agT c_agU) ->
let {
x_av5 :: (c_agU -> d_agS) -> p_agQ a_agT c_agU -> p_agQ b_agR d_agS
[LclId, Arity=2]
x_av5 = \ _ [Occ=Dead] (eta_B1 :: p_agQ a_agT c_agU) -> x_X1 } in
x_av5 eta_B2 eta_B1
$trModule_sv9 :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
$trModule_sv9 = "main"#
$trModule_sva :: TrName
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
$trModule_sva = TrNameS $trModule_sv9
$trModule_svb :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
$trModule_svb = "Bug"#
$trModule_svc :: TrName
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
$trModule_svc = TrNameS $trModule_svb
$trModule :: Module
[LclIdX,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
$trModule = Module $trModule_sva $trModule_svc
*** End of Offense ***
GHC 8.10.1 passes Core Lint.