-import Unique ( Unique )
-import StringBuffer ( StringBuffer, hGetStringBuffer )
-import FastString ( mkFastString )
-import Lex
-import Outputable
-
-import IO ( isDoesNotExistError )
-import List ( nub )
-\end{code}
-
-
-%*********************************************************
-%* *
-\subsection{Loading a new interface file}
-%* *
-%*********************************************************
-
-\begin{code}
-loadHomeInterface :: SDoc -> Name -> RnM d (Module, Ifaces)
-loadHomeInterface doc_str name
- = loadInterface doc_str (moduleName (nameModule name)) ImportBySystem
-
-loadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d (Module, Ifaces)
-loadInterface doc_str mod_name from
- = getIfacesRn `thenRn` \ ifaces ->
- let
- mod_map = iImpModInfo ifaces
- mod_info = lookupFM mod_map mod_name
- in_map = maybeToBool mod_info
- in
-
- -- Issue a warning for a redundant {- SOURCE -} import
- -- It's redundant if the moduld is in the iImpModInfo at all,
- -- because we arrange to read all the ordinary imports before
- -- any of the {- SOURCE -} imports
- warnCheckRn (not (in_map && case from of {ImportByUserSource -> True; other -> False}))
- (warnRedundantSourceImport mod_name) `thenRn_`
-
- -- CHECK WHETHER WE HAVE IT ALREADY
- case mod_info of {
- Just (_, _, Just (load_mod, _, _))
- -> -- We're read it already so don't re-read it
- returnRn (load_mod, ifaces) ;
-
- mod_map_result ->
-
- -- READ THE MODULE IN
- findAndReadIface doc_str mod_name from in_map `thenRn` \ (hi_boot_read, read_result) ->
- case read_result of {
- Nothing -> -- Not found, so add an empty export env to the Ifaces map
- -- so that we don't look again
- let
- mod = mkVanillaModule mod_name
- new_mod_map = addToFM mod_map mod_name (0, False, Just (mod, False, []))
- new_ifaces = ifaces { iImpModInfo = new_mod_map }
- in
- setIfacesRn new_ifaces `thenRn_`
- failWithRn (mod, new_ifaces) (noIfaceErr mod hi_boot_read) ;
-
- -- Found and parsed!
- Just (mod, iface) ->
-
- -- LOAD IT INTO Ifaces
-
- -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
- --- names is done correctly (notably, whether this is an .hi file or .hi-boot file).
- -- If we do loadExport first the wrong info gets into the cache (unless we
- -- explicitly tag each export which seems a bit of a bore)
-
- getModuleRn `thenRn` \ this_mod_nm ->
- let
- rd_decls = pi_decls iface
- in
- foldlRn (loadDecl mod) (iDecls ifaces) rd_decls `thenRn` \ new_decls ->
- foldlRn (loadInstDecl mod) (iInsts ifaces) (pi_insts iface) `thenRn` \ new_insts ->
- foldlRn (loadRule mod) (iRules ifaces) (pi_rules iface) `thenRn` \ new_rules ->
- foldlRn (loadFixDecl mod_name) (iFixes ifaces) rd_decls `thenRn` \ new_fixities ->
- mapRn (loadExport this_mod_nm) (pi_exports iface) `thenRn` \ avails_s ->
- let
- -- For an explicit user import, add to mod_map info about
- -- the things the imported module depends on, extracted
- -- from its usage info.
- mod_map1 = case from of
- ImportByUser -> addModDeps mod mod_map (pi_usages iface)
- other -> mod_map
-
- -- Now add info about this module
- mod_map2 = addToFM mod_map1 mod_name mod_details
- mod_details = (pi_mod iface, pi_orphan iface, Just (mod, hi_boot_read, concat avails_s))
-
- new_ifaces = ifaces { iImpModInfo = mod_map2,
- iDecls = new_decls,
- iFixes = new_fixities,
- iRules = new_rules,
- iInsts = new_insts }
- in
- setIfacesRn new_ifaces `thenRn_`
- returnRn (mod, new_ifaces)
- }}
-
-addModDeps :: Module -> ImportedModuleInfo
- -> [ImportVersion a] -> ImportedModuleInfo
-addModDeps mod mod_deps new_deps
- = foldr add mod_deps new_deps
- where
- is_lib = isLibModule mod -- Don't record dependencies when importing a library module
- add (imp_mod, version, has_orphans, _) deps
- | is_lib && not has_orphans = deps
- | otherwise = addToFM_C combine deps imp_mod (version, has_orphans, Nothing)
- -- Record dependencies for modules that are
- -- either are dependent via a non-library module
- -- or contain orphan rules or instance decls
-
- -- Don't ditch a module that's already loaded!!
- combine old@(_, _, Just _) new = old
- combine old@(_, _, Nothing) new = new
-
-loadExport :: ModuleName -> ExportItem -> RnM d [AvailInfo]
-loadExport this_mod (mod, entities)
- | mod == this_mod = returnRn []
- -- If the module exports anything defined in this module, just ignore it.
- -- Reason: otherwise it looks as if there are two local definition sites
- -- for the thing, and an error gets reported. Easiest thing is just to
- -- filter them out up front. This situation only arises if a module
- -- imports itself, or another module that imported it. (Necessarily,
- -- this invoves a loop.) Consequence: if you say
- -- module A where
- -- import B( AType )
- -- type AType = ...
- --
- -- module B( AType ) where
- -- import {-# SOURCE #-} A( AType )
- --
- -- then you'll get a 'B does not export AType' message. A bit bogus
- -- but it's a bogus thing to do!
-
- | otherwise
- = mapRn (load_entity mod) entities
- where
- new_name mod occ = mkImportedGlobalName mod occ
-
- load_entity mod (Avail occ)
- = new_name mod occ `thenRn` \ name ->
- returnRn (Avail name)
- load_entity mod (AvailTC occ occs)
- = new_name mod occ `thenRn` \ name ->
- mapRn (new_name mod) occs `thenRn` \ names ->
- returnRn (AvailTC name names)
-
-
-loadFixDecl :: ModuleName -> FixityEnv
- -> (Version, RdrNameHsDecl)
- -> RnM d FixityEnv
-loadFixDecl mod_name fixity_env (version, FixD sig@(FixitySig rdr_name fixity loc))
- = -- Ignore the version; when the fixity changes the version of
- -- its 'host' entity changes, so we don't need a separate version
- -- number for fixities
- mkImportedGlobalName mod_name (rdrNameOcc rdr_name) `thenRn` \ name ->
- let
- new_fixity_env = addToNameEnv fixity_env name (FixitySig name fixity loc)
- in
- returnRn new_fixity_env
-
- -- Ignore the other sorts of decl
-loadFixDecl mod_name fixity_env other_decl = returnRn fixity_env
-
-loadDecl :: Module
- -> DeclsMap
- -> (Version, RdrNameHsDecl)
- -> RnM d DeclsMap
-
-loadDecl mod decls_map (version, decl)
- = getDeclBinders new_name decl `thenRn` \ maybe_avail ->
- case maybe_avail of {
- Nothing -> returnRn decls_map; -- No bindings
- Just avail ->
-
- getDeclSysBinders new_name decl `thenRn` \ sys_bndrs ->
- let
- main_name = availName avail
- new_decls_map = foldl add_decl decls_map
- [ (name, (version, avail, name==main_name, (mod, decl')))
- | name <- sys_bndrs ++ availNames avail]
- add_decl decls_map (name, stuff)
- = WARN( name `elemNameEnv` decls_map, ppr name )
- addToNameEnv decls_map name stuff
- in
- returnRn new_decls_map
- }
- where
- -- newImportedBinder puts into the cache the binder with the
- -- module information set correctly. When the decl is later renamed,
- -- the binding site will thereby get the correct module.
- new_name rdr_name loc = newImportedBinder mod rdr_name
-
- {-
- If a signature decl is being loaded, and optIgnoreIfacePragmas is on,
- we toss away unfolding information.
-
- Also, if the signature is loaded from a module we're importing from source,
- we do the same. This is to avoid situations when compiling a pair of mutually
- recursive modules, peering at unfolding info in the interface file of the other,
- e.g., you compile A, it looks at B's interface file and may as a result change
- its interface file. Hence, B is recompiled, maybe changing its interface file,
- which will the unfolding info used in A to become invalid. Simple way out is to
- just ignore unfolding info.
-
- [Jan 99: I junked the second test above. If we're importing from an hi-boot
- file there isn't going to *be* any pragma info. Maybe the above comment
- dates from a time where we picked up a .hi file first if it existed?]
- -}
- decl' = case decl of
- SigD (IfaceSig name tp ls loc) | opt_IgnoreIfacePragmas -> SigD (IfaceSig name tp [] loc)
- other -> decl
-
-loadInstDecl :: Module
- -> Bag GatedDecl
- -> RdrNameInstDecl
- -> RnM d (Bag GatedDecl)
-loadInstDecl mod insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
- =
- -- Find out what type constructors and classes are "gates" for the
- -- instance declaration. If all these "gates" are slurped in then
- -- we should slurp the instance decl too.
- --
- -- We *don't* want to count names in the context part as gates, though.
- -- For example:
- -- instance Foo a => Baz (T a) where ...
- --
- -- Here the gates are Baz and T, but *not* Foo.
- let
- munged_inst_ty = removeContext inst_ty
- free_names = extractHsTyRdrNames munged_inst_ty
- in
- setModuleRn (moduleName mod) $
- mapRn mkImportedGlobalFromRdrName free_names `thenRn` \ gate_names ->
- returnRn ((mkNameSet gate_names, (mod, InstD decl)) `consBag` insts)
-
-
--- In interface files, the instance decls now look like
--- forall a. Foo a -> Baz (T a)
--- so we have to strip off function argument types as well
--- as the bit before the '=>' (which is always empty in interface files)
-removeContext (HsForAllTy tvs cxt ty) = HsForAllTy tvs [] (removeFuns ty)
-removeContext ty = removeFuns ty
-
-removeFuns (MonoFunTy _ ty) = removeFuns ty
-removeFuns ty = ty
-
-
-loadRule :: Module -> Bag GatedDecl
- -> RdrNameRuleDecl -> RnM d (Bag GatedDecl)
--- "Gate" the rule simply by whether the rule variable is
--- needed. We can refine this later.
-loadRule mod rules decl@(IfaceRuleDecl var body src_loc)
- = setModuleRn (moduleName mod) $
- mkImportedGlobalFromRdrName var `thenRn` \ var_name ->
- returnRn ((unitNameSet var_name, (mod, RuleD decl)) `consBag` rules)
-\end{code}
-
-
-%********************************************************
-%* *
-\subsection{Loading usage information}
-%* *
-%********************************************************
-
-\begin{code}
-checkUpToDate :: ModuleName -> RnMG Bool -- True <=> no need to recompile
-checkUpToDate mod_name
- = getIfacesRn `thenRn` \ ifaces ->
- findAndReadIface doc_str mod_name
- ImportByUser
- (error "checkUpToDate") `thenRn` \ (_, read_result) ->
-
- -- CHECK WHETHER WE HAVE IT ALREADY
- case read_result of
- Nothing -> -- Old interface file not found, so we'd better bail out
- traceRn (sep [ptext SLIT("Didnt find old iface"),
- pprModuleName mod_name]) `thenRn_`
- returnRn False
-
- Just (_, iface)
- -> -- Found it, so now check it
- checkModUsage (pi_usages iface)
- where
- -- Only look in current directory, with suffix .hi
- doc_str = sep [ptext SLIT("need usage info from"), pprModuleName mod_name]
-
-checkModUsage [] = returnRn True -- Yes! Everything is up to date!
-
-checkModUsage ((mod_name, old_mod_vers, _, whats_imported) : rest)
- = loadInterface doc_str mod_name ImportBySystem `thenRn` \ (mod, ifaces) ->
- let
- maybe_mod_vers = case lookupFM (iImpModInfo ifaces) mod_name of
- Just (version, _, Just (_, _, _)) -> Just version
- other -> Nothing
- in
- case maybe_mod_vers of {
- Nothing -> -- If we can't find a version number for the old module then
- -- bail out saying things aren't up to date
- traceRn (sep [ptext SLIT("Can't find version number for module"),
- pprModuleName mod_name]) `thenRn_`
- returnRn False ;
-
- Just new_mod_vers ->
-
- -- If the module version hasn't changed, just move on
- if new_mod_vers == old_mod_vers then
- traceRn (sep [ptext SLIT("Module version unchanged:"), pprModuleName mod_name]) `thenRn_`
- checkModUsage rest
- else
- traceRn (sep [ptext SLIT("Module version has changed:"), pprModuleName mod_name]) `thenRn_`
-
- -- Module version changed, so check entities inside
-
- -- If the usage info wants to say "I imported everything from this module"
- -- it does so by making whats_imported equal to Everything
- -- In that case, we must recompile
- case whats_imported of {
- Everything -> traceRn (ptext SLIT("...and I needed the whole module")) `thenRn_`
- returnRn False; -- Bale out
-
- Specifically old_local_vers ->
-
- -- Non-empty usage list, so check item by item
- checkEntityUsage mod_name (iDecls ifaces) old_local_vers `thenRn` \ up_to_date ->
- if up_to_date then
- traceRn (ptext SLIT("...but the bits I use haven't.")) `thenRn_`
- checkModUsage rest -- This one's ok, so check the rest
- else
- returnRn False -- This one failed, so just bail out now
- }}
- where
- doc_str = sep [ptext SLIT("need version info for"), pprModuleName mod_name]
-
-
-checkEntityUsage mod decls []
- = returnRn True -- Yes! All up to date!
-
-checkEntityUsage mod decls ((occ_name,old_vers) : rest)
- = mkImportedGlobalName mod occ_name `thenRn` \ name ->
- case lookupNameEnv decls name of
-
- Nothing -> -- We used it before, but it ain't there now
- putDocRn (sep [ptext SLIT("No longer exported:"), ppr name]) `thenRn_`
- returnRn False
-
- Just (new_vers,_,_,_) -- It's there, but is it up to date?
- | new_vers == old_vers
- -- Up to date, so check the rest
- -> checkEntityUsage mod decls rest
-
- | otherwise
- -- Out of date, so bale out
- -> putDocRn (sep [ptext SLIT("Out of date:"), ppr name]) `thenRn_`
- returnRn False