{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
module NameCache
( lookupOrigNameCache
, extendOrigNameCache
, extendNameCache
, initNameCache
, NameCache(..), OrigNameCache
) where
import GhcPrelude
import Module
import Name
import UniqSupply
import TysWiredIn
import Util
import Outputable
import PrelNames
#include "HsVersions.h"
type OrigNameCache = ModuleEnv (OccEnv Name)
lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache OrigNameCache
nc Module
mod OccName
occ
| Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
gHC_TYPES Bool -> Bool -> Bool
|| Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
gHC_PRIM Bool -> Bool -> Bool
|| Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
gHC_TUPLE
, Just Name
name <- OccName -> Maybe Name
isBuiltInOcc_maybe OccName
occ
=
Name -> Maybe Name
forall a. a -> Maybe a
Just Name
name
| Bool
otherwise
= case OrigNameCache -> Module -> Maybe (OccEnv Name)
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv OrigNameCache
nc Module
mod of
Maybe (OccEnv Name)
Nothing -> Maybe Name
forall a. Maybe a
Nothing
Just OccEnv Name
occ_env -> OccEnv Name -> OccName -> Maybe Name
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv Name
occ_env OccName
occ
extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
extendOrigNameCache OrigNameCache
nc Name
name
= ASSERT2( isExternalName name, ppr name )
OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
extendNameCache OrigNameCache
nc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name) (Name -> OccName
nameOccName Name
name) Name
name
extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
extendNameCache OrigNameCache
nc Module
mod OccName
occ Name
name
= (OccEnv Name -> OccEnv Name -> OccEnv Name)
-> OrigNameCache -> Module -> OccEnv Name -> OrigNameCache
forall a.
(a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnvWith OccEnv Name -> OccEnv Name -> OccEnv Name
forall p. p -> OccEnv Name -> OccEnv Name
combine OrigNameCache
nc Module
mod (OccName -> Name -> OccEnv Name
forall a. OccName -> a -> OccEnv a
unitOccEnv OccName
occ Name
name)
where
combine :: p -> OccEnv Name -> OccEnv Name
combine p
_ OccEnv Name
occ_env = OccEnv Name -> OccName -> Name -> OccEnv Name
forall a. OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv OccEnv Name
occ_env OccName
occ Name
name
data NameCache
= NameCache { NameCache -> UniqSupply
nsUniqs :: !UniqSupply,
NameCache -> OrigNameCache
nsNames :: !OrigNameCache
}
initNameCache :: UniqSupply -> [Name] -> NameCache
initNameCache :: UniqSupply -> [Name] -> NameCache
initNameCache UniqSupply
us [Name]
names
= NameCache :: UniqSupply -> OrigNameCache -> NameCache
NameCache { nsUniqs :: UniqSupply
nsUniqs = UniqSupply
us,
nsNames :: OrigNameCache
nsNames = [Name] -> OrigNameCache
initOrigNames [Name]
names }
initOrigNames :: [Name] -> OrigNameCache
initOrigNames :: [Name] -> OrigNameCache
initOrigNames [Name]
names = (OrigNameCache -> Name -> OrigNameCache)
-> OrigNameCache -> [Name] -> OrigNameCache
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OrigNameCache -> Name -> OrigNameCache
extendOrigNameCache OrigNameCache
forall a. ModuleEnv a
emptyModuleEnv [Name]
names