1 -- -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow, 2005
7 -- -----------------------------------------------------------------------------
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
20 defaultCleanupHandler,
23 -- * Flags and settings
24 DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
25 GhcMode(..), GhcLink(..), defaultObjectTarget,
32 Target(..), TargetId(..), Phase,
39 -- * Extending the program scope
40 extendGlobalRdrScope, -- :: Session -> [GlobalRdrElt] -> IO ()
41 setGlobalRdrScope, -- :: Session -> [GlobalRdrElt] -> IO ()
42 extendGlobalTypeScope, -- :: Session -> [Id] -> IO ()
43 setGlobalTypeScope, -- :: Session -> [Id] -> IO ()
45 -- * Loading\/compiling the program
47 load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
48 workingDirectoryChanged,
49 checkModule, CheckedModule(..),
50 TypecheckedSource, ParsedSource, RenamedSource,
53 -- * Parsing Haddock comments
56 -- * Inspecting the module structure of the program
57 ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
62 -- * Inspecting modules
67 modInfoPrintUnqualified,
70 modInfoIsExportedName,
75 PrintUnqualified, alwaysQualify,
77 -- * Interactive evaluation
78 getBindings, getPrintUnqual,
81 setContext, getContext,
90 runStmt, SingleStep(..),
92 Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
93 resumeHistory, resumeHistoryIx),
94 History(historyBreakInfo, historyEnclosingDecl),
95 GHC.getHistorySpan, getHistoryModule,
99 InteractiveEval.forward,
102 compileExpr, HValue, dynCompileExpr,
104 GHC.obtainTerm, GHC.obtainTerm1, GHC.obtainTermB, reconstructType,
106 ModBreaks(..), BreakIndex,
107 BreakInfo(breakInfo_number, breakInfo_module),
108 BreakArray, setBreakOn, setBreakOff, getBreak,
111 -- * Abstract syntax elements
117 Module, mkModule, pprModule, moduleName, modulePackageId,
118 ModuleName, mkModuleName, moduleNameString,
122 isExternalName, nameModule, pprParenSymName, nameSrcSpan,
124 RdrName(Qual,Unqual),
128 isImplicitId, isDeadBinder,
129 isExportedId, isLocalId, isGlobalId,
131 isPrimOpId, isFCallId, isClassOpId_maybe,
132 isDataConWorkId, idDataCon,
133 isBottomingId, isDictonaryId,
134 recordSelectorFieldLabel,
136 -- ** Type constructors
138 tyConTyVars, tyConDataCons, tyConArity,
139 isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
141 synTyConDefn, synTyConType, synTyConResKind,
147 -- ** Data constructors
149 dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
150 dataConIsInfix, isVanillaDataCon,
152 StrictnessMark(..), isMarkedStrict,
156 classMethods, classSCTheta, classTvsFds,
161 instanceDFunId, pprInstance, pprInstanceHdr,
163 -- ** Types and Kinds
164 Type, dropForAlls, splitForAllTys, funResultTy,
165 pprParendType, pprTypeApp,
168 ThetaType, pprThetaArrow,
174 module HsSyn, -- ToDo: remove extraneous bits
178 defaultFixity, maxPrecedence,
182 -- ** Source locations
184 mkSrcLoc, isGoodSrcLoc, noSrcLoc,
185 srcLocFile, srcLocLine, srcLocCol,
187 mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
188 srcSpanStart, srcSpanEnd,
190 srcSpanStartLine, srcSpanEndLine,
191 srcSpanStartCol, srcSpanEndCol,
194 GhcException(..), showGhcException,
204 * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
205 * what StaticFlags should we expose, if any?
208 #include "HsVersions.h"
211 import qualified Linker
212 import Linker ( HValue )
217 import InteractiveEval
224 import Type hiding (typeKind)
225 import TcType hiding (typeKind)
227 import Var hiding (setIdType)
228 import TysPrim ( alphaTyVars )
233 import Name hiding ( varName )
234 import OccName ( parenSymOcc )
235 import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr )
239 import TcRnDriver ( tcRnModule )
240 import DriverPipeline
241 import DriverPhases ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase )
242 import HeaderInfo ( getImports, getOptions )
244 import HscMain ( newHscEnv, hscFileCheck, HscChecked(..) )
248 import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
258 import Bag ( unitBag, listToBag )
259 import ErrUtils ( Severity(..), showPass, fatalErrorMsg, debugTraceMsg,
260 mkPlainErrMsg, printBagOfErrors, printBagOfWarnings,
262 import qualified ErrUtils
264 import StringBuffer ( StringBuffer, hGetStringBuffer )
267 import Maybes ( expectJust, mapCatMaybes )
269 import HaddockLex ( tokenise )
271 import Control.Concurrent
272 import System.Directory ( getModificationTime, doesFileExist )
275 import qualified Data.List as List
277 import System.Exit ( exitWith, ExitCode(..) )
278 import System.Time ( ClockTime )
279 import Control.Exception as Exception hiding (handle)
282 import System.IO.Error ( try, isDoesNotExistError )
283 import Prelude hiding (init)
286 -- -----------------------------------------------------------------------------
287 -- Exception handlers
289 -- | Install some default exception handlers and run the inner computation.
290 -- Unless you want to handle exceptions yourself, you should wrap this around
291 -- the top level of your program. The default handlers output the error
292 -- message(s) to stderr and exit cleanly.
293 defaultErrorHandler :: DynFlags -> IO a -> IO a
294 defaultErrorHandler dflags inner =
295 -- top-level exception handler: any unrecognised exception is a compiler bug.
296 handle (\exception -> do
299 -- an IO exception probably isn't our fault, so don't panic
301 fatalErrorMsg dflags (text (show exception))
302 AsyncException StackOverflow ->
303 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
305 fatalErrorMsg dflags (text (show (Panic (show exception))))
306 exitWith (ExitFailure 1)
309 -- program errors: messages with locations attached. Sometimes it is
310 -- convenient to just throw these as exceptions.
311 handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
312 exitWith (ExitFailure 1)) $
314 -- error messages propagated as exceptions
315 handleDyn (\dyn -> do
318 PhaseFailed _ code -> exitWith code
319 Interrupted -> exitWith (ExitFailure 1)
320 _ -> do fatalErrorMsg dflags (text (show (dyn :: GhcException)))
321 exitWith (ExitFailure 1)
325 -- | Install a default cleanup handler to remove temporary files
326 -- deposited by a GHC run. This is seperate from
327 -- 'defaultErrorHandler', because you might want to override the error
328 -- handling, but still get the ordinary cleanup behaviour.
329 defaultCleanupHandler :: DynFlags -> IO a -> IO a
330 defaultCleanupHandler dflags inner =
331 -- make sure we clean up after ourselves
332 later (do cleanTempFiles dflags
335 -- exceptions will be blocked while we clean the temporary files,
336 -- so there shouldn't be any difficulty if we receive further
341 -- | Starts a new session. A session consists of a set of loaded
342 -- modules, a set of options (DynFlags), and an interactive context.
343 newSession :: Maybe FilePath -> IO Session
344 newSession mb_top_dir = do
346 main_thread <- myThreadId
347 modifyMVar_ interruptTargetThread (return . (main_thread :))
348 installSignalHandlers
351 dflags0 <- initSysTools mb_top_dir defaultDynFlags
352 dflags <- initDynFlags dflags0
353 env <- newHscEnv dflags
357 -- tmp: this breaks the abstraction, but required because DriverMkDepend
358 -- needs to call the Finder. ToDo: untangle this.
359 sessionHscEnv :: Session -> IO HscEnv
360 sessionHscEnv (Session ref) = readIORef ref
362 -- -----------------------------------------------------------------------------
365 -- | Grabs the DynFlags from the Session
366 getSessionDynFlags :: Session -> IO DynFlags
367 getSessionDynFlags s = withSession s (return . hsc_dflags)
369 -- | Updates the DynFlags in a Session. This also reads
370 -- the package database (unless it has already been read),
371 -- and prepares the compilers knowledge about packages. It
372 -- can be called again to load new packages: just add new
373 -- package flags to (packageFlags dflags).
375 -- Returns a list of new packages that may need to be linked in using
376 -- the dynamic linker (see 'linkPackages') as a result of new package
377 -- flags. If you are not doing linking or doing static linking, you
378 -- can ignore the list of packages returned.
380 setSessionDynFlags :: Session -> DynFlags -> IO [PackageId]
381 setSessionDynFlags (Session ref) dflags = do
382 hsc_env <- readIORef ref
383 (dflags', preload) <- initPackages dflags
384 writeIORef ref $! hsc_env{ hsc_dflags = dflags' }
387 -- | If there is no -o option, guess the name of target executable
388 -- by using top-level source file name as a base.
389 guessOutputFile :: Session -> IO ()
390 guessOutputFile s = modifySession s $ \env ->
391 let dflags = hsc_dflags env
392 mod_graph = hsc_mod_graph env
393 mainModuleSrcPath, guessedName :: Maybe String
394 mainModuleSrcPath = do
395 let isMain = (== mainModIs dflags) . ms_mod
396 [ms] <- return (filter isMain mod_graph)
397 ml_hs_file (ms_location ms)
398 guessedName = fmap basenameOf mainModuleSrcPath
400 case outputFile dflags of
402 Nothing -> env { hsc_dflags = dflags { outputFile = guessedName } }
404 -- -----------------------------------------------------------------------------
407 -- ToDo: think about relative vs. absolute file paths. And what
408 -- happens when the current directory changes.
410 -- | Sets the targets for this session. Each target may be a module name
411 -- or a filename. The targets correspond to the set of root modules for
412 -- the program\/library. Unloading the current program is achieved by
413 -- setting the current set of targets to be empty, followed by load.
414 setTargets :: Session -> [Target] -> IO ()
415 setTargets s targets = modifySession s (\h -> h{ hsc_targets = targets })
417 -- | returns the current set of targets
418 getTargets :: Session -> IO [Target]
419 getTargets s = withSession s (return . hsc_targets)
421 -- | Add another target
422 addTarget :: Session -> Target -> IO ()
424 = modifySession s (\h -> h{ hsc_targets = target : hsc_targets h })
427 removeTarget :: Session -> TargetId -> IO ()
428 removeTarget s target_id
429 = modifySession s (\h -> h{ hsc_targets = filter (hsc_targets h) })
431 filter targets = [ t | t@(Target id _) <- targets, id /= target_id ]
433 -- Attempts to guess what Target a string refers to. This function implements
434 -- the --make/GHCi command-line syntax for filenames:
436 -- - if the string looks like a Haskell source filename, then interpret
438 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
440 -- - otherwise interpret the string as a module name
442 guessTarget :: String -> Maybe Phase -> IO Target
443 guessTarget file (Just phase)
444 = return (Target (TargetFile file (Just phase)) Nothing)
445 guessTarget file Nothing
446 | isHaskellSrcFilename file
447 = return (Target (TargetFile file Nothing) Nothing)
449 = do exists <- doesFileExist hs_file
451 then return (Target (TargetFile hs_file Nothing) Nothing)
453 exists <- doesFileExist lhs_file
455 then return (Target (TargetFile lhs_file Nothing) Nothing)
457 return (Target (TargetModule (mkModuleName file)) Nothing)
459 hs_file = file `joinFileExt` "hs"
460 lhs_file = file `joinFileExt` "lhs"
462 -- -----------------------------------------------------------------------------
463 -- Extending the program scope
465 extendGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
466 extendGlobalRdrScope session rdrElts
467 = modifySession session $ \hscEnv ->
468 let global_rdr = hsc_global_rdr_env hscEnv
469 in hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv global_rdr rdrElts }
471 setGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
472 setGlobalRdrScope session rdrElts
473 = modifySession session $ \hscEnv ->
474 hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv rdrElts }
476 extendGlobalTypeScope :: Session -> [Id] -> IO ()
477 extendGlobalTypeScope session ids
478 = modifySession session $ \hscEnv ->
479 let global_type = hsc_global_type_env hscEnv
480 in hscEnv{ hsc_global_type_env = extendTypeEnvWithIds global_type ids }
482 setGlobalTypeScope :: Session -> [Id] -> IO ()
483 setGlobalTypeScope session ids
484 = modifySession session $ \hscEnv ->
485 hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
487 -- -----------------------------------------------------------------------------
488 -- Parsing Haddock comments
490 parseHaddockComment :: String -> Either String (HsDoc RdrName)
491 parseHaddockComment string = parseHaddockParagraphs (tokenise string)
493 -- -----------------------------------------------------------------------------
494 -- Loading the program
496 -- Perform a dependency analysis starting from the current targets
497 -- and update the session with the new module graph.
498 depanal :: Session -> [ModuleName] -> Bool -> IO (Maybe ModuleGraph)
499 depanal (Session ref) excluded_mods allow_dup_roots = do
500 hsc_env <- readIORef ref
502 dflags = hsc_dflags hsc_env
503 targets = hsc_targets hsc_env
504 old_graph = hsc_mod_graph hsc_env
506 showPass dflags "Chasing dependencies"
507 debugTraceMsg dflags 2 (hcat [
508 text "Chasing modules from: ",
509 hcat (punctuate comma (map pprTarget targets))])
511 r <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
513 Just mod_graph -> writeIORef ref hsc_env{ hsc_mod_graph = mod_graph }
518 -- | The result of load.
520 = LoadOk Errors -- ^ all specified targets were loaded successfully.
521 | LoadFailed Errors -- ^ not all modules were loaded.
523 type Errors = [String]
525 data ErrMsg = ErrMsg {
526 errMsgSeverity :: Severity, -- warning, error, etc.
527 errMsgSpans :: [SrcSpan],
528 errMsgShortDoc :: Doc,
529 errMsgExtraInfo :: Doc
535 | LoadUpTo ModuleName
536 | LoadDependenciesOf ModuleName
538 -- | Try to load the program. If a Module is supplied, then just
539 -- attempt to load up to this target. If no Module is supplied,
540 -- then try to load all targets.
541 load :: Session -> LoadHowMuch -> IO SuccessFlag
542 load s@(Session ref) how_much
544 -- Dependency analysis first. Note that this fixes the module graph:
545 -- even if we don't get a fully successful upsweep, the full module
546 -- graph is still retained in the Session. We can tell which modules
547 -- were successfully loaded by inspecting the Session's HPT.
548 mb_graph <- depanal s [] False
550 Just mod_graph -> catchingFailure $ load2 s how_much mod_graph
551 Nothing -> return Failed
552 where catchingFailure f = f `Exception.catch` \e -> do
553 hsc_env <- readIORef ref
554 -- trac #1565 / test ghci021:
555 -- let bindings may explode if we try to use them after
557 writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
560 load2 s@(Session ref) how_much mod_graph = do
562 hsc_env <- readIORef ref
564 let hpt1 = hsc_HPT hsc_env
565 let dflags = hsc_dflags hsc_env
567 -- The "bad" boot modules are the ones for which we have
568 -- B.hs-boot in the module graph, but no B.hs
569 -- The downsweep should have ensured this does not happen
571 let all_home_mods = [ms_mod_name s
572 | s <- mod_graph, not (isBootSummary s)]
574 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
575 not (ms_mod_name s `elem` all_home_mods)]
577 ASSERT( null bad_boot_mods ) return ()
579 -- mg2_with_srcimps drops the hi-boot nodes, returning a
580 -- graph with cycles. Among other things, it is used for
581 -- backing out partially complete cycles following a failed
582 -- upsweep, and for removing from hpt all the modules
583 -- not in strict downwards closure, during calls to compile.
584 let mg2_with_srcimps :: [SCC ModSummary]
585 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
587 -- If we can determine that any of the {-# SOURCE #-} imports
588 -- are definitely unnecessary, then emit a warning.
589 warnUnnecessarySourceImports dflags mg2_with_srcimps
592 -- check the stability property for each module.
593 stable_mods@(stable_obj,stable_bco)
594 = checkStability hpt1 mg2_with_srcimps all_home_mods
596 -- prune bits of the HPT which are definitely redundant now,
598 pruned_hpt = pruneHomePackageTable hpt1
599 (flattenSCCs mg2_with_srcimps)
604 debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
605 text "Stable BCO:" <+> ppr stable_bco)
607 -- Unload any modules which are going to be re-linked this time around.
608 let stable_linkables = [ linkable
609 | m <- stable_obj++stable_bco,
610 Just hmi <- [lookupUFM pruned_hpt m],
611 Just linkable <- [hm_linkable hmi] ]
612 unload hsc_env stable_linkables
614 -- We could at this point detect cycles which aren't broken by
615 -- a source-import, and complain immediately, but it seems better
616 -- to let upsweep_mods do this, so at least some useful work gets
617 -- done before the upsweep is abandoned.
618 --hPutStrLn stderr "after tsort:\n"
619 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
621 -- Now do the upsweep, calling compile for each module in
622 -- turn. Final result is version 3 of everything.
624 -- Topologically sort the module graph, this time including hi-boot
625 -- nodes, and possibly just including the portion of the graph
626 -- reachable from the module specified in the 2nd argument to load.
627 -- This graph should be cycle-free.
628 -- If we're restricting the upsweep to a portion of the graph, we
629 -- also want to retain everything that is still stable.
630 let full_mg :: [SCC ModSummary]
631 full_mg = topSortModuleGraph False mod_graph Nothing
633 maybe_top_mod = case how_much of
635 LoadDependenciesOf m -> Just m
638 partial_mg0 :: [SCC ModSummary]
639 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
641 -- LoadDependenciesOf m: we want the upsweep to stop just
642 -- short of the specified module (unless the specified module
645 | LoadDependenciesOf mod <- how_much
646 = ASSERT( case last partial_mg0 of
647 AcyclicSCC ms -> ms_mod_name ms == mod; _ -> False )
648 List.init partial_mg0
654 | AcyclicSCC ms <- full_mg,
655 ms_mod_name ms `elem` stable_obj++stable_bco,
656 ms_mod_name ms `notElem` [ ms_mod_name ms' |
657 AcyclicSCC ms' <- partial_mg ] ]
659 mg = stable_mg ++ partial_mg
661 -- clean up between compilations
662 let cleanup = cleanTempFilesExcept dflags
663 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
665 debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
667 (upsweep_ok, hsc_env1, modsUpswept)
668 <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
669 pruned_hpt stable_mods cleanup mg
671 -- Make modsDone be the summaries for each home module now
672 -- available; this should equal the domain of hpt3.
673 -- Get in in a roughly top .. bottom order (hence reverse).
675 let modsDone = reverse modsUpswept
677 -- Try and do linking in some form, depending on whether the
678 -- upsweep was completely or only partially successful.
680 if succeeded upsweep_ok
683 -- Easy; just relink it all.
684 do debugTraceMsg dflags 2 (text "Upsweep completely successful.")
686 -- Clean up after ourselves
687 cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
689 -- Issue a warning for the confusing case where the user
690 -- said '-o foo' but we're not going to do any linking.
691 -- We attempt linking if either (a) one of the modules is
692 -- called Main, or (b) the user said -no-hs-main, indicating
693 -- that main() is going to come from somewhere else.
695 let ofile = outputFile dflags
696 let no_hs_main = dopt Opt_NoHsMain dflags
698 main_mod = mainModIs dflags
699 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
700 do_linking = a_root_is_Main || no_hs_main
702 when (ghcLink dflags == LinkBinary
703 && isJust ofile && not do_linking) $
704 debugTraceMsg dflags 1 $
705 text ("Warning: output was redirected with -o, " ++
706 "but no output will be generated\n" ++
707 "because there is no " ++
708 moduleNameString (moduleName main_mod) ++ " module.")
710 -- link everything together
711 linkresult <- link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
713 loadFinish Succeeded linkresult ref hsc_env1
716 -- Tricky. We need to back out the effects of compiling any
717 -- half-done cycles, both so as to clean up the top level envs
718 -- and to avoid telling the interactive linker to link them.
719 do debugTraceMsg dflags 2 (text "Upsweep partially successful.")
722 = map ms_mod modsDone
723 let mods_to_zap_names
724 = findPartiallyCompletedCycles modsDone_names
727 = filter ((`notElem` mods_to_zap_names).ms_mod)
730 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
733 -- Clean up after ourselves
734 cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
736 -- there should be no Nothings where linkables should be, now
737 ASSERT(all (isJust.hm_linkable)
738 (eltsUFM (hsc_HPT hsc_env))) do
740 -- Link everything together
741 linkresult <- link (ghcLink dflags) dflags False hpt4
743 let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
744 loadFinish Failed linkresult ref hsc_env4
746 -- Finish up after a load.
748 -- If the link failed, unload everything and return.
749 loadFinish all_ok Failed ref hsc_env
750 = do unload hsc_env []
751 writeIORef ref $! discardProg hsc_env
754 -- Empty the interactive context and set the module context to the topmost
755 -- newly loaded module, or the Prelude if none were loaded.
756 loadFinish all_ok Succeeded ref hsc_env
757 = do writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
761 -- Forget the current program, but retain the persistent info in HscEnv
762 discardProg :: HscEnv -> HscEnv
764 = hsc_env { hsc_mod_graph = emptyMG,
765 hsc_IC = emptyInteractiveContext,
766 hsc_HPT = emptyHomePackageTable }
768 -- used to fish out the preprocess output files for the purposes of
769 -- cleaning up. The preprocessed file *might* be the same as the
770 -- source file, but that doesn't do any harm.
771 ppFilesFromSummaries summaries = map ms_hspp_file summaries
773 -- -----------------------------------------------------------------------------
777 CheckedModule { parsedSource :: ParsedSource,
778 renamedSource :: Maybe RenamedSource,
779 typecheckedSource :: Maybe TypecheckedSource,
780 checkedModuleInfo :: Maybe ModuleInfo,
781 coreBinds :: Maybe [CoreBind]
783 -- ToDo: improvements that could be made here:
784 -- if the module succeeded renaming but not typechecking,
785 -- we can still get back the GlobalRdrEnv and exports, so
786 -- perhaps the ModuleInfo should be split up into separate
787 -- fields within CheckedModule.
789 type ParsedSource = Located (HsModule RdrName)
790 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
791 Maybe (HsDoc Name), HaddockModInfo Name)
792 type TypecheckedSource = LHsBinds Id
795 -- - things that aren't in the output of the typechecker right now:
799 -- - type/data/newtype declarations
800 -- - class declarations
802 -- - extra things in the typechecker's output:
803 -- - default methods are turned into top-level decls.
804 -- - dictionary bindings
807 -- | This is the way to get access to parsed and typechecked source code
808 -- for a module. 'checkModule' attempts to typecheck the module. If
809 -- successful, it returns the abstract syntax for the module.
810 -- If compileToCore is true, it also desugars the module and returns the
811 -- resulting Core bindings as a component of the CheckedModule.
812 checkModule :: Session -> ModuleName -> Bool -> IO (Maybe CheckedModule)
813 checkModule session@(Session ref) mod compileToCore = do
814 -- parse & typecheck the module
815 hsc_env <- readIORef ref
816 let mg = hsc_mod_graph hsc_env
817 case [ ms | ms <- mg, ms_mod_name ms == mod ] of
820 mbChecked <- hscFileCheck
821 hsc_env{hsc_dflags=ms_hspp_opts ms}
824 Nothing -> return Nothing
825 Just (HscChecked parsed renamed Nothing _) ->
826 return (Just (CheckedModule {
827 parsedSource = parsed,
828 renamedSource = renamed,
829 typecheckedSource = Nothing,
830 checkedModuleInfo = Nothing,
831 coreBinds = Nothing }))
832 Just (HscChecked parsed renamed
833 (Just (tc_binds, rdr_env, details))
834 maybeCoreBinds) -> do
835 let minf = ModuleInfo {
836 minf_type_env = md_types details,
837 minf_exports = availsToNameSet $
839 minf_rdr_env = Just rdr_env,
840 minf_instances = md_insts details
842 ,minf_modBreaks = emptyModBreaks
845 return (Just (CheckedModule {
846 parsedSource = parsed,
847 renamedSource = renamed,
848 typecheckedSource = Just tc_binds,
849 checkedModuleInfo = Just minf,
850 coreBinds = maybeCoreBinds}))
852 -- | This is the way to get access to the Core bindings corresponding
853 -- to a module. 'compileToCore' invokes 'checkModule' to parse, typecheck, and
854 -- desugar the module, then returns the resulting list of Core bindings if
856 compileToCore :: Session -> FilePath -> IO (Maybe [CoreBind])
857 compileToCore session@(Session ref) fn = do
858 hsc_env <- readIORef ref
859 -- First, set the target to the desired filename
860 target <- guessTarget fn Nothing
861 addTarget session target
862 load session LoadAllTargets
863 -- Then find dependencies
864 maybeModGraph <- depanal session [] True
865 case maybeModGraph of
866 Nothing -> return Nothing
868 case find ((== fn) . msHsFilePath) modGraph of
869 Just modSummary -> do
870 -- Now we have the module name;
871 -- parse, typecheck and desugar the module
872 let mod = ms_mod_name modSummary
873 maybeCheckedModule <- checkModule session mod True
874 case maybeCheckedModule of
875 Nothing -> return Nothing
876 Just checkedMod -> return $ coreBinds checkedMod
877 -- ---------------------------------------------------------------------------
880 unload :: HscEnv -> [Linkable] -> IO ()
881 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
882 = case ghcLink (hsc_dflags hsc_env) of
884 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
886 LinkInMemory -> panic "unload: no interpreter"
890 -- -----------------------------------------------------------------------------
894 Stability tells us which modules definitely do not need to be recompiled.
895 There are two main reasons for having stability:
897 - avoid doing a complete upsweep of the module graph in GHCi when
898 modules near the bottom of the tree have not changed.
900 - to tell GHCi when it can load object code: we can only load object code
901 for a module when we also load object code fo all of the imports of the
902 module. So we need to know that we will definitely not be recompiling
903 any of these modules, and we can use the object code.
905 The stability check is as follows. Both stableObject and
906 stableBCO are used during the upsweep phase later.
909 stable m = stableObject m || stableBCO m
912 all stableObject (imports m)
913 && old linkable does not exist, or is == on-disk .o
914 && date(on-disk .o) > date(.hs)
917 all stable (imports m)
918 && date(BCO) > date(.hs)
921 These properties embody the following ideas:
923 - if a module is stable, then:
924 - if it has been compiled in a previous pass (present in HPT)
925 then it does not need to be compiled or re-linked.
926 - if it has not been compiled in a previous pass,
927 then we only need to read its .hi file from disk and
928 link it to produce a ModDetails.
930 - if a modules is not stable, we will definitely be at least
931 re-linking, and possibly re-compiling it during the upsweep.
932 All non-stable modules can (and should) therefore be unlinked
935 - Note that objects are only considered stable if they only depend
936 on other objects. We can't link object code against byte code.
940 :: HomePackageTable -- HPT from last compilation
941 -> [SCC ModSummary] -- current module graph (cyclic)
942 -> [ModuleName] -- all home modules
943 -> ([ModuleName], -- stableObject
944 [ModuleName]) -- stableBCO
946 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
948 checkSCC (stable_obj, stable_bco) scc0
949 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
950 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
951 | otherwise = (stable_obj, stable_bco)
953 scc = flattenSCC scc0
954 scc_mods = map ms_mod_name scc
955 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
957 scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
958 -- all imports outside the current SCC, but in the home pkg
960 stable_obj_imps = map (`elem` stable_obj) scc_allimps
961 stable_bco_imps = map (`elem` stable_bco) scc_allimps
968 and (zipWith (||) stable_obj_imps stable_bco_imps)
972 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
976 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
977 Just hmi | Just l <- hm_linkable hmi
978 -> isObjectLinkable l && t == linkableTime l
980 -- why '>=' rather than '>' above? If the filesystem stores
981 -- times to the nearset second, we may occasionally find that
982 -- the object & source have the same modification time,
983 -- especially if the source was automatically generated
984 -- and compiled. Using >= is slightly unsafe, but it matches
988 = case lookupUFM hpt (ms_mod_name ms) of
989 Just hmi | Just l <- hm_linkable hmi ->
990 not (isObjectLinkable l) &&
991 linkableTime l >= ms_hs_date ms
994 ms_allimps :: ModSummary -> [ModuleName]
995 ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
997 -- -----------------------------------------------------------------------------
998 -- Prune the HomePackageTable
1000 -- Before doing an upsweep, we can throw away:
1002 -- - For non-stable modules:
1003 -- - all ModDetails, all linked code
1004 -- - all unlinked code that is out of date with respect to
1007 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
1008 -- space at the end of the upsweep, because the topmost ModDetails of the
1009 -- old HPT holds on to the entire type environment from the previous
1012 pruneHomePackageTable
1015 -> ([ModuleName],[ModuleName])
1018 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
1021 | is_stable modl = hmi'
1022 | otherwise = hmi'{ hm_details = emptyModDetails }
1024 modl = moduleName (mi_module (hm_iface hmi))
1025 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
1026 = hmi{ hm_linkable = Nothing }
1029 where ms = expectJust "prune" (lookupUFM ms_map modl)
1031 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
1033 is_stable m = m `elem` stable_obj || m `elem` stable_bco
1035 -- -----------------------------------------------------------------------------
1037 -- Return (names of) all those in modsDone who are part of a cycle
1038 -- as defined by theGraph.
1039 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
1040 findPartiallyCompletedCycles modsDone theGraph
1044 chew ((AcyclicSCC v):rest) = chew rest -- acyclic? not interesting.
1045 chew ((CyclicSCC vs):rest)
1046 = let names_in_this_cycle = nub (map ms_mod vs)
1048 = nub ([done | done <- modsDone,
1049 done `elem` names_in_this_cycle])
1050 chewed_rest = chew rest
1052 if notNull mods_in_this_cycle
1053 && length mods_in_this_cycle < length names_in_this_cycle
1054 then mods_in_this_cycle ++ chewed_rest
1057 -- -----------------------------------------------------------------------------
1060 -- This is where we compile each module in the module graph, in a pass
1061 -- from the bottom to the top of the graph.
1063 -- There better had not be any cyclic groups here -- we check for them.
1066 :: HscEnv -- Includes initially-empty HPT
1067 -> HomePackageTable -- HPT from last time round (pruned)
1068 -> ([ModuleName],[ModuleName]) -- stable modules (see checkStability)
1069 -> IO () -- How to clean up unwanted tmp files
1070 -> [SCC ModSummary] -- Mods to do (the worklist)
1072 HscEnv, -- With an updated HPT
1073 [ModSummary]) -- Mods which succeeded
1075 upsweep hsc_env old_hpt stable_mods cleanup mods
1076 = upsweep' hsc_env old_hpt stable_mods cleanup mods 1 (length mods)
1078 upsweep' hsc_env old_hpt stable_mods cleanup
1080 = return (Succeeded, hsc_env, [])
1082 upsweep' hsc_env old_hpt stable_mods cleanup
1083 (CyclicSCC ms:_) _ _
1084 = do fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
1085 return (Failed, hsc_env, [])
1087 upsweep' hsc_env old_hpt stable_mods cleanup
1088 (AcyclicSCC mod:mods) mod_index nmods
1089 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1090 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
1091 -- (moduleEnvElts (hsc_HPT hsc_env)))
1093 mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod
1096 cleanup -- Remove unwanted tmp files between compilations
1099 Nothing -> return (Failed, hsc_env, [])
1101 { let this_mod = ms_mod_name mod
1103 -- Add new info to hsc_env
1104 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
1105 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
1107 -- Space-saving: delete the old HPT entry
1108 -- for mod BUT if mod is a hs-boot
1109 -- node, don't delete it. For the
1110 -- interface, the HPT entry is probaby for the
1111 -- main Haskell source file. Deleting it
1112 -- would force .. (what?? --SDM)
1113 old_hpt1 | isBootSummary mod = old_hpt
1114 | otherwise = delFromUFM old_hpt this_mod
1116 ; (restOK, hsc_env2, modOKs)
1117 <- upsweep' hsc_env1 old_hpt1 stable_mods cleanup
1118 mods (mod_index+1) nmods
1119 ; return (restOK, hsc_env2, mod:modOKs)
1123 -- Compile a single module. Always produce a Linkable for it if
1124 -- successful. If no compilation happened, return the old Linkable.
1125 upsweep_mod :: HscEnv
1127 -> ([ModuleName],[ModuleName])
1129 -> Int -- index of module
1130 -> Int -- total number of modules
1131 -> IO (Maybe HomeModInfo) -- Nothing => Failed
1133 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
1135 this_mod_name = ms_mod_name summary
1136 this_mod = ms_mod summary
1137 mb_obj_date = ms_obj_date summary
1138 obj_fn = ml_obj_file (ms_location summary)
1139 hs_date = ms_hs_date summary
1141 is_stable_obj = this_mod_name `elem` stable_obj
1142 is_stable_bco = this_mod_name `elem` stable_bco
1144 old_hmi = lookupUFM old_hpt this_mod_name
1146 -- We're using the dflags for this module now, obtained by
1147 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
1148 dflags = ms_hspp_opts summary
1149 prevailing_target = hscTarget (hsc_dflags hsc_env)
1150 local_target = hscTarget dflags
1152 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
1153 -- we don't do anything dodgy: these should only work to change
1154 -- from -fvia-C to -fasm and vice-versa, otherwise we could
1155 -- end up trying to link object code to byte code.
1156 target = if prevailing_target /= local_target
1157 && (not (isObjectTarget prevailing_target)
1158 || not (isObjectTarget local_target))
1159 then prevailing_target
1162 -- store the corrected hscTarget into the summary
1163 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
1165 -- The old interface is ok if
1166 -- a) we're compiling a source file, and the old HPT
1167 -- entry is for a source file
1168 -- b) we're compiling a hs-boot file
1169 -- Case (b) allows an hs-boot file to get the interface of its
1170 -- real source file on the second iteration of the compilation
1171 -- manager, but that does no harm. Otherwise the hs-boot file
1172 -- will always be recompiled
1177 Just hm_info | isBootSummary summary -> Just iface
1178 | not (mi_boot iface) -> Just iface
1179 | otherwise -> Nothing
1181 iface = hm_iface hm_info
1183 compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
1184 compile_it = upsweep_compile hsc_env old_hpt this_mod_name
1185 summary' mod_index nmods mb_old_iface
1187 compile_it_discard_iface
1188 = upsweep_compile hsc_env old_hpt this_mod_name
1189 summary' mod_index nmods Nothing
1195 -- Regardless of whether we're generating object code or
1196 -- byte code, we can always use an existing object file
1197 -- if it is *stable* (see checkStability).
1198 | is_stable_obj, isJust old_hmi ->
1200 -- object is stable, and we have an entry in the
1201 -- old HPT: nothing to do
1203 | is_stable_obj, isNothing old_hmi -> do
1204 linkable <- findObjectLinkable this_mod obj_fn
1205 (expectJust "upseep1" mb_obj_date)
1206 compile_it (Just linkable)
1207 -- object is stable, but we need to load the interface
1208 -- off disk to make a HMI.
1212 ASSERT(isJust old_hmi) -- must be in the old_hpt
1214 -- BCO is stable: nothing to do
1216 | Just hmi <- old_hmi,
1217 Just l <- hm_linkable hmi, not (isObjectLinkable l),
1218 linkableTime l >= ms_hs_date summary ->
1220 -- we have an old BCO that is up to date with respect
1221 -- to the source: do a recompilation check as normal.
1225 -- no existing code at all: we must recompile.
1227 -- When generating object code, if there's an up-to-date
1228 -- object file on the disk, then we can use it.
1229 -- However, if the object file is new (compared to any
1230 -- linkable we had from a previous compilation), then we
1231 -- must discard any in-memory interface, because this
1232 -- means the user has compiled the source file
1233 -- separately and generated a new interface, that we must
1234 -- read from the disk.
1236 obj | isObjectTarget obj,
1237 Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
1240 | Just l <- hm_linkable hmi,
1241 isObjectLinkable l && linkableTime l == obj_date
1242 -> compile_it (Just l)
1244 linkable <- findObjectLinkable this_mod obj_fn obj_date
1245 compile_it_discard_iface (Just linkable)
1251 -- Run hsc to compile a module
1252 upsweep_compile hsc_env old_hpt this_mod summary
1257 compresult <- compile hsc_env summary mb_old_linkable mb_old_iface
1261 -- Compilation failed. Compile may still have updated the PCS, tho.
1262 CompErrs -> return Nothing
1264 -- Compilation "succeeded", and may or may not have returned a new
1265 -- linkable (depending on whether compilation was actually performed
1267 CompOK new_details new_iface new_linkable
1268 -> do let new_info = HomeModInfo { hm_iface = new_iface,
1269 hm_details = new_details,
1270 hm_linkable = new_linkable }
1271 return (Just new_info)
1274 -- Filter modules in the HPT
1275 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
1276 retainInTopLevelEnvs keep_these hpt
1277 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
1279 , let mb_mod_info = lookupUFM hpt mod
1280 , isJust mb_mod_info ]
1282 -- ---------------------------------------------------------------------------
1283 -- Topological sort of the module graph
1286 :: Bool -- Drop hi-boot nodes? (see below)
1290 -- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1291 -- The resulting list of strongly-connected-components is in topologically
1292 -- sorted order, starting with the module(s) at the bottom of the
1293 -- dependency graph (ie compile them first) and ending with the ones at
1296 -- Drop hi-boot nodes (first boolean arg)?
1298 -- False: treat the hi-boot summaries as nodes of the graph,
1299 -- so the graph must be acyclic
1301 -- True: eliminate the hi-boot nodes, and instead pretend
1302 -- the a source-import of Foo is an import of Foo
1303 -- The resulting graph has no hi-boot nodes, but can by cyclic
1305 topSortModuleGraph drop_hs_boot_nodes summaries Nothing
1306 = stronglyConnComp (fst (moduleGraphNodes drop_hs_boot_nodes summaries))
1307 topSortModuleGraph drop_hs_boot_nodes summaries (Just mod)
1308 = stronglyConnComp (map vertex_fn (reachable graph root))
1310 -- restrict the graph to just those modules reachable from
1311 -- the specified module. We do this by building a graph with
1312 -- the full set of nodes, and determining the reachable set from
1313 -- the specified node.
1314 (nodes, lookup_key) = moduleGraphNodes drop_hs_boot_nodes summaries
1315 (graph, vertex_fn, key_fn) = graphFromEdges' nodes
1317 | Just key <- lookup_key HsSrcFile mod, Just v <- key_fn key = v
1318 | otherwise = throwDyn (ProgramError "module does not exist")
1320 moduleGraphNodes :: Bool -> [ModSummary]
1321 -> ([(ModSummary, Int, [Int])], HscSource -> ModuleName -> Maybe Int)
1322 moduleGraphNodes drop_hs_boot_nodes summaries = (nodes, lookup_key)
1324 -- Drop hs-boot nodes by using HsSrcFile as the key
1325 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1326 | otherwise = HsBootFile
1328 -- We use integers as the keys for the SCC algorithm
1329 nodes :: [(ModSummary, Int, [Int])]
1330 nodes = [(s, expectJust "topSort" $
1331 lookup_key (ms_hsc_src s) (ms_mod_name s),
1332 out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
1333 out_edge_keys HsSrcFile (map unLoc (ms_imps s)) ++
1334 (-- see [boot-edges] below
1335 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
1337 else case lookup_key HsBootFile (ms_mod_name s) of
1342 , not (isBootSummary s && drop_hs_boot_nodes) ]
1343 -- Drop the hi-boot ones if told to do so
1345 -- [boot-edges] if this is a .hs and there is an equivalent
1346 -- .hs-boot, add a link from the former to the latter. This
1347 -- has the effect of detecting bogus cases where the .hs-boot
1348 -- depends on the .hs, by introducing a cycle. Additionally,
1349 -- it ensures that we will always process the .hs-boot before
1350 -- the .hs, and so the HomePackageTable will always have the
1351 -- most up to date information.
1353 key_map :: NodeMap Int
1354 key_map = listToFM ([(moduleName (ms_mod s), ms_hsc_src s)
1358 lookup_key :: HscSource -> ModuleName -> Maybe Int
1359 lookup_key hs_src mod = lookupFM key_map (mod, hs_src)
1361 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1362 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1363 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1364 -- the IsBootInterface parameter True; else False
1367 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
1368 type NodeMap a = FiniteMap NodeKey a -- keyed by (mod, src_file_type) pairs
1370 msKey :: ModSummary -> NodeKey
1371 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1373 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1374 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
1376 nodeMapElts :: NodeMap a -> [a]
1377 nodeMapElts = eltsFM
1379 -- If there are {-# SOURCE #-} imports between strongly connected
1380 -- components in the topological sort, then those imports can
1381 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1382 -- were necessary, then the edge would be part of a cycle.
1383 warnUnnecessarySourceImports :: DynFlags -> [SCC ModSummary] -> IO ()
1384 warnUnnecessarySourceImports dflags sccs =
1385 printBagOfWarnings dflags (listToBag (concat (map (check.flattenSCC) sccs)))
1387 let mods_in_this_cycle = map ms_mod_name ms in
1388 [ warn m i | m <- ms, i <- ms_srcimps m,
1389 unLoc i `notElem` mods_in_this_cycle ]
1391 warn :: ModSummary -> Located ModuleName -> WarnMsg
1392 warn ms (L loc mod) =
1394 (ptext SLIT("Warning: {-# SOURCE #-} unnecessary in import of ")
1395 <+> quotes (ppr mod))
1397 -----------------------------------------------------------------------------
1398 -- Downsweep (dependency analysis)
1400 -- Chase downwards from the specified root set, returning summaries
1401 -- for all home modules encountered. Only follow source-import
1404 -- We pass in the previous collection of summaries, which is used as a
1405 -- cache to avoid recalculating a module summary if the source is
1408 -- The returned list of [ModSummary] nodes has one node for each home-package
1409 -- module, plus one for any hs-boot files. The imports of these nodes
1410 -- are all there, including the imports of non-home-package modules.
1413 -> [ModSummary] -- Old summaries
1414 -> [ModuleName] -- Ignore dependencies on these; treat
1415 -- them as if they were package modules
1416 -> Bool -- True <=> allow multiple targets to have
1417 -- the same module name; this is
1418 -- very useful for ghc -M
1419 -> IO (Maybe [ModSummary])
1420 -- The elts of [ModSummary] all have distinct
1421 -- (Modules, IsBoot) identifiers, unless the Bool is true
1422 -- in which case there can be repeats
1423 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1424 = -- catch error messages and return them
1425 handleDyn (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
1426 rootSummaries <- mapM getRootSummary roots
1427 let root_map = mkRootMap rootSummaries
1428 checkDuplicates root_map
1429 summs <- loop (concatMap msDeps rootSummaries) root_map
1432 roots = hsc_targets hsc_env
1434 old_summary_map :: NodeMap ModSummary
1435 old_summary_map = mkNodeMap old_summaries
1437 getRootSummary :: Target -> IO ModSummary
1438 getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
1439 = do exists <- doesFileExist file
1441 then summariseFile hsc_env old_summaries file mb_phase maybe_buf
1442 else throwDyn $ mkPlainErrMsg noSrcSpan $
1443 text "can't find file:" <+> text file
1444 getRootSummary (Target (TargetModule modl) maybe_buf)
1445 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1446 (L rootLoc modl) maybe_buf excl_mods
1447 case maybe_summary of
1448 Nothing -> packageModErr modl
1451 rootLoc = mkGeneralSrcSpan FSLIT("<command line>")
1453 -- In a root module, the filename is allowed to diverge from the module
1454 -- name, so we have to check that there aren't multiple root files
1455 -- defining the same module (otherwise the duplicates will be silently
1456 -- ignored, leading to confusing behaviour).
1457 checkDuplicates :: NodeMap [ModSummary] -> IO ()
1458 checkDuplicates root_map
1459 | allow_dup_roots = return ()
1460 | null dup_roots = return ()
1461 | otherwise = multiRootsErr (head dup_roots)
1463 dup_roots :: [[ModSummary]] -- Each at least of length 2
1464 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1466 loop :: [(Located ModuleName,IsBootInterface)]
1467 -- Work list: process these modules
1468 -> NodeMap [ModSummary]
1469 -- Visited set; the range is a list because
1470 -- the roots can have the same module names
1471 -- if allow_dup_roots is True
1473 -- The result includes the worklist, except
1474 -- for those mentioned in the visited set
1475 loop [] done = return (concat (nodeMapElts done))
1476 loop ((wanted_mod, is_boot) : ss) done
1477 | Just summs <- lookupFM done key
1478 = if isSingleton summs then
1481 do { multiRootsErr summs; return [] }
1482 | otherwise = do { mb_s <- summariseModule hsc_env old_summary_map
1483 is_boot wanted_mod Nothing excl_mods
1485 Nothing -> loop ss done
1486 Just s -> loop (msDeps s ++ ss)
1487 (addToFM done key [s]) }
1489 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1491 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1492 mkRootMap summaries = addListToFM_C (++) emptyFM
1493 [ (msKey s, [s]) | s <- summaries ]
1495 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
1496 -- (msDeps s) returns the dependencies of the ModSummary s.
1497 -- A wrinkle is that for a {-# SOURCE #-} import we return
1498 -- *both* the hs-boot file
1499 -- *and* the source file
1500 -- as "dependencies". That ensures that the list of all relevant
1501 -- modules always contains B.hs if it contains B.hs-boot.
1502 -- Remember, this pass isn't doing the topological sort. It's
1503 -- just gathering the list of all relevant ModSummaries
1505 concat [ [(m,True), (m,False)] | m <- ms_srcimps s ]
1506 ++ [ (m,False) | m <- ms_imps s ]
1508 -----------------------------------------------------------------------------
1509 -- Summarising modules
1511 -- We have two types of summarisation:
1513 -- * Summarise a file. This is used for the root module(s) passed to
1514 -- cmLoadModules. The file is read, and used to determine the root
1515 -- module name. The module name may differ from the filename.
1517 -- * Summarise a module. We are given a module name, and must provide
1518 -- a summary. The finder is used to locate the file in which the module
1523 -> [ModSummary] -- old summaries
1524 -> FilePath -- source file name
1525 -> Maybe Phase -- start phase
1526 -> Maybe (StringBuffer,ClockTime)
1529 summariseFile hsc_env old_summaries file mb_phase maybe_buf
1530 -- we can use a cached summary if one is available and the
1531 -- source file hasn't changed, But we have to look up the summary
1532 -- by source file, rather than module name as we do in summarise.
1533 | Just old_summary <- findSummaryBySourceFile old_summaries file
1535 let location = ms_location old_summary
1537 -- return the cached summary if the source didn't change
1538 src_timestamp <- case maybe_buf of
1539 Just (_,t) -> return t
1540 Nothing -> getModificationTime file
1541 -- The file exists; we checked in getRootSummary above.
1542 -- If it gets removed subsequently, then this
1543 -- getModificationTime may fail, but that's the right
1546 if ms_hs_date old_summary == src_timestamp
1547 then do -- update the object-file timestamp
1548 obj_timestamp <- getObjTimestamp location False
1549 return old_summary{ ms_obj_date = obj_timestamp }
1557 let dflags = hsc_dflags hsc_env
1559 (dflags', hspp_fn, buf)
1560 <- preprocessFile dflags file mb_phase maybe_buf
1562 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn
1564 -- Make a ModLocation for this file
1565 location <- mkHomeModLocation dflags mod_name file
1567 -- Tell the Finder cache where it is, so that subsequent calls
1568 -- to findModule will find it, even if it's not on any search path
1569 mod <- addHomeModuleToFinder hsc_env mod_name location
1571 src_timestamp <- case maybe_buf of
1572 Just (_,t) -> return t
1573 Nothing -> getModificationTime file
1574 -- getMofificationTime may fail
1576 obj_timestamp <- modificationTimeIfExists (ml_obj_file location)
1578 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1579 ms_location = location,
1580 ms_hspp_file = hspp_fn,
1581 ms_hspp_opts = dflags',
1582 ms_hspp_buf = Just buf,
1583 ms_srcimps = srcimps, ms_imps = the_imps,
1584 ms_hs_date = src_timestamp,
1585 ms_obj_date = obj_timestamp })
1587 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
1588 findSummaryBySourceFile summaries file
1589 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
1590 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
1594 -- Summarise a module, and pick up source and timestamp.
1597 -> NodeMap ModSummary -- Map of old summaries
1598 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
1599 -> Located ModuleName -- Imported module to be summarised
1600 -> Maybe (StringBuffer, ClockTime)
1601 -> [ModuleName] -- Modules to exclude
1602 -> IO (Maybe ModSummary) -- Its new summary
1604 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf excl_mods
1605 | wanted_mod `elem` excl_mods
1608 | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
1609 = do -- Find its new timestamp; all the
1610 -- ModSummaries in the old map have valid ml_hs_files
1611 let location = ms_location old_summary
1612 src_fn = expectJust "summariseModule" (ml_hs_file location)
1614 -- check the modification time on the source file, and
1615 -- return the cached summary if it hasn't changed. If the
1616 -- file has disappeared, we need to call the Finder again.
1618 Just (_,t) -> check_timestamp old_summary location src_fn t
1620 m <- System.IO.Error.try (getModificationTime src_fn)
1622 Right t -> check_timestamp old_summary location src_fn t
1623 Left e | isDoesNotExistError e -> find_it
1624 | otherwise -> ioError e
1626 | otherwise = find_it
1628 dflags = hsc_dflags hsc_env
1630 hsc_src = if is_boot then HsBootFile else HsSrcFile
1632 check_timestamp old_summary location src_fn src_timestamp
1633 | ms_hs_date old_summary == src_timestamp = do
1634 -- update the object-file timestamp
1635 obj_timestamp <- getObjTimestamp location is_boot
1636 return (Just old_summary{ ms_obj_date = obj_timestamp })
1638 -- source changed: re-summarise.
1639 new_summary location (ms_mod old_summary) src_fn src_timestamp
1642 -- Don't use the Finder's cache this time. If the module was
1643 -- previously a package module, it may have now appeared on the
1644 -- search path, so we want to consider it to be a home module. If
1645 -- the module was previously a home module, it may have moved.
1646 uncacheModule hsc_env wanted_mod
1647 found <- findImportedModule hsc_env wanted_mod Nothing
1650 | isJust (ml_hs_file location) ->
1652 just_found location mod
1654 -- Drop external-pkg
1655 ASSERT(modulePackageId mod /= thisPackage dflags)
1659 err -> noModError dflags loc wanted_mod err
1662 just_found location mod = do
1663 -- Adjust location to point to the hs-boot source file,
1664 -- hi file, object file, when is_boot says so
1665 let location' | is_boot = addBootSuffixLocn location
1666 | otherwise = location
1667 src_fn = expectJust "summarise2" (ml_hs_file location')
1669 -- Check that it exists
1670 -- It might have been deleted since the Finder last found it
1671 maybe_t <- modificationTimeIfExists src_fn
1673 Nothing -> noHsFileErr loc src_fn
1674 Just t -> new_summary location' mod src_fn t
1677 new_summary location mod src_fn src_timestamp
1679 -- Preprocess the source file and get its imports
1680 -- The dflags' contains the OPTIONS pragmas
1681 (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn Nothing maybe_buf
1682 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn
1684 when (mod_name /= wanted_mod) $
1685 throwDyn $ mkPlainErrMsg mod_loc $
1686 text "file name does not match module name"
1687 <+> quotes (ppr mod_name)
1689 -- Find the object timestamp, and return the summary
1690 obj_timestamp <- getObjTimestamp location is_boot
1692 return (Just ( ModSummary { ms_mod = mod,
1693 ms_hsc_src = hsc_src,
1694 ms_location = location,
1695 ms_hspp_file = hspp_fn,
1696 ms_hspp_opts = dflags',
1697 ms_hspp_buf = Just buf,
1698 ms_srcimps = srcimps,
1700 ms_hs_date = src_timestamp,
1701 ms_obj_date = obj_timestamp }))
1704 getObjTimestamp location is_boot
1705 = if is_boot then return Nothing
1706 else modificationTimeIfExists (ml_obj_file location)
1709 preprocessFile :: DynFlags -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
1710 -> IO (DynFlags, FilePath, StringBuffer)
1711 preprocessFile dflags src_fn mb_phase Nothing
1713 (dflags', hspp_fn) <- preprocess dflags (src_fn, mb_phase)
1714 buf <- hGetStringBuffer hspp_fn
1715 return (dflags', hspp_fn, buf)
1717 preprocessFile dflags src_fn mb_phase (Just (buf, time))
1719 -- case we bypass the preprocessing stage?
1721 local_opts = getOptions buf src_fn
1723 (dflags', errs) <- parseDynamicFlags dflags (map unLoc local_opts)
1727 | Just (Unlit _) <- mb_phase = True
1728 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
1729 -- note: local_opts is only required if there's no Unlit phase
1730 | dopt Opt_Cpp dflags' = True
1731 | dopt Opt_Pp dflags' = True
1734 when needs_preprocessing $
1735 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
1737 return (dflags', src_fn, buf)
1740 -----------------------------------------------------------------------------
1742 -----------------------------------------------------------------------------
1744 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
1745 -- ToDo: we don't have a proper line number for this error
1746 noModError dflags loc wanted_mod err
1747 = throwDyn $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
1749 noHsFileErr loc path
1750 = throwDyn $ mkPlainErrMsg loc $ text "Can't find" <+> text path
1753 = throwDyn $ mkPlainErrMsg noSrcSpan $
1754 text "module" <+> quotes (ppr mod) <+> text "is a package module"
1756 multiRootsErr :: [ModSummary] -> IO ()
1757 multiRootsErr summs@(summ1:_)
1758 = throwDyn $ mkPlainErrMsg noSrcSpan $
1759 text "module" <+> quotes (ppr mod) <+>
1760 text "is defined in multiple files:" <+>
1761 sep (map text files)
1764 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
1766 cyclicModuleErr :: [ModSummary] -> SDoc
1768 = hang (ptext SLIT("Module imports form a cycle for modules:"))
1769 2 (vcat (map show_one ms))
1771 show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
1772 nest 2 $ ptext SLIT("imports:") <+>
1773 (pp_imps HsBootFile (ms_srcimps ms)
1774 $$ pp_imps HsSrcFile (ms_imps ms))]
1775 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
1776 pp_imps src mods = fsep (map (show_mod src) mods)
1779 -- | Inform GHC that the working directory has changed. GHC will flush
1780 -- its cache of module locations, since it may no longer be valid.
1781 -- Note: if you change the working directory, you should also unload
1782 -- the current program (set targets to empty, followed by load).
1783 workingDirectoryChanged :: Session -> IO ()
1784 workingDirectoryChanged s = withSession s $ flushFinderCaches
1786 -- -----------------------------------------------------------------------------
1787 -- inspecting the session
1789 -- | Get the module dependency graph.
1790 getModuleGraph :: Session -> IO ModuleGraph -- ToDo: DiGraph ModSummary
1791 getModuleGraph s = withSession s (return . hsc_mod_graph)
1793 isLoaded :: Session -> ModuleName -> IO Bool
1794 isLoaded s m = withSession s $ \hsc_env ->
1795 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
1797 getBindings :: Session -> IO [TyThing]
1798 getBindings s = withSession s $ \hsc_env ->
1799 -- we have to implement the shadowing behaviour of ic_tmp_ids here
1800 -- (see InteractiveContext) and the quickest way is to use an OccEnv.
1802 tmp_ids = ic_tmp_ids (hsc_IC hsc_env)
1803 filtered = foldr f (const []) tmp_ids emptyUniqSet
1805 | uniq `elementOfUniqSet` set = rest set
1806 | otherwise = AnId id : rest (addOneToUniqSet set uniq)
1807 where uniq = getUnique (nameOccName (idName id))
1811 getPrintUnqual :: Session -> IO PrintUnqualified
1812 getPrintUnqual s = withSession s (return . icPrintUnqual . hsc_IC)
1814 -- | Container for information about a 'Module'.
1815 data ModuleInfo = ModuleInfo {
1816 minf_type_env :: TypeEnv,
1817 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
1818 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
1819 minf_instances :: [Instance]
1821 ,minf_modBreaks :: ModBreaks
1823 -- ToDo: this should really contain the ModIface too
1825 -- We don't want HomeModInfo here, because a ModuleInfo applies
1826 -- to package modules too.
1828 -- | Request information about a loaded 'Module'
1829 getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
1830 getModuleInfo s mdl = withSession s $ \hsc_env -> do
1831 let mg = hsc_mod_graph hsc_env
1832 if mdl `elem` map ms_mod mg
1833 then getHomeModuleInfo hsc_env (moduleName mdl)
1835 {- if isHomeModule (hsc_dflags hsc_env) mdl
1837 else -} getPackageModuleInfo hsc_env mdl
1838 -- getPackageModuleInfo will attempt to find the interface, so
1839 -- we don't want to call it for a home module, just in case there
1840 -- was a problem loading the module and the interface doesn't
1841 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
1843 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
1844 getPackageModuleInfo hsc_env mdl = do
1846 (_msgs, mb_avails) <- getModuleExports hsc_env mdl
1848 Nothing -> return Nothing
1850 eps <- readIORef (hsc_EPS hsc_env)
1852 names = availsToNameSet avails
1854 tys = [ ty | name <- concatMap availNames avails,
1855 Just ty <- [lookupTypeEnv pte name] ]
1857 return (Just (ModuleInfo {
1858 minf_type_env = mkTypeEnv tys,
1859 minf_exports = names,
1860 minf_rdr_env = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
1861 minf_instances = error "getModuleInfo: instances for package module unimplemented",
1862 minf_modBreaks = emptyModBreaks
1865 -- bogusly different for non-GHCI (ToDo)
1869 getHomeModuleInfo hsc_env mdl =
1870 case lookupUFM (hsc_HPT hsc_env) mdl of
1871 Nothing -> return Nothing
1873 let details = hm_details hmi
1874 return (Just (ModuleInfo {
1875 minf_type_env = md_types details,
1876 minf_exports = availsToNameSet (md_exports details),
1877 minf_rdr_env = mi_globals $! hm_iface hmi,
1878 minf_instances = md_insts details
1880 ,minf_modBreaks = md_modBreaks details
1884 -- | The list of top-level entities defined in a module
1885 modInfoTyThings :: ModuleInfo -> [TyThing]
1886 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
1888 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
1889 modInfoTopLevelScope minf
1890 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
1892 modInfoExports :: ModuleInfo -> [Name]
1893 modInfoExports minf = nameSetToList $! minf_exports minf
1895 -- | Returns the instances defined by the specified module.
1896 -- Warning: currently unimplemented for package modules.
1897 modInfoInstances :: ModuleInfo -> [Instance]
1898 modInfoInstances = minf_instances
1900 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
1901 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
1903 modInfoPrintUnqualified :: ModuleInfo -> Maybe PrintUnqualified
1904 modInfoPrintUnqualified minf = fmap mkPrintUnqualified (minf_rdr_env minf)
1906 modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
1907 modInfoLookupName s minf name = withSession s $ \hsc_env -> do
1908 case lookupTypeEnv (minf_type_env minf) name of
1909 Just tyThing -> return (Just tyThing)
1911 eps <- readIORef (hsc_EPS hsc_env)
1912 return $! lookupType (hsc_dflags hsc_env)
1913 (hsc_HPT hsc_env) (eps_PTE eps) name
1916 modInfoModBreaks = minf_modBreaks
1919 isDictonaryId :: Id -> Bool
1921 = case tcSplitSigmaTy (idType id) of { (tvs, theta, tau) -> isDictTy tau }
1923 -- | Looks up a global name: that is, any top-level name in any
1924 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
1925 -- the interactive context, and therefore does not require a preceding
1927 lookupGlobalName :: Session -> Name -> IO (Maybe TyThing)
1928 lookupGlobalName s name = withSession s $ \hsc_env -> do
1929 eps <- readIORef (hsc_EPS hsc_env)
1930 return $! lookupType (hsc_dflags hsc_env)
1931 (hsc_HPT hsc_env) (eps_PTE eps) name
1933 -- -----------------------------------------------------------------------------
1934 -- Misc exported utils
1936 dataConType :: DataCon -> Type
1937 dataConType dc = idType (dataConWrapId dc)
1939 -- | print a 'NamedThing', adding parentheses if the name is an operator.
1940 pprParenSymName :: NamedThing a => a -> SDoc
1941 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
1943 -- ----------------------------------------------------------------------------
1948 -- - Data and Typeable instances for HsSyn.
1950 -- ToDo: check for small transformations that happen to the syntax in
1951 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
1953 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
1954 -- to get from TyCons, Ids etc. to TH syntax (reify).
1956 -- :browse will use either lm_toplev or inspect lm_interface, depending
1957 -- on whether the module is interpreted or not.
1959 -- This is for reconstructing refactored source code
1960 -- Calls the lexer repeatedly.
1961 -- ToDo: add comment tokens to token stream
1962 getTokenStream :: Session -> Module -> IO [Located Token]
1965 -- -----------------------------------------------------------------------------
1966 -- Interactive evaluation
1968 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
1969 -- filesystem and package database to find the corresponding 'Module',
1970 -- using the algorithm that is used for an @import@ declaration.
1971 findModule :: Session -> ModuleName -> Maybe PackageId -> IO Module
1972 findModule s mod_name maybe_pkg = withSession s $ \hsc_env ->
1973 findModule' hsc_env mod_name maybe_pkg
1975 findModule' hsc_env mod_name maybe_pkg =
1977 dflags = hsc_dflags hsc_env
1978 hpt = hsc_HPT hsc_env
1979 this_pkg = thisPackage dflags
1981 case lookupUFM hpt mod_name of
1982 Just mod_info -> return (mi_module (hm_iface mod_info))
1983 _not_a_home_module -> do
1984 res <- findImportedModule hsc_env mod_name maybe_pkg
1986 Found _ m | modulePackageId m /= this_pkg -> return m
1987 | otherwise -> throwDyn (CmdLineError (showSDoc $
1988 text "module" <+> pprModule m <+>
1989 text "is not loaded"))
1990 err -> let msg = cannotFindModule dflags mod_name err in
1991 throwDyn (CmdLineError (showSDoc msg))
1994 getHistorySpan :: Session -> History -> IO SrcSpan
1995 getHistorySpan sess h = withSession sess $ \hsc_env ->
1996 return$ InteractiveEval.getHistorySpan hsc_env h
1998 obtainTerm :: Session -> Bool -> Id -> IO Term
1999 obtainTerm sess force id = withSession sess $ \hsc_env ->
2000 InteractiveEval.obtainTerm hsc_env force id
2002 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
2003 obtainTerm1 sess force mb_ty a = withSession sess $ \hsc_env ->
2004 InteractiveEval.obtainTerm1 hsc_env force mb_ty a
2006 obtainTermB :: Session -> Int -> Bool -> Id -> IO Term
2007 obtainTermB sess bound force id = withSession sess $ \hsc_env ->
2008 InteractiveEval.obtainTermB hsc_env bound force id