1 -- -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow, 2005
7 -- -----------------------------------------------------------------------------
12 defaultCleanupHandler,
15 Ghc, GhcT, GhcMonad(..),
16 runGhc, runGhcT, initGhcMonad,
17 gcatch, gbracket, gfinally,
18 clearWarnings, getWarnings, hasWarnings,
19 printExceptionAndWarnings, printWarnings,
20 handleSourceError, defaultCallbacks, GhcApiCallbacks(..),
22 -- * Flags and settings
23 DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
24 GhcMode(..), GhcLink(..), defaultObjectTarget,
31 Target(..), TargetId(..), Phase,
38 -- * Extending the program scope
41 extendGlobalTypeScope,
44 -- * Loading\/compiling the program
46 load, loadWithLogger, LoadHowMuch(..),
47 SuccessFlag(..), succeeded, failed,
48 defaultWarnErrLogger, WarnErrLogger,
49 workingDirectoryChanged,
50 parseModule, typecheckModule, desugarModule, loadModule,
51 ParsedModule(..), TypecheckedModule(..), DesugaredModule(..),
52 TypecheckedSource, ParsedSource, RenamedSource, -- ditto
53 TypecheckedMod, ParsedMod,
54 moduleInfo, renamedSource, typecheckedSource,
55 parsedSource, coreModule,
56 compileToCoreModule, compileToCoreSimplified,
60 -- * Parsing Haddock comments
63 -- * Inspecting the module structure of the program
64 ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
69 -- * Inspecting modules
76 modInfoIsExportedName,
80 mkPrintUnqualifiedForModule,
82 -- * Querying the environment
86 PrintUnqualified, alwaysQualify,
88 -- * Interactive evaluation
89 getBindings, getPrintUnqual,
92 setContext, getContext,
102 runStmt, SingleStep(..),
104 Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
105 resumeHistory, resumeHistoryIx),
106 History(historyBreakInfo, historyEnclosingDecl),
107 GHC.getHistorySpan, getHistoryModule,
110 InteractiveEval.back,
111 InteractiveEval.forward,
114 InteractiveEval.compileExpr, HValue, dynCompileExpr,
116 GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
118 ModBreaks(..), BreakIndex,
119 BreakInfo(breakInfo_number, breakInfo_module),
120 BreakArray, setBreakOn, setBreakOff, getBreak,
123 -- * Abstract syntax elements
129 Module, mkModule, pprModule, moduleName, modulePackageId,
130 ModuleName, mkModuleName, moduleNameString,
134 isExternalName, nameModule, pprParenSymName, nameSrcSpan,
136 RdrName(Qual,Unqual),
140 isImplicitId, isDeadBinder,
141 isExportedId, isLocalId, isGlobalId,
143 isPrimOpId, isFCallId, isClassOpId_maybe,
144 isDataConWorkId, idDataCon,
145 isBottomingId, isDictonaryId,
146 recordSelectorFieldLabel,
148 -- ** Type constructors
150 tyConTyVars, tyConDataCons, tyConArity,
151 isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
153 synTyConDefn, synTyConType, synTyConResKind,
159 -- ** Data constructors
161 dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
162 dataConIsInfix, isVanillaDataCon,
164 StrictnessMark(..), isMarkedStrict,
168 classMethods, classSCTheta, classTvsFds,
173 instanceDFunId, pprInstance, pprInstanceHdr,
175 -- ** Types and Kinds
176 Type, splitForAllTys, funResultTy,
177 pprParendType, pprTypeApp,
180 ThetaType, pprThetaArrow,
186 module HsSyn, -- ToDo: remove extraneous bits
190 defaultFixity, maxPrecedence,
194 -- ** Source locations
196 mkSrcLoc, isGoodSrcLoc, noSrcLoc,
197 srcLocFile, srcLocLine, srcLocCol,
199 mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
200 srcSpanStart, srcSpanEnd,
202 srcSpanStartLine, srcSpanEndLine,
203 srcSpanStartCol, srcSpanEndCol,
208 -- *** Constructing Located
209 noLoc, mkGeneralLocated,
211 -- *** Deconstructing Located
214 -- *** Combining and comparing Located values
215 eqLocated, cmpLocated, combineLocs, addCLoc,
216 leftmost_smallest, leftmost_largest, rightmost,
220 GhcException(..), showGhcException,
222 -- * Token stream manipulations
224 getTokenStream, getRichTokenStream,
225 showRichTokenStream, addSourceToTokens,
235 * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
236 * what StaticFlags should we expose, if any?
239 #include "HsVersions.h"
242 import qualified Linker
243 import Linker ( HValue )
247 import InteractiveEval
252 import TcRnTypes hiding (LIE)
253 import TcRnMonad ( initIfaceCheck )
257 import qualified HsSyn -- hack as we want to reexport the whole module
258 import HsSyn hiding ((<.>))
259 import Type hiding (typeKind)
260 import TcType hiding (typeKind)
263 import TysPrim ( alphaTyVars )
268 import Name hiding ( varName )
269 import OccName ( parenSymOcc )
270 import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr,
272 import FamInstEnv ( emptyFamInstEnv )
276 import DriverPipeline
277 import DriverPhases ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase )
283 import StaticFlagParser
284 import qualified StaticFlags
285 import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
290 import qualified UniqFM as UFM
296 import Bag ( unitBag, listToBag, emptyBag, isEmptyBag )
300 import StringBuffer ( StringBuffer, hGetStringBuffer, nextChar )
303 import Maybes ( expectJust, mapCatMaybes )
305 import HaddockLex ( tokenise )
309 import Control.Concurrent
310 import System.Directory ( getModificationTime, doesFileExist,
311 getCurrentDirectory )
314 import qualified Data.List as List
315 import Data.Typeable ( Typeable )
316 import Data.Word ( Word8 )
318 import System.Exit ( exitWith, ExitCode(..) )
319 import System.Time ( ClockTime, getClockTime )
322 import System.FilePath
324 import System.IO.Error ( try, isDoesNotExistError )
325 import Prelude hiding (init)
328 -- -----------------------------------------------------------------------------
329 -- Exception handlers
331 -- | Install some default exception handlers and run the inner computation.
332 -- Unless you want to handle exceptions yourself, you should wrap this around
333 -- the top level of your program. The default handlers output the error
334 -- message(s) to stderr and exit cleanly.
335 defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => DynFlags -> m a -> m a
336 defaultErrorHandler dflags inner =
337 -- top-level exception handler: any unrecognised exception is a compiler bug.
338 ghandle (\exception -> liftIO $ do
340 case fromException exception of
341 -- an IO exception probably isn't our fault, so don't panic
342 Just (ioe :: IOException) ->
343 fatalErrorMsg dflags (text (show ioe))
344 _ -> case fromException exception of
345 Just StackOverflow ->
346 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
347 _ -> case fromException exception of
348 Just (ex :: ExitCode) -> throw ex
351 (text (show (Panic (show exception))))
352 exitWith (ExitFailure 1)
355 -- error messages propagated as exceptions
360 PhaseFailed _ code -> exitWith code
361 Interrupted -> exitWith (ExitFailure 1)
362 _ -> do fatalErrorMsg dflags (text (show ge))
363 exitWith (ExitFailure 1)
367 -- | Install a default cleanup handler to remove temporary files deposited by
368 -- a GHC run. This is seperate from 'defaultErrorHandler', because you might
369 -- want to override the error handling, but still get the ordinary cleanup
371 defaultCleanupHandler :: (ExceptionMonad m, MonadIO m) =>
372 DynFlags -> m a -> m a
373 defaultCleanupHandler dflags inner =
374 -- make sure we clean up after ourselves
377 cleanTempFiles dflags
380 -- exceptions will be blocked while we clean the temporary files,
381 -- so there shouldn't be any difficulty if we receive further
384 -- | Print the error message and all warnings. Useful inside exception
385 -- handlers. Clears warnings after printing.
386 printExceptionAndWarnings :: GhcMonad m => SourceError -> m ()
387 printExceptionAndWarnings err = do
388 let errs = srcErrorMessages err
390 dflags <- getSessionDynFlags
392 -- Empty errors means we failed due to -Werror. (Since this function
393 -- takes a source error as argument, we know for sure _some_ error
394 -- did indeed happen.)
396 printBagOfWarnings dflags warns
397 printBagOfErrors dflags (unitBag warnIsErrorMsg)
398 else liftIO $ printBagOfErrors dflags errs
401 -- | Print all accumulated warnings using 'log_action'.
402 printWarnings :: GhcMonad m => m ()
404 dflags <- getSessionDynFlags
406 liftIO $ printBagOfWarnings dflags warns
409 -- | Run function for the 'Ghc' monad.
411 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
412 -- to this function will create a new session which should not be shared among
415 -- Any errors not handled inside the 'Ghc' action are propagated as IO
418 runGhc :: Maybe FilePath -- ^ See argument to 'initGhcMonad'.
419 -> Ghc a -- ^ The action to perform.
421 runGhc mb_top_dir ghc = do
422 wref <- newIORef emptyBag
423 ref <- newIORef undefined
424 let session = Session ref wref
425 flip unGhc session $ do
426 initGhcMonad mb_top_dir
428 -- XXX: unregister interrupt handlers here?
430 -- | Run function for 'GhcT' monad transformer.
432 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
433 -- to this function will create a new session which should not be shared among
436 runGhcT :: (ExceptionMonad m, Functor m, MonadIO m) =>
437 Maybe FilePath -- ^ See argument to 'initGhcMonad'.
438 -> GhcT m a -- ^ The action to perform.
440 runGhcT mb_top_dir ghct = do
441 wref <- liftIO $ newIORef emptyBag
442 ref <- liftIO $ newIORef undefined
443 let session = Session ref wref
444 flip unGhcT session $ do
445 initGhcMonad mb_top_dir
448 -- | Initialise a GHC session.
450 -- If you implement a custom 'GhcMonad' you must call this function in the
451 -- monad run function. It will initialise the session variable and clear all
454 -- The first argument should point to the directory where GHC's library files
455 -- reside. More precisely, this should be the output of @ghc --print-libdir@
456 -- of the version of GHC the module using this API is compiled with. For
457 -- portability, you should use the @ghc-paths@ package, available at
458 -- <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/ghc-paths>.
460 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
461 initGhcMonad mb_top_dir = do
463 main_thread <- liftIO $ myThreadId
464 liftIO $ modifyMVar_ interruptTargetThread (return . (main_thread :))
465 liftIO $ installSignalHandlers
467 liftIO $ StaticFlags.initStaticOpts
469 dflags0 <- liftIO $ initDynFlags defaultDynFlags
470 dflags <- liftIO $ initSysTools mb_top_dir dflags0
471 env <- liftIO $ newHscEnv defaultCallbacks dflags
475 defaultCallbacks :: GhcApiCallbacks
478 reportModuleCompilationResult =
479 \_ mb_err -> defaultWarnErrLogger mb_err
482 -- -----------------------------------------------------------------------------
485 -- | Grabs the DynFlags from the Session
486 getSessionDynFlags :: GhcMonad m => m DynFlags
487 getSessionDynFlags = withSession (return . hsc_dflags)
489 -- | Updates the DynFlags in a Session. This also reads
490 -- the package database (unless it has already been read),
491 -- and prepares the compilers knowledge about packages. It
492 -- can be called again to load new packages: just add new
493 -- package flags to (packageFlags dflags).
495 -- Returns a list of new packages that may need to be linked in using
496 -- the dynamic linker (see 'linkPackages') as a result of new package
497 -- flags. If you are not doing linking or doing static linking, you
498 -- can ignore the list of packages returned.
500 setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
501 setSessionDynFlags dflags = do
502 (dflags', preload) <- liftIO $ initPackages dflags
503 modifySession (\h -> h{ hsc_dflags = dflags' })
506 -- | If there is no -o option, guess the name of target executable
507 -- by using top-level source file name as a base.
508 guessOutputFile :: GhcMonad m => m ()
509 guessOutputFile = modifySession $ \env ->
510 let dflags = hsc_dflags env
511 mod_graph = hsc_mod_graph env
512 mainModuleSrcPath :: Maybe String
513 mainModuleSrcPath = do
514 let isMain = (== mainModIs dflags) . ms_mod
515 [ms] <- return (filter isMain mod_graph)
516 ml_hs_file (ms_location ms)
517 name = fmap dropExtension mainModuleSrcPath
519 #if defined(mingw32_HOST_OS)
520 -- we must add the .exe extention unconditionally here, otherwise
521 -- when name has an extension of its own, the .exe extension will
522 -- not be added by DriverPipeline.exeFileName. See #2248
523 name_exe = fmap (<.> "exe") name
528 case outputFile dflags of
530 Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } }
532 -- -----------------------------------------------------------------------------
535 -- ToDo: think about relative vs. absolute file paths. And what
536 -- happens when the current directory changes.
538 -- | Sets the targets for this session. Each target may be a module name
539 -- or a filename. The targets correspond to the set of root modules for
540 -- the program\/library. Unloading the current program is achieved by
541 -- setting the current set of targets to be empty, followed by 'load'.
542 setTargets :: GhcMonad m => [Target] -> m ()
543 setTargets targets = modifySession (\h -> h{ hsc_targets = targets })
545 -- | Returns the current set of targets
546 getTargets :: GhcMonad m => m [Target]
547 getTargets = withSession (return . hsc_targets)
549 -- | Add another target.
550 addTarget :: GhcMonad m => Target -> m ()
552 = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
555 removeTarget :: GhcMonad m => TargetId -> m ()
556 removeTarget target_id
557 = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
559 filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
561 -- | Attempts to guess what Target a string refers to. This function
562 -- implements the @--make@/GHCi command-line syntax for filenames:
564 -- - if the string looks like a Haskell source filename, then interpret it
567 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
570 -- - otherwise interpret the string as a module name
572 guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
573 guessTarget str (Just phase)
574 = return (Target (TargetFile str (Just phase)) True Nothing)
575 guessTarget str Nothing
576 | isHaskellSrcFilename file
577 = return (target (TargetFile file Nothing))
579 = do exists <- liftIO $ doesFileExist hs_file
581 then return (target (TargetFile hs_file Nothing))
583 exists <- liftIO $ doesFileExist lhs_file
585 then return (target (TargetFile lhs_file Nothing))
587 if looksLikeModuleName file
588 then return (target (TargetModule (mkModuleName file)))
591 (ProgramError (showSDoc $
592 text "target" <+> quotes (text file) <+>
593 text "is not a module name or a source file"))
596 | '*':rest <- str = (rest, False)
597 | otherwise = (str, True)
599 hs_file = file <.> "hs"
600 lhs_file = file <.> "lhs"
602 target tid = Target tid obj_allowed Nothing
604 -- -----------------------------------------------------------------------------
605 -- Extending the program scope
607 extendGlobalRdrScope :: GhcMonad m => [GlobalRdrElt] -> m ()
608 extendGlobalRdrScope rdrElts
609 = modifySession $ \hscEnv ->
610 let global_rdr = hsc_global_rdr_env hscEnv
611 in hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv global_rdr rdrElts }
613 setGlobalRdrScope :: GhcMonad m => [GlobalRdrElt] -> m ()
614 setGlobalRdrScope rdrElts
615 = modifySession $ \hscEnv ->
616 hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv rdrElts }
618 extendGlobalTypeScope :: GhcMonad m => [Id] -> m ()
619 extendGlobalTypeScope ids
620 = modifySession $ \hscEnv ->
621 let global_type = hsc_global_type_env hscEnv
622 in hscEnv{ hsc_global_type_env = extendTypeEnvWithIds global_type ids }
624 setGlobalTypeScope :: GhcMonad m => [Id] -> m ()
625 setGlobalTypeScope ids
626 = modifySession $ \hscEnv ->
627 hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
629 -- -----------------------------------------------------------------------------
630 -- Parsing Haddock comments
632 parseHaddockComment :: String -> Either String (HsDoc RdrName)
633 parseHaddockComment string =
634 case parseHaddockParagraphs (tokenise string) of
638 -- -----------------------------------------------------------------------------
639 -- Loading the program
641 -- | Perform a dependency analysis starting from the current targets
642 -- and update the session with the new module graph.
644 -- Dependency analysis entails parsing the @import@ directives and may
645 -- therefore require running certain preprocessors.
647 -- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.
648 -- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the
649 -- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module. Thus if you want to
650 -- changes to the 'DynFlags' to take effect you need to call this function
653 depanal :: GhcMonad m =>
654 [ModuleName] -- ^ excluded modules
655 -> Bool -- ^ allow duplicate roots
657 depanal excluded_mods allow_dup_roots = do
658 hsc_env <- getSession
660 dflags = hsc_dflags hsc_env
661 targets = hsc_targets hsc_env
662 old_graph = hsc_mod_graph hsc_env
664 liftIO $ showPass dflags "Chasing dependencies"
665 liftIO $ debugTraceMsg dflags 2 (hcat [
666 text "Chasing modules from: ",
667 hcat (punctuate comma (map pprTarget targets))])
669 mod_graph <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
670 modifySession $ \_ -> hsc_env { hsc_mod_graph = mod_graph }
673 -- | Describes which modules of the module graph need to be loaded.
676 -- ^ Load all targets and its dependencies.
677 | LoadUpTo ModuleName
678 -- ^ Load only the given module and its dependencies.
679 | LoadDependenciesOf ModuleName
680 -- ^ Load only the dependencies of the given module, but not the module
683 -- | Try to load the program. See 'LoadHowMuch' for the different modes.
685 -- This function implements the core of GHC's @--make@ mode. It preprocesses,
686 -- compiles and loads the specified modules, avoiding re-compilation wherever
687 -- possible. Depending on the target (see 'DynFlags.hscTarget') compilating
688 -- and loading may result in files being created on disk.
690 -- Calls the 'reportModuleCompilationResult' callback after each compiling
691 -- each module, whether successful or not.
693 -- Throw a 'SourceError' if errors are encountered before the actual
694 -- compilation starts (e.g., during dependency analysis). All other errors
695 -- are reported using the callback.
697 load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
699 mod_graph <- depanal [] False
700 load2 how_much mod_graph
702 -- | A function called to log warnings and errors.
703 type WarnErrLogger = GhcMonad m => Maybe SourceError -> m ()
705 defaultWarnErrLogger :: WarnErrLogger
706 defaultWarnErrLogger Nothing = printWarnings
707 defaultWarnErrLogger (Just e) = printExceptionAndWarnings e
709 -- | Try to load the program. If a Module is supplied, then just
710 -- attempt to load up to this target. If no Module is supplied,
711 -- then try to load all targets.
713 -- The first argument is a function that is called after compiling each
714 -- module to print wanrings and errors.
716 -- While compiling a module, all 'SourceError's are caught and passed to the
717 -- logger, however, this function may still throw a 'SourceError' if
718 -- dependency analysis failed (e.g., due to a parse error).
720 loadWithLogger :: GhcMonad m => WarnErrLogger -> LoadHowMuch -> m SuccessFlag
721 loadWithLogger logger how_much = do
722 -- Dependency analysis first. Note that this fixes the module graph:
723 -- even if we don't get a fully successful upsweep, the full module
724 -- graph is still retained in the Session. We can tell which modules
725 -- were successfully loaded by inspecting the Session's HPT.
726 withLocalCallbacks (\cbs -> cbs { reportModuleCompilationResult =
730 load2 :: GhcMonad m => LoadHowMuch -> [ModSummary]
732 load2 how_much mod_graph = do
734 hsc_env <- getSession
736 let hpt1 = hsc_HPT hsc_env
737 let dflags = hsc_dflags hsc_env
739 -- The "bad" boot modules are the ones for which we have
740 -- B.hs-boot in the module graph, but no B.hs
741 -- The downsweep should have ensured this does not happen
743 let all_home_mods = [ms_mod_name s
744 | s <- mod_graph, not (isBootSummary s)]
745 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
746 not (ms_mod_name s `elem` all_home_mods)]
747 ASSERT( null bad_boot_mods ) return ()
749 -- check that the module given in HowMuch actually exists, otherwise
750 -- topSortModuleGraph will bomb later.
751 let checkHowMuch (LoadUpTo m) = checkMod m
752 checkHowMuch (LoadDependenciesOf m) = checkMod m
756 | m `elem` all_home_mods = and_then
758 liftIO $ errorMsg dflags (text "no such module:" <+>
762 checkHowMuch how_much $ do
764 -- mg2_with_srcimps drops the hi-boot nodes, returning a
765 -- graph with cycles. Among other things, it is used for
766 -- backing out partially complete cycles following a failed
767 -- upsweep, and for removing from hpt all the modules
768 -- not in strict downwards closure, during calls to compile.
769 let mg2_with_srcimps :: [SCC ModSummary]
770 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
772 -- If we can determine that any of the {-# SOURCE #-} imports
773 -- are definitely unnecessary, then emit a warning.
774 warnUnnecessarySourceImports mg2_with_srcimps
777 -- check the stability property for each module.
778 stable_mods@(stable_obj,stable_bco)
779 = checkStability hpt1 mg2_with_srcimps all_home_mods
781 -- prune bits of the HPT which are definitely redundant now,
783 pruned_hpt = pruneHomePackageTable hpt1
784 (flattenSCCs mg2_with_srcimps)
787 liftIO $ evaluate pruned_hpt
789 -- before we unload anything, make sure we don't leave an old
790 -- interactive context around pointing to dead bindings. Also,
791 -- write the pruned HPT to allow the old HPT to be GC'd.
792 modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext,
793 hsc_HPT = pruned_hpt }
795 liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
796 text "Stable BCO:" <+> ppr stable_bco)
798 -- Unload any modules which are going to be re-linked this time around.
799 let stable_linkables = [ linkable
800 | m <- stable_obj++stable_bco,
801 Just hmi <- [lookupUFM pruned_hpt m],
802 Just linkable <- [hm_linkable hmi] ]
803 liftIO $ unload hsc_env stable_linkables
805 -- We could at this point detect cycles which aren't broken by
806 -- a source-import, and complain immediately, but it seems better
807 -- to let upsweep_mods do this, so at least some useful work gets
808 -- done before the upsweep is abandoned.
809 --hPutStrLn stderr "after tsort:\n"
810 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
812 -- Now do the upsweep, calling compile for each module in
813 -- turn. Final result is version 3 of everything.
815 -- Topologically sort the module graph, this time including hi-boot
816 -- nodes, and possibly just including the portion of the graph
817 -- reachable from the module specified in the 2nd argument to load.
818 -- This graph should be cycle-free.
819 -- If we're restricting the upsweep to a portion of the graph, we
820 -- also want to retain everything that is still stable.
821 let full_mg :: [SCC ModSummary]
822 full_mg = topSortModuleGraph False mod_graph Nothing
824 maybe_top_mod = case how_much of
826 LoadDependenciesOf m -> Just m
829 partial_mg0 :: [SCC ModSummary]
830 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
832 -- LoadDependenciesOf m: we want the upsweep to stop just
833 -- short of the specified module (unless the specified module
836 | LoadDependenciesOf _mod <- how_much
837 = ASSERT( case last partial_mg0 of
838 AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
839 List.init partial_mg0
845 | AcyclicSCC ms <- full_mg,
846 ms_mod_name ms `elem` stable_obj++stable_bco,
847 ms_mod_name ms `notElem` [ ms_mod_name ms' |
848 AcyclicSCC ms' <- partial_mg ] ]
850 mg = stable_mg ++ partial_mg
852 -- clean up between compilations
853 let cleanup = cleanTempFilesExcept dflags
854 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
856 liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
858 (upsweep_ok, hsc_env1, modsUpswept)
859 <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
860 pruned_hpt stable_mods cleanup mg
862 -- Make modsDone be the summaries for each home module now
863 -- available; this should equal the domain of hpt3.
864 -- Get in in a roughly top .. bottom order (hence reverse).
866 let modsDone = reverse modsUpswept
868 -- Try and do linking in some form, depending on whether the
869 -- upsweep was completely or only partially successful.
871 if succeeded upsweep_ok
874 -- Easy; just relink it all.
875 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep completely successful.")
877 -- Clean up after ourselves
878 liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
880 -- Issue a warning for the confusing case where the user
881 -- said '-o foo' but we're not going to do any linking.
882 -- We attempt linking if either (a) one of the modules is
883 -- called Main, or (b) the user said -no-hs-main, indicating
884 -- that main() is going to come from somewhere else.
886 let ofile = outputFile dflags
887 let no_hs_main = dopt Opt_NoHsMain dflags
889 main_mod = mainModIs dflags
890 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
891 do_linking = a_root_is_Main || no_hs_main
893 when (ghcLink dflags == LinkBinary
894 && isJust ofile && not do_linking) $
895 liftIO $ debugTraceMsg dflags 1 $
896 text ("Warning: output was redirected with -o, " ++
897 "but no output will be generated\n" ++
898 "because there is no " ++
899 moduleNameString (moduleName main_mod) ++ " module.")
901 -- link everything together
902 linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
904 loadFinish Succeeded linkresult hsc_env1
907 -- Tricky. We need to back out the effects of compiling any
908 -- half-done cycles, both so as to clean up the top level envs
909 -- and to avoid telling the interactive linker to link them.
910 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep partially successful.")
913 = map ms_mod modsDone
914 let mods_to_zap_names
915 = findPartiallyCompletedCycles modsDone_names
918 = filter ((`notElem` mods_to_zap_names).ms_mod)
921 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
924 -- Clean up after ourselves
925 liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
927 -- there should be no Nothings where linkables should be, now
928 ASSERT(all (isJust.hm_linkable)
929 (eltsUFM (hsc_HPT hsc_env))) do
931 -- Link everything together
932 linkresult <- liftIO $ link (ghcLink dflags) dflags False hpt4
934 let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
935 loadFinish Failed linkresult hsc_env4
937 -- Finish up after a load.
939 -- If the link failed, unload everything and return.
940 loadFinish :: GhcMonad m =>
941 SuccessFlag -> SuccessFlag -> HscEnv
943 loadFinish _all_ok Failed hsc_env
944 = do liftIO $ unload hsc_env []
945 modifySession $ \_ -> discardProg hsc_env
948 -- Empty the interactive context and set the module context to the topmost
949 -- newly loaded module, or the Prelude if none were loaded.
950 loadFinish all_ok Succeeded hsc_env
951 = do modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext }
955 -- Forget the current program, but retain the persistent info in HscEnv
956 discardProg :: HscEnv -> HscEnv
958 = hsc_env { hsc_mod_graph = emptyMG,
959 hsc_IC = emptyInteractiveContext,
960 hsc_HPT = emptyHomePackageTable }
962 -- used to fish out the preprocess output files for the purposes of
963 -- cleaning up. The preprocessed file *might* be the same as the
964 -- source file, but that doesn't do any harm.
965 ppFilesFromSummaries :: [ModSummary] -> [FilePath]
966 ppFilesFromSummaries summaries = map ms_hspp_file summaries
968 -- -----------------------------------------------------------------------------
970 class ParsedMod m where
971 modSummary :: m -> ModSummary
972 parsedSource :: m -> ParsedSource
974 class ParsedMod m => TypecheckedMod m where
975 renamedSource :: m -> Maybe RenamedSource
976 typecheckedSource :: m -> TypecheckedSource
977 moduleInfo :: m -> ModuleInfo
978 tm_internals :: m -> (TcGblEnv, ModDetails)
979 -- ToDo: improvements that could be made here:
980 -- if the module succeeded renaming but not typechecking,
981 -- we can still get back the GlobalRdrEnv and exports, so
982 -- perhaps the ModuleInfo should be split up into separate
985 class TypecheckedMod m => DesugaredMod m where
986 coreModule :: m -> ModGuts
988 -- | The result of successful parsing.
990 ParsedModule { pm_mod_summary :: ModSummary
991 , pm_parsed_source :: ParsedSource }
993 instance ParsedMod ParsedModule where
994 modSummary m = pm_mod_summary m
995 parsedSource m = pm_parsed_source m
997 -- | The result of successful typechecking. It also contains the parser
999 data TypecheckedModule =
1000 TypecheckedModule { tm_parsed_module :: ParsedModule
1001 , tm_renamed_source :: Maybe RenamedSource
1002 , tm_typechecked_source :: TypecheckedSource
1003 , tm_checked_module_info :: ModuleInfo
1004 , tm_internals_ :: (TcGblEnv, ModDetails)
1007 instance ParsedMod TypecheckedModule where
1008 modSummary m = modSummary (tm_parsed_module m)
1009 parsedSource m = parsedSource (tm_parsed_module m)
1011 instance TypecheckedMod TypecheckedModule where
1012 renamedSource m = tm_renamed_source m
1013 typecheckedSource m = tm_typechecked_source m
1014 moduleInfo m = tm_checked_module_info m
1015 tm_internals m = tm_internals_ m
1017 -- | The result of successful desugaring (i.e., translation to core). Also
1018 -- contains all the information of a typechecked module.
1019 data DesugaredModule =
1020 DesugaredModule { dm_typechecked_module :: TypecheckedModule
1021 , dm_core_module :: ModGuts
1024 instance ParsedMod DesugaredModule where
1025 modSummary m = modSummary (dm_typechecked_module m)
1026 parsedSource m = parsedSource (dm_typechecked_module m)
1028 instance TypecheckedMod DesugaredModule where
1029 renamedSource m = renamedSource (dm_typechecked_module m)
1030 typecheckedSource m = typecheckedSource (dm_typechecked_module m)
1031 moduleInfo m = moduleInfo (dm_typechecked_module m)
1032 tm_internals m = tm_internals_ (dm_typechecked_module m)
1034 instance DesugaredMod DesugaredModule where
1035 coreModule m = dm_core_module m
1037 type ParsedSource = Located (HsModule RdrName)
1038 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
1039 Maybe (HsDoc Name), HaddockModInfo Name)
1040 type TypecheckedSource = LHsBinds Id
1043 -- - things that aren't in the output of the typechecker right now:
1044 -- - the export list
1046 -- - type signatures
1047 -- - type/data/newtype declarations
1048 -- - class declarations
1050 -- - extra things in the typechecker's output:
1051 -- - default methods are turned into top-level decls.
1052 -- - dictionary bindings
1054 -- | Return the 'ModSummary' of a module with the given name.
1056 -- The module must be part of the module graph (see 'hsc_mod_graph' and
1057 -- 'ModuleGraph'). If this is not the case, this function will throw a
1060 -- This function ignores boot modules and requires that there is only one
1061 -- non-boot module with the given name.
1062 getModSummary :: GhcMonad m => ModuleName -> m ModSummary
1063 getModSummary mod = do
1064 mg <- liftM hsc_mod_graph getSession
1065 case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
1066 [] -> throw $ mkApiErr (text "Module not part of module graph")
1068 multiple -> throw $ mkApiErr (text "getModSummary is ambiguous: " <+> ppr multiple)
1070 -- | Parse a module.
1072 -- Throws a 'SourceError' on parse error.
1073 parseModule :: GhcMonad m => ModSummary -> m ParsedModule
1075 rdr_module <- withTempSession
1076 (\e -> e { hsc_dflags = ms_hspp_opts ms }) $
1078 return (ParsedModule ms rdr_module)
1080 -- | Typecheck and rename a parsed module.
1082 -- Throws a 'SourceError' if either fails.
1083 typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
1084 typecheckModule pmod = do
1085 let ms = modSummary pmod
1086 withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
1087 (tc_gbl_env, rn_info)
1088 <- hscTypecheckRename ms (parsedSource pmod)
1089 details <- makeSimpleDetails tc_gbl_env
1092 tm_internals_ = (tc_gbl_env, details),
1093 tm_parsed_module = pmod,
1094 tm_renamed_source = rn_info,
1095 tm_typechecked_source = tcg_binds tc_gbl_env,
1096 tm_checked_module_info =
1098 minf_type_env = md_types details,
1099 minf_exports = availsToNameSet $ md_exports details,
1100 minf_rdr_env = Just (tcg_rdr_env tc_gbl_env),
1101 minf_instances = md_insts details
1103 ,minf_modBreaks = emptyModBreaks
1107 -- | Desugar a typechecked module.
1108 desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
1109 desugarModule tcm = do
1110 let ms = modSummary tcm
1111 withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
1112 let (tcg, _) = tm_internals tcm
1113 guts <- hscDesugar ms tcg
1116 dm_typechecked_module = tcm,
1117 dm_core_module = guts
1120 -- | Load a module. Input doesn't need to be desugared.
1122 -- XXX: Describe usage.
1123 loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
1125 let ms = modSummary tcm
1126 let mod = ms_mod_name ms
1127 let (tcg, _details) = tm_internals tcm
1129 withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
1131 let compilerBackend comp env ms' _ _mb_old_iface _ =
1132 withTempSession (\_ -> env) $
1133 hscBackend comp tcg ms'
1135 hsc_env <- getSession
1137 <- compile' (compilerBackend hscNothingCompiler
1138 ,compilerBackend hscInteractiveCompiler
1139 ,compilerBackend hscBatchCompiler)
1140 hsc_env ms 1 1 Nothing Nothing
1141 -- compile' shouldn't change the environment
1142 return $ addToUFM (hsc_HPT hsc_env) mod mod_info
1143 modifySession $ \e -> e{ hsc_HPT = hpt_new }
1146 -- | This is the way to get access to the Core bindings corresponding
1147 -- to a module. 'compileToCore' parses, typechecks, and
1148 -- desugars the module, then returns the resulting Core module (consisting of
1149 -- the module name, type declarations, and function declarations) if
1151 compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
1152 compileToCoreModule = compileCore False
1154 -- | Like compileToCoreModule, but invokes the simplifier, so
1155 -- as to return simplified and tidied Core.
1156 compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
1157 compileToCoreSimplified = compileCore True
1159 -- | Provided for backwards-compatibility: compileToCore returns just the Core
1160 -- bindings, but for most purposes, you probably want to call
1161 -- compileToCoreModule.
1162 compileToCore :: GhcMonad m => FilePath -> m [CoreBind]
1163 compileToCore fn = do
1164 mod <- compileToCoreModule session fn
1165 return $ cm_binds mod
1167 -- | Takes a CoreModule and compiles the bindings therein
1168 -- to object code. The first argument is a bool flag indicating
1169 -- whether to run the simplifier.
1170 -- The resulting .o, .hi, and executable files, if any, are stored in the
1171 -- current directory, and named according to the module name.
1172 -- This has only so far been tested with a single self-contained module.
1173 compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m ()
1174 compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
1175 dflags <- getSessionDynFlags
1176 currentTime <- liftIO $ getClockTime
1177 cwd <- liftIO $ getCurrentDirectory
1178 modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd
1179 ((moduleNameSlashes . moduleName) mName)
1181 let modSummary = ModSummary { ms_mod = mName,
1182 ms_hsc_src = ExtCoreFile,
1183 ms_location = modLocation,
1184 -- By setting the object file timestamp to Nothing,
1185 -- we always force recompilation, which is what we
1186 -- want. (Thus it doesn't matter what the timestamp
1187 -- for the (nonexistent) source file is.)
1188 ms_hs_date = currentTime,
1189 ms_obj_date = Nothing,
1190 -- Only handling the single-module case for now, so no imports.
1195 ms_hspp_opts = dflags,
1196 ms_hspp_buf = Nothing
1199 let maybe_simplify mod_guts | simplify = hscSimplify mod_guts
1200 | otherwise = return mod_guts
1201 guts <- maybe_simplify (mkModGuts cm)
1202 (iface, changed, _details, cgguts)
1203 <- hscNormalIface guts Nothing
1204 hscWriteIface iface changed modSummary
1205 hscGenHardCode cgguts modSummary
1208 -- Makes a "vanilla" ModGuts.
1209 mkModGuts :: CoreModule -> ModGuts
1210 mkModGuts coreModule = ModGuts {
1211 mg_module = cm_module coreModule,
1214 mg_deps = noDependencies,
1215 mg_dir_imps = emptyModuleEnv,
1216 mg_used_names = emptyNameSet,
1217 mg_rdr_env = emptyGlobalRdrEnv,
1218 mg_fix_env = emptyFixityEnv,
1219 mg_types = emptyTypeEnv,
1223 mg_binds = cm_binds coreModule,
1224 mg_foreign = NoStubs,
1225 mg_warns = NoWarnings,
1227 mg_hpc_info = emptyHpcInfo False,
1228 mg_modBreaks = emptyModBreaks,
1229 mg_vect_info = noVectInfo,
1230 mg_inst_env = emptyInstEnv,
1231 mg_fam_inst_env = emptyFamInstEnv
1234 compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
1235 compileCore simplify fn = do
1236 -- First, set the target to the desired filename
1237 target <- guessTarget fn Nothing
1240 -- Then find dependencies
1241 modGraph <- depanal [] True
1242 case find ((== fn) . msHsFilePath) modGraph of
1243 Just modSummary -> do
1244 -- Now we have the module name;
1245 -- parse, typecheck and desugar the module
1246 mod_guts <- coreModule `fmap`
1247 -- TODO: space leaky: call hsc* directly?
1248 (desugarModule =<< typecheckModule =<< parseModule modSummary)
1249 liftM gutsToCoreModule $
1252 -- If simplify is true: simplify (hscSimplify), then tidy
1254 hsc_env <- getSession
1255 simpl_guts <- hscSimplify mod_guts
1256 tidy_guts <- liftIO $ tidyProgram hsc_env simpl_guts
1257 return $ Left tidy_guts
1259 return $ Right mod_guts
1261 Nothing -> panic "compileToCoreModule: target FilePath not found in\
1262 module dependency graph"
1263 where -- two versions, based on whether we simplify (thus run tidyProgram,
1264 -- which returns a (CgGuts, ModDetails) pair, or not (in which case
1265 -- we just have a ModGuts.
1266 gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
1267 gutsToCoreModule (Left (cg, md)) = CoreModule {
1268 cm_module = cg_module cg, cm_types = md_types md,
1269 cm_imports = cg_dir_imps cg, cm_binds = cg_binds cg
1271 gutsToCoreModule (Right mg) = CoreModule {
1272 cm_module = mg_module mg, cm_types = mg_types mg,
1273 cm_imports = moduleEnvKeys (mg_dir_imps mg), cm_binds = mg_binds mg
1276 -- ---------------------------------------------------------------------------
1279 unload :: HscEnv -> [Linkable] -> IO ()
1280 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
1281 = case ghcLink (hsc_dflags hsc_env) of
1283 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
1285 LinkInMemory -> panic "unload: no interpreter"
1286 -- urgh. avoid warnings:
1287 hsc_env stable_linkables
1291 -- -----------------------------------------------------------------------------
1295 Stability tells us which modules definitely do not need to be recompiled.
1296 There are two main reasons for having stability:
1298 - avoid doing a complete upsweep of the module graph in GHCi when
1299 modules near the bottom of the tree have not changed.
1301 - to tell GHCi when it can load object code: we can only load object code
1302 for a module when we also load object code fo all of the imports of the
1303 module. So we need to know that we will definitely not be recompiling
1304 any of these modules, and we can use the object code.
1306 The stability check is as follows. Both stableObject and
1307 stableBCO are used during the upsweep phase later.
1310 stable m = stableObject m || stableBCO m
1313 all stableObject (imports m)
1314 && old linkable does not exist, or is == on-disk .o
1315 && date(on-disk .o) > date(.hs)
1318 all stable (imports m)
1319 && date(BCO) > date(.hs)
1322 These properties embody the following ideas:
1324 - if a module is stable, then:
1326 - if it has been compiled in a previous pass (present in HPT)
1327 then it does not need to be compiled or re-linked.
1329 - if it has not been compiled in a previous pass,
1330 then we only need to read its .hi file from disk and
1331 link it to produce a 'ModDetails'.
1333 - if a modules is not stable, we will definitely be at least
1334 re-linking, and possibly re-compiling it during the 'upsweep'.
1335 All non-stable modules can (and should) therefore be unlinked
1336 before the 'upsweep'.
1338 - Note that objects are only considered stable if they only depend
1339 on other objects. We can't link object code against byte code.
1343 :: HomePackageTable -- HPT from last compilation
1344 -> [SCC ModSummary] -- current module graph (cyclic)
1345 -> [ModuleName] -- all home modules
1346 -> ([ModuleName], -- stableObject
1347 [ModuleName]) -- stableBCO
1349 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
1351 checkSCC (stable_obj, stable_bco) scc0
1352 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
1353 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
1354 | otherwise = (stable_obj, stable_bco)
1356 scc = flattenSCC scc0
1357 scc_mods = map ms_mod_name scc
1358 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
1360 scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))
1361 -- all imports outside the current SCC, but in the home pkg
1363 stable_obj_imps = map (`elem` stable_obj) scc_allimps
1364 stable_bco_imps = map (`elem` stable_bco) scc_allimps
1368 && all object_ok scc
1371 and (zipWith (||) stable_obj_imps stable_bco_imps)
1375 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
1379 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
1380 Just hmi | Just l <- hm_linkable hmi
1381 -> isObjectLinkable l && t == linkableTime l
1383 -- why '>=' rather than '>' above? If the filesystem stores
1384 -- times to the nearset second, we may occasionally find that
1385 -- the object & source have the same modification time,
1386 -- especially if the source was automatically generated
1387 -- and compiled. Using >= is slightly unsafe, but it matches
1388 -- make's behaviour.
1391 = case lookupUFM hpt (ms_mod_name ms) of
1392 Just hmi | Just l <- hm_linkable hmi ->
1393 not (isObjectLinkable l) &&
1394 linkableTime l >= ms_hs_date ms
1397 -- -----------------------------------------------------------------------------
1399 -- | Prune the HomePackageTable
1401 -- Before doing an upsweep, we can throw away:
1403 -- - For non-stable modules:
1404 -- - all ModDetails, all linked code
1405 -- - all unlinked code that is out of date with respect to
1408 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
1409 -- space at the end of the upsweep, because the topmost ModDetails of the
1410 -- old HPT holds on to the entire type environment from the previous
1413 pruneHomePackageTable
1416 -> ([ModuleName],[ModuleName])
1419 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
1422 | is_stable modl = hmi'
1423 | otherwise = hmi'{ hm_details = emptyModDetails }
1425 modl = moduleName (mi_module (hm_iface hmi))
1426 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
1427 = hmi{ hm_linkable = Nothing }
1430 where ms = expectJust "prune" (lookupUFM ms_map modl)
1432 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
1434 is_stable m = m `elem` stable_obj || m `elem` stable_bco
1436 -- -----------------------------------------------------------------------------
1438 -- Return (names of) all those in modsDone who are part of a cycle
1439 -- as defined by theGraph.
1440 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
1441 findPartiallyCompletedCycles modsDone theGraph
1445 chew ((AcyclicSCC _):rest) = chew rest -- acyclic? not interesting.
1446 chew ((CyclicSCC vs):rest)
1447 = let names_in_this_cycle = nub (map ms_mod vs)
1449 = nub ([done | done <- modsDone,
1450 done `elem` names_in_this_cycle])
1451 chewed_rest = chew rest
1453 if notNull mods_in_this_cycle
1454 && length mods_in_this_cycle < length names_in_this_cycle
1455 then mods_in_this_cycle ++ chewed_rest
1458 -- -----------------------------------------------------------------------------
1462 -- This is where we compile each module in the module graph, in a pass
1463 -- from the bottom to the top of the graph.
1465 -- There better had not be any cyclic groups here -- we check for them.
1469 HscEnv -- ^ Includes initially-empty HPT
1470 -> HomePackageTable -- ^ HPT from last time round (pruned)
1471 -> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability)
1472 -> IO () -- ^ How to clean up unwanted tmp files
1473 -> [SCC ModSummary] -- ^ Mods to do (the worklist)
1479 -- 1. A flag whether the complete upsweep was successful.
1480 -- 2. The 'HscEnv' with an updated HPT
1481 -- 3. A list of modules which succeeded loading.
1483 upsweep hsc_env old_hpt stable_mods cleanup sccs = do
1484 (res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
1485 return (res, hsc_env, reverse done)
1488 upsweep' hsc_env _old_hpt done
1490 = return (Succeeded, hsc_env, done)
1492 upsweep' hsc_env _old_hpt done
1493 (CyclicSCC ms:_) _ _
1494 = do liftIO $ fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
1495 return (Failed, hsc_env, done)
1497 upsweep' hsc_env old_hpt done
1498 (AcyclicSCC mod:mods) mod_index nmods
1499 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1500 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
1501 -- (moduleEnvElts (hsc_HPT hsc_env)))
1502 let logger = reportModuleCompilationResult (hsc_callbacks hsc_env)
1505 <- handleSourceError
1506 (\err -> do logger mod (Just err); return Nothing) $ do
1507 mod_info <- upsweep_mod hsc_env old_hpt stable_mods
1509 logger mod Nothing -- log warnings
1510 return (Just mod_info)
1512 liftIO cleanup -- Remove unwanted tmp files between compilations
1515 Nothing -> return (Failed, hsc_env, done)
1517 let this_mod = ms_mod_name mod
1519 -- Add new info to hsc_env
1520 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
1521 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
1523 -- Space-saving: delete the old HPT entry
1524 -- for mod BUT if mod is a hs-boot
1525 -- node, don't delete it. For the
1526 -- interface, the HPT entry is probaby for the
1527 -- main Haskell source file. Deleting it
1528 -- would force the real module to be recompiled
1530 old_hpt1 | isBootSummary mod = old_hpt
1531 | otherwise = delFromUFM old_hpt this_mod
1535 -- fixup our HomePackageTable after we've finished compiling
1536 -- a mutually-recursive loop. See reTypecheckLoop, below.
1537 hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done'
1539 upsweep' hsc_env2 old_hpt1 done' mods (mod_index+1) nmods
1541 -- | Compile a single module. Always produce a Linkable for it if
1542 -- successful. If no compilation happened, return the old Linkable.
1543 upsweep_mod :: GhcMonad m =>
1546 -> ([ModuleName],[ModuleName])
1548 -> Int -- index of module
1549 -> Int -- total number of modules
1552 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
1554 this_mod_name = ms_mod_name summary
1555 this_mod = ms_mod summary
1556 mb_obj_date = ms_obj_date summary
1557 obj_fn = ml_obj_file (ms_location summary)
1558 hs_date = ms_hs_date summary
1560 is_stable_obj = this_mod_name `elem` stable_obj
1561 is_stable_bco = this_mod_name `elem` stable_bco
1563 old_hmi = lookupUFM old_hpt this_mod_name
1565 -- We're using the dflags for this module now, obtained by
1566 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
1567 dflags = ms_hspp_opts summary
1568 prevailing_target = hscTarget (hsc_dflags hsc_env)
1569 local_target = hscTarget dflags
1571 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
1572 -- we don't do anything dodgy: these should only work to change
1573 -- from -fvia-C to -fasm and vice-versa, otherwise we could
1574 -- end up trying to link object code to byte code.
1575 target = if prevailing_target /= local_target
1576 && (not (isObjectTarget prevailing_target)
1577 || not (isObjectTarget local_target))
1578 then prevailing_target
1581 -- store the corrected hscTarget into the summary
1582 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
1584 -- The old interface is ok if
1585 -- a) we're compiling a source file, and the old HPT
1586 -- entry is for a source file
1587 -- b) we're compiling a hs-boot file
1588 -- Case (b) allows an hs-boot file to get the interface of its
1589 -- real source file on the second iteration of the compilation
1590 -- manager, but that does no harm. Otherwise the hs-boot file
1591 -- will always be recompiled
1596 Just hm_info | isBootSummary summary -> Just iface
1597 | not (mi_boot iface) -> Just iface
1598 | otherwise -> Nothing
1600 iface = hm_iface hm_info
1602 compile_it :: GhcMonad m => Maybe Linkable -> m HomeModInfo
1603 compile_it = compile hsc_env summary' mod_index nmods mb_old_iface
1605 compile_it_discard_iface :: GhcMonad m =>
1606 Maybe Linkable -> m HomeModInfo
1607 compile_it_discard_iface
1608 = compile hsc_env summary' mod_index nmods Nothing
1610 -- With the HscNothing target we create empty linkables to avoid
1611 -- recompilation. We have to detect these to recompile anyway if
1612 -- the target changed since the last compile.
1614 | Just hmi <- old_hmi, Just l <- hm_linkable hmi =
1615 null (linkableUnlinked l)
1617 -- we have no linkable, so it cannot be fake
1620 implies False _ = True
1626 -- Regardless of whether we're generating object code or
1627 -- byte code, we can always use an existing object file
1628 -- if it is *stable* (see checkStability).
1629 | is_stable_obj, Just hmi <- old_hmi -> do
1630 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1631 (text "skipping stable obj mod:" <+> ppr this_mod_name)
1633 -- object is stable, and we have an entry in the
1634 -- old HPT: nothing to do
1636 | is_stable_obj, isNothing old_hmi -> do
1637 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1638 (text "compiling stable on-disk mod:" <+> ppr this_mod_name)
1639 linkable <- liftIO $ findObjectLinkable this_mod obj_fn
1640 (expectJust "upsweep1" mb_obj_date)
1641 compile_it (Just linkable)
1642 -- object is stable, but we need to load the interface
1643 -- off disk to make a HMI.
1645 | not (isObjectTarget target), is_stable_bco,
1646 (target /= HscNothing) `implies` not is_fake_linkable ->
1647 ASSERT(isJust old_hmi) -- must be in the old_hpt
1648 let Just hmi = old_hmi in do
1649 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1650 (text "skipping stable BCO mod:" <+> ppr this_mod_name)
1652 -- BCO is stable: nothing to do
1654 | not (isObjectTarget target),
1655 Just hmi <- old_hmi,
1656 Just l <- hm_linkable hmi,
1657 not (isObjectLinkable l),
1658 (target /= HscNothing) `implies` not is_fake_linkable,
1659 linkableTime l >= ms_hs_date summary -> do
1660 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1661 (text "compiling non-stable BCO mod:" <+> ppr this_mod_name)
1663 -- we have an old BCO that is up to date with respect
1664 -- to the source: do a recompilation check as normal.
1666 -- When generating object code, if there's an up-to-date
1667 -- object file on the disk, then we can use it.
1668 -- However, if the object file is new (compared to any
1669 -- linkable we had from a previous compilation), then we
1670 -- must discard any in-memory interface, because this
1671 -- means the user has compiled the source file
1672 -- separately and generated a new interface, that we must
1673 -- read from the disk.
1675 | isObjectTarget target,
1676 Just obj_date <- mb_obj_date,
1677 obj_date >= hs_date -> do
1680 | Just l <- hm_linkable hmi,
1681 isObjectLinkable l && linkableTime l == obj_date -> do
1682 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1683 (text "compiling mod with new on-disk obj:" <+> ppr this_mod_name)
1686 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1687 (text "compiling mod with new on-disk obj2:" <+> ppr this_mod_name)
1688 linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date
1689 compile_it_discard_iface (Just linkable)
1692 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1693 (text "compiling mod:" <+> ppr this_mod_name)
1698 -- Filter modules in the HPT
1699 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
1700 retainInTopLevelEnvs keep_these hpt
1701 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
1703 , let mb_mod_info = lookupUFM hpt mod
1704 , isJust mb_mod_info ]
1706 -- ---------------------------------------------------------------------------
1707 -- Typecheck module loops
1710 See bug #930. This code fixes a long-standing bug in --make. The
1711 problem is that when compiling the modules *inside* a loop, a data
1712 type that is only defined at the top of the loop looks opaque; but
1713 after the loop is done, the structure of the data type becomes
1716 The difficulty is then that two different bits of code have
1717 different notions of what the data type looks like.
1719 The idea is that after we compile a module which also has an .hs-boot
1720 file, we re-generate the ModDetails for each of the modules that
1721 depends on the .hs-boot file, so that everyone points to the proper
1722 TyCons, Ids etc. defined by the real module, not the boot module.
1723 Fortunately re-generating a ModDetails from a ModIface is easy: the
1724 function TcIface.typecheckIface does exactly that.
1726 Picking the modules to re-typecheck is slightly tricky. Starting from
1727 the module graph consisting of the modules that have already been
1728 compiled, we reverse the edges (so they point from the imported module
1729 to the importing module), and depth-first-search from the .hs-boot
1730 node. This gives us all the modules that depend transitively on the
1731 .hs-boot module, and those are exactly the modules that we need to
1734 Following this fix, GHC can compile itself with --make -O2.
1737 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
1738 reTypecheckLoop hsc_env ms graph
1739 | not (isBootSummary ms) &&
1740 any (\m -> ms_mod m == this_mod && isBootSummary m) graph
1742 let mss = reachableBackwards (ms_mod_name ms) graph
1743 non_boot = filter (not.isBootSummary) mss
1744 debugTraceMsg (hsc_dflags hsc_env) 2 $
1745 text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
1746 typecheckLoop hsc_env (map ms_mod_name non_boot)
1750 this_mod = ms_mod ms
1752 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
1753 typecheckLoop hsc_env mods = do
1755 fixIO $ \new_hpt -> do
1756 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
1757 mds <- initIfaceCheck new_hsc_env $
1758 mapM (typecheckIface . hm_iface) hmis
1759 let new_hpt = addListToUFM old_hpt
1760 (zip mods [ hmi{ hm_details = details }
1761 | (hmi,details) <- zip hmis mds ])
1763 return hsc_env{ hsc_HPT = new_hpt }
1765 old_hpt = hsc_HPT hsc_env
1766 hmis = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
1768 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
1769 reachableBackwards mod summaries
1770 = [ ms | (ms,_,_) <- reachableG (transposeG graph) root ]
1771 where -- the rest just sets up the graph:
1772 (graph, lookup_node) = moduleGraphNodes False summaries
1773 root = expectJust "reachableBackwards" (lookup_node HsBootFile mod)
1775 -- ---------------------------------------------------------------------------
1776 -- Topological sort of the module graph
1778 type SummaryNode = (ModSummary, Int, [Int])
1782 -- ^ Drop hi-boot nodes? (see below)
1785 -- ^ Root module name. If @Nothing@, use the full graph.
1787 -- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1788 -- The resulting list of strongly-connected-components is in topologically
1789 -- sorted order, starting with the module(s) at the bottom of the
1790 -- dependency graph (ie compile them first) and ending with the ones at
1793 -- Drop hi-boot nodes (first boolean arg)?
1795 -- - @False@: treat the hi-boot summaries as nodes of the graph,
1796 -- so the graph must be acyclic
1798 -- - @True@: eliminate the hi-boot nodes, and instead pretend
1799 -- the a source-import of Foo is an import of Foo
1800 -- The resulting graph has no hi-boot nodes, but can be cyclic
1802 topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
1803 = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph
1805 (graph, lookup_node) = moduleGraphNodes drop_hs_boot_nodes summaries
1807 initial_graph = case mb_root_mod of
1810 -- restrict the graph to just those modules reachable from
1811 -- the specified module. We do this by building a graph with
1812 -- the full set of nodes, and determining the reachable set from
1813 -- the specified node.
1814 let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
1815 | otherwise = ghcError (ProgramError "module does not exist")
1816 in graphFromEdgedVertices (seq root (reachableG graph root))
1818 summaryNodeKey :: SummaryNode -> Int
1819 summaryNodeKey (_, k, _) = k
1821 summaryNodeSummary :: SummaryNode -> ModSummary
1822 summaryNodeSummary (s, _, _) = s
1824 moduleGraphNodes :: Bool -> [ModSummary]
1825 -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
1826 moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)
1828 numbered_summaries = zip summaries [1..]
1830 lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode
1831 lookup_node hs_src mod = lookupFM node_map (mod, hs_src)
1833 lookup_key :: HscSource -> ModuleName -> Maybe Int
1834 lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)
1836 node_map :: NodeMap SummaryNode
1837 node_map = listToFM [ ((moduleName (ms_mod s), ms_hsc_src s), node)
1838 | node@(s, _, _) <- nodes ]
1840 -- We use integers as the keys for the SCC algorithm
1841 nodes :: [SummaryNode]
1842 nodes = [ (s, key, out_keys)
1843 | (s, key) <- numbered_summaries
1844 -- Drop the hi-boot ones if told to do so
1845 , not (isBootSummary s && drop_hs_boot_nodes)
1846 , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
1847 out_edge_keys HsSrcFile (map unLoc (ms_home_imps s)) ++
1848 (-- see [boot-edges] below
1849 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
1851 else case lookup_key HsBootFile (ms_mod_name s) of
1855 -- [boot-edges] if this is a .hs and there is an equivalent
1856 -- .hs-boot, add a link from the former to the latter. This
1857 -- has the effect of detecting bogus cases where the .hs-boot
1858 -- depends on the .hs, by introducing a cycle. Additionally,
1859 -- it ensures that we will always process the .hs-boot before
1860 -- the .hs, and so the HomePackageTable will always have the
1861 -- most up to date information.
1863 -- Drop hs-boot nodes by using HsSrcFile as the key
1864 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1865 | otherwise = HsBootFile
1867 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1868 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1869 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1870 -- the IsBootInterface parameter True; else False
1873 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
1874 type NodeMap a = FiniteMap NodeKey a -- keyed by (mod, src_file_type) pairs
1876 msKey :: ModSummary -> NodeKey
1877 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1879 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1880 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
1882 nodeMapElts :: NodeMap a -> [a]
1883 nodeMapElts = eltsFM
1885 -- | If there are {-# SOURCE #-} imports between strongly connected
1886 -- components in the topological sort, then those imports can
1887 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1888 -- were necessary, then the edge would be part of a cycle.
1889 warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()
1890 warnUnnecessarySourceImports sccs =
1891 logWarnings (listToBag (concatMap (check.flattenSCC) sccs))
1893 let mods_in_this_cycle = map ms_mod_name ms in
1894 [ warn i | m <- ms, i <- ms_home_srcimps m,
1895 unLoc i `notElem` mods_in_this_cycle ]
1897 warn :: Located ModuleName -> WarnMsg
1900 (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
1901 <+> quotes (ppr mod))
1903 -----------------------------------------------------------------------------
1904 -- Downsweep (dependency analysis)
1906 -- Chase downwards from the specified root set, returning summaries
1907 -- for all home modules encountered. Only follow source-import
1910 -- We pass in the previous collection of summaries, which is used as a
1911 -- cache to avoid recalculating a module summary if the source is
1914 -- The returned list of [ModSummary] nodes has one node for each home-package
1915 -- module, plus one for any hs-boot files. The imports of these nodes
1916 -- are all there, including the imports of non-home-package modules.
1918 downsweep :: GhcMonad m =>
1920 -> [ModSummary] -- Old summaries
1921 -> [ModuleName] -- Ignore dependencies on these; treat
1922 -- them as if they were package modules
1923 -> Bool -- True <=> allow multiple targets to have
1924 -- the same module name; this is
1925 -- very useful for ghc -M
1927 -- The elts of [ModSummary] all have distinct
1928 -- (Modules, IsBoot) identifiers, unless the Bool is true
1929 -- in which case there can be repeats
1930 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1931 = do -- catch error messages and return them
1932 --handleErrMsg -- should be covered by GhcMonad now
1933 -- (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
1934 rootSummaries <- mapM getRootSummary roots
1935 let root_map = mkRootMap rootSummaries
1936 checkDuplicates root_map
1937 summs <- loop (concatMap msDeps rootSummaries) root_map
1940 roots = hsc_targets hsc_env
1942 old_summary_map :: NodeMap ModSummary
1943 old_summary_map = mkNodeMap old_summaries
1945 getRootSummary :: GhcMonad m => Target -> m ModSummary
1946 getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)
1947 = do exists <- liftIO $ doesFileExist file
1949 then summariseFile hsc_env old_summaries file mb_phase
1950 obj_allowed maybe_buf
1951 else throwOneError $ mkPlainErrMsg noSrcSpan $
1952 text "can't find file:" <+> text file
1953 getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
1954 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1955 (L rootLoc modl) obj_allowed
1957 case maybe_summary of
1958 Nothing -> packageModErr modl
1961 rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1963 -- In a root module, the filename is allowed to diverge from the module
1964 -- name, so we have to check that there aren't multiple root files
1965 -- defining the same module (otherwise the duplicates will be silently
1966 -- ignored, leading to confusing behaviour).
1967 checkDuplicates :: GhcMonad m => NodeMap [ModSummary] -> m ()
1968 checkDuplicates root_map
1969 | allow_dup_roots = return ()
1970 | null dup_roots = return ()
1971 | otherwise = liftIO $ multiRootsErr (head dup_roots)
1973 dup_roots :: [[ModSummary]] -- Each at least of length 2
1974 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1976 loop :: GhcMonad m =>
1977 [(Located ModuleName,IsBootInterface)]
1978 -- Work list: process these modules
1979 -> NodeMap [ModSummary]
1980 -- Visited set; the range is a list because
1981 -- the roots can have the same module names
1982 -- if allow_dup_roots is True
1984 -- The result includes the worklist, except
1985 -- for those mentioned in the visited set
1986 loop [] done = return (concat (nodeMapElts done))
1987 loop ((wanted_mod, is_boot) : ss) done
1988 | Just summs <- lookupFM done key
1989 = if isSingleton summs then
1992 do { liftIO $ multiRootsErr summs; return [] }
1994 = do mb_s <- summariseModule hsc_env old_summary_map
1995 is_boot wanted_mod True
1998 Nothing -> loop ss done
1999 Just s -> loop (msDeps s ++ ss) (addToFM done key [s])
2001 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
2003 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
2004 mkRootMap summaries = addListToFM_C (++) emptyFM
2005 [ (msKey s, [s]) | s <- summaries ]
2007 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
2008 -- (msDeps s) returns the dependencies of the ModSummary s.
2009 -- A wrinkle is that for a {-# SOURCE #-} import we return
2010 -- *both* the hs-boot file
2011 -- *and* the source file
2012 -- as "dependencies". That ensures that the list of all relevant
2013 -- modules always contains B.hs if it contains B.hs-boot.
2014 -- Remember, this pass isn't doing the topological sort. It's
2015 -- just gathering the list of all relevant ModSummaries
2017 concat [ [(m,True), (m,False)] | m <- ms_home_srcimps s ]
2018 ++ [ (m,False) | m <- ms_home_imps s ]
2020 home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
2021 home_imps imps = [ ideclName i | L _ i <- imps, isNothing (ideclPkgQual i) ]
2023 ms_home_allimps :: ModSummary -> [ModuleName]
2024 ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
2026 ms_home_srcimps :: ModSummary -> [Located ModuleName]
2027 ms_home_srcimps = home_imps . ms_srcimps
2029 ms_home_imps :: ModSummary -> [Located ModuleName]
2030 ms_home_imps = home_imps . ms_imps
2032 -----------------------------------------------------------------------------
2033 -- Summarising modules
2035 -- We have two types of summarisation:
2037 -- * Summarise a file. This is used for the root module(s) passed to
2038 -- cmLoadModules. The file is read, and used to determine the root
2039 -- module name. The module name may differ from the filename.
2041 -- * Summarise a module. We are given a module name, and must provide
2042 -- a summary. The finder is used to locate the file in which the module
2048 -> [ModSummary] -- old summaries
2049 -> FilePath -- source file name
2050 -> Maybe Phase -- start phase
2051 -> Bool -- object code allowed?
2052 -> Maybe (StringBuffer,ClockTime)
2055 summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
2056 -- we can use a cached summary if one is available and the
2057 -- source file hasn't changed, But we have to look up the summary
2058 -- by source file, rather than module name as we do in summarise.
2059 | Just old_summary <- findSummaryBySourceFile old_summaries file
2061 let location = ms_location old_summary
2063 -- return the cached summary if the source didn't change
2064 src_timestamp <- case maybe_buf of
2065 Just (_,t) -> return t
2066 Nothing -> liftIO $ getModificationTime file
2067 -- The file exists; we checked in getRootSummary above.
2068 -- If it gets removed subsequently, then this
2069 -- getModificationTime may fail, but that's the right
2072 if ms_hs_date old_summary == src_timestamp
2073 then do -- update the object-file timestamp
2075 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2076 || obj_allowed -- bug #1205
2077 then liftIO $ getObjTimestamp location False
2079 return old_summary{ ms_obj_date = obj_timestamp }
2087 let dflags = hsc_dflags hsc_env
2089 (dflags', hspp_fn, buf)
2090 <- preprocessFile hsc_env file mb_phase maybe_buf
2092 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
2094 -- Make a ModLocation for this file
2095 location <- liftIO $ mkHomeModLocation dflags mod_name file
2097 -- Tell the Finder cache where it is, so that subsequent calls
2098 -- to findModule will find it, even if it's not on any search path
2099 mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location
2101 src_timestamp <- case maybe_buf of
2102 Just (_,t) -> return t
2103 Nothing -> liftIO $ getModificationTime file
2104 -- getMofificationTime may fail
2106 -- when the user asks to load a source file by name, we only
2107 -- use an object file if -fobject-code is on. See #1205.
2109 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2110 || obj_allowed -- bug #1205
2111 then liftIO $ modificationTimeIfExists (ml_obj_file location)
2114 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
2115 ms_location = location,
2116 ms_hspp_file = hspp_fn,
2117 ms_hspp_opts = dflags',
2118 ms_hspp_buf = Just buf,
2119 ms_srcimps = srcimps, ms_imps = the_imps,
2120 ms_hs_date = src_timestamp,
2121 ms_obj_date = obj_timestamp })
2123 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
2124 findSummaryBySourceFile summaries file
2125 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
2126 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
2130 -- Summarise a module, and pick up source and timestamp.
2134 -> NodeMap ModSummary -- Map of old summaries
2135 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
2136 -> Located ModuleName -- Imported module to be summarised
2137 -> Bool -- object code allowed?
2138 -> Maybe (StringBuffer, ClockTime)
2139 -> [ModuleName] -- Modules to exclude
2140 -> m (Maybe ModSummary) -- Its new summary
2142 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
2143 obj_allowed maybe_buf excl_mods
2144 | wanted_mod `elem` excl_mods
2147 | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
2148 = do -- Find its new timestamp; all the
2149 -- ModSummaries in the old map have valid ml_hs_files
2150 let location = ms_location old_summary
2151 src_fn = expectJust "summariseModule" (ml_hs_file location)
2153 -- check the modification time on the source file, and
2154 -- return the cached summary if it hasn't changed. If the
2155 -- file has disappeared, we need to call the Finder again.
2157 Just (_,t) -> check_timestamp old_summary location src_fn t
2159 m <- liftIO $ System.IO.Error.try (getModificationTime src_fn)
2161 Right t -> check_timestamp old_summary location src_fn t
2162 Left e | isDoesNotExistError e -> find_it
2163 | otherwise -> liftIO $ ioError e
2165 | otherwise = find_it
2167 dflags = hsc_dflags hsc_env
2169 hsc_src = if is_boot then HsBootFile else HsSrcFile
2171 check_timestamp old_summary location src_fn src_timestamp
2172 | ms_hs_date old_summary == src_timestamp = do
2173 -- update the object-file timestamp
2174 obj_timestamp <- liftIO $
2175 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2176 || obj_allowed -- bug #1205
2177 then getObjTimestamp location is_boot
2179 return (Just old_summary{ ms_obj_date = obj_timestamp })
2181 -- source changed: re-summarise.
2182 new_summary location (ms_mod old_summary) src_fn src_timestamp
2185 -- Don't use the Finder's cache this time. If the module was
2186 -- previously a package module, it may have now appeared on the
2187 -- search path, so we want to consider it to be a home module. If
2188 -- the module was previously a home module, it may have moved.
2189 liftIO $ uncacheModule hsc_env wanted_mod
2190 found <- liftIO $ findImportedModule hsc_env wanted_mod Nothing
2193 | isJust (ml_hs_file location) ->
2195 just_found location mod
2197 -- Drop external-pkg
2198 ASSERT(modulePackageId mod /= thisPackage dflags)
2201 err -> liftIO $ noModError dflags loc wanted_mod err
2204 just_found location mod = do
2205 -- Adjust location to point to the hs-boot source file,
2206 -- hi file, object file, when is_boot says so
2207 let location' | is_boot = addBootSuffixLocn location
2208 | otherwise = location
2209 src_fn = expectJust "summarise2" (ml_hs_file location')
2211 -- Check that it exists
2212 -- It might have been deleted since the Finder last found it
2213 maybe_t <- liftIO $ modificationTimeIfExists src_fn
2215 Nothing -> noHsFileErr loc src_fn
2216 Just t -> new_summary location' mod src_fn t
2219 new_summary location mod src_fn src_timestamp
2221 -- Preprocess the source file and get its imports
2222 -- The dflags' contains the OPTIONS pragmas
2223 (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
2224 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
2226 when (mod_name /= wanted_mod) $
2227 throwOneError $ mkPlainErrMsg mod_loc $
2228 text "File name does not match module name:"
2229 $$ text "Saw:" <+> quotes (ppr mod_name)
2230 $$ text "Expected:" <+> quotes (ppr wanted_mod)
2232 -- Find the object timestamp, and return the summary
2233 obj_timestamp <- liftIO $
2234 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2235 || obj_allowed -- bug #1205
2236 then getObjTimestamp location is_boot
2239 return (Just (ModSummary { ms_mod = mod,
2240 ms_hsc_src = hsc_src,
2241 ms_location = location,
2242 ms_hspp_file = hspp_fn,
2243 ms_hspp_opts = dflags',
2244 ms_hspp_buf = Just buf,
2245 ms_srcimps = srcimps,
2247 ms_hs_date = src_timestamp,
2248 ms_obj_date = obj_timestamp }))
2251 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
2252 getObjTimestamp location is_boot
2253 = if is_boot then return Nothing
2254 else modificationTimeIfExists (ml_obj_file location)
2257 preprocessFile :: GhcMonad m =>
2260 -> Maybe Phase -- ^ Starting phase
2261 -> Maybe (StringBuffer,ClockTime)
2262 -> m (DynFlags, FilePath, StringBuffer)
2263 preprocessFile hsc_env src_fn mb_phase Nothing
2265 (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
2266 buf <- liftIO $ hGetStringBuffer hspp_fn
2267 return (dflags', hspp_fn, buf)
2269 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
2271 let dflags = hsc_dflags hsc_env
2272 -- case we bypass the preprocessing stage?
2274 local_opts = getOptions dflags buf src_fn
2276 (dflags', leftovers, warns)
2277 <- parseDynamicNoPackageFlags dflags local_opts
2278 checkProcessArgsResult leftovers
2279 handleFlagWarnings dflags' warns
2283 | Just (Unlit _) <- mb_phase = True
2284 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
2285 -- note: local_opts is only required if there's no Unlit phase
2286 | dopt Opt_Cpp dflags' = True
2287 | dopt Opt_Pp dflags' = True
2290 when needs_preprocessing $
2291 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
2293 return (dflags', src_fn, buf)
2296 -----------------------------------------------------------------------------
2298 -----------------------------------------------------------------------------
2300 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
2301 -- ToDo: we don't have a proper line number for this error
2302 noModError dflags loc wanted_mod err
2303 = throwOneError $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
2305 noHsFileErr :: GhcMonad m => SrcSpan -> String -> m a
2306 noHsFileErr loc path
2307 = throwOneError $ mkPlainErrMsg loc $ text "Can't find" <+> text path
2309 packageModErr :: GhcMonad m => ModuleName -> m a
2311 = throwOneError $ mkPlainErrMsg noSrcSpan $
2312 text "module" <+> quotes (ppr mod) <+> text "is a package module"
2314 multiRootsErr :: [ModSummary] -> IO ()
2315 multiRootsErr [] = panic "multiRootsErr"
2316 multiRootsErr summs@(summ1:_)
2317 = throwOneError $ mkPlainErrMsg noSrcSpan $
2318 text "module" <+> quotes (ppr mod) <+>
2319 text "is defined in multiple files:" <+>
2320 sep (map text files)
2323 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
2325 cyclicModuleErr :: [ModSummary] -> SDoc
2327 = hang (ptext (sLit "Module imports form a cycle for modules:"))
2328 2 (vcat (map show_one ms))
2330 show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
2331 nest 2 $ ptext (sLit "imports:") <+>
2332 (pp_imps HsBootFile (ms_srcimps ms)
2333 $$ pp_imps HsSrcFile (ms_imps ms))]
2334 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
2335 pp_imps src mods = fsep (map (show_mod src) mods)
2338 -- | Inform GHC that the working directory has changed. GHC will flush
2339 -- its cache of module locations, since it may no longer be valid.
2340 -- Note: if you change the working directory, you should also unload
2341 -- the current program (set targets to empty, followed by load).
2342 workingDirectoryChanged :: GhcMonad m => m ()
2343 workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)
2345 -- -----------------------------------------------------------------------------
2346 -- inspecting the session
2348 -- | Get the module dependency graph.
2349 getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
2350 getModuleGraph = liftM hsc_mod_graph getSession
2352 -- | Return @True@ <==> module is loaded.
2353 isLoaded :: GhcMonad m => ModuleName -> m Bool
2354 isLoaded m = withSession $ \hsc_env ->
2355 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
2357 -- | Return the bindings for the current interactive session.
2358 getBindings :: GhcMonad m => m [TyThing]
2359 getBindings = withSession $ \hsc_env ->
2360 -- we have to implement the shadowing behaviour of ic_tmp_ids here
2361 -- (see InteractiveContext) and the quickest way is to use an OccEnv.
2363 tmp_ids = ic_tmp_ids (hsc_IC hsc_env)
2364 filtered = foldr f (const []) tmp_ids emptyUniqSet
2366 | uniq `elementOfUniqSet` set = rest set
2367 | otherwise = AnId id : rest (addOneToUniqSet set uniq)
2368 where uniq = getUnique (nameOccName (idName id))
2372 getPrintUnqual :: GhcMonad m => m PrintUnqualified
2373 getPrintUnqual = withSession $ \hsc_env ->
2374 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
2376 -- | Container for information about a 'Module'.
2377 data ModuleInfo = ModuleInfo {
2378 minf_type_env :: TypeEnv,
2379 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
2380 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
2381 minf_instances :: [Instance]
2383 ,minf_modBreaks :: ModBreaks
2385 -- ToDo: this should really contain the ModIface too
2387 -- We don't want HomeModInfo here, because a ModuleInfo applies
2388 -- to package modules too.
2390 -- | Request information about a loaded 'Module'
2391 getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X
2392 getModuleInfo mdl = withSession $ \hsc_env -> do
2393 let mg = hsc_mod_graph hsc_env
2394 if mdl `elem` map ms_mod mg
2395 then liftIO $ getHomeModuleInfo hsc_env (moduleName mdl)
2397 {- if isHomeModule (hsc_dflags hsc_env) mdl
2399 else -} liftIO $ getPackageModuleInfo hsc_env mdl
2400 -- getPackageModuleInfo will attempt to find the interface, so
2401 -- we don't want to call it for a home module, just in case there
2402 -- was a problem loading the module and the interface doesn't
2403 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
2405 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
2407 getPackageModuleInfo hsc_env mdl = do
2408 (_msgs, mb_avails) <- getModuleExports hsc_env mdl
2410 Nothing -> return Nothing
2412 eps <- readIORef (hsc_EPS hsc_env)
2414 names = availsToNameSet avails
2416 tys = [ ty | name <- concatMap availNames avails,
2417 Just ty <- [lookupTypeEnv pte name] ]
2419 return (Just (ModuleInfo {
2420 minf_type_env = mkTypeEnv tys,
2421 minf_exports = names,
2422 minf_rdr_env = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
2423 minf_instances = error "getModuleInfo: instances for package module unimplemented",
2424 minf_modBreaks = emptyModBreaks
2427 getPackageModuleInfo _hsc_env _mdl = do
2428 -- bogusly different for non-GHCI (ToDo)
2432 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
2433 getHomeModuleInfo hsc_env mdl =
2434 case lookupUFM (hsc_HPT hsc_env) mdl of
2435 Nothing -> return Nothing
2437 let details = hm_details hmi
2438 return (Just (ModuleInfo {
2439 minf_type_env = md_types details,
2440 minf_exports = availsToNameSet (md_exports details),
2441 minf_rdr_env = mi_globals $! hm_iface hmi,
2442 minf_instances = md_insts details
2444 ,minf_modBreaks = getModBreaks hmi
2448 -- | The list of top-level entities defined in a module
2449 modInfoTyThings :: ModuleInfo -> [TyThing]
2450 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
2452 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
2453 modInfoTopLevelScope minf
2454 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
2456 modInfoExports :: ModuleInfo -> [Name]
2457 modInfoExports minf = nameSetToList $! minf_exports minf
2459 -- | Returns the instances defined by the specified module.
2460 -- Warning: currently unimplemented for package modules.
2461 modInfoInstances :: ModuleInfo -> [Instance]
2462 modInfoInstances = minf_instances
2464 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
2465 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
2467 mkPrintUnqualifiedForModule :: GhcMonad m =>
2469 -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X
2470 mkPrintUnqualifiedForModule minf = withSession $ \hsc_env -> do
2471 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
2473 modInfoLookupName :: GhcMonad m =>
2475 -> m (Maybe TyThing) -- XXX: returns a Maybe X
2476 modInfoLookupName minf name = withSession $ \hsc_env -> do
2477 case lookupTypeEnv (minf_type_env minf) name of
2478 Just tyThing -> return (Just tyThing)
2480 eps <- liftIO $ readIORef (hsc_EPS hsc_env)
2481 return $! lookupType (hsc_dflags hsc_env)
2482 (hsc_HPT hsc_env) (eps_PTE eps) name
2485 modInfoModBreaks :: ModuleInfo -> ModBreaks
2486 modInfoModBreaks = minf_modBreaks
2489 isDictonaryId :: Id -> Bool
2491 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
2493 -- | Looks up a global name: that is, any top-level name in any
2494 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
2495 -- the interactive context, and therefore does not require a preceding
2497 lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
2498 lookupGlobalName name = withSession $ \hsc_env -> do
2499 liftIO $ lookupTypeHscEnv hsc_env name
2501 findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
2502 findGlobalAnns deserialize target = withSession $ \hsc_env -> do
2503 ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
2504 return (findAnns deserialize ann_env target)
2507 -- | get the GlobalRdrEnv for a session
2508 getGRE :: GhcMonad m => m GlobalRdrEnv
2509 getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
2512 -- -----------------------------------------------------------------------------
2514 -- | Return all /external/ modules available in the package database.
2515 -- Modules from the current session (i.e., from the 'HomePackageTable') are
2517 packageDbModules :: GhcMonad m =>
2518 Bool -- ^ Only consider exposed packages.
2520 packageDbModules only_exposed = do
2521 dflags <- getSessionDynFlags
2522 let pkgs = UFM.eltsUFM (pkgIdMap (pkgState dflags))
2524 [ mkModule pid modname | p <- pkgs
2525 , not only_exposed || exposed p
2526 , pid <- [mkPackageId (package p)]
2527 , modname <- exposedModules p ]
2529 -- -----------------------------------------------------------------------------
2530 -- Misc exported utils
2532 dataConType :: DataCon -> Type
2533 dataConType dc = idType (dataConWrapId dc)
2535 -- | print a 'NamedThing', adding parentheses if the name is an operator.
2536 pprParenSymName :: NamedThing a => a -> SDoc
2537 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
2539 -- ----------------------------------------------------------------------------
2544 -- - Data and Typeable instances for HsSyn.
2546 -- ToDo: check for small transformations that happen to the syntax in
2547 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
2549 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
2550 -- to get from TyCons, Ids etc. to TH syntax (reify).
2552 -- :browse will use either lm_toplev or inspect lm_interface, depending
2553 -- on whether the module is interpreted or not.
2557 -- Extract the filename, stringbuffer content and dynflags associed to a module
2559 -- XXX: Explain pre-conditions
2560 getModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynFlags)
2561 getModuleSourceAndFlags mod = do
2562 m <- getModSummary (moduleName mod)
2563 case ml_hs_file $ ms_location m of
2564 Nothing -> throw $ mkApiErr (text "No source available for module " <+> ppr mod)
2565 Just sourceFile -> do
2566 source <- liftIO $ hGetStringBuffer sourceFile
2567 return (sourceFile, source, ms_hspp_opts m)
2570 -- | Return module source as token stream, including comments.
2572 -- The module must be in the module graph and its source must be available.
2573 -- Throws a 'HscTypes.SourceError' on parse error.
2574 getTokenStream :: GhcMonad m => Module -> m [Located Token]
2575 getTokenStream mod = do
2576 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
2577 let startLoc = mkSrcLoc (mkFastString sourceFile) 0 0
2578 case lexTokenStream source startLoc flags of
2579 POk _ ts -> return ts
2580 PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
2582 -- | Give even more information on the source than 'getTokenStream'
2583 -- This function allows reconstructing the source completely with
2584 -- 'showRichTokenStream'.
2585 getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
2586 getRichTokenStream mod = do
2587 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
2588 let startLoc = mkSrcLoc (mkFastString sourceFile) 0 0
2589 case lexTokenStream source startLoc flags of
2590 POk _ ts -> return $ addSourceToTokens startLoc source ts
2591 PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
2593 -- | Given a source location and a StringBuffer corresponding to this
2594 -- location, return a rich token stream with the source associated to the
2596 addSourceToTokens :: SrcLoc -> StringBuffer -> [Located Token]
2597 -> [(Located Token, String)]
2598 addSourceToTokens _ _ [] = []
2599 addSourceToTokens loc buf (t@(L span _) : ts)
2600 | not (isGoodSrcSpan span) = (t,"") : addSourceToTokens loc buf ts
2601 | otherwise = (t,str) : addSourceToTokens newLoc newBuf ts
2603 (newLoc, newBuf, str) = go "" loc buf
2604 start = srcSpanStart span
2605 end = srcSpanEnd span
2606 go acc loc buf | loc < start = go acc nLoc nBuf
2607 | start <= loc && loc < end = go (ch:acc) nLoc nBuf
2608 | otherwise = (loc, buf, reverse acc)
2609 where (ch, nBuf) = nextChar buf
2610 nLoc = advanceSrcLoc loc ch
2613 -- | Take a rich token stream such as produced from 'getRichTokenStream' and
2614 -- return source code almost identical to the original code (except for
2615 -- insignificant whitespace.)
2616 showRichTokenStream :: [(Located Token, String)] -> String
2617 showRichTokenStream ts = go startLoc ts ""
2618 where sourceFile = srcSpanFile (getLoc . fst . head $ ts)
2619 startLoc = mkSrcLoc sourceFile 0 0
2621 go loc ((L span _, str):ts)
2622 | not (isGoodSrcSpan span) = go loc ts
2623 | locLine == tokLine = ((replicate (tokCol - locCol) ' ') ++)
2626 | otherwise = ((replicate (tokLine - locLine) '\n') ++)
2627 . ((replicate tokCol ' ') ++)
2630 where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
2631 (tokLine, tokCol) = (srcSpanStartLine span, srcSpanStartCol span)
2632 tokEnd = srcSpanEnd span
2634 -- -----------------------------------------------------------------------------
2635 -- Interactive evaluation
2637 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
2638 -- filesystem and package database to find the corresponding 'Module',
2639 -- using the algorithm that is used for an @import@ declaration.
2640 findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
2641 findModule mod_name maybe_pkg = withSession $ \hsc_env -> liftIO $ -- XXX
2643 dflags = hsc_dflags hsc_env
2644 hpt = hsc_HPT hsc_env
2645 this_pkg = thisPackage dflags
2647 case lookupUFM hpt mod_name of
2648 Just mod_info -> return (mi_module (hm_iface mod_info))
2649 _not_a_home_module -> do
2650 res <- findImportedModule hsc_env mod_name maybe_pkg
2652 Found _ m | modulePackageId m /= this_pkg -> return m
2653 | otherwise -> ghcError (CmdLineError (showSDoc $
2654 text "module" <+> quotes (ppr (moduleName m)) <+>
2655 text "is not loaded"))
2656 err -> let msg = cannotFindModule dflags mod_name err in
2657 ghcError (CmdLineError (showSDoc msg))
2660 getHistorySpan :: GhcMonad m => History -> m SrcSpan
2661 getHistorySpan h = withSession $ \hsc_env ->
2662 return$ InteractiveEval.getHistorySpan hsc_env h
2664 obtainTermFromVal :: GhcMonad m => Int -> Bool -> Type -> a -> m Term
2665 obtainTermFromVal bound force ty a =
2666 withSession $ \hsc_env ->
2667 liftIO $ InteractiveEval.obtainTermFromVal hsc_env bound force ty a
2669 obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
2670 obtainTermFromId bound force id =
2671 withSession $ \hsc_env ->
2672 liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id