diff options
Diffstat (limited to 'compiler/GHC/Tc/Solver/Canonical.hs')
| -rw-r--r-- | compiler/GHC/Tc/Solver/Canonical.hs | 22 |
1 files changed, 11 insertions, 11 deletions
diff --git a/compiler/GHC/Tc/Solver/Canonical.hs b/compiler/GHC/Tc/Solver/Canonical.hs index db1c3c1652..b7c702e5b9 100644 --- a/compiler/GHC/Tc/Solver/Canonical.hs +++ b/compiler/GHC/Tc/Solver/Canonical.hs @@ -872,13 +872,13 @@ solveForAll ev tvs theta pred pend_sc | CtWanted { ctev_dest = dest } <- ev = -- See Note [Solving a Wanted forall-constraint] setLclEnv (ctLocEnv loc) $ - -- This setLclEnv is important: the emitImplicationTcS uses that - -- TcLclEnv for the implication, and that in turn sets the location - -- for the Givens when solving the constraint (#21006) - do { let skol_info = QuantCtxtSkol - empty_subst = mkEmptyTCvSubst $ mkInScopeSet $ + -- This setLclEnv is important: the emitImplicationTcS uses that + -- TcLclEnv for the implication, and that in turn sets the location + -- for the Givens when solving the constraint (#21006) + do { skol_info <- mkSkolemInfo QuantCtxtSkol + ; let empty_subst = mkEmptyTCvSubst $ mkInScopeSet $ tyCoVarsOfTypes (pred:theta) `delVarSetList` tvs - ; (subst, skol_tvs) <- tcInstSkolTyVarsX empty_subst tvs + ; (subst, skol_tvs) <- tcInstSkolTyVarsX skol_info empty_subst tvs ; given_ev_vars <- mapM newEvVar (substTheta subst theta) ; (lvl, (w_id, wanteds)) @@ -888,7 +888,7 @@ solveForAll ev tvs theta pred pend_sc ; return ( ctEvEvId wanted_ev , unitBag (mkNonCanonical wanted_ev)) } - ; ev_binds <- emitImplicationTcS lvl skol_info skol_tvs + ; ev_binds <- emitImplicationTcS lvl (getSkolemInfo skol_info) skol_tvs given_ev_vars wanteds ; setWantedEvTerm dest $ @@ -1352,11 +1352,11 @@ can_eq_nc_forall ev eq_rel s1 s2 else do { traceTcS "Creating implication for polytype equality" $ ppr ev ; let empty_subst1 = mkEmptyTCvSubst $ mkInScopeSet free_tvs - ; (subst1, skol_tvs) <- tcInstSkolTyVarsX empty_subst1 $ + ; skol_info <- mkSkolemInfo (UnifyForAllSkol phi1) + ; (subst1, skol_tvs) <- tcInstSkolTyVarsX skol_info empty_subst1 $ binderVars bndrs1 - ; let skol_info = UnifyForAllSkol phi1 - phi1' = substTy subst1 phi1 + ; let phi1' = substTy subst1 phi1 -- Unify the kinds, extend the substitution go :: [TcTyVar] -> TCvSubst -> [TyVarBinder] @@ -1384,7 +1384,7 @@ can_eq_nc_forall ev eq_rel s1 s2 ; (lvl, (all_co, wanteds)) <- pushLevelNoWorkList (ppr skol_info) $ go skol_tvs empty_subst2 bndrs2 - ; emitTvImplicationTcS lvl skol_info skol_tvs wanteds + ; emitTvImplicationTcS lvl (getSkolemInfo skol_info) skol_tvs wanteds ; setWantedEq orig_dest all_co ; stopWith ev "Deferred polytype equality" } } |