From 467f588c25e6d7825a11eff018a67727b3dea71b Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sat, 15 Mar 2008 19:42:20 +0000 Subject: [PATCH] Remove leftover NoteTy/FTVNote bits --- compiler/codeGen/ClosureInfo.lhs | 1 - compiler/coreSyn/MkExternalCore.lhs | 1 - compiler/iface/IfaceType.lhs | 2 -- compiler/ilxGen/IlxGen.lhs | 16 +--------------- compiler/typecheck/TcMType.lhs | 8 -------- compiler/typecheck/TcSplice.lhs | 1 - compiler/typecheck/TcTyDecls.lhs | 1 - compiler/typecheck/TcTyFuns.lhs | 4 ---- compiler/typecheck/TcType.lhs | 6 ------ compiler/typecheck/TcUnify.lhs | 1 - compiler/types/Coercion.lhs | 7 +------ compiler/types/FamInstEnv.lhs | 3 --- compiler/types/Type.lhs | 22 ---------------------- compiler/types/TypeRep.lhs | 20 ++------------------ 14 files changed, 4 insertions(+), 89 deletions(-) diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs index 0746ba9..37b3a58 100644 --- a/compiler/codeGen/ClosureInfo.lhs +++ b/compiler/codeGen/ClosureInfo.lhs @@ -978,7 +978,6 @@ getTyDescription ty AppTy fun _ -> getTyDescription fun FunTy _ res -> '-' : '>' : fun_result res TyConApp tycon _ -> getOccString tycon - NoteTy (FTVNote _) ty -> getTyDescription ty PredTy sty -> getPredTyDescription sty ForAllTy _ ty -> getTyDescription ty } diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs index 4fa8218..78008e1 100644 --- a/compiler/coreSyn/MkExternalCore.lhs +++ b/compiler/coreSyn/MkExternalCore.lhs @@ -177,7 +177,6 @@ make_ty (TyConApp tc ts) = foldl C.Tapp (C.Tcon (make_con_qid (tyConName tc))) -- Maybe CoreTidy should know whether to expand newtypes or not? make_ty (PredTy p) = make_ty (predTypeRep p) -make_ty (NoteTy _ t) = make_ty t diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs index 5528a1b..93de8e6 100644 --- a/compiler/iface/IfaceType.lhs +++ b/compiler/iface/IfaceType.lhs @@ -297,8 +297,6 @@ toIfaceType (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t) toIfaceType (PredTy st) = IfacePredTy (toIfacePred st) -toIfaceType (NoteTy other_note ty) = - toIfaceType ty ---------------- -- A little bit of (perhaps optional) trickiness here. When diff --git a/compiler/ilxGen/IlxGen.lhs b/compiler/ilxGen/IlxGen.lhs index ea579f1..cf36eb8 100644 --- a/compiler/ilxGen/IlxGen.lhs +++ b/compiler/ilxGen/IlxGen.lhs @@ -186,7 +186,6 @@ importsType2 env (TyVarTy _) = importsNone importsType2 env (TyConApp tc args) =importsTyCon env tc . importsTypeArgs2 env args importsType2 env (FunTy arg res) = importsType env arg . importsType2 env res importsType2 env (ForAllTy tv body_ty) = importsType2 env body_ty -importsType2 env (NoteTy _ ty) = importsType2 env ty importsType2 _ _ = panic "IlxGen.lhs: importsType2 ty" importsTypeArgs2 env tys = foldR (importsType2 env) tys @@ -211,7 +210,6 @@ importsTyConDataConType2 env (TyVarTy _) = importsNone importsTyConDataConType2 env (TyConApp tc args) = importsTyConDataConTypeTyCon env tc . importsTyConDataConTypeArgs2 env args importsTyConDataConType2 env (FunTy arg res) = importsTyConDataConType env arg . importsTyConDataConType2 env res importsTyConDataConType2 env (ForAllTy tv body_ty) = importsTyConDataConType2 env body_ty -importsTyConDataConType2 env (NoteTy _ ty) = importsTyConDataConType2 env ty importsTyConDataConType2 _ _ = panic "IlxGen.lhs: importsTyConDataConType2 ty" importsTyConDataConTypeArgs2 env tys = foldR (importsTyConDataConType2 env) tys @@ -841,8 +839,6 @@ ilxFunAppArgs env num_sofar funty args tail_call known_clo -- This part strips off at most "max" term applications or one type application get_type_args 0 args env funty = ([],[],env,args,funty) - get_type_args max args env (NoteTy _ ty) = - trace "IlxGen Internal Error: non representation type passed to get_args" (get_type_args max args env ty) get_type_args max ((arg@(StgTypeArg v)):rest) env (ForAllTy tv rem_funty) = if isIlxTyVar tv then let env2 = extendIlxEnvWithFormalTyVars env [tv] in @@ -855,9 +851,6 @@ ilxFunAppArgs env num_sofar funty args tail_call known_clo get_type_args _ (StgTypeArg _:_) _ _ = trace "IlxGen Internal Error: get_type_args could not get ForAllTy for corresponding arg" ([],[],env,[],funty) get_type_args _ args env funty = ([],[],env,args,funty) - get_term_args n max args env (NoteTy _ ty) - -- Skip NoteTy types - = trace "IlxGen Internal Error: non representation type passed to get_term_args" (get_term_args n max args env ty) get_term_args n 0 args env funty -- Stop if we've hit the maximum number of ILX arguments to apply n one hit. = ([],[],env,args,funty) @@ -1146,7 +1139,6 @@ pprIlxTopVar env v \begin{code} -isVoidIlxRepType (NoteTy _ ty) = isVoidIlxRepType ty isVoidIlxRepType (TyConApp tc _) | (tyConPrimRep tc == VoidRep) = True isVoidIlxRepType (TyConApp tc tys) = isUnboxedTupleTyCon tc && null (filter (not. isVoidIlxRepType) tys) @@ -1156,7 +1148,7 @@ isVoidIlxRepId id = isVoidIlxRepType (idType id) --- Get rid of all NoteTy and NewTy artifacts +-- Get rid of all NewTy artifacts deepIlxRepType :: Type -> Type deepIlxRepType (FunTy l r) = FunTy (deepIlxRepType l) (deepIlxRepType r) @@ -1173,7 +1165,6 @@ deepIlxRepType ty@(TyConApp tc tys) TyConApp tc (map deepIlxRepType tys) deepIlxRepType (AppTy f x) = AppTy (deepIlxRepType f) (deepIlxRepType x) deepIlxRepType (ForAllTy b ty) = ForAllTy b (deepIlxRepType ty) -deepIlxRepType (NoteTy _ ty) = deepIlxRepType ty deepIlxRepType (PredTy p) = deepIlxRepType (predTypeRep p) deepIlxRepType ty@(TyVarTy tv) = ty @@ -1227,11 +1218,6 @@ ilxTypeR env ty@(ForAllTy tv body_ty) | otherwise = ilxComment (text "higher order type var " <+> pprId tv) <+> pprIlxFunTy (text "class [mscorlib]System.Object") (ilxTypeR env body_ty) -ilxTypeR env (NoteTy _ ty) - = trace "WARNING! non-representation type given to ilxTypeR: see generated ILX for context where this occurs" - (vcat [text "/* WARNING! non-representation type given to ilxTypeR! */", - ilxTypeR env ty ]) - pprIlxFunTy dom ran = parens (hsep [text "func",parens dom,text "-->", ran]) ilxTyConApp env tcon args = diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs index 2edfdb0..4cd966f 100644 --- a/compiler/typecheck/TcMType.lhs +++ b/compiler/typecheck/TcMType.lhs @@ -222,7 +222,6 @@ checkTauTvUpdate orig_tv orig_ty | isSynTyCon tc = go_syn tc tys | otherwise = do { tys' <- mapM go tys ; return $ occurs (TyConApp tc) tys' } - go (NoteTy _ ty2) = go ty2 -- Discard free-tyvar annotations go (PredTy p) = do { p' <- go_pred p ; return $ occurs1 PredTy p' } go (FunTy arg res) = do { arg' <- go arg @@ -888,8 +887,6 @@ zonkType :: (TcTyVar -> TcM Type) -- What to do with unbound mutable type varia zonkType unbound_var_fn ty = go ty where - go (NoteTy _ ty2) = go ty2 -- Discard free-tyvar annotations - go (TyConApp tc tys) = do tys' <- mapM go tys return (TyConApp tc tys') @@ -1112,9 +1109,6 @@ check_type rank ubx_tup (AppTy ty1 ty2) = do { check_arg_type rank ty1 ; check_arg_type rank ty2 } -check_type rank ubx_tup (NoteTy other_note ty) - = check_type rank ubx_tup ty - check_type rank ubx_tup ty@(TyConApp tc tys) | isSynTyCon tc = do { -- Check that the synonym has enough args @@ -1754,7 +1748,6 @@ fvType :: Type -> [TyVar] fvType ty | Just exp_ty <- tcView ty = fvType exp_ty fvType (TyVarTy tv) = [tv] fvType (TyConApp _ tys) = fvTypes tys -fvType (NoteTy _ ty) = fvType ty fvType (PredTy pred) = fvPred pred fvType (FunTy arg res) = fvType arg ++ fvType res fvType (AppTy fun arg) = fvType fun ++ fvType arg @@ -1773,7 +1766,6 @@ sizeType :: Type -> Int sizeType ty | Just exp_ty <- tcView ty = sizeType exp_ty sizeType (TyVarTy _) = 1 sizeType (TyConApp _ tys) = sizeTypes tys + 1 -sizeType (NoteTy _ ty) = sizeType ty sizeType (PredTy pred) = sizePred pred sizeType (FunTy arg res) = sizeType arg + sizeType res + 1 sizeType (AppTy fun arg) = sizeType fun + sizeType arg diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 48cec19..5ea37da 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -872,7 +872,6 @@ reifyClass cls reifyType :: TypeRep.Type -> TcM TH.Type reifyType (TyVarTy tv) = return (TH.VarT (reifyName tv)) reifyType (TyConApp tc tys) = reify_tc_app (reifyName tc) tys -reifyType (NoteTy _ ty) = reifyType ty reifyType (AppTy t1 t2) = do { [r1,r2] <- reifyTypes [t1,t2] ; return (r1 `TH.AppT` r2) } reifyType (FunTy t1 t2) = do { [r1,r2] <- reifyTypes [t1,t2] ; return (TH.ArrowT `TH.AppT` r1 `TH.AppT` r2) } reifyType ty@(ForAllTy _ _) = do { cxt' <- reifyCxt cxt; diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs index de22c63..956f944 100644 --- a/compiler/typecheck/TcTyDecls.lhs +++ b/compiler/typecheck/TcTyDecls.lhs @@ -99,7 +99,6 @@ synTyConsOfType ty go (FunTy a b) = go a `plusNameEnv` go b go (PredTy (IParam _ ty)) = go ty go (PredTy (ClassP cls tys)) = go_s tys -- Ignore class - go (NoteTy _ ty) = go ty go (ForAllTy _ ty) = go ty go_tc tc tys | isSynTyCon tc = extendNameEnv (go_s tys) (tyConName tc) tc diff --git a/compiler/typecheck/TcTyFuns.lhs b/compiler/typecheck/TcTyFuns.lhs index 3bd5fb6..36ff1bb 100644 --- a/compiler/typecheck/TcTyFuns.lhs +++ b/compiler/typecheck/TcTyFuns.lhs @@ -229,10 +229,6 @@ tcGenericNormaliseFamInst fun (ForAllTy tyvar ty1) = do { (coi,nty1) <- tcGenericNormaliseFamInst fun ty1 ; return (mkForAllTyCoI tyvar coi, mkForAllTy tyvar nty1) } -tcGenericNormaliseFamInst fun (NoteTy note ty1) - = do { (coi,nty1) <- tcGenericNormaliseFamInst fun ty1 - ; return (coi, NoteTy note nty1) - } tcGenericNormaliseFamInst fun ty@(TyVarTy tv) | isTcTyVar tv = do { traceTc (text "tcGenericNormaliseFamInst" <+> ppr ty) diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index 165018d..c263660 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -812,7 +812,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 @@ -821,7 +820,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 @@ -832,7 +830,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} @@ -1020,7 +1017,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 @@ -1084,7 +1080,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 @@ -1104,7 +1099,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 diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index 86928b7..7ce2fca 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -1637,7 +1637,6 @@ unBox :: BoxyType -> TcM TcType -- -- For once, it's safe to treat synonyms as opaque! -unBox (NoteTy n ty) = do { ty' <- unBox ty; return (NoteTy n ty') } unBox (TyConApp tc tys) = do { tys' <- mapM unBox tys; return (TyConApp tc tys') } unBox (AppTy f a) = do { f' <- unBox f; a' <- unBox a; return (mkAppTy f' a') } unBox (FunTy f a) = do { f' <- unBox f; a' <- unBox a; return (FunTy f' a') } diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index 756026b..9ebd00e 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -50,7 +50,7 @@ module Coercion ( isIdentityCoercion, mkSymCoI, mkTransCoI, mkTyConAppCoI, mkAppTyCoI, mkFunTyCoI, - mkNoteTyCoI, mkForAllTyCoI, + mkForAllTyCoI, fromCoI, fromACo, mkClassPPredCoI, mkIParamPredCoI, mkEqPredCoI @@ -145,7 +145,6 @@ coercionKind (FunTy ty1 ty2) coercionKind (ForAllTy tv ty) = let (ty1, ty2) = coercionKind ty in (ForAllTy tv ty1, ForAllTy tv ty2) -coercionKind (NoteTy _ ty) = coercionKind ty coercionKind (PredTy (EqPred c1 c2)) = let k1 = coercionKindPredTy c1 k2 = coercionKindPredTy c2 in @@ -544,10 +543,6 @@ mkFunTyCoI _ IdCo _ IdCo = IdCo mkFunTyCoI ty1 coi1 ty2 coi2 = ACo $ FunTy (fromCoI coi1 ty1) (fromCoI coi2 ty2) -mkNoteTyCoI :: TyNote -> CoercionI -> CoercionI -mkNoteTyCoI _ IdCo = IdCo -mkNoteTyCoI note (ACo co) = ACo $ NoteTy note co - mkForAllTyCoI :: TyVar -> CoercionI -> CoercionI mkForAllTyCoI _ IdCo = IdCo mkForAllTyCoI tv (ACo co) = ACo $ ForAllTy tv co diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs index f442e02..3bfe55d 100644 --- a/compiler/types/FamInstEnv.lhs +++ b/compiler/types/FamInstEnv.lhs @@ -428,9 +428,6 @@ normaliseType env (FunTy ty1 ty2) normaliseType env (ForAllTy tyvar ty1) = let (coi,nty1) = normaliseType env ty1 in (mkForAllTyCoI tyvar coi,ForAllTy tyvar nty1) -normaliseType env (NoteTy note ty1) - = let (coi,nty1) = normaliseType env ty1 - in (coi,NoteTy note nty1) normaliseType _ ty@(TyVarTy _) = (IdCo,ty) normaliseType env (PredTy predty) diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index bddcdd1..67b58a37 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -130,7 +130,6 @@ import TyCon import StaticFlags import Util import Outputable -import UniqSet import Data.List import Data.Maybe ( isJust ) @@ -167,7 +166,6 @@ coreView :: Type -> Maybe Type -- By being non-recursive and inlined, this case analysis gets efficiently -- joined onto the case analysis that the caller is already doing -coreView (NoteTy _ ty) = Just ty coreView (PredTy p) | isEqPred p = Nothing | otherwise = Just (predTypeRep p) @@ -184,7 +182,6 @@ coreView _ = Nothing {-# INLINE tcView #-} tcView :: Type -> Maybe Type -- Same, but for the type checker, which just looks through synonyms -tcView (NoteTy _ ty) = Just ty tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys') tcView _ = Nothing @@ -193,9 +190,7 @@ tcView _ = Nothing rttiView :: Type -> Type -- Same, but for the RTTI system, which cannot deal with predicates nor polymorphism rttiView (ForAllTy _ ty) = rttiView ty -rttiView (NoteTy _ ty) = rttiView ty rttiView (FunTy PredTy{} ty) = rttiView ty -rttiView (FunTy NoteTy{} ty) = rttiView ty rttiView ty@TyConApp{} | Just ty' <- coreView ty = rttiView ty' rttiView (TyConApp tc tys) = mkTyConApp tc (map rttiView tys) @@ -206,7 +201,6 @@ rttiView ty = ty kindView :: Kind -> Maybe Kind -- C.f. coreView, tcView -- For the moment, we don't even handle synonyms in kinds -kindView (NoteTy _ k) = Just k kindView _ = Nothing \end{code} @@ -256,7 +250,6 @@ mkAppTy :: Type -> Type -> Type mkAppTy orig_ty1 orig_ty2 = mk_app orig_ty1 where - mk_app (NoteTy _ ty1) = mk_app ty1 mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ [orig_ty2]) mk_app _ = AppTy orig_ty1 orig_ty2 -- Note that the TyConApp could be an @@ -278,7 +271,6 @@ mkAppTys orig_ty1 [] = orig_ty1 mkAppTys orig_ty1 orig_tys2 = mk_app orig_ty1 where - mk_app (NoteTy _ ty1) = mk_app ty1 mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2) -- mkTyConApp: see notes with mkAppTy mk_app _ = foldl AppTy orig_ty1 orig_tys2 @@ -560,7 +552,6 @@ mkForAllTys :: [TyVar] -> Type -> Type mkForAllTys tyvars ty = foldr ForAllTy ty tyvars isForAllTy :: Type -> Bool -isForAllTy (NoteTy _ ty) = isForAllTy ty isForAllTy (ForAllTy _ _) = True isForAllTy _ = False @@ -701,7 +692,6 @@ typeKind (TyConApp tycon tys) = ASSERT( not (isCoercionTyCon tycon) ) -- We should be looking for the coercion kind, -- not the type kind foldr (\_ k -> kindFunResult k) (tyConKind tycon) tys -typeKind (NoteTy _ ty) = typeKind ty typeKind (PredTy pred) = predKind pred typeKind (AppTy fun _) = kindFunResult (typeKind fun) typeKind (ForAllTy _ ty) = typeKind ty @@ -732,7 +722,6 @@ tyVarsOfType :: Type -> TyVarSet -- NB: for type synonyms tyVarsOfType does *not* expand the synonym tyVarsOfType (TyVarTy tv) = unitVarSet tv tyVarsOfType (TyConApp _ tys) = tyVarsOfTypes tys -tyVarsOfType (NoteTy (FTVNote tvs) _) = tvs tyVarsOfType (PredTy sty) = tyVarsOfPred sty tyVarsOfType (FunTy arg res) = tyVarsOfType arg `unionVarSet` tyVarsOfType res tyVarsOfType (AppTy fun arg) = tyVarsOfType fun `unionVarSet` tyVarsOfType arg @@ -824,7 +813,6 @@ tidyType env@(_, subst) ty Just tv' -> TyVarTy tv' go (TyConApp tycon tys) = let args = map go tys in args `seqList` TyConApp tycon args - go (NoteTy note ty) = (NoteTy $! (go_note note)) $! (go ty) go (PredTy sty) = PredTy (tidyPred env sty) go (AppTy fun arg) = (AppTy $! (go fun)) $! (go arg) go (FunTy fun arg) = (FunTy $! (go fun)) $! (go arg) @@ -832,8 +820,6 @@ tidyType env@(_, subst) ty where (envp, tvp) = tidyTyVarBndr env tv - go_note note@(FTVNote _ftvs) = note -- No need to tidy the free tyvars - tidyTypes :: TidyEnv -> [Type] -> [Type] tidyTypes env tys = map (tidyType env) tys @@ -957,7 +943,6 @@ seqType :: Type -> () seqType (TyVarTy tv) = tv `seq` () seqType (AppTy t1 t2) = seqType t1 `seq` seqType t2 seqType (FunTy t1 t2) = seqType t1 `seq` seqType t2 -seqType (NoteTy note t2) = seqNote note `seq` seqType t2 seqType (PredTy p) = seqPred p seqType (TyConApp tc tys) = tc `seq` seqTypes tys seqType (ForAllTy tv ty) = tv `seq` seqType ty @@ -966,9 +951,6 @@ seqTypes :: [Type] -> () seqTypes [] = () seqTypes (ty:tys) = seqType ty `seq` seqTypes tys -seqNote :: TyNote -> () -seqNote (FTVNote set) = sizeUniqSet set `seq` () - seqPred :: PredType -> () seqPred (ClassP c tys) = c `seq` seqTypes tys seqPred (IParam n ty) = n `seq` seqType ty @@ -1067,7 +1049,6 @@ tcPartOfType t1 (AppTy s2 t2) = tcPartOfType t1 s2 || tcPartOfType t1 t2 tcPartOfType t1 (FunTy s2 t2) = tcPartOfType t1 s2 || tcPartOfType t1 t2 tcPartOfType t1 (PredTy p2) = tcPartOfPred t1 p2 tcPartOfType t1 (TyConApp _ ts) = any (tcPartOfType t1) ts -tcPartOfType t1 (NoteTy _ t2) = tcPartOfType t1 t2 tcPartOfPred :: Type -> PredType -> Bool tcPartOfPred t1 (IParam _ t2) = tcPartOfType t1 t2 @@ -1103,7 +1084,6 @@ cmpTypeX env (AppTy s1 t1) (AppTy s2 t2) = cmpTypeX env s1 s2 `thenC cmpTypeX env (FunTy s1 t1) (FunTy s2 t2) = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2 cmpTypeX env (PredTy p1) (PredTy p2) = cmpPredX env p1 p2 cmpTypeX env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` cmpTypesX env tys1 tys2 -cmpTypeX env t1 (NoteTy _ t2) = cmpTypeX env t1 t2 -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy < PredTy cmpTypeX _ (AppTy _ _) (TyVarTy _) = GT @@ -1399,8 +1379,6 @@ subst_ty subst ty go (PredTy p) = PredTy $! (substPred subst p) - go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard the free tyvar note - go (FunTy arg res) = (FunTy $! (go arg)) $! (go res) go (AppTy fun arg) = mkAppTy (go fun) $! (go arg) -- The mkAppTy smart constructor is important diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs index 6b45a5d..4927dcc 100644 --- a/compiler/types/TypeRep.lhs +++ b/compiler/types/TypeRep.lhs @@ -7,7 +7,7 @@ \begin{code} module TypeRep ( TyThing(..), - Type(..), TyNote(..), -- Representation visible + Type(..), PredType(..), -- to friends Kind, ThetaType, -- Synonyms @@ -49,7 +49,6 @@ import {-# SOURCE #-} DataCon( DataCon, dataConName ) -- friends: import Var -import VarSet import Name import OccName import BasicTypes @@ -169,7 +168,6 @@ data Type | AppTy Type -- Function is *not* a TyConApp Type -- It must be another AppTy, or TyVarTy - -- (or NoteTy of these) | TyConApp -- Application of a TyCon, including newtypes *and* synonyms TyCon -- *Invariant* saturated appliations of FunTyCon and @@ -195,10 +193,6 @@ data Type -- of a coercion variable; never as the argument or result -- of a FunTy (unlike ClassP, IParam) - | NoteTy -- A type with a note attached - TyNote - Type -- The expanded version - type Kind = Type -- Invariant: a kind is always -- FunTy k1 k2 -- or TyConApp PrimTyCon [...] @@ -207,8 +201,6 @@ type Kind = Type -- Invariant: a kind is always type SuperKind = Type -- Invariant: a super kind is always -- TyConApp SuperKindTyCon ... - -data TyNote = FTVNote TyVarSet -- The free type variables of the noted expression \end{code} ------------------------------------- @@ -395,12 +387,10 @@ tySuperKind = kindTyConType tySuperKindTyCon coSuperKind = kindTyConType coSuperKindTyCon isTySuperKind :: SuperKind -> Bool -isTySuperKind (NoteTy _ ty) = isTySuperKind ty isTySuperKind (TyConApp kc []) = kc `hasKey` tySuperKindTyConKey isTySuperKind _ = False isCoSuperKind :: SuperKind -> Bool -isCoSuperKind (NoteTy _ ty) = isCoSuperKind ty isCoSuperKind (TyConApp kc []) = kc `hasKey` coSuperKindTyConKey isCoSuperKind _ = False @@ -418,7 +408,6 @@ isCoercionKind :: Kind -> Bool -- All coercions are of form (ty1 ~ ty2) -- This function is here rather than in Coercion, -- because it's used in a knot-tied way to enforce invariants in Var -isCoercionKind (NoteTy _ k) = isCoercionKind k isCoercionKind (PredTy (EqPred {})) = True isCoercionKind _ = False @@ -426,7 +415,7 @@ coVarPred :: CoVar -> PredType coVarPred tv = ASSERT( isCoVar tv ) case tyVarKind tv of - PredTy eq -> eq -- There shouldn't even be a NoteTy in the way + PredTy eq -> eq other -> pprPanic "coVarPred" (ppr tv $$ ppr other) \end{code} @@ -501,7 +490,6 @@ pprParendKind = pprParendType ppr_type :: Prec -> Type -> SDoc ppr_type _ (TyVarTy tv) = ppr tv ppr_type _ (PredTy pred) = ifPprDebug (ptext SLIT("")) <> (ppr pred) -ppr_type p (NoteTy _ ty2) = ifPprDebug (ptext SLIT("")) <> ppr_type p ty2 ppr_type p (TyConApp tc tys) = ppr_tc_app p tc tys ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $ @@ -532,15 +520,11 @@ ppr_forall_type p ty -- equality predicates. split1 tvs (ForAllTy tv ty) | not (isCoVar tv) = split1 (tv:tvs) ty - split1 tvs (NoteTy _ ty) = split1 tvs ty split1 tvs ty = (reverse tvs, ty) - split2 ps (NoteTy _ arg -- Rather a disgusting case - `FunTy` res) = split2 ps (arg `FunTy` res) split2 ps (PredTy p `FunTy` ty) = split2 (p:ps) ty split2 ps (ForAllTy tv ty) | isCoVar tv = split2 (coVarPred tv : ps) ty - split2 ps (NoteTy _ ty) = split2 ps ty split2 ps ty = (reverse ps, ty) ppr_tc_app :: Prec -> TyCon -> [Type] -> SDoc -- 1.7.10.4