1 -- -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow, 2005
7 -- -----------------------------------------------------------------------------
13 defaultCleanupHandler,
16 -- * Flags and settings
17 DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
18 GhcMode(..), GhcLink(..), defaultObjectTarget,
25 Target(..), TargetId(..), Phase,
32 -- * Extending the program scope
33 extendGlobalRdrScope, -- :: Session -> [GlobalRdrElt] -> IO ()
34 setGlobalRdrScope, -- :: Session -> [GlobalRdrElt] -> IO ()
35 extendGlobalTypeScope, -- :: Session -> [Id] -> IO ()
36 setGlobalTypeScope, -- :: Session -> [Id] -> IO ()
38 -- * Loading\/compiling the program
40 load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
41 workingDirectoryChanged,
42 checkModule, checkAndLoadModule, CheckedModule(..),
43 TypecheckedSource, ParsedSource, RenamedSource,
44 compileToCore, compileToCoreModule, compileToCoreSimplified,
47 -- * Parsing Haddock comments
50 -- * Inspecting the module structure of the program
51 ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
56 -- * Inspecting modules
63 modInfoIsExportedName,
66 mkPrintUnqualifiedForModule,
69 PrintUnqualified, alwaysQualify,
71 -- * Interactive evaluation
72 getBindings, getPrintUnqual,
75 setContext, getContext,
85 runStmt, SingleStep(..),
87 Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
88 resumeHistory, resumeHistoryIx),
89 History(historyBreakInfo, historyEnclosingDecl),
90 GHC.getHistorySpan, getHistoryModule,
94 InteractiveEval.forward,
97 InteractiveEval.compileExpr, HValue, dynCompileExpr,
99 GHC.obtainTerm, GHC.obtainTerm1, GHC.obtainTermB, reconstructType,
101 ModBreaks(..), BreakIndex,
102 BreakInfo(breakInfo_number, breakInfo_module),
103 BreakArray, setBreakOn, setBreakOff, getBreak,
106 -- * Abstract syntax elements
112 Module, mkModule, pprModule, moduleName, modulePackageId,
113 ModuleName, mkModuleName, moduleNameString,
117 isExternalName, nameModule, pprParenSymName, nameSrcSpan,
119 RdrName(Qual,Unqual),
123 isImplicitId, isDeadBinder,
124 isExportedId, isLocalId, isGlobalId,
126 isPrimOpId, isFCallId, isClassOpId_maybe,
127 isDataConWorkId, idDataCon,
128 isBottomingId, isDictonaryId,
129 recordSelectorFieldLabel,
131 -- ** Type constructors
133 tyConTyVars, tyConDataCons, tyConArity,
134 isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
136 synTyConDefn, synTyConType, synTyConResKind,
142 -- ** Data constructors
144 dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
145 dataConIsInfix, isVanillaDataCon,
147 StrictnessMark(..), isMarkedStrict,
151 classMethods, classSCTheta, classTvsFds,
156 instanceDFunId, pprInstance, pprInstanceHdr,
158 -- ** Types and Kinds
159 Type, splitForAllTys, funResultTy,
160 pprParendType, pprTypeApp,
163 ThetaType, pprThetaArrow,
169 module HsSyn, -- ToDo: remove extraneous bits
173 defaultFixity, maxPrecedence,
177 -- ** Source locations
179 mkSrcLoc, isGoodSrcLoc, noSrcLoc,
180 srcLocFile, srcLocLine, srcLocCol,
182 mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
183 srcSpanStart, srcSpanEnd,
185 srcSpanStartLine, srcSpanEndLine,
186 srcSpanStartCol, srcSpanEndCol,
189 GhcException(..), showGhcException,
199 * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
200 * what StaticFlags should we expose, if any?
203 #include "HsVersions.h"
206 import qualified Linker
207 import Linker ( HValue )
211 import InteractiveEval
216 import TcRnTypes hiding (LIE)
217 import TcRnMonad ( initIfaceCheck )
221 import qualified HsSyn -- hack as we want to reexport the whole module
222 import HsSyn hiding ((<.>))
223 import Type hiding (typeKind)
224 import TcType hiding (typeKind)
227 import TysPrim ( alphaTyVars )
232 import Name hiding ( varName )
233 import OccName ( parenSymOcc )
234 import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr,
236 import FamInstEnv ( emptyFamInstEnv )
240 import DriverPipeline
241 import DriverPhases ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase )
248 import StaticFlagParser
249 import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
258 import Bag ( unitBag, listToBag )
261 import StringBuffer ( StringBuffer, hGetStringBuffer )
264 import Maybes ( expectJust, mapCatMaybes )
266 import HaddockLex ( tokenise )
269 import Control.Concurrent
270 import System.Directory ( getModificationTime, doesFileExist,
271 getCurrentDirectory )
274 import qualified Data.List as List
276 import System.Exit ( exitWith, ExitCode(..) )
277 import System.Time ( ClockTime, getClockTime )
280 import System.FilePath
282 import System.IO.Error ( try, isDoesNotExistError )
283 #if __GLASGOW_HASKELL__ >= 609
284 import Data.Typeable (cast)
286 import Prelude hiding (init)
289 -- -----------------------------------------------------------------------------
290 -- Exception handlers
292 -- | Install some default exception handlers and run the inner computation.
293 -- Unless you want to handle exceptions yourself, you should wrap this around
294 -- the top level of your program. The default handlers output the error
295 -- message(s) to stderr and exit cleanly.
296 defaultErrorHandler :: DynFlags -> IO a -> IO a
297 defaultErrorHandler dflags inner =
298 -- top-level exception handler: any unrecognised exception is a compiler bug.
299 #if __GLASGOW_HASKELL__ < 609
300 handle (\exception -> do
303 -- an IO exception probably isn't our fault, so don't panic
305 fatalErrorMsg dflags (text (show exception))
306 AsyncException StackOverflow ->
307 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
308 ExitException _ -> throw exception
310 fatalErrorMsg dflags (text (show (Panic (show exception))))
311 exitWith (ExitFailure 1)
314 handle (\(SomeException exception) -> do
316 case cast exception of
317 -- an IO exception probably isn't our fault, so don't panic
318 Just (ioe :: IOException) ->
319 fatalErrorMsg dflags (text (show ioe))
320 _ -> case cast exception of
321 Just StackOverflow ->
322 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
323 _ -> case cast exception of
324 Just (ex :: ExitCode) -> throw ex
327 (text (show (Panic (show exception))))
328 exitWith (ExitFailure 1)
332 -- program errors: messages with locations attached. Sometimes it is
333 -- convenient to just throw these as exceptions.
335 (\em -> do printBagOfErrors dflags (unitBag em)
336 exitWith (ExitFailure 1)) $
338 -- error messages propagated as exceptions
343 PhaseFailed _ code -> exitWith code
344 Interrupted -> exitWith (ExitFailure 1)
345 _ -> do fatalErrorMsg dflags (text (show ge))
346 exitWith (ExitFailure 1)
350 -- | Install a default cleanup handler to remove temporary files
351 -- deposited by a GHC run. This is seperate from
352 -- 'defaultErrorHandler', because you might want to override the error
353 -- handling, but still get the ordinary cleanup behaviour.
354 defaultCleanupHandler :: DynFlags -> IO a -> IO a
355 defaultCleanupHandler dflags inner =
356 -- make sure we clean up after ourselves
358 (do cleanTempFiles dflags
361 -- exceptions will be blocked while we clean the temporary files,
362 -- so there shouldn't be any difficulty if we receive further
366 -- | Starts a new session. A session consists of a set of loaded
367 -- modules, a set of options (DynFlags), and an interactive context.
368 -- ToDo: explain argument [[mb_top_dir]]
369 newSession :: Maybe FilePath -> IO Session
370 newSession mb_top_dir = do
372 main_thread <- myThreadId
373 modifyMVar_ interruptTargetThread (return . (main_thread :))
374 installSignalHandlers
377 dflags0 <- initDynFlags defaultDynFlags
378 dflags <- initSysTools mb_top_dir dflags0
379 env <- newHscEnv dflags
383 -- tmp: this breaks the abstraction, but required because DriverMkDepend
384 -- needs to call the Finder. ToDo: untangle this.
385 sessionHscEnv :: Session -> IO HscEnv
386 sessionHscEnv (Session ref) = readIORef ref
388 -- -----------------------------------------------------------------------------
391 -- | Grabs the DynFlags from the Session
392 getSessionDynFlags :: Session -> IO DynFlags
393 getSessionDynFlags s = withSession s (return . hsc_dflags)
395 -- | Updates the DynFlags in a Session. This also reads
396 -- the package database (unless it has already been read),
397 -- and prepares the compilers knowledge about packages. It
398 -- can be called again to load new packages: just add new
399 -- package flags to (packageFlags dflags).
401 -- Returns a list of new packages that may need to be linked in using
402 -- the dynamic linker (see 'linkPackages') as a result of new package
403 -- flags. If you are not doing linking or doing static linking, you
404 -- can ignore the list of packages returned.
406 setSessionDynFlags :: Session -> DynFlags -> IO [PackageId]
407 setSessionDynFlags (Session ref) dflags = do
408 hsc_env <- readIORef ref
409 (dflags', preload) <- initPackages dflags
410 writeIORef ref $! hsc_env{ hsc_dflags = dflags' }
413 -- | If there is no -o option, guess the name of target executable
414 -- by using top-level source file name as a base.
415 guessOutputFile :: Session -> IO ()
416 guessOutputFile s = modifySession s $ \env ->
417 let dflags = hsc_dflags env
418 mod_graph = hsc_mod_graph env
419 mainModuleSrcPath :: Maybe String
420 mainModuleSrcPath = do
421 let isMain = (== mainModIs dflags) . ms_mod
422 [ms] <- return (filter isMain mod_graph)
423 ml_hs_file (ms_location ms)
424 name = fmap dropExtension mainModuleSrcPath
426 #if defined(mingw32_HOST_OS)
427 -- we must add the .exe extention unconditionally here, otherwise
428 -- when name has an extension of its own, the .exe extension will
429 -- not be added by DriverPipeline.exeFileName. See #2248
430 name_exe = fmap (<.> "exe") name
435 case outputFile dflags of
437 Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } }
439 -- -----------------------------------------------------------------------------
442 -- ToDo: think about relative vs. absolute file paths. And what
443 -- happens when the current directory changes.
445 -- | Sets the targets for this session. Each target may be a module name
446 -- or a filename. The targets correspond to the set of root modules for
447 -- the program\/library. Unloading the current program is achieved by
448 -- setting the current set of targets to be empty, followed by load.
449 setTargets :: Session -> [Target] -> IO ()
450 setTargets s targets = modifySession s (\h -> h{ hsc_targets = targets })
452 -- | returns the current set of targets
453 getTargets :: Session -> IO [Target]
454 getTargets s = withSession s (return . hsc_targets)
456 -- | Add another target
457 addTarget :: Session -> Target -> IO ()
459 = modifySession s (\h -> h{ hsc_targets = target : hsc_targets h })
462 removeTarget :: Session -> TargetId -> IO ()
463 removeTarget s target_id
464 = modifySession s (\h -> h{ hsc_targets = filter (hsc_targets h) })
466 filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
468 -- Attempts to guess what Target a string refers to. This function implements
469 -- the --make/GHCi command-line syntax for filenames:
471 -- - if the string looks like a Haskell source filename, then interpret
473 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
475 -- - otherwise interpret the string as a module name
477 guessTarget :: String -> Maybe Phase -> IO Target
478 guessTarget str (Just phase)
479 = return (Target (TargetFile str (Just phase)) True Nothing)
480 guessTarget str Nothing
481 | isHaskellSrcFilename file
482 = return (target (TargetFile file Nothing))
484 = do exists <- doesFileExist hs_file
486 then return (target (TargetFile hs_file Nothing))
488 exists <- doesFileExist lhs_file
490 then return (target (TargetFile lhs_file Nothing))
492 if looksLikeModuleName file
493 then return (target (TargetModule (mkModuleName file)))
496 (ProgramError (showSDoc $
497 text "target" <+> quotes (text file) <+>
498 text "is not a module name or a source file"))
501 | '*':rest <- str = (rest, False)
502 | otherwise = (str, True)
504 hs_file = file <.> "hs"
505 lhs_file = file <.> "lhs"
507 target tid = Target tid obj_allowed Nothing
509 -- -----------------------------------------------------------------------------
510 -- Extending the program scope
512 extendGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
513 extendGlobalRdrScope session rdrElts
514 = modifySession session $ \hscEnv ->
515 let global_rdr = hsc_global_rdr_env hscEnv
516 in hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv global_rdr rdrElts }
518 setGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
519 setGlobalRdrScope session rdrElts
520 = modifySession session $ \hscEnv ->
521 hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv rdrElts }
523 extendGlobalTypeScope :: Session -> [Id] -> IO ()
524 extendGlobalTypeScope session ids
525 = modifySession session $ \hscEnv ->
526 let global_type = hsc_global_type_env hscEnv
527 in hscEnv{ hsc_global_type_env = extendTypeEnvWithIds global_type ids }
529 setGlobalTypeScope :: Session -> [Id] -> IO ()
530 setGlobalTypeScope session ids
531 = modifySession session $ \hscEnv ->
532 hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
534 -- -----------------------------------------------------------------------------
535 -- Parsing Haddock comments
537 parseHaddockComment :: String -> Either String (HsDoc RdrName)
538 parseHaddockComment string =
539 case parseHaddockParagraphs (tokenise string) of
543 -- -----------------------------------------------------------------------------
544 -- Loading the program
546 -- Perform a dependency analysis starting from the current targets
547 -- and update the session with the new module graph.
548 depanal :: Session -> [ModuleName] -> Bool -> IO (Maybe ModuleGraph)
549 depanal (Session ref) excluded_mods allow_dup_roots = do
550 hsc_env <- readIORef ref
552 dflags = hsc_dflags hsc_env
553 targets = hsc_targets hsc_env
554 old_graph = hsc_mod_graph hsc_env
556 showPass dflags "Chasing dependencies"
557 debugTraceMsg dflags 2 (hcat [
558 text "Chasing modules from: ",
559 hcat (punctuate comma (map pprTarget targets))])
561 r <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
563 Just mod_graph -> writeIORef ref hsc_env{ hsc_mod_graph = mod_graph }
568 -- | The result of load.
570 = LoadOk Errors -- ^ all specified targets were loaded successfully.
571 | LoadFailed Errors -- ^ not all modules were loaded.
573 type Errors = [String]
575 data ErrMsg = ErrMsg {
576 errMsgSeverity :: Severity, -- warning, error, etc.
577 errMsgSpans :: [SrcSpan],
578 errMsgShortDoc :: Doc,
579 errMsgExtraInfo :: Doc
585 | LoadUpTo ModuleName
586 | LoadDependenciesOf ModuleName
588 -- | Try to load the program. If a Module is supplied, then just
589 -- attempt to load up to this target. If no Module is supplied,
590 -- then try to load all targets.
591 load :: Session -> LoadHowMuch -> IO SuccessFlag
594 -- Dependency analysis first. Note that this fixes the module graph:
595 -- even if we don't get a fully successful upsweep, the full module
596 -- graph is still retained in the Session. We can tell which modules
597 -- were successfully loaded by inspecting the Session's HPT.
598 mb_graph <- depanal s [] False
600 Just mod_graph -> load2 s how_much mod_graph
601 Nothing -> return Failed
603 load2 :: Session -> LoadHowMuch -> [ModSummary] -> IO SuccessFlag
604 load2 s@(Session ref) how_much mod_graph = do
606 hsc_env <- readIORef ref
608 let hpt1 = hsc_HPT hsc_env
609 let dflags = hsc_dflags hsc_env
611 -- The "bad" boot modules are the ones for which we have
612 -- B.hs-boot in the module graph, but no B.hs
613 -- The downsweep should have ensured this does not happen
615 let all_home_mods = [ms_mod_name s
616 | s <- mod_graph, not (isBootSummary s)]
617 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
618 not (ms_mod_name s `elem` all_home_mods)]
619 ASSERT( null bad_boot_mods ) return ()
621 -- check that the module given in HowMuch actually exists, otherwise
622 -- topSortModuleGraph will bomb later.
623 let checkHowMuch (LoadUpTo m) = checkMod m
624 checkHowMuch (LoadDependenciesOf m) = checkMod m
628 | m `elem` all_home_mods = and_then
630 errorMsg dflags (text "no such module:" <+>
634 checkHowMuch how_much $ do
636 -- mg2_with_srcimps drops the hi-boot nodes, returning a
637 -- graph with cycles. Among other things, it is used for
638 -- backing out partially complete cycles following a failed
639 -- upsweep, and for removing from hpt all the modules
640 -- not in strict downwards closure, during calls to compile.
641 let mg2_with_srcimps :: [SCC ModSummary]
642 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
644 -- If we can determine that any of the {-# SOURCE #-} imports
645 -- are definitely unnecessary, then emit a warning.
646 warnUnnecessarySourceImports dflags mg2_with_srcimps
649 -- check the stability property for each module.
650 stable_mods@(stable_obj,stable_bco)
651 = checkStability hpt1 mg2_with_srcimps all_home_mods
653 -- prune bits of the HPT which are definitely redundant now,
655 pruned_hpt = pruneHomePackageTable hpt1
656 (flattenSCCs mg2_with_srcimps)
661 -- before we unload anything, make sure we don't leave an old
662 -- interactive context around pointing to dead bindings. Also,
663 -- write the pruned HPT to allow the old HPT to be GC'd.
664 writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext,
665 hsc_HPT = pruned_hpt }
667 debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
668 text "Stable BCO:" <+> ppr stable_bco)
670 -- Unload any modules which are going to be re-linked this time around.
671 let stable_linkables = [ linkable
672 | m <- stable_obj++stable_bco,
673 Just hmi <- [lookupUFM pruned_hpt m],
674 Just linkable <- [hm_linkable hmi] ]
675 unload hsc_env stable_linkables
677 -- We could at this point detect cycles which aren't broken by
678 -- a source-import, and complain immediately, but it seems better
679 -- to let upsweep_mods do this, so at least some useful work gets
680 -- done before the upsweep is abandoned.
681 --hPutStrLn stderr "after tsort:\n"
682 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
684 -- Now do the upsweep, calling compile for each module in
685 -- turn. Final result is version 3 of everything.
687 -- Topologically sort the module graph, this time including hi-boot
688 -- nodes, and possibly just including the portion of the graph
689 -- reachable from the module specified in the 2nd argument to load.
690 -- This graph should be cycle-free.
691 -- If we're restricting the upsweep to a portion of the graph, we
692 -- also want to retain everything that is still stable.
693 let full_mg :: [SCC ModSummary]
694 full_mg = topSortModuleGraph False mod_graph Nothing
696 maybe_top_mod = case how_much of
698 LoadDependenciesOf m -> Just m
701 partial_mg0 :: [SCC ModSummary]
702 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
704 -- LoadDependenciesOf m: we want the upsweep to stop just
705 -- short of the specified module (unless the specified module
708 | LoadDependenciesOf _mod <- how_much
709 = ASSERT( case last partial_mg0 of
710 AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
711 List.init partial_mg0
717 | AcyclicSCC ms <- full_mg,
718 ms_mod_name ms `elem` stable_obj++stable_bco,
719 ms_mod_name ms `notElem` [ ms_mod_name ms' |
720 AcyclicSCC ms' <- partial_mg ] ]
722 mg = stable_mg ++ partial_mg
724 -- clean up between compilations
725 let cleanup = cleanTempFilesExcept dflags
726 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
728 debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
730 (upsweep_ok, hsc_env1, modsUpswept)
731 <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
732 pruned_hpt stable_mods cleanup mg
734 -- Make modsDone be the summaries for each home module now
735 -- available; this should equal the domain of hpt3.
736 -- Get in in a roughly top .. bottom order (hence reverse).
738 let modsDone = reverse modsUpswept
740 -- Try and do linking in some form, depending on whether the
741 -- upsweep was completely or only partially successful.
743 if succeeded upsweep_ok
746 -- Easy; just relink it all.
747 do debugTraceMsg dflags 2 (text "Upsweep completely successful.")
749 -- Clean up after ourselves
750 cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
752 -- Issue a warning for the confusing case where the user
753 -- said '-o foo' but we're not going to do any linking.
754 -- We attempt linking if either (a) one of the modules is
755 -- called Main, or (b) the user said -no-hs-main, indicating
756 -- that main() is going to come from somewhere else.
758 let ofile = outputFile dflags
759 let no_hs_main = dopt Opt_NoHsMain dflags
761 main_mod = mainModIs dflags
762 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
763 do_linking = a_root_is_Main || no_hs_main
765 when (ghcLink dflags == LinkBinary
766 && isJust ofile && not do_linking) $
767 debugTraceMsg dflags 1 $
768 text ("Warning: output was redirected with -o, " ++
769 "but no output will be generated\n" ++
770 "because there is no " ++
771 moduleNameString (moduleName main_mod) ++ " module.")
773 -- link everything together
774 linkresult <- link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
776 loadFinish Succeeded linkresult ref hsc_env1
779 -- Tricky. We need to back out the effects of compiling any
780 -- half-done cycles, both so as to clean up the top level envs
781 -- and to avoid telling the interactive linker to link them.
782 do debugTraceMsg dflags 2 (text "Upsweep partially successful.")
785 = map ms_mod modsDone
786 let mods_to_zap_names
787 = findPartiallyCompletedCycles modsDone_names
790 = filter ((`notElem` mods_to_zap_names).ms_mod)
793 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
796 -- Clean up after ourselves
797 cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
799 -- there should be no Nothings where linkables should be, now
800 ASSERT(all (isJust.hm_linkable)
801 (eltsUFM (hsc_HPT hsc_env))) do
803 -- Link everything together
804 linkresult <- link (ghcLink dflags) dflags False hpt4
806 let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
807 loadFinish Failed linkresult ref hsc_env4
809 -- Finish up after a load.
811 -- If the link failed, unload everything and return.
812 loadFinish :: SuccessFlag -> SuccessFlag -> IORef HscEnv -> HscEnv -> IO SuccessFlag
813 loadFinish _all_ok Failed ref hsc_env
814 = do unload hsc_env []
815 writeIORef ref $! discardProg hsc_env
818 -- Empty the interactive context and set the module context to the topmost
819 -- newly loaded module, or the Prelude if none were loaded.
820 loadFinish all_ok Succeeded ref hsc_env
821 = do writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
825 -- Forget the current program, but retain the persistent info in HscEnv
826 discardProg :: HscEnv -> HscEnv
828 = hsc_env { hsc_mod_graph = emptyMG,
829 hsc_IC = emptyInteractiveContext,
830 hsc_HPT = emptyHomePackageTable }
832 -- used to fish out the preprocess output files for the purposes of
833 -- cleaning up. The preprocessed file *might* be the same as the
834 -- source file, but that doesn't do any harm.
835 ppFilesFromSummaries :: [ModSummary] -> [FilePath]
836 ppFilesFromSummaries summaries = map ms_hspp_file summaries
838 -- -----------------------------------------------------------------------------
842 CheckedModule { parsedSource :: ParsedSource,
843 renamedSource :: Maybe RenamedSource,
844 typecheckedSource :: Maybe TypecheckedSource,
845 checkedModuleInfo :: Maybe ModuleInfo,
846 coreModule :: Maybe ModGuts
848 -- ToDo: improvements that could be made here:
849 -- if the module succeeded renaming but not typechecking,
850 -- we can still get back the GlobalRdrEnv and exports, so
851 -- perhaps the ModuleInfo should be split up into separate
852 -- fields within CheckedModule.
854 type ParsedSource = Located (HsModule RdrName)
855 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
856 Maybe (HsDoc Name), HaddockModInfo Name)
857 type TypecheckedSource = LHsBinds Id
860 -- - things that aren't in the output of the typechecker right now:
864 -- - type/data/newtype declarations
865 -- - class declarations
867 -- - extra things in the typechecker's output:
868 -- - default methods are turned into top-level decls.
869 -- - dictionary bindings
872 -- | This is the way to get access to parsed and typechecked source code
873 -- for a module. 'checkModule' attempts to typecheck the module. If
874 -- successful, it returns the abstract syntax for the module.
875 -- If compileToCore is true, it also desugars the module and returns the
876 -- resulting Core bindings as a component of the CheckedModule.
877 checkModule :: Session -> ModuleName -> Bool -> IO (Maybe CheckedModule)
878 checkModule (Session ref) mod compile_to_core
880 hsc_env <- readIORef ref
881 let mg = hsc_mod_graph hsc_env
882 case [ ms | ms <- mg, ms_mod_name ms == mod ] of
884 (ms:_) -> checkModule_ ref ms compile_to_core False
886 -- | parses and typechecks a module, optionally generates Core, and also
887 -- loads the module into the 'Session' so that modules which depend on
888 -- this one may subsequently be typechecked using 'checkModule' or
889 -- 'checkAndLoadModule'. If you need to check more than one module,
890 -- you probably want to use 'checkAndLoadModule'. Constructing the
891 -- interface takes a little work, so it might be slightly slower than
893 checkAndLoadModule :: Session -> ModSummary -> Bool -> IO (Maybe CheckedModule)
894 checkAndLoadModule (Session ref) ms compile_to_core
895 = checkModule_ ref ms compile_to_core True
897 checkModule_ :: IORef HscEnv -> ModSummary -> Bool -> Bool
898 -> IO (Maybe CheckedModule)
899 checkModule_ ref ms compile_to_core load
901 let mod = ms_mod_name ms
902 hsc_env0 <- readIORef ref
903 let hsc_env = hsc_env0{hsc_dflags=ms_hspp_opts ms}
904 mb_parsed <- parseFile hsc_env ms
906 Nothing -> return Nothing
907 Just rdr_module -> do
908 mb_typechecked <- typecheckRenameModule hsc_env ms rdr_module
909 case mb_typechecked of
910 Nothing -> return (Just CheckedModule {
911 parsedSource = rdr_module,
912 renamedSource = Nothing,
913 typecheckedSource = Nothing,
914 checkedModuleInfo = Nothing,
915 coreModule = Nothing })
916 Just (tcg, rn_info) -> do
917 details <- makeSimpleDetails hsc_env tcg
919 let tc_binds = tcg_binds tcg
920 let rdr_env = tcg_rdr_env tcg
921 let minf = ModuleInfo {
922 minf_type_env = md_types details,
923 minf_exports = availsToNameSet $
925 minf_rdr_env = Just rdr_env,
926 minf_instances = md_insts details
928 ,minf_modBreaks = emptyModBreaks
932 mb_guts <- if compile_to_core
933 then deSugarModule hsc_env ms tcg
936 -- If we are loading this module so that we can typecheck
937 -- dependent modules, generate an interface and stuff it
938 -- all in the HomePackageTable.
940 (iface,_) <- makeSimpleIface hsc_env Nothing tcg details
941 let mod_info = HomeModInfo {
943 hm_details = details,
944 hm_linkable = Nothing }
945 let hpt_new = addToUFM (hsc_HPT hsc_env) mod mod_info
946 writeIORef ref hsc_env0{ hsc_HPT = hpt_new }
948 return (Just (CheckedModule {
949 parsedSource = rdr_module,
950 renamedSource = rn_info,
951 typecheckedSource = Just tc_binds,
952 checkedModuleInfo = Just minf,
953 coreModule = mb_guts }))
955 -- | This is the way to get access to the Core bindings corresponding
956 -- to a module. 'compileToCore' invokes 'checkModule' to parse, typecheck, and
957 -- desugar the module, then returns the resulting Core module (consisting of
958 -- the module name, type declarations, and function declarations) if
960 compileToCoreModule :: Session -> FilePath -> IO (Maybe CoreModule)
961 compileToCoreModule = compileCore False
963 -- | Like compileToCoreModule, but invokes the simplifier, so
964 -- as to return simplified and tidied Core.
965 compileToCoreSimplified :: Session -> FilePath -> IO (Maybe CoreModule)
966 compileToCoreSimplified = compileCore True
968 -- | Provided for backwards-compatibility: compileToCore returns just the Core
969 -- bindings, but for most purposes, you probably want to call
970 -- compileToCoreModule.
971 compileToCore :: Session -> FilePath -> IO (Maybe [CoreBind])
972 compileToCore session fn = do
973 maybeCoreModule <- compileToCoreModule session fn
974 return $ fmap cm_binds maybeCoreModule
976 -- | Takes a CoreModule and compiles the bindings therein
977 -- to object code. The first argument is a bool flag indicating
978 -- whether to run the simplifier.
979 -- The resulting .o, .hi, and executable files, if any, are stored in the
980 -- current directory, and named according to the module name.
981 -- Returns True iff compilation succeeded.
982 -- This has only so far been tested with a single self-contained module.
983 compileCoreToObj :: Bool -> Session -> CoreModule -> IO Bool
984 compileCoreToObj simplify session cm@(CoreModule{ cm_module = mName }) = do
985 hscEnv <- sessionHscEnv session
986 dflags <- getSessionDynFlags session
987 currentTime <- getClockTime
988 cwd <- getCurrentDirectory
989 modLocation <- mkHiOnlyModLocation dflags (hiSuf dflags) cwd
990 ((moduleNameSlashes . moduleName) mName)
992 let modSummary = ModSummary { ms_mod = mName,
993 ms_hsc_src = ExtCoreFile,
994 ms_location = modLocation,
995 -- By setting the object file timestamp to Nothing,
996 -- we always force recompilation, which is what we
997 -- want. (Thus it doesn't matter what the timestamp
998 -- for the (nonexistent) source file is.)
999 ms_hs_date = currentTime,
1000 ms_obj_date = Nothing,
1001 -- Only handling the single-module case for now, so no imports.
1006 ms_hspp_opts = dflags,
1007 ms_hspp_buf = Nothing
1010 mbHscResult <- evalComp
1011 ((if simplify then hscSimplify else return) (mkModGuts cm)
1012 >>= hscNormalIface >>= hscWriteIface >>= hscOneShot)
1013 (CompState{ compHscEnv=hscEnv,
1014 compModSummary=modSummary,
1015 compOldIface=Nothing})
1016 return $ isJust mbHscResult
1018 -- Makes a "vanilla" ModGuts.
1019 mkModGuts :: CoreModule -> ModGuts
1020 mkModGuts coreModule = ModGuts {
1021 mg_module = cm_module coreModule,
1024 mg_deps = noDependencies,
1025 mg_dir_imps = emptyModuleEnv,
1026 mg_used_names = emptyNameSet,
1027 mg_rdr_env = emptyGlobalRdrEnv,
1028 mg_fix_env = emptyFixityEnv,
1029 mg_types = emptyTypeEnv,
1033 mg_binds = cm_binds coreModule,
1034 mg_foreign = NoStubs,
1035 mg_warns = NoWarnings,
1036 mg_hpc_info = emptyHpcInfo False,
1037 mg_modBreaks = emptyModBreaks,
1038 mg_vect_info = noVectInfo,
1039 mg_inst_env = emptyInstEnv,
1040 mg_fam_inst_env = emptyFamInstEnv
1043 compileCore :: Bool -> Session -> FilePath -> IO (Maybe CoreModule)
1044 compileCore simplify session fn = do
1045 -- First, set the target to the desired filename
1046 target <- guessTarget fn Nothing
1047 addTarget session target
1048 load session LoadAllTargets
1049 -- Then find dependencies
1050 maybeModGraph <- depanal session [] True
1051 case maybeModGraph of
1052 Nothing -> return Nothing
1054 case find ((== fn) . msHsFilePath) modGraph of
1055 Just modSummary -> do
1056 -- Now we have the module name;
1057 -- parse, typecheck and desugar the module
1058 let mod = ms_mod_name modSummary
1059 maybeCheckedModule <- checkModule session mod True
1060 case maybeCheckedModule of
1061 Nothing -> return Nothing
1062 Just checkedMod -> (liftM $ fmap gutsToCoreModule) $
1063 case (coreModule checkedMod) of
1064 Just mg | simplify -> (sessionHscEnv session)
1065 -- If simplify is true: simplify (hscSimplify),
1066 -- then tidy (tidyProgram).
1067 >>= \ hscEnv -> evalComp (hscSimplify mg)
1068 (CompState{ compHscEnv=hscEnv,
1069 compModSummary=modSummary,
1070 compOldIface=Nothing})
1071 >>= (tidyProgram hscEnv)
1072 >>= (return . Just . Left)
1073 Just guts -> return $ Just $ Right guts
1074 Nothing -> return Nothing
1075 Nothing -> panic "compileToCoreModule: target FilePath not found in\
1076 module dependency graph"
1077 where -- two versions, based on whether we simplify (thus run tidyProgram,
1078 -- which returns a (CgGuts, ModDetails) pair, or not (in which case
1079 -- we just have a ModGuts.
1080 gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
1081 gutsToCoreModule (Left (cg, md)) = CoreModule {
1082 cm_module = cg_module cg, cm_types = md_types md,
1083 cm_imports = cg_dir_imps cg, cm_binds = cg_binds cg
1085 gutsToCoreModule (Right mg) = CoreModule {
1086 cm_module = mg_module mg, cm_types = mg_types mg,
1087 cm_imports = moduleEnvKeys (mg_dir_imps mg), cm_binds = mg_binds mg
1090 -- ---------------------------------------------------------------------------
1093 unload :: HscEnv -> [Linkable] -> IO ()
1094 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
1095 = case ghcLink (hsc_dflags hsc_env) of
1097 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
1099 LinkInMemory -> panic "unload: no interpreter"
1100 -- urgh. avoid warnings:
1101 hsc_env stable_linkables
1105 -- -----------------------------------------------------------------------------
1109 Stability tells us which modules definitely do not need to be recompiled.
1110 There are two main reasons for having stability:
1112 - avoid doing a complete upsweep of the module graph in GHCi when
1113 modules near the bottom of the tree have not changed.
1115 - to tell GHCi when it can load object code: we can only load object code
1116 for a module when we also load object code fo all of the imports of the
1117 module. So we need to know that we will definitely not be recompiling
1118 any of these modules, and we can use the object code.
1120 The stability check is as follows. Both stableObject and
1121 stableBCO are used during the upsweep phase later.
1124 stable m = stableObject m || stableBCO m
1127 all stableObject (imports m)
1128 && old linkable does not exist, or is == on-disk .o
1129 && date(on-disk .o) > date(.hs)
1132 all stable (imports m)
1133 && date(BCO) > date(.hs)
1136 These properties embody the following ideas:
1138 - if a module is stable, then:
1139 - if it has been compiled in a previous pass (present in HPT)
1140 then it does not need to be compiled or re-linked.
1141 - if it has not been compiled in a previous pass,
1142 then we only need to read its .hi file from disk and
1143 link it to produce a ModDetails.
1145 - if a modules is not stable, we will definitely be at least
1146 re-linking, and possibly re-compiling it during the upsweep.
1147 All non-stable modules can (and should) therefore be unlinked
1150 - Note that objects are only considered stable if they only depend
1151 on other objects. We can't link object code against byte code.
1155 :: HomePackageTable -- HPT from last compilation
1156 -> [SCC ModSummary] -- current module graph (cyclic)
1157 -> [ModuleName] -- all home modules
1158 -> ([ModuleName], -- stableObject
1159 [ModuleName]) -- stableBCO
1161 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
1163 checkSCC (stable_obj, stable_bco) scc0
1164 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
1165 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
1166 | otherwise = (stable_obj, stable_bco)
1168 scc = flattenSCC scc0
1169 scc_mods = map ms_mod_name scc
1170 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
1172 scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
1173 -- all imports outside the current SCC, but in the home pkg
1175 stable_obj_imps = map (`elem` stable_obj) scc_allimps
1176 stable_bco_imps = map (`elem` stable_bco) scc_allimps
1180 && all object_ok scc
1183 and (zipWith (||) stable_obj_imps stable_bco_imps)
1187 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
1191 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
1192 Just hmi | Just l <- hm_linkable hmi
1193 -> isObjectLinkable l && t == linkableTime l
1195 -- why '>=' rather than '>' above? If the filesystem stores
1196 -- times to the nearset second, we may occasionally find that
1197 -- the object & source have the same modification time,
1198 -- especially if the source was automatically generated
1199 -- and compiled. Using >= is slightly unsafe, but it matches
1200 -- make's behaviour.
1203 = case lookupUFM hpt (ms_mod_name ms) of
1204 Just hmi | Just l <- hm_linkable hmi ->
1205 not (isObjectLinkable l) &&
1206 linkableTime l >= ms_hs_date ms
1209 ms_allimps :: ModSummary -> [ModuleName]
1210 ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
1212 -- -----------------------------------------------------------------------------
1213 -- Prune the HomePackageTable
1215 -- Before doing an upsweep, we can throw away:
1217 -- - For non-stable modules:
1218 -- - all ModDetails, all linked code
1219 -- - all unlinked code that is out of date with respect to
1222 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
1223 -- space at the end of the upsweep, because the topmost ModDetails of the
1224 -- old HPT holds on to the entire type environment from the previous
1227 pruneHomePackageTable
1230 -> ([ModuleName],[ModuleName])
1233 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
1236 | is_stable modl = hmi'
1237 | otherwise = hmi'{ hm_details = emptyModDetails }
1239 modl = moduleName (mi_module (hm_iface hmi))
1240 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
1241 = hmi{ hm_linkable = Nothing }
1244 where ms = expectJust "prune" (lookupUFM ms_map modl)
1246 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
1248 is_stable m = m `elem` stable_obj || m `elem` stable_bco
1250 -- -----------------------------------------------------------------------------
1252 -- Return (names of) all those in modsDone who are part of a cycle
1253 -- as defined by theGraph.
1254 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
1255 findPartiallyCompletedCycles modsDone theGraph
1259 chew ((AcyclicSCC _):rest) = chew rest -- acyclic? not interesting.
1260 chew ((CyclicSCC vs):rest)
1261 = let names_in_this_cycle = nub (map ms_mod vs)
1263 = nub ([done | done <- modsDone,
1264 done `elem` names_in_this_cycle])
1265 chewed_rest = chew rest
1267 if notNull mods_in_this_cycle
1268 && length mods_in_this_cycle < length names_in_this_cycle
1269 then mods_in_this_cycle ++ chewed_rest
1272 -- -----------------------------------------------------------------------------
1275 -- This is where we compile each module in the module graph, in a pass
1276 -- from the bottom to the top of the graph.
1278 -- There better had not be any cyclic groups here -- we check for them.
1281 :: HscEnv -- Includes initially-empty HPT
1282 -> HomePackageTable -- HPT from last time round (pruned)
1283 -> ([ModuleName],[ModuleName]) -- stable modules (see checkStability)
1284 -> IO () -- How to clean up unwanted tmp files
1285 -> [SCC ModSummary] -- Mods to do (the worklist)
1287 HscEnv, -- With an updated HPT
1288 [ModSummary]) -- Mods which succeeded
1290 upsweep hsc_env old_hpt stable_mods cleanup sccs = do
1291 (res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
1292 return (res, hsc_env, reverse done)
1295 upsweep' hsc_env _old_hpt done
1297 = return (Succeeded, hsc_env, done)
1299 upsweep' hsc_env _old_hpt done
1300 (CyclicSCC ms:_) _ _
1301 = do fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
1302 return (Failed, hsc_env, done)
1304 upsweep' hsc_env old_hpt done
1305 (AcyclicSCC mod:mods) mod_index nmods
1306 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1307 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
1308 -- (moduleEnvElts (hsc_HPT hsc_env)))
1310 mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod
1313 cleanup -- Remove unwanted tmp files between compilations
1316 Nothing -> return (Failed, hsc_env, done)
1318 let this_mod = ms_mod_name mod
1320 -- Add new info to hsc_env
1321 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
1322 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
1324 -- Space-saving: delete the old HPT entry
1325 -- for mod BUT if mod is a hs-boot
1326 -- node, don't delete it. For the
1327 -- interface, the HPT entry is probaby for the
1328 -- main Haskell source file. Deleting it
1329 -- would force the real module to be recompiled
1331 old_hpt1 | isBootSummary mod = old_hpt
1332 | otherwise = delFromUFM old_hpt this_mod
1336 -- fixup our HomePackageTable after we've finished compiling
1337 -- a mutually-recursive loop. See reTypecheckLoop, below.
1338 hsc_env2 <- reTypecheckLoop hsc_env1 mod done'
1340 upsweep' hsc_env2 old_hpt1 done' mods (mod_index+1) nmods
1343 -- Compile a single module. Always produce a Linkable for it if
1344 -- successful. If no compilation happened, return the old Linkable.
1345 upsweep_mod :: HscEnv
1347 -> ([ModuleName],[ModuleName])
1349 -> Int -- index of module
1350 -> Int -- total number of modules
1351 -> IO (Maybe HomeModInfo) -- Nothing => Failed
1353 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
1355 this_mod_name = ms_mod_name summary
1356 this_mod = ms_mod summary
1357 mb_obj_date = ms_obj_date summary
1358 obj_fn = ml_obj_file (ms_location summary)
1359 hs_date = ms_hs_date summary
1361 is_stable_obj = this_mod_name `elem` stable_obj
1362 is_stable_bco = this_mod_name `elem` stable_bco
1364 old_hmi = lookupUFM old_hpt this_mod_name
1366 -- We're using the dflags for this module now, obtained by
1367 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
1368 dflags = ms_hspp_opts summary
1369 prevailing_target = hscTarget (hsc_dflags hsc_env)
1370 local_target = hscTarget dflags
1372 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
1373 -- we don't do anything dodgy: these should only work to change
1374 -- from -fvia-C to -fasm and vice-versa, otherwise we could
1375 -- end up trying to link object code to byte code.
1376 target = if prevailing_target /= local_target
1377 && (not (isObjectTarget prevailing_target)
1378 || not (isObjectTarget local_target))
1379 then prevailing_target
1382 -- store the corrected hscTarget into the summary
1383 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
1385 -- The old interface is ok if
1386 -- a) we're compiling a source file, and the old HPT
1387 -- entry is for a source file
1388 -- b) we're compiling a hs-boot file
1389 -- Case (b) allows an hs-boot file to get the interface of its
1390 -- real source file on the second iteration of the compilation
1391 -- manager, but that does no harm. Otherwise the hs-boot file
1392 -- will always be recompiled
1397 Just hm_info | isBootSummary summary -> Just iface
1398 | not (mi_boot iface) -> Just iface
1399 | otherwise -> Nothing
1401 iface = hm_iface hm_info
1403 compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
1404 compile_it = compile hsc_env summary' mod_index nmods mb_old_iface
1406 compile_it_discard_iface
1407 = compile hsc_env summary' mod_index nmods Nothing
1413 -- Regardless of whether we're generating object code or
1414 -- byte code, we can always use an existing object file
1415 -- if it is *stable* (see checkStability).
1416 | is_stable_obj, isJust old_hmi ->
1418 -- object is stable, and we have an entry in the
1419 -- old HPT: nothing to do
1421 | is_stable_obj, isNothing old_hmi -> do
1422 linkable <- findObjectLinkable this_mod obj_fn
1423 (expectJust "upseep1" mb_obj_date)
1424 compile_it (Just linkable)
1425 -- object is stable, but we need to load the interface
1426 -- off disk to make a HMI.
1430 ASSERT(isJust old_hmi) -- must be in the old_hpt
1432 -- BCO is stable: nothing to do
1434 | Just hmi <- old_hmi,
1435 Just l <- hm_linkable hmi, not (isObjectLinkable l),
1436 linkableTime l >= ms_hs_date summary ->
1438 -- we have an old BCO that is up to date with respect
1439 -- to the source: do a recompilation check as normal.
1443 -- no existing code at all: we must recompile.
1445 -- When generating object code, if there's an up-to-date
1446 -- object file on the disk, then we can use it.
1447 -- However, if the object file is new (compared to any
1448 -- linkable we had from a previous compilation), then we
1449 -- must discard any in-memory interface, because this
1450 -- means the user has compiled the source file
1451 -- separately and generated a new interface, that we must
1452 -- read from the disk.
1454 obj | isObjectTarget obj,
1455 Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
1458 | Just l <- hm_linkable hmi,
1459 isObjectLinkable l && linkableTime l == obj_date
1460 -> compile_it (Just l)
1462 linkable <- findObjectLinkable this_mod obj_fn obj_date
1463 compile_it_discard_iface (Just linkable)
1470 -- Filter modules in the HPT
1471 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
1472 retainInTopLevelEnvs keep_these hpt
1473 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
1475 , let mb_mod_info = lookupUFM hpt mod
1476 , isJust mb_mod_info ]
1478 -- ---------------------------------------------------------------------------
1479 -- Typecheck module loops
1482 See bug #930. This code fixes a long-standing bug in --make. The
1483 problem is that when compiling the modules *inside* a loop, a data
1484 type that is only defined at the top of the loop looks opaque; but
1485 after the loop is done, the structure of the data type becomes
1488 The difficulty is then that two different bits of code have
1489 different notions of what the data type looks like.
1491 The idea is that after we compile a module which also has an .hs-boot
1492 file, we re-generate the ModDetails for each of the modules that
1493 depends on the .hs-boot file, so that everyone points to the proper
1494 TyCons, Ids etc. defined by the real module, not the boot module.
1495 Fortunately re-generating a ModDetails from a ModIface is easy: the
1496 function TcIface.typecheckIface does exactly that.
1498 Picking the modules to re-typecheck is slightly tricky. Starting from
1499 the module graph consisting of the modules that have already been
1500 compiled, we reverse the edges (so they point from the imported module
1501 to the importing module), and depth-first-search from the .hs-boot
1502 node. This gives us all the modules that depend transitively on the
1503 .hs-boot module, and those are exactly the modules that we need to
1506 Following this fix, GHC can compile itself with --make -O2.
1509 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
1510 reTypecheckLoop hsc_env ms graph
1511 | not (isBootSummary ms) &&
1512 any (\m -> ms_mod m == this_mod && isBootSummary m) graph
1514 let mss = reachableBackwards (ms_mod_name ms) graph
1515 non_boot = filter (not.isBootSummary) mss
1516 debugTraceMsg (hsc_dflags hsc_env) 2 $
1517 text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
1518 typecheckLoop hsc_env (map ms_mod_name non_boot)
1522 this_mod = ms_mod ms
1524 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
1525 typecheckLoop hsc_env mods = do
1527 fixIO $ \new_hpt -> do
1528 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
1529 mds <- initIfaceCheck new_hsc_env $
1530 mapM (typecheckIface . hm_iface) hmis
1531 let new_hpt = addListToUFM old_hpt
1532 (zip mods [ hmi{ hm_details = details }
1533 | (hmi,details) <- zip hmis mds ])
1535 return hsc_env{ hsc_HPT = new_hpt }
1537 old_hpt = hsc_HPT hsc_env
1538 hmis = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
1540 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
1541 reachableBackwards mod summaries
1542 = [ ms | (ms,_,_) <- reachableG (transposeG graph) root ]
1543 where -- the rest just sets up the graph:
1544 (graph, lookup_node) = moduleGraphNodes False summaries
1545 root = expectJust "reachableBackwards" (lookup_node HsBootFile mod)
1547 -- ---------------------------------------------------------------------------
1548 -- Topological sort of the module graph
1550 type SummaryNode = (ModSummary, Int, [Int])
1553 :: Bool -- Drop hi-boot nodes? (see below)
1557 -- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1558 -- The resulting list of strongly-connected-components is in topologically
1559 -- sorted order, starting with the module(s) at the bottom of the
1560 -- dependency graph (ie compile them first) and ending with the ones at
1563 -- Drop hi-boot nodes (first boolean arg)?
1565 -- False: treat the hi-boot summaries as nodes of the graph,
1566 -- so the graph must be acyclic
1568 -- True: eliminate the hi-boot nodes, and instead pretend
1569 -- the a source-import of Foo is an import of Foo
1570 -- The resulting graph has no hi-boot nodes, but can by cyclic
1572 topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
1573 = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph
1575 (graph, lookup_node) = moduleGraphNodes drop_hs_boot_nodes summaries
1577 initial_graph = case mb_root_mod of
1580 -- restrict the graph to just those modules reachable from
1581 -- the specified module. We do this by building a graph with
1582 -- the full set of nodes, and determining the reachable set from
1583 -- the specified node.
1584 let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
1585 | otherwise = ghcError (ProgramError "module does not exist")
1586 in graphFromEdgedVertices (seq root (reachableG graph root))
1588 summaryNodeKey :: SummaryNode -> Int
1589 summaryNodeKey (_, k, _) = k
1591 summaryNodeSummary :: SummaryNode -> ModSummary
1592 summaryNodeSummary (s, _, _) = s
1594 moduleGraphNodes :: Bool -> [ModSummary]
1595 -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
1596 moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)
1598 numbered_summaries = zip summaries [1..]
1600 lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode
1601 lookup_node hs_src mod = lookupFM node_map (mod, hs_src)
1603 lookup_key :: HscSource -> ModuleName -> Maybe Int
1604 lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)
1606 node_map :: NodeMap SummaryNode
1607 node_map = listToFM [ ((moduleName (ms_mod s), ms_hsc_src s), node)
1608 | node@(s, _, _) <- nodes ]
1610 -- We use integers as the keys for the SCC algorithm
1611 nodes :: [SummaryNode]
1612 nodes = [ (s, key, out_keys)
1613 | (s, key) <- numbered_summaries
1614 -- Drop the hi-boot ones if told to do so
1615 , not (isBootSummary s && drop_hs_boot_nodes)
1616 , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
1617 out_edge_keys HsSrcFile (map unLoc (ms_imps s)) ++
1618 (-- see [boot-edges] below
1619 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
1621 else case lookup_key HsBootFile (ms_mod_name s) of
1625 -- [boot-edges] if this is a .hs and there is an equivalent
1626 -- .hs-boot, add a link from the former to the latter. This
1627 -- has the effect of detecting bogus cases where the .hs-boot
1628 -- depends on the .hs, by introducing a cycle. Additionally,
1629 -- it ensures that we will always process the .hs-boot before
1630 -- the .hs, and so the HomePackageTable will always have the
1631 -- most up to date information.
1633 -- Drop hs-boot nodes by using HsSrcFile as the key
1634 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1635 | otherwise = HsBootFile
1637 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1638 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1639 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1640 -- the IsBootInterface parameter True; else False
1643 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
1644 type NodeMap a = FiniteMap NodeKey a -- keyed by (mod, src_file_type) pairs
1646 msKey :: ModSummary -> NodeKey
1647 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1649 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1650 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
1652 nodeMapElts :: NodeMap a -> [a]
1653 nodeMapElts = eltsFM
1655 -- If there are {-# SOURCE #-} imports between strongly connected
1656 -- components in the topological sort, then those imports can
1657 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1658 -- were necessary, then the edge would be part of a cycle.
1659 warnUnnecessarySourceImports :: DynFlags -> [SCC ModSummary] -> IO ()
1660 warnUnnecessarySourceImports dflags sccs =
1661 printBagOfWarnings dflags (listToBag (concat (map (check.flattenSCC) sccs)))
1663 let mods_in_this_cycle = map ms_mod_name ms in
1664 [ warn i | m <- ms, i <- ms_srcimps m,
1665 unLoc i `notElem` mods_in_this_cycle ]
1667 warn :: Located ModuleName -> WarnMsg
1670 (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
1671 <+> quotes (ppr mod))
1673 -----------------------------------------------------------------------------
1674 -- Downsweep (dependency analysis)
1676 -- Chase downwards from the specified root set, returning summaries
1677 -- for all home modules encountered. Only follow source-import
1680 -- We pass in the previous collection of summaries, which is used as a
1681 -- cache to avoid recalculating a module summary if the source is
1684 -- The returned list of [ModSummary] nodes has one node for each home-package
1685 -- module, plus one for any hs-boot files. The imports of these nodes
1686 -- are all there, including the imports of non-home-package modules.
1689 -> [ModSummary] -- Old summaries
1690 -> [ModuleName] -- Ignore dependencies on these; treat
1691 -- them as if they were package modules
1692 -> Bool -- True <=> allow multiple targets to have
1693 -- the same module name; this is
1694 -- very useful for ghc -M
1695 -> IO (Maybe [ModSummary])
1696 -- The elts of [ModSummary] all have distinct
1697 -- (Modules, IsBoot) identifiers, unless the Bool is true
1698 -- in which case there can be repeats
1699 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1700 = -- catch error messages and return them
1702 (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
1703 rootSummaries <- mapM getRootSummary roots
1704 let root_map = mkRootMap rootSummaries
1705 checkDuplicates root_map
1706 summs <- loop (concatMap msDeps rootSummaries) root_map
1709 roots = hsc_targets hsc_env
1711 old_summary_map :: NodeMap ModSummary
1712 old_summary_map = mkNodeMap old_summaries
1714 getRootSummary :: Target -> IO ModSummary
1715 getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)
1716 = do exists <- doesFileExist file
1718 then summariseFile hsc_env old_summaries file mb_phase
1719 obj_allowed maybe_buf
1720 else throwErrMsg $ mkPlainErrMsg noSrcSpan $
1721 text "can't find file:" <+> text file
1722 getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
1723 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1724 (L rootLoc modl) obj_allowed
1726 case maybe_summary of
1727 Nothing -> packageModErr modl
1730 rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1732 -- In a root module, the filename is allowed to diverge from the module
1733 -- name, so we have to check that there aren't multiple root files
1734 -- defining the same module (otherwise the duplicates will be silently
1735 -- ignored, leading to confusing behaviour).
1736 checkDuplicates :: NodeMap [ModSummary] -> IO ()
1737 checkDuplicates root_map
1738 | allow_dup_roots = return ()
1739 | null dup_roots = return ()
1740 | otherwise = multiRootsErr (head dup_roots)
1742 dup_roots :: [[ModSummary]] -- Each at least of length 2
1743 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1745 loop :: [(Located ModuleName,IsBootInterface)]
1746 -- Work list: process these modules
1747 -> NodeMap [ModSummary]
1748 -- Visited set; the range is a list because
1749 -- the roots can have the same module names
1750 -- if allow_dup_roots is True
1752 -- The result includes the worklist, except
1753 -- for those mentioned in the visited set
1754 loop [] done = return (concat (nodeMapElts done))
1755 loop ((wanted_mod, is_boot) : ss) done
1756 | Just summs <- lookupFM done key
1757 = if isSingleton summs then
1760 do { multiRootsErr summs; return [] }
1762 = do mb_s <- summariseModule hsc_env old_summary_map
1763 is_boot wanted_mod True
1766 Nothing -> loop ss done
1767 Just s -> loop (msDeps s ++ ss) (addToFM done key [s])
1769 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1771 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1772 mkRootMap summaries = addListToFM_C (++) emptyFM
1773 [ (msKey s, [s]) | s <- summaries ]
1775 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
1776 -- (msDeps s) returns the dependencies of the ModSummary s.
1777 -- A wrinkle is that for a {-# SOURCE #-} import we return
1778 -- *both* the hs-boot file
1779 -- *and* the source file
1780 -- as "dependencies". That ensures that the list of all relevant
1781 -- modules always contains B.hs if it contains B.hs-boot.
1782 -- Remember, this pass isn't doing the topological sort. It's
1783 -- just gathering the list of all relevant ModSummaries
1785 concat [ [(m,True), (m,False)] | m <- ms_srcimps s ]
1786 ++ [ (m,False) | m <- ms_imps s ]
1788 -----------------------------------------------------------------------------
1789 -- Summarising modules
1791 -- We have two types of summarisation:
1793 -- * Summarise a file. This is used for the root module(s) passed to
1794 -- cmLoadModules. The file is read, and used to determine the root
1795 -- module name. The module name may differ from the filename.
1797 -- * Summarise a module. We are given a module name, and must provide
1798 -- a summary. The finder is used to locate the file in which the module
1803 -> [ModSummary] -- old summaries
1804 -> FilePath -- source file name
1805 -> Maybe Phase -- start phase
1806 -> Bool -- object code allowed?
1807 -> Maybe (StringBuffer,ClockTime)
1810 summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
1811 -- we can use a cached summary if one is available and the
1812 -- source file hasn't changed, But we have to look up the summary
1813 -- by source file, rather than module name as we do in summarise.
1814 | Just old_summary <- findSummaryBySourceFile old_summaries file
1816 let location = ms_location old_summary
1818 -- return the cached summary if the source didn't change
1819 src_timestamp <- case maybe_buf of
1820 Just (_,t) -> return t
1821 Nothing -> getModificationTime file
1822 -- The file exists; we checked in getRootSummary above.
1823 -- If it gets removed subsequently, then this
1824 -- getModificationTime may fail, but that's the right
1827 if ms_hs_date old_summary == src_timestamp
1828 then do -- update the object-file timestamp
1830 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1831 || obj_allowed -- bug #1205
1832 then getObjTimestamp location False
1834 return old_summary{ ms_obj_date = obj_timestamp }
1842 let dflags = hsc_dflags hsc_env
1844 (dflags', hspp_fn, buf)
1845 <- preprocessFile hsc_env file mb_phase maybe_buf
1847 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
1849 -- Make a ModLocation for this file
1850 location <- mkHomeModLocation dflags mod_name file
1852 -- Tell the Finder cache where it is, so that subsequent calls
1853 -- to findModule will find it, even if it's not on any search path
1854 mod <- addHomeModuleToFinder hsc_env mod_name location
1856 src_timestamp <- case maybe_buf of
1857 Just (_,t) -> return t
1858 Nothing -> getModificationTime file
1859 -- getMofificationTime may fail
1861 -- when the user asks to load a source file by name, we only
1862 -- use an object file if -fobject-code is on. See #1205.
1864 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1865 || obj_allowed -- bug #1205
1866 then modificationTimeIfExists (ml_obj_file location)
1869 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1870 ms_location = location,
1871 ms_hspp_file = hspp_fn,
1872 ms_hspp_opts = dflags',
1873 ms_hspp_buf = Just buf,
1874 ms_srcimps = srcimps, ms_imps = the_imps,
1875 ms_hs_date = src_timestamp,
1876 ms_obj_date = obj_timestamp })
1878 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
1879 findSummaryBySourceFile summaries file
1880 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
1881 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
1885 -- Summarise a module, and pick up source and timestamp.
1888 -> NodeMap ModSummary -- Map of old summaries
1889 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
1890 -> Located ModuleName -- Imported module to be summarised
1891 -> Bool -- object code allowed?
1892 -> Maybe (StringBuffer, ClockTime)
1893 -> [ModuleName] -- Modules to exclude
1894 -> IO (Maybe ModSummary) -- Its new summary
1896 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
1897 obj_allowed maybe_buf excl_mods
1898 | wanted_mod `elem` excl_mods
1901 | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
1902 = do -- Find its new timestamp; all the
1903 -- ModSummaries in the old map have valid ml_hs_files
1904 let location = ms_location old_summary
1905 src_fn = expectJust "summariseModule" (ml_hs_file location)
1907 -- check the modification time on the source file, and
1908 -- return the cached summary if it hasn't changed. If the
1909 -- file has disappeared, we need to call the Finder again.
1911 Just (_,t) -> check_timestamp old_summary location src_fn t
1913 m <- System.IO.Error.try (getModificationTime src_fn)
1915 Right t -> check_timestamp old_summary location src_fn t
1916 Left e | isDoesNotExistError e -> find_it
1917 | otherwise -> ioError e
1919 | otherwise = find_it
1921 dflags = hsc_dflags hsc_env
1923 hsc_src = if is_boot then HsBootFile else HsSrcFile
1925 check_timestamp old_summary location src_fn src_timestamp
1926 | ms_hs_date old_summary == src_timestamp = do
1927 -- update the object-file timestamp
1929 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1930 || obj_allowed -- bug #1205
1931 then getObjTimestamp location is_boot
1933 return (Just old_summary{ ms_obj_date = obj_timestamp })
1935 -- source changed: re-summarise.
1936 new_summary location (ms_mod old_summary) src_fn src_timestamp
1939 -- Don't use the Finder's cache this time. If the module was
1940 -- previously a package module, it may have now appeared on the
1941 -- search path, so we want to consider it to be a home module. If
1942 -- the module was previously a home module, it may have moved.
1943 uncacheModule hsc_env wanted_mod
1944 found <- findImportedModule hsc_env wanted_mod Nothing
1947 | isJust (ml_hs_file location) ->
1949 just_found location mod
1951 -- Drop external-pkg
1952 ASSERT(modulePackageId mod /= thisPackage dflags)
1955 err -> noModError dflags loc wanted_mod err
1958 just_found location mod = do
1959 -- Adjust location to point to the hs-boot source file,
1960 -- hi file, object file, when is_boot says so
1961 let location' | is_boot = addBootSuffixLocn location
1962 | otherwise = location
1963 src_fn = expectJust "summarise2" (ml_hs_file location')
1965 -- Check that it exists
1966 -- It might have been deleted since the Finder last found it
1967 maybe_t <- modificationTimeIfExists src_fn
1969 Nothing -> noHsFileErr loc src_fn
1970 Just t -> new_summary location' mod src_fn t
1973 new_summary location mod src_fn src_timestamp
1975 -- Preprocess the source file and get its imports
1976 -- The dflags' contains the OPTIONS pragmas
1977 (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
1978 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
1980 when (mod_name /= wanted_mod) $
1981 throwErrMsg $ mkPlainErrMsg mod_loc $
1982 text "File name does not match module name:"
1983 $$ text "Saw:" <+> quotes (ppr mod_name)
1984 $$ text "Expected:" <+> quotes (ppr wanted_mod)
1986 -- Find the object timestamp, and return the summary
1989 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1990 || obj_allowed -- bug #1205
1991 then getObjTimestamp location is_boot
1994 return (Just ( ModSummary { ms_mod = mod,
1995 ms_hsc_src = hsc_src,
1996 ms_location = location,
1997 ms_hspp_file = hspp_fn,
1998 ms_hspp_opts = dflags',
1999 ms_hspp_buf = Just buf,
2000 ms_srcimps = srcimps,
2002 ms_hs_date = src_timestamp,
2003 ms_obj_date = obj_timestamp }))
2006 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
2007 getObjTimestamp location is_boot
2008 = if is_boot then return Nothing
2009 else modificationTimeIfExists (ml_obj_file location)
2012 preprocessFile :: HscEnv -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
2013 -> IO (DynFlags, FilePath, StringBuffer)
2014 preprocessFile hsc_env src_fn mb_phase Nothing
2016 (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
2017 buf <- hGetStringBuffer hspp_fn
2018 return (dflags', hspp_fn, buf)
2020 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
2022 let dflags = hsc_dflags hsc_env
2023 -- case we bypass the preprocessing stage?
2025 local_opts = getOptions dflags buf src_fn
2027 (dflags', leftovers, warns) <- parseDynamicFlags dflags local_opts
2028 checkProcessArgsResult leftovers
2029 handleFlagWarnings dflags' warns
2033 | Just (Unlit _) <- mb_phase = True
2034 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
2035 -- note: local_opts is only required if there's no Unlit phase
2036 | dopt Opt_Cpp dflags' = True
2037 | dopt Opt_Pp dflags' = True
2040 when needs_preprocessing $
2041 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
2043 return (dflags', src_fn, buf)
2046 -----------------------------------------------------------------------------
2048 -----------------------------------------------------------------------------
2050 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
2051 -- ToDo: we don't have a proper line number for this error
2052 noModError dflags loc wanted_mod err
2053 = throwErrMsg $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
2055 noHsFileErr :: SrcSpan -> String -> a
2056 noHsFileErr loc path
2057 = throwErrMsg $ mkPlainErrMsg loc $ text "Can't find" <+> text path
2059 packageModErr :: ModuleName -> a
2061 = throwErrMsg $ mkPlainErrMsg noSrcSpan $
2062 text "module" <+> quotes (ppr mod) <+> text "is a package module"
2064 multiRootsErr :: [ModSummary] -> IO ()
2065 multiRootsErr [] = panic "multiRootsErr"
2066 multiRootsErr summs@(summ1:_)
2067 = throwErrMsg $ mkPlainErrMsg noSrcSpan $
2068 text "module" <+> quotes (ppr mod) <+>
2069 text "is defined in multiple files:" <+>
2070 sep (map text files)
2073 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
2075 cyclicModuleErr :: [ModSummary] -> SDoc
2077 = hang (ptext (sLit "Module imports form a cycle for modules:"))
2078 2 (vcat (map show_one ms))
2080 show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
2081 nest 2 $ ptext (sLit "imports:") <+>
2082 (pp_imps HsBootFile (ms_srcimps ms)
2083 $$ pp_imps HsSrcFile (ms_imps ms))]
2084 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
2085 pp_imps src mods = fsep (map (show_mod src) mods)
2088 -- | Inform GHC that the working directory has changed. GHC will flush
2089 -- its cache of module locations, since it may no longer be valid.
2090 -- Note: if you change the working directory, you should also unload
2091 -- the current program (set targets to empty, followed by load).
2092 workingDirectoryChanged :: Session -> IO ()
2093 workingDirectoryChanged s = withSession s $ flushFinderCaches
2095 -- -----------------------------------------------------------------------------
2096 -- inspecting the session
2098 -- | Get the module dependency graph.
2099 getModuleGraph :: Session -> IO ModuleGraph -- ToDo: DiGraph ModSummary
2100 getModuleGraph s = withSession s (return . hsc_mod_graph)
2102 isLoaded :: Session -> ModuleName -> IO Bool
2103 isLoaded s m = withSession s $ \hsc_env ->
2104 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
2106 getBindings :: Session -> IO [TyThing]
2107 getBindings s = withSession s $ \hsc_env ->
2108 -- we have to implement the shadowing behaviour of ic_tmp_ids here
2109 -- (see InteractiveContext) and the quickest way is to use an OccEnv.
2111 tmp_ids = ic_tmp_ids (hsc_IC hsc_env)
2112 filtered = foldr f (const []) tmp_ids emptyUniqSet
2114 | uniq `elementOfUniqSet` set = rest set
2115 | otherwise = AnId id : rest (addOneToUniqSet set uniq)
2116 where uniq = getUnique (nameOccName (idName id))
2120 getPrintUnqual :: Session -> IO PrintUnqualified
2121 getPrintUnqual s = withSession s $ \hsc_env ->
2122 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
2124 -- | Container for information about a 'Module'.
2125 data ModuleInfo = ModuleInfo {
2126 minf_type_env :: TypeEnv,
2127 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
2128 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
2129 minf_instances :: [Instance]
2131 ,minf_modBreaks :: ModBreaks
2133 -- ToDo: this should really contain the ModIface too
2135 -- We don't want HomeModInfo here, because a ModuleInfo applies
2136 -- to package modules too.
2138 -- | Request information about a loaded 'Module'
2139 getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
2140 getModuleInfo s mdl = withSession s $ \hsc_env -> do
2141 let mg = hsc_mod_graph hsc_env
2142 if mdl `elem` map ms_mod mg
2143 then getHomeModuleInfo hsc_env (moduleName mdl)
2145 {- if isHomeModule (hsc_dflags hsc_env) mdl
2147 else -} getPackageModuleInfo hsc_env mdl
2148 -- getPackageModuleInfo will attempt to find the interface, so
2149 -- we don't want to call it for a home module, just in case there
2150 -- was a problem loading the module and the interface doesn't
2151 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
2153 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
2155 getPackageModuleInfo hsc_env mdl = do
2156 (_msgs, mb_avails) <- getModuleExports hsc_env mdl
2158 Nothing -> return Nothing
2160 eps <- readIORef (hsc_EPS hsc_env)
2162 names = availsToNameSet avails
2164 tys = [ ty | name <- concatMap availNames avails,
2165 Just ty <- [lookupTypeEnv pte name] ]
2167 return (Just (ModuleInfo {
2168 minf_type_env = mkTypeEnv tys,
2169 minf_exports = names,
2170 minf_rdr_env = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
2171 minf_instances = error "getModuleInfo: instances for package module unimplemented",
2172 minf_modBreaks = emptyModBreaks
2175 getPackageModuleInfo _hsc_env _mdl = do
2176 -- bogusly different for non-GHCI (ToDo)
2180 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
2181 getHomeModuleInfo hsc_env mdl =
2182 case lookupUFM (hsc_HPT hsc_env) mdl of
2183 Nothing -> return Nothing
2185 let details = hm_details hmi
2186 return (Just (ModuleInfo {
2187 minf_type_env = md_types details,
2188 minf_exports = availsToNameSet (md_exports details),
2189 minf_rdr_env = mi_globals $! hm_iface hmi,
2190 minf_instances = md_insts details
2192 ,minf_modBreaks = getModBreaks hmi
2196 -- | The list of top-level entities defined in a module
2197 modInfoTyThings :: ModuleInfo -> [TyThing]
2198 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
2200 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
2201 modInfoTopLevelScope minf
2202 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
2204 modInfoExports :: ModuleInfo -> [Name]
2205 modInfoExports minf = nameSetToList $! minf_exports minf
2207 -- | Returns the instances defined by the specified module.
2208 -- Warning: currently unimplemented for package modules.
2209 modInfoInstances :: ModuleInfo -> [Instance]
2210 modInfoInstances = minf_instances
2212 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
2213 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
2215 mkPrintUnqualifiedForModule :: Session -> ModuleInfo -> IO (Maybe PrintUnqualified)
2216 mkPrintUnqualifiedForModule s minf = withSession s $ \hsc_env -> do
2217 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
2219 modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
2220 modInfoLookupName s minf name = withSession s $ \hsc_env -> do
2221 case lookupTypeEnv (minf_type_env minf) name of
2222 Just tyThing -> return (Just tyThing)
2224 eps <- readIORef (hsc_EPS hsc_env)
2225 return $! lookupType (hsc_dflags hsc_env)
2226 (hsc_HPT hsc_env) (eps_PTE eps) name
2229 modInfoModBreaks :: ModuleInfo -> ModBreaks
2230 modInfoModBreaks = minf_modBreaks
2233 isDictonaryId :: Id -> Bool
2235 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
2237 -- | Looks up a global name: that is, any top-level name in any
2238 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
2239 -- the interactive context, and therefore does not require a preceding
2241 lookupGlobalName :: Session -> Name -> IO (Maybe TyThing)
2242 lookupGlobalName s name = withSession s $ \hsc_env -> do
2243 eps <- hscEPS hsc_env
2244 return $! lookupType (hsc_dflags hsc_env)
2245 (hsc_HPT hsc_env) (eps_PTE eps) name
2248 -- | get the GlobalRdrEnv for a session
2249 getGRE :: Session -> IO GlobalRdrEnv
2250 getGRE s = withSession s $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
2253 -- -----------------------------------------------------------------------------
2254 -- Misc exported utils
2256 dataConType :: DataCon -> Type
2257 dataConType dc = idType (dataConWrapId dc)
2259 -- | print a 'NamedThing', adding parentheses if the name is an operator.
2260 pprParenSymName :: NamedThing a => a -> SDoc
2261 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
2263 -- ----------------------------------------------------------------------------
2268 -- - Data and Typeable instances for HsSyn.
2270 -- ToDo: check for small transformations that happen to the syntax in
2271 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
2273 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
2274 -- to get from TyCons, Ids etc. to TH syntax (reify).
2276 -- :browse will use either lm_toplev or inspect lm_interface, depending
2277 -- on whether the module is interpreted or not.
2279 -- This is for reconstructing refactored source code
2280 -- Calls the lexer repeatedly.
2281 -- ToDo: add comment tokens to token stream
2282 getTokenStream :: Session -> Module -> IO [Located Token]
2285 -- -----------------------------------------------------------------------------
2286 -- Interactive evaluation
2288 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
2289 -- filesystem and package database to find the corresponding 'Module',
2290 -- using the algorithm that is used for an @import@ declaration.
2291 findModule :: Session -> ModuleName -> Maybe FastString -> IO Module
2292 findModule s mod_name maybe_pkg = withSession s $ \hsc_env ->
2294 dflags = hsc_dflags hsc_env
2295 hpt = hsc_HPT hsc_env
2296 this_pkg = thisPackage dflags
2298 case lookupUFM hpt mod_name of
2299 Just mod_info -> return (mi_module (hm_iface mod_info))
2300 _not_a_home_module -> do
2301 res <- findImportedModule hsc_env mod_name maybe_pkg
2303 Found _ m | modulePackageId m /= this_pkg -> return m
2304 | otherwise -> ghcError (CmdLineError (showSDoc $
2305 text "module" <+> quotes (ppr (moduleName m)) <+>
2306 text "is not loaded"))
2307 err -> let msg = cannotFindModule dflags mod_name err in
2308 ghcError (CmdLineError (showSDoc msg))
2311 getHistorySpan :: Session -> History -> IO SrcSpan
2312 getHistorySpan sess h = withSession sess $ \hsc_env ->
2313 return$ InteractiveEval.getHistorySpan hsc_env h
2315 obtainTerm :: Session -> Bool -> Id -> IO Term
2316 obtainTerm sess force id = withSession sess $ \hsc_env ->
2317 InteractiveEval.obtainTerm hsc_env force id
2319 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
2320 obtainTerm1 sess force mb_ty a = withSession sess $ \hsc_env ->
2321 InteractiveEval.obtainTerm1 hsc_env force mb_ty a
2323 obtainTermB :: Session -> Int -> Bool -> Id -> IO Term
2324 obtainTermB sess bound force id = withSession sess $ \hsc_env ->
2325 InteractiveEval.obtainTermB hsc_env bound force id