ghc/compiler/types/Kind.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996
   3 %
   4 \section[Kind]{The @Kind@ datatype}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module Kind (
  10         Kind(..),               -- Only visible to friends: TcKind
  11
  12         mkArrowKind,
  13         mkTypeKind,
  14         mkUnboxedTypeKind,
  15         mkBoxedTypeKind,
  16
  17         hasMoreBoxityInfo,
  18         resultKind, argKind,
  19
  20         pprKind, pprParendKind,
  21
  22         isUnboxedTypeKind, isTypeKind, isBoxedTypeKind,
  23         notArrowKind
  24     ) where
  25
  26 IMP_Ubiq(){-uitous-}
  27
  28 import Util             ( panic, assertPanic )
  29
  30 import Outputable       ( Outputable(..), pprQuote )
  31 import Pretty
  32 \end{code}
  33
  34 \begin{code}
  35 data Kind
  36   = TypeKind            -- Any type (incl unboxed types)
  37   | BoxedTypeKind       -- Any boxed type
  38   | UnboxedTypeKind     -- Any unboxed type
  39   | ArrowKind Kind Kind
  40   deriving Eq
  41
  42 mkArrowKind       = ArrowKind
  43 mkTypeKind        = TypeKind
  44 mkUnboxedTypeKind = UnboxedTypeKind
  45 mkBoxedTypeKind   = BoxedTypeKind
  46
  47 isTypeKind :: Kind -> Bool
  48 isTypeKind TypeKind = True
  49 isTypeKind other    = False
  50
  51 isBoxedTypeKind :: Kind -> Bool
  52 isBoxedTypeKind BoxedTypeKind = True
  53 isBoxedTypeKind other         = False
  54
  55 isUnboxedTypeKind :: Kind -> Bool
  56 isUnboxedTypeKind UnboxedTypeKind = True
  57 isUnboxedTypeKind other           = False
  58
  59 hasMoreBoxityInfo :: Kind -> Kind -> Bool
  60
  61 BoxedTypeKind   `hasMoreBoxityInfo` TypeKind        = True
  62 BoxedTypeKind   `hasMoreBoxityInfo` BoxedTypeKind   = True
  63
  64 UnboxedTypeKind `hasMoreBoxityInfo` TypeKind        = True
  65 UnboxedTypeKind `hasMoreBoxityInfo` UnboxedTypeKind = True
  66
  67 TypeKind        `hasMoreBoxityInfo` TypeKind        = True
  68
  69 kind1@(ArrowKind _ _) `hasMoreBoxityInfo` kind2@(ArrowKind _ _) = ASSERT( kind1 == kind2 )
  70                                                                   True
  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.
  74
  75 kind1           `hasMoreBoxityInfo` kind2           = False
  76
  77 notArrowKind (ArrowKind _ _) = False
  78 notArrowKind other_kind      = True
  79
  80 resultKind :: Kind -> Kind      -- Get result from arrow kind
  81 resultKind (ArrowKind _ res_kind) = res_kind
  82 resultKind other_kind             = panic "resultKind"
  83
  84 argKind :: Kind -> Kind         -- Get argument from arrow kind
  85 argKind (ArrowKind arg_kind _) = arg_kind
  86 argKind other_kind             = panic "argKind"
  87 \end{code}
  88
  89 Printing
  90 ~~~~~~~~
  91 \begin{code}
  92 instance Outputable Kind where
  93   ppr sty kind = pprQuote sty $ \ _ -> pprKind kind
  94
  95 pprKind TypeKind        = char '*'      -- 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]
  99
 100 pprParendKind k@(ArrowKind _ _) = parens (pprKind k)
 101 pprParendKind k                 = pprKind k
 102 \end{code}