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

    {-# LANGUAGE RankNTypes #-}

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

            ifaceExportNames,

            trace_if, trace_hi_diffs,

            -- Name-cache stuff
            allocateGlobalBinder,
       ) where

    import GHC.Prelude

    import GHC.Driver.Env
    import GHC.Driver.DynFlags

    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 GHC.Utils.Error
    import GHC.Utils.Logger

    import Data.List     ( partition )
    import Control.Monad

    {-
    *********************************************************
    *                                                      *
            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 { hsc_env <- TcRnIf a b HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv
           ; name <- liftIO $ allocateGlobalBinder (hsc_NC hsc_env) mod occ loc
           ; traceIf (text "newGlobalBinder" <+>
                      (vcat [ ppr mod <+> ppr occ <+> ppr loc, ppr name]))
           ; return 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)
      NameCache -> Module -> OccName -> SrcSpan -> IO Name
    allocateGlobalBinder (HscEnv -> NameCache
    hsc_NC HscEnv
    hsc_env) Module
    mod OccName
    occ SrcSpan
    loc

    allocateGlobalBinder
      :: NameCache
      -> Module -> OccName -> SrcSpan
      -> IO Name
    -- See Note [The Name Cache] in GHC.Types.Name.Cache
    allocateGlobalBinder :: NameCache -> Module -> OccName -> SrcSpan -> IO Name
    allocateGlobalBinder NameCache
    nc Module
    mod OccName
    occ SrcSpan
    loc
      = NameCache
    -> Module
    -> OccName
    -> (OrigNameCache -> IO (OrigNameCache, Name))
    -> IO Name
    forall c.
    NameCache
    -> Module
    -> OccName
    -> (OrigNameCache -> IO (OrigNameCache, c))
    -> IO c
    updateNameCache NameCache
    nc Module
    mod OccName
    occ ((OrigNameCache -> IO (OrigNameCache, Name)) -> IO Name)
    -> (OrigNameCache -> IO (OrigNameCache, Name)) -> IO Name
    forall a b. (a -> b) -> a -> b
    $ \OrigNameCache
    cache0 -> do
          case OrigNameCache -> Module -> OccName -> Maybe Name
    lookupOrigNameCache OrigNameCache
    cache0 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
                      -> (OrigNameCache, Name) -> IO (OrigNameCache, Name)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrigNameCache
    cache0, Name
    name)
                      | Bool
    otherwise
                      -> (OrigNameCache, Name) -> IO (OrigNameCache, Name)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrigNameCache
    new_cache, 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
    extendOrigNameCache OrigNameCache
    cache0 Module
    mod OccName
    occ Name
    name'

            -- Miss in the cache!
            -- Build a completely new Name, and put it in the cache
            Maybe Name
    _ -> do
                  uniq <- NameCache -> IO Unique
    takeUniqFromNameCache NameCache
    nc
                  let name      = Unique -> Module -> OccName -> SrcSpan -> Name
    mkExternalName Unique
    uniq Module
    mod OccName
    occ SrcSpan
    loc
                  let new_cache = OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
    extendOrigNameCache OrigNameCache
    cache0 Module
    mod OccName
    occ Name
    name
                  pure (new_cache, name)

    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 a. a -> IOEnv (Env gbl lcl) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [IfaceExport]
    exports

    {-
    ************************************************************************
    *                                                                      *
                    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
      hsc_env <- TcRnIf a b HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv
      traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ)
      liftIO $ lookupNameCache (hsc_NC hsc_env) mod occ

    lookupNameCache :: NameCache -> Module -> OccName -> IO 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 :: NameCache -> Module -> OccName -> IO Name
    lookupNameCache NameCache
    nc Module
    mod OccName
    occ = NameCache
    -> Module
    -> OccName
    -> (OrigNameCache -> IO (OrigNameCache, Name))
    -> IO Name
    forall c.
    NameCache
    -> Module
    -> OccName
    -> (OrigNameCache -> IO (OrigNameCache, c))
    -> IO c
    updateNameCache NameCache
    nc Module
    mod OccName
    occ ((OrigNameCache -> IO (OrigNameCache, Name)) -> IO Name)
    -> (OrigNameCache -> IO (OrigNameCache, Name)) -> IO Name
    forall a b. (a -> b) -> a -> b
    $ \OrigNameCache
    cache0 ->
      case OrigNameCache -> Module -> OccName -> Maybe Name
    lookupOrigNameCache OrigNameCache
    cache0 Module
    mod OccName
    occ of
        Just Name
    name -> (OrigNameCache, Name) -> IO (OrigNameCache, Name)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrigNameCache
    cache0, Name
    name)
        Maybe Name
    Nothing   -> do
          uniq <- NameCache -> IO Unique
    takeUniqFromNameCache NameCache
    nc
          let name      = Unique -> Module -> OccName -> SrcSpan -> Name
    mkExternalName Unique
    uniq Module
    mod OccName
    occ SrcSpan
    noSrcSpan
          let new_cache = OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
    extendOrigNameCache OrigNameCache
    cache0 Module
    mod OccName
    occ Name
    name
          pure (new_cache, 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) ()
    forall a b. a -> b -> b
    `seq` () -> IOEnv (Env m n) ()
    forall a. a -> IOEnv (Env m n) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()  -- c.f. seq in newGlobalBinder
           ; hsc_env <- TcRnIf m n HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv
           ; liftIO $ updateNameCache (hsc_NC hsc_env) mod occ $ \OrigNameCache
    cache -> do
             let name' :: Name
    name'  = Unique -> Module -> OccName -> SrcSpan -> Name
    mkExternalName Unique
    uniq Module
    mod OccName
    occ SrcSpan
    loc
                 cache' :: OrigNameCache
    cache' = OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
    extendOrigNameCache OrigNameCache
    cache Module
    mod OccName
    occ Name
    name'
             (OrigNameCache, Name) -> IO (OrigNameCache, Name)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OrigNameCache
    cache', 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 a. a -> IOEnv (Env m n) a
    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  { lcl <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
            ; case lookupFsEnv (if_id_env lcl) occ of
                Just Id
    ty_var -> Id -> IfL Id
    forall a. a -> IOEnv (Env IfGblEnv IfLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Id
    ty_var
                Maybe Id
    Nothing     -> SDoc -> IfL Id
    forall a. SDoc -> IfL a
    failIfM (SDoc -> IfL Id) -> SDoc -> IfL Id
    forall a b. (a -> b) -> a -> b
    $
                  [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat
                    [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Iface id out of scope: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> FastString -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr FastString
    occ
                    , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "env:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> FastStringEnv Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (IfLclEnv -> FastStringEnv Id
    if_id_env IfLclEnv
    lcl) ]
            }

    extendIfaceIdEnv :: [Id] -> IfL a -> IfL a
    extendIfaceIdEnv :: forall a. [Id] -> IfL a -> IfL a
    extendIfaceIdEnv [Id]
    ids
      = (IfLclEnv -> IfLclEnv)
    -> TcRnIf IfGblEnv IfLclEnv a -> TcRnIf IfGblEnv IfLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv ((IfLclEnv -> IfLclEnv)
     -> TcRnIf IfGblEnv IfLclEnv a -> TcRnIf IfGblEnv IfLclEnv a)
    -> (IfLclEnv -> IfLclEnv)
    -> TcRnIf IfGblEnv IfLclEnv a
    -> TcRnIf IfGblEnv IfLclEnv a
    forall a b. (a -> b) -> a -> b
    $ \IfLclEnv
    env ->
        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] }
        in IfLclEnv
    env { if_id_env = id_env' }

    tcIfaceTyVar :: FastString -> IfL TyVar
    tcIfaceTyVar :: FastString -> IfL Id
    tcIfaceTyVar FastString
    occ
      = do  { lcl <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
            ; case lookupFsEnv (if_tv_env lcl) occ of
                Just Id
    ty_var -> Id -> IfL Id
    forall a. a -> IOEnv (Env IfGblEnv IfLclEnv) a
    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
    forall doc. IsLine doc => String -> doc
    text String
    "Iface type variable out of scope: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> 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  { lcl <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
            ; return (lookupFsEnv (if_tv_env lcl) occ) }

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

    extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a
    extendIfaceTyVarEnv :: forall a. [Id] -> IfL a -> IfL a
    extendIfaceTyVarEnv [Id]
    tyvars
      = (IfLclEnv -> IfLclEnv)
    -> TcRnIf IfGblEnv IfLclEnv a -> TcRnIf IfGblEnv IfLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv ((IfLclEnv -> IfLclEnv)
     -> TcRnIf IfGblEnv IfLclEnv a -> TcRnIf IfGblEnv IfLclEnv a)
    -> (IfLclEnv -> IfLclEnv)
    -> TcRnIf IfGblEnv IfLclEnv a
    -> TcRnIf IfGblEnv IfLclEnv a
    forall a b. (a -> b) -> a -> b
    $ \IfLclEnv
    env ->
        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] }
        in IfLclEnv
    env { if_tv_env = tv_env' }

    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  { env <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; lookupOrig (if_mod env) occ }

    newIfaceName :: OccName -> IfL Name
    newIfaceName :: OccName -> IfL Name
    newIfaceName OccName
    occ
      = do  { uniq <- TcRnIf IfGblEnv IfLclEnv Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
            ; return $! mkInternalName uniq occ noSrcSpan }

    newIfaceNames :: [OccName] -> IfL [Name]
    newIfaceNames :: [OccName] -> IfL [Name]
    newIfaceNames [OccName]
    occs
      = do  { uniqs <- IOEnv (Env IfGblEnv IfLclEnv) [Unique]
    forall (m :: * -> *). MonadUnique m => m [Unique]
    getUniquesM
            ; return [ mkInternalName uniq occ noSrcSpan
                     | (occ,uniq) <- occs `zip` uniqs] }

    trace_if :: Logger -> SDoc -> IO ()
    {-# INLINE trace_if #-}
    trace_if :: Logger -> SDoc -> IO ()
    trace_if Logger
    logger SDoc
    doc = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    Opt_D_dump_if_trace) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> SDoc -> IO ()
    putMsg Logger
    logger SDoc
    doc

    trace_hi_diffs :: Logger -> SDoc -> IO ()
    {-# INLINE trace_hi_diffs #-}
    trace_hi_diffs :: Logger -> SDoc -> IO ()
    trace_hi_diffs Logger
    logger SDoc
    doc = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    Opt_D_dump_hi_diffs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> SDoc -> IO ()
    putMsg Logger
    logger SDoc
    doc