X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=6dba52b50081cd275a548d6141a2698a93fa21bb;hb=272fb49ecfeffe7aaa66b9b61bab12d8a858458d;hp=144a670c396f59f641d399d1eb7fe6ac2cacd1c2;hpb=e659c1f58da286070b96a75c65d966347cbcbfe5;p=ghc-hetmet.git

diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 144a670..6dba52b 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -17,8 +17,8 @@ module TyCon(
 	SynTyConRhs(..),
 
 	isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
-	isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isClosedNewTyCon,
-	isPrimTyCon, 
+	isAlgTyCon, isDataTyCon, isNewTyCon, isClosedNewTyCon, isSynTyCon,
+	isClosedSynTyCon, isPrimTyCon, 
 	isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
 	assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
 	isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
@@ -600,6 +600,13 @@ 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.
+--
+isClosedSynTyCon :: TyCon -> Bool
+isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon)
+
 isGadtSyntaxTyCon :: TyCon -> Bool
 isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
 isGadtSyntaxTyCon other				       = False