diff options
author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2020-06-15 19:59:46 +0200 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2020-06-17 16:22:03 -0400 |
commit | 6cb84c469bf1ab6b03e099f5d100e78800ca09e0 (patch) | |
tree | 5dd883d7fd637093b60b7a62ecdb58389873bb0f /compiler/GHC/Core/Lint.hs | |
parent | 40fa237e1daab7a76b9871bb6c50b953a1addf23 (diff) | |
download | haskell-6cb84c469bf1ab6b03e099f5d100e78800ca09e0.tar.gz |
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
Diffstat (limited to 'compiler/GHC/Core/Lint.hs')
-rw-r--r-- | compiler/GHC/Core/Lint.hs | 13 |
1 files changed, 7 insertions, 6 deletions
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs index 43c93595df..d14bc633fe 100644 --- a/compiler/GHC/Core/Lint.hs +++ b/compiler/GHC/Core/Lint.hs @@ -1277,7 +1277,7 @@ lintTyApp fun_ty arg_ty -- application. lintValApp :: CoreExpr -> LintedType -> LintedType -> UsageEnv -> UsageEnv -> LintM (LintedType, UsageEnv) lintValApp arg fun_ty arg_ty fun_ue arg_ue - | Just (Scaled w arg_ty', res_ty') <- splitFunTy_maybe fun_ty + | Just (w, arg_ty', res_ty') <- splitFunTy_maybe fun_ty = do { ensureEqTys arg_ty' arg_ty err1 ; let app_ue = addUE fun_ue (scaleUE w arg_ue) ; return (res_ty', app_ue) } @@ -2743,17 +2743,18 @@ ensureSubMult actual_usage described_usage err_msg = do flags <- getLintFlags when (lf_check_linearity flags) $ case actual_usage' `submult` described_usage' of Submult -> return () - Unknown -> case actual_usage' of - MultMul m1 m2 -> ensureSubMult m1 described_usage' err_msg >> + Unknown -> case isMultMul actual_usage' of + Just (m1, m2) -> ensureSubMult m1 described_usage' err_msg >> ensureSubMult m2 described_usage' err_msg - _ -> when (not (actual_usage' `eqType` described_usage')) (addErrL err_msg) + Nothing -> when (not (actual_usage' `eqType` described_usage')) (addErrL err_msg) where actual_usage' = normalize actual_usage described_usage' = normalize described_usage normalize :: Mult -> Mult - normalize (MultMul m1 m2) = mkMultMul (normalize m1) (normalize m2) - normalize m = m + normalize m = case isMultMul m of + Just (m1, m2) -> mkMultMul (normalize m1) (normalize m2) + Nothing -> m lintRole :: Outputable thing => thing -- where the role appeared |