TcTyVar,
TcTyVarSet,
newTyVar,
- newTyVarTy, -- Kind -> NF_TcM s TcType
- newTyVarTys, -- Int -> Kind -> NF_TcM s [TcType]
+ newTyVarTy, -- Kind -> NF_TcM TcType
+ newTyVarTys, -- Int -> Kind -> NF_TcM [TcType]
-----------------------------------------
TcType, TcTauType, TcThetaType, TcRhoType,
-- friends:
import TypeRep ( Type(..), Kind, TyNote(..) ) -- friend
-import Type ( ThetaType, PredType(..),
- getTyVar, mkAppTy, mkTyConApp, mkPredTy,
- splitPredTy_maybe, splitForAllTys, isNotUsgTy,
+import Type ( PredType(..),
+ getTyVar, mkAppTy, mkUTy,
+ splitPredTy_maybe, splitForAllTys,
isTyVarTy, mkTyVarTy, mkTyVarTys,
- openTypeKind, boxedTypeKind,
+ openTypeKind, liftedTypeKind,
superKind, superBoxity,
- defaultKind, boxedBoxity
+ defaultKind, liftedBoxity
)
import Subst ( Subst, mkTopTyVarSubst, substTy )
-import TyCon ( tyConKind, mkPrimTyCon )
+import TyCon ( mkPrimTyCon )
import PrimRep ( PrimRep(VoidRep) )
import Var ( TyVar, tyVarKind, tyVarName, isTyVar, isMutTyVar, mkTyVar )
-- others:
-import TcMonad
+import TcMonad -- TcType, amongst others
import TysWiredIn ( voidTy )
import Name ( Name, NamedThing(..), setNameUnique, mkSysLocalName,
- mkDerivedName, mkDerivedTyConOcc
+ mkLocalName, mkDerivedTyConOcc
)
-import Unique ( Unique, Uniquable(..) )
+import Unique ( Uniquable(..) )
+import SrcLoc ( noSrcLoc )
import Util ( nOfThem )
import Outputable
\end{code}
to a for-all type.
\begin{code}
-tcSplitRhoTy :: TcType -> NF_TcM s (TcThetaType, TcType)
+tcSplitRhoTy :: TcType -> NF_TcM (TcThetaType, TcType)
tcSplitRhoTy t
= go t t []
where
case maybe_ty of
Just ty | not (isTyVarTy ty) -> go syn_t ty ts
other -> returnNF_Tc (reverse ts, syn_t)
+ go syn_t (UsageTy _ t) ts = go syn_t t ts
go syn_t t ts = returnNF_Tc (reverse ts, syn_t)
\end{code}
%************************************************************************
\begin{code}
-newTyVar :: Kind -> NF_TcM s TcTyVar
+newTyVar :: Kind -> NF_TcM TcTyVar
newTyVar kind
= tcGetUnique `thenNF_Tc` \ uniq ->
tcNewMutTyVar (mkSysLocalName uniq SLIT("t")) kind
-newTyVarTy :: Kind -> NF_TcM s TcType
+newTyVarTy :: Kind -> NF_TcM TcType
newTyVarTy kind
= newTyVar kind `thenNF_Tc` \ tc_tyvar ->
returnNF_Tc (TyVarTy tc_tyvar)
-newTyVarTys :: Int -> Kind -> NF_TcM s [TcType]
+newTyVarTys :: Int -> Kind -> NF_TcM [TcType]
newTyVarTys n kind = mapNF_Tc newTyVarTy (nOfThem n kind)
-newKindVar :: NF_TcM s TcKind
+newKindVar :: NF_TcM TcKind
newKindVar
= tcGetUnique `thenNF_Tc` \ uniq ->
tcNewMutTyVar (mkSysLocalName uniq SLIT("k")) superKind `thenNF_Tc` \ kv ->
returnNF_Tc (TyVarTy kv)
-newKindVars :: Int -> NF_TcM s [TcKind]
+newKindVars :: Int -> NF_TcM [TcKind]
newKindVars n = mapNF_Tc (\ _ -> newKindVar) (nOfThem n ())
-newBoxityVar :: NF_TcM s TcKind
+newBoxityVar :: NF_TcM TcKind
newBoxityVar
= tcGetUnique `thenNF_Tc` \ uniq ->
tcNewMutTyVar (mkSysLocalName uniq SLIT("bx")) superBoxity `thenNF_Tc` \ kv ->
\begin{code}
tcInstTyVars :: [TyVar]
- -> NF_TcM s ([TcTyVar], [TcType], Subst)
+ -> NF_TcM ([TcTyVar], [TcType], Subst)
tcInstTyVars tyvars
= mapNF_Tc tcInstTyVar tyvars `thenNF_Tc` \ tc_tyvars ->
fresh type variables, returning them and the instantiated body of the for-all.
\begin{code}
-tcInstTcType :: TcType -> NF_TcM s ([TcTyVar], TcType)
+tcInstTcType :: TcType -> NF_TcM ([TcTyVar], TcType)
tcInstTcType ty
= case splitForAllTys ty of
([], _) -> returnNF_Tc ([], ty) -- Nothing to do
%************************************************************************
\begin{code}
-tcPutTyVar :: TcTyVar -> TcType -> NF_TcM s TcType
-tcGetTyVar :: TcTyVar -> NF_TcM s (Maybe TcType)
+tcPutTyVar :: TcTyVar -> TcType -> NF_TcM TcType
+tcGetTyVar :: TcTyVar -> NF_TcM (Maybe TcType)
\end{code}
Putting is easy:
\begin{code}
-tcPutTyVar tyvar ty = tcWriteMutTyVar tyvar (Just ty) `thenNF_Tc_`
+tcPutTyVar tyvar ty = UASSERT2( not (isUTy ty), ppr tyvar <+> ppr ty )
+ tcWriteMutTyVar tyvar (Just ty) `thenNF_Tc_`
returnNF_Tc ty
\end{code}
Nothing -> returnNF_Tc Nothing
-short_out :: TcType -> NF_TcM s TcType
+short_out :: TcType -> NF_TcM TcType
short_out ty@(TyVarTy tyvar)
| not (isMutTyVar tyvar)
= returnNF_Tc ty
----------------- Type variables
\begin{code}
-zonkTcTyVars :: [TcTyVar] -> NF_TcM s [TcType]
+zonkTcTyVars :: [TcTyVar] -> NF_TcM [TcType]
zonkTcTyVars tyvars = mapNF_Tc zonkTcTyVar tyvars
-zonkTcTyVar :: TcTyVar -> NF_TcM s TcType
+zonkTcTyVar :: TcTyVar -> NF_TcM TcType
zonkTcTyVar tyvar = zonkTyVar (\ tv -> returnNF_Tc (TyVarTy tv)) tyvar
-zonkTcSigTyVars :: [TcTyVar] -> NF_TcM s [TcTyVar]
+zonkTcSigTyVars :: [TcTyVar] -> NF_TcM [TcTyVar]
-- This guy is to zonk the tyvars we're about to feed into tcSimplify
-- Usually this job is done by checkSigTyVars, but in a couple of places
-- that is overkill, so we use this simpler chap
----------------- Types
\begin{code}
-zonkTcType :: TcType -> NF_TcM s TcType
+zonkTcType :: TcType -> NF_TcM TcType
zonkTcType ty = zonkType (\ tv -> returnNF_Tc (TyVarTy tv)) ty
-zonkTcTypes :: [TcType] -> NF_TcM s [TcType]
+zonkTcTypes :: [TcType] -> NF_TcM [TcType]
zonkTcTypes tys = mapNF_Tc zonkTcType tys
zonkTcClassConstraints cts = mapNF_Tc zonk cts
= zonkTcTypes tys `thenNF_Tc` \ new_tys ->
returnNF_Tc (clas, new_tys)
-zonkTcThetaType :: TcThetaType -> NF_TcM s TcThetaType
+zonkTcThetaType :: TcThetaType -> NF_TcM TcThetaType
zonkTcThetaType theta = mapNF_Tc zonkTcPredType theta
-zonkTcPredType :: TcPredType -> NF_TcM s TcPredType
+zonkTcPredType :: TcPredType -> NF_TcM TcPredType
zonkTcPredType (Class c ts) =
zonkTcTypes ts `thenNF_Tc` \ new_ts ->
returnNF_Tc (Class c new_ts)
are used at the end of type checking
\begin{code}
-zonkKindEnv :: [(Name, TcKind)] -> NF_TcM s [(Name, Kind)]
+zonkKindEnv :: [(Name, TcKind)] -> NF_TcM [(Name, Kind)]
zonkKindEnv pairs
= mapNF_Tc zonk_it pairs
where
-- When zonking a kind, we want to
-- zonk a *kind* variable to (Type *)
-- zonk a *boxity* variable to *
- zonk_unbound_kind_var kv | tyVarKind kv == superKind = tcPutTyVar kv boxedTypeKind
- | tyVarKind kv == superBoxity = tcPutTyVar kv boxedBoxity
+ zonk_unbound_kind_var kv | tyVarKind kv == superKind = tcPutTyVar kv liftedTypeKind
+ | tyVarKind kv == superBoxity = tcPutTyVar kv liftedBoxity
| otherwise = pprPanic "zonkKindEnv" (ppr kv)
-zonkTcTypeToType :: TcType -> NF_TcM s Type
+zonkTcTypeToType :: TcType -> NF_TcM Type
zonkTcTypeToType ty = zonkType zonk_unbound_tyvar ty
where
-- Zonk a mutable but unbound type variable to
- -- Void if it has kind Boxed
+ -- Void if it has kind Lifted
-- :Void otherwise
zonk_unbound_tyvar tv
- | kind == boxedTypeKind
+ | kind == liftedTypeKind
= tcPutTyVar tv voidTy -- Just to avoid creating a new tycon in
-- this vastly common case
| otherwise
mk_void_tycon tv kind -- Make a new TyCon with the same kind as the
-- type variable tv. Same name too, apart from
-- making it start with a colon (sigh)
- = mkPrimTyCon tc_name kind 0 [] VoidRep
+ -- I dread to think what will happen if this gets out into an
+ -- interface file. Catastrophe likely. Major sigh.
+ = pprTrace "Urk! Inventing strangely-kinded void TyCon" (ppr tc_name) $
+ mkPrimTyCon tc_name kind 0 [] VoidRep
where
- tc_name = mkDerivedName mkDerivedTyConOcc (getName tv) (getUnique tv)
+ tc_name = mkLocalName (getUnique tv) (mkDerivedTyConOcc (getOccName tv)) noSrcLoc
-- zonkTcTyVarToTyVar is applied to the *binding* occurrence
-- of a type variable, at the *end* of type checking. It changes
-- Now any bound occurences of the original type variable will get
-- zonked to the immutable version.
-zonkTcTyVarToTyVar :: TcTyVar -> NF_TcM s TyVar
+zonkTcTyVarToTyVar :: TcTyVar -> NF_TcM TyVar
zonkTcTyVarToTyVar tv
= let
-- Make an immutable version, defaulting
- -- the kind to boxed if necessary
+ -- the kind to lifted if necessary
immut_tv = mkTyVar (tyVarName tv) (defaultKind (tyVarKind tv))
immut_tv_ty = mkTyVarTy immut_tv
-- For tyvars bound at a for-all, zonkType zonks them to an immutable
-- type variable and zonks the kind too
-zonkType :: (TcTyVar -> NF_TcM s Type) -- What to do with unbound mutable type variables
+zonkType :: (TcTyVar -> NF_TcM Type) -- What to do with unbound mutable type variables
-- see zonkTcType, and zonkTcTypeToType
-> TcType
- -> NF_TcM s Type
+ -> NF_TcM Type
zonkType unbound_var_fn ty
= go ty
where
go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard free-tyvar annotations
- go (NoteTy (UsgNote usg) ty2) = go ty2 `thenNF_Tc` \ ty2' ->
- returnNF_Tc (NoteTy (UsgNote usg) ty2')
-
- go (NoteTy (UsgForAll uv) ty2)= go ty2 `thenNF_Tc` \ ty2' ->
- returnNF_Tc (NoteTy (UsgForAll uv) ty2')
-
go (PredTy p) = go_pred p `thenNF_Tc` \ p' ->
returnNF_Tc (PredTy p')
go arg `thenNF_Tc` \ arg' ->
returnNF_Tc (mkAppTy fun' arg')
+ go (UsageTy u ty) = go u `thenNF_Tc` \ u' ->
+ go ty `thenNF_Tc` \ ty' ->
+ returnNF_Tc (mkUTy u' ty')
+
-- The two interesting cases!
go (TyVarTy tyvar) = zonkTyVar unbound_var_fn tyvar
go_pred (IParam n ty) = go ty `thenNF_Tc` \ ty' ->
returnNF_Tc (IParam n ty')
-zonkTyVar :: (TcTyVar -> NF_TcM s Type) -- What to do for an unbound mutable variable
- -> TcTyVar -> NF_TcM s TcType
+zonkTyVar :: (TcTyVar -> NF_TcM Type) -- What to do for an unbound mutable variable
+ -> TcTyVar -> NF_TcM TcType
zonkTyVar unbound_var_fn tyvar
| not (isMutTyVar tyvar) -- Not a mutable tyvar. This can happen when
-- zonking a forall type, when the bound type variable
= tcGetTyVar tyvar `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
Nothing -> unbound_var_fn tyvar -- Mutable and unbound
- Just other_ty -> ASSERT( isNotUsgTy other_ty )
- zonkType unbound_var_fn other_ty -- Bound
+ Just other_ty -> zonkType unbound_var_fn other_ty -- Bound
\end{code}
projects / ghc-hetmet.git / blobdiff