Remove HsEqTy and XEqTy
authorRyan Scott <ryan.gl.scott@gmail.com>
Wed, 20 Jun 2018 03:17:02 +0000 (23:17 -0400)
committerBen Gamari <ben@smart-cactus.org>
Wed, 20 Jun 2018 15:17:26 +0000 (11:17 -0400)
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

compiler/deSugar/DsMeta.hs
compiler/hsSyn/Convert.hs
compiler/hsSyn/HsExtension.hs
compiler/hsSyn/HsTypes.hs
compiler/rename/RnTypes.hs
compiler/typecheck/TcHsType.hs
utils/haddock

index 832473e..bb3c46b 100644 (file)
@@ -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
index 3da163c..329d000 100644 (file)
@@ -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))
     }
index 7243a65..52e19b9 100644 (file)
@@ -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)
index 8e959f7..6d14d7d 100644 (file)
@@ -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
index ca4986f..c8ddd0a 100644 (file)
@@ -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
index 20bfc95..205ec9e 100644 (file)
@@ -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'.
index 5e3cf5d..679f612 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 5e3cf5d8868323079ff5494a8225b0467404a5d1
+Subproject commit 679f61210b18acd6299687fca66c81196ca358a5