module TcType (
- TcTyVar(..),
+ SYN_IE(TcTyVar),
newTcTyVar,
newTyVarTy, -- Kind -> NF_TcM s (TcType s)
newTyVarTys, -- Int -> Kind -> NF_TcM s [TcType s]
- TcTyVarSet(..),
+ SYN_IE(TcTyVarSet),
-----------------------------------------
- TcType(..), TcMaybe(..),
- TcTauType(..), TcThetaType(..), TcRhoType(..),
+ SYN_IE(TcType), TcMaybe(..),
+ SYN_IE(TcTauType), SYN_IE(TcThetaType), SYN_IE(TcRhoType),
-- Find the type to which a type variable is bound
tcWriteTyVar, -- :: TcTyVar s -> TcType s -> NF_TcM (TcType s)
tcInstTyVars,
tcInstSigTyVars,
- tcInstType, tcInstSigType, tcInstTcType,
+ tcInstType, tcInstSigType, tcInstTcType, tcInstSigTcType,
tcInstTheta, tcInstId,
zonkTcTyVars,
-- friends:
-import Type ( Type(..), ThetaType(..), GenType(..),
+import Type ( SYN_IE(Type), SYN_IE(ThetaType), GenType(..),
tyVarsOfTypes, getTyVar_maybe,
splitForAllTy, splitRhoTy,
mkForAllTys, instantiateTy
)
-import TyVar ( TyVar(..), GenTyVar(..), TyVarSet(..), GenTyVarSet(..),
- TyVarEnv(..), lookupTyVarEnv, addOneToTyVarEnv,
+import TyVar ( SYN_IE(TyVar), GenTyVar(..), SYN_IE(TyVarSet), SYN_IE(GenTyVarSet),
+ SYN_IE(TyVarEnv), lookupTyVarEnv, addOneToTyVarEnv,
nullTyVarEnv, mkTyVarEnv,
tyVarSetToList
)
import Kind ( Kind )
import TcKind ( TcKind )
import TcMonad hiding ( rnMtoTcM )
-import Usage ( Usage(..), GenUsage, UVar(..), duffUsage )
+import Usage ( SYN_IE(Usage), GenUsage, SYN_IE(UVar), duffUsage )
-import TysWiredIn ( voidTy )
+import TysPrim ( voidTy )
IMP_Ubiq()
import Unique ( Unique )
import UniqFM ( UniqFM )
import Maybes ( assocMaybe )
-import Util ( zipEqual, nOfThem, panic, pprPanic, pprTrace{-ToDo:rm-} )
+import Util ( zipEqual, nOfThem, panic{-, pprPanic, pprTrace ToDo:rm-} )
-import Outputable ( Outputable(..) ) -- Debugging messages
-import PprType ( GenTyVar, GenType )
-import Pretty -- ditto
-import PprStyle ( PprStyle(..) ) -- ditto
+--import Outputable ( Outputable(..) ) -- Debugging messages
+--import PprType ( GenTyVar, GenType )
+--import Pretty -- ditto
+--import PprStyle ( PprStyle(..) ) -- ditto
\end{code}
where
(tyvars, rho) = splitForAllTy ty
+tcInstSigTcType :: TcType s -> NF_TcM s ([TcTyVar s], TcType s)
+tcInstSigTcType ty
+ = case tyvars of
+ [] -> returnNF_Tc ([], ty) -- Nothing to do
+ other -> tcInstSigTyVars tyvars `thenNF_Tc` \ (tyvars', _, tenv) ->
+ returnNF_Tc (tyvars', instantiateTy tenv rho)
+ where
+ (tyvars, rho) = splitForAllTy ty
+
tcInstType :: [(GenTyVar flexi,TcType s)]
-> GenType (GenTyVar flexi) UVar
-> NF_TcM s (TcType s)
bind_fn = inst_tyvar UnBound
occ_fn env tyvar = case lookupTyVarEnv env tyvar of
Just ty -> returnNF_Tc ty
- Nothing -> pprPanic "tcInstType:" (ppAboves [ppr PprDebug ty_to_inst,
- ppr PprDebug tyvar])
+ Nothing -> panic "tcInstType:1" --(ppAboves [ppr PprDebug ty_to_inst,
+ -- ppr PprDebug tyvar])
tcInstSigType :: GenType (GenTyVar flexi) UVar -> NF_TcM s (TcType s)
tcInstSigType ty_to_inst
bind_fn = inst_tyvar DontBind
occ_fn env tyvar = case lookupTyVarEnv env tyvar of
Just ty -> returnNF_Tc ty
- Nothing -> pprPanic "tcInstType:" (ppAboves [ppr PprDebug ty_to_inst,
- ppr PprDebug tyvar])
+ Nothing -> panic "tcInstType:2"-- (ppAboves [ppr PprDebug ty_to_inst,
+ -- ppr PprDebug tyvar])
zonkTcTyVarToTyVar :: TcTyVar s -> NF_TcM s TyVar
zonkTcTyVarToTyVar tv
TyVarTy tv' -> returnNF_Tc (tcTyVarToTyVar tv')
- _ -> pprTrace "zonkTcTyVarToTyVar:" (ppCat [ppr PprDebug tv, ppr PprDebug tv_ty]) $
+ _ -> --pprTrace "zonkTcTyVarToTyVar:" (ppCat [ppr PprDebug tv, ppr PprDebug tv_ty]) $
returnNF_Tc (tcTyVarToTyVar tv)
tcConvert bind_fn occ_fn env ty_to_convert
- = do env ty_to_convert
+ = doo env ty_to_convert
where
- do env (TyConTy tycon usage) = returnNF_Tc (TyConTy tycon usage)
+ doo env (TyConTy tycon usage) = returnNF_Tc (TyConTy tycon usage)
- do env (SynTy tycon tys ty) = mapNF_Tc (do env) tys `thenNF_Tc` \ tys' ->
- do env ty `thenNF_Tc` \ ty' ->
+ doo env (SynTy tycon tys ty) = mapNF_Tc (doo env) tys `thenNF_Tc` \ tys' ->
+ doo 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' ->
+ doo env (FunTy arg res usage) = doo env arg `thenNF_Tc` \ arg' ->
+ doo 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' ->
+ doo env (AppTy fun arg) = doo env fun `thenNF_Tc` \ fun' ->
+ doo env arg `thenNF_Tc` \ arg' ->
returnNF_Tc (AppTy fun' arg')
- do env (DictTy clas ty usage)= do env ty `thenNF_Tc` \ ty' ->
+ doo env (DictTy clas ty usage)= doo env ty `thenNF_Tc` \ ty' ->
returnNF_Tc (DictTy clas ty' usage)
- do env (ForAllUsageTy u us ty) = do env ty `thenNF_Tc` \ ty' ->
+ doo env (ForAllUsageTy u us ty) = doo env ty `thenNF_Tc` \ ty' ->
returnNF_Tc (ForAllUsageTy u us ty')
-- The two interesting cases!
- do env (TyVarTy tv) = occ_fn env tv
+ doo env (TyVarTy tv) = occ_fn env tv
- do env (ForAllTy tyvar ty)
+ doo env (ForAllTy tyvar ty)
= bind_fn tyvar `thenNF_Tc` \ tyvar' ->
let
new_env = addOneToTyVarEnv env tyvar (TyVarTy tyvar')
in
- do new_env ty `thenNF_Tc` \ ty' ->
+ doo new_env ty `thenNF_Tc` \ ty' ->
returnNF_Tc (ForAllTy tyvar' ty')
case tv_ty of -- Should be a tyvar!
TyVarTy tv' ->
returnNF_Tc (ForAllTy tv' ty')
- _ -> pprTrace "zonkTcType:ForAllTy:" (ppCat [ppr PprDebug tv, ppr PprDebug tv_ty]) $
+ _ -> --pprTrace "zonkTcType:ForAllTy:" (ppCat [ppr PprDebug tv, ppr PprDebug tv_ty]) $
returnNF_Tc (ForAllTy tv{-(tcTyVarToTyVar tv)-} ty')
projects / ghc-hetmet.git / blobdiff