[commit: ghc] master: Beef up mkNakedCastTy (1f66128)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/1f661281a23b6eab83a1144c43e464c0e2d2195a/ghc

>---------------------------------------------------------------

commit 1f661281a23b6eab83a1144c43e464c0e2d2195a
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Sun Jun 12 00:00:53 2016 +0100

    Beef up mkNakedCastTy
    
    By spotting Refl coercions we can avoid building an awful
    lot of CastTys.  Simple and effective.


>---------------------------------------------------------------

1f661281a23b6eab83a1144c43e464c0e2d2195a
 compiler/typecheck/TcType.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index b48a0c1..5a453dd 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -1186,7 +1186,13 @@ mkNakedAppTy :: Type -> Type -> Type
 mkNakedAppTy ty1 ty2 = mkNakedAppTys ty1 [ty2]
 
 mkNakedCastTy :: Type -> Coercion -> Type
-mkNakedCastTy = CastTy
+-- Do simple, fast compaction; especially dealing with Refl
+-- for which it's plain stupid to create a cast
+-- This simple function killed off a huge number of Refl casts
+-- in types, at birth.
+mkNakedCastTy ty co | isReflCo co = ty
+mkNakedCastTy (CastTy ty co1) co2 = CastTy ty (co1 `mkTransCo` co2)
+mkNakedCastTy ty co = CastTy ty co
 
 {-
 ************************************************************************