diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2016-06-12 00:00:53 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2016-06-13 10:57:19 +0100 |
| commit | 1f661281a23b6eab83a1144c43e464c0e2d2195a (patch) | |
| tree | 1950f6a7491817ad8cd2dc13b01d736ad9fbc0ef | |
| parent | 35c9de7ca053eda472cb446c53bcd2007bfd8394 (diff) | |
| download | haskell-1f661281a23b6eab83a1144c43e464c0e2d2195a.tar.gz | |
Beef up mkNakedCastTy
By spotting Refl coercions we can avoid building an awful
lot of CastTys. Simple and effective.
| -rw-r--r-- | compiler/typecheck/TcType.hs | 8 |
1 files changed, 7 insertions, 1 deletions
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index b48a0c1e04..5a453dd9c5 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 {- ************************************************************************ |