2 % (c) The University of Glasgow, 2002
4 % The Compilation Manager
8 ModSummary, -- Abstract
9 ModuleGraph, -- All the modules from the home package
13 cmInit, -- :: GhciMode -> IO CmState
15 cmDepAnal, -- :: CmState -> [FilePath] -> IO ModuleGraph
16 cmTopSort, -- :: Bool -> ModuleGraph -> [SCC ModSummary]
17 cyclicModuleErr, -- :: [ModSummary] -> String -- Used by DriverMkDepend
19 cmLoadModules, -- :: CmState -> ModuleGraph
20 -- -> IO (CmState, Bool, [String])
22 cmUnload, -- :: CmState -> IO CmState
26 cmModuleIsInterpreted, -- :: CmState -> String -> IO Bool
28 cmSetContext, -- :: CmState -> [String] -> [String] -> IO CmState
29 cmGetContext, -- :: CmState -> IO ([String],[String])
31 cmGetInfo, -- :: CmState -> String -> IO (CmState, [(TyThing,Fixity)])
33 cmBrowseModule, -- :: CmState -> IO [TyThing]
37 cmRunStmt, -- :: CmState -> String -> IO (CmState, CmRunResult)
39 cmTypeOfExpr, -- :: CmState -> String -> IO (CmState, Maybe String)
40 cmKindOfType, -- :: CmState -> String -> IO (CmState, Maybe String)
41 cmTypeOfName, -- :: CmState -> Name -> IO (Maybe String)
44 cmCompileExpr, -- :: CmState -> String -> IO (CmState, Maybe HValue)
45 cmGetModuleGraph, -- :: CmState -> ModuleGraph
49 cmGetBindings, -- :: CmState -> [TyThing]
50 cmGetPrintUnqual, -- :: CmState -> PrintUnqualified
55 #include "HsVersions.h"
57 import Packages ( isHomePackage )
58 import DriverPipeline ( CompResult(..), preprocess, compile, link )
59 import HscMain ( newHscEnv )
60 import DriverState ( v_Output_file, v_NoHsMain, v_MainModIs )
61 import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, isHaskellSrcFilename )
62 import Finder ( findModule, findLinkable, addHomeModuleToFinder, flushFinderCache,
63 mkHomeModLocation, FindResult(..), cantFindError )
64 import HscTypes ( ModSummary(..), HomeModInfo(..), ModIface(..), msHsFilePath,
65 HscEnv(..), GhciMode(..),
66 InteractiveContext(..), emptyInteractiveContext,
67 HomePackageTable, emptyHomePackageTable, IsBootInterface,
68 Linkable(..), isObjectLinkable )
69 import Module ( Module, mkModule, delModuleEnv, delModuleEnvList, mkModuleEnv,
70 lookupModuleEnv, moduleEnvElts, extendModuleEnv, filterModuleEnv,
71 moduleUserString, addBootSuffixLocn,
73 import GetImports ( getImports )
74 import Digraph ( SCC(..), stronglyConnComp, flattenSCC, flattenSCCs )
75 import ErrUtils ( showPass )
76 import SysTools ( cleanTempFilesExcept )
77 import BasicTypes ( SuccessFlag(..), succeeded )
78 import StringBuffer ( hGetStringBuffer )
82 import CmdLineOpts ( DynFlags(..) )
83 import Maybes ( expectJust, orElse, mapCatMaybes )
86 import DATA_IOREF ( readIORef )
89 import HscMain ( hscGetInfo, GetInfoResult, hscStmt, hscTcExpr, hscKcType )
90 import HscTypes ( TyThing(..), icPrintUnqual, showModMsg )
91 import TcRnDriver ( mkExportEnv, getModuleContents )
92 import IfaceSyn ( IfaceDecl )
93 import RdrName ( GlobalRdrEnv, plusGlobalRdrEnv )
97 import Type ( tidyType )
98 import VarEnv ( emptyTidyEnv )
99 import Linker ( HValue, unload, extendLinkEnv )
100 import GHC.Exts ( unsafeCoerce# )
102 import Control.Exception as Exception ( Exception, try )
103 import CmdLineOpts ( DynFlag(..), dopt_unset )
106 import EXCEPTION ( throwDyn )
109 import Directory ( getModificationTime, doesFileExist )
117 %************************************************************************
119 The module dependency graph
120 ModSummary, ModGraph, NodeKey, NodeMap
122 %************************************************************************
124 The nodes of the module graph are
125 EITHER a regular Haskell source module
126 OR a hi-boot source module
128 A ModuleGraph contains all the nodes from the home package (only).
129 There will be a node for each source module, plus a node for each hi-boot
133 type ModuleGraph = [ModSummary] -- The module graph,
134 -- NOT NECESSARILY IN TOPOLOGICAL ORDER
136 emptyMG :: ModuleGraph
140 ms_allimps :: ModSummary -> [Module]
141 ms_allimps ms = ms_srcimps ms ++ ms_imps ms
144 type NodeKey = (Module, HscSource) -- The nodes of the graph are
145 type NodeMap a = FiniteMap NodeKey a -- keyed by (mod, src_file_type) pairs
147 msKey :: ModSummary -> NodeKey
148 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (mod,boot)
150 emptyNodeMap :: NodeMap a
151 emptyNodeMap = emptyFM
153 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
154 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
156 nodeMapElts :: NodeMap a -> [a]
161 %************************************************************************
163 The compilation manager state
165 %************************************************************************
169 -- Persistent state for the entire system
172 cm_hsc :: HscEnv, -- Includes the home-package table
173 cm_mg :: ModuleGraph, -- The module graph
174 cm_ic :: InteractiveContext -- Command-line binding info
178 cmGetModuleGraph cmstate = cm_mg cmstate
179 cmGetBindings cmstate = nameEnvElts (ic_type_env (cm_ic cmstate))
180 cmGetPrintUnqual cmstate = icPrintUnqual (cm_ic cmstate)
181 cmHPT cmstate = hsc_HPT (cm_hsc cmstate)
184 cmInit :: GhciMode -> DynFlags -> IO CmState
185 cmInit ghci_mode dflags
186 = do { hsc_env <- newHscEnv ghci_mode dflags
187 ; return (CmState { cm_hsc = hsc_env,
189 cm_ic = emptyInteractiveContext })}
191 discardCMInfo :: CmState -> CmState
192 -- Forget the compilation manager's state, including the home package table
193 -- but retain the persistent info in HscEnv
194 discardCMInfo cm_state
195 = cm_state { cm_mg = emptyMG, cm_ic = emptyInteractiveContext,
196 cm_hsc = (cm_hsc cm_state) { hsc_HPT = emptyHomePackageTable } }
198 -------------------------------------------------------------------
199 -- The unlinked image
201 -- The compilation manager keeps a list of compiled, but as-yet unlinked
202 -- binaries (byte code or object code). Even when it links bytecode
203 -- it keeps the unlinked version so it can re-link it later without
206 type UnlinkedImage = [Linkable] -- the unlinked images (should be a set, really)
208 findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable
209 findModuleLinkable_maybe lis mod
210 = case [LM time nm us | LM time nm us <- lis, nm == mod] of
213 many -> pprPanic "findModuleLinkable" (ppr mod)
215 delModuleLinkable :: [Linkable] -> Module -> [Linkable]
216 delModuleLinkable ls mod = [ l | l@(LM _ nm _) <- ls, nm /= mod ]
220 %************************************************************************
224 %************************************************************************
228 -----------------------------------------------------------------------------
229 -- Setting the context doesn't throw away any bindings; the bindings
230 -- we've built up in the InteractiveContext simply move to the new
231 -- module. They always shadow anything in scope in the current context.
235 -> [String] -- take the top-level scopes of these modules
236 -> [String] -- and the just the exports from these
238 cmSetContext cmstate toplevs exports = do
239 let old_ic = cm_ic cmstate
240 hsc_env = cm_hsc cmstate
241 hpt = hsc_HPT hsc_env
243 export_env <- mkExportEnv hsc_env (map mkModule exports)
244 toplev_envs <- mapM (mkTopLevEnv hpt) toplevs
246 let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
247 return cmstate{ cm_ic = old_ic { ic_toplev_scope = toplevs,
248 ic_exports = exports,
249 ic_rn_gbl_env = all_env } }
251 mkTopLevEnv :: HomePackageTable -> String -> IO GlobalRdrEnv
253 = case lookupModuleEnv hpt (mkModule mod) of
254 Nothing -> throwDyn (ProgramError ("mkTopLevEnv: not a home module " ++ mod))
255 Just details -> case hm_globals details of
256 Nothing -> throwDyn (ProgramError ("mkTopLevEnv: not interpreted " ++ mod))
257 Just env -> return env
259 cmGetContext :: CmState -> IO ([String],[String])
260 cmGetContext CmState{cm_ic=ic} =
261 return (ic_toplev_scope ic, ic_exports ic)
263 cmModuleIsInterpreted :: CmState -> String -> IO Bool
264 cmModuleIsInterpreted cmstate str
265 = case lookupModuleEnv (cmHPT cmstate) (mkModule str) of
266 Just details -> return (isJust (hm_globals details))
267 _not_a_home_module -> return False
269 -----------------------------------------------------------------------------
271 cmSetDFlags :: CmState -> DynFlags -> CmState
272 cmSetDFlags cm_state dflags
273 = cm_state { cm_hsc = (cm_hsc cm_state) { hsc_dflags = dflags } }
275 cmGetDFlags :: CmState -> DynFlags
276 cmGetDFlags cm_state = hsc_dflags (cm_hsc cm_state)
278 -----------------------------------------------------------------------------
279 -- cmInfoThing: convert a String to a TyThing
281 -- A string may refer to more than one TyThing (eg. a constructor,
282 -- and type constructor), so we return a list of all the possible TyThings.
284 cmGetInfo :: CmState -> String -> IO [GetInfoResult]
285 cmGetInfo cmstate id = hscGetInfo (cm_hsc cmstate) (cm_ic cmstate) id
287 -- ---------------------------------------------------------------------------
288 -- cmBrowseModule: get all the TyThings defined in a module
290 cmBrowseModule :: CmState -> String -> Bool -> IO [IfaceDecl]
291 cmBrowseModule cmstate str exports_only
292 = do { mb_decls <- getModuleContents (cm_hsc cmstate) (cm_ic cmstate)
293 (mkModule str) exports_only
295 Nothing -> return [] -- An error of some kind
300 -----------------------------------------------------------------------------
301 cmShowModule :: CmState -> ModSummary -> String
302 cmShowModule cmstate mod_summary
303 = case lookupModuleEnv hpt (ms_mod mod_summary) of
304 Nothing -> panic "missing linkable"
305 Just mod_info -> showModMsg obj_linkable mod_summary
307 obj_linkable = isObjectLinkable (hm_linkable mod_info)
309 hpt = hsc_HPT (cm_hsc cmstate)
311 -----------------------------------------------------------------------------
312 -- cmRunStmt: Run a statement/expr.
315 = CmRunOk [Name] -- names bound by this evaluation
317 | CmRunException Exception -- statement raised an exception
319 cmRunStmt :: CmState -> String -> IO (CmState, CmRunResult)
320 cmRunStmt cmstate@CmState{ cm_hsc=hsc_env, cm_ic=icontext } expr
322 -- Turn off -fwarn-unused-bindings when running a statement, to hide
323 -- warnings about the implicit bindings we introduce.
324 let dflags' = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
325 hsc_env' = hsc_env{ hsc_dflags = dflags' }
327 maybe_stuff <- hscStmt hsc_env' icontext expr
330 Nothing -> return (cmstate, CmRunFailed)
331 Just (new_ic, names, hval) -> do
333 let thing_to_run = unsafeCoerce# hval :: IO [HValue]
334 either_hvals <- sandboxIO thing_to_run
338 -- on error, keep the *old* interactive context,
339 -- so that 'it' is not bound to something
340 -- that doesn't exist.
341 return ( cmstate, CmRunException e )
344 -- Get the newly bound things, and bind them.
345 -- Don't need to delete any shadowed bindings;
346 -- the new ones override the old ones.
347 extendLinkEnv (zip names hvals)
349 return (cmstate{ cm_ic=new_ic },
353 -- We run the statement in a "sandbox" to protect the rest of the
354 -- system from anything the expression might do. For now, this
355 -- consists of just wrapping it in an exception handler, but see below
356 -- for another version.
358 sandboxIO :: IO a -> IO (Either Exception a)
359 sandboxIO thing = Exception.try thing
362 -- This version of sandboxIO runs the expression in a completely new
363 -- RTS main thread. It is disabled for now because ^C exceptions
364 -- won't be delivered to the new thread, instead they'll be delivered
365 -- to the (blocked) GHCi main thread.
367 -- SLPJ: when re-enabling this, reflect a wrong-stat error as an exception
369 sandboxIO :: IO a -> IO (Either Int (Either Exception a))
371 st_thing <- newStablePtr (Exception.try thing)
372 alloca $ \ p_st_result -> do
373 stat <- rts_evalStableIO st_thing p_st_result
374 freeStablePtr st_thing
376 then do st_result <- peek p_st_result
377 result <- deRefStablePtr st_result
378 freeStablePtr st_result
379 return (Right result)
381 return (Left (fromIntegral stat))
383 foreign import "rts_evalStableIO" {- safe -}
384 rts_evalStableIO :: StablePtr (IO a) -> Ptr (StablePtr a) -> IO CInt
385 -- more informative than the C type!
388 -----------------------------------------------------------------------------
389 -- cmTypeOfExpr: returns a string representing the type of an expression
391 cmTypeOfExpr :: CmState -> String -> IO (Maybe String)
392 cmTypeOfExpr cmstate expr
393 = do maybe_stuff <- hscTcExpr (cm_hsc cmstate) (cm_ic cmstate) expr
396 Nothing -> return Nothing
397 Just ty -> return (Just res_str)
399 res_str = showSDocForUser unqual (text expr <+> dcolon <+> ppr tidy_ty)
400 unqual = icPrintUnqual (cm_ic cmstate)
401 tidy_ty = tidyType emptyTidyEnv ty
404 -----------------------------------------------------------------------------
405 -- cmKindOfType: returns a string representing the kind of a type
407 cmKindOfType :: CmState -> String -> IO (Maybe String)
408 cmKindOfType cmstate str
409 = do maybe_stuff <- hscKcType (cm_hsc cmstate) (cm_ic cmstate) str
411 Nothing -> return Nothing
412 Just kind -> return (Just res_str)
414 res_str = showSDocForUser unqual (text str <+> dcolon <+> ppr kind)
415 unqual = icPrintUnqual (cm_ic cmstate)
417 -----------------------------------------------------------------------------
418 -- cmTypeOfName: returns a string representing the type of a name.
420 cmTypeOfName :: CmState -> Name -> IO (Maybe String)
421 cmTypeOfName CmState{ cm_ic=ic } name
423 hPutStrLn stderr ("cmTypeOfName: " ++ showSDoc (ppr name))
424 case lookupNameEnv (ic_type_env ic) name of
425 Nothing -> return Nothing
426 Just (AnId id) -> return (Just str)
428 unqual = icPrintUnqual ic
429 ty = tidyType emptyTidyEnv (idType id)
430 str = showSDocForUser unqual (ppr ty)
432 _ -> panic "cmTypeOfName"
434 -----------------------------------------------------------------------------
435 -- cmCompileExpr: compile an expression and deliver an HValue
437 cmCompileExpr :: CmState -> String -> IO (Maybe HValue)
438 cmCompileExpr cmstate expr
441 <- hscStmt (cm_hsc cmstate) (cm_ic cmstate)
442 ("let __cmCompileExpr = "++expr)
445 Nothing -> return Nothing
446 Just (new_ic, names, hval) -> do
449 hvals <- (unsafeCoerce# hval) :: IO [HValue]
451 case (names,hvals) of
452 ([n],[hv]) -> return (Just hv)
453 _ -> panic "cmCompileExpr"
459 %************************************************************************
461 Loading and unloading
463 %************************************************************************
466 -----------------------------------------------------------------------------
467 -- Unload the compilation manager's state: everything it knows about the
468 -- current collection of modules in the Home package.
470 cmUnload :: CmState -> IO CmState
471 cmUnload state@CmState{ cm_hsc = hsc_env }
472 = do -- Throw away the old home dir cache
475 -- Unload everything the linker knows about
478 -- Start with a fresh CmState, but keep the PersistentCompilerState
479 return (discardCMInfo state)
481 cm_unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
482 = case hsc_mode hsc_env of
485 Interactive -> Linker.unload (hsc_dflags hsc_env) stable_linkables
487 Interactive -> panic "cm_unload: no interpreter"
489 other -> panic "cm_unload: strange mode"
492 -----------------------------------------------------------------------------
493 -- Trace dependency graph
495 -- This is a seperate pass so that the caller can back off and keep
496 -- the current state if the downsweep fails. Typically the caller
497 -- might go cmDepAnal
500 -- He wants to do the dependency analysis before the unload, so that
501 -- if the former fails he can use the later
503 cmDepAnal :: CmState -> [FilePath] -> IO ModuleGraph
504 cmDepAnal cmstate rootnames
505 = do showPass dflags "Chasing dependencies"
506 when (verbosity dflags >= 1 && gmode == Batch) $
507 hPutStrLn stderr (showSDoc (hcat [
508 text "Chasing modules from: ",
509 hcat (punctuate comma (map text rootnames))]))
510 downsweep dflags rootnames (cm_mg cmstate)
512 hsc_env = cm_hsc cmstate
513 dflags = hsc_dflags hsc_env
514 gmode = hsc_mode hsc_env
516 -----------------------------------------------------------------------------
517 -- The real business of the compilation manager: given a system state and
518 -- a module name, try and bring the module up to date, probably changing
519 -- the system state at the same time.
521 cmLoadModules :: CmState -- The HPT may not be as up to date
522 -> ModuleGraph -- Bang up to date; but may contain hi-boot no
523 -> IO (CmState, -- new state
524 SuccessFlag, -- was successful
525 [String]) -- list of modules loaded
527 cmLoadModules cmstate1 mg2unsorted
528 = do -- version 1's are the original, before downsweep
529 let hsc_env = cm_hsc cmstate1
530 let hpt1 = hsc_HPT hsc_env
531 let ghci_mode = hsc_mode hsc_env -- this never changes
532 let dflags = hsc_dflags hsc_env -- this never changes
534 -- Do the downsweep to reestablish the module graph
535 let verb = verbosity dflags
537 -- Find out if we have a Main module
538 mb_main_mod <- readIORef v_MainModIs
540 main_mod = mb_main_mod `orElse` "Main"
542 = any ((==main_mod).moduleUserString.ms_mod)
545 let mg2unsorted_names = map ms_mod mg2unsorted
547 -- mg2 should be cycle free; but it includes hi-boot ModSummary nodes
548 let mg2 :: [SCC ModSummary]
549 mg2 = cmTopSort False mg2unsorted
551 -- mg2_with_srcimps drops the hi-boot nodes, returning a
552 -- graph with cycles. Among other things, it is used for
553 -- backing out partially complete cycles following a failed
554 -- upsweep, and for removing from hpt all the modules
555 -- not in strict downwards closure, during calls to compile.
556 let mg2_with_srcimps :: [SCC ModSummary]
557 mg2_with_srcimps = cmTopSort True mg2unsorted
559 -- Sort out which linkables we wish to keep in the unlinked image.
560 -- See getValidLinkables below for details.
561 (valid_old_linkables, new_linkables)
562 <- getValidLinkables ghci_mode (hptLinkables hpt1)
563 mg2unsorted_names mg2_with_srcimps
565 -- putStrLn (showSDoc (vcat [ppr valid_old_linkables, ppr new_linkables]))
567 -- The new_linkables are .o files we found on the disk, presumably
568 -- as a result of a GHC run "on the side". So we'd better forget
569 -- everything we know abouut those modules!
570 let old_hpt = delModuleEnvList hpt1 (map linkableModule new_linkables)
572 -- When (verb >= 2) $
573 -- putStrLn (showSDoc (text "Valid linkables:"
574 -- <+> ppr valid_linkables))
576 -- Figure out a stable set of modules which can be retained
577 -- the top level envs, to avoid upsweeping them. Goes to a
578 -- bit of trouble to avoid upsweeping module cycles.
580 -- Construct a set S of stable modules like this:
581 -- Travel upwards, over the sccified graph. For each scc
582 -- of modules ms, add ms to S only if:
583 -- 1. All home imports of ms are either in ms or S
584 -- 2. A valid old linkable exists for each module in ms
586 -- mg2_with_srcimps has no hi-boot nodes,
587 -- and hence neither does stable_mods
588 stable_summaries <- preUpsweep valid_old_linkables
589 mg2unsorted_names [] mg2_with_srcimps
590 let stable_mods = map ms_mod stable_summaries
591 stable_linkables = filter (\m -> linkableModule m `elem` stable_mods)
594 stable_hpt = filterModuleEnv is_stable_hm hpt1
595 is_stable_hm hm_info = mi_module (hm_iface hm_info) `elem` stable_mods
598 = filter (\scc -> any (`notElem` stable_mods)
599 (map ms_mod (flattenSCC scc)))
603 hPutStrLn stderr (showSDoc (text "Stable modules:"
604 <+> sep (map (text.moduleUserString) stable_mods)))
606 -- Unload any modules which are going to be re-linked this time around.
607 cm_unload hsc_env stable_linkables
609 -- We can now glom together our linkable sets
610 let valid_linkables = valid_old_linkables ++ new_linkables
612 -- We could at this point detect cycles which aren't broken by
613 -- a source-import, and complain immediately, but it seems better
614 -- to let upsweep_mods do this, so at least some useful work gets
615 -- done before the upsweep is abandoned.
616 --hPutStrLn stderr "after tsort:\n"
617 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
619 -- Because we don't take into account source imports when doing
620 -- the topological sort, there shouldn't be any cycles in mg2.
621 -- If there is, we complain and give up -- the user needs to
622 -- break the cycle using a boot file.
624 -- Now do the upsweep, calling compile for each module in
625 -- turn. Final result is version 3 of everything.
627 -- clean up between compilations
628 let cleanup = cleanTempFilesExcept dflags
629 (ppFilesFromSummaries (flattenSCCs mg2))
631 (upsweep_ok, hsc_env3, modsUpswept)
632 <- upsweep_mods (hsc_env { hsc_HPT = stable_hpt })
633 (old_hpt, valid_linkables)
634 cleanup upsweep_these
636 -- At this point, modsUpswept and newLis should have the same
637 -- length, so there is one new (or old) linkable for each
638 -- mod which was processed (passed to compile).
640 -- Make modsDone be the summaries for each home module now
641 -- available; this should equal the domain of hpt3.
642 -- (NOT STRICTLY TRUE if an interactive session was started
643 -- with some object on disk ???)
644 -- Get in in a roughly top .. bottom order (hence reverse).
646 let modsDone = reverse modsUpswept ++ stable_summaries
648 -- Try and do linking in some form, depending on whether the
649 -- upsweep was completely or only partially successful.
651 if succeeded upsweep_ok
654 -- Easy; just relink it all.
655 do when (verb >= 2) $
656 hPutStrLn stderr "Upsweep completely successful."
658 -- clean up after ourselves
659 cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
661 ofile <- readIORef v_Output_file
662 no_hs_main <- readIORef v_NoHsMain
664 -- Issue a warning for the confusing case where the user
665 -- said '-o foo' but we're not going to do any linking.
666 -- We attempt linking if either (a) one of the modules is
667 -- called Main, or (b) the user said -no-hs-main, indicating
668 -- that main() is going to come from somewhere else.
670 let do_linking = a_root_is_Main || no_hs_main
671 when (ghci_mode == Batch && isJust ofile && not do_linking
673 hPutStrLn stderr ("Warning: output was redirected with -o, but no output will be generated\nbecause there is no " ++ main_mod ++ " module.")
675 -- link everything together
676 linkresult <- link ghci_mode dflags do_linking (hsc_HPT hsc_env3)
678 let cmstate3 = cmstate1 { cm_mg = modsDone, cm_hsc = hsc_env3 }
679 cmLoadFinish Succeeded linkresult cmstate3
682 -- Tricky. We need to back out the effects of compiling any
683 -- half-done cycles, both so as to clean up the top level envs
684 -- and to avoid telling the interactive linker to link them.
685 do when (verb >= 2) $
686 hPutStrLn stderr "Upsweep partially successful."
689 = map ms_mod modsDone
690 let mods_to_zap_names
691 = findPartiallyCompletedCycles modsDone_names
694 = filter ((`notElem` mods_to_zap_names).ms_mod)
697 let hpt4 = retainInTopLevelEnvs (map ms_mod mods_to_keep)
700 -- Clean up after ourselves
701 cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
703 -- Link everything together
704 linkresult <- link ghci_mode dflags False hpt4
706 let cmstate3 = cmstate1 { cm_mg = mods_to_keep,
707 cm_hsc = hsc_env3 { hsc_HPT = hpt4 } }
708 cmLoadFinish Failed linkresult cmstate3
711 -- Finish up after a cmLoad.
713 -- If the link failed, unload everything and return.
714 cmLoadFinish ok Failed cmstate
715 = do cm_unload (cm_hsc cmstate) []
716 return (discardCMInfo cmstate, Failed, [])
718 -- Empty the interactive context and set the module context to the topmost
719 -- newly loaded module, or the Prelude if none were loaded.
720 cmLoadFinish ok Succeeded cmstate
721 = do let new_cmstate = cmstate { cm_ic = emptyInteractiveContext }
722 mods_loaded = map (moduleUserString.ms_mod)
725 return (new_cmstate, ok, mods_loaded)
727 -- used to fish out the preprocess output files for the purposes of
728 -- cleaning up. The preprocessed file *might* be the same as the
729 -- source file, but that doesn't do any harm.
730 ppFilesFromSummaries summaries = [ fn | Just fn <- map ms_hspp_file summaries ]
732 -----------------------------------------------------------------------------
735 -- For each module (or SCC of modules), we take:
737 -- - an on-disk linkable, if this is the first time around and one
740 -- - the old linkable, otherwise (and if one is available).
742 -- and we throw away the linkable if it is older than the source file.
743 -- In interactive mode, we also ignore the on-disk linkables unless
744 -- all of the dependents of this SCC also have on-disk linkables (we
745 -- can't have dynamically loaded objects that depend on interpreted
748 -- If a module has a valid linkable, then it may be STABLE (see below),
749 -- and it is classified as SOURCE UNCHANGED for the purposes of calling
752 -- ToDo: this pass could be merged with the preUpsweep.
756 -> [Linkable] -- old linkables
757 -> [Module] -- all home modules
758 -> [SCC ModSummary] -- all modules in the program, dependency order
759 -> IO ( [Linkable], -- still-valid linkables
760 [Linkable] -- new linkables we just found on the disk
761 -- presumably generated by separate run of ghc
764 getValidLinkables mode old_linkables all_home_mods module_graph
765 = do { -- Process the SCCs in bottom-to-top order
766 -- (foldM works left-to-right)
767 ls <- foldM (getValidLinkablesSCC mode old_linkables all_home_mods)
769 ; return (partition_it ls [] []) }
771 partition_it [] valid new = (valid,new)
772 partition_it ((l,b):ls) valid new
773 | b = partition_it ls valid (l:new)
774 | otherwise = partition_it ls (l:valid) new
779 -> [Linkable] -- old linkables
780 -> [Module] -- all home modules
783 -> IO [(Linkable,Bool)]
785 getValidLinkablesSCC mode old_linkables all_home_mods new_linkables scc0
787 scc = flattenSCC scc0
788 scc_names = map ms_mod scc
789 home_module m = m `elem` all_home_mods && m `notElem` scc_names
790 scc_allhomeimps = nub (filter home_module (concatMap ms_imps scc))
791 -- NB. ms_imps, not ms_allimps above. We don't want to
792 -- force a module's SOURCE imports to be already compiled for
793 -- its object linkable to be valid.
795 -- The new_linkables is only the *valid* linkables below here
796 has_object m = case findModuleLinkable_maybe (map fst new_linkables) m of
798 Just l -> isObjectLinkable l
800 objects_allowed = mode == Batch || all has_object scc_allhomeimps
804 <- foldM (getValidLinkable old_linkables objects_allowed) [] scc
806 -- since an scc can contain only all objects or no objects at all,
807 -- we have to check whether we got all objects or not, and re-do
808 -- the linkable check if not.
811 && not (all isObjectLinkable (map fst new_linkables'))
812 then foldM (getValidLinkable old_linkables False) [] scc
813 else return new_linkables'
815 return (new_linkables ++ new_linkables')
818 getValidLinkable :: [Linkable] -> Bool -> [(Linkable,Bool)] -> ModSummary
819 -> IO [(Linkable,Bool)]
820 -- True <=> linkable is new; i.e. freshly discovered on the disk
821 -- presumably generated 'on the side'
822 -- by a separate GHC run
823 getValidLinkable old_linkables objects_allowed new_linkables summary
824 -- 'objects_allowed' says whether we permit this module to
825 -- have a .o-file linkable. We only permit it if all the
826 -- modules it depends on also have .o files; a .o file can't
827 -- link to a bytecode module
828 = do let mod_name = ms_mod summary
831 <- if (not objects_allowed)
834 else findLinkable mod_name (ms_location summary)
836 let old_linkable = findModuleLinkable_maybe old_linkables mod_name
839 case (old_linkable, maybe_disk_linkable) of
840 (Nothing, Nothing) -> []
842 -- new object linkable just appeared
843 (Nothing, Just l) -> up_to_date l True
846 | isObjectLinkable l -> []
847 -- object linkable disappeared! In case we need to
848 -- relink the module, disregard the old linkable and
849 -- just interpret the module from now on.
850 | otherwise -> up_to_date l False
851 -- old byte code linkable
854 | not (isObjectLinkable l) -> up_to_date l False
855 -- if the previous linkable was interpreted, then we
856 -- ignore a newly compiled version, because the version
857 -- numbers in the interface file will be out-of-sync with
858 -- our internal ones.
859 | linkableTime l' > linkableTime l -> up_to_date l' True
860 | linkableTime l' == linkableTime l -> up_to_date l False
862 -- on-disk linkable has been replaced by an older one!
863 -- again, disregard the previous one.
866 | linkableTime l < ms_hs_date summary = []
867 | otherwise = [(l,b)]
868 -- why '<' rather than '<=' above? If the filesystem stores
869 -- times to the nearset second, we may occasionally find that
870 -- the object & source have the same modification time,
871 -- especially if the source was automatically generated
872 -- and compiled. Using >= is slightly unsafe, but it matches
875 return (new_linkables' ++ new_linkables)
878 hptLinkables :: HomePackageTable -> [Linkable]
879 -- Get all the linkables from the home package table, one for each module
880 -- Once the HPT is up to date, these are the ones we should link
881 hptLinkables hpt = map hm_linkable (moduleEnvElts hpt)
884 -----------------------------------------------------------------------------
885 -- Do a pre-upsweep without use of "compile", to establish a
886 -- (downward-closed) set of stable modules for which we won't call compile.
889 -- * has a valid linkable (see getValidLinkables above)
890 -- * depends only on stable modules
891 -- * has an interface in the HPT (interactive mode only)
893 preUpsweep :: [Linkable] -- new valid linkables
894 -> [Module] -- names of all mods encountered in downsweep
895 -> [ModSummary] -- accumulating stable modules
896 -> [SCC ModSummary] -- scc-ified mod graph, including src imps
897 -> IO [ModSummary] -- stable modules
899 preUpsweep valid_lis all_home_mods stable [] = return stable
900 preUpsweep valid_lis all_home_mods stable (scc0:sccs)
901 = do let scc = flattenSCC scc0
902 scc_allhomeimps :: [Module]
904 = nub (filter (`elem` all_home_mods) (concatMap ms_allimps scc))
905 all_imports_in_scc_or_stable
906 = all in_stable_or_scc scc_allhomeimps
907 scc_mods = map ms_mod scc
908 stable_names = scc_mods ++ map ms_mod stable
909 in_stable_or_scc m = m `elem` stable_names
911 -- now we check for valid linkables: each module in the SCC must
912 -- have a valid linkable (see getValidLinkables above).
913 has_valid_linkable scc_mod
914 = isJust (findModuleLinkable_maybe valid_lis scc_mod)
916 scc_is_stable = all_imports_in_scc_or_stable
917 && all has_valid_linkable scc_mods
920 then preUpsweep valid_lis all_home_mods (scc ++ stable) sccs
921 else preUpsweep valid_lis all_home_mods stable sccs
924 -- Return (names of) all those in modsDone who are part of a cycle
925 -- as defined by theGraph.
926 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
927 findPartiallyCompletedCycles modsDone theGraph
931 chew ((AcyclicSCC v):rest) = chew rest -- acyclic? not interesting.
932 chew ((CyclicSCC vs):rest)
933 = let names_in_this_cycle = nub (map ms_mod vs)
935 = nub ([done | done <- modsDone,
936 done `elem` names_in_this_cycle])
937 chewed_rest = chew rest
939 if notNull mods_in_this_cycle
940 && length mods_in_this_cycle < length names_in_this_cycle
941 then mods_in_this_cycle ++ chewed_rest
945 -- Compile multiple modules, stopping as soon as an error appears.
946 -- There better had not be any cyclic groups here -- we check for them.
947 upsweep_mods :: HscEnv -- Includes initially-empty HPT
948 -> (HomePackageTable, [Linkable]) -- HPT and valid linkables from last time round
949 -> IO () -- How to clean up unwanted tmp files
950 -> [SCC ModSummary] -- Mods to do (the worklist)
952 HscEnv, -- With an updated HPT
953 [ModSummary]) -- Mods which succeeded
955 upsweep_mods hsc_env oldUI cleanup
957 = return (Succeeded, hsc_env, [])
959 upsweep_mods hsc_env oldUI cleanup
961 = do hPutStrLn stderr (showSDoc (cyclicModuleErr ms))
962 return (Failed, hsc_env, [])
964 upsweep_mods hsc_env oldUI@(old_hpt, old_linkables) cleanup
965 (AcyclicSCC mod:mods)
966 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
967 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
968 -- (moduleEnvElts (hsc_HPT hsc_env)))
970 mb_mod_info <- upsweep_mod hsc_env oldUI mod
972 cleanup -- Remove unwanted tmp files between compilations
975 Nothing -> return (Failed, hsc_env, [])
977 { let this_mod = ms_mod mod
979 -- Add new info to hsc_env
980 hpt1 = extendModuleEnv (hsc_HPT hsc_env) this_mod mod_info
981 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
983 -- Space-saving: delete the old HPT entry and linkable for mod
984 -- BUT if mod is a hs-boot node, don't delete it
985 -- For the linkable this is dead right: the linkable relates only
986 -- to the main Haskell source file.
987 -- For the interface, the HPT entry is probaby for the main Haskell
988 -- source file. Deleting it would force
989 oldUI1 | isHsBoot (ms_hsc_src mod) = oldUI
991 = (delModuleEnv old_hpt this_mod,
992 delModuleLinkable old_linkables this_mod)
994 ; (restOK, hsc_env2, modOKs) <- upsweep_mods hsc_env1 oldUI1 cleanup mods
995 ; return (restOK, hsc_env2, mod:modOKs) }
998 -- Compile a single module. Always produce a Linkable for it if
999 -- successful. If no compilation happened, return the old Linkable.
1000 upsweep_mod :: HscEnv
1001 -> (HomePackageTable, UnlinkedImage)
1003 -> IO (Maybe HomeModInfo) -- Nothing => Failed
1005 upsweep_mod hsc_env (old_hpt, old_linkables) summary
1007 let this_mod = ms_mod summary
1009 -- The old interface is ok if it's in the old HPT
1010 -- a) we're compiling a source file, and the old HPT entry is for a source file
1011 -- b) we're compiling a hs-boot file
1012 -- Case (b) allows an hs-boot file to get the interface of its real source file
1013 -- on the second iteration of the compilation manager, but that does no harm.
1014 -- Otherwise the hs-boot file will always be recompiled
1016 = case lookupModuleEnv old_hpt this_mod of
1018 Just hm_info | isHsBoot (ms_hsc_src summary) -> Just iface
1019 | not (mi_boot iface) -> Just iface
1020 | otherwise -> Nothing
1022 iface = hm_iface hm_info
1024 maybe_old_linkable = findModuleLinkable_maybe old_linkables this_mod
1025 source_unchanged = isJust maybe_old_linkable
1027 old_linkable = expectJust "upsweep_mod:old_linkable" maybe_old_linkable
1030 | Just l <- maybe_old_linkable, isObjectLinkable l = True
1033 compresult <- compile hsc_env summary source_unchanged have_object mb_old_iface
1037 -- Compilation "succeeded", and may or may not have returned a new
1038 -- linkable (depending on whether compilation was actually performed
1040 CompOK new_details new_globals new_iface maybe_new_linkable
1042 new_linkable = maybe_new_linkable `orElse` old_linkable
1043 new_info = HomeModInfo { hm_iface = new_iface,
1044 hm_globals = new_globals,
1045 hm_details = new_details,
1046 hm_linkable = new_linkable }
1047 return (Just new_info)
1049 -- Compilation failed. Compile may still have updated the PCS, tho.
1050 CompErrs -> return Nothing
1052 -- Filter modules in the HPT
1053 retainInTopLevelEnvs :: [Module] -> HomePackageTable -> HomePackageTable
1054 retainInTopLevelEnvs keep_these hpt
1055 = mkModuleEnv [ (mod, fromJust mb_mod_info)
1057 , let mb_mod_info = lookupModuleEnv hpt mod
1058 , isJust mb_mod_info ]
1060 -----------------------------------------------------------------------------
1061 cmTopSort :: Bool -- Drop hi-boot nodes? (see below)
1064 -- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1066 -- Drop hi-boot nodes (first boolean arg)?
1068 -- False: treat the hi-boot summaries as nodes of the graph,
1069 -- so the graph must be acyclic
1071 -- True: eliminate the hi-boot nodes, and instead pretend
1072 -- the a source-import of Foo is an import of Foo
1073 -- The resulting graph has no hi-boot nodes, but can by cyclic
1075 cmTopSort drop_hs_boot_nodes summaries
1076 = stronglyConnComp nodes
1078 -- Drop hs-boot nodes by using HsSrcFile as the key
1079 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1080 | otherwise = HsBootFile
1082 -- We use integers as the keys for the SCC algorithm
1083 nodes :: [(ModSummary, Int, [Int])]
1084 nodes = [(s, fromJust (lookup_key (ms_hsc_src s) (ms_mod s)),
1085 out_edge_keys hs_boot_key (ms_srcimps s) ++
1086 out_edge_keys HsSrcFile (ms_imps s) )
1088 , not (ms_hsc_src s == HsBootFile && drop_hs_boot_nodes) ]
1089 -- Drop the hi-boot ones if told to do so
1091 key_map :: NodeMap Int
1092 key_map = listToFM ([(ms_mod s, ms_hsc_src s) | s <- summaries]
1095 lookup_key :: HscSource -> Module -> Maybe Int
1096 lookup_key hs_src mod = lookupFM key_map (mod, hs_src)
1098 out_edge_keys :: HscSource -> [Module] -> [Int]
1099 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1100 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1101 -- the IsBootInterface parameter True; else False
1104 -----------------------------------------------------------------------------
1105 -- Downsweep (dependency analysis)
1107 -- Chase downwards from the specified root set, returning summaries
1108 -- for all home modules encountered. Only follow source-import
1111 -- We pass in the previous collection of summaries, which is used as a
1112 -- cache to avoid recalculating a module summary if the source is
1115 downsweep :: DynFlags -> [FilePath] -> [ModSummary] -> IO [ModSummary]
1116 downsweep dflags roots old_summaries
1117 = do rootSummaries <- mapM getRootSummary roots
1118 checkDuplicates rootSummaries
1119 loop (concatMap msImports rootSummaries)
1120 (mkNodeMap rootSummaries)
1122 old_summary_map :: NodeMap ModSummary
1123 old_summary_map = mkNodeMap old_summaries
1125 getRootSummary :: FilePath -> IO ModSummary
1127 | isHaskellSrcFilename file
1128 = do exists <- doesFileExist file
1129 if exists then summariseFile dflags file else do
1130 throwDyn (CmdLineError ("can't find file `" ++ file ++ "'"))
1132 = do exists <- doesFileExist hs_file
1133 if exists then summariseFile dflags hs_file else do
1134 exists <- doesFileExist lhs_file
1135 if exists then summariseFile dflags lhs_file else do
1136 let mod_name = mkModule file
1137 maybe_summary <- summarise dflags emptyNodeMap Nothing False mod_name
1138 case maybe_summary of
1139 Nothing -> packageModErr mod_name
1142 hs_file = file ++ ".hs"
1143 lhs_file = file ++ ".lhs"
1145 -- In a root module, the filename is allowed to diverge from the module
1146 -- name, so we have to check that there aren't multiple root files
1147 -- defining the same module (otherwise the duplicates will be silently
1148 -- ignored, leading to confusing behaviour).
1149 checkDuplicates :: [ModSummary] -> IO ()
1150 checkDuplicates summaries = mapM_ check summaries
1155 many -> multiRootsErr modl many
1156 where modl = ms_mod summ
1158 [ fromJust (ml_hs_file (ms_location summ'))
1159 | summ' <- summaries, ms_mod summ' == modl ]
1161 loop :: [(FilePath,Module,IsBootInterface)] -- Work list: process these modules
1162 -> NodeMap ModSummary -- Visited set
1163 -> IO [ModSummary] -- The result includes the worklist, except
1164 -- for those mentioned in the visited set
1165 loop [] done = return (nodeMapElts done)
1166 loop ((cur_path, wanted_mod, is_boot) : ss) done
1167 | key `elemFM` done = loop ss done
1168 | otherwise = do { mb_s <- summarise dflags old_summary_map
1169 (Just cur_path) is_boot wanted_mod
1171 Nothing -> loop ss done
1172 Just s -> loop (msImports s ++ ss)
1173 (addToFM done key s) }
1175 key = (wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1177 msImports :: ModSummary -> [(FilePath, -- Importing module
1178 Module, -- Imported module
1179 IsBootInterface)] -- {-# SOURCE #-} import or not
1180 msImports s = [(f, m,True) | m <- ms_srcimps s]
1181 ++ [(f, m,False) | m <- ms_imps s]
1183 f = msHsFilePath s -- Keep the importing module for error reporting
1186 -----------------------------------------------------------------------------
1187 -- Summarising modules
1189 -- We have two types of summarisation:
1191 -- * Summarise a file. This is used for the root module(s) passed to
1192 -- cmLoadModules. The file is read, and used to determine the root
1193 -- module name. The module name may differ from the filename.
1195 -- * Summarise a module. We are given a module name, and must provide
1196 -- a summary. The finder is used to locate the file in which the module
1199 summariseFile :: DynFlags -> FilePath -> IO ModSummary
1200 -- Used for Haskell source only, I think
1201 -- We know the file name, and we know it exists,
1202 -- but we don't necessarily know the module name (might differ)
1203 summariseFile dflags file
1204 = do (dflags', hspp_fn) <- preprocess dflags file
1205 -- The dflags' contains the OPTIONS pragmas
1207 -- Read the file into a buffer. We're going to cache
1208 -- this buffer in the ModLocation (ml_hspp_buf) so that it
1209 -- doesn't have to be slurped again when hscMain parses the
1211 buf <- hGetStringBuffer hspp_fn
1212 (srcimps,the_imps,mod) <- getImports dflags' buf hspp_fn
1214 -- Make a ModLocation for this file
1215 location <- mkHomeModLocation mod file
1217 -- Tell the Finder cache where it is, so that subsequent calls
1218 -- to findModule will find it, even if it's not on any search path
1219 addHomeModuleToFinder mod location
1222 <- case ml_hs_file location of
1223 Nothing -> noHsFileErr Nothing mod
1224 Just src_fn -> getModificationTime src_fn
1226 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1227 ms_location = location,
1228 ms_hspp_file = Just hspp_fn,
1229 ms_hspp_buf = Just buf,
1230 ms_srcimps = srcimps, ms_imps = the_imps,
1231 ms_hs_date = src_timestamp })
1233 -- Summarise a module, and pick up source and timestamp.
1234 summarise :: DynFlags
1235 -> NodeMap ModSummary -- Map of old summaries
1236 -> Maybe FilePath -- Importing module (for error messages)
1237 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
1238 -> Module -- Imported module to be summarised
1239 -> IO (Maybe ModSummary) -- Its new summary
1241 summarise dflags old_summary_map cur_mod is_boot wanted_mod
1242 = do { found <- findModule dflags wanted_mod True {-explicit-}
1246 -> do { summary <- do_summary location
1247 ; return (Just summary) }
1249 -> return Nothing -- Drop an external-package modules
1251 err -> noModError dflags cur_mod wanted_mod err
1254 hsc_src = if is_boot then HsBootFile else HsSrcFile
1257 = do { -- Adjust location to point to the hs-boot source file,
1258 -- hi file, object file, when is_boot says so
1259 let location' | is_boot = addBootSuffixLocn location
1260 | otherwise = location
1262 -- Find the source file to summarise
1263 ; src_fn <- case ml_hs_file location' of
1264 Nothing -> noHsFileErr cur_mod wanted_mod
1265 Just src_fn -> return src_fn
1267 -- In the case of hs-boot files, check that it exists
1268 -- The Finder was dealing only with the main source file
1269 ; if is_boot then do
1270 { exists <- doesFileExist src_fn
1271 ; if exists then return ()
1272 else noHsBootFileErr cur_mod src_fn }
1275 -- Find its timestamp
1276 ; src_timestamp <- getModificationTime src_fn
1278 -- return the cached summary if the source didn't change
1279 ; case lookupFM old_summary_map (wanted_mod, hsc_src) of {
1280 Just s | ms_hs_date s == src_timestamp -> return s;
1283 -- Preprocess the source file
1284 { (dflags', hspp_fn) <- preprocess dflags src_fn
1285 -- The dflags' contains the OPTIONS pragmas
1287 ; buf <- hGetStringBuffer hspp_fn
1288 ; (srcimps, the_imps, mod_name) <- getImports dflags' buf hspp_fn
1290 ; when (mod_name /= wanted_mod) $
1291 throwDyn (ProgramError
1292 (showSDoc (text src_fn
1293 <> text ": file name does not match module name"
1294 <+> quotes (ppr mod_name))))
1296 ; return (ModSummary { ms_mod = wanted_mod,
1297 ms_hsc_src = hsc_src,
1298 ms_location = location',
1299 ms_hspp_file = Just hspp_fn,
1300 ms_hspp_buf = Just buf,
1301 ms_srcimps = srcimps,
1303 ms_hs_date = src_timestamp })
1307 -----------------------------------------------------------------------------
1309 -----------------------------------------------------------------------------
1311 noModError :: DynFlags -> Maybe FilePath -> Module -> FindResult -> IO ab
1312 -- ToDo: we don't have a proper line number for this error
1313 noModError dflags cur_mod wanted_mod err
1314 = throwDyn $ ProgramError $ showSDoc $
1315 vcat [cantFindError dflags wanted_mod err,
1316 nest 2 (parens (pp_where cur_mod))]
1318 noHsFileErr :: Maybe FilePath -> Module -> IO a
1319 -- Complain about not being able to find an imported module
1320 noHsFileErr cur_mod mod
1321 = throwDyn $ CmdLineError $ showSDoc $
1322 vcat [text "No source file for module" <+> quotes (ppr mod),
1323 nest 2 (parens (pp_where cur_mod))]
1325 noHsBootFileErr cur_mod path
1326 = throwDyn $ CmdLineError $ showSDoc $
1327 vcat [text "Can't find" <+> text path,
1328 nest 2 (parens (pp_where cur_mod))]
1330 pp_where Nothing = text "one of the roots of the dependency analysis"
1331 pp_where (Just p) = text "imported from" <+> text p
1334 = throwDyn (CmdLineError (showSDoc (text "module" <+>
1335 quotes (ppr mod) <+>
1336 text "is a package module")))
1338 multiRootsErr mod files
1339 = throwDyn (ProgramError (showSDoc (
1340 text "module" <+> quotes (ppr mod) <+>
1341 text "is defined in multiple files:" <+>
1342 sep (map text files))))
1344 cyclicModuleErr :: [ModSummary] -> SDoc
1346 = hang (ptext SLIT("Module imports form a cycle for modules:"))
1347 2 (vcat (map show_one ms))
1349 show_one ms = vcat [show_mod (ms_hsc_src ms) (ms_mod ms),
1350 ptext SLIT("Imports:") <+>
1351 (pp_imps HsBootFile (ms_srcimps ms)
1352 $$ pp_imps HsSrcFile (ms_imps ms))]
1353 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
1354 pp_imps src mods = fsep (map (show_mod src) mods)