--- 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
-
- ; (rdr_env', fix_env') <- extendRdrEnvRn shadowP (tcg_rdr_env gbl_env,
- tcg_fix_env gbl_env)
- avails fixities
-
- ; traceRn (text "local avails: " <> ppr avails)
-
- ; return (gbl_env { tcg_rdr_env = rdr_env',
- tcg_fix_env = fix_env'})
- }
-
--- 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,
- -- 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)
+extendGlobalRdrEnvRn :: [AvailInfo]
+ -> MiniFixityEnv
+ -> RnM (TcGblEnv, TcLclEnv)
+ -- Updates both the GlobalRdrEnv and the FixityEnv
+ -- We return a new TcLclEnv only because we might have to
+ -- delete some bindings from it;
+ -- see Note [Top-level Names in Template Haskell decl quotes]
+
+extendGlobalRdrEnvRn avails new_fixities
+ = do { (gbl_env, lcl_env) <- getEnvs
+ ; stage <- getStage
+ ; let rdr_env = tcg_rdr_env gbl_env
+ fix_env = tcg_fix_env gbl_env
+
+ -- Delete new_occs from global and local envs
+ -- If we are in a TemplateHaskell decl bracket,
+ -- we are going to shadow them
+ -- See Note [Top-level Names in Template Haskell decl quotes]
+ shadowP = isBrackStage stage
+ new_occs = map (nameOccName . gre_name) gres
+ rdr_env1 = transformGREs qual_gre new_occs rdr_env
+ lcl_env1 = lcl_env { tcl_rdr = delListFromOccEnv (tcl_rdr lcl_env) new_occs }
+ (rdr_env2, lcl_env2) | shadowP = (rdr_env1, lcl_env1)
+ | otherwise = (rdr_env, lcl_env)
+
+ rdr_env3 = foldl extendGlobalRdrEnv rdr_env2 gres
+ fix_env' = foldl extend_fix_env fix_env gres
+ (rdr_env', dups) = findLocalDupsRdrEnv rdr_env3 new_occs
+
+ gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }
+
+ ; mapM_ addDupDeclErr dups
+
+ ; traceRn (text "extendGlobalRdrEnvRn" <+> (ppr new_fixities $$ ppr fix_env $$ ppr fix_env'))
+ ; return (gbl_env', lcl_env2) }
+ where
+ gres = gresFromAvails LocalDef avails
+
+ -- If there is a fixity decl for the gre, add it to the fixity env
+ extend_fix_env fix_env gre
+ | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
+ = extendNameEnv fix_env name (FixItem occ fi)
+ | otherwise
+ = fix_env
+ where
+ name = gre_name gre
+ occ = nameOccName name
+
+ qual_gre :: GlobalRdrElt -> GlobalRdrElt
+ -- Transform top-level GREs from the module being compiled
+ -- so that they are out of the way of new definitions in a Template
+ -- Haskell bracket
+ -- See Note [Top-level Names in Template Haskell decl quotes]
+ -- Seems like 5 times as much work as it deserves!
+ --
+ -- For a LocalDef we make a (fake) qualified imported GRE for a
+ -- local GRE so that the original *qualified* name is still in scope
+ -- but the *unqualified* one no longer is. What a hack!
+
+ qual_gre gre@(GRE { gre_prov = LocalDef, gre_name = name })
+ | isExternalName name = gre { gre_prov = Imported [imp_spec] }
+ | otherwise = gre
+ -- Do not shadow Internal (ie Template Haskell) Names
+ -- See Note [Top-level Names in Template Haskell decl quotes]
+ where
+ mod = ASSERT2( isExternalName name, ppr name) moduleName (nameModule name)
+ imp_spec = ImpSpec { is_item = ImpAll, is_decl = decl_spec }
+ decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod,
+ is_qual = True, -- Qualified only!
+ is_dloc = srcLocSpan (nameSrcLoc name) }
+
+ qual_gre gre@(GRE { gre_prov = Imported specs })
+ = gre { gre_prov = Imported (map qual_spec specs) }
+
+ qual_spec spec@(ImpSpec { is_decl = decl_spec })
+ = spec { is_decl = decl_spec { is_qual = True } }