Commit a0f8b3ac authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

In mkCast (Coercion c1) c2, check that c2 has (~#) on both sides

Otherwise the RHS is utterly bogus.  I also added some asserts.
Thanks to Max for pointing this out.
parent 6a9e5217
......@@ -181,6 +181,10 @@ mkCast :: CoreExpr -> Coercion -> CoreExpr
mkCast e co | isReflCo co = e
mkCast (Coercion e_co) co
| isCoVarType (pSnd (coercionKind co))
-- The guard here checks that g has a (~#) on both sides,
-- otherwise decomposeCo fails. Can in principle happen
-- with unsafeCoerce
= Coercion new_co
where
-- g :: (s1 ~# s2) ~# (t1 ~# t2)
......
......@@ -976,11 +976,6 @@ simplType env ty
---------------------------------
simplCoercionF :: SimplEnv -> InCoercion -> SimplCont
-> SimplM (SimplEnv, OutExpr)
-- We are simplifying a term of form (Coercion co)
-- Simplify the InCoercion, and then try to combine with the
-- context, to implememt the rule
-- (Coercion co) |> g
-- = Coercion (syn (nth 0 g) ; co ; nth 1 g)
simplCoercionF env co cont
= do { co' <- simplCoercion env co
; rebuild env (Coercion co') cont }
......@@ -1164,7 +1159,7 @@ rebuild env expr cont
= case cont of
Stop {} -> return (env, expr)
CoerceIt co cont -> rebuild env (mkCast expr co) cont
-- NB: mkCast implements the (Coercion co |> g) optimisation
-- NB: mkCast implements the (Coercion co |> g) optimisation
Select _ bndr alts se cont -> rebuildCase (se `setFloats` env) expr bndr alts cont
StrictArg info _ cont -> rebuildCall env (info `addArgTo` expr) cont
StrictBind b bs body se cont -> do { env' <- simplNonRecX (se `setFloats` env) b expr
......
......@@ -318,8 +318,9 @@ isCoVar v = isCoVarType (varType v)
isCoVarType :: Type -> Bool
isCoVarType ty -- Tests for t1 ~# t2, the unboxed equality
| Just tc <- tyConAppTyCon_maybe ty = tc `hasKey` eqPrimTyConKey
| otherwise = False
= case splitTyConApp_maybe ty of
Just (tc,tys) -> tc `hasKey` eqPrimTyConKey && tys `lengthAtLeast` 2
Nothing -> False
\end{code}
......@@ -456,8 +457,9 @@ pprCoAxiom ax
--
-- > decomposeCo 3 c = [nth 0 c, nth 1 c, nth 2 c]
decomposeCo :: Arity -> Coercion -> [Coercion]
decomposeCo arity co = [mkNthCo n co | n <- [0..(arity-1)] ]
-- Remember, Nth is zero-indexed
decomposeCo arity co
= [mkNthCo n co | n <- [0..(arity-1)] ]
-- Remember, Nth is zero-indexed
-- | Attempts to obtain the type variable underlying a 'Coercion'
getCoVar_maybe :: Coercion -> Maybe CoVar
......@@ -615,8 +617,19 @@ mkTransCo co (Refl _) = co
mkTransCo co1 co2 = TransCo co1 co2
mkNthCo :: Int -> Coercion -> Coercion
mkNthCo n (Refl ty) = Refl (tyConAppArgN n ty)
mkNthCo n co = NthCo n co
mkNthCo n (Refl ty) = ASSERT( ok_tc_app ty n )
Refl (tyConAppArgN n ty)
mkNthCo n co = ASSERT( ok_tc_app _ty1 n && ok_tc_app _ty2 n )
NthCo n co
where
Pair _ty1 _ty2 = coercionKind co
#ifdef DEBUG
ok_tc_app :: Type -> Int -> Bool
ok_tc_app ty n = case splitTyConApp_maybe ty of
Just (_, tys) -> tys `lengthExceeds` n
Nothing -> False
#endif
-- | Instantiates a 'Coercion' with a 'Type' argument.
mkInstCo :: Coercion -> Type -> Coercion
......
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