diff --git a/compiler/GHC/Core/Map/Type.hs b/compiler/GHC/Core/Map/Type.hs
index 3d2a67ad6fb4925a9e8d1d32c9e23bfe236030dc..15c624d8b3f2464193b85c4a61320b27669f1ce2 100644
--- a/compiler/GHC/Core/Map/Type.hs
+++ b/compiler/GHC/Core/Map/Type.hs
@@ -48,10 +48,13 @@ import GHC.Types.Var.Env
 import GHC.Types.Unique.FM
 import GHC.Utils.Outputable
 
+import GHC.Utils.Panic
+
 import qualified Data.Map    as Map
 import qualified Data.IntMap as IntMap
 
 import Control.Monad ( (>=>) )
+import GHC.Data.Maybe
 
 -- NB: Be careful about RULES and type families (#5821).  So we should make sure
 -- to specify @Key TypeMapX@ (and not @DeBruijn Type@, the reduced form)
@@ -291,12 +294,12 @@ fdT k m = foldTM k (tm_var m)
         . foldMaybe k (tm_coerce m)
 
 filterT :: (a -> Bool) -> TypeMapX a -> TypeMapX a
-filterT f (TM { tm_var  = tvar, tm_app = tapp, tm_tyconapp = ttyconapp
+filterT f (TM { tm_var  = tvar, tm_app = tapp, tm_tycon = ttycon
               , tm_funty = tfunty, tm_forall = tforall, tm_tylit = tlit
               , tm_coerce = tcoerce })
   = TM { tm_var    = filterTM f tvar
        , tm_app    = mapTM (filterTM f) tapp
-       , tm_tyconapp = mapDNameEnv (filterTM f) ttyconapp
+       , tm_tycon  = filterTM f ttycon
        , tm_funty  = mapTM (mapTM (filterTM f)) tfunty
        , tm_forall = mapTM (filterTM f) tforall
        , tm_tylit  = filterTM f tlit
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index 122c6f0f2d149f83cfa7fde5350dccfddf6fcdd6..7df953724bd5ce5a93b4490c7949d847d299608c 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -2540,6 +2540,17 @@ ordering leads to nondeterminism. We hit the same problem in the TyVarTy case,
 comparing type variables is nondeterministic, note the call to nonDetCmpVar in
 nonDetCmpTypeX.
 See Note [Unique Determinism] for more details.
+
+Note [Computing equality on types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There are several places within GHC that depend on the precise choice of
+definitional equality used. If we change that definition, all these places
+must be updated. This Note merely serves as a place for all these places
+to refer to, so searching for references to this Note will find every place
+that needs to be updated.
+
+See also Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep.
+
 -}
 
 nonDetCmpType :: Type -> Type -> Ordering
@@ -2569,6 +2580,7 @@ data TypeOrdering = TLT  -- ^ @t1 < t2@
 
 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 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
diff --git a/compiler/GHC/Core/Unify.hs b/compiler/GHC/Core/Unify.hs
index 319007ef0c52b038c92b9b265e7afbec352850a6..2e6b89f355a00d454b952890ebcb6f2856c9a00d 100644
--- a/compiler/GHC/Core/Unify.hs
+++ b/compiler/GHC/Core/Unify.hs
@@ -1067,7 +1067,7 @@ unify_ty :: UMEnv
          -> UM ()
 -- See Note [Specification of unification]
 -- Respects newtypes, PredTypes
-
+-- See Note [Computing equality on types] in GHC.Core.Type
 unify_ty env ty1 ty2 kco
   -- See Note [Comparing nullary type synonyms] in GHC.Core.Type.
   | TyConApp tc1 [] <- ty1
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index 19705341913076397aaa15895283299df2106279..f684f91fb2350d169663fce471f88e0675694d3a 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -1595,6 +1595,7 @@ 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
 tc_eq_type keep_syns vis_only orig_ty1 orig_ty2
   = go orig_env orig_ty1 orig_ty2
   where