X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=fa9e0ec14cb40dbe69498d95bd13a3137c9eca74;hb=83a8fc9f6e04436784693a2188a58eac9c3e9664;hp=ce6f4a30ab6e8b00aed6e7d6e05e7ce5f2315584;hpb=215ce9f15215399ce30ae55c9521087847d78646;p=ghc-hetmet.git

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index ce6f4a3..fa9e0ec 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -62,6 +62,7 @@ import Class
 import TyCon
 import DataCon
 import Type
+import Coercion
 import TcType
 import InstEnv
 import FamInstEnv
@@ -318,7 +319,10 @@ mkIface_ hsc_env maybe_old_fingerprint
      le_occ n1 n2 = nameOccName n1 <= nameOccName n2
 
      dflags = hsc_dflags hsc_env
+
+     deliberatelyOmitted :: String -> a
      deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
+
      ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
 
      flattenVectInfo (VectInfo { vectInfoVar   = vVar
@@ -855,7 +859,7 @@ mk_usage_info pit hsc_env this_mod direct_imports used_names
         | isWiredInName name = mv_map  -- ignore wired-in names
         | otherwise
         = case nameModule_maybe name of
-             Nothing  -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
+             Nothing  -> pprPanic "mkUsageInfo: internal name?" (ppr name)
              Just mod -> -- We use this fiddly lambda function rather than
                          -- (++) as the argument to extendModuleEnv_C to
                          -- avoid quadratic behaviour (trac #2680)
@@ -1333,7 +1337,7 @@ tyThingToIfaceDecl (AClass clas)
 
     toIfaceClassOp (sel_id, def_meth)
 	= ASSERT(sel_tyvars == clas_tyvars)
-	  IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
+	  IfaceClassOp (getOccName sel_id) (toDmSpec def_meth) (toIfaceType op_ty)
 	where
 		-- Be careful when splitting the type, because of things
 		-- like  	class Foo a where
@@ -1343,6 +1347,10 @@ tyThingToIfaceDecl (AClass clas)
 	  (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
 	  op_ty		       = funResultTy rho_ty
 
+    toDmSpec NoDefMeth   = NoDM
+    toDmSpec GenDefMeth  = GenericDM
+    toDmSpec (DefMeth _) = VanillaDM
+
     toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
 
 tyThingToIfaceDecl (ATyCon tycon)
@@ -1373,14 +1381,14 @@ tyThingToIfaceDecl (ATyCon tycon)
     tyvars = tyConTyVars tycon
     (syn_rhs, syn_ki) 
        = case synTyConRhs tycon of
-	    OpenSynTyCon ki _ -> (Nothing,               toIfaceType ki)
-	    SynonymTyCon ty   -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
+	    SynFamilyTyCon  -> (Nothing,               toIfaceType (synTyConResKind tycon))
+	    SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
 
     ifaceConDecls (NewTyCon { data_con = con })     = 
       IfNewTyCon  (ifaceConDecl con)
     ifaceConDecls (DataTyCon { data_cons = cons })  = 
       IfDataTyCon (map ifaceConDecl cons)
-    ifaceConDecls OpenTyCon {}                      = IfOpenDataTyCon
+    ifaceConDecls DataFamilyTyCon {}                = IfOpenDataTyCon
     ifaceConDecls AbstractTyCon			    = IfAbstractTyCon
 	-- The last case happens when a TyCon has been trimmed during tidying
 	-- Furthermore, tyThingToIfaceDecl is also used
@@ -1541,7 +1549,7 @@ toIfUnfolding lb unf@(CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
 	-- have stuck in NoUnfolding.  For supercompilation we want 
 	-- to see that unfolding!
 
-toIfUnfolding lb (DFunUnfolding _con ops)
+toIfUnfolding lb (DFunUnfolding _ar _con ops)
   = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
       -- No need to serialise the data constructor; 
       -- we can recover it from the type of the dfun