From 6cb84c469bf1ab6b03e099f5d100e78800ca09e0 Mon Sep 17 00:00:00 2001 From: Krzysztof Gogolewski Date: Mon, 15 Jun 2020 19:59:46 +0200 Subject: Various performance improvements This implements several general performance improvements to GHC, to offset the effect of the linear types change. General optimisations: - Add a `coreFullView` function which iterates `coreView` on the head. This avoids making function recursive solely because the iterate `coreView` themselves. As a consequence, this functions can be inlined, and trigger case-of-known constructor (_e.g._ `kindRep_maybe`, `isLiftedRuntimeRep`, `isMultiplicityTy`, `getTyVar_maybe`, `splitAppTy_maybe`, `splitFunType_maybe`, `tyConAppTyCon_maybe`). The common pattern about all these functions is that they are almost always used as views, and immediately consumed by a case expression. This commit also mark them asx `INLINE`. - In `subst_ty` add a special case for nullary `TyConApp`, which avoid allocations altogether. - Use `mkTyConApp` in `subst_ty` for the general `TyConApp`. This required quite a bit of module shuffling. case. `myTyConApp` enforces crucial sharing, which was lost during substitution. See also !2952 . - Make `subst_ty` stricter. - In `eqType` (specifically, in `nonDetCmpType`), add a special case, tested first, for the very common case of nullary `TyConApp`. `nonDetCmpType` has been made `INLINE` otherwise it is actually a regression. This is similar to the optimisations in !2952. Linear-type specific optimisations: - Use `tyConAppTyCon_maybe` instead of the more complex `eqType` in the definition of the pattern synonyms `One` and `Many`. - Break the `hs-boot` cycles between `Multiplicity.hs` and `Type.hs`: `Multiplicity` now import `Type` normally, rather than from the `hs-boot`. This way `tyConAppTyCon_maybe` can inline properly in the `One` and `Many` pattern synonyms. - Make `updateIdTypeAndMult` strict in its type and multiplicity - The `scaleIdBy` gets a specialised definition rather than being an alias to `scaleVarBy` - `splitFunTy_maybe` is given the type `Type -> Maybe (Mult, Type, Type)` instead of `Type -> Maybe (Scaled Type, Type)` - Remove the `MultMul` pattern synonym in favour of a view `isMultMul` because pattern synonyms appear not to inline well. - in `eqType`, in a `FunTy`, compare multiplicities last: they are almost always both `Many`, so it helps failing faster. - Cache `manyDataConTy` in `mkTyConApp`, to make sure that all the instances of `TyConApp ManyDataConTy []` are physically the same. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Arnaud Spiwack Metric Decrease: haddock.base T12227 T12545 T12990 T1969 T3064 T5030 T9872b Metric Increase: haddock.base haddock.Cabal haddock.compiler T12150 T12234 T12425 T12707 T13035 T13056 T15164 T16190 T18304 T1969 T3064 T3294 T5631 T5642 T5837 T6048 T9020 T9233 T9675 T9872a T9961 WWRec --- compiler/GHC/Tc/Utils/Env.hs | 1 - compiler/GHC/Tc/Utils/TcMType.hs | 5 ++--- compiler/GHC/Tc/Utils/TcType.hs | 3 +-- compiler/GHC/Tc/Utils/Unify.hs | 5 +++-- compiler/GHC/Tc/Utils/Zonk.hs | 4 ++-- 5 files changed, 8 insertions(+), 10 deletions(-) (limited to 'compiler/GHC/Tc/Utils') diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs index 55c0ad4e67..eebe9eb8ed 100644 --- a/compiler/GHC/Tc/Utils/Env.hs +++ b/compiler/GHC/Tc/Utils/Env.hs @@ -113,7 +113,6 @@ import GHC.Data.Bag import GHC.Data.List.SetOps import GHC.Utils.Error import GHC.Data.Maybe( MaybeErr(..), orElse ) -import GHC.Core.Multiplicity import qualified GHC.LanguageExtensions as LangExt import GHC.Utils.Misc ( HasDebugCallStack ) diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs index c33c335ac7..d2afbfb4ca 100644 --- a/compiler/GHC/Tc/Utils/TcMType.hs +++ b/compiler/GHC/Tc/Utils/TcMType.hs @@ -127,7 +127,6 @@ import GHC.Data.FastString import GHC.Data.Bag import GHC.Data.Pair import GHC.Types.Unique.Set -import GHC.Core.Multiplicity import GHC.Driver.Session import qualified GHC.LanguageExtensions as LangExt import GHC.Types.Basic ( TypeOrKind(..) ) @@ -2040,7 +2039,7 @@ zonkImplication implic@(Implic { ic_skols = skols , ic_info = info' }) } zonkEvVar :: EvVar -> TcM EvVar -zonkEvVar var = updateVarTypeAndMultM zonkTcType var +zonkEvVar var = updateIdTypeAndMultM zonkTcType var zonkWC :: WantedConstraints -> TcM WantedConstraints @@ -2315,7 +2314,7 @@ tidyHole env h@(Hole { hole_ty = ty }) = h { hole_ty = tidyType env ty } ---------------- tidyEvVar :: TidyEnv -> EvVar -> EvVar -tidyEvVar env var = updateVarTypeAndMult (tidyType env) var +tidyEvVar env var = updateIdTypeAndMult (tidyType env) var ---------------- tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index f06cdd7d31..da6e71547f 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -200,7 +200,6 @@ import GHC.Core.TyCo.Subst ( mkTvSubst, substTyWithCoVars ) import GHC.Core.TyCo.FVs import GHC.Core.TyCo.Ppr import GHC.Core.Class -import GHC.Core.Multiplicity import GHC.Types.Var import GHC.Types.ForeignCall import GHC.Types.Var.Set @@ -869,7 +868,7 @@ anyRewritableTyVar ignore_cos role pred ty go rl bvs (TyConApp tc tys) = go_tc rl bvs tc tys go rl bvs (AppTy fun arg) = go rl bvs fun || go NomEq bvs arg go rl bvs (FunTy _ w arg res) = go NomEq bvs arg_rep || go NomEq bvs res_rep || - go rl bvs arg || go rl bvs res || go rl bvs w + go rl bvs arg || go rl bvs res || go NomEq bvs w where arg_rep = getRuntimeRep arg -- forgetting these causes #17024 res_rep = getRuntimeRep res go rl bvs (ForAllTy tv ty) = go rl (bvs `extendVarSet` binderVar tv) ty diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs index a6711abcc1..75f4e83979 100644 --- a/compiler/GHC/Tc/Utils/Unify.hs +++ b/compiler/GHC/Tc/Utils/Unify.hs @@ -622,7 +622,7 @@ tc_sub_type unify inst_orig ctxt ty_actual ty_expected where possibly_poly ty | isForAllTy ty = True - | Just (_, res) <- splitFunTy_maybe ty = possibly_poly res + | Just (_, _, res) <- splitFunTy_maybe ty = possibly_poly res | otherwise = False -- NB *not* tcSplitFunTy, because here we want -- to decompose type-class arguments too @@ -746,7 +746,8 @@ to a UserTypeCtxt of GenSigCtxt. Why? -- only produce trivial evidence, then this check would happen in the constraint -- solver. tcSubMult :: CtOrigin -> Mult -> Mult -> TcM HsWrapper -tcSubMult origin (MultMul w1 w2) w_expected = +tcSubMult origin w_actual w_expected + | Just (w1, w2) <- isMultMul w_actual = do { w1 <- tcSubMult origin w1 w_expected ; w2 <- tcSubMult origin w2 w_expected ; return (w1 <.> w2) } diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs index 05eb4d9ba4..6dd6026841 100644 --- a/compiler/GHC/Tc/Utils/Zonk.hs +++ b/compiler/GHC/Tc/Utils/Zonk.hs @@ -402,7 +402,7 @@ zonkEvBndr :: ZonkEnv -> EvVar -> TcM EvVar -- Works for dictionaries and coercions -- Does not extend the ZonkEnv zonkEvBndr env var - = updateVarTypeAndMultM ({-# SCC "zonkEvBndr_zonkTcTypeToType" #-} zonkTcTypeToTypeX env) var + = updateIdTypeAndMultM ({-# SCC "zonkEvBndr_zonkTcTypeToType" #-} zonkTcTypeToTypeX env) var {- zonkEvVarOcc :: ZonkEnv -> EvVar -> TcM EvTerm @@ -583,7 +583,7 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs , (L loc bind@(FunBind { fun_id = (L mloc mono_id) , fun_matches = ms , fun_ext = co_fn })) <- lbind - = do { new_mono_id <- updateVarTypeAndMultM (zonkTcTypeToTypeX env) mono_id + = do { new_mono_id <- updateIdTypeAndMultM (zonkTcTypeToTypeX env) mono_id -- Specifically /not/ zonkIdBndr; we do not -- want to complain about a levity-polymorphic binder ; (env', new_co_fn) <- zonkCoFn env co_fn -- cgit v1.2.1