X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=88dbfa366460e90c057dda08d61b650a197f8306;hb=cd54b707b0d77a3c62ee9f57b82dae98727f1c34;hp=c0d49a36dbc1f8cf376152dded3178f072b9d9ef;hpb=3e0a7b9fbc16e432efa562df027d189fa274943a;p=ghc-hetmet.git diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index c0d49a3..88dbfa3 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -59,10 +59,10 @@ import Annotations import CoreSyn import CoreFVs import Class +import Kind import TyCon import DataCon import Type -import Coercion import TcType import InstEnv import FamInstEnv @@ -900,8 +900,8 @@ mk_usage_info pit hsc_env this_mod direct_imports used_names finsts_mod = mi_finsts iface hash_env = mi_hash_fn iface mod_hash = mi_mod_hash iface - export_hash | depend_on_exports mod = Just (mi_exp_hash iface) - | otherwise = Nothing + export_hash | depend_on_exports = Just (mi_exp_hash iface) + | otherwise = Nothing used_occs = lookupModuleEnv ent_map mod `orElse` [] @@ -918,21 +918,21 @@ mk_usage_info pit hsc_env this_mod direct_imports used_names Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names) Just r -> r - depend_on_exports mod = - case lookupModuleEnv direct_imports mod of - Just _ -> True - -- Even if we used 'import M ()', we have to register a - -- usage on the export list because we are sensitive to - -- changes in orphan instances/rules. - Nothing -> False - -- In GHC 6.8.x the above line read "True", and in - -- fact it recorded a dependency on *all* the - -- modules underneath in the dependency tree. This - -- happens to make orphans work right, but is too - -- expensive: it'll read too many interface files. - -- The 'isNothing maybe_iface' check above saved us - -- from generating many of these usages (at least in - -- one-shot mode), but that's even more bogus! + depend_on_exports = is_direct_import + {- True + Even if we used 'import M ()', we have to register a + usage on the export list because we are sensitive to + changes in orphan instances/rules. + False + In GHC 6.8.x we always returned true, and in + fact it recorded a dependency on *all* the + modules underneath in the dependency tree. This + happens to make orphans work right, but is too + expensive: it'll read too many interface files. + The 'isNothing maybe_iface' check above saved us + from generating many of these usages (at least in + one-shot mode), but that's even more bogus! + -} \end{code} \begin{code} @@ -1387,14 +1387,16 @@ tyThingToIfaceDecl (ATyCon tycon) = IfCon { ifConOcc = getOccName (dataConName data_con), ifConInfix = dataConIsInfix data_con, ifConWrapper = isJust (dataConWrapId_maybe data_con), - ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con), - ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con), - ifConEqSpec = to_eq_spec (dataConEqSpec data_con), - ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con), - ifConArgTys = map toIfaceType (dataConOrigArgTys data_con), + ifConUnivTvs = toIfaceTvBndrs univ_tvs, + ifConExTvs = toIfaceTvBndrs ex_tvs, + ifConEqSpec = to_eq_spec eq_spec, + ifConCtxt = toIfaceContext theta, + ifConArgTys = map toIfaceType arg_tys, ifConFields = map getOccName (dataConFieldLabels data_con), ifConStricts = dataConStrictMarks data_con } + where + (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _) = dataConFullSig data_con to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec] @@ -1402,6 +1404,8 @@ tyThingToIfaceDecl (ATyCon tycon) famInstToIface (Just (famTyCon, instTys)) = Just (toIfaceTyCon famTyCon, map toIfaceType instTys) +tyThingToIfaceDecl c@(ACoAxiom _) = pprPanic "tyThingToIfaceDecl (ACoCon _)" (ppr c) + tyThingToIfaceDecl (ADataCon dc) = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier @@ -1431,7 +1435,7 @@ instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag, (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id) -- Slightly awkward: we need the Class to get the fundeps (tvs, fds) = classTvsFds cls - arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys] + arg_names = [filterNameSet is_local (orphNamesOfType ty) | ty <- tys] orph | is_local cls_name = Just (nameOccName cls_name) | all isJust mb_ns = ASSERT( not (null mb_ns) ) head mb_ns | otherwise = Nothing @@ -1549,10 +1553,10 @@ coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn}) = pprTrace "toHsRule: builtin" (ppr fn) $ bogusIfaceRule fn -coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn, - ru_act = act, ru_bndrs = bndrs, - ru_args = args, ru_rhs = rhs, - ru_auto = auto }) +coreRuleToIfaceRule mod rule@(Rule { ru_name = name, ru_fn = fn, + ru_act = act, ru_bndrs = bndrs, + ru_args = args, ru_rhs = rhs, + ru_auto = auto }) = IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = map toIfaceBndr bndrs, ifRuleHead = fn, @@ -1566,14 +1570,14 @@ coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn, -- construct the same ru_rough field as we have right now; -- see tcIfaceRule do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty)) + do_arg (Coercion co) = IfaceType (coToIfaceType co) + do_arg arg = toIfaceExpr arg -- Compute orphanhood. See Note [Orphans] in IfaceSyn -- A rule is an orphan only if none of the variables -- mentioned on its left-hand side are locally defined - lhs_names = fn : nameSetToList (exprsFreeNames args) - -- No need to delete bndrs, because - -- exprsFreeNames finds only External names + lhs_names = nameSetToList (ruleLhsOrphNames rule) orph = case filter (nameIsLocalOrFrom mod) lhs_names of (n : _) -> Just (nameOccName n) @@ -1587,15 +1591,16 @@ bogusIfaceRule id_name --------------------- toIfaceExpr :: CoreExpr -> IfaceExpr -toIfaceExpr (Var v) = toIfaceVar v -toIfaceExpr (Lit l) = IfaceLit l -toIfaceExpr (Type ty) = IfaceType (toIfaceType ty) -toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b) -toIfaceExpr (App f a) = toIfaceApp f [a] -toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as) -toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e) -toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co) -toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e) +toIfaceExpr (Var v) = toIfaceVar v +toIfaceExpr (Lit l) = IfaceLit l +toIfaceExpr (Type ty) = IfaceType (toIfaceType ty) +toIfaceExpr (Coercion co) = IfaceCo (coToIfaceType co) +toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b) +toIfaceExpr (App f a) = toIfaceApp f [a] +toIfaceExpr (Case s x _ as) = IfaceCase (toIfaceExpr s) (getFS x) (map toIfaceAlt as) +toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e) +toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (coToIfaceType co) +toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e) --------------------- toIfaceNote :: Note -> IfaceNote