X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=3bc9257c65ab978a255829a1ad1dea3d5ac20ff3;hb=d76c18e05f6366c23144624b696a02fbaa6d26e8;hp=fa91a0ac190d37c4c13416e00753600cfce1417c;hpb=7121d8296720cf1a79259350f361f5771210b23d;p=ghc-hetmet.git

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index fa91a0a..3bc9257 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -185,14 +185,17 @@ import IdInfo		( IdInfo, CafInfo(..), WorkerInfo(..),
 import NewDemand	( isTopSig )
 import CoreSyn
 import Class		( classExtraBigSig, classTyCon )
-import TyCon		( TyCon, AlgTyConRhs(..), isRecursiveTyCon, isForeignTyCon,
+import TyCon		( TyCon, AlgTyConRhs(..), SynTyConRhs(..),
+			  isRecursiveTyCon, isForeignTyCon, 
 			  isSynTyCon, isAlgTyCon, isPrimTyCon, isFunTyCon,
 			  isTupleTyCon, tupleTyConBoxity, tyConStupidTheta,
 			  tyConHasGenerics, synTyConRhs, isGadtSyntaxTyCon,
-			  tyConArity, tyConTyVars, algTyConRhs, tyConExtName  )
+			  tyConArity, tyConTyVars, algTyConRhs, tyConExtName,
+			  tyConFamInst_maybe, tyConFamInstIndex )
 import DataCon		( dataConName, dataConFieldLabels, dataConStrictMarks,
-			  dataConTyCon, dataConIsInfix, dataConUnivTyVars, dataConExTyVars, dataConEqSpec,
-			  dataConTheta, dataConOrigArgTys )
+			  dataConTyCon, dataConIsInfix, dataConUnivTyVars,
+			  dataConExTyVars, dataConEqSpec, dataConTheta,
+			  dataConOrigArgTys ) 
 import Type		( TyThing(..), splitForAllTys, funResultTy )
 import TcType		( deNoteType )
 import TysPrim		( alphaTyVars )
@@ -376,17 +379,17 @@ mkExtNameFn hsc_env eps this_mod
     	occ	 = nameOccName name
     	par_occ  = nameOccName (nameParent name)
     		-- The version of the *parent* is the one want
-    	vers     = lookupVersion mod par_occ
+    	vers     = lookupVersion mod par_occ occ
     	      
-    lookupVersion :: Module -> OccName -> Version
+    lookupVersion :: Module -> OccName -> OccName -> Version
 	-- Even though we're looking up a home-package thing, in
 	-- one-shot mode the imported interfaces may be in the PIT
-    lookupVersion mod occ
-      = mi_ver_fn iface occ `orElse` 
-        pprPanic "lookupVers1" (ppr mod <+> ppr occ)
+    lookupVersion mod par_occ occ
+      = mi_ver_fn iface par_occ `orElse` 
+        pprPanic "lookupVers1" (ppr mod <+> ppr par_occ <+> ppr occ)
       where
         iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse` 
-	        pprPanic "lookupVers2" (ppr mod <+> ppr occ)
+	        pprPanic "lookupVers2" (ppr mod <+> ppr par_occ <+> ppr occ)
 
 
 ---------------------
@@ -996,10 +999,12 @@ tyThingToIfaceDecl ext (AClass clas)
 		 ifName	  = getOccName clas,
 		 ifTyVars = toIfaceTvBndrs clas_tyvars,
 		 ifFDs    = map toIfaceFD clas_fds,
+		 ifATs	  = map (tyThingToIfaceDecl ext . ATyCon) clas_ats,
 		 ifSigs	  = map toIfaceClassOp op_stuff,
 	  	 ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
   where
-    (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
+    (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff) 
+      = classExtraBigSig clas
     tycon = classTyCon clas
 
     toIfaceClassOp (sel_id, def_meth)
@@ -1018,9 +1023,10 @@ tyThingToIfaceDecl ext (AClass clas)
 
 tyThingToIfaceDecl ext (ATyCon tycon)
   | isSynTyCon tycon
-  = IfaceSyn {	ifName   = getOccName tycon,
-		ifTyVars = toIfaceTvBndrs tyvars,
-		ifSynRhs = toIfaceType ext syn_ty }
+  = IfaceSyn {	ifName    = getOccName tycon,
+		ifTyVars  = toIfaceTvBndrs tyvars,
+		ifOpenSyn = syn_isOpen,
+		ifSynRhs  = toIfaceType ext syn_tyki }
 
   | isAlgTyCon tycon
   = IfaceData {	ifName    = getOccName tycon,
@@ -1029,7 +1035,9 @@ tyThingToIfaceDecl ext (ATyCon tycon)
 		ifCons    = ifaceConDecls (algTyConRhs tycon),
 	  	ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
 		ifGadtSyntax = isGadtSyntaxTyCon tycon,
-		ifGeneric = tyConHasGenerics tycon }
+		ifGeneric = tyConHasGenerics tycon,
+		ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
+					   (tyConFamInstIndex tycon) }
 
   | isForeignTyCon tycon
   = IfaceForeign { ifName    = getOccName tycon,
@@ -1043,15 +1051,22 @@ tyThingToIfaceDecl ext (ATyCon tycon)
 		ifCons    = IfAbstractTyCon,
 		ifGadtSyntax = False,
 		ifGeneric = False,
-		ifRec     = NonRecursive}
+		ifRec     = NonRecursive,
+		ifFamInst = Nothing }
 
   | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
   where
     tyvars = tyConTyVars tycon
-    syn_ty = synTyConRhs tycon
-
-    ifaceConDecls (NewTyCon { data_con = con })    = IfNewTyCon  (ifaceConDecl con)
-    ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
+    (syn_isOpen, syn_tyki) = case synTyConRhs tycon of
+			       OpenSynTyCon ki -> (True , ki)
+			       SynonymTyCon ty -> (False, ty)
+
+    ifaceConDecls (NewTyCon { data_con = con })    = 
+      IfNewTyCon  (ifaceConDecl con)
+    ifaceConDecls (DataTyCon { data_cons = cons }) = 
+      IfDataTyCon (map ifaceConDecl cons)
+    ifaceConDecls OpenDataTyCon                    = IfOpenDataTyCon
+    ifaceConDecls OpenNewTyCon                     = IfOpenNewTyCon
     ifaceConDecls AbstractTyCon			   = IfAbstractTyCon
 	-- The last case happens when a TyCon has been trimmed during tidying
 	-- Furthermore, tyThingToIfaceDecl is also used
@@ -1065,12 +1080,18 @@ tyThingToIfaceDecl ext (ATyCon tycon)
 		    ifConExTvs   = toIfaceTvBndrs (dataConExTyVars data_con),
 		    ifConEqSpec  = to_eq_spec (dataConEqSpec data_con),
 		    ifConCtxt    = toIfaceContext ext (dataConTheta data_con),
-		    ifConArgTys  = map (toIfaceType ext) (dataConOrigArgTys data_con),
-		    ifConFields  = map getOccName (dataConFieldLabels data_con),
+		    ifConArgTys  = map (toIfaceType ext) 
+				       (dataConOrigArgTys data_con),
+		    ifConFields  = map getOccName 
+				       (dataConFieldLabels data_con),
 		    ifConStricts = dataConStrictMarks data_con }
 
     to_eq_spec spec = [(getOccName tv, toIfaceType ext ty) | (tv,ty) <- spec]
 
+    famInstToIface Nothing                    _     = Nothing
+    famInstToIface (Just (famTyCon, instTys)) index = 
+      Just (toIfaceTyCon ext famTyCon, map (toIfaceType ext) instTys, index)
+
 tyThingToIfaceDecl ext (ADataCon dc)
  = pprPanic "toIfaceDecl" (ppr dc)	-- Should be trimmed out earlier