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 )
29 --import Outputable ( Outputable(..) )
35 = TypeKind -- Any type (incl unboxed types)
36 | BoxedTypeKind -- Any boxed type
37 | UnboxedTypeKind -- Any unboxed type
41 mkArrowKind = ArrowKind
43 mkUnboxedTypeKind = UnboxedTypeKind
44 mkBoxedTypeKind = BoxedTypeKind
46 isTypeKind :: Kind -> Bool
47 isTypeKind TypeKind = True
48 isTypeKind other = False
50 isBoxedTypeKind :: Kind -> Bool
51 isBoxedTypeKind BoxedTypeKind = True
52 isBoxedTypeKind other = False
54 isUnboxedTypeKind :: Kind -> Bool
55 isUnboxedTypeKind UnboxedTypeKind = True
56 isUnboxedTypeKind other = False
58 hasMoreBoxityInfo :: Kind -> Kind -> Bool
60 BoxedTypeKind `hasMoreBoxityInfo` TypeKind = True
61 BoxedTypeKind `hasMoreBoxityInfo` BoxedTypeKind = True
63 UnboxedTypeKind `hasMoreBoxityInfo` TypeKind = True
64 UnboxedTypeKind `hasMoreBoxityInfo` UnboxedTypeKind = True
66 TypeKind `hasMoreBoxityInfo` TypeKind = True
68 kind1@(ArrowKind _ _) `hasMoreBoxityInfo` kind2@(ArrowKind _ _) = ASSERT( kind1 == kind2 )
70 -- The two kinds can be arrow kinds; for example when unifying
71 -- (m1 Int) and (m2 Int) we end up unifying m1 and m2, which should
72 -- have the same kind.
74 kind1 `hasMoreBoxityInfo` kind2 = False
76 notArrowKind (ArrowKind _ _) = False
77 notArrowKind other_kind = True
79 resultKind :: Kind -> Kind -- Get result from arrow kind
80 resultKind (ArrowKind _ res_kind) = res_kind
81 resultKind other_kind = panic "resultKind"
83 argKind :: Kind -> Kind -- Get argument from arrow kind
84 argKind (ArrowKind arg_kind _) = arg_kind
85 argKind other_kind = panic "argKind"
91 instance Outputable Kind where
92 ppr sty kind = pprKind kind
94 pprKind TypeKind = ppChar '*' -- Can be boxed or unboxed
95 pprKind BoxedTypeKind = ppChar '*'
96 pprKind UnboxedTypeKind = ppStr "*#" -- Unboxed
97 pprKind (ArrowKind k1 k2) = ppSep [pprParendKind k1, ppStr "->", pprKind k2]
99 pprParendKind k@(ArrowKind _ _) = ppBesides [ppLparen, pprKind k, ppRparen]
100 pprParendKind k = pprKind k