diff options
Diffstat (limited to 'compiler/GHC/Tc/Solver/Monad.hs')
| -rw-r--r-- | compiler/GHC/Tc/Solver/Monad.hs | 41 |
1 files changed, 22 insertions, 19 deletions
diff --git a/compiler/GHC/Tc/Solver/Monad.hs b/compiler/GHC/Tc/Solver/Monad.hs index 8721068b8c..99c35f826d 100644 --- a/compiler/GHC/Tc/Solver/Monad.hs +++ b/compiler/GHC/Tc/Solver/Monad.hs @@ -113,7 +113,7 @@ module GHC.Tc.Solver.Monad ( -- if the whole instance matcher simply belongs -- here - breakTyVarCycle_maybe, rewriterView + breakTyEqCycle_maybe, rewriterView ) where import GHC.Prelude @@ -934,7 +934,7 @@ runTcSWithEvBinds = runTcSWithEvBinds' True False runTcSWithEvBinds' :: Bool -- ^ Restore type variable cycles afterwards? -- Don't if you want to reuse the InertSet. - -- See also Note [Type variable cycles] + -- See also Note [Type equality cycles] -- in GHC.Tc.Solver.Canonical -> Bool -> EvBindsVar @@ -1898,21 +1898,20 @@ solverDepthError loc ty -- | Conditionally replace all type family applications in the RHS with fresh -- variables, emitting givens that relate the type family application to the --- variable. See Note [Type variable cycles] in GHC.Tc.Solver.Canonical. +-- variable. See Note [Type equality cycles] in GHC.Tc.Solver.Canonical. -- This only works under conditions as described in the Note; otherwise, returns -- Nothing. -breakTyVarCycle_maybe :: CtEvidence - -> CheckTyEqResult -- result of checkTypeEq - -> CanEqLHS - -> TcType -- RHS - -> TcS (Maybe (TcTyVar, ReductionN)) +breakTyEqCycle_maybe :: CtEvidence + -> CheckTyEqResult -- result of checkTypeEq + -> CanEqLHS + -> TcType -- RHS + -> TcS (Maybe ReductionN) -- new RHS that doesn't have any type families - -- TcTyVar is the LHS tv; convenient for the caller -breakTyVarCycle_maybe (ctLocOrigin . ctEvLoc -> CycleBreakerOrigin _) _ _ _ +breakTyEqCycle_maybe (ctLocOrigin . ctEvLoc -> CycleBreakerOrigin _) _ _ _ -- see Detail (7) of Note = return Nothing -breakTyVarCycle_maybe ev cte_result (TyVarLHS lhs_tv) rhs +breakTyEqCycle_maybe ev cte_result lhs rhs | NomEq <- eq_rel , cte_result `cterHasOnlyProblem` cteSolubleOccurs @@ -1921,7 +1920,7 @@ breakTyVarCycle_maybe ev cte_result (TyVarLHS lhs_tv) rhs = do { should_break <- final_check ; if should_break then do { redn <- go rhs - ; return (Just (lhs_tv, redn)) } + ; return (Just redn) } else return Nothing } where flavour = ctEvFlavour ev @@ -1929,10 +1928,14 @@ breakTyVarCycle_maybe ev cte_result (TyVarLHS lhs_tv) rhs final_check = case flavour of Given -> return True - Wanted -> do { result <- touchabilityTest Wanted lhs_tv rhs - ; return $ case result of - Untouchable -> False - _ -> True } + Wanted -- Wanteds work only with a touchable tyvar on the left + -- See "Wanted" section of the Note. + | TyVarLHS lhs_tv <- lhs -> + do { result <- touchabilityTest Wanted lhs_tv rhs + ; return $ case result of + Untouchable -> False + _ -> True } + | otherwise -> return False -- This could be considerably more efficient. See Detail (5) of Note. go :: TcType -> TcS ReductionN @@ -1977,7 +1980,7 @@ breakTyVarCycle_maybe ev cte_result (TyVarLHS lhs_tv) rhs fun_app new_ty given_term = evCoercion $ mkNomReflCo new_ty -- See Detail (4) of Note ; new_given <- newGivenEvVar new_loc (given_pred, given_term) - ; traceTcS "breakTyVarCycle replacing type family in Given" (ppr new_given) + ; traceTcS "breakTyEqCycle replacing type family in Given" (ppr new_given) ; emitWorkNC [new_given] ; updInertTcS $ \is -> is { inert_cycle_breakers = insertCycleBreakerBinding new_tv fun_app @@ -1995,10 +1998,10 @@ breakTyVarCycle_maybe ev cte_result (TyVarLHS lhs_tv) rhs new_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin -- does not fit scenario from Note -breakTyVarCycle_maybe _ _ _ _ = return Nothing +breakTyEqCycle_maybe _ _ _ _ = return Nothing -- | Fill in CycleBreakerTvs with the variables they stand for. --- See Note [Type variable cycles] in GHC.Tc.Solver.Canonical. +-- See Note [Type equality cycles] in GHC.Tc.Solver.Canonical. restoreTyVarCycles :: InertSet -> TcM () restoreTyVarCycles is = forAllCycleBreakerBindings_ (inert_cycle_breakers is) TcM.writeMetaTyVar |