Compare types of recursive let-bindings in alpha-equivalence

This commit fixes #20641 by checking the types of recursive
let-bindings when performing alpha-equality.

The `Eq (DeBruijn CoreExpr)` instance now also compares
`BreakPoint`s similarly to `GHC.Core.Utils.eqTickish`, taking
bound variables into account.

In addition, the `Eq (DeBruijn Type)` instance now correctly
compares the kinds of the types when one of them contains a
Cast: the instance is modeled after `nonDetCmpTypeX`.

6 files changed, 254 insertions, 146 deletions

diff --git a/compiler/GHC/Core/Map/Expr.hs b/compiler/GHC/Core/Map/Expr.hs
index 9cff1d33a1..4c79cd880a 100644
--- a/compiler/GHC/Core/Map/Expr.hs
+++ b/compiler/GHC/Core/Map/Expr.hs
@@ -16,6 +16,8 @@
 module GHC.Core.Map.Expr (
    -- * Maps over Core expressions
    CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap,
+   -- * Alpha equality
+   eqDeBruijnExpr, eqCoreExpr,
    -- * 'TrieMap' class reexports
    TrieMap(..), insertTM, deleteTM,
    lkDFreeVar, xtDFreeVar,
@@ -140,33 +142,42 @@ data CoreMapX a
      }
 
 instance Eq (DeBruijn CoreExpr) where
-  D env1 e1 == D env2 e2 = go e1 e2 where
-    go (Var v1) (Var v2)
-      = case (lookupCME env1 v1, lookupCME env2 v2) of
-                            (Just b1, Just b2) -> b1 == b2
-                            (Nothing, Nothing) -> v1 == v2
-                            _ -> False
+    (==) = eqDeBruijnExpr
+
+eqDeBruijnExpr :: DeBruijn CoreExpr -> DeBruijn CoreExpr -> Bool
+eqDeBruijnExpr (D env1 e1) (D env2 e2) = go e1 e2 where
+    go (Var v1) (Var v2) = eqDeBruijnVar (D env1 v1) (D env2 v2)
     go (Lit lit1)    (Lit lit2)      = lit1 == lit2
-    go (Type t1)    (Type t2)        = D env1 t1 == D env2 t2
-    go (Coercion co1) (Coercion co2) = D env1 co1 == D env2 co2
+    -- See Note [Using tcView inside eqDeBruijnType] in GHC.Core.Map.Type
+    go (Type t1)    (Type t2)        = eqDeBruijnType (D env1 t1) (D env2 t2)
+    -- See Note [Alpha-equality for Coercion arguments]
+    go (Coercion {}) (Coercion {}) = True
     go (Cast e1 co1) (Cast e2 co2) = D env1 co1 == D env2 co2 && go e1 e2
     go (App f1 a1)   (App f2 a2)   = go f1 f2 && go a1 a2
-    -- This seems a bit dodgy, see 'eqTickish'
-    go (Tick n1 e1)  (Tick n2 e2)  = n1 == n2 && go e1 e2
+    go (Tick n1 e1) (Tick n2 e2)
+      =  eqDeBruijnTickish (D env1 n1) (D env2 n2)
+      && go e1 e2
 
     go (Lam b1 e1)  (Lam b2 e2)
-      =  D env1 (varType b1) == D env2 (varType b2)
+          -- See Note [Using tcView inside eqDeBruijnType] in GHC.Core.Map.Type
+      =  eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2))
       && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2)
-      && D (extendCME env1 b1) e1 == D (extendCME env2 b2) e2
+      && eqDeBruijnExpr (D (extendCME env1 b1) e1) (D (extendCME env2 b2) e2)
 
     go (Let (NonRec v1 r1) e1) (Let (NonRec v2 r2) e2)
-      =  go r1 r2
-      && D (extendCME env1 v1) e1 == D (extendCME env2 v2) e2
+      =  go r1 r2 -- See Note [Alpha-equality for let-bindings]
+      && eqDeBruijnExpr (D (extendCME env1 v1) e1) (D (extendCME env2 v2) e2)
 
     go (Let (Rec ps1) e1) (Let (Rec ps2) e2)
       = equalLength ps1 ps2
+      -- See Note [Alpha-equality for let-bindings]
+      && all2 (\b1 b2 -> -- See Note [Using tcView inside eqDeBruijnType] in
+                         -- GHC.Core.Map.Type
+                         eqDeBruijnType (D env1 (varType b1))
+                                        (D env2 (varType b2)))
+              bs1 bs2
       && D env1' rs1 == D env2' rs2
-      && D env1' e1  == D env2' e2
+      && eqDeBruijnExpr (D env1' e1) (D env2' e2)
       where
         (bs1,rs1) = unzip ps1
         (bs2,rs2) = unzip ps2
@@ -177,10 +188,60 @@ instance Eq (DeBruijn CoreExpr) where
       | null a1   -- See Note [Empty case alternatives]
       = null a2 && go e1 e2 && D env1 t1 == D env2 t2
       | otherwise
-      =  go e1 e2 && D (extendCME env1 b1) a1 == D (extendCME env2 b2) a2
+      = go e1 e2 && D (extendCME env1 b1) a1 == D (extendCME env2 b2) a2
 
     go _ _ = False
 
+eqDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Bool
+eqDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where
+    go (Breakpoint lext lid lids) (Breakpoint rext rid rids)
+        =  lid == rid
+        && D env1 lids == D env2 rids
+        && lext == rext
+    go l r = l == r
+
+-- Compares for equality, modulo alpha
+eqCoreExpr :: CoreExpr -> CoreExpr -> Bool
+eqCoreExpr e1 e2 = eqDeBruijnExpr (deBruijnize e1) (deBruijnize e2)
+
+{- Note [Alpha-equality for Coercion arguments]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The 'Coercion' constructor only appears in argument positions, and so, if the
+functions are equal, then the arguments must have equal types. Because the
+comparison for coercions (correctly) checks only their types, checking for
+alpha-equality of the coercions is redundant.
+-}
+
+{- Note [Alpha-equality for let-bindings]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+For /recursive/ let-bindings we need to check that the types of the binders
+are alpha-equivalent. Otherwise
+
+  letrec (x : Bool) = x in x
+
+and
+
+  letrec (y : Char) = y in y
+
+would be considered alpha-equivalent, which they are obviously not.
+
+For /non-recursive/ let-bindings, we do not have to check that the types of
+the binders are alpha-equivalent. When the RHSs (the expressions) of the
+non-recursive let-binders are well-formed and well-typed (which we assume they
+are at this point in the compiler), and the RHSs are alpha-equivalent, then the
+bindings must have the same type.
+
+In addition, it is also worth pointing out that
+
+  letrec { x = e1; y = e2 } in b
+
+is NOT considered equal to
+
+  letrec { y = e2; x = e1 } in b
+-}
+
 emptyE :: CoreMapX a
 emptyE = CM { cm_var = emptyTM, cm_lit = emptyTM
             , cm_co = emptyTM, cm_type = emptyTM
diff --git a/compiler/GHC/Core/Map/Type.hs b/compiler/GHC/Core/Map/Type.hs
index 15c624d8b3..1617d93991 100644
--- a/compiler/GHC/Core/Map/Type.hs
+++ b/compiler/GHC/Core/Map/Type.hs
@@ -21,7 +21,7 @@ module GHC.Core.Map.Type (
    -- * Utilities for use by friends only
    TypeMapG, CoercionMapG,
 
-   DeBruijn(..), deBruijnize,
+   DeBruijn(..), deBruijnize, eqDeBruijnType, eqDeBruijnVar,
 
    BndrMap, xtBndr, lkBndr,
    VarMap, xtVar, lkVar, lkDFreeVar, xtDFreeVar,
@@ -182,38 +182,122 @@ instance TrieMap TypeMapX where
    filterTM = filterT
 
 instance Eq (DeBruijn Type) where
-  env_t@(D env t) == env_t'@(D env' t')
-    | Just new_t  <- tcView t  = D env new_t == env_t'
-    | Just new_t' <- tcView t' = env_t       == D env' new_t'
-    | otherwise
-    = case (t, t') of
-        (CastTy t1 _, _)  -> D env t1 == D env t'
-        (_, CastTy t1' _) -> D env t  == D env t1'
-
-        (TyVarTy v, TyVarTy v')
-            -> case (lookupCME env v, lookupCME env' v') of
-                (Just bv, Just bv') -> bv == bv'
-                (Nothing, Nothing)  -> v == v'
-                _ -> False
-                -- See Note [Equality on AppTys] in GHC.Core.Type
-        (AppTy t1 t2, s) | Just (t1', t2') <- repSplitAppTy_maybe s
-            -> D env t1 == D env' t1' && D env t2 == D env' t2'
-        (s, AppTy t1' t2') | Just (t1, t2) <- repSplitAppTy_maybe s
-            -> D env t1 == D env' t1' && D env t2 == D env' t2'
-        (FunTy v1 w1 t1 t2, FunTy v1' w1' t1' t2')
-            -> v1 == v1' &&
-               D env w1 == D env w1' &&
-               D env t1 == D env' t1' &&
-               D env t2 == D env' t2'
-        (TyConApp tc tys, TyConApp tc' tys')
-            -> tc == tc' && D env tys == D env' tys'
-        (LitTy l, LitTy l')
-            -> l == l'
-        (ForAllTy (Bndr tv _) ty, ForAllTy (Bndr tv' _) ty')
-            -> D env (varType tv)      == D env' (varType tv') &&
-               D (extendCME env tv) ty == D (extendCME env' tv') ty'
-        (CoercionTy {}, CoercionTy {})
-            -> True
+  (==) = eqDeBruijnType
+
+{- Note [Using tcView inside eqDeBruijnType]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+`eqDeBruijnType` uses `tcView` and thus treats Type and Constraint as
+distinct -- see Note [coreView vs tcView] in GHC.Core.Type. We do that because
+`eqDeBruijnType` is used in TrieMaps, which are used for instance for instance
+selection in the type checker. [Or at least will be soon.]
+
+However, the odds that we have two expressions that are identical save for the
+'Type'/'Constraint' distinction are low. (Not impossible to do. But doubtful
+anyone has ever done so in the history of Haskell.)
+
+And it's actually all OK: 'eqExpr' is conservative: if `eqExpr e1 e2` returns
+'True', thne it must be that `e1` behaves identically to `e2` in all contexts.
+But if `eqExpr e1 e2` returns 'False', then we learn nothing. The use of
+'tcView' where we expect 'coreView' means 'eqExpr' returns 'False' bit more
+often that it should. This might, say, stop a `RULE` from firing or CSE from
+optimizing an expression. Stopping `RULE` firing is good actually: `RULES` are
+written in Haskell, where `Type /= Constraint`. Stopping CSE is unfortunate,
+but tolerable.
+-}
+
+-- | An equality relation between two 'Type's (known below as @t1 :: k2@
+-- and @t2 :: k2@)
+data TypeEquality = TNEQ -- ^ @t1 /= t2@
+                  | TEQ  -- ^ @t1 ~ t2@ and there are not casts in either,
+                         -- therefore we can conclude @k1 ~ k2@
+                  | TEQX -- ^ @t1 ~ t2@ yet one of the types contains a cast so
+                         -- they may differ in kind
+
+eqDeBruijnType :: DeBruijn Type -> DeBruijn Type -> Bool
+eqDeBruijnType env_t1@(D env1 t1) env_t2@(D env2 t2) =
+    -- See Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep
+    -- See Note [Computing equality on types]
+    case go env_t1 env_t2 of
+      TEQX  -> toBool (go (D env1 k1) (D env2 k2))
+      ty_eq -> toBool ty_eq
+  where
+    k1 = typeKind t1
+    k2 = typeKind t2
+
+    toBool :: TypeEquality -> Bool
+    toBool TNEQ = False
+    toBool _    = True
+
+    liftEquality :: Bool -> TypeEquality
+    liftEquality False = TNEQ
+    liftEquality _     = TEQ
+
+    hasCast :: TypeEquality -> TypeEquality
+    hasCast TEQ = TEQX
+    hasCast eq  = eq
+
+    andEq :: TypeEquality -> TypeEquality -> TypeEquality
+    andEq TNEQ _ = TNEQ
+    andEq TEQX e = hasCast e
+    andEq TEQ  e = e
+
+    -- See Note [Comparing nullary type synonyms] in GHC.Core.Type
+    go (D _ (TyConApp tc1 [])) (D _ (TyConApp tc2 []))
+      | tc1 == tc2
+      = TEQ
+    go env_t@(D env t) env_t'@(D env' t')
+      -- See Note [Using tcView inside eqDeBruijnType]
+      | Just new_t  <- tcView t  = go (D env new_t) env_t'
+      | Just new_t' <- tcView t' = go env_t (D env' new_t')
+      | otherwise
+      = case (t, t') of
+          -- See Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep
+          (CastTy t1 _, _)  -> hasCast (go (D env t1) (D env t'))
+          (_, CastTy t1' _) -> hasCast (go (D env t) (D env t1'))
+
+          (TyVarTy v, TyVarTy v')
+              -> liftEquality $ eqDeBruijnVar (D env v) (D env' v')
+          -- See Note [Equality on AppTys] in GHC.Core.Type
+          (AppTy t1 t2, s) | Just (t1', t2') <- repSplitAppTy_maybe s
+              -> go (D env t1) (D env' t1') `andEq` go (D env t2) (D env' t2')
+          (s, AppTy t1' t2') | Just (t1, t2) <- repSplitAppTy_maybe s
+              -> go (D env t1) (D env' t1') `andEq` go (D env t2) (D env' t2')
+          (FunTy v1 w1 t1 t2, FunTy v1' w1' t1' t2')
+
+              -> liftEquality (v1 == v1') `andEq`
+                 -- NB: eqDeBruijnType does the kind check requested by
+                 -- Note [Equality on FunTys] in GHC.Core.TyCo.Rep
+                 liftEquality (eqDeBruijnType (D env t1) (D env' t1')) `andEq`
+                 liftEquality (eqDeBruijnType (D env t2) (D env' t2')) `andEq`
+                 -- Comparing multiplicities last because the test is usually true
+                 go (D env w1) (D env w1')
+          (TyConApp tc tys, TyConApp tc' tys')
+              -> liftEquality (tc == tc') `andEq` gos env env' tys tys'
+          (LitTy l, LitTy l')
+              -> liftEquality (l == l')
+          (ForAllTy (Bndr tv vis) ty, ForAllTy (Bndr tv' vis') ty')
+              -> -- See Note [ForAllTy and typechecker equality] in
+                 -- GHC.Tc.Solver.Canonical for why we use `sameVis` here
+                 liftEquality (vis `sameVis` vis') `andEq`
+                 go (D env (varType tv)) (D env' (varType tv')) `andEq`
+                 go (D (extendCME env tv) ty) (D (extendCME env' tv') ty')
+          (CoercionTy {}, CoercionTy {})
+              -> TEQ
+          _ -> TNEQ
+
+    gos _  _  []         []         = TEQ
+    gos e1 e2 (ty1:tys1) (ty2:tys2) = go (D e1 ty1) (D e2 ty2) `andEq`
+                                      gos e1 e2 tys1 tys2
+    gos _  _  _          _          = TNEQ
+
+instance Eq (DeBruijn Var) where
+  (==) = eqDeBruijnVar
+
+eqDeBruijnVar :: DeBruijn Var -> DeBruijn Var -> Bool
+eqDeBruijnVar (D env1 v1) (D env2 v2) =
+    case (lookupCME env1 v1, lookupCME env2 v2) of
+        (Just b1, Just b2) -> b1 == b2
+        (Nothing, Nothing) -> v1 == v2
         _ -> False
 
 instance {-# OVERLAPPING #-}
diff --git a/compiler/GHC/Core/Opt/CSE.hs b/compiler/GHC/Core/Opt/CSE.hs
index 6b5a12e9f1..08d4ce193b 100644
--- a/compiler/GHC/Core/Opt/CSE.hs
+++ b/compiler/GHC/Core/Opt/CSE.hs
@@ -20,7 +20,7 @@ import GHC.Types.Id     ( Id, idType, idHasRules, zapStableUnfolding
                         , idInlineActivation, setInlineActivation
                         , zapIdOccInfo, zapIdUsageInfo, idInlinePragma
                         , isJoinId, isJoinId_maybe )
-import GHC.Core.Utils   ( mkAltExpr, eqExpr
+import GHC.Core.Utils   ( mkAltExpr
                         , exprIsTickedString
                         , stripTicksE, stripTicksT, mkTicks )
 import GHC.Core.FVs     ( exprFreeVars )
@@ -652,7 +652,7 @@ cseExpr env (Case e bndr ty alts) = cseCase env e bndr ty alts
 cseCase :: CSEnv -> InExpr -> InId -> InType -> [InAlt] -> OutExpr
 cseCase env scrut bndr ty alts
   = Case scrut1 bndr3 ty' $
-    combineAlts alt_env (map cse_alt alts)
+    combineAlts (map cse_alt alts)
   where
     ty' = substTy (csEnvSubst env) ty
     (cse_done, scrut1) = try_for_cse env scrut
@@ -684,9 +684,9 @@ cseCase env scrut bndr ty alts
         where
           (env', args') = addBinders alt_env args
 
-combineAlts :: CSEnv -> [OutAlt] -> [OutAlt]
+combineAlts :: [OutAlt] -> [OutAlt]
 -- See Note [Combine case alternatives]
-combineAlts env alts
+combineAlts alts
   | (Just alt1, rest_alts) <- find_bndr_free_alt alts
   , Alt _ bndrs1 rhs1 <- alt1
   , let filtered_alts = filterOut (identical_alt rhs1) rest_alts
@@ -697,7 +697,6 @@ combineAlts env alts
   | otherwise
   = alts
   where
-    in_scope = substInScope (csEnvSubst env)
 
     find_bndr_free_alt :: [CoreAlt] -> (Maybe CoreAlt, [CoreAlt])
        -- The (Just alt) is a binder-free alt
@@ -709,7 +708,7 @@ combineAlts env alts
       | otherwise  = case find_bndr_free_alt alts of
                        (mb_bf, alts) -> (mb_bf, alt:alts)
 
-    identical_alt rhs1 (Alt _ _ rhs) = eqExpr in_scope rhs1 rhs
+    identical_alt rhs1 (Alt _ _ rhs) = eqCoreExpr rhs1 rhs
        -- Even if this alt has binders, they will have been cloned
        -- If any of these binders are mentioned in 'rhs', then
        -- 'rhs' won't compare equal to 'rhs1' (which is from an
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index b9b436ffe5..cce8830a97 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -37,8 +37,6 @@ import GHC.Platform
 import {-# SOURCE #-} GHC.Types.Id.Make ( mkPrimOpId, voidPrimId )
 import GHC.Types.Id
 import GHC.Types.Literal
-import GHC.Types.Var.Set
-import GHC.Types.Var.Env
 import GHC.Types.Name.Occurrence ( occNameFS )
 import GHC.Types.Tickish
 import GHC.Types.Name ( Name, nameOccName )
@@ -48,15 +46,15 @@ import GHC.Core
 import GHC.Core.Make
 import GHC.Core.SimpleOpt (  exprIsConApp_maybe, exprIsLiteral_maybe )
 import GHC.Core.DataCon ( DataCon,dataConTagZ, dataConTyCon, dataConWrapId, dataConWorkId )
-import GHC.Core.Utils  ( eqExpr, cheapEqExpr, exprIsHNF, exprType
+import GHC.Core.Utils  ( cheapEqExpr, exprIsHNF, exprType
                        , stripTicksTop, stripTicksTopT, mkTicks )
 import GHC.Core.Multiplicity
-import GHC.Core.FVs
 import GHC.Core.Type
 import GHC.Core.TyCon
    ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon
    , isNewTyCon, tyConDataCons
    , tyConFamilySize )
+import GHC.Core.Map.Expr ( eqCoreExpr )
 
 import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey )
 import GHC.Builtin.Types
@@ -2390,8 +2388,7 @@ match_cstring_foldr_lit foldVariant _ env _
   , unpk `hasKey` foldVariant
   , Just (LitString s1) <- exprIsLiteral_maybe env lit1
   , Just (LitString s2) <- exprIsLiteral_maybe env lit2
-  , let freeVars = (mkInScopeSet (exprFreeVars c1 `unionVarSet` exprFreeVars c2))
-    in eqExpr freeVars c1 c2
+  , eqCoreExpr c1 c2
   , (c1Ticks, c1') <- stripStrTopTicks env c1
   , c2Ticks <- stripStrTopTicksT c2
   = assert (ty1 `eqType` ty2) $
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index ff57df697f..b639629474 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -39,7 +39,7 @@ import GHC.Core.Subst
 import GHC.Core.SimpleOpt ( exprIsLambda_maybe )
 import GHC.Core.FVs       ( exprFreeVars, exprsFreeVars, bindFreeVars
                           , rulesFreeVarsDSet, exprsOrphNames, exprFreeVarsList )
-import GHC.Core.Utils     ( exprType, eqExpr, mkTick, mkTicks
+import GHC.Core.Utils     ( exprType, mkTick, mkTicks
                           , stripTicksTopT, stripTicksTopE
                           , isJoinBind )
 import GHC.Core.Ppr       ( pprRules )
@@ -49,6 +49,7 @@ import GHC.Core.Type as Type
    , mkEmptyTCvSubst, substTy )
 import GHC.Core.Coercion as Coercion
 import GHC.Core.Tidy     ( tidyRules )
+import GHC.Core.Map.Expr ( eqCoreExpr )
 
 import GHC.Tc.Utils.TcType  ( tcSplitTyConApp_maybe )
 import GHC.Builtin.Types    ( anyTypeOfKind )
@@ -968,7 +969,7 @@ match_tmpl_var renv@(RV { rv_lcl = rn_env, rv_fltR = flt_env })
                 -- e.g. match forall a. (\x-> a x) against (\y. y y)
 
   | Just e1' <- lookupVarEnv id_subst v1'
-  = if eqExpr (rnInScopeSet rn_env) e1' e2'
+  = if eqCoreExpr e1' e2'
     then Just subst
     else Nothing
 
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 271380557d..fe831590ef 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -35,7 +35,7 @@ module GHC.Core.Utils (
 
         -- * Equality
         cheapEqExpr, cheapEqExpr', eqExpr,
-        diffExpr, diffBinds,
+        diffBinds,
 
         -- * Lambdas and eta reduction
         tryEtaReduce, zapLamBndrs,
@@ -78,6 +78,7 @@ import GHC.Core.Coercion
 import GHC.Core.Reduction
 import GHC.Core.TyCon
 import GHC.Core.Multiplicity
+import GHC.Core.Map.Expr ( eqCoreExpr )
 
 import GHC.Builtin.Names ( makeStaticName, unsafeEqualityProofIdKey )
 import GHC.Builtin.PrimOps
@@ -2123,48 +2124,11 @@ cheapEqExpr' ignoreTick e1 e2
 
 eqExpr :: InScopeSet -> CoreExpr -> CoreExpr -> Bool
 -- Compares for equality, modulo alpha
-eqExpr in_scope e1 e2
-  = go (mkRnEnv2 in_scope) e1 e2
-  where
-    go env (Var v1) (Var v2)
-      | rnOccL env v1 == rnOccR env v2
-      = True
-
-    go _   (Lit lit1)    (Lit lit2)      = lit1 == lit2
-    go env (Type t1)    (Type t2)        = eqTypeX env t1 t2
-    go env (Coercion co1) (Coercion co2) = eqCoercionX env co1 co2
-    go env (Cast e1 co1) (Cast e2 co2) = eqCoercionX env co1 co2 && go env e1 e2
-    go env (App f1 a1)   (App f2 a2)   = go env f1 f2 && go env a1 a2
-    go env (Tick n1 e1)  (Tick n2 e2)  = eqTickish env n1 n2 && go env e1 e2
-
-    go env (Lam b1 e1)  (Lam b2 e2)
-      =  eqTypeX env (varType b1) (varType b2)   -- False for Id/TyVar combination
-      && go (rnBndr2 env b1 b2) e1 e2
-
-    go env (Let (NonRec v1 r1) e1) (Let (NonRec v2 r2) e2)
-      =  go env r1 r2  -- No need to check binder types, since RHSs match
-      && go (rnBndr2 env v1 v2) e1 e2
-
-    go env (Let (Rec ps1) e1) (Let (Rec ps2) e2)
-      = equalLength ps1 ps2
-      && all2 (go env') rs1 rs2 && go env' e1 e2
-      where
-        (bs1,rs1) = unzip ps1
-        (bs2,rs2) = unzip ps2
-        env' = rnBndrs2 env bs1 bs2
-
-    go env (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)
-      | null a1   -- See Note [Empty case alternatives] in GHC.Data.TrieMap
-      = null a2 && go env e1 e2 && eqTypeX env t1 t2
-      | otherwise
-      =  go env e1 e2 && all2 (go_alt (rnBndr2 env b1 b2)) a1 a2
-
-    go _ _ _ = False
-
-    -----------
-    go_alt env (Alt c1 bs1 e1) (Alt c2 bs2 e2)
-      = c1 == c2 && go (rnBndrs2 env bs1 bs2) e1 e2
+-- TODO: remove eqExpr once GHC 9.4 is released
+eqExpr _ = eqCoreExpr
+{-# DEPRECATED eqExpr "Use 'GHC.Core.Map.Expr.eqCoreExpr', 'eqExpr' will be removed in GHC 9.6" #-}
 
+-- Used by diffBinds, which is itself only used in GHC.Core.Lint.lintAnnots
 eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool
 eqTickish env (Breakpoint lext lid lids) (Breakpoint rext rid rids)
       = lid == rid &&
@@ -2172,47 +2136,6 @@ eqTickish env (Breakpoint lext lid lids) (Breakpoint rext rid rids)
         lext == rext
 eqTickish _ l r = l == r
 
--- | Finds differences between core expressions, modulo alpha and
--- renaming. Setting @top@ means that the @IdInfo@ of bindings will be
--- checked for differences as well.
-diffExpr :: Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
-diffExpr _   env (Var v1)   (Var v2)   | rnOccL env v1 == rnOccR env v2 = []
-diffExpr _   _   (Lit lit1) (Lit lit2) | lit1 == lit2                   = []
-diffExpr _   env (Type t1)  (Type t2)  | eqTypeX env t1 t2              = []
-diffExpr _   env (Coercion co1) (Coercion co2)
-                                       | eqCoercionX env co1 co2        = []
-diffExpr top env (Cast e1 co1)  (Cast e2 co2)
-  | eqCoercionX env co1 co2                = diffExpr top env e1 e2
-diffExpr top env (Tick n1 e1)   e2
-  | not (tickishIsCode n1)                 = diffExpr top env e1 e2
-diffExpr top env e1             (Tick n2 e2)
-  | not (tickishIsCode n2)                 = diffExpr top env e1 e2
-diffExpr top env (Tick n1 e1)   (Tick n2 e2)
-  | eqTickish env n1 n2                    = diffExpr top env e1 e2
- -- The error message of failed pattern matches will contain
- -- generated names, which are allowed to differ.
-diffExpr _   _   (App (App (Var absent) _) _)
-                 (App (App (Var absent2) _) _)
-  | isDeadEndId absent && isDeadEndId absent2 = []
-diffExpr top env (App f1 a1)    (App f2 a2)
-  = diffExpr top env f1 f2 ++ diffExpr top env a1 a2
-diffExpr top env (Lam b1 e1)  (Lam b2 e2)
-  | eqTypeX env (varType b1) (varType b2)   -- False for Id/TyVar combination
-  = diffExpr top (rnBndr2 env b1 b2) e1 e2
-diffExpr top env (Let bs1 e1) (Let bs2 e2)
-  = let (ds, env') = diffBinds top env (flattenBinds [bs1]) (flattenBinds [bs2])
-    in ds ++ diffExpr top env' e1 e2
-diffExpr top env (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)
-  | equalLength a1 a2 && not (null a1) || eqTypeX env t1 t2
-    -- See Note [Empty case alternatives] in GHC.Data.TrieMap
-  = diffExpr top env e1 e2 ++ concat (zipWith diffAlt a1 a2)
-  where env' = rnBndr2 env b1 b2
-        diffAlt (Alt c1 bs1 e1) (Alt c2 bs2 e2)
-          | c1 /= c2  = [text "alt-cons " <> ppr c1 <> text " /= " <> ppr c2]
-          | otherwise = diffExpr top (rnBndrs2 env' bs1 bs2) e1 e2
-diffExpr _  _ e1 e2
-  = [fsep [ppr e1, text "/=", ppr e2]]
-
 -- | Finds differences between core bindings, see @diffExpr@.
 --
 -- The main problem here is that while we expect the binds to have the
@@ -2223,6 +2146,8 @@ diffExpr _  _ e1 e2
 -- leaves us just with mutually recursive and/or mismatching bindings,
 -- which we then speculatively match by ordering them. It's by no means
 -- perfect, but gets the job done well enough.
+--
+-- Only used in GHC.Core.Lint.lintAnnots
 diffBinds :: Bool -> RnEnv2 -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
           -> ([SDoc], RnEnv2)
 diffBinds top env binds1 = go (length binds1) env binds1
@@ -2270,6 +2195,47 @@ diffBinds top env binds1 = go (length binds1) env binds1
          | otherwise
          = diffIdInfo env bndr1 bndr2
 
+-- | Finds differences between core expressions, modulo alpha and
+-- renaming. Setting @top@ means that the @IdInfo@ of bindings will be
+-- checked for differences as well.
+diffExpr :: Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
+diffExpr _   env (Var v1)   (Var v2)   | rnOccL env v1 == rnOccR env v2 = []
+diffExpr _   _   (Lit lit1) (Lit lit2) | lit1 == lit2                   = []
+diffExpr _   env (Type t1)  (Type t2)  | eqTypeX env t1 t2              = []
+diffExpr _   env (Coercion co1) (Coercion co2)
+                                       | eqCoercionX env co1 co2        = []
+diffExpr top env (Cast e1 co1)  (Cast e2 co2)
+  | eqCoercionX env co1 co2                = diffExpr top env e1 e2
+diffExpr top env (Tick n1 e1)   e2
+  | not (tickishIsCode n1)                 = diffExpr top env e1 e2
+diffExpr top env e1             (Tick n2 e2)
+  | not (tickishIsCode n2)                 = diffExpr top env e1 e2
+diffExpr top env (Tick n1 e1)   (Tick n2 e2)
+  | eqTickish env n1 n2                    = diffExpr top env e1 e2
+ -- The error message of failed pattern matches will contain
+ -- generated names, which are allowed to differ.
+diffExpr _   _   (App (App (Var absent) _) _)
+                 (App (App (Var absent2) _) _)
+  | isDeadEndId absent && isDeadEndId absent2 = []
+diffExpr top env (App f1 a1)    (App f2 a2)
+  = diffExpr top env f1 f2 ++ diffExpr top env a1 a2
+diffExpr top env (Lam b1 e1)  (Lam b2 e2)
+  | eqTypeX env (varType b1) (varType b2)   -- False for Id/TyVar combination
+  = diffExpr top (rnBndr2 env b1 b2) e1 e2
+diffExpr top env (Let bs1 e1) (Let bs2 e2)
+  = let (ds, env') = diffBinds top env (flattenBinds [bs1]) (flattenBinds [bs2])
+    in ds ++ diffExpr top env' e1 e2
+diffExpr top env (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)
+  | equalLength a1 a2 && not (null a1) || eqTypeX env t1 t2
+    -- See Note [Empty case alternatives] in GHC.Data.TrieMap
+  = diffExpr top env e1 e2 ++ concat (zipWith diffAlt a1 a2)
+  where env' = rnBndr2 env b1 b2
+        diffAlt (Alt c1 bs1 e1) (Alt c2 bs2 e2)
+          | c1 /= c2  = [text "alt-cons " <> ppr c1 <> text " /= " <> ppr c2]
+          | otherwise = diffExpr top (rnBndrs2 env' bs1 bs2) e1 e2
+diffExpr _  _ e1 e2
+  = [fsep [ppr e1, text "/=", ppr e2]]
+
 -- | Find differences in @IdInfo@. We will especially check whether
 -- the unfoldings match, if present (see @diffUnfold@).
 diffIdInfo :: RnEnv2 -> Var -> Var -> [SDoc]