summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2016-12-21 11:24:25 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2016-12-21 12:26:24 +0000
commitc66dd05c8d02e2b7df825ed2f13b79fb3a16ab58 (patch)
treee57ac7e92fe14e93b2d7101e836f81676985a0cd
parentc73a982bc49a234a030cea2496b70829c98b1e10 (diff)
downloadhaskell-c66dd05c8d02e2b7df825ed2f13b79fb3a16ab58.tar.gz
Move typeSize/coercionSize into TyCoRep
While investigating something else I found that 'typeSize' was allocating like crazy. Stupid becuase it should allocate precisely nothing!! Turned out that it was because typeSize and coercionSize were mutually recursive across module boundaries, and so could not benefit from the CPR property. To fix this I moved them both into TyCoRep. It's not critical (because typeSize is really only used in debug mode, but I tripped over and example (T5642) in which typeSize was one of the biggest single allocators in all of GHC. And it's easy to fix, so I did.
-rw-r--r--compiler/types/Coercion.hs24
-rw-r--r--compiler/types/Coercion.hs-boot1
-rw-r--r--compiler/types/TyCoRep.hs60
-rw-r--r--compiler/types/Type.hs21
4 files changed, 59 insertions, 47 deletions
diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs
index 6545ec0fd5..0adadc33ca 100644
--- a/compiler/types/Coercion.hs
+++ b/compiler/types/Coercion.hs
@@ -150,30 +150,6 @@ setCoVarUnique = setVarUnique
setCoVarName :: CoVar -> Name -> CoVar
setCoVarName = setVarName
-coercionSize :: Coercion -> Int
-coercionSize (Refl _ ty) = typeSize ty
-coercionSize (TyConAppCo _ _ args) = 1 + sum (map coercionSize args)
-coercionSize (AppCo co arg) = coercionSize co + coercionSize arg
-coercionSize (ForAllCo _ h co) = 1 + coercionSize co + coercionSize h
-coercionSize (CoVarCo _) = 1
-coercionSize (AxiomInstCo _ _ args) = 1 + sum (map coercionSize args)
-coercionSize (UnivCo p _ t1 t2) = 1 + provSize p + typeSize t1 + typeSize t2
-coercionSize (SymCo co) = 1 + coercionSize co
-coercionSize (TransCo co1 co2) = 1 + coercionSize co1 + coercionSize co2
-coercionSize (NthCo _ co) = 1 + coercionSize co
-coercionSize (LRCo _ co) = 1 + coercionSize co
-coercionSize (InstCo co arg) = 1 + coercionSize co + coercionSize arg
-coercionSize (CoherenceCo c1 c2) = 1 + coercionSize c1 + coercionSize c2
-coercionSize (KindCo co) = 1 + coercionSize co
-coercionSize (SubCo co) = 1 + coercionSize co
-coercionSize (AxiomRuleCo _ cs) = 1 + sum (map coercionSize cs)
-
-provSize :: UnivCoProvenance -> Int
-provSize UnsafeCoerceProv = 1
-provSize (PhantomProv co) = 1 + coercionSize co
-provSize (ProofIrrelProv co) = 1 + coercionSize co
-provSize (PluginProv _) = 1
-provSize (HoleProv h) = pprPanic "provSize hits a hole" (ppr h)
{-
%************************************************************************
diff --git a/compiler/types/Coercion.hs-boot b/compiler/types/Coercion.hs-boot
index 807d855772..8ba92952b4 100644
--- a/compiler/types/Coercion.hs-boot
+++ b/compiler/types/Coercion.hs-boot
@@ -39,7 +39,6 @@ mkCoercionType :: Role -> Type -> Type -> Type
data LiftingContext
liftCoSubst :: Role -> LiftingContext -> Type -> Coercion
-coercionSize :: Coercion -> Int
seqCo :: Coercion -> ()
coercionKind :: Coercion -> Pair Type
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index c007321988..63aba3cf44 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -123,7 +123,10 @@ module TyCoRep (
tidyTopType,
tidyKind,
tidyCo, tidyCos,
- tidyTyVarBinder, tidyTyVarBinders
+ tidyTyVarBinder, tidyTyVarBinders,
+
+ -- * Sizes
+ typeSize, coercionSize, provSize
) where
#include "HsVersions.h"
@@ -2743,3 +2746,58 @@ tidyCo env@(_, subst) co
tidyCos :: TidyEnv -> [Coercion] -> [Coercion]
tidyCos env = map (tidyCo env)
+
+
+{- *********************************************************************
+* *
+ typeSize, coercionSize
+* *
+********************************************************************* -}
+
+-- NB: We put typeSize/coercionSize here because they are mutually
+-- recursive, and have the CPR property. If we have mutual
+-- recursion across a hi-boot file, we don't get the CPR property
+-- and these functions allocate a tremendous amount of rubbish.
+-- It's not critical (because typeSize is really only used in
+-- debug mode, but I tripped over and example (T5642) in which
+-- typeSize was one of the biggest single allocators in all of GHC.
+-- And it's easy to fix, so I did.
+
+-- NB: typeSize does not respect `eqType`, in that two types that
+-- are `eqType` may return different sizes. This is OK, because this
+-- function is used only in reporting, not decision-making.
+
+typeSize :: Type -> Int
+typeSize (LitTy {}) = 1
+typeSize (TyVarTy {}) = 1
+typeSize (AppTy t1 t2) = typeSize t1 + typeSize t2
+typeSize (FunTy t1 t2) = typeSize t1 + typeSize t2
+typeSize (ForAllTy (TvBndr tv _) t) = typeSize (tyVarKind tv) + typeSize t
+typeSize (TyConApp _ ts) = 1 + sum (map typeSize ts)
+typeSize (CastTy ty co) = typeSize ty + coercionSize co
+typeSize (CoercionTy co) = coercionSize co
+
+coercionSize :: Coercion -> Int
+coercionSize (Refl _ ty) = typeSize ty
+coercionSize (TyConAppCo _ _ args) = 1 + sum (map coercionSize args)
+coercionSize (AppCo co arg) = coercionSize co + coercionSize arg
+coercionSize (ForAllCo _ h co) = 1 + coercionSize co + coercionSize h
+coercionSize (CoVarCo _) = 1
+coercionSize (AxiomInstCo _ _ args) = 1 + sum (map coercionSize args)
+coercionSize (UnivCo p _ t1 t2) = 1 + provSize p + typeSize t1 + typeSize t2
+coercionSize (SymCo co) = 1 + coercionSize co
+coercionSize (TransCo co1 co2) = 1 + coercionSize co1 + coercionSize co2
+coercionSize (NthCo _ co) = 1 + coercionSize co
+coercionSize (LRCo _ co) = 1 + coercionSize co
+coercionSize (InstCo co arg) = 1 + coercionSize co + coercionSize arg
+coercionSize (CoherenceCo c1 c2) = 1 + coercionSize c1 + coercionSize c2
+coercionSize (KindCo co) = 1 + coercionSize co
+coercionSize (SubCo co) = 1 + coercionSize co
+coercionSize (AxiomRuleCo _ cs) = 1 + sum (map coercionSize cs)
+
+provSize :: UnivCoProvenance -> Int
+provSize UnsafeCoerceProv = 1
+provSize (PhantomProv co) = 1 + coercionSize co
+provSize (ProofIrrelProv co) = 1 + coercionSize co
+provSize (PluginProv _) = 1
+provSize (HoleProv h) = pprPanic "provSize hits a hole" (ppr h)
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 1e429effd1..14aa8fd38d 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -1733,27 +1733,6 @@ predTypeEqRel ty
{-
%************************************************************************
%* *
- Size
-* *
-************************************************************************
--}
-
--- NB: This function does not respect `eqType`, in that two types that
--- are `eqType` may return different sizes. This is OK, because this
--- function is used only in reporting, not decision-making.
-typeSize :: Type -> Int
-typeSize (LitTy {}) = 1
-typeSize (TyVarTy {}) = 1
-typeSize (AppTy t1 t2) = typeSize t1 + typeSize t2
-typeSize (FunTy t1 t2) = typeSize t1 + typeSize t2
-typeSize (ForAllTy (TvBndr tv _) t) = typeSize (tyVarKind tv) + typeSize t
-typeSize (TyConApp _ ts) = 1 + sum (map typeSize ts)
-typeSize (CastTy ty co) = typeSize ty + coercionSize co
-typeSize (CoercionTy co) = coercionSize co
-
-{-
-%************************************************************************
-%* *
Well-scoped tyvars
* *
************************************************************************