diff options
author | Richard Eisenberg <rae@richarde.dev> | 2021-11-22 17:50:46 -0500 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-12-28 10:09:28 -0500 |
commit | 72824c63e25c5c8c7ef89475c6064a3b9613b381 (patch) | |
tree | 8738e7e8ffcfa3fdf1844ab262c160abb552a874 | |
parent | fd42ab5fa1df847a6b595dfe4b63d9c7eecbf400 (diff) | |
download | haskell-72824c63e25c5c8c7ef89475c6064a3b9613b381.tar.gz |
Skip computing superclass origins for equalities
This yields a small, but measurable, performance improvement.
-rw-r--r-- | compiler/GHC/Tc/Solver/Canonical.hs | 17 |
1 files changed, 13 insertions, 4 deletions
diff --git a/compiler/GHC/Tc/Solver/Canonical.hs b/compiler/GHC/Tc/Solver/Canonical.hs index 67b49c8777..e07f2a4633 100644 --- a/compiler/GHC/Tc/Solver/Canonical.hs +++ b/compiler/GHC/Tc/Solver/Canonical.hs @@ -46,6 +46,8 @@ import GHC.Builtin.Types.Prim ( concretePrimTyCon ) import GHC.Types.Name.Set import GHC.Types.Name.Reader import GHC.Hs.Type( HsIPName(..) ) +import GHC.Types.Unique ( hasKey ) +import GHC.Builtin.Names ( coercibleTyConKey ) import GHC.Data.Pair import GHC.Utils.Misc @@ -537,19 +539,19 @@ mk_strict_superclasses :: NameSet -> CtEvidence -- nor are repeated mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys - = concatMapM (do_one_given (mk_given_loc loc)) $ + = concatMapM do_one_given $ classSCSelIds cls where dict_ids = mkTemplateLocals theta size = sizeTypes tys - do_one_given given_loc sel_id + do_one_given sel_id | isUnliftedType sc_pred , not (null tvs && null theta) = -- See Note [Equality superclasses in quantified constraints] return [] | otherwise - = do { given_ev <- newGivenEvVar given_loc $ + = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred ; mk_superclasses rec_clss given_ev tvs theta sc_pred } where @@ -579,13 +581,20 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) `App` (evId evar `mkVarApps` (tvs ++ dict_ids)) `mkVarApps` sc_tvs - mk_given_loc loc + sc_loc | isCTupleClass cls = loc -- For tuple predicates, just take them apart, without -- adding their (large) size into the chain. When we -- get down to a base predicate, we'll include its size. -- #10335 + | isEqPredClass cls + || cls `hasKey` coercibleTyConKey + = loc -- The only superclasses of ~, ~~, and Coercible are primitive + -- equalities, and they don't use the InstSCOrigin mechanism + -- detailed in Note [Solving superclass constraints] in + -- GHC.Tc.TyCl.Instance. Skip for a tiny performance win. + -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance -- for explantation of InstSCOrigin and Note [Replacement vs keeping] in -- GHC.Tc.Solver.Interact for why we need OtherSCOrigin and depths |