-
+%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[TcType]{Types used in the typechecker}
newtypes, and predicates are meaningful.
* look through usage types
-The "tc" prefix is for "typechechecker", because the type checker
+The "tc" prefix is for "TypeChecker", because the type checker
is the principal client.
\begin{code}
isClassPred, isTyVarClassPred, isEqPred,
mkDictTy, tcSplitPredTy_maybe,
isPredTy, isDictTy, tcSplitDFunTy, tcSplitDFunHead, predTyUnique,
- mkClassPred, isInheritablePred, isLinearPred, isIPPred, mkPredName,
+ mkClassPred, isInheritablePred, isIPPred, mkPredName,
dataConsStupidTheta, isRefineableTy,
---------------------------------
#include "HsVersions.h"
-- friends:
-import TypeRep ( Type(..), funTyCon, Kind ) -- friend
-
-import Type ( -- Re-exports
- tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
- tyVarsOfTheta, Kind, PredType(..), KindVar,
- ThetaType, isUnliftedTypeKind, unliftedTypeKind,
- argTypeKind,
- liftedTypeKind, openTypeKind, mkArrowKind,
- tySuperKind, isLiftedTypeKind,
- mkArrowKinds, mkForAllTy, mkForAllTys,
- defaultKind, isSubArgTypeKind, isSubOpenTypeKind,
- mkFunTy, mkFunTys, zipFunTys,
- mkTyConApp, mkAppTy,
- mkAppTys, applyTy, applyTys,
- mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy,
- mkPredTys, isUnLiftedType,
- isUnboxedTupleType, isPrimitiveType,
- splitTyConApp_maybe,
- tidyTopType, tidyType, tidyPred, tidyTypes,
- tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
- tidyTyVarBndr, tidyOpenTyVar,
- tidyOpenTyVars, tidyKind,
- isSubKind, tcView,
-
- tcEqType, tcEqTypes, tcCmpType, tcCmpTypes,
- tcEqPred, tcCmpPred, tcEqTypeX, eqKind,
-
- TvSubst(..),
- TvSubstEnv, emptyTvSubst, mkTvSubst, zipTyEnv,
- mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst,
- getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
- extendTvSubst, extendTvSubstList, isInScope, notElemTvSubst,
- substTy, substTys, substTyWith, substTheta,
- substTyVar, substTyVarBndr, substPred, lookupTyVar,
-
- typeKind, repType, coreView, repSplitAppTy_maybe,
- pprKind, pprParendKind,
- pprType, pprParendType, pprTyThingCategory,
- pprPred, pprTheta, pprThetaArrow, pprClassPred
- )
-import TyCon ( TyCon, isUnLiftedTyCon, isSynTyCon, isOpenTyCon,
- synTyConDefn, tyConUnique )
-import DataCon ( DataCon, dataConStupidTheta, dataConResTys )
-import Class ( Class )
-import Var ( TyVar, Id, isCoVar, isTcTyVar, mkTcTyVar, tyVarName, tyVarKind, tcTyVarDetails )
-import ForeignCall ( Safety, DNType(..) )
-import Unify ( tcMatchTys )
+import TypeRep
+import DataCon
+import Class
+import Var
+import ForeignCall
+import Unify
import VarSet
+import Type
+import TyCon
-- others:
-import DynFlags ( DynFlags, DynFlag( Opt_GlasgowExts ), dopt )
-import Name ( Name, NamedThing(..), mkInternalName, getSrcLoc, mkSystemName )
+import DynFlags
+import Name
import NameSet
-import VarEnv ( TidyEnv )
-import OccName ( OccName, mkDictOcc, mkOccName, tvName )
-import PrelNames -- Lots (e.g. in isFFIArgumentTy)
-import TysWiredIn ( unitTyCon, charTyCon, listTyCon )
-import BasicTypes ( IPName(..), Arity, ipNameName )
-import SrcLoc ( SrcLoc, SrcSpan )
-import Util ( equalLength )
-import Maybes ( maybeToBool, expectJust, mapCatMaybes )
-import ListSetOps ( hasNoDups )
-import List ( nubBy )
+import VarEnv
+import OccName
+import PrelNames
+import TysWiredIn
+import BasicTypes
+import SrcLoc
+import Util
+import Maybes
+import ListSetOps
import Outputable
-import DATA_IOREF
+
+import Data.List
+import Data.IORef
\end{code}
kindVarRef :: KindVar -> IORef MetaDetails
kindVarRef tc =
+ ASSERT ( isTcTyVar tc )
case tcTyVarDetails tc of
MetaTv TauTv ref -> ref
other -> pprPanic "kindVarRef" (ppr tc)
-- Print info about the binding of a skolem tyvar,
-- or nothing if we don't have anything useful to say
pprSkolTvBinding tv
- = ppr_details (tcTyVarDetails tv)
+ = ASSERT ( isTcTyVar tv )
+ ppr_details (tcTyVarDetails tv)
where
ppr_details (MetaTv TauTv _) = quotes (ppr tv) <+> ptext SLIT("is a meta type variable")
ppr_details (MetaTv BoxTv _) = quotes (ppr tv) <+> ptext SLIT("is a boxy type variable")
-----------------------
tcTyConAppTyCon :: Type -> TyCon
-tcTyConAppTyCon ty = fst (tcSplitTyConApp ty)
+tcTyConAppTyCon ty = case tcSplitTyConApp_maybe ty of
+ Just (tc, _) -> tc
+ Nothing -> pprPanic "tcTyConAppTyCon" (pprType ty)
tcTyConAppArgs :: Type -> [Type]
-tcTyConAppArgs ty = snd (tcSplitTyConApp ty)
+tcTyConAppArgs ty = case tcSplitTyConApp_maybe ty of
+ Just (_, args) -> args
+ Nothing -> pprPanic "tcTyConAppArgs" (pprType ty)
tcSplitTyConApp :: Type -> (TyCon, [Type])
tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
getClassPredTys (ClassP clas tys) = (clas, tys)
getClassPredTys other = panic "getClassPredTys"
-isEqPred :: PredType -> Bool
-isEqPred (EqPred {}) = True
-isEqPred _ = False
-
mkDictTy :: Class -> [Type] -> Type
mkDictTy clas tys = mkPredTy (ClassP clas tys)
-- which can be free in g's rhs, and shared by both calls to g
isInheritablePred (ClassP _ _) = True
isInheritablePred other = False
-
-isLinearPred :: TcPredType -> Bool
-isLinearPred (IParam (Linear n) _) = True
-isLinearPred other = False
\end{code}
--------------------- Equality predicates ---------------------------------