[project @ 1997-08-25 22:34:28 by sof]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcKind.lhs

diff --git a/ghc/compiler/typecheck/TcKind.lhs b/ghc/compiler/typecheck/TcKind.lhs
index 05b4a03..bafa1fb 100644 (file)
--- a/ghc/compiler/typecheck/TcKind.lhs
+++ b/ghc/compiler/typecheck/TcKind.lhs
@@ -1,9 +1,11 @@
 \begin{code}
+#include "HsVersions.h"
+
 module TcKind (
 
        Kind, mkTypeKind, mkBoxedTypeKind, mkUnboxedTypeKind, mkArrowKind, 
-       isSubKindOf,    -- Kind -> Kind -> Bool
-       resultKind,     -- Kind -> Kind
+       hasMoreBoxityInfo,      -- Kind -> Kind -> Bool
+       resultKind,             -- Kind -> Kind
 
        TcKind, mkTcTypeKind, mkTcArrowKind, mkTcVarKind,
        newKindVar,     -- NF_TcM s (TcKind s)
@@ -14,12 +16,15 @@ module TcKind (
        tcDefaultKind   -- TcKind s -> NF_TcM s Kind
   ) where
 
+IMP_Ubiq(){-uitous-}
+
 import Kind
 import TcMonad
 
-import Ubiq
 import Unique  ( Unique, pprUnique10 )
 import Pretty
+import Util    ( nOfThem )
+import Outputable
 \end{code}
 
 
@@ -39,7 +44,7 @@ newKindVar = tcGetUnique              `thenNF_Tc` \ uniq ->
             returnNF_Tc (TcVarKind uniq box)
 
 newKindVars :: Int -> NF_TcM s [TcKind s]
-newKindVars n = mapNF_Tc (\_->newKindVar) (take n (repeat ()))
+newKindVars n = mapNF_Tc (\ _ -> newKindVar) (nOfThem n ())
 \end{code}
 
 
@@ -172,16 +177,16 @@ zonkTcKind kind@(TcVarKind uniq box)
 
 \begin{code}
 instance Outputable (TcKind s) where
-  ppr sty kind = ppr_kind sty kind
+  ppr sty kind = pprQuote sty $ \ sty -> ppr_kind sty kind
 
 ppr_kind sty TcTypeKind 
-  = ppStr "*"
+  = char '*'
 ppr_kind sty (TcArrowKind kind1 kind2) 
-  = ppSep [ppr_parend sty kind1, ppStr "->", ppr_kind sty kind2]
+  = sep [ppr_parend sty kind1, ptext SLIT("->"), ppr_kind sty kind2]
 ppr_kind sty (TcVarKind uniq box) 
-  = ppBesides [ppStr "k", pprUnique10 uniq]
+  = hcat [char 'k', pprUnique10 uniq]
 
-ppr_parend sty kind@(TcArrowKind _ _) = ppBesides [ppChar '(', ppr_kind sty kind, ppChar ')']
+ppr_parend sty kind@(TcArrowKind _ _) = hcat [char '(', ppr_kind sty kind, char ')']
 ppr_parend sty other_kind            = ppr_kind sty other_kind
 \end{code}
 
@@ -191,20 +196,17 @@ Errors and contexts
 ~~~~~~~~~~~~~~~~~~~
 \begin{code}
 unifyKindCtxt kind1 kind2 sty
-  = ppHang (ppStr "When unifying two kinds") 4
-          (ppSep [ppr sty kind1, ppStr "and", ppr sty kind2])
+  = hang (ptext SLIT("When unifying two kinds")) 4
+          (sep [ppr sty kind1, ptext SLIT("and"), ppr sty kind2])
 
 kindOccurCheck kind1 kind2 sty
-  = ppHang (ppStr "Cannot construct the infinite kind:") 4
-       (ppSep [ppBesides [ppStr "`", ppr sty kind1, ppStr "'"],
-               ppStr "=",
-               ppBesides [ppStr "`", ppr sty kind1, ppStr "'"],
-               ppStr "(\"occurs check\")"])
+  = hang (ptext SLIT("Cannot construct the infinite kind:")) 4
+       (sep [ppr sty kind1, equals, ppr sty kind1, ptext SLIT("(\"occurs check\")")])
 
 kindMisMatchErr kind1 kind2 sty
- = ppHang (ppStr "Couldn't match the kind") 4
-       (ppSep [ppBesides [ppStr "`", ppr sty kind1, ppStr "'"],
-               ppStr "against",
-               ppBesides [ppStr "`", ppr sty kind2, ppStr "'"]
-       ])
+ = hang (ptext SLIT("Couldn't match the kind")) 4
+       (sep [ppr sty kind1,
+             ptext SLIT("against"),
+             ppr sty kind2]
+       )
 \end{code}