+\begin{code}
+type SymbolTable = ModuleEnv ModDetails
+type IfaceTable = ModuleEnv ModIface
+
+type HomeIfaceTable = IfaceTable
+type PackageIfaceTable = IfaceTable
+
+type HomeSymbolTable = SymbolTable -- Domain = modules in the home package
+type PackageSymbolTable = SymbolTable -- Domain = modules in the some other package
+type GlobalSymbolTable = SymbolTable -- Domain = all modules
+
+emptyIfaceTable :: IfaceTable
+emptyIfaceTable = emptyUFM
+\end{code}
+
+Simple lookups in the symbol table.
+
+\begin{code}
+lookupTable :: ModuleEnv a -> ModuleEnv a -> Name -> Maybe a
+-- We often have two Symbol- or IfaceTables, and want to do a lookup
+lookupTable ht pt name
+ = lookupModuleEnv ht mod `seqMaybe` lookupModuleEnv pt mod
+ where
+ mod = nameModule name
+
+lookupTableByModName :: ModuleEnv a -> ModuleEnv a -> ModuleName -> Maybe a
+-- We often have two Symbol- or IfaceTables, and want to do a lookup
+lookupTableByModName ht pt mod
+ = lookupModuleEnvByName ht mod `seqMaybe` lookupModuleEnvByName pt mod
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Type environment stuff}
+%* *
+%************************************************************************
+
+\begin{code}
+type TypeEnv = NameEnv TyThing
+emptyTypeEnv = emptyNameEnv
+
+data TyThing = AnId Id
+ | ATyCon TyCon
+ | AClass Class
+
+isTyClThing :: TyThing -> Bool
+isTyClThing (ATyCon _) = True
+isTyClThing (AClass _) = True
+isTyClThing (AnId _) = False
+
+instance NamedThing TyThing where
+ getName (AnId id) = getName id
+ getName (ATyCon tc) = getName tc
+ getName (AClass cl) = getName cl
+
+typeEnvClasses env = [cl | AClass cl <- nameEnvElts env]
+typeEnvTyCons env = [tc | ATyCon tc <- nameEnvElts env]
+
+\end{code}
+
+
+\begin{code}
+lookupTypeEnv :: SymbolTable -> Name -> Maybe TyThing
+lookupTypeEnv tbl name
+ = case lookupModuleEnv tbl (nameModule name) of
+ Just details -> lookupNameEnv (md_types details) name
+ Nothing -> Nothing
+
+
+groupTyThings :: [TyThing] -> FiniteMap Module TypeEnv
+ -- Finite map because we want the range too
+groupTyThings things
+ = foldl add emptyFM things
+ where
+ add :: FiniteMap Module TypeEnv -> TyThing -> FiniteMap Module TypeEnv
+ add tbl thing = addToFM tbl mod new_env
+ where
+ name = getName thing
+ mod = nameModule name
+ new_env = case lookupFM tbl mod of
+ Nothing -> unitNameEnv name thing
+ Just env -> extendNameEnv env name thing
+
+extendTypeEnv :: SymbolTable -> FiniteMap Module TypeEnv -> SymbolTable
+extendTypeEnv tbl things
+ = foldFM add tbl things
+ where
+ add mod type_env tbl
+ = extendModuleEnv tbl mod new_details
+ where
+ new_details
+ = case lookupModuleEnv tbl mod of
+ Nothing -> emptyModDetails {md_types = type_env}
+ Just details -> details {md_types = md_types details
+ `plusNameEnv` type_env}