X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcType.lhs;h=1c35bda47755baaede113730a69bb0b4151b3607;hb=2c8f04b5b883db74f449dfc8c224929fe28b027d;hp=8426310f011af86e8ebb293f463c6755fc6cc015;hpb=7b0181919416d8f04324575b7e17031ca692f5b0;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs index 8426310..1c35bda 100644 --- a/ghc/compiler/typecheck/TcType.lhs +++ b/ghc/compiler/typecheck/TcType.lhs @@ -1,63 +1,67 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 +% +\section[TcType]{Types used in the typechecker} + \begin{code} module TcType ( - - TcTyVar(..), + + TcTyVar, TcBox, + TcTyVarSet, newTcTyVar, newTyVarTy, -- Kind -> NF_TcM s (TcType s) newTyVarTys, -- Int -> Kind -> NF_TcM s [TcType s] - - TcTyVarSet(..), - ----------------------------------------- - TcType(..), TcMaybe(..), - TcTauType(..), TcThetaType(..), TcRhoType(..), + TcType, TcMaybe(..), + TcTauType, TcThetaType, TcRhoType, -- Find the type to which a type variable is bound tcWriteTyVar, -- :: TcTyVar s -> TcType s -> NF_TcM (TcType s) tcReadTyVar, -- :: TcTyVar s -> NF_TcM (TcMaybe s) - tcInstTyVars, -- TyVar -> NF_TcM s (TcTyVar s) + tcSplitForAllTy, tcSplitRhoTy, + + tcInstTyVars, tcInstSigTyVars, - tcInstType, tcInstTcType, tcInstTheta, tcInstId, + tcInstType, + tcInstSigType, tcInstTcType, tcInstSigTcType, + tcInstTheta, - zonkTcTyVars, -- TcTyVarSet s -> NF_TcM s (TcTyVarSet s) - zonkTcType, -- TcType s -> NF_TcM s (TcType s) - zonkTcTypeToType, -- TcType s -> NF_TcM s Type - zonkTcTyVarToTyVar -- TcTyVar s -> NF_TcM s TyVar + zonkTcTyVars, zonkSigTyVar, + zonkTcType, zonkTcTypes, zonkTcThetaType, + zonkTcTypeToType, + zonkTcTyVar, + zonkTcTyVarToTyVar ) where +#include "HsVersions.h" -- friends: -import Type ( Type(..), ThetaType(..), GenType(..), - tyVarsOfTypes, getTyVar_maybe, - splitForAllTy, splitRhoTy - ) -import TyVar ( TyVar(..), GenTyVar(..), TyVarSet(..), GenTyVarSet(..), - tyVarSetToList - ) +import Type ( Type, ThetaType, GenType(..), mkAppTy, + tyVarsOfTypes, splitDictTy_maybe, + isTyVarTy, instantiateTy + ) +import TyVar ( TyVar, GenTyVar(..), GenTyVarSet, + TyVarEnv, lookupTyVarEnv, addToTyVarEnv, + emptyTyVarEnv, zipTyVarEnv, tyVarSetToList + ) -- others: -import Class ( GenClass ) -import Id ( idType ) -import Kind ( Kind ) -import TcKind ( TcKind ) +import Class ( Class ) +import TyCon ( isFunTyCon ) +import Kind ( Kind ) import TcMonad -import Usage ( Usage(..), GenUsage, UVar(..), duffUsage ) -import Ubiq +import TysPrim ( voidTy ) + import Unique ( Unique ) import UniqFM ( UniqFM ) -import Maybes ( assocMaybe ) -import Util ( panic, pprPanic ) - -import Outputable ( Outputable(..) ) -- Debugging messages -import PprType ( GenTyVar, GenType ) -import Pretty -- ditto -import PprStyle ( PprStyle(..) ) -- ditto +import BasicTypes ( unused ) +import Util ( nOfThem, panic ) \end{code} @@ -65,40 +69,71 @@ import PprStyle ( PprStyle(..) ) -- ditto Data types ~~~~~~~~~~ + \begin{code} -type TcType s = GenType (TcTyVar s) UVar -- Used during typechecker +type TcType s = GenType (TcBox s) -- Used during typechecker -- Invariant on ForAllTy in TcTypes: -- forall a. T -- a cannot occur inside a MutTyVar in T; that is, -- T is "flattened" before quantifying over a -type TcThetaType s = [(Class, TcType s)] +type TcThetaType s = [(Class, [TcType s])] type TcRhoType s = TcType s -- No ForAllTys type TcTauType s = TcType s -- No DictTys or ForAllTys -type Box s = MutableVar s (TcMaybe s) +type TcBox s = TcRef s (TcMaybe s) data TcMaybe s = UnBound | BoundTo (TcType s) - | DontBind -- This variant is used for tyvars - -- arising from type signatures, or - -- existentially quantified tyvars; - -- The idea is that we must not unify - -- such tyvars with anything except - -- themselves. -- Interestingly, you can't use (Maybe (TcType s)) instead of (TcMaybe s), -- because you get a synonym loop if you do! -type TcTyVar s = GenTyVar (Box s) -type TcTyVarSet s = GenTyVarSet (Box s) +type TcTyVar s = GenTyVar (TcBox s) +type TcTyVarSet s = GenTyVarSet (TcBox s) \end{code} \begin{code} tcTyVarToTyVar :: TcTyVar s -> TyVar -tcTyVarToTyVar (TyVar uniq kind name _) = TyVar uniq kind name duffUsage +tcTyVarToTyVar (TyVar uniq kind name _) = TyVar uniq kind name unused \end{code} +Utility functions +~~~~~~~~~~~~~~~~~ +These tcSplit functions are like their non-Tc analogues, but they +follow through bound type variables. + +\begin{code} +tcSplitForAllTy :: TcType s -> NF_TcM s ([TcTyVar s], TcType s) +tcSplitForAllTy t + = go t t [] + where + go syn_t (ForAllTy tv t) tvs = go t t (tv:tvs) + go syn_t (SynTy _ t) tvs = go syn_t t tvs + go syn_t (TyVarTy tv) tvs = tcReadTyVar tv `thenNF_Tc` \ maybe_ty -> + case maybe_ty of + BoundTo ty | not (isTyVarTy ty) -> go syn_t ty tvs + other -> returnNF_Tc (reverse tvs, syn_t) + go syn_t t tvs = returnNF_Tc (reverse tvs, syn_t) + +tcSplitRhoTy :: TcType s -> NF_TcM s (TcThetaType s, TcType s) +tcSplitRhoTy t + = go t t [] + where + -- A type variable is never instantiated to a dictionary type, + -- so we don't need to do a tcReadVar on the "arg". + go syn_t (FunTy arg res) ts = case splitDictTy_maybe arg of + Just pair -> go res res (pair:ts) + Nothing -> returnNF_Tc (reverse ts, syn_t) + go syn_t (SynTy _ t) ts = go syn_t t ts + go syn_t (TyVarTy tv) ts = tcReadTyVar tv `thenNF_Tc` \ maybe_ty -> + case maybe_ty of + BoundTo ty | not (isTyVarTy ty) -> go syn_t ty ts + other -> returnNF_Tc (reverse ts, syn_t) + go syn_t t ts = returnNF_Tc (reverse ts, syn_t) +\end{code} + + Type instantiation ~~~~~~~~~~~~~~~~~~ @@ -115,138 +150,160 @@ newTyVarTy kind returnNF_Tc (TyVarTy tc_tyvar) newTyVarTys :: Int -> Kind -> NF_TcM s [TcType s] -newTyVarTys n kind = mapNF_Tc newTyVarTy (take n (repeat kind)) +newTyVarTys n kind = mapNF_Tc newTyVarTy (nOfThem n kind) - --- For signature type variables, mark them as "DontBind" +-- For signature type variables, use the user name for the type variable tcInstTyVars, tcInstSigTyVars :: [GenTyVar flexi] - -> NF_TcM s ([TcTyVar s], [TcType s], [(GenTyVar flexi, TcType s)]) -tcInstTyVars tyvars = inst_tyvars UnBound tyvars -tcInstSigTyVars tyvars = inst_tyvars DontBind tyvars + -> NF_TcM s ([TcTyVar s], [TcType s], TyVarEnv (TcType s)) +tcInstTyVars tyvars = inst_tyvars inst_tyvar tyvars +tcInstSigTyVars tyvars = inst_tyvars inst_sig_tyvar tyvars -inst_tyvars initial_cts tyvars - = mapNF_Tc (inst_tyvar initial_cts) tyvars `thenNF_Tc` \ tc_tyvars -> +inst_tyvars inst tyvars + = mapNF_Tc inst tyvars `thenNF_Tc` \ tc_tyvars -> let tys = map TyVarTy tc_tyvars in - returnNF_Tc (tc_tyvars, tys, tyvars `zip` tys) + returnNF_Tc (tc_tyvars, tys, zipTyVarEnv tyvars tys) + +inst_tyvar (TyVar _ kind name _) + = tcGetUnique `thenNF_Tc` \ uniq -> + tcNewMutVar UnBound `thenNF_Tc` \ box -> + returnNF_Tc (TyVar uniq kind Nothing box) + -- The "Nothing" means that it'll always print with its + -- unique (or something similar). If we leave the original (Just Name) + -- in there then error messages will say "can't match (T a) against (T a)" -inst_tyvar initial_cts (TyVar _ kind name _) +inst_sig_tyvar (TyVar _ kind name _) = tcGetUnique `thenNF_Tc` \ uniq -> - tcNewMutVar initial_cts `thenNF_Tc` \ box -> + + tcNewMutVar UnBound `thenNF_Tc` \ box -> + -- Was DontBind, but we've nuked that "optimisation" + returnNF_Tc (TyVar uniq kind name box) + -- We propagate the name of the sigature type variable \end{code} -@tcInstType@ and @tcInstTcType@ both create a fresh instance of a +@tcInstType@ and @tcInstSigType@ both create a fresh instance of a type, returning a @TcType@. All inner for-alls are instantiated with fresh TcTyVars. -There are two versions, one for instantiating a @Type@, and one for a @TcType@. -The former must instantiate everything; all tyvars must be bound either -by a forall or by an environment passed in. The latter can do some sharing, -and is happy with free tyvars (which is vital when instantiating the type -of local functions). In the future @tcInstType@ may try to be clever about not -instantiating constant sub-parts. +The difference is that tcInstType instantiates all forall'd type +variables (and their bindees) with anonymous type variables, whereas +tcInstSigType instantiates them with named type variables. +@tcInstSigType@ also doesn't take an environment. + +On the other hand, @tcInstTcType@ instantiates a TcType. It uses +instantiateTy which could take advantage of sharing some day. \begin{code} -tcInstType :: [(TyVar,TcType s)] -> Type -> NF_TcM s (TcType s) +tcInstTcType :: TcType s -> NF_TcM s ([TcTyVar s], TcType s) +tcInstTcType ty + = tcSplitForAllTy ty `thenNF_Tc` \ (tyvars, rho) -> + case tyvars of + [] -> returnNF_Tc ([], ty) -- Nothing to do + other -> tcInstTyVars tyvars `thenNF_Tc` \ (tyvars', _, tenv) -> + returnNF_Tc (tyvars', instantiateTy tenv rho) + +tcInstSigTcType :: TcType s -> NF_TcM s ([TcTyVar s], TcType s) +tcInstSigTcType ty + = tcSplitForAllTy ty `thenNF_Tc` \ (tyvars, rho) -> + case tyvars of + [] -> returnNF_Tc ([], ty) -- Nothing to do + other -> tcInstSigTyVars tyvars `thenNF_Tc` \ (tyvars', _, tenv) -> + returnNF_Tc (tyvars', instantiateTy tenv rho) + +tcInstType :: TyVarEnv (TcType s) + -> GenType flexi + -> NF_TcM s (TcType s) tcInstType tenv ty_to_inst - = do [(uniq,ty) | (TyVar uniq _ _ _, ty) <- tenv] ty_to_inst + = tcConvert bind_fn occ_fn tenv ty_to_inst + where + bind_fn = inst_tyvar + occ_fn env tyvar = case lookupTyVarEnv env tyvar of + Just ty -> returnNF_Tc ty + Nothing -> panic "tcInstType:1" --(vcat [ppr ty_to_inst, + -- ppr tyvar]) + +tcInstSigType :: GenType flexi -> NF_TcM s (TcType s) +tcInstSigType ty_to_inst + = tcConvert bind_fn occ_fn emptyTyVarEnv ty_to_inst where - do env (TyConTy tycon usage) = returnNF_Tc (TyConTy tycon usage) + bind_fn = inst_sig_tyvar -- Note: inst_sig_tyvar, not inst_tyvar + -- I don't think that can lead to strange error messages + -- of the form can't match (T a) against (T a) + -- See notes with inst_tyvar - do env (SynTy tycon tys ty) = mapNF_Tc (do env) tys `thenNF_Tc` \ tys' -> - do env ty `thenNF_Tc` \ ty' -> - returnNF_Tc (SynTy tycon tys' ty') + occ_fn env tyvar = case lookupTyVarEnv env tyvar of + Just ty -> returnNF_Tc ty + Nothing -> panic "tcInstType:2"-- (vcat [ppr ty_to_inst, + -- ppr tyvar]) - do env (FunTy arg res usage) = do env arg `thenNF_Tc` \ arg' -> - do env res `thenNF_Tc` \ res' -> - returnNF_Tc (FunTy arg' res' usage) +zonkTcTyVarToTyVar :: TcTyVar s -> NF_TcM s TyVar +zonkTcTyVarToTyVar tv + = zonkTcTyVar tv `thenNF_Tc` \ tv_ty -> + case tv_ty of -- Should be a tyvar! - do env (AppTy fun arg) = do env fun `thenNF_Tc` \ fun' -> - do env arg `thenNF_Tc` \ arg' -> - returnNF_Tc (AppTy fun' arg') + TyVarTy tv' -> returnNF_Tc (tcTyVarToTyVar tv') - do env (DictTy clas ty usage)= do env ty `thenNF_Tc` \ ty' -> - returnNF_Tc (DictTy clas ty' usage) + _ -> --pprTrace "zonkTcTyVarToTyVar:" (hsep [ppr tv, ppr tv_ty]) $ + returnNF_Tc (tcTyVarToTyVar tv) - do env (TyVarTy tv@(TyVar uniq kind name _)) - = case assocMaybe env uniq of - Just tc_ty -> returnNF_Tc tc_ty - Nothing -> pprPanic "tcInstType:" (ppAboves [ppr PprDebug tenv, - ppr PprDebug ty_to_inst, ppr PprDebug tv]) - do env (ForAllTy tyvar@(TyVar uniq kind name _) ty) - = inst_tyvar DontBind tyvar `thenNF_Tc` \ tc_tyvar -> - let - new_env = (uniq, TyVarTy tc_tyvar) : env - in - do new_env ty `thenNF_Tc` \ ty' -> - returnNF_Tc (ForAllTy tc_tyvar ty') +zonkTcTypeToType :: TyVarEnv Type -> TcType s -> NF_TcM s Type +zonkTcTypeToType env ty + = tcConvert zonkTcTyVarToTyVar occ_fn env ty + where + occ_fn env tyvar + = tcReadTyVar tyvar `thenNF_Tc` \ maybe_ty -> + case maybe_ty of + BoundTo (TyVarTy tyvar') -> lookup env tyvar' + BoundTo other_ty -> tcConvert zonkTcTyVarToTyVar occ_fn env other_ty + other -> lookup env tyvar - -- ForAllUsage impossible + lookup env tyvar = case lookupTyVarEnv env tyvar of + Just ty -> returnNF_Tc ty + Nothing -> returnNF_Tc voidTy -- Unbound type variables go to Void -tcInstTheta :: [(TyVar,TcType s)] -> ThetaType -> NF_TcM s (TcThetaType s) -tcInstTheta tenv theta - = mapNF_Tc go theta +tcConvert bind_fn occ_fn env ty_to_convert + = doo env ty_to_convert where - go (clas,ty) = tcInstType tenv ty `thenNF_Tc` \ tc_ty -> - returnNF_Tc (clas, tc_ty) - --- A useful function that takes an occurrence of a global thing --- and instantiates its type with fresh type variables -tcInstId :: Id - -> NF_TcM s ([TcTyVar s], -- It's instantiated type - TcThetaType s, -- - TcType s) -- - -tcInstId id - = let - (tyvars, rho) = splitForAllTy (idType id) - in - tcInstTyVars tyvars `thenNF_Tc` \ (tyvars', arg_tys, tenv) -> - tcInstType tenv rho `thenNF_Tc` \ rho' -> - let - (theta', tau') = splitRhoTy rho' - in - returnNF_Tc (tyvars', theta', tau') + doo env (TyConApp tycon tys) = mapNF_Tc (doo env) tys `thenNF_Tc` \ tys' -> + returnNF_Tc (TyConApp tycon tys') + + doo env (SynTy ty1 ty2) = doo env ty1 `thenNF_Tc` \ ty1' -> + doo env ty2 `thenNF_Tc` \ ty2' -> + returnNF_Tc (SynTy ty1' ty2') + + doo env (FunTy arg res) = doo env arg `thenNF_Tc` \ arg' -> + doo env res `thenNF_Tc` \ res' -> + returnNF_Tc (FunTy arg' res') + + doo env (AppTy fun arg) = doo env fun `thenNF_Tc` \ fun' -> + doo env arg `thenNF_Tc` \ arg' -> + returnNF_Tc (mkAppTy fun' arg') + + -- The two interesting cases! + doo env (TyVarTy tv) = occ_fn env tv + + doo env (ForAllTy tyvar ty) + = bind_fn tyvar `thenNF_Tc` \ tyvar' -> + let + new_env = addToTyVarEnv env tyvar (TyVarTy tyvar') + in + doo new_env ty `thenNF_Tc` \ ty' -> + returnNF_Tc (ForAllTy tyvar' ty') -tcInstTcType :: [(TcTyVar s,TcType s)] -> TcType s -> NF_TcM s (TcType s) -tcInstTcType tenv ty_to_inst - = do [(uniq,ty) | (TyVar uniq _ _ _, ty) <- tenv] ty_to_inst +tcInstTheta :: TyVarEnv (TcType s) -> ThetaType -> NF_TcM s (TcThetaType s) +tcInstTheta tenv theta + = mapNF_Tc go theta where - do env ty@(TyConTy tycon usage) = returnNF_Tc ty - --- Could do clever stuff here to avoid instantiating constant types - do env (SynTy tycon tys ty) = mapNF_Tc (do env) tys `thenNF_Tc` \ tys' -> - do env ty `thenNF_Tc` \ ty' -> - returnNF_Tc (SynTy tycon tys' ty') - - do env (FunTy arg res usage) = do env arg `thenNF_Tc` \ arg' -> - do env res `thenNF_Tc` \ res' -> - returnNF_Tc (FunTy arg' res' usage) - - do env (AppTy fun arg) = do env fun `thenNF_Tc` \ fun' -> - do env arg `thenNF_Tc` \ arg' -> - returnNF_Tc (AppTy fun' arg') - - do env (DictTy clas ty usage)= do env ty `thenNF_Tc` \ ty' -> - returnNF_Tc (DictTy clas ty' usage) - - do env ty@(TyVarTy (TyVar uniq kind name _)) - = case assocMaybe env uniq of - Just tc_ty -> returnNF_Tc tc_ty - Nothing -> returnNF_Tc ty - - do env (ForAllTy (TyVar uniq kind name _) ty) = panic "tcInstTcType" - - -- ForAllUsage impossible - + go (clas,tys) = mapNF_Tc (tcInstType tenv) tys `thenNF_Tc` \ tc_tys -> + returnNF_Tc (clas, tc_tys) \end{code} Reading and writing TcTyVars @@ -299,71 +356,68 @@ short_out other_ty = returnNF_Tc other_ty Zonking ~~~~~~~ -@zonkTcTypeToType@ converts from @TcType@ to @Type@. It follows through all -the substitutions of course. - \begin{code} -zonkTcTypeToType :: TcType s -> NF_TcM s Type -zonkTcTypeToType ty = zonk tcTyVarToTyVar ty - -zonkTcType :: TcType s -> NF_TcM s (TcType s) -zonkTcType ty = zonk (\tyvar -> tyvar) ty - zonkTcTyVars :: TcTyVarSet s -> NF_TcM s (TcTyVarSet s) zonkTcTyVars tyvars - = mapNF_Tc (zonk_tv (\tyvar -> tyvar)) - (tyVarSetToList tyvars) `thenNF_Tc` \ tys -> + = mapNF_Tc zonkTcTyVar (tyVarSetToList tyvars) `thenNF_Tc` \ tys -> returnNF_Tc (tyVarsOfTypes tys) -zonkTcTyVarToTyVar :: TcTyVar s -> NF_TcM s TyVar -zonkTcTyVarToTyVar tyvar - = zonk_tv_to_tv tcTyVarToTyVar tyvar - - -zonk tyvar_fn (TyVarTy tyvar) - = zonk_tv tyvar_fn tyvar - -zonk tyvar_fn (AppTy ty1 ty2) - = zonk tyvar_fn ty1 `thenNF_Tc` \ ty1' -> - zonk tyvar_fn ty2 `thenNF_Tc` \ ty2' -> - returnNF_Tc (AppTy ty1' ty2') - -zonk tyvar_fn (TyConTy tc u) - = returnNF_Tc (TyConTy tc u) - -zonk tyvar_fn (SynTy tc tys ty) - = mapNF_Tc (zonk tyvar_fn) tys `thenNF_Tc` \ tys' -> - zonk tyvar_fn ty `thenNF_Tc` \ ty' -> - returnNF_Tc (SynTy tc tys' ty') - -zonk tyvar_fn (ForAllTy tv ty) - = zonk_tv_to_tv tyvar_fn tv `thenNF_Tc` \ tv' -> - zonk tyvar_fn ty `thenNF_Tc` \ ty' -> - returnNF_Tc (ForAllTy tv' ty') - -zonk tyvar_fn (ForAllUsageTy uv uvs ty) - = panic "zonk:ForAllUsageTy" - -zonk tyvar_fn (FunTy ty1 ty2 u) - = zonk tyvar_fn ty1 `thenNF_Tc` \ ty1' -> - zonk tyvar_fn ty2 `thenNF_Tc` \ ty2' -> - returnNF_Tc (FunTy ty1' ty2' u) - -zonk tyvar_fn (DictTy c ty u) - = zonk tyvar_fn ty `thenNF_Tc` \ ty' -> - returnNF_Tc (DictTy c ty' u) - - -zonk_tv tyvar_fn tyvar +zonkTcTyVar :: TcTyVar s -> NF_TcM s (TcType s) +zonkTcTyVar tyvar + = tcReadTyVar tyvar `thenNF_Tc` \ maybe_ty -> + case maybe_ty of + BoundTo ty@(TyVarTy tyvar') -> returnNF_Tc ty -- tcReadTyVar never returns a bound tyvar + BoundTo other -> zonkTcType other + other -> returnNF_Tc (TyVarTy tyvar) + +-- Signature type variables only get bound to each other, +-- never to a type +zonkSigTyVar :: TcTyVar s -> NF_TcM s (TcTyVar s) +zonkSigTyVar tyvar = tcReadTyVar tyvar `thenNF_Tc` \ maybe_ty -> case maybe_ty of - BoundTo ty -> zonk tyvar_fn ty - other -> returnNF_Tc (TyVarTy (tyvar_fn tyvar)) + BoundTo ty@(TyVarTy tyvar') -> returnNF_Tc tyvar' -- tcReadTyVar never returns a bound tyvar + BoundTo other -> panic "zonkSigTyVar" -- Should only be bound to another tyvar + other -> returnNF_Tc tyvar + +zonkTcTypes :: [TcType s] -> NF_TcM s [TcType s] +zonkTcTypes tys = mapNF_Tc zonkTcType tys +zonkTcThetaType :: TcThetaType s -> NF_TcM s (TcThetaType s) +zonkTcThetaType theta = mapNF_Tc zonk theta + where + zonk (c,ts) = zonkTcTypes ts `thenNF_Tc` \ new_ts -> + returnNF_Tc (c, new_ts) + +zonkTcType :: TcType s -> NF_TcM s (TcType s) -zonk_tv_to_tv tyvar_fn tyvar - = zonk_tv tyvar_fn tyvar `thenNF_Tc` \ ty -> - case getTyVar_maybe ty of - Nothing -> panic "zonk_tv_to_tv" - Just tyvar -> returnNF_Tc tyvar +zonkTcType (TyVarTy tyvar) = zonkTcTyVar tyvar + +zonkTcType (AppTy ty1 ty2) + = zonkTcType ty1 `thenNF_Tc` \ ty1' -> + zonkTcType ty2 `thenNF_Tc` \ ty2' -> + returnNF_Tc (mkAppTy ty1' ty2') + +zonkTcType (TyConApp tc tys) + = mapNF_Tc zonkTcType tys `thenNF_Tc` \ tys' -> + returnNF_Tc (TyConApp tc tys') + +zonkTcType (SynTy ty1 ty2) + = zonkTcType ty1 `thenNF_Tc` \ ty1' -> + zonkTcType ty2 `thenNF_Tc` \ ty2' -> + returnNF_Tc (SynTy ty1' ty2') + +zonkTcType (ForAllTy tv ty) + = zonkTcTyVar tv `thenNF_Tc` \ tv_ty -> + zonkTcType ty `thenNF_Tc` \ ty' -> + case tv_ty of -- Should be a tyvar! + TyVarTy tv' -> returnNF_Tc (ForAllTy tv' ty') + _ -> panic "zonkTcType" + -- pprTrace "zonkTcType:ForAllTy:" (hsep [ppr tv, ppr tv_ty]) $ + -- returnNF_Tc (ForAllTy tv{-(tcTyVarToTyVar tv)-} ty') + +zonkTcType (FunTy ty1 ty2) + = zonkTcType ty1 `thenNF_Tc` \ ty1' -> + zonkTcType ty2 `thenNF_Tc` \ ty2' -> + returnNF_Tc (FunTy ty1' ty2') \end{code}