X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=fa9e0ec14cb40dbe69498d95bd13a3137c9eca74;hb=83a8fc9f6e04436784693a2188a58eac9c3e9664;hp=8849b1e97d24e0923420f2b1e3b1d548b509eef6;hpb=dcad0717256d926dcc3ff35e9752a2e9fba70faa;p=ghc-hetmet.git diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 8849b1e..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 @@ -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