{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}

-- | The Name Cache
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"

{-

Note [The Name Cache]
~~~~~~~~~~~~~~~~~~~~~
The Name Cache makes sure that, during any invocation of GHC, each
External Name "M.x" has one, and only one globally-agreed Unique.

* The first time we come across M.x we make up a Unique and record that
  association in the Name Cache.

* When we come across "M.x" again, we look it up in the Name Cache,
  and get a hit.

The functions newGlobalBinder, allocateGlobalBinder do the main work.
When you make an External name, you should probably be calling one
of them.


Note [Built-in syntax and the OrigNameCache]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Built-in syntax like tuples and unboxed sums are quite ubiquitous. To lower
their cost we use two tricks,

  a. We specially encode tuple and sum Names in interface files' symbol tables
     to avoid having to look up their names while loading interface files.
     Namely these names are encoded as by their Uniques. We know how to get from
     a Unique back to the Name which it represents via the mapping defined in
     the SumTupleUniques module. See Note [Symbol table representation of names]
     in BinIface and for details.

  b. We don't include them in the Orig name cache but instead parse their
     OccNames (in isBuiltInOcc_maybe) to avoid bloating the name cache with
     them.

Why is the second measure necessary? Good question; afterall, 1) the parser
emits built-in syntax directly as Exact RdrNames, and 2) built-in syntax never
needs to looked-up during interface loading due to (a). It turns out that there
are two reasons why we might look up an Orig RdrName for built-in syntax,

  * If you use setRdrNameSpace on an Exact RdrName it may be
    turned into an Orig RdrName.

  * Template Haskell turns a BuiltInSyntax Name into a TH.NameG
    (DsMeta.globalVar), and parses a NameG into an Orig RdrName
    (Convert.thRdrName).  So, e.g. $(do { reify '(,); ... }) will
    go this route (Trac #8954).

-}

-- | Per-module cache of original 'OccName's given 'Name's
type OrigNameCache   = ModuleEnv (OccEnv Name)

lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache nc :: OrigNameCache
nc mod :: Module
mod occ :: 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
name <- OccName -> Maybe Name
isBuiltInOcc_maybe OccName
occ
  =     -- See Note [Known-key names], 3(c) in PrelNames
        -- Special case for tuples; there are too many
        -- of them to pre-populate the original-name cache
    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
        Nothing      -> Maybe Name
forall a. Maybe a
Nothing
        Just occ_env :: 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 nc :: OrigNameCache
nc name :: 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 nc :: OrigNameCache
nc mod :: Module
mod occ :: OccName
occ name :: 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 _ occ_env :: 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

-- | The NameCache makes sure that there is just one Unique assigned for
-- each original name; i.e. (module-name, occ-name) pair and provides
-- something of a lookup mechanism for those names.
data NameCache
 = NameCache {  NameCache -> UniqSupply
nsUniqs :: !UniqSupply,
                -- ^ Supply of uniques
                NameCache -> OrigNameCache
nsNames :: !OrigNameCache
                -- ^ Ensures that one original name gets one unique
   }

-- | Return a function to atomically update the name cache.
initNameCache :: UniqSupply -> [Name] -> NameCache
initNameCache :: UniqSupply -> [Name] -> NameCache
initNameCache us :: UniqSupply
us names :: [Name]
names
  = $WNameCache :: UniqSupply -> OrigNameCache -> NameCache
NameCache { nsUniqs :: UniqSupply
nsUniqs = UniqSupply
us,
                nsNames :: OrigNameCache
nsNames = [Name] -> OrigNameCache
initOrigNames [Name]
names }

initOrigNames :: [Name] -> OrigNameCache
initOrigNames :: [Name] -> OrigNameCache
initOrigNames names :: [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