[commit: ghc] wip/fix-validate: Remove tcTyConUserTyVars (1845c2b)
git at git.haskell.org
git at git.haskell.org
Thu Feb 21 19:32:07 UTC 2019
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/fix-validate
Link : http://ghc.haskell.org/trac/ghc/changeset/1845c2ba57958541d00982de9064699510dd299c/ghc
>---------------------------------------------------------------
commit 1845c2ba57958541d00982de9064699510dd299c
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Thu Feb 21 08:46:13 2019 +0000
Remove tcTyConUserTyVars
The tcTyConUserTyVars field of TcTyCon was entirely unused.
This patch kills it off entirely.
>---------------------------------------------------------------
1845c2ba57958541d00982de9064699510dd299c
compiler/typecheck/TcHsType.hs | 8 ++++----
compiler/typecheck/TcTyClsDecls.hs | 6 ++----
compiler/types/TyCon.hs | 11 ++++-------
3 files changed, 10 insertions(+), 15 deletions(-)
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 91b7aa2..c40d8b5 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -1835,7 +1835,7 @@ kcLHsQTyVars_Cusk, kcLHsQTyVars_NonCusk
------------------------------
kcLHsQTyVars_Cusk name flav
- user_tyvars@(HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = kv_ns
+ (HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = kv_ns
, hsq_dependent = dep_names }
, hsq_explicit = hs_tvs }) thing_inside
-- CUSK case
@@ -1876,7 +1876,7 @@ kcLHsQTyVars_Cusk name flav
++ map (mkRequiredTyConBinder mentioned_kv_set) tc_tvs
all_tv_prs = mkTyVarNamePairs (scoped_kvs ++ tc_tvs)
- tycon = mkTcTyCon name (ppr user_tyvars)
+ tycon = mkTcTyCon name
final_tc_binders
res_kind
all_tv_prs
@@ -1918,7 +1918,7 @@ kcLHsQTyVars_Cusk _ _ (XLHsQTyVars _) _ = panic "kcLHsQTyVars"
------------------------------
kcLHsQTyVars_NonCusk name flav
- user_tyvars@(HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = kv_ns
+ (HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = kv_ns
, hsq_dependent = dep_names }
, hsq_explicit = hs_tvs }) thing_inside
-- Non_CUSK case
@@ -1940,7 +1940,7 @@ kcLHsQTyVars_NonCusk name flav
-- Also, note that tc_binders has the tyvars from only the
-- user-written tyvarbinders. See S1 in Note [How TcTyCons work]
-- in TcTyClsDecls
- tycon = mkTcTyCon name (ppr user_tyvars) tc_binders res_kind
+ tycon = mkTcTyCon name tc_binders res_kind
(mkTyVarNamePairs (scoped_kvs ++ tc_tvs))
False -- not yet generalised
flav
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 55c06fc..8dfdbb2 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -540,7 +540,6 @@ generaliseTcTyCon tc
tc_flav = tyConFlavour tc
tc_res_kind = tyConResKind tc
tc_tvs = tyConTyVars tc
- user_tyvars = tcTyConUserTyVars tc -- ToDo: nuke
(scoped_tv_names, scoped_tvs) = unzip (tcTyConScopedTyVars tc)
-- NB: scoped_tvs includes both specified and required (tc_tvs)
@@ -596,7 +595,7 @@ generaliseTcTyCon tc
scoped_tv_pairs = scoped_tv_names `zip` scoped_tvs
-- Step 7: Make the result TcTyCon
- tycon = mkTcTyCon tc_name user_tyvars final_tcbs tc_res_kind
+ tycon = mkTcTyCon tc_name final_tcbs tc_res_kind
scoped_tv_pairs
True {- it's generalised now -}
(tyConFlavour tc)
@@ -1497,7 +1496,6 @@ tcFamDecl1 :: Maybe Class -> FamilyDecl GhcRn -> TcM TyCon
tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info
, fdLName = tc_lname@(dL->L _ tc_name)
, fdResultSig = (dL->L _ sig)
- , fdTyVars = user_tyvars
, fdInjectivityAnn = inj })
| DataFamily <- fam_info
= bindTyClTyVars tc_name $ \ binders res_kind -> do
@@ -1559,7 +1557,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info
Just eqns -> do {
-- Process the equations, creating CoAxBranches
- ; let tc_fam_tc = mkTcTyCon tc_name (ppr user_tyvars) binders res_kind
+ ; let tc_fam_tc = mkTcTyCon tc_name binders res_kind
[] False {- this doesn't matter here -}
ClosedTypeFamilyFlavour
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index 058f090..ca49560 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -99,7 +99,7 @@ module TyCon(
algTcFields,
tyConRuntimeRepInfo,
tyConBinders, tyConResKind, tyConTyVarBinders,
- tcTyConScopedTyVars, tcTyConUserTyVars, tcTyConIsPoly,
+ tcTyConScopedTyVars, tcTyConIsPoly,
mkTyConTagMap,
-- ** Manipulating TyCons
@@ -861,7 +861,6 @@ data TyCon
-- without a CUSK, it's the original left-to-right
-- that the user wrote. Nec'y for getting Specified
-- variables in the right order.
- tcTyConUserTyVars :: SDoc, -- ^ Original, user-written tycon tyvars
tcTyConIsPoly :: Bool, -- ^ Is this TcTyCon already generalized?
tcTyConFlavour :: TyConFlavour
@@ -1583,7 +1582,6 @@ mkSumTyCon name binders res_kind arity tyvars cons parent
-- See also Note [Kind checking recursive type and class declarations]
-- in TcTyClsDecls.
mkTcTyCon :: Name
- -> SDoc -- ^ user-written tycon tyvars
-> [TyConBinder]
-> Kind -- ^ /result/ kind only
-> [(Name,TcTyVar)] -- ^ Scoped type variables;
@@ -1591,7 +1589,7 @@ mkTcTyCon :: Name
-> Bool -- ^ Is this TcTyCon generalised already?
-> TyConFlavour -- ^ What sort of 'TyCon' this represents
-> TyCon
-mkTcTyCon name tyvars binders res_kind scoped_tvs poly flav
+mkTcTyCon name binders res_kind scoped_tvs poly flav
= TcTyCon { tyConUnique = getUnique name
, tyConName = name
, tyConTyVars = binderVars binders
@@ -1601,8 +1599,7 @@ mkTcTyCon name tyvars binders res_kind scoped_tvs poly flav
, tyConArity = length binders
, tcTyConScopedTyVars = scoped_tvs
, tcTyConIsPoly = poly
- , tcTyConFlavour = flav
- , tcTyConUserTyVars = tyvars }
+ , tcTyConFlavour = flav }
-- | Create an unlifted primitive 'TyCon', such as @Int#@.
mkPrimTyCon :: Name -> [TyConBinder]
@@ -1719,7 +1716,7 @@ isAbstractTyCon _ = False
-- Used when recovering from errors
makeRecoveryTyCon :: TyCon -> TyCon
makeRecoveryTyCon tc
- = mkTcTyCon (tyConName tc) empty
+ = mkTcTyCon (tyConName tc)
(tyConBinders tc) (tyConResKind tc)
[{- no scoped vars -}]
True
More information about the ghc-commits
mailing list