rnLocalBindsAndThen, rnValBindsLHS, rnValBindsRHS, -- or these for local bindings
rnMethodBinds, renameSigs, mkSigTvFn,
rnMatchGroup, rnGRHSs,
- makeMiniFixityEnv
+ makeMiniFixityEnv, MiniFixityEnv
) where
#include "HsVersions.h"
NameMaker, localRecNameMaker, topRecNameMaker, applyNameMaker,
patSigErr)
-import RnEnv ( lookupLocatedBndrRn,
- lookupInstDeclBndr, newIPNameRn,
- lookupLocatedSigOccRn, bindPatSigTyVarsFV,
- bindLocalFixities, bindSigTyVarsFV,
- warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
- bindLocatedLocalsFV, bindLocalNames, bindLocalNamesFV,
- bindLocalNamesFV_WithFixities,
- bindLocatedLocalsRn,
- checkDupAndShadowedRdrNames
- )
+import RnEnv
import DynFlags ( DynFlag(..) )
import HscTypes (FixItem(..))
import Name
\begin{code}
-- for top-level bindings, we need to make top-level names,
-- 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
- -- these fixities need to be brought into scope with the names
+rnTopBindsLHS :: MiniFixityEnv
-> HsValBinds RdrName
-> RnM (HsValBindsLR Name RdrName)
rnTopBindsLHS fix_env binds =
rnTopBinds :: HsValBinds RdrName
-> RnM (HsValBinds Name, DefUses)
rnTopBinds b =
- do nl <- rnTopBindsLHS emptyUFM b
+ do nl <- rnTopBindsLHS emptyOccEnv b
let bound_names = map unLoc (collectHsValBinders nl)
bindLocalNames bound_names $ rnTopBindsRHS bound_names nl
\begin{code}
-- wrapper for local binds
-- creates the documentation info and calls the helper below
-rnValBindsLHS :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind
- -- these fixities need to be brought into scope with the names
+rnValBindsLHS :: MiniFixityEnv
-> HsValBinds RdrName
-> RnM (HsValBindsLR Name RdrName)
rnValBindsLHS fix_env binds =
-- 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)
-> SDoc -- doc string for dup names and shadowing
- -> UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind
- -- these fixities need to be brought into scope with the names
+ -> MiniFixityEnv
-> HsValBinds RdrName
-> RnM (HsValBindsLR Name RdrName)
rnValBindsRHSGen trim bound_names binds@(ValBindsIn mbinds sigs) = do
-- rename the sigs
+ env <- getGblEnv
+ traceRn (ptext SLIT("Rename sigs") <+> ppr (tcg_rdr_env env))
sigs' <- rename_sigs sigs
-- rename the RHSes
binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds
-- Checks for duplicates, but not that only locally defined things are fixed.
-- Note: for local fixity declarations, duplicates would also be checked in
-- 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
- -- of the fixity declaration it came from
-
-makeMiniFixityEnv decls = foldlM add_one emptyUFM decls
+
+makeMiniFixityEnv :: [LFixitySig RdrName] -> RnM MiniFixityEnv
+
+makeMiniFixityEnv decls = foldlM add_one emptyOccEnv decls
where
add_one env (L loc (FixitySig (L name_loc name) fixity)) = do
{ -- this fixity decl is a duplicate iff
-- (we only need to check the local fix_env because
-- definitions of non-local will be caught elsewhere)
let {occ = rdrNameOcc name;
- curKey = occNameFS occ;
fix_item = L loc fixity};
- case lookupUFM env curKey of
- Nothing -> return $ addToUFM env curKey fix_item
+ case lookupOccEnv env occ of
+ Nothing -> return $ extendOccEnv env occ fix_item
Just (L loc' _) -> do
{ setSrcSpan loc $
- addLocErr (L name_loc name) (dupFixityDecl loc')
+ addLocErr (L name_loc name) (dupFixityDecl loc')
; return env}
}
getLookupOccRn,
newLocalsRn, newIPNameRn,
- bindLocalNames, bindLocalNamesFV, bindLocalNamesFV_WithFixities,
+ bindLocalNames, bindLocalNamesFV,
+ MiniFixityEnv, bindLocalNamesFV_WithFixities,
bindLocatedLocalsFV, bindLocatedLocalsRn,
bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
bindTyVarsRn, extendTyVarEnvFVRn,
import NameEnv
import LazyUniqFM
import DataCon ( dataConFieldLabels )
-import OccName ( OccName, tcName, isDataOcc, pprNonVarNameSpace, occNameSpace,
- reportIfUnused, occNameFS )
+import OccName
import Module ( Module, ModuleName )
import PrelNames ( mkUnboundName, rOOT_MAIN, iNTERACTIVE,
consDataConKey, hasKey, forall_tv_RDR )
}
--------------------------------
+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
-- Used for nested fixity decls:
-- bind the names that are in scope already;
-- the fixities are given as a UFM from an OccName's FastString to a fixity decl
-- Also check for unused binders
bindLocalNamesFV_WithFixities :: [Name]
- -> UniqFM (Located Fixity)
+ -> MiniFixityEnv
-> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV_WithFixities names fixities thing_inside
= bindLocalNamesFV names $
boundFixities = foldr
(\ name -> \ acc ->
-- 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
Nothing -> acc) [] names
-- bind the names; extend the fixity env; do the thing inside
import TcRnMonad
import RnEnv
import HscTypes ( availNames )
-import RnNames ( getLocalDeclBinders, extendRdrEnvRn )
import RnTypes ( rnHsTypeFVs,
mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec)
import RnPat (rnQuasiQuote, rnOverLit, rnPatsAndThen_LocalRightwards, rnBindPat,
-- left-hand sides
-rn_rec_stmt_lhs :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind
- -- these fixities need to be brought into scope with the names
+rn_rec_stmt_lhs :: MiniFixityEnv
-> LStmt RdrName
-- rename LHS, and return its FVs
-- Warning: we will only need the FreeVars below in the case of a BindStmt,
rn_rec_stmt_lhs _ stmt@(L _ (GroupStmt _ _)) -- Syntactically illegal in mdo
= pprPanic "rn_rec_stmt" (ppr stmt)
-rn_rec_stmts_lhs :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind
- -- these fixities need to be brought into scope with the names
+rn_rec_stmts_lhs :: MiniFixityEnv
-> [LStmt RdrName]
-> RnM [(LStmtLR Name RdrName, FreeVars)]
rn_rec_stmts_lhs fix_env stmts =
-- for details
module RnNames (
- rnImports, importsFromLocalDecls,
- rnExports,
- getLocalDeclBinders, extendRdrEnvRn,
+ rnImports, getLocalNonValBinders,
+ rnExports, extendGlobalRdrEnvRn,
reportUnusedNames, finishDeprecations,
) where
* the ImportAvails
created by its bindings.
-\begin{code}
--- Bool determines shadowing:
--- true: names in the group should shadow other UnQuals
--- with the same OccName (used in Template Haskell)
--- false: duplicates should be reported as an error
---
--- The UniqFM (OccName -> FixItem) associates a Name's OccName's
--- FastString with a fixity declaration (that needs the actual OccName
--- to be plugged in). This fixity must be brought into scope when such
--- a Name is.
-importsFromLocalDecls :: Bool -> HsGroup RdrName -> UniqFM (Located Fixity) -> RnM TcGblEnv
-importsFromLocalDecls shadowP group fixities
- = do { gbl_env <- getGblEnv
-
- ; avails <- getLocalDeclBinders gbl_env group
+Note [Shadowing in extendRdrEnvRn]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Usually when etending the GlobalRdrEnv we complain if a new binding
+duplicates an existing one. By adding the bindings one at a time,
+this check also complains if we add two new bindings for the same name.
+(Remember that in Template Haskell the duplicates might *already be*
+in the GlobalRdrEnv from higher up the module.)
+
+But with a Template Haskell quotation we want to *shadow*:
+ f x = h [d| f = 3 |]
+Here the inner binding for 'f' simply shadows the outer one.
+And that applies even if the binding for 'f' is in a where-clause,
+and hence is in the *local* RdrEnv not the *global* RdrEnv.
+
+Hence the shadowP boolean passed in.
- ; (rdr_env', fix_env') <- extendRdrEnvRn shadowP (tcg_rdr_env gbl_env,
- tcg_fix_env gbl_env)
- avails fixities
+\begin{code}
+extendGlobalRdrEnvRn :: Bool -- Note [Shadowing in extendGlobalRdrEnvRn]
+ -> [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',
- tcg_fix_env = fix_env'})
- }
+ extend envs@(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 envs }
+ [] -> return (simple_extend envs gre)
--- Bool determines shadowing as in importsFromLocalDecls.
--- UniqFM FixItem is the same as in importsFromLocalDecls.
---
--- Add the new locally-bound names one by one, checking for duplicates as
--- 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,
+ simple_extend (rdr_env, fix_env) gre
+ = (extendGlobalRdrEnv rdr_env gre, fix_env')
+ where
+ -- If there is a fixity decl for the gre,
-- add it to the fixity env
- extendFixEnv env gre =
- let name = gre_name gre
- occ = nameOccName name
- curKey = occNameFS occ in
- case lookupUFM fixities curKey of
- 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)
+ name = gre_name gre
+ occ = nameOccName name
+ fix_env' = case lookupOccEnv new_fixities occ of
+ Nothing -> fix_env
+ Just (L _ fi) -> extendNameEnv fix_env name (FixItem occ fi)
\end{code}
@getLocalDeclBinders@ returns the names for an @HsDecl@. It's
don't return it in the 'AvailInfo'.
\begin{code}
--- Note: this function does NOT get the binders of the ValBinds that
--- will be bound during renaming
-getLocalDeclBinders :: TcGblEnv -> HsGroup RdrName -> RnM [AvailInfo]
-getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs,
- hs_tyclds = tycl_decls,
- hs_instds = inst_decls,
- hs_fords = foreign_decls })
+getLocalNonValBinders :: HsGroup RdrName -> RnM [AvailInfo]
+-- Get all the top-level binders bound the group *except*
+-- for value bindings, which are treated separately
+-- Specificaly we return AvailInfo for
+-- type decls
+-- class 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
; at_names_s <- mapM inst_ats inst_decls
; val_names <- mapM new_simple val_bndrs
--
-- NOTE: currently the test does not warn about
-- import M( x )
- -- imoprt N( x )
+ -- import N( x )
-- even if the same underlying 'x' is involved, because dropping
-- 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
import TcRnMonad
import RnEnv
import HscTypes ( availNames )
-import RnNames ( getLocalDeclBinders, extendRdrEnvRn )
import RnTypes ( rnHsTypeFVs,
mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec, mkConOpPatRn
)
; return (res, fvs) }})
topRecNameMaker, localRecNameMaker
- :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind
- -- these fixities need to be brought into scope with the names
- -> NameMaker
+ :: MiniFixityEnv -> NameMaker
-- topNameMaker and localBindMaker do not check for unused binding
localRecNameMaker fix_env
bindTyVarsRn, extendTyVarEnvFVRn,
bindLocalNames, checkDupRdrNames, mapFvRn, lookupGreLocalRn,
)
-import RnNames (importsFromLocalDecls, extendRdrEnvRn)
-import HscTypes (GenAvailInfo(..))
+import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
+import HscTypes ( GenAvailInfo(..) )
import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
import TcRnMonad
\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
--
--- 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
-- (False) whether duplicates are reported as an error
rnSrcDecls :: Bool -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
local_fix_env <- makeMiniFixityEnv fix_decls;
-- (B) Bring top level binders (and their fixities) into scope,
- -- except for the value bindings, which get brought in below.
- inNewEnv (importsFromLocalDecls shadowP group local_fix_env) $ \ tcg_env -> do {
+ -- *except* for the value bindings, which get brought in below.
+ 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
-- extend the record field env.
-- This depends on the data constructors and field names being in
-- 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.
-- This depends on everything from (B) being in scope,
let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
lhs_avails = map Avail lhs_binders
} ;
- inNewEnv (extendRdrEnvRn shadowP (tcg_rdr_env tcg_env, tcg_fix_env tcg_env)
- lhs_avails local_fix_env
- >>= \ (new_rdr_env, new_fix_env) ->
- return (tcg_env { tcg_rdr_env = new_rdr_env,
- tcg_fix_env = new_fix_env
- })) $ \tcg_env -> do {
+ (tcg_env, tcl_env) <- extendGlobalRdrEnvRn shadowP lhs_avails local_fix_env ;
+ setEnvs (tcg_env, tcl_env) $ do {
-- Now everything is in scope, as the remaining renaming assumes.
; (derivs', deriv_fvs) <- rn_derivs derivs
; condecls' <- rnConDecls (unLoc tycon') condecls
-- 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',
tcdLName = tycon', tcdTyVars = tyvars',
tcdTyPats = typats', tcdKindSig = Nothing,
; (derivs', deriv_fvs) <- rn_derivs derivs
; condecls' <- rnConDecls (unLoc tycon') condecls
-- 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 [],
tcdLName = tycon', tcdTyVars = tyvars',
tcdTyPats = Nothing, tcdKindSig = sig,
; return (tyvars', context', fds', ats', ats_fvs, sigs') }
-- 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
-- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
not (unLoc tv `elemLocalRdrEnv` name_env) ]
-- 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
; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
rnConDeclDetails doc (RecCon fields)
= do { new_fields <- mappM (rnField doc) fields
-- No need to check for duplicate fields
- -- since that is done by RnNames.extendRdrEnvRn
+ -- since that is done by RnNames.extendGlobalRdrEnvRn
; return (RecCon new_fields) }
rnField doc (ConDeclField name ty haddock_doc)
-- (b) tcExtCoreBindings doesn't need anything
-- (in fact, it might not even need to be in the scope of
-- this tcg_env at all)
- tcg_env <- importsFromLocalDecls False (mkFakeGroup ldecls)
- emptyUFM {- no fixity decls -} ;
+ avails <- getLocalNonValBinders (mkFakeGroup ldecls) ;
+ tc_envs <- extendGlobalRdrEnvRn False avails
+ emptyOccEnv {- no fixity decls -} ;
- setGblEnv tcg_env $ do {
+ setEnvs tc_envs $ do {
rn_decls <- checkNoErrs $ rnTyClDecls ldecls ;
projects / ghc-hetmet.git / commitdiff