X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcType.lhs;h=218d8df6d57579cd1ac3e0be9db9c4e33070860b;hb=92342d8911151aef493e20ad264ea2afde1f591b;hp=a53daf52fde36341314890b137d3bd6c53006312;hpb=da95f4a039f7bc12b625338353df8399dec41c5e;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs index a53daf5..218d8df 100644 --- a/ghc/compiler/typecheck/TcType.lhs +++ b/ghc/compiler/typecheck/TcType.lhs @@ -24,7 +24,7 @@ module TcType ( -- MetaDetails TcTyVarDetails(..), MetaDetails(Flexi, Indirect), SkolemInfo(..), pprSkolemTyVar, - isImmutableTyVar, isSkolemTyVar, isMetaTyVar, skolemTvInfo, metaTvRef, + isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isExistentialTyVar, skolemTvInfo, metaTvRef, isFlexi, isIndirect, -------------------------------- @@ -38,7 +38,7 @@ module TcType ( tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs, tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, tcSplitSigmaTy, - tcSplitMethodTy, tcGetTyVar_maybe, tcGetTyVar, + tcGetTyVar_maybe, tcGetTyVar, --------------------------------- -- Predicates. @@ -290,7 +290,7 @@ instance Outputable MetaDetails where ppr Flexi = ptext SLIT("Flexi") ppr (Indirect ty) = ptext SLIT("Indirect") <+> ppr ty -isImmutableTyVar, isSkolemTyVar, isMetaTyVar :: TyVar -> Bool +isImmutableTyVar, isSkolemTyVar, isExistentialTyVar, isMetaTyVar :: TyVar -> Bool isImmutableTyVar tv | isTcTyVar tv = isSkolemTyVar tv | otherwise = True @@ -301,6 +301,12 @@ isSkolemTyVar tv SkolemTv _ -> True MetaTv _ -> False +isExistentialTyVar tv -- Existential type variable, bound by a pattern + = ASSERT( isTcTyVar tv ) + case tcTyVarDetails tv of + SkolemTv (PatSkol _ _) -> True + other -> False + isMetaTyVar tv = ASSERT( isTcTyVar tv ) case tcTyVarDetails tv of @@ -347,7 +353,6 @@ mkPhiTy theta ty = foldr (\p r -> FunTy (mkPredTy p) r) ty theta isTauTy :: Type -> Bool isTauTy (TyVarTy v) = True isTauTy (TyConApp _ tys) = all isTauTy tys -isTauTy (NewTcApp _ tys) = all isTauTy tys isTauTy (AppTy a b) = isTauTy a && isTauTy b isTauTy (FunTy a b) = isTauTy a && isTauTy b isTauTy (PredTy p) = True -- Don't look through source types @@ -360,7 +365,6 @@ getDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to -- construct a dictionary function name getDFunTyKey (TyVarTy tv) = getOccName tv getDFunTyKey (TyConApp tc _) = getOccName tc -getDFunTyKey (NewTcApp tc _) = getOccName tc getDFunTyKey (AppTy fun _) = getDFunTyKey fun getDFunTyKey (NoteTy _ t) = getDFunTyKey t getDFunTyKey (FunTy arg _) = getOccName funTyCon @@ -422,7 +426,6 @@ tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type]) tcSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys) -tcSplitTyConApp_maybe (NewTcApp tc tys) = Just (tc, tys) tcSplitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res]) tcSplitTyConApp_maybe (NoteTy n ty) = tcSplitTyConApp_maybe ty -- Newtypes are opaque, so they may be split @@ -453,9 +456,6 @@ tcSplitAppTy_maybe (NoteTy n ty) = tcSplitAppTy_maybe ty tcSplitAppTy_maybe (TyConApp tc tys) = case snocView tys of Just (tys', ty') -> Just (TyConApp tc tys', ty') Nothing -> Nothing -tcSplitAppTy_maybe (NewTcApp tc tys) = case snocView tys of - Just (tys', ty') -> Just (NewTcApp tc tys', ty') - Nothing -> Nothing tcSplitAppTy_maybe other = Nothing tcSplitAppTy ty = case tcSplitAppTy_maybe ty of @@ -480,24 +480,6 @@ tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty) tcIsTyVarTy :: Type -> Bool tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty) -\end{code} - -The type of a method for class C is always of the form: - Forall a1..an. C a1..an => sig_ty -where sig_ty is the type given by the method's signature, and thus in general -is a ForallTy. At the point that splitMethodTy is called, it is expected -that the outer Forall has already been stripped off. splitMethodTy then -returns (C a1..an, sig_ty') where sig_ty' is sig_ty with any Notes stripped off. - -\begin{code} -tcSplitMethodTy :: Type -> (PredType, Type) -tcSplitMethodTy ty = split ty - where - split (FunTy arg res) = case tcSplitPredTy_maybe arg of - Just p -> (p, res) - Nothing -> panic "splitMethodTy" - split (NoteTy n ty) = split ty - split _ = panic "splitMethodTy" tcSplitDFunTy :: Type -> ([TyVar], [PredType], Class, [Type]) -- Split the type of a dictionary function @@ -632,10 +614,9 @@ cmpTy env (PredTy p1) (PredTy p2) = cmpPredTy env p1 p2 cmpTy env (AppTy f1 a1) (AppTy f2 a2) = cmpTy env f1 f2 `thenCmp` cmpTy env a1 a2 cmpTy env (FunTy f1 a1) (FunTy f2 a2) = cmpTy env f1 f2 `thenCmp` cmpTy env a1 a2 cmpTy env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` (cmpTys env tys1 tys2) -cmpTy env (NewTcApp tc1 tys1) (NewTcApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` (cmpTys env tys1 tys2) cmpTy env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = cmpTy (extendVarEnv env tv1 tv2) t1 t2 - -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < NewTcApp < ForAllTy < PredTy + -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy < PredTy cmpTy env (AppTy _ _) (TyVarTy _) = GT cmpTy env (FunTy _ _) (TyVarTy _) = GT @@ -645,16 +626,10 @@ cmpTy env (TyConApp _ _) (TyVarTy _) = GT cmpTy env (TyConApp _ _) (AppTy _ _) = GT cmpTy env (TyConApp _ _) (FunTy _ _) = GT -cmpTy env (NewTcApp _ _) (TyVarTy _) = GT -cmpTy env (NewTcApp _ _) (AppTy _ _) = GT -cmpTy env (NewTcApp _ _) (FunTy _ _) = GT -cmpTy env (NewTcApp _ _) (TyConApp _ _) = GT - cmpTy env (ForAllTy _ _) (TyVarTy _) = GT cmpTy env (ForAllTy _ _) (AppTy _ _) = GT cmpTy env (ForAllTy _ _) (FunTy _ _) = GT cmpTy env (ForAllTy _ _) (TyConApp _ _) = GT -cmpTy env (ForAllTy _ _) (NewTcApp _ _) = GT cmpTy env (PredTy _) t2 = GT @@ -739,7 +714,6 @@ deNoteType :: Type -> Type -- Remove synonyms, but not predicate types deNoteType ty@(TyVarTy tyvar) = ty deNoteType (TyConApp tycon tys) = TyConApp tycon (map deNoteType tys) -deNoteType (NewTcApp tycon tys) = NewTcApp tycon (map deNoteType tys) deNoteType (PredTy p) = PredTy (deNotePredType p) deNoteType (NoteTy _ ty) = deNoteType ty deNoteType (AppTy fun arg) = AppTy (deNoteType fun) (deNoteType arg) @@ -758,7 +732,6 @@ end of the compiler. tyClsNamesOfType :: Type -> NameSet tyClsNamesOfType (TyVarTy tv) = emptyNameSet tyClsNamesOfType (TyConApp tycon tys) = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys -tyClsNamesOfType (NewTcApp tycon tys) = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys tyClsNamesOfType (NoteTy (SynNote ty1) ty2) = tyClsNamesOfType ty1 tyClsNamesOfType (NoteTy other_note ty2) = tyClsNamesOfType ty2 tyClsNamesOfType (PredTy (IParam n ty)) = tyClsNamesOfType ty