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 hsc_env = intermediateCleanTempFiles dflags
254 (flattenSCCs mg2_with_srcimps)
257 liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
260 setSession hsc_env{ hsc_HPT = emptyHomePackageTable }
261 (upsweep_ok, modsUpswept)
262 <- upsweep pruned_hpt stable_mods cleanup mg
264 -- Make modsDone be the summaries for each home module now
265 -- available; this should equal the domain of hpt3.
266 -- Get in in a roughly top .. bottom order (hence reverse).
268 let modsDone = reverse modsUpswept
270 -- Try and do linking in some form, depending on whether the
271 -- upsweep was completely or only partially successful.
273 if succeeded upsweep_ok
276 -- Easy; just relink it all.
277 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep completely successful.")
279 -- Clean up after ourselves
280 hsc_env1 <- getSession
281 liftIO $ intermediateCleanTempFiles dflags modsDone hsc_env1
283 -- Issue a warning for the confusing case where the user
284 -- said '-o foo' but we're not going to do any linking.
285 -- We attempt linking if either (a) one of the modules is
286 -- called Main, or (b) the user said -no-hs-main, indicating
287 -- that main() is going to come from somewhere else.
289 let ofile = outputFile dflags
290 let no_hs_main = dopt Opt_NoHsMain dflags
292 main_mod = mainModIs dflags
293 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
294 do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib
296 when (ghcLink dflags == LinkBinary
297 && isJust ofile && not do_linking) $
298 liftIO $ debugTraceMsg dflags 1 $
299 text ("Warning: output was redirected with -o, " ++
300 "but no output will be generated\n" ++
301 "because there is no " ++
302 moduleNameString (moduleName main_mod) ++ " module.")
304 -- link everything together
305 linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
307 loadFinish Succeeded linkresult
310 -- Tricky. We need to back out the effects of compiling any
311 -- half-done cycles, both so as to clean up the top level envs
312 -- and to avoid telling the interactive linker to link them.
313 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep partially successful.")
316 = map ms_mod modsDone
317 let mods_to_zap_names
318 = findPartiallyCompletedCycles modsDone_names
321 = filter ((`notElem` mods_to_zap_names).ms_mod)
324 hsc_env1 <- getSession
325 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
328 -- Clean up after ourselves
329 liftIO $ intermediateCleanTempFiles dflags mods_to_keep hsc_env1
331 -- there should be no Nothings where linkables should be, now
332 ASSERT(all (isJust.hm_linkable)
333 (eltsUFM (hsc_HPT hsc_env))) do
335 -- Link everything together
336 linkresult <- liftIO $ link (ghcLink dflags) dflags False hpt4
338 modifySession $ \hsc_env -> hsc_env{ hsc_HPT = hpt4 }
339 loadFinish Failed linkresult
341 -- Finish up after a load.
343 -- If the link failed, unload everything and return.
344 loadFinish :: GhcMonad m =>
345 SuccessFlag -> SuccessFlag
347 loadFinish _all_ok Failed
348 = do hsc_env <- getSession
349 liftIO $ unload hsc_env []
350 modifySession discardProg
353 -- Empty the interactive context and set the module context to the topmost
354 -- newly loaded module, or the Prelude if none were loaded.
355 loadFinish all_ok Succeeded
356 = do modifySession $ \hsc_env -> hsc_env{ hsc_IC = emptyInteractiveContext }
360 -- Forget the current program, but retain the persistent info in HscEnv
361 discardProg :: HscEnv -> HscEnv
363 = hsc_env { hsc_mod_graph = emptyMG,
364 hsc_IC = emptyInteractiveContext,
365 hsc_HPT = emptyHomePackageTable }
367 intermediateCleanTempFiles :: DynFlags -> [ModSummary] -> HscEnv -> IO ()
368 intermediateCleanTempFiles dflags summaries hsc_env
369 = cleanTempFilesExcept dflags except
372 -- Save preprocessed files. The preprocessed file *might* be
373 -- the same as the source file, but that doesn't do any
375 map ms_hspp_file summaries ++
376 -- Save object files for loaded modules. The point of this
377 -- is that we might have generated and compiled a stub C
378 -- file, and in the case of GHCi the object file will be a
379 -- temporary file which we must not remove because we need
380 -- to load/link it later.
381 hptObjs (hsc_HPT hsc_env)
383 -- | If there is no -o option, guess the name of target executable
384 -- by using top-level source file name as a base.
385 guessOutputFile :: GhcMonad m => m ()
386 guessOutputFile = modifySession $ \env ->
387 let dflags = hsc_dflags env
388 mod_graph = hsc_mod_graph env
389 mainModuleSrcPath :: Maybe String
390 mainModuleSrcPath = do
391 let isMain = (== mainModIs dflags) . ms_mod
392 [ms] <- return (filter isMain mod_graph)
393 ml_hs_file (ms_location ms)
394 name = fmap dropExtension mainModuleSrcPath
396 #if defined(mingw32_HOST_OS)
397 -- we must add the .exe extention unconditionally here, otherwise
398 -- when name has an extension of its own, the .exe extension will
399 -- not be added by DriverPipeline.exeFileName. See #2248
400 name_exe = fmap (<.> "exe") name
405 case outputFile dflags of
407 Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } }
409 -- -----------------------------------------------------------------------------
411 -- | Prune the HomePackageTable
413 -- Before doing an upsweep, we can throw away:
415 -- - For non-stable modules:
416 -- - all ModDetails, all linked code
417 -- - all unlinked code that is out of date with respect to
420 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
421 -- space at the end of the upsweep, because the topmost ModDetails of the
422 -- old HPT holds on to the entire type environment from the previous
425 pruneHomePackageTable
428 -> ([ModuleName],[ModuleName])
431 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
434 | is_stable modl = hmi'
435 | otherwise = hmi'{ hm_details = emptyModDetails }
437 modl = moduleName (mi_module (hm_iface hmi))
438 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
439 = hmi{ hm_linkable = Nothing }
442 where ms = expectJust "prune" (lookupUFM ms_map modl)
444 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
446 is_stable m = m `elem` stable_obj || m `elem` stable_bco
448 -- -----------------------------------------------------------------------------
450 -- Return (names of) all those in modsDone who are part of a cycle
451 -- as defined by theGraph.
452 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
453 findPartiallyCompletedCycles modsDone theGraph
457 chew ((AcyclicSCC _):rest) = chew rest -- acyclic? not interesting.
458 chew ((CyclicSCC vs):rest)
459 = let names_in_this_cycle = nub (map ms_mod vs)
461 = nub ([done | done <- modsDone,
462 done `elem` names_in_this_cycle])
463 chewed_rest = chew rest
465 if notNull mods_in_this_cycle
466 && length mods_in_this_cycle < length names_in_this_cycle
467 then mods_in_this_cycle ++ chewed_rest
471 -- ---------------------------------------------------------------------------
474 unload :: HscEnv -> [Linkable] -> IO ()
475 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
476 = case ghcLink (hsc_dflags hsc_env) of
478 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
480 LinkInMemory -> panic "unload: no interpreter"
481 -- urgh. avoid warnings:
482 hsc_env stable_linkables
486 -- -----------------------------------------------------------------------------
490 Stability tells us which modules definitely do not need to be recompiled.
491 There are two main reasons for having stability:
493 - avoid doing a complete upsweep of the module graph in GHCi when
494 modules near the bottom of the tree have not changed.
496 - to tell GHCi when it can load object code: we can only load object code
497 for a module when we also load object code fo all of the imports of the
498 module. So we need to know that we will definitely not be recompiling
499 any of these modules, and we can use the object code.
501 The stability check is as follows. Both stableObject and
502 stableBCO are used during the upsweep phase later.
505 stable m = stableObject m || stableBCO m
508 all stableObject (imports m)
509 && old linkable does not exist, or is == on-disk .o
510 && date(on-disk .o) > date(.hs)
513 all stable (imports m)
514 && date(BCO) > date(.hs)
517 These properties embody the following ideas:
519 - if a module is stable, then:
521 - if it has been compiled in a previous pass (present in HPT)
522 then it does not need to be compiled or re-linked.
524 - if it has not been compiled in a previous pass,
525 then we only need to read its .hi file from disk and
526 link it to produce a 'ModDetails'.
528 - if a modules is not stable, we will definitely be at least
529 re-linking, and possibly re-compiling it during the 'upsweep'.
530 All non-stable modules can (and should) therefore be unlinked
531 before the 'upsweep'.
533 - Note that objects are only considered stable if they only depend
534 on other objects. We can't link object code against byte code.
538 :: HomePackageTable -- HPT from last compilation
539 -> [SCC ModSummary] -- current module graph (cyclic)
540 -> [ModuleName] -- all home modules
541 -> ([ModuleName], -- stableObject
542 [ModuleName]) -- stableBCO
544 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
546 checkSCC (stable_obj, stable_bco) scc0
547 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
548 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
549 | otherwise = (stable_obj, stable_bco)
551 scc = flattenSCC scc0
552 scc_mods = map ms_mod_name scc
553 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
555 scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))
556 -- all imports outside the current SCC, but in the home pkg
558 stable_obj_imps = map (`elem` stable_obj) scc_allimps
559 stable_bco_imps = map (`elem` stable_bco) scc_allimps
566 and (zipWith (||) stable_obj_imps stable_bco_imps)
570 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
574 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
575 Just hmi | Just l <- hm_linkable hmi
576 -> isObjectLinkable l && t == linkableTime l
578 -- why '>=' rather than '>' above? If the filesystem stores
579 -- times to the nearset second, we may occasionally find that
580 -- the object & source have the same modification time,
581 -- especially if the source was automatically generated
582 -- and compiled. Using >= is slightly unsafe, but it matches
586 = case lookupUFM hpt (ms_mod_name ms) of
587 Just hmi | Just l <- hm_linkable hmi ->
588 not (isObjectLinkable l) &&
589 linkableTime l >= ms_hs_date ms
592 -- -----------------------------------------------------------------------------
596 -- This is where we compile each module in the module graph, in a pass
597 -- from the bottom to the top of the graph.
599 -- There better had not be any cyclic groups here -- we check for them.
603 => HomePackageTable -- ^ HPT from last time round (pruned)
604 -> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability)
605 -> (HscEnv -> IO ()) -- ^ How to clean up unwanted tmp files
606 -> [SCC ModSummary] -- ^ Mods to do (the worklist)
611 -- 1. A flag whether the complete upsweep was successful.
612 -- 2. The 'HscEnv' in the monad has an updated HPT
613 -- 3. A list of modules which succeeded loading.
615 upsweep old_hpt stable_mods cleanup sccs = do
616 (res, done) <- upsweep' old_hpt [] sccs 1 (length sccs)
617 return (res, reverse done)
620 upsweep' _old_hpt done
622 = return (Succeeded, done)
624 upsweep' _old_hpt done
626 = do dflags <- getSessionDynFlags
627 liftIO $ fatalErrorMsg dflags (cyclicModuleErr ms)
628 return (Failed, done)
630 upsweep' old_hpt done
631 (AcyclicSCC mod:mods) mod_index nmods
632 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
633 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
634 -- (moduleEnvElts (hsc_HPT hsc_env)))
635 let logger _mod = defaultWarnErrLogger
637 hsc_env <- getSession
639 -- Remove unwanted tmp files between compilations
640 liftIO (cleanup hsc_env)
644 (\err -> do logger mod (Just err); return Nothing) $ do
645 mod_info <- liftIO $ upsweep_mod hsc_env old_hpt stable_mods
647 logger mod Nothing -- log warnings
648 return (Just mod_info)
651 Nothing -> return (Failed, done)
653 let this_mod = ms_mod_name mod
655 -- Add new info to hsc_env
656 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
657 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
659 -- Space-saving: delete the old HPT entry
660 -- for mod BUT if mod is a hs-boot
661 -- node, don't delete it. For the
662 -- interface, the HPT entry is probaby for the
663 -- main Haskell source file. Deleting it
664 -- would force the real module to be recompiled
666 old_hpt1 | isBootSummary mod = old_hpt
667 | otherwise = delFromUFM old_hpt this_mod
671 -- fixup our HomePackageTable after we've finished compiling
672 -- a mutually-recursive loop. See reTypecheckLoop, below.
673 hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done'
676 upsweep' old_hpt1 done' mods (mod_index+1) nmods
678 -- | Compile a single module. Always produce a Linkable for it if
679 -- successful. If no compilation happened, return the old Linkable.
680 upsweep_mod :: HscEnv
682 -> ([ModuleName],[ModuleName])
684 -> Int -- index of module
685 -> Int -- total number of modules
688 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
690 this_mod_name = ms_mod_name summary
691 this_mod = ms_mod summary
692 mb_obj_date = ms_obj_date summary
693 obj_fn = ml_obj_file (ms_location summary)
694 hs_date = ms_hs_date summary
696 is_stable_obj = this_mod_name `elem` stable_obj
697 is_stable_bco = this_mod_name `elem` stable_bco
699 old_hmi = lookupUFM old_hpt this_mod_name
701 -- We're using the dflags for this module now, obtained by
702 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
703 dflags = ms_hspp_opts summary
704 prevailing_target = hscTarget (hsc_dflags hsc_env)
705 local_target = hscTarget dflags
707 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
708 -- we don't do anything dodgy: these should only work to change
709 -- from -fvia-C to -fasm and vice-versa, otherwise we could
710 -- end up trying to link object code to byte code.
711 target = if prevailing_target /= local_target
712 && (not (isObjectTarget prevailing_target)
713 || not (isObjectTarget local_target))
714 then prevailing_target
717 -- store the corrected hscTarget into the summary
718 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
720 -- The old interface is ok if
721 -- a) we're compiling a source file, and the old HPT
722 -- entry is for a source file
723 -- b) we're compiling a hs-boot file
724 -- Case (b) allows an hs-boot file to get the interface of its
725 -- real source file on the second iteration of the compilation
726 -- manager, but that does no harm. Otherwise the hs-boot file
727 -- will always be recompiled
732 Just hm_info | isBootSummary summary -> Just iface
733 | not (mi_boot iface) -> Just iface
734 | otherwise -> Nothing
736 iface = hm_iface hm_info
738 compile_it :: Maybe Linkable -> IO HomeModInfo
739 compile_it mb_linkable =
740 compile hsc_env summary' mod_index nmods
741 mb_old_iface mb_linkable
743 compile_it_discard_iface :: Maybe Linkable -> IO HomeModInfo
744 compile_it_discard_iface mb_linkable =
745 compile hsc_env summary' mod_index nmods
748 -- With the HscNothing target we create empty linkables to avoid
749 -- recompilation. We have to detect these to recompile anyway if
750 -- the target changed since the last compile.
752 | Just hmi <- old_hmi, Just l <- hm_linkable hmi =
753 null (linkableUnlinked l)
755 -- we have no linkable, so it cannot be fake
758 implies False _ = True
764 -- Regardless of whether we're generating object code or
765 -- byte code, we can always use an existing object file
766 -- if it is *stable* (see checkStability).
767 | is_stable_obj, Just hmi <- old_hmi -> do
768 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
769 (text "skipping stable obj mod:" <+> ppr this_mod_name)
771 -- object is stable, and we have an entry in the
772 -- old HPT: nothing to do
774 | is_stable_obj, isNothing old_hmi -> do
775 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
776 (text "compiling stable on-disk mod:" <+> ppr this_mod_name)
777 linkable <- liftIO $ findObjectLinkable this_mod obj_fn
778 (expectJust "upsweep1" mb_obj_date)
779 compile_it (Just linkable)
780 -- object is stable, but we need to load the interface
781 -- off disk to make a HMI.
783 | not (isObjectTarget target), is_stable_bco,
784 (target /= HscNothing) `implies` not is_fake_linkable ->
785 ASSERT(isJust old_hmi) -- must be in the old_hpt
786 let Just hmi = old_hmi in do
787 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
788 (text "skipping stable BCO mod:" <+> ppr this_mod_name)
790 -- BCO is stable: nothing to do
792 | not (isObjectTarget target),
794 Just l <- hm_linkable hmi,
795 not (isObjectLinkable l),
796 (target /= HscNothing) `implies` not is_fake_linkable,
797 linkableTime l >= ms_hs_date summary -> do
798 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
799 (text "compiling non-stable BCO mod:" <+> ppr this_mod_name)
801 -- we have an old BCO that is up to date with respect
802 -- to the source: do a recompilation check as normal.
804 -- When generating object code, if there's an up-to-date
805 -- object file on the disk, then we can use it.
806 -- However, if the object file is new (compared to any
807 -- linkable we had from a previous compilation), then we
808 -- must discard any in-memory interface, because this
809 -- means the user has compiled the source file
810 -- separately and generated a new interface, that we must
811 -- read from the disk.
813 | isObjectTarget target,
814 Just obj_date <- mb_obj_date,
815 obj_date >= hs_date -> do
818 | Just l <- hm_linkable hmi,
819 isObjectLinkable l && linkableTime l == obj_date -> do
820 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
821 (text "compiling mod with new on-disk obj:" <+> ppr this_mod_name)
824 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
825 (text "compiling mod with new on-disk obj2:" <+> ppr this_mod_name)
826 linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date
827 compile_it_discard_iface (Just linkable)
830 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
831 (text "compiling mod:" <+> ppr this_mod_name)
836 -- Filter modules in the HPT
837 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
838 retainInTopLevelEnvs keep_these hpt
839 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
841 , let mb_mod_info = lookupUFM hpt mod
842 , isJust mb_mod_info ]
844 -- ---------------------------------------------------------------------------
845 -- Typecheck module loops
848 See bug #930. This code fixes a long-standing bug in --make. The
849 problem is that when compiling the modules *inside* a loop, a data
850 type that is only defined at the top of the loop looks opaque; but
851 after the loop is done, the structure of the data type becomes
854 The difficulty is then that two different bits of code have
855 different notions of what the data type looks like.
857 The idea is that after we compile a module which also has an .hs-boot
858 file, we re-generate the ModDetails for each of the modules that
859 depends on the .hs-boot file, so that everyone points to the proper
860 TyCons, Ids etc. defined by the real module, not the boot module.
861 Fortunately re-generating a ModDetails from a ModIface is easy: the
862 function TcIface.typecheckIface does exactly that.
864 Picking the modules to re-typecheck is slightly tricky. Starting from
865 the module graph consisting of the modules that have already been
866 compiled, we reverse the edges (so they point from the imported module
867 to the importing module), and depth-first-search from the .hs-boot
868 node. This gives us all the modules that depend transitively on the
869 .hs-boot module, and those are exactly the modules that we need to
872 Following this fix, GHC can compile itself with --make -O2.
875 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
876 reTypecheckLoop hsc_env ms graph
877 | not (isBootSummary ms) &&
878 any (\m -> ms_mod m == this_mod && isBootSummary m) graph
880 let mss = reachableBackwards (ms_mod_name ms) graph
881 non_boot = filter (not.isBootSummary) mss
882 debugTraceMsg (hsc_dflags hsc_env) 2 $
883 text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
884 typecheckLoop hsc_env (map ms_mod_name non_boot)
890 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
891 typecheckLoop hsc_env mods = do
893 fixIO $ \new_hpt -> do
894 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
895 mds <- initIfaceCheck new_hsc_env $
896 mapM (typecheckIface . hm_iface) hmis
897 let new_hpt = addListToUFM old_hpt
898 (zip mods [ hmi{ hm_details = details }
899 | (hmi,details) <- zip hmis mds ])
901 return hsc_env{ hsc_HPT = new_hpt }
903 old_hpt = hsc_HPT hsc_env
904 hmis = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
906 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
907 reachableBackwards mod summaries
908 = [ ms | (ms,_,_) <- reachableG (transposeG graph) root ]
909 where -- the rest just sets up the graph:
910 (graph, lookup_node) = moduleGraphNodes False summaries
911 root = expectJust "reachableBackwards" (lookup_node HsBootFile mod)
913 -- ---------------------------------------------------------------------------
914 -- Topological sort of the module graph
916 type SummaryNode = (ModSummary, Int, [Int])
920 -- ^ Drop hi-boot nodes? (see below)
923 -- ^ Root module name. If @Nothing@, use the full graph.
925 -- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
926 -- The resulting list of strongly-connected-components is in topologically
927 -- sorted order, starting with the module(s) at the bottom of the
928 -- dependency graph (ie compile them first) and ending with the ones at
931 -- Drop hi-boot nodes (first boolean arg)?
933 -- - @False@: treat the hi-boot summaries as nodes of the graph,
934 -- so the graph must be acyclic
936 -- - @True@: eliminate the hi-boot nodes, and instead pretend
937 -- the a source-import of Foo is an import of Foo
938 -- The resulting graph has no hi-boot nodes, but can be cyclic
940 topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
941 = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph
943 (graph, lookup_node) = moduleGraphNodes drop_hs_boot_nodes summaries
945 initial_graph = case mb_root_mod of
948 -- restrict the graph to just those modules reachable from
949 -- the specified module. We do this by building a graph with
950 -- the full set of nodes, and determining the reachable set from
951 -- the specified node.
952 let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
953 | otherwise = ghcError (ProgramError "module does not exist")
954 in graphFromEdgedVertices (seq root (reachableG graph root))
956 summaryNodeKey :: SummaryNode -> Int
957 summaryNodeKey (_, k, _) = k
959 summaryNodeSummary :: SummaryNode -> ModSummary
960 summaryNodeSummary (s, _, _) = s
962 moduleGraphNodes :: Bool -> [ModSummary]
963 -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
964 moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)
966 numbered_summaries = zip summaries [1..]
968 lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode
969 lookup_node hs_src mod = Map.lookup (mod, hs_src) node_map
971 lookup_key :: HscSource -> ModuleName -> Maybe Int
972 lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)
974 node_map :: NodeMap SummaryNode
975 node_map = Map.fromList [ ((moduleName (ms_mod s), ms_hsc_src s), node)
976 | node@(s, _, _) <- nodes ]
978 -- We use integers as the keys for the SCC algorithm
979 nodes :: [SummaryNode]
980 nodes = [ (s, key, out_keys)
981 | (s, key) <- numbered_summaries
982 -- Drop the hi-boot ones if told to do so
983 , not (isBootSummary s && drop_hs_boot_nodes)
984 , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
985 out_edge_keys HsSrcFile (map unLoc (ms_home_imps s)) ++
986 (-- see [boot-edges] below
987 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
989 else case lookup_key HsBootFile (ms_mod_name s) of
993 -- [boot-edges] if this is a .hs and there is an equivalent
994 -- .hs-boot, add a link from the former to the latter. This
995 -- has the effect of detecting bogus cases where the .hs-boot
996 -- depends on the .hs, by introducing a cycle. Additionally,
997 -- it ensures that we will always process the .hs-boot before
998 -- the .hs, and so the HomePackageTable will always have the
999 -- most up to date information.
1001 -- Drop hs-boot nodes by using HsSrcFile as the key
1002 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1003 | otherwise = HsBootFile
1005 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1006 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1007 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1008 -- the IsBootInterface parameter True; else False
1011 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
1012 type NodeMap a = Map.Map NodeKey a -- keyed by (mod, src_file_type) pairs
1014 msKey :: ModSummary -> NodeKey
1015 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1017 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1018 mkNodeMap summaries = Map.fromList [ (msKey s, s) | s <- summaries]
1020 nodeMapElts :: NodeMap a -> [a]
1021 nodeMapElts = Map.elems
1023 -- | If there are {-# SOURCE #-} imports between strongly connected
1024 -- components in the topological sort, then those imports can
1025 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1026 -- were necessary, then the edge would be part of a cycle.
1027 warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()
1028 warnUnnecessarySourceImports sccs = do
1029 logWarnings (listToBag (concatMap (check.flattenSCC) sccs))
1031 let mods_in_this_cycle = map ms_mod_name ms in
1032 [ warn i | m <- ms, i <- ms_home_srcimps m,
1033 unLoc i `notElem` mods_in_this_cycle ]
1035 warn :: Located ModuleName -> WarnMsg
1038 (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
1039 <+> quotes (ppr mod))
1041 -----------------------------------------------------------------------------
1042 -- Downsweep (dependency analysis)
1044 -- Chase downwards from the specified root set, returning summaries
1045 -- for all home modules encountered. Only follow source-import
1048 -- We pass in the previous collection of summaries, which is used as a
1049 -- cache to avoid recalculating a module summary if the source is
1052 -- The returned list of [ModSummary] nodes has one node for each home-package
1053 -- module, plus one for any hs-boot files. The imports of these nodes
1054 -- are all there, including the imports of non-home-package modules.
1057 -> [ModSummary] -- Old summaries
1058 -> [ModuleName] -- Ignore dependencies on these; treat
1059 -- them as if they were package modules
1060 -> Bool -- True <=> allow multiple targets to have
1061 -- the same module name; this is
1062 -- very useful for ghc -M
1064 -- The elts of [ModSummary] all have distinct
1065 -- (Modules, IsBoot) identifiers, unless the Bool is true
1066 -- in which case there can be repeats
1067 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1069 rootSummaries <- mapM getRootSummary roots
1070 let root_map = mkRootMap rootSummaries
1071 checkDuplicates root_map
1072 summs <- loop (concatMap msDeps rootSummaries) root_map
1075 roots = hsc_targets hsc_env
1077 old_summary_map :: NodeMap ModSummary
1078 old_summary_map = mkNodeMap old_summaries
1080 getRootSummary :: Target -> IO ModSummary
1081 getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)
1082 = do exists <- liftIO $ doesFileExist file
1084 then summariseFile hsc_env old_summaries file mb_phase
1085 obj_allowed maybe_buf
1086 else throwOneError $ mkPlainErrMsg noSrcSpan $
1087 text "can't find file:" <+> text file
1088 getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
1089 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1090 (L rootLoc modl) obj_allowed
1092 case maybe_summary of
1093 Nothing -> packageModErr modl
1096 rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1098 -- In a root module, the filename is allowed to diverge from the module
1099 -- name, so we have to check that there aren't multiple root files
1100 -- defining the same module (otherwise the duplicates will be silently
1101 -- ignored, leading to confusing behaviour).
1102 checkDuplicates :: NodeMap [ModSummary] -> IO ()
1103 checkDuplicates root_map
1104 | allow_dup_roots = return ()
1105 | null dup_roots = return ()
1106 | otherwise = liftIO $ multiRootsErr (head dup_roots)
1108 dup_roots :: [[ModSummary]] -- Each at least of length 2
1109 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1111 loop :: [(Located ModuleName,IsBootInterface)]
1112 -- Work list: process these modules
1113 -> NodeMap [ModSummary]
1114 -- Visited set; the range is a list because
1115 -- the roots can have the same module names
1116 -- if allow_dup_roots is True
1118 -- The result includes the worklist, except
1119 -- for those mentioned in the visited set
1120 loop [] done = return (concat (nodeMapElts done))
1121 loop ((wanted_mod, is_boot) : ss) done
1122 | Just summs <- Map.lookup key done
1123 = if isSingleton summs then
1126 do { multiRootsErr summs; return [] }
1128 = do mb_s <- summariseModule hsc_env old_summary_map
1129 is_boot wanted_mod True
1132 Nothing -> loop ss done
1133 Just s -> loop (msDeps s ++ ss) (Map.insert key [s] done)
1135 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1137 -- XXX Does the (++) here need to be flipped?
1138 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1139 mkRootMap summaries = Map.insertListWith (flip (++))
1140 [ (msKey s, [s]) | s <- summaries ]
1143 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
1144 -- (msDeps s) returns the dependencies of the ModSummary s.
1145 -- A wrinkle is that for a {-# SOURCE #-} import we return
1146 -- *both* the hs-boot file
1147 -- *and* the source file
1148 -- as "dependencies". That ensures that the list of all relevant
1149 -- modules always contains B.hs if it contains B.hs-boot.
1150 -- Remember, this pass isn't doing the topological sort. It's
1151 -- just gathering the list of all relevant ModSummaries
1153 concat [ [(m,True), (m,False)] | m <- ms_home_srcimps s ]
1154 ++ [ (m,False) | m <- ms_home_imps s ]
1156 home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
1157 home_imps imps = [ ideclName i | L _ i <- imps, isLocal (ideclPkgQual i) ]
1158 where isLocal Nothing = True
1159 isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special
1162 ms_home_allimps :: ModSummary -> [ModuleName]
1163 ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
1165 ms_home_srcimps :: ModSummary -> [Located ModuleName]
1166 ms_home_srcimps = home_imps . ms_srcimps
1168 ms_home_imps :: ModSummary -> [Located ModuleName]
1169 ms_home_imps = home_imps . ms_imps
1171 -----------------------------------------------------------------------------
1172 -- Summarising modules
1174 -- We have two types of summarisation:
1176 -- * Summarise a file. This is used for the root module(s) passed to
1177 -- cmLoadModules. The file is read, and used to determine the root
1178 -- module name. The module name may differ from the filename.
1180 -- * Summarise a module. We are given a module name, and must provide
1181 -- a summary. The finder is used to locate the file in which the module
1186 -> [ModSummary] -- old summaries
1187 -> FilePath -- source file name
1188 -> Maybe Phase -- start phase
1189 -> Bool -- object code allowed?
1190 -> Maybe (StringBuffer,ClockTime)
1193 summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
1194 -- we can use a cached summary if one is available and the
1195 -- source file hasn't changed, But we have to look up the summary
1196 -- by source file, rather than module name as we do in summarise.
1197 | Just old_summary <- findSummaryBySourceFile old_summaries file
1199 let location = ms_location old_summary
1201 -- return the cached summary if the source didn't change
1202 src_timestamp <- case maybe_buf of
1203 Just (_,t) -> return t
1204 Nothing -> liftIO $ getModificationTime file
1205 -- The file exists; we checked in getRootSummary above.
1206 -- If it gets removed subsequently, then this
1207 -- getModificationTime may fail, but that's the right
1210 if ms_hs_date old_summary == src_timestamp
1211 then do -- update the object-file timestamp
1213 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1214 || obj_allowed -- bug #1205
1215 then liftIO $ getObjTimestamp location False
1217 return old_summary{ ms_obj_date = obj_timestamp }
1225 let dflags = hsc_dflags hsc_env
1227 (dflags', hspp_fn, buf)
1228 <- preprocessFile hsc_env file mb_phase maybe_buf
1230 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
1232 -- Make a ModLocation for this file
1233 location <- liftIO $ mkHomeModLocation dflags mod_name file
1235 -- Tell the Finder cache where it is, so that subsequent calls
1236 -- to findModule will find it, even if it's not on any search path
1237 mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location
1239 src_timestamp <- case maybe_buf of
1240 Just (_,t) -> return t
1241 Nothing -> liftIO $ getModificationTime file
1242 -- getMofificationTime may fail
1244 -- when the user asks to load a source file by name, we only
1245 -- use an object file if -fobject-code is on. See #1205.
1247 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1248 || obj_allowed -- bug #1205
1249 then liftIO $ modificationTimeIfExists (ml_obj_file location)
1252 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1253 ms_location = location,
1254 ms_hspp_file = hspp_fn,
1255 ms_hspp_opts = dflags',
1256 ms_hspp_buf = Just buf,
1257 ms_srcimps = srcimps, ms_imps = the_imps,
1258 ms_hs_date = src_timestamp,
1259 ms_obj_date = obj_timestamp })
1261 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
1262 findSummaryBySourceFile summaries file
1263 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
1264 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
1268 -- Summarise a module, and pick up source and timestamp.
1271 -> NodeMap ModSummary -- Map of old summaries
1272 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
1273 -> Located ModuleName -- Imported module to be summarised
1274 -> Bool -- object code allowed?
1275 -> Maybe (StringBuffer, ClockTime)
1276 -> [ModuleName] -- Modules to exclude
1277 -> IO (Maybe ModSummary) -- Its new summary
1279 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
1280 obj_allowed maybe_buf excl_mods
1281 | wanted_mod `elem` excl_mods
1284 | Just old_summary <- Map.lookup (wanted_mod, hsc_src) old_summary_map
1285 = do -- Find its new timestamp; all the
1286 -- ModSummaries in the old map have valid ml_hs_files
1287 let location = ms_location old_summary
1288 src_fn = expectJust "summariseModule" (ml_hs_file location)
1290 -- check the modification time on the source file, and
1291 -- return the cached summary if it hasn't changed. If the
1292 -- file has disappeared, we need to call the Finder again.
1294 Just (_,t) -> check_timestamp old_summary location src_fn t
1296 m <- tryIO (getModificationTime src_fn)
1298 Right t -> check_timestamp old_summary location src_fn t
1299 Left e | isDoesNotExistError e -> find_it
1300 | otherwise -> ioError e
1302 | otherwise = find_it
1304 dflags = hsc_dflags hsc_env
1306 hsc_src = if is_boot then HsBootFile else HsSrcFile
1308 check_timestamp old_summary location src_fn src_timestamp
1309 | ms_hs_date old_summary == src_timestamp = do
1310 -- update the object-file timestamp
1312 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1313 || obj_allowed -- bug #1205
1314 then getObjTimestamp location is_boot
1316 return (Just old_summary{ ms_obj_date = obj_timestamp })
1318 -- source changed: re-summarise.
1319 new_summary location (ms_mod old_summary) src_fn src_timestamp
1322 -- Don't use the Finder's cache this time. If the module was
1323 -- previously a package module, it may have now appeared on the
1324 -- search path, so we want to consider it to be a home module. If
1325 -- the module was previously a home module, it may have moved.
1326 uncacheModule hsc_env wanted_mod
1327 found <- findImportedModule hsc_env wanted_mod Nothing
1330 | isJust (ml_hs_file location) ->
1332 just_found location mod
1334 -- Drop external-pkg
1335 ASSERT(modulePackageId mod /= thisPackage dflags)
1338 err -> noModError dflags loc wanted_mod err
1341 just_found location mod = do
1342 -- Adjust location to point to the hs-boot source file,
1343 -- hi file, object file, when is_boot says so
1344 let location' | is_boot = addBootSuffixLocn location
1345 | otherwise = location
1346 src_fn = expectJust "summarise2" (ml_hs_file location')
1348 -- Check that it exists
1349 -- It might have been deleted since the Finder last found it
1350 maybe_t <- modificationTimeIfExists src_fn
1352 Nothing -> noHsFileErr loc src_fn
1353 Just t -> new_summary location' mod src_fn t
1356 new_summary location mod src_fn src_timestamp
1358 -- Preprocess the source file and get its imports
1359 -- The dflags' contains the OPTIONS pragmas
1360 (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
1361 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
1363 when (mod_name /= wanted_mod) $
1364 throwOneError $ mkPlainErrMsg mod_loc $
1365 text "File name does not match module name:"
1366 $$ text "Saw:" <+> quotes (ppr mod_name)
1367 $$ text "Expected:" <+> quotes (ppr wanted_mod)
1369 -- Find the object timestamp, and return the summary
1371 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1372 || obj_allowed -- bug #1205
1373 then getObjTimestamp location is_boot
1376 return (Just (ModSummary { ms_mod = mod,
1377 ms_hsc_src = hsc_src,
1378 ms_location = location,
1379 ms_hspp_file = hspp_fn,
1380 ms_hspp_opts = dflags',
1381 ms_hspp_buf = Just buf,
1382 ms_srcimps = srcimps,
1384 ms_hs_date = src_timestamp,
1385 ms_obj_date = obj_timestamp }))
1388 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
1389 getObjTimestamp location is_boot
1390 = if is_boot then return Nothing
1391 else modificationTimeIfExists (ml_obj_file location)
1394 preprocessFile :: HscEnv
1396 -> Maybe Phase -- ^ Starting phase
1397 -> Maybe (StringBuffer,ClockTime)
1398 -> IO (DynFlags, FilePath, StringBuffer)
1399 preprocessFile hsc_env src_fn mb_phase Nothing
1401 (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
1402 buf <- hGetStringBuffer hspp_fn
1403 return (dflags', hspp_fn, buf)
1405 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
1407 let dflags = hsc_dflags hsc_env
1408 let local_opts = getOptions dflags buf src_fn
1410 (dflags', leftovers, warns)
1411 <- parseDynamicNoPackageFlags dflags local_opts
1412 checkProcessArgsResult leftovers
1413 handleFlagWarnings dflags' warns
1415 let needs_preprocessing
1416 | Just (Unlit _) <- mb_phase = True
1417 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
1418 -- note: local_opts is only required if there's no Unlit phase
1419 | xopt Opt_Cpp dflags' = True
1420 | dopt Opt_Pp dflags' = True
1423 when needs_preprocessing $
1424 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
1426 return (dflags', src_fn, buf)
1429 -----------------------------------------------------------------------------
1431 -----------------------------------------------------------------------------
1433 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
1434 -- ToDo: we don't have a proper line number for this error
1435 noModError dflags loc wanted_mod err
1436 = throwOneError $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
1438 noHsFileErr :: SrcSpan -> String -> IO a
1439 noHsFileErr loc path
1440 = throwOneError $ mkPlainErrMsg loc $ text "Can't find" <+> text path
1442 packageModErr :: ModuleName -> IO a
1444 = throwOneError $ mkPlainErrMsg noSrcSpan $
1445 text "module" <+> quotes (ppr mod) <+> text "is a package module"
1447 multiRootsErr :: [ModSummary] -> IO ()
1448 multiRootsErr [] = panic "multiRootsErr"
1449 multiRootsErr summs@(summ1:_)
1450 = throwOneError $ mkPlainErrMsg noSrcSpan $
1451 text "module" <+> quotes (ppr mod) <+>
1452 text "is defined in multiple files:" <+>
1453 sep (map text files)
1456 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
1458 cyclicModuleErr :: [ModSummary] -> SDoc
1460 = hang (ptext (sLit "Module imports form a cycle for modules:"))
1461 2 (vcat (map show_one ms))
1463 mods_in_cycle = map ms_mod_name ms
1464 imp_modname = unLoc . ideclName . unLoc
1465 just_in_cycle = filter ((`elem` mods_in_cycle) . imp_modname)
1468 vcat [ show_mod (ms_hsc_src ms) (ms_mod_name ms) <+>
1469 maybe empty (parens . text) (ml_hs_file (ms_location ms)),
1470 nest 2 $ ptext (sLit "imports:") <+> vcat [
1471 pp_imps HsBootFile (just_in_cycle $ ms_srcimps ms),
1472 pp_imps HsSrcFile (just_in_cycle $ ms_imps ms) ]
1474 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
1475 pp_imps src imps = fsep (map (show_mod src . unLoc . ideclName . unLoc) imps)