-- (c) The University of Glasgow 2002-2006

{-# LANGUAGE CPP, RankNTypes, BangPatterns #-}

module GHC.Iface.Env (
        newGlobalBinder, newInteractiveBinder,
        externaliseName,
        lookupIfaceTop,
        lookupOrig, lookupOrigIO, lookupOrigNameCache, extendNameCache,
        newIfaceName, newIfaceNames,
        extendIfaceIdEnv, extendIfaceTyVarEnv,
        tcIfaceLclId, tcIfaceTyVar, lookupIfaceVar,
        lookupIfaceTyVar, extendIfaceEnvs,
        setNameModule,

        ifaceExportNames,

        -- Name-cache stuff
        allocateGlobalBinder, updNameCacheTc, updNameCache,
        mkNameCacheUpdater, NameCacheUpdater(..),
   ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Driver.Env

import GHC.Tc.Utils.Monad
import GHC.Core.Type
import GHC.Iface.Type
import GHC.Runtime.Context

import GHC.Unit.Module
import GHC.Unit.Module.ModIface

import GHC.Data.FastString
import GHC.Data.FastString.Env

import GHC.Types.Var
import GHC.Types.Name
import GHC.Types.Avail
import GHC.Types.Name.Cache
import GHC.Types.Unique.Supply
import GHC.Types.SrcLoc

import GHC.Utils.Outputable
import Data.List     ( partition )
import Data.IORef

{-
*********************************************************
*                                                      *
        Allocating new Names in the Name Cache
*                                                      *
*********************************************************

See Also: Note [The Name Cache] in GHC.Types.Name.Cache
-}

newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
-- Used for source code and interface files, to make the
-- Name for a thing, given its Module and OccName
-- See Note [The Name Cache] in GHC.Types.Name.Cache
--
-- The cache may already have a binding for this thing,
-- because we may have seen an occurrence before, but now is the
-- moment when we know its Module and SrcLoc in their full glory

newGlobalBinder :: forall a b. Module -> OccName -> SrcSpan -> TcRnIf a b Name
newGlobalBinder Module
mod OccName
occ SrcSpan
loc
  = do { Name
name <- Module
-> OccName -> (NameCache -> (NameCache, Name)) -> TcRnIf a b Name
forall c a b.
Module -> OccName -> (NameCache -> (NameCache, c)) -> TcRnIf a b c
updNameCacheTc Module
mod OccName
occ ((NameCache -> (NameCache, Name)) -> TcRnIf a b Name)
-> (NameCache -> (NameCache, Name)) -> TcRnIf a b Name
forall a b. (a -> b) -> a -> b
$ \NameCache
name_cache ->
                 NameCache -> Module -> OccName -> SrcSpan -> (NameCache, Name)
allocateGlobalBinder NameCache
name_cache Module
mod OccName
occ SrcSpan
loc
       ; SDoc -> TcRnIf a b ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"newGlobalBinder" SDoc -> SDoc -> SDoc
<+>
                  ([SDoc] -> SDoc
vcat [ Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
loc, Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name]))
       ; Name -> TcRnIf a b Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }

newInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name
-- Works in the IO monad, and gets the Module
-- from the interactive context
newInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name
newInteractiveBinder HscEnv
hsc_env OccName
occ SrcSpan
loc
 = do { let mod :: Module
mod = InteractiveContext -> Module
icInteractiveModule (HscEnv -> InteractiveContext
hsc_IC HscEnv
hsc_env)
       ; HscEnv
-> Module -> OccName -> (NameCache -> (NameCache, Name)) -> IO Name
forall c.
HscEnv
-> Module -> OccName -> (NameCache -> (NameCache, c)) -> IO c
updNameCacheIO HscEnv
hsc_env Module
mod OccName
occ ((NameCache -> (NameCache, Name)) -> IO Name)
-> (NameCache -> (NameCache, Name)) -> IO Name
forall a b. (a -> b) -> a -> b
$ \NameCache
name_cache ->
         NameCache -> Module -> OccName -> SrcSpan -> (NameCache, Name)
allocateGlobalBinder NameCache
name_cache Module
mod OccName
occ SrcSpan
loc }

allocateGlobalBinder
  :: NameCache
  -> Module -> OccName -> SrcSpan
  -> (NameCache, Name)
-- See Note [The Name Cache] in GHC.Types.Name.Cache
allocateGlobalBinder :: NameCache -> Module -> OccName -> SrcSpan -> (NameCache, Name)
allocateGlobalBinder NameCache
name_supply Module
mod OccName
occ SrcSpan
loc
  = case OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache (NameCache -> OrigNameCache
nsNames NameCache
name_supply) Module
mod OccName
occ of
        -- A hit in the cache!  We are at the binding site of the name.
        -- This is the moment when we know the SrcLoc
        -- of the Name, so we set this field in the Name we return.
        --
        -- Then (bogus) multiple bindings of the same Name
        -- get different SrcLocs can be reported as such.
        --
        -- Possible other reason: it might be in the cache because we
        --      encountered an occurrence before the binding site for an
        --      implicitly-imported Name.  Perhaps the current SrcLoc is
        --      better... but not really: it'll still just say 'imported'
        --
        -- IMPORTANT: Don't mess with wired-in names.
        --            Their wired-in-ness is in their NameSort
        --            and their Module is correct.

        Just Name
name | Name -> Bool
isWiredInName Name
name
                  -> (NameCache
name_supply, Name
name)
                  | Bool
otherwise
                  -> (NameCache
new_name_supply, Name
name')
                  where
                    uniq :: Unique
uniq            = Name -> Unique
nameUnique Name
name
                    name' :: Name
name'           = Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName Unique
uniq Module
mod OccName
occ SrcSpan
loc
                                      -- name' is like name, but with the right SrcSpan
                    new_cache :: OrigNameCache
new_cache       = OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
extendNameCache (NameCache -> OrigNameCache
nsNames NameCache
name_supply) Module
mod OccName
occ Name
name'
                    new_name_supply :: NameCache
new_name_supply = NameCache
name_supply {nsNames :: OrigNameCache
nsNames = OrigNameCache
new_cache}

        -- Miss in the cache!
        -- Build a completely new Name, and put it in the cache
        Maybe Name
_ -> (NameCache
new_name_supply, Name
name)
                  where
                    (Unique
uniq, UniqSupply
us')     = UniqSupply -> (Unique, UniqSupply)
takeUniqFromSupply (NameCache -> UniqSupply
nsUniqs NameCache
name_supply)
                    name :: Name
name            = Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName Unique
uniq Module
mod OccName
occ SrcSpan
loc
                    new_cache :: OrigNameCache
new_cache       = OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
extendNameCache (NameCache -> OrigNameCache
nsNames NameCache
name_supply) Module
mod OccName
occ Name
name
                    new_name_supply :: NameCache
new_name_supply = NameCache
name_supply {nsUniqs :: UniqSupply
nsUniqs = UniqSupply
us', nsNames :: OrigNameCache
nsNames = OrigNameCache
new_cache}

ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]
ifaceExportNames :: forall gbl lcl. [IfaceExport] -> TcRnIf gbl lcl [IfaceExport]
ifaceExportNames [IfaceExport]
exports = [IfaceExport] -> IOEnv (Env gbl lcl) [IfaceExport]
forall (m :: * -> *) a. Monad m => a -> m a
return [IfaceExport]
exports

-- | A function that atomically updates the name cache given a modifier
-- function.  The second result of the modifier function will be the result
-- of the IO action.
newtype NameCacheUpdater
      = NCU { NameCacheUpdater -> forall c. (NameCache -> (NameCache, c)) -> IO c
updateNameCache :: forall c. (NameCache -> (NameCache, c)) -> IO c }

mkNameCacheUpdater :: TcRnIf a b NameCacheUpdater
mkNameCacheUpdater :: forall a b. TcRnIf a b NameCacheUpdater
mkNameCacheUpdater = do { HscEnv
hsc_env <- TcRnIf a b HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
                        ; let !ncRef :: IORef NameCache
ncRef = HscEnv -> IORef NameCache
hsc_NC HscEnv
hsc_env
                        ; NameCacheUpdater -> TcRnIf a b NameCacheUpdater
forall (m :: * -> *) a. Monad m => a -> m a
return ((forall c. (NameCache -> (NameCache, c)) -> IO c)
-> NameCacheUpdater
NCU (IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
forall c. IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
updNameCache IORef NameCache
ncRef)) }

updNameCacheTc :: Module -> OccName -> (NameCache -> (NameCache, c))
               -> TcRnIf a b c
updNameCacheTc :: forall c a b.
Module -> OccName -> (NameCache -> (NameCache, c)) -> TcRnIf a b c
updNameCacheTc Module
mod OccName
occ NameCache -> (NameCache, c)
upd_fn = do {
    HscEnv
hsc_env <- TcRnIf a b HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
  ; IO c -> TcRnIf a b c
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO c -> TcRnIf a b c) -> IO c -> TcRnIf a b c
forall a b. (a -> b) -> a -> b
$ HscEnv
-> Module -> OccName -> (NameCache -> (NameCache, c)) -> IO c
forall c.
HscEnv
-> Module -> OccName -> (NameCache -> (NameCache, c)) -> IO c
updNameCacheIO HscEnv
hsc_env Module
mod OccName
occ NameCache -> (NameCache, c)
upd_fn }


updNameCacheIO ::  HscEnv -> Module -> OccName
               -> (NameCache -> (NameCache, c))
               -> IO c
updNameCacheIO :: forall c.
HscEnv
-> Module -> OccName -> (NameCache -> (NameCache, c)) -> IO c
updNameCacheIO HscEnv
hsc_env Module
mod OccName
occ NameCache -> (NameCache, c)
upd_fn = do {

    -- First ensure that mod and occ are evaluated
    -- If not, chaos can ensue:
    --      we read the name-cache
    --      then pull on mod (say)
    --      which does some stuff that modifies the name cache
    -- This did happen, with tycon_mod in GHC.IfaceToCore.tcIfaceAlt (DataAlt..)

    Module
mod Module -> IO () -> IO ()
`seq` OccName
occ OccName -> IO () -> IO ()
`seq` () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  ; IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
forall c. IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
updNameCache (HscEnv -> IORef NameCache
hsc_NC HscEnv
hsc_env) NameCache -> (NameCache, c)
upd_fn }


{-
************************************************************************
*                                                                      *
                Name cache access
*                                                                      *
************************************************************************
-}

-- | Look up the 'Name' for a given 'Module' and 'OccName'.
-- Consider alternatively using 'lookupIfaceTop' if you're in the 'IfL' monad
-- and 'Module' is simply that of the 'ModIface' you are typechecking.
lookupOrig :: Module -> OccName -> TcRnIf a b Name
lookupOrig :: forall a b. Module -> OccName -> TcRnIf a b Name
lookupOrig Module
mod OccName
occ
  = do  { SDoc -> TcRnIf a b ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"lookup_orig" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)

        ; Module
-> OccName -> (NameCache -> (NameCache, Name)) -> TcRnIf a b Name
forall c a b.
Module -> OccName -> (NameCache -> (NameCache, c)) -> TcRnIf a b c
updNameCacheTc Module
mod OccName
occ ((NameCache -> (NameCache, Name)) -> TcRnIf a b Name)
-> (NameCache -> (NameCache, Name)) -> TcRnIf a b Name
forall a b. (a -> b) -> a -> b
$ Module -> OccName -> NameCache -> (NameCache, Name)
lookupNameCache Module
mod OccName
occ }

lookupOrigIO :: HscEnv -> Module -> OccName -> IO Name
lookupOrigIO :: HscEnv -> Module -> OccName -> IO Name
lookupOrigIO HscEnv
hsc_env Module
mod OccName
occ
  = HscEnv
-> Module -> OccName -> (NameCache -> (NameCache, Name)) -> IO Name
forall c.
HscEnv
-> Module -> OccName -> (NameCache -> (NameCache, c)) -> IO c
updNameCacheIO HscEnv
hsc_env Module
mod OccName
occ ((NameCache -> (NameCache, Name)) -> IO Name)
-> (NameCache -> (NameCache, Name)) -> IO Name
forall a b. (a -> b) -> a -> b
$ Module -> OccName -> NameCache -> (NameCache, Name)
lookupNameCache Module
mod OccName
occ

lookupNameCache :: Module -> OccName -> NameCache -> (NameCache, Name)
-- Lookup up the (Module,OccName) in the NameCache
-- If you find it, return it; if not, allocate a fresh original name and extend
-- the NameCache.
-- Reason: this may the first occurrence of (say) Foo.bar we have encountered.
-- If we need to explore its value we will load Foo.hi; but meanwhile all we
-- need is a Name for it.
lookupNameCache :: Module -> OccName -> NameCache -> (NameCache, Name)
lookupNameCache Module
mod OccName
occ NameCache
name_cache =
  case OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache (NameCache -> OrigNameCache
nsNames NameCache
name_cache) Module
mod OccName
occ of {
    Just Name
name -> (NameCache
name_cache, Name
name);
    Maybe Name
Nothing   ->
        case UniqSupply -> (Unique, UniqSupply)
takeUniqFromSupply (NameCache -> UniqSupply
nsUniqs NameCache
name_cache) of {
          (Unique
uniq, UniqSupply
us) ->
              let
                name :: Name
name      = Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName Unique
uniq Module
mod OccName
occ SrcSpan
noSrcSpan
                new_cache :: OrigNameCache
new_cache = OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
extendNameCache (NameCache -> OrigNameCache
nsNames NameCache
name_cache) Module
mod OccName
occ Name
name
              in (NameCache
name_cache{ nsUniqs :: UniqSupply
nsUniqs = UniqSupply
us, nsNames :: OrigNameCache
nsNames = OrigNameCache
new_cache }, Name
name) }}

externaliseName :: Module -> Name -> TcRnIf m n Name
-- Take an Internal Name and make it an External one,
-- with the same unique
externaliseName :: forall m n. Module -> Name -> TcRnIf m n Name
externaliseName Module
mod Name
name
  = do { let occ :: OccName
occ = Name -> OccName
nameOccName Name
name
             loc :: SrcSpan
loc = Name -> SrcSpan
nameSrcSpan Name
name
             uniq :: Unique
uniq = Name -> Unique
nameUnique Name
name
       ; OccName
occ OccName -> IOEnv (Env m n) () -> IOEnv (Env m n) ()
`seq` () -> IOEnv (Env m n) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- c.f. seq in newGlobalBinder
       ; Module
-> OccName -> (NameCache -> (NameCache, Name)) -> TcRnIf m n Name
forall c a b.
Module -> OccName -> (NameCache -> (NameCache, c)) -> TcRnIf a b c
updNameCacheTc Module
mod OccName
occ ((NameCache -> (NameCache, Name)) -> TcRnIf m n Name)
-> (NameCache -> (NameCache, Name)) -> TcRnIf m n Name
forall a b. (a -> b) -> a -> b
$ \ NameCache
ns ->
         let name' :: Name
name' = Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName Unique
uniq Module
mod OccName
occ SrcSpan
loc
             ns' :: NameCache
ns'   = NameCache
ns { nsNames :: OrigNameCache
nsNames = OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
extendNameCache (NameCache -> OrigNameCache
nsNames NameCache
ns) Module
mod OccName
occ Name
name' }
         in (NameCache
ns', Name
name') }

-- | Set the 'Module' of a 'Name'.
setNameModule :: Maybe Module -> Name -> TcRnIf m n Name
setNameModule :: forall m n. Maybe Module -> Name -> TcRnIf m n Name
setNameModule Maybe Module
Nothing Name
n = Name -> IOEnv (Env m n) Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
setNameModule (Just Module
m) Name
n =
    Module -> OccName -> SrcSpan -> IOEnv (Env m n) Name
forall a b. Module -> OccName -> SrcSpan -> TcRnIf a b Name
newGlobalBinder Module
m (Name -> OccName
nameOccName Name
n) (Name -> SrcSpan
nameSrcSpan Name
n)

{-
************************************************************************
*                                                                      *
                Type variables and local Ids
*                                                                      *
************************************************************************
-}

tcIfaceLclId :: FastString -> IfL Id
tcIfaceLclId :: FastString -> IfL Id
tcIfaceLclId FastString
occ
  = do  { IfLclEnv
lcl <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
        ; case (FastStringEnv Id -> FastString -> Maybe Id
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv (IfLclEnv -> FastStringEnv Id
if_id_env IfLclEnv
lcl) FastString
occ) of
            Just Id
ty_var -> Id -> IfL Id
forall (m :: * -> *) a. Monad m => a -> m a
return Id
ty_var
            Maybe Id
Nothing     -> SDoc -> IfL Id
forall a. SDoc -> IfL a
failIfM (String -> SDoc
text String
"Iface id out of scope: " SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
occ)
        }

extendIfaceIdEnv :: [Id] -> IfL a -> IfL a
extendIfaceIdEnv :: forall a. [Id] -> IfL a -> IfL a
extendIfaceIdEnv [Id]
ids IfL a
thing_inside
  = do  { IfLclEnv
env <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
        ; let { id_env' :: FastStringEnv Id
id_env' = FastStringEnv Id -> [(FastString, Id)] -> FastStringEnv Id
forall a. FastStringEnv a -> [(FastString, a)] -> FastStringEnv a
extendFsEnvList (IfLclEnv -> FastStringEnv Id
if_id_env IfLclEnv
env) [(FastString, Id)]
pairs
              ; pairs :: [(FastString, Id)]
pairs   = [(OccName -> FastString
occNameFS (Id -> OccName
forall a. NamedThing a => a -> OccName
getOccName Id
id), Id
id) | Id
id <- [Id]
ids] }
        ; IfLclEnv -> IfL a -> IfL a
forall lcl' gbl a lcl.
lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
setLclEnv (IfLclEnv
env { if_id_env :: FastStringEnv Id
if_id_env = FastStringEnv Id
id_env' }) IfL a
thing_inside }


tcIfaceTyVar :: FastString -> IfL TyVar
tcIfaceTyVar :: FastString -> IfL Id
tcIfaceTyVar FastString
occ
  = do  { IfLclEnv
lcl <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
        ; case (FastStringEnv Id -> FastString -> Maybe Id
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv (IfLclEnv -> FastStringEnv Id
if_tv_env IfLclEnv
lcl) FastString
occ) of
            Just Id
ty_var -> Id -> IfL Id
forall (m :: * -> *) a. Monad m => a -> m a
return Id
ty_var
            Maybe Id
Nothing     -> SDoc -> IfL Id
forall a. SDoc -> IfL a
failIfM (String -> SDoc
text String
"Iface type variable out of scope: " SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
occ)
        }

lookupIfaceTyVar :: IfaceTvBndr -> IfL (Maybe TyVar)
lookupIfaceTyVar :: IfaceTvBndr -> IfL (Maybe Id)
lookupIfaceTyVar (FastString
occ, IfaceKind
_)
  = do  { IfLclEnv
lcl <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
        ; Maybe Id -> IfL (Maybe Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (FastStringEnv Id -> FastString -> Maybe Id
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv (IfLclEnv -> FastStringEnv Id
if_tv_env IfLclEnv
lcl) FastString
occ) }

lookupIfaceVar :: IfaceBndr -> IfL (Maybe TyCoVar)
lookupIfaceVar :: IfaceBndr -> IfL (Maybe Id)
lookupIfaceVar (IfaceIdBndr (IfaceKind
_, FastString
occ, IfaceKind
_))
  = do  { IfLclEnv
lcl <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
        ; Maybe Id -> IfL (Maybe Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (FastStringEnv Id -> FastString -> Maybe Id
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv (IfLclEnv -> FastStringEnv Id
if_id_env IfLclEnv
lcl) FastString
occ) }
lookupIfaceVar (IfaceTvBndr (FastString
occ, IfaceKind
_))
  = do  { IfLclEnv
lcl <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
        ; Maybe Id -> IfL (Maybe Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (FastStringEnv Id -> FastString -> Maybe Id
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv (IfLclEnv -> FastStringEnv Id
if_tv_env IfLclEnv
lcl) FastString
occ) }

extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a
extendIfaceTyVarEnv :: forall a. [Id] -> IfL a -> IfL a
extendIfaceTyVarEnv [Id]
tyvars IfL a
thing_inside
  = do  { IfLclEnv
env <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
        ; let { tv_env' :: FastStringEnv Id
tv_env' = FastStringEnv Id -> [(FastString, Id)] -> FastStringEnv Id
forall a. FastStringEnv a -> [(FastString, a)] -> FastStringEnv a
extendFsEnvList (IfLclEnv -> FastStringEnv Id
if_tv_env IfLclEnv
env) [(FastString, Id)]
pairs
              ; pairs :: [(FastString, Id)]
pairs   = [(OccName -> FastString
occNameFS (Id -> OccName
forall a. NamedThing a => a -> OccName
getOccName Id
tv), Id
tv) | Id
tv <- [Id]
tyvars] }
        ; IfLclEnv -> IfL a -> IfL a
forall lcl' gbl a lcl.
lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
setLclEnv (IfLclEnv
env { if_tv_env :: FastStringEnv Id
if_tv_env = FastStringEnv Id
tv_env' }) IfL a
thing_inside }

extendIfaceEnvs :: [TyCoVar] -> IfL a -> IfL a
extendIfaceEnvs :: forall a. [Id] -> IfL a -> IfL a
extendIfaceEnvs [Id]
tcvs IfL a
thing_inside
  = [Id] -> IfL a -> IfL a
forall a. [Id] -> IfL a -> IfL a
extendIfaceTyVarEnv [Id]
tvs (IfL a -> IfL a) -> IfL a -> IfL a
forall a b. (a -> b) -> a -> b
$
    [Id] -> IfL a -> IfL a
forall a. [Id] -> IfL a -> IfL a
extendIfaceIdEnv    [Id]
cvs (IfL a -> IfL a) -> IfL a -> IfL a
forall a b. (a -> b) -> a -> b
$
    IfL a
thing_inside
  where
    ([Id]
tvs, [Id]
cvs) = (Id -> Bool) -> [Id] -> ([Id], [Id])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Id -> Bool
isTyVar [Id]
tcvs

{-
************************************************************************
*                                                                      *
                Getting from RdrNames to Names
*                                                                      *
************************************************************************
-}

-- | Look up a top-level name from the current Iface module
lookupIfaceTop :: OccName -> IfL Name
lookupIfaceTop :: OccName -> IfL Name
lookupIfaceTop OccName
occ
  = do  { IfLclEnv
env <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv; Module -> OccName -> IfL Name
forall a b. Module -> OccName -> TcRnIf a b Name
lookupOrig (IfLclEnv -> Module
if_mod IfLclEnv
env) OccName
occ }

newIfaceName :: OccName -> IfL Name
newIfaceName :: OccName -> IfL Name
newIfaceName OccName
occ
  = do  { Unique
uniq <- TcRnIf IfGblEnv IfLclEnv Unique
forall gbl lcl. TcRnIf gbl lcl Unique
newUnique
        ; Name -> IfL Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> IfL Name) -> Name -> IfL Name
forall a b. (a -> b) -> a -> b
$! Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq OccName
occ SrcSpan
noSrcSpan }

newIfaceNames :: [OccName] -> IfL [Name]
newIfaceNames :: [OccName] -> IfL [Name]
newIfaceNames [OccName]
occs
  = do  { UniqSupply
uniqs <- TcRnIf IfGblEnv IfLclEnv UniqSupply
forall gbl lcl. TcRnIf gbl lcl UniqSupply
newUniqueSupply
        ; [Name] -> IfL [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq OccName
occ SrcSpan
noSrcSpan
                 | (OccName
occ,Unique
uniq) <- [OccName]
occs [OccName] -> [Unique] -> [(OccName, Unique)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` UniqSupply -> [Unique]
uniqsFromSupply UniqSupply
uniqs] }

{-
Names in a NameCache are always stored as a Global, and have the SrcLoc
of their binding locations.

Actually that's not quite right.  When we first encounter the original
name, we might not be at its binding site (e.g. we are reading an
interface file); so we give it 'noSrcLoc' then.  Later, when we find
its binding site, we fix it up.
-}

updNameCache :: IORef NameCache
             -> (NameCache -> (NameCache, c))  -- The updating function
             -> IO c
updNameCache :: forall c. IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
updNameCache IORef NameCache
ncRef NameCache -> (NameCache, c)
upd_fn
  = IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef NameCache
ncRef NameCache -> (NameCache, c)
upd_fn