[commit: ghc] master: Remove HsEqTy and XEqTy (b948398)
git at git.haskell.org
git at git.haskell.org
Wed Jun 20 15:52:05 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/b9483981d128f55d8dae3f434f49fa6b5b30c779/ghc
>---------------------------------------------------------------
commit b9483981d128f55d8dae3f434f49fa6b5b30c779
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date: Tue Jun 19 23:17:02 2018 -0400
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
>---------------------------------------------------------------
b9483981d128f55d8dae3f434f49fa6b5b30c779
compiler/deSugar/DsMeta.hs | 5 -----
compiler/hsSyn/Convert.hs | 7 ++++---
compiler/hsSyn/HsExtension.hs | 2 --
compiler/hsSyn/HsTypes.hs | 17 -----------------
compiler/rename/RnTypes.hs | 9 ---------
compiler/typecheck/TcHsType.hs | 8 --------
utils/haddock | 2 +-
7 files changed, 5 insertions(+), 45 deletions(-)
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 832473e..bb3c46b 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 3da163c..329d000 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 7243a65..52e19b9 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 8e959f7..6d14d7d 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 ca4986f..c8ddd0a 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 20bfc95..205ec9e 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
index 5e3cf5d..679f612 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit 5e3cf5d8868323079ff5494a8225b0467404a5d1
+Subproject commit 679f61210b18acd6299687fca66c81196ca358a5
More information about the ghc-commits
mailing list