X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fiface%2FIfaceType.lhs;h=1c1412a81282c768809f874f5d20396e9aae8657;hb=3721dd37a707d2aacb5cac814410a78096e28a2c;hp=04ca8ebcc80bfd5f91005049734c7b1324a07ef1;hpb=576650d4966549866ad2d07d618f99c9a0c7529d;p=ghc-hetmet.git

diff --git a/ghc/compiler/iface/IfaceType.lhs b/ghc/compiler/iface/IfaceType.lhs
index 04ca8eb..1c1412a 100644
--- a/ghc/compiler/iface/IfaceType.lhs
+++ b/ghc/compiler/iface/IfaceType.lhs
@@ -6,17 +6,16 @@
 
 \begin{code}
 module IfaceType (
-	IfaceType(..), IfaceKind(..), IfacePredType(..), IfaceTyCon(..),
+	IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
 	IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr,
 
 	IfaceExtName(..), mkIfaceExtName, ifaceTyConName, 
 
 	-- Conversion from Type -> IfaceType
-	toIfaceType, toIfaceKind, toIfacePred, toIfaceContext, 
+	toIfaceType, toIfacePred, toIfaceContext, 
 	toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs, 
 
 	-- Printing
-	pprIfaceKind, pprParendIfaceKind, 
 	pprIfaceType, pprParendIfaceType, pprIfaceContext, 
 	pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
 	getIfaceExt,
@@ -26,8 +25,7 @@ module IfaceType (
 
 #include "HsVersions.h"
 
-import Type		( openTypeKind, liftedTypeKind, unliftedTypeKind,
-			  splitFunTy_maybe, eqKind )
+import Kind		( Kind(..) )
 import TypeRep		( Type(..), TyNote(..), PredType(..), Kind, ThetaType )
 import TyCon		( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity )
 import Var		( isId, tyVarKind, idType )
@@ -38,10 +36,6 @@ import Module		( ModuleName )
 import BasicTypes	( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
 import Outputable
 import FastString
-
-#ifdef DEBUG
-import TypeRep( crudePprType )
-#endif
 \end{code}
 
 	
@@ -89,14 +83,8 @@ type IfaceIdBndr  = (OccName, IfaceType)	-- OccName, because always local
 type IfaceTvBndr  = (OccName, IfaceKind)
 
 -------------------------------
-data IfaceKind 
-  = IfaceLiftedTypeKind 
-  | IfaceOpenTypeKind
-  | IfaceUnliftedTypeKind
-  | IfaceFunKind IfaceKind IfaceKind
-  deriving( Eq )
+type IfaceKind = Kind			-- Re-use the Kind type, but no KindVars in it
 
--------------------------------
 data IfaceType
   = IfaceTyVar    OccName		-- Type variable only, not tycon
   | IfaceAppTy    IfaceType IfaceType
@@ -220,8 +208,8 @@ pprIfaceBndrs bs = sep (map ppr bs)
 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
 
 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
-pprIfaceTvBndr (tv, IfaceLiftedTypeKind) = ppr tv
-pprIfaceTvBndr (tv, kind) 		 = parens (ppr tv <> dcolon <> ppr kind)
+pprIfaceTvBndr (tv, LiftedTypeKind) = ppr tv
+pprIfaceTvBndr (tv, kind) 	    = parens (ppr tv <> dcolon <> ppr kind)
 
 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
@@ -231,19 +219,6 @@ pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
 
 \begin{code}
 ---------------------------------
-instance Outputable IfaceKind where
-  ppr k = pprIfaceKind tOP_PREC k
-
-pprParendIfaceKind :: IfaceKind -> SDoc
-pprParendIfaceKind k = pprIfaceKind tYCON_PREC k
-
-pprIfaceKind prec IfaceLiftedTypeKind   = ptext SLIT("*")
-pprIfaceKind prec IfaceUnliftedTypeKind = ptext SLIT("#")
-pprIfaceKind prec IfaceOpenTypeKind     = ptext SLIT("?")
-pprIfaceKind prec (IfaceFunKind k1 k2)  = maybeParen prec fUN_PREC $
-				          sep [ pprIfaceKind fUN_PREC k1, arrow <+> ppr k2]
-
----------------------------------
 instance Outputable IfaceType where
   ppr ty = ppr_ty ty
 
@@ -256,7 +231,7 @@ pprIfaceType :: Int -> IfaceType -> SDoc
 	-- Simple cases
 pprIfaceType ctxt_prec (IfaceTyVar tyvar)     = ppr tyvar
 pprIfaceType ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
-pprIfaceType ctxt_prec (IfacePredTy st)     = braces (ppr st)
+pprIfaceType ctxt_prec (IfacePredTy st)       = braces (ppr st)
 
 	-- Function types
 pprIfaceType ctxt_prec (IfaceFunTy ty1 ty2)
@@ -325,7 +300,7 @@ pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
 
 \begin{code}
 ----------------
-toIfaceTvBndr tyvar   = (getOccName tyvar, toIfaceKind (tyVarKind tyvar))
+toIfaceTvBndr tyvar   = (getOccName tyvar, tyVarKind tyvar)
 toIfaceIdBndr ext id  = (getOccName id,    toIfaceType ext (idType id))
 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
 
@@ -334,18 +309,6 @@ toIfaceBndr ext var
   | otherwise = IfaceTvBndr (toIfaceTvBndr var)
 
 ---------------------
-toIfaceKind :: Kind -> IfaceKind
-toIfaceKind k 
-  | k `eqKind` openTypeKind     = IfaceOpenTypeKind
-  | k `eqKind` liftedTypeKind   = IfaceLiftedTypeKind
-  | k `eqKind` unliftedTypeKind = IfaceUnliftedTypeKind
-  | Just (arg,res) <- splitFunTy_maybe k 
-  = IfaceFunKind (toIfaceKind arg) (toIfaceKind res)
-#ifdef DEBUG
-  | otherwise = pprPanic "toIfaceKind" (crudePprType k)
-#endif
-
----------------------
 toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType
 toIfaceType ext (TyVarTy tv)     	     = IfaceTyVar (getOccName tv)
 toIfaceType ext (AppTy t1 t2)    	     = IfaceAppTy (toIfaceType ext t1) (toIfaceType ext t2)