tyClDeclFVs, ruleDeclFVs, impDeclFVs
)
import RnHiFiles ( loadInterface, loadHomeInterface, loadOrphanModules )
+import RnNames ( mkModDeps )
import RnSource ( rnTyClDecl, rnInstDecl, rnIfaceRuleDecl )
import TcEnv ( getInGlobalScope, tcLookupGlobal_maybe )
import TcRnMonad
import IdInfo ( GlobalIdDetails(..) )
import TcType ( tyClsNamesOfType, classNamesOfTheta )
import FieldLabel ( fieldLabelTyCon )
-import DataCon ( dataConTyCon )
+import DataCon ( dataConTyCon, dataConWrapId )
import TyCon ( visibleDataCons, isSynTyCon, getSynTyConDefn, tyConClass_maybe, tyConName )
import Class ( className, classSCTheta )
-import Name ( Name {-instance NamedThing-}, isWiredInName, isInternalName, nameModule, NamedThing(..)
- )
+import Name ( Name {-instance NamedThing-}, isWiredInName, nameIsLocalOrFrom,
+ nameModule, NamedThing(..) )
import NameEnv ( delFromNameEnv, lookupNameEnv )
import NameSet
-import Module ( Module, isHomeModule, extendModuleSet )
+import Module ( Module, isHomeModule )
import PrelNames ( hasKey, fractionalClassKey, numClassKey,
integerTyConName, doubleTyConName )
import FiniteMap
-- Tiresomely, we must get the "main" name for the
-- thing, because that's what VSlurp contains, and what
-- is recorded in the usage information
-get_main_name (AClass cl) = className cl
+get_main_name (AClass cl) = className cl
+get_main_name (ADataCon dc) = tyConName (dataConTyCon dc)
get_main_name (ATyCon tc)
| Just clas <- tyConClass_maybe tc = get_main_name (AClass clas)
| otherwise = tyConName tc
get_main_name (AnId id)
= case globalIdDetails id of
- DataConId dc -> get_main_name (ATyCon (dataConTyCon dc))
+ DataConWorkId dc -> get_main_name (ATyCon (dataConTyCon dc))
DataConWrapId dc -> get_main_name (ATyCon (dataConTyCon dc))
RecordSelId lbl -> get_main_name (ATyCon (fieldLabelTyCon lbl))
other -> idName id
recordUsage name = updUsages (upd_usg name)
upd_usg name usages
- | isHomeModule mod = usages { usg_home = addOneToNameSet (usg_home usages) name }
- | otherwise = usages { usg_ext = extendModuleSet (usg_ext usages) mod }
+ | isHomeModule mod = addOneToNameSet usages name
+ | otherwise = usages
where
mod = nameModule name
\end{code}
= -- STEP 0: Check if it's from this module
-- Doing this catches a common case quickly
getModule `thenM` \ this_mod ->
- if isInternalName name || nameModule name == this_mod then
+ if nameIsLocalOrFrom this_mod name then
-- Variables defined on the GHCi command line (e.g. let x = 3)
-- are Internal names (which don't have a Module)
returnM AlreadySlurped
super_classes = classNamesOfTheta (classSCTheta cl)
getWiredInGates (AnId the_id) = tyClsNamesOfType (idType the_id)
+getWiredInGates (ADataCon dc) = tyClsNamesOfType (idType (dataConWrapId dc))
getWiredInGates (ATyCon tc)
| isSynTyCon tc = tyClsNamesOfType ty
| otherwise = unitFV (getName tc)
getImportedInstDecls gates
= -- First, load any orphan-instance modules that aren't aready loaded
-- Orphan-instance modules are recorded in the module dependecnies
- getEps `thenM` \ eps ->
+ getImports `thenM` \ imports ->
+ getEps `thenM` \ eps ->
let
old_gates = eps_inst_gates eps
new_gates = gates `minusNameSet` old_gates
all_gates = new_gates `unionNameSets` old_gates
- orphan_mods = [mod | (mod, (True, _)) <- fmToList (eps_imp_mods eps)]
+ orphan_mods = imp_orphs imports
in
loadOrphanModules orphan_mods `thenM_`
| otherwise
= getEps `thenM` \ eps ->
getInGlobalScope `thenM` \ in_type_env ->
- let
- -- Slurp rules for anything that is slurped,
+ let -- Slurp rules for anything that is slurped,
-- either now, or previously
available n = n `elemNameSet` slurped || in_type_env n
(decls, new_rules) = selectGated available (eps_rules eps)
= returnM outOfDate
| otherwise
= traceHiDiffs (text "Considering whether compilation is required for" <+>
- ppr (mi_module iface) <> colon) `thenM_`
+ ppr (mi_module iface) <> colon) `thenM_`
-- Source code unchanged and no errors yet... carry on
- checkList [checkModUsage u | u <- mi_usages iface]
+ -- First put the dependent-module info in the envt, just temporarily,
+ -- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
+ -- It's just temporary because either the usage check will succeed
+ -- (in which case we are done with this module) or it'll fail (in which
+ -- case we'll compile the module from scratch anyhow).
+ updGblEnv (\ gbl -> gbl { tcg_imports = mod_deps }) (
+ checkList [checkModUsage u | u <- mi_usages iface]
+ )
+
+ where
+ -- This is a bit of a hack really
+ mod_deps = emptyImportAvails { imp_dep_mods = mkModDeps (dep_mods (mi_deps iface)) }
checkList :: [TcRn m RecompileRequired] -> TcRn m RecompileRequired
checkList [] = returnM upToDate
\end{code}
\begin{code}
-checkModUsage :: ImportVersion Name -> TcRn m RecompileRequired
+checkModUsage :: Usage Name -> TcRn m RecompileRequired
-- Given the usage information extracted from the old
-- M.hi file for the module being compiled, figure out
-- whether M needs to be recompiled.
-checkModUsage (mod_name, _, _, NothingAtAll)
- -- If CurrentModule.hi contains
- -- import Foo :: ;
- -- then that simply records that Foo lies below CurrentModule in the
- -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
- -- In this case we don't even want to open Foo's interface.
- = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
-
-checkModUsage (mod_name, _, is_boot, whats_imported)
+checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
+ usg_rules = old_rule_vers,
+ usg_exports = maybe_old_export_vers,
+ usg_entities = old_decl_vers })
= -- Load the imported interface is possible
- -- We use tryLoadInterface, because failure is not an error
- -- (might just be that the old .hi file for this module is out of date)
let
doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
- from = ImportForUsage is_boot
in
traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_`
- tryM (loadInterface doc_str mod_name from) `thenM` \ mb_iface ->
+ tryM (loadInterface doc_str mod_name ImportBySystem) `thenM` \ mb_iface ->
case mb_iface of {
Left exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"),
new_export_vers = vers_exports new_vers
new_rule_vers = vers_rules new_vers
in
- case whats_imported of { -- NothingAtAll dealt with earlier
-
- Everything old_mod_vers -> checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile ->
- if recompile then
- out_of_date (ptext SLIT("...and I needed the whole module"))
- else
- returnM upToDate ;
-
- Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
-
-- CHECK MODULE
checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile ->
if not recompile then
else
up_to_date (ptext SLIT(" Great! The bits I use are up to date"))
- }}
+ }
------------------------
checkModuleVersion old_mod_vers new_mod_vers
projects / ghc-hetmet.git / blobdiff