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