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.

compiler/coreSyn/CoreUtils.lhs

@@ -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)

compiler/simplCore/Simplify.lhs

@@ -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

compiler/types/Coercion.lhs

@@ -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