2 % (c) The AQUA Project, Glasgow University, 1996
4 \section[Kind]{The @Kind@ datatype}
7 #include "HsVersions.h"
10 Kind(..), -- Only visible to friends: TcKind
20 isUnboxedKind, isTypeKind,
26 import Util ( panic, assertPanic )
27 --import Outputable ( Outputable(..) )
33 = TypeKind -- Any type (incl unboxed types)
34 | BoxedTypeKind -- Any boxed type
35 | UnboxedTypeKind -- Any unboxed type
39 mkArrowKind = ArrowKind
41 mkUnboxedTypeKind = UnboxedTypeKind
42 mkBoxedTypeKind = BoxedTypeKind
44 isTypeKind :: Kind -> Bool
45 isTypeKind TypeKind = True
46 isTypeKind other = False
48 isUnboxedKind :: Kind -> Bool
49 isUnboxedKind UnboxedTypeKind = True
50 isUnboxedKind other = False
52 hasMoreBoxityInfo :: Kind -> Kind -> Bool
54 BoxedTypeKind `hasMoreBoxityInfo` TypeKind = True
55 BoxedTypeKind `hasMoreBoxityInfo` BoxedTypeKind = True
57 UnboxedTypeKind `hasMoreBoxityInfo` TypeKind = True
58 UnboxedTypeKind `hasMoreBoxityInfo` UnboxedTypeKind = True
60 TypeKind `hasMoreBoxityInfo` TypeKind = True
62 kind1@(ArrowKind _ _) `hasMoreBoxityInfo` kind2@(ArrowKind _ _) = ASSERT( kind1 == kind2 )
64 -- The two kinds can be arrow kinds; for example when unifying
65 -- (m1 Int) and (m2 Int) we end up unifying m1 and m2, which should
66 -- have the same kind.
68 kind1 `hasMoreBoxityInfo` kind2 = False
70 notArrowKind (ArrowKind _ _) = False
71 notArrowKind other_kind = True
73 resultKind :: Kind -> Kind -- Get result from arrow kind
74 resultKind (ArrowKind _ res_kind) = res_kind
75 resultKind other_kind = panic "resultKind"
77 argKind :: Kind -> Kind -- Get argument from arrow kind
78 argKind (ArrowKind arg_kind _) = arg_kind
79 argKind other_kind = panic "argKind"
85 instance Outputable Kind where
86 ppr sty kind = pprKind kind
88 pprKind TypeKind = ppStr "*"
89 pprKind BoxedTypeKind = ppStr "*b"
90 pprKind UnboxedTypeKind = ppStr "*u"
91 pprKind (ArrowKind k1 k2) = ppSep [pprKind_parend k1, ppStr "->", pprKind k2]
93 pprKind_parend k@(ArrowKind _ _) = ppBesides [ppLparen, pprKind k, ppRparen]
94 pprKind_parend k = pprKind k