X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=bb21536b2d25161856f45fc4903be8c702992bac;hb=524c609b6d8d220b03640dc71a209530bf2ed280;hp=120e1b95e69a9fe4b850936a54afee3ecbade14e;hpb=9ffadf219cbc4f8ec57264786df936a3cee88aec;p=ghc-hetmet.git

diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 120e1b9..bb21536 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -39,6 +39,7 @@ module TyCon(
         isCoercionTyCon, isCoercionTyCon_maybe,
         isForeignTyCon,
 
+	isInjectiveTyCon,
 	isDataTyCon, isProductTyCon, isEnumerationTyCon, 
 	isNewTyCon, isAbstractTyCon, isOpenTyCon,
         isUnLiftedTyCon,
@@ -494,7 +495,7 @@ Then
 %************************************************************************
 
 A PrimRep is somewhat similar to a CgRep (see codeGen/SMRep) and a
-MachRep (see cmm/MachOp), although each of these types has a distinct
+MachRep (see cmm/CmmExpr), although each of these types has a distinct
 and clearly defined purpose:
 
   - A PrimRep is a CgRep + information about signedness + information
@@ -811,9 +812,20 @@ isEnumerationTyCon _                                                   = False
 
 -- | Is this a 'TyCon', synonym or otherwise, that may have further instances appear?
 isOpenTyCon :: TyCon -> Bool
-isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _ _}) = True
-isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {}    }) = True
-isOpenTyCon _					     = False
+isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon {}}) = True
+isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {}})    = True
+isOpenTyCon _					    = 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!
 
 -- | Extract the mapping from 'TyVar' indexes to indexes in the corresponding family
 -- argument lists form an open 'TyCon' of any sort, if the given 'TyCon' is indeed
@@ -954,7 +966,7 @@ tcExpandTyCon_maybe _ _ = Nothing
 
 -- ^ Used to create the view /Core/ has on 'TyCon's. We expand not only closed synonyms like 'tcExpandTyCon_maybe',
 -- but also non-recursive @newtype@s
-coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive,	-- Not recursive
+coreExpandTyCon_maybe (AlgTyCon {
          algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs, nt_co = Nothing }}) tys
    = case etad_rhs of	-- Don't do this in the pattern match, lest we accidentally
 			-- match the etad_rhs of a *recursive* newtype
@@ -1085,13 +1097,10 @@ synTyConResKind tycon  = pprPanic "synTyConResKind" (ppr tycon)
 -- has more than one constructor, or represents a primitive or function type constructor then
 -- @Nothing@ is returned. In any other case, the function panics
 tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon
-tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = DataTyCon {data_cons = [c] }}) = Just c
-tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = c }})    = Just c
-tyConSingleDataCon_maybe (AlgTyCon {})	         = Nothing
-tyConSingleDataCon_maybe (TupleTyCon {dataCon = con}) = Just con
-tyConSingleDataCon_maybe (PrimTyCon {})               = Nothing
-tyConSingleDataCon_maybe (FunTyCon {})                = Nothing  -- case at funty
-tyConSingleDataCon_maybe tc = pprPanic "tyConSingleDataCon_maybe: unexpected tycon " $ ppr tc
+tyConSingleDataCon_maybe (TupleTyCon {dataCon = c}) 			       = Just c
+tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = [c] }}) = Just c
+tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = c }})     = Just c
+tyConSingleDataCon_maybe _                           			       = Nothing
 \end{code}
 
 \begin{code}