- 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
- = 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
- 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
-
- 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])
-
-zonkTcTyVarToTyVar :: TcTyVar s -> NF_TcM s TyVar
-zonkTcTyVarToTyVar tv
- = zonkTcTyVar tv `thenNF_Tc` \ tv_ty ->
- case tv_ty of -- Should be a tyvar!
-
- TyVarTy tv' -> returnNF_Tc (tcTyVarToTyVar tv')
-
- _ -> --pprTrace "zonkTcTyVarToTyVar:" (hsep [ppr tv, ppr tv_ty]) $
- returnNF_Tc (tcTyVarToTyVar tv)
-
-
-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
-
- lookup env tyvar = case lookupTyVarEnv env tyvar of
- Just ty -> returnNF_Tc ty
- Nothing -> returnNF_Tc voidTy -- Unbound type variables go to Void
-
-
-tcConvert bind_fn occ_fn env ty_to_convert
- = doo env ty_to_convert
- where
- 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