applyTy, applyTys, isForAllTy, dropForAlls,
-- Source types
- predTypeRep, mkPredTy, mkPredTys, pprSourceTyCon,
+ predTypeRep, mkPredTy, mkPredTys, pprSourceTyCon, mkFamilyTyConApp,
-- Newtypes
- splitRecNewType_maybe, newTyConInstRhs,
+ newTyConInstRhs,
-- Lifting and boxity
isUnLiftedType, isUnboxedTupleType, isAlgType, isPrimitiveType,
import Outputable
import UniqSet
+import Data.List
import Data.Maybe ( isJust )
\end{code}
splitNewTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
splitNewTyConApp_maybe other = Nothing
--- get instantiated newtype rhs, the arguments had better saturate
--- the constructor
newTyConInstRhs :: TyCon -> [Type] -> Type
newTyConInstRhs tycon tys =
let (tvs, ty) = newTyConRhs tycon in substTyWith tvs tys ty
repType ty | Just ty' <- coreView ty = repType ty'
repType (ForAllTy _ ty) = repType ty
repType (TyConApp tc tys)
- | isClosedNewTyCon tc = -- Recursive newtypes are opaque to coreView
- -- but we must expand them here. Sure to
- -- be saturated because repType is only applied
- -- to types of kind *
- ASSERT( {- isRecursiveTyCon tc && -} tys `lengthIs` tyConArity tc )
- repType (new_type_rep tc tys)
+ | isNewTyCon tc
+ , (tvs, rep_ty) <- newTyConRep tc
+ = -- Recursive newtypes are opaque to coreView
+ -- but we must expand them here. Sure to
+ -- be saturated because repType is only applied
+ -- to types of kind *
+ ASSERT( tys `lengthIs` tyConArity tc )
+ repType (substTyWith tvs tys rep_ty)
+
repType ty = ty
-- repType' aims to be a more thorough version of repType
go ty = ty
--- new_type_rep doesn't ask any questions:
--- it just expands newtype, whether recursive or not
-new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
- case newTyConRep new_tycon of
- (tvs, rep_ty) -> substTyWith tvs tys rep_ty
-
-- ToDo: this could be moved to the code generator, using splitTyConApp instead
-- of inspecting the type directly.
typePrimRep :: Type -> PrimRep
-- The reason is that f must have kind *->*, not *->*#, because
-- (we claim) there is no way to constrain f's kind any other
-- way.
-
\end{code}
-- look through that too if necessary
predTypeRep (EqPred ty1 ty2) = pprPanic "predTypeRep" (ppr (EqPred ty1 ty2))
+mkFamilyTyConApp :: TyCon -> [Type] -> Type
+-- Given a family instance TyCon and its arg types, return the
+-- corresponding family type. E.g.
+-- data family T a
+-- data instance T (Maybe b) = MkT b -- Instance tycon :RTL
+-- Then
+-- mkFamilyTyConApp :RTL Int = T (Maybe Int)
+mkFamilyTyConApp tc tys
+ | Just (fam_tc, fam_tys) <- tyConFamInst_maybe tc
+ , let fam_subst = zipTopTvSubst (tyConTyVars tc) tys
+ = mkTyConApp fam_tc (substTys fam_subst fam_tys)
+ | otherwise
+ = mkTyConApp tc tys
+
-- Pretty prints a tycon, using the family instance in case of a
-- representation tycon. For example
-- e.g. data T [a] = ...
-- In that case we want to print `T [a]', where T is the family TyCon
pprSourceTyCon tycon
- | Just (repTyCon, tys) <- tyConFamInst_maybe tycon
- = ppr $ repTyCon `TyConApp` tys -- can't be FunTyCon
+ | Just (fam_tc, tys) <- tyConFamInst_maybe tycon
+ = ppr $ fam_tc `TyConApp` tys -- can't be FunTyCon
| otherwise
= ppr tycon
\end{code}
%************************************************************************
%* *
- NewTypes
-%* *
-%************************************************************************
-
-\begin{code}
-splitRecNewType_maybe :: Type -> Maybe Type
--- Sometimes we want to look through a recursive newtype, and that's what happens here
--- It only strips *one layer* off, so the caller will usually call itself recursively
--- Only applied to types of kind *, hence the newtype is always saturated
-splitRecNewType_maybe ty | Just ty' <- coreView ty = splitRecNewType_maybe ty'
-splitRecNewType_maybe (TyConApp tc tys)
- | isClosedNewTyCon tc
- = ASSERT( tys `lengthIs` tyConArity tc ) -- splitRecNewType_maybe only be applied
- -- to *types* (of kind *)
- ASSERT( isRecursiveTyCon tc ) -- Guaranteed by coreView
- case newTyConRhs tc of
- (tvs, rep_ty) -> ASSERT( length tvs == length tys )
- Just (substTyWith tvs tys rep_ty)
-
-splitRecNewType_maybe other = Nothing
-
-
-
-\end{code}
-
-
-%************************************************************************
-%* *
\subsection{Kinds and free variables}
%* *
%************************************************************************