-- | Module hole substitutions
module GHC.Unit.Subst
   ( ShHoleSubst
   , renameHoleUnit
   , renameHoleModule
   , renameHoleUnit'
   , renameHoleModule'
   )
where

import GHC.Prelude

import {-# SOURCE #-} GHC.Unit.State
import GHC.Unit.Types
import GHC.Unit.Module.Env
import GHC.Unit.Module
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Types.Unique.DSet

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

-- | Substitutes holes in a 'Module'.  NOT suitable for being called
-- directly on a 'nameModule', see Note [Representation of module/name variable].
-- @p[A=<A>]:B@ maps to @p[A=q():A]:B@ with @A=q():A@;
-- similarly, @<A>@ maps to @q():A@.
renameHoleModule :: PackageState -> ShHoleSubst -> Module -> Module
renameHoleModule :: PackageState -> ShHoleSubst -> Module -> Module
renameHoleModule PackageState
state = UnitInfoMap -> ShHoleSubst -> Module -> Module
renameHoleModule' (PackageState -> UnitInfoMap
unitInfoMap PackageState
state)

-- | Substitutes holes in a 'Unit', suitable for renaming when
-- an include occurs; see Note [Representation of module/name variable].
--
-- @p[A=<A>]@ maps to @p[A=<B>]@ with @A=<B>@.
renameHoleUnit :: PackageState -> ShHoleSubst -> Unit -> Unit
renameHoleUnit :: PackageState -> ShHoleSubst -> Unit -> Unit
renameHoleUnit PackageState
state = UnitInfoMap -> ShHoleSubst -> Unit -> Unit
renameHoleUnit' (PackageState -> UnitInfoMap
unitInfoMap PackageState
state)

-- | Like 'renameHoleModule', but requires only 'UnitInfoMap'
-- so it can be used by "Packages".
renameHoleModule' :: UnitInfoMap -> ShHoleSubst -> Module -> Module
renameHoleModule' :: UnitInfoMap -> ShHoleSubst -> Module -> Module
renameHoleModule' UnitInfoMap
pkg_map ShHoleSubst
env Module
m
  | Bool -> Bool
not (Module -> Bool
forall u. GenModule (GenUnit u) -> Bool
isHoleModule Module
m) =
        let uid :: Unit
uid = UnitInfoMap -> ShHoleSubst -> Unit -> Unit
renameHoleUnit' UnitInfoMap
pkg_map ShHoleSubst
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' <- ShHoleSubst -> ModuleName -> Maybe Module
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
External instance of the constraint type Uniquable ModuleName
lookupUFM ShHoleSubst
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 "Packages".
renameHoleUnit' :: UnitInfoMap -> ShHoleSubst -> Unit -> Unit
renameHoleUnit' :: UnitInfoMap -> ShHoleSubst -> Unit -> Unit
renameHoleUnit' UnitInfoMap
pkg_map ShHoleSubst
env Unit
uid =
    case Unit
uid of
      (VirtUnit
        InstantiatedUnit{ instUnitInstanceOf :: forall unit. GenInstantiatedUnit unit -> Indefinite unit
instUnitInstanceOf = Indefinite UnitId
cid
                        , instUnitInsts :: forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts      = GenInstantiations UnitId
insts
                        , instUnitHoles :: forall unit. GenInstantiatedUnit unit -> UniqDSet ModuleName
instUnitHoles      = UniqDSet ModuleName
fh })
          -> if UniqFM ModuleName -> Bool
forall elt. UniqFM elt -> Bool
isNullUFM ((ModuleName -> Module -> ModuleName)
-> UniqFM ModuleName -> ShHoleSubst -> UniqFM ModuleName
forall elt1 elt2 elt3.
(elt1 -> elt2 -> elt3) -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
intersectUFM_C ModuleName -> Module -> ModuleName
forall a b. a -> b -> a
const (UniqDFM ModuleName -> UniqFM ModuleName
forall elt. UniqDFM elt -> UniqFM elt
udfmToUfm (UniqDSet ModuleName -> UniqDFM ModuleName
forall a. UniqDSet a -> UniqDFM a
getUniqDSet UniqDSet ModuleName
fh)) ShHoleSubst
env)
                then Unit
uid
                -- Functorially apply the substitution to the instantiation,
                -- then check the 'UnitInfoMap' to see if there is
                -- a compiled version of this 'InstantiatedUnit' we can improve to.
                -- See Note [VirtUnit to RealUnit improvement]
                else UnitInfoMap -> Unit -> Unit
improveUnit UnitInfoMap
pkg_map (Unit -> Unit) -> Unit -> Unit
forall a b. (a -> b) -> a -> b
$
                        Indefinite UnitId -> GenInstantiations UnitId -> Unit
mkVirtUnit Indefinite UnitId
cid
                            (((ModuleName, Module) -> (ModuleName, Module))
-> GenInstantiations UnitId -> GenInstantiations UnitId
forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
k,Module
v) -> (ModuleName
k, UnitInfoMap -> ShHoleSubst -> Module -> Module
renameHoleModule' UnitInfoMap
pkg_map ShHoleSubst
env Module
v)) GenInstantiations UnitId
insts)
      Unit
_ -> Unit
uid