SynTyConRhs(..),
isFunTyCon, isUnLiftedTyCon, isProductTyCon,
- isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
+ isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isClosedNewTyCon,
+ isPrimTyCon,
isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
- isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo,
+ isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo_maybe,
isHiBootTyCon, isSuperKindTyCon,
isCoercionTyCon_maybe, isCoercionTyCon,
#include "HsVersions.h"
-import {-# SOURCE #-} TypeRep ( Kind, Type, Coercion, PredType )
+import {-# SOURCE #-} TypeRep ( Kind, Type, PredType )
import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
import Var ( TyVar, Id )
tyConTyVars :: [TyVar], -- Scopes over (a) the algTcStupidTheta
-- (b) the cached types in
-- algTyConRhs.NewTyCon
+ -- (c) the family instance
+ -- types if present
-- But not over the data constructors
tyConArgPoss :: Maybe [Int], -- for associated families: for each
tyConName :: Name
}
-type KindCon = TyCon
-
-type SuperKindCon = TyCon
-
type FieldLabel = Name
data AlgTyConRhs
OpenNewTyCon -> False
NewTyCon {} -> False
AbstractTyCon -> pprPanic "isDataTyCon" (ppr tc)
-
isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
isDataTyCon other = False
isNewTyCon :: TyCon -> Bool
-isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
-isNewTyCon other = False
+isNewTyCon (AlgTyCon {algTcRhs = rhs}) = case rhs of
+ OpenNewTyCon -> True
+ NewTyCon {} -> True
+ _ -> False
+isNewTyCon other = False
+
+-- This is an important refinement as typical newtype optimisations do *not*
+-- hold for newtype families. Why? Given a type `T a', if T is a newtype
+-- family, there is no unique right hand side by which `T a' can be replaced
+-- by a cast.
+--
+isClosedNewTyCon :: TyCon -> Bool
+isClosedNewTyCon tycon = isNewTyCon tycon && not (isOpenTyCon tycon)
isProductTyCon :: TyCon -> Bool
-- A "product" tycon
newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
-newTyConCo :: TyCon -> Maybe TyCon
-newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_co = co }}) = co
-newTyConCo tycon = pprPanic "newTyConCo" (ppr tycon)
+newTyConCo_maybe :: TyCon -> Maybe TyCon
+newTyConCo_maybe (AlgTyCon {algTcRhs = NewTyCon { nt_co = co }}) = co
+newTyConCo_maybe _ = Nothing
tyConPrimRep :: TyCon -> PrimRep
tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
tyConClass_maybe ther_tycon = Nothing
isFamInstTyCon :: TyCon -> Bool
-isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _}) = True
-isFamInstTyCon other_tycon = False
+isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
+isFamInstTyCon other_tycon = False
tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) =