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