+%************************************************************************
+%* *
+ 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
+ gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated
+ }
+
+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
+
+lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
+lookupGRE_RdrName rdr_name env
+ = case lookupOccEnv env occ of
+ Nothing -> []
+ Just gres | isUnqual rdr_name -> filter unQualOK gres
+ | otherwise -> filter (hasQual mod) gres
+ where
+ mod = rdrNameModule rdr_name
+ occ = rdrNameOcc rdr_name
+
+lookupGRE_Name :: GlobalRdrEnv -> Name -> [GlobalRdrElt]
+lookupGRE_Name env name
+ = [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name),
+ gre_name gre == name ]
+
+
+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)
+
+hasQual :: ModuleName -> GlobalRdrElt -> Bool
+-- A qualified version of this thing is in scope
+hasQual mod (GRE {gre_prov = LocalDef m}) = m == mod
+hasQual mod (GRE {gre_prov = Imported is _}) = any ((== mod) . is_as) 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,
+ gre_deprec = gre_deprec g1 `seqMaybe` gre_deprec g2 }
+ -- Could the deprecs be different? If we re-export
+ -- something deprecated, is it propagated? I forget.
+\end{code}
+