From: simonpj@microsoft.com <unknown>
Date: Fri, 30 Oct 2009 10:00:34 +0000 (+0000)
Subject: Improve coercion optimisation
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=40b82d31494eabb51ef2eb47d6e6191e0db764fd

Improve coercion optimisation

* Remove trace from optCoercion

* Use simplCoercion for type arguments in the Simplifier
  (because they might be coercions)
---

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 1b46aa9..1f691ea 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -819,7 +819,7 @@ simplExprF' env expr@(Lam _ _) cont
 
 simplExprF' env (Type ty) cont
   = ASSERT( contIsRhsOrArg cont )
-    do  { ty' <- simplType env ty
+    do  { ty' <- simplCoercion env ty
         ; rebuild env (Type ty') cont }
 
 simplExprF' env (Case scrut bndr _ alts) cont
@@ -857,6 +857,8 @@ simplType env ty
 
 ---------------------------------
 simplCoercion :: SimplEnv -> InType -> SimplM OutType
+-- The InType isn't *necessarily* a coercion, but it might be
+-- (in a type application, say) and optCoercion is a no-op on types
 simplCoercion env co
   = do { co' <- simplType env co
        ; return (optCoercion co') }
@@ -1165,7 +1167,7 @@ rebuildCall env fun (ArgInfo { ai_strs = [] }) cont
                    | otherwise = mkCoerce co expr
 
 rebuildCall env fun info (ApplyTo _ (Type arg_ty) se cont)
-  = do  { ty' <- simplType (se `setInScope` env) arg_ty
+  = do  { ty' <- simplCoercion (se `setInScope` env) arg_ty
         ; rebuildCall env (fun `App` Type ty') info cont }
 
 rebuildCall env fun 
diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs
index e5dfe26..bec90db 100644
--- a/compiler/types/Coercion.lhs
+++ b/compiler/types/Coercion.lhs
@@ -680,8 +680,8 @@ mkEqPredCoI _   (ACo co1) ty2 coi2      = ACo $ PredTy $ EqPred co1 (fromCoI coi
 \begin{code}
 optCoercion :: Coercion -> Coercion
 optCoercion co
-  = pprTrace "optCoercion" (ppr co $$ ppr (coercionKind co) $$ text ">-->" $$ ppr result) $
-    ASSERT2( coercionKind co `eq` coercionKind result, ppr co $$ ppr result $$ ppr (coercionKind co) $$ ppr (coercionKind result) )
+  = ASSERT2( coercionKind co `eq` coercionKind result, 
+             ppr co $$ ppr result $$ ppr (coercionKind co) $$ ppr (coercionKind result) )
     result
   where
         (s1,t1) `eq` (s2,t2) = s1 `coreEqType` s2 && t1 `coreEqType` t2