#include "HsVersions.h"
-import CmdLineOpts ( opt_NoImplicitPrelude, opt_WarnDuplicateExports,
- opt_SourceUnchanged, opt_WarnUnusedBinds
- )
-
-import HsSyn ( HsModule(..), HsDecl(..), TyClDecl(..),
- IE(..), ieName,
- ForeignDecl(..), ForKind(..), isDynamicExtName,
- FixitySig(..), Sig(..), ImportDecl(..),
+import CmdLineOpts ( opt_NoImplicitPrelude, opt_WarnDuplicateExports )
+
+import HsSyn ( HsModule(..), HsDecl(..), IE(..), ieName, ImportDecl(..),
collectTopBinders
)
import RdrHsSyn ( RdrNameIE, RdrNameImportDecl,
RdrNameHsModule, RdrNameHsDecl
)
-import RnIfaces ( getInterfaceExports, getDeclBinders, getDeclSysBinders,
+import RnIfaces ( getInterfaceExports, getDeclBinders,
recordLocalSlurps, checkModUsage, findAndReadIface, outOfDate
)
import RnEnv
import RnMonad
import FiniteMap
-import PrelInfo ( pRELUDE_Name, mAIN_Name, main_RDR )
+import PrelNames ( pRELUDE_Name, mAIN_Name, main_RDR )
import UniqFM ( lookupUFM )
import Bag ( bagToList )
import Module ( ModuleName, mkThisModule, pprModuleName, WhereFrom(..) )
import NameSet
import Name ( Name, ExportFlag(..), ImportReason(..), Provenance(..),
- isLocallyDefined, setNameProvenance,
- nameOccName, getSrcLoc, pprProvenance, getNameProvenance
+ setLocalNameSort, nameOccName, nameEnvElts
)
import RdrName ( RdrName, rdrNameOcc, setRdrNameOcc, mkRdrQual, mkRdrUnqual, isQual, isUnqual )
import OccName ( setOccNameSpace, dataName )
-import SrcLoc ( SrcLoc )
import NameSet ( elemNameSet, emptyNameSet )
import Outputable
import Maybes ( maybeToBool, catMaybes, mapMaybe )
-import UniqFM ( emptyUFM, listToUFM, plusUFM_C )
-import Unique ( getUnique )
-import Util ( removeDups, equivClassesByUniq, sortLt )
+import UniqFM ( emptyUFM, listToUFM )
+import ListSetOps ( removeDups )
+import Util ( sortLt )
import List ( partition )
\end{code}
rec_exp_fn :: Name -> ExportFlag
rec_exp_fn = mk_export_fn (availsToNameSet rec_export_avails)
in
- setModuleRn this_mod $
-- PROCESS LOCAL DECLS
-- Do these *first* so that the correct provenance gets
returnRn 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 gbl_env,
- isQual rdr_name]) `thenRn_`
-
-- PROCESS EXPORT LISTS
exportsFromAvail this_mod exports all_avails gbl_env `thenRn` \ export_avails ->
returnRn (outOfDate, Nothing)
Right iface
- | not opt_SourceUnchanged
+ | panic "checkEarlyExit: ???: not opt_SourceUnchanged"
-> -- Source code changed
traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_`
returnRn (False, Just iface)
filterImports imp_mod_name import_spec avails `thenRn` \ (filtered_avails, hides, explicits) ->
+ let
+ mk_provenance name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits))
+ (is_unqual name))
+ in
+
qualifyImports imp_mod_name
(not qual_only) -- Maybe want unqualified names
as_mod hides
- (improveAvails imp_mod iloc explicits
- is_unqual filtered_avails)
-
-
-improveAvails imp_mod iloc explicits is_unqual avails
- -- 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
- = map improve_avail avails
- where
- improve_avail (Avail n) = Avail (improve n)
- improve_avail (AvailTC n ns) = AvailTC (improve n) (map improve ns)
-
- improve name = setNameProvenance name
- (NonLocalDef (UserImport imp_mod iloc (is_explicit name))
- (is_unqual name))
- is_explicit name = name `elemNameSet` explicits
+ mk_provenance
+ filtered_avails
\end{code}
\begin{code}
importsFromLocalDecls mod_name rec_exp_fn decls
- = mapRn (getLocalDeclBinders newLocalName) decls `thenRn` \ avails_s ->
+ = mapRn (getLocalDeclBinders mod rec_exp_fn) decls `thenRn` \ avails_s ->
let
avails = concat avails_s
-- Build the environment
qualifyImports mod_name
- True -- Want unqualified names
- Nothing -- no 'as M'
- [] -- Hide nothing
+ True -- Want unqualified names
+ Nothing -- no 'as M'
+ [] -- Hide nothing
+ (\n -> LocalDef) -- Provenance is local
avails
-
where
mod = mkThisModule mod_name
- newLocalName rdr_name loc
- = check_unqual rdr_name loc `thenRn_`
- newTopBinder mod (rdrNameOcc rdr_name) `thenRn` \ name ->
- returnRn (setNameProvenance name (LocalDef loc (rec_exp_fn name)))
-
- -- There should never be a qualified name in a binding position (except in instance decls)
- -- The parser doesn't check this because the same parser parses instance decls
- check_unqual rdr_name loc
- | isUnqual rdr_name = returnRn ()
- | otherwise = qualNameErr (text "the binding for" <+> quotes (ppr rdr_name))
- (rdr_name,loc)
-
-getLocalDeclBinders :: (RdrName -> SrcLoc -> RnMG Name) -- New-name function
- -> RdrNameHsDecl
- -> RnMG Avails
-getLocalDeclBinders new_name (ValD binds)
+getLocalDeclBinders :: Module
+ -> (Name -> Bool) -- Is-exported predicate
+ -> RdrNameHsDecl -> RnMG Avails
+getLocalDeclBinders mod rec_exp_fn (ValD binds)
= mapRn do_one (bagToList (collectTopBinders binds))
where
- do_one (rdr_name, loc) = new_name rdr_name loc `thenRn` \ name ->
+ do_one (rdr_name, loc) = newLocalName mod rec_exp_fn rdr_name loc `thenRn` \ name ->
returnRn (Avail name)
-getLocalDeclBinders new_name decl
- = getDeclBinders new_name decl `thenRn` \ maybe_avail ->
+getLocalDeclBinders mod rec_exp_fn decl
+ = getDeclBinders (newLocalName mod rec_exp_fn) decl `thenRn` \ maybe_avail ->
case maybe_avail of
Nothing -> returnRn [] -- Instance decls and suchlike
- Just avail -> getDeclSysBinders new_sys_name decl `thenRn_`
- returnRn [avail]
+ Just avail -> returnRn [avail]
+
+newLocalName mod rec_exp_fn rdr_name loc
+ = check_unqual rdr_name loc `thenRn_`
+ newTopBinder mod rdr_name loc `thenRn` \ name ->
+ returnRn (setLocalNameSort name (rec_exp_fn name))
where
- -- The getDeclSysBinders is just to get the names of superclass selectors
- -- etc, into the cache
- new_sys_name rdr_name loc = newImplicitBinder (rdrNameOcc rdr_name) loc
+ -- There should never be a qualified name in a binding position (except in instance decls)
+ -- The parser doesn't check this because the same parser parses instance decls
+ check_unqual rdr_name loc
+ | isUnqual rdr_name = returnRn ()
+ | otherwise = qualNameErr (text "the binding for" <+> quotes (ppr rdr_name))
+ (rdr_name,loc)
\end{code}
+
%************************************************************************
%* *
\subsection{Filtering imports}
-> Bool -- True <=> want unqualified import
-> Maybe ModuleName -- Optional "as M" part
-> [AvailInfo] -- What's to be hidden
+ -> (Name -> Provenance)
-> Avails -- Whats imported and how
-> RnMG (GlobalRdrEnv, ExportAvails)
-qualifyImports this_mod unqual_imp as_mod hides avails
+qualifyImports this_mod unqual_imp as_mod hides mk_provenance avails
=
-- Make the name environment. We're talking about a
-- single module here, so there must be no name clashes.
| unqual_imp = env2
| otherwise = env1
where
- env1 = addOneToGlobalRdrEnv env (mkRdrQual qual_mod occ) name
- env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) name
+ env1 = addOneToGlobalRdrEnv env (mkRdrQual qual_mod occ) (name,prov)
+ env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) (name,prov)
occ = nameOccName name
+ prov = mk_provenance name
del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
where
where
rdr_name = ieName ie
maybe_in_scope = lookupFM global_name_env rdr_name
- Just (name:dup_names) = maybe_in_scope
+ Just ((name,_):dup_names) = maybe_in_scope
maybe_avail = lookupUFM entity_avail_env name
Just avail = maybe_avail
maybe_export_avail = filterAvail ie avail
dupDeclErr (n:ns)
= vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
- nest 4 (vcat (map pp sorted_ns))]
+ nest 4 (vcat (map ppr sorted_locs))]
where
- sorted_ns = sortLt occ'ed_before (n:ns)
-
- occ'ed_before a b = LT == compare (getSrcLoc a) (getSrcLoc b)
-
- pp n = pprProvenance (getNameProvenance n)
+ sorted_locs = sortLt occ'ed_before (map nameSrcLoc (n:ns))
+ occ'ed_before a b = LT == compare a b
dupExportWarn occ_name ie1 ie2
= hsep [quotes (ppr occ_name),