diff options
Diffstat (limited to 'compiler/GHC/Tc/Deriv')
-rw-r--r-- | compiler/GHC/Tc/Deriv/Infer.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Tc/Deriv/Utils.hs | 11 |
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) |