Implement a smart constructor mkUnsafeCoercion, and use it

This just ensures that an unsafe coercion is as localised as possible.
For example, instead of
    UnsafeCo (Int -> t1) (Int -> t2)
use
    Int -> UnsafeCo t1 t2

diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs
index bc93372..6d58e5f 100644 (file)
--- a/compiler/types/Coercion.lhs
+++ b/compiler/types/Coercion.lhs
@@ -379,9 +379,18 @@ mkInstsCoercion co tys = foldl mkInstCoercion co tys
 -- | Manufacture a coercion from this air. Needless to say, this is not usually safe,
 -- but it is used when we know we are dealing with bottom, which is one case in which 
 -- it is safe.  This is also used implement the @unsafeCoerce#@ primitive.
+-- Optimise by pushing down through type constructors
 mkUnsafeCoercion :: Type -> Type -> Coercion
-mkUnsafeCoercion ty1 ty2 = mkCoercion unsafeCoercionTyCon [ty1, ty2]
+mkUnsafeCoercion (TyConApp tc1 tys1) (TyConApp tc2 tys2)
+  | tc1 == tc2
+  = TyConApp tc1 (zipWith mkUnsafeCoercion tys1 tys2)
 
+mkUnsafeCoercion (FunTy a1 r1) (FunTy a2 r2)
+  = FunTy (mkUnsafeCoercion a1 a2) (mkUnsafeCoercion r1 r2)
+
+mkUnsafeCoercion ty1 ty2 
+  | ty1 `coreEqType` ty2 = ty1
+  | otherwise            = mkCoercion unsafeCoercionTyCon [ty1, ty2]
 
 -- See note [Newtype coercions] in TyCon
 

diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs
index 43de7d6..ecf93a0 100644 (file)
--- a/compiler/types/OptCoercion.lhs
+++ b/compiler/types/OptCoercion.lhs
@@ -112,8 +112,8 @@ opt_co_tc_app env sym tc desc cos
         | otherwise -> opt_trans opt_co1 opt_co2\r
 \r
       CoUnsafe\r
-        | sym       -> TyConApp tc [opt_co2,opt_co1]\r
-        | otherwise -> TyConApp tc [opt_co1,opt_co2]\r
+        | sym       -> mkUnsafeCoercion ty2' ty1'\r
+        | otherwise -> mkUnsafeCoercion ty1' ty2'\r
 \r
       CoSym   -> opt_co env (not sym) co1\r
       CoLeft  -> opt_lr fst\r
@@ -125,21 +125,22 @@ opt_co_tc_app env sym tc desc cos
       CoInst        -- See if the first arg is already a forall\r
                    -- ...then we can just extend the current substitution\r
         | Just (tv, co1_body) <- splitForAllTy_maybe co1\r
-        -> opt_co (extendTvSubst env tv ty') sym co1_body\r
+        -> opt_co (extendTvSubst env tv ty2') sym co1_body\r
 \r
                     -- See if is *now* a forall\r
         | Just (tv, opt_co1_body) <- splitForAllTy_maybe opt_co1\r
-        -> substTyWith [tv] [ty'] opt_co1_body -- An inefficient one-variable substitution\r
+        -> substTyWith [tv] [ty2'] opt_co1_body        -- An inefficient one-variable substitution\r
 \r
         | otherwise\r
-        -> TyConApp tc [opt_co1, ty']\r
-        where\r
-          ty' = substTy env co2\r
+        -> TyConApp tc [opt_co1, ty2']\r
 \r
   where\r
     (co1 : cos1) = cos\r
     (co2 : _)    = cos1\r
 \r
+    ty1' = substTy env co1\r
+    ty2' = substTy env co2\r
+\r
        -- These opt_cos have the sym pushed into them\r
     opt_co1 = opt_co env sym co1\r
     opt_co2 = opt_co env sym co2\r
@@ -362,6 +363,8 @@ etaCoPred_maybe co
   = Nothing\r
 \r
 etaApp_maybe :: Coercion -> Maybe (Coercion, Coercion)\r
+-- Split a coercion g :: t1a t1b ~ t2a t2b\r
+-- into (left g, right g) if possible\r
 etaApp_maybe co\r
   | Just (co1, co2) <- splitAppTy_maybe co\r
   = Just (co1, co2)\r