25d8254f559a16f34c7d7e1e2d6301d89ac9f4c9
[ghc.git] / compiler / deSugar / DsUsage.hs
1 {-# LANGUAGE CPP #-}
2
3 module DsUsage (
4 -- * Dependency/fingerprinting code (used by MkIface)
5 mkUsageInfo, mkUsedNames, mkDependencies
6 ) where
7
8 #include "HsVersions.h"
9
10 import DynFlags
11 import HscTypes
12 import TcRnTypes
13 import Name
14 import NameSet
15 import Module
16 import Outputable
17 import Util
18 import UniqSet
19 import UniqDFM
20 import Fingerprint
21 import Maybes
22
23 import Data.List
24 import Data.IORef
25 import Data.Map (Map)
26 import qualified Data.Map as Map
27 import qualified Data.Set as Set
28
29 -- | Extract information from the rename and typecheck phases to produce
30 -- a dependencies information for the module being compiled.
31 mkDependencies :: TcGblEnv -> IO Dependencies
32 mkDependencies
33 TcGblEnv{ tcg_mod = mod,
34 tcg_imports = imports,
35 tcg_th_used = th_var
36 }
37 = do
38 -- Template Haskell used?
39 th_used <- readIORef th_var
40 let dep_mods = eltsUDFM (delFromUDFM (imp_dep_mods imports)
41 (moduleName mod))
42 -- M.hi-boot can be in the imp_dep_mods, but we must remove
43 -- it before recording the modules on which this one depends!
44 -- (We want to retain M.hi-boot in imp_dep_mods so that
45 -- loadHiBootInterface can see if M's direct imports depend
46 -- on M.hi-boot, and hence that we should do the hi-boot consistency
47 -- check.)
48
49 pkgs | th_used = Set.insert (toInstalledUnitId thUnitId) (imp_dep_pkgs imports)
50 | otherwise = imp_dep_pkgs imports
51
52 -- Set the packages required to be Safe according to Safe Haskell.
53 -- See Note [RnNames . Tracking Trust Transitively]
54 sorted_pkgs = sort (Set.toList pkgs)
55 trust_pkgs = imp_trust_pkgs imports
56 dep_pkgs' = map (\x -> (x, x `Set.member` trust_pkgs)) sorted_pkgs
57
58 return Deps { dep_mods = dep_mods,
59 dep_pkgs = dep_pkgs',
60 dep_orphs = sortBy stableModuleCmp (imp_orphs imports),
61 dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
62 -- sort to get into canonical order
63 -- NB. remember to use lexicographic ordering
64
65 mkUsedNames :: TcGblEnv -> NameSet
66 mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
67
68 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] -> [(Module, Fingerprint)] -> IO [Usage]
69 mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged
70 = do
71 eps <- hscEPS hsc_env
72 hashes <- mapM getFileHash dependent_files
73 let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
74 dir_imp_mods used_names
75 usages = mod_usages ++ [ UsageFile { usg_file_path = f
76 , usg_file_hash = hash }
77 | (f, hash) <- zip dependent_files hashes ]
78 ++ [ UsageMergedRequirement
79 { usg_mod = mod,
80 usg_mod_hash = hash
81 }
82 | (mod, hash) <- merged ]
83 usages `seqList` return usages
84 -- seq the list of Usages returned: occasionally these
85 -- don't get evaluated for a while and we can end up hanging on to
86 -- the entire collection of Ifaces.
87
88 mk_mod_usage_info :: PackageIfaceTable
89 -> HscEnv
90 -> Module
91 -> ImportedMods
92 -> NameSet
93 -> [Usage]
94 mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
95 = mapMaybe mkUsage usage_mods
96 where
97 hpt = hsc_HPT hsc_env
98 dflags = hsc_dflags hsc_env
99 this_pkg = thisPackage dflags
100
101 used_mods = moduleEnvKeys ent_map
102 dir_imp_mods = moduleEnvKeys direct_imports
103 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
104 usage_mods = sortBy stableModuleCmp all_mods
105 -- canonical order is imported, to avoid interface-file
106 -- wobblage.
107
108 -- ent_map groups together all the things imported and used
109 -- from a particular module
110 ent_map :: ModuleEnv [OccName]
111 ent_map = nonDetFoldUniqSet add_mv emptyModuleEnv used_names
112 -- nonDetFoldUFM is OK here. If you follow the logic, we sort by OccName
113 -- in ent_hashs
114 where
115 add_mv name mv_map
116 | isWiredInName name = mv_map -- ignore wired-in names
117 | otherwise
118 = case nameModule_maybe name of
119 Nothing -> ASSERT2( isSystemName name, ppr name ) mv_map
120 -- See Note [Internal used_names]
121
122 Just mod ->
123 -- See Note [Identity versus semantic module]
124 let mod' = if isHoleModule mod
125 then mkModule this_pkg (moduleName mod)
126 else mod
127 -- This lambda function is really just a
128 -- specialised (++); originally came about to
129 -- avoid quadratic behaviour (trac #2680)
130 in extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod' [occ]
131 where occ = nameOccName name
132
133 -- We want to create a Usage for a home module if
134 -- a) we used something from it; has something in used_names
135 -- b) we imported it, even if we used nothing from it
136 -- (need to recompile if its export list changes: export_fprint)
137 mkUsage :: Module -> Maybe Usage
138 mkUsage mod
139 | isNothing maybe_iface -- We can't depend on it if we didn't
140 -- load its interface.
141 || mod == this_mod -- We don't care about usages of
142 -- things in *this* module
143 = Nothing
144
145 | moduleUnitId mod /= this_pkg
146 = Just UsagePackageModule{ usg_mod = mod,
147 usg_mod_hash = mod_hash,
148 usg_safe = imp_safe }
149 -- for package modules, we record the module hash only
150
151 | (null used_occs
152 && isNothing export_hash
153 && not is_direct_import
154 && not finsts_mod)
155 = Nothing -- Record no usage info
156 -- for directly-imported modules, we always want to record a usage
157 -- on the orphan hash. This is what triggers a recompilation if
158 -- an orphan is added or removed somewhere below us in the future.
159
160 | otherwise
161 = Just UsageHomeModule {
162 usg_mod_name = moduleName mod,
163 usg_mod_hash = mod_hash,
164 usg_exports = export_hash,
165 usg_entities = Map.toList ent_hashs,
166 usg_safe = imp_safe }
167 where
168 maybe_iface = lookupIfaceByModule dflags hpt pit mod
169 -- In one-shot mode, the interfaces for home-package
170 -- modules accumulate in the PIT not HPT. Sigh.
171
172 Just iface = maybe_iface
173 finsts_mod = mi_finsts iface
174 hash_env = mi_hash_fn iface
175 mod_hash = mi_mod_hash iface
176 export_hash | depend_on_exports = Just (mi_exp_hash iface)
177 | otherwise = Nothing
178
179 by_is_safe (ImportedByUser imv) = imv_is_safe imv
180 by_is_safe _ = False
181 (is_direct_import, imp_safe)
182 = case lookupModuleEnv direct_imports mod of
183 -- ezyang: I'm not sure if any is the correct
184 -- metric here. If safety was guaranteed to be uniform
185 -- across all imports, why did the old code only look
186 -- at the first import?
187 Just bys -> (True, any by_is_safe bys)
188 Nothing -> (False, safeImplicitImpsReq dflags)
189 -- Nothing case is for references to entities which were
190 -- not directly imported (NB: the "implicit" Prelude import
191 -- counts as directly imported! An entity is not directly
192 -- imported if, e.g., we got a reference to it from a
193 -- reexport of another module.)
194
195 used_occs = lookupModuleEnv ent_map mod `orElse` []
196
197 -- Making a Map here ensures that (a) we remove duplicates
198 -- when we have usages on several subordinates of a single parent,
199 -- and (b) that the usages emerge in a canonical order, which
200 -- is why we use Map rather than OccEnv: Map works
201 -- using Ord on the OccNames, which is a lexicographic ordering.
202 ent_hashs :: Map OccName Fingerprint
203 ent_hashs = Map.fromList (map lookup_occ used_occs)
204
205 lookup_occ occ =
206 case hash_env occ of
207 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
208 Just r -> r
209
210 depend_on_exports = is_direct_import
211 {- True
212 Even if we used 'import M ()', we have to register a
213 usage on the export list because we are sensitive to
214 changes in orphan instances/rules.
215 False
216 In GHC 6.8.x we always returned true, and in
217 fact it recorded a dependency on *all* the
218 modules underneath in the dependency tree. This
219 happens to make orphans work right, but is too
220 expensive: it'll read too many interface files.
221 The 'isNothing maybe_iface' check above saved us
222 from generating many of these usages (at least in
223 one-shot mode), but that's even more bogus!
224 -}