OptCoercion: Ensure that TyConApps match in arity
authorBen Gamari <bgamari.foss@gmail.com>
Mon, 8 May 2017 21:40:50 +0000 (17:40 -0400)
committerBen Gamari <ben@smart-cactus.org>
Mon, 8 May 2017 21:42:35 +0000 (17:42 -0400)
Previously OptCoercion would potentially change the type of UnivCo
coercions of the shape,
```
co :: TyCon arg1 ... argN ~ TyCon arg1' ... argN'
```
where the arities of the left and right applications differ. In this
case we
would try to zip the two argument lists, meaning that one would get
truncated.

One would think this could never happen since it implies we are
applying the
same TyCon to two different numbers of arguments. However, it does
arise in the
case of applications of the `Any` tycon, which arises from the
typechecker (in
`Data.Typeable.Internal`) where we end up with an `UnsafeCo`,
```
co :: Any (Any -> Any) Any ~ Any (Any -> Any)
```

Test Plan: Validate

Reviewers: simonpj, austin, goldfire

Reviewed By: simonpj

Subscribers: rwbarton, thomie

GHC Trac Issues: #13658

Differential Revision: https://phabricator.haskell.org/D3545

compiler/types/OptCoercion.hs

index b1aa646..17ab302 100644 (file)
@@ -364,6 +364,20 @@ opt_phantom env sym co
   where
     Pair ty1 ty2 = coercionKind co
 
   where
     Pair ty1 ty2 = coercionKind co
 
+{- Note [Differing kinds]
+   ~~~~~~~~~~~~~~~~~~~~~~
+The two types may not have the same kind (although that would be very unusual).
+But even if they have the same kind, and the same type constructor, the number
+of arguments in a `CoTyConApp` can differ. Consider
+
+  Any :: forall k. k
+
+  Any * Int                      :: *
+  Any (*->*) Maybe Int  :: *
+
+Hence the need to compare argument lengths; see Trac #13658
+ -}
+
 opt_univ :: LiftingContext -> SymFlag -> UnivCoProvenance -> Role
          -> Type -> Type -> Coercion
 opt_univ env sym (PhantomProv h) _r ty1 ty2
 opt_univ :: LiftingContext -> SymFlag -> UnivCoProvenance -> Role
          -> Type -> Type -> Coercion
 opt_univ env sym (PhantomProv h) _r ty1 ty2
@@ -378,6 +392,7 @@ opt_univ env sym prov role oty1 oty2
   | Just (tc1, tys1) <- splitTyConApp_maybe oty1
   , Just (tc2, tys2) <- splitTyConApp_maybe oty2
   , tc1 == tc2
   | Just (tc1, tys1) <- splitTyConApp_maybe oty1
   , Just (tc2, tys2) <- splitTyConApp_maybe oty2
   , tc1 == tc2
+  , equalLength tys1 tys2 -- see Note [Differing kinds]
       -- NB: prov must not be the two interesting ones (ProofIrrel & Phantom);
       -- Phantom is already taken care of, and ProofIrrel doesn't relate tyconapps
   = let roles    = tyConRolesX role tc1
       -- NB: prov must not be the two interesting ones (ProofIrrel & Phantom);
       -- Phantom is already taken care of, and ProofIrrel doesn't relate tyconapps
   = let roles    = tyConRolesX role tc1