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         isUnboxedKind, isTypeKind,
  21         notArrowKind
  22     ) where
  23
  24 IMP_Ubiq(){-uitous-}
  25
  26 import Util             ( panic, assertPanic )
  27 --import Outputable     ( Outputable(..) )
  28 import Pretty
  29 \end{code}
  30
  31 \begin{code}
  32 data Kind
  33   = TypeKind            -- Any type (incl unboxed types)
  34   | BoxedTypeKind       -- Any boxed type
  35   | UnboxedTypeKind     -- Any unboxed type
  36   | ArrowKind Kind Kind
  37   deriving Eq
  38
  39 mkArrowKind       = ArrowKind
  40 mkTypeKind        = TypeKind
  41 mkUnboxedTypeKind = UnboxedTypeKind
  42 mkBoxedTypeKind   = BoxedTypeKind
  43
  44 isTypeKind :: Kind -> Bool
  45 isTypeKind TypeKind = True
  46 isTypeKind other    = False
  47
  48 isUnboxedKind :: Kind -> Bool
  49 isUnboxedKind UnboxedTypeKind   = True
  50 isUnboxedKind other             = False
  51
  52 hasMoreBoxityInfo :: Kind -> Kind -> Bool
  53
  54 BoxedTypeKind   `hasMoreBoxityInfo` TypeKind        = True
  55 BoxedTypeKind   `hasMoreBoxityInfo` BoxedTypeKind   = True
  56
  57 UnboxedTypeKind `hasMoreBoxityInfo` TypeKind        = True
  58 UnboxedTypeKind `hasMoreBoxityInfo` UnboxedTypeKind = True
  59
  60 TypeKind        `hasMoreBoxityInfo` TypeKind        = True
  61
  62 kind1@(ArrowKind _ _) `hasMoreBoxityInfo` kind2@(ArrowKind _ _) = ASSERT( kind1 == kind2 )
  63                                                                   True
  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.
  67
  68 kind1           `hasMoreBoxityInfo` kind2           = False
  69
  70 notArrowKind (ArrowKind _ _) = False
  71 notArrowKind other_kind      = True
  72
  73 resultKind :: Kind -> Kind      -- Get result from arrow kind
  74 resultKind (ArrowKind _ res_kind) = res_kind
  75 resultKind other_kind             = panic "resultKind"
  76
  77 argKind :: Kind -> Kind         -- Get argument from arrow kind
  78 argKind (ArrowKind arg_kind _) = arg_kind
  79 argKind other_kind             = panic "argKind"
  80 \end{code}
  81
  82 Printing
  83 ~~~~~~~~
  84 \begin{code}
  85 instance Outputable Kind where
  86   ppr sty kind = pprKind kind
  87
  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]
  92
  93 pprKind_parend k@(ArrowKind _ _) = ppBesides [ppLparen, pprKind k, ppRparen]
  94 pprKind_parend k                 = pprKind k
  95 \end{code}