diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index 1fd5d0cbcfcedccb61239ea22eda05a22c0281e6..135163e037c4d206e92133d6ef7a93f82d98d7a2 100644
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -127,7 +127,7 @@ pprTyConHdr tyCon
keyword | isSynTyCon tyCon = sLit "type"
| isNewTyCon tyCon = sLit "newtype"
- | otherwise = sLit "data"
+ | otherwise = sLit "data"
opt_family
| isFamilyTyCon tyCon = ptext (sLit "family")
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index f701b30db8a50285dfef00821c76c1e8920d8ebe..190e4cef4e9e8ecf9bb93548259c5651fe743113 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -629,10 +629,9 @@ tcTyFamInstDecl mb_clsinfo (L loc decl@(TyFamInstDecl { tfid_eqn = eqn }))
; fam_tc <- tcFamInstDeclCombined mb_clsinfo fam_lname
-- (0) Check it's an open type family
- ; checkTc (isFamilyTyCon fam_tc) (notFamily fam_tc)
- ; checkTc (isSynTyCon fam_tc) (wrongKindOfFamily fam_tc)
- ; checkTc (isOpenSynFamilyTyCon fam_tc)
- (notOpenFamily fam_tc)
+ ; checkTc (isFamilyTyCon fam_tc) (notFamily fam_tc)
+ ; checkTc (isSynFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc)
+ ; checkTc (isOpenSynFamilyTyCon fam_tc) (notOpenFamily fam_tc)
-- (1) do the work of verifying the synonym group
; co_ax_branch <- tcSynFamInstDecl fam_tc decl
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index c03af38b9a5b1be18213b3f6159d16983dcec737..1e32847bdf4bf428b3148bde4b0c99679af63c31 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -878,7 +878,7 @@ tcSynFamInstDecl :: TyCon -> TyFamInstDecl Name -> TcM CoAxBranch
-- Placed here because type family instances appear as
-- default decls in class declarations
tcSynFamInstDecl fam_tc (TyFamInstDecl { tfid_eqn = eqn })
- = do { checkTc (isSynTyCon fam_tc) (wrongKindOfFamily fam_tc)
+ = do { checkTc (isSynFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc)
; tcTyFamInstEqn (tyConName fam_tc) (tyConKind fam_tc) eqn }
-- Checks to make sure that all the names in an instance group are the same
@@ -1670,9 +1670,9 @@ checkValidRoleAnnots :: RoleAnnots -> TyThing -> TcM ()
checkValidRoleAnnots role_annots thing
= case thing of
{ ATyCon tc
- | isSynTyCon tc -> check_no_roles
- | isFamilyTyCon tc -> check_no_roles
- | isAlgTyCon tc -> check_roles
+ | isTypeSynonymTyCon tc -> check_no_roles
+ | isFamilyTyCon tc -> check_no_roles
+ | isAlgTyCon tc -> check_roles
where
name = tyConName tc
@@ -2202,12 +2202,12 @@ addTyThingCtxt thing
name = getName thing
flav = case thing of
ATyCon tc
- | isClassTyCon tc -> ptext (sLit "class")
- | isSynFamilyTyCon tc -> ptext (sLit "type family")
- | isDataFamilyTyCon tc -> ptext (sLit "data family")
- | isSynTyCon tc -> ptext (sLit "type")
- | isNewTyCon tc -> ptext (sLit "newtype")
- | isDataTyCon tc -> ptext (sLit "data")
+ | isClassTyCon tc -> ptext (sLit "class")
+ | isSynFamilyTyCon tc -> ptext (sLit "type family")
+ | isDataFamilyTyCon tc -> ptext (sLit "data family")
+ | isTypeSynonymTyCon tc -> ptext (sLit "type")
+ | isNewTyCon tc -> ptext (sLit "newtype")
+ | isDataTyCon tc -> ptext (sLit "data")
_ -> pprTrace "addTyThingCtxt strange" (ppr thing)
empty
diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs
index b26c56de1293ca224d8d2e5ef269d71726748188..638a07aeec18070747cf252958204d46818ceaa3 100644
--- a/compiler/typecheck/TcTyDecls.lhs
+++ b/compiler/typecheck/TcTyDecls.lhs
@@ -672,10 +672,10 @@ initialRoleEnv is_boot annots = extendNameEnvList emptyNameEnv .
initialRoleEnv1 :: Bool -> RoleAnnots -> TyCon -> (Name, [Role])
initialRoleEnv1 is_boot annots_env tc
- | isFamilyTyCon tc = (name, map (const Nominal) tyvars)
- | isAlgTyCon tc
- || isSynTyCon tc = (name, default_roles)
- | otherwise = pprPanic "initialRoleEnv1" (ppr tc)
+ | isFamilyTyCon tc = (name, map (const Nominal) tyvars)
+ | isAlgTyCon tc = (name, default_roles)
+ | isTypeSynonymTyCon tc = (name, default_roles)
+ | otherwise = pprPanic "initialRoleEnv1" (ppr tc)
where name = tyConName tc
tyvars = tyConTyVars tc
(kvs, tvs) = span isKindVar tyvars
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 551b17c6be5cecbe0652470550c269f554a11726..6dae2e00a6f44b3b712f5d2399fa874d3f75dd9f 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -961,7 +961,7 @@ tcInstHeadTyNotSynonym :: Type -> Bool
-- are transparent, so we need a special function here
tcInstHeadTyNotSynonym ty
= case ty of
- TyConApp tc _ -> not (isSynTyCon tc)
+ TyConApp tc _ -> not (isTypeSynonymTyCon tc)
_ -> True
tcInstHeadTyAppAllTyVars :: Type -> Bool
diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs
index d85287c1f36c69cd895f8ca8015944a2b79cd5ed..ebb375dd5ed700f24b6ebda820011bd5d903aeae 100644
--- a/compiler/typecheck/TcValidity.lhs
+++ b/compiler/typecheck/TcValidity.lhs
@@ -290,7 +290,7 @@ check_type ctxt rank (AppTy ty1 ty2)
; check_arg_type ctxt rank ty2 }
check_type ctxt rank ty@(TyConApp tc tys)
- | isSynTyCon tc = check_syn_tc_app ctxt rank ty tc tys
+ | isTypeSynonymTyCon tc = check_syn_tc_app ctxt rank ty tc tys
| isUnboxedTupleTyCon tc = check_ubx_tuple ctxt ty tys
| otherwise = mapM_ (check_arg_type ctxt rank) tys
diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index bb489b33e1b328bf09e763b9344386aac2884863..607be9374badc3688ec8a1cc55fbe28faccbdb4a 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -34,14 +34,13 @@ module TyCon(
isFunTyCon,
isPrimTyCon,
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon,
- isSynTyCon,
+ isSynTyCon, isTypeSynonymTyCon,
isDecomposableTyCon,
isForeignTyCon,
isPromotedDataCon, isPromotedTyCon,
isPromotedDataCon_maybe, isPromotedTyCon_maybe,
promotableTyCon_maybe, promoteTyCon,
- isInjectiveTyCon,
isDataTyCon, isProductTyCon, isDataProductTyCon_maybe,
isEnumerationTyCon,
isNewTyCon, isAbstractTyCon,
@@ -1187,11 +1186,17 @@ isDataProductTyCon_maybe (TupleTyCon { dataCon = con })
= Just con
isDataProductTyCon_maybe _ = Nothing
--- | Is this a 'TyCon' representing a type synonym (@type@)?
+-- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)?
+isTypeSynonymTyCon :: TyCon -> Bool
+isTypeSynonymTyCon (SynTyCon { synTcRhs = SynonymTyCon {} }) = True
+isTypeSynonymTyCon _ = False
+
+-- | Is this 'TyCon' a type synonym or type family?
isSynTyCon :: TyCon -> Bool
isSynTyCon (SynTyCon {}) = True
isSynTyCon _ = False
+
-- As for newtypes, it is in some contexts important to distinguish between
-- closed synonyms and synonym families, as synonym families have no unique
-- right hand side to which a synonym family application can expand.
@@ -1199,7 +1204,14 @@ isSynTyCon _ = False
isDecomposableTyCon :: TyCon -> Bool
-- True iff we can decompose (T a b c) into ((T a b) c)
+-- I.e. is it injective?
-- Specifically NOT true of synonyms (open and otherwise)
+-- Ultimately we may have injective associated types
+-- in which case this test will become more interesting
+--
+-- It'd be unusual to call isInjectiveTyCon on a regular H98
+-- type synonym, because you should probably have expanded it first
+-- But regardless, it's not decomposable
isDecomposableTyCon (SynTyCon {}) = False
isDecomposableTyCon _other = True
@@ -1259,17 +1271,6 @@ isDataFamilyTyCon :: TyCon -> Bool
isDataFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = True
isDataFamilyTyCon _ = False
--- | Injective 'TyCon's can be decomposed, so that
--- T ty1 ~ T ty2 => ty1 ~ ty2
-isInjectiveTyCon :: TyCon -> Bool
-isInjectiveTyCon tc = not (isSynTyCon tc)
- -- Ultimately we may have injective associated types
- -- in which case this test will become more interesting
- --
- -- It'd be unusual to call isInjectiveTyCon on a regular H98
- -- type synonym, because you should probably have expanded it first
- -- But regardless, it's not injective!
-
-- | Are we able to extract informationa 'TyVar' to class argument list
-- mappping from a given 'TyCon'?
isTyConAssoc :: TyCon -> Bool
@@ -1370,13 +1371,15 @@ isPromotedDataCon_maybe _ = Nothing
-- * Family instances are /not/ implicit as they represent the instance body
-- (similar to a @dfun@ does that for a class instance).
isImplicitTyCon :: TyCon -> Bool
-isImplicitTyCon tycon
- | isTyConAssoc tycon = True
- | isSynTyCon tycon = False
- | isAlgTyCon tycon = isTupleTyCon tycon
- | otherwise = True
- -- 'otherwise' catches: FunTyCon, PrimTyCon,
- -- PromotedDataCon, PomotedTypeTyCon
+isImplicitTyCon (FunTyCon {}) = True
+isImplicitTyCon (TupleTyCon {}) = True
+isImplicitTyCon (PrimTyCon {}) = True
+isImplicitTyCon (PromotedDataCon {}) = True
+isImplicitTyCon (PromotedTyCon {}) = True
+isImplicitTyCon (AlgTyCon { algTcParent = AssocFamilyTyCon {} }) = True
+isImplicitTyCon (AlgTyCon {}) = False
+isImplicitTyCon (SynTyCon { synTcParent = AssocFamilyTyCon {} }) = True
+isImplicitTyCon (SynTyCon {}) = False
tyConCType_maybe :: TyCon -> Maybe CType
tyConCType_maybe tc@(AlgTyCon {}) = tyConCType tc