X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=cd4c4c71bc0feba06d15280771bd954bde0567fe;hb=365ab3dad0f9a77e01758a14bf3817dea0ee2a31;hp=94ea3f9b07cb78c5ed359b9583b1b8a79c2226e7;hpb=138b885a335734039daf7debb0a7dfc3dc947c00;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index 94ea3f9..cd4c4c7 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -1,4 +1,4 @@ - +% % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[TcType]{Types used in the typechecker} @@ -10,7 +10,7 @@ compiler. These parts 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} @@ -68,7 +68,7 @@ module TcType ( isClassPred, isTyVarClassPred, isEqPred, mkDictTy, tcSplitPredTy_maybe, isPredTy, isDictTy, tcSplitDFunTy, tcSplitDFunHead, predTyUnique, - mkClassPred, isInheritablePred, isLinearPred, isIPPred, mkPredName, + mkClassPred, isInheritablePred, isIPPred, mkPredName, dataConsStupidTheta, isRefineableTy, --------------------------------- @@ -186,7 +186,7 @@ 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 BasicTypes ( Arity, ipNameName ) import SrcLoc ( SrcLoc, SrcSpan ) import Util ( equalLength ) import Maybes ( maybeToBool, expectJust, mapCatMaybes ) @@ -399,6 +399,7 @@ mkKindName unique = mkSystemName unique kind_var_occ kindVarRef :: KindVar -> IORef MetaDetails kindVarRef tc = + ASSERT ( isTcTyVar tc ) case tcTyVarDetails tc of MetaTv TauTv ref -> ref other -> pprPanic "kindVarRef" (ppr tc) @@ -472,7 +473,8 @@ pprSkolTvBinding :: TcTyVar -> SDoc -- 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") @@ -696,10 +698,14 @@ tcMultiSplitSigmaTy sigma ----------------------- 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 @@ -889,10 +895,6 @@ isInheritablePred :: PredType -> Bool -- 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 ---------------------------------