diff options
| author | Richard Eisenberg <rae@cs.brynmawr.edu> | 2017-03-22 22:32:04 -0400 |
|---|---|---|
| committer | Richard Eisenberg <rae@cs.brynmawr.edu> | 2017-03-27 15:04:15 -0400 |
| commit | cea7141851ce653cb20207da3591d09e73fa396d (patch) | |
| tree | 379e1f984df117738aa0c6cd99bbd9e966fbf4bd /compiler/coreSyn | |
| parent | 5025fe2435d030f0c5ecdc2a933c7bfcb3efcb7c (diff) | |
| download | haskell-cea7141851ce653cb20207da3591d09e73fa396d.tar.gz | |
Fix #13458
Core Lint shouldn't check representations of types that don't
have representations.
test case: typecheck/should_compile/T13458
Diffstat (limited to 'compiler/coreSyn')
| -rw-r--r-- | compiler/coreSyn/CoreLint.hs | 26 |
1 files changed, 18 insertions, 8 deletions
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 0363d6be51..b97f97e88d 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -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 () } |