summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc/Deriv
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Tc/Deriv')
-rw-r--r--compiler/GHC/Tc/Deriv/Infer.hs8
-rw-r--r--compiler/GHC/Tc/Deriv/Utils.hs11
2 files changed, 12 insertions, 7 deletions
diff --git a/compiler/GHC/Tc/Deriv/Infer.hs b/compiler/GHC/Tc/Deriv/Infer.hs
index f5f9e9d9ba..db54c9bab4 100644
--- a/compiler/GHC/Tc/Deriv/Infer.hs
+++ b/compiler/GHC/Tc/Deriv/Infer.hs
@@ -718,14 +718,14 @@ simplifyDeriv :: PredType -- ^ @C inst_ty@, head of the instance we are
-> TcM ThetaType -- ^ Needed constraints (after simplification),
-- i.e. @['PredType']@.
simplifyDeriv pred tvs thetas
- = do { (skol_subst, tvs_skols) <- tcInstSkolTyVars tvs -- Skolemize
+ = do { skol_info <- mkSkolemInfo (DerivSkol pred)
+ ; (skol_subst, tvs_skols) <- tcInstSkolTyVars skol_info tvs -- Skolemize
-- The constraint solving machinery
-- expects *TcTyVars* not TyVars.
-- We use *non-overlappable* (vanilla) skolems
-- See Note [Overlap and deriving]
; let skol_set = mkVarSet tvs_skols
- skol_info = DerivSkol pred
doc = text "deriving" <+> parens (ppr pred)
mk_given_ev :: PredType -> TcM EvVar
@@ -766,7 +766,7 @@ simplifyDeriv pred tvs thetas
= do { ac_given_evs <- mapM mk_given_ev ac_givens
; (_, wanteds)
<- captureConstraints $
- checkConstraints skol_info ac_skols ac_given_evs $
+ checkConstraints (getSkolemInfo skol_info) ac_skols ac_given_evs $
-- The checkConstraints bumps the TcLevel, and
-- wraps the wanted constraints in an implication,
-- when (but only when) necessary
@@ -841,7 +841,7 @@ simplifyDeriv pred tvs thetas
-- forall tvs. min_theta => solved_wanteds
; min_theta_vars <- mapM newEvVar min_theta
; (leftover_implic, _)
- <- buildImplicationFor tc_lvl skol_info tvs_skols
+ <- buildImplicationFor tc_lvl (getSkolemInfo skol_info) tvs_skols
min_theta_vars solved_wanteds
-- This call to simplifyTop is purely for error reporting
-- See Note [Error reporting for deriving clauses]
diff --git a/compiler/GHC/Tc/Deriv/Utils.hs b/compiler/GHC/Tc/Deriv/Utils.hs
index 2036e98300..91a11c9af6 100644
--- a/compiler/GHC/Tc/Deriv/Utils.hs
+++ b/compiler/GHC/Tc/Deriv/Utils.hs
@@ -507,13 +507,18 @@ mkPredOrigin origin t_or_k pred = PredOrigin pred origin t_or_k
mkThetaOrigin :: CtOrigin -> TypeOrKind
-> [TyVar] -> [TyVar] -> ThetaType -> ThetaType
-> ThetaOrigin
-mkThetaOrigin origin t_or_k skols metas givens
- = ThetaOrigin skols metas givens . map (mkPredOrigin origin t_or_k)
+mkThetaOrigin origin t_or_k skols metas givens wanteds
+ = ThetaOrigin { to_anyclass_skols = skols
+ , to_anyclass_metas = metas
+ , to_anyclass_givens = givens
+ , to_wanted_origins = map (mkPredOrigin origin t_or_k) wanteds }
-- A common case where the ThetaOrigin only contains wanted constraints, with
-- no givens or locally scoped type variables.
mkThetaOriginFromPreds :: [PredOrigin] -> ThetaOrigin
-mkThetaOriginFromPreds = ThetaOrigin [] [] []
+mkThetaOriginFromPreds origins
+ = ThetaOrigin { to_anyclass_skols = [], to_anyclass_metas = []
+ , to_anyclass_givens = [], to_wanted_origins = origins }
substPredOrigin :: HasCallStack => TCvSubst -> PredOrigin -> PredOrigin
substPredOrigin subst (PredOrigin pred origin t_or_k)