diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2016-12-21 11:24:25 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2016-12-21 12:26:24 +0000 |
commit | c66dd05c8d02e2b7df825ed2f13b79fb3a16ab58 (patch) | |
tree | e57ac7e92fe14e93b2d7101e836f81676985a0cd | |
parent | c73a982bc49a234a030cea2496b70829c98b1e10 (diff) | |
download | haskell-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.hs | 24 | ||||
-rw-r--r-- | compiler/types/Coercion.hs-boot | 1 | ||||
-rw-r--r-- | compiler/types/TyCoRep.hs | 60 | ||||
-rw-r--r-- | compiler/types/Type.hs | 21 |
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 * * ************************************************************************ |