diff options
| author | simonpj@microsoft.com <unknown> | 2009-10-30 10:00:34 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2009-10-30 10:00:34 +0000 |
| commit | 40b82d31494eabb51ef2eb47d6e6191e0db764fd (patch) | |
| tree | 1a6f7c1ec9d7d6746028c0e78aad1f3a9e724a0f | |
| parent | af28015f9139151ef33098481e774be92bfcbe8f (diff) | |
| download | haskell-40b82d31494eabb51ef2eb47d6e6191e0db764fd.tar.gz | |
Improve coercion optimisation
* Remove trace from optCoercion
* Use simplCoercion for type arguments in the Simplifier
(because they might be coercions)
| -rw-r--r-- | compiler/simplCore/Simplify.lhs | 6 | ||||
| -rw-r--r-- | compiler/types/Coercion.lhs | 4 |
2 files changed, 6 insertions, 4 deletions
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 1b46aa9fe2..1f691eaa43 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 e5dfe2682a..bec90db772 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 |