TcTyVar, TcKind, TcType, TcTauType, TcThetaType, TcRhoType, TcTyVarSet,
--------------------------------
- -- Find the type to which a type variable is bound
- tcPutTyVar, -- :: TcTyVar -> TcType -> NF_TcM TcType
- tcGetTyVar, -- :: TcTyVar -> NF_TcM (Maybe TcType) does shorting out
-
- --------------------------------
-- Creating new mutable type variables
newTyVar,
newTyVarTy, -- Kind -> NF_TcM TcType
-- friends:
-import TypeRep ( Type(..), Kind, TyNote(..) ) -- friend
-import Type -- Lots and lots
+import TypeRep ( Type(..), SourceType(..), Kind, TyNote(..), -- friend
+ openKindCon, typeCon
+ )
import TcType ( tcEqType,
tcSplitRhoTy, tcSplitPredTy_maybe, tcSplitAppTy_maybe,
- tcSplitTyConApp_maybe, tcSplitFunTy_maybe
+ tcSplitTyConApp_maybe, tcSplitFunTy_maybe, tcSplitForAllTys,
+ tcGetTyVar, tcIsTyVarTy,
+
+ mkAppTy, mkTyVarTy, mkTyVarTys, mkFunTy, mkTyConApp,
+
+ liftedTypeKind, unliftedTypeKind, openTypeKind, defaultKind, superKind,
+ superBoxity, liftedBoxity, hasMoreBoxityInfo, typeKind,
+ tyVarsOfType, tyVarsOfTypes, tidyOpenType, tidyOpenTypes, tidyTyVar,
+ eqKind,
)
import Subst ( Subst, mkTopTyVarSubst, substTy )
import TyCon ( TyCon, mkPrimTyCon, isTupleTyCon, tyConArity, tupleTyConBoxity )
Just pair -> go res res (pair:ts)
Nothing -> returnNF_Tc (reverse ts, syn_t)
go syn_t (NoteTy n t) ts = go syn_t t ts
- go syn_t (TyVarTy tv) ts = tcGetTyVar tv `thenNF_Tc` \ maybe_ty ->
+ go syn_t (TyVarTy tv) ts = getTcTyVar tv `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
- Just ty | not (isTyVarTy ty) -> go syn_t ty ts
- other -> returnNF_Tc (reverse ts, syn_t)
+ Just ty | not (tcIsTyVarTy 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}
tcInstType :: TcType -> NF_TcM ([TcTyVar], TcThetaType, TcType)
tcInstType ty
- = case splitForAllTys ty of
+ = case tcSplitForAllTys ty of
([], rho) -> -- There may be overloading but no type variables;
-- (?x :: Int) => Int -> Int
let
%************************************************************************
\begin{code}
-tcPutTyVar :: TcTyVar -> TcType -> NF_TcM TcType
-tcGetTyVar :: TcTyVar -> NF_TcM (Maybe TcType)
+putTcTyVar :: TcTyVar -> TcType -> NF_TcM TcType
+getTcTyVar :: TcTyVar -> NF_TcM (Maybe TcType)
\end{code}
Putting is easy:
\begin{code}
-tcPutTyVar tyvar ty
+putTcTyVar tyvar ty
| not (isMutTyVar tyvar)
- = pprTrace "tcPutTyVar" (ppr tyvar) $
+ = pprTrace "putTcTyVar" (ppr tyvar) $
returnNF_Tc ty
| otherwise
Getting is more interesting. The easy thing to do is just to read, thus:
\begin{verbatim}
-tcGetTyVar tyvar = tcReadMutTyVar tyvar
+getTcTyVar tyvar = tcReadMutTyVar tyvar
\end{verbatim}
But it's more fun to short out indirections on the way: If this
We return Nothing iff the original box was unbound.
\begin{code}
-tcGetTyVar tyvar
+getTcTyVar tyvar
| not (isMutTyVar tyvar)
- = pprTrace "tcGetTyVar" (ppr tyvar) $
+ = pprTrace "getTcTyVar" (ppr tyvar) $
returnNF_Tc (Just (mkTyVarTy tyvar))
| otherwise
-- that is overkill, so we use this simpler chap
zonkTcSigTyVars tyvars
= zonkTcTyVars tyvars `thenNF_Tc` \ tys ->
- returnNF_Tc (map (getTyVar "zonkTcSigTyVars") tys)
+ returnNF_Tc (map (tcGetTyVar "zonkTcSigTyVars") tys)
\end{code}
----------------- Types
-- 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 `eqKind` superKind = tcPutTyVar kv liftedTypeKind
- | tyVarKind kv `eqKind` superBoxity = tcPutTyVar kv liftedBoxity
+ zonk_unbound_kind_var kv | tyVarKind kv `eqKind` superKind = putTcTyVar kv liftedTypeKind
+ | tyVarKind kv `eqKind` superBoxity = putTcTyVar kv liftedBoxity
| otherwise = pprPanic "zonkKindEnv" (ppr kv)
zonkTcTypeToType :: TcType -> NF_TcM Type
-- :Void otherwise
zonk_unbound_tyvar tv
| kind `eqKind` liftedTypeKind || kind `eqKind` openTypeKind
- = tcPutTyVar tv voidTy -- Just to avoid creating a new tycon in
+ = putTcTyVar tv voidTy -- Just to avoid creating a new tycon in
-- this vastly common case
| otherwise
- = tcPutTyVar tv (TyConApp (mk_void_tycon tv kind) [])
+ = putTcTyVar tv (TyConApp (mk_void_tycon tv kind) [])
where
kind = tyVarKind tv
immut_tv = mkTyVar (tyVarName tv) (defaultKind (tyVarKind tv))
immut_tv_ty = mkTyVarTy immut_tv
- zap tv = tcPutTyVar tv immut_tv_ty
+ zap tv = putTcTyVar tv immut_tv_ty
-- Bind the mutable version to the immutable one
in
-- If the type variable is mutable, then bind it to immut_tv_ty
go (UsageTy u ty) = go u `thenNF_Tc` \ u' ->
go ty `thenNF_Tc` \ ty' ->
- returnNF_Tc (mkUTy u' ty')
+ returnNF_Tc (UsageTy u' ty')
-- The two interesting cases!
go (TyVarTy tyvar) = zonkTyVar unbound_var_fn tyvar
returnNF_Tc (TyVarTy tyvar)
| otherwise
- = tcGetTyVar tyvar `thenNF_Tc` \ maybe_ty ->
+ = getTcTyVar tyvar `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
Nothing -> unbound_var_fn tyvar -- Mutable and unbound
Just other_ty -> zonkType unbound_var_fn other_ty -- Bound
-- for some boxity bx
unifyOpenTypeKind ty@(TyVarTy tyvar)
- = tcGetTyVar tyvar `thenNF_Tc` \ maybe_ty ->
+ = getTcTyVar tyvar `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
Just ty' -> unifyOpenTypeKind ty'
other -> unify_open_kind_help ty
-> TcM ()
uVar swapped tv1 ps_ty2 ty2
- = tcGetTyVar tv1 `thenNF_Tc` \ maybe_ty1 ->
+ = getTcTyVar tv1 `thenNF_Tc` \ maybe_ty1 ->
case maybe_ty1 of
Just ty1 | swapped -> uTys ps_ty2 ty2 ty1 ty1 -- Swap back
| otherwise -> uTys ty1 ty1 ps_ty2 ty2 -- Same order
-- Distinct type variables
-- ASSERT maybe_ty1 /= Just
| otherwise
- = tcGetTyVar tv2 `thenNF_Tc` \ maybe_ty2 ->
+ = getTcTyVar tv2 `thenNF_Tc` \ maybe_ty2 ->
case maybe_ty2 of
Just ty2' -> uUnboundVar swapped tv1 maybe_ty1 ty2' ty2'
Nothing | update_tv2
-> WARN( not (k1 `hasMoreBoxityInfo` k2), (ppr tv1 <+> ppr k1) $$ (ppr tv2 <+> ppr k2) )
- tcPutTyVar tv2 (TyVarTy tv1) `thenNF_Tc_`
+ putTcTyVar tv2 (TyVarTy tv1) `thenNF_Tc_`
returnTc ()
| otherwise
-> WARN( not (k2 `hasMoreBoxityInfo` k1), (ppr tv2 <+> ppr k2) $$ (ppr tv1 <+> ppr k1) )
- (tcPutTyVar tv1 ps_ty2 `thenNF_Tc_`
+ (putTcTyVar tv1 ps_ty2 `thenNF_Tc_`
returnTc ())
where
k1 = tyVarKind tv1
-- That's why we have this two-state occurs-check
zonkTcType ps_ty2 `thenNF_Tc` \ ps_ty2' ->
if not (tv1 `elemVarSet` tyVarsOfType ps_ty2') then
- tcPutTyVar tv1 ps_ty2' `thenNF_Tc_`
+ putTcTyVar tv1 ps_ty2' `thenNF_Tc_`
returnTc ()
else
zonkTcType non_var_ty2 `thenNF_Tc` \ non_var_ty2' ->
if not (tv1 `elemVarSet` tyVarsOfType non_var_ty2') then
-- This branch rarely succeeds, except in strange cases
-- like that in the example above
- tcPutTyVar tv1 non_var_ty2' `thenNF_Tc_`
+ putTcTyVar tv1 non_var_ty2' `thenNF_Tc_`
returnTc ()
else
failWithTcM (unifyOccurCheck tv1 ps_ty2')
-> TcM (TcType, TcType) -- otherwise return arg and result types
unifyFunTy ty@(TyVarTy tyvar)
- = tcGetTyVar tyvar `thenNF_Tc` \ maybe_ty ->
+ = getTcTyVar tyvar `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
Just ty' -> unifyFunTy ty'
other -> unify_fun_ty_help ty
-> TcM TcType -- list element type
unifyListTy ty@(TyVarTy tyvar)
- = tcGetTyVar tyvar `thenNF_Tc` \ maybe_ty ->
+ = getTcTyVar tyvar `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
Just ty' -> unifyListTy ty'
other -> unify_list_ty_help ty
\begin{code}
unifyTupleTy :: Boxity -> Arity -> TcType -> TcM [TcType]
unifyTupleTy boxity arity ty@(TyVarTy tyvar)
- = tcGetTyVar tyvar `thenNF_Tc` \ maybe_ty ->
+ = getTcTyVar tyvar `thenNF_Tc` \ maybe_ty ->
case maybe_ty of
Just ty' -> unifyTupleTy boxity arity ty'
other -> unify_tuple_ty_help boxity arity ty
PredType, mkPredTy, mkPredTys, getClassPredTys_maybe, getClassPredTys,
isPredTy, isClassPred, isTyVarClassPred, predHasFDs,
mkDictTy, tcSplitPredTy_maybe, predTyUnique,
- isDictTy, tcSplitDFunTy,
+ isDictTy, tcSplitDFunTy, predTyUnique,
mkClassPred, predMentionsIPs, inheritablePred, isIPPred, mkPredName,
---------------------------------
--------------------------------
-- Rexported from Type
- Kind, Type, SourceType(..), PredType, ThetaType,
- unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
+ Kind, -- Stuff to do with kinds is insensitive to pre/post Tc
+ unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
+ superBoxity, liftedBoxity, hasMoreBoxityInfo, defaultKind, superKind,
+
+ Type, SourceType(..), PredType, ThetaType,
mkForAllTy, mkForAllTys,
mkFunTy, mkFunTys, zipFunTys,
mkTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
- mkTyVarTy, mkTyVarTys, mkTyConTy,
- predTyUnique, mkClassPred,
+ mkTyVarTy, mkTyVarTys, mkTyConTy,
+
isUnLiftedType, -- Source types are always lifted
isUnboxedTupleType, -- Ditto
+
tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
tidyTyVar, tidyTyVars,
- eqKind, eqUsage,
+ typeKind, eqKind, eqUsage,
- -- Reexported ???
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta
) where
import {-# SOURCE #-} PprType( pprType )
-- friends:
-import TypeRep ( Type(..), TyNote(..) ) -- friend
-import Type -- Lots and lots
+import TypeRep ( Type(..), TyNote(..), funTyCon ) -- friend
+import Type ( mkUTyM, unUTy ) -- Used locally
+
+import Type ( -- Re-exports
+ tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
+ Kind, Type, TauType, SourceType(..), PredType, ThetaType,
+ unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
+ mkForAllTy, mkForAllTys, defaultKind,
+ mkFunTy, mkFunTys, zipFunTys,
+ mkTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
+ mkTyVarTy, mkTyVarTys, mkTyConTy,
+ isUnLiftedType, isUnboxedTupleType,
+ tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
+ tidyTyVar, tidyTyVars, eqKind, eqUsage,
+ hasMoreBoxityInfo, liftedBoxity, superBoxity, typeKind, superKind
+ )
import TyCon ( TyCon, isPrimTyCon, tyConArity, isNewTyCon )
import Class ( classTyCon, classHasFDs, Class )
import Var ( TyVar, tyVarKind )
isTauTy (TyConApp _ tys) = all isTauTy tys
isTauTy (AppTy a b) = isTauTy a && isTauTy b
isTauTy (FunTy a b) = isTauTy a && isTauTy b
-isTauTy (SourceTy p) = isTauTy (sourceTypeRep p)
+isTauTy (SourceTy p) = True -- Don't look through source types
isTauTy (NoteTy _ ty) = isTauTy ty
isTauTy (UsageTy _ ty) = isTauTy ty
isTauTy other = False
isClassPred (ClassP clas tys) = True
isClassPred other = False
-isTyVarClassPred (ClassP clas tys) = all isTyVarTy tys
+isTyVarClassPred (ClassP clas tys) = all tcIsTyVarTy tys
isTyVarClassPred other = False
getClassPredTys_maybe :: SourceType -> Maybe (Class, [Type])
-- Returns types that are opaque to Haskell.
-- Most of these are unlifted, but now that we interact with .NET, we
-- may have primtive (foreign-imported) types that are lifted
-isPrimitiveType ty = case splitTyConApp_maybe ty of
+isPrimitiveType ty = case tcSplitTyConApp_maybe ty of
Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
isPrimTyCon tc
other -> False