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