X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fiface%2FMkIface.lhs;h=69d862f164e4e4f76f2812cf9ffaafc0871c0d08;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hp=489c2f7abd17c1ba07276ce386352c932972af31;hpb=de21f53e25eb67248ba416187d34ba7ec9ec143a;p=ghc-hetmet.git diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 489c2f7..69d862f 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -4,6 +4,13 @@ % \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings +-- for details + module MkIface ( mkUsageInfo, -- Construct the usage info for a module @@ -705,7 +712,7 @@ bump_unless False v = bumpVersion v \begin{code} mkUsageInfo :: HscEnv - -> ModuleEnv (Module, Bool, SrcSpan) + -> ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)]) -> [(ModuleName, IsBootInterface)] -> NameSet -> IO [Usage] mkUsageInfo hsc_env dir_imp_mods dep_mods used_names @@ -717,6 +724,12 @@ mkUsageInfo hsc_env dir_imp_mods dep_mods used_names -- don't get evaluated for a while and we can end up hanging on to -- the entire collection of Ifaces. +mk_usage_info :: PackageIfaceTable + -> HscEnv + -> ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)]) + -> [(ModuleName, IsBootInterface)] + -> NameSet + -> [Usage] mk_usage_info pit hsc_env dir_imp_mods dep_mods used_names = mapCatMaybes mkUsage dep_mods -- ToDo: do we need to sort into canonical order? @@ -739,8 +752,8 @@ mk_usage_info pit hsc_env dir_imp_mods dep_mods used_names add_item occs _ = occ:occs depend_on_exports mod = case lookupModuleEnv dir_imp_mods mod of - Just (_,no_imp,_) -> not no_imp - Nothing -> True + Just (_, xs) -> any (\(_, no_imp, _) -> not no_imp) xs + Nothing -> True -- We want to create a Usage for a home module if -- a) we used something from; has something in used_names @@ -1212,7 +1225,7 @@ tyThingToIfaceDecl (ATyCon tycon) ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con), ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con), ifConEqSpec = to_eq_spec (dataConEqSpec data_con), - ifConCtxt = toIfaceContext (dataConTheta data_con), + ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con), ifConArgTys = map toIfaceType (dataConOrigArgTys data_con), ifConFields = map getOccName (dataConFieldLabels data_con),