comment
[ghc.git] / compiler / main / GhcMake.hs
1 {-# LANGUAGE ScopedTypeVariables #-}
2
3 -- -----------------------------------------------------------------------------
4 --
5 -- (c) The University of Glasgow, 2011
6 --
7 -- This module implements multi-module compilation, and is used
8 -- by --make and GHCi.
9 --
10 -- -----------------------------------------------------------------------------
11
12 module GhcMake(
13 depanal,
14 load, LoadHowMuch(..),
15
16 topSortModuleGraph,
17
18 noModError, cyclicModuleErr
19 ) where
20
21 #include "HsVersions.h"
22
23 #ifdef GHCI
24 import qualified Linker ( unload )
25 #endif
26
27 import DriverPipeline
28 import DriverPhases
29 import GhcMonad
30 import Module
31 import HscTypes
32 import ErrUtils
33 import DynFlags
34 import HsSyn hiding ((<.>))
35 import Finder
36 import HeaderInfo
37 import TcIface ( typecheckIface )
38 import TcRnMonad ( initIfaceCheck )
39 import RdrName ( RdrName )
40
41 import Exception ( evaluate, tryIO )
42 import Panic
43 import SysTools
44 import BasicTypes
45 import SrcLoc
46 import Util
47 import Digraph
48 import Bag ( listToBag )
49 import Maybes ( expectJust, mapCatMaybes )
50 import StringBuffer
51 import FastString
52 import Outputable
53 import UniqFM
54
55 import qualified Data.Map as Map
56 import qualified FiniteMap as Map( insertListWith)
57
58 import System.Directory ( doesFileExist, getModificationTime )
59 import System.IO ( fixIO )
60 import System.IO.Error ( isDoesNotExistError )
61 import System.Time ( ClockTime )
62 import System.FilePath
63 import Control.Monad
64 import Data.Maybe
65 import Data.List
66 import qualified Data.List as List
67
68 -- -----------------------------------------------------------------------------
69 -- Loading the program
70
71 -- | Perform a dependency analysis starting from the current targets
72 -- and update the session with the new module graph.
73 --
74 -- Dependency analysis entails parsing the @import@ directives and may
75 -- therefore require running certain preprocessors.
76 --
77 -- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.
78 -- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the
79 -- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module. Thus if you want to
80 -- changes to the 'DynFlags' to take effect you need to call this function
81 -- again.
82 --
83 depanal :: GhcMonad m =>
84 [ModuleName] -- ^ excluded modules
85 -> Bool -- ^ allow duplicate roots
86 -> m ModuleGraph
87 depanal excluded_mods allow_dup_roots = do
88 hsc_env <- getSession
89 let
90 dflags = hsc_dflags hsc_env
91 targets = hsc_targets hsc_env
92 old_graph = hsc_mod_graph hsc_env
93
94 liftIO $ showPass dflags "Chasing dependencies"
95 liftIO $ debugTraceMsg dflags 2 (hcat [
96 text "Chasing modules from: ",
97 hcat (punctuate comma (map pprTarget targets))])
98
99 mod_graph <- liftIO $ downsweep hsc_env old_graph excluded_mods allow_dup_roots
100 modifySession $ \_ -> hsc_env { hsc_mod_graph = mod_graph }
101 return mod_graph
102
103 -- | Describes which modules of the module graph need to be loaded.
104 data LoadHowMuch
105 = LoadAllTargets
106 -- ^ Load all targets and its dependencies.
107 | LoadUpTo ModuleName
108 -- ^ Load only the given module and its dependencies.
109 | LoadDependenciesOf ModuleName
110 -- ^ Load only the dependencies of the given module, but not the module
111 -- itself.
112
113 -- | Try to load the program. See 'LoadHowMuch' for the different modes.
114 --
115 -- This function implements the core of GHC's @--make@ mode. It preprocesses,
116 -- compiles and loads the specified modules, avoiding re-compilation wherever
117 -- possible. Depending on the target (see 'DynFlags.hscTarget') compilating
118 -- and loading may result in files being created on disk.
119 --
120 -- Calls the 'reportModuleCompilationResult' callback after each compiling
121 -- each module, whether successful or not.
122 --
123 -- Throw a 'SourceError' if errors are encountered before the actual
124 -- compilation starts (e.g., during dependency analysis). All other errors
125 -- are reported using the callback.
126 --
127 load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
128 load how_much = do
129 mod_graph <- depanal [] False
130 load2 how_much mod_graph
131
132 load2 :: GhcMonad m => LoadHowMuch -> [ModSummary]
133 -> m SuccessFlag
134 load2 how_much mod_graph = do
135 guessOutputFile
136 hsc_env <- getSession
137
138 let hpt1 = hsc_HPT hsc_env
139 let dflags = hsc_dflags hsc_env
140
141 -- The "bad" boot modules are the ones for which we have
142 -- B.hs-boot in the module graph, but no B.hs
143 -- The downsweep should have ensured this does not happen
144 -- (see msDeps)
145 let all_home_mods = [ms_mod_name s
146 | s <- mod_graph, not (isBootSummary s)]
147 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
148 not (ms_mod_name s `elem` all_home_mods)]
149 ASSERT( null bad_boot_mods ) return ()
150
151 -- check that the module given in HowMuch actually exists, otherwise
152 -- topSortModuleGraph will bomb later.
153 let checkHowMuch (LoadUpTo m) = checkMod m
154 checkHowMuch (LoadDependenciesOf m) = checkMod m
155 checkHowMuch _ = id
156
157 checkMod m and_then
158 | m `elem` all_home_mods = and_then
159 | otherwise = do
160 liftIO $ errorMsg dflags (text "no such module:" <+>
161 quotes (ppr m))
162 return Failed
163
164 checkHowMuch how_much $ do
165
166 -- mg2_with_srcimps drops the hi-boot nodes, returning a
167 -- graph with cycles. Among other things, it is used for
168 -- backing out partially complete cycles following a failed
169 -- upsweep, and for removing from hpt all the modules
170 -- not in strict downwards closure, during calls to compile.
171 let mg2_with_srcimps :: [SCC ModSummary]
172 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
173
174 -- If we can determine that any of the {-# SOURCE #-} imports
175 -- are definitely unnecessary, then emit a warning.
176 warnUnnecessarySourceImports mg2_with_srcimps
177
178 let
179 -- check the stability property for each module.
180 stable_mods@(stable_obj,stable_bco)
181 = checkStability hpt1 mg2_with_srcimps all_home_mods
182
183 -- prune bits of the HPT which are definitely redundant now,
184 -- to save space.
185 pruned_hpt = pruneHomePackageTable hpt1
186 (flattenSCCs mg2_with_srcimps)
187 stable_mods
188
189 _ <- liftIO $ evaluate pruned_hpt
190
191 -- before we unload anything, make sure we don't leave an old
192 -- interactive context around pointing to dead bindings. Also,
193 -- write the pruned HPT to allow the old HPT to be GC'd.
194 modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext,
195 hsc_HPT = pruned_hpt }
196
197 liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
198 text "Stable BCO:" <+> ppr stable_bco)
199
200 -- Unload any modules which are going to be re-linked this time around.
201 let stable_linkables = [ linkable
202 | m <- stable_obj++stable_bco,
203 Just hmi <- [lookupUFM pruned_hpt m],
204 Just linkable <- [hm_linkable hmi] ]
205 liftIO $ unload hsc_env stable_linkables
206
207 -- We could at this point detect cycles which aren't broken by
208 -- a source-import, and complain immediately, but it seems better
209 -- to let upsweep_mods do this, so at least some useful work gets
210 -- done before the upsweep is abandoned.
211 --hPutStrLn stderr "after tsort:\n"
212 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
213
214 -- Now do the upsweep, calling compile for each module in
215 -- turn. Final result is version 3 of everything.
216
217 -- Topologically sort the module graph, this time including hi-boot
218 -- nodes, and possibly just including the portion of the graph
219 -- reachable from the module specified in the 2nd argument to load.
220 -- This graph should be cycle-free.
221 -- If we're restricting the upsweep to a portion of the graph, we
222 -- also want to retain everything that is still stable.
223 let full_mg :: [SCC ModSummary]
224 full_mg = topSortModuleGraph False mod_graph Nothing
225
226 maybe_top_mod = case how_much of
227 LoadUpTo m -> Just m
228 LoadDependenciesOf m -> Just m
229 _ -> Nothing
230
231 partial_mg0 :: [SCC ModSummary]
232 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
233
234 -- LoadDependenciesOf m: we want the upsweep to stop just
235 -- short of the specified module (unless the specified module
236 -- is stable).
237 partial_mg
238 | LoadDependenciesOf _mod <- how_much
239 = ASSERT( case last partial_mg0 of
240 AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
241 List.init partial_mg0
242 | otherwise
243 = partial_mg0
244
245 stable_mg =
246 [ AcyclicSCC ms
247 | AcyclicSCC ms <- full_mg,
248 ms_mod_name ms `elem` stable_obj++stable_bco,
249 ms_mod_name ms `notElem` [ ms_mod_name ms' |
250 AcyclicSCC ms' <- partial_mg ] ]
251
252 mg = stable_mg ++ partial_mg
253
254 -- clean up between compilations
255 let cleanup hsc_env = intermediateCleanTempFiles dflags
256 (flattenSCCs mg2_with_srcimps)
257 hsc_env
258
259 liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
260 2 (ppr mg))
261
262 setSession hsc_env{ hsc_HPT = emptyHomePackageTable }
263 (upsweep_ok, modsUpswept)
264 <- upsweep pruned_hpt stable_mods cleanup mg
265
266 -- Make modsDone be the summaries for each home module now
267 -- available; this should equal the domain of hpt3.
268 -- Get in in a roughly top .. bottom order (hence reverse).
269
270 let modsDone = reverse modsUpswept
271
272 -- Try and do linking in some form, depending on whether the
273 -- upsweep was completely or only partially successful.
274
275 if succeeded upsweep_ok
276
277 then
278 -- Easy; just relink it all.
279 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep completely successful.")
280
281 -- Clean up after ourselves
282 hsc_env1 <- getSession
283 liftIO $ intermediateCleanTempFiles dflags modsDone hsc_env1
284
285 -- Issue a warning for the confusing case where the user
286 -- said '-o foo' but we're not going to do any linking.
287 -- We attempt linking if either (a) one of the modules is
288 -- called Main, or (b) the user said -no-hs-main, indicating
289 -- that main() is going to come from somewhere else.
290 --
291 let ofile = outputFile dflags
292 let no_hs_main = dopt Opt_NoHsMain dflags
293 let
294 main_mod = mainModIs dflags
295 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
296 do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib
297
298 when (ghcLink dflags == LinkBinary
299 && isJust ofile && not do_linking) $
300 liftIO $ debugTraceMsg dflags 1 $
301 text ("Warning: output was redirected with -o, " ++
302 "but no output will be generated\n" ++
303 "because there is no " ++
304 moduleNameString (moduleName main_mod) ++ " module.")
305
306 -- link everything together
307 linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
308
309 loadFinish Succeeded linkresult
310
311 else
312 -- Tricky. We need to back out the effects of compiling any
313 -- half-done cycles, both so as to clean up the top level envs
314 -- and to avoid telling the interactive linker to link them.
315 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep partially successful.")
316
317 let modsDone_names
318 = map ms_mod modsDone
319 let mods_to_zap_names
320 = findPartiallyCompletedCycles modsDone_names
321 mg2_with_srcimps
322 let mods_to_keep
323 = filter ((`notElem` mods_to_zap_names).ms_mod)
324 modsDone
325
326 hsc_env1 <- getSession
327 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
328 (hsc_HPT hsc_env1)
329
330 -- Clean up after ourselves
331 liftIO $ intermediateCleanTempFiles dflags mods_to_keep hsc_env1
332
333 -- there should be no Nothings where linkables should be, now
334 ASSERT(all (isJust.hm_linkable)
335 (eltsUFM (hsc_HPT hsc_env))) do
336
337 -- Link everything together
338 linkresult <- liftIO $ link (ghcLink dflags) dflags False hpt4
339
340 modifySession $ \hsc_env -> hsc_env{ hsc_HPT = hpt4 }
341 loadFinish Failed linkresult
342
343 -- Finish up after a load.
344
345 -- If the link failed, unload everything and return.
346 loadFinish :: GhcMonad m =>
347 SuccessFlag -> SuccessFlag
348 -> m SuccessFlag
349 loadFinish _all_ok Failed
350 = do hsc_env <- getSession
351 liftIO $ unload hsc_env []
352 modifySession discardProg
353 return Failed
354
355 -- Empty the interactive context and set the module context to the topmost
356 -- newly loaded module, or the Prelude if none were loaded.
357 loadFinish all_ok Succeeded
358 = do modifySession $ \hsc_env -> hsc_env{ hsc_IC = emptyInteractiveContext }
359 return all_ok
360
361
362 -- Forget the current program, but retain the persistent info in HscEnv
363 discardProg :: HscEnv -> HscEnv
364 discardProg hsc_env
365 = hsc_env { hsc_mod_graph = emptyMG,
366 hsc_IC = emptyInteractiveContext,
367 hsc_HPT = emptyHomePackageTable }
368
369 intermediateCleanTempFiles :: DynFlags -> [ModSummary] -> HscEnv -> IO ()
370 intermediateCleanTempFiles dflags summaries hsc_env
371 = cleanTempFilesExcept dflags except
372 where
373 except =
374 -- Save preprocessed files. The preprocessed file *might* be
375 -- the same as the source file, but that doesn't do any
376 -- harm.
377 map ms_hspp_file summaries ++
378 -- Save object files for loaded modules. The point of this
379 -- is that we might have generated and compiled a stub C
380 -- file, and in the case of GHCi the object file will be a
381 -- temporary file which we must not remove because we need
382 -- to load/link it later.
383 hptObjs (hsc_HPT hsc_env)
384
385 -- | If there is no -o option, guess the name of target executable
386 -- by using top-level source file name as a base.
387 guessOutputFile :: GhcMonad m => m ()
388 guessOutputFile = modifySession $ \env ->
389 let dflags = hsc_dflags env
390 mod_graph = hsc_mod_graph env
391 mainModuleSrcPath :: Maybe String
392 mainModuleSrcPath = do
393 let isMain = (== mainModIs dflags) . ms_mod
394 [ms] <- return (filter isMain mod_graph)
395 ml_hs_file (ms_location ms)
396 name = fmap dropExtension mainModuleSrcPath
397
398 #if defined(mingw32_HOST_OS)
399 -- we must add the .exe extention unconditionally here, otherwise
400 -- when name has an extension of its own, the .exe extension will
401 -- not be added by DriverPipeline.exeFileName. See #2248
402 name_exe = fmap (<.> "exe") name
403 #else
404 name_exe = name
405 #endif
406 in
407 case outputFile dflags of
408 Just _ -> env
409 Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } }
410
411 -- -----------------------------------------------------------------------------
412
413 -- | Prune the HomePackageTable
414 --
415 -- Before doing an upsweep, we can throw away:
416 --
417 -- - For non-stable modules:
418 -- - all ModDetails, all linked code
419 -- - all unlinked code that is out of date with respect to
420 -- the source file
421 --
422 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
423 -- space at the end of the upsweep, because the topmost ModDetails of the
424 -- old HPT holds on to the entire type environment from the previous
425 -- compilation.
426
427 pruneHomePackageTable
428 :: HomePackageTable
429 -> [ModSummary]
430 -> ([ModuleName],[ModuleName])
431 -> HomePackageTable
432
433 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
434 = mapUFM prune hpt
435 where prune hmi
436 | is_stable modl = hmi'
437 | otherwise = hmi'{ hm_details = emptyModDetails }
438 where
439 modl = moduleName (mi_module (hm_iface hmi))
440 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
441 = hmi{ hm_linkable = Nothing }
442 | otherwise
443 = hmi
444 where ms = expectJust "prune" (lookupUFM ms_map modl)
445
446 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
447
448 is_stable m = m `elem` stable_obj || m `elem` stable_bco
449
450 -- -----------------------------------------------------------------------------
451
452 -- Return (names of) all those in modsDone who are part of a cycle
453 -- as defined by theGraph.
454 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
455 findPartiallyCompletedCycles modsDone theGraph
456 = chew theGraph
457 where
458 chew [] = []
459 chew ((AcyclicSCC _):rest) = chew rest -- acyclic? not interesting.
460 chew ((CyclicSCC vs):rest)
461 = let names_in_this_cycle = nub (map ms_mod vs)
462 mods_in_this_cycle
463 = nub ([done | done <- modsDone,
464 done `elem` names_in_this_cycle])
465 chewed_rest = chew rest
466 in
467 if notNull mods_in_this_cycle
468 && length mods_in_this_cycle < length names_in_this_cycle
469 then mods_in_this_cycle ++ chewed_rest
470 else chewed_rest
471
472
473 -- ---------------------------------------------------------------------------
474 -- Unloading
475
476 unload :: HscEnv -> [Linkable] -> IO ()
477 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
478 = case ghcLink (hsc_dflags hsc_env) of
479 #ifdef GHCI
480 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
481 #else
482 LinkInMemory -> panic "unload: no interpreter"
483 -- urgh. avoid warnings:
484 hsc_env stable_linkables
485 #endif
486 _other -> return ()
487
488 -- -----------------------------------------------------------------------------
489
490 {- |
491
492 Stability tells us which modules definitely do not need to be recompiled.
493 There are two main reasons for having stability:
494
495 - avoid doing a complete upsweep of the module graph in GHCi when
496 modules near the bottom of the tree have not changed.
497
498 - to tell GHCi when it can load object code: we can only load object code
499 for a module when we also load object code fo all of the imports of the
500 module. So we need to know that we will definitely not be recompiling
501 any of these modules, and we can use the object code.
502
503 The stability check is as follows. Both stableObject and
504 stableBCO are used during the upsweep phase later.
505
506 @
507 stable m = stableObject m || stableBCO m
508
509 stableObject m =
510 all stableObject (imports m)
511 && old linkable does not exist, or is == on-disk .o
512 && date(on-disk .o) > date(.hs)
513
514 stableBCO m =
515 all stable (imports m)
516 && date(BCO) > date(.hs)
517 @
518
519 These properties embody the following ideas:
520
521 - if a module is stable, then:
522
523 - if it has been compiled in a previous pass (present in HPT)
524 then it does not need to be compiled or re-linked.
525
526 - if it has not been compiled in a previous pass,
527 then we only need to read its .hi file from disk and
528 link it to produce a 'ModDetails'.
529
530 - if a modules is not stable, we will definitely be at least
531 re-linking, and possibly re-compiling it during the 'upsweep'.
532 All non-stable modules can (and should) therefore be unlinked
533 before the 'upsweep'.
534
535 - Note that objects are only considered stable if they only depend
536 on other objects. We can't link object code against byte code.
537 -}
538
539 checkStability
540 :: HomePackageTable -- HPT from last compilation
541 -> [SCC ModSummary] -- current module graph (cyclic)
542 -> [ModuleName] -- all home modules
543 -> ([ModuleName], -- stableObject
544 [ModuleName]) -- stableBCO
545
546 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
547 where
548 checkSCC (stable_obj, stable_bco) scc0
549 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
550 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
551 | otherwise = (stable_obj, stable_bco)
552 where
553 scc = flattenSCC scc0
554 scc_mods = map ms_mod_name scc
555 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
556
557 scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))
558 -- all imports outside the current SCC, but in the home pkg
559
560 stable_obj_imps = map (`elem` stable_obj) scc_allimps
561 stable_bco_imps = map (`elem` stable_bco) scc_allimps
562
563 stableObjects =
564 and stable_obj_imps
565 && all object_ok scc
566
567 stableBCOs =
568 and (zipWith (||) stable_obj_imps stable_bco_imps)
569 && all bco_ok scc
570
571 object_ok ms
572 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
573 && same_as_prev t
574 | otherwise = False
575 where
576 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
577 Just hmi | Just l <- hm_linkable hmi
578 -> isObjectLinkable l && t == linkableTime l
579 _other -> True
580 -- why '>=' rather than '>' above? If the filesystem stores
581 -- times to the nearset second, we may occasionally find that
582 -- the object & source have the same modification time,
583 -- especially if the source was automatically generated
584 -- and compiled. Using >= is slightly unsafe, but it matches
585 -- make's behaviour.
586 --
587 -- But see #5527, where someone ran into this and it caused
588 -- a problem.
589
590 bco_ok ms
591 = case lookupUFM hpt (ms_mod_name ms) of
592 Just hmi | Just l <- hm_linkable hmi ->
593 not (isObjectLinkable l) &&
594 linkableTime l >= ms_hs_date ms
595 _other -> False
596
597 -- -----------------------------------------------------------------------------
598
599 -- | The upsweep
600 --
601 -- This is where we compile each module in the module graph, in a pass
602 -- from the bottom to the top of the graph.
603 --
604 -- There better had not be any cyclic groups here -- we check for them.
605
606 upsweep
607 :: GhcMonad m
608 => HomePackageTable -- ^ HPT from last time round (pruned)
609 -> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability)
610 -> (HscEnv -> IO ()) -- ^ How to clean up unwanted tmp files
611 -> [SCC ModSummary] -- ^ Mods to do (the worklist)
612 -> m (SuccessFlag,
613 [ModSummary])
614 -- ^ Returns:
615 --
616 -- 1. A flag whether the complete upsweep was successful.
617 -- 2. The 'HscEnv' in the monad has an updated HPT
618 -- 3. A list of modules which succeeded loading.
619
620 upsweep old_hpt stable_mods cleanup sccs = do
621 (res, done) <- upsweep' old_hpt [] sccs 1 (length sccs)
622 return (res, reverse done)
623 where
624
625 upsweep' _old_hpt done
626 [] _ _
627 = return (Succeeded, done)
628
629 upsweep' _old_hpt done
630 (CyclicSCC ms:_) _ _
631 = do dflags <- getSessionDynFlags
632 liftIO $ fatalErrorMsg dflags (cyclicModuleErr ms)
633 return (Failed, done)
634
635 upsweep' old_hpt done
636 (AcyclicSCC mod:mods) mod_index nmods
637 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
638 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
639 -- (moduleEnvElts (hsc_HPT hsc_env)))
640 let logger _mod = defaultWarnErrLogger
641
642 hsc_env <- getSession
643
644 -- Remove unwanted tmp files between compilations
645 liftIO (cleanup hsc_env)
646
647 mb_mod_info
648 <- handleSourceError
649 (\err -> do logger mod (Just err); return Nothing) $ do
650 mod_info <- liftIO $ upsweep_mod hsc_env old_hpt stable_mods
651 mod mod_index nmods
652 logger mod Nothing -- log warnings
653 return (Just mod_info)
654
655 case mb_mod_info of
656 Nothing -> return (Failed, done)
657 Just mod_info -> do
658 let this_mod = ms_mod_name mod
659
660 -- Add new info to hsc_env
661 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
662 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
663
664 -- Space-saving: delete the old HPT entry
665 -- for mod BUT if mod is a hs-boot
666 -- node, don't delete it. For the
667 -- interface, the HPT entry is probaby for the
668 -- main Haskell source file. Deleting it
669 -- would force the real module to be recompiled
670 -- every time.
671 old_hpt1 | isBootSummary mod = old_hpt
672 | otherwise = delFromUFM old_hpt this_mod
673
674 done' = mod:done
675
676 -- fixup our HomePackageTable after we've finished compiling
677 -- a mutually-recursive loop. See reTypecheckLoop, below.
678 hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done'
679 setSession hsc_env2
680
681 upsweep' old_hpt1 done' mods (mod_index+1) nmods
682
683 -- | Compile a single module. Always produce a Linkable for it if
684 -- successful. If no compilation happened, return the old Linkable.
685 upsweep_mod :: HscEnv
686 -> HomePackageTable
687 -> ([ModuleName],[ModuleName])
688 -> ModSummary
689 -> Int -- index of module
690 -> Int -- total number of modules
691 -> IO HomeModInfo
692
693 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
694 = let
695 this_mod_name = ms_mod_name summary
696 this_mod = ms_mod summary
697 mb_obj_date = ms_obj_date summary
698 obj_fn = ml_obj_file (ms_location summary)
699 hs_date = ms_hs_date summary
700
701 is_stable_obj = this_mod_name `elem` stable_obj
702 is_stable_bco = this_mod_name `elem` stable_bco
703
704 old_hmi = lookupUFM old_hpt this_mod_name
705
706 -- We're using the dflags for this module now, obtained by
707 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
708 dflags = ms_hspp_opts summary
709 prevailing_target = hscTarget (hsc_dflags hsc_env)
710 local_target = hscTarget dflags
711
712 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
713 -- we don't do anything dodgy: these should only work to change
714 -- from -fvia-C to -fasm and vice-versa, otherwise we could
715 -- end up trying to link object code to byte code.
716 target = if prevailing_target /= local_target
717 && (not (isObjectTarget prevailing_target)
718 || not (isObjectTarget local_target))
719 then prevailing_target
720 else local_target
721
722 -- store the corrected hscTarget into the summary
723 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
724
725 -- The old interface is ok if
726 -- a) we're compiling a source file, and the old HPT
727 -- entry is for a source file
728 -- b) we're compiling a hs-boot file
729 -- Case (b) allows an hs-boot file to get the interface of its
730 -- real source file on the second iteration of the compilation
731 -- manager, but that does no harm. Otherwise the hs-boot file
732 -- will always be recompiled
733
734 mb_old_iface
735 = case old_hmi of
736 Nothing -> Nothing
737 Just hm_info | isBootSummary summary -> Just iface
738 | not (mi_boot iface) -> Just iface
739 | otherwise -> Nothing
740 where
741 iface = hm_iface hm_info
742
743 compile_it :: Maybe Linkable -> SourceModified -> IO HomeModInfo
744 compile_it mb_linkable src_modified =
745 compile hsc_env summary' mod_index nmods
746 mb_old_iface mb_linkable src_modified
747
748 compile_it_discard_iface :: Maybe Linkable -> SourceModified
749 -> IO HomeModInfo
750 compile_it_discard_iface mb_linkable src_modified =
751 compile hsc_env summary' mod_index nmods
752 Nothing mb_linkable src_modified
753
754 -- With the HscNothing target we create empty linkables to avoid
755 -- recompilation. We have to detect these to recompile anyway if
756 -- the target changed since the last compile.
757 is_fake_linkable
758 | Just hmi <- old_hmi, Just l <- hm_linkable hmi =
759 null (linkableUnlinked l)
760 | otherwise =
761 -- we have no linkable, so it cannot be fake
762 False
763
764 implies False _ = True
765 implies True x = x
766
767 in
768 case () of
769 _
770 -- Regardless of whether we're generating object code or
771 -- byte code, we can always use an existing object file
772 -- if it is *stable* (see checkStability).
773 | is_stable_obj, Just hmi <- old_hmi -> do
774 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
775 (text "skipping stable obj mod:" <+> ppr this_mod_name)
776 return hmi
777 -- object is stable, and we have an entry in the
778 -- old HPT: nothing to do
779
780 | is_stable_obj, isNothing old_hmi -> do
781 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
782 (text "compiling stable on-disk mod:" <+> ppr this_mod_name)
783 linkable <- liftIO $ findObjectLinkable this_mod obj_fn
784 (expectJust "upsweep1" mb_obj_date)
785 compile_it (Just linkable) SourceUnmodifiedAndStable
786 -- object is stable, but we need to load the interface
787 -- off disk to make a HMI.
788
789 | not (isObjectTarget target), is_stable_bco,
790 (target /= HscNothing) `implies` not is_fake_linkable ->
791 ASSERT(isJust old_hmi) -- must be in the old_hpt
792 let Just hmi = old_hmi in do
793 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
794 (text "skipping stable BCO mod:" <+> ppr this_mod_name)
795 return hmi
796 -- BCO is stable: nothing to do
797
798 | not (isObjectTarget target),
799 Just hmi <- old_hmi,
800 Just l <- hm_linkable hmi,
801 not (isObjectLinkable l),
802 (target /= HscNothing) `implies` not is_fake_linkable,
803 linkableTime l >= ms_hs_date summary -> do
804 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
805 (text "compiling non-stable BCO mod:" <+> ppr this_mod_name)
806 compile_it (Just l) SourceUnmodified
807 -- we have an old BCO that is up to date with respect
808 -- to the source: do a recompilation check as normal.
809
810 -- When generating object code, if there's an up-to-date
811 -- object file on the disk, then we can use it.
812 -- However, if the object file is new (compared to any
813 -- linkable we had from a previous compilation), then we
814 -- must discard any in-memory interface, because this
815 -- means the user has compiled the source file
816 -- separately and generated a new interface, that we must
817 -- read from the disk.
818 --
819 | isObjectTarget target,
820 Just obj_date <- mb_obj_date,
821 obj_date >= hs_date -> do
822 case old_hmi of
823 Just hmi
824 | Just l <- hm_linkable hmi,
825 isObjectLinkable l && linkableTime l == obj_date -> do
826 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
827 (text "compiling mod with new on-disk obj:" <+> ppr this_mod_name)
828 compile_it (Just l) SourceUnmodified
829 _otherwise -> do
830 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
831 (text "compiling mod with new on-disk obj2:" <+> ppr this_mod_name)
832 linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date
833 compile_it_discard_iface (Just linkable) SourceUnmodified
834
835 _otherwise -> do
836 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
837 (text "compiling mod:" <+> ppr this_mod_name)
838 compile_it Nothing SourceModified
839
840
841
842 -- Filter modules in the HPT
843 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
844 retainInTopLevelEnvs keep_these hpt
845 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
846 | mod <- keep_these
847 , let mb_mod_info = lookupUFM hpt mod
848 , isJust mb_mod_info ]
849
850 -- ---------------------------------------------------------------------------
851 -- Typecheck module loops
852
853 {-
854 See bug #930. This code fixes a long-standing bug in --make. The
855 problem is that when compiling the modules *inside* a loop, a data
856 type that is only defined at the top of the loop looks opaque; but
857 after the loop is done, the structure of the data type becomes
858 apparent.
859
860 The difficulty is then that two different bits of code have
861 different notions of what the data type looks like.
862
863 The idea is that after we compile a module which also has an .hs-boot
864 file, we re-generate the ModDetails for each of the modules that
865 depends on the .hs-boot file, so that everyone points to the proper
866 TyCons, Ids etc. defined by the real module, not the boot module.
867 Fortunately re-generating a ModDetails from a ModIface is easy: the
868 function TcIface.typecheckIface does exactly that.
869
870 Picking the modules to re-typecheck is slightly tricky. Starting from
871 the module graph consisting of the modules that have already been
872 compiled, we reverse the edges (so they point from the imported module
873 to the importing module), and depth-first-search from the .hs-boot
874 node. This gives us all the modules that depend transitively on the
875 .hs-boot module, and those are exactly the modules that we need to
876 re-typecheck.
877
878 Following this fix, GHC can compile itself with --make -O2.
879 -}
880
881 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
882 reTypecheckLoop hsc_env ms graph
883 | not (isBootSummary ms) &&
884 any (\m -> ms_mod m == this_mod && isBootSummary m) graph
885 = do
886 let mss = reachableBackwards (ms_mod_name ms) graph
887 non_boot = filter (not.isBootSummary) mss
888 debugTraceMsg (hsc_dflags hsc_env) 2 $
889 text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
890 typecheckLoop hsc_env (map ms_mod_name non_boot)
891 | otherwise
892 = return hsc_env
893 where
894 this_mod = ms_mod ms
895
896 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
897 typecheckLoop hsc_env mods = do
898 new_hpt <-
899 fixIO $ \new_hpt -> do
900 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
901 mds <- initIfaceCheck new_hsc_env $
902 mapM (typecheckIface . hm_iface) hmis
903 let new_hpt = addListToUFM old_hpt
904 (zip mods [ hmi{ hm_details = details }
905 | (hmi,details) <- zip hmis mds ])
906 return new_hpt
907 return hsc_env{ hsc_HPT = new_hpt }
908 where
909 old_hpt = hsc_HPT hsc_env
910 hmis = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
911
912 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
913 reachableBackwards mod summaries
914 = [ ms | (ms,_,_) <- reachableG (transposeG graph) root ]
915 where -- the rest just sets up the graph:
916 (graph, lookup_node) = moduleGraphNodes False summaries
917 root = expectJust "reachableBackwards" (lookup_node HsBootFile mod)
918
919 -- ---------------------------------------------------------------------------
920 -- Topological sort of the module graph
921
922 type SummaryNode = (ModSummary, Int, [Int])
923
924 topSortModuleGraph
925 :: Bool
926 -- ^ Drop hi-boot nodes? (see below)
927 -> [ModSummary]
928 -> Maybe ModuleName
929 -- ^ Root module name. If @Nothing@, use the full graph.
930 -> [SCC ModSummary]
931 -- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
932 -- The resulting list of strongly-connected-components is in topologically
933 -- sorted order, starting with the module(s) at the bottom of the
934 -- dependency graph (ie compile them first) and ending with the ones at
935 -- the top.
936 --
937 -- Drop hi-boot nodes (first boolean arg)?
938 --
939 -- - @False@: treat the hi-boot summaries as nodes of the graph,
940 -- so the graph must be acyclic
941 --
942 -- - @True@: eliminate the hi-boot nodes, and instead pretend
943 -- the a source-import of Foo is an import of Foo
944 -- The resulting graph has no hi-boot nodes, but can be cyclic
945
946 topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
947 = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph
948 where
949 (graph, lookup_node) = moduleGraphNodes drop_hs_boot_nodes summaries
950
951 initial_graph = case mb_root_mod of
952 Nothing -> graph
953 Just root_mod ->
954 -- restrict the graph to just those modules reachable from
955 -- the specified module. We do this by building a graph with
956 -- the full set of nodes, and determining the reachable set from
957 -- the specified node.
958 let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
959 | otherwise = ghcError (ProgramError "module does not exist")
960 in graphFromEdgedVertices (seq root (reachableG graph root))
961
962 summaryNodeKey :: SummaryNode -> Int
963 summaryNodeKey (_, k, _) = k
964
965 summaryNodeSummary :: SummaryNode -> ModSummary
966 summaryNodeSummary (s, _, _) = s
967
968 moduleGraphNodes :: Bool -> [ModSummary]
969 -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
970 moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)
971 where
972 numbered_summaries = zip summaries [1..]
973
974 lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode
975 lookup_node hs_src mod = Map.lookup (mod, hs_src) node_map
976
977 lookup_key :: HscSource -> ModuleName -> Maybe Int
978 lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)
979
980 node_map :: NodeMap SummaryNode
981 node_map = Map.fromList [ ((moduleName (ms_mod s), ms_hsc_src s), node)
982 | node@(s, _, _) <- nodes ]
983
984 -- We use integers as the keys for the SCC algorithm
985 nodes :: [SummaryNode]
986 nodes = [ (s, key, out_keys)
987 | (s, key) <- numbered_summaries
988 -- Drop the hi-boot ones if told to do so
989 , not (isBootSummary s && drop_hs_boot_nodes)
990 , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
991 out_edge_keys HsSrcFile (map unLoc (ms_home_imps s)) ++
992 (-- see [boot-edges] below
993 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
994 then []
995 else case lookup_key HsBootFile (ms_mod_name s) of
996 Nothing -> []
997 Just k -> [k]) ]
998
999 -- [boot-edges] if this is a .hs and there is an equivalent
1000 -- .hs-boot, add a link from the former to the latter. This
1001 -- has the effect of detecting bogus cases where the .hs-boot
1002 -- depends on the .hs, by introducing a cycle. Additionally,
1003 -- it ensures that we will always process the .hs-boot before
1004 -- the .hs, and so the HomePackageTable will always have the
1005 -- most up to date information.
1006
1007 -- Drop hs-boot nodes by using HsSrcFile as the key
1008 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1009 | otherwise = HsBootFile
1010
1011 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1012 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1013 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1014 -- the IsBootInterface parameter True; else False
1015
1016
1017 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
1018 type NodeMap a = Map.Map NodeKey a -- keyed by (mod, src_file_type) pairs
1019
1020 msKey :: ModSummary -> NodeKey
1021 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1022
1023 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1024 mkNodeMap summaries = Map.fromList [ (msKey s, s) | s <- summaries]
1025
1026 nodeMapElts :: NodeMap a -> [a]
1027 nodeMapElts = Map.elems
1028
1029 -- | If there are {-# SOURCE #-} imports between strongly connected
1030 -- components in the topological sort, then those imports can
1031 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1032 -- were necessary, then the edge would be part of a cycle.
1033 warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()
1034 warnUnnecessarySourceImports sccs = do
1035 logWarnings (listToBag (concatMap (check.flattenSCC) sccs))
1036 where check ms =
1037 let mods_in_this_cycle = map ms_mod_name ms in
1038 [ warn i | m <- ms, i <- ms_home_srcimps m,
1039 unLoc i `notElem` mods_in_this_cycle ]
1040
1041 warn :: Located ModuleName -> WarnMsg
1042 warn (L loc mod) =
1043 mkPlainErrMsg loc
1044 (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
1045 <+> quotes (ppr mod))
1046
1047 -----------------------------------------------------------------------------
1048 -- Downsweep (dependency analysis)
1049
1050 -- Chase downwards from the specified root set, returning summaries
1051 -- for all home modules encountered. Only follow source-import
1052 -- links.
1053
1054 -- We pass in the previous collection of summaries, which is used as a
1055 -- cache to avoid recalculating a module summary if the source is
1056 -- unchanged.
1057 --
1058 -- The returned list of [ModSummary] nodes has one node for each home-package
1059 -- module, plus one for any hs-boot files. The imports of these nodes
1060 -- are all there, including the imports of non-home-package modules.
1061
1062 downsweep :: HscEnv
1063 -> [ModSummary] -- Old summaries
1064 -> [ModuleName] -- Ignore dependencies on these; treat
1065 -- them as if they were package modules
1066 -> Bool -- True <=> allow multiple targets to have
1067 -- the same module name; this is
1068 -- very useful for ghc -M
1069 -> IO [ModSummary]
1070 -- The elts of [ModSummary] all have distinct
1071 -- (Modules, IsBoot) identifiers, unless the Bool is true
1072 -- in which case there can be repeats
1073 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1074 = do
1075 rootSummaries <- mapM getRootSummary roots
1076 let root_map = mkRootMap rootSummaries
1077 checkDuplicates root_map
1078 summs <- loop (concatMap msDeps rootSummaries) root_map
1079 return summs
1080 where
1081 roots = hsc_targets hsc_env
1082
1083 old_summary_map :: NodeMap ModSummary
1084 old_summary_map = mkNodeMap old_summaries
1085
1086 getRootSummary :: Target -> IO ModSummary
1087 getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)
1088 = do exists <- liftIO $ doesFileExist file
1089 if exists
1090 then summariseFile hsc_env old_summaries file mb_phase
1091 obj_allowed maybe_buf
1092 else throwOneError $ mkPlainErrMsg noSrcSpan $
1093 text "can't find file:" <+> text file
1094 getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
1095 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1096 (L rootLoc modl) obj_allowed
1097 maybe_buf excl_mods
1098 case maybe_summary of
1099 Nothing -> packageModErr modl
1100 Just s -> return s
1101
1102 rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1103
1104 -- In a root module, the filename is allowed to diverge from the module
1105 -- name, so we have to check that there aren't multiple root files
1106 -- defining the same module (otherwise the duplicates will be silently
1107 -- ignored, leading to confusing behaviour).
1108 checkDuplicates :: NodeMap [ModSummary] -> IO ()
1109 checkDuplicates root_map
1110 | allow_dup_roots = return ()
1111 | null dup_roots = return ()
1112 | otherwise = liftIO $ multiRootsErr (head dup_roots)
1113 where
1114 dup_roots :: [[ModSummary]] -- Each at least of length 2
1115 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1116
1117 loop :: [(Located ModuleName,IsBootInterface)]
1118 -- Work list: process these modules
1119 -> NodeMap [ModSummary]
1120 -- Visited set; the range is a list because
1121 -- the roots can have the same module names
1122 -- if allow_dup_roots is True
1123 -> IO [ModSummary]
1124 -- The result includes the worklist, except
1125 -- for those mentioned in the visited set
1126 loop [] done = return (concat (nodeMapElts done))
1127 loop ((wanted_mod, is_boot) : ss) done
1128 | Just summs <- Map.lookup key done
1129 = if isSingleton summs then
1130 loop ss done
1131 else
1132 do { multiRootsErr summs; return [] }
1133 | otherwise
1134 = do mb_s <- summariseModule hsc_env old_summary_map
1135 is_boot wanted_mod True
1136 Nothing excl_mods
1137 case mb_s of
1138 Nothing -> loop ss done
1139 Just s -> loop (msDeps s ++ ss) (Map.insert key [s] done)
1140 where
1141 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1142
1143 -- XXX Does the (++) here need to be flipped?
1144 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1145 mkRootMap summaries = Map.insertListWith (flip (++))
1146 [ (msKey s, [s]) | s <- summaries ]
1147 Map.empty
1148
1149 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
1150 -- (msDeps s) returns the dependencies of the ModSummary s.
1151 -- A wrinkle is that for a {-# SOURCE #-} import we return
1152 -- *both* the hs-boot file
1153 -- *and* the source file
1154 -- as "dependencies". That ensures that the list of all relevant
1155 -- modules always contains B.hs if it contains B.hs-boot.
1156 -- Remember, this pass isn't doing the topological sort. It's
1157 -- just gathering the list of all relevant ModSummaries
1158 msDeps s =
1159 concat [ [(m,True), (m,False)] | m <- ms_home_srcimps s ]
1160 ++ [ (m,False) | m <- ms_home_imps s ]
1161
1162 home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
1163 home_imps imps = [ ideclName i | L _ i <- imps, isLocal (ideclPkgQual i) ]
1164 where isLocal Nothing = True
1165 isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special
1166 isLocal _ = False
1167
1168 ms_home_allimps :: ModSummary -> [ModuleName]
1169 ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
1170
1171 ms_home_srcimps :: ModSummary -> [Located ModuleName]
1172 ms_home_srcimps = home_imps . ms_srcimps
1173
1174 ms_home_imps :: ModSummary -> [Located ModuleName]
1175 ms_home_imps = home_imps . ms_imps
1176
1177 -----------------------------------------------------------------------------
1178 -- Summarising modules
1179
1180 -- We have two types of summarisation:
1181 --
1182 -- * Summarise a file. This is used for the root module(s) passed to
1183 -- cmLoadModules. The file is read, and used to determine the root
1184 -- module name. The module name may differ from the filename.
1185 --
1186 -- * Summarise a module. We are given a module name, and must provide
1187 -- a summary. The finder is used to locate the file in which the module
1188 -- resides.
1189
1190 summariseFile
1191 :: HscEnv
1192 -> [ModSummary] -- old summaries
1193 -> FilePath -- source file name
1194 -> Maybe Phase -- start phase
1195 -> Bool -- object code allowed?
1196 -> Maybe (StringBuffer,ClockTime)
1197 -> IO ModSummary
1198
1199 summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
1200 -- we can use a cached summary if one is available and the
1201 -- source file hasn't changed, But we have to look up the summary
1202 -- by source file, rather than module name as we do in summarise.
1203 | Just old_summary <- findSummaryBySourceFile old_summaries file
1204 = do
1205 let location = ms_location old_summary
1206
1207 -- return the cached summary if the source didn't change
1208 src_timestamp <- case maybe_buf of
1209 Just (_,t) -> return t
1210 Nothing -> liftIO $ getModificationTime file
1211 -- The file exists; we checked in getRootSummary above.
1212 -- If it gets removed subsequently, then this
1213 -- getModificationTime may fail, but that's the right
1214 -- behaviour.
1215
1216 if ms_hs_date old_summary == src_timestamp
1217 then do -- update the object-file timestamp
1218 obj_timestamp <-
1219 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1220 || obj_allowed -- bug #1205
1221 then liftIO $ getObjTimestamp location False
1222 else return Nothing
1223 return old_summary{ ms_obj_date = obj_timestamp }
1224 else
1225 new_summary
1226
1227 | otherwise
1228 = new_summary
1229 where
1230 new_summary = do
1231 let dflags = hsc_dflags hsc_env
1232
1233 (dflags', hspp_fn, buf)
1234 <- preprocessFile hsc_env file mb_phase maybe_buf
1235
1236 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
1237
1238 -- Make a ModLocation for this file
1239 location <- liftIO $ mkHomeModLocation dflags mod_name file
1240
1241 -- Tell the Finder cache where it is, so that subsequent calls
1242 -- to findModule will find it, even if it's not on any search path
1243 mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location
1244
1245 src_timestamp <- case maybe_buf of
1246 Just (_,t) -> return t
1247 Nothing -> liftIO $ getModificationTime file
1248 -- getMofificationTime may fail
1249
1250 -- when the user asks to load a source file by name, we only
1251 -- use an object file if -fobject-code is on. See #1205.
1252 obj_timestamp <-
1253 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1254 || obj_allowed -- bug #1205
1255 then liftIO $ modificationTimeIfExists (ml_obj_file location)
1256 else return Nothing
1257
1258 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1259 ms_location = location,
1260 ms_hspp_file = hspp_fn,
1261 ms_hspp_opts = dflags',
1262 ms_hspp_buf = Just buf,
1263 ms_srcimps = srcimps, ms_textual_imps = the_imps,
1264 ms_hs_date = src_timestamp,
1265 ms_obj_date = obj_timestamp })
1266
1267 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
1268 findSummaryBySourceFile summaries file
1269 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
1270 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
1271 [] -> Nothing
1272 (x:_) -> Just x
1273
1274 -- Summarise a module, and pick up source and timestamp.
1275 summariseModule
1276 :: HscEnv
1277 -> NodeMap ModSummary -- Map of old summaries
1278 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
1279 -> Located ModuleName -- Imported module to be summarised
1280 -> Bool -- object code allowed?
1281 -> Maybe (StringBuffer, ClockTime)
1282 -> [ModuleName] -- Modules to exclude
1283 -> IO (Maybe ModSummary) -- Its new summary
1284
1285 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
1286 obj_allowed maybe_buf excl_mods
1287 | wanted_mod `elem` excl_mods
1288 = return Nothing
1289
1290 | Just old_summary <- Map.lookup (wanted_mod, hsc_src) old_summary_map
1291 = do -- Find its new timestamp; all the
1292 -- ModSummaries in the old map have valid ml_hs_files
1293 let location = ms_location old_summary
1294 src_fn = expectJust "summariseModule" (ml_hs_file location)
1295
1296 -- check the modification time on the source file, and
1297 -- return the cached summary if it hasn't changed. If the
1298 -- file has disappeared, we need to call the Finder again.
1299 case maybe_buf of
1300 Just (_,t) -> check_timestamp old_summary location src_fn t
1301 Nothing -> do
1302 m <- tryIO (getModificationTime src_fn)
1303 case m of
1304 Right t -> check_timestamp old_summary location src_fn t
1305 Left e | isDoesNotExistError e -> find_it
1306 | otherwise -> ioError e
1307
1308 | otherwise = find_it
1309 where
1310 dflags = hsc_dflags hsc_env
1311
1312 hsc_src = if is_boot then HsBootFile else HsSrcFile
1313
1314 check_timestamp old_summary location src_fn src_timestamp
1315 | ms_hs_date old_summary == src_timestamp = do
1316 -- update the object-file timestamp
1317 obj_timestamp <-
1318 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1319 || obj_allowed -- bug #1205
1320 then getObjTimestamp location is_boot
1321 else return Nothing
1322 return (Just old_summary{ ms_obj_date = obj_timestamp })
1323 | otherwise =
1324 -- source changed: re-summarise.
1325 new_summary location (ms_mod old_summary) src_fn src_timestamp
1326
1327 find_it = do
1328 -- Don't use the Finder's cache this time. If the module was
1329 -- previously a package module, it may have now appeared on the
1330 -- search path, so we want to consider it to be a home module. If
1331 -- the module was previously a home module, it may have moved.
1332 uncacheModule hsc_env wanted_mod
1333 found <- findImportedModule hsc_env wanted_mod Nothing
1334 case found of
1335 Found location mod
1336 | isJust (ml_hs_file location) ->
1337 -- Home package
1338 just_found location mod
1339 | otherwise ->
1340 -- Drop external-pkg
1341 ASSERT(modulePackageId mod /= thisPackage dflags)
1342 return Nothing
1343
1344 err -> noModError dflags loc wanted_mod err
1345 -- Not found
1346
1347 just_found location mod = do
1348 -- Adjust location to point to the hs-boot source file,
1349 -- hi file, object file, when is_boot says so
1350 let location' | is_boot = addBootSuffixLocn location
1351 | otherwise = location
1352 src_fn = expectJust "summarise2" (ml_hs_file location')
1353
1354 -- Check that it exists
1355 -- It might have been deleted since the Finder last found it
1356 maybe_t <- modificationTimeIfExists src_fn
1357 case maybe_t of
1358 Nothing -> noHsFileErr loc src_fn
1359 Just t -> new_summary location' mod src_fn t
1360
1361
1362 new_summary location mod src_fn src_timestamp
1363 = do
1364 -- Preprocess the source file and get its imports
1365 -- The dflags' contains the OPTIONS pragmas
1366 (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
1367 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
1368
1369 when (mod_name /= wanted_mod) $
1370 throwOneError $ mkPlainErrMsg mod_loc $
1371 text "File name does not match module name:"
1372 $$ text "Saw:" <+> quotes (ppr mod_name)
1373 $$ text "Expected:" <+> quotes (ppr wanted_mod)
1374
1375 -- Find the object timestamp, and return the summary
1376 obj_timestamp <-
1377 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1378 || obj_allowed -- bug #1205
1379 then getObjTimestamp location is_boot
1380 else return Nothing
1381
1382 return (Just (ModSummary { ms_mod = mod,
1383 ms_hsc_src = hsc_src,
1384 ms_location = location,
1385 ms_hspp_file = hspp_fn,
1386 ms_hspp_opts = dflags',
1387 ms_hspp_buf = Just buf,
1388 ms_srcimps = srcimps,
1389 ms_textual_imps = the_imps,
1390 ms_hs_date = src_timestamp,
1391 ms_obj_date = obj_timestamp }))
1392
1393
1394 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
1395 getObjTimestamp location is_boot
1396 = if is_boot then return Nothing
1397 else modificationTimeIfExists (ml_obj_file location)
1398
1399
1400 preprocessFile :: HscEnv
1401 -> FilePath
1402 -> Maybe Phase -- ^ Starting phase
1403 -> Maybe (StringBuffer,ClockTime)
1404 -> IO (DynFlags, FilePath, StringBuffer)
1405 preprocessFile hsc_env src_fn mb_phase Nothing
1406 = do
1407 (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
1408 buf <- hGetStringBuffer hspp_fn
1409 return (dflags', hspp_fn, buf)
1410
1411 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
1412 = do
1413 let dflags = hsc_dflags hsc_env
1414 let local_opts = getOptions dflags buf src_fn
1415
1416 (dflags', leftovers, warns)
1417 <- parseDynamicFilePragma dflags local_opts
1418 checkProcessArgsResult leftovers
1419 handleFlagWarnings dflags' warns
1420
1421 let needs_preprocessing
1422 | Just (Unlit _) <- mb_phase = True
1423 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
1424 -- note: local_opts is only required if there's no Unlit phase
1425 | xopt Opt_Cpp dflags' = True
1426 | dopt Opt_Pp dflags' = True
1427 | otherwise = False
1428
1429 when needs_preprocessing $
1430 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
1431
1432 return (dflags', src_fn, buf)
1433
1434
1435 -----------------------------------------------------------------------------
1436 -- Error messages
1437 -----------------------------------------------------------------------------
1438
1439 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
1440 -- ToDo: we don't have a proper line number for this error
1441 noModError dflags loc wanted_mod err
1442 = throwOneError $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
1443
1444 noHsFileErr :: SrcSpan -> String -> IO a
1445 noHsFileErr loc path
1446 = throwOneError $ mkPlainErrMsg loc $ text "Can't find" <+> text path
1447
1448 packageModErr :: ModuleName -> IO a
1449 packageModErr mod
1450 = throwOneError $ mkPlainErrMsg noSrcSpan $
1451 text "module" <+> quotes (ppr mod) <+> text "is a package module"
1452
1453 multiRootsErr :: [ModSummary] -> IO ()
1454 multiRootsErr [] = panic "multiRootsErr"
1455 multiRootsErr summs@(summ1:_)
1456 = throwOneError $ mkPlainErrMsg noSrcSpan $
1457 text "module" <+> quotes (ppr mod) <+>
1458 text "is defined in multiple files:" <+>
1459 sep (map text files)
1460 where
1461 mod = ms_mod summ1
1462 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
1463
1464 cyclicModuleErr :: [ModSummary] -> SDoc
1465 -- From a strongly connected component we find
1466 -- a single cycle to report
1467 cyclicModuleErr mss
1468 = ASSERT( not (null mss) )
1469 case findCycle graph of
1470 Nothing -> ptext (sLit "Unexpected non-cycle") <+> ppr mss
1471 Just path -> vcat [ ptext (sLit "Module imports form a cycle:")
1472 , nest 2 (show_path path) ]
1473 where
1474 graph :: [Node NodeKey ModSummary]
1475 graph = [(ms, msKey ms, get_deps ms) | ms <- mss]
1476
1477 get_deps :: ModSummary -> [NodeKey]
1478 get_deps ms = ([ (unLoc m, HsBootFile) | m <- ms_home_srcimps ms ] ++
1479 [ (unLoc m, HsSrcFile) | m <- ms_home_imps ms ])
1480
1481 show_path [] = panic "show_path"
1482 show_path [m] = ptext (sLit "module") <+> ppr_ms m
1483 <+> ptext (sLit "imports itself")
1484 show_path (m1:m2:ms) = vcat ( nest 7 (ptext (sLit "module") <+> ppr_ms m1)
1485 : nest 6 (ptext (sLit "imports") <+> ppr_ms m2)
1486 : go ms )
1487 where
1488 go [] = [ptext (sLit "which imports") <+> ppr_ms m1]
1489 go (m:ms) = (ptext (sLit "which imports") <+> ppr_ms m) : go ms
1490
1491
1492 ppr_ms :: ModSummary -> SDoc
1493 ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+>
1494 (parens (text (msHsFilePath ms)))
1495