Core Lint error when building reroute-0.6.0.0 on HEAD
(Originally discovered in a head.hackage CI job here.)
The reroute-0.6.0.0 Hackage library fails to build on HEAD when built with -dcore-lint. Here is a minimal example:
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
module Web.Routing.SafeRouting where
import Control.DeepSeq (NFData (..))
import Data.Kind (Constraint)
import Data.Typeable (Typeable)
class FromHttpApiData a where
data PolyMap (c :: * -> Constraint) (f :: * -> *) (a :: *) where
PMNil :: PolyMap c f a
PMCons :: (Typeable p, c p) => f (p -> a) -> PolyMap c f a -> PolyMap c f a
rnfHelper :: (forall p. c p => f (p -> a) -> ()) -> PolyMap c f a -> ()
rnfHelper _ PMNil = ()
rnfHelper h (PMCons v pm) = h v `seq` rnfHelper h pm
data PathMap x =
PathMap [x] (PolyMap FromHttpApiData PathMap x)
instance NFData x => NFData (PathMap x) where
rnf (PathMap a b) = rnf a `seq` rnfHelper rnf bIt will produce this Core Lint error on HEAD:
$ ~/Software/ghc/inplace/bin/ghc-stage2 -dcore-lint Bug1.hs -O -dno-typeable-binds -fforce-recomp
[1 of 1] Compiling Web.Routing.SafeRouting ( Bug1.hs, Bug1.o )
*** Core Lint errors : in result of Specialise ***
Bug1.hs:24:10: warning:
From-type of Cast differs from type of enclosed expression
From-type: NFData x_aT3
Type of enclosed expression: NFData (p_aTl -> x_aT3)
Actual enclosed expression: $dNFData_sUv
Coercion used in cast: N:NFData[0] <x_aT3>_N
In the RHS of $s$crnf_sUw :: forall {p} {x}. PathMap x -> ()
In the body of lambda with binder p_aTl :: *
In the body of lambda with binder x_aT3 :: *
In the body of lambda with binder eta_B0 :: PathMap x_aT3
In the body of letrec with binders $dNFData_sUv :: NFData
(p_aTl -> x_aT3)
In a case alternative: (PathMap a_aHg :: [x_aT3],
b_aHh :: PolyMap FromHttpApiData PathMap x_aT3)
Substitution: [TCvSubst
In scope: InScope {x_aT3 p_aTl}
Type env: [aT3 :-> x_aT3, aTl :-> p_aTl]
Co env: []]
*** Offending Program ***
Rec {
rnfHelper [Occ=LoopBreaker]
:: forall (c :: * -> Constraint) (f :: * -> *) a.
(forall p. c p => f (p -> a) -> ()) -> PolyMap c f a -> ()
[LclIdX,
Arity=2,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 30] 90 10}]
rnfHelper
= \ (@(c_aSx :: * -> Constraint))
(@(f_aSy :: * -> *))
(@a_aSz)
(ds_dTD :: forall p. c_aSx p => f_aSy (p -> a_aSz) -> ())
(ds_dTE :: PolyMap c_aSx f_aSy a_aSz) ->
case ds_dTE of {
PMNil -> ();
PMCons @p_aSD $dTypeable_aSE irred_aSF v_aHn pm_aHo ->
case ds_dTD @p_aSD irred_aSF v_aHn of { () ->
rnfHelper @c_aSx @f_aSy @a_aSz ds_dTD pm_aHo
}
}
end Rec }
Rec {
$s$crnf_sUw :: forall {p} {x}. PathMap x -> ()
[LclId, Arity=1]
$s$crnf_sUw
= \ (@p_aTl) (@x_aT3) (eta_B0 :: PathMap x_aT3) ->
let {
$dNFData_sUv :: NFData (p_aTl -> x_aT3)
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}]
$dNFData_sUv
= (\ (v_aUr :: p_aTl -> x_aT3) ->
case v_aUr of { __DEFAULT -> () })
`cast` (Sym (N:NFData[0] <p_aTl -> x_aT3>_N)
:: ((p_aTl -> x_aT3) -> ()) ~R# NFData (p_aTl -> x_aT3)) } in
case eta_B0 of { PathMap a_aHg b_aHh ->
case $fNFData1List_$cliftRnf
@x_aT3
($dNFData_sUv
`cast` (N:NFData[0] <x_aT3>_N :: NFData x_aT3 ~R# (x_aT3 -> ())))
a_aHg
of
{ () ->
rnfHelper
@FromHttpApiData
@PathMap
@x_aT3
(\ (@p_X3) _ [Occ=Dead] (eta_X4 :: PathMap (p_X3 -> x_aT3)) ->
$crnf_aT6
@(p_X3 -> x_aT3)
((\ (v_aUr :: p_X3 -> x_aT3) -> case v_aUr of { __DEFAULT -> () })
`cast` (Sym (N:NFData[0] <p_X3 -> x_aT3>_N)
:: ((p_X3 -> x_aT3) -> ()) ~R# NFData (p_X3 -> x_aT3)))
eta_X4)
b_aHh
}
}
$crnf_aT6 [Occ=LoopBreaker]
:: forall x. NFData x => PathMap x -> ()
[LclId,
Arity=2,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 20] 150 0},
RULES: "SPEC $crnf @(p -> x)"
forall (@p_aTl) (@x_aT3) ($dNFData_sUv :: NFData (p_aTl -> x_aT3)).
$crnf_aT6 @(p_aTl -> x_aT3) $dNFData_sUv
= $s$crnf_sUw @p_aTl @x_aT3]
$crnf_aT6
= \ (@x_aT3)
($dNFData_aT4 :: NFData x_aT3)
(eta_B0 :: PathMap x_aT3) ->
case eta_B0 of { PathMap a_aHg b_aHh ->
case $fNFData1List_$cliftRnf
@x_aT3
($dNFData_aT4
`cast` (N:NFData[0] <x_aT3>_N :: NFData x_aT3 ~R# (x_aT3 -> ())))
a_aHg
of
{ () ->
rnfHelper
@FromHttpApiData
@PathMap
@x_aT3
(\ (@p_aTl) _ [Occ=Dead] (eta_X3 :: PathMap (p_aTl -> x_aT3)) ->
$crnf_aT6
@(p_aTl -> x_aT3)
((\ (v_aUr :: p_aTl -> x_aT3) -> case v_aUr of { __DEFAULT -> () })
`cast` (Sym (N:NFData[0] <p_aTl -> x_aT3>_N)
:: ((p_aTl -> x_aT3) -> ()) ~R# NFData (p_aTl -> x_aT3)))
eta_X3)
b_aHh
}
}
end Rec }
$fNFDataPathMap [InlPrag=INLINE (sat-args=0)]
:: forall x. NFData x => NFData (PathMap x)
[LclIdX[DFunId(nt)],
Arity=2,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=True)
Tmpl= $crnf_aT6
`cast` (forall (x :: <*>_N).
<NFData x>_R %<'Many>_N ->_R Sym (N:NFData[0] <PathMap x>_N)
:: (forall {x}. NFData x => PathMap x -> ())
~R# (forall {x}. NFData x => NFData (PathMap x)))}]
$fNFDataPathMap
= $crnf_aT6
`cast` (forall (x :: <*>_N).
<NFData x>_R %<'Many>_N ->_R Sym (N:NFData[0] <PathMap x>_N)
:: (forall {x}. NFData x => PathMap x -> ())
~R# (forall {x}. NFData x => NFData (PathMap x)))
*** End of Offense ***
<no location info>: error:
Compilation had errors
<no location info>: error: ExitFailure 1This regression was introduced in commit 4d2ee313 (Specialising through specialised method calls). cc @sgraf812