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 file (Just phase)
479 = return (Target (TargetFile file (Just phase)) Nothing)
480 guessTarget file Nothing
481 | isHaskellSrcFilename file
482 = return (Target (TargetFile file Nothing) Nothing)
483 | looksLikeModuleName file
484 = return (Target (TargetModule (mkModuleName file)) Nothing)
486 = do exists <- doesFileExist hs_file
488 then return (Target (TargetFile hs_file Nothing) Nothing)
490 exists <- doesFileExist lhs_file
492 then return (Target (TargetFile lhs_file Nothing) Nothing)
495 (ProgramError (showSDoc $
496 text "target" <+> quotes (text file) <+>
497 text "is not a module name or a source file"))
499 hs_file = file <.> "hs"
500 lhs_file = file <.> "lhs"
502 -- -----------------------------------------------------------------------------
503 -- Extending the program scope
505 extendGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
506 extendGlobalRdrScope session rdrElts
507 = modifySession session $ \hscEnv ->
508 let global_rdr = hsc_global_rdr_env hscEnv
509 in hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv global_rdr rdrElts }
511 setGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
512 setGlobalRdrScope session rdrElts
513 = modifySession session $ \hscEnv ->
514 hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv rdrElts }
516 extendGlobalTypeScope :: Session -> [Id] -> IO ()
517 extendGlobalTypeScope session ids
518 = modifySession session $ \hscEnv ->
519 let global_type = hsc_global_type_env hscEnv
520 in hscEnv{ hsc_global_type_env = extendTypeEnvWithIds global_type ids }
522 setGlobalTypeScope :: Session -> [Id] -> IO ()
523 setGlobalTypeScope session ids
524 = modifySession session $ \hscEnv ->
525 hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
527 -- -----------------------------------------------------------------------------
528 -- Parsing Haddock comments
530 parseHaddockComment :: String -> Either String (HsDoc RdrName)
531 parseHaddockComment string =
532 case parseHaddockParagraphs (tokenise string) of
536 -- -----------------------------------------------------------------------------
537 -- Loading the program
539 -- Perform a dependency analysis starting from the current targets
540 -- and update the session with the new module graph.
541 depanal :: Session -> [ModuleName] -> Bool -> IO (Maybe ModuleGraph)
542 depanal (Session ref) excluded_mods allow_dup_roots = do
543 hsc_env <- readIORef ref
545 dflags = hsc_dflags hsc_env
546 targets = hsc_targets hsc_env
547 old_graph = hsc_mod_graph hsc_env
549 showPass dflags "Chasing dependencies"
550 debugTraceMsg dflags 2 (hcat [
551 text "Chasing modules from: ",
552 hcat (punctuate comma (map pprTarget targets))])
554 r <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
556 Just mod_graph -> writeIORef ref hsc_env{ hsc_mod_graph = mod_graph }
561 -- | The result of load.
563 = LoadOk Errors -- ^ all specified targets were loaded successfully.
564 | LoadFailed Errors -- ^ not all modules were loaded.
566 type Errors = [String]
568 data ErrMsg = ErrMsg {
569 errMsgSeverity :: Severity, -- warning, error, etc.
570 errMsgSpans :: [SrcSpan],
571 errMsgShortDoc :: Doc,
572 errMsgExtraInfo :: Doc
578 | LoadUpTo ModuleName
579 | LoadDependenciesOf ModuleName
581 -- | Try to load the program. If a Module is supplied, then just
582 -- attempt to load up to this target. If no Module is supplied,
583 -- then try to load all targets.
584 load :: Session -> LoadHowMuch -> IO SuccessFlag
587 -- Dependency analysis first. Note that this fixes the module graph:
588 -- even if we don't get a fully successful upsweep, the full module
589 -- graph is still retained in the Session. We can tell which modules
590 -- were successfully loaded by inspecting the Session's HPT.
591 mb_graph <- depanal s [] False
593 Just mod_graph -> load2 s how_much mod_graph
594 Nothing -> return Failed
596 load2 :: Session -> LoadHowMuch -> [ModSummary] -> IO SuccessFlag
597 load2 s@(Session ref) how_much mod_graph = do
599 hsc_env <- readIORef ref
601 let hpt1 = hsc_HPT hsc_env
602 let dflags = hsc_dflags hsc_env
604 -- The "bad" boot modules are the ones for which we have
605 -- B.hs-boot in the module graph, but no B.hs
606 -- The downsweep should have ensured this does not happen
608 let all_home_mods = [ms_mod_name s
609 | s <- mod_graph, not (isBootSummary s)]
610 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
611 not (ms_mod_name s `elem` all_home_mods)]
612 ASSERT( null bad_boot_mods ) return ()
614 -- check that the module given in HowMuch actually exists, otherwise
615 -- topSortModuleGraph will bomb later.
616 let checkHowMuch (LoadUpTo m) = checkMod m
617 checkHowMuch (LoadDependenciesOf m) = checkMod m
621 | m `elem` all_home_mods = and_then
623 errorMsg dflags (text "no such module:" <+>
627 checkHowMuch how_much $ do
629 -- mg2_with_srcimps drops the hi-boot nodes, returning a
630 -- graph with cycles. Among other things, it is used for
631 -- backing out partially complete cycles following a failed
632 -- upsweep, and for removing from hpt all the modules
633 -- not in strict downwards closure, during calls to compile.
634 let mg2_with_srcimps :: [SCC ModSummary]
635 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
637 -- If we can determine that any of the {-# SOURCE #-} imports
638 -- are definitely unnecessary, then emit a warning.
639 warnUnnecessarySourceImports dflags mg2_with_srcimps
642 -- check the stability property for each module.
643 stable_mods@(stable_obj,stable_bco)
644 = checkStability hpt1 mg2_with_srcimps all_home_mods
646 -- prune bits of the HPT which are definitely redundant now,
648 pruned_hpt = pruneHomePackageTable hpt1
649 (flattenSCCs mg2_with_srcimps)
654 -- before we unload anything, make sure we don't leave an old
655 -- interactive context around pointing to dead bindings. Also,
656 -- write the pruned HPT to allow the old HPT to be GC'd.
657 writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext,
658 hsc_HPT = pruned_hpt }
660 debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
661 text "Stable BCO:" <+> ppr stable_bco)
663 -- Unload any modules which are going to be re-linked this time around.
664 let stable_linkables = [ linkable
665 | m <- stable_obj++stable_bco,
666 Just hmi <- [lookupUFM pruned_hpt m],
667 Just linkable <- [hm_linkable hmi] ]
668 unload hsc_env stable_linkables
670 -- We could at this point detect cycles which aren't broken by
671 -- a source-import, and complain immediately, but it seems better
672 -- to let upsweep_mods do this, so at least some useful work gets
673 -- done before the upsweep is abandoned.
674 --hPutStrLn stderr "after tsort:\n"
675 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
677 -- Now do the upsweep, calling compile for each module in
678 -- turn. Final result is version 3 of everything.
680 -- Topologically sort the module graph, this time including hi-boot
681 -- nodes, and possibly just including the portion of the graph
682 -- reachable from the module specified in the 2nd argument to load.
683 -- This graph should be cycle-free.
684 -- If we're restricting the upsweep to a portion of the graph, we
685 -- also want to retain everything that is still stable.
686 let full_mg :: [SCC ModSummary]
687 full_mg = topSortModuleGraph False mod_graph Nothing
689 maybe_top_mod = case how_much of
691 LoadDependenciesOf m -> Just m
694 partial_mg0 :: [SCC ModSummary]
695 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
697 -- LoadDependenciesOf m: we want the upsweep to stop just
698 -- short of the specified module (unless the specified module
701 | LoadDependenciesOf _mod <- how_much
702 = ASSERT( case last partial_mg0 of
703 AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
704 List.init partial_mg0
710 | AcyclicSCC ms <- full_mg,
711 ms_mod_name ms `elem` stable_obj++stable_bco,
712 ms_mod_name ms `notElem` [ ms_mod_name ms' |
713 AcyclicSCC ms' <- partial_mg ] ]
715 mg = stable_mg ++ partial_mg
717 -- clean up between compilations
718 let cleanup = cleanTempFilesExcept dflags
719 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
721 debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
723 (upsweep_ok, hsc_env1, modsUpswept)
724 <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
725 pruned_hpt stable_mods cleanup mg
727 -- Make modsDone be the summaries for each home module now
728 -- available; this should equal the domain of hpt3.
729 -- Get in in a roughly top .. bottom order (hence reverse).
731 let modsDone = reverse modsUpswept
733 -- Try and do linking in some form, depending on whether the
734 -- upsweep was completely or only partially successful.
736 if succeeded upsweep_ok
739 -- Easy; just relink it all.
740 do debugTraceMsg dflags 2 (text "Upsweep completely successful.")
742 -- Clean up after ourselves
743 cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
745 -- Issue a warning for the confusing case where the user
746 -- said '-o foo' but we're not going to do any linking.
747 -- We attempt linking if either (a) one of the modules is
748 -- called Main, or (b) the user said -no-hs-main, indicating
749 -- that main() is going to come from somewhere else.
751 let ofile = outputFile dflags
752 let no_hs_main = dopt Opt_NoHsMain dflags
754 main_mod = mainModIs dflags
755 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
756 do_linking = a_root_is_Main || no_hs_main
758 when (ghcLink dflags == LinkBinary
759 && isJust ofile && not do_linking) $
760 debugTraceMsg dflags 1 $
761 text ("Warning: output was redirected with -o, " ++
762 "but no output will be generated\n" ++
763 "because there is no " ++
764 moduleNameString (moduleName main_mod) ++ " module.")
766 -- link everything together
767 linkresult <- link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
769 loadFinish Succeeded linkresult ref hsc_env1
772 -- Tricky. We need to back out the effects of compiling any
773 -- half-done cycles, both so as to clean up the top level envs
774 -- and to avoid telling the interactive linker to link them.
775 do debugTraceMsg dflags 2 (text "Upsweep partially successful.")
778 = map ms_mod modsDone
779 let mods_to_zap_names
780 = findPartiallyCompletedCycles modsDone_names
783 = filter ((`notElem` mods_to_zap_names).ms_mod)
786 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
789 -- Clean up after ourselves
790 cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
792 -- there should be no Nothings where linkables should be, now
793 ASSERT(all (isJust.hm_linkable)
794 (eltsUFM (hsc_HPT hsc_env))) do
796 -- Link everything together
797 linkresult <- link (ghcLink dflags) dflags False hpt4
799 let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
800 loadFinish Failed linkresult ref hsc_env4
802 -- Finish up after a load.
804 -- If the link failed, unload everything and return.
805 loadFinish :: SuccessFlag -> SuccessFlag -> IORef HscEnv -> HscEnv -> IO SuccessFlag
806 loadFinish _all_ok Failed ref hsc_env
807 = do unload hsc_env []
808 writeIORef ref $! discardProg hsc_env
811 -- Empty the interactive context and set the module context to the topmost
812 -- newly loaded module, or the Prelude if none were loaded.
813 loadFinish all_ok Succeeded ref hsc_env
814 = do writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
818 -- Forget the current program, but retain the persistent info in HscEnv
819 discardProg :: HscEnv -> HscEnv
821 = hsc_env { hsc_mod_graph = emptyMG,
822 hsc_IC = emptyInteractiveContext,
823 hsc_HPT = emptyHomePackageTable }
825 -- used to fish out the preprocess output files for the purposes of
826 -- cleaning up. The preprocessed file *might* be the same as the
827 -- source file, but that doesn't do any harm.
828 ppFilesFromSummaries :: [ModSummary] -> [FilePath]
829 ppFilesFromSummaries summaries = map ms_hspp_file summaries
831 -- -----------------------------------------------------------------------------
835 CheckedModule { parsedSource :: ParsedSource,
836 renamedSource :: Maybe RenamedSource,
837 typecheckedSource :: Maybe TypecheckedSource,
838 checkedModuleInfo :: Maybe ModuleInfo,
839 coreModule :: Maybe ModGuts
841 -- ToDo: improvements that could be made here:
842 -- if the module succeeded renaming but not typechecking,
843 -- we can still get back the GlobalRdrEnv and exports, so
844 -- perhaps the ModuleInfo should be split up into separate
845 -- fields within CheckedModule.
847 type ParsedSource = Located (HsModule RdrName)
848 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
849 Maybe (HsDoc Name), HaddockModInfo Name)
850 type TypecheckedSource = LHsBinds Id
853 -- - things that aren't in the output of the typechecker right now:
857 -- - type/data/newtype declarations
858 -- - class declarations
860 -- - extra things in the typechecker's output:
861 -- - default methods are turned into top-level decls.
862 -- - dictionary bindings
865 -- | This is the way to get access to parsed and typechecked source code
866 -- for a module. 'checkModule' attempts to typecheck the module. If
867 -- successful, it returns the abstract syntax for the module.
868 -- If compileToCore is true, it also desugars the module and returns the
869 -- resulting Core bindings as a component of the CheckedModule.
870 checkModule :: Session -> ModuleName -> Bool -> IO (Maybe CheckedModule)
871 checkModule (Session ref) mod compile_to_core
873 hsc_env <- readIORef ref
874 let mg = hsc_mod_graph hsc_env
875 case [ ms | ms <- mg, ms_mod_name ms == mod ] of
877 (ms:_) -> checkModule_ ref ms compile_to_core False
879 -- | parses and typechecks a module, optionally generates Core, and also
880 -- loads the module into the 'Session' so that modules which depend on
881 -- this one may subsequently be typechecked using 'checkModule' or
882 -- 'checkAndLoadModule'. If you need to check more than one module,
883 -- you probably want to use 'checkAndLoadModule'. Constructing the
884 -- interface takes a little work, so it might be slightly slower than
886 checkAndLoadModule :: Session -> ModSummary -> Bool -> IO (Maybe CheckedModule)
887 checkAndLoadModule (Session ref) ms compile_to_core
888 = checkModule_ ref ms compile_to_core True
890 checkModule_ :: IORef HscEnv -> ModSummary -> Bool -> Bool
891 -> IO (Maybe CheckedModule)
892 checkModule_ ref ms compile_to_core load
894 let mod = ms_mod_name ms
895 hsc_env0 <- readIORef ref
896 let hsc_env = hsc_env0{hsc_dflags=ms_hspp_opts ms}
897 mb_parsed <- parseFile hsc_env ms
899 Nothing -> return Nothing
900 Just rdr_module -> do
901 mb_typechecked <- typecheckRenameModule hsc_env ms rdr_module
902 case mb_typechecked of
903 Nothing -> return (Just CheckedModule {
904 parsedSource = rdr_module,
905 renamedSource = Nothing,
906 typecheckedSource = Nothing,
907 checkedModuleInfo = Nothing,
908 coreModule = Nothing })
909 Just (tcg, rn_info) -> do
910 details <- makeSimpleDetails hsc_env tcg
912 let tc_binds = tcg_binds tcg
913 let rdr_env = tcg_rdr_env tcg
914 let minf = ModuleInfo {
915 minf_type_env = md_types details,
916 minf_exports = availsToNameSet $
918 minf_rdr_env = Just rdr_env,
919 minf_instances = md_insts details
921 ,minf_modBreaks = emptyModBreaks
925 mb_guts <- if compile_to_core
926 then deSugarModule hsc_env ms tcg
929 -- If we are loading this module so that we can typecheck
930 -- dependent modules, generate an interface and stuff it
931 -- all in the HomePackageTable.
933 (iface,_) <- makeSimpleIface hsc_env Nothing tcg details
934 let mod_info = HomeModInfo {
936 hm_details = details,
937 hm_linkable = Nothing }
938 let hpt_new = addToUFM (hsc_HPT hsc_env) mod mod_info
939 writeIORef ref hsc_env0{ hsc_HPT = hpt_new }
941 return (Just (CheckedModule {
942 parsedSource = rdr_module,
943 renamedSource = rn_info,
944 typecheckedSource = Just tc_binds,
945 checkedModuleInfo = Just minf,
946 coreModule = mb_guts }))
948 -- | This is the way to get access to the Core bindings corresponding
949 -- to a module. 'compileToCore' invokes 'checkModule' to parse, typecheck, and
950 -- desugar the module, then returns the resulting Core module (consisting of
951 -- the module name, type declarations, and function declarations) if
953 compileToCoreModule :: Session -> FilePath -> IO (Maybe CoreModule)
954 compileToCoreModule = compileCore False
956 -- | Like compileToCoreModule, but invokes the simplifier, so
957 -- as to return simplified and tidied Core.
958 compileToCoreSimplified :: Session -> FilePath -> IO (Maybe CoreModule)
959 compileToCoreSimplified = compileCore True
961 -- | Provided for backwards-compatibility: compileToCore returns just the Core
962 -- bindings, but for most purposes, you probably want to call
963 -- compileToCoreModule.
964 compileToCore :: Session -> FilePath -> IO (Maybe [CoreBind])
965 compileToCore session fn = do
966 maybeCoreModule <- compileToCoreModule session fn
967 return $ fmap cm_binds maybeCoreModule
969 -- | Takes a CoreModule and compiles the bindings therein
970 -- to object code. The first argument is a bool flag indicating
971 -- whether to run the simplifier.
972 -- The resulting .o, .hi, and executable files, if any, are stored in the
973 -- current directory, and named according to the module name.
974 -- Returns True iff compilation succeeded.
975 -- This has only so far been tested with a single self-contained module.
976 compileCoreToObj :: Bool -> Session -> CoreModule -> IO Bool
977 compileCoreToObj simplify session cm@(CoreModule{ cm_module = mName }) = do
978 hscEnv <- sessionHscEnv session
979 dflags <- getSessionDynFlags session
980 currentTime <- getClockTime
981 cwd <- getCurrentDirectory
982 modLocation <- mkHiOnlyModLocation dflags (hiSuf dflags) cwd
983 ((moduleNameSlashes . moduleName) mName)
985 let modSummary = ModSummary { ms_mod = mName,
986 ms_hsc_src = ExtCoreFile,
987 ms_location = modLocation,
988 -- By setting the object file timestamp to Nothing,
989 -- we always force recompilation, which is what we
990 -- want. (Thus it doesn't matter what the timestamp
991 -- for the (nonexistent) source file is.)
992 ms_hs_date = currentTime,
993 ms_obj_date = Nothing,
994 -- Only handling the single-module case for now, so no imports.
999 ms_hspp_opts = dflags,
1000 ms_hspp_buf = Nothing
1003 mbHscResult <- evalComp
1004 ((if simplify then hscSimplify else return) (mkModGuts cm)
1005 >>= hscNormalIface >>= hscWriteIface >>= hscOneShot)
1006 (CompState{ compHscEnv=hscEnv,
1007 compModSummary=modSummary,
1008 compOldIface=Nothing})
1009 return $ isJust mbHscResult
1011 -- Makes a "vanilla" ModGuts.
1012 mkModGuts :: CoreModule -> ModGuts
1013 mkModGuts coreModule = ModGuts {
1014 mg_module = cm_module coreModule,
1017 mg_deps = noDependencies,
1018 mg_dir_imps = emptyModuleEnv,
1019 mg_used_names = emptyNameSet,
1020 mg_rdr_env = emptyGlobalRdrEnv,
1021 mg_fix_env = emptyFixityEnv,
1022 mg_types = emptyTypeEnv,
1026 mg_binds = cm_binds coreModule,
1027 mg_foreign = NoStubs,
1028 mg_warns = NoWarnings,
1029 mg_hpc_info = emptyHpcInfo False,
1030 mg_modBreaks = emptyModBreaks,
1031 mg_vect_info = noVectInfo,
1032 mg_inst_env = emptyInstEnv,
1033 mg_fam_inst_env = emptyFamInstEnv
1036 compileCore :: Bool -> Session -> FilePath -> IO (Maybe CoreModule)
1037 compileCore simplify session fn = do
1038 -- First, set the target to the desired filename
1039 target <- guessTarget fn Nothing
1040 addTarget session target
1041 load session LoadAllTargets
1042 -- Then find dependencies
1043 maybeModGraph <- depanal session [] True
1044 case maybeModGraph of
1045 Nothing -> return Nothing
1047 case find ((== fn) . msHsFilePath) modGraph of
1048 Just modSummary -> do
1049 -- Now we have the module name;
1050 -- parse, typecheck and desugar the module
1051 let mod = ms_mod_name modSummary
1052 maybeCheckedModule <- checkModule session mod True
1053 case maybeCheckedModule of
1054 Nothing -> return Nothing
1055 Just checkedMod -> (liftM $ fmap gutsToCoreModule) $
1056 case (coreModule checkedMod) of
1057 Just mg | simplify -> (sessionHscEnv session)
1058 -- If simplify is true: simplify (hscSimplify),
1059 -- then tidy (tidyProgram).
1060 >>= \ hscEnv -> evalComp (hscSimplify mg)
1061 (CompState{ compHscEnv=hscEnv,
1062 compModSummary=modSummary,
1063 compOldIface=Nothing})
1064 >>= (tidyProgram hscEnv)
1065 >>= (return . Just . Left)
1066 Just guts -> return $ Just $ Right guts
1067 Nothing -> return Nothing
1068 Nothing -> panic "compileToCoreModule: target FilePath not found in\
1069 module dependency graph"
1070 where -- two versions, based on whether we simplify (thus run tidyProgram,
1071 -- which returns a (CgGuts, ModDetails) pair, or not (in which case
1072 -- we just have a ModGuts.
1073 gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
1074 gutsToCoreModule (Left (cg, md)) = CoreModule {
1075 cm_module = cg_module cg, cm_types = md_types md,
1076 cm_imports = cg_dir_imps cg, cm_binds = cg_binds cg
1078 gutsToCoreModule (Right mg) = CoreModule {
1079 cm_module = mg_module mg, cm_types = mg_types mg,
1080 cm_imports = moduleEnvKeys (mg_dir_imps mg), cm_binds = mg_binds mg
1083 -- ---------------------------------------------------------------------------
1086 unload :: HscEnv -> [Linkable] -> IO ()
1087 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
1088 = case ghcLink (hsc_dflags hsc_env) of
1090 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
1092 LinkInMemory -> panic "unload: no interpreter"
1093 -- urgh. avoid warnings:
1094 hsc_env stable_linkables
1098 -- -----------------------------------------------------------------------------
1102 Stability tells us which modules definitely do not need to be recompiled.
1103 There are two main reasons for having stability:
1105 - avoid doing a complete upsweep of the module graph in GHCi when
1106 modules near the bottom of the tree have not changed.
1108 - to tell GHCi when it can load object code: we can only load object code
1109 for a module when we also load object code fo all of the imports of the
1110 module. So we need to know that we will definitely not be recompiling
1111 any of these modules, and we can use the object code.
1113 The stability check is as follows. Both stableObject and
1114 stableBCO are used during the upsweep phase later.
1117 stable m = stableObject m || stableBCO m
1120 all stableObject (imports m)
1121 && old linkable does not exist, or is == on-disk .o
1122 && date(on-disk .o) > date(.hs)
1125 all stable (imports m)
1126 && date(BCO) > date(.hs)
1129 These properties embody the following ideas:
1131 - if a module is stable, then:
1132 - if it has been compiled in a previous pass (present in HPT)
1133 then it does not need to be compiled or re-linked.
1134 - if it has not been compiled in a previous pass,
1135 then we only need to read its .hi file from disk and
1136 link it to produce a ModDetails.
1138 - if a modules is not stable, we will definitely be at least
1139 re-linking, and possibly re-compiling it during the upsweep.
1140 All non-stable modules can (and should) therefore be unlinked
1143 - Note that objects are only considered stable if they only depend
1144 on other objects. We can't link object code against byte code.
1148 :: HomePackageTable -- HPT from last compilation
1149 -> [SCC ModSummary] -- current module graph (cyclic)
1150 -> [ModuleName] -- all home modules
1151 -> ([ModuleName], -- stableObject
1152 [ModuleName]) -- stableBCO
1154 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
1156 checkSCC (stable_obj, stable_bco) scc0
1157 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
1158 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
1159 | otherwise = (stable_obj, stable_bco)
1161 scc = flattenSCC scc0
1162 scc_mods = map ms_mod_name scc
1163 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
1165 scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
1166 -- all imports outside the current SCC, but in the home pkg
1168 stable_obj_imps = map (`elem` stable_obj) scc_allimps
1169 stable_bco_imps = map (`elem` stable_bco) scc_allimps
1173 && all object_ok scc
1176 and (zipWith (||) stable_obj_imps stable_bco_imps)
1180 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
1184 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
1185 Just hmi | Just l <- hm_linkable hmi
1186 -> isObjectLinkable l && t == linkableTime l
1188 -- why '>=' rather than '>' above? If the filesystem stores
1189 -- times to the nearset second, we may occasionally find that
1190 -- the object & source have the same modification time,
1191 -- especially if the source was automatically generated
1192 -- and compiled. Using >= is slightly unsafe, but it matches
1193 -- make's behaviour.
1196 = case lookupUFM hpt (ms_mod_name ms) of
1197 Just hmi | Just l <- hm_linkable hmi ->
1198 not (isObjectLinkable l) &&
1199 linkableTime l >= ms_hs_date ms
1202 ms_allimps :: ModSummary -> [ModuleName]
1203 ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
1205 -- -----------------------------------------------------------------------------
1206 -- Prune the HomePackageTable
1208 -- Before doing an upsweep, we can throw away:
1210 -- - For non-stable modules:
1211 -- - all ModDetails, all linked code
1212 -- - all unlinked code that is out of date with respect to
1215 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
1216 -- space at the end of the upsweep, because the topmost ModDetails of the
1217 -- old HPT holds on to the entire type environment from the previous
1220 pruneHomePackageTable
1223 -> ([ModuleName],[ModuleName])
1226 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
1229 | is_stable modl = hmi'
1230 | otherwise = hmi'{ hm_details = emptyModDetails }
1232 modl = moduleName (mi_module (hm_iface hmi))
1233 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
1234 = hmi{ hm_linkable = Nothing }
1237 where ms = expectJust "prune" (lookupUFM ms_map modl)
1239 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
1241 is_stable m = m `elem` stable_obj || m `elem` stable_bco
1243 -- -----------------------------------------------------------------------------
1245 -- Return (names of) all those in modsDone who are part of a cycle
1246 -- as defined by theGraph.
1247 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
1248 findPartiallyCompletedCycles modsDone theGraph
1252 chew ((AcyclicSCC _):rest) = chew rest -- acyclic? not interesting.
1253 chew ((CyclicSCC vs):rest)
1254 = let names_in_this_cycle = nub (map ms_mod vs)
1256 = nub ([done | done <- modsDone,
1257 done `elem` names_in_this_cycle])
1258 chewed_rest = chew rest
1260 if notNull mods_in_this_cycle
1261 && length mods_in_this_cycle < length names_in_this_cycle
1262 then mods_in_this_cycle ++ chewed_rest
1265 -- -----------------------------------------------------------------------------
1268 -- This is where we compile each module in the module graph, in a pass
1269 -- from the bottom to the top of the graph.
1271 -- There better had not be any cyclic groups here -- we check for them.
1274 :: HscEnv -- Includes initially-empty HPT
1275 -> HomePackageTable -- HPT from last time round (pruned)
1276 -> ([ModuleName],[ModuleName]) -- stable modules (see checkStability)
1277 -> IO () -- How to clean up unwanted tmp files
1278 -> [SCC ModSummary] -- Mods to do (the worklist)
1280 HscEnv, -- With an updated HPT
1281 [ModSummary]) -- Mods which succeeded
1283 upsweep hsc_env old_hpt stable_mods cleanup sccs = do
1284 (res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
1285 return (res, hsc_env, reverse done)
1288 upsweep' hsc_env _old_hpt done
1290 = return (Succeeded, hsc_env, done)
1292 upsweep' hsc_env _old_hpt done
1293 (CyclicSCC ms:_) _ _
1294 = do fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
1295 return (Failed, hsc_env, done)
1297 upsweep' hsc_env old_hpt done
1298 (AcyclicSCC mod:mods) mod_index nmods
1299 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1300 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
1301 -- (moduleEnvElts (hsc_HPT hsc_env)))
1303 mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod
1306 cleanup -- Remove unwanted tmp files between compilations
1309 Nothing -> return (Failed, hsc_env, done)
1311 let this_mod = ms_mod_name mod
1313 -- Add new info to hsc_env
1314 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
1315 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
1317 -- Space-saving: delete the old HPT entry
1318 -- for mod BUT if mod is a hs-boot
1319 -- node, don't delete it. For the
1320 -- interface, the HPT entry is probaby for the
1321 -- main Haskell source file. Deleting it
1322 -- would force the real module to be recompiled
1324 old_hpt1 | isBootSummary mod = old_hpt
1325 | otherwise = delFromUFM old_hpt this_mod
1329 -- fixup our HomePackageTable after we've finished compiling
1330 -- a mutually-recursive loop. See reTypecheckLoop, below.
1331 hsc_env2 <- reTypecheckLoop hsc_env1 mod done'
1333 upsweep' hsc_env2 old_hpt1 done' mods (mod_index+1) nmods
1336 -- Compile a single module. Always produce a Linkable for it if
1337 -- successful. If no compilation happened, return the old Linkable.
1338 upsweep_mod :: HscEnv
1340 -> ([ModuleName],[ModuleName])
1342 -> Int -- index of module
1343 -> Int -- total number of modules
1344 -> IO (Maybe HomeModInfo) -- Nothing => Failed
1346 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
1348 this_mod_name = ms_mod_name summary
1349 this_mod = ms_mod summary
1350 mb_obj_date = ms_obj_date summary
1351 obj_fn = ml_obj_file (ms_location summary)
1352 hs_date = ms_hs_date summary
1354 is_stable_obj = this_mod_name `elem` stable_obj
1355 is_stable_bco = this_mod_name `elem` stable_bco
1357 old_hmi = lookupUFM old_hpt this_mod_name
1359 -- We're using the dflags for this module now, obtained by
1360 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
1361 dflags = ms_hspp_opts summary
1362 prevailing_target = hscTarget (hsc_dflags hsc_env)
1363 local_target = hscTarget dflags
1365 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
1366 -- we don't do anything dodgy: these should only work to change
1367 -- from -fvia-C to -fasm and vice-versa, otherwise we could
1368 -- end up trying to link object code to byte code.
1369 target = if prevailing_target /= local_target
1370 && (not (isObjectTarget prevailing_target)
1371 || not (isObjectTarget local_target))
1372 then prevailing_target
1375 -- store the corrected hscTarget into the summary
1376 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
1378 -- The old interface is ok if
1379 -- a) we're compiling a source file, and the old HPT
1380 -- entry is for a source file
1381 -- b) we're compiling a hs-boot file
1382 -- Case (b) allows an hs-boot file to get the interface of its
1383 -- real source file on the second iteration of the compilation
1384 -- manager, but that does no harm. Otherwise the hs-boot file
1385 -- will always be recompiled
1390 Just hm_info | isBootSummary summary -> Just iface
1391 | not (mi_boot iface) -> Just iface
1392 | otherwise -> Nothing
1394 iface = hm_iface hm_info
1396 compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
1397 compile_it = compile hsc_env summary' mod_index nmods mb_old_iface
1399 compile_it_discard_iface
1400 = compile hsc_env summary' mod_index nmods Nothing
1406 -- Regardless of whether we're generating object code or
1407 -- byte code, we can always use an existing object file
1408 -- if it is *stable* (see checkStability).
1409 | is_stable_obj, isJust old_hmi ->
1411 -- object is stable, and we have an entry in the
1412 -- old HPT: nothing to do
1414 | is_stable_obj, isNothing old_hmi -> do
1415 linkable <- findObjectLinkable this_mod obj_fn
1416 (expectJust "upseep1" mb_obj_date)
1417 compile_it (Just linkable)
1418 -- object is stable, but we need to load the interface
1419 -- off disk to make a HMI.
1423 ASSERT(isJust old_hmi) -- must be in the old_hpt
1425 -- BCO is stable: nothing to do
1427 | Just hmi <- old_hmi,
1428 Just l <- hm_linkable hmi, not (isObjectLinkable l),
1429 linkableTime l >= ms_hs_date summary ->
1431 -- we have an old BCO that is up to date with respect
1432 -- to the source: do a recompilation check as normal.
1436 -- no existing code at all: we must recompile.
1438 -- When generating object code, if there's an up-to-date
1439 -- object file on the disk, then we can use it.
1440 -- However, if the object file is new (compared to any
1441 -- linkable we had from a previous compilation), then we
1442 -- must discard any in-memory interface, because this
1443 -- means the user has compiled the source file
1444 -- separately and generated a new interface, that we must
1445 -- read from the disk.
1447 obj | isObjectTarget obj,
1448 Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
1451 | Just l <- hm_linkable hmi,
1452 isObjectLinkable l && linkableTime l == obj_date
1453 -> compile_it (Just l)
1455 linkable <- findObjectLinkable this_mod obj_fn obj_date
1456 compile_it_discard_iface (Just linkable)
1463 -- Filter modules in the HPT
1464 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
1465 retainInTopLevelEnvs keep_these hpt
1466 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
1468 , let mb_mod_info = lookupUFM hpt mod
1469 , isJust mb_mod_info ]
1471 -- ---------------------------------------------------------------------------
1472 -- Typecheck module loops
1475 See bug #930. This code fixes a long-standing bug in --make. The
1476 problem is that when compiling the modules *inside* a loop, a data
1477 type that is only defined at the top of the loop looks opaque; but
1478 after the loop is done, the structure of the data type becomes
1481 The difficulty is then that two different bits of code have
1482 different notions of what the data type looks like.
1484 The idea is that after we compile a module which also has an .hs-boot
1485 file, we re-generate the ModDetails for each of the modules that
1486 depends on the .hs-boot file, so that everyone points to the proper
1487 TyCons, Ids etc. defined by the real module, not the boot module.
1488 Fortunately re-generating a ModDetails from a ModIface is easy: the
1489 function TcIface.typecheckIface does exactly that.
1491 Picking the modules to re-typecheck is slightly tricky. Starting from
1492 the module graph consisting of the modules that have already been
1493 compiled, we reverse the edges (so they point from the imported module
1494 to the importing module), and depth-first-search from the .hs-boot
1495 node. This gives us all the modules that depend transitively on the
1496 .hs-boot module, and those are exactly the modules that we need to
1499 Following this fix, GHC can compile itself with --make -O2.
1502 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
1503 reTypecheckLoop hsc_env ms graph
1504 | not (isBootSummary ms) &&
1505 any (\m -> ms_mod m == this_mod && isBootSummary m) graph
1507 let mss = reachableBackwards (ms_mod_name ms) graph
1508 non_boot = filter (not.isBootSummary) mss
1509 debugTraceMsg (hsc_dflags hsc_env) 2 $
1510 text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
1511 typecheckLoop hsc_env (map ms_mod_name non_boot)
1515 this_mod = ms_mod ms
1517 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
1518 typecheckLoop hsc_env mods = do
1520 fixIO $ \new_hpt -> do
1521 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
1522 mds <- initIfaceCheck new_hsc_env $
1523 mapM (typecheckIface . hm_iface) hmis
1524 let new_hpt = addListToUFM old_hpt
1525 (zip mods [ hmi{ hm_details = details }
1526 | (hmi,details) <- zip hmis mds ])
1528 return hsc_env{ hsc_HPT = new_hpt }
1530 old_hpt = hsc_HPT hsc_env
1531 hmis = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
1533 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
1534 reachableBackwards mod summaries
1535 = [ ms | (ms,_,_) <- reachableG (transposeG graph) root ]
1536 where -- the rest just sets up the graph:
1537 (graph, lookup_node) = moduleGraphNodes False summaries
1538 root = expectJust "reachableBackwards" (lookup_node HsBootFile mod)
1540 -- ---------------------------------------------------------------------------
1541 -- Topological sort of the module graph
1543 type SummaryNode = (ModSummary, Int, [Int])
1546 :: Bool -- Drop hi-boot nodes? (see below)
1550 -- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1551 -- The resulting list of strongly-connected-components is in topologically
1552 -- sorted order, starting with the module(s) at the bottom of the
1553 -- dependency graph (ie compile them first) and ending with the ones at
1556 -- Drop hi-boot nodes (first boolean arg)?
1558 -- False: treat the hi-boot summaries as nodes of the graph,
1559 -- so the graph must be acyclic
1561 -- True: eliminate the hi-boot nodes, and instead pretend
1562 -- the a source-import of Foo is an import of Foo
1563 -- The resulting graph has no hi-boot nodes, but can by cyclic
1565 topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
1566 = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph
1568 (graph, lookup_node) = moduleGraphNodes drop_hs_boot_nodes summaries
1570 initial_graph = case mb_root_mod of
1573 -- restrict the graph to just those modules reachable from
1574 -- the specified module. We do this by building a graph with
1575 -- the full set of nodes, and determining the reachable set from
1576 -- the specified node.
1577 let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
1578 | otherwise = ghcError (ProgramError "module does not exist")
1579 in graphFromEdgedVertices (seq root (reachableG graph root))
1581 summaryNodeKey :: SummaryNode -> Int
1582 summaryNodeKey (_, k, _) = k
1584 summaryNodeSummary :: SummaryNode -> ModSummary
1585 summaryNodeSummary (s, _, _) = s
1587 moduleGraphNodes :: Bool -> [ModSummary]
1588 -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
1589 moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)
1591 numbered_summaries = zip summaries [1..]
1593 lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode
1594 lookup_node hs_src mod = lookupFM node_map (mod, hs_src)
1596 lookup_key :: HscSource -> ModuleName -> Maybe Int
1597 lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)
1599 node_map :: NodeMap SummaryNode
1600 node_map = listToFM [ ((moduleName (ms_mod s), ms_hsc_src s), node)
1601 | node@(s, _, _) <- nodes ]
1603 -- We use integers as the keys for the SCC algorithm
1604 nodes :: [SummaryNode]
1605 nodes = [ (s, key, out_keys)
1606 | (s, key) <- numbered_summaries
1607 -- Drop the hi-boot ones if told to do so
1608 , not (isBootSummary s && drop_hs_boot_nodes)
1609 , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
1610 out_edge_keys HsSrcFile (map unLoc (ms_imps s)) ++
1611 (-- see [boot-edges] below
1612 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
1614 else case lookup_key HsBootFile (ms_mod_name s) of
1618 -- [boot-edges] if this is a .hs and there is an equivalent
1619 -- .hs-boot, add a link from the former to the latter. This
1620 -- has the effect of detecting bogus cases where the .hs-boot
1621 -- depends on the .hs, by introducing a cycle. Additionally,
1622 -- it ensures that we will always process the .hs-boot before
1623 -- the .hs, and so the HomePackageTable will always have the
1624 -- most up to date information.
1626 -- Drop hs-boot nodes by using HsSrcFile as the key
1627 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1628 | otherwise = HsBootFile
1630 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1631 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1632 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1633 -- the IsBootInterface parameter True; else False
1636 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
1637 type NodeMap a = FiniteMap NodeKey a -- keyed by (mod, src_file_type) pairs
1639 msKey :: ModSummary -> NodeKey
1640 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1642 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1643 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
1645 nodeMapElts :: NodeMap a -> [a]
1646 nodeMapElts = eltsFM
1648 -- If there are {-# SOURCE #-} imports between strongly connected
1649 -- components in the topological sort, then those imports can
1650 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1651 -- were necessary, then the edge would be part of a cycle.
1652 warnUnnecessarySourceImports :: DynFlags -> [SCC ModSummary] -> IO ()
1653 warnUnnecessarySourceImports dflags sccs =
1654 printBagOfWarnings dflags (listToBag (concat (map (check.flattenSCC) sccs)))
1656 let mods_in_this_cycle = map ms_mod_name ms in
1657 [ warn i | m <- ms, i <- ms_srcimps m,
1658 unLoc i `notElem` mods_in_this_cycle ]
1660 warn :: Located ModuleName -> WarnMsg
1663 (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
1664 <+> quotes (ppr mod))
1666 -----------------------------------------------------------------------------
1667 -- Downsweep (dependency analysis)
1669 -- Chase downwards from the specified root set, returning summaries
1670 -- for all home modules encountered. Only follow source-import
1673 -- We pass in the previous collection of summaries, which is used as a
1674 -- cache to avoid recalculating a module summary if the source is
1677 -- The returned list of [ModSummary] nodes has one node for each home-package
1678 -- module, plus one for any hs-boot files. The imports of these nodes
1679 -- are all there, including the imports of non-home-package modules.
1682 -> [ModSummary] -- Old summaries
1683 -> [ModuleName] -- Ignore dependencies on these; treat
1684 -- them as if they were package modules
1685 -> Bool -- True <=> allow multiple targets to have
1686 -- the same module name; this is
1687 -- very useful for ghc -M
1688 -> IO (Maybe [ModSummary])
1689 -- The elts of [ModSummary] all have distinct
1690 -- (Modules, IsBoot) identifiers, unless the Bool is true
1691 -- in which case there can be repeats
1692 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1693 = -- catch error messages and return them
1695 (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
1696 rootSummaries <- mapM getRootSummary roots
1697 let root_map = mkRootMap rootSummaries
1698 checkDuplicates root_map
1699 summs <- loop (concatMap msDeps rootSummaries) root_map
1702 roots = hsc_targets hsc_env
1704 old_summary_map :: NodeMap ModSummary
1705 old_summary_map = mkNodeMap old_summaries
1707 getRootSummary :: Target -> IO ModSummary
1708 getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
1709 = do exists <- doesFileExist file
1711 then summariseFile hsc_env old_summaries file mb_phase maybe_buf
1712 else throwErrMsg $ mkPlainErrMsg noSrcSpan $
1713 text "can't find file:" <+> text file
1714 getRootSummary (Target (TargetModule modl) maybe_buf)
1715 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1716 (L rootLoc modl) maybe_buf excl_mods
1717 case maybe_summary of
1718 Nothing -> packageModErr modl
1721 rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1723 -- In a root module, the filename is allowed to diverge from the module
1724 -- name, so we have to check that there aren't multiple root files
1725 -- defining the same module (otherwise the duplicates will be silently
1726 -- ignored, leading to confusing behaviour).
1727 checkDuplicates :: NodeMap [ModSummary] -> IO ()
1728 checkDuplicates root_map
1729 | allow_dup_roots = return ()
1730 | null dup_roots = return ()
1731 | otherwise = multiRootsErr (head dup_roots)
1733 dup_roots :: [[ModSummary]] -- Each at least of length 2
1734 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1736 loop :: [(Located ModuleName,IsBootInterface)]
1737 -- Work list: process these modules
1738 -> NodeMap [ModSummary]
1739 -- Visited set; the range is a list because
1740 -- the roots can have the same module names
1741 -- if allow_dup_roots is True
1743 -- The result includes the worklist, except
1744 -- for those mentioned in the visited set
1745 loop [] done = return (concat (nodeMapElts done))
1746 loop ((wanted_mod, is_boot) : ss) done
1747 | Just summs <- lookupFM done key
1748 = if isSingleton summs then
1751 do { multiRootsErr summs; return [] }
1752 | otherwise = do { mb_s <- summariseModule hsc_env old_summary_map
1753 is_boot wanted_mod Nothing excl_mods
1755 Nothing -> loop ss done
1756 Just s -> loop (msDeps s ++ ss)
1757 (addToFM done key [s]) }
1759 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1761 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1762 mkRootMap summaries = addListToFM_C (++) emptyFM
1763 [ (msKey s, [s]) | s <- summaries ]
1765 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
1766 -- (msDeps s) returns the dependencies of the ModSummary s.
1767 -- A wrinkle is that for a {-# SOURCE #-} import we return
1768 -- *both* the hs-boot file
1769 -- *and* the source file
1770 -- as "dependencies". That ensures that the list of all relevant
1771 -- modules always contains B.hs if it contains B.hs-boot.
1772 -- Remember, this pass isn't doing the topological sort. It's
1773 -- just gathering the list of all relevant ModSummaries
1775 concat [ [(m,True), (m,False)] | m <- ms_srcimps s ]
1776 ++ [ (m,False) | m <- ms_imps s ]
1778 -----------------------------------------------------------------------------
1779 -- Summarising modules
1781 -- We have two types of summarisation:
1783 -- * Summarise a file. This is used for the root module(s) passed to
1784 -- cmLoadModules. The file is read, and used to determine the root
1785 -- module name. The module name may differ from the filename.
1787 -- * Summarise a module. We are given a module name, and must provide
1788 -- a summary. The finder is used to locate the file in which the module
1793 -> [ModSummary] -- old summaries
1794 -> FilePath -- source file name
1795 -> Maybe Phase -- start phase
1796 -> Maybe (StringBuffer,ClockTime)
1799 summariseFile hsc_env old_summaries file mb_phase maybe_buf
1800 -- we can use a cached summary if one is available and the
1801 -- source file hasn't changed, But we have to look up the summary
1802 -- by source file, rather than module name as we do in summarise.
1803 | Just old_summary <- findSummaryBySourceFile old_summaries file
1805 let location = ms_location old_summary
1807 -- return the cached summary if the source didn't change
1808 src_timestamp <- case maybe_buf of
1809 Just (_,t) -> return t
1810 Nothing -> getModificationTime file
1811 -- The file exists; we checked in getRootSummary above.
1812 -- If it gets removed subsequently, then this
1813 -- getModificationTime may fail, but that's the right
1816 if ms_hs_date old_summary == src_timestamp
1817 then do -- update the object-file timestamp
1819 if isObjectTarget (hscTarget (hsc_dflags hsc_env)) -- bug #1205
1820 then getObjTimestamp location False
1822 return old_summary{ ms_obj_date = obj_timestamp }
1830 let dflags = hsc_dflags hsc_env
1832 (dflags', hspp_fn, buf)
1833 <- preprocessFile hsc_env file mb_phase maybe_buf
1835 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
1837 -- Make a ModLocation for this file
1838 location <- mkHomeModLocation dflags mod_name file
1840 -- Tell the Finder cache where it is, so that subsequent calls
1841 -- to findModule will find it, even if it's not on any search path
1842 mod <- addHomeModuleToFinder hsc_env mod_name location
1844 src_timestamp <- case maybe_buf of
1845 Just (_,t) -> return t
1846 Nothing -> getModificationTime file
1847 -- getMofificationTime may fail
1849 -- when the user asks to load a source file by name, we only
1850 -- use an object file if -fobject-code is on. See #1205.
1852 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1853 then modificationTimeIfExists (ml_obj_file location)
1856 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1857 ms_location = location,
1858 ms_hspp_file = hspp_fn,
1859 ms_hspp_opts = dflags',
1860 ms_hspp_buf = Just buf,
1861 ms_srcimps = srcimps, ms_imps = the_imps,
1862 ms_hs_date = src_timestamp,
1863 ms_obj_date = obj_timestamp })
1865 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
1866 findSummaryBySourceFile summaries file
1867 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
1868 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
1872 -- Summarise a module, and pick up source and timestamp.
1875 -> NodeMap ModSummary -- Map of old summaries
1876 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
1877 -> Located ModuleName -- Imported module to be summarised
1878 -> Maybe (StringBuffer, ClockTime)
1879 -> [ModuleName] -- Modules to exclude
1880 -> IO (Maybe ModSummary) -- Its new summary
1882 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf excl_mods
1883 | wanted_mod `elem` excl_mods
1886 | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
1887 = do -- Find its new timestamp; all the
1888 -- ModSummaries in the old map have valid ml_hs_files
1889 let location = ms_location old_summary
1890 src_fn = expectJust "summariseModule" (ml_hs_file location)
1892 -- check the modification time on the source file, and
1893 -- return the cached summary if it hasn't changed. If the
1894 -- file has disappeared, we need to call the Finder again.
1896 Just (_,t) -> check_timestamp old_summary location src_fn t
1898 m <- System.IO.Error.try (getModificationTime src_fn)
1900 Right t -> check_timestamp old_summary location src_fn t
1901 Left e | isDoesNotExistError e -> find_it
1902 | otherwise -> ioError e
1904 | otherwise = find_it
1906 dflags = hsc_dflags hsc_env
1908 hsc_src = if is_boot then HsBootFile else HsSrcFile
1910 check_timestamp old_summary location src_fn src_timestamp
1911 | ms_hs_date old_summary == src_timestamp = do
1912 -- update the object-file timestamp
1913 obj_timestamp <- getObjTimestamp location is_boot
1914 return (Just old_summary{ ms_obj_date = obj_timestamp })
1916 -- source changed: re-summarise.
1917 new_summary location (ms_mod old_summary) src_fn src_timestamp
1920 -- Don't use the Finder's cache this time. If the module was
1921 -- previously a package module, it may have now appeared on the
1922 -- search path, so we want to consider it to be a home module. If
1923 -- the module was previously a home module, it may have moved.
1924 uncacheModule hsc_env wanted_mod
1925 found <- findImportedModule hsc_env wanted_mod Nothing
1928 | isJust (ml_hs_file location) ->
1930 just_found location mod
1932 -- Drop external-pkg
1933 ASSERT(modulePackageId mod /= thisPackage dflags)
1936 err -> noModError dflags loc wanted_mod err
1939 just_found location mod = do
1940 -- Adjust location to point to the hs-boot source file,
1941 -- hi file, object file, when is_boot says so
1942 let location' | is_boot = addBootSuffixLocn location
1943 | otherwise = location
1944 src_fn = expectJust "summarise2" (ml_hs_file location')
1946 -- Check that it exists
1947 -- It might have been deleted since the Finder last found it
1948 maybe_t <- modificationTimeIfExists src_fn
1950 Nothing -> noHsFileErr loc src_fn
1951 Just t -> new_summary location' mod src_fn t
1954 new_summary location mod src_fn src_timestamp
1956 -- Preprocess the source file and get its imports
1957 -- The dflags' contains the OPTIONS pragmas
1958 (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
1959 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
1961 when (mod_name /= wanted_mod) $
1962 throwErrMsg $ mkPlainErrMsg mod_loc $
1963 text "File name does not match module name:"
1964 $$ text "Saw:" <+> quotes (ppr mod_name)
1965 $$ text "Expected:" <+> quotes (ppr wanted_mod)
1967 -- Find the object timestamp, and return the summary
1968 obj_timestamp <- getObjTimestamp location is_boot
1970 return (Just ( ModSummary { ms_mod = mod,
1971 ms_hsc_src = hsc_src,
1972 ms_location = location,
1973 ms_hspp_file = hspp_fn,
1974 ms_hspp_opts = dflags',
1975 ms_hspp_buf = Just buf,
1976 ms_srcimps = srcimps,
1978 ms_hs_date = src_timestamp,
1979 ms_obj_date = obj_timestamp }))
1982 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
1983 getObjTimestamp location is_boot
1984 = if is_boot then return Nothing
1985 else modificationTimeIfExists (ml_obj_file location)
1988 preprocessFile :: HscEnv -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
1989 -> IO (DynFlags, FilePath, StringBuffer)
1990 preprocessFile hsc_env src_fn mb_phase Nothing
1992 (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
1993 buf <- hGetStringBuffer hspp_fn
1994 return (dflags', hspp_fn, buf)
1996 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
1998 let dflags = hsc_dflags hsc_env
1999 -- case we bypass the preprocessing stage?
2001 local_opts = getOptions dflags buf src_fn
2003 (dflags', leftovers, warns) <- parseDynamicFlags dflags (map unLoc local_opts)
2004 checkProcessArgsResult leftovers src_fn
2005 handleFlagWarnings dflags' warns
2009 | Just (Unlit _) <- mb_phase = True
2010 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
2011 -- note: local_opts is only required if there's no Unlit phase
2012 | dopt Opt_Cpp dflags' = True
2013 | dopt Opt_Pp dflags' = True
2016 when needs_preprocessing $
2017 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
2019 return (dflags', src_fn, buf)
2022 -----------------------------------------------------------------------------
2024 -----------------------------------------------------------------------------
2026 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
2027 -- ToDo: we don't have a proper line number for this error
2028 noModError dflags loc wanted_mod err
2029 = throwErrMsg $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
2031 noHsFileErr :: SrcSpan -> String -> a
2032 noHsFileErr loc path
2033 = throwErrMsg $ mkPlainErrMsg loc $ text "Can't find" <+> text path
2035 packageModErr :: ModuleName -> a
2037 = throwErrMsg $ mkPlainErrMsg noSrcSpan $
2038 text "module" <+> quotes (ppr mod) <+> text "is a package module"
2040 multiRootsErr :: [ModSummary] -> IO ()
2041 multiRootsErr [] = panic "multiRootsErr"
2042 multiRootsErr summs@(summ1:_)
2043 = throwErrMsg $ mkPlainErrMsg noSrcSpan $
2044 text "module" <+> quotes (ppr mod) <+>
2045 text "is defined in multiple files:" <+>
2046 sep (map text files)
2049 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
2051 cyclicModuleErr :: [ModSummary] -> SDoc
2053 = hang (ptext (sLit "Module imports form a cycle for modules:"))
2054 2 (vcat (map show_one ms))
2056 show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
2057 nest 2 $ ptext (sLit "imports:") <+>
2058 (pp_imps HsBootFile (ms_srcimps ms)
2059 $$ pp_imps HsSrcFile (ms_imps ms))]
2060 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
2061 pp_imps src mods = fsep (map (show_mod src) mods)
2064 -- | Inform GHC that the working directory has changed. GHC will flush
2065 -- its cache of module locations, since it may no longer be valid.
2066 -- Note: if you change the working directory, you should also unload
2067 -- the current program (set targets to empty, followed by load).
2068 workingDirectoryChanged :: Session -> IO ()
2069 workingDirectoryChanged s = withSession s $ flushFinderCaches
2071 -- -----------------------------------------------------------------------------
2072 -- inspecting the session
2074 -- | Get the module dependency graph.
2075 getModuleGraph :: Session -> IO ModuleGraph -- ToDo: DiGraph ModSummary
2076 getModuleGraph s = withSession s (return . hsc_mod_graph)
2078 isLoaded :: Session -> ModuleName -> IO Bool
2079 isLoaded s m = withSession s $ \hsc_env ->
2080 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
2082 getBindings :: Session -> IO [TyThing]
2083 getBindings s = withSession s $ \hsc_env ->
2084 -- we have to implement the shadowing behaviour of ic_tmp_ids here
2085 -- (see InteractiveContext) and the quickest way is to use an OccEnv.
2087 tmp_ids = ic_tmp_ids (hsc_IC hsc_env)
2088 filtered = foldr f (const []) tmp_ids emptyUniqSet
2090 | uniq `elementOfUniqSet` set = rest set
2091 | otherwise = AnId id : rest (addOneToUniqSet set uniq)
2092 where uniq = getUnique (nameOccName (idName id))
2096 getPrintUnqual :: Session -> IO PrintUnqualified
2097 getPrintUnqual s = withSession s $ \hsc_env ->
2098 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
2100 -- | Container for information about a 'Module'.
2101 data ModuleInfo = ModuleInfo {
2102 minf_type_env :: TypeEnv,
2103 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
2104 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
2105 minf_instances :: [Instance]
2107 ,minf_modBreaks :: ModBreaks
2109 -- ToDo: this should really contain the ModIface too
2111 -- We don't want HomeModInfo here, because a ModuleInfo applies
2112 -- to package modules too.
2114 -- | Request information about a loaded 'Module'
2115 getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
2116 getModuleInfo s mdl = withSession s $ \hsc_env -> do
2117 let mg = hsc_mod_graph hsc_env
2118 if mdl `elem` map ms_mod mg
2119 then getHomeModuleInfo hsc_env (moduleName mdl)
2121 {- if isHomeModule (hsc_dflags hsc_env) mdl
2123 else -} getPackageModuleInfo hsc_env mdl
2124 -- getPackageModuleInfo will attempt to find the interface, so
2125 -- we don't want to call it for a home module, just in case there
2126 -- was a problem loading the module and the interface doesn't
2127 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
2129 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
2131 getPackageModuleInfo hsc_env mdl = do
2132 (_msgs, mb_avails) <- getModuleExports hsc_env mdl
2134 Nothing -> return Nothing
2136 eps <- readIORef (hsc_EPS hsc_env)
2138 names = availsToNameSet avails
2140 tys = [ ty | name <- concatMap availNames avails,
2141 Just ty <- [lookupTypeEnv pte name] ]
2143 return (Just (ModuleInfo {
2144 minf_type_env = mkTypeEnv tys,
2145 minf_exports = names,
2146 minf_rdr_env = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
2147 minf_instances = error "getModuleInfo: instances for package module unimplemented",
2148 minf_modBreaks = emptyModBreaks
2151 getPackageModuleInfo _hsc_env _mdl = do
2152 -- bogusly different for non-GHCI (ToDo)
2156 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
2157 getHomeModuleInfo hsc_env mdl =
2158 case lookupUFM (hsc_HPT hsc_env) mdl of
2159 Nothing -> return Nothing
2161 let details = hm_details hmi
2162 return (Just (ModuleInfo {
2163 minf_type_env = md_types details,
2164 minf_exports = availsToNameSet (md_exports details),
2165 minf_rdr_env = mi_globals $! hm_iface hmi,
2166 minf_instances = md_insts details
2168 ,minf_modBreaks = getModBreaks hmi
2172 -- | The list of top-level entities defined in a module
2173 modInfoTyThings :: ModuleInfo -> [TyThing]
2174 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
2176 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
2177 modInfoTopLevelScope minf
2178 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
2180 modInfoExports :: ModuleInfo -> [Name]
2181 modInfoExports minf = nameSetToList $! minf_exports minf
2183 -- | Returns the instances defined by the specified module.
2184 -- Warning: currently unimplemented for package modules.
2185 modInfoInstances :: ModuleInfo -> [Instance]
2186 modInfoInstances = minf_instances
2188 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
2189 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
2191 mkPrintUnqualifiedForModule :: Session -> ModuleInfo -> IO (Maybe PrintUnqualified)
2192 mkPrintUnqualifiedForModule s minf = withSession s $ \hsc_env -> do
2193 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
2195 modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
2196 modInfoLookupName s minf name = withSession s $ \hsc_env -> do
2197 case lookupTypeEnv (minf_type_env minf) name of
2198 Just tyThing -> return (Just tyThing)
2200 eps <- readIORef (hsc_EPS hsc_env)
2201 return $! lookupType (hsc_dflags hsc_env)
2202 (hsc_HPT hsc_env) (eps_PTE eps) name
2205 modInfoModBreaks :: ModuleInfo -> ModBreaks
2206 modInfoModBreaks = minf_modBreaks
2209 isDictonaryId :: Id -> Bool
2211 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
2213 -- | Looks up a global name: that is, any top-level name in any
2214 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
2215 -- the interactive context, and therefore does not require a preceding
2217 lookupGlobalName :: Session -> Name -> IO (Maybe TyThing)
2218 lookupGlobalName s name = withSession s $ \hsc_env -> do
2219 eps <- hscEPS hsc_env
2220 return $! lookupType (hsc_dflags hsc_env)
2221 (hsc_HPT hsc_env) (eps_PTE eps) name
2224 -- | get the GlobalRdrEnv for a session
2225 getGRE :: Session -> IO GlobalRdrEnv
2226 getGRE s = withSession s $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
2229 -- -----------------------------------------------------------------------------
2230 -- Misc exported utils
2232 dataConType :: DataCon -> Type
2233 dataConType dc = idType (dataConWrapId dc)
2235 -- | print a 'NamedThing', adding parentheses if the name is an operator.
2236 pprParenSymName :: NamedThing a => a -> SDoc
2237 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
2239 -- ----------------------------------------------------------------------------
2244 -- - Data and Typeable instances for HsSyn.
2246 -- ToDo: check for small transformations that happen to the syntax in
2247 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
2249 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
2250 -- to get from TyCons, Ids etc. to TH syntax (reify).
2252 -- :browse will use either lm_toplev or inspect lm_interface, depending
2253 -- on whether the module is interpreted or not.
2255 -- This is for reconstructing refactored source code
2256 -- Calls the lexer repeatedly.
2257 -- ToDo: add comment tokens to token stream
2258 getTokenStream :: Session -> Module -> IO [Located Token]
2261 -- -----------------------------------------------------------------------------
2262 -- Interactive evaluation
2264 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
2265 -- filesystem and package database to find the corresponding 'Module',
2266 -- using the algorithm that is used for an @import@ declaration.
2267 findModule :: Session -> ModuleName -> Maybe FastString -> IO Module
2268 findModule s mod_name maybe_pkg = withSession s $ \hsc_env ->
2270 dflags = hsc_dflags hsc_env
2271 hpt = hsc_HPT hsc_env
2272 this_pkg = thisPackage dflags
2274 case lookupUFM hpt mod_name of
2275 Just mod_info -> return (mi_module (hm_iface mod_info))
2276 _not_a_home_module -> do
2277 res <- findImportedModule hsc_env mod_name maybe_pkg
2279 Found _ m | modulePackageId m /= this_pkg -> return m
2280 | otherwise -> ghcError (CmdLineError (showSDoc $
2281 text "module" <+> quotes (ppr (moduleName m)) <+>
2282 text "is not loaded"))
2283 err -> let msg = cannotFindModule dflags mod_name err in
2284 ghcError (CmdLineError (showSDoc msg))
2287 getHistorySpan :: Session -> History -> IO SrcSpan
2288 getHistorySpan sess h = withSession sess $ \hsc_env ->
2289 return$ InteractiveEval.getHistorySpan hsc_env h
2291 obtainTerm :: Session -> Bool -> Id -> IO Term
2292 obtainTerm sess force id = withSession sess $ \hsc_env ->
2293 InteractiveEval.obtainTerm hsc_env force id
2295 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
2296 obtainTerm1 sess force mb_ty a = withSession sess $ \hsc_env ->
2297 InteractiveEval.obtainTerm1 hsc_env force mb_ty a
2299 obtainTermB :: Session -> Int -> Bool -> Id -> IO Term
2300 obtainTermB sess bound force id = withSession sess $ \hsc_env ->
2301 InteractiveEval.obtainTermB hsc_env bound force id