X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fiface%2FIfaceType.lhs;h=2056a33f09b738c87815d990c5de6d76a7f74061;hb=6cfd14d1fca66eac8a1247f0a86aa11521650106;hp=9853a04ea4da00839a61a30dc9d96777963b1981;hpb=839d23a4ddbb27409eebc8c1f33a04ab4a0f1654;p=ghc-hetmet.git

diff --git a/ghc/compiler/iface/IfaceType.lhs b/ghc/compiler/iface/IfaceType.lhs
index 9853a04..2056a33 100644
--- a/ghc/compiler/iface/IfaceType.lhs
+++ b/ghc/compiler/iface/IfaceType.lhs
@@ -15,6 +15,7 @@ module IfaceType (
 	-- Conversion from Type -> IfaceType
 	toIfaceType, toIfacePred, toIfaceContext, 
 	toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs, 
+	toIfaceTyCon, toIfaceTyCon_name,
 
 	-- Printing
 	pprIfaceType, pprParendIfaceType, pprIfaceContext, 
@@ -26,12 +27,13 @@ module IfaceType (
 #include "HsVersions.h"
 
 import Kind		( Kind(..) )
-import TypeRep		( Type(..), TyNote(..), PredType(..), ThetaType )
-import TyCon		( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity )
+import TypeRep		( TyThing(..), Type(..), TyNote(..), PredType(..), ThetaType )
+import TyCon		( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity, tyConName )
 import Var		( isId, tyVarKind, idType )
 import TysWiredIn	( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
 import OccName		( OccName, parenSymOcc )
-import Name		( Name, getName, getOccName, nameModule, nameOccName )
+import Name		( Name, getName, getOccName, nameModule, nameOccName,
+			  wiredInNameTyThing_maybe )
 import Module		( Module )
 import BasicTypes	( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
 import Outputable
@@ -335,18 +337,37 @@ toIfaceBndr ext var
 
 ---------------------
 toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType
+-- Synonyms are retained in the interface type
 toIfaceType ext (TyVarTy tv)     	     = IfaceTyVar (getOccName tv)
 toIfaceType ext (AppTy t1 t2)    	     = IfaceAppTy (toIfaceType ext t1) (toIfaceType ext t2)
 toIfaceType ext (FunTy t1 t2)    	     = IfaceFunTy (toIfaceType ext t1) (toIfaceType ext t2)
-toIfaceType ext (TyConApp tc tys) 	     = IfaceTyConApp (mkIfaceTc ext tc) (toIfaceTypes ext tys)
+toIfaceType ext (TyConApp tc tys) 	     = IfaceTyConApp (toIfaceTyCon ext tc) (toIfaceTypes ext tys)
 toIfaceType ext (ForAllTy tv t)  	     = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType ext t)
 toIfaceType ext (PredTy st)     	     = IfacePredTy (toIfacePred ext st)
-toIfaceType ext (NoteTy (SynNote tc_app) ty) = toIfaceType ext tc_app	-- Retain synonyms
 toIfaceType ext (NoteTy other_note ty)	     = toIfaceType ext ty
 
 ----------------
-mkIfaceTc :: (Name -> IfaceExtName) -> TyCon -> IfaceTyCon
-mkIfaceTc ext tc 
+-- A little bit of (perhaps optional) trickiness here.  When
+-- compiling Data.Tuple, the tycons are not TupleTyCons, although
+-- they have a wired-in name.  But we'd like to dump them into the Iface
+-- as a tuple tycon, to save lookups when reading the interface
+-- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
+-- toIfaceTyCon_name will still catch it.
+
+toIfaceTyCon :: (Name -> IfaceExtName) -> TyCon -> IfaceTyCon
+toIfaceTyCon ext tc 
+  | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
+  | otherwise	    = toIfaceTyCon_name ext (tyConName tc)
+
+toIfaceTyCon_name :: (Name -> IfaceExtName) -> Name -> IfaceTyCon
+toIfaceTyCon_name ext nm
+  | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
+  = toIfaceWiredInTyCon ext tc nm
+  | otherwise
+  = IfaceTc (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 
@@ -354,8 +375,6 @@ mkIfaceTc ext tc
   | nm == listTyConName = IfaceListTc 
   | nm == parrTyConName = IfacePArrTc 
   | otherwise		= IfaceTc (ext nm)
-  where
-    nm = getName tc
 
 ----------------
 toIfaceTypes ext ts = map (toIfaceType ext) ts