module GHC.Unit.External.Substitution (
  -- * Substitution and module renaming
  ShHoleSubst,
  renameHoleModule',
  renameHoleUnit',
  renameUnitInfo,
) where

import GHC.Prelude

import GHC.Unit.Module
import GHC.Unit.Info
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Types.Unique.DSet

-- -----------------------------------------------------------------------------
-- Module renaming

-- | Substitution on module variables, mapping module names to module
-- identifiers.
type ShHoleSubst = ModuleNameEnv Module

-- | Rename a 'UnitInfo' according to some module instantiation.
renameUnitInfo :: UnitInfoMap -> [(ModuleName, Module)] -> UnitInfo -> UnitInfo
renameUnitInfo :: UnitInfoMap -> [(ModuleName, Module)] -> UnitInfo -> UnitInfo
renameUnitInfo UnitInfoMap
pkg_map [(ModuleName, Module)]
insts UnitInfo
conf =
    let hsubst :: UniqFM ModuleName Module
hsubst = [(ModuleName, Module)] -> UniqFM ModuleName Module
forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
listToUFM [(ModuleName, Module)]
insts
        smod :: Module -> Module
smod  = UnitInfoMap -> UniqFM ModuleName Module -> Module -> Module
renameHoleModule' UnitInfoMap
pkg_map UniqFM ModuleName Module
hsubst
        new_insts :: [(ModuleName, Module)]
new_insts = ((ModuleName, Module) -> (ModuleName, Module))
-> [(ModuleName, Module)] -> [(ModuleName, Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
k,Module
v) -> (ModuleName
k,Module -> Module
smod Module
v)) (UnitInfo -> [(ModuleName, Module)]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [(modulename, mod)]
unitInstantiations UnitInfo
conf)
    in UnitInfo
conf {
        unitInstantiations = new_insts,
        unitExposedModules = map (\(ModuleName
mod_name, Maybe Module
mb_mod) -> (ModuleName
mod_name, (Module -> Module) -> Maybe Module -> Maybe Module
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Module -> Module
smod Maybe Module
mb_mod))
                             (unitExposedModules conf)
    }


-- | Like 'renameHoleModule', but requires only 'UnitInfoMap'
-- so it can be used by "GHC.Unit.State".
renameHoleModule' :: UnitInfoMap -> ShHoleSubst -> Module -> Module
renameHoleModule' :: UnitInfoMap -> UniqFM ModuleName Module -> Module -> Module
renameHoleModule' UnitInfoMap
pkg_map UniqFM ModuleName Module
env Module
m
  | Bool -> Bool
not (Module -> Bool
forall u. GenModule (GenUnit u) -> Bool
isHoleModule Module
m) =
        let uid :: Unit
uid = UnitInfoMap -> UniqFM ModuleName Module -> Unit -> Unit
renameHoleUnit' UnitInfoMap
pkg_map UniqFM ModuleName Module
env (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
m)
        in Unit -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule Unit
uid (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m)
  | Just Module
m' <- UniqFM ModuleName Module -> ModuleName -> Maybe Module
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM ModuleName Module
env (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m) = Module
m'
  -- NB m = <Blah>, that's what's in scope.
  | Bool
otherwise = Module
m

-- | Like 'renameHoleUnit', but requires only 'UnitInfoMap'
-- so it can be used by "GHC.Unit.State".
renameHoleUnit' :: UnitInfoMap -> ShHoleSubst -> Unit -> Unit
renameHoleUnit' :: UnitInfoMap -> UniqFM ModuleName Module -> Unit -> Unit
renameHoleUnit' UnitInfoMap
pkg_map UniqFM ModuleName Module
env Unit
uid =
    case Unit
uid of
      (VirtUnit
        InstantiatedUnit{ instUnitInstanceOf :: forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf = UnitId
cid
                        , instUnitInsts :: forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts      = [(ModuleName, Module)]
insts
                        , instUnitHoles :: forall unit. GenInstantiatedUnit unit -> UniqDSet ModuleName
instUnitHoles      = UniqDSet ModuleName
fh })
          -> if UniqFM ModuleName ModuleName -> Bool
forall {k} (key :: k) elt. UniqFM key elt -> Bool
isNullUFM ((ModuleName -> Module -> ModuleName)
-> UniqFM ModuleName ModuleName
-> UniqFM ModuleName Module
-> UniqFM ModuleName ModuleName
forall {k} elt1 elt2 elt3 (key :: k).
(elt1 -> elt2 -> elt3)
-> UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt3
intersectUFM_C ModuleName -> Module -> ModuleName
forall a b. a -> b -> a
const (UniqDFM ModuleName ModuleName -> UniqFM ModuleName ModuleName
forall {k} (key :: k) elt. UniqDFM key elt -> UniqFM key elt
udfmToUfm (UniqDSet ModuleName -> UniqDFM ModuleName ModuleName
forall a. UniqDSet a -> UniqDFM a a
getUniqDSet UniqDSet ModuleName
fh)) UniqFM ModuleName Module
env)
                then Unit
uid
                else UnitId -> [(ModuleName, Module)] -> Unit
forall u.
IsUnitId u =>
u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
mkVirtUnit UnitId
cid
                          (((ModuleName, Module) -> (ModuleName, Module))
-> [(ModuleName, Module)] -> [(ModuleName, Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
k,Module
v) -> (ModuleName
k, UnitInfoMap -> UniqFM ModuleName Module -> Module -> Module
renameHoleModule' UnitInfoMap
pkg_map UniqFM ModuleName Module
env Module
v)) [(ModuleName, Module)]
insts)
      Unit
_ -> Unit
uid