diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-06-19 23:17:02 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2018-06-20 11:17:26 -0400 |
commit | b9483981d128f55d8dae3f434f49fa6b5b30c779 (patch) | |
tree | ddabff49ad039caa25227d5523f7c52cbdb43fe5 | |
parent | f4dce6cfd71d2a1dc2e281f19cae85e62aaf6b8e (diff) | |
download | haskell-b9483981d128f55d8dae3f434f49fa6b5b30c779.tar.gz |
Remove HsEqTy and XEqTy
After commit d650729f9a0f3b6aa5e6ef2d5fba337f6f70fa60, the
`HsEqTy` constructor of `HsType` is essentially dead code. Given that
we want to remove `HsEqTy` anyway as a part of #10056 (comment:27),
let's just rip it out.
Bumps the haddock submodule.
Test Plan: ./validate
Reviewers: goldfire, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie, carter
GHC Trac Issues: #10056
Differential Revision: https://phabricator.haskell.org/D4876
-rw-r--r-- | compiler/deSugar/DsMeta.hs | 5 | ||||
-rw-r--r-- | compiler/hsSyn/Convert.hs | 7 | ||||
-rw-r--r-- | compiler/hsSyn/HsExtension.hs | 2 | ||||
-rw-r--r-- | compiler/hsSyn/HsTypes.hs | 17 | ||||
-rw-r--r-- | compiler/rename/RnTypes.hs | 9 | ||||
-rw-r--r-- | compiler/typecheck/TcHsType.hs | 8 | ||||
m--------- | utils/haddock | 0 |
7 files changed, 4 insertions, 44 deletions
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 832473edd6..bb3c46ba47 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -1121,11 +1121,6 @@ repTy (HsSumTy _ tys) = do tys1 <- repLTys tys repTy (HsOpTy _ ty1 n ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1) `nlHsAppTy` ty2) repTy (HsParTy _ t) = repLTy t -repTy (HsEqTy _ t1 t2) = do - t1' <- repLTy t1 - t2' <- repLTy t2 - eq <- repTequality - repTapps eq [t1', t2'] repTy (HsStarTy _ _) = repTStar repTy (HsKindSig _ t k) = do t1 <- repLTy t diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 3da163c71d..329d000e29 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -18,6 +18,7 @@ import GhcPrelude import HsSyn as Hs import qualified Class +import PrelNames import RdrName import qualified Name import Module @@ -28,7 +29,6 @@ import SrcLoc import Type import qualified Coercion ( Role(..) ) import TysWiredIn -import TysPrim (eqPrimTyCon) import BasicTypes as Hs import ForeignCall import Unique @@ -1378,10 +1378,11 @@ cvtTypeKind ty_str ty (noLoc (getRdrName constraintKindTyCon))) EqualityT - | [x',y'] <- tys' -> returnL (HsEqTy noExt x' y') + | [x',y'] <- tys' -> + returnL (HsOpTy noExt x' (noLoc eqTyCon_RDR) y') | otherwise -> mk_apps (HsTyVar noExt NotPromoted - (noLoc (getRdrName eqPrimTyCon))) tys' + (noLoc eqTyCon_RDR)) tys' _ -> failWith (ptext (sLit ("Malformed " ++ ty_str)) <+> text (show ty)) } diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs index 7243a6514e..52e19b96f3 100644 --- a/compiler/hsSyn/HsExtension.hs +++ b/compiler/hsSyn/HsExtension.hs @@ -910,7 +910,6 @@ type family XSumTy x type family XOpTy x type family XParTy x type family XIParamTy x -type family XEqTy x type family XStarTy x type family XKindSig x type family XSpliceTy x @@ -937,7 +936,6 @@ type ForallXType (c :: * -> Constraint) (x :: *) = , c (XOpTy x) , c (XParTy x) , c (XIParamTy x) - , c (XEqTy x) , c (XStarTy x) , c (XKindSig x) , c (XSpliceTy x) diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 8e959f7586..6d14d7df86 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -548,18 +548,6 @@ data HsType pass -- For details on above see note [Api annotations] in ApiAnnotation - | HsEqTy (XEqTy pass) - (LHsType pass) -- ty1 ~ ty2 - (LHsType pass) -- Always allowed even without - -- TypeOperators, and has special - -- kinding rule - -- ^ - -- > ty1 ~ ty2 - -- - -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde' - - -- For details on above see note [Api annotations] in ApiAnnotation - | HsStarTy (XStarTy pass) Bool -- Is this the Unicode variant? -- Note [HsStarTy] @@ -665,7 +653,6 @@ type instance XSumTy (GhcPass _) = NoExt type instance XOpTy (GhcPass _) = NoExt type instance XParTy (GhcPass _) = NoExt type instance XIParamTy (GhcPass _) = NoExt -type instance XEqTy (GhcPass _) = NoExt type instance XStarTy (GhcPass _) = NoExt type instance XKindSig (GhcPass _) = NoExt @@ -1395,9 +1382,6 @@ ppr_mono_ty (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys) ppr_mono_ty (HsTyLit _ t) = ppr_tylit t ppr_mono_ty (HsWildCardTy {}) = char '_' -ppr_mono_ty (HsEqTy _ ty1 ty2) - = ppr_mono_lty ty1 <+> char '~' <+> ppr_mono_lty ty2 - ppr_mono_ty (HsStarTy _ isUni) = char (if isUni then '★' else '*') ppr_mono_ty (HsAppTy _ fun_ty arg_ty) @@ -1457,7 +1441,6 @@ hsTypeNeedsParens p = go go (HsExplicitTupleTy{}) = False go (HsTyLit{}) = False go (HsWildCardTy{}) = False - go (HsEqTy{}) = p >= opPrec go (HsStarTy{}) = False go (HsAppTy{}) = p >= appPrec go (HsOpTy{}) = p >= opPrec diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index ca4986f050..c8ddd0a851 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -629,12 +629,6 @@ rnHsTyKi env t@(HsIParamTy _ n ty) ; (ty', fvs) <- rnLHsTyKi env ty ; return (HsIParamTy noExt n ty', fvs) } -rnHsTyKi env t@(HsEqTy _ ty1 ty2) - = do { checkPolyKinds env t - ; (ty1', fvs1) <- rnLHsTyKi env ty1 - ; (ty2', fvs2) <- rnLHsTyKi env ty2 - ; return (HsEqTy noExt ty1' ty2', fvs1 `plusFV` fvs2) } - rnHsTyKi _ (HsStarTy _ isUni) = return (HsStarTy noExt isUni, emptyFVs) @@ -1064,7 +1058,6 @@ collectAnonWildCards lty = go lty HsOpTy _ ty1 _ ty2 -> go ty1 `mappend` go ty2 HsParTy _ ty -> go ty HsIParamTy _ _ ty -> go ty - HsEqTy _ ty1 ty2 -> go ty1 `mappend` go ty2 HsKindSig _ ty kind -> go ty `mappend` go kind HsDocTy _ ty _ -> go ty HsBangTy _ _ ty -> go ty @@ -1745,8 +1738,6 @@ extract_lty t_or_k (L _ ty) acc HsFunTy _ ty1 ty2 -> extract_lty t_or_k ty1 =<< extract_lty t_or_k ty2 acc HsIParamTy _ _ ty -> extract_lty t_or_k ty acc - HsEqTy _ ty1 ty2 -> extract_lty t_or_k ty1 =<< - extract_lty t_or_k ty2 acc HsOpTy _ ty1 tv ty2 -> extract_tv t_or_k tv =<< extract_lty t_or_k ty1 =<< extract_lty t_or_k ty2 acc diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 20bfc951ea..205ec9e03e 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -796,14 +796,6 @@ tc_hs_type mode rn_ty@(HsIParamTy _ (L _ n) ty) exp_kind ; checkExpectedKind rn_ty (mkClassPred ipClass [n',ty']) constraintKind exp_kind } -tc_hs_type mode rn_ty@(HsEqTy _ ty1 ty2) exp_kind - = do { (ty1', kind1) <- tc_infer_lhs_type mode ty1 - ; (ty2', kind2) <- tc_infer_lhs_type mode ty2 - ; ty2'' <- checkExpectedKind (unLoc ty2) ty2' kind2 kind1 - ; eq_tc <- tcLookupTyCon eqTyConName - ; let ty' = mkNakedTyConApp eq_tc [kind1, ty1', ty2''] - ; checkExpectedKind rn_ty ty' constraintKind exp_kind } - tc_hs_type _ rn_ty@(HsStarTy _ _) exp_kind -- Desugaring 'HsStarTy' to 'Data.Kind.Type' here means that we don't have to -- handle it in 'coreView' and 'tcView'. diff --git a/utils/haddock b/utils/haddock -Subproject 5e3cf5d8868323079ff5494a8225b0467404a5d +Subproject 679f61210b18acd6299687fca66c81196ca358a |