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