Commit b9483981 authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari

Remove HsEqTy and XEqTy

After commit d650729f, 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
parent f4dce6cf
......@@ -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
......
......@@ -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))
}
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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'.
......
Subproject commit 5e3cf5d8868323079ff5494a8225b0467404a5d1
Subproject commit 679f61210b18acd6299687fca66c81196ca358a5
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment