+
+-----------------------------------------------
+-- Expand type-constructor applications
+-----------------------------------------------
+
+\begin{code}
+tcExpandTyCon_maybe, coreExpandTyCon_maybe
+ :: TyCon
+ -> [Type] -- Args to tycon
+ -> Maybe ([(TyVar,Type)], -- Substitution
+ Type, -- Body type (not yet substituted)
+ [Type]) -- Leftover args
+
+-- For the *typechecker* view, we expand synonyms only
+tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs, synTcRhs = rhs }) tys
+ = expand tvs rhs tys
+tcExpandTyCon_maybe other_tycon tys = Nothing
+
+---------------
+-- For the *Core* view, we expand synonyms *and* non-recursive newtypes
+coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive, -- Not recursive
+ algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs }}) tys
+ = case etad_rhs of -- Don't do this in the pattern match, lest we accidentally
+ -- match the etad_rhs of a *recursive* newtype
+ (tvs,rhs) -> expand tvs rhs tys
+
+coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys
+
+----------------
+expand :: [TyVar] -> Type -- Template
+ -> [Type] -- Args
+ -> Maybe ([(TyVar,Type)], Type, [Type]) -- Expansion
+expand tvs rhs tys
+ = case n_tvs `compare` length tys of
+ LT -> Just (tvs `zip` tys, rhs, drop n_tvs tys)
+ EQ -> Just (tvs `zip` tys, rhs, [])
+ GT -> Nothing
+ where
+ n_tvs = length tvs
+\end{code}
+