2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
7 Kind(..), KindVar(..), SimpleKind,
8 openTypeKind, liftedTypeKind, unliftedTypeKind,
9 argTypeKind, ubxTupleKind,
11 isLiftedTypeKind, isUnliftedTypeKind,
12 isArgTypeKind, isOpenTypeKind,
13 mkArrowKind, mkArrowKinds,
15 isSubKind, defaultKind,
16 kindFunResult, splitKindFunTys, mkKindVar,
18 pprKind, pprParendKind
21 #include "HsVersions.h"
23 import Unique ( Unique )
30 There's a little subtyping at the kind level:
39 where * [LiftedTypeKind] means boxed type
40 # [UnliftedTypeKind] means unboxed type
41 (#) [UbxTupleKind] means unboxed tuple
42 ?? [ArgTypeKind] is the lub of *,#
43 ? [OpenTypeKind] means any type at all
47 error :: forall a:?. String -> a
49 (\(x::t) -> ...) Here t::?? (i.e. not unboxed tuple)
55 | UnliftedTypeKind -- #
56 | UbxTupleKind -- (##)
58 | FunKind Kind Kind -- k1 -> k2
62 data KindVar = KVar Unique (IORef (Maybe SimpleKind))
63 -- INVARIANT: a KindVar can only be instantaited by a SimpleKind
65 type SimpleKind = Kind
66 -- A SimpleKind has no ? or # kinds in it:
67 -- sk ::= * | sk1 -> sk2 | kvar
69 instance Eq KindVar where
70 (KVar u1 _) == (KVar u2 _) = u1 == u2
72 mkKindVar :: Unique -> IORef (Maybe Kind) -> KindVar
78 During kind inference, a kind variable unifies only with
82 data T a = MkT a (T Int#)
83 fails. We give T the kind (k -> *), and the kind variable k won't unify
84 with # (the kind of Int#).
88 When creating a fresh internal type variable, we give it a kind to express
89 constraints on it. E.g. in (\x->e) we make up a fresh type variable for x,
92 During unification we only bind an internal type variable to a type
93 whose kind is lower in the sub-kind hierarchy than the kind of the tyvar.
95 When unifying two internal type variables, we collect their kind constraints by
96 finding the GLB of the two. Since the partial order is a tree, they only
97 have a glb if one is a sub-kind of the other. In that case, we bind the
98 less-informative one to the more informative one. Neat, eh?
102 liftedTypeKind = LiftedTypeKind
103 unliftedTypeKind = UnliftedTypeKind
104 openTypeKind = OpenTypeKind
105 argTypeKind = ArgTypeKind
106 ubxTupleKind = UbxTupleKind
108 mkArrowKind :: Kind -> Kind -> Kind
109 mkArrowKind k1 k2 = k1 `FunKind` k2
111 mkArrowKinds :: [Kind] -> Kind -> Kind
112 mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds
115 %************************************************************************
119 %************************************************************************
122 kindFunResult :: Kind -> Kind
123 kindFunResult (FunKind _ k) = k
124 kindFunResult k = pprPanic "kindFunResult" (ppr k)
126 splitKindFunTys :: Kind -> ([Kind],Kind)
127 splitKindFunTys (FunKind k1 k2) = case splitKindFunTys k2 of
128 (as, r) -> (k1:as, r)
129 splitKindFunTys k = ([], k)
131 isLiftedTypeKind, isUnliftedTypeKind :: Kind -> Bool
132 isLiftedTypeKind LiftedTypeKind = True
133 isLiftedTypeKind other = False
135 isUnliftedTypeKind UnliftedTypeKind = True
136 isUnliftedTypeKind other = False
138 isArgTypeKind :: Kind -> Bool
139 -- True of any sub-kind of ArgTypeKind
140 isArgTypeKind LiftedTypeKind = True
141 isArgTypeKind UnliftedTypeKind = True
142 isArgTypeKind ArgTypeKind = True
143 isArgTypeKind other = False
145 isOpenTypeKind :: Kind -> Bool
146 -- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
147 isOpenTypeKind (FunKind _ _) = False
148 isOpenTypeKind other = True
150 isSubKind :: Kind -> Kind -> Bool
151 -- (k1 `isSubKind` k2) checks that k1 <: k2
152 isSubKind LiftedTypeKind LiftedTypeKind = True
153 isSubKind UnliftedTypeKind UnliftedTypeKind = True
154 isSubKind UbxTupleKind UbxTupleKind = True
155 isSubKind k1 OpenTypeKind = isOpenTypeKind k1
156 isSubKind k1 ArgTypeKind = isArgTypeKind k1
157 isSubKind (FunKind a1 r1) (FunKind a2 r2)
158 = (a2 `isSubKind` a1) && (r1 `isSubKind` r2)
159 isSubKind k1 k2 = False
161 defaultKind :: Kind -> Kind
162 -- Used when generalising: default kind '?' and '??' to '*'
164 -- When we generalise, we make generic type variables whose kind is
165 -- simple (* or *->* etc). So generic type variables (other than
166 -- built-in constants like 'error') always have simple kinds. This is important;
169 -- We want f to get type
170 -- f :: forall (a::*). a -> Bool
172 -- f :: forall (a::??). a -> Bool
173 -- because that would allow a call like (f 3#) as well as (f True),
174 --and the calling conventions differ. This defaulting is done in TcMType.zonkTcTyVarBndr.
175 defaultKind OpenTypeKind = LiftedTypeKind
176 defaultKind ArgTypeKind = LiftedTypeKind
177 defaultKind kind = kind
181 %************************************************************************
185 %************************************************************************
188 instance Outputable KindVar where
189 ppr (KVar uniq _) = text "k_" <> ppr uniq
191 instance Outputable Kind where
194 pprParendKind :: Kind -> SDoc
195 pprParendKind k@(FunKind _ _) = parens (pprKind k)
196 pprParendKind k = pprKind k
198 pprKind (KindVar v) = ppr v
199 pprKind LiftedTypeKind = ptext SLIT("*")
200 pprKind UnliftedTypeKind = ptext SLIT("#")
201 pprKind OpenTypeKind = ptext SLIT("?")
202 pprKind ArgTypeKind = ptext SLIT("??")
203 pprKind UbxTupleKind = ptext SLIT("(#)")
204 pprKind (FunKind k1 k2) = sep [ pprParendKind k1, arrow <+> pprKind k2]