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