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 --import Outputable     ( Outputable(..) )
  30 import Pretty
  31 \end{code}
  32
  33 \begin{code}
  34 data Kind
  35   = TypeKind            -- Any type (incl unboxed types)
  36   | BoxedTypeKind       -- Any boxed type
  37   | UnboxedTypeKind     -- Any unboxed type
  38   | ArrowKind Kind Kind
  39   deriving Eq
  40
  41 mkArrowKind       = ArrowKind
  42 mkTypeKind        = TypeKind
  43 mkUnboxedTypeKind = UnboxedTypeKind
  44 mkBoxedTypeKind   = BoxedTypeKind
  45
  46 isTypeKind :: Kind -> Bool
  47 isTypeKind TypeKind = True
  48 isTypeKind other    = False
  49
  50 isBoxedTypeKind :: Kind -> Bool
  51 isBoxedTypeKind BoxedTypeKind = True
  52 isBoxedTypeKind other         = False
  53
  54 isUnboxedTypeKind :: Kind -> Bool
  55 isUnboxedTypeKind UnboxedTypeKind = True
  56 isUnboxedTypeKind other           = False
  57
  58 hasMoreBoxityInfo :: Kind -> Kind -> Bool
  59
  60 BoxedTypeKind   `hasMoreBoxityInfo` TypeKind        = True
  61 BoxedTypeKind   `hasMoreBoxityInfo` BoxedTypeKind   = True
  62
  63 UnboxedTypeKind `hasMoreBoxityInfo` TypeKind        = True
  64 UnboxedTypeKind `hasMoreBoxityInfo` UnboxedTypeKind = True
  65
  66 TypeKind        `hasMoreBoxityInfo` TypeKind        = True
  67
  68 kind1@(ArrowKind _ _) `hasMoreBoxityInfo` kind2@(ArrowKind _ _) = ASSERT( kind1 == kind2 )
  69                                                                   True
  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.
  73
  74 kind1           `hasMoreBoxityInfo` kind2           = False
  75
  76 notArrowKind (ArrowKind _ _) = False
  77 notArrowKind other_kind      = True
  78
  79 resultKind :: Kind -> Kind      -- Get result from arrow kind
  80 resultKind (ArrowKind _ res_kind) = res_kind
  81 resultKind other_kind             = panic "resultKind"
  82
  83 argKind :: Kind -> Kind         -- Get argument from arrow kind
  84 argKind (ArrowKind arg_kind _) = arg_kind
  85 argKind other_kind             = panic "argKind"
  86 \end{code}
  87
  88 Printing
  89 ~~~~~~~~
  90 \begin{code}
  91 instance Outputable Kind where
  92   ppr sty kind = pprKind kind
  93
  94 pprKind TypeKind        = ppStr "**"    -- Can be boxed or unboxed
  95 pprKind BoxedTypeKind   = ppStr "*"
  96 pprKind UnboxedTypeKind = ppStr "*#"    -- Unboxed
  97 pprKind (ArrowKind k1 k2) = ppSep [pprParendKind k1, ppStr "->", pprKind k2]
  98
  99 pprParendKind k@(ArrowKind _ _) = ppBesides [ppLparen, pprKind k, ppRparen]
 100 pprParendKind k                 = pprKind k
 101 \end{code}