+
+
+%************************************************************************
+%* *
+\subsection{Get global names}
+%* *
+%************************************************************************
+
+\begin{code}
+getGlobalNames :: RdrNameHsModule
+ -> RnMG (Maybe (ExportEnv,
+ GlobalRdrEnv,
+ FixityEnv, -- Fixities for local decls only
+ NameEnv AvailInfo -- Maps a name to its parent AvailInfo
+ -- Just for in-scope things only
+ ))
+ -- Nothing => no need to recompile
+
+getGlobalNames (HsModule this_mod _ exports imports decls mod_loc)
+ = -- These two fix-loops are to get the right
+ -- provenance information into a Name
+ fixRn (\ ~(rec_gbl_env, rec_exported_avails, _) ->
+
+ let
+ rec_unqual_fn :: Name -> Bool -- Is this chap in scope unqualified?
+ rec_unqual_fn = unQualInScope rec_gbl_env
+
+ rec_exp_fn :: Name -> ExportFlag
+ rec_exp_fn = mk_export_fn (availsToNameSet rec_exported_avails)
+ in
+ setModuleRn this_mod $
+
+ -- PROCESS LOCAL DECLS
+ -- Do these *first* so that the correct provenance gets
+ -- into the global name cache.
+ importsFromLocalDecls this_mod rec_exp_fn decls
+ `thenRn` \ (local_gbl_env, local_mod_avails) ->
+
+ -- PROCESS IMPORT DECLS
+ -- Do the non {- SOURCE -} ones first, so that we get a helpful
+ -- warning for {- SOURCE -} ones that are unnecessary
+ let
+ (source, ordinary) = partition is_source_import all_imports
+ is_source_import (ImportDecl _ ImportByUserSource _ _ _ _) = True
+ is_source_import other = False
+ in
+ mapAndUnzipRn (importsFromImportDecl rec_unqual_fn) ordinary
+ `thenRn` \ (imp_gbl_envs1, imp_avails_s1) ->
+ mapAndUnzipRn (importsFromImportDecl rec_unqual_fn) source
+ `thenRn` \ (imp_gbl_envs2, imp_avails_s2) ->
+
+ -- COMBINE RESULTS
+ -- We put the local env second, so that a local provenance
+ -- "wins", even if a module imports itself.
+ let
+ gbl_env :: GlobalRdrEnv
+ imp_gbl_env = foldr plusGlobalRdrEnv emptyRdrEnv (imp_gbl_envs2 ++ imp_gbl_envs1)
+ gbl_env = imp_gbl_env `plusGlobalRdrEnv` local_gbl_env
+
+ all_avails :: ExportAvails
+ all_avails = foldr plusExportAvails local_mod_avails (imp_avails_s2 ++ imp_avails_s1)
+ in
+
+ -- TRY FOR EARLY EXIT
+ -- We can't go for an early exit before this because we have to check
+ -- for name clashes. Consider:
+ --
+ -- module A where module B where
+ -- import B h = True
+ -- f = h
+ --
+ -- Suppose I've compiled everything up, and then I add a
+ -- new definition to module B, that defines "f".
+ --
+ -- Then I must detect the name clash in A before going for an early
+ -- exit. The early-exit code checks what's actually needed from B
+ -- to compile A, and of course that doesn't include B.f. That's
+ -- why we wait till after the plusEnv stuff to do the early-exit.
+ checkEarlyExit this_mod `thenRn` \ up_to_date ->
+ if up_to_date then
+ returnRn (gbl_env, junk_exp_fn, Nothing)
+ else
+
+ -- RECORD BETTER PROVENANCES IN THE CACHE
+ -- The names in the envirnoment have better provenances (e.g. imported on line x)
+ -- than the names in the name cache. We update the latter now, so that we
+ -- we start renaming declarations we'll get the good names
+ -- The isQual is because the qualified name is always in scope
+ updateProvenances (concat [names | (rdr_name, names) <- rdrEnvToList imp_gbl_env,
+ isQual rdr_name]) `thenRn_`
+
+ -- PROCESS EXPORT LISTS
+ exportsFromAvail this_mod exports all_avails gbl_env
+ `thenRn` \ exported_avails ->
+
+ -- DONE
+ returnRn (gbl_env, exported_avails, Just all_avails)
+ ) `thenRn` \ (gbl_env, exported_avails, maybe_stuff) ->
+
+ case maybe_stuff of {
+ Nothing -> returnRn Nothing ;
+ Just all_avails ->
+
+ traceRn (text "updateProv" <+> fsep (map ppr (rdrEnvElts gbl_env))) `thenRn_`
+
+ -- DEAL WITH FIXITIES
+ fixitiesFromLocalDecls gbl_env decls `thenRn` \ local_fixity_env ->
+ let
+ -- Export only those fixities that are for names that are
+ -- (a) defined in this module
+ -- (b) exported
+ exported_fixities :: [(Name,Fixity)]
+ exported_fixities = [(name,fixity)
+ | FixitySig name fixity _ <- nameEnvElts local_fixity_env,
+ isLocallyDefined name
+ ]
+ in
+ traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts local_fixity_env))) `thenRn_`
+
+ --- TIDY UP
+ let
+ export_env = ExportEnv exported_avails exported_fixities
+ (_, global_avail_env) = all_avails
+ in
+ returnRn (Just (export_env, gbl_env, local_fixity_env, global_avail_env))
+ }
+ where
+ junk_exp_fn = error "RnNames:export_fn"
+
+ all_imports = prel_imports ++ imports
+
+ -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
+ -- because the former doesn't even look at Prelude.hi for instance declarations,
+ -- whereas the latter does.
+ prel_imports | this_mod == pRELUDE_Name ||
+ explicit_prelude_import ||
+ opt_NoImplicitPrelude
+ = []
+
+ | otherwise = [ImportDecl pRELUDE_Name
+ ImportByUser
+ False {- Not qualified -}
+ Nothing {- No "as" -}
+ Nothing {- No import list -}
+ mod_loc]
+
+ explicit_prelude_import
+ = not (null [ () | (ImportDecl mod _ _ _ _ _) <- imports, mod == pRELUDE_Name ])
+\end{code}
+
+\begin{code}
+checkEarlyExit mod
+ = checkErrsRn `thenRn` \ no_errs_so_far ->
+ if not no_errs_so_far then
+ -- Found errors already, so exit now
+ returnRn True
+ else
+
+ traceRn (text "Considering whether compilation is required...") `thenRn_`
+ if not opt_SourceUnchanged then
+ -- Source code changed and no errors yet... carry on
+ traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_`
+ returnRn False
+ else
+
+ -- Unchanged source, and no errors yet; see if usage info
+ -- up to date, and exit if so
+ checkUpToDate mod `thenRn` \ up_to_date ->
+ putDocRn (text "Compilation" <+>
+ text (if up_to_date then "IS NOT" else "IS") <+>
+ text "required") `thenRn_`
+ returnRn up_to_date
+\end{code}
+
+\begin{code}
+importsFromImportDecl :: (Name -> Bool) -- OK to omit qualifier
+ -> RdrNameImportDecl
+ -> RnMG (GlobalRdrEnv,
+ ExportAvails)
+
+importsFromImportDecl is_unqual (ImportDecl imp_mod_name from qual_only as_mod import_spec iloc)
+ = pushSrcLocRn iloc $
+ getInterfaceExports imp_mod_name from `thenRn` \ (imp_mod, avails) ->
+
+ if null avails then
+ -- If there's an error in getInterfaceExports, (e.g. interface
+ -- file not found) we get lots of spurious errors from 'filterImports'
+ returnRn (emptyRdrEnv, mkEmptyExportAvails imp_mod_name)
+ else
+
+ filterImports imp_mod_name import_spec avails
+ `thenRn` \ (filtered_avails, hides, explicits) ->
+
+ -- We 'improve' the provenance by setting
+ -- (a) the import-reason field, so that the Name says how it came into scope
+ -- including whether it's explicitly imported
+ -- (b) the print-unqualified field
+ -- But don't fiddle with wired-in things or we get in a twist
+ let
+ improve_prov name =
+ setNameProvenance name (NonLocalDef (UserImport imp_mod iloc (is_explicit name))
+ (is_unqual name))
+ is_explicit name = name `elemNameSet` explicits
+ in
+ qualifyImports imp_mod_name
+ (not qual_only) -- Maybe want unqualified names
+ as_mod hides
+ filtered_avails improve_prov
+ `thenRn` \ (rdr_name_env, mod_avails) ->
+
+ returnRn (rdr_name_env, mod_avails)