176c0862fed8419c395493462fb2659e2accf255
[ghc.git] / compiler / main / GhcMake.hs
1 {-# LANGUAGE BangPatterns, CPP, NondecreasingIndentation, ScopedTypeVariables #-}
2 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
3 -- NB: we specifically ignore deprecations. GHC 7.6 marks the .QSem module as
4 -- deprecated, although it became un-deprecated later. As a result, using 7.6
5 -- as your bootstrap compiler throws annoying warnings.
6
7 -- -----------------------------------------------------------------------------
8 --
9 -- (c) The University of Glasgow, 2011
10 --
11 -- This module implements multi-module compilation, and is used
12 -- by --make and GHCi.
13 --
14 -- -----------------------------------------------------------------------------
15 module GhcMake(
16 depanal,
17 load, load', LoadHowMuch(..),
18
19 topSortModuleGraph,
20
21 ms_home_srcimps, ms_home_imps,
22
23 IsBoot(..),
24 summariseModule,
25 hscSourceToIsBoot,
26 findExtraSigImports,
27 implicitRequirements,
28
29 noModError, cyclicModuleErr,
30 moduleGraphNodes, SummaryNode
31 ) where
32
33 #include "HsVersions.h"
34
35 import qualified Linker ( unload )
36
37 import DriverPhases
38 import DriverPipeline
39 import DynFlags
40 import ErrUtils
41 import Finder
42 import GhcMonad
43 import HeaderInfo
44 import HscTypes
45 import Module
46 import TcIface ( typecheckIface )
47 import TcRnMonad ( initIfaceCheck )
48 import HscMain
49
50 import Bag ( listToBag )
51 import BasicTypes
52 import Digraph
53 import Exception ( tryIO, gbracket, gfinally )
54 import FastString
55 import Maybes ( expectJust )
56 import Name
57 import MonadUtils ( allM, MonadIO )
58 import Outputable
59 import Panic
60 import SrcLoc
61 import StringBuffer
62 import SysTools
63 import UniqFM
64 import UniqDSet
65 import TcBackpack
66 import Packages
67 import UniqSet
68 import Util
69 import qualified GHC.LanguageExtensions as LangExt
70 import NameEnv
71
72 import Data.Either ( rights, partitionEithers )
73 import qualified Data.Map as Map
74 import Data.Map (Map)
75 import qualified Data.Set as Set
76 import qualified FiniteMap as Map ( insertListWith )
77
78 import Control.Concurrent ( forkIOWithUnmask, killThread )
79 import qualified GHC.Conc as CC
80 import Control.Concurrent.MVar
81 import Control.Concurrent.QSem
82 import Control.Exception
83 import Control.Monad
84 import Data.IORef
85 import Data.List
86 import qualified Data.List as List
87 import Data.Maybe
88 import Data.Ord ( comparing )
89 import Data.Time
90 import System.Directory
91 import System.FilePath
92 import System.IO ( fixIO )
93 import System.IO.Error ( isDoesNotExistError )
94
95 import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities )
96
97 label_self :: String -> IO ()
98 label_self thread_name = do
99 self_tid <- CC.myThreadId
100 CC.labelThread self_tid thread_name
101
102 -- -----------------------------------------------------------------------------
103 -- Loading the program
104
105 -- | Perform a dependency analysis starting from the current targets
106 -- and update the session with the new module graph.
107 --
108 -- Dependency analysis entails parsing the @import@ directives and may
109 -- therefore require running certain preprocessors.
110 --
111 -- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.
112 -- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the
113 -- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module. Thus if you want
114 -- changes to the 'DynFlags' to take effect you need to call this function
115 -- again.
116 --
117 depanal :: GhcMonad m =>
118 [ModuleName] -- ^ excluded modules
119 -> Bool -- ^ allow duplicate roots
120 -> m ModuleGraph
121 depanal excluded_mods allow_dup_roots = do
122 hsc_env <- getSession
123 let
124 dflags = hsc_dflags hsc_env
125 targets = hsc_targets hsc_env
126 old_graph = hsc_mod_graph hsc_env
127
128 withTiming (pure dflags) (text "Chasing dependencies") (const ()) $ do
129 liftIO $ debugTraceMsg dflags 2 (hcat [
130 text "Chasing modules from: ",
131 hcat (punctuate comma (map pprTarget targets))])
132
133 -- Home package modules may have been moved or deleted, and new
134 -- source files may have appeared in the home package that shadow
135 -- external package modules, so we have to discard the existing
136 -- cached finder data.
137 liftIO $ flushFinderCaches hsc_env
138
139 mod_graphE <- liftIO $ downsweep hsc_env old_graph
140 excluded_mods allow_dup_roots
141 mod_graph <- reportImportErrors mod_graphE
142
143 warnMissingHomeModules hsc_env mod_graph
144
145 setSession hsc_env { hsc_mod_graph = mod_graph }
146 return mod_graph
147
148 -- Note [Missing home modules]
149 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
150 -- Sometimes user doesn't want GHC to pick up modules, not explicitly listed
151 -- in a command line. For example, cabal may want to enable this warning
152 -- when building a library, so that GHC warns user about modules, not listed
153 -- neither in `exposed-modules`, nor in `other-modules`.
154 --
155 -- Here "home module" means a module, that doesn't come from an other package.
156 --
157 -- For example, if GHC is invoked with modules "A" and "B" as targets,
158 -- but "A" imports some other module "C", then GHC will issue a warning
159 -- about module "C" not being listed in a command line.
160 --
161 -- The warning in enabled by `-Wmissing-home-modules`. See Trac #13129
162 warnMissingHomeModules :: GhcMonad m => HscEnv -> ModuleGraph -> m ()
163 warnMissingHomeModules hsc_env mod_graph =
164 when (wopt Opt_WarnMissingHomeModules dflags && not (null missing)) $
165 logWarnings (listToBag [warn])
166 where
167 dflags = hsc_dflags hsc_env
168 missing = filter (`notElem` targets) imports
169 imports = map (moduleName . ms_mod) mod_graph
170 targets = map (targetid_to_name . targetId) (hsc_targets hsc_env)
171
172 msg = text "Modules are not listed in command line: "
173 <> sep (map ppr missing)
174 warn = makeIntoWarning
175 (Reason Opt_WarnMissingHomeModules)
176 (mkPlainErrMsg dflags noSrcSpan msg)
177
178 targetid_to_name (TargetModule name) = name
179 targetid_to_name (TargetFile file _) =
180 -- We can get a file even if module name in specified in command line
181 -- because it can be converted in guessTarget. So let's convert it back.
182 mkModuleName (fst $ splitExtension file)
183
184 -- | Describes which modules of the module graph need to be loaded.
185 data LoadHowMuch
186 = LoadAllTargets
187 -- ^ Load all targets and its dependencies.
188 | LoadUpTo ModuleName
189 -- ^ Load only the given module and its dependencies.
190 | LoadDependenciesOf ModuleName
191 -- ^ Load only the dependencies of the given module, but not the module
192 -- itself.
193
194 -- | Try to load the program. See 'LoadHowMuch' for the different modes.
195 --
196 -- This function implements the core of GHC's @--make@ mode. It preprocesses,
197 -- compiles and loads the specified modules, avoiding re-compilation wherever
198 -- possible. Depending on the target (see 'DynFlags.hscTarget') compiling
199 -- and loading may result in files being created on disk.
200 --
201 -- Calls the 'defaultWarnErrLogger' after each compiling each module, whether
202 -- successful or not.
203 --
204 -- Throw a 'SourceError' if errors are encountered before the actual
205 -- compilation starts (e.g., during dependency analysis). All other errors
206 -- are reported using the 'defaultWarnErrLogger'.
207 --
208 load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
209 load how_much = do
210 mod_graph <- depanal [] False
211 load' how_much (Just batchMsg) mod_graph
212
213 -- | Generalized version of 'load' which also supports a custom
214 -- 'Messager' (for reporting progress) and 'ModuleGraph' (generally
215 -- produced by calling 'depanal'.
216 load' :: GhcMonad m => LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag
217 load' how_much mHscMessage mod_graph = do
218 modifySession $ \hsc_env -> hsc_env { hsc_mod_graph = mod_graph }
219 guessOutputFile
220 hsc_env <- getSession
221
222 let hpt1 = hsc_HPT hsc_env
223 let dflags = hsc_dflags hsc_env
224
225 -- The "bad" boot modules are the ones for which we have
226 -- B.hs-boot in the module graph, but no B.hs
227 -- The downsweep should have ensured this does not happen
228 -- (see msDeps)
229 let all_home_mods =
230 mkUniqSet [ ms_mod_name s
231 | s <- mod_graph, not (isBootSummary s)]
232 -- TODO: Figure out what the correct form of this assert is. It's violated
233 -- when you have HsBootMerge nodes in the graph: then you'll have hs-boot
234 -- files without corresponding hs files.
235 -- bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
236 -- not (ms_mod_name s `elem` all_home_mods)]
237 -- ASSERT( null bad_boot_mods ) return ()
238
239 -- check that the module given in HowMuch actually exists, otherwise
240 -- topSortModuleGraph will bomb later.
241 let checkHowMuch (LoadUpTo m) = checkMod m
242 checkHowMuch (LoadDependenciesOf m) = checkMod m
243 checkHowMuch _ = id
244
245 checkMod m and_then
246 | m `elementOfUniqSet` all_home_mods = and_then
247 | otherwise = do
248 liftIO $ errorMsg dflags (text "no such module:" <+>
249 quotes (ppr m))
250 return Failed
251
252 checkHowMuch how_much $ do
253
254 -- mg2_with_srcimps drops the hi-boot nodes, returning a
255 -- graph with cycles. Among other things, it is used for
256 -- backing out partially complete cycles following a failed
257 -- upsweep, and for removing from hpt all the modules
258 -- not in strict downwards closure, during calls to compile.
259 let mg2_with_srcimps :: [SCC ModSummary]
260 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
261
262 -- If we can determine that any of the {-# SOURCE #-} imports
263 -- are definitely unnecessary, then emit a warning.
264 warnUnnecessarySourceImports mg2_with_srcimps
265
266 let
267 -- check the stability property for each module.
268 stable_mods@(stable_obj,stable_bco)
269 = checkStability hpt1 mg2_with_srcimps all_home_mods
270
271 -- prune bits of the HPT which are definitely redundant now,
272 -- to save space.
273 pruned_hpt = pruneHomePackageTable hpt1
274 (flattenSCCs mg2_with_srcimps)
275 stable_mods
276
277 _ <- liftIO $ evaluate pruned_hpt
278
279 -- before we unload anything, make sure we don't leave an old
280 -- interactive context around pointing to dead bindings. Also,
281 -- write the pruned HPT to allow the old HPT to be GC'd.
282 setSession $ discardIC $ hsc_env { hsc_HPT = pruned_hpt }
283
284 liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
285 text "Stable BCO:" <+> ppr stable_bco)
286
287 -- Unload any modules which are going to be re-linked this time around.
288 let stable_linkables = [ linkable
289 | m <- stable_obj++stable_bco,
290 Just hmi <- [lookupHpt pruned_hpt m],
291 Just linkable <- [hm_linkable hmi] ]
292 liftIO $ unload hsc_env stable_linkables
293
294 -- We could at this point detect cycles which aren't broken by
295 -- a source-import, and complain immediately, but it seems better
296 -- to let upsweep_mods do this, so at least some useful work gets
297 -- done before the upsweep is abandoned.
298 --hPutStrLn stderr "after tsort:\n"
299 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
300
301 -- Now do the upsweep, calling compile for each module in
302 -- turn. Final result is version 3 of everything.
303
304 -- Topologically sort the module graph, this time including hi-boot
305 -- nodes, and possibly just including the portion of the graph
306 -- reachable from the module specified in the 2nd argument to load.
307 -- This graph should be cycle-free.
308 -- If we're restricting the upsweep to a portion of the graph, we
309 -- also want to retain everything that is still stable.
310 let full_mg :: [SCC ModSummary]
311 full_mg = topSortModuleGraph False mod_graph Nothing
312
313 maybe_top_mod = case how_much of
314 LoadUpTo m -> Just m
315 LoadDependenciesOf m -> Just m
316 _ -> Nothing
317
318 partial_mg0 :: [SCC ModSummary]
319 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
320
321 -- LoadDependenciesOf m: we want the upsweep to stop just
322 -- short of the specified module (unless the specified module
323 -- is stable).
324 partial_mg
325 | LoadDependenciesOf _mod <- how_much
326 = ASSERT( case last partial_mg0 of
327 AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
328 List.init partial_mg0
329 | otherwise
330 = partial_mg0
331
332 stable_mg =
333 [ AcyclicSCC ms
334 | AcyclicSCC ms <- full_mg,
335 ms_mod_name ms `elem` stable_obj++stable_bco ]
336
337 -- the modules from partial_mg that are not also stable
338 -- NB. also keep cycles, we need to emit an error message later
339 unstable_mg = filter not_stable partial_mg
340 where not_stable (CyclicSCC _) = True
341 not_stable (AcyclicSCC ms)
342 = ms_mod_name ms `notElem` stable_obj++stable_bco
343
344 -- Load all the stable modules first, before attempting to load
345 -- an unstable module (#7231).
346 mg = stable_mg ++ unstable_mg
347
348 -- clean up between compilations
349 let cleanup hsc_env = intermediateCleanTempFiles (hsc_dflags hsc_env)
350 (flattenSCCs mg2_with_srcimps)
351 hsc_env
352
353 liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
354 2 (ppr mg))
355
356 n_jobs <- case parMakeCount dflags of
357 Nothing -> liftIO getNumProcessors
358 Just n -> return n
359 let upsweep_fn | n_jobs > 1 = parUpsweep n_jobs
360 | otherwise = upsweep
361
362 setSession hsc_env{ hsc_HPT = emptyHomePackageTable }
363 (upsweep_ok, modsUpswept)
364 <- upsweep_fn mHscMessage pruned_hpt stable_mods cleanup mg
365
366 -- Make modsDone be the summaries for each home module now
367 -- available; this should equal the domain of hpt3.
368 -- Get in in a roughly top .. bottom order (hence reverse).
369
370 let modsDone = reverse modsUpswept
371
372 -- Try and do linking in some form, depending on whether the
373 -- upsweep was completely or only partially successful.
374
375 if succeeded upsweep_ok
376
377 then
378 -- Easy; just relink it all.
379 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep completely successful.")
380
381 -- Clean up after ourselves
382 hsc_env1 <- getSession
383 liftIO $ intermediateCleanTempFiles dflags modsDone hsc_env1
384
385 -- Issue a warning for the confusing case where the user
386 -- said '-o foo' but we're not going to do any linking.
387 -- We attempt linking if either (a) one of the modules is
388 -- called Main, or (b) the user said -no-hs-main, indicating
389 -- that main() is going to come from somewhere else.
390 --
391 let ofile = outputFile dflags
392 let no_hs_main = gopt Opt_NoHsMain dflags
393 let
394 main_mod = mainModIs dflags
395 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
396 do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib
397
398 -- link everything together
399 linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
400
401 if ghcLink dflags == LinkBinary && isJust ofile && not do_linking
402 then do
403 liftIO $ errorMsg dflags $ text
404 ("output was redirected with -o, " ++
405 "but no output will be generated\n" ++
406 "because there is no " ++
407 moduleNameString (moduleName main_mod) ++ " module.")
408 -- This should be an error, not a warning (#10895).
409 loadFinish Failed linkresult
410 else
411 loadFinish Succeeded linkresult
412
413 else
414 -- Tricky. We need to back out the effects of compiling any
415 -- half-done cycles, both so as to clean up the top level envs
416 -- and to avoid telling the interactive linker to link them.
417 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep partially successful.")
418
419 let modsDone_names
420 = map ms_mod modsDone
421 let mods_to_zap_names
422 = findPartiallyCompletedCycles modsDone_names
423 mg2_with_srcimps
424 let mods_to_keep
425 = filter ((`Set.notMember` mods_to_zap_names).ms_mod)
426 modsDone
427
428 hsc_env1 <- getSession
429 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
430 (hsc_HPT hsc_env1)
431
432 -- Clean up after ourselves
433 liftIO $ intermediateCleanTempFiles dflags mods_to_keep hsc_env1
434
435 -- there should be no Nothings where linkables should be, now
436 let just_linkables =
437 isNoLink (ghcLink dflags)
438 || allHpt (isJust.hm_linkable)
439 (filterHpt ((== HsSrcFile).mi_hsc_src.hm_iface)
440 hpt4)
441 ASSERT( just_linkables ) do
442
443 -- Link everything together
444 linkresult <- liftIO $ link (ghcLink dflags) dflags False hpt4
445
446 modifySession $ \hsc_env -> hsc_env{ hsc_HPT = hpt4 }
447 loadFinish Failed linkresult
448
449
450 -- | Finish up after a load.
451 loadFinish :: GhcMonad m => SuccessFlag -> SuccessFlag -> m SuccessFlag
452
453 -- If the link failed, unload everything and return.
454 loadFinish _all_ok Failed
455 = do hsc_env <- getSession
456 liftIO $ unload hsc_env []
457 modifySession discardProg
458 return Failed
459
460 -- Empty the interactive context and set the module context to the topmost
461 -- newly loaded module, or the Prelude if none were loaded.
462 loadFinish all_ok Succeeded
463 = do modifySession discardIC
464 return all_ok
465
466
467 -- | Forget the current program, but retain the persistent info in HscEnv
468 discardProg :: HscEnv -> HscEnv
469 discardProg hsc_env
470 = discardIC $ hsc_env { hsc_mod_graph = emptyMG
471 , hsc_HPT = emptyHomePackageTable }
472
473 -- | Discard the contents of the InteractiveContext, but keep the DynFlags.
474 -- It will also keep ic_int_print and ic_monad if their names are from
475 -- external packages.
476 discardIC :: HscEnv -> HscEnv
477 discardIC hsc_env
478 = hsc_env { hsc_IC = empty_ic { ic_int_print = new_ic_int_print
479 , ic_monad = new_ic_monad } }
480 where
481 -- Force the new values for ic_int_print and ic_monad to avoid leaking old_ic
482 !new_ic_int_print = keep_external_name ic_int_print
483 !new_ic_monad = keep_external_name ic_monad
484 dflags = ic_dflags old_ic
485 old_ic = hsc_IC hsc_env
486 empty_ic = emptyInteractiveContext dflags
487 keep_external_name ic_name
488 | nameIsFromExternalPackage this_pkg old_name = old_name
489 | otherwise = ic_name empty_ic
490 where
491 this_pkg = thisPackage dflags
492 old_name = ic_name old_ic
493
494 intermediateCleanTempFiles :: DynFlags -> [ModSummary] -> HscEnv -> IO ()
495 intermediateCleanTempFiles dflags summaries hsc_env
496 = do notIntermediate <- readIORef (filesToNotIntermediateClean dflags)
497 cleanTempFilesExcept dflags (notIntermediate ++ except)
498 where
499 except =
500 -- Save preprocessed files. The preprocessed file *might* be
501 -- the same as the source file, but that doesn't do any
502 -- harm.
503 map ms_hspp_file summaries ++
504 -- Save object files for loaded modules. The point of this
505 -- is that we might have generated and compiled a stub C
506 -- file, and in the case of GHCi the object file will be a
507 -- temporary file which we must not remove because we need
508 -- to load/link it later.
509 hptObjs (hsc_HPT hsc_env)
510
511 -- | If there is no -o option, guess the name of target executable
512 -- by using top-level source file name as a base.
513 guessOutputFile :: GhcMonad m => m ()
514 guessOutputFile = modifySession $ \env ->
515 let dflags = hsc_dflags env
516 -- Force mod_graph to avoid leaking env
517 !mod_graph = hsc_mod_graph env
518 mainModuleSrcPath :: Maybe String
519 mainModuleSrcPath = do
520 let isMain = (== mainModIs dflags) . ms_mod
521 [ms] <- return (filter isMain mod_graph)
522 ml_hs_file (ms_location ms)
523 name = fmap dropExtension mainModuleSrcPath
524
525 name_exe = do
526 #if defined(mingw32_HOST_OS)
527 -- we must add the .exe extension unconditionally here, otherwise
528 -- when name has an extension of its own, the .exe extension will
529 -- not be added by DriverPipeline.exeFileName. See #2248
530 name' <- fmap (<.> "exe") name
531 #else
532 name' <- name
533 #endif
534 mainModuleSrcPath' <- mainModuleSrcPath
535 -- #9930: don't clobber input files (unless they ask for it)
536 if name' == mainModuleSrcPath'
537 then throwGhcException . UsageError $
538 "default output name would overwrite the input file; " ++
539 "must specify -o explicitly"
540 else Just name'
541 in
542 case outputFile dflags of
543 Just _ -> env
544 Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } }
545
546 -- -----------------------------------------------------------------------------
547 --
548 -- | Prune the HomePackageTable
549 --
550 -- Before doing an upsweep, we can throw away:
551 --
552 -- - For non-stable modules:
553 -- - all ModDetails, all linked code
554 -- - all unlinked code that is out of date with respect to
555 -- the source file
556 --
557 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
558 -- space at the end of the upsweep, because the topmost ModDetails of the
559 -- old HPT holds on to the entire type environment from the previous
560 -- compilation.
561 pruneHomePackageTable :: HomePackageTable
562 -> [ModSummary]
563 -> ([ModuleName],[ModuleName])
564 -> HomePackageTable
565 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
566 = mapHpt prune hpt
567 where prune hmi
568 | is_stable modl = hmi'
569 | otherwise = hmi'{ hm_details = emptyModDetails }
570 where
571 modl = moduleName (mi_module (hm_iface hmi))
572 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
573 = hmi{ hm_linkable = Nothing }
574 | otherwise
575 = hmi
576 where ms = expectJust "prune" (lookupUFM ms_map modl)
577
578 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
579
580 is_stable m = m `elem` stable_obj || m `elem` stable_bco
581
582 -- -----------------------------------------------------------------------------
583 --
584 -- | Return (names of) all those in modsDone who are part of a cycle as defined
585 -- by theGraph.
586 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> Set.Set Module
587 findPartiallyCompletedCycles modsDone theGraph
588 = Set.unions
589 [mods_in_this_cycle
590 | CyclicSCC vs <- theGraph -- Acyclic? Not interesting.
591 , let names_in_this_cycle = Set.fromList (map ms_mod vs)
592 mods_in_this_cycle =
593 Set.intersection (Set.fromList modsDone) names_in_this_cycle
594 -- If size mods_in_this_cycle == size names_in_this_cycle,
595 -- then this cycle has already been completed and we're not
596 -- interested.
597 , Set.size mods_in_this_cycle < Set.size names_in_this_cycle]
598
599
600 -- ---------------------------------------------------------------------------
601 --
602 -- | Unloading
603 unload :: HscEnv -> [Linkable] -> IO ()
604 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
605 = case ghcLink (hsc_dflags hsc_env) of
606 LinkInMemory -> Linker.unload hsc_env stable_linkables
607 _other -> return ()
608
609 -- -----------------------------------------------------------------------------
610 {- |
611
612 Stability tells us which modules definitely do not need to be recompiled.
613 There are two main reasons for having stability:
614
615 - avoid doing a complete upsweep of the module graph in GHCi when
616 modules near the bottom of the tree have not changed.
617
618 - to tell GHCi when it can load object code: we can only load object code
619 for a module when we also load object code fo all of the imports of the
620 module. So we need to know that we will definitely not be recompiling
621 any of these modules, and we can use the object code.
622
623 The stability check is as follows. Both stableObject and
624 stableBCO are used during the upsweep phase later.
625
626 @
627 stable m = stableObject m || stableBCO m
628
629 stableObject m =
630 all stableObject (imports m)
631 && old linkable does not exist, or is == on-disk .o
632 && date(on-disk .o) > date(.hs)
633
634 stableBCO m =
635 all stable (imports m)
636 && date(BCO) > date(.hs)
637 @
638
639 These properties embody the following ideas:
640
641 - if a module is stable, then:
642
643 - if it has been compiled in a previous pass (present in HPT)
644 then it does not need to be compiled or re-linked.
645
646 - if it has not been compiled in a previous pass,
647 then we only need to read its .hi file from disk and
648 link it to produce a 'ModDetails'.
649
650 - if a modules is not stable, we will definitely be at least
651 re-linking, and possibly re-compiling it during the 'upsweep'.
652 All non-stable modules can (and should) therefore be unlinked
653 before the 'upsweep'.
654
655 - Note that objects are only considered stable if they only depend
656 on other objects. We can't link object code against byte code.
657
658 - Note that even if an object is stable, we may end up recompiling
659 if the interface is out of date because an *external* interface
660 has changed. The current code in GhcMake handles this case
661 fairly poorly, so be careful.
662 -}
663 checkStability
664 :: HomePackageTable -- HPT from last compilation
665 -> [SCC ModSummary] -- current module graph (cyclic)
666 -> UniqSet ModuleName -- all home modules
667 -> ([ModuleName], -- stableObject
668 [ModuleName]) -- stableBCO
669
670 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
671 where
672 checkSCC (stable_obj, stable_bco) scc0
673 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
674 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
675 | otherwise = (stable_obj, stable_bco)
676 where
677 scc = flattenSCC scc0
678 scc_mods = map ms_mod_name scc
679 home_module m =
680 m `elementOfUniqSet` all_home_mods && m `notElem` scc_mods
681
682 scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))
683 -- all imports outside the current SCC, but in the home pkg
684
685 stable_obj_imps = map (`elem` stable_obj) scc_allimps
686 stable_bco_imps = map (`elem` stable_bco) scc_allimps
687
688 stableObjects =
689 and stable_obj_imps
690 && all object_ok scc
691
692 stableBCOs =
693 and (zipWith (||) stable_obj_imps stable_bco_imps)
694 && all bco_ok scc
695
696 object_ok ms
697 | gopt Opt_ForceRecomp (ms_hspp_opts ms) = False
698 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
699 && same_as_prev t
700 | otherwise = False
701 where
702 same_as_prev t = case lookupHpt hpt (ms_mod_name ms) of
703 Just hmi | Just l <- hm_linkable hmi
704 -> isObjectLinkable l && t == linkableTime l
705 _other -> True
706 -- why '>=' rather than '>' above? If the filesystem stores
707 -- times to the nearset second, we may occasionally find that
708 -- the object & source have the same modification time,
709 -- especially if the source was automatically generated
710 -- and compiled. Using >= is slightly unsafe, but it matches
711 -- make's behaviour.
712 --
713 -- But see #5527, where someone ran into this and it caused
714 -- a problem.
715
716 bco_ok ms
717 | gopt Opt_ForceRecomp (ms_hspp_opts ms) = False
718 | otherwise = case lookupHpt hpt (ms_mod_name ms) of
719 Just hmi | Just l <- hm_linkable hmi ->
720 not (isObjectLinkable l) &&
721 linkableTime l >= ms_hs_date ms
722 _other -> False
723
724 {- Parallel Upsweep
725 -
726 - The parallel upsweep attempts to concurrently compile the modules in the
727 - compilation graph using multiple Haskell threads.
728 -
729 - The Algorithm
730 -
731 - A Haskell thread is spawned for each module in the module graph, waiting for
732 - its direct dependencies to finish building before it itself begins to build.
733 -
734 - Each module is associated with an initially empty MVar that stores the
735 - result of that particular module's compile. If the compile succeeded, then
736 - the HscEnv (synchronized by an MVar) is updated with the fresh HMI of that
737 - module, and the module's HMI is deleted from the old HPT (synchronized by an
738 - IORef) to save space.
739 -
740 - Instead of immediately outputting messages to the standard handles, all
741 - compilation output is deferred to a per-module TQueue. A QSem is used to
742 - limit the number of workers that are compiling simultaneously.
743 -
744 - Meanwhile, the main thread sequentially loops over all the modules in the
745 - module graph, outputting the messages stored in each module's TQueue.
746 -}
747
748 -- | Each module is given a unique 'LogQueue' to redirect compilation messages
749 -- to. A 'Nothing' value contains the result of compilation, and denotes the
750 -- end of the message queue.
751 data LogQueue = LogQueue !(IORef [Maybe (WarnReason, Severity, SrcSpan, PprStyle, MsgDoc)])
752 !(MVar ())
753
754 -- | The graph of modules to compile and their corresponding result 'MVar' and
755 -- 'LogQueue'.
756 type CompilationGraph = [(ModSummary, MVar SuccessFlag, LogQueue)]
757
758 -- | Build a 'CompilationGraph' out of a list of strongly-connected modules,
759 -- also returning the first, if any, encountered module cycle.
760 buildCompGraph :: [SCC ModSummary] -> IO (CompilationGraph, Maybe [ModSummary])
761 buildCompGraph [] = return ([], Nothing)
762 buildCompGraph (scc:sccs) = case scc of
763 AcyclicSCC ms -> do
764 mvar <- newEmptyMVar
765 log_queue <- do
766 ref <- newIORef []
767 sem <- newEmptyMVar
768 return (LogQueue ref sem)
769 (rest,cycle) <- buildCompGraph sccs
770 return ((ms,mvar,log_queue):rest, cycle)
771 CyclicSCC mss -> return ([], Just mss)
772
773 -- A Module and whether it is a boot module.
774 type BuildModule = (Module, IsBoot)
775
776 -- | 'Bool' indicating if a module is a boot module or not. We need to treat
777 -- boot modules specially when building compilation graphs, since they break
778 -- cycles. Regular source files and signature files are treated equivalently.
779 data IsBoot = IsBoot | NotBoot
780 deriving (Ord, Eq, Show, Read)
781
782 -- | Tests if an 'HscSource' is a boot file, primarily for constructing
783 -- elements of 'BuildModule'.
784 hscSourceToIsBoot :: HscSource -> IsBoot
785 hscSourceToIsBoot HsBootFile = IsBoot
786 hscSourceToIsBoot _ = NotBoot
787
788 mkBuildModule :: ModSummary -> BuildModule
789 mkBuildModule ms = (ms_mod ms, if isBootSummary ms then IsBoot else NotBoot)
790
791 -- | The entry point to the parallel upsweep.
792 --
793 -- See also the simpler, sequential 'upsweep'.
794 parUpsweep
795 :: GhcMonad m
796 => Int
797 -- ^ The number of workers we wish to run in parallel
798 -> Maybe Messager
799 -> HomePackageTable
800 -> ([ModuleName],[ModuleName])
801 -> (HscEnv -> IO ())
802 -> [SCC ModSummary]
803 -> m (SuccessFlag,
804 [ModSummary])
805 parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
806 hsc_env <- getSession
807 let dflags = hsc_dflags hsc_env
808
809 when (not (null (unitIdsToCheck dflags))) $
810 throwGhcException (ProgramError "Backpack typechecking not supported with -j")
811
812 -- The bits of shared state we'll be using:
813
814 -- The global HscEnv is updated with the module's HMI when a module
815 -- successfully compiles.
816 hsc_env_var <- liftIO $ newMVar hsc_env
817
818 -- The old HPT is used for recompilation checking in upsweep_mod. When a
819 -- module successfully gets compiled, its HMI is pruned from the old HPT.
820 old_hpt_var <- liftIO $ newIORef old_hpt
821
822 -- What we use to limit parallelism with.
823 par_sem <- liftIO $ newQSem n_jobs
824
825
826 let updNumCapabilities = liftIO $ do
827 n_capabilities <- getNumCapabilities
828 n_cpus <- getNumProcessors
829 -- Setting number of capabilities more than
830 -- CPU count usually leads to high userspace
831 -- lock contention. Trac #9221
832 let n_caps = min n_jobs n_cpus
833 unless (n_capabilities /= 1) $ setNumCapabilities n_caps
834 return n_capabilities
835 -- Reset the number of capabilities once the upsweep ends.
836 let resetNumCapabilities orig_n = liftIO $ setNumCapabilities orig_n
837
838 gbracket updNumCapabilities resetNumCapabilities $ \_ -> do
839
840 -- Sync the global session with the latest HscEnv once the upsweep ends.
841 let finallySyncSession io = io `gfinally` do
842 hsc_env <- liftIO $ readMVar hsc_env_var
843 setSession hsc_env
844
845 finallySyncSession $ do
846
847 -- Build the compilation graph out of the list of SCCs. Module cycles are
848 -- handled at the very end, after some useful work gets done. Note that
849 -- this list is topologically sorted (by virtue of 'sccs' being sorted so).
850 (comp_graph,cycle) <- liftIO $ buildCompGraph sccs
851 let comp_graph_w_idx = zip comp_graph [1..]
852
853 -- The list of all loops in the compilation graph.
854 -- NB: For convenience, the last module of each loop (aka the module that
855 -- finishes the loop) is prepended to the beginning of the loop.
856 let comp_graph_loops = go (map fstOf3 (reverse comp_graph))
857 where
858 go [] = []
859 go (ms:mss) | Just loop <- getModLoop ms (ms:mss)
860 = map mkBuildModule (ms:loop) : go mss
861 | otherwise
862 = go mss
863
864 -- Build a Map out of the compilation graph with which we can efficiently
865 -- look up the result MVar associated with a particular home module.
866 let home_mod_map :: Map BuildModule (MVar SuccessFlag, Int)
867 home_mod_map =
868 Map.fromList [ (mkBuildModule ms, (mvar, idx))
869 | ((ms,mvar,_),idx) <- comp_graph_w_idx ]
870
871
872 liftIO $ label_self "main --make thread"
873 -- For each module in the module graph, spawn a worker thread that will
874 -- compile this module.
875 let { spawnWorkers = forM comp_graph_w_idx $ \((mod,!mvar,!log_queue),!mod_idx) ->
876 forkIOWithUnmask $ \unmask -> do
877 liftIO $ label_self $ unwords
878 [ "worker --make thread"
879 , "for module"
880 , show (moduleNameString (ms_mod_name mod))
881 , "number"
882 , show mod_idx
883 ]
884 -- Replace the default log_action with one that writes each
885 -- message to the module's log_queue. The main thread will
886 -- deal with synchronously printing these messages.
887 --
888 -- Use a local filesToClean var so that we can clean up
889 -- intermediate files in a timely fashion (as soon as
890 -- compilation for that module is finished) without having to
891 -- worry about accidentally deleting a simultaneous compile's
892 -- important files.
893 lcl_files_to_clean <- newIORef []
894 let lcl_dflags = dflags { log_action = parLogAction log_queue
895 , filesToClean = lcl_files_to_clean }
896
897 -- Unmask asynchronous exceptions and perform the thread-local
898 -- work to compile the module (see parUpsweep_one).
899 m_res <- try $ unmask $ prettyPrintGhcErrors lcl_dflags $
900 parUpsweep_one mod home_mod_map comp_graph_loops
901 lcl_dflags mHscMessage cleanup
902 par_sem hsc_env_var old_hpt_var
903 stable_mods mod_idx (length sccs)
904
905 res <- case m_res of
906 Right flag -> return flag
907 Left exc -> do
908 -- Don't print ThreadKilled exceptions: they are used
909 -- to kill the worker thread in the event of a user
910 -- interrupt, and the user doesn't have to be informed
911 -- about that.
912 when (fromException exc /= Just ThreadKilled)
913 (errorMsg lcl_dflags (text (show exc)))
914 return Failed
915
916 -- Populate the result MVar.
917 putMVar mvar res
918
919 -- Write the end marker to the message queue, telling the main
920 -- thread that it can stop waiting for messages from this
921 -- particular compile.
922 writeLogQueue log_queue Nothing
923
924 -- Add the remaining files that weren't cleaned up to the
925 -- global filesToClean ref, for cleanup later.
926 files_kept <- readIORef (filesToClean lcl_dflags)
927 addFilesToClean dflags files_kept
928
929
930 -- Kill all the workers, masking interrupts (since killThread is
931 -- interruptible). XXX: This is not ideal.
932 ; killWorkers = uninterruptibleMask_ . mapM_ killThread }
933
934
935 -- Spawn the workers, making sure to kill them later. Collect the results
936 -- of each compile.
937 results <- liftIO $ bracket spawnWorkers killWorkers $ \_ ->
938 -- Loop over each module in the compilation graph in order, printing
939 -- each message from its log_queue.
940 forM comp_graph $ \(mod,mvar,log_queue) -> do
941 printLogs dflags log_queue
942 result <- readMVar mvar
943 if succeeded result then return (Just mod) else return Nothing
944
945
946 -- Collect and return the ModSummaries of all the successful compiles.
947 -- NB: Reverse this list to maintain output parity with the sequential upsweep.
948 let ok_results = reverse (catMaybes results)
949
950 -- Handle any cycle in the original compilation graph and return the result
951 -- of the upsweep.
952 case cycle of
953 Just mss -> do
954 liftIO $ fatalErrorMsg dflags (cyclicModuleErr mss)
955 return (Failed,ok_results)
956 Nothing -> do
957 let success_flag = successIf (all isJust results)
958 return (success_flag,ok_results)
959
960 where
961 writeLogQueue :: LogQueue -> Maybe (WarnReason,Severity,SrcSpan,PprStyle,MsgDoc) -> IO ()
962 writeLogQueue (LogQueue ref sem) msg = do
963 atomicModifyIORef' ref $ \msgs -> (msg:msgs,())
964 _ <- tryPutMVar sem ()
965 return ()
966
967 -- The log_action callback that is used to synchronize messages from a
968 -- worker thread.
969 parLogAction :: LogQueue -> LogAction
970 parLogAction log_queue _dflags !reason !severity !srcSpan !style !msg = do
971 writeLogQueue log_queue (Just (reason,severity,srcSpan,style,msg))
972
973 -- Print each message from the log_queue using the log_action from the
974 -- session's DynFlags.
975 printLogs :: DynFlags -> LogQueue -> IO ()
976 printLogs !dflags (LogQueue ref sem) = read_msgs
977 where read_msgs = do
978 takeMVar sem
979 msgs <- atomicModifyIORef' ref $ \xs -> ([], reverse xs)
980 print_loop msgs
981
982 print_loop [] = read_msgs
983 print_loop (x:xs) = case x of
984 Just (reason,severity,srcSpan,style,msg) -> do
985 putLogMsg dflags reason severity srcSpan style msg
986 print_loop xs
987 -- Exit the loop once we encounter the end marker.
988 Nothing -> return ()
989
990 -- The interruptible subset of the worker threads' work.
991 parUpsweep_one
992 :: ModSummary
993 -- ^ The module we wish to compile
994 -> Map BuildModule (MVar SuccessFlag, Int)
995 -- ^ The map of home modules and their result MVar
996 -> [[BuildModule]]
997 -- ^ The list of all module loops within the compilation graph.
998 -> DynFlags
999 -- ^ The thread-local DynFlags
1000 -> Maybe Messager
1001 -- ^ The messager
1002 -> (HscEnv -> IO ())
1003 -- ^ The callback for cleaning up intermediate files
1004 -> QSem
1005 -- ^ The semaphore for limiting the number of simultaneous compiles
1006 -> MVar HscEnv
1007 -- ^ The MVar that synchronizes updates to the global HscEnv
1008 -> IORef HomePackageTable
1009 -- ^ The old HPT
1010 -> ([ModuleName],[ModuleName])
1011 -- ^ Lists of stable objects and BCOs
1012 -> Int
1013 -- ^ The index of this module
1014 -> Int
1015 -- ^ The total number of modules
1016 -> IO SuccessFlag
1017 -- ^ The result of this compile
1018 parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup par_sem
1019 hsc_env_var old_hpt_var stable_mods mod_index num_mods = do
1020
1021 let this_build_mod = mkBuildModule mod
1022
1023 let home_imps = map unLoc $ ms_home_imps mod
1024 let home_src_imps = map unLoc $ ms_home_srcimps mod
1025
1026 -- All the textual imports of this module.
1027 let textual_deps = Set.fromList $ mapFst (mkModule (thisPackage lcl_dflags)) $
1028 zip home_imps (repeat NotBoot) ++
1029 zip home_src_imps (repeat IsBoot)
1030
1031 -- Dealing with module loops
1032 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
1033 --
1034 -- Not only do we have to deal with explicit textual dependencies, we also
1035 -- have to deal with implicit dependencies introduced by import cycles that
1036 -- are broken by an hs-boot file. We have to ensure that:
1037 --
1038 -- 1. A module that breaks a loop must depend on all the modules in the
1039 -- loop (transitively or otherwise). This is normally always fulfilled
1040 -- by the module's textual dependencies except in degenerate loops,
1041 -- e.g.:
1042 --
1043 -- A.hs imports B.hs-boot
1044 -- B.hs doesn't import A.hs
1045 -- C.hs imports A.hs, B.hs
1046 --
1047 -- In this scenario, getModLoop will detect the module loop [A,B] but
1048 -- the loop finisher B doesn't depend on A. So we have to explicitly add
1049 -- A in as a dependency of B when we are compiling B.
1050 --
1051 -- 2. A module that depends on a module in an external loop can't proceed
1052 -- until the entire loop is re-typechecked.
1053 --
1054 -- These two invariants have to be maintained to correctly build a
1055 -- compilation graph with one or more loops.
1056
1057
1058 -- The loop that this module will finish. After this module successfully
1059 -- compiles, this loop is going to get re-typechecked.
1060 let finish_loop = listToMaybe
1061 [ tail loop | loop <- comp_graph_loops
1062 , head loop == this_build_mod ]
1063
1064 -- If this module finishes a loop then it must depend on all the other
1065 -- modules in that loop because the entire module loop is going to be
1066 -- re-typechecked once this module gets compiled. These extra dependencies
1067 -- are this module's "internal" loop dependencies, because this module is
1068 -- inside the loop in question.
1069 let int_loop_deps = Set.fromList $
1070 case finish_loop of
1071 Nothing -> []
1072 Just loop -> filter (/= this_build_mod) loop
1073
1074 -- If this module depends on a module within a loop then it must wait for
1075 -- that loop to get re-typechecked, i.e. it must wait on the module that
1076 -- finishes that loop. These extra dependencies are this module's
1077 -- "external" loop dependencies, because this module is outside of the
1078 -- loop(s) in question.
1079 let ext_loop_deps = Set.fromList
1080 [ head loop | loop <- comp_graph_loops
1081 , any (`Set.member` textual_deps) loop
1082 , this_build_mod `notElem` loop ]
1083
1084
1085 let all_deps = foldl1 Set.union [textual_deps, int_loop_deps, ext_loop_deps]
1086
1087 -- All of the module's home-module dependencies.
1088 let home_deps_with_idx =
1089 [ home_dep | dep <- Set.toList all_deps
1090 , Just home_dep <- [Map.lookup dep home_mod_map] ]
1091
1092 -- Sort the list of dependencies in reverse-topological order. This way, by
1093 -- the time we get woken up by the result of an earlier dependency,
1094 -- subsequent dependencies are more likely to have finished. This step
1095 -- effectively reduces the number of MVars that each thread blocks on.
1096 let home_deps = map fst $ sortBy (flip (comparing snd)) home_deps_with_idx
1097
1098 -- Wait for the all the module's dependencies to finish building.
1099 deps_ok <- allM (fmap succeeded . readMVar) home_deps
1100
1101 -- We can't build this module if any of its dependencies failed to build.
1102 if not deps_ok
1103 then return Failed
1104 else do
1105 -- Any hsc_env at this point is OK to use since we only really require
1106 -- that the HPT contains the HMIs of our dependencies.
1107 hsc_env <- readMVar hsc_env_var
1108 old_hpt <- readIORef old_hpt_var
1109
1110 let logger err = printBagOfErrors lcl_dflags (srcErrorMessages err)
1111
1112 -- Limit the number of parallel compiles.
1113 let withSem sem = bracket_ (waitQSem sem) (signalQSem sem)
1114 mb_mod_info <- withSem par_sem $
1115 handleSourceError (\err -> do logger err; return Nothing) $ do
1116 -- Have the ModSummary and HscEnv point to our local log_action
1117 -- and filesToClean var.
1118 let lcl_mod = localize_mod mod
1119 let lcl_hsc_env = localize_hsc_env hsc_env
1120
1121 -- Re-typecheck the loop
1122 -- This is necessary to make sure the knot is tied when
1123 -- we close a recursive module loop, see bug #12035.
1124 type_env_var <- liftIO $ newIORef emptyNameEnv
1125 let lcl_hsc_env' = lcl_hsc_env { hsc_type_env_var =
1126 Just (ms_mod lcl_mod, type_env_var) }
1127 lcl_hsc_env'' <- case finish_loop of
1128 Nothing -> return lcl_hsc_env'
1129 Just loop -> typecheckLoop lcl_dflags lcl_hsc_env' $
1130 map (moduleName . fst) loop
1131
1132 -- Compile the module.
1133 mod_info <- upsweep_mod lcl_hsc_env'' mHscMessage old_hpt stable_mods
1134 lcl_mod mod_index num_mods
1135 return (Just mod_info)
1136
1137 case mb_mod_info of
1138 Nothing -> return Failed
1139 Just mod_info -> do
1140 let this_mod = ms_mod_name mod
1141
1142 -- Prune the old HPT unless this is an hs-boot module.
1143 unless (isBootSummary mod) $
1144 atomicModifyIORef' old_hpt_var $ \old_hpt ->
1145 (delFromHpt old_hpt this_mod, ())
1146
1147 -- Update and fetch the global HscEnv.
1148 lcl_hsc_env' <- modifyMVar hsc_env_var $ \hsc_env -> do
1149 let hsc_env' = hsc_env
1150 { hsc_HPT = addToHpt (hsc_HPT hsc_env)
1151 this_mod mod_info }
1152 -- If this module is a loop finisher, now is the time to
1153 -- re-typecheck the loop.
1154 hsc_env'' <- case finish_loop of
1155 Nothing -> return hsc_env'
1156 Just loop -> typecheckLoop lcl_dflags hsc_env' $
1157 map (moduleName . fst) loop
1158 return (hsc_env'', localize_hsc_env hsc_env'')
1159
1160 -- Clean up any intermediate files.
1161 cleanup lcl_hsc_env'
1162 return Succeeded
1163
1164 where
1165 localize_mod mod
1166 = mod { ms_hspp_opts = (ms_hspp_opts mod)
1167 { log_action = log_action lcl_dflags
1168 , filesToClean = filesToClean lcl_dflags } }
1169
1170 localize_hsc_env hsc_env
1171 = hsc_env { hsc_dflags = (hsc_dflags hsc_env)
1172 { log_action = log_action lcl_dflags
1173 , filesToClean = filesToClean lcl_dflags } }
1174
1175 -- -----------------------------------------------------------------------------
1176 --
1177 -- | The upsweep
1178 --
1179 -- This is where we compile each module in the module graph, in a pass
1180 -- from the bottom to the top of the graph.
1181 --
1182 -- There better had not be any cyclic groups here -- we check for them.
1183 upsweep
1184 :: GhcMonad m
1185 => Maybe Messager
1186 -> HomePackageTable -- ^ HPT from last time round (pruned)
1187 -> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability)
1188 -> (HscEnv -> IO ()) -- ^ How to clean up unwanted tmp files
1189 -> [SCC ModSummary] -- ^ Mods to do (the worklist)
1190 -> m (SuccessFlag,
1191 [ModSummary])
1192 -- ^ Returns:
1193 --
1194 -- 1. A flag whether the complete upsweep was successful.
1195 -- 2. The 'HscEnv' in the monad has an updated HPT
1196 -- 3. A list of modules which succeeded loading.
1197
1198 upsweep mHscMessage old_hpt stable_mods cleanup sccs = do
1199 dflags <- getSessionDynFlags
1200 (res, done) <- upsweep' old_hpt [] sccs 1 (length sccs)
1201 (unitIdsToCheck dflags) done_holes
1202 return (res, reverse done)
1203 where
1204 done_holes = emptyUniqSet
1205
1206 upsweep' _old_hpt done
1207 [] _ _ uids_to_check _
1208 = do hsc_env <- getSession
1209 liftIO . runHsc hsc_env $ mapM_ (ioMsgMaybe . tcRnCheckUnitId hsc_env) uids_to_check
1210 return (Succeeded, done)
1211
1212 upsweep' _old_hpt done
1213 (CyclicSCC ms:_) _ _ _ _
1214 = do dflags <- getSessionDynFlags
1215 liftIO $ fatalErrorMsg dflags (cyclicModuleErr ms)
1216 return (Failed, done)
1217
1218 upsweep' old_hpt done
1219 (AcyclicSCC mod:mods) mod_index nmods uids_to_check done_holes
1220 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1221 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
1222 -- (moduleEnvElts (hsc_HPT hsc_env)))
1223 let logger _mod = defaultWarnErrLogger
1224
1225 hsc_env <- getSession
1226
1227 -- TODO: Cache this, so that we don't repeatedly re-check
1228 -- our imports when you run --make.
1229 let (ready_uids, uids_to_check')
1230 = partition (\uid -> isEmptyUniqDSet
1231 (unitIdFreeHoles uid `uniqDSetMinusUniqSet` done_holes))
1232 uids_to_check
1233 done_holes'
1234 | ms_hsc_src mod == HsigFile
1235 = addOneToUniqSet done_holes (ms_mod_name mod)
1236 | otherwise = done_holes
1237 liftIO . runHsc hsc_env $ mapM_ (ioMsgMaybe . tcRnCheckUnitId hsc_env) ready_uids
1238
1239 -- Remove unwanted tmp files between compilations
1240 liftIO (cleanup hsc_env)
1241
1242 -- Get ready to tie the knot
1243 type_env_var <- liftIO $ newIORef emptyNameEnv
1244 let hsc_env1 = hsc_env { hsc_type_env_var =
1245 Just (ms_mod mod, type_env_var) }
1246 setSession hsc_env1
1247
1248 -- Lazily reload the HPT modules participating in the loop.
1249 -- See Note [Tying the knot]--if we don't throw out the old HPT
1250 -- and reinitalize the knot-tying process, anything that was forced
1251 -- while we were previously typechecking won't get updated, this
1252 -- was bug #12035.
1253 hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done
1254 setSession hsc_env2
1255
1256 mb_mod_info
1257 <- handleSourceError
1258 (\err -> do logger mod (Just err); return Nothing) $ do
1259 mod_info <- liftIO $ upsweep_mod hsc_env2 mHscMessage old_hpt stable_mods
1260 mod mod_index nmods
1261 logger mod Nothing -- log warnings
1262 return (Just mod_info)
1263
1264 case mb_mod_info of
1265 Nothing -> return (Failed, done)
1266 Just mod_info -> do
1267 let this_mod = ms_mod_name mod
1268
1269 -- Add new info to hsc_env
1270 hpt1 = addToHpt (hsc_HPT hsc_env2) this_mod mod_info
1271 hsc_env3 = hsc_env2 { hsc_HPT = hpt1, hsc_type_env_var = Nothing }
1272
1273 -- Space-saving: delete the old HPT entry
1274 -- for mod BUT if mod is a hs-boot
1275 -- node, don't delete it. For the
1276 -- interface, the HPT entry is probaby for the
1277 -- main Haskell source file. Deleting it
1278 -- would force the real module to be recompiled
1279 -- every time.
1280 old_hpt1 | isBootSummary mod = old_hpt
1281 | otherwise = delFromHpt old_hpt this_mod
1282
1283 done' = mod:done
1284
1285 -- fixup our HomePackageTable after we've finished compiling
1286 -- a mutually-recursive loop. We have to do this again
1287 -- to make sure we have the final unfoldings, which may
1288 -- not have been computed accurately in the previous
1289 -- retypecheck.
1290 hsc_env4 <- liftIO $ reTypecheckLoop hsc_env3 mod done'
1291 setSession hsc_env4
1292
1293 -- Add any necessary entries to the static pointer
1294 -- table. See Note [Grand plan for static forms] in
1295 -- StaticPtrTable.
1296 when (hscTarget (hsc_dflags hsc_env4) == HscInterpreted) $
1297 liftIO $ hscAddSptEntries hsc_env4
1298 [ spt
1299 | Just linkable <- pure $ hm_linkable mod_info
1300 , unlinked <- linkableUnlinked linkable
1301 , BCOs _ spts <- pure unlinked
1302 , spt <- spts
1303 ]
1304
1305 upsweep' old_hpt1 done' mods (mod_index+1) nmods uids_to_check' done_holes'
1306
1307 unitIdsToCheck :: DynFlags -> [UnitId]
1308 unitIdsToCheck dflags =
1309 nubSort $ concatMap goUnitId (explicitPackages (pkgState dflags))
1310 where
1311 goUnitId uid =
1312 case splitUnitIdInsts uid of
1313 (_, Just indef) ->
1314 let insts = indefUnitIdInsts indef
1315 in uid : concatMap (goUnitId . moduleUnitId . snd) insts
1316 _ -> []
1317
1318 maybeGetIfaceDate :: DynFlags -> ModLocation -> IO (Maybe UTCTime)
1319 maybeGetIfaceDate dflags location
1320 | writeInterfaceOnlyMode dflags
1321 -- Minor optimization: it should be harmless to check the hi file location
1322 -- always, but it's better to avoid hitting the filesystem if possible.
1323 = modificationTimeIfExists (ml_hi_file location)
1324 | otherwise
1325 = return Nothing
1326
1327 -- | Compile a single module. Always produce a Linkable for it if
1328 -- successful. If no compilation happened, return the old Linkable.
1329 upsweep_mod :: HscEnv
1330 -> Maybe Messager
1331 -> HomePackageTable
1332 -> ([ModuleName],[ModuleName])
1333 -> ModSummary
1334 -> Int -- index of module
1335 -> Int -- total number of modules
1336 -> IO HomeModInfo
1337 upsweep_mod hsc_env mHscMessage old_hpt (stable_obj, stable_bco) summary mod_index nmods
1338 = let
1339 this_mod_name = ms_mod_name summary
1340 this_mod = ms_mod summary
1341 mb_obj_date = ms_obj_date summary
1342 mb_if_date = ms_iface_date summary
1343 obj_fn = ml_obj_file (ms_location summary)
1344 hs_date = ms_hs_date summary
1345
1346 is_stable_obj = this_mod_name `elem` stable_obj
1347 is_stable_bco = this_mod_name `elem` stable_bco
1348
1349 old_hmi = lookupHpt old_hpt this_mod_name
1350
1351 -- We're using the dflags for this module now, obtained by
1352 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
1353 dflags = ms_hspp_opts summary
1354 prevailing_target = hscTarget (hsc_dflags hsc_env)
1355 local_target = hscTarget dflags
1356
1357 -- If OPTIONS_GHC contains -fasm or -fllvm, be careful that
1358 -- we don't do anything dodgy: these should only work to change
1359 -- from -fllvm to -fasm and vice-versa, otherwise we could
1360 -- end up trying to link object code to byte code.
1361 target = if prevailing_target /= local_target
1362 && (not (isObjectTarget prevailing_target)
1363 || not (isObjectTarget local_target))
1364 then prevailing_target
1365 else local_target
1366
1367 -- store the corrected hscTarget into the summary
1368 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
1369
1370 -- The old interface is ok if
1371 -- a) we're compiling a source file, and the old HPT
1372 -- entry is for a source file
1373 -- b) we're compiling a hs-boot file
1374 -- Case (b) allows an hs-boot file to get the interface of its
1375 -- real source file on the second iteration of the compilation
1376 -- manager, but that does no harm. Otherwise the hs-boot file
1377 -- will always be recompiled
1378
1379 mb_old_iface
1380 = case old_hmi of
1381 Nothing -> Nothing
1382 Just hm_info | isBootSummary summary -> Just iface
1383 | not (mi_boot iface) -> Just iface
1384 | otherwise -> Nothing
1385 where
1386 iface = hm_iface hm_info
1387
1388 compile_it :: Maybe Linkable -> SourceModified -> IO HomeModInfo
1389 compile_it mb_linkable src_modified =
1390 compileOne' Nothing mHscMessage hsc_env summary' mod_index nmods
1391 mb_old_iface mb_linkable src_modified
1392
1393 compile_it_discard_iface :: Maybe Linkable -> SourceModified
1394 -> IO HomeModInfo
1395 compile_it_discard_iface mb_linkable src_modified =
1396 compileOne' Nothing mHscMessage hsc_env summary' mod_index nmods
1397 Nothing mb_linkable src_modified
1398
1399 -- With the HscNothing target we create empty linkables to avoid
1400 -- recompilation. We have to detect these to recompile anyway if
1401 -- the target changed since the last compile.
1402 is_fake_linkable
1403 | Just hmi <- old_hmi, Just l <- hm_linkable hmi =
1404 null (linkableUnlinked l)
1405 | otherwise =
1406 -- we have no linkable, so it cannot be fake
1407 False
1408
1409 implies False _ = True
1410 implies True x = x
1411
1412 in
1413 case () of
1414 _
1415 -- Regardless of whether we're generating object code or
1416 -- byte code, we can always use an existing object file
1417 -- if it is *stable* (see checkStability).
1418 | is_stable_obj, Just hmi <- old_hmi -> do
1419 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1420 (text "skipping stable obj mod:" <+> ppr this_mod_name)
1421 return hmi
1422 -- object is stable, and we have an entry in the
1423 -- old HPT: nothing to do
1424
1425 | is_stable_obj, isNothing old_hmi -> do
1426 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1427 (text "compiling stable on-disk mod:" <+> ppr this_mod_name)
1428 linkable <- liftIO $ findObjectLinkable this_mod obj_fn
1429 (expectJust "upsweep1" mb_obj_date)
1430 compile_it (Just linkable) SourceUnmodifiedAndStable
1431 -- object is stable, but we need to load the interface
1432 -- off disk to make a HMI.
1433
1434 | not (isObjectTarget target), is_stable_bco,
1435 (target /= HscNothing) `implies` not is_fake_linkable ->
1436 ASSERT(isJust old_hmi) -- must be in the old_hpt
1437 let Just hmi = old_hmi in do
1438 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1439 (text "skipping stable BCO mod:" <+> ppr this_mod_name)
1440 return hmi
1441 -- BCO is stable: nothing to do
1442
1443 | not (isObjectTarget target),
1444 Just hmi <- old_hmi,
1445 Just l <- hm_linkable hmi,
1446 not (isObjectLinkable l),
1447 (target /= HscNothing) `implies` not is_fake_linkable,
1448 linkableTime l >= ms_hs_date summary -> do
1449 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1450 (text "compiling non-stable BCO mod:" <+> ppr this_mod_name)
1451 compile_it (Just l) SourceUnmodified
1452 -- we have an old BCO that is up to date with respect
1453 -- to the source: do a recompilation check as normal.
1454
1455 -- When generating object code, if there's an up-to-date
1456 -- object file on the disk, then we can use it.
1457 -- However, if the object file is new (compared to any
1458 -- linkable we had from a previous compilation), then we
1459 -- must discard any in-memory interface, because this
1460 -- means the user has compiled the source file
1461 -- separately and generated a new interface, that we must
1462 -- read from the disk.
1463 --
1464 | isObjectTarget target,
1465 Just obj_date <- mb_obj_date,
1466 obj_date >= hs_date -> do
1467 case old_hmi of
1468 Just hmi
1469 | Just l <- hm_linkable hmi,
1470 isObjectLinkable l && linkableTime l == obj_date -> do
1471 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1472 (text "compiling mod with new on-disk obj:" <+> ppr this_mod_name)
1473 compile_it (Just l) SourceUnmodified
1474 _otherwise -> do
1475 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1476 (text "compiling mod with new on-disk obj2:" <+> ppr this_mod_name)
1477 linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date
1478 compile_it_discard_iface (Just linkable) SourceUnmodified
1479
1480 -- See Note [Recompilation checking when typechecking only]
1481 | writeInterfaceOnlyMode dflags,
1482 Just if_date <- mb_if_date,
1483 if_date >= hs_date -> do
1484 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1485 (text "skipping tc'd mod:" <+> ppr this_mod_name)
1486 compile_it Nothing SourceUnmodified
1487
1488 _otherwise -> do
1489 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1490 (text "compiling mod:" <+> ppr this_mod_name)
1491 compile_it Nothing SourceModified
1492
1493 -- Note [Recompilation checking when typechecking only]
1494 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1495 -- If we are compiling with -fno-code -fwrite-interface, there won't
1496 -- be any object code that we can compare against, nor should there
1497 -- be: we're *just* generating interface files. In this case, we
1498 -- want to check if the interface file is new, in lieu of the object
1499 -- file. See also Trac #9243.
1500
1501
1502 -- Filter modules in the HPT
1503 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
1504 retainInTopLevelEnvs keep_these hpt
1505 = listToHpt [ (mod, expectJust "retain" mb_mod_info)
1506 | mod <- keep_these
1507 , let mb_mod_info = lookupHpt hpt mod
1508 , isJust mb_mod_info ]
1509
1510 -- ---------------------------------------------------------------------------
1511 -- Typecheck module loops
1512 {-
1513 See bug #930. This code fixes a long-standing bug in --make. The
1514 problem is that when compiling the modules *inside* a loop, a data
1515 type that is only defined at the top of the loop looks opaque; but
1516 after the loop is done, the structure of the data type becomes
1517 apparent.
1518
1519 The difficulty is then that two different bits of code have
1520 different notions of what the data type looks like.
1521
1522 The idea is that after we compile a module which also has an .hs-boot
1523 file, we re-generate the ModDetails for each of the modules that
1524 depends on the .hs-boot file, so that everyone points to the proper
1525 TyCons, Ids etc. defined by the real module, not the boot module.
1526 Fortunately re-generating a ModDetails from a ModIface is easy: the
1527 function TcIface.typecheckIface does exactly that.
1528
1529 Picking the modules to re-typecheck is slightly tricky. Starting from
1530 the module graph consisting of the modules that have already been
1531 compiled, we reverse the edges (so they point from the imported module
1532 to the importing module), and depth-first-search from the .hs-boot
1533 node. This gives us all the modules that depend transitively on the
1534 .hs-boot module, and those are exactly the modules that we need to
1535 re-typecheck.
1536
1537 Following this fix, GHC can compile itself with --make -O2.
1538 -}
1539
1540 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
1541 reTypecheckLoop hsc_env ms graph
1542 | Just loop <- getModLoop ms graph
1543 -- SOME hs-boot files should still
1544 -- get used, just not the loop-closer.
1545 , let non_boot = filter (\l -> not (isBootSummary l &&
1546 ms_mod l == ms_mod ms)) loop
1547 = typecheckLoop (hsc_dflags hsc_env) hsc_env (map ms_mod_name non_boot)
1548 | otherwise
1549 = return hsc_env
1550
1551 getModLoop :: ModSummary -> ModuleGraph -> Maybe [ModSummary]
1552 getModLoop ms graph
1553 | not (isBootSummary ms)
1554 , any (\m -> ms_mod m == this_mod && isBootSummary m) graph
1555 , let mss = reachableBackwards (ms_mod_name ms) graph
1556 = Just mss
1557 | otherwise
1558 = Nothing
1559 where
1560 this_mod = ms_mod ms
1561
1562 typecheckLoop :: DynFlags -> HscEnv -> [ModuleName] -> IO HscEnv
1563 typecheckLoop dflags hsc_env mods = do
1564 debugTraceMsg dflags 2 $
1565 text "Re-typechecking loop: " <> ppr mods
1566 new_hpt <-
1567 fixIO $ \new_hpt -> do
1568 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
1569 mds <- initIfaceCheck (text "typecheckLoop") new_hsc_env $
1570 mapM (typecheckIface . hm_iface) hmis
1571 let new_hpt = addListToHpt old_hpt
1572 (zip mods [ hmi{ hm_details = details }
1573 | (hmi,details) <- zip hmis mds ])
1574 return new_hpt
1575 return hsc_env{ hsc_HPT = new_hpt }
1576 where
1577 old_hpt = hsc_HPT hsc_env
1578 hmis = map (expectJust "typecheckLoop" . lookupHpt old_hpt) mods
1579
1580 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
1581 reachableBackwards mod summaries
1582 = [ node_payload node | node <- reachableG (transposeG graph) root ]
1583 where -- the rest just sets up the graph:
1584 (graph, lookup_node) = moduleGraphNodes False summaries
1585 root = expectJust "reachableBackwards" (lookup_node HsBootFile mod)
1586
1587 -- ---------------------------------------------------------------------------
1588 --
1589 -- | Topological sort of the module graph
1590 topSortModuleGraph
1591 :: Bool
1592 -- ^ Drop hi-boot nodes? (see below)
1593 -> [ModSummary]
1594 -> Maybe ModuleName
1595 -- ^ Root module name. If @Nothing@, use the full graph.
1596 -> [SCC ModSummary]
1597 -- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1598 -- The resulting list of strongly-connected-components is in topologically
1599 -- sorted order, starting with the module(s) at the bottom of the
1600 -- dependency graph (ie compile them first) and ending with the ones at
1601 -- the top.
1602 --
1603 -- Drop hi-boot nodes (first boolean arg)?
1604 --
1605 -- - @False@: treat the hi-boot summaries as nodes of the graph,
1606 -- so the graph must be acyclic
1607 --
1608 -- - @True@: eliminate the hi-boot nodes, and instead pretend
1609 -- the a source-import of Foo is an import of Foo
1610 -- The resulting graph has no hi-boot nodes, but can be cyclic
1611
1612 topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
1613 = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph
1614 where
1615 -- stronglyConnCompG flips the original order, so if we reverse
1616 -- the summaries we get a stable topological sort.
1617 (graph, lookup_node) = moduleGraphNodes drop_hs_boot_nodes (reverse summaries)
1618
1619 initial_graph = case mb_root_mod of
1620 Nothing -> graph
1621 Just root_mod ->
1622 -- restrict the graph to just those modules reachable from
1623 -- the specified module. We do this by building a graph with
1624 -- the full set of nodes, and determining the reachable set from
1625 -- the specified node.
1626 let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
1627 | otherwise = throwGhcException (ProgramError "module does not exist")
1628 in graphFromEdgedVerticesUniq (seq root (reachableG graph root))
1629
1630 type SummaryNode = Node Int ModSummary
1631
1632 summaryNodeKey :: SummaryNode -> Int
1633 summaryNodeKey = node_key
1634
1635 summaryNodeSummary :: SummaryNode -> ModSummary
1636 summaryNodeSummary = node_payload
1637
1638 moduleGraphNodes :: Bool -> [ModSummary]
1639 -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
1640 moduleGraphNodes drop_hs_boot_nodes summaries =
1641 (graphFromEdgedVerticesUniq nodes, lookup_node)
1642 where
1643 numbered_summaries = zip summaries [1..]
1644
1645 lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode
1646 lookup_node hs_src mod = Map.lookup (mod, hscSourceToIsBoot hs_src) node_map
1647
1648 lookup_key :: HscSource -> ModuleName -> Maybe Int
1649 lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)
1650
1651 node_map :: NodeMap SummaryNode
1652 node_map = Map.fromList [ ((moduleName (ms_mod s),
1653 hscSourceToIsBoot (ms_hsc_src s)), node)
1654 | node <- nodes
1655 , let s = summaryNodeSummary node ]
1656
1657 -- We use integers as the keys for the SCC algorithm
1658 nodes :: [SummaryNode]
1659 nodes = [ DigraphNode s key out_keys
1660 | (s, key) <- numbered_summaries
1661 -- Drop the hi-boot ones if told to do so
1662 , not (isBootSummary s && drop_hs_boot_nodes)
1663 , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
1664 out_edge_keys HsSrcFile (map unLoc (ms_home_imps s)) ++
1665 (-- see [boot-edges] below
1666 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
1667 then []
1668 else case lookup_key HsBootFile (ms_mod_name s) of
1669 Nothing -> []
1670 Just k -> [k]) ]
1671
1672 -- [boot-edges] if this is a .hs and there is an equivalent
1673 -- .hs-boot, add a link from the former to the latter. This
1674 -- has the effect of detecting bogus cases where the .hs-boot
1675 -- depends on the .hs, by introducing a cycle. Additionally,
1676 -- it ensures that we will always process the .hs-boot before
1677 -- the .hs, and so the HomePackageTable will always have the
1678 -- most up to date information.
1679
1680 -- Drop hs-boot nodes by using HsSrcFile as the key
1681 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1682 | otherwise = HsBootFile
1683
1684 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1685 out_edge_keys hi_boot ms = mapMaybe (lookup_key hi_boot) ms
1686 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1687 -- IsBoot; else NotBoot
1688
1689 -- The nodes of the graph are keyed by (mod, is boot?) pairs
1690 -- NB: hsig files show up as *normal* nodes (not boot!), since they don't
1691 -- participate in cycles (for now)
1692 type NodeKey = (ModuleName, IsBoot)
1693 type NodeMap a = Map.Map NodeKey a
1694
1695 msKey :: ModSummary -> NodeKey
1696 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot })
1697 = (moduleName mod, hscSourceToIsBoot boot)
1698
1699 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1700 mkNodeMap summaries = Map.fromList [ (msKey s, s) | s <- summaries]
1701
1702 nodeMapElts :: NodeMap a -> [a]
1703 nodeMapElts = Map.elems
1704
1705 -- | If there are {-# SOURCE #-} imports between strongly connected
1706 -- components in the topological sort, then those imports can
1707 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1708 -- were necessary, then the edge would be part of a cycle.
1709 warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()
1710 warnUnnecessarySourceImports sccs = do
1711 dflags <- getDynFlags
1712 when (wopt Opt_WarnUnusedImports dflags)
1713 (logWarnings (listToBag (concatMap (check dflags . flattenSCC) sccs)))
1714 where check dflags ms =
1715 let mods_in_this_cycle = map ms_mod_name ms in
1716 [ warn dflags i | m <- ms, i <- ms_home_srcimps m,
1717 unLoc i `notElem` mods_in_this_cycle ]
1718
1719 warn :: DynFlags -> Located ModuleName -> WarnMsg
1720 warn dflags (L loc mod) =
1721 mkPlainErrMsg dflags loc
1722 (text "Warning: {-# SOURCE #-} unnecessary in import of "
1723 <+> quotes (ppr mod))
1724
1725
1726 reportImportErrors :: MonadIO m => [Either ErrMsg b] -> m [b]
1727 reportImportErrors xs | null errs = return oks
1728 | otherwise = throwManyErrors errs
1729 where (errs, oks) = partitionEithers xs
1730
1731 throwManyErrors :: MonadIO m => [ErrMsg] -> m ab
1732 throwManyErrors errs = liftIO $ throwIO $ mkSrcErr $ listToBag errs
1733
1734
1735 -----------------------------------------------------------------------------
1736 --
1737 -- | Downsweep (dependency analysis)
1738 --
1739 -- Chase downwards from the specified root set, returning summaries
1740 -- for all home modules encountered. Only follow source-import
1741 -- links.
1742 --
1743 -- We pass in the previous collection of summaries, which is used as a
1744 -- cache to avoid recalculating a module summary if the source is
1745 -- unchanged.
1746 --
1747 -- The returned list of [ModSummary] nodes has one node for each home-package
1748 -- module, plus one for any hs-boot files. The imports of these nodes
1749 -- are all there, including the imports of non-home-package modules.
1750 downsweep :: HscEnv
1751 -> [ModSummary] -- Old summaries
1752 -> [ModuleName] -- Ignore dependencies on these; treat
1753 -- them as if they were package modules
1754 -> Bool -- True <=> allow multiple targets to have
1755 -- the same module name; this is
1756 -- very useful for ghc -M
1757 -> IO [Either ErrMsg ModSummary]
1758 -- The elts of [ModSummary] all have distinct
1759 -- (Modules, IsBoot) identifiers, unless the Bool is true
1760 -- in which case there can be repeats
1761 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1762 = do
1763 rootSummaries <- mapM getRootSummary roots
1764 rootSummariesOk <- reportImportErrors rootSummaries
1765 let root_map = mkRootMap rootSummariesOk
1766 checkDuplicates root_map
1767 summs <- loop (concatMap calcDeps rootSummariesOk) root_map
1768 return summs
1769 where
1770 calcDeps = msDeps
1771
1772 dflags = hsc_dflags hsc_env
1773 roots = hsc_targets hsc_env
1774
1775 old_summary_map :: NodeMap ModSummary
1776 old_summary_map = mkNodeMap old_summaries
1777
1778 getRootSummary :: Target -> IO (Either ErrMsg ModSummary)
1779 getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)
1780 = do exists <- liftIO $ doesFileExist file
1781 if exists
1782 then Right `fmap` summariseFile hsc_env old_summaries file mb_phase
1783 obj_allowed maybe_buf
1784 else return $ Left $ mkPlainErrMsg dflags noSrcSpan $
1785 text "can't find file:" <+> text file
1786 getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
1787 = do maybe_summary <- summariseModule hsc_env old_summary_map NotBoot
1788 (L rootLoc modl) obj_allowed
1789 maybe_buf excl_mods
1790 case maybe_summary of
1791 Nothing -> return $ Left $ moduleNotFoundErr dflags modl
1792 Just s -> return s
1793
1794 rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1795
1796 -- In a root module, the filename is allowed to diverge from the module
1797 -- name, so we have to check that there aren't multiple root files
1798 -- defining the same module (otherwise the duplicates will be silently
1799 -- ignored, leading to confusing behaviour).
1800 checkDuplicates :: NodeMap [Either ErrMsg ModSummary] -> IO ()
1801 checkDuplicates root_map
1802 | allow_dup_roots = return ()
1803 | null dup_roots = return ()
1804 | otherwise = liftIO $ multiRootsErr dflags (head dup_roots)
1805 where
1806 dup_roots :: [[ModSummary]] -- Each at least of length 2
1807 dup_roots = filterOut isSingleton $ map rights $ nodeMapElts root_map
1808
1809 loop :: [(Located ModuleName,IsBoot)]
1810 -- Work list: process these modules
1811 -> NodeMap [Either ErrMsg ModSummary]
1812 -- Visited set; the range is a list because
1813 -- the roots can have the same module names
1814 -- if allow_dup_roots is True
1815 -> IO [Either ErrMsg ModSummary]
1816 -- The result includes the worklist, except
1817 -- for those mentioned in the visited set
1818 loop [] done = return (concat (nodeMapElts done))
1819 loop ((wanted_mod, is_boot) : ss) done
1820 | Just summs <- Map.lookup key done
1821 = if isSingleton summs then
1822 loop ss done
1823 else
1824 do { multiRootsErr dflags (rights summs); return [] }
1825 | otherwise
1826 = do mb_s <- summariseModule hsc_env old_summary_map
1827 is_boot wanted_mod True
1828 Nothing excl_mods
1829 case mb_s of
1830 Nothing -> loop ss done
1831 Just (Left e) -> loop ss (Map.insert key [Left e] done)
1832 Just (Right s)-> loop (calcDeps s ++ ss)
1833 (Map.insert key [Right s] done)
1834 where
1835 key = (unLoc wanted_mod, is_boot)
1836
1837 mkRootMap :: [ModSummary] -> NodeMap [Either ErrMsg ModSummary]
1838 mkRootMap summaries = Map.insertListWith (flip (++))
1839 [ (msKey s, [Right s]) | s <- summaries ]
1840 Map.empty
1841
1842 -- | Returns the dependencies of the ModSummary s.
1843 -- A wrinkle is that for a {-# SOURCE #-} import we return
1844 -- *both* the hs-boot file
1845 -- *and* the source file
1846 -- as "dependencies". That ensures that the list of all relevant
1847 -- modules always contains B.hs if it contains B.hs-boot.
1848 -- Remember, this pass isn't doing the topological sort. It's
1849 -- just gathering the list of all relevant ModSummaries
1850 msDeps :: ModSummary -> [(Located ModuleName, IsBoot)]
1851 msDeps s =
1852 concat [ [(m,IsBoot), (m,NotBoot)] | m <- ms_home_srcimps s ]
1853 ++ [ (m,NotBoot) | m <- ms_home_imps s ]
1854
1855 home_imps :: [(Maybe FastString, Located ModuleName)] -> [Located ModuleName]
1856 home_imps imps = [ lmodname | (mb_pkg, lmodname) <- imps,
1857 isLocal mb_pkg ]
1858 where isLocal Nothing = True
1859 isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special
1860 isLocal _ = False
1861
1862 ms_home_allimps :: ModSummary -> [ModuleName]
1863 ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
1864
1865 -- | Like 'ms_home_imps', but for SOURCE imports.
1866 ms_home_srcimps :: ModSummary -> [Located ModuleName]
1867 ms_home_srcimps = home_imps . ms_srcimps
1868
1869 -- | All of the (possibly) home module imports from a
1870 -- 'ModSummary'; that is to say, each of these module names
1871 -- could be a home import if an appropriately named file
1872 -- existed. (This is in contrast to package qualified
1873 -- imports, which are guaranteed not to be home imports.)
1874 ms_home_imps :: ModSummary -> [Located ModuleName]
1875 ms_home_imps = home_imps . ms_imps
1876
1877 -----------------------------------------------------------------------------
1878 -- Summarising modules
1879
1880 -- We have two types of summarisation:
1881 --
1882 -- * Summarise a file. This is used for the root module(s) passed to
1883 -- cmLoadModules. The file is read, and used to determine the root
1884 -- module name. The module name may differ from the filename.
1885 --
1886 -- * Summarise a module. We are given a module name, and must provide
1887 -- a summary. The finder is used to locate the file in which the module
1888 -- resides.
1889
1890 summariseFile
1891 :: HscEnv
1892 -> [ModSummary] -- old summaries
1893 -> FilePath -- source file name
1894 -> Maybe Phase -- start phase
1895 -> Bool -- object code allowed?
1896 -> Maybe (StringBuffer,UTCTime)
1897 -> IO ModSummary
1898
1899 summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
1900 -- we can use a cached summary if one is available and the
1901 -- source file hasn't changed, But we have to look up the summary
1902 -- by source file, rather than module name as we do in summarise.
1903 | Just old_summary <- findSummaryBySourceFile old_summaries file
1904 = do
1905 let location = ms_location old_summary
1906 dflags = hsc_dflags hsc_env
1907
1908 src_timestamp <- get_src_timestamp
1909 -- The file exists; we checked in getRootSummary above.
1910 -- If it gets removed subsequently, then this
1911 -- getModificationUTCTime may fail, but that's the right
1912 -- behaviour.
1913
1914 -- return the cached summary if the source didn't change
1915 if ms_hs_date old_summary == src_timestamp &&
1916 not (gopt Opt_ForceRecomp (hsc_dflags hsc_env))
1917 then do -- update the object-file timestamp
1918 obj_timestamp <-
1919 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1920 || obj_allowed -- bug #1205
1921 then liftIO $ getObjTimestamp location NotBoot
1922 else return Nothing
1923 hi_timestamp <- maybeGetIfaceDate dflags location
1924
1925 -- We have to repopulate the Finder's cache because it
1926 -- was flushed before the downsweep.
1927 _ <- liftIO $ addHomeModuleToFinder hsc_env
1928 (moduleName (ms_mod old_summary)) (ms_location old_summary)
1929
1930 return old_summary{ ms_obj_date = obj_timestamp
1931 , ms_iface_date = hi_timestamp }
1932 else
1933 new_summary src_timestamp
1934
1935 | otherwise
1936 = do src_timestamp <- get_src_timestamp
1937 new_summary src_timestamp
1938 where
1939 get_src_timestamp = case maybe_buf of
1940 Just (_,t) -> return t
1941 Nothing -> liftIO $ getModificationUTCTime file
1942 -- getModificationUTCTime may fail
1943
1944 new_summary src_timestamp = do
1945 let dflags = hsc_dflags hsc_env
1946
1947 let hsc_src = if isHaskellSigFilename file then HsigFile else HsSrcFile
1948
1949 (dflags', hspp_fn, buf)
1950 <- preprocessFile hsc_env file mb_phase maybe_buf
1951
1952 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
1953
1954 -- Make a ModLocation for this file
1955 location <- liftIO $ mkHomeModLocation dflags mod_name file
1956
1957 -- Tell the Finder cache where it is, so that subsequent calls
1958 -- to findModule will find it, even if it's not on any search path
1959 mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location
1960
1961 -- when the user asks to load a source file by name, we only
1962 -- use an object file if -fobject-code is on. See #1205.
1963 obj_timestamp <-
1964 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1965 || obj_allowed -- bug #1205
1966 then liftIO $ modificationTimeIfExists (ml_obj_file location)
1967 else return Nothing
1968
1969 hi_timestamp <- maybeGetIfaceDate dflags location
1970
1971 extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name
1972 required_by_imports <- implicitRequirements hsc_env the_imps
1973
1974 return (ModSummary { ms_mod = mod,
1975 ms_hsc_src = hsc_src,
1976 ms_location = location,
1977 ms_hspp_file = hspp_fn,
1978 ms_hspp_opts = dflags',
1979 ms_hspp_buf = Just buf,
1980 ms_parsed_mod = Nothing,
1981 ms_srcimps = srcimps,
1982 ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports,
1983 ms_hs_date = src_timestamp,
1984 ms_iface_date = hi_timestamp,
1985 ms_obj_date = obj_timestamp })
1986
1987 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
1988 findSummaryBySourceFile summaries file
1989 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
1990 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
1991 [] -> Nothing
1992 (x:_) -> Just x
1993
1994 -- Summarise a module, and pick up source and timestamp.
1995 summariseModule
1996 :: HscEnv
1997 -> NodeMap ModSummary -- Map of old summaries
1998 -> IsBoot -- IsBoot <=> a {-# SOURCE #-} import
1999 -> Located ModuleName -- Imported module to be summarised
2000 -> Bool -- object code allowed?
2001 -> Maybe (StringBuffer, UTCTime)
2002 -> [ModuleName] -- Modules to exclude
2003 -> IO (Maybe (Either ErrMsg ModSummary)) -- Its new summary
2004
2005 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
2006 obj_allowed maybe_buf excl_mods
2007 | wanted_mod `elem` excl_mods
2008 = return Nothing
2009
2010 | Just old_summary <- Map.lookup (wanted_mod, is_boot) old_summary_map
2011 = do -- Find its new timestamp; all the
2012 -- ModSummaries in the old map have valid ml_hs_files
2013 let location = ms_location old_summary
2014 src_fn = expectJust "summariseModule" (ml_hs_file location)
2015
2016 -- check the modification time on the source file, and
2017 -- return the cached summary if it hasn't changed. If the
2018 -- file has disappeared, we need to call the Finder again.
2019 case maybe_buf of
2020 Just (_,t) -> check_timestamp old_summary location src_fn t
2021 Nothing -> do
2022 m <- tryIO (getModificationUTCTime src_fn)
2023 case m of
2024 Right t -> check_timestamp old_summary location src_fn t
2025 Left e | isDoesNotExistError e -> find_it
2026 | otherwise -> ioError e
2027
2028 | otherwise = find_it
2029 where
2030 dflags = hsc_dflags hsc_env
2031
2032 check_timestamp old_summary location src_fn src_timestamp
2033 | ms_hs_date old_summary == src_timestamp &&
2034 not (gopt Opt_ForceRecomp dflags) = do
2035 -- update the object-file timestamp
2036 obj_timestamp <-
2037 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2038 || obj_allowed -- bug #1205
2039 then getObjTimestamp location is_boot
2040 else return Nothing
2041 hi_timestamp <- maybeGetIfaceDate dflags location
2042 return (Just (Right old_summary{ ms_obj_date = obj_timestamp
2043 , ms_iface_date = hi_timestamp}))
2044 | otherwise =
2045 -- source changed: re-summarise.
2046 new_summary location (ms_mod old_summary) src_fn src_timestamp
2047
2048 find_it = do
2049 found <- findImportedModule hsc_env wanted_mod Nothing
2050 case found of
2051 Found location mod
2052 | isJust (ml_hs_file location) ->
2053 -- Home package
2054 just_found location mod
2055
2056 _ -> return Nothing
2057 -- Not found
2058 -- (If it is TRULY not found at all, we'll
2059 -- error when we actually try to compile)
2060
2061 just_found location mod = do
2062 -- Adjust location to point to the hs-boot source file,
2063 -- hi file, object file, when is_boot says so
2064 let location' | IsBoot <- is_boot = addBootSuffixLocn location
2065 | otherwise = location
2066 src_fn = expectJust "summarise2" (ml_hs_file location')
2067
2068 -- Check that it exists
2069 -- It might have been deleted since the Finder last found it
2070 maybe_t <- modificationTimeIfExists src_fn
2071 case maybe_t of
2072 Nothing -> return $ Just $ Left $ noHsFileErr dflags loc src_fn
2073 Just t -> new_summary location' mod src_fn t
2074
2075
2076 new_summary location mod src_fn src_timestamp
2077 = do
2078 -- Preprocess the source file and get its imports
2079 -- The dflags' contains the OPTIONS pragmas
2080 (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
2081 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
2082
2083 -- NB: Despite the fact that is_boot is a top-level parameter, we
2084 -- don't actually know coming into this function what the HscSource
2085 -- of the module in question is. This is because we may be processing
2086 -- this module because another module in the graph imported it: in this
2087 -- case, we know if it's a boot or not because of the {-# SOURCE #-}
2088 -- annotation, but we don't know if it's a signature or a regular
2089 -- module until we actually look it up on the filesystem.
2090 let hsc_src = case is_boot of
2091 IsBoot -> HsBootFile
2092 _ | isHaskellSigFilename src_fn -> HsigFile
2093 | otherwise -> HsSrcFile
2094
2095 when (mod_name /= wanted_mod) $
2096 throwOneError $ mkPlainErrMsg dflags' mod_loc $
2097 text "File name does not match module name:"
2098 $$ text "Saw:" <+> quotes (ppr mod_name)
2099 $$ text "Expected:" <+> quotes (ppr wanted_mod)
2100
2101 when (hsc_src == HsigFile && isNothing (lookup mod_name (thisUnitIdInsts dflags))) $
2102 let suggested_instantiated_with =
2103 hcat (punctuate comma $
2104 [ ppr k <> text "=" <> ppr v
2105 | (k,v) <- ((mod_name, mkHoleModule mod_name)
2106 : thisUnitIdInsts dflags)
2107 ])
2108 in throwOneError $ mkPlainErrMsg dflags' mod_loc $
2109 text "Unexpected signature:" <+> quotes (ppr mod_name)
2110 $$ if gopt Opt_BuildingCabalPackage dflags
2111 then parens (text "Try adding" <+> quotes (ppr mod_name)
2112 <+> text "to the"
2113 <+> quotes (text "signatures")
2114 <+> text "field in your Cabal file.")
2115 else parens (text "Try passing -instantiated-with=\"" <>
2116 suggested_instantiated_with <> text "\"" $$
2117 text "replacing <" <> ppr mod_name <> text "> as necessary.")
2118
2119 -- Find the object timestamp, and return the summary
2120 obj_timestamp <-
2121 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2122 || obj_allowed -- bug #1205
2123 then getObjTimestamp location is_boot
2124 else return Nothing
2125
2126 hi_timestamp <- maybeGetIfaceDate dflags location
2127
2128 extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name
2129 required_by_imports <- implicitRequirements hsc_env the_imps
2130
2131 return (Just (Right (ModSummary { ms_mod = mod,
2132 ms_hsc_src = hsc_src,
2133 ms_location = location,
2134 ms_hspp_file = hspp_fn,
2135 ms_hspp_opts = dflags',
2136 ms_hspp_buf = Just buf,
2137 ms_parsed_mod = Nothing,
2138 ms_srcimps = srcimps,
2139 ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports,
2140 ms_hs_date = src_timestamp,
2141 ms_iface_date = hi_timestamp,
2142 ms_obj_date = obj_timestamp })))
2143
2144
2145 getObjTimestamp :: ModLocation -> IsBoot -> IO (Maybe UTCTime)
2146 getObjTimestamp location is_boot
2147 = if is_boot == IsBoot then return Nothing
2148 else modificationTimeIfExists (ml_obj_file location)
2149
2150
2151 preprocessFile :: HscEnv
2152 -> FilePath
2153 -> Maybe Phase -- ^ Starting phase
2154 -> Maybe (StringBuffer,UTCTime)
2155 -> IO (DynFlags, FilePath, StringBuffer)
2156 preprocessFile hsc_env src_fn mb_phase Nothing
2157 = do
2158 (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
2159 buf <- hGetStringBuffer hspp_fn
2160 return (dflags', hspp_fn, buf)
2161
2162 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
2163 = do
2164 let dflags = hsc_dflags hsc_env
2165 let local_opts = getOptions dflags buf src_fn
2166
2167 (dflags', leftovers, warns)
2168 <- parseDynamicFilePragma dflags local_opts
2169 checkProcessArgsResult dflags leftovers
2170 handleFlagWarnings dflags' warns
2171
2172 let needs_preprocessing
2173 | Just (Unlit _) <- mb_phase = True
2174 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
2175 -- note: local_opts is only required if there's no Unlit phase
2176 | xopt LangExt.Cpp dflags' = True
2177 | gopt Opt_Pp dflags' = True
2178 | otherwise = False
2179
2180 when needs_preprocessing $
2181 throwGhcExceptionIO (ProgramError "buffer needs preprocesing; interactive check disabled")
2182
2183 return (dflags', src_fn, buf)
2184
2185
2186 -----------------------------------------------------------------------------
2187 -- Error messages
2188 -----------------------------------------------------------------------------
2189
2190 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> ErrMsg
2191 -- ToDo: we don't have a proper line number for this error
2192 noModError dflags loc wanted_mod err
2193 = mkPlainErrMsg dflags loc $ cannotFindModule dflags wanted_mod err
2194
2195 noHsFileErr :: DynFlags -> SrcSpan -> String -> ErrMsg
2196 noHsFileErr dflags loc path
2197 = mkPlainErrMsg dflags loc $ text "Can't find" <+> text path
2198
2199 moduleNotFoundErr :: DynFlags -> ModuleName -> ErrMsg
2200 moduleNotFoundErr dflags mod
2201 = mkPlainErrMsg dflags noSrcSpan $
2202 text "module" <+> quotes (ppr mod) <+> text "cannot be found locally"
2203
2204 multiRootsErr :: DynFlags -> [ModSummary] -> IO ()
2205 multiRootsErr _ [] = panic "multiRootsErr"
2206 multiRootsErr dflags summs@(summ1:_)
2207 = throwOneError $ mkPlainErrMsg dflags noSrcSpan $
2208 text "module" <+> quotes (ppr mod) <+>
2209 text "is defined in multiple files:" <+>
2210 sep (map text files)
2211 where
2212 mod = ms_mod summ1
2213 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
2214
2215 cyclicModuleErr :: [ModSummary] -> SDoc
2216 -- From a strongly connected component we find
2217 -- a single cycle to report
2218 cyclicModuleErr mss
2219 = ASSERT( not (null mss) )
2220 case findCycle graph of
2221 Nothing -> text "Unexpected non-cycle" <+> ppr mss
2222 Just path -> vcat [ text "Module imports form a cycle:"
2223 , nest 2 (show_path path) ]
2224 where
2225 graph :: [Node NodeKey ModSummary]
2226 graph = [ DigraphNode ms (msKey ms) (get_deps ms) | ms <- mss]
2227
2228 get_deps :: ModSummary -> [NodeKey]
2229 get_deps ms = ([ (unLoc m, IsBoot) | m <- ms_home_srcimps ms ] ++
2230 [ (unLoc m, NotBoot) | m <- ms_home_imps ms ])
2231
2232 show_path [] = panic "show_path"
2233 show_path [m] = text "module" <+> ppr_ms m
2234 <+> text "imports itself"
2235 show_path (m1:m2:ms) = vcat ( nest 7 (text "module" <+> ppr_ms m1)
2236 : nest 6 (text "imports" <+> ppr_ms m2)
2237 : go ms )
2238 where
2239 go [] = [text "which imports" <+> ppr_ms m1]
2240 go (m:ms) = (text "which imports" <+> ppr_ms m) : go ms
2241
2242
2243 ppr_ms :: ModSummary -> SDoc
2244 ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+>
2245 (parens (text (msHsFilePath ms)))