diff options
Diffstat (limited to 'compiler/GHC/Core/Lint.hs')
| -rw-r--r-- | compiler/GHC/Core/Lint.hs | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs index 74b6ca7e9a..b3ed2ce8eb 100644 --- a/compiler/GHC/Core/Lint.hs +++ b/compiler/GHC/Core/Lint.hs @@ -2108,13 +2108,15 @@ lintCoercion co@(UnivCo prov r ty1 ty2) -- see #9122 for discussion of these checks checkTypes t1 t2 + | allow_ill_kinded_univ_co prov + = return () -- Skip kind checks + | otherwise = do { checkWarnL (not lev_poly1) (report "left-hand type is levity-polymorphic") ; checkWarnL (not lev_poly2) (report "right-hand type is levity-polymorphic") ; when (not (lev_poly1 || lev_poly2)) $ - do { checkWarnL (reps1 `equalLength` reps2 || - is_core_prep_prov prov) + do { checkWarnL (reps1 `equalLength` reps2) (report "between values with different # of reps") ; zipWithM_ validateCoercion reps1 reps2 }} where @@ -2130,8 +2132,8 @@ lintCoercion co@(UnivCo prov r ty1 ty2) -- e.g (case error @Int "blah" of {}) :: Int# -- ==> (error @Int "blah") |> Unsafe Int Int# -- See Note [Unsafe coercions] in GHC.Core.CoreToStg.Prep - is_core_prep_prov CorePrepProv = True - is_core_prep_prov _ = False + allow_ill_kinded_univ_co (CorePrepProv homo_kind) = not homo_kind + allow_ill_kinded_univ_co _ = False validateCoercion :: PrimRep -> PrimRep -> LintM () validateCoercion rep1 rep2 @@ -2162,8 +2164,8 @@ lintCoercion co@(UnivCo prov r ty1 ty2) ; check_kinds kco k1 k2 ; return (ProofIrrelProv kco') } - lint_prov _ _ prov@(PluginProv _) = return prov - lint_prov _ _ prov@CorePrepProv = return prov + lint_prov _ _ prov@(PluginProv _) = return prov + lint_prov _ _ prov@(CorePrepProv _) = return prov check_kinds kco k1 k2 = do { let Pair k1' k2' = coercionKind kco |