-- Kinds
Kind, SimpleKind, KindVar,
- kindFunResult, splitKindFunTys,
+ kindFunResult, splitKindFunTys, splitKindFunTysN,
liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
argTypeKindTyCon, ubxTupleKindTyCon,
-- friends:
import Var ( Var, TyVar, tyVarKind, tyVarName,
- setTyVarName, setTyVarKind, mkWildTyVar )
+ setTyVarName, setTyVarKind, mkWildCoVar )
import VarEnv
import VarSet
import Class ( Class, classTyCon )
import PrelNames( openTypeKindTyConKey, unliftedTypeKindTyConKey,
ubxTupleKindTyConKey, argTypeKindTyConKey )
-import TyCon ( TyCon, isRecursiveTyCon, isPrimTyCon,
+import TyCon ( TyCon, isPrimTyCon,
isUnboxedTupleTyCon, isUnLiftedTyCon,
- isFunTyCon, isNewTyCon, newTyConRep, newTyConRhs,
- isAlgTyCon, tyConArity, isSuperKindTyCon,
+ isFunTyCon, isNewTyCon, isClosedNewTyCon,
+ newTyConRep, newTyConRhs,
+ isAlgTyCon, isSuperKindTyCon,
tcExpandTyCon_maybe, coreExpandTyCon_maybe,
- tyConKind, PrimRep(..), tyConPrimRep, tyConUnique,
- isCoercionTyCon_maybe, isCoercionTyCon
+ tyConKind, PrimRep(..), tyConPrimRep, tyConUnique
)
-- others
import StaticFlags ( opt_DictsStrict )
-import Util ( mapAccumL, seqList, lengthIs, snocView, thenCmp, isEqual, all2 )
+import Util ( mapAccumL, seqList, snocView, thenCmp, isEqual, all2 )
import Outputable
import UniqSet ( sizeUniqSet ) -- Should come via VarSet
import Maybe ( isJust )
+
+#ifdef DEBUG
+import TyCon ( isRecursiveTyCon, tyConArity, isCoercionTyCon )
+import Util ( lengthIs )
+#endif
\end{code}
\begin{code}
mkFunTy :: Type -> Type -> Type
-mkFunTy (PredTy (EqPred ty1 ty2)) res = mkForAllTy (mkWildTyVar (PredTy (EqPred ty1 ty2))) res
+mkFunTy (PredTy (EqPred ty1 ty2)) res = mkForAllTy (mkWildCoVar (PredTy (EqPred ty1 ty2))) res
mkFunTy arg res = FunTy arg res
mkFunTys :: [Type] -> Type -> Type
(b) synonyms
(c) predicates
(d) usage annotations
- (e) all newtypes, including recursive ones
+ (e) all newtypes, including recursive ones, but not newtype families
It's useful in the back end.
\begin{code}
repType ty | Just ty' <- coreView ty = repType ty'
repType (ForAllTy _ ty) = repType ty
repType (TyConApp tc tys)
- | isNewTyCon tc = -- Recursive newtypes are opaque to coreView
+ | isClosedNewTyCon tc = -- Recursive newtypes are opaque to coreView
-- but we must expand them here. Sure to
-- be saturated because repType is only applied
-- to types of kind *
-- Only applied to types of kind *, hence the newtype is always saturated
splitRecNewType_maybe ty | Just ty' <- coreView ty = splitRecNewType_maybe ty'
splitRecNewType_maybe (TyConApp tc tys)
- | isNewTyCon tc
+ | isClosedNewTyCon tc
= ASSERT( tys `lengthIs` tyConArity tc ) -- splitRecNewType_maybe only be applied
-- to *types* (of kind *)
ASSERT( isRecursiveTyCon tc ) -- Guaranteed by coreView
-- This comparison is used exclusively (I think) for the
-- finite map built in TcSimplify
cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` cmpTypesX env tys1 tys2
-cmpPredX env (IParam _ _) (ClassP _ _) = LT
-cmpPredX env (ClassP _ _) (IParam _ _) = GT
+cmpPredX env (EqPred ty1 ty2) (EqPred ty1' ty2') = (cmpTypeX env ty1 ty1') `thenCmp` (cmpTypeX env ty2 ty2')
+
+-- Constructor order: IParam < ClassP < EqPred
+cmpPredX env (IParam {}) _ = LT
+cmpPredX env (ClassP {}) (IParam {}) = GT
+cmpPredX env (ClassP {}) (EqPred {}) = LT
+cmpPredX env (EqPred {}) _ = GT
\end{code}
PredTypes are used as a FM key in TcSimplify,
splitKindFunTys :: Kind -> ([Kind],Kind)
splitKindFunTys k = splitFunTys k
+splitKindFunTysN :: Int -> Kind -> ([Kind],Kind)
+splitKindFunTysN k = splitFunTysN k
+
isUbxTupleKind, isOpenTypeKind, isArgTypeKind, isUnliftedTypeKind :: Kind -> Bool
isOpenTypeKindCon tc = tyConUnique tc == openTypeKindTyConKey
isSubKind :: Kind -> Kind -> Bool
-- (k1 `isSubKind` k2) checks that k1 <: k2
-isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc1
+isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc2
isSubKind (FunTy a1 r1) (FunTy a2 r2) = (a2 `isSubKind` a1) && (r1 `isSubKind` r2)
isSubKind (PredTy (EqPred ty1 ty2)) (PredTy (EqPred ty1' ty2'))
= ty1 `tcEqType` ty1' && ty2 `tcEqType` ty2'