Commit cea71418 authored by Richard Eisenberg's avatar Richard Eisenberg

Fix #13458

Core Lint shouldn't check representations of types that don't
have representations.

test case: typecheck/should_compile/T13458
parent 5025fe24
......@@ -1630,7 +1630,7 @@ lintCoercion co@(UnivCo prov r ty1 ty2)
(checkTypes ty1 ty2)
; return (k1, k2, ty1, ty2, r) }
where
report s = hang (text $ "Unsafe coercion between " ++ s)
report s = hang (text $ "Unsafe coercion: " ++ s)
2 (vcat [ text "From:" <+> ppr ty1
, text " To:" <+> ppr ty2])
isUnBoxed :: PrimRep -> Bool
......@@ -1638,10 +1638,20 @@ lintCoercion co@(UnivCo prov r ty1 ty2)
-- see #9122 for discussion of these checks
checkTypes t1 t2
= do { checkWarnL (reps1 `equalLength` reps2)
(report "values with different # of reps")
; zipWithM_ validateCoercion reps1 reps2 }
= do { checkWarnL lev_poly1
(report "left-hand type is levity-polymorphic")
; checkWarnL lev_poly2
(report "right-hand type is levity-polymorphic")
; when (not (lev_poly1 || lev_poly2)) $
do { checkWarnL (reps1 `equalLength` reps2)
(report "between values with different # of reps")
; zipWithM_ validateCoercion reps1 reps2 }}
where
lev_poly1 = isTypeLevPoly t1
lev_poly2 = isTypeLevPoly t2
-- don't look at these unless lev_poly1/2 are False
-- Otherwise, we get #13458
reps1 = typePrimRep t1
reps2 = typePrimRep t2
......@@ -1649,15 +1659,15 @@ lintCoercion co@(UnivCo prov r ty1 ty2)
validateCoercion rep1 rep2
= do { dflags <- getDynFlags
; checkWarnL (isUnBoxed rep1 == isUnBoxed rep2)
(report "unboxed and boxed value")
(report "between unboxed and boxed value")
; checkWarnL (TyCon.primRepSizeW dflags rep1
== TyCon.primRepSizeW dflags rep2)
(report "unboxed values of different size")
(report "between unboxed values of different size")
; let fl = liftM2 (==) (TyCon.primRepIsFloat rep1)
(TyCon.primRepIsFloat rep2)
; case fl of
Nothing -> addWarnL (report "vector types")
Just False -> addWarnL (report "float and integral values")
Nothing -> addWarnL (report "between vector types")
Just False -> addWarnL (report "between float and integral values")
_ -> return ()
}
......
......@@ -343,10 +343,6 @@ kindPrimRep doc (TyConApp typ [runtime_rep])
kindPrimRep doc ki
= pprPanic "kindPrimRep" (ppr ki $$ doc)
-- TODO (RAE): Remove:
-- WARN( True, text "kindPrimRep defaulting to LiftedRep on" <+> ppr ki $$ doc )
-- [LiftedRep] -- this can happen legitimately for, e.g., Any
-- | Take a type of kind RuntimeRep and extract the list of 'PrimRep' that
-- it encodes.
runtimeRepPrimRep :: HasDebugCallStack => SDoc -> Type -> [PrimRep]
......
{-# LANGUAGE MagicHash, TypeInType, ScopedTypeVariables #-}
{-# OPTIONS_GHC -O #-}
module T13458 where
import GHC.Exts
import Data.Kind
import Unsafe.Coerce
unsafeCoerce' :: forall (r :: RuntimeRep)
(a :: TYPE r) (b :: TYPE r).
a -> b
unsafeCoerce' = unsafeCoerce id
......@@ -546,3 +546,4 @@ test('T12926', normal, compile, [''])
test('T13381', normal, compile_fail, [''])
test('T13337', normal, compile, [''])
test('T13343', normal, compile, [''])
test('T13458', normal, compile, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment