import HsSyn
import RdrHsSyn ( RdrNameIE )
import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
- mkRdrUnqual, mkRdrQual, lookupRdrEnv, foldRdrEnv
+ mkRdrUnqual, mkRdrQual, lookupRdrEnv, foldRdrEnv, rdrEnvToList,
+ unqualifyRdrName
)
import HsTypes ( hsTyVarName, replaceTyVarName )
import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
import PrelNames ( mkUnboundName, syntaxList, SyntaxMap, vanillaSyntaxMap,
derivingOccurrences,
mAIN_Name, pREL_MAIN_Name,
- ioTyConName, integerTyConName, doubleTyConName, intTyConName,
+ ioTyConName, intTyConName,
boolTyConName, funTyConName,
unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
eqStringName, printName,
- hasKey, fractionalClassKey, numClassKey,
bindIOName, returnIOName, failIOName
)
import TysWiredIn ( unitTyCon ) -- A little odd
mod = rdrNameModule rdr_name
occ = rdrNameOcc rdr_name
in
- loadInterface (ppr rdr_name) mod ImportBySystem `thenRn` \ iface ->
+ loadInterface (ppr rdr_name) mod ImportByUser `thenRn` \ iface ->
case [ name | (_,avails) <- mi_exports iface,
avail <- avails,
name <- availNames avail,
\end{code}
\begin{code}
-implicitGates :: Name -> FreeVars
--- If we load class Num, add Integer to the gates
--- This takes account of the fact that Integer might be needed for
--- defaulting, but we don't want to load Integer (and all its baggage)
--- if there's no numeric stuff needed.
--- Similarly for class Fractional and Double
---
--- NB: If we load (say) Floating, we'll end up loading Fractional too,
--- since Fractional is a superclass of Floating
-implicitGates cls | cls `hasKey` numClassKey = unitFV integerTyConName
- | cls `hasKey` fractionalClassKey = unitFV doubleTyConName
- | otherwise = emptyFVs
-\end{code}
-
-\begin{code}
rnSyntaxNames :: GlobalRdrEnv -> FreeVars -> RnMG (FreeVars, SyntaxMap)
-- Look up the re-bindable syntactic sugar names
-- Any errors arising from these lookups may surprise the
newLocalsRn rdr_names_w_loc
= getNameSupplyRn `thenRn` \ name_supply ->
let
- n = length rdr_names_w_loc
(us', us1) = splitUniqSupply (nsUniqs name_supply)
- uniqs = uniqsFromSupply n us1
+ uniqs = uniqsFromSupply us1
names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
| ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
]
\begin{code}
mkGlobalRdrEnv :: ModuleName -- Imported module (after doing the "as M" name change)
-> Bool -- True <=> want unqualified import
- -> Bool -- True <=> want qualified import
- -> [AvailInfo] -- What's to be hidden (but only the unqualified
- -- version is hidden)
-> (Name -> Provenance)
- -> Avails -- Whats imported and how
+ -> Avails -- Whats imported
+ -> Avails -- What's to be hidden
+ -- I.e. import (imports - hides)
-> Deprecations
-> GlobalRdrEnv
-mkGlobalRdrEnv this_mod unqual_imp qual_imp hides
- mk_provenance avails deprecs
- = gbl_env2
+mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails hides deprecs
+ = gbl_env3
where
-- Make the name environment. We're talking about a
-- single module here, so there must be no name clashes.
-- In practice there only ever will be if it's the module
-- being compiled.
- -- Add the things that are available
+ -- Add qualified names for the things that are available
+ -- (Qualified names are always imported)
gbl_env1 = foldl add_avail emptyRdrEnv avails
- -- Delete things that are hidden
+ -- Delete (qualified names of) things that are hidden
gbl_env2 = foldl del_avail gbl_env1 hides
+ -- Add unqualified names
+ gbl_env3 | unqual_imp = foldl add_unqual gbl_env2 (rdrEnvToList gbl_env2)
+ | otherwise = gbl_env2
+
+ add_unqual env (qual_name, elts)
+ = foldl add_one env elts
+ where
+ add_one env elt = addOneToGlobalRdrEnv env unqual_name elt
+ unqual_name = unqualifyRdrName qual_name
+ -- The qualified import should only have added one
+ -- binding for each qualified name! But if there's an error in
+ -- the module (multiple bindings for the same name) we may get
+ -- duplicates. So the simple thing is to do the fold.
+
+ del_avail env avail
+ = foldl delOneFromGlobalRdrEnv env rdr_names
+ where
+ rdr_names = map (mkRdrQual this_mod . nameOccName)
+ (availNames avail)
+
+
add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
add_avail env avail = foldl add_name env (availNames avail)
- add_name env name
- | qual_imp && unqual_imp = env3
- | unqual_imp = env2
- | qual_imp = env1
- | otherwise = env
+ add_name env name -- Add qualified name only
+ = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt
where
- env1 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt
- env2 = addOneToGlobalRdrEnv env (mkRdrUnqual occ) elt
- env3 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) elt
occ = nameOccName name
elt = GRE name (mk_provenance name) (lookupDeprec deprecs name)
- del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
- where
- rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
-
mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
-- Used to construct a GlobalRdrEnv for an interface that we've
-- read from a .hi file. We can't construct the original top-level
mkIfaceGlobalRdrEnv m_avails
= foldl add emptyRdrEnv m_avails
where
- add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True False []
- (\n -> LocalDef) avails NoDeprecs)
+ add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True
+ (\n -> LocalDef) avails [] NoDeprecs)
-- The NoDeprecs is a bit of a hack I suppose
\end{code}
= pushSrcLocRn loc $
addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
$$
- (ptext SLIT("in") <+> descriptor))
+ descriptor)
warnDeprec :: Name -> DeprecTxt -> RnM d ()
warnDeprec name txt
quotes (ppr name) <+> text "is deprecated:",
nest 4 (ppr txt) ])
\end{code}
+