diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Rename/Names.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Runtime/Context.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Types/Name/Reader.hs | 25 | ||||
| -rw-r--r-- | compiler/GHC/Types/TyThing.hs | 2 |
4 files changed, 18 insertions, 18 deletions
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index 6dff5b195e..92e1309bd6 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -624,7 +624,8 @@ extendGlobalRdrEnvRn avails new_fixities | otherwise = rdr_env lcl_env3 = lcl_env2 { tcl_th_bndrs = extendNameEnvList th_bndrs - [ (n, (TopLevel, th_lvl)) + [ ( greNameMangledName n + , (TopLevel, th_lvl) ) | n <- new_names ] } ; rdr_env2 <- foldlM add_gre rdr_env1 new_gres @@ -635,8 +636,8 @@ extendGlobalRdrEnvRn avails new_fixities ; traceRn "extendGlobalRdrEnvRn 2" (pprGlobalRdrEnv True rdr_env2) ; return (gbl_env', lcl_env3) } where - new_names = concatMap availNames avails - new_occs = map nameOccName new_names + new_names = concatMap availGreNames avails + new_occs = map occName new_names -- If there is a fixity decl for the gre, add it to the fixity env extend_fix_env fix_env gre diff --git a/compiler/GHC/Runtime/Context.hs b/compiler/GHC/Runtime/Context.hs index 243624553d..6b4a4d0624 100644 --- a/compiler/GHC/Runtime/Context.hs +++ b/compiler/GHC/Runtime/Context.hs @@ -367,7 +367,7 @@ icExtendGblRdrEnv env tythings | otherwise = foldl' extendGlobalRdrEnv env1 (concatMap localGREsFromAvail avail) where - env1 = shadowNames env (concatMap availNames avail) + env1 = shadowNames env (concatMap availGreNames avail) avail = tyThingAvailInfo thing -- Ugh! The new_tythings may include record selectors, since they diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs index 6eb81653a5..a4ec4bea8d 100644 --- a/compiler/GHC/Types/Name/Reader.hs +++ b/compiler/GHC/Types/Name/Reader.hs @@ -1068,7 +1068,7 @@ extendGlobalRdrEnv env gre = extendOccEnv_Acc insertGRE Utils.singleton env (greOccName gre) gre -shadowNames :: GlobalRdrEnv -> [Name] -> GlobalRdrEnv +shadowNames :: GlobalRdrEnv -> [GreName] -> GlobalRdrEnv shadowNames = foldl' shadowName {- Note [GlobalRdrEnv shadowing] @@ -1144,22 +1144,21 @@ There are two reasons for shadowing: At that stage, the class op 'f' will have an Internal name. -} -shadowName :: GlobalRdrEnv -> Name -> GlobalRdrEnv +shadowName :: GlobalRdrEnv -> GreName -> GlobalRdrEnv -- Remove certain old GREs that share the same OccName as this new Name. -- See Note [GlobalRdrEnv shadowing] for details -shadowName env name - = alterOccEnv (fmap alter_fn) env (nameOccName name) +shadowName env new_name + = alterOccEnv (fmap (mapMaybe shadow)) env (occName new_name) where - alter_fn :: [GlobalRdrElt] -> [GlobalRdrElt] - alter_fn gres = mapMaybe (shadow_with name) gres + maybe_new_mod = nameModule_maybe (greNameMangledName new_name) - shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt - shadow_with new_name + shadow :: GlobalRdrElt -> Maybe GlobalRdrElt + shadow old_gre@(GRE { gre_lcl = lcl, gre_imp = iss }) = case greDefinitionModule old_gre of Nothing -> Just old_gre -- Old name is Internal; do not shadow Just old_mod - | Just new_mod <- nameModule_maybe new_name + | Just new_mod <- maybe_new_mod , new_mod == old_mod -- Old name same as new name; shadow completely -> Nothing @@ -1170,7 +1169,7 @@ shadowName env name -> Just (old_gre { gre_lcl = False, gre_imp = iss' }) where - iss' = lcl_imp ++ mapMaybe (shadow_is new_name) iss + iss' = lcl_imp ++ mapMaybe shadow_is iss lcl_imp | lcl = [mk_fake_imp_spec old_gre old_mod] | otherwise = [] @@ -1183,9 +1182,9 @@ shadowName env name , is_qual = True , is_dloc = greDefinitionSrcSpan old_gre } - shadow_is :: Name -> ImportSpec -> Maybe ImportSpec - shadow_is new_name is@(ImpSpec { is_decl = id_spec }) - | Just new_mod <- nameModule_maybe new_name + shadow_is :: ImportSpec -> Maybe ImportSpec + shadow_is is@(ImpSpec { is_decl = id_spec }) + | Just new_mod <- maybe_new_mod , is_as id_spec == moduleName new_mod = Nothing -- Shadow both qualified and unqualified | otherwise -- Shadow unqualified only diff --git a/compiler/GHC/Types/TyThing.hs b/compiler/GHC/Types/TyThing.hs index 1eb08b4549..fb89c42ee3 100644 --- a/compiler/GHC/Types/TyThing.hs +++ b/compiler/GHC/Types/TyThing.hs @@ -261,7 +261,7 @@ tyThingAvailInfo (ATyCon t) dcs = tyConDataCons t flds = tyConFieldLabels t tyThingAvailInfo (AConLike (PatSynCon p)) - = map avail ((getName p) : map flSelector (patSynFieldLabels p)) + = avail (getName p) : map availField (patSynFieldLabels p) tyThingAvailInfo t = [avail (getName t)] |