summaryrefslogtreecommitdiff
path: root/compiler/GHC/Unit/Env.hs
blob: 89e8d77586a691fc5532ad3d4e83a37d66498aef (plain)
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
module GHC.Unit.Env
    ( UnitEnv (..)
    , initUnitEnv
    , unsafeGetHomeUnit
    , preloadUnitsInfo
    , preloadUnitsInfo'
    )
where

import GHC.Prelude

import GHC.Unit.State
import GHC.Unit.Home
import GHC.Unit.Types

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_home_unit :: !(Maybe HomeUnit)
        -- ^ Home unit

    , ue_platform  :: !Platform
        -- ^ Platform

    , ue_namever   :: !GhcNameVersion
        -- ^ GHC name/version (used for dynamic library suffix)
    }

initUnitEnv :: GhcNameVersion -> Platform -> IO UnitEnv
initUnitEnv namever platform = do
  return $ UnitEnv
    { ue_units     = emptyUnitState
    , ue_unit_dbs  = Nothing
    , ue_home_unit = Nothing
    , 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

-- -----------------------------------------------------------------------------
-- 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 []