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