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