+%************************************************************************
+%* *
+ GlobalRdrEnv
+%* *
+%************************************************************************
+
+\begin{code}
+type GlobalRdrEnv = OccEnv [GlobalRdrElt]
+ -- Keyed by OccName; when looking up a qualified name
+ -- we look up the OccName part, and then check the Provenance
+ -- to see if the appropriate qualification is valid. This
+ -- saves routinely doubling the size of the env by adding both
+ -- qualified and unqualified names to the domain.
+ --
+ -- The list in the range is reqd because there may be name clashes
+ -- These only get reported on lookup, not on construction
+
+ -- INVARIANT: All the members of the list have distinct
+ -- gre_name fields; that is, no duplicate Names
+
+emptyGlobalRdrEnv = emptyOccEnv
+
+globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
+globalRdrEnvElts env = foldOccEnv (++) [] env
+
+data GlobalRdrElt
+ = GRE { gre_name :: Name,
+ gre_prov :: Provenance -- Why it's in scope
+ }
+
+instance Outputable GlobalRdrElt where
+ ppr gre = ppr name <+> pp_parent (nameParent_maybe name)
+ <+> parens (pprNameProvenance gre)
+ where
+ name = gre_name gre
+ pp_parent (Just p) = brackets (text "parent:" <+> ppr p)
+ pp_parent Nothing = empty
+
+pprGlobalRdrEnv :: GlobalRdrEnv -> SDoc
+pprGlobalRdrEnv env
+ = vcat (map pp (occEnvElts env))
+ where
+ pp gres = ppr (nameOccName (gre_name (head gres))) <> colon <+>
+ vcat [ ppr (gre_name gre) <+> pprNameProvenance gre
+ | gre <- gres]
+\end{code}
+
+\begin{code}
+lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
+lookupGlobalRdrEnv env rdr_name = case lookupOccEnv env rdr_name of
+ Nothing -> []
+ Just gres -> gres
+
+extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
+extendGlobalRdrEnv env gre = extendOccEnv_C add env occ [gre]
+ where
+ occ = nameOccName (gre_name gre)
+ add gres _ = gre:gres
+
+lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
+lookupGRE_RdrName rdr_name env
+ = case lookupOccEnv env (rdrNameOcc rdr_name) of
+ Nothing -> []
+ Just gres -> pickGREs rdr_name gres
+
+lookupGRE_Name :: GlobalRdrEnv -> Name -> [GlobalRdrElt]
+lookupGRE_Name env name
+ = [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name),
+ gre_name gre == name ]
+
+
+pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
+-- Take a list of GREs which have the right OccName
+-- Pick those GREs that are suitable for this RdrName
+-- And for those, keep only only the Provenances that are suitable
+--
+-- Consider
+-- module A ( f ) where
+-- import qualified Foo( f )
+-- import Baz( f )
+-- f = undefined
+-- Let's suppose that Foo.f and Baz.f are the same entity really.
+-- The export of f is ambiguous because it's in scope from the local def
+-- and the import. The lookup of (Unqual f) should return a GRE for
+-- the locally-defined f, and a GRE for the imported f, with a *single*
+-- provenance, namely the one for Baz(f).
+pickGREs rdr_name gres
+ = mapCatMaybes pick gres
+ where
+ is_unqual = isUnqual rdr_name
+ mod = rdrNameModule rdr_name
+
+ pick :: GlobalRdrElt -> Maybe GlobalRdrElt
+ pick gre@(GRE {gre_prov = LocalDef, gre_name = n}) -- Local def
+ | is_unqual || nameModule n == mod = Just gre
+ | otherwise = Nothing
+ pick gre@(GRE {gre_prov = Imported [is]}) -- Single import (efficiency)
+ | is_unqual = if not (is_qual (is_decl is)) then Just gre
+ else Nothing
+ | otherwise = if mod == is_as (is_decl is) then Just gre
+ else Nothing
+ pick gre@(GRE {gre_prov = Imported is}) -- Multiple import
+ | null filtered_is = Nothing
+ | otherwise = Just (gre {gre_prov = Imported filtered_is})
+ where
+ filtered_is | is_unqual = filter (not . is_qual . is_decl) is
+ | otherwise = filter ((== mod) . is_as . is_decl) is
+
+isLocalGRE :: GlobalRdrElt -> Bool
+isLocalGRE (GRE {gre_prov = LocalDef}) = True
+isLocalGRE other = False
+
+unQualOK :: GlobalRdrElt -> Bool
+-- An unqualifed version of this thing is in scope
+unQualOK (GRE {gre_prov = LocalDef}) = True
+unQualOK (GRE {gre_prov = Imported is}) = not (all (is_qual . is_decl) is)
+
+plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
+plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
+
+mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
+mkGlobalRdrEnv gres
+ = foldr add emptyGlobalRdrEnv gres
+ where
+ add gre env = extendOccEnv_C (foldr insertGRE) env
+ (nameOccName (gre_name gre))
+ [gre]
+
+insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
+insertGRE new_g [] = [new_g]
+insertGRE new_g (old_g : old_gs)
+ | gre_name new_g == gre_name old_g
+ = new_g `plusGRE` old_g : old_gs
+ | otherwise
+ = old_g : insertGRE new_g old_gs
+
+plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
+-- Used when the gre_name fields match
+plusGRE g1 g2
+ = GRE { gre_name = gre_name g1,
+ gre_prov = gre_prov g1 `plusProv` gre_prov g2 }
+\end{code}
+