[Git][ghc/ghc][wip/T24725] Faster type equality
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Wed Jun 19 21:21:52 UTC 2024
Simon Peyton Jones pushed to branch wip/T24725 at Glasgow Haskell Compiler / GHC
Commits:
56f6962b by Simon Peyton Jones at 2024-06-19T22:21:17+01:00
Faster type equality
This MR speeds up type equality, triggered by perf regressions that
showed up when fixing #24725 by parameterising type equality over
whether to ignore multiplicity.
The changes are:
* Do not use `nonDetCmpType` for type /equality/. Instead use a specialised
type-equality function, which we have always had!
`nonDetCmpType` remains, but I did not invest effort in refactoring
or optimising it.
* Type equality is parameterised by
- whether to expand synonyms
- whether to respect multiplicities
- whether it has a RnEnv2 environment
In this MR I systematically specialise it for static values of these
parameters. Much more direct and predictable than before. See
Note [Specialising type equality]
* We want to avoid comparing kinds if possible. I refactored how this
happens, at least for `eqType`.
See Note [Casts and coercions in type comparison]
* To make Lint fast, we want to avoid allocating a thunk for <msg> in
ensureEqTypes ty1 ty2 <msg>
because the test almost always succeeds, and <msg> isn't needed.
See Note [INLINE ensureEqTys]
Metric Decrease:
T13386
T5030
- - - - -
6 changed files:
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Multiplicity.hs
- compiler/GHC/Core/TyCo/Compare.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Tc/Utils/TcType.hs
Changes:
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -53,7 +53,7 @@ import GHC.Core.Predicate( isCoVarType )
import GHC.Core.Multiplicity
import GHC.Core.UsageEnv
import GHC.Core.TyCo.Rep -- checks validity of types/coercions
-import GHC.Core.TyCo.Compare ( eqType, eqTypeOpt, defaultCmpTypeOpt, CmpTypeOpt (..), eqForAllVis )
+import GHC.Core.TyCo.Compare ( eqType, eqTypes, eqTypeIgnoringMultiplicity, eqForAllVis )
import GHC.Core.TyCo.Subst
import GHC.Core.TyCo.FVs
import GHC.Core.TyCo.Ppr
@@ -2807,7 +2807,7 @@ lint_axiom ax@(CoAxiom { co_ax_tc = tc, co_ax_branches = branches
extra_checks
| isNewTyCon tc
- = do { CoAxBranch { cab_tvs = tvs
+ = do { CoAxBranch { cab_tvs = ax_tvs
, cab_eta_tvs = eta_tvs
, cab_cvs = cvs
, cab_roles = roles
@@ -2815,14 +2815,10 @@ lint_axiom ax@(CoAxiom { co_ax_tc = tc, co_ax_branches = branches
<- case branch_list of
[branch] -> return branch
_ -> failWithL (text "multi-branch axiom with newtype")
- ; let ax_lhs = mkInfForAllTys tvs $
- mkTyConApp tc lhs_tys
- nt_tvs = takeList tvs (tyConTyVars tc)
- -- axiom may be eta-reduced: Note [Newtype eta] in GHC.Core.TyCon
- nt_lhs = mkInfForAllTys nt_tvs $
- mkTyConApp tc (mkTyVarTys nt_tvs)
- -- See Note [Newtype eta] in GHC.Core.TyCon
- ; lintL (ax_lhs `eqType` nt_lhs)
+
+ -- The LHS of the axiom is (N lhs_tys)
+ -- We expect it to be (N ax_tvs)
+ ; lintL (mkTyVarTys ax_tvs `eqTypes` lhs_tys)
(text "Newtype axiom LHS does not match newtype definition")
; lintL (null cvs)
(text "Newtype axiom binds coercion variables")
@@ -2831,7 +2827,7 @@ lint_axiom ax@(CoAxiom { co_ax_tc = tc, co_ax_branches = branches
(text "Newtype axiom has eta-tvs")
; lintL (ax_role == Representational)
(text "Newtype axiom role not representational")
- ; lintL (roles `equalLength` tvs)
+ ; lintL (roles `equalLength` ax_tvs)
(text "Newtype axiom roles list is the wrong length." $$
text "roles:" <+> sep (map ppr roles))
; lintL (roles == takeList roles (tyConRoles tc))
@@ -3101,17 +3097,14 @@ Note [Linting linearity]
Lint ignores linearity unless `-dlinear-core-lint` is set. For why, see below.
But first, "ignore linearity" specifically means two things. When ignoring linearity:
-* In `ensureEqTypes`, use `eqTypeOpt` with instructions to ignore multiplicities in FunTy.
+* In `ensureEqTypes`, use `eqTypeIgnoringMultiplicity`
* In `ensureSubMult`, do nothing
-The behaviour of functions such as eqTypeOpt which may or may not ignore
-linearity is governed by a flag of type GHC.Core.Multiplicity.MultiplicityFlag.
-
-But why make `-dcore-lint` ignore linearity? Because
-optimisation passes are not (yet) guaranteed to maintain linearity. They should
-do so semantically (GHC is careful not to duplicate computation) but it is much
-harder to ensure that the statically-checkable constraints of Linear Core are
-maintained. The current Linear Core is described in the wiki at:
+But why make `-dcore-lint` ignore linearity? Because optimisation passes are
+not (yet) guaranteed to maintain linearity. They should do so semantically (GHC
+is careful not to duplicate computation) but it is much harder to ensure that
+the statically-checkable constraints of Linear Core are maintained. The current
+Linear Core is described in the wiki at:
https://gitlab.haskell.org/ghc/ghc/-/wikis/linear-types/implementation.
Here are some examples of how the optimiser can break linearity checking. Other
@@ -3495,17 +3488,25 @@ ensureEqTys :: LintedType -> LintedType -> SDoc -> LintM ()
-- check ty2 is subtype of ty1 (ie, has same structure but usage
-- annotations need only be consistent, not equal)
-- Assumes ty1,ty2 are have already had the substitution applied
-ensureEqTys ty1 ty2 msg = do
- flags <- getLintFlags
- -- When `-dlinear-core-lint` is off, then consider `a -> b` and `a %1 -> b` to
- -- be equal. See Note [Linting linearity].
- lintL (eqTypeOpt (opt flags) ty1 ty2) msg
- where
- opt flags =
- if lf_check_linearity flags then
- defaultCmpTypeOpt { cmp_multiplicity_in_funty = RespectMultiplicities }
- else
- defaultCmpTypeOpt { cmp_multiplicity_in_funty = IgnoreMultiplicities }
+{-# INLINE ensureEqTys #-} -- See Note [INLINE ensureEqTys]
+ensureEqTys ty1 ty2 msg
+ = do { flags <- getLintFlags
+ ; lintL (eq_type flags ty1 ty2) msg }
+
+eq_type :: LintFlags -> Type -> Type -> Bool
+-- When `-dlinear-core-lint` is off, then consider `a -> b` and `a %1 -> b` to
+-- be equal. See Note [Linting linearity].
+eq_type flags ty1 ty2 | lf_check_linearity flags = eqType ty1 ty2
+ | otherwise = eqTypeIgnoringMultiplicity ty1 ty2
+
+{- Note [INLINE ensureEqTys]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+To make Lint fast, we want to avoid allocating a thunk for <msg> in
+ ensureEqTypes ty1 ty2 <msg>
+because the test almost always succeeds, and <msg> isn't needed.
+So we INLINE `ensureEqTys`. This actually make a difference of
+1-2% when compiling programs with -dcore-lint.
+-}
ensureSubUsage :: Usage -> Mult -> SDoc -> LintM ()
ensureSubUsage Bottom _ _ = return ()
=====================================
compiler/GHC/Core/Multiplicity.hs
=====================================
@@ -31,7 +31,8 @@ module GHC.Core.Multiplicity
, submult
, mapScaledType
, pprArrowWithMultiplicity
- , MultiplicityFlag(..)) where
+ , MultiplicityFlag(..)
+ ) where
import GHC.Prelude
=====================================
compiler/GHC/Core/TyCo/Compare.hs
=====================================
@@ -7,16 +7,17 @@
-- | Type equality and comparison
module GHC.Core.TyCo.Compare (
- -- * Type comparison
- eqType, eqTypeOpt, eqTypeX, eqTypes, nonDetCmpType, nonDetCmpTypes, nonDetCmpTypeX,
- nonDetCmpTypesX, nonDetCmpTc,
+ -- * Type equality
+ eqType, eqTypeIgnoringMultiplicity, eqTypeX, eqTypes,
eqVarBndrs,
- CmpTypeOpt (..), defaultCmpTypeOpt,
pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck,
tcEqTyConApps,
mayLookIdentical,
+ -- * Type comparison
+ nonDetCmpType,
+
-- * Visiblity comparision
eqForAllVis, cmpForAllVis
@@ -30,10 +31,12 @@ import GHC.Core.Type( typeKind, coreView, tcSplitAppTyNoView_maybe, splitAppTyNo
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.FVs
import GHC.Core.TyCon
+import GHC.Core.Multiplicity( MultiplicityFlag(..) )
import GHC.Types.Var
import GHC.Types.Unique
import GHC.Types.Var.Env
+import GHC.Types.Var.Set
import GHC.Utils.Outputable
import GHC.Utils.Misc
@@ -42,7 +45,6 @@ import GHC.Utils.Panic
import GHC.Base (reallyUnsafePtrEquality#)
import qualified Data.Semigroup as S
-import GHC.Core.Multiplicity
{- GHC.Core.TyCo.Compare overview
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -54,7 +56,11 @@ so it currently sits "on top of" GHC.Core.Type.
{- *********************************************************************
* *
- Type equality
+ Type equality
+
+ We don't use (==) from class Eq, partly so that we know where
+ type equality is called, and partly because there are multiple
+ variants.
* *
********************************************************************* -}
@@ -74,6 +80,93 @@ that needs to be updated.
* See Historical Note [Typechecker equality vs definitional equality]
below
+Note [Casts and coercions in type comparision]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+As (EQTYPE) in Note [Non-trivial definitional equality] says, our
+general plan, implemented by `fullEq`, is:
+ (1) ignore both casts and coercions when comparing types,
+ (2) instead, compare the /kinds/ of the two types,
+ as well as the types themselves
+
+If possible we want to avoid step (2), comparing the kinds; doing so involves
+calling `typeKind` and doing another comparision.
+
+When can we avoid doing so? Answer: we can certainly avoid doing so if the
+types we are comparing have no casts or coercions. But we can do better.
+Consider
+ eqType (TyConApp T [s1, ..., sn]) (TyConApp T [t1, .., tn])
+We are going to call (eqType s1 t1), (eqType s2 t2) etc.
+
+The kinds of `s1` and `t1` must be equal, because these TyConApps are well-kinded,
+and both TyConApps are headed by the same T. So the first recursive call to `eqType`
+certainly doesn't need to check kinds. If that call returns False, we stop. Otherwise,
+we know that `s1` and `t1` are themselves equal (not just their kinds). This
+makes the kinds of `s2` and `t2` to be equal, because those kinds come from the
+kind of T instantiated with `s1` and `t1` -- which are the same. Thus we do not
+need to check the kinds of `s2` and `t2`. By induction, we don't need to check
+the kinds of *any* of the types in a TyConApp, and we also do not need to check
+the kinds of the TyConApps themselves.
+
+Conclusion:
+
+* casts and coercions under a TyConApp don't matter -- even including type synonyms
+
+* In step (2), use `hasCasts` to tell if there are any casts to worry about. It
+ does not look very deep, because TyConApps and FunTys are so common, and it
+ doesn't allocate. The only recursive cases are AppTy and ForAllTy.
+
+Alternative implementation. Instead of `hasCasts`, we could make the
+generic_eq_type function return
+ data EqResult = NotEq | EqWithNoCasts | EqWithCasts
+Practically free; but stylistically I prefer useing `hasCasts`:
+ * `generic_eq_type` can just uses familiar booleans
+ * There is a lot more branching with the three-value variant.
+ * It separates concerns. No need to think about cast-tracking when doing the
+ equality comparison.
+ * Indeed sometimes we omit the kind check unconditionally, so tracking it is just wasted
+ work.
+I did try both; there was no perceptible perf difference so I chose `hasCasts` version.
+
+Note [Equality on AppTys]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+In our cast-ignoring equality, we want to say that the following two
+are equal:
+
+ (Maybe |> co) (Int |> co') ~? Maybe Int
+
+But the left is an AppTy while the right is a TyConApp. The solution is
+to use splitAppTyNoView_maybe to break up the TyConApp into its pieces and
+then continue. Easy to do, but also easy to forget to do.
+
+Note [Comparing nullary type synonyms]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider the task of testing equality between two 'Type's of the form
+
+ TyConApp tc []
+
+where @tc@ is a type synonym. A naive way to perform this comparison these
+would first expand the synonym and then compare the resulting expansions.
+
+However, this is obviously wasteful and the RHS of @tc@ may be large; it is
+much better to rather compare the TyCons directly. Consequently, before
+expanding type synonyms in type comparisons we first look for a nullary
+TyConApp and simply compare the TyCons if we find one. Of course, if we find
+that the TyCons are *not* equal then we still need to perform the expansion as
+their RHSs may still be equal.
+
+We perform this optimisation in a number of places:
+
+ * GHC.Core.Types.eqType
+ * GHC.Core.Types.nonDetCmpType
+ * GHC.Core.Unify.unify_ty
+ * GHC.Tc.Solver.Equality.can_eq_nc'
+ * TcUnify.uType
+
+This optimisation is especially helpful for the ubiquitous GHC.Types.Type,
+since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications
+whenever possible. See Note [Using synonyms to compress types] in
+GHC.Core.Type for details.
+
Note [Type comparisons using object pointer comparisons]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Quite often we substitute the type from a definition site into
@@ -83,6 +176,21 @@ The type of every `x` will often be represented by a single object
in the heap. We can take advantage of this by shortcutting the equality
check if two types are represented by the same pointer under the hood.
In some cases this reduces compiler allocations by ~2%.
+
+See Note [Pointer comparison operations] in GHC.Builtin.primops.txt.pp
+
+Note [Respecting multiplicity when comparing types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Generally speaking, we respect multiplicities (i.e. the linear part of the type
+system) when comparing types. Doing so is of course crucial during typechecking.
+
+But for reasons described in Note [Linting linearity] in GHC.Core.Lint, it is hard
+to ensure that Core is always type-correct when it comes to linearity. So
+* `eqTypeIgnoringMultiplicity` provides a way to compare types that /ignores/ multiplicities
+* We use this multiplicity-blind comparison very occasionally, notably
+ - in Core Lint: see Note [Linting linearity] in GHC.Core.Lint
+ - in rule matching: see Note [Rewrite rules ignore multiplicities in FunTy]
+ in GHC.Core.Unify
-}
@@ -90,21 +198,12 @@ tcEqKind :: HasDebugCallStack => Kind -> Kind -> Bool
tcEqKind = tcEqType
tcEqType :: HasDebugCallStack => Type -> Type -> Bool
--- ^ tcEqType implements typechecker equality
--- It behaves just like eqType, but is implemented
--- differently (for now)
-tcEqType ty1 ty2
- = tcEqTypeNoSyns ki1 ki2
- && tcEqTypeNoSyns ty1 ty2
- where
- ki1 = typeKind ty1
- ki2 = typeKind ty2
+tcEqType = eqType
-- | Just like 'tcEqType', but will return True for types of different kinds
-- as long as their non-coercion structure is identical.
tcEqTypeNoKindCheck :: Type -> Type -> Bool
-tcEqTypeNoKindCheck ty1 ty2
- = tcEqTypeNoSyns ty1 ty2
+tcEqTypeNoKindCheck = eqTypeNoKindCheck
-- | Check whether two TyConApps are the same; if the number of arguments
-- are different, just checks the common prefix of arguments.
@@ -116,175 +215,220 @@ tcEqTyConApps tc1 args1 tc2 args2
-- any difference in the kinds of later arguments would show up
-- as differences in earlier (dependent) arguments
-{-
-Note [Specialising tc_eq_type]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The type equality predicates in Type are hit pretty hard during typechecking.
-Consequently we take pains to ensure that these paths are compiled to
-efficient, minimally-allocating code.
-
-To this end we place an INLINE on tc_eq_type, ensuring that it is inlined into
-its publicly-visible interfaces (e.g. tcEqType). In addition to eliminating
-some dynamic branches, this allows the simplifier to eliminate the closure
-allocations that would otherwise be necessary to capture the two boolean "mode"
-flags. This reduces allocations by a good fraction of a percent when compiling
-Cabal.
-
-See #19226.
--}
-
-mayLookIdentical :: Type -> Type -> Bool
--- | Returns True if the /visible/ part of the types
--- might look equal, even if they are really unequal (in the invisible bits)
---
--- This function is very similar to tc_eq_type but it is much more
--- heuristic. Notably, it is always safe to return True, even with types
--- that might (in truth) be unequal -- this affects error messages only
--- (Originally there were one function with an extra flag, but the result
--- was hard to understand.)
-mayLookIdentical orig_ty1 orig_ty2
- = go orig_env orig_ty1 orig_ty2
- where
- orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2]
-
- go :: RnEnv2 -> Type -> Type -> Bool
- -- See Note [Comparing nullary type synonyms]
- go _ (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2 = True
-
- go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2
- go env t1 t2 | Just t2' <- coreView t2 = go env t1 t2'
- go env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 == rnOccR env tv2
- go _ (LitTy lit1) (LitTy lit2) = lit1 == lit2
- go env (CastTy t1 _) t2 = go env t1 t2
- go env t1 (CastTy t2 _) = go env t1 t2
- go _ (CoercionTy {}) (CoercionTy {}) = True
-
- go env (ForAllTy (Bndr tv1 vis1) ty1)
- (ForAllTy (Bndr tv2 vis2) ty2)
- = vis1 `eqForAllVis` vis2 -- See Note [ForAllTy and type equality]
- && go (rnBndr2 env tv1 tv2) ty1 ty2
- -- Visible stuff only: ignore kinds of binders
-
- -- If we have (forall (r::RunTimeRep). ty1 ~ blah) then respond
- -- with True. Reason: the type pretty-printer defaults RuntimeRep
- -- foralls (see Ghc.Iface.Type.hideNonStandardTypes). That can make,
- -- say (forall r. TYPE r -> Type) into (Type -> Type), so it looks the
- -- same as a very different type (#24553). By responding True, we
- -- tell GHC (see calls of mayLookIdentical) to display without defaulting.
- -- See Note [Showing invisible bits of types in error messages]
- -- in GHC.Tc.Errors.Ppr
- go _ (ForAllTy b _) _ | isDefaultableBndr b = True
- go _ _ (ForAllTy b _) | isDefaultableBndr b = True
+-- | Type equality on lists of types, looking through type synonyms
+eqTypes :: [Type] -> [Type] -> Bool
+eqTypes [] [] = True
+eqTypes (t1:ts1) (t2:ts2) = eqType t1 t2 && eqTypes ts1 ts2
+eqTypes _ _ = False
- go env (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2)
- = go env arg1 arg2 && go env res1 res2 && go env w1 w2
- -- Visible stuff only: ignore agg kinds
+eqVarBndrs :: HasCallStack => RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2
+-- Check that the var lists are the same length
+-- and have matching kinds; if so, extend the RnEnv2
+-- Returns Nothing if they don't match
+eqVarBndrs env [] []
+ = Just env
+eqVarBndrs env (tv1:tvs1) (tv2:tvs2)
+ | eqTypeX env (varType tv1) (varType tv2)
+ = eqVarBndrs (rnBndr2 env tv1 tv2) tvs1 tvs2
+eqVarBndrs _ _ _= Nothing
- -- See Note [Equality on AppTys] in GHC.Core.Type
- go env (AppTy s1 t1) ty2
- | Just (s2, t2) <- tcSplitAppTyNoView_maybe ty2
- = go env s1 s2 && go env t1 t2
- go env ty1 (AppTy s2 t2)
- | Just (s1, t1) <- tcSplitAppTyNoView_maybe ty1
- = go env s1 s2 && go env t1 t2
+initRnEnv :: Type -> Type -> RnEnv2
+initRnEnv ta tb = mkRnEnv2 $ mkInScopeSet $
+ tyCoVarsOfType ta `unionVarSet` tyCoVarsOfType tb
- go env (TyConApp tc1 ts1) (TyConApp tc2 ts2)
- = tc1 == tc2 && gos env (tyConBinders tc1) ts1 ts2
+eqTypeNoKindCheck :: Type -> Type -> Bool
+eqTypeNoKindCheck ty1 ty2 = eq_type_expand_respect ty1 ty2
- go _ _ _ = False
-
- gos :: RnEnv2 -> [TyConBinder] -> [Type] -> [Type] -> Bool
- gos _ _ [] [] = True
- gos env bs (t1:ts1) (t2:ts2)
- | (invisible, bs') <- case bs of
- [] -> (False, [])
- (b:bs) -> (isInvisibleTyConBinder b, bs)
- = (invisible || go env t1 t2) && gos env bs' ts1 ts2
-
- gos _ _ _ _ = False
+-- | Type equality comparing both visible and invisible arguments,
+-- expanding synonyms and respecting multiplicities.
+eqType :: HasCallStack => Type -> Type -> Bool
+eqType ta tb = fullEq eq_type_expand_respect ta tb
+-- | Compare types with respect to a (presumably) non-empty 'RnEnv2'.
+eqTypeX :: HasCallStack => RnEnv2 -> Type -> Type -> Bool
+eqTypeX env ta tb = fullEq (eq_type_expand_respect_x env) ta tb
--- | Type equality comparing both visible and invisible arguments and expanding
--- type synonyms.
-tcEqTypeNoSyns :: Type -> Type -> Bool
-tcEqTypeNoSyns ta tb = tc_eq_type False ta tb
+eqTypeIgnoringMultiplicity :: Type -> Type -> Bool
+-- See Note [Respecting multiplicity when comparing types]
+eqTypeIgnoringMultiplicity ta tb = fullEq eq_type_expand_ignore ta tb
-- | Like 'pickyEqTypeVis', but returns a Bool for convenience
pickyEqType :: Type -> Type -> Bool
-- Check when two types _look_ the same, _including_ synonyms.
-- So (pickyEqType String [Char]) returns False
-- This ignores kinds and coercions, because this is used only for printing.
-pickyEqType ty1 ty2 = tc_eq_type True ty1 ty2
+pickyEqType ta tb = eq_type_keep_respect ta tb
--- | Real worker for 'tcEqType'. No kind check!
-tc_eq_type :: Bool -- ^ True <=> do not expand type synonyms
- -> Type -> Type
- -> Bool
--- Flags False, False is the usual setting for tc_eq_type
--- See Note [Computing equality on types] in Type
-{-# INLINE tc_eq_type #-} -- See Note [Specialising tc_eq_type].
-tc_eq_type keep_syns orig_ty1 orig_ty2
- = go orig_env orig_ty1 orig_ty2
- where
- orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2]
+{- Note [Specialising type equality]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The type equality predicates in Type are hit pretty hard by GHC. Consequently
+we take pains to ensure that these paths are compiled to efficient,
+minimally-allocating code. Plan:
- go :: RnEnv2 -> Type -> Type -> Bool
- -- See Note [Comparing nullary type synonyms]
- go _ (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2 = True
+* The main workhorse is `inline_generic_eq_type_x`. It is /non-recursive/
+ and is marked INLINE.
- go env t1 t2 | not keep_syns, Just t1' <- coreView t1 = go env t1' t2
- go env t1 t2 | not keep_syns, Just t2' <- coreView t2 = go env t1 t2'
+* `inline_generic_eq_type_x` has various parameters that control what it does:
+ * syn_flag::SynFlag whether type synonyms are expanded or kept.
+ * mult_flag::MultiplicityFlag whether multiplicities are ignored or respected
+ * mb_env::Maybe RnEnv2 an optional RnEnv2.
- go env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 == rnOccR env tv2
- go _ (LitTy lit1) (LitTy lit2) = lit1 == lit2
- go env (CastTy t1 _) t2 = go env t1 t2
- go env t1 (CastTy t2 _) = go env t1 t2
- go _ (CoercionTy {}) (CoercionTy {}) = True
+* `inline_generic_eq_type_x` has a handful of call sites, namely the ones
+ in `eq_type_expand_respect`, `eq_type_expand_repect_x` etc. It inlines
+ at all these sites, specialising to the data values passed for the
+ control parameters.
- go env (ForAllTy (Bndr tv1 vis1) ty1)
- (ForAllTy (Bndr tv2 vis2) ty2)
- = vis1 `eqForAllVis` vis2 -- See Note [ForAllTy and type equality]
- && go env (varType tv1) (varType tv2)
- && go (rnBndr2 env tv1 tv2) ty1 ty2
+* All /other/ calls to `inline_generic_eq_type_x` go via
+ generic_eq_type_x = inline_generic_eq_type_x
+ {-# NOINLNE generic_eq_type_x #-}
+ The idea is that all calls to `generic_eq_type_x` are specialised by the
+ RULES, so this NOINLINE version is seldom, if ever, actually called.
+
+* For each of specialised copy of `inline_generic_eq_type_x, there is a
+ corresponding rewrite RULE that rewrites a call to (generic_eq_type_x args)
+ into the appropriate specialied version.
+
+See #19226.
+-}
+
+-- | This flag controls whether we expand synonyms during comparison
+data SynFlag = ExpandSynonyms | KeepSynonyms
+
+eq_type_expand_respect, eq_type_expand_ignore, eq_type_keep_respect
+ :: Type -> Type -> Bool
+eq_type_expand_respect_x, eq_type_expand_ignore_x, eq_type_keep_respect_x
+ :: RnEnv2 -> Type -> Type -> Bool
+
+eq_type_expand_respect = inline_generic_eq_type_x ExpandSynonyms RespectMultiplicities Nothing
+eq_type_expand_respect_x env = inline_generic_eq_type_x ExpandSynonyms RespectMultiplicities (Just env)
+eq_type_expand_ignore = inline_generic_eq_type_x ExpandSynonyms IgnoreMultiplicities Nothing
+eq_type_expand_ignore_x env = inline_generic_eq_type_x ExpandSynonyms IgnoreMultiplicities (Just env)
+eq_type_keep_respect = inline_generic_eq_type_x KeepSynonyms RespectMultiplicities Nothing
+eq_type_keep_respect_x env = inline_generic_eq_type_x KeepSynonyms RespectMultiplicities (Just env)
+
+{-# RULES
+"eqType1" generic_eq_type_x ExpandSynonyms RespectMultiplicities Nothing
+ = eq_type_expand_respect
+"eqType2" forall env. generic_eq_type_x ExpandSynonyms RespectMultiplicities (Just env)
+ = eq_type_expand_respect_x env
+"eqType3" generic_eq_type_x ExpandSynonyms IgnoreMultiplicities Nothing
+ = eq_type_expand_ignore
+"eqType4" forall env. generic_eq_type_x ExpandSynonyms IgnoreMultiplicities (Just env)
+ = eq_type_expand_ignore_x env
+"eqType5" generic_eq_type_x KeepSynonyms RespectMultiplicities Nothing
+ = eq_type_keep_respect
+"eqType6" forall env. generic_eq_type_x KeepSynonyms RespectMultiplicities (Just env)
+ = eq_type_keep_respect_x env
+ #-}
+
+-- ---------------------------------------------------------------
+-- | Real worker for 'eqType'. No kind check!
+-- Inline it at the (handful of local) call sites
+-- The "generic" bit refers to the flag paramerisation
+-- See Note [Specialising type equality].
+generic_eq_type_x, inline_generic_eq_type_x
+ :: SynFlag -> MultiplicityFlag -> Maybe RnEnv2 -> Type -> Type -> Bool
+
+{-# NOINLINE generic_eq_type_x #-}
+generic_eq_type_x = inline_generic_eq_type_x
+-- See Note [Computing equality on types] in Type
+
+{-# INLINE inline_generic_eq_type_x #-}
+-- This non-recursive function can inline at its (few) call sites. The
+-- recursion goes via generic_eq_type_x, which is the loop-breaker.
+inline_generic_eq_type_x syn_flag mult_flag mb_env
+ = \ t1 t2 -> t1 `seq` t2 `seq`
+ let go = generic_eq_type_x syn_flag mult_flag mb_env
+ -- Abbreviation for recursive calls
+ in case (t1,t2) of
+ _ | 1# <- reallyUnsafePtrEquality# t1 t2 -> True
+ -- See Note [Type comparisons using object pointer comparisons]
+
+ (TyConApp tc1 [], TyConApp tc2 []) | tc1 == tc2 -> True
+ -- See Note [Comparing nullary type synonyms]
+
+ _ | ExpandSynonyms <- syn_flag, Just t1' <- coreView t1 -> go t1' t2
+ | ExpandSynonyms <- syn_flag, Just t2' <- coreView t2 -> go t1 t2'
+
+ (TyVarTy tv1, TyVarTy tv2)
+ -> case mb_env of
+ Nothing -> tv1 == tv2
+ Just env -> rnOccL env tv1 == rnOccR env tv2
+
+ (LitTy lit1, LitTy lit2) -> lit1 == lit2
+ (CastTy t1' _, _) -> go t1' t2 -- Ignore casts
+ (_, CastTy t2' _) -> go t1 t2' -- Ignore casts
+ (CoercionTy {}, CoercionTy {}) -> True -- Ignore coercions
-- Make sure we handle all FunTy cases since falling through to the
-- AppTy case means that tcSplitAppTyNoView_maybe may see an unzonked
-- kind variable, which causes things to blow up.
-- See Note [Equality on FunTys] in GHC.Core.TyCo.Rep: we must check
-- kinds here
- go env (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2)
- = go env (typeKind arg1) (typeKind arg2) &&
- go env (typeKind res1) (typeKind res2) &&
- go env arg1 arg2 && go env res1 res2 && go env w1 w2
+ (FunTy _ w1 arg1 res1, FunTy _ w2 arg2 res2)
+ -> fullEq go arg1 arg2
+ && fullEq go res1 res2
+ && (case mult_flag of
+ RespectMultiplicities -> go w1 w2
+ IgnoreMultiplicities -> True)
-- See Note [Equality on AppTys] in GHC.Core.Type
- go env (AppTy s1 t1) ty2
- | Just (s2, t2) <- tcSplitAppTyNoView_maybe ty2
- = go env s1 s2 && go env t1 t2
- go env ty1 (AppTy s2 t2)
- | Just (s1, t1) <- tcSplitAppTyNoView_maybe ty1
- = go env s1 s2 && go env t1 t2
-
- go env (TyConApp tc1 ts1) (TyConApp tc2 ts2)
- = tc1 == tc2 && gos env ts1 ts2
-
- go _ _ _ = False
-
- gos _ [] [] = True
- gos env (t1:ts1) (t2:ts2) = go env t1 t2 && gos env ts1 ts2
- gos _ _ _ = False
+ (AppTy s1 t1', _)
+ | Just (s2, t2') <- tcSplitAppTyNoView_maybe t2
+ -> go s1 s2 && go t1' t2'
+ (_, AppTy s2 t2')
+ | Just (s1, t1') <- tcSplitAppTyNoView_maybe t1
+ -> go s1 s2 && go t1' t2'
+
+ (TyConApp tc1 ts1, TyConApp tc2 ts2)
+ | tc1 == tc2 -> gos ts1 ts2
+ | otherwise -> False
+ where
+ gos [] [] = True
+ gos (t1:ts1) (t2:ts2) = go t1 t2 && gos ts1 ts2
+ gos _ _ = False
+
+ (ForAllTy (Bndr tv1 vis1) body1, ForAllTy (Bndr tv2 vis2) body2)
+ -> case mb_env of
+ Nothing -> generic_eq_type_x syn_flag mult_flag
+ (Just (initRnEnv t1 t2)) t1 t2
+ Just env
+ | vis1 `eqForAllVis` vis2 -- See Note [ForAllTy and type equality]
+ -> go (varType tv1) (varType tv2) -- Always do kind-check
+ && generic_eq_type_x syn_flag mult_flag
+ (Just (rnBndr2 env tv1 tv2)) body1 body2
+ | otherwise
+ -> False
+
+ _ -> False
+
+fullEq :: (Type -> Type -> Bool) -> Type -> Type -> Bool
+-- Do "full equality" including the kind check
+-- See Note [Casts and coercions in type comparision]
+{-# INLINE fullEq #-}
+fullEq eq ty1 ty2
+ = case eq ty1 ty2 of
+ False -> False
+ True | hasCasts ty1 || hasCasts ty2
+ -> eq (typeKind ty1) (typeKind ty2)
+ | otherwise
+ -> True
+
+hasCasts :: Type -> Bool
+-- Fast, does not look deep, does not allocate
+hasCasts (CastTy {}) = True
+hasCasts (CoercionTy {}) = True
+hasCasts (AppTy t1 t2) = hasCasts t1 || hasCasts t2
+hasCasts (ForAllTy _ ty) = hasCasts ty
+hasCasts _ = False -- TyVarTy, TyConApp, FunTy, LitTy
-isDefaultableBndr :: ForAllTyBinder -> Bool
--- This function should line up with the defaulting done
--- by GHC.Iface.Type.defaultIfaceTyVarsOfKind
--- See Note [Showing invisible bits of types in error messages]
--- in GHC.Tc.Errors.Ppr
-isDefaultableBndr (Bndr tv vis)
- = isInvisibleForAllTyFlag vis && is_defaultable (tyVarKind tv)
- where
- is_defaultable ki = isLevityTy ki || isRuntimeRepTy ki || isMultiplicityTy ki
+{- *********************************************************************
+* *
+ Comparing ForAllTyFlags
+* *
+********************************************************************* -}
-- | Do these denote the same level of visibility? 'Required'
-- arguments are visible, others are not. So this function
@@ -444,94 +588,13 @@ is more finer-grained than definitional equality in two places:
************************************************************************
* *
Comparison for types
- (We don't use instances so that we know where it happens)
+
+ Not so heavily used, less carefully optimised
* *
************************************************************************
-Note [Equality on AppTys]
-~~~~~~~~~~~~~~~~~~~~~~~~~
-In our cast-ignoring equality, we want to say that the following two
-are equal:
-
- (Maybe |> co) (Int |> co') ~? Maybe Int
-
-But the left is an AppTy while the right is a TyConApp. The solution is
-to use splitAppTyNoView_maybe to break up the TyConApp into its pieces and
-then continue. Easy to do, but also easy to forget to do.
-
-Note [Comparing nullary type synonyms]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider the task of testing equality between two 'Type's of the form
-
- TyConApp tc []
-
-where @tc@ is a type synonym. A naive way to perform this comparison these
-would first expand the synonym and then compare the resulting expansions.
-
-However, this is obviously wasteful and the RHS of @tc@ may be large; it is
-much better to rather compare the TyCons directly. Consequently, before
-expanding type synonyms in type comparisons we first look for a nullary
-TyConApp and simply compare the TyCons if we find one. Of course, if we find
-that the TyCons are *not* equal then we still need to perform the expansion as
-their RHSs may still be equal.
-
-We perform this optimisation in a number of places:
-
- * GHC.Core.Types.eqType
- * GHC.Core.Types.nonDetCmpType
- * GHC.Core.Unify.unify_ty
- * GHC.Tc.Solver.Equality.can_eq_nc'
- * TcUnify.uType
-
-This optimisation is especially helpful for the ubiquitous GHC.Types.Type,
-since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications
-whenever possible. See Note [Using synonyms to compress types] in
-GHC.Core.Type for details.
-
--}
-
-eqType :: Type -> Type -> Bool
--- ^ Type equality on source types. Does not look through @newtypes@,
--- 'PredType's or type families, but it does look through type synonyms.
--- This first checks that the kinds of the types are equal and then
--- checks whether the types are equal, ignoring casts and coercions.
--- (The kind check is a recursive call, but since all kinds have type
--- @Type@, there is no need to check the types of kinds.)
--- See also Note [Non-trivial definitional equality] in "GHC.Core.TyCo.Rep".
-eqType t1 t2 = isEqual $ nonDetCmpType t1 t2
- -- It's OK to use nonDetCmpType here and eqType is deterministic,
- -- nonDetCmpType does equality deterministically
-
-eqTypeOpt :: CmpTypeOpt -> Type -> Type -> Bool
-eqTypeOpt opt t1 t2 = isEqual $ nonDetCmpTypeOpt opt t1 t2
-
--- | Compare types with respect to a (presumably) non-empty 'RnEnv2'.
-eqTypeX :: RnEnv2 -> Type -> Type -> Bool
-eqTypeX env t1 t2 = isEqual $ nonDetCmpTypeX defaultCmpTypeOpt env t1 t2
- -- It's OK to use nonDetCmpType here and eqTypeX is deterministic,
- -- nonDetCmpTypeX does equality deterministically
-
--- | Type equality on lists of types, looking through type synonyms
--- but not newtypes.
-eqTypes :: [Type] -> [Type] -> Bool
-eqTypes tys1 tys2 = isEqual $ nonDetCmpTypes tys1 tys2
- -- It's OK to use nonDetCmpType here and eqTypes is deterministic,
- -- nonDetCmpTypes does equality deterministically
-
-eqVarBndrs :: RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2
--- Check that the var lists are the same length
--- and have matching kinds; if so, extend the RnEnv2
--- Returns Nothing if they don't match
-eqVarBndrs env [] []
- = Just env
-eqVarBndrs env (tv1:tvs1) (tv2:tvs2)
- | eqTypeX env (varType tv1) (varType tv2)
- = eqVarBndrs (rnBndr2 env tv1 tv2) tvs1 tvs2
-eqVarBndrs _ _ _= Nothing
-
-- Now here comes the real worker
-{-
Note [nonDetCmpType nondeterminism]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
nonDetCmpType is implemented in terms of nonDetCmpTypeX. nonDetCmpTypeX
@@ -541,27 +604,20 @@ comparing type variables is nondeterministic, note the call to nonDetCmpVar in
nonDetCmpTypeX.
See Note [Unique Determinism] for more details.
-}
-nonDetCmpType :: Type -> Type -> Ordering
-nonDetCmpType = nonDetCmpTypeOpt defaultCmpTypeOpt
-nonDetCmpTypeOpt :: CmpTypeOpt -> Type -> Type -> Ordering
-nonDetCmpTypeOpt _ !t1 !t2
+nonDetCmpType :: Type -> Type -> Ordering
+{-# INLINE nonDetCmpType #-}
+nonDetCmpType !t1 !t2
-- See Note [Type comparisons using object pointer comparisons]
| 1# <- reallyUnsafePtrEquality# t1 t2
= EQ
-nonDetCmpTypeOpt _ (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2
+nonDetCmpType (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2
= EQ
-nonDetCmpTypeOpt opt t1 t2
+nonDetCmpType t1 t2
-- we know k1 and k2 have the same kind, because they both have kind *.
- = nonDetCmpTypeX opt rn_env t1 t2
+ = nonDetCmpTypeX rn_env t1 t2
where
rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes [t1, t2]))
-{-# INLINE nonDetCmpType #-}
-
-nonDetCmpTypes :: [Type] -> [Type] -> Ordering
-nonDetCmpTypes ts1 ts2 = nonDetCmpTypesX rn_env ts1 ts2
- where
- rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes (ts1 ++ ts2)))
-- | An ordering relation between two 'Type's (known below as @t1 :: k1@
-- and @t2 :: k2@)
@@ -573,10 +629,11 @@ data TypeOrdering = TLT -- ^ @t1 < t2@
| TGT -- ^ @t1 > t2@
deriving (Eq, Ord, Enum, Bounded)
-nonDetCmpTypeX :: CmpTypeOpt -> RnEnv2 -> Type -> Type -> Ordering -- Main workhorse
+nonDetCmpTypeX :: RnEnv2 -> Type -> Type -> Ordering -- Main workhorse
-- See Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep
-- See Note [Computing equality on types]
-nonDetCmpTypeX opt env orig_t1 orig_t2 =
+ -- Always respects multiplicities, unlike eqType
+nonDetCmpTypeX env orig_t1 orig_t2 =
case go env orig_t1 orig_t2 of
-- If there are casts then we also need to do a comparison of
-- the kinds of the types being compared
@@ -635,13 +692,9 @@ nonDetCmpTypeX opt env orig_t1 orig_t2 =
go env (FunTy _ w1 s1 t1) (FunTy _ w2 s2 t2)
-- NB: nonDepCmpTypeX does the kind check requested by
-- Note [Equality on FunTys] in GHC.Core.TyCo.Rep
- = liftOrdering (nonDetCmpTypeX opt env s1 s2 S.<> nonDetCmpTypeX opt env t1 t2)
- `thenCmpTy` cmp_mults
+ = liftOrdering (nonDetCmpTypeX env s1 s2 S.<> nonDetCmpTypeX env t1 t2)
+ `thenCmpTy` go env w1 w2
-- Comparing multiplicities last because the test is usually true
- where
- cmp_mults = case cmp_multiplicity_in_funty opt of
- RespectMultiplicities -> go env w1 w2
- IgnoreMultiplicities -> TEQ
go env (TyConApp tc1 tys1) (TyConApp tc2 tys2)
= liftOrdering (tc1 `nonDetCmpTc` tc2) `thenCmpTy` gos env tys1 tys2
@@ -672,36 +725,6 @@ nonDetCmpTypeX opt env orig_t1 orig_t2 =
gos _ _ [] = TGT
gos env (ty1:tys1) (ty2:tys2) = go env ty1 ty2 `thenCmpTy` gos env tys1 tys2
-{- Note [Respecting multiplicity when comparing types]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Generally speaking, we respect multiplicities (i.e. the linear part of the type
-system) when comparing types. Doing so is of course crucial during typechecking.
-
-But for reasons described in Note [Linting linearity] in GHC.Core.Lint, it is hard
-to ensure that Core is always type-correct when it comes to linearity. So
-* `CmpTypeOpt` provides a way to compare types that /ignores/ multiplicities
-* We use this multiplicity-blind comparison very occasionally, notably
- - in Core Lint: see Note [Linting linearity] in GHC.Core.Lint
- - in rule matching: see Note [Rewrite rules ignore multiplicities in FunTy]
- in GHC.Core.Unify
--}
-data CmpTypeOpt = CmpTypeOpt
- { -- Whether to consider `a -> b` and `a %1 -> b` distinct or equal. Default:
- -- RespectMultiplicities. See Note [Respecting multiplicity when comparing types].
- cmp_multiplicity_in_funty :: MultiplicityFlag
- }
-
-defaultCmpTypeOpt :: CmpTypeOpt
-defaultCmpTypeOpt = CmpTypeOpt
- { cmp_multiplicity_in_funty = RespectMultiplicities }
-
--------------
-nonDetCmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering
-nonDetCmpTypesX _ [] [] = EQ
-nonDetCmpTypesX env (t1:tys1) (t2:tys2) = nonDetCmpTypeX defaultCmpTypeOpt env t1 t2 S.<>
- nonDetCmpTypesX env tys1 tys2
-nonDetCmpTypesX _ [] _ = LT
-nonDetCmpTypesX _ _ [] = GT
-------------
-- | Compare two 'TyCon's.
@@ -714,4 +737,91 @@ nonDetCmpTc tc1 tc2
u2 = tyConUnique tc2
+{- *********************************************************************
+* *
+ mayLookIdentical
+* *
+********************************************************************* -}
+
+mayLookIdentical :: Type -> Type -> Bool
+-- | Returns True if the /visible/ part of the types
+-- might look equal, even if they are really unequal (in the invisible bits)
+--
+-- This function is very similar to tc_eq_type but it is much more
+-- heuristic. Notably, it is always safe to return True, even with types
+-- that might (in truth) be unequal -- this affects error messages only
+-- (Originally this test was done by eqType with an extra flag, but the result
+-- was hard to understand.)
+mayLookIdentical orig_ty1 orig_ty2
+ = go orig_env orig_ty1 orig_ty2
+ where
+ orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2]
+
+ go :: RnEnv2 -> Type -> Type -> Bool
+ -- See Note [Comparing nullary type synonyms]
+ go _ (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2 = True
+
+ go env t1 t2 | Just t1' <- coreView t1 = go env t1' t2
+ go env t1 t2 | Just t2' <- coreView t2 = go env t1 t2'
+
+ go env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 == rnOccR env tv2
+ go _ (LitTy lit1) (LitTy lit2) = lit1 == lit2
+ go env (CastTy t1 _) t2 = go env t1 t2
+ go env t1 (CastTy t2 _) = go env t1 t2
+ go _ (CoercionTy {}) (CoercionTy {}) = True
+
+ go env (ForAllTy (Bndr tv1 vis1) ty1)
+ (ForAllTy (Bndr tv2 vis2) ty2)
+ = vis1 `eqForAllVis` vis2 -- See Note [ForAllTy and type equality]
+ && go (rnBndr2 env tv1 tv2) ty1 ty2
+ -- Visible stuff only: ignore kinds of binders
+
+ -- If we have (forall (r::RunTimeRep). ty1 ~ blah) then respond
+ -- with True. Reason: the type pretty-printer defaults RuntimeRep
+ -- foralls (see Ghc.Iface.Type.hideNonStandardTypes). That can make,
+ -- say (forall r. TYPE r -> Type) into (Type -> Type), so it looks the
+ -- same as a very different type (#24553). By responding True, we
+ -- tell GHC (see calls of mayLookIdentical) to display without defaulting.
+ -- See Note [Showing invisible bits of types in error messages]
+ -- in GHC.Tc.Errors.Ppr
+ go _ (ForAllTy b _) _ | isDefaultableBndr b = True
+ go _ _ (ForAllTy b _) | isDefaultableBndr b = True
+
+ go env (FunTy _ w1 arg1 res1) (FunTy _ w2 arg2 res2)
+ = go env arg1 arg2 && go env res1 res2 && go env w1 w2
+ -- Visible stuff only: ignore agg kinds
+
+ -- See Note [Equality on AppTys] in GHC.Core.Type
+ go env (AppTy s1 t1) ty2
+ | Just (s2, t2) <- tcSplitAppTyNoView_maybe ty2
+ = go env s1 s2 && go env t1 t2
+ go env ty1 (AppTy s2 t2)
+ | Just (s1, t1) <- tcSplitAppTyNoView_maybe ty1
+ = go env s1 s2 && go env t1 t2
+
+ go env (TyConApp tc1 ts1) (TyConApp tc2 ts2)
+ = tc1 == tc2 && gos env (tyConBinders tc1) ts1 ts2
+
+ go _ _ _ = False
+
+ gos :: RnEnv2 -> [TyConBinder] -> [Type] -> [Type] -> Bool
+ gos _ _ [] [] = True
+ gos env bs (t1:ts1) (t2:ts2)
+ | (invisible, bs') <- case bs of
+ [] -> (False, [])
+ (b:bs) -> (isInvisibleTyConBinder b, bs)
+ = (invisible || go env t1 t2) && gos env bs' ts1 ts2
+
+ gos _ _ _ _ = False
+
+
+isDefaultableBndr :: ForAllTyBinder -> Bool
+-- This function should line up with the defaulting done
+-- by GHC.Iface.Type.defaultIfaceTyVarsOfKind
+-- See Note [Showing invisible bits of types in error messages]
+-- in GHC.Tc.Errors.Ppr
+isDefaultableBndr (Bndr tv vis)
+ = isInvisibleForAllTyFlag vis && is_defaultable (tyVarKind tv)
+ where
+ is_defaultable ki = isLevityTy ki || isRuntimeRepTy ki || isMultiplicityTy ki
=====================================
compiler/GHC/Core/TyCo/Rep.hs
=====================================
@@ -350,14 +350,24 @@ This kind instantiation only happens in TyConApp currently.
Note [Non-trivial definitional equality]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Is Int |> <*> the same as Int? YES! In order to reduce headaches,
-we decide that any reflexive casts in types are just ignored.
-(Indeed they must be. See Note [Respecting definitional equality].)
-More generally, the `eqType` function, which defines Core's type equality
-relation, ignores casts and coercion arguments, as long as the
-two types have the same kind. This allows us to be a little sloppier
-in keeping track of coercions, which is a good thing. It also means
-that eqType does not depend on eqCoercion, which is also a good thing.
+Is ((IO |> co1) Int |> co2) equal to (IO Int)?
+Assume
+ co1 :: (Type->Type) ~ (Type->Wombat)
+ co2 :: Wombat ~ Type
+Well, yes. The casts are just getting in the way.
+See also Note [Respecting definitional equality].
+
+So we do this:
+
+(EQTYPE)
+ The `eqType` function, which defines Core's type equality relation,
+ - /ignores/ casts, and
+ - /ignores/ coercion arguments
+ - /provided/ two types have the same kind
+
+This allows us to be a little sloppier in keeping track of coercions, which is a
+good thing. It also means that eqType does not depend on eqCoercion, which is
+also a good thing.
Why is this sensible? That is, why is something different than α-equivalence
appropriate for the implementation of eqType?
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -233,6 +233,7 @@ ruleMatchTyKiX tmpl_tvs rn_env tenv tmpl target
= case tc_unify_tys (matchBindFun tmpl_tvs) False False
True -- <-- this means to match the kinds
IgnoreMultiplicities
+ -- See Note [Rewrite rules ignore multiplicities in FunTy]
rn_env tenv emptyCvSubstEnv [tmpl] [target] of
Unifiable (tenv', _) -> Just tenv'
_ -> Nothing
@@ -418,10 +419,16 @@ their types unify (see Note [Matching variable types] in GHC.Core.Rules). So
when unifying types for the sake of rule-matching, the unification algorithm
must be able to ignore multiplicities altogether.
-The way we implement this deserves a comment. In unify_ty, `FunTy` is handled as
-if it was a regular type constructor. In this case, and when the types being
-unified are *function* arrows, but not constraint arrows, then the first
-argument is a multiplicity.
+How is this done?
+ (1) The `um_arr_mult` field of `UMEnv` recordsw when we are doing rule-matching,
+ and hence want to ignore multiplicities.
+ (2) The field is set to True in by `ruleMatchTyKiX`.
+ (3) It is consulted when matching `FunTy` in `unify_ty`.
+
+Wrinkle in (3). In `unify_tc_app`, in `unify_ty`, `FunTy` is handled as if it
+was a regular type constructor. In this case, and when the types being unified
+are *function* arrows, but not constraint arrows, then the first argument is a
+multiplicity.
We select this situation by comparing the type constructor with fUNTyCon. In
this case, and this case only, we can safely drop the first argument (using the
@@ -1208,21 +1215,22 @@ unify_ty env ty1 ty2 _kco
where
mb_tc_app1 = splitTyConApp_maybe ty1
mb_tc_app2 = splitTyConApp_maybe ty2
+
unify_tc_app tc tys1 tys2
| tc == fUNTyCon
, IgnoreMultiplicities <- um_arr_mult env
- , (_ : no_mult_tys1) <- tys1
- , (_ : no_mult_tys2) <- tys2
+ , (_mult1 : no_mult_tys1) <- tys1
+ , (_mult2 : no_mult_tys2) <- tys2
= -- We're comparing function arrow types here (not constraint arrow
-- types!), and they have at least one argument, which is the arrow's
-- multiplicity annotation. The flag `um_arr_mult` instructs us to
-- ignore multiplicities in this very case. This is a little tricky: see
- -- Note [Rewrite rules ignore multiplicities in FunTy].
+ -- point (3) in Note [Rewrite rules ignore multiplicities in FunTy].
unify_tys env no_mult_tys1 no_mult_tys2
+
| otherwise
= unify_tys env tys1 tys2
-
-- Applications need a bit of care!
-- They can match FunTy and TyConApp, so use splitAppTy_maybe
-- NB: we've already dealt with type variables,
=====================================
compiler/GHC/Tc/Utils/TcType.hs
=====================================
@@ -96,7 +96,7 @@ module GHC.Tc.Utils.TcType (
-- Re-exported from GHC.Core.TyCo.Compare
-- mainly just for back-compat reasons
- eqType, eqTypes, nonDetCmpType, nonDetCmpTypes, eqTypeX,
+ eqType, eqTypes, nonDetCmpType, eqTypeX,
pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck, mayLookIdentical,
tcEqTyConApps, eqForAllVis, eqVarBndrs,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56f6962b9aa84b5a08b238cc44ed36cfa7b20f68
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56f6962b9aa84b5a08b238cc44ed36cfa7b20f68
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240619/1c901964/attachment-0001.html>
More information about the ghc-commits
mailing list