diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2020-03-24 13:13:43 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2020-12-14 13:37:09 -0500 |
| commit | 7e9debd4ceb068effe8ac81892d2cabcb8f55850 (patch) | |
| tree | f222f3f3e5d662a12ab00fcb1a81d8e8dfb6c0de /compiler/GHC/Tc | |
| parent | c696bb2f4476e0ce4071e0d91687c1fe84405599 (diff) | |
| download | haskell-7e9debd4ceb068effe8ac81892d2cabcb8f55850.tar.gz | |
Optimise nullary type constructor usage
During the compilation of programs GHC very frequently deals with
the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch
teaches GHC to avoid expanding the `Type` synonym (and other nullary
type synonyms) during type comparisons, saving a good amount of work.
This optimisation is described in `Note [Comparing nullary type
synonyms]`.
To maximize the impact of this optimisation, we introduce a few
special-cases to reduce `TYPE 'LiftedRep` to `Type`. See
`Note [Prefer Type over TYPE 'LiftedPtrRep]`.
Closes #17958.
Metric Decrease:
T18698b
T1969
T12227
T12545
T12707
T14683
T3064
T5631
T5642
T9020
T9630
T9872a
T13035
haddock.Cabal
haddock.base
Diffstat (limited to 'compiler/GHC/Tc')
| -rw-r--r-- | compiler/GHC/Tc/Solver/Canonical.hs | 5 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/TcMType.hs | 1 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/TcType.hs | 5 |
3 files changed, 10 insertions, 1 deletions
diff --git a/compiler/GHC/Tc/Solver/Canonical.hs b/compiler/GHC/Tc/Solver/Canonical.hs index fd608c3314..ce8bf24632 100644 --- a/compiler/GHC/Tc/Solver/Canonical.hs +++ b/compiler/GHC/Tc/Solver/Canonical.hs @@ -956,6 +956,11 @@ can_eq_nc' -> Type -> Type -- RHS, after and before type-synonym expansion, resp -> TcS (StopOrContinue Ct) +-- See Note [Comparing nullary type synonyms] in GHC.Core.Type. +can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2 + | tc1 == tc2 + = canEqReflexive ev eq_rel ty1 + -- Expand synonyms first; see Note [Type synonyms and canonicalization] can_eq_nc' rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 | Just ty1' <- tcView ty1 = can_eq_nc' rewritten rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs index ccb9152e01..e688dd5685 100644 --- a/compiler/GHC/Tc/Utils/TcMType.hs +++ b/compiler/GHC/Tc/Utils/TcMType.hs @@ -120,7 +120,6 @@ import GHC.Types.Id as Id import GHC.Types.Name import GHC.Types.Var.Set import GHC.Builtin.Types -import GHC.Builtin.Types.Prim import GHC.Types.Var.Env import GHC.Types.Name.Env import GHC.Utils.Misc diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index 3e52419772..6e4eea8f19 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -1581,6 +1581,11 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 = go orig_env orig_ty1 orig_ty2 where go :: RnEnv2 -> Type -> Type -> Bool + -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. + go _ (TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = True + go env t1 t2 | not keep_syns, Just t1' <- tcView t1 = go env t1' t2 go env t1 t2 | not keep_syns, Just t2' <- tcView t2 = go env t1 t2' |