\begin{code}
module Kind (
- Kind(..), KindVar(..), SimpleKind,
+ Kind(..), SimpleKind,
openTypeKind, liftedTypeKind, unliftedTypeKind,
argTypeKind, ubxTupleKind,
mkArrowKind, mkArrowKinds,
isSubKind, defaultKind,
- kindFunResult, splitKindFunTys, mkKindVar,
+ kindFunResult, splitKindFunTys,
+
+ KindVar, mkKindVar, kindVarRef, kindVarUniq,
+ kindVarOcc, setKindVarOcc,
pprKind, pprParendKind
) where
#include "HsVersions.h"
import Unique ( Unique )
+import OccName ( OccName, mkOccName, tvName )
import Outputable
import DATA_IOREF
\end{code}
In particular:
- error :: forall a:<any>. String -> a
+ error :: forall a:?. String -> a
(->) :: ?? -> ? -> *
- (\(x::t) -> ...) Here t::<any> (i.e. not unboxed tuple)
+ (\(x::t) -> ...) Here t::?? (i.e. not unboxed tuple)
\begin{code}
data Kind
- = LiftedTypeKind -- *
+ = LiftedTypeKind -- *
| OpenTypeKind -- ?
- | UnliftedTypeKind -- #
+ | UnliftedTypeKind -- #
| UbxTupleKind -- (##)
| ArgTypeKind -- ??
| FunKind Kind Kind -- k1 -> k2
| KindVar KindVar
deriving( Eq )
-data KindVar = KVar Unique (IORef (Maybe SimpleKind))
- -- INVARIANT: a KindVar can only be instantaited by a SimpleKind
+data KindVar = KVar Unique OccName (IORef (Maybe SimpleKind))
+ -- INVARIANT: a KindVar can only be instantiated by a SimpleKind
type SimpleKind = Kind
-- A SimpleKind has no ? or # kinds in it:
-- sk ::= * | sk1 -> sk2 | kvar
instance Eq KindVar where
- (KVar u1 _) == (KVar u2 _) = u1 == u2
+ (KVar u1 _ _) == (KVar u2 _ _) = u1 == u2
mkKindVar :: Unique -> IORef (Maybe Kind) -> KindVar
-mkKindVar = KVar
+mkKindVar u r = KVar u kind_var_occ r
+
+kindVarRef :: KindVar -> IORef (Maybe Kind)
+kindVarRef (KVar _ _ ref) = ref
+
+kindVarUniq :: KindVar -> Unique
+kindVarUniq (KVar uniq _ _) = uniq
+
+kindVarOcc :: KindVar -> OccName
+kindVarOcc (KVar _ occ _) = occ
+
+setKindVarOcc :: KindVar -> OccName -> KindVar
+setKindVarOcc (KVar u _ r) occ = KVar u occ r
+
+kind_var_occ :: OccName -- Just one for all KindVars
+ -- They may be jiggled by tidying
+kind_var_occ = mkOccName tvName "k"
\end{code}
Kind inference
have a glb if one is a sub-kind of the other. In that case, we bind the
less-informative one to the more informative one. Neat, eh?
-In the olden days, when we generalise, we make generic type variables
-whose kind is simple. So generic type variables (other than built-in
-constants like 'error') always have simple kinds. But I don't see any
-reason to do that any more (TcMType.zapTcTyVarToTyVar).
-
\begin{code}
liftedTypeKind = LiftedTypeKind
isOpenTypeKind :: Kind -> Bool
-- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
isOpenTypeKind (FunKind _ _) = False
+isOpenTypeKind (KindVar _) = False -- This is a conservative answer
+ -- It matters in the call to isSubKind in
+ -- checkExpectedKind.
isOpenTypeKind other = True
isSubKind :: Kind -> Kind -> Bool
isSubKind UbxTupleKind UbxTupleKind = True
isSubKind k1 OpenTypeKind = isOpenTypeKind k1
isSubKind k1 ArgTypeKind = isArgTypeKind k1
-isSubKind (FunKind a1 r1) (FunKind a2 r2)
- = (a2 `isSubKind` a1) && (r1 `isSubKind` r2)
-isSubKind k1 k2 = False
+isSubKind (FunKind a1 r1) (FunKind a2 r2) = (a2 `isSubKind` a1) && (r1 `isSubKind` r2)
+isSubKind k1 k2 = False
defaultKind :: Kind -> Kind
-- Used when generalising: default kind '?' and '??' to '*'
+--
+-- When we generalise, we make generic type variables whose kind is
+-- simple (* or *->* etc). So generic type variables (other than
+-- built-in constants like 'error') always have simple kinds. This is important;
+-- consider
+-- f x = True
+-- We want f to get type
+-- f :: forall (a::*). a -> Bool
+-- Not
+-- f :: forall (a::??). a -> Bool
+-- because that would allow a call like (f 3#) as well as (f True),
+--and the calling conventions differ. This defaulting is done in TcMType.zonkTcTyVarBndr.
defaultKind OpenTypeKind = LiftedTypeKind
defaultKind ArgTypeKind = LiftedTypeKind
defaultKind kind = kind
\begin{code}
instance Outputable KindVar where
- ppr (KVar uniq _) = text "k_" <> ppr uniq
+ ppr (KVar uniq occ _) = ppr occ <> ifPprDebug (ppr uniq)
instance Outputable Kind where
ppr k = pprKind k
pprKind ArgTypeKind = ptext SLIT("??")
pprKind UbxTupleKind = ptext SLIT("(#)")
pprKind (FunKind k1 k2) = sep [ pprParendKind k1, arrow <+> pprKind k2]
-\end{code}
-
-
+\end{code}