2 % (c) The AQUA Project, Glasgow University, 1996
4 \section[Kind]{The @Kind@ datatype}
8 GenKind(..), -- Only visible to friends: TcKind
19 pprKind, pprParendKind,
21 isUnboxedTypeKind, isTypeKind, isBoxedTypeKind
24 #include "HsVersions.h"
26 import Util ( panic, assertPanic )
27 import Unique ( Unique, pprUnique )
28 import BasicTypes ( Unused )
34 = TypeKind -- Any type (incl unboxed types)
35 | BoxedTypeKind -- Any boxed type
36 | UnboxedTypeKind -- Any unboxed type
37 | ArrowKind (GenKind flexi) (GenKind flexi)
38 | VarKind Unique flexi
40 type Kind = GenKind Unused -- No variables at all
42 instance Eq (GenKind flexi) where
43 TypeKind == TypeKind = True
44 BoxedTypeKind == BoxedTypeKind = True
45 UnboxedTypeKind == UnboxedTypeKind = True
46 (ArrowKind j1 j2) == (ArrowKind k1 k2) = j1==k1 && j2==k2
47 (VarKind u1 _) == (VarKind u2 _) = u1==u2
50 mkArrowKind = ArrowKind
52 mkUnboxedTypeKind = UnboxedTypeKind
53 mkBoxedTypeKind = BoxedTypeKind
55 isTypeKind :: GenKind flexi -> Bool
56 isTypeKind TypeKind = True
57 isTypeKind other = False
59 isBoxedTypeKind :: GenKind flexi -> Bool
60 isBoxedTypeKind BoxedTypeKind = True
61 isBoxedTypeKind other = False
63 isUnboxedTypeKind :: GenKind flexi -> Bool
64 isUnboxedTypeKind UnboxedTypeKind = True
65 isUnboxedTypeKind other = False
67 hasMoreBoxityInfo :: GenKind flexi -> GenKind flexi -> Bool
69 BoxedTypeKind `hasMoreBoxityInfo` TypeKind = True
70 BoxedTypeKind `hasMoreBoxityInfo` BoxedTypeKind = True
72 UnboxedTypeKind `hasMoreBoxityInfo` TypeKind = True
73 UnboxedTypeKind `hasMoreBoxityInfo` UnboxedTypeKind = True
75 TypeKind `hasMoreBoxityInfo` TypeKind = True
77 kind1@(ArrowKind _ _) `hasMoreBoxityInfo` kind2@(ArrowKind _ _)
78 = ASSERT( if kind1 == kind2 then True
79 else pprPanic "hadMoreBoxityInfo" (ppr kind1 <> comma <+> ppr kind2) )
81 -- The two kinds can be arrow kinds; for example when unifying
82 -- (m1 Int) and (m2 Int) we end up unifying m1 and m2, which should
83 -- have the same kind.
85 kind1 `hasMoreBoxityInfo` kind2 = False
87 resultKind :: GenKind flexi -> GenKind flexi -- Get result from arrow kind
88 resultKind (ArrowKind _ res_kind) = res_kind
89 resultKind other_kind = panic "resultKind"
91 argKind :: GenKind flexi -> GenKind flexi -- Get argument from arrow kind
92 argKind (ArrowKind arg_kind _) = arg_kind
93 argKind other_kind = panic "argKind"
99 instance Outputable (GenKind flexi) where
100 ppr kind = pprKind kind
102 pprKind TypeKind = text "**" -- Can be boxed or unboxed
103 pprKind BoxedTypeKind = char '*'
104 pprKind UnboxedTypeKind = text "*#" -- Unboxed
105 pprKind (ArrowKind k1 k2) = sep [pprParendKind k1, text "->", pprKind k2]
106 pprKind (VarKind u _) = char 'k' <> pprUnique u
108 pprParendKind k@(ArrowKind _ _) = parens (pprKind k)
109 pprParendKind k = pprKind k