%
\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
import FamInstEnv
import TcRnMonad
import HscTypes
-
+import Finder
import DynFlags
+import VarEnv
+import Var
import Name
import NameEnv
import NameSet
mg_rdr_env = rdr_env,
mg_fix_env = fix_env,
mg_deprecs = src_deprecs,
- mg_vect_info = vect_info })
+ mg_hpc_info = hpc_info })
(ModDetails{ md_insts = insts,
md_fam_insts = fam_insts,
md_rules = rules,
+ md_vect_info = vect_info,
md_types = type_env,
md_exports = exports })
; iface_rules = map (coreRuleToIfaceRule this_mod) rules
; iface_insts = map instanceToIfaceInst insts
; iface_fam_insts = map famInstToIfaceFamInst fam_insts
+ ; iface_vect_info = flattenVectInfo vect_info
; intermediate_iface = ModIface {
mi_module = this_mod,
mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
mi_rules = sortLe le_rule iface_rules,
+ mi_vect_info = iface_vect_info,
+
mi_fixities = fixities,
mi_deprecs = deprecs,
mi_globals = Just rdr_env,
mi_finsts = False, -- Ditto
mi_decls = deliberatelyOmitted "decls",
mi_ver_fn = deliberatelyOmitted "ver_fn",
-
- mi_vect_info = flattenVectInfo vect_info,
+ mi_hpc = isHpcUsed hpc_info,
-- And build the cached values
mi_dep_fn = mkIfaceDepCache deprecs,
-- 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
}
deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
- flattenVectInfo (VectInfo ccVar) = IfaceVectInfo (nameSetToList 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 ()
-- 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"
\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
-- 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?
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
| (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.
+
%************************************************************************
%* *
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
-- 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
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,
-- 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
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,
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
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),
| 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
projects / ghc-hetmet.git / blobdiff