X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FIfaceType.lhs;h=70399e7e814f143cb0672ee90950b8a783541fbd;hp=bf0f3831b4e3826254a822269fa07ad93dbacd4f;hb=9da4639011348fb6c318e3cba4b08622f811d9c4;hpb=a73d6d950f6599d35f1e0aeb80d30112816a6928

diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs
index bf0f383..70399e7 100644
--- a/compiler/iface/IfaceType.lhs
+++ b/compiler/iface/IfaceType.lhs
@@ -7,10 +7,10 @@
 \begin{code}
 module IfaceType (
 	IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
-	IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr,
+	IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
 
 	IfaceExtName(..), mkIfaceExtName, isLocalIfaceExtName,
-	ifaceTyConName, interactiveExtNameFun,
+	ifaceTyConName,
 
 	-- Conversion from Type -> IfaceType
 	toIfaceType, toIfacePred, toIfaceContext, 
@@ -26,15 +26,17 @@ module IfaceType (
 
 #include "HsVersions.h"
 
-import Kind		( Kind(..) )
-import TypeRep		( TyThing(..), Type(..), PredType(..), ThetaType )
+import TypeRep		( TyThing(..), Type(..), PredType(..), ThetaType,
+                          unliftedTypeKindTyConName, openTypeKindTyConName,
+                          ubxTupleKindTyConName, argTypeKindTyConName,
+                          liftedTypeKindTyConName )
 import TyCon		( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity, tyConName )
 import Var		( isId, tyVarKind, idType )
 import TysWiredIn	( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
 import OccName		( OccName, parenSymOcc, occNameFS )
 import Name		( Name, getName, getOccName, nameModule, nameOccName,
 			  wiredInNameTyThing_maybe )
-import Module		( Module )
+import Module		( Module, ModuleName )
 import BasicTypes	( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
 import Outputable
 import FastString
@@ -49,13 +51,15 @@ import FastString
 
 \begin{code}
 data IfaceExtName
-  = ExtPkg Module OccName		-- From an external package; no version #
-					-- Also used for wired-in things regardless
-					-- of whether they are home-pkg or not
+  = ExtPkg Module OccName
+	-- From an external package; no version # Also used for
+	-- wired-in things regardless of whether they are home-pkg or
+	-- not
 
-  | HomePkg Module OccName Version	-- From another module in home package;
-					-- has version #; in all other respects,
-					-- HomePkg and ExtPkg are the same
+  | HomePkg ModuleName OccName Version
+	-- From another module in home package; has version #; in all
+	-- other respects, HomePkg and ExtPkg are the same. Since this
+	-- is a home package name, we use ModuleName rather than Module
 
   | LocalTop OccName			-- Top-level from the same module as 
 					-- the enclosing IfaceDecl
@@ -79,14 +83,6 @@ ifaceExtOcc (ExtPkg _ occ)    	= occ
 ifaceExtOcc (HomePkg _ occ _) 	= occ
 ifaceExtOcc (LocalTop occ)    	= occ
 ifaceExtOcc (LocalTopSub occ _) = occ
-
-interactiveExtNameFun :: PrintUnqualified -> Name-> IfaceExtName
-interactiveExtNameFun print_unqual name
-  | print_unqual mod occ = LocalTop occ
-  | otherwise		 = ExtPkg mod occ
-  where
-    mod = nameModule name
-    occ = nameOccName name
 \end{code}
 
 
@@ -105,7 +101,9 @@ type IfaceIdBndr  = (FastString, IfaceType)
 type IfaceTvBndr  = (FastString, IfaceKind)
 
 -------------------------------
-type IfaceKind = Kind			-- Re-use the Kind type, but no KindVars in it
+type IfaceKind = IfaceType			-- Re-use the Kind type, but no KindVars in it
+
+type IfaceCoercion = IfaceType
 
 data IfaceType
   = IfaceTyVar    FastString			-- Type variable only, not tycon
@@ -119,14 +117,19 @@ data IfaceType
 data IfacePredType 	-- NewTypes are handled as ordinary TyConApps
   = IfaceClassP IfaceExtName [IfaceType]
   | IfaceIParam (IPName OccName) IfaceType
+  | IfaceEqPred IfaceType IfaceType
 
 type IfaceContext = [IfacePredType]
 
+-- NB: If you add a data constructor, remember to add a case to
+--     IfaceSyn.eqIfTc!
 data IfaceTyCon 	-- Abbreviations for common tycons with known names
   = IfaceTc IfaceExtName	-- The common case
   | IfaceIntTc | IfaceBoolTc | IfaceCharTc
   | IfaceListTc | IfacePArrTc
   | IfaceTupTc Boxity Arity 
+  | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
+  | IfaceUbxTupleKindTc | IfaceArgTypeKindTc 
 
 ifaceTyConName :: IfaceTyCon -> Name	-- Works for all except IfaceTc
 ifaceTyConName IfaceIntTc  	  = intTyConName
@@ -135,7 +138,14 @@ ifaceTyConName IfaceCharTc 	  = charTyConName
 ifaceTyConName IfaceListTc 	  = listTyConName
 ifaceTyConName IfacePArrTc 	  = parrTyConName
 ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
+ifaceTyConName IfaceLiftedTypeKindTc   = liftedTypeKindTyConName
+ifaceTyConName IfaceOpenTypeKindTc     = openTypeKindTyConName
+ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
+ifaceTyConName IfaceUbxTupleKindTc     = ubxTupleKindTyConName
+ifaceTyConName IfaceArgTypeKindTc      = argTypeKindTyConName
 ifaceTyConName (IfaceTc ext)      = pprPanic "ifaceTyConName" (ppr ext)
+
+
 \end{code}
 
 
@@ -200,15 +210,12 @@ maybeParen ctxt_prec inner_prec pretty
 -- These instances are used only when printing for the user, either when
 -- debugging, or in GHCi when printing the results of a :info command
 instance Outputable IfaceExtName where
-    ppr (ExtPkg mod occ)       = pprExt mod occ
-    ppr (HomePkg mod occ vers) = pprExt mod occ <> braces (ppr vers)
+    ppr (ExtPkg mod occ)       = ppr mod <> dot <> ppr occ
+    ppr (HomePkg mod occ vers) = ppr mod <> dot <> ppr occ <> braces (ppr vers)
     ppr (LocalTop occ)	       = ppr occ	-- Do we want to distinguish these 
     ppr (LocalTopSub occ _)    = ppr occ	-- from an ordinary occurrence?
-
-pprExt :: Module -> OccName -> SDoc
 -- No need to worry about printing unqualified becuase that was handled
 -- in the transiation to IfaceSyn 
-pprExt mod occ = ppr mod <> dot <> ppr occ
 
 instance Outputable IfaceBndr where
     ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
@@ -220,9 +227,9 @@ pprIfaceBndrs bs = sep (map ppr bs)
 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
 
 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
-pprIfaceTvBndr (tv, LiftedTypeKind) = ppr tv
-pprIfaceTvBndr (tv, kind) 	    = parens (ppr tv <> dcolon <> ppr kind)
-
+pprIfaceTvBndr (tv, IfaceTyConApp IfaceLiftedTypeKindTc []) 
+  = ppr tv
+pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
 \end{code}
@@ -298,6 +305,7 @@ ppr_tc tc		   = ppr tc
 -------------------
 instance Outputable IfacePredType where
 	-- Print without parens
+  ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext SLIT(":=:"), ppr ty2]
   ppr (IfaceIParam ip ty)  = hsep [ppr ip, dcolon, ppr ty]
   ppr (IfaceClassP cls ts) = parenSymOcc (ifaceExtOcc cls) (ppr cls)
 			     <+> sep (map pprParendIfaceType ts)
@@ -327,7 +335,7 @@ pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
 
 \begin{code}
 ----------------
-toIfaceTvBndr tyvar   = (occNameFS (getOccName tyvar), tyVarKind tyvar)
+toIfaceTvBndr tyvar   = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
 toIfaceIdBndr ext id  = (occNameFS (getOccName id),    toIfaceType ext (idType id))
 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
 
@@ -335,6 +343,9 @@ toIfaceBndr ext var
   | isId var  = IfaceIdBndr (toIfaceIdBndr ext var)
   | otherwise = IfaceTvBndr (toIfaceTvBndr var)
 
+-- we had better not have to use ext for kinds
+toIfaceKind = toIfaceType (\name -> pprPanic "toIfaceKind ext used on:" (ppr name))
+
 ---------------------
 toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType
 -- Synonyms are retained in the interface type
@@ -368,20 +379,26 @@ toIfaceTyCon_name ext nm
 
 toIfaceWiredInTyCon :: (Name -> IfaceExtName) -> TyCon -> Name -> IfaceTyCon
 toIfaceWiredInTyCon ext tc nm
-  | isTupleTyCon tc     = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
-  | nm == intTyConName  = IfaceIntTc
-  | nm == boolTyConName = IfaceBoolTc 
-  | nm == charTyConName = IfaceCharTc 
-  | nm == listTyConName = IfaceListTc 
-  | nm == parrTyConName = IfacePArrTc 
-  | otherwise		= IfaceTc (ext nm)
+  | isTupleTyCon tc                 =  IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
+  | nm == intTyConName              = IfaceIntTc
+  | nm == boolTyConName             = IfaceBoolTc 
+  | nm == charTyConName             = IfaceCharTc 
+  | nm == listTyConName             = IfaceListTc 
+  | nm == parrTyConName             = IfacePArrTc 
+  | nm == liftedTypeKindTyConName   = IfaceLiftedTypeKindTc
+  | nm == unliftedTypeKindTyConName = IfaceUnliftedTypeKindTc
+  | nm == openTypeKindTyConName     = IfaceOpenTypeKindTc
+  | nm == argTypeKindTyConName      = IfaceArgTypeKindTc
+  | nm == ubxTupleKindTyConName     = IfaceUbxTupleKindTc
+  | otherwise		            = IfaceTc (ext nm)
 
 ----------------
 toIfaceTypes ext ts = map (toIfaceType ext) ts
 
 ----------------
-toIfacePred ext (ClassP cls ts) = IfaceClassP (ext (getName cls)) (toIfaceTypes ext ts)
-toIfacePred ext (IParam ip t)   = IfaceIParam (mapIPName getOccName ip) (toIfaceType ext t)
+toIfacePred ext (ClassP cls ts)  = IfaceClassP (ext (getName cls)) (toIfaceTypes ext ts)
+toIfacePred ext (IParam ip t)    = IfaceIParam (mapIPName getOccName ip) (toIfaceType ext t)
+toIfacePred ext (EqPred ty1 ty2) = IfaceEqPred (toIfaceType ext ty1) (toIfaceType ext ty2)
 
 ----------------
 toIfaceContext :: (Name -> IfaceExtName) -> ThetaType -> IfaceContext