never executed always true always false
1 module GHC.Unit.External
2 ( ExternalUnitCache (..)
3 , initExternalUnitCache
4 , ExternalPackageState (..)
5 , initExternalPackageState
6 , EpsStats(..)
7 , addEpsInStats
8 , PackageTypeEnv
9 , PackageIfaceTable
10 , PackageInstEnv
11 , PackageFamInstEnv
12 , PackageRuleBase
13 , PackageCompleteMatches
14 , emptyPackageIfaceTable
15 )
16 where
17
18 import GHC.Prelude
19
20 import GHC.Unit
21 import GHC.Unit.Module.ModIface
22
23 import GHC.Core ( RuleBase )
24 import GHC.Core.FamInstEnv
25 import GHC.Core.InstEnv ( InstEnv, emptyInstEnv )
26 import GHC.Core.Opt.ConstantFold
27 import GHC.Core.Rules (mkRuleBase)
28
29 import GHC.Types.Annotations ( AnnEnv, emptyAnnEnv )
30 import GHC.Types.CompleteMatch
31 import GHC.Types.TypeEnv
32 import GHC.Types.Unique.DSet
33 import GHC.Types.Unique.FM
34
35 import Data.IORef
36
37
38 type PackageTypeEnv = TypeEnv
39 type PackageRuleBase = RuleBase
40 type PackageInstEnv = InstEnv
41 type PackageFamInstEnv = FamInstEnv
42 type PackageAnnEnv = AnnEnv
43 type PackageCompleteMatches = CompleteMatches
44
45 -- | Helps us find information about modules in the imported packages
46 type PackageIfaceTable = ModuleEnv ModIface
47 -- Domain = modules in the imported packages
48
49 -- | Constructs an empty PackageIfaceTable
50 emptyPackageIfaceTable :: PackageIfaceTable
51 emptyPackageIfaceTable = emptyModuleEnv
52
53 -- | Information about the currently loaded external packages.
54 -- This is mutable because packages will be demand-loaded during
55 -- a compilation run as required.
56 newtype ExternalUnitCache = ExternalUnitCache
57 { euc_eps :: IORef ExternalPackageState
58 }
59
60 initExternalUnitCache :: IO ExternalUnitCache
61 initExternalUnitCache = ExternalUnitCache <$> newIORef initExternalPackageState
62
63 initExternalPackageState :: ExternalPackageState
64 initExternalPackageState = EPS
65 { eps_is_boot = emptyUFM
66 , eps_PIT = emptyPackageIfaceTable
67 , eps_free_holes = emptyInstalledModuleEnv
68 , eps_PTE = emptyTypeEnv
69 , eps_inst_env = emptyInstEnv
70 , eps_fam_inst_env = emptyFamInstEnv
71 , eps_rule_base = mkRuleBase builtinRules
72 , -- Initialise the EPS rule pool with the built-in rules
73 eps_mod_fam_inst_env = emptyModuleEnv
74 , eps_complete_matches = []
75 , eps_ann_env = emptyAnnEnv
76 , eps_stats = EpsStats
77 { n_ifaces_in = 0
78 , n_decls_in = 0
79 , n_decls_out = 0
80 , n_insts_in = 0
81 , n_insts_out = 0
82 , n_rules_in = length builtinRules
83 , n_rules_out = 0
84 }
85 }
86
87
88 -- | Information about other packages that we have slurped in by reading
89 -- their interface files
90 data ExternalPackageState
91 = EPS {
92 eps_is_boot :: !(ModuleNameEnv ModuleNameWithIsBoot),
93 -- ^ In OneShot mode (only), home-package modules
94 -- accumulate in the external package state, and are
95 -- sucked in lazily. For these home-pkg modules
96 -- (only) we need to record which are boot modules.
97 -- We set this field after loading all the
98 -- explicitly-imported interfaces, but before doing
99 -- anything else
100 --
101 -- The 'ModuleName' part is not necessary, but it's useful for
102 -- debug prints, and it's convenient because this field comes
103 -- direct from 'GHC.Tc.Utils.imp_dep_mods'
104
105 eps_PIT :: !PackageIfaceTable,
106 -- ^ The 'ModIface's for modules in external packages
107 -- whose interfaces we have opened.
108 -- The declarations in these interface files are held in the
109 -- 'eps_decls', 'eps_inst_env', 'eps_fam_inst_env' and 'eps_rules'
110 -- fields of this record, not in the 'mi_decls' fields of the
111 -- interface we have sucked in.
112 --
113 -- What /is/ in the PIT is:
114 --
115 -- * The Module
116 --
117 -- * Fingerprint info
118 --
119 -- * Its exports
120 --
121 -- * Fixities
122 --
123 -- * Deprecations and warnings
124
125 eps_free_holes :: InstalledModuleEnv (UniqDSet ModuleName),
126 -- ^ Cache for 'mi_free_holes'. Ordinarily, we can rely on
127 -- the 'eps_PIT' for this information, EXCEPT that when
128 -- we do dependency analysis, we need to look at the
129 -- 'Dependencies' of our imports to determine what their
130 -- precise free holes are ('moduleFreeHolesPrecise'). We
131 -- don't want to repeatedly reread in the interface
132 -- for every import, so cache it here. When the PIT
133 -- gets filled in we can drop these entries.
134
135 eps_PTE :: !PackageTypeEnv,
136 -- ^ Result of typechecking all the external package
137 -- interface files we have sucked in. The domain of
138 -- the mapping is external-package modules
139
140 eps_inst_env :: !PackageInstEnv, -- ^ The total 'InstEnv' accumulated
141 -- from all the external-package modules
142 eps_fam_inst_env :: !PackageFamInstEnv,-- ^ The total 'FamInstEnv' accumulated
143 -- from all the external-package modules
144 eps_rule_base :: !PackageRuleBase, -- ^ The total 'RuleEnv' accumulated
145 -- from all the external-package modules
146 eps_ann_env :: !PackageAnnEnv, -- ^ The total 'AnnEnv' accumulated
147 -- from all the external-package modules
148 eps_complete_matches :: !PackageCompleteMatches,
149 -- ^ The total 'CompleteMatches' accumulated
150 -- from all the external-package modules
151
152 eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external
153 -- packages, keyed off the module that declared them
154
155 eps_stats :: !EpsStats -- ^ Stastics about what was loaded from external packages
156 }
157
158 -- | Accumulated statistics about what we are putting into the 'ExternalPackageState'.
159 -- \"In\" means stuff that is just /read/ from interface files,
160 -- \"Out\" means actually sucked in and type-checked
161 data EpsStats = EpsStats { n_ifaces_in
162 , n_decls_in, n_decls_out
163 , n_rules_in, n_rules_out
164 , n_insts_in, n_insts_out :: !Int }
165
166 addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats
167 -- ^ Add stats for one newly-read interface
168 addEpsInStats stats n_decls n_insts n_rules
169 = stats { n_ifaces_in = n_ifaces_in stats + 1
170 , n_decls_in = n_decls_in stats + n_decls
171 , n_insts_in = n_insts_in stats + n_insts
172 , n_rules_in = n_rules_in stats + n_rules }
173