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