Fix #13458
authorRichard Eisenberg <rae@cs.brynmawr.edu>
Thu, 23 Mar 2017 02:32:04 +0000 (22:32 -0400)
committerRichard Eisenberg <rae@cs.brynmawr.edu>
Mon, 27 Mar 2017 19:04:15 +0000 (15:04 -0400)
Core Lint shouldn't check representations of types that don't
have representations.

test case: typecheck/should_compile/T13458

compiler/coreSyn/CoreLint.hs
compiler/simplStg/RepType.hs
testsuite/tests/typecheck/should_compile/T13458.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/all.T

index 0363d6b..b97f97e 100644 (file)
@@ -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 ()
             }
 
index f59a854..be72574 100644 (file)
@@ -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]
diff --git a/testsuite/tests/typecheck/should_compile/T13458.hs b/testsuite/tests/typecheck/should_compile/T13458.hs
new file mode 100644 (file)
index 0000000..9b51378
--- /dev/null
@@ -0,0 +1,11 @@
+{-# 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
index 9caaf25..97a5350 100644 (file)
@@ -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, [''])