[Git][ghc/ghc][wip/T24978] More

Simon Peyton Jones (@simonpj) gitlab at gitlab.haskell.org
Sat Jun 22 22:37:35 UTC 2024



Simon Peyton Jones pushed to branch wip/T24978 at Glasgow Haskell Compiler / GHC


Commits:
798f2555 by Simon Peyton Jones at 2024-06-22T23:37:01+01:00
More

- - - - -


25 changed files:

- compiler/GHC/Builtin/Types/Literals.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Errors/Hole.hs-boot
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Instance/FunDeps.hs
- compiler/GHC/Tc/Plugin.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/Solver/Types.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/BasicTypes.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/CtLocEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/Unify.hs


Changes:

=====================================
compiler/GHC/Builtin/Types/Literals.hs
=====================================
@@ -33,7 +33,6 @@ import GHC.Core.Type
 import GHC.Data.Pair
 import GHC.Core.TyCon    ( TyCon, FamTyConFlav(..), mkFamilyTyCon
                          , Injectivity(..) )
-import GHC.Core.Coercion ( Role(..) )
 import GHC.Tc.Types.Constraint ( Xi )
 import GHC.Core.Coercion.Axiom
 import GHC.Core.TyCo.Compare   ( tcEqType )
@@ -250,13 +249,12 @@ typeNatModTyCon = mkTypeNatFunTyCon2 name
   name = mkWiredInTyConName UserSyntax gHC_INTERNAL_TYPENATS (fsLit "Mod")
             typeNatModTyFamNameKey typeNatModTyCon
 
-typeNatExpTyCon :: TyCon
+typeNatExpTyCon :: TyCon  -- Exponentiation
 typeNatExpTyCon = mkTypeNatFunTyCon2 name
   BuiltInSynFamily
     { sfMatchFam      = matchFamExp
-    , sfInteractTop   = sfInteractTopNone
     , sfInteractInert = sfInteractInertNone
---    , sfInteractTop   = interactTopExp
+    , sfInteractTop   = [axExpTop1,axExpTop2,axExpTop3]
 --    , sfInteractInert = interactInertExp
     }
   where
@@ -975,18 +973,18 @@ axMulInteract2  -- (x1*y ~ z, x2*y ~ z) => (x1~x2)   if  y/0
     do { ny1 <- isNumLitTy y1; guard (ny1 /= 0); guard (z1 `tcEqType` z2)
        ; guard (y1 `tcEqType` y2); return (Pair x1 x2) }
 
-{-
-interactTopExp :: [Xi] -> Xi -> [Pair Type]
-interactTopExp [s,t] r
-  | Just 0 <- mbZ = [ s === num 0 ]                                       -- (s ^ t ~ 0) => (s ~ 0)
-  | Just x <- mbX, Just z <- mbZ, Just y <- logExact  z x = [t === num y] -- (2 ^ t ~ 8) => (t ~ 3)
-  | Just y <- mbY, Just z <- mbZ, Just x <- rootExact z y = [s === num x] -- (s ^ 2 ~ 9) => (s ~ 3)
-  where
-  mbX = isNumLitTy s
-  mbY = isNumLitTy t
-  mbZ = isNumLitTy r
-interactTopExp _ _ = []
+axExpTop1, axExpTop2, axExpTop3 :: CoAxiomRule
+axExpTop1   -- (s ^ t ~ 0) => (s ~ 0)
+  = mkTopBinFamDeduction "ExpT1" typeNatExpTyCon $ \ s _t r ->
+    do { 0 <- isNumLitTy r; return (Pair s r) }
+axExpTop2   -- (2 ^ t ~ 8) => (t ~ 3)
+  = mkTopBinFamDeduction "ExpT2" typeNatExpTyCon $ \ s t r ->
+    do { ns <- isNumLitTy s; nr <- isNumLitTy r; y <- logExact nr ns; return (Pair t (num y)) }
+axExpTop3   -- (s ^ 2 ~ 9) => (s ~ 3)
+  = mkTopBinFamDeduction "ExpT3" typeNatExpTyCon $ \ s t r ->
+    do { nt <- isNumLitTy t; nr <- isNumLitTy r; y <- rootExact nr nt; return (Pair s (num y)) }
 
+{-
 interactTopCmpNat :: [Xi] -> Xi -> [Pair Type]
 interactTopCmpNat [s,t] r
   | Just EQ <- isOrderingLitTy r = [ s === t ]


=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -30,6 +30,7 @@ import GHC.Tc.Utils.Monad
 import GHC.Tc.Errors.Types
 import GHC.Tc.Errors.Ppr
 import GHC.Tc.Types.Constraint
+import GHC.Tc.Types.CtLocEnv
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Zonk.Type
 import GHC.Tc.Utils.TcType
@@ -53,7 +54,6 @@ import GHC.Types.Basic
 import GHC.Types.Error
 import qualified GHC.Types.Unique.Map as UM
 
---import GHC.Rename.Unbound ( unknownNameSuggestions, WhatLooking(..) )
 import GHC.Unit.Module
 import qualified GHC.LanguageExtensions as LangExt
 


=====================================
compiler/GHC/Tc/Errors/Hole.hs
=====================================
@@ -39,6 +39,7 @@ import GHC.Tc.Types.Constraint
 import GHC.Tc.Types.Origin
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Types.Evidence
+import GHC.Tc.Types.CtLocEnv
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Zonk.TcType
 import GHC.Core.Type


=====================================
compiler/GHC/Tc/Errors/Hole.hs-boot
=====================================
@@ -7,7 +7,8 @@ module GHC.Tc.Errors.Hole where
 import GHC.Types.Var ( Id )
 import GHC.Tc.Errors.Types ( HoleFitDispConfig, ValidHoleFits )
 import GHC.Tc.Types  ( TcM )
-import GHC.Tc.Types.Constraint ( CtEvidence, CtLoc, Hole, Implication )
+import GHC.Tc.Types.Constraint ( CtEvidence, Hole, Implication )
+import GHC.Tc.Types.CtLocEnv( CtLoc )
 import GHC.Utils.Outputable ( SDoc )
 import GHC.Types.Var.Env ( TidyEnv )
 import GHC.Tc.Errors.Hole.FitTypes ( HoleFit, TypedHole, HoleFitCandidate )


=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -76,6 +76,7 @@ import GHC.Tc.Errors.Types
 import GHC.Tc.Types.BasicTypes
 import GHC.Tc.Types.Constraint
 import GHC.Tc.Types.Origin hiding ( Position(..) )
+import GHC.Tc.Types.CtLocEnv
 import GHC.Tc.Types.Rank (Rank(..))
 import GHC.Tc.Types.TH
 import GHC.Tc.Utils.TcType


=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -174,6 +174,7 @@ import GHC.Tc.Types.Evidence (EvBindsVar)
 import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol)
                            , UserTypeCtxt (PatSynCtxt), TyVarBndrs, TypedThing
                            , FixedRuntimeRepOrigin(..), InstanceWhat )
+import GHC.Tc.Types.CtLocEnv( CtLoc, ctLocOrigin, SubGoalDepth )
 import GHC.Tc.Types.Rank (Rank)
 import GHC.Tc.Utils.TcType (TcType, TcSigmaType, TcPredType,
                             PatersonCondFailure, PatersonCondFailureContext)
@@ -192,8 +193,10 @@ import GHC.Types.TyThing (TyThing)
 import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar, CoVar, Specificity)
 import GHC.Types.Var.Env (TidyEnv)
 import GHC.Types.Var.Set (TyVarSet, VarSet)
+
 import GHC.Unit.Types (Module)
 import GHC.Utils.Outputable
+
 import GHC.Core.Class (Class, ClassMinimalDef, ClassOpItem, ClassATItem)
 import GHC.Core.Coercion (Coercion)
 import GHC.Core.Coercion.Axiom (CoAxBranch)


=====================================
compiler/GHC/Tc/Instance/FunDeps.hs
=====================================
@@ -24,7 +24,6 @@ where
 
 import GHC.Prelude
 
-import GHC.Types.Name
 import GHC.Types.Var
 import GHC.Core.Class
 import GHC.Core.Predicate
@@ -42,7 +41,6 @@ import GHC.Tc.Utils.TcType( transSuperClasses )
 
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
-import GHC.Types.SrcLoc
 
 import GHC.Utils.Outputable
 import GHC.Utils.FV
@@ -231,15 +229,14 @@ improveFromAnother _ _ _ = []
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 improveFromInstEnv :: InstEnvs
-                   -> (PredType -> SrcSpan -> loc)
+                   -> (ClsInst -> loc)
                    -> Class -> [Type]
                    -> [FunDepEqn loc] -- Needs to be a FunDepEqn because
                                       -- of quantified variables
 -- See Note [Improving against instances]
 -- Post: Equations oriented from the template (matching instance) to the workitem!
 improveFromInstEnv inst_env mk_loc cls tys
-  = [ FDEqn { fd_qtvs = meta_tvs, fd_eqs = eqs
-            , fd_loc = mk_loc p_inst (getSrcSpan (is_dfun ispec)) }
+  = [ FDEqn { fd_qtvs = meta_tvs, fd_eqs = eqs, fd_loc = mk_loc ispec }
     | fd <- cls_fds             -- Iterate through the fundeps first,
                                 -- because there often are none!
     , let trimmed_tcs = trimRoughMatchTcs cls_tvs fd rough_tcs


=====================================
compiler/GHC/Tc/Plugin.hs
=====================================
@@ -66,7 +66,9 @@ import GHC.Core.FamInstEnv     ( FamInstEnv )
 import GHC.Tc.Utils.Monad      ( TcGblEnv, TcLclEnv, TcPluginM
                                , unsafeTcPluginTcM
                                , liftIO, traceTc )
-import GHC.Tc.Types.Constraint ( Ct, CtLoc, CtEvidence(..) )
+import GHC.Tc.Types.Constraint ( Ct, CtEvidence(..) )
+import GHC.Tc.Types.CtLocEnv   ( CtLoc )
+
 import GHC.Tc.Utils.TcMType    ( TcTyVar, TcType )
 import GHC.Tc.Utils.Env        ( TcTyThing )
 import GHC.Tc.Types.Evidence   ( CoercionHole, EvTerm(..)


=====================================
compiler/GHC/Tc/Solver.hs
=====================================
@@ -56,6 +56,7 @@ import GHC.Tc.Zonk.TcType     as TcM
 import GHC.Tc.Solver.InertSet
 import GHC.Tc.Solver.Monad  as TcS
 import GHC.Tc.Types.Constraint
+import GHC.Tc.Types.CtLocEnv( mkGivenLoc )
 import GHC.Tc.Instance.FunDeps
 import GHC.Core.Predicate
 import GHC.Tc.Types.Origin


=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -16,6 +16,7 @@ import GHC.Tc.Instance.FunDeps
 import GHC.Tc.Instance.Class( safeOverlap, matchEqualityInst )
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Types.Constraint
+import GHC.Tc.Types.CtLocEnv
 import GHC.Tc.Types.Origin
 import GHC.Tc.Types.EvTerm( evCallStack )
 import GHC.Tc.Solver.InertSet
@@ -28,7 +29,7 @@ import GHC.Hs.Type( HsIPName(..) )
 
 import GHC.Core
 import GHC.Core.Type
-import GHC.Core.InstEnv     ( DFunInstType )
+import GHC.Core.InstEnv     ( DFunInstType, ClsInst(..) )
 import GHC.Core.Class
 import GHC.Core.Predicate
 import GHC.Core.Multiplicity ( scaledThing )
@@ -39,7 +40,6 @@ import GHC.Types.Name.Set
 import GHC.Types.Var
 import GHC.Types.Id( mkTemplateLocals )
 import GHC.Types.Var.Set
-import GHC.Types.SrcLoc
 import GHC.Types.Var.Env
 
 import GHC.Utils.Monad ( concatMapM, foldlM )
@@ -1681,13 +1681,15 @@ doTopFunDepImprovement dict_ct@(DictCt { di_ev = ev, di_cls = cls, di_tys = xis
      dict_loc    = ctEvLoc ev
      dict_origin = ctLocOrigin dict_loc
 
-     mk_ct_loc :: PredType   -- From instance decl
-               -> SrcSpan    -- also from instance deol
+     mk_ct_loc :: ClsInst   -- The instance decl
                -> (CtLoc, RewriterSet)
-     mk_ct_loc inst_pred inst_loc
+     mk_ct_loc ispec
        = ( dict_loc { ctl_origin = FunDepOrigin2 dict_pred dict_origin
                                                  inst_pred inst_loc }
          , emptyRewriterSet )
+       where
+         inst_pred = mkClassPred cls (is_tys ispec)
+         inst_loc  = getSrcSpan (is_dfun ispec)
 
 
 {- *********************************************************************


=====================================
compiler/GHC/Tc/Solver/Equality.hs
=====================================
@@ -16,6 +16,7 @@ import GHC.Tc.Solver.InertSet
 import GHC.Tc.Solver.Types( findFunEqsByTyCon )
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Types.Constraint
+import GHC.Tc.Types.CtLocEnv
 import GHC.Tc.Types.Origin
 import GHC.Tc.Utils.Unify
 import GHC.Tc.Utils.TcType
@@ -1322,7 +1323,7 @@ canDecomposableTyConAppOK ev eq_rel tc (ty1,tys1) (ty2,tys2)
                    -- Remember: ty1/ty2 may be more fully zonked than evar
                    --           See the call to canonicaliseEquality in solveEquality.
              -> emitNewGivens loc
-                       [ (r, ty1, ty2, mkSelCo (SelTyCon i r) ev_co)
+                       [ (r, mkSelCo (SelTyCon i r) ev_co)
                        | (r, ty1, ty2, i) <- zip4 tc_roles tys1 tys2 [0..]
                        , r /= Phantom
                        , not (isCoercionTy ty1) && not (isCoercionTy ty2) ]
@@ -1380,10 +1381,8 @@ canDecomposableFunTy ev eq_rel af f1@(ty1,m1,a1,r1) f2@(ty2,m2,a2,r2)
                    -- Remember: ty1/ty2 may be more fully zonked than evar
                    --           See the call to canonicaliseEquality in solveEquality.
              -> emitNewGivens loc
-                       [ (funRole role fs, ty1, ty2, mkSelCo (SelFun fs) ev_co)
-                       | (fs, ty1, ty2) <- [ (SelMult, m1, m2)
-                                           , (SelArg,  a1, a2)
-                                           , (SelRes,  r1, r2)] ]
+                       [ (funRole role fs, mkSelCo (SelFun fs) ev_co)
+                       | fs <- [SelMult, SelArg, SelRes] ]
 
     ; stopWith ev "Decomposed TyConApp" }
 
@@ -3000,8 +2999,8 @@ improveGivenTopFunEqs :: TyCon -> [TcType] -> CtEvidence -> Xi -> TcS Bool
 improveGivenTopFunEqs fam_tc args ev rhs_ty
   | Just ops <- isBuiltInSynFamTyCon_maybe fam_tc
   = do { emitNewGivens (ctEvLoc ev) $
-           [ (Nominal, s, t, new_co)
-           | (ax, Pair s t) <- tryInteractTopFam ops fam_tc args rhs_ty
+           [ (Nominal, new_co)
+           | (ax, _) <- tryInteractTopFam ops fam_tc args rhs_ty
            , let new_co = mkAxiomRuleCo ax [given_co] ]
        ; return False }
   | otherwise
@@ -3102,12 +3101,13 @@ improve_top_fun_eqs fam_envs fam_tc args rhs_ty
 
 
 improveLocalFunEqs :: InertCans -> TyCon -> [TcType] -> EqCt -> TcS Bool
+-- Emit equalities from interaction between two equalities
 improveLocalFunEqs inerts fam_tc args (EqCt { eq_ev = work_ev, eq_rhs = rhs })
   | isGiven work_ev = improveGivenLocalFunEqs  funeqs_for_tc fam_tc args work_ev rhs
   | otherwise       = improveWantedLocalFunEqs funeqs_for_tc fam_tc args work_ev rhs
   where
     funeqs = inert_funeqs inerts
-    funeqs_for_tc :: [EqCt]
+    funeqs_for_tc :: [EqCt]   -- Mixture of Given and Wanted
     funeqs_for_tc = [ funeq_ct | equal_ct_list <- findFunEqsByTyCon funeqs fam_tc
                                , funeq_ct <- equal_ct_list
                                , NomEq == eq_eq_rel funeq_ct ]
@@ -3115,46 +3115,53 @@ improveLocalFunEqs inerts fam_tc args (EqCt { eq_ev = work_ev, eq_rhs = rhs })
                                   -- with type family dependencies
 
 
-improveGivenLocalFunEqs :: TyCon -> [TcType] -> CtEvidence -> Xi  -- Work item
-                        -> [EqCt]                                 -- Inert items
+improveGivenLocalFunEqs :: [EqCt]    -- Inert items, mixture of Given and Wanted
+                        -> TyCon -> [TcType] -> CtEvidence -> Xi  -- Work item
                         -> TcS Bool  -- True <=> Something was emitted
+-- Emit equalities from interaction between two Given type-family equalities
+--    e.g.    (x+y1~z, x+y2~z) => (y1 ~ y2)
 improveGivenLocalFunEqs funeqs_for_tc fam_tc work_args work_ev work_rhs
   | Just ops <- isBuiltInSynFamTyCon_maybe fam_tc
-  = foldlM (do_one ops) False fun_eqs_for_tc
+  = foldlM (do_one ops) False funeqs_for_tc
   | otherwise
   = return False
-  where
-    do_one ops so_far (EqCt { eq_ev = inert_ev
-                            , eq_lhs = TyFamLHS _ inert_args
-                            , eq_rhs = inert_rhs })
-      | isGiven inert_ev, not (null quads)
-      = do { emitNewGivens (ctEvLoc ev) quads; return True }
-
-     | otherwise
-     = return so_far
   where
     given_co :: Coercion = ctEvCoercion work_ev
 
-    quads = [ (Nominal, s, t, new_co)
-            | (ax, Pair s t) <- tryInteractInertFam ops fam_tc
-                                    work_args  work_rhs inert_args inert_rhs
-            , let new_co = mkAxiomRuleCo ax [given_co] ]
-
-improveWantedLocalFunEqs :: [EqCt] -> TyCon -> [TcType]
-                         -> CtEvidence -> Xi -> TcS Bool
--- Generate improvement equalities for a Watend constraint, by comparing
--- the current work item with inert CFunEqs
+    do_one :: BuiltInSynFamily -> Bool -> EqCt -> TcS Bool
+    do_one ops _ (EqCt { eq_ev = inert_ev
+                        , eq_lhs = TyFamLHS _ inert_args
+                        , eq_rhs = inert_rhs })
+      | isGiven inert_ev
+      , not (null pairs)
+      = do { emitNewGivens (ctEvLoc inert_ev) pairs; return True }
+             -- This CtLoc for the new Givens doesn't reflect the
+             -- fact that it's a combination of Givens, but I don't
+             -- this that matters.
+      where
+        pairs = [ (Nominal, new_co)
+                | (ax, _) <- tryInteractInertFam ops fam_tc
+                                        work_args  work_rhs inert_args inert_rhs
+                , let new_co = mkAxiomRuleCo ax [given_co] ]
+
+    do_one _ so_far _ = return so_far
+
+improveWantedLocalFunEqs
+    :: [EqCt]     -- Inert items (Given and Wanted)
+    -> TyCon -> [TcType] -> CtEvidence -> Xi  -- Work item (wanted)
+    -> TcS Bool
+-- Emit improvement equalities for a Wanted constraint, by comparing
+-- the current work item with inert CFunEqs (boh Given and Wanted)
 -- E.g.   x + y ~ z,   x + y' ~ z   =>   [W] y ~ y'
 --
 -- See Note [FunDep and implicit parameter reactions]
-improveWantedLocalFunEqs fun_eqs_for_tc fam_tc args work_ev rhs
+improveWantedLocalFunEqs funeqs_for_tc fam_tc args work_ev rhs
   | null improvement_eqns
   = return False
   | otherwise
   = do { traceTcS "interactFunEq improvements: " $
                    vcat [ text "Eqns:" <+> ppr improvement_eqns
-                        , text "Candidates:" <+> ppr funeqs_for_tc
-                        , text "Inert eqs:" <+> ppr (inert_eqs inerts) ]
+                        , text "Candidates:" <+> ppr funeqs_for_tc ]
        ; emitFunDepWanteds work_ev improvement_eqns }
   where
     work_loc      = ctEvLoc work_ev


=====================================
compiler/GHC/Tc/Solver/InertSet.hs
=====================================
@@ -56,6 +56,7 @@ import GHC.Prelude
 
 import GHC.Tc.Types.Constraint
 import GHC.Tc.Types.Origin
+import GHC.Tc.Types.CtLocEnv( CtLoc, ctLocOrigin, ctLocSpan, ctLocLevel )
 import GHC.Tc.Solver.Types
 import GHC.Tc.Utils.TcType
 


=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -148,15 +148,20 @@ import GHC.Driver.DynFlags
 
 import GHC.Tc.Instance.Class( safeOverlap, instanceReturnsDictCon )
 import GHC.Tc.Instance.FunDeps( FunDepEqn(..) )
-import GHC.Tc.Utils.TcType
+
+
 import GHC.Tc.Solver.Types
 import GHC.Tc.Solver.InertSet
-import GHC.Tc.Types.Evidence
 import GHC.Tc.Errors.Types
+
+import GHC.Tc.Utils.TcType
+import GHC.Tc.Utils.Unify
+
+import GHC.Tc.Types.Evidence
 import GHC.Tc.Types
 import GHC.Tc.Types.Origin
+import GHC.Tc.Types.CtLocEnv
 import GHC.Tc.Types.Constraint
-import GHC.Tc.Utils.Unify
 
 import GHC.Builtin.Names ( unsatisfiableClassNameKey )
 
@@ -1766,11 +1771,12 @@ newBoundEvVarId pred rhs
        ; setEvBind (mkGivenEvBind new_ev rhs)
        ; return new_ev }
 
-emitNewGivens :: CtLoc -> [(Role,TcType,TcType,TcCoercion)] -> TcS ()
+emitNewGivens :: CtLoc -> [(Role,TcCoercion)] -> TcS ()
 emitNewGivens loc pts
   = do { evs <- mapM (newGivenEvVar loc) $
                 [ (mkPrimEqPredRole role ty1 ty2, evCoercion co)
-                | (role, ty1, ty2, co) <- pts
+                | (role, co) <- pts
+                , let Pair ty1 ty2 = coercionKind co
                 , not (ty1 `tcEqType` ty2) ] -- Kill reflexive Givens at birth
        ; emitWorkNC evs }
 


=====================================
compiler/GHC/Tc/Solver/Rewrite.hs
=====================================
@@ -11,6 +11,7 @@ import GHC.Tc.Types ( TcGblEnv(tcg_tc_plugin_rewriters),
                       RewriteEnv(..),
                       runTcPluginM )
 import GHC.Tc.Types.Constraint
+import GHC.Tc.Types.CtLocEnv( CtLoc, bumpCtLocDepth )
 import GHC.Core.Predicate
 import GHC.Tc.Utils.TcType
 import GHC.Core.Type


=====================================
compiler/GHC/Tc/Solver/Solve.hs
=====================================
@@ -14,6 +14,7 @@ import GHC.Tc.Solver.Rewrite( rewrite )
 import GHC.Tc.Errors.Types
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Types.Evidence
+import GHC.Tc.Types.CtLocEnv( ctLocEnv, ctLocOrigin, setCtLocOrigin )
 import GHC.Tc.Types
 import GHC.Tc.Types.Origin
 import GHC.Tc.Types.Constraint


=====================================
compiler/GHC/Tc/Solver/Types.hs
=====================================
@@ -24,6 +24,7 @@ import GHC.Prelude
 
 import GHC.Tc.Types.Constraint
 import GHC.Tc.Types.Origin
+import GHC.Tc.Types.CtLocEnv( CtLoc, ctLocOrigin )
 import GHC.Tc.Utils.TcType
 
 import GHC.Types.Unique


=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -119,6 +119,7 @@ import GHC.Hs
 
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Types.Constraint
+import GHC.Tc.Types.CtLocEnv( CtLoc )
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Types.TH
 import GHC.Tc.Types.TcRef


=====================================
compiler/GHC/Tc/Types/BasicTypes.hs
=====================================
@@ -24,6 +24,9 @@ module GHC.Tc.Types.BasicTypes (
 
 import GHC.Prelude
 
+import GHC.Tc.Types.Origin( UserTypeCtxt )
+import GHC.Tc.Utils.TcType
+
 import GHC.Types.Id
 import GHC.Types.Basic
 import GHC.Types.Var
@@ -32,8 +35,6 @@ import GHC.Types.Name
 import GHC.Types.TyThing
 import GHC.Types.Name.Env
 import GHC.Types.Name.Set
-import GHC.Tc.Types.Origin
-import GHC.Tc.Utils.TcType
 
 import GHC.Hs.Extension ( GhcRn )
 


=====================================
compiler/GHC/Tc/Types/Constraint.hs
=====================================
@@ -65,13 +65,6 @@ module GHC.Tc.Types.Constraint (
         ImplicStatus(..), isInsolubleStatus, isSolvedStatus,
         UserGiven, getUserGivensFromImplics,
         HasGivenEqs(..), checkImplicationInvariants,
-        SubGoalDepth, initialSubGoalDepth, maxSubGoalDepth,
-        bumpSubGoalDepth, subGoalDepthExceeded,
-        CtLoc(..), ctLocSpan, ctLocEnv, ctLocLevel, ctLocOrigin,
-        ctLocTypeOrKind_maybe,
-        ctLocDepth, bumpCtLocDepth, isGivenLoc,
-        setCtLocOrigin, updateCtLocOrigin, setCtLocEnv, setCtLocSpan,
-        pprCtLoc, adjustCtLoc, adjustCtLocTyConBinder,
 
         -- CtLocEnv
         CtLocEnv(..), setCtLocEnvLoc, setCtLocEnvLvl, getCtLocEnvLoc, getCtLocEnvLvl, ctLocEnvInGeneratedCode,
@@ -82,7 +75,6 @@ module GHC.Tc.Types.Constraint (
         ctEvPred, ctEvLoc, ctEvOrigin, ctEvEqRel,
         ctEvExpr, ctEvTerm, ctEvCoercion, ctEvEvId,
         ctEvRewriters, ctEvUnique, tcEvDestUnique,
-        mkKindEqLoc, toKindLoc, toInvisibleLoc, mkGivenLoc,
         ctEvRole, setCtEvPredType, setCtEvLoc, arisesFromGivens,
         tyCoVarsOfCtEvList, tyCoVarsOfCtEv, tyCoVarsOfCtEvsList,
 
@@ -125,11 +117,9 @@ import GHC.Core.TyCo.Ppr
 import GHC.Utils.FV
 import GHC.Types.Var.Set
 import GHC.Builtin.Names
-import GHC.Types.Basic
 import GHC.Types.Unique.Set
 
 import GHC.Utils.Outputable
-import GHC.Types.SrcLoc
 import GHC.Data.Bag
 import GHC.Utils.Misc
 import GHC.Utils.Panic
@@ -950,9 +940,6 @@ tyCoFVsOfHole (Hole { hole_ty = ty }) = tyCoFVsOfType ty
 tyCoFVsOfBag :: (a -> FV) -> Bag a -> FV
 tyCoFVsOfBag tvs_of = foldr (unionFV . tvs_of) emptyFV
 
-isGivenLoc :: CtLoc -> Bool
-isGivenLoc loc = isGivenOrigin (ctLocOrigin loc)
-
 {-
 ************************************************************************
 *                                                                      *
@@ -2416,175 +2403,3 @@ eqCanRewriteFR (Wanted, NomEq) (Wanted, ReprEq) = False
 eqCanRewriteFR (Wanted, r1)    (Wanted, r2)     = eqCanRewrite r1 r2
 eqCanRewriteFR (Wanted, _)     (Given, _)       = False
 
-{-
-************************************************************************
-*                                                                      *
-            SubGoalDepth
-*                                                                      *
-************************************************************************
-
-Note [SubGoalDepth]
-~~~~~~~~~~~~~~~~~~~
-The 'SubGoalDepth' takes care of stopping the constraint solver from looping.
-
-The counter starts at zero and increases. It includes dictionary constraints,
-equality simplification, and type family reduction. (Why combine these? Because
-it's actually quite easy to mistake one for another, in sufficiently involved
-scenarios, like ConstraintKinds.)
-
-The flag -freduction-depth=n fixes the maximum level.
-
-* The counter includes the depth of type class instance declarations.  Example:
-     [W] d{7} : Eq [Int]
-  That is d's dictionary-constraint depth is 7.  If we use the instance
-     $dfEqList :: Eq a => Eq [a]
-  to simplify it, we get
-     d{7} = $dfEqList d'{8}
-  where d'{8} : Eq Int, and d' has depth 8.
-
-  For civilised (decidable) instance declarations, each increase of
-  depth removes a type constructor from the type, so the depth never
-  gets big; i.e. is bounded by the structural depth of the type.
-
-* The counter also increments when resolving
-equalities involving type functions. Example:
-  Assume we have a wanted at depth 7:
-    [W] d{7} : F () ~ a
-  If there is a type function equation "F () = Int", this would be rewritten to
-    [W] d{8} : Int ~ a
-  and remembered as having depth 8.
-
-  Again, without UndecidableInstances, this counter is bounded, but without it
-  can resolve things ad infinitum. Hence there is a maximum level.
-
-* Lastly, every time an equality is rewritten, the counter increases. Again,
-  rewriting an equality constraint normally makes progress, but it's possible
-  the "progress" is just the reduction of an infinitely-reducing type family.
-  Hence we need to track the rewrites.
-
-When compiling a program requires a greater depth, then GHC recommends turning
-off this check entirely by setting -freduction-depth=0. This is because the
-exact number that works is highly variable, and is likely to change even between
-minor releases. Because this check is solely to prevent infinite compilation
-times, it seems safe to disable it when a user has ascertained that their program
-doesn't loop at the type level.
-
--}
-
--- | See Note [SubGoalDepth]
-newtype SubGoalDepth = SubGoalDepth Int
-  deriving (Eq, Ord, Outputable)
-
-initialSubGoalDepth :: SubGoalDepth
-initialSubGoalDepth = SubGoalDepth 0
-
-bumpSubGoalDepth :: SubGoalDepth -> SubGoalDepth
-bumpSubGoalDepth (SubGoalDepth n) = SubGoalDepth (n + 1)
-
-maxSubGoalDepth :: SubGoalDepth -> SubGoalDepth -> SubGoalDepth
-maxSubGoalDepth (SubGoalDepth n) (SubGoalDepth m) = SubGoalDepth (n `max` m)
-
-subGoalDepthExceeded :: IntWithInf -> SubGoalDepth -> Bool
-subGoalDepthExceeded reductionDepth (SubGoalDepth d)
-  = mkIntWithInf d > reductionDepth
-
-{-
-************************************************************************
-*                                                                      *
-            CtLoc
-*                                                                      *
-************************************************************************
-
-The 'CtLoc' gives information about where a constraint came from.
-This is important for decent error message reporting because
-dictionaries don't appear in the original source code.
-
--}
-
-data CtLoc = CtLoc { ctl_origin   :: CtOrigin
-                   , ctl_env      :: CtLocEnv -- Everything we need to know about
-                                              -- the context this Ct arose in.
-                   , ctl_t_or_k   :: Maybe TypeOrKind  -- OK if we're not sure
-                   , ctl_depth    :: !SubGoalDepth }
-
-mkKindEqLoc :: TcType -> TcType   -- original *types* being compared
-            -> CtLoc -> CtLoc
-mkKindEqLoc s1 s2 ctloc
-  | CtLoc { ctl_t_or_k = t_or_k, ctl_origin = origin } <- ctloc
-  = ctloc { ctl_origin = KindEqOrigin s1 s2 origin t_or_k
-          , ctl_t_or_k = Just KindLevel }
-
-adjustCtLocTyConBinder :: TyConBinder -> CtLoc -> CtLoc
--- Adjust the CtLoc when decomposing a type constructor
-adjustCtLocTyConBinder tc_bndr loc
-  = adjustCtLoc is_vis is_kind loc
-  where
-    is_vis  = isVisibleTyConBinder tc_bndr
-    is_kind = isNamedTyConBinder tc_bndr
-
-adjustCtLoc :: Bool    -- True <=> A visible argument
-            -> Bool    -- True <=> A kind argument
-            -> CtLoc -> CtLoc
--- Adjust the CtLoc when decomposing a type constructor, application, etc
-adjustCtLoc is_vis is_kind loc
-  = loc2
-  where
-    loc1 | is_kind   = toKindLoc loc
-         | otherwise = loc
-    loc2 | is_vis    = loc1
-         | otherwise = toInvisibleLoc loc1
-
--- | Take a CtLoc and moves it to the kind level
-toKindLoc :: CtLoc -> CtLoc
-toKindLoc loc = loc { ctl_t_or_k = Just KindLevel }
-
-toInvisibleLoc :: CtLoc -> CtLoc
-toInvisibleLoc loc = updateCtLocOrigin loc toInvisibleOrigin
-
-mkGivenLoc :: TcLevel -> SkolemInfoAnon -> CtLocEnv -> CtLoc
-mkGivenLoc tclvl skol_info env
-  = CtLoc { ctl_origin   = GivenOrigin skol_info
-          , ctl_env      = setCtLocEnvLvl env tclvl
-          , ctl_t_or_k   = Nothing    -- this only matters for error msgs
-          , ctl_depth    = initialSubGoalDepth }
-
-ctLocEnv :: CtLoc -> CtLocEnv
-ctLocEnv = ctl_env
-
-ctLocLevel :: CtLoc -> TcLevel
-ctLocLevel loc = getCtLocEnvLvl (ctLocEnv loc)
-
-ctLocDepth :: CtLoc -> SubGoalDepth
-ctLocDepth = ctl_depth
-
-ctLocOrigin :: CtLoc -> CtOrigin
-ctLocOrigin = ctl_origin
-
-ctLocSpan :: CtLoc -> RealSrcSpan
-ctLocSpan (CtLoc { ctl_env = lcl}) = getCtLocEnvLoc lcl
-
-ctLocTypeOrKind_maybe :: CtLoc -> Maybe TypeOrKind
-ctLocTypeOrKind_maybe = ctl_t_or_k
-
-setCtLocSpan :: CtLoc -> RealSrcSpan -> CtLoc
-setCtLocSpan ctl@(CtLoc { ctl_env = lcl }) loc = setCtLocEnv ctl (setCtLocRealLoc lcl loc)
-
-bumpCtLocDepth :: CtLoc -> CtLoc
-bumpCtLocDepth loc@(CtLoc { ctl_depth = d }) = loc { ctl_depth = bumpSubGoalDepth d }
-
-setCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc
-setCtLocOrigin ctl orig = ctl { ctl_origin = orig }
-
-updateCtLocOrigin :: CtLoc -> (CtOrigin -> CtOrigin) -> CtLoc
-updateCtLocOrigin ctl@(CtLoc { ctl_origin = orig }) upd
-  = ctl { ctl_origin = upd orig }
-
-setCtLocEnv :: CtLoc -> CtLocEnv -> CtLoc
-setCtLocEnv ctl env = ctl { ctl_env = env }
-
-pprCtLoc :: CtLoc -> SDoc
--- "arising from ... at ..."
--- Not an instance of Outputable because of the "arising from" prefix
-pprCtLoc (CtLoc { ctl_origin = o, ctl_env = lcl})
-  = sep [ pprCtOrigin o
-        , text "at" <+> ppr (getCtLocEnvLoc lcl)]


=====================================
compiler/GHC/Tc/Types/CtLocEnv.hs
=====================================
@@ -1,22 +1,222 @@
 module GHC.Tc.Types.CtLocEnv (
-    CtLocEnv(..)
-  , getCtLocEnvLoc
-  , getCtLocEnvLvl
-  , setCtLocEnvLvl
-  , setCtLocRealLoc
-  , setCtLocEnvLoc
-  , ctLocEnvInGeneratedCode
+
+  -- * SubGoalDepth
+  CtLocEnv(..),
+  getCtLocEnvLoc, setCtLocEnvLoc, setCtLocRealLoc,
+  getCtLocEnvLvl, setCtLocEnvLvl,
+  ctLocEnvInGeneratedCode,
+
+  -- * SubGoalDepth
+  SubGoalDepth, initialSubGoalDepth, maxSubGoalDepth,
+  bumpSubGoalDepth, subGoalDepthExceeded,
+
+  -- * CtLoc
+  CtLoc(..), ctLocSpan, ctLocEnv, ctLocLevel, ctLocOrigin,
+  ctLocTypeOrKind_maybe, toInvisibleLoc,
+  ctLocDepth, bumpCtLocDepth, isGivenLoc, mkGivenLoc, mkKindEqLoc,
+  setCtLocOrigin, updateCtLocOrigin, setCtLocEnv, setCtLocSpan,
+  pprCtLoc, adjustCtLoc, adjustCtLocTyConBinder,
+
   ) where
 
 import GHC.Prelude
 
+import GHC.Tc.Types.BasicTypes
+import GHC.Tc.Types.ErrCtxt
+import GHC.Tc.Types.Origin
+
+import GHC.Tc.Utils.TcType
+
 import GHC.Types.SrcLoc
 import GHC.Types.Name.Reader
+import GHC.Types.Basic( IntWithInf, mkIntWithInf, TypeOrKind(..) )
+
+import GHC.Core.TyCon( TyConBinder, isVisibleTyConBinder, isNamedTyConBinder )
+
+import GHC.Utils.Outputable
+
+
+{- *********************************************************************
+*                                                                      *
+            SubGoalDepth
+*                                                                      *
+********************************************************************* -}
+
+{- Note [SubGoalDepth]
+~~~~~~~~~~~~~~~~~~~~~~
+The 'SubGoalDepth' takes care of stopping the constraint solver from looping.
+
+The counter starts at zero and increases. It includes dictionary constraints,
+equality simplification, and type family reduction. (Why combine these? Because
+it's actually quite easy to mistake one for another, in sufficiently involved
+scenarios, like ConstraintKinds.)
+
+The flag -freduction-depth=n fixes the maximum level.
+
+* The counter includes the depth of type class instance declarations.  Example:
+     [W] d{7} : Eq [Int]
+  That is d's dictionary-constraint depth is 7.  If we use the instance
+     $dfEqList :: Eq a => Eq [a]
+  to simplify it, we get
+     d{7} = $dfEqList d'{8}
+  where d'{8} : Eq Int, and d' has depth 8.
+
+  For civilised (decidable) instance declarations, each increase of
+  depth removes a type constructor from the type, so the depth never
+  gets big; i.e. is bounded by the structural depth of the type.
+
+* The counter also increments when resolving
+equalities involving type functions. Example:
+  Assume we have a wanted at depth 7:
+    [W] d{7} : F () ~ a
+  If there is a type function equation "F () = Int", this would be rewritten to
+    [W] d{8} : Int ~ a
+  and remembered as having depth 8.
+
+  Again, without UndecidableInstances, this counter is bounded, but without it
+  can resolve things ad infinitum. Hence there is a maximum level.
+
+* Lastly, every time an equality is rewritten, the counter increases. Again,
+  rewriting an equality constraint normally makes progress, but it's possible
+  the "progress" is just the reduction of an infinitely-reducing type family.
+  Hence we need to track the rewrites.
+
+When compiling a program requires a greater depth, then GHC recommends turning
+off this check entirely by setting -freduction-depth=0. This is because the
+exact number that works is highly variable, and is likely to change even between
+minor releases. Because this check is solely to prevent infinite compilation
+times, it seems safe to disable it when a user has ascertained that their program
+doesn't loop at the type level.
+
+-}
+
+-- | See Note [SubGoalDepth]
+newtype SubGoalDepth = SubGoalDepth Int
+  deriving (Eq, Ord, Outputable)
+
+initialSubGoalDepth :: SubGoalDepth
+initialSubGoalDepth = SubGoalDepth 0
+
+bumpSubGoalDepth :: SubGoalDepth -> SubGoalDepth
+bumpSubGoalDepth (SubGoalDepth n) = SubGoalDepth (n + 1)
+
+maxSubGoalDepth :: SubGoalDepth -> SubGoalDepth -> SubGoalDepth
+maxSubGoalDepth (SubGoalDepth n) (SubGoalDepth m) = SubGoalDepth (n `max` m)
+
+subGoalDepthExceeded :: IntWithInf -> SubGoalDepth -> Bool
+subGoalDepthExceeded reductionDepth (SubGoalDepth d)
+  = mkIntWithInf d > reductionDepth
+
+
+{- *********************************************************************
+*                                                                      *
+            CtLoc
+*                                                                      *
+************************************************************************
+
+The 'CtLoc' gives information about where a constraint came from.
+This is important for decent error message reporting because
+dictionaries don't appear in the original source code.
+
+-}
+
+data CtLoc = CtLoc { ctl_origin   :: CtOrigin
+                   , ctl_env      :: CtLocEnv -- Everything we need to know about
+                                              -- the context this Ct arose in.
+                   , ctl_t_or_k   :: Maybe TypeOrKind  -- OK if we're not sure
+                   , ctl_depth    :: !SubGoalDepth }
+
+mkKindEqLoc :: TcType -> TcType   -- original *types* being compared
+            -> CtLoc -> CtLoc
+mkKindEqLoc s1 s2 ctloc
+  | CtLoc { ctl_t_or_k = t_or_k, ctl_origin = origin } <- ctloc
+  = ctloc { ctl_origin = KindEqOrigin s1 s2 origin t_or_k
+          , ctl_t_or_k = Just KindLevel }
+
+adjustCtLocTyConBinder :: TyConBinder -> CtLoc -> CtLoc
+-- Adjust the CtLoc when decomposing a type constructor
+adjustCtLocTyConBinder tc_bndr loc
+  = adjustCtLoc is_vis is_kind loc
+  where
+    is_vis  = isVisibleTyConBinder tc_bndr
+    is_kind = isNamedTyConBinder tc_bndr
+
+adjustCtLoc :: Bool    -- True <=> A visible argument
+            -> Bool    -- True <=> A kind argument
+            -> CtLoc -> CtLoc
+-- Adjust the CtLoc when decomposing a type constructor, application, etc
+adjustCtLoc is_vis is_kind loc
+  = loc2
+  where
+    loc1 | is_kind   = toKindLoc loc
+         | otherwise = loc
+    loc2 | is_vis    = loc1
+         | otherwise = toInvisibleLoc loc1
+
+-- | Take a CtLoc and moves it to the kind level
+toKindLoc :: CtLoc -> CtLoc
+toKindLoc loc = loc { ctl_t_or_k = Just KindLevel }
+
+toInvisibleLoc :: CtLoc -> CtLoc
+toInvisibleLoc loc = updateCtLocOrigin loc toInvisibleOrigin
+
+mkGivenLoc :: TcLevel -> SkolemInfoAnon -> CtLocEnv -> CtLoc
+mkGivenLoc tclvl skol_info env
+  = CtLoc { ctl_origin   = GivenOrigin skol_info
+          , ctl_env      = setCtLocEnvLvl env tclvl
+          , ctl_t_or_k   = Nothing    -- this only matters for error msgs
+          , ctl_depth    = initialSubGoalDepth }
+
+ctLocEnv :: CtLoc -> CtLocEnv
+ctLocEnv = ctl_env
+
+ctLocLevel :: CtLoc -> TcLevel
+ctLocLevel loc = getCtLocEnvLvl (ctLocEnv loc)
+
+ctLocDepth :: CtLoc -> SubGoalDepth
+ctLocDepth = ctl_depth
+
+ctLocOrigin :: CtLoc -> CtOrigin
+ctLocOrigin = ctl_origin
+
+ctLocSpan :: CtLoc -> RealSrcSpan
+ctLocSpan (CtLoc { ctl_env = lcl}) = getCtLocEnvLoc lcl
+
+ctLocTypeOrKind_maybe :: CtLoc -> Maybe TypeOrKind
+ctLocTypeOrKind_maybe = ctl_t_or_k
+
+setCtLocSpan :: CtLoc -> RealSrcSpan -> CtLoc
+setCtLocSpan ctl@(CtLoc { ctl_env = lcl }) loc = setCtLocEnv ctl (setCtLocRealLoc lcl loc)
+
+bumpCtLocDepth :: CtLoc -> CtLoc
+bumpCtLocDepth loc@(CtLoc { ctl_depth = d }) = loc { ctl_depth = bumpSubGoalDepth d }
+
+setCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc
+setCtLocOrigin ctl orig = ctl { ctl_origin = orig }
+
+updateCtLocOrigin :: CtLoc -> (CtOrigin -> CtOrigin) -> CtLoc
+updateCtLocOrigin ctl@(CtLoc { ctl_origin = orig }) upd
+  = ctl { ctl_origin = upd orig }
+
+setCtLocEnv :: CtLoc -> CtLocEnv -> CtLoc
+setCtLocEnv ctl env = ctl { ctl_env = env }
+
+isGivenLoc :: CtLoc -> Bool
+isGivenLoc loc = isGivenOrigin (ctLocOrigin loc)
+
+pprCtLoc :: CtLoc -> SDoc
+-- "arising from ... at ..."
+-- Not an instance of Outputable because of the "arising from" prefix
+pprCtLoc (CtLoc { ctl_origin = o, ctl_env = lcl})
+  = sep [ pprCtOrigin o
+        , text "at" <+> ppr (getCtLocEnvLoc lcl)]
 
-import GHC.Tc.Types.BasicTypes
-import GHC.Tc.Utils.TcType
-import GHC.Tc.Types.ErrCtxt
 
+{- *********************************************************************
+*                                                                      *
+            CtLocEnv
+*                                                                      *
+********************************************************************* -}
 
 -- | Local typechecker environment for a constraint.
 --
@@ -57,4 +257,4 @@ setCtLocEnvLoc env loc@(UnhelpfulSpan _)
   = env
 
 ctLocEnvInGeneratedCode :: CtLocEnv -> Bool
-ctLocEnvInGeneratedCode = ctl_in_gen_code
\ No newline at end of file
+ctLocEnvInGeneratedCode = ctl_in_gen_code


=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -447,9 +447,9 @@ in the right place.  So we proceed as follows:
 * Typically a'' will have a nice pretty name like "a", but the point is
   that the foral-bound variables of the signature we report line up with
   the instantiated skolems lying  around in other types.
+-}
 
-
-************************************************************************
+{- *********************************************************************
 *                                                                      *
             CtOrigin
 *                                                                      *
@@ -968,6 +968,7 @@ pprNonLinearPatternReason PatternSynonymReason = parens (text "pattern synonyms
 pprNonLinearPatternReason ViewPatternReason = parens (text "view patterns aren't linear")
 pprNonLinearPatternReason OtherPatternReason = empty
 
+
 {- *********************************************************************
 *                                                                      *
              CallStacks and CtOrigin


=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -54,6 +54,7 @@ import GHC.Tc.Gen.Export
 import GHC.Tc.Solver
 import GHC.Tc.TyCl.Utils
 import GHC.Tc.Types.Constraint
+import GHC.Tc.Types.CtLocEnv( mkGivenLoc )
 import GHC.Tc.Types.Origin
 import GHC.Tc.Utils.Env
 import GHC.Tc.Utils.Monad


=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -157,6 +157,7 @@ import GHC.Builtin.Names
 import GHC.Tc.Errors.Types
 import GHC.Tc.Types     -- Re-export all
 import GHC.Tc.Types.Constraint
+import GHC.Tc.Types.CtLocEnv
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Types.Origin
 import GHC.Tc.Types.TcRef


=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -111,6 +111,7 @@ import {-# SOURCE #-} GHC.Tc.Utils.Unify( unifyInvisibleType, tcSubMult )
 import GHC.Tc.Types.Origin
 import GHC.Tc.Types.Constraint
 import GHC.Tc.Types.Evidence
+import GHC.Tc.Types.CtLocEnv( CtLoc, ctLocOrigin )
 import GHC.Tc.Utils.Monad        -- TcType, amongst others
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Errors.Types


=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -59,6 +59,7 @@ import GHC.Tc.Utils.TcMType
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Types.Constraint
+import GHC.Tc.Types.CtLocEnv( CtLoc, mkKindEqLoc, adjustCtLoc )
 import GHC.Tc.Types.Origin
 import GHC.Tc.Zonk.TcType
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/798f255538aa4b1113d2dc0f526214e45faba61a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/798f255538aa4b1113d2dc0f526214e45faba61a
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/20240622/d7c79e84/attachment-0001.html>


More information about the ghc-commits mailing list