[project @ 1996-04-05 08:26:04 by partain]

[ghc-hetmet.git] / ghc / compiler / types / Kind.lhs

diff --git a/ghc/compiler/types/Kind.lhs b/ghc/compiler/types/Kind.lhs
index 0b247e4..945c66b 100644 (file)
--- a/ghc/compiler/types/Kind.lhs
+++ b/ghc/compiler/types/Kind.lhs
@@ -19,6 +19,8 @@ module Kind (
 import Ubiq{-uitous-}
 
 import Util            ( panic )
+import Outputable      ( Outputable(..) )
+import Pretty
 \end{code}
 
 \begin{code}
@@ -48,3 +50,18 @@ argKind :: Kind -> Kind              -- Get argument from arrow kind
 argKind (ArrowKind arg_kind _) = arg_kind
 argKind other_kind            = panic "argKind"
 \end{code}
+
+Printing
+~~~~~~~~
+\begin{code}
+instance Outputable Kind where
+  ppr sty kind = pprKind kind
+
+pprKind TypeKind        = ppStr "*"
+pprKind BoxedTypeKind   = ppStr "*b"
+pprKind UnboxedTypeKind = ppStr "*u"
+pprKind (ArrowKind k1 k2) = ppSep [pprKind_parend k1, ppStr "->", pprKind k2]
+
+pprKind_parend k@(ArrowKind _ _) = ppBesides [ppLparen, pprKind k, ppRparen]
+pprKind_parend k                = pprKind k
+\end{code}