[Git][ghc/ghc][wip/forall-vis-coercions] revert temporary renamings of the forallco constructors
Matthew Craven (@clyring)
gitlab at gitlab.haskell.org
Sun Apr 23 18:21:26 UTC 2023
Matthew Craven pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC
Commits:
d7f95d4a by Matthew Craven at 2023-04-23T14:20:33-04:00
revert temporary renamings of the forallco constructors
- - - - -
17 changed files:
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCo/Tidy.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Iface/Rename.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Utils/TcMType.hs
Changes:
=====================================
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)
=====================================
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
=====================================
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
=====================================
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 })
=====================================
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
=====================================
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
=====================================
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
=====================================
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.
=====================================
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
=====================================
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
=====================================
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)
=====================================
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
=====================================
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
=====================================
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
=====================================
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
=====================================
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
=====================================
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 }
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7f95d4a8492e9aaf5a5c6af317ffe4e393413d2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7f95d4a8492e9aaf5a5c6af317ffe4e393413d2
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230423/6b3b0d81/attachment-0001.html>
More information about the ghc-commits
mailing list