X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=95d8deb964b590403e3cce26edff420a85b4a41c;hp=625f855f4cba0c61481aeb2a562b721c345b08a0;hb=4c6a3f787abcaed009a574196d82237d9ae64fc8;hpb=bdaf685ced63faab7353717c01999e582efb4e37 diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index 625f855..95d8deb 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -165,6 +165,7 @@ import Util import Maybes import ListSetOps import Outputable +import FastString import Data.List import Data.IORef @@ -670,9 +671,7 @@ tcSplitPhiTy ty = split ty ty [] split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs split orig_ty (ForAllTy tv ty) ts - | isCoVar tv = split ty ty (eq_pred:ts) - where - PredTy eq_pred = tyVarKind tv + | isCoVar tv = split ty ty (coVarPred tv : ts) split orig_ty (FunTy arg res) ts | Just p <- tcSplitPredTy_maybe arg = split res res (p:ts) split orig_ty ty ts = (reverse ts, orig_ty) @@ -814,7 +813,6 @@ tcInstHeadTyNotSynonym :: Type -> Bool -- are transparent, so we need a special function here tcInstHeadTyNotSynonym ty = case ty of - NoteTy _ ty -> tcInstHeadTyNotSynonym ty TyConApp tc tys -> not (isSynTyCon tc) _ -> True @@ -823,7 +821,6 @@ tcInstHeadTyAppAllTyVars :: Type -> Bool -- These must be a constructor applied to type variable arguments tcInstHeadTyAppAllTyVars ty = case ty of - NoteTy _ ty -> tcInstHeadTyAppAllTyVars ty TyConApp _ tys -> ok tys FunTy arg res -> ok [arg, res] other -> False @@ -834,7 +831,6 @@ tcInstHeadTyAppAllTyVars ty where tvs = mapCatMaybes get_tv tys - get_tv (NoteTy _ ty) = get_tv ty -- Again, do not look get_tv (TyVarTy tv) = Just tv -- through synonyms get_tv other = Nothing \end{code} @@ -1022,7 +1018,6 @@ tcTyVarsOfType :: Type -> TcTyVarSet tcTyVarsOfType (TyVarTy tv) = if isTcTyVar tv then unitVarSet tv else emptyVarSet tcTyVarsOfType (TyConApp tycon tys) = tcTyVarsOfTypes tys -tcTyVarsOfType (NoteTy _ ty) = tcTyVarsOfType ty tcTyVarsOfType (PredTy sty) = tcTyVarsOfPred sty tcTyVarsOfType (FunTy arg res) = tcTyVarsOfType arg `unionVarSet` tcTyVarsOfType res tcTyVarsOfType (AppTy fun arg) = tcTyVarsOfType fun `unionVarSet` tcTyVarsOfType arg @@ -1086,7 +1081,6 @@ exactTyVarsOfType ty go (AppTy fun arg) = go fun `unionVarSet` go arg go (ForAllTy tyvar ty) = delVarSet (go ty) tyvar `unionVarSet` go_tv tyvar - go (NoteTy _ _) = panic "exactTyVarsOfType" -- Handled by tcView go_pred (IParam _ ty) = go ty go_pred (ClassP _ tys) = exactTyVarsOfTypes tys @@ -1106,7 +1100,6 @@ end of the compiler. tyClsNamesOfType :: Type -> NameSet tyClsNamesOfType (TyVarTy tv) = emptyNameSet tyClsNamesOfType (TyConApp tycon tys) = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys -tyClsNamesOfType (NoteTy _ ty2) = tyClsNamesOfType ty2 tyClsNamesOfType (PredTy (IParam n ty)) = tyClsNamesOfType ty tyClsNamesOfType (PredTy (ClassP cl tys)) = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys tyClsNamesOfType (PredTy (EqPred ty1 ty2)) = tyClsNamesOfType ty1 `unionNameSets` tyClsNamesOfType ty2