1 -- -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow, 2011
5 -- This module implements multi-module compilation, and is used
8 -- -----------------------------------------------------------------------------
12 load, LoadHowMuch(..),
16 noModError, cyclicModuleErr
19 #include "HsVersions.h"
22 import qualified Linker ( unload )
32 import HsSyn hiding ((<.>))
35 import TcIface ( typecheckIface )
36 import TcRnMonad ( initIfaceCheck )
37 import RdrName ( RdrName )
39 import Exception ( evaluate, tryIO )
46 import Bag ( listToBag )
47 import Maybes ( expectJust, mapCatMaybes )
53 import qualified Data.Map as Map
54 import qualified FiniteMap as Map( insertListWith)
56 import System.Directory ( doesFileExist, getModificationTime )
57 import System.IO ( fixIO )
58 import System.IO.Error ( isDoesNotExistError )
59 import System.Time ( ClockTime )
60 import System.FilePath
64 import qualified Data.List as List
66 -- -----------------------------------------------------------------------------
67 -- Loading the program
69 -- | Perform a dependency analysis starting from the current targets
70 -- and update the session with the new module graph.
72 -- Dependency analysis entails parsing the @import@ directives and may
73 -- therefore require running certain preprocessors.
75 -- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.
76 -- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the
77 -- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module. Thus if you want to
78 -- changes to the 'DynFlags' to take effect you need to call this function
81 depanal :: GhcMonad m =>
82 [ModuleName] -- ^ excluded modules
83 -> Bool -- ^ allow duplicate roots
85 depanal excluded_mods allow_dup_roots = do
88 dflags = hsc_dflags hsc_env
89 targets = hsc_targets hsc_env
90 old_graph = hsc_mod_graph hsc_env
92 liftIO $ showPass dflags "Chasing dependencies"
93 liftIO $ debugTraceMsg dflags 2 (hcat [
94 text "Chasing modules from: ",
95 hcat (punctuate comma (map pprTarget targets))])
97 mod_graph <- liftIO $ downsweep hsc_env old_graph excluded_mods allow_dup_roots
98 modifySession $ \_ -> hsc_env { hsc_mod_graph = mod_graph }
101 -- | Describes which modules of the module graph need to be loaded.
104 -- ^ Load all targets and its dependencies.
105 | LoadUpTo ModuleName
106 -- ^ Load only the given module and its dependencies.
107 | LoadDependenciesOf ModuleName
108 -- ^ Load only the dependencies of the given module, but not the module
111 -- | Try to load the program. See 'LoadHowMuch' for the different modes.
113 -- This function implements the core of GHC's @--make@ mode. It preprocesses,
114 -- compiles and loads the specified modules, avoiding re-compilation wherever
115 -- possible. Depending on the target (see 'DynFlags.hscTarget') compilating
116 -- and loading may result in files being created on disk.
118 -- Calls the 'reportModuleCompilationResult' callback after each compiling
119 -- each module, whether successful or not.
121 -- Throw a 'SourceError' if errors are encountered before the actual
122 -- compilation starts (e.g., during dependency analysis). All other errors
123 -- are reported using the callback.
125 load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
127 mod_graph <- depanal [] False
128 load2 how_much mod_graph
130 load2 :: GhcMonad m => LoadHowMuch -> [ModSummary]
132 load2 how_much mod_graph = do
134 hsc_env <- getSession
136 let hpt1 = hsc_HPT hsc_env
137 let dflags = hsc_dflags hsc_env
139 -- The "bad" boot modules are the ones for which we have
140 -- B.hs-boot in the module graph, but no B.hs
141 -- The downsweep should have ensured this does not happen
143 let all_home_mods = [ms_mod_name s
144 | s <- mod_graph, not (isBootSummary s)]
145 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
146 not (ms_mod_name s `elem` all_home_mods)]
147 ASSERT( null bad_boot_mods ) return ()
149 -- check that the module given in HowMuch actually exists, otherwise
150 -- topSortModuleGraph will bomb later.
151 let checkHowMuch (LoadUpTo m) = checkMod m
152 checkHowMuch (LoadDependenciesOf m) = checkMod m
156 | m `elem` all_home_mods = and_then
158 liftIO $ errorMsg dflags (text "no such module:" <+>
162 checkHowMuch how_much $ do
164 -- mg2_with_srcimps drops the hi-boot nodes, returning a
165 -- graph with cycles. Among other things, it is used for
166 -- backing out partially complete cycles following a failed
167 -- upsweep, and for removing from hpt all the modules
168 -- not in strict downwards closure, during calls to compile.
169 let mg2_with_srcimps :: [SCC ModSummary]
170 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
172 -- If we can determine that any of the {-# SOURCE #-} imports
173 -- are definitely unnecessary, then emit a warning.
174 warnUnnecessarySourceImports mg2_with_srcimps
177 -- check the stability property for each module.
178 stable_mods@(stable_obj,stable_bco)
179 = checkStability hpt1 mg2_with_srcimps all_home_mods
181 -- prune bits of the HPT which are definitely redundant now,
183 pruned_hpt = pruneHomePackageTable hpt1
184 (flattenSCCs mg2_with_srcimps)
187 _ <- liftIO $ evaluate pruned_hpt
189 -- before we unload anything, make sure we don't leave an old
190 -- interactive context around pointing to dead bindings. Also,
191 -- write the pruned HPT to allow the old HPT to be GC'd.
192 modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext,
193 hsc_HPT = pruned_hpt }
195 liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
196 text "Stable BCO:" <+> ppr stable_bco)
198 -- Unload any modules which are going to be re-linked this time around.
199 let stable_linkables = [ linkable
200 | m <- stable_obj++stable_bco,
201 Just hmi <- [lookupUFM pruned_hpt m],
202 Just linkable <- [hm_linkable hmi] ]
203 liftIO $ unload hsc_env stable_linkables
205 -- We could at this point detect cycles which aren't broken by
206 -- a source-import, and complain immediately, but it seems better
207 -- to let upsweep_mods do this, so at least some useful work gets
208 -- done before the upsweep is abandoned.
209 --hPutStrLn stderr "after tsort:\n"
210 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
212 -- Now do the upsweep, calling compile for each module in
213 -- turn. Final result is version 3 of everything.
215 -- Topologically sort the module graph, this time including hi-boot
216 -- nodes, and possibly just including the portion of the graph
217 -- reachable from the module specified in the 2nd argument to load.
218 -- This graph should be cycle-free.
219 -- If we're restricting the upsweep to a portion of the graph, we
220 -- also want to retain everything that is still stable.
221 let full_mg :: [SCC ModSummary]
222 full_mg = topSortModuleGraph False mod_graph Nothing
224 maybe_top_mod = case how_much of
226 LoadDependenciesOf m -> Just m
229 partial_mg0 :: [SCC ModSummary]
230 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
232 -- LoadDependenciesOf m: we want the upsweep to stop just
233 -- short of the specified module (unless the specified module
236 | LoadDependenciesOf _mod <- how_much
237 = ASSERT( case last partial_mg0 of
238 AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
239 List.init partial_mg0
245 | AcyclicSCC ms <- full_mg,
246 ms_mod_name ms `elem` stable_obj++stable_bco,
247 ms_mod_name ms `notElem` [ ms_mod_name ms' |
248 AcyclicSCC ms' <- partial_mg ] ]
250 mg = stable_mg ++ partial_mg
252 -- clean up between compilations
253 let cleanup = cleanTempFilesExcept dflags
254 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
256 liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
259 setSession hsc_env{ hsc_HPT = emptyHomePackageTable }
260 (upsweep_ok, modsUpswept)
261 <- upsweep pruned_hpt stable_mods cleanup mg
263 -- Make modsDone be the summaries for each home module now
264 -- available; this should equal the domain of hpt3.
265 -- Get in in a roughly top .. bottom order (hence reverse).
267 let modsDone = reverse modsUpswept
269 -- Try and do linking in some form, depending on whether the
270 -- upsweep was completely or only partially successful.
272 if succeeded upsweep_ok
275 -- Easy; just relink it all.
276 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep completely successful.")
278 -- Clean up after ourselves
279 liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
281 -- Issue a warning for the confusing case where the user
282 -- said '-o foo' but we're not going to do any linking.
283 -- We attempt linking if either (a) one of the modules is
284 -- called Main, or (b) the user said -no-hs-main, indicating
285 -- that main() is going to come from somewhere else.
287 let ofile = outputFile dflags
288 let no_hs_main = dopt Opt_NoHsMain dflags
290 main_mod = mainModIs dflags
291 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
292 do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib
294 when (ghcLink dflags == LinkBinary
295 && isJust ofile && not do_linking) $
296 liftIO $ debugTraceMsg dflags 1 $
297 text ("Warning: output was redirected with -o, " ++
298 "but no output will be generated\n" ++
299 "because there is no " ++
300 moduleNameString (moduleName main_mod) ++ " module.")
302 -- link everything together
303 hsc_env1 <- getSession
304 linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
306 loadFinish Succeeded linkresult
309 -- Tricky. We need to back out the effects of compiling any
310 -- half-done cycles, both so as to clean up the top level envs
311 -- and to avoid telling the interactive linker to link them.
312 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep partially successful.")
315 = map ms_mod modsDone
316 let mods_to_zap_names
317 = findPartiallyCompletedCycles modsDone_names
320 = filter ((`notElem` mods_to_zap_names).ms_mod)
323 hsc_env1 <- getSession
324 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
327 -- Clean up after ourselves
328 liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
330 -- there should be no Nothings where linkables should be, now
331 ASSERT(all (isJust.hm_linkable)
332 (eltsUFM (hsc_HPT hsc_env))) do
334 -- Link everything together
335 linkresult <- liftIO $ link (ghcLink dflags) dflags False hpt4
337 modifySession $ \hsc_env -> hsc_env{ hsc_HPT = hpt4 }
338 loadFinish Failed linkresult
340 -- Finish up after a load.
342 -- If the link failed, unload everything and return.
343 loadFinish :: GhcMonad m =>
344 SuccessFlag -> SuccessFlag
346 loadFinish _all_ok Failed
347 = do hsc_env <- getSession
348 liftIO $ unload hsc_env []
349 modifySession discardProg
352 -- Empty the interactive context and set the module context to the topmost
353 -- newly loaded module, or the Prelude if none were loaded.
354 loadFinish all_ok Succeeded
355 = do modifySession $ \hsc_env -> hsc_env{ hsc_IC = emptyInteractiveContext }
359 -- Forget the current program, but retain the persistent info in HscEnv
360 discardProg :: HscEnv -> HscEnv
362 = hsc_env { hsc_mod_graph = emptyMG,
363 hsc_IC = emptyInteractiveContext,
364 hsc_HPT = emptyHomePackageTable }
366 -- used to fish out the preprocess output files for the purposes of
367 -- cleaning up. The preprocessed file *might* be the same as the
368 -- source file, but that doesn't do any harm.
369 ppFilesFromSummaries :: [ModSummary] -> [FilePath]
370 ppFilesFromSummaries summaries = map ms_hspp_file summaries
372 -- | If there is no -o option, guess the name of target executable
373 -- by using top-level source file name as a base.
374 guessOutputFile :: GhcMonad m => m ()
375 guessOutputFile = modifySession $ \env ->
376 let dflags = hsc_dflags env
377 mod_graph = hsc_mod_graph env
378 mainModuleSrcPath :: Maybe String
379 mainModuleSrcPath = do
380 let isMain = (== mainModIs dflags) . ms_mod
381 [ms] <- return (filter isMain mod_graph)
382 ml_hs_file (ms_location ms)
383 name = fmap dropExtension mainModuleSrcPath
385 #if defined(mingw32_HOST_OS)
386 -- we must add the .exe extention unconditionally here, otherwise
387 -- when name has an extension of its own, the .exe extension will
388 -- not be added by DriverPipeline.exeFileName. See #2248
389 name_exe = fmap (<.> "exe") name
394 case outputFile dflags of
396 Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } }
398 -- -----------------------------------------------------------------------------
400 -- | Prune the HomePackageTable
402 -- Before doing an upsweep, we can throw away:
404 -- - For non-stable modules:
405 -- - all ModDetails, all linked code
406 -- - all unlinked code that is out of date with respect to
409 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
410 -- space at the end of the upsweep, because the topmost ModDetails of the
411 -- old HPT holds on to the entire type environment from the previous
414 pruneHomePackageTable
417 -> ([ModuleName],[ModuleName])
420 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
423 | is_stable modl = hmi'
424 | otherwise = hmi'{ hm_details = emptyModDetails }
426 modl = moduleName (mi_module (hm_iface hmi))
427 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
428 = hmi{ hm_linkable = Nothing }
431 where ms = expectJust "prune" (lookupUFM ms_map modl)
433 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
435 is_stable m = m `elem` stable_obj || m `elem` stable_bco
437 -- -----------------------------------------------------------------------------
439 -- Return (names of) all those in modsDone who are part of a cycle
440 -- as defined by theGraph.
441 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
442 findPartiallyCompletedCycles modsDone theGraph
446 chew ((AcyclicSCC _):rest) = chew rest -- acyclic? not interesting.
447 chew ((CyclicSCC vs):rest)
448 = let names_in_this_cycle = nub (map ms_mod vs)
450 = nub ([done | done <- modsDone,
451 done `elem` names_in_this_cycle])
452 chewed_rest = chew rest
454 if notNull mods_in_this_cycle
455 && length mods_in_this_cycle < length names_in_this_cycle
456 then mods_in_this_cycle ++ chewed_rest
460 -- ---------------------------------------------------------------------------
463 unload :: HscEnv -> [Linkable] -> IO ()
464 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
465 = case ghcLink (hsc_dflags hsc_env) of
467 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
469 LinkInMemory -> panic "unload: no interpreter"
470 -- urgh. avoid warnings:
471 hsc_env stable_linkables
475 -- -----------------------------------------------------------------------------
479 Stability tells us which modules definitely do not need to be recompiled.
480 There are two main reasons for having stability:
482 - avoid doing a complete upsweep of the module graph in GHCi when
483 modules near the bottom of the tree have not changed.
485 - to tell GHCi when it can load object code: we can only load object code
486 for a module when we also load object code fo all of the imports of the
487 module. So we need to know that we will definitely not be recompiling
488 any of these modules, and we can use the object code.
490 The stability check is as follows. Both stableObject and
491 stableBCO are used during the upsweep phase later.
494 stable m = stableObject m || stableBCO m
497 all stableObject (imports m)
498 && old linkable does not exist, or is == on-disk .o
499 && date(on-disk .o) > date(.hs)
502 all stable (imports m)
503 && date(BCO) > date(.hs)
506 These properties embody the following ideas:
508 - if a module is stable, then:
510 - if it has been compiled in a previous pass (present in HPT)
511 then it does not need to be compiled or re-linked.
513 - if it has not been compiled in a previous pass,
514 then we only need to read its .hi file from disk and
515 link it to produce a 'ModDetails'.
517 - if a modules is not stable, we will definitely be at least
518 re-linking, and possibly re-compiling it during the 'upsweep'.
519 All non-stable modules can (and should) therefore be unlinked
520 before the 'upsweep'.
522 - Note that objects are only considered stable if they only depend
523 on other objects. We can't link object code against byte code.
527 :: HomePackageTable -- HPT from last compilation
528 -> [SCC ModSummary] -- current module graph (cyclic)
529 -> [ModuleName] -- all home modules
530 -> ([ModuleName], -- stableObject
531 [ModuleName]) -- stableBCO
533 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
535 checkSCC (stable_obj, stable_bco) scc0
536 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
537 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
538 | otherwise = (stable_obj, stable_bco)
540 scc = flattenSCC scc0
541 scc_mods = map ms_mod_name scc
542 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
544 scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))
545 -- all imports outside the current SCC, but in the home pkg
547 stable_obj_imps = map (`elem` stable_obj) scc_allimps
548 stable_bco_imps = map (`elem` stable_bco) scc_allimps
555 and (zipWith (||) stable_obj_imps stable_bco_imps)
559 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
563 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
564 Just hmi | Just l <- hm_linkable hmi
565 -> isObjectLinkable l && t == linkableTime l
567 -- why '>=' rather than '>' above? If the filesystem stores
568 -- times to the nearset second, we may occasionally find that
569 -- the object & source have the same modification time,
570 -- especially if the source was automatically generated
571 -- and compiled. Using >= is slightly unsafe, but it matches
575 = case lookupUFM hpt (ms_mod_name ms) of
576 Just hmi | Just l <- hm_linkable hmi ->
577 not (isObjectLinkable l) &&
578 linkableTime l >= ms_hs_date ms
581 -- -----------------------------------------------------------------------------
585 -- This is where we compile each module in the module graph, in a pass
586 -- from the bottom to the top of the graph.
588 -- There better had not be any cyclic groups here -- we check for them.
592 => HomePackageTable -- ^ HPT from last time round (pruned)
593 -> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability)
594 -> IO () -- ^ How to clean up unwanted tmp files
595 -> [SCC ModSummary] -- ^ Mods to do (the worklist)
600 -- 1. A flag whether the complete upsweep was successful.
601 -- 2. The 'HscEnv' in the monad has an updated HPT
602 -- 3. A list of modules which succeeded loading.
604 upsweep old_hpt stable_mods cleanup sccs = do
605 (res, done) <- upsweep' old_hpt [] sccs 1 (length sccs)
606 return (res, reverse done)
609 upsweep' _old_hpt done
611 = return (Succeeded, done)
613 upsweep' _old_hpt done
615 = do dflags <- getSessionDynFlags
616 liftIO $ fatalErrorMsg dflags (cyclicModuleErr ms)
617 return (Failed, done)
619 upsweep' old_hpt done
620 (AcyclicSCC mod:mods) mod_index nmods
621 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
622 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
623 -- (moduleEnvElts (hsc_HPT hsc_env)))
624 let logger _mod = defaultWarnErrLogger
626 hsc_env <- getSession
629 (\err -> do logger mod (Just err); return Nothing) $ do
630 mod_info <- liftIO $ upsweep_mod hsc_env old_hpt stable_mods
632 logger mod Nothing -- log warnings
633 return (Just mod_info)
635 liftIO cleanup -- Remove unwanted tmp files between compilations
638 Nothing -> return (Failed, done)
640 let this_mod = ms_mod_name mod
642 -- Add new info to hsc_env
643 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
644 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
646 -- Space-saving: delete the old HPT entry
647 -- for mod BUT if mod is a hs-boot
648 -- node, don't delete it. For the
649 -- interface, the HPT entry is probaby for the
650 -- main Haskell source file. Deleting it
651 -- would force the real module to be recompiled
653 old_hpt1 | isBootSummary mod = old_hpt
654 | otherwise = delFromUFM old_hpt this_mod
658 -- fixup our HomePackageTable after we've finished compiling
659 -- a mutually-recursive loop. See reTypecheckLoop, below.
660 hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done'
663 upsweep' old_hpt1 done' mods (mod_index+1) nmods
665 -- | Compile a single module. Always produce a Linkable for it if
666 -- successful. If no compilation happened, return the old Linkable.
667 upsweep_mod :: HscEnv
669 -> ([ModuleName],[ModuleName])
671 -> Int -- index of module
672 -> Int -- total number of modules
675 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
677 this_mod_name = ms_mod_name summary
678 this_mod = ms_mod summary
679 mb_obj_date = ms_obj_date summary
680 obj_fn = ml_obj_file (ms_location summary)
681 hs_date = ms_hs_date summary
683 is_stable_obj = this_mod_name `elem` stable_obj
684 is_stable_bco = this_mod_name `elem` stable_bco
686 old_hmi = lookupUFM old_hpt this_mod_name
688 -- We're using the dflags for this module now, obtained by
689 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
690 dflags = ms_hspp_opts summary
691 prevailing_target = hscTarget (hsc_dflags hsc_env)
692 local_target = hscTarget dflags
694 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
695 -- we don't do anything dodgy: these should only work to change
696 -- from -fvia-C to -fasm and vice-versa, otherwise we could
697 -- end up trying to link object code to byte code.
698 target = if prevailing_target /= local_target
699 && (not (isObjectTarget prevailing_target)
700 || not (isObjectTarget local_target))
701 then prevailing_target
704 -- store the corrected hscTarget into the summary
705 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
707 -- The old interface is ok if
708 -- a) we're compiling a source file, and the old HPT
709 -- entry is for a source file
710 -- b) we're compiling a hs-boot file
711 -- Case (b) allows an hs-boot file to get the interface of its
712 -- real source file on the second iteration of the compilation
713 -- manager, but that does no harm. Otherwise the hs-boot file
714 -- will always be recompiled
719 Just hm_info | isBootSummary summary -> Just iface
720 | not (mi_boot iface) -> Just iface
721 | otherwise -> Nothing
723 iface = hm_iface hm_info
725 compile_it :: Maybe Linkable -> IO HomeModInfo
726 compile_it mb_linkable =
727 compile hsc_env summary' mod_index nmods
728 mb_old_iface mb_linkable
730 compile_it_discard_iface :: Maybe Linkable -> IO HomeModInfo
731 compile_it_discard_iface mb_linkable =
732 compile hsc_env summary' mod_index nmods
735 -- With the HscNothing target we create empty linkables to avoid
736 -- recompilation. We have to detect these to recompile anyway if
737 -- the target changed since the last compile.
739 | Just hmi <- old_hmi, Just l <- hm_linkable hmi =
740 null (linkableUnlinked l)
742 -- we have no linkable, so it cannot be fake
745 implies False _ = True
751 -- Regardless of whether we're generating object code or
752 -- byte code, we can always use an existing object file
753 -- if it is *stable* (see checkStability).
754 | is_stable_obj, Just hmi <- old_hmi -> do
755 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
756 (text "skipping stable obj mod:" <+> ppr this_mod_name)
758 -- object is stable, and we have an entry in the
759 -- old HPT: nothing to do
761 | is_stable_obj, isNothing old_hmi -> do
762 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
763 (text "compiling stable on-disk mod:" <+> ppr this_mod_name)
764 linkable <- liftIO $ findObjectLinkable this_mod obj_fn
765 (expectJust "upsweep1" mb_obj_date)
766 compile_it (Just linkable)
767 -- object is stable, but we need to load the interface
768 -- off disk to make a HMI.
770 | not (isObjectTarget target), is_stable_bco,
771 (target /= HscNothing) `implies` not is_fake_linkable ->
772 ASSERT(isJust old_hmi) -- must be in the old_hpt
773 let Just hmi = old_hmi in do
774 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
775 (text "skipping stable BCO mod:" <+> ppr this_mod_name)
777 -- BCO is stable: nothing to do
779 | not (isObjectTarget target),
781 Just l <- hm_linkable hmi,
782 not (isObjectLinkable l),
783 (target /= HscNothing) `implies` not is_fake_linkable,
784 linkableTime l >= ms_hs_date summary -> do
785 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
786 (text "compiling non-stable BCO mod:" <+> ppr this_mod_name)
788 -- we have an old BCO that is up to date with respect
789 -- to the source: do a recompilation check as normal.
791 -- When generating object code, if there's an up-to-date
792 -- object file on the disk, then we can use it.
793 -- However, if the object file is new (compared to any
794 -- linkable we had from a previous compilation), then we
795 -- must discard any in-memory interface, because this
796 -- means the user has compiled the source file
797 -- separately and generated a new interface, that we must
798 -- read from the disk.
800 | isObjectTarget target,
801 Just obj_date <- mb_obj_date,
802 obj_date >= hs_date -> do
805 | Just l <- hm_linkable hmi,
806 isObjectLinkable l && linkableTime l == obj_date -> do
807 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
808 (text "compiling mod with new on-disk obj:" <+> ppr this_mod_name)
811 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
812 (text "compiling mod with new on-disk obj2:" <+> ppr this_mod_name)
813 linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date
814 compile_it_discard_iface (Just linkable)
817 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
818 (text "compiling mod:" <+> ppr this_mod_name)
823 -- Filter modules in the HPT
824 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
825 retainInTopLevelEnvs keep_these hpt
826 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
828 , let mb_mod_info = lookupUFM hpt mod
829 , isJust mb_mod_info ]
831 -- ---------------------------------------------------------------------------
832 -- Typecheck module loops
835 See bug #930. This code fixes a long-standing bug in --make. The
836 problem is that when compiling the modules *inside* a loop, a data
837 type that is only defined at the top of the loop looks opaque; but
838 after the loop is done, the structure of the data type becomes
841 The difficulty is then that two different bits of code have
842 different notions of what the data type looks like.
844 The idea is that after we compile a module which also has an .hs-boot
845 file, we re-generate the ModDetails for each of the modules that
846 depends on the .hs-boot file, so that everyone points to the proper
847 TyCons, Ids etc. defined by the real module, not the boot module.
848 Fortunately re-generating a ModDetails from a ModIface is easy: the
849 function TcIface.typecheckIface does exactly that.
851 Picking the modules to re-typecheck is slightly tricky. Starting from
852 the module graph consisting of the modules that have already been
853 compiled, we reverse the edges (so they point from the imported module
854 to the importing module), and depth-first-search from the .hs-boot
855 node. This gives us all the modules that depend transitively on the
856 .hs-boot module, and those are exactly the modules that we need to
859 Following this fix, GHC can compile itself with --make -O2.
862 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
863 reTypecheckLoop hsc_env ms graph
864 | not (isBootSummary ms) &&
865 any (\m -> ms_mod m == this_mod && isBootSummary m) graph
867 let mss = reachableBackwards (ms_mod_name ms) graph
868 non_boot = filter (not.isBootSummary) mss
869 debugTraceMsg (hsc_dflags hsc_env) 2 $
870 text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
871 typecheckLoop hsc_env (map ms_mod_name non_boot)
877 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
878 typecheckLoop hsc_env mods = do
880 fixIO $ \new_hpt -> do
881 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
882 mds <- initIfaceCheck new_hsc_env $
883 mapM (typecheckIface . hm_iface) hmis
884 let new_hpt = addListToUFM old_hpt
885 (zip mods [ hmi{ hm_details = details }
886 | (hmi,details) <- zip hmis mds ])
888 return hsc_env{ hsc_HPT = new_hpt }
890 old_hpt = hsc_HPT hsc_env
891 hmis = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
893 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
894 reachableBackwards mod summaries
895 = [ ms | (ms,_,_) <- reachableG (transposeG graph) root ]
896 where -- the rest just sets up the graph:
897 (graph, lookup_node) = moduleGraphNodes False summaries
898 root = expectJust "reachableBackwards" (lookup_node HsBootFile mod)
900 -- ---------------------------------------------------------------------------
901 -- Topological sort of the module graph
903 type SummaryNode = (ModSummary, Int, [Int])
907 -- ^ Drop hi-boot nodes? (see below)
910 -- ^ Root module name. If @Nothing@, use the full graph.
912 -- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
913 -- The resulting list of strongly-connected-components is in topologically
914 -- sorted order, starting with the module(s) at the bottom of the
915 -- dependency graph (ie compile them first) and ending with the ones at
918 -- Drop hi-boot nodes (first boolean arg)?
920 -- - @False@: treat the hi-boot summaries as nodes of the graph,
921 -- so the graph must be acyclic
923 -- - @True@: eliminate the hi-boot nodes, and instead pretend
924 -- the a source-import of Foo is an import of Foo
925 -- The resulting graph has no hi-boot nodes, but can be cyclic
927 topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
928 = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph
930 (graph, lookup_node) = moduleGraphNodes drop_hs_boot_nodes summaries
932 initial_graph = case mb_root_mod of
935 -- restrict the graph to just those modules reachable from
936 -- the specified module. We do this by building a graph with
937 -- the full set of nodes, and determining the reachable set from
938 -- the specified node.
939 let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
940 | otherwise = ghcError (ProgramError "module does not exist")
941 in graphFromEdgedVertices (seq root (reachableG graph root))
943 summaryNodeKey :: SummaryNode -> Int
944 summaryNodeKey (_, k, _) = k
946 summaryNodeSummary :: SummaryNode -> ModSummary
947 summaryNodeSummary (s, _, _) = s
949 moduleGraphNodes :: Bool -> [ModSummary]
950 -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
951 moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)
953 numbered_summaries = zip summaries [1..]
955 lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode
956 lookup_node hs_src mod = Map.lookup (mod, hs_src) node_map
958 lookup_key :: HscSource -> ModuleName -> Maybe Int
959 lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)
961 node_map :: NodeMap SummaryNode
962 node_map = Map.fromList [ ((moduleName (ms_mod s), ms_hsc_src s), node)
963 | node@(s, _, _) <- nodes ]
965 -- We use integers as the keys for the SCC algorithm
966 nodes :: [SummaryNode]
967 nodes = [ (s, key, out_keys)
968 | (s, key) <- numbered_summaries
969 -- Drop the hi-boot ones if told to do so
970 , not (isBootSummary s && drop_hs_boot_nodes)
971 , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
972 out_edge_keys HsSrcFile (map unLoc (ms_home_imps s)) ++
973 (-- see [boot-edges] below
974 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
976 else case lookup_key HsBootFile (ms_mod_name s) of
980 -- [boot-edges] if this is a .hs and there is an equivalent
981 -- .hs-boot, add a link from the former to the latter. This
982 -- has the effect of detecting bogus cases where the .hs-boot
983 -- depends on the .hs, by introducing a cycle. Additionally,
984 -- it ensures that we will always process the .hs-boot before
985 -- the .hs, and so the HomePackageTable will always have the
986 -- most up to date information.
988 -- Drop hs-boot nodes by using HsSrcFile as the key
989 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
990 | otherwise = HsBootFile
992 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
993 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
994 -- If we want keep_hi_boot_nodes, then we do lookup_key with
995 -- the IsBootInterface parameter True; else False
998 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
999 type NodeMap a = Map.Map NodeKey a -- keyed by (mod, src_file_type) pairs
1001 msKey :: ModSummary -> NodeKey
1002 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1004 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1005 mkNodeMap summaries = Map.fromList [ (msKey s, s) | s <- summaries]
1007 nodeMapElts :: NodeMap a -> [a]
1008 nodeMapElts = Map.elems
1010 -- | If there are {-# SOURCE #-} imports between strongly connected
1011 -- components in the topological sort, then those imports can
1012 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1013 -- were necessary, then the edge would be part of a cycle.
1014 warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()
1015 warnUnnecessarySourceImports sccs = do
1016 logWarnings (listToBag (concatMap (check.flattenSCC) sccs))
1018 let mods_in_this_cycle = map ms_mod_name ms in
1019 [ warn i | m <- ms, i <- ms_home_srcimps m,
1020 unLoc i `notElem` mods_in_this_cycle ]
1022 warn :: Located ModuleName -> WarnMsg
1025 (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
1026 <+> quotes (ppr mod))
1028 -----------------------------------------------------------------------------
1029 -- Downsweep (dependency analysis)
1031 -- Chase downwards from the specified root set, returning summaries
1032 -- for all home modules encountered. Only follow source-import
1035 -- We pass in the previous collection of summaries, which is used as a
1036 -- cache to avoid recalculating a module summary if the source is
1039 -- The returned list of [ModSummary] nodes has one node for each home-package
1040 -- module, plus one for any hs-boot files. The imports of these nodes
1041 -- are all there, including the imports of non-home-package modules.
1044 -> [ModSummary] -- Old summaries
1045 -> [ModuleName] -- Ignore dependencies on these; treat
1046 -- them as if they were package modules
1047 -> Bool -- True <=> allow multiple targets to have
1048 -- the same module name; this is
1049 -- very useful for ghc -M
1051 -- The elts of [ModSummary] all have distinct
1052 -- (Modules, IsBoot) identifiers, unless the Bool is true
1053 -- in which case there can be repeats
1054 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1056 rootSummaries <- mapM getRootSummary roots
1057 let root_map = mkRootMap rootSummaries
1058 checkDuplicates root_map
1059 summs <- loop (concatMap msDeps rootSummaries) root_map
1062 roots = hsc_targets hsc_env
1064 old_summary_map :: NodeMap ModSummary
1065 old_summary_map = mkNodeMap old_summaries
1067 getRootSummary :: Target -> IO ModSummary
1068 getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)
1069 = do exists <- liftIO $ doesFileExist file
1071 then summariseFile hsc_env old_summaries file mb_phase
1072 obj_allowed maybe_buf
1073 else throwOneError $ mkPlainErrMsg noSrcSpan $
1074 text "can't find file:" <+> text file
1075 getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
1076 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1077 (L rootLoc modl) obj_allowed
1079 case maybe_summary of
1080 Nothing -> packageModErr modl
1083 rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1085 -- In a root module, the filename is allowed to diverge from the module
1086 -- name, so we have to check that there aren't multiple root files
1087 -- defining the same module (otherwise the duplicates will be silently
1088 -- ignored, leading to confusing behaviour).
1089 checkDuplicates :: NodeMap [ModSummary] -> IO ()
1090 checkDuplicates root_map
1091 | allow_dup_roots = return ()
1092 | null dup_roots = return ()
1093 | otherwise = liftIO $ multiRootsErr (head dup_roots)
1095 dup_roots :: [[ModSummary]] -- Each at least of length 2
1096 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1098 loop :: [(Located ModuleName,IsBootInterface)]
1099 -- Work list: process these modules
1100 -> NodeMap [ModSummary]
1101 -- Visited set; the range is a list because
1102 -- the roots can have the same module names
1103 -- if allow_dup_roots is True
1105 -- The result includes the worklist, except
1106 -- for those mentioned in the visited set
1107 loop [] done = return (concat (nodeMapElts done))
1108 loop ((wanted_mod, is_boot) : ss) done
1109 | Just summs <- Map.lookup key done
1110 = if isSingleton summs then
1113 do { multiRootsErr summs; return [] }
1115 = do mb_s <- summariseModule hsc_env old_summary_map
1116 is_boot wanted_mod True
1119 Nothing -> loop ss done
1120 Just s -> loop (msDeps s ++ ss) (Map.insert key [s] done)
1122 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1124 -- XXX Does the (++) here need to be flipped?
1125 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1126 mkRootMap summaries = Map.insertListWith (flip (++))
1127 [ (msKey s, [s]) | s <- summaries ]
1130 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
1131 -- (msDeps s) returns the dependencies of the ModSummary s.
1132 -- A wrinkle is that for a {-# SOURCE #-} import we return
1133 -- *both* the hs-boot file
1134 -- *and* the source file
1135 -- as "dependencies". That ensures that the list of all relevant
1136 -- modules always contains B.hs if it contains B.hs-boot.
1137 -- Remember, this pass isn't doing the topological sort. It's
1138 -- just gathering the list of all relevant ModSummaries
1140 concat [ [(m,True), (m,False)] | m <- ms_home_srcimps s ]
1141 ++ [ (m,False) | m <- ms_home_imps s ]
1143 home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
1144 home_imps imps = [ ideclName i | L _ i <- imps, isLocal (ideclPkgQual i) ]
1145 where isLocal Nothing = True
1146 isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special
1149 ms_home_allimps :: ModSummary -> [ModuleName]
1150 ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
1152 ms_home_srcimps :: ModSummary -> [Located ModuleName]
1153 ms_home_srcimps = home_imps . ms_srcimps
1155 ms_home_imps :: ModSummary -> [Located ModuleName]
1156 ms_home_imps = home_imps . ms_imps
1158 -----------------------------------------------------------------------------
1159 -- Summarising modules
1161 -- We have two types of summarisation:
1163 -- * Summarise a file. This is used for the root module(s) passed to
1164 -- cmLoadModules. The file is read, and used to determine the root
1165 -- module name. The module name may differ from the filename.
1167 -- * Summarise a module. We are given a module name, and must provide
1168 -- a summary. The finder is used to locate the file in which the module
1173 -> [ModSummary] -- old summaries
1174 -> FilePath -- source file name
1175 -> Maybe Phase -- start phase
1176 -> Bool -- object code allowed?
1177 -> Maybe (StringBuffer,ClockTime)
1180 summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
1181 -- we can use a cached summary if one is available and the
1182 -- source file hasn't changed, But we have to look up the summary
1183 -- by source file, rather than module name as we do in summarise.
1184 | Just old_summary <- findSummaryBySourceFile old_summaries file
1186 let location = ms_location old_summary
1188 -- return the cached summary if the source didn't change
1189 src_timestamp <- case maybe_buf of
1190 Just (_,t) -> return t
1191 Nothing -> liftIO $ getModificationTime file
1192 -- The file exists; we checked in getRootSummary above.
1193 -- If it gets removed subsequently, then this
1194 -- getModificationTime may fail, but that's the right
1197 if ms_hs_date old_summary == src_timestamp
1198 then do -- update the object-file timestamp
1200 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1201 || obj_allowed -- bug #1205
1202 then liftIO $ getObjTimestamp location False
1204 return old_summary{ ms_obj_date = obj_timestamp }
1212 let dflags = hsc_dflags hsc_env
1214 (dflags', hspp_fn, buf)
1215 <- preprocessFile hsc_env file mb_phase maybe_buf
1217 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
1219 -- Make a ModLocation for this file
1220 location <- liftIO $ mkHomeModLocation dflags mod_name file
1222 -- Tell the Finder cache where it is, so that subsequent calls
1223 -- to findModule will find it, even if it's not on any search path
1224 mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location
1226 src_timestamp <- case maybe_buf of
1227 Just (_,t) -> return t
1228 Nothing -> liftIO $ getModificationTime file
1229 -- getMofificationTime may fail
1231 -- when the user asks to load a source file by name, we only
1232 -- use an object file if -fobject-code is on. See #1205.
1234 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1235 || obj_allowed -- bug #1205
1236 then liftIO $ modificationTimeIfExists (ml_obj_file location)
1239 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1240 ms_location = location,
1241 ms_hspp_file = hspp_fn,
1242 ms_hspp_opts = dflags',
1243 ms_hspp_buf = Just buf,
1244 ms_srcimps = srcimps, ms_imps = the_imps,
1245 ms_hs_date = src_timestamp,
1246 ms_obj_date = obj_timestamp })
1248 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
1249 findSummaryBySourceFile summaries file
1250 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
1251 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
1255 -- Summarise a module, and pick up source and timestamp.
1258 -> NodeMap ModSummary -- Map of old summaries
1259 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
1260 -> Located ModuleName -- Imported module to be summarised
1261 -> Bool -- object code allowed?
1262 -> Maybe (StringBuffer, ClockTime)
1263 -> [ModuleName] -- Modules to exclude
1264 -> IO (Maybe ModSummary) -- Its new summary
1266 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
1267 obj_allowed maybe_buf excl_mods
1268 | wanted_mod `elem` excl_mods
1271 | Just old_summary <- Map.lookup (wanted_mod, hsc_src) old_summary_map
1272 = do -- Find its new timestamp; all the
1273 -- ModSummaries in the old map have valid ml_hs_files
1274 let location = ms_location old_summary
1275 src_fn = expectJust "summariseModule" (ml_hs_file location)
1277 -- check the modification time on the source file, and
1278 -- return the cached summary if it hasn't changed. If the
1279 -- file has disappeared, we need to call the Finder again.
1281 Just (_,t) -> check_timestamp old_summary location src_fn t
1283 m <- tryIO (getModificationTime src_fn)
1285 Right t -> check_timestamp old_summary location src_fn t
1286 Left e | isDoesNotExistError e -> find_it
1287 | otherwise -> ioError e
1289 | otherwise = find_it
1291 dflags = hsc_dflags hsc_env
1293 hsc_src = if is_boot then HsBootFile else HsSrcFile
1295 check_timestamp old_summary location src_fn src_timestamp
1296 | ms_hs_date old_summary == src_timestamp = do
1297 -- update the object-file timestamp
1299 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1300 || obj_allowed -- bug #1205
1301 then getObjTimestamp location is_boot
1303 return (Just old_summary{ ms_obj_date = obj_timestamp })
1305 -- source changed: re-summarise.
1306 new_summary location (ms_mod old_summary) src_fn src_timestamp
1309 -- Don't use the Finder's cache this time. If the module was
1310 -- previously a package module, it may have now appeared on the
1311 -- search path, so we want to consider it to be a home module. If
1312 -- the module was previously a home module, it may have moved.
1313 uncacheModule hsc_env wanted_mod
1314 found <- findImportedModule hsc_env wanted_mod Nothing
1317 | isJust (ml_hs_file location) ->
1319 just_found location mod
1321 -- Drop external-pkg
1322 ASSERT(modulePackageId mod /= thisPackage dflags)
1325 err -> noModError dflags loc wanted_mod err
1328 just_found location mod = do
1329 -- Adjust location to point to the hs-boot source file,
1330 -- hi file, object file, when is_boot says so
1331 let location' | is_boot = addBootSuffixLocn location
1332 | otherwise = location
1333 src_fn = expectJust "summarise2" (ml_hs_file location')
1335 -- Check that it exists
1336 -- It might have been deleted since the Finder last found it
1337 maybe_t <- modificationTimeIfExists src_fn
1339 Nothing -> noHsFileErr loc src_fn
1340 Just t -> new_summary location' mod src_fn t
1343 new_summary location mod src_fn src_timestamp
1345 -- Preprocess the source file and get its imports
1346 -- The dflags' contains the OPTIONS pragmas
1347 (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
1348 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
1350 when (mod_name /= wanted_mod) $
1351 throwOneError $ mkPlainErrMsg mod_loc $
1352 text "File name does not match module name:"
1353 $$ text "Saw:" <+> quotes (ppr mod_name)
1354 $$ text "Expected:" <+> quotes (ppr wanted_mod)
1356 -- Find the object timestamp, and return the summary
1358 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1359 || obj_allowed -- bug #1205
1360 then getObjTimestamp location is_boot
1363 return (Just (ModSummary { ms_mod = mod,
1364 ms_hsc_src = hsc_src,
1365 ms_location = location,
1366 ms_hspp_file = hspp_fn,
1367 ms_hspp_opts = dflags',
1368 ms_hspp_buf = Just buf,
1369 ms_srcimps = srcimps,
1371 ms_hs_date = src_timestamp,
1372 ms_obj_date = obj_timestamp }))
1375 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
1376 getObjTimestamp location is_boot
1377 = if is_boot then return Nothing
1378 else modificationTimeIfExists (ml_obj_file location)
1381 preprocessFile :: HscEnv
1383 -> Maybe Phase -- ^ Starting phase
1384 -> Maybe (StringBuffer,ClockTime)
1385 -> IO (DynFlags, FilePath, StringBuffer)
1386 preprocessFile hsc_env src_fn mb_phase Nothing
1388 (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
1389 buf <- hGetStringBuffer hspp_fn
1390 return (dflags', hspp_fn, buf)
1392 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
1394 let dflags = hsc_dflags hsc_env
1395 -- case we bypass the preprocessing stage?
1397 local_opts = getOptions dflags buf src_fn
1399 (dflags', leftovers, warns)
1400 <- parseDynamicNoPackageFlags dflags local_opts
1401 checkProcessArgsResult leftovers
1402 handleFlagWarnings dflags' warns
1406 | Just (Unlit _) <- mb_phase = True
1407 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
1408 -- note: local_opts is only required if there's no Unlit phase
1409 | xopt Opt_Cpp dflags' = True
1410 | dopt Opt_Pp dflags' = True
1413 when needs_preprocessing $
1414 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
1416 return (dflags', src_fn, buf)
1419 -----------------------------------------------------------------------------
1421 -----------------------------------------------------------------------------
1423 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
1424 -- ToDo: we don't have a proper line number for this error
1425 noModError dflags loc wanted_mod err
1426 = throwOneError $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
1428 noHsFileErr :: SrcSpan -> String -> IO a
1429 noHsFileErr loc path
1430 = throwOneError $ mkPlainErrMsg loc $ text "Can't find" <+> text path
1432 packageModErr :: ModuleName -> IO a
1434 = throwOneError $ mkPlainErrMsg noSrcSpan $
1435 text "module" <+> quotes (ppr mod) <+> text "is a package module"
1437 multiRootsErr :: [ModSummary] -> IO ()
1438 multiRootsErr [] = panic "multiRootsErr"
1439 multiRootsErr summs@(summ1:_)
1440 = throwOneError $ mkPlainErrMsg noSrcSpan $
1441 text "module" <+> quotes (ppr mod) <+>
1442 text "is defined in multiple files:" <+>
1443 sep (map text files)
1446 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
1448 cyclicModuleErr :: [ModSummary] -> SDoc
1450 = hang (ptext (sLit "Module imports form a cycle for modules:"))
1451 2 (vcat (map show_one ms))
1453 mods_in_cycle = map ms_mod_name ms
1454 imp_modname = unLoc . ideclName . unLoc
1455 just_in_cycle = filter ((`elem` mods_in_cycle) . imp_modname)
1458 vcat [ show_mod (ms_hsc_src ms) (ms_mod_name ms) <+>
1459 maybe empty (parens . text) (ml_hs_file (ms_location ms)),
1460 nest 2 $ ptext (sLit "imports:") <+> vcat [
1461 pp_imps HsBootFile (just_in_cycle $ ms_srcimps ms),
1462 pp_imps HsSrcFile (just_in_cycle $ ms_imps ms) ]
1464 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
1465 pp_imps src imps = fsep (map (show_mod src . unLoc . ideclName . unLoc) imps)