X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=c10c2eb91408b11ff542f018df2e22ac6c6e147e;hb=2fff69381d951c08a42e512722c3633d9ba556d0;hp=94ea3f9b07cb78c5ed359b9583b1b8a79c2226e7;hpb=138b885a335734039daf7debb0a7dfc3dc947c00;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index 94ea3f9..c10c2eb 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -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} @@ -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") @@ -710,9 +712,17 @@ tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type]) tcSplitTyConApp_maybe ty | Just ty' <- tcView ty = tcSplitTyConApp_maybe ty' tcSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys) tcSplitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res]) +tcSplitTyConApp_maybe (AppTy arg res) = Just (funTyCon, [arg,res]) -- Newtypes are opaque, so they may be split -- However, predicates are not treated -- as tycon applications by the type checker + +-- XXX - 2006-09-24: This case is hard-coded in (rendering predicates opaque as well) +-- to make the newly reworked newtype-deriving work on the trivial case: +-- newtype T = T () deriving (Eq, Ord) +-- Please remove this if the newtype-deriving scheme no longer produces a PredTy. +tcSplitTyConApp_maybe (PredTy (ClassP _ [ty'])) = tcSplitTyConApp_maybe ty' + tcSplitTyConApp_maybe other = Nothing -----------------------