[commit: ghc] master: Move typeSize/coercionSize into TyCoRep (c66dd05)
git at git.haskell.org
git at git.haskell.org
Wed Dec 21 14:06:26 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/c66dd05c8d02e2b7df825ed2f13b79fb3a16ab58/ghc
>---------------------------------------------------------------
commit c66dd05c8d02e2b7df825ed2f13b79fb3a16ab58
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Wed Dec 21 11:24:25 2016 +0000
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.
>---------------------------------------------------------------
c66dd05c8d02e2b7df825ed2f13b79fb3a16ab58
compiler/types/Coercion.hs | 24 -----------------
compiler/types/Coercion.hs-boot | 1 -
compiler/types/TyCoRep.hs | 60 ++++++++++++++++++++++++++++++++++++++++-
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 6545ec0..0adadc3 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 807d855..8ba9295 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 c007321..63aba3c 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 1e429ef..14aa8fd 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
* *
************************************************************************
More information about the ghc-commits
mailing list