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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
module GHC.Unit.Env
( UnitEnv (..)
, initUnitEnv
, unsafeGetHomeUnit
, updateHpt
, preloadUnitsInfo
, preloadUnitsInfo'
)
where
import GHC.Prelude
import GHC.Unit.External
import GHC.Unit.State
import GHC.Unit.Home
import GHC.Unit.Types
import GHC.Unit.Home.ModInfo
import GHC.Platform
import GHC.Settings
import GHC.Data.Maybe
import GHC.Utils.Panic.Plain
data UnitEnv = UnitEnv
{ ue_units :: !UnitState
-- ^ External units
, ue_unit_dbs :: !(Maybe [UnitDatabase UnitId])
-- ^ Stack of unit databases for the target platform.
--
-- This field is populated with the result of `initUnits`.
--
-- 'Nothing' means the databases have never been read from disk.
--
-- Usually we don't reload the databases from disk if they are
-- cached, even if the database flags changed!
, ue_eps :: {-# UNPACK #-} !ExternalUnitCache
-- ^ Information about the currently loaded external packages.
-- This is mutable because packages will be demand-loaded during
-- a compilation run as required.
, ue_home_unit :: !(Maybe HomeUnit)
-- ^ Home unit
, ue_hpt :: !HomePackageTable
-- ^ The home package table describes already-compiled
-- home-package modules, /excluding/ the module we
-- are compiling right now.
-- (In one-shot mode the current module is the only
-- home-package module, so hsc_HPT is empty. All other
-- modules count as \"external-package\" modules.
-- However, even in GHCi mode, hi-boot interfaces are
-- demand-loaded into the external-package table.)
--
-- 'hsc_HPT' is not mutable because we only demand-load
-- external packages; the home package is eagerly
-- loaded, module by module, by the compilation manager.
--
-- The HPT may contain modules compiled earlier by @--make@
-- but not actually below the current module in the dependency
-- graph.
--
-- (This changes a previous invariant: changed Jan 05.)
, ue_platform :: !Platform
-- ^ Platform
, ue_namever :: !GhcNameVersion
-- ^ GHC name/version (used for dynamic library suffix)
}
initUnitEnv :: GhcNameVersion -> Platform -> IO UnitEnv
initUnitEnv namever platform = do
eps <- initExternalUnitCache
return $ UnitEnv
{ ue_units = emptyUnitState
, ue_unit_dbs = Nothing
, ue_eps = eps
, ue_home_unit = Nothing
, ue_hpt = emptyHomePackageTable
, ue_platform = platform
, ue_namever = namever
}
-- | Get home-unit
--
-- Unsafe because the home-unit may not be set
unsafeGetHomeUnit :: UnitEnv -> HomeUnit
unsafeGetHomeUnit ue = case ue_home_unit ue of
Nothing -> panic "unsafeGetHomeUnit: No home unit"
Just h -> h
updateHpt :: (HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv
updateHpt f ue = ue { ue_hpt = f (ue_hpt ue) }
-- -----------------------------------------------------------------------------
-- Extracting information from the packages in scope
-- Many of these functions take a list of packages: in those cases,
-- the list is expected to contain the "dependent packages",
-- i.e. those packages that were found to be depended on by the
-- current module/program. These can be auto or non-auto packages, it
-- doesn't really matter. The list is always combined with the list
-- of preload (command-line) packages to determine which packages to
-- use.
-- | Lookup 'UnitInfo' for every preload unit from the UnitState, for every unit
-- used to instantiate the home unit, and for every unit explicitly passed in
-- the given list of UnitId.
preloadUnitsInfo' :: UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' unit_env ids0 = all_infos
where
unit_state = ue_units unit_env
ids = ids0 ++ inst_ids
inst_ids = case ue_home_unit unit_env of
Nothing -> []
Just home_unit
-- An indefinite package will have insts to HOLE,
-- which is not a real package. Don't look it up.
-- Fixes #14525
| isHomeUnitIndefinite home_unit -> []
| otherwise -> map (toUnitId . moduleUnit . snd) (homeUnitInstantiations home_unit)
pkg_map = unitInfoMap unit_state
preload = preloadUnits unit_state
all_pkgs = closeUnitDeps' pkg_map preload (ids `zip` repeat Nothing)
all_infos = map (unsafeLookupUnitId unit_state) <$> all_pkgs
-- | Lookup 'UnitInfo' for every preload unit from the UnitState and for every
-- unit used to instantiate the home unit.
preloadUnitsInfo :: UnitEnv -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo unit_env = preloadUnitsInfo' unit_env []
|
