Commit a27c5f77 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Fix Trac #2188: scoping in TH declarations quotes

This patch fixes a rather tiresome issue, namely the fact that
a TH declaration quote *shadows* bindings in outer scopes:

  f g = [d| f :: Int
            f = g
  	    g :: Int
            g = 4 |]

Here, the outer bindings for 'f' (top-level) and 'g' (local)
are shadowed, and the inner bindings for f,g should not be
reported as duplicates.  (Remember they are top-level bindings.)

The actual bug was that we'd forgotten to delete 'g' from the
LocalRdrEnv, so the type sig for 'g' was binding to the outer
'g' not the inner one.
parent 3e571a94
...@@ -20,7 +20,7 @@ module RnBinds (rnTopBinds, rnTopBindsLHS, rnTopBindsRHS, -- use these for top-l ...@@ -20,7 +20,7 @@ module RnBinds (rnTopBinds, rnTopBindsLHS, rnTopBindsRHS, -- use these for top-l
rnLocalBindsAndThen, rnValBindsLHS, rnValBindsRHS, -- or these for local bindings rnLocalBindsAndThen, rnValBindsLHS, rnValBindsRHS, -- or these for local bindings
rnMethodBinds, renameSigs, mkSigTvFn, rnMethodBinds, renameSigs, mkSigTvFn,
rnMatchGroup, rnGRHSs, rnMatchGroup, rnGRHSs,
makeMiniFixityEnv makeMiniFixityEnv, MiniFixityEnv
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -36,16 +36,7 @@ import RnPat (rnPatsAndThen_LocalRightwards, rnBindPat, ...@@ -36,16 +36,7 @@ import RnPat (rnPatsAndThen_LocalRightwards, rnBindPat,
NameMaker, localRecNameMaker, topRecNameMaker, applyNameMaker, NameMaker, localRecNameMaker, topRecNameMaker, applyNameMaker,
patSigErr) patSigErr)
import RnEnv ( lookupLocatedBndrRn, import RnEnv
lookupInstDeclBndr, newIPNameRn,
lookupLocatedSigOccRn, bindPatSigTyVarsFV,
bindLocalFixities, bindSigTyVarsFV,
warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
bindLocatedLocalsFV, bindLocalNames, bindLocalNamesFV,
bindLocalNamesFV_WithFixities,
bindLocatedLocalsRn,
checkDupAndShadowedRdrNames
)
import DynFlags ( DynFlag(..) ) import DynFlags ( DynFlag(..) )
import HscTypes (FixItem(..)) import HscTypes (FixItem(..))
import Name import Name
...@@ -175,8 +166,7 @@ it expects the global environment to contain bindings for the binders ...@@ -175,8 +166,7 @@ it expects the global environment to contain bindings for the binders
\begin{code} \begin{code}
-- for top-level bindings, we need to make top-level names, -- for top-level bindings, we need to make top-level names,
-- so we have a different entry point than for local bindings -- so we have a different entry point than for local bindings
rnTopBindsLHS :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind rnTopBindsLHS :: MiniFixityEnv
-- these fixities need to be brought into scope with the names
-> HsValBinds RdrName -> HsValBinds RdrName
-> RnM (HsValBindsLR Name RdrName) -> RnM (HsValBindsLR Name RdrName)
rnTopBindsLHS fix_env binds = rnTopBindsLHS fix_env binds =
...@@ -200,7 +190,7 @@ rnTopBindsRHS bound_names binds = ...@@ -200,7 +190,7 @@ rnTopBindsRHS bound_names binds =
rnTopBinds :: HsValBinds RdrName rnTopBinds :: HsValBinds RdrName
-> RnM (HsValBinds Name, DefUses) -> RnM (HsValBinds Name, DefUses)
rnTopBinds b = rnTopBinds b =
do nl <- rnTopBindsLHS emptyUFM b do nl <- rnTopBindsLHS emptyOccEnv b
let bound_names = map unLoc (collectHsValBinders nl) let bound_names = map unLoc (collectHsValBinders nl)
bindLocalNames bound_names $ rnTopBindsRHS bound_names nl bindLocalNames bound_names $ rnTopBindsRHS bound_names nl
...@@ -262,8 +252,7 @@ rnIPBind (IPBind n expr) = do ...@@ -262,8 +252,7 @@ rnIPBind (IPBind n expr) = do
\begin{code} \begin{code}
-- wrapper for local binds -- wrapper for local binds
-- creates the documentation info and calls the helper below -- creates the documentation info and calls the helper below
rnValBindsLHS :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind rnValBindsLHS :: MiniFixityEnv
-- these fixities need to be brought into scope with the names
-> HsValBinds RdrName -> HsValBinds RdrName
-> RnM (HsValBindsLR Name RdrName) -> RnM (HsValBindsLR Name RdrName)
rnValBindsLHS fix_env binds = rnValBindsLHS fix_env binds =
...@@ -274,8 +263,7 @@ rnValBindsLHS fix_env binds = ...@@ -274,8 +263,7 @@ rnValBindsLHS fix_env binds =
-- just so we don't forget to do it somewhere -- just so we don't forget to do it somewhere
rnValBindsLHSFromDoc_Local :: [Located RdrName] -- RdrNames of the LHS (so we don't have to gather them twice) rnValBindsLHSFromDoc_Local :: [Located RdrName] -- RdrNames of the LHS (so we don't have to gather them twice)
-> SDoc -- doc string for dup names and shadowing -> SDoc -- doc string for dup names and shadowing
-> UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind -> MiniFixityEnv
-- these fixities need to be brought into scope with the names
-> HsValBinds RdrName -> HsValBinds RdrName
-> RnM (HsValBindsLR Name RdrName) -> RnM (HsValBindsLR Name RdrName)
...@@ -332,6 +320,8 @@ rnValBindsRHSGen :: (FreeVars -> FreeVars) -- for trimming free var sets ...@@ -332,6 +320,8 @@ rnValBindsRHSGen :: (FreeVars -> FreeVars) -- for trimming free var sets
rnValBindsRHSGen trim bound_names binds@(ValBindsIn mbinds sigs) = do rnValBindsRHSGen trim bound_names binds@(ValBindsIn mbinds sigs) = do
-- rename the sigs -- rename the sigs
env <- getGblEnv
traceRn (ptext SLIT("Rename sigs") <+> ppr (tcg_rdr_env env))
sigs' <- rename_sigs sigs sigs' <- rename_sigs sigs
-- rename the RHSes -- rename the RHSes
binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds
...@@ -420,11 +410,10 @@ rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside ...@@ -420,11 +410,10 @@ rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
-- Checks for duplicates, but not that only locally defined things are fixed. -- Checks for duplicates, but not that only locally defined things are fixed.
-- Note: for local fixity declarations, duplicates would also be checked in -- Note: for local fixity declarations, duplicates would also be checked in
-- check_sigs below. But we also use this function at the top level. -- check_sigs below. But we also use this function at the top level.
makeMiniFixityEnv :: [LFixitySig RdrName]
-> RnM (UniqFM (Located Fixity)) -- key is the FastString of the OccName makeMiniFixityEnv :: [LFixitySig RdrName] -> RnM MiniFixityEnv
-- of the fixity declaration it came from
makeMiniFixityEnv decls = foldlM add_one emptyOccEnv decls
makeMiniFixityEnv decls = foldlM add_one emptyUFM decls
where where
add_one env (L loc (FixitySig (L name_loc name) fixity)) = do add_one env (L loc (FixitySig (L name_loc name) fixity)) = do
{ -- this fixity decl is a duplicate iff { -- this fixity decl is a duplicate iff
...@@ -432,14 +421,13 @@ makeMiniFixityEnv decls = foldlM add_one emptyUFM decls ...@@ -432,14 +421,13 @@ makeMiniFixityEnv decls = foldlM add_one emptyUFM decls
-- (we only need to check the local fix_env because -- (we only need to check the local fix_env because
-- definitions of non-local will be caught elsewhere) -- definitions of non-local will be caught elsewhere)
let {occ = rdrNameOcc name; let {occ = rdrNameOcc name;
curKey = occNameFS occ;
fix_item = L loc fixity}; fix_item = L loc fixity};
case lookupUFM env curKey of case lookupOccEnv env occ of
Nothing -> return $ addToUFM env curKey fix_item Nothing -> return $ extendOccEnv env occ fix_item
Just (L loc' _) -> do Just (L loc' _) -> do
{ setSrcSpan loc $ { setSrcSpan loc $
addLocErr (L name_loc name) (dupFixityDecl loc') addLocErr (L name_loc name) (dupFixityDecl loc')
; return env} ; return env}
} }
......
...@@ -25,7 +25,8 @@ module RnEnv ( ...@@ -25,7 +25,8 @@ module RnEnv (
getLookupOccRn, getLookupOccRn,
newLocalsRn, newIPNameRn, newLocalsRn, newIPNameRn,
bindLocalNames, bindLocalNamesFV, bindLocalNamesFV_WithFixities, bindLocalNames, bindLocalNamesFV,
MiniFixityEnv, bindLocalNamesFV_WithFixities,
bindLocatedLocalsFV, bindLocatedLocalsRn, bindLocatedLocalsFV, bindLocatedLocalsRn,
bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV, bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
bindTyVarsRn, extendTyVarEnvFVRn, bindTyVarsRn, extendTyVarEnvFVRn,
...@@ -57,8 +58,7 @@ import NameSet ...@@ -57,8 +58,7 @@ import NameSet
import NameEnv import NameEnv
import LazyUniqFM import LazyUniqFM
import DataCon ( dataConFieldLabels ) import DataCon ( dataConFieldLabels )
import OccName ( OccName, tcName, isDataOcc, pprNonVarNameSpace, occNameSpace, import OccName
reportIfUnused, occNameFS )
import Module ( Module, ModuleName ) import Module ( Module, ModuleName )
import PrelNames ( mkUnboundName, rOOT_MAIN, iNTERACTIVE, import PrelNames ( mkUnboundName, rOOT_MAIN, iNTERACTIVE,
consDataConKey, hasKey, forall_tv_RDR ) consDataConKey, hasKey, forall_tv_RDR )
...@@ -547,6 +547,13 @@ lookupLocalDataTcNames rdr_name ...@@ -547,6 +547,13 @@ lookupLocalDataTcNames rdr_name
} }
-------------------------------- --------------------------------
type MiniFixityEnv = OccEnv (Located Fixity)
-- Mini fixity env for the names we're about
-- to bind, in a single binding group
--
-- We keep the location so that if we find
-- a duplicate, we can report it sensibly
bindLocalFixities :: [FixitySig RdrName] -> (UniqFM (Located Fixity) -> RnM a) -> RnM a bindLocalFixities :: [FixitySig RdrName] -> (UniqFM (Located Fixity) -> RnM a) -> RnM a
-- Used for nested fixity decls: -- Used for nested fixity decls:
-- bind the names that are in scope already; -- bind the names that are in scope already;
...@@ -580,7 +587,7 @@ bindLocalFixities fixes thing_inside ...@@ -580,7 +587,7 @@ bindLocalFixities fixes thing_inside
-- the fixities are given as a UFM from an OccName's FastString to a fixity decl -- the fixities are given as a UFM from an OccName's FastString to a fixity decl
-- Also check for unused binders -- Also check for unused binders
bindLocalNamesFV_WithFixities :: [Name] bindLocalNamesFV_WithFixities :: [Name]
-> UniqFM (Located Fixity) -> MiniFixityEnv
-> RnM (a, FreeVars) -> RnM (a, FreeVars) -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV_WithFixities names fixities thing_inside bindLocalNamesFV_WithFixities names fixities thing_inside
= bindLocalNamesFV names $ = bindLocalNamesFV names $
...@@ -591,7 +598,7 @@ bindLocalNamesFV_WithFixities names fixities thing_inside ...@@ -591,7 +598,7 @@ bindLocalNamesFV_WithFixities names fixities thing_inside
boundFixities = foldr boundFixities = foldr
(\ name -> \ acc -> (\ name -> \ acc ->
-- check whether this name has a fixity decl -- check whether this name has a fixity decl
case lookupUFM fixities (occNameFS (nameOccName name)) of case lookupOccEnv fixities (nameOccName name) of
Just (L _ fix) -> (name, FixItem (nameOccName name) fix) : acc Just (L _ fix) -> (name, FixItem (nameOccName name) fix) : acc
Nothing -> acc) [] names Nothing -> acc) [] names
-- bind the names; extend the fixity env; do the thing inside -- bind the names; extend the fixity env; do the thing inside
......
...@@ -34,7 +34,6 @@ import HsSyn ...@@ -34,7 +34,6 @@ import HsSyn
import TcRnMonad import TcRnMonad
import RnEnv import RnEnv
import HscTypes ( availNames ) import HscTypes ( availNames )
import RnNames ( getLocalDeclBinders, extendRdrEnvRn )
import RnTypes ( rnHsTypeFVs, import RnTypes ( rnHsTypeFVs,
mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec) mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec)
import RnPat (rnQuasiQuote, rnOverLit, rnPatsAndThen_LocalRightwards, rnBindPat, import RnPat (rnQuasiQuote, rnOverLit, rnPatsAndThen_LocalRightwards, rnBindPat,
...@@ -914,8 +913,7 @@ collectRecStmtsFixities l = ...@@ -914,8 +913,7 @@ collectRecStmtsFixities l =
-- left-hand sides -- left-hand sides
rn_rec_stmt_lhs :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind rn_rec_stmt_lhs :: MiniFixityEnv
-- these fixities need to be brought into scope with the names
-> LStmt RdrName -> LStmt RdrName
-- rename LHS, and return its FVs -- rename LHS, and return its FVs
-- Warning: we will only need the FreeVars below in the case of a BindStmt, -- Warning: we will only need the FreeVars below in the case of a BindStmt,
...@@ -956,8 +954,7 @@ rn_rec_stmt_lhs _ stmt@(L _ (TransformStmt _ _ _)) -- Syntactically illegal in m ...@@ -956,8 +954,7 @@ rn_rec_stmt_lhs _ stmt@(L _ (TransformStmt _ _ _)) -- Syntactically illegal in m
rn_rec_stmt_lhs _ stmt@(L _ (GroupStmt _ _)) -- Syntactically illegal in mdo rn_rec_stmt_lhs _ stmt@(L _ (GroupStmt _ _)) -- Syntactically illegal in mdo
= pprPanic "rn_rec_stmt" (ppr stmt) = pprPanic "rn_rec_stmt" (ppr stmt)
rn_rec_stmts_lhs :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind rn_rec_stmts_lhs :: MiniFixityEnv
-- these fixities need to be brought into scope with the names
-> [LStmt RdrName] -> [LStmt RdrName]
-> RnM [(LStmtLR Name RdrName, FreeVars)] -> RnM [(LStmtLR Name RdrName, FreeVars)]
rn_rec_stmts_lhs fix_env stmts = rn_rec_stmts_lhs fix_env stmts =
......
...@@ -12,9 +12,8 @@ ...@@ -12,9 +12,8 @@
-- for details -- for details
module RnNames ( module RnNames (
rnImports, importsFromLocalDecls, rnImports, getLocalNonValBinders,
rnExports, rnExports, extendGlobalRdrEnvRn,
getLocalDeclBinders, extendRdrEnvRn,
reportUnusedNames, finishDeprecations, reportUnusedNames, finishDeprecations,
) where ) where
...@@ -275,82 +274,70 @@ From the top-level declarations of this module produce ...@@ -275,82 +274,70 @@ From the top-level declarations of this module produce
* the ImportAvails * the ImportAvails
created by its bindings. created by its bindings.
\begin{code} Note [Shadowing in extendRdrEnvRn]
-- Bool determines shadowing: ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- true: names in the group should shadow other UnQuals Usually when etending the GlobalRdrEnv we complain if a new binding
-- with the same OccName (used in Template Haskell) duplicates an existing one. By adding the bindings one at a time,
-- false: duplicates should be reported as an error this check also complains if we add two new bindings for the same name.
-- (Remember that in Template Haskell the duplicates might *already be*
-- The UniqFM (OccName -> FixItem) associates a Name's OccName's in the GlobalRdrEnv from higher up the module.)
-- FastString with a fixity declaration (that needs the actual OccName
-- to be plugged in). This fixity must be brought into scope when such But with a Template Haskell quotation we want to *shadow*:
-- a Name is. f x = h [d| f = 3 |]
importsFromLocalDecls :: Bool -> HsGroup RdrName -> UniqFM (Located Fixity) -> RnM TcGblEnv Here the inner binding for 'f' simply shadows the outer one.
importsFromLocalDecls shadowP group fixities And that applies even if the binding for 'f' is in a where-clause,
= do { gbl_env <- getGblEnv and hence is in the *local* RdrEnv not the *global* RdrEnv.
; avails <- getLocalDeclBinders gbl_env group Hence the shadowP boolean passed in.
; (rdr_env', fix_env') <- extendRdrEnvRn shadowP (tcg_rdr_env gbl_env, \begin{code}
tcg_fix_env gbl_env) extendGlobalRdrEnvRn :: Bool -- Note [Shadowing in extendGlobalRdrEnvRn]
avails fixities -> [AvailInfo]
-> MiniFixityEnv
-> RnM (TcGblEnv, TcLclEnv)
-- Updates both the GlobalRdrEnv and the FixityEnv
-- We return a new TcLclEnv only becuase we might have to
-- delete some bindings from it; see Note [Shadowing in extendGlobalRdrEnvRn]
extendGlobalRdrEnvRn shadowP avails new_fixities
= do { (gbl_env, lcl_env) <- getEnvs
; let rdr_env = tcg_rdr_env gbl_env
fix_env = tcg_fix_env gbl_env
-- Delete new_occs from global and local envs
-- We are going to shadow them
new_occs = map (nameOccName . gre_name) gres
rdr_env1 = hideSomeUnquals rdr_env new_occs
lcl_env1 = lcl_env { tcl_rdr = delListFromOccEnv (tcl_rdr lcl_env) new_occs }
-- Note [Shadowing in extendGlobalRdrEnvRn]
(rdr_env2, lcl_env2) | shadowP = (rdr_env1, lcl_env1)
| otherwise = (rdr_env, lcl_env)
; traceRn (text "local avails: " <> ppr avails) ; (rdr_env', fix_env') <- foldlM extend (rdr_env2, fix_env) gres
; let gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }
; return (gbl_env', lcl_env2) }
where
gres = gresFromAvails LocalDef avails
; return (gbl_env { tcg_rdr_env = rdr_env', extend envs@(cur_rdr_env, cur_fix_env) gre
tcg_fix_env = fix_env'}) = let gres = lookupGlobalRdrEnv cur_rdr_env (nameOccName (gre_name gre))
} in case filter isLocalGRE gres of -- Check for existing *local* defns
dup_gre:_ -> do { addDupDeclErr (gre_name dup_gre) (gre_name gre)
; return envs }
[] -> return (simple_extend envs gre)
-- Bool determines shadowing as in importsFromLocalDecls. simple_extend (rdr_env, fix_env) gre
-- UniqFM FixItem is the same as in importsFromLocalDecls. = (extendGlobalRdrEnv rdr_env gre, fix_env')
-- where
-- Add the new locally-bound names one by one, checking for duplicates as -- If there is a fixity decl for the gre,
-- we do so. Remember that in Template Haskell the duplicates
-- might *already be* in the GlobalRdrEnv from higher up the module.
--
-- Also update the FixityEnv with the fixities for the names brought into scope.
--
-- Note that the return values are the extensions of the two inputs,
-- not the extras relative to them.
extendRdrEnvRn :: Bool -> (GlobalRdrEnv, NameEnv FixItem)
-> [AvailInfo] -> UniqFM (Located Fixity) -> RnM (GlobalRdrEnv, NameEnv FixItem)
extendRdrEnvRn shadowP (rdr_env, fix_env) avails fixities =
let -- if there is a fixity decl for the gre,
-- add it to the fixity env -- add it to the fixity env
extendFixEnv env gre = name = gre_name gre
let name = gre_name gre occ = nameOccName name
occ = nameOccName name fix_env' = case lookupOccEnv new_fixities occ of
curKey = occNameFS occ in Nothing -> fix_env
case lookupUFM fixities curKey of Just (L _ fi) -> extendNameEnv fix_env name (FixItem occ fi)
Nothing -> env
Just (L _ fi) -> extendNameEnv env name (FixItem occ fi)
(rdr_env_to_extend, extender) =
if shadowP
then -- when shadowing is on,
-- (1) we need to remove the existing Unquals for the
-- names we're extending the env with
-- (2) but extending the env is simple
let names = concatMap availNames avails
new_occs = map nameOccName names
trimmed_rdr_env = hideSomeUnquals rdr_env new_occs
in
(trimmed_rdr_env,
\(cur_rdr_env, cur_fix_env) -> \gre ->
return (extendGlobalRdrEnv cur_rdr_env gre,
extendFixEnv cur_fix_env gre))
else -- when shadowing is off,
-- (1) we don't munge the incoming env
-- (2) but we need to check for dups when extending
(rdr_env,
\(cur_rdr_env, cur_fix_env) -> \gre ->
let gres = lookupGlobalRdrEnv cur_rdr_env (nameOccName (gre_name gre))
in case filter isLocalGRE gres of -- Check for existing *local* defns
dup_gre:_ -> do { addDupDeclErr (gre_name dup_gre) (gre_name gre)
; return (cur_rdr_env, cur_fix_env) }
[] -> return (extendGlobalRdrEnv cur_rdr_env gre,
extendFixEnv cur_fix_env gre))
in foldlM extender (rdr_env_to_extend, fix_env) (gresFromAvails LocalDef avails)
\end{code} \end{code}
@getLocalDeclBinders@ returns the names for an @HsDecl@. It's @getLocalDeclBinders@ returns the names for an @HsDecl@. It's
...@@ -370,13 +357,24 @@ raising a duplicate declaration error. So, we make a new name for it, but ...@@ -370,13 +357,24 @@ raising a duplicate declaration error. So, we make a new name for it, but
don't return it in the 'AvailInfo'. don't return it in the 'AvailInfo'.
\begin{code} \begin{code}
-- Note: this function does NOT get the binders of the ValBinds that getLocalNonValBinders :: HsGroup RdrName -> RnM [AvailInfo]
-- will be bound during renaming -- Get all the top-level binders bound the group *except*
getLocalDeclBinders :: TcGblEnv -> HsGroup RdrName -> RnM [AvailInfo] -- for value bindings, which are treated separately
getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs, -- Specificaly we return AvailInfo for
hs_tyclds = tycl_decls, -- type decls
hs_instds = inst_decls, -- class decls
hs_fords = foreign_decls }) -- associated types
-- foreign imports
-- (in hs-boot files) value signatures
getLocalNonValBinders group
= do { gbl_env <- getGblEnv
; get_local_binders gbl_env group }
get_local_binders gbl_env (HsGroup {hs_valds = ValBindsIn _ val_sigs,
hs_tyclds = tycl_decls,
hs_instds = inst_decls,
hs_fords = foreign_decls })
= do { tc_names_s <- mapM new_tc tycl_decls = do { tc_names_s <- mapM new_tc tycl_decls
; at_names_s <- mapM inst_ats inst_decls ; at_names_s <- mapM inst_ats inst_decls
; val_names <- mapM new_simple val_bndrs ; val_names <- mapM new_simple val_bndrs
...@@ -1264,7 +1262,7 @@ warnDuplicateImports gres ...@@ -1264,7 +1262,7 @@ warnDuplicateImports gres
-- --
-- NOTE: currently the test does not warn about -- NOTE: currently the test does not warn about
-- import M( x ) -- import M( x )
-- imoprt N( x ) -- import N( x )
-- even if the same underlying 'x' is involved, because dropping -- even if the same underlying 'x' is involved, because dropping
-- either import would change the qualified names in scope (M.x, N.x) -- either import would change the qualified names in scope (M.x, N.x)
-- But if the qualified names aren't used, the import is indeed redundant -- But if the qualified names aren't used, the import is indeed redundant
......
...@@ -50,7 +50,6 @@ import HsSyn ...@@ -50,7 +50,6 @@ import HsSyn
import TcRnMonad import TcRnMonad
import RnEnv import RnEnv
import HscTypes ( availNames ) import HscTypes ( availNames )
import RnNames ( getLocalDeclBinders, extendRdrEnvRn )
import RnTypes ( rnHsTypeFVs, import RnTypes ( rnHsTypeFVs,
mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec, mkConOpPatRn mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec, mkConOpPatRn
) )
...@@ -111,9 +110,7 @@ matchNameMaker ...@@ -111,9 +110,7 @@ matchNameMaker
; return (res, fvs) }}) ; return (res, fvs) }})
topRecNameMaker, localRecNameMaker topRecNameMaker, localRecNameMaker
:: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind :: MiniFixityEnv -> NameMaker
-- these fixities need to be brought into scope with the names
-> NameMaker
-- topNameMaker and localBindMaker do not check for unused binding -- topNameMaker and localBindMaker do not check for unused binding
localRecNameMaker fix_env localRecNameMaker fix_env
......
...@@ -36,8 +36,8 @@ import RnEnv ( lookupLocalDataTcNames, ...@@ -36,8 +36,8 @@ import RnEnv ( lookupLocalDataTcNames,
bindTyVarsRn, extendTyVarEnvFVRn, bindTyVarsRn, extendTyVarEnvFVRn,
bindLocalNames, checkDupRdrNames, mapFvRn, lookupGreLocalRn, bindLocalNames, checkDupRdrNames, mapFvRn, lookupGreLocalRn,
) )
import RnNames (importsFromLocalDecls, extendRdrEnvRn) import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
import HscTypes (GenAvailInfo(..)) import HscTypes ( GenAvailInfo(..) )
import RnHsDoc ( rnHsDoc, rnMbLHsDoc ) import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
import TcRnMonad import TcRnMonad
...@@ -98,10 +98,10 @@ Checks the @(..)@ etc constraints in the export list. ...@@ -98,10 +98,10 @@ Checks the @(..)@ etc constraints in the export list.
\begin{code} \begin{code}
-- brings the binders of the group into scope in the appropriate places; -- Brings the binders of the group into scope in the appropriate places;
-- does NOT assume that anything is in scope already -- does NOT assume that anything is in scope already
-- --
-- the Bool determines whether (True) names in the group shadow existing -- The Bool determines whether (True) names in the group shadow existing
-- Unquals in the global environment (used in Template Haskell) or -- Unquals in the global environment (used in Template Haskell) or
-- (False) whether duplicates are reported as an error -- (False) whether duplicates are reported as an error
rnSrcDecls :: Bool -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name) rnSrcDecls :: Bool -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
...@@ -123,8 +123,10 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls, ...@@ -123,8 +123,10 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls,
local_fix_env <- makeMiniFixityEnv fix_decls; local_fix_env <- makeMiniFixityEnv fix_decls;
-- (B) Bring top level binders (and their fixities) into scope, -- (B) Bring top level binders (and their fixities) into scope,
-- except for the value bindings, which get brought in below. -- *except* for the value bindings, which get brought in below.
inNewEnv (importsFromLocalDecls shadowP group local_fix_env) $ \ tcg_env -> do { avails <- getLocalNonValBinders group ;
tc_envs <- extendGlobalRdrEnvRn shadowP avails local_fix_env ;
setEnvs tc_envs $ do {
failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
...@@ -132,7 +134,7 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls, ...@@ -132,7 +134,7 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls,
-- extend the record field env. -- extend the record field env.
-- This depends on the data constructors and field names being in -- This depends on the data constructors and field names being in
-- scope from (B) above -- scope from (B) above
inNewEnv (extendRecordFieldEnv tycl_decls) $ \ tcg_env -> do { inNewEnv (extendRecordFieldEnv tycl_decls) $ \ _ -> do {
-- (D) Rename the left-hand sides of the value bindings. -- (D) Rename the left-hand sides of the value bindings.
-- This depends on everything from (B) being in scope, -- This depends on everything from (B) being in scope,
...@@ -143,12 +145,8 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls, ...@@ -143,12 +145,8 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls,
let { lhs_binders = map unLoc $ collectHsValBinders new_lhs; let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
lhs_avails = map Avail lhs_binders lhs_avails = map Avail lhs_binders
} ; } ;
inNewEnv (extendRdrEnvRn shadowP (tcg_rdr_env tcg_env, tcg_fix_env tcg_env) (tcg_env, tcl_env) <- extendGlobalRdrEnvRn shadowP lhs_avails local_fix_env ;
lhs_avails local_fix_env setEnvs (tcg_env, tcl_env) $ do {
>>= \ (new_rdr_env, new_fix_env) ->
return (tcg_env { tcg_rdr_env = new_rdr_env,
tcg_fix_env = new_fix_env
})) $ \tcg_env -> do {
-- Now everything is in scope, as the remaining renaming assumes. -- Now everything is in scope, as the remaining renaming assumes.
...@@ -637,7 +635,7 @@ rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context, ...@@ -637,7 +635,7 @@ rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
; (derivs', deriv_fvs) <- rn_derivs derivs ; (derivs', deriv_fvs) <- rn_derivs derivs
; condecls' <- rnConDecls (unLoc tycon') condecls ; condecls' <- rnConDecls (unLoc tycon') condecls
-- No need to check for duplicate constructor decls -- No need to check for duplicate constructor decls
-- since that is done by RnNames.extendRdrEnvRn -- since that is done by RnNames.extendGlobalRdrEnvRn
; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
tcdLName = tycon', tcdTyVars = tyvars', tcdLName = tycon', tcdTyVars = tyvars',
tcdTyPats = typats', tcdKindSig = Nothing, tcdTyPats = typats', tcdKindSig = Nothing,
...@@ -665,7 +663,7 @@ rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context, ...@@ -665,7 +663,7 @@ rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
; (derivs', deriv_fvs) <- rn_derivs derivs ; (derivs', deriv_fvs) <- rn_derivs derivs
; condecls' <- rnConDecls (unLoc tycon') condecls ; condecls' <- rnConDecls (unLoc tycon') condecls
-- No need to check for duplicate constructor decls -- No need to check for duplicate constructor decls
-- since that is done by RnNames.extendRdrEnvRn -- since that is done by RnNames.extendGlobalRdrEnvRn
; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
tcdLName = tycon', tcdTyVars = tyvars', tcdLName = tycon', tcdTyVars = tyvars',
tcdTyPats = Nothing, tcdKindSig = sig, tcdTyPats = Nothing, tcdKindSig = sig,
...@@ -730,7 +728,7 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname, ...@@ -730,7 +728,7 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
; return (tyvars', context', fds', ats', ats_fvs, sigs') } ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
-- No need to check for duplicate associated type decls -- No need to check for duplicate associated type decls
-- since that is done by RnNames.extendRdrEnvRn -- since that is done by RnNames.extendGlobalRdrEnvRn
-- Check the signatures -- Check the signatures
-- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs). -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
...@@ -756,7 +754,7 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname, ...@@ -756,7 +754,7 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds, gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
not (unLoc tv `elemLocalRdrEnv` name_env) ] not (unLoc tv `elemLocalRdrEnv` name_env) ]
-- No need to check for duplicate method signatures -- No need to check for duplicate method signatures
-- since that is done by RnNames.extendRdrEnvRn -- since that is done by RnNames.extendGlobalRdrEnvRn
-- and the methods are already in scope -- and the methods are already in scope
; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds } ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
...@@ -858,7 +856,7 @@ rnConDeclDetails doc (InfixCon ty1 ty2) ...@@ -858,7 +856,7 @@ rnConDeclDetails doc (InfixCon ty1 ty2)
rnConDeclDetails doc (RecCon fields) rnConDeclDetails doc (RecCon fields)
= do { new_fields <- mappM (rnField doc) fields = do { new_fields <- mappM (rnField doc) fields
-- No need to check for duplicate fields -- No need to check for duplicate fields