#include "HsVersions.h"
-import CmdLineOpts ( opt_NoImplicitPrelude, opt_WarnDuplicateExports, opt_SourceUnchanged )
+import CmdLineOpts ( opt_NoImplicitPrelude, opt_WarnDuplicateExports )
import HsSyn ( HsModule(..), HsDecl(..), IE(..), ieName, ImportDecl(..),
collectTopBinders
import Bag ( bagToList )
import Module ( ModuleName, mkThisModule, pprModuleName, WhereFrom(..) )
import NameSet
-import Name ( Name, ExportFlag(..), ImportReason(..), Provenance(..),
- setNameProvenance,
- nameOccName, getSrcLoc, pprProvenance, getNameProvenance,
- nameEnvElts
+import Name ( Name, ImportReason(..), Provenance(..),
+ setLocalNameSort, nameOccName, nameEnvElts
)
import RdrName ( RdrName, rdrNameOcc, setRdrNameOcc, mkRdrQual, mkRdrUnqual, isQual, isUnqual )
import OccName ( setOccNameSpace, dataName )
import Outputable
import Maybes ( maybeToBool, catMaybes, mapMaybe )
import UniqFM ( emptyUFM, listToUFM )
-import Util ( removeDups, sortLt )
+import ListSetOps ( removeDups )
+import Util ( sortLt )
import List ( partition )
\end{code}
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 :: Name -> Bool
rec_exp_fn = mk_export_fn (availsToNameSet rec_export_avails)
in
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}
-- 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
-getLocalDeclBinders :: Module -> (Name -> ExportFlag)
+getLocalDeclBinders :: Module
+ -> (Name -> Bool) -- Is-exported predicate
-> RdrNameHsDecl -> RnMG Avails
getLocalDeclBinders mod rec_exp_fn (ValD binds)
= mapRn do_one (bagToList (collectTopBinders binds))
Just avail -> returnRn [avail]
newLocalName mod rec_exp_fn 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)))
+ = check_unqual rdr_name loc `thenRn_`
+ newTopBinder mod rdr_name loc `thenRn` \ name ->
+ returnRn (setLocalNameSort name (rec_exp_fn name))
where
-- 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
-> 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
where
name_occ = nameOccName name
-mk_export_fn :: NameSet -> (Name -> ExportFlag)
-mk_export_fn exported_names
- = \name -> if name `elemNameSet` exported_names
- then Exported
- else NotExported
+mk_export_fn :: NameSet -> (Name -> Bool) -- True => exported
+mk_export_fn exported_names = \name -> name `elemNameSet` exported_names
\end{code}
%************************************************************************
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),
projects / ghc-hetmet.git / blobdiff