applyTy, applyTys, applyTysD, isForAllTy, dropForAlls,
-- (Newtypes)
- newTyConInstRhs,
+ newTyConInstRhs, carefullySplitNewType_maybe,
-- (Type families)
- tyFamInsts,
+ tyFamInsts, predFamInsts,
-- (Source types)
mkPredTy, mkPredTys, mkFamilyTyConApp,
splitTyConApp_maybe _ = Nothing
newTyConInstRhs :: TyCon -> [Type] -> Type
--- ^ Unwrap one 'layer' of newtype on a type constructor and it's arguments, using an
+-- ^ Unwrap one 'layer' of newtype on a type constructor and its arguments, using an
-- eta-reduced version of the @newtype@ if possible
newTyConInstRhs tycon tys
= ASSERT2( equalLength tvs tys1, ppr tycon $$ ppr tys $$ ppr tvs )
-- | Looks through:
--
-- 1. For-alls
---
-- 2. Synonyms
---
-- 3. Predicates
---
--- 4. Usage annotations
---
--- 5. All newtypes, including recursive ones, but not newtype families
+-- 4. All newtypes, including recursive ones, but not newtype families
--
-- It's useful in the back end of the compiler.
repType :: Type -> Type
go rec_nts (ForAllTy _ ty) -- Look through foralls
= go rec_nts ty
- go rec_nts ty@(TyConApp tc tys) -- Expand newtypes
- | Just _co_con <- newTyConCo_maybe tc -- See Note [Expanding newtypes]
- = if tc `elem` rec_nts -- in Type.lhs
- then ty
- else go rec_nts' nt_rhs
- where
- nt_rhs = newTyConInstRhs tc tys
- rec_nts' | isRecursiveTyCon tc = tc:rec_nts
- | otherwise = rec_nts
+ go rec_nts (TyConApp tc tys) -- Expand newtypes
+ | Just (rec_nts', ty') <- carefullySplitNewType_maybe rec_nts tc tys
+ = go rec_nts' ty'
go _ ty = ty
+carefullySplitNewType_maybe :: [TyCon] -> TyCon -> [Type] -> Maybe ([TyCon],Type)
+-- Return the representation of a newtype, unless
+-- we've seen it already: see Note [Expanding newtypes]
+carefullySplitNewType_maybe rec_nts tc tys
+ | isNewTyCon tc
+ , not (tc `elem` rec_nts) = Just (rec_nts', newTyConInstRhs tc tys)
+ | otherwise = Nothing
+ where
+ rec_nts' | isRecursiveTyCon tc = tc:rec_nts
+ | otherwise = rec_nts
+
+
-- ToDo: this could be moved to the code generator, using splitTyConApp instead
-- of inspecting the type directly.
(mkForAllTys (drop n_args tvs) rho_ty)
| otherwise -- Too many type args
= ASSERT2( n_tvs > 0, doc $$ ppr orig_fun_ty ) -- Zero case gives infnite loop!
- applyTys (substTyWith tvs (take n_tvs arg_tys) rho_ty)
- (drop n_tvs arg_tys)
+ applyTysD doc (substTyWith tvs (take n_tvs arg_tys) rho_ty)
+ (drop n_tvs arg_tys)
where
(tvs, rho_ty) = splitForAllTys orig_fun_ty
n_tvs = length tvs
tyFamInsts (FunTy ty1 ty2) = tyFamInsts ty1 ++ tyFamInsts ty2
tyFamInsts (AppTy ty1 ty2) = tyFamInsts ty1 ++ tyFamInsts ty2
tyFamInsts (ForAllTy _ ty) = tyFamInsts ty
+tyFamInsts (PredTy pty) = predFamInsts pty
+
+-- | Finds type family instances occuring in a predicate type after expanding
+-- synonyms.
+predFamInsts :: PredType -> [(TyCon, [Type])]
+predFamInsts (ClassP _cla tys) = concat (map tyFamInsts tys)
+predFamInsts (IParam _ ty) = tyFamInsts ty
+predFamInsts (EqPred ty1 ty2) = tyFamInsts ty1 ++ tyFamInsts ty2
\end{code}