diff options
author | Matthew Craven <5086-clyring@users.noreply.gitlab.haskell.org> | 2023-04-23 14:20:33 -0400 |
---|---|---|
committer | Matthew Craven <5086-clyring@users.noreply.gitlab.haskell.org> | 2023-04-23 14:20:33 -0400 |
commit | d7f95d4a8492e9aaf5a5c6af317ffe4e393413d2 (patch) | |
tree | 0e0925a0a6b898b045ea6f88ab28d8abcea17251 | |
parent | 88066d9ef1fc0c5f9c92c6376418cf02c1d038a4 (diff) | |
download | haskell-d7f95d4a8492e9aaf5a5c6af317ffe4e393413d2.tar.gz |
revert temporary renamings of the forallco constructorswip/forall-vis-coercions
-rw-r--r-- | compiler/GHC/Core/Coercion.hs | 35 | ||||
-rw-r--r-- | compiler/GHC/Core/Coercion/Opt.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Core/FVs.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Core/Lint.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Core/TyCo/FVs.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/Core/TyCo/Rep.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Core/TyCo/Subst.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Core/TyCo/Tidy.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Core/Type.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Core/Unify.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/CoreToIface.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Iface/Rename.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Iface/Syntax.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Iface/Type.hs | 16 | ||||
-rw-r--r-- | compiler/GHC/IfaceToCore.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Tc/TyCl/Utils.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Tc/Utils/TcMType.hs | 2 |
17 files changed, 56 insertions, 55 deletions
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs index 4263f26d92..5de9aedde2 100644 --- a/compiler/GHC/Core/Coercion.hs +++ b/compiler/GHC/Core/Coercion.hs @@ -169,6 +169,7 @@ import Control.Monad (foldM, zipWithM) import Data.Function ( on ) import Data.Char( isDigit ) import qualified Data.Monoid as Monoid +import Control.DeepSeq {- %************************************************************************ @@ -556,18 +557,18 @@ splitFunCo_maybe (FunCo { fco_arg = arg, fco_res = res }) = Just (arg, res) splitFunCo_maybe _ = Nothing splitForAllCo_maybe :: Coercion -> Maybe (TyCoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion) -splitForAllCo_maybe (ForAllCoX tv vL vR k_co co) = Just (tv, vL, vR, k_co, co) +splitForAllCo_maybe (ForAllCo tv vL vR k_co co) = Just (tv, vL, vR, k_co, co) splitForAllCo_maybe _ = Nothing -- | Like 'splitForAllCo_maybe', but only returns Just for tyvar binder splitForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion) -splitForAllCo_ty_maybe (ForAllCoX tv vL vR k_co co) +splitForAllCo_ty_maybe (ForAllCo tv vL vR k_co co) | isTyVar tv = Just (tv, vL, vR, k_co, co) splitForAllCo_ty_maybe _ = Nothing -- | Like 'splitForAllCo_maybe', but only returns Just for covar binder splitForAllCo_co_maybe :: Coercion -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion) -splitForAllCo_co_maybe (ForAllCoX cv vL vR k_co co) +splitForAllCo_co_maybe (ForAllCo cv vL vR k_co co) | isCoVar cv = Just (cv, vL, vR, k_co, co) splitForAllCo_co_maybe _ = Nothing @@ -966,7 +967,7 @@ mkForAllCo v visL visR kind_co co , visL `eqForAllVis` visR = mkReflCo r (mkTyCoForAllTy v visL ty) | otherwise - = ForAllCoX v visL visR kind_co co + = ForAllCo v visL visR kind_co co -- | Like 'mkForAllCo', but the inner coercion shouldn't be an obvious -- reflexive coercion. For example, it is guaranteed in 'mkForAllCos'. @@ -981,7 +982,7 @@ mkForAllCo_NoRefl v visL visR kind_co co = mkFunCoNoFTF (coercionRole co) (multToCo ManyTy) kind_co co -- Functions from coercions are always unrestricted | otherwise - = ForAllCoX v visL visR kind_co co + = ForAllCo v visL visR kind_co co -- | Make nested ForAllCos, with 'Specified' visibility mkForAllCos :: [(TyCoVar, CoercionN)] -> Coercion -> Coercion @@ -1165,7 +1166,7 @@ mkSelCo_maybe cs co | Just (ty, r) <- isReflCo_maybe co = Just (mkReflCo r (getNthFromType cs ty)) - go SelForAll (ForAllCoX _ _ _ kind_co _) + go SelForAll (ForAllCo _ _ _ kind_co _) = Just kind_co -- If co :: (forall a1:k1. t1) ~ (forall a2:k2. t2) -- then (nth SelForAll co :: k1 ~N k2) @@ -1233,7 +1234,7 @@ mkLRCo lr co -- | Instantiates a 'Coercion'. mkInstCo :: Coercion -> CoercionN -> Coercion -mkInstCo (ForAllCoX tcv _visL _visR _kind_co body_co) co +mkInstCo (ForAllCo tcv _visL _visR _kind_co body_co) co | Just (arg, _) <- isReflCo_maybe co -- works for both tyvar and covar = substCoUnchecked (zipTCvSubst [tcv] [arg]) body_co @@ -1385,9 +1386,9 @@ setNominalRole_maybe r co = TransCo <$> setNominalRole_maybe_helper co1 <*> setNominalRole_maybe_helper co2 setNominalRole_maybe_helper (AppCo co1 co2) = AppCo <$> setNominalRole_maybe_helper co1 <*> pure co2 - setNominalRole_maybe_helper (ForAllCoX tv visL visR kind_co co) + setNominalRole_maybe_helper (ForAllCo tv visL visR kind_co co) | visL `eqForAllVis` visR - = ForAllCoX tv visL visR kind_co <$> setNominalRole_maybe_helper co + = ForAllCo tv visL visR kind_co <$> setNominalRole_maybe_helper co setNominalRole_maybe_helper (SelCo n co) -- NB, this case recurses via setNominalRole_maybe, not -- setNominalRole_maybe_helper! @@ -1498,11 +1499,11 @@ promoteCoercion co = case co of | otherwise -> mkKindCo co - ForAllCoX tv _ _ _ g + ForAllCo tv _ _ _ g | isTyVar tv -> promoteCoercion g - ForAllCoX {} + ForAllCo {} -- Is it possible to make a tricky coercion with type -- "forall {covar}. ty ~R# forall covar -> ty"? Probably not; -- forall-covar-types are still very internal-ish and limited. @@ -2328,7 +2329,7 @@ seqCo (Refl ty) = seqType ty seqCo (GRefl r ty mco) = r `seq` seqType ty `seq` seqMCo mco seqCo (TyConAppCo r tc cos) = r `seq` tc `seq` seqCos cos seqCo (AppCo co1 co2) = seqCo co1 `seq` seqCo co2 -seqCo (ForAllCoX tv visL visR k co) = seqType (varType tv) `seq` +seqCo (ForAllCo tv visL visR k co) = seqType (varType tv) `seq` rnf visL `seq` rnf visR `seq` seqCo k `seq` seqCo co seqCo (FunCo r af1 af2 w co1 co2) = r `seq` af1 `seq` af2 `seq` @@ -2395,7 +2396,7 @@ coercionLKind co go (GRefl _ ty _) = ty go (TyConAppCo _ tc cos) = mkTyConApp tc (map go cos) go (AppCo co1 co2) = mkAppTy (go co1) (go co2) - go (ForAllCoX tv1 visL _ _ co1) = mkTyCoForAllTy tv1 visL (go co1) + go (ForAllCo tv1 visL _ _ co1) = mkTyCoForAllTy tv1 visL (go co1) go (FunCo { fco_afl = af, fco_mult = mult, fco_arg = arg, fco_res = res}) {- See Note [FunCo] -} = FunTy { ft_af = af, ft_mult = go mult , ft_arg = go arg, ft_res = go res } @@ -2474,7 +2475,7 @@ coercionRKind co go (AxiomRuleCo ax cos) = pSnd $ expectJust "coercionKind" $ coaxrProves ax $ map coercionKind cos - go co@(ForAllCoX tv1 _visL visR k_co co1) -- works for both tyvar and covar + go co@(ForAllCo tv1 _visL visR k_co co1) -- works for both tyvar and covar | isGReflCo k_co = mkTyCoForAllTy tv1 visR (go co1) -- kind_co always has kind @Type@, thus @isGReflCo@ | otherwise = go_forall empty_subst co @@ -2498,7 +2499,7 @@ coercionRKind co go_app (InstCo co arg) args = go_app co (go arg:args) go_app co args = piResultTys (go co) args - go_forall subst (ForAllCoX tv1 _visL visR k_co co) + go_forall subst (ForAllCo tv1 _visL visR k_co co) -- See Note [Nested ForAllCos] | isTyVar tv1 = mkForAllTy (Bndr tv2 visR) (go_forall subst' co) @@ -2510,7 +2511,7 @@ coercionRKind co | otherwise = extendTvSubst (extendSubstInScope subst tv2) tv1 $ TyVarTy tv2 `mkCastTy` mkSymCo k_co - go_forall subst (ForAllCoX cv1 _visL visR k_co co) + go_forall subst (ForAllCo cv1 _visL visR k_co co) | isCoVar cv1 = mkTyCoForAllTy cv2 visR (go_forall subst' co) where @@ -2564,7 +2565,7 @@ coercionRole = go go (GRefl r _ _) = r go (TyConAppCo r _ _) = r go (AppCo co1 _) = go co1 - go (ForAllCoX _tcv _visL _visR _kco co) = go co + go (ForAllCo _tcv _visL _visR _kco co) = go co go (FunCo { fco_role = r }) = r go (CoVarCo cv) = coVarRole cv go (HoleCo h) = coVarRole (coHoleCoVar h) diff --git a/compiler/GHC/Core/Coercion/Opt.hs b/compiler/GHC/Core/Coercion/Opt.hs index 0a856b4665..2950836d79 100644 --- a/compiler/GHC/Core/Coercion/Opt.hs +++ b/compiler/GHC/Core/Coercion/Opt.hs @@ -291,7 +291,7 @@ opt_co4 env sym rep r (AppCo co1 co2) = mkAppCo (opt_co4_wrap env sym rep r co1) (opt_co4_wrap env sym False Nominal co2) -opt_co4 env sym rep r (ForAllCoX tv visL visR k_co co) +opt_co4 env sym rep r (ForAllCo tv visL visR k_co co) = case optForAllCoBndr env sym tv k_co of (env', tv', k_co') -> mkForAllCo tv' visL visR k_co' $ opt_co4_wrap env' sym rep r co @@ -377,7 +377,7 @@ opt_co4 env sym rep r (SelCo (SelTyCon n r1) (TyConAppCo _ _ cos)) opt_co4 env sym rep r (SelCo (SelFun fs) (FunCo _r2 _afl _afr w co1 co2)) = opt_co4_wrap env sym rep r (getNthFun fs w co1 co2) -opt_co4 env sym rep _ (SelCo SelForAll (ForAllCoX _ _ _ eta _)) +opt_co4 env sym rep _ (SelCo SelForAll (ForAllCo _ _ _ eta _)) -- works for both tyvar and covar = opt_co4_wrap env sym rep Nominal eta @@ -385,7 +385,7 @@ opt_co4 env sym rep r (SelCo n co) | Just nth_co <- case (co', n) of (TyConAppCo _ _ cos, SelTyCon n _) -> Just (cos `getNth` n) (FunCo _ _ _ w co1 co2, SelFun fs) -> Just (getNthFun fs w co1 co2) - (ForAllCoX _ _ _ eta _, SelForAll) -> Just eta + (ForAllCo _ _ _ eta _, SelForAll) -> Just eta _ -> Nothing = if rep && (r == Nominal) -- keep propagating the SubCo diff --git a/compiler/GHC/Core/FVs.hs b/compiler/GHC/Core/FVs.hs index 1ca3da48cc..eb0a4e6f9c 100644 --- a/compiler/GHC/Core/FVs.hs +++ b/compiler/GHC/Core/FVs.hs @@ -386,7 +386,7 @@ orphNamesOfCo (Refl ty) = orphNamesOfType ty orphNamesOfCo (GRefl _ ty mco) = orphNamesOfType ty `unionNameSet` orphNamesOfMCo mco orphNamesOfCo (TyConAppCo _ tc cos) = unitNameSet (getName tc) `unionNameSet` orphNamesOfCos cos orphNamesOfCo (AppCo co1 co2) = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2 -orphNamesOfCo (ForAllCoX _tcv _vL _vR kind_co co) = orphNamesOfCo kind_co +orphNamesOfCo (ForAllCo _tcv _vL _vR kind_co co) = orphNamesOfCo kind_co `unionNameSet` orphNamesOfCo co orphNamesOfCo (FunCo { fco_mult = co_mult, fco_arg = co1, fco_res = co2 }) = orphNamesOfCo co_mult diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs index cc406893fd..8dff951f2a 100644 --- a/compiler/GHC/Core/Lint.hs +++ b/compiler/GHC/Core/Lint.hs @@ -2222,7 +2222,7 @@ lintCoercion co@(AppCo co1 co2) ; return (AppCo co1' co2') } ---------- -lintCoercion co@(ForAllCoX tcv visL visR kind_co body_co) +lintCoercion co@(ForAllCo tcv visL visR kind_co body_co) | not (isTyCoVar tcv) = failWithL (text "Non tyco binder in ForAllCo:" <+> ppr co) | otherwise @@ -2253,7 +2253,7 @@ lintCoercion co@(ForAllCoX tcv visL visR kind_co body_co) lintL (visL `eqForAllVis` visR) $ text "Nominal ForAllCo has mismatched visibilities: " <+> ppr co - ; return (ForAllCoX tcv' visL visR kind_co' body_co') } } + ; return (ForAllCo tcv' visL visR kind_co' body_co') } } lintCoercion co@(FunCo { fco_role = r, fco_afl = afl, fco_afr = afr , fco_mult = cow, fco_arg = co1, fco_res = co2 }) diff --git a/compiler/GHC/Core/TyCo/FVs.hs b/compiler/GHC/Core/TyCo/FVs.hs index 415e4b782f..9f415dbb54 100644 --- a/compiler/GHC/Core/TyCo/FVs.hs +++ b/compiler/GHC/Core/TyCo/FVs.hs @@ -631,7 +631,7 @@ tyCoFVsOfCo (GRefl _ ty mco) fv_cand in_scope acc tyCoFVsOfCo (TyConAppCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc tyCoFVsOfCo (AppCo co arg) fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc -tyCoFVsOfCo (ForAllCoX tv _visL _visR kind_co co) fv_cand in_scope acc +tyCoFVsOfCo (ForAllCo tv _visL _visR kind_co co) fv_cand in_scope acc = (tyCoFVsVarBndr tv (tyCoFVsOfCo co) `unionFV` tyCoFVsOfCo kind_co) fv_cand in_scope acc tyCoFVsOfCo (FunCo { fco_mult = w, fco_arg = co1, fco_res = co2 }) fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2 `unionFV` tyCoFVsOfCo w) fv_cand in_scope acc @@ -686,7 +686,7 @@ almost_devoid_co_var_of_co (TyConAppCo _ _ cos) cv almost_devoid_co_var_of_co (AppCo co arg) cv = almost_devoid_co_var_of_co co cv && almost_devoid_co_var_of_co arg cv -almost_devoid_co_var_of_co (ForAllCoX v _visL _visR kind_co co) cv +almost_devoid_co_var_of_co (ForAllCo v _visL _visR kind_co co) cv = almost_devoid_co_var_of_co kind_co cv && (v == cv || almost_devoid_co_var_of_co co cv) almost_devoid_co_var_of_co (FunCo { fco_mult = w, fco_arg = co1, fco_res = co2 }) cv @@ -1109,7 +1109,7 @@ tyConsOfType ty go_co (GRefl _ ty mco) = go ty `unionUniqSets` go_mco mco go_co (TyConAppCo _ tc args) = go_tc tc `unionUniqSets` go_cos args go_co (AppCo co arg) = go_co co `unionUniqSets` go_co arg - go_co (ForAllCoX _ _ _ kind_co co) = go_co kind_co `unionUniqSets` go_co co + go_co (ForAllCo _ _ _ kind_co co) = go_co kind_co `unionUniqSets` go_co co go_co (FunCo { fco_mult = m, fco_arg = a, fco_res = r }) = go_co m `unionUniqSets` go_co a `unionUniqSets` go_co r go_co (AxiomInstCo ax _ args) = go_ax ax `unionUniqSets` go_cos args @@ -1293,14 +1293,14 @@ occCheckExpand vs_to_avoid ty go_co cxt (AppCo co arg) = do { co' <- go_co cxt co ; arg' <- go_co cxt arg ; return (AppCo co' arg') } - go_co cxt@(as, env) (ForAllCoX tv visL visR kind_co body_co) + go_co cxt@(as, env) (ForAllCo tv visL visR kind_co body_co) = do { kind_co' <- go_co cxt kind_co ; let tv' = setVarType tv $ coercionLKind kind_co' env' = extendVarEnv env tv tv' as' = as `delVarSet` tv ; body' <- go_co (as', env') body_co - ; return (ForAllCoX tv' visL visR kind_co' body') } + ; return (ForAllCo tv' visL visR kind_co' body') } go_co cxt co@(FunCo { fco_mult = w, fco_arg = co1 ,fco_res = co2 }) = do { co1' <- go_co cxt co1 ; co2' <- go_co cxt co2 diff --git a/compiler/GHC/Core/TyCo/Rep.hs b/compiler/GHC/Core/TyCo/Rep.hs index 1beef01853..257d85e62a 100644 --- a/compiler/GHC/Core/TyCo/Rep.hs +++ b/compiler/GHC/Core/TyCo/Rep.hs @@ -850,7 +850,7 @@ data Coercion -- AppCo :: e -> N -> e -- See Note [Forall coercions] - | ForAllCoX + | ForAllCo TyCoVar !ForAllTyFlag -- visibility of coercionLKind !ForAllTyFlag -- visibility of coercionRKind @@ -1757,7 +1757,7 @@ foldTyCo (TyCoFolder { tcf_view = view go_co env (FunCo { fco_mult = cw, fco_arg = c1, fco_res = c2 }) = go_co env cw `mappend` go_co env c1 `mappend` go_co env c2 - go_co env (ForAllCoX tv _vis1 _vis2 kind_co co) + go_co env (ForAllCo tv _vis1 _vis2 kind_co co) = go_co env kind_co `mappend` go_ty env (varType tv) `mappend` go_co env' co where @@ -1812,7 +1812,7 @@ coercionSize (GRefl _ ty MRefl) = typeSize ty coercionSize (GRefl _ ty (MCo co)) = 1 + typeSize ty + coercionSize co coercionSize (TyConAppCo _ _ args) = 1 + sum (map coercionSize args) coercionSize (AppCo co arg) = coercionSize co + coercionSize arg -coercionSize (ForAllCoX _ _ _ h co) = 1 + coercionSize co + coercionSize h +coercionSize (ForAllCo _ _ _ h co) = 1 + coercionSize co + coercionSize h coercionSize (FunCo _ _ _ w c1 c2) = 1 + coercionSize c1 + coercionSize c2 + coercionSize w coercionSize (CoVarCo _) = 1 diff --git a/compiler/GHC/Core/TyCo/Subst.hs b/compiler/GHC/Core/TyCo/Subst.hs index 5dfc79dbf6..7ed64e1954 100644 --- a/compiler/GHC/Core/TyCo/Subst.hs +++ b/compiler/GHC/Core/TyCo/Subst.hs @@ -889,7 +889,7 @@ subst_co subst co go (TyConAppCo r tc args)= let args' = map go args in args' `seqList` mkTyConAppCo r tc args' go (AppCo co arg) = (mkAppCo $! go co) $! go arg - go (ForAllCoX tv visL visR kind_co co) + go (ForAllCo tv visL visR kind_co co) = case substForAllCoBndrUnchecked subst tv kind_co of (subst', tv', kind_co') -> ((mkForAllCo $! tv') visL visR $! kind_co') $! subst_co subst' co diff --git a/compiler/GHC/Core/TyCo/Tidy.hs b/compiler/GHC/Core/TyCo/Tidy.hs index 988bbc7c49..e5e091a30a 100644 --- a/compiler/GHC/Core/TyCo/Tidy.hs +++ b/compiler/GHC/Core/TyCo/Tidy.hs @@ -228,8 +228,8 @@ tidyCo env@(_, subst) co go (GRefl r ty mco) = (GRefl r $! tidyType env ty) $! go_mco mco go (TyConAppCo r tc cos) = TyConAppCo r tc $! strictMap go cos go (AppCo co1 co2) = (AppCo $! go co1) $! go co2 - go (ForAllCoX tv visL visR h co) - = ((((ForAllCoX $! tvp) $! visL) $! visR) $! (go h)) $! (tidyCo envp co) + go (ForAllCo tv visL visR h co) + = ((((ForAllCo $! tvp) $! visL) $! visR) $! (go h)) $! (tidyCo envp co) where (envp, tvp) = tidyVarBndr env tv -- the case above duplicates a bit of work in tidying h and the kind -- of tv. But the alternative is to use coercionKind, which seems worse. diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index 159fa2a38b..97e6a5cd12 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -547,7 +547,7 @@ expandTypeSynonyms ty = mkTyConAppCo r tc (map (go_co subst) args) go_co subst (AppCo co arg) = mkAppCo (go_co subst co) (go_co subst arg) - go_co subst (ForAllCoX tv visL visR kind_co co) + go_co subst (ForAllCo tv visL visR kind_co co) = let (subst', tv', kind_co') = go_cobndr subst tv kind_co in mkForAllCo tv' visL visR kind_co' (go_co subst' co) go_co subst (FunCo r afl afr w co1 co2) @@ -988,7 +988,7 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar | otherwise = mkTyConAppCo r tc <$> go_cos env cos - go_co env (ForAllCoX tv visL visR kind_co co) + go_co env (ForAllCo tv visL visR kind_co co) = do { kind_co' <- go_co env kind_co ; (env', tv') <- tycobinder env tv visL ; co' <- go_co env' co diff --git a/compiler/GHC/Core/Unify.hs b/compiler/GHC/Core/Unify.hs index 89b3bfc3b7..c0f6480485 100644 --- a/compiler/GHC/Core/Unify.hs +++ b/compiler/GHC/Core/Unify.hs @@ -1673,7 +1673,7 @@ ty_co_match menv subst (FunTy { ft_mult = w, ft_arg = ty1, ft_res = ty2 }) -- not doing so caused #21205. ty_co_match menv subst (ForAllTy (Bndr tv1 vis1t) ty1) - (ForAllCoX tv2 vis1c vis2c kind_co2 co2) + (ForAllCo tv2 vis1c vis2c kind_co2 co2) lkco rkco | isTyVar tv1 && isTyVar tv2 , vis1t == vis1c && vis1c == vis2c -- Is this necessary? @@ -1777,7 +1777,7 @@ pushRefl co = Just (TyConApp tc tys, r) -> Just (TyConAppCo r tc (zipWith mkReflCo (tyConRoleListX r tc) tys)) Just (ForAllTy (Bndr tv vis) ty, r) - -> Just (ForAllCoX tv vis vis (mkNomReflCo (varType tv)) (mkReflCo r ty)) + -> Just (ForAllCo tv vis vis (mkNomReflCo (varType tv)) (mkReflCo r ty)) -- NB: NoRefl variant. Otherwise, we get a loop! _ -> Nothing diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs index 941f79168e..c0c40fea1e 100644 --- a/compiler/GHC/CoreToIface.hs +++ b/compiler/GHC/CoreToIface.hs @@ -311,8 +311,8 @@ toIfaceCoercionX fr co go (FunCo { fco_role = r, fco_mult = w, fco_arg = co1, fco_res = co2 }) = IfaceFunCo r (go w) (go co1) (go co2) - go (ForAllCoX tv visL visR k co) - = IfaceForAllCoY(toIfaceBndr tv) + go (ForAllCo tv visL visR k co) + = IfaceForAllCo (toIfaceBndr tv) visL visR (toIfaceCoercionX fr' k) diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs index 996cd88826..fe08cad059 100644 --- a/compiler/GHC/Iface/Rename.hs +++ b/compiler/GHC/Iface/Rename.hs @@ -668,8 +668,8 @@ rnIfaceCo (IfaceTyConAppCo role tc cos) = IfaceTyConAppCo role <$> rnIfaceTyCon tc <*> mapM rnIfaceCo cos rnIfaceCo (IfaceAppCo co1 co2) = IfaceAppCo <$> rnIfaceCo co1 <*> rnIfaceCo co2 -rnIfaceCo (IfaceForAllCoY bndr visL visR co1 co2) - = (\bndr' co1' co2' -> IfaceForAllCoY bndr' visL visR co1' co2') +rnIfaceCo (IfaceForAllCo bndr visL visR co1 co2) + = (\bndr' co1' co2' -> IfaceForAllCo bndr' visL visR co1' co2') <$> rnIfaceBndr bndr <*> rnIfaceCo co1 <*> rnIfaceCo co2 rnIfaceCo (IfaceFreeCoVar c) = pure (IfaceFreeCoVar c) rnIfaceCo (IfaceCoVarCo lcl) = IfaceCoVarCo <$> pure lcl diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs index 18a512e207..e3ff179b74 100644 --- a/compiler/GHC/Iface/Syntax.hs +++ b/compiler/GHC/Iface/Syntax.hs @@ -1717,7 +1717,7 @@ freeNamesIfCoercion (IfaceTyConAppCo _ tc cos) = freeNamesIfTc tc &&& fnList freeNamesIfCoercion cos freeNamesIfCoercion (IfaceAppCo c1 c2) = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2 -freeNamesIfCoercion (IfaceForAllCoY _tcv _visL _visR kind_co co) +freeNamesIfCoercion (IfaceForAllCo _tcv _visL _visR kind_co co) = freeNamesIfCoercion kind_co &&& freeNamesIfCoercion co freeNamesIfCoercion (IfaceFreeCoVar _) = emptyNameSet freeNamesIfCoercion (IfaceCoVarCo _) = emptyNameSet diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs index 22c458bc08..dcb8293488 100644 --- a/compiler/GHC/Iface/Type.hs +++ b/compiler/GHC/Iface/Type.hs @@ -380,7 +380,7 @@ data IfaceCoercion | IfaceFunCo Role IfaceCoercion IfaceCoercion IfaceCoercion | IfaceTyConAppCo Role IfaceTyCon [IfaceCoercion] | IfaceAppCo IfaceCoercion IfaceCoercion - | IfaceForAllCoY IfaceBndr !ForAllTyFlag !ForAllTyFlag IfaceCoercion IfaceCoercion + | IfaceForAllCo IfaceBndr !ForAllTyFlag !ForAllTyFlag IfaceCoercion IfaceCoercion | IfaceCoVarCo IfLclName | IfaceAxiomInstCo IfExtName BranchIndex [IfaceCoercion] | IfaceAxiomRuleCo IfLclName [IfaceCoercion] @@ -604,7 +604,7 @@ substIfaceType env ty go_co (IfaceFunCo r w c1 c2) = IfaceFunCo r (go_co w) (go_co c1) (go_co c2) go_co (IfaceTyConAppCo r tc cos) = IfaceTyConAppCo r tc (go_cos cos) go_co (IfaceAppCo c1 c2) = IfaceAppCo (go_co c1) (go_co c2) - go_co (IfaceForAllCoY {}) = pprPanic "substIfaceCoercion" (ppr ty) + go_co (IfaceForAllCo {}) = pprPanic "substIfaceCoercion" (ppr ty) go_co (IfaceFreeCoVar cv) = IfaceFreeCoVar cv go_co (IfaceCoVarCo cv) = IfaceCoVarCo cv go_co (IfaceHoleCo cv) = IfaceHoleCo cv @@ -1791,16 +1791,16 @@ ppr_co _ (IfaceTyConAppCo r tc cos) ppr_co ctxt_prec (IfaceAppCo co1 co2) = maybeParen ctxt_prec appPrec $ ppr_co funPrec co1 <+> pprParendIfaceCoercion co2 -ppr_co ctxt_prec co@(IfaceForAllCoY {}) +ppr_co ctxt_prec co@(IfaceForAllCo {}) = maybeParen ctxt_prec funPrec $ -- FIXME: collect and pretty-print visibility info? pprIfaceForAllCoPart tvs (pprIfaceCoercion inner_co) where (tvs, inner_co) = split_co co - split_co (IfaceForAllCoY (IfaceTvBndr (name, _)) _visL _visR kind_co co') + split_co (IfaceForAllCo (IfaceTvBndr (name, _)) _visL _visR kind_co co') = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'') - split_co (IfaceForAllCoY (IfaceIdBndr (_, name, _)) _visL _visR kind_co co') + split_co (IfaceForAllCo (IfaceIdBndr (_, name, _)) _visL _visR kind_co co') = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'') split_co co' = ([], co') @@ -2107,7 +2107,7 @@ instance Binary IfaceCoercion where putByte bh 5 put_ bh a put_ bh b - put_ bh (IfaceForAllCoY a visL visR b c) = do + put_ bh (IfaceForAllCo a visL visR b c) = do putByte bh 6 put_ bh a put_ bh visL @@ -2189,7 +2189,7 @@ instance Binary IfaceCoercion where visR <- get bh b <- get bh c <- get bh - return $ IfaceForAllCoY a visL visR b c + return $ IfaceForAllCo a visL visR b c 7 -> do a <- get bh return $ IfaceCoVarCo a 8 -> do a <- get bh @@ -2287,7 +2287,7 @@ instance NFData IfaceCoercion where IfaceFunCo f1 f2 f3 f4 -> f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 IfaceTyConAppCo f1 f2 f3 -> f1 `seq` rnf f2 `seq` rnf f3 IfaceAppCo f1 f2 -> rnf f1 `seq` rnf f2 - IfaceForAllCoY f1 f2 f3 f4 f5 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 + IfaceForAllCo f1 f2 f3 f4 f5 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 IfaceCoVarCo f1 -> rnf f1 IfaceAxiomInstCo f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 IfaceAxiomRuleCo f1 f2 -> rnf f1 `seq` rnf f2 diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs index fe9c2132fe..8057080bd2 100644 --- a/compiler/GHC/IfaceToCore.hs +++ b/compiler/GHC/IfaceToCore.hs @@ -1491,9 +1491,9 @@ tcIfaceCo = go go (IfaceFunCo r w c1 c2) = mkFunCoNoFTF r <$> go w <*> go c1 <*> go c2 go (IfaceTyConAppCo r tc cs) = TyConAppCo r <$> tcIfaceTyCon tc <*> mapM go cs go (IfaceAppCo c1 c2) = AppCo <$> go c1 <*> go c2 - go (IfaceForAllCoY tv visL visR k c) = do { k' <- go k + go (IfaceForAllCo tv visL visR k c) = do { k' <- go k ; bindIfaceBndr tv $ \ tv' -> - ForAllCoX tv' visL visR k' <$> go c } + ForAllCo tv' visL visR k' <$> go c } go (IfaceCoVarCo n) = CoVarCo <$> go_var n go (IfaceAxiomInstCo n i cs) = AxiomInstCo <$> tcIfaceCoAxiom n <*> pure i <*> mapM go cs go (IfaceUnivCo p r t1 t2) = UnivCo <$> tcIfaceUnivCoProv p <*> pure r diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs index a1d6c93333..9dca3de9a0 100644 --- a/compiler/GHC/Tc/TyCl/Utils.hs +++ b/compiler/GHC/Tc/TyCl/Utils.hs @@ -137,7 +137,7 @@ synonymTyConsOfType ty go_co (GRefl _ ty mco) = go ty `plusNameEnv` go_mco mco go_co (TyConAppCo _ tc cs) = go_tc tc `plusNameEnv` go_co_s cs go_co (AppCo co co') = go_co co `plusNameEnv` go_co co' - go_co (ForAllCoX _ _ _ co co') = go_co co `plusNameEnv` go_co co' + go_co (ForAllCo _ _ _ co co') = go_co co `plusNameEnv` go_co co' go_co (FunCo { fco_mult = m, fco_arg = a, fco_res = r }) = go_co m `plusNameEnv` go_co a `plusNameEnv` go_co r go_co (CoVarCo _) = emptyNameEnv diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs index e4351ed87d..1dd333fb30 100644 --- a/compiler/GHC/Tc/Utils/TcMType.hs +++ b/compiler/GHC/Tc/Utils/TcMType.hs @@ -1568,7 +1568,7 @@ collect_cand_qtvs_co orig_ty cur_lvl bound = go_co go_co dv (CoVarCo cv) = go_cv dv cv - go_co dv (ForAllCoX tcv _visL _visR kind_co co) + go_co dv (ForAllCo tcv _visL _visR kind_co co) = do { dv1 <- go_co dv kind_co ; collect_cand_qtvs_co orig_ty cur_lvl (bound `extendVarSet` tcv) dv1 co } |