X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FTcIface.lhs;h=2831c2dda737ae91215bad8ed458457d9f29ba7c;hb=909d2dd885f5eebaf7c12cf15d5ac153d646566e;hp=388d0402163cdc4cabe4f75fa21d6a231c646ab9;hpb=80c89b80c355b2aaebcd53330e6c6170c3f05aca;p=ghc-hetmet.git diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 388d040..2831c2d 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -361,21 +361,23 @@ tcIfaceDecl (IfaceData {ifName = occ_name, ifCons = rdr_cons, ifRec = is_rec, ifGeneric = want_generic, - ifFamily = mb_family }) + ifFamInst = mb_family }) = do { tc_name <- lookupIfaceTop occ_name ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do { tycon <- fixM ( \ tycon -> do { stupid_theta <- tcIfaceCtxt ctxt + ; famInst <- + case mb_family of + Nothing -> return Nothing + Just (fam, tys) -> + do { famTyCon <- tcIfaceTyCon fam + ; insttys <- mapM tcIfaceType tys + ; return $ Just (famTyCon, insttys) + } ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons - ; family <- case mb_family of - Nothing -> return Nothing - Just fam -> - do { famTyCon <- tcIfaceTyCon fam - ; return $ Just famTyCon - } ; buildAlgTyCon tc_name tyvars stupid_theta - cons is_rec want_generic gadt_syn family + cons is_rec want_generic gadt_syn famInst }) ; traceIf (text "tcIfaceDecl4" <+> ppr tycon) ; return (ATyCon tycon) @@ -437,7 +439,7 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs, ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec, ifConArgTys = args, ifConFields = field_lbls, - ifConStricts = stricts, ifConInstTys = mb_insttys }) + ifConStricts = stricts}) = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do bindIfaceTyVars ex_tvs $ \ ex_tyvars -> do { name <- lookupIfaceTop occ @@ -456,17 +458,12 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons -- the component types unless they are really needed ; arg_tys <- forkM (mk_doc name) (mappM tcIfaceType args) ; lbl_names <- mappM lookupIfaceTop field_lbls - ; mb_insttys' <- case mb_insttys of - Nothing -> return Nothing - Just insttys -> liftM Just $ - mappM tcIfaceType insttys ; buildDataCon name is_infix {- Not infix -} stricts lbl_names univ_tyvars ex_tyvars eq_spec theta arg_tys tycon - mb_insttys' } mk_doc con_name = ptext SLIT("Constructor") <+> ppr con_name