1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
-- | 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 state = renameHoleModule' (unitInfoMap 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 state = renameHoleUnit' (unitInfoMap state)
-- | Like 'renameHoleModule', but requires only 'ClosureUnitInfoMap'
-- so it can be used by "Packages".
renameHoleModule' :: ClosureUnitInfoMap -> ShHoleSubst -> Module -> Module
renameHoleModule' pkg_map env m
| not (isHoleModule m) =
let uid = renameHoleUnit' pkg_map env (moduleUnit m)
in mkModule uid (moduleName m)
| Just m' <- lookupUFM env (moduleName m) = m'
-- NB m = <Blah>, that's what's in scope.
| otherwise = m
-- | Like 'renameHoleUnit, but requires only 'ClosureUnitInfoMap'
-- so it can be used by "Packages".
renameHoleUnit' :: ClosureUnitInfoMap -> ShHoleSubst -> Unit -> Unit
renameHoleUnit' pkg_map env uid =
case uid of
(VirtUnit
InstantiatedUnit{ instUnitInstanceOf = cid
, instUnitInsts = insts
, instUnitHoles = fh })
-> if isNullUFM (intersectUFM_C const (udfmToUfm (getUniqDSet fh)) env)
then uid
-- Functorially apply the substitution to the instantiation,
-- then check the 'ClosureUnitInfoMap' to see if there is
-- a compiled version of this 'InstantiatedUnit' we can improve to.
-- See Note [VirtUnit to RealUnit improvement]
else improveUnit pkg_map $
mkVirtUnit cid
(map (\(k,v) -> (k, renameHoleModule' pkg_map env v)) insts)
_ -> uid
|
