X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=489c2f7abd17c1ba07276ce386352c932972af31;hb=a8427a4125e9b78e88a487eeabf018f1c6e8bc08;hp=811af49947157fde2727b2d660181b4e7e8ae5aa;hpb=098f818b622e5095fbd3f6318a463fcb2ce14fc6;p=ghc-hetmet.git diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 811af49..489c2f7 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -193,7 +193,7 @@ import InstEnv import FamInstEnv import TcRnMonad import HscTypes - +import Finder import DynFlags import VarEnv import Var @@ -244,7 +244,8 @@ mkIface hsc_env maybe_old_iface mg_deps = deps, mg_rdr_env = rdr_env, mg_fix_env = fix_env, - mg_deprecs = src_deprecs}) + mg_deprecs = src_deprecs, + mg_hpc_info = hpc_info }) (ModDetails{ md_insts = insts, md_fam_insts = fam_insts, md_rules = rules, @@ -304,6 +305,7 @@ mkIface hsc_env maybe_old_iface mi_finsts = False, -- Ditto mi_decls = deliberatelyOmitted "decls", mi_ver_fn = deliberatelyOmitted "ver_fn", + mi_hpc = isHpcUsed hpc_info, -- And build the cached values mi_dep_fn = mkIfaceDepCache deprecs, @@ -312,7 +314,7 @@ mkIface hsc_env maybe_old_iface -- Add version information ; ext_ver_fn = mkParentVerFun hsc_env eps ; (new_iface, no_change_at_all, pp_diffs, pp_orphs) - = _scc_ "versioninfo" + = {-# SCC "versioninfo" #-} addVersionInfo ext_ver_fn maybe_old_iface intermediate_iface decls } @@ -339,8 +341,19 @@ mkIface hsc_env maybe_old_iface deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x) ifFamInstTcName = ifaceTyConName . ifFamInstTyCon - flattenVectInfo (VectInfo ccVar) = - IfaceVectInfo [Var.varName v | (v, _) <- varEnvElts ccVar] + flattenVectInfo (VectInfo { vectInfoVar = vVar + , vectInfoTyCon = vTyCon + }) = + IfaceVectInfo { + ifaceVectInfoVar = [ Var.varName v + | (v, _) <- varEnvElts vVar], + ifaceVectInfoTyCon = [ tyConName t + | (t, t_v) <- nameEnvElts vTyCon + , t /= t_v], + ifaceVectInfoTyConReuse = [ tyConName t + | (t, t_v) <- nameEnvElts vTyCon + , t == t_v] + } ----------------------------- writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO () @@ -461,7 +474,8 @@ addVersionInfo ver_fn (Just old_iface@(ModIface { -- If the usages havn't changed either, we don't need to write the interface file no_other_changes = mi_usages new_iface == mi_usages old_iface && - mi_deps new_iface == mi_deps old_iface + mi_deps new_iface == mi_deps old_iface && + mi_hpc new_iface == mi_hpc old_iface no_change_at_all = no_output_change && no_other_changes pp_diffs = vcat [pp_change no_export_change "Export list" @@ -792,23 +806,54 @@ mkIfaceExports exports | (mod, avails) <- fmToList groupFM ] where + -- Group by the module where the exported entities are defined + -- (which may not be the same for all Names in an Avail) -- Deliberately use FiniteMap rather than UniqFM so we -- get a canonical ordering groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName)) groupFM = foldl add emptyModuleEnv exports - add env avail - = extendModuleEnv_C add_avail env mod (unitFM avail_fs avail_occ) + add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName)) + -> Module -> GenAvailInfo OccName + -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName)) + add_one env mod avail + = extendModuleEnv_C plusFM env mod + (unitFM (occNameFS (availName avail)) avail) + + -- NB: we should not get T(X) and T(Y) in the export list + -- else the plusFM will simply discard one! They + -- should have been combined by now. + add env (Avail n) + = add_one env (nameModule n) (Avail (nameOccName n)) + + add env (AvailTC tc ns) + = foldl add_for_mod env mods where - avail_occ = availToOccs avail - mod = nameModule (availName avail) - avail_fs = occNameFS (availName avail_occ) - add_avail avail_fm _ = addToFM avail_fm avail_fs avail_occ - - availToOccs (Avail n) = Avail (nameOccName n) - availToOccs (AvailTC tc ns) = AvailTC (nameOccName tc) (map nameOccName ns) + tc_occ = nameOccName tc + mods = nub (map nameModule ns) + -- Usually just one, but see Note [Original module] + + add_for_mod env mod + = add_one env mod (AvailTC tc_occ names_from_mod) + where + names_from_mod = [nameOccName n | n <- ns, nameModule n == mod] \end{code} +Note [Orignal module] +~~~~~~~~~~~~~~~~~~~~~ +Consider this: + module X where { data family T } + module Y( T(..) ) where { import X; data instance T Int = MkT Int } +The exported Avail from Y will look like + X.T{X.T, Y.MkT} +That is, in Y, + - only MkT is brought into scope by the data instance; + - but the parent (used for grouping and naming in T(..) exports) is X.T + - and in this case we export X.T too + +In the result of MkIfaceExports, the names are grouped by defining module, +so we may need to split up a single Avail into multiple ones. + %************************************************************************ %* * @@ -848,7 +893,7 @@ check_old_iface hsc_env mod_summary source_unchanged maybe_iface case maybe_iface of { Just old_iface -> do -- Use the one we already have { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary)) - ; recomp <- checkVersions hsc_env source_unchanged old_iface + ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface ; return (recomp, Just old_iface) } ; Nothing -> do @@ -867,9 +912,10 @@ check_old_iface hsc_env mod_summary source_unchanged maybe_iface -- We have got the old iface; check its versions { traceIf (text "Read the interface file" <+> text iface_path) - ; recomp <- checkVersions hsc_env source_unchanged iface + ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface ; returnM (recomp, Just iface) }}}}} + \end{code} @recompileRequired@ is called from the HscMain. It checks whether @@ -884,15 +930,19 @@ outOfDate = True -- Recompile required checkVersions :: HscEnv -> Bool -- True <=> source unchanged + -> ModSummary -> ModIface -- Old interface -> IfG RecompileRequired -checkVersions hsc_env source_unchanged iface +checkVersions hsc_env source_unchanged mod_summary iface | not source_unchanged = returnM outOfDate | otherwise = do { traceHiDiffs (text "Considering whether compilation is required for" <+> ppr (mi_module iface) <> colon) + ; recomp <- checkDependencies hsc_env mod_summary iface + ; if recomp then return outOfDate else do { + -- Source code unchanged and no errors yet... carry on -- First put the dependent-module info, read from the old interface, into the envt, @@ -905,16 +955,63 @@ checkVersions hsc_env source_unchanged iface -- We do this regardless of compilation mode, although in --make mode -- all the dependent modules should be in the HPT already, so it's -- quite redundant - ; updateEps_ $ \eps -> eps { eps_is_boot = mod_deps } + updateEps_ $ \eps -> eps { eps_is_boot = mod_deps } ; let this_pkg = thisPackage (hsc_dflags hsc_env) ; checkList [checkModUsage this_pkg u | u <- mi_usages iface] - } + }} where -- This is a bit of a hack really mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface) mod_deps = mkModDeps (dep_mods (mi_deps iface)) + +-- If the direct imports of this module are resolved to targets that +-- are not among the dependencies of the previous interface file, +-- then we definitely need to recompile. This catches cases like +-- - an exposed package has been upgraded +-- - we are compiling with different package flags +-- - a home module that was shadowing a package module has been removed +-- - a new home module has been added that shadows a package module +-- See bug #1372. +-- +-- Returns True if recompilation is required. +checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired +checkDependencies hsc_env summary iface + = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary)) + where + prev_dep_mods = dep_mods (mi_deps iface) + prev_dep_pkgs = dep_pkgs (mi_deps iface) + + this_pkg = thisPackage (hsc_dflags hsc_env) + + orM = foldr f (return False) + where f m rest = do b <- m; if b then return True else rest + + dep_missing (L _ mod) = do + find_res <- ioToIOEnv $ findImportedModule hsc_env mod Nothing + case find_res of + Found _ mod + | pkg == this_pkg + -> if moduleName mod `notElem` map fst prev_dep_mods + then do traceHiDiffs $ + text "imported module " <> quotes (ppr mod) <> + text " not among previous dependencies" + return outOfDate + else + return upToDate + | otherwise + -> if pkg `notElem` prev_dep_pkgs + then do traceHiDiffs $ + text "imported module " <> quotes (ppr mod) <> + text " is from package " <> quotes (ppr pkg) <> + text ", which is not among previous dependencies" + return outOfDate + else + return upToDate + where pkg = modulePackageId mod + _otherwise -> return outOfDate + checkModUsage :: PackageId ->Usage -> IfG RecompileRequired -- Given the usage information extracted from the old -- M.hi file for the module being compiled, figure out @@ -1070,10 +1167,12 @@ tyThingToIfaceDecl (AClass clas) tyThingToIfaceDecl (ATyCon tycon) | isSynTyCon tycon - = IfaceSyn { ifName = getOccName tycon, - ifTyVars = toIfaceTvBndrs tyvars, + = IfaceSyn { ifName = getOccName tycon, + ifTyVars = toIfaceTvBndrs tyvars, ifOpenSyn = syn_isOpen, - ifSynRhs = toIfaceType syn_tyki } + ifSynRhs = toIfaceType syn_tyki, + ifFamInst = famInstToIface (tyConFamInst_maybe tycon) + } | isAlgTyCon tycon = IfaceData { ifName = getOccName tycon, @@ -1100,8 +1199,7 @@ tyThingToIfaceDecl (ATyCon tycon) IfNewTyCon (ifaceConDecl con) ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons) - ifaceConDecls OpenTyCon { otIsNewtype = False } = IfOpenDataTyCon - ifaceConDecls OpenTyCon { otIsNewtype = True } = IfOpenNewTyCon + ifaceConDecls OpenTyCon {} = IfOpenDataTyCon ifaceConDecls AbstractTyCon = IfAbstractTyCon -- The last case happens when a TyCon has been trimmed during tidying -- Furthermore, tyThingToIfaceDecl is also used @@ -1347,6 +1445,8 @@ toIfaceVar v | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v)) -- Foreign calls have special syntax | isExternalName name = IfaceExt name + | Just (TickBox m ix) <- isTickBoxOp_maybe v + = IfaceTick m ix | otherwise = IfaceLcl (getFS name) where name = idName v