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