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