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 pprKind, pprParendKind,
22 isUnboxedTypeKind, isTypeKind, isBoxedTypeKind,
28 import Util ( panic, assertPanic )
30 import Outputable ( Outputable(..), pprQuote )
36 = TypeKind -- Any type (incl unboxed types)
37 | BoxedTypeKind -- Any boxed type
38 | UnboxedTypeKind -- Any unboxed type
42 mkArrowKind = ArrowKind
44 mkUnboxedTypeKind = UnboxedTypeKind
45 mkBoxedTypeKind = BoxedTypeKind
47 isTypeKind :: Kind -> Bool
48 isTypeKind TypeKind = True
49 isTypeKind other = False
51 isBoxedTypeKind :: Kind -> Bool
52 isBoxedTypeKind BoxedTypeKind = True
53 isBoxedTypeKind other = False
55 isUnboxedTypeKind :: Kind -> Bool
56 isUnboxedTypeKind UnboxedTypeKind = True
57 isUnboxedTypeKind other = False
59 hasMoreBoxityInfo :: Kind -> Kind -> Bool
61 BoxedTypeKind `hasMoreBoxityInfo` TypeKind = True
62 BoxedTypeKind `hasMoreBoxityInfo` BoxedTypeKind = True
64 UnboxedTypeKind `hasMoreBoxityInfo` TypeKind = True
65 UnboxedTypeKind `hasMoreBoxityInfo` UnboxedTypeKind = True
67 TypeKind `hasMoreBoxityInfo` TypeKind = True
69 kind1@(ArrowKind _ _) `hasMoreBoxityInfo` kind2@(ArrowKind _ _) = ASSERT( kind1 == kind2 )
71 -- The two kinds can be arrow kinds; for example when unifying
72 -- (m1 Int) and (m2 Int) we end up unifying m1 and m2, which should
73 -- have the same kind.
75 kind1 `hasMoreBoxityInfo` kind2 = False
77 notArrowKind (ArrowKind _ _) = False
78 notArrowKind other_kind = True
80 resultKind :: Kind -> Kind -- Get result from arrow kind
81 resultKind (ArrowKind _ res_kind) = res_kind
82 resultKind other_kind = panic "resultKind"
84 argKind :: Kind -> Kind -- Get argument from arrow kind
85 argKind (ArrowKind arg_kind _) = arg_kind
86 argKind other_kind = panic "argKind"
92 instance Outputable Kind where
93 ppr sty kind = pprQuote sty $ \ _ -> pprKind kind
95 pprKind TypeKind = text "**" -- Can be boxed or unboxed
96 pprKind BoxedTypeKind = char '*'
97 pprKind UnboxedTypeKind = text "*#" -- Unboxed
98 pprKind (ArrowKind k1 k2) = sep [pprParendKind k1, text "->", pprKind k2]
100 pprParendKind k@(ArrowKind _ _) = parens (pprKind k)
101 pprParendKind k = pprKind k