Commit 467f588c authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Remove leftover NoteTy/FTVNote bits

parent 2e3b6bd7
......@@ -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
}
......
......@@ -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
......
......@@ -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
......
......@@ -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 =
......
......@@ -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
......
......@@ -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;
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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') }
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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("<pred>")) <> (ppr pred)
ppr_type p (NoteTy _ ty2) = ifPprDebug (ptext SLIT("<note>")) <> 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
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment