diff options
Diffstat (limited to 'compiler/GHC/Tc/Utils')
| -rw-r--r-- | compiler/GHC/Tc/Utils/TcMType.hs | 17 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/Zonk.hs | 9 |
2 files changed, 17 insertions, 9 deletions
diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs index 4f69413a86..038fc5027b 100644 --- a/compiler/GHC/Tc/Utils/TcMType.hs +++ b/compiler/GHC/Tc/Utils/TcMType.hs @@ -1581,15 +1581,11 @@ collect_cand_qtvs_co orig_ty bound = go_co go_co dv (InstCo co1 co2) = foldlM go_co dv [co1, co2] go_co dv (KindCo co) = go_co dv co go_co dv (SubCo co) = go_co dv co + go_co dv (HoleCo hole) = go_hole dv hole go_co dv (ZappedCo _ t1 t2 vs) = do dv1 <- collect_cand_qtvs orig_ty True bound dv t1 dv2 <- collect_cand_qtvs orig_ty True bound dv1 t2 - foldlM go_cv dv2 vs - - go_co dv (HoleCo hole) - = do m_co <- unpackCoercionHole_maybe hole - case m_co of - Just co -> go_co dv co - Nothing -> go_cv dv (coHoleCoVar hole) + dv3 <- foldlM go_cv dv2 (freeCoVars vs) + foldlM go_hole dv3 (freeCoHoles vs) go_co dv (CoVarCo cv) = go_cv dv cv @@ -1615,6 +1611,13 @@ collect_cand_qtvs_co orig_ty bound = go_co (dv { dv_cvs = cvs `extendVarSet` cv }) (idType cv) + go_hole :: CandidatesQTvs -> CoercionHole -> TcM CandidatesQTvs + go_hole dv hole = do + m_co <- unpackCoercionHole_maybe hole + case m_co of + Just co -> go_co dv co + Nothing -> go_cv dv (coHoleCoVar hole) + is_bound tv = tv `elemVarSet` bound {- Note [Order of accumulation] diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs index b0af88d813..6a0380469b 100644 --- a/compiler/GHC/Tc/Utils/Zonk.hs +++ b/compiler/GHC/Tc/Utils/Zonk.hs @@ -1911,10 +1911,15 @@ zonkScaledTcTypeToTypeX env (Scaled m ty) = Scaled <$> zonkTcTypeToTypeX env m zonkTcTypeToTypeX :: ZonkEnv -> TcType -> TcM Type zonkTcTypesToTypesX :: ZonkEnv -> [TcType] -> TcM [Type] -zonkCoToCo :: ZonkEnv -> Coercion -> TcM Coercion -(zonkTcTypeToTypeX, zonkTcTypesToTypesX, zonkCoToCo, _) +zonkCoToCo_, zonkCoToCo :: ZonkEnv -> Coercion -> TcM Coercion -- "RAE" +(zonkTcTypeToTypeX, zonkTcTypesToTypesX, zonkCoToCo_, _) = mapTyCoX zonk_tycomapper +zonkCoToCo env co = do { traceTc "RAE1" (ppr co) + ; co' <- zonkCoToCo_ env co + ; traceTc "RAE2" (ppr co') + ; return co' } + zonkScaledTcTypesToTypesX :: ZonkEnv -> [Scaled TcType] -> TcM [Scaled Type] zonkScaledTcTypesToTypesX env scaled_tys = mapM (zonkScaledTcTypeToTypeX env) scaled_tys |