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(..),
23 -- * Flags and settings
24 DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
25 GhcMode(..), GhcLink(..), defaultObjectTarget,
32 Target(..), TargetId(..), Phase,
39 -- * Extending the program scope
42 extendGlobalTypeScope,
45 -- * Loading\/compiling the program
47 load, loadWithLogger, LoadHowMuch(..),
48 SuccessFlag(..), succeeded, failed,
49 defaultWarnErrLogger, WarnErrLogger,
50 workingDirectoryChanged,
51 parseModule, typecheckModule, desugarModule, loadModule,
52 ParsedModule(..), TypecheckedModule(..), DesugaredModule(..),
53 TypecheckedSource, ParsedSource, RenamedSource, -- ditto
54 TypecheckedMod, ParsedMod,
55 moduleInfo, renamedSource, typecheckedSource,
56 parsedSource, coreModule,
57 compileToCoreModule, compileToCoreSimplified,
61 -- * Parsing Haddock comments
64 -- * Inspecting the module structure of the program
65 ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
70 -- * Inspecting modules
77 modInfoIsExportedName,
81 mkPrintUnqualifiedForModule,
83 -- * Querying the environment
87 PrintUnqualified, alwaysQualify,
89 -- * Interactive evaluation
90 getBindings, getPrintUnqual,
94 setContext, getContext,
104 runStmt, SingleStep(..),
106 Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
107 resumeHistory, resumeHistoryIx),
108 History(historyBreakInfo, historyEnclosingDecl),
109 GHC.getHistorySpan, getHistoryModule,
112 InteractiveEval.back,
113 InteractiveEval.forward,
116 InteractiveEval.compileExpr, HValue, dynCompileExpr,
118 GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
120 ModBreaks(..), BreakIndex,
121 BreakInfo(breakInfo_number, breakInfo_module),
122 BreakArray, setBreakOn, setBreakOff, getBreak,
125 -- * Abstract syntax elements
131 Module, mkModule, pprModule, moduleName, modulePackageId,
132 ModuleName, mkModuleName, moduleNameString,
136 isExternalName, nameModule, pprParenSymName, nameSrcSpan,
138 RdrName(Qual,Unqual),
142 isImplicitId, isDeadBinder,
143 isExportedId, isLocalId, isGlobalId,
145 isPrimOpId, isFCallId, isClassOpId_maybe,
146 isDataConWorkId, idDataCon,
147 isBottomingId, isDictonaryId,
148 recordSelectorFieldLabel,
150 -- ** Type constructors
152 tyConTyVars, tyConDataCons, tyConArity,
153 isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
155 synTyConDefn, synTyConType, synTyConResKind,
161 -- ** Data constructors
163 dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
164 dataConIsInfix, isVanillaDataCon,
166 StrictnessMark(..), isMarkedStrict,
170 classMethods, classSCTheta, classTvsFds,
175 instanceDFunId, pprInstance, pprInstanceHdr,
177 -- ** Types and Kinds
178 Type, splitForAllTys, funResultTy,
179 pprParendType, pprTypeApp,
182 ThetaType, pprThetaArrow,
188 module HsSyn, -- ToDo: remove extraneous bits
192 defaultFixity, maxPrecedence,
196 -- ** Source locations
198 mkSrcLoc, isGoodSrcLoc, noSrcLoc,
199 srcLocFile, srcLocLine, srcLocCol,
201 mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
202 srcSpanStart, srcSpanEnd,
204 srcSpanStartLine, srcSpanEndLine,
205 srcSpanStartCol, srcSpanEndCol,
210 -- *** Constructing Located
211 noLoc, mkGeneralLocated,
213 -- *** Deconstructing Located
216 -- *** Combining and comparing Located values
217 eqLocated, cmpLocated, combineLocs, addCLoc,
218 leftmost_smallest, leftmost_largest, rightmost,
222 GhcException(..), showGhcException,
224 -- * Token stream manipulations
226 getTokenStream, getRichTokenStream,
227 showRichTokenStream, addSourceToTokens,
237 * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
238 * what StaticFlags should we expose, if any?
241 #include "HsVersions.h"
244 import qualified Linker
245 import Linker ( HValue )
248 import InteractiveEval
253 import TcRnTypes hiding (LIE)
254 import TcRnMonad ( initIfaceCheck )
258 import qualified HsSyn -- hack as we want to reexport the whole module
259 import HsSyn hiding ((<.>))
260 import Type hiding (typeKind)
261 import TcType hiding (typeKind)
264 import TysPrim ( alphaTyVars )
269 import Name hiding ( varName )
270 -- import OccName ( parenSymOcc )
271 import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr,
273 import FamInstEnv ( emptyFamInstEnv )
277 import DriverPipeline
278 import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase )
284 import StaticFlagParser
285 import qualified StaticFlags
286 import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
291 import qualified UniqFM as UFM
295 import Bag ( unitBag, listToBag, emptyBag, isEmptyBag )
299 import StringBuffer ( StringBuffer, hGetStringBuffer, nextChar )
302 import Maybes ( expectJust, mapCatMaybes )
304 import HaddockLex ( tokenise )
308 import Control.Concurrent
309 import System.Directory ( getModificationTime, doesFileExist,
310 getCurrentDirectory )
313 import qualified Data.List as List
314 import Data.Typeable ( Typeable )
315 import Data.Word ( Word8 )
317 import System.Exit ( exitWith, ExitCode(..) )
318 import System.Time ( ClockTime, getClockTime )
321 import System.FilePath
323 import System.IO.Error ( try, isDoesNotExistError )
324 import Prelude hiding (init)
327 -- -----------------------------------------------------------------------------
328 -- Exception handlers
330 -- | Install some default exception handlers and run the inner computation.
331 -- Unless you want to handle exceptions yourself, you should wrap this around
332 -- the top level of your program. The default handlers output the error
333 -- message(s) to stderr and exit cleanly.
334 defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => DynFlags -> m a -> m a
335 defaultErrorHandler dflags inner =
336 -- top-level exception handler: any unrecognised exception is a compiler bug.
337 ghandle (\exception -> liftIO $ do
339 case fromException exception of
340 -- an IO exception probably isn't our fault, so don't panic
341 Just (ioe :: IOException) ->
342 fatalErrorMsg dflags (text (show ioe))
343 _ -> case fromException exception of
344 Just StackOverflow ->
345 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
346 _ -> case fromException exception of
347 Just (ex :: ExitCode) -> throw ex
350 (text (show (Panic (show exception))))
351 exitWith (ExitFailure 1)
354 -- error messages propagated as exceptions
359 PhaseFailed _ code -> exitWith code
360 Interrupted -> exitWith (ExitFailure 1)
361 _ -> do fatalErrorMsg dflags (text (show ge))
362 exitWith (ExitFailure 1)
366 -- | Install a default cleanup handler to remove temporary files deposited by
367 -- a GHC run. This is seperate from 'defaultErrorHandler', because you might
368 -- want to override the error handling, but still get the ordinary cleanup
370 defaultCleanupHandler :: (ExceptionMonad m, MonadIO m) =>
371 DynFlags -> m a -> m a
372 defaultCleanupHandler dflags inner =
373 -- make sure we clean up after ourselves
376 cleanTempFiles dflags
379 -- exceptions will be blocked while we clean the temporary files,
380 -- so there shouldn't be any difficulty if we receive further
383 -- | Print the error message and all warnings. Useful inside exception
384 -- handlers. Clears warnings after printing.
385 printExceptionAndWarnings :: GhcMonad m => SourceError -> m ()
386 printExceptionAndWarnings err = do
387 let errs = srcErrorMessages err
389 dflags <- getSessionDynFlags
391 -- Empty errors means we failed due to -Werror. (Since this function
392 -- takes a source error as argument, we know for sure _some_ error
393 -- did indeed happen.)
395 printBagOfWarnings dflags warns
396 printBagOfErrors dflags (unitBag warnIsErrorMsg)
397 else liftIO $ printBagOfErrors dflags errs
400 -- | Print all accumulated warnings using 'log_action'.
401 printWarnings :: GhcMonad m => m ()
403 dflags <- getSessionDynFlags
405 liftIO $ printBagOfWarnings dflags warns
408 -- | Run function for the 'Ghc' monad.
410 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
411 -- to this function will create a new session which should not be shared among
414 -- Any errors not handled inside the 'Ghc' action are propagated as IO
417 runGhc :: Maybe FilePath -- ^ See argument to 'initGhcMonad'.
418 -> Ghc a -- ^ The action to perform.
420 runGhc mb_top_dir ghc = do
421 wref <- newIORef emptyBag
422 ref <- newIORef undefined
423 let session = Session ref wref
424 flip unGhc session $ do
425 initGhcMonad mb_top_dir
427 -- XXX: unregister interrupt handlers here?
429 -- | Run function for 'GhcT' monad transformer.
431 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
432 -- to this function will create a new session which should not be shared among
435 runGhcT :: (ExceptionMonad m, Functor m, MonadIO m) =>
436 Maybe FilePath -- ^ See argument to 'initGhcMonad'.
437 -> GhcT m a -- ^ The action to perform.
439 runGhcT mb_top_dir ghct = do
440 wref <- liftIO $ newIORef emptyBag
441 ref <- liftIO $ newIORef undefined
442 let session = Session ref wref
443 flip unGhcT session $ do
444 initGhcMonad mb_top_dir
447 -- | Initialise a GHC session.
449 -- If you implement a custom 'GhcMonad' you must call this function in the
450 -- monad run function. It will initialise the session variable and clear all
453 -- The first argument should point to the directory where GHC's library files
454 -- reside. More precisely, this should be the output of @ghc --print-libdir@
455 -- of the version of GHC the module using this API is compiled with. For
456 -- portability, you should use the @ghc-paths@ package, available at
457 -- <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/ghc-paths>.
459 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
460 initGhcMonad mb_top_dir = do
462 main_thread <- liftIO $ myThreadId
463 liftIO $ modifyMVar_ interruptTargetThread (return . (main_thread :))
464 liftIO $ installSignalHandlers
466 liftIO $ StaticFlags.initStaticOpts
468 dflags0 <- liftIO $ initDynFlags defaultDynFlags
469 dflags <- liftIO $ initSysTools mb_top_dir dflags0
470 env <- liftIO $ newHscEnv defaultCallbacks dflags
474 defaultCallbacks :: GhcApiCallbacks
477 reportModuleCompilationResult =
478 \_ mb_err -> defaultWarnErrLogger mb_err
481 -- -----------------------------------------------------------------------------
484 -- | Grabs the DynFlags from the Session
485 getSessionDynFlags :: GhcMonad m => m DynFlags
486 getSessionDynFlags = withSession (return . hsc_dflags)
488 -- | Updates the DynFlags in a Session. This also reads
489 -- the package database (unless it has already been read),
490 -- and prepares the compilers knowledge about packages. It
491 -- can be called again to load new packages: just add new
492 -- package flags to (packageFlags dflags).
494 -- Returns a list of new packages that may need to be linked in using
495 -- the dynamic linker (see 'linkPackages') as a result of new package
496 -- flags. If you are not doing linking or doing static linking, you
497 -- can ignore the list of packages returned.
499 setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
500 setSessionDynFlags dflags = do
501 (dflags', preload) <- liftIO $ initPackages dflags
502 modifySession (\h -> h{ hsc_dflags = dflags' })
505 -- | If there is no -o option, guess the name of target executable
506 -- by using top-level source file name as a base.
507 guessOutputFile :: GhcMonad m => m ()
508 guessOutputFile = modifySession $ \env ->
509 let dflags = hsc_dflags env
510 mod_graph = hsc_mod_graph env
511 mainModuleSrcPath :: Maybe String
512 mainModuleSrcPath = do
513 let isMain = (== mainModIs dflags) . ms_mod
514 [ms] <- return (filter isMain mod_graph)
515 ml_hs_file (ms_location ms)
516 name = fmap dropExtension mainModuleSrcPath
518 #if defined(mingw32_HOST_OS)
519 -- we must add the .exe extention unconditionally here, otherwise
520 -- when name has an extension of its own, the .exe extension will
521 -- not be added by DriverPipeline.exeFileName. See #2248
522 name_exe = fmap (<.> "exe") name
527 case outputFile dflags of
529 Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } }
531 -- -----------------------------------------------------------------------------
534 -- ToDo: think about relative vs. absolute file paths. And what
535 -- happens when the current directory changes.
537 -- | Sets the targets for this session. Each target may be a module name
538 -- or a filename. The targets correspond to the set of root modules for
539 -- the program\/library. Unloading the current program is achieved by
540 -- setting the current set of targets to be empty, followed by 'load'.
541 setTargets :: GhcMonad m => [Target] -> m ()
542 setTargets targets = modifySession (\h -> h{ hsc_targets = targets })
544 -- | Returns the current set of targets
545 getTargets :: GhcMonad m => m [Target]
546 getTargets = withSession (return . hsc_targets)
548 -- | Add another target.
549 addTarget :: GhcMonad m => Target -> m ()
551 = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
554 removeTarget :: GhcMonad m => TargetId -> m ()
555 removeTarget target_id
556 = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
558 filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
560 -- | Attempts to guess what Target a string refers to. This function
561 -- implements the @--make@/GHCi command-line syntax for filenames:
563 -- - if the string looks like a Haskell source filename, then interpret it
566 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
569 -- - otherwise interpret the string as a module name
571 guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
572 guessTarget str (Just phase)
573 = return (Target (TargetFile str (Just phase)) True Nothing)
574 guessTarget str Nothing
575 | isHaskellSrcFilename file
576 = return (target (TargetFile file Nothing))
578 = do exists <- liftIO $ doesFileExist hs_file
580 then return (target (TargetFile hs_file Nothing))
582 exists <- liftIO $ doesFileExist lhs_file
584 then return (target (TargetFile lhs_file Nothing))
586 if looksLikeModuleName file
587 then return (target (TargetModule (mkModuleName file)))
590 (ProgramError (showSDoc $
591 text "target" <+> quotes (text file) <+>
592 text "is not a module name or a source file"))
595 | '*':rest <- str = (rest, False)
596 | otherwise = (str, True)
598 hs_file = file <.> "hs"
599 lhs_file = file <.> "lhs"
601 target tid = Target tid obj_allowed Nothing
603 -- -----------------------------------------------------------------------------
604 -- Extending the program scope
606 extendGlobalRdrScope :: GhcMonad m => [GlobalRdrElt] -> m ()
607 extendGlobalRdrScope rdrElts
608 = modifySession $ \hscEnv ->
609 let global_rdr = hsc_global_rdr_env hscEnv
610 in hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv global_rdr rdrElts }
612 setGlobalRdrScope :: GhcMonad m => [GlobalRdrElt] -> m ()
613 setGlobalRdrScope rdrElts
614 = modifySession $ \hscEnv ->
615 hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv rdrElts }
617 extendGlobalTypeScope :: GhcMonad m => [Id] -> m ()
618 extendGlobalTypeScope ids
619 = modifySession $ \hscEnv ->
620 let global_type = hsc_global_type_env hscEnv
621 in hscEnv{ hsc_global_type_env = extendTypeEnvWithIds global_type ids }
623 setGlobalTypeScope :: GhcMonad m => [Id] -> m ()
624 setGlobalTypeScope ids
625 = modifySession $ \hscEnv ->
626 hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
628 -- -----------------------------------------------------------------------------
629 -- Parsing Haddock comments
631 parseHaddockComment :: String -> Either String (HsDoc RdrName)
632 parseHaddockComment string =
633 case parseHaddockParagraphs (tokenise string) of
637 -- -----------------------------------------------------------------------------
638 -- Loading the program
640 -- | Perform a dependency analysis starting from the current targets
641 -- and update the session with the new module graph.
643 -- Dependency analysis entails parsing the @import@ directives and may
644 -- therefore require running certain preprocessors.
646 -- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.
647 -- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the
648 -- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module. Thus if you want to
649 -- changes to the 'DynFlags' to take effect you need to call this function
652 depanal :: GhcMonad m =>
653 [ModuleName] -- ^ excluded modules
654 -> Bool -- ^ allow duplicate roots
656 depanal excluded_mods allow_dup_roots = do
657 hsc_env <- getSession
659 dflags = hsc_dflags hsc_env
660 targets = hsc_targets hsc_env
661 old_graph = hsc_mod_graph hsc_env
663 liftIO $ showPass dflags "Chasing dependencies"
664 liftIO $ debugTraceMsg dflags 2 (hcat [
665 text "Chasing modules from: ",
666 hcat (punctuate comma (map pprTarget targets))])
668 mod_graph <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
669 modifySession $ \_ -> hsc_env { hsc_mod_graph = mod_graph }
672 -- | Describes which modules of the module graph need to be loaded.
675 -- ^ Load all targets and its dependencies.
676 | LoadUpTo ModuleName
677 -- ^ Load only the given module and its dependencies.
678 | LoadDependenciesOf ModuleName
679 -- ^ Load only the dependencies of the given module, but not the module
682 -- | Try to load the program. See 'LoadHowMuch' for the different modes.
684 -- This function implements the core of GHC's @--make@ mode. It preprocesses,
685 -- compiles and loads the specified modules, avoiding re-compilation wherever
686 -- possible. Depending on the target (see 'DynFlags.hscTarget') compilating
687 -- and loading may result in files being created on disk.
689 -- Calls the 'reportModuleCompilationResult' callback after each compiling
690 -- each module, whether successful or not.
692 -- Throw a 'SourceError' if errors are encountered before the actual
693 -- compilation starts (e.g., during dependency analysis). All other errors
694 -- are reported using the callback.
696 load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
698 mod_graph <- depanal [] False
699 load2 how_much mod_graph
701 -- | A function called to log warnings and errors.
702 type WarnErrLogger = GhcMonad m => Maybe SourceError -> m ()
704 defaultWarnErrLogger :: WarnErrLogger
705 defaultWarnErrLogger Nothing = printWarnings
706 defaultWarnErrLogger (Just e) = printExceptionAndWarnings e
708 -- | Try to load the program. If a Module is supplied, then just
709 -- attempt to load up to this target. If no Module is supplied,
710 -- then try to load all targets.
712 -- The first argument is a function that is called after compiling each
713 -- module to print wanrings and errors.
715 -- While compiling a module, all 'SourceError's are caught and passed to the
716 -- logger, however, this function may still throw a 'SourceError' if
717 -- dependency analysis failed (e.g., due to a parse error).
719 loadWithLogger :: GhcMonad m => WarnErrLogger -> LoadHowMuch -> m SuccessFlag
720 loadWithLogger logger how_much = do
721 -- Dependency analysis first. Note that this fixes the module graph:
722 -- even if we don't get a fully successful upsweep, the full module
723 -- graph is still retained in the Session. We can tell which modules
724 -- were successfully loaded by inspecting the Session's HPT.
725 withLocalCallbacks (\cbs -> cbs { reportModuleCompilationResult =
729 load2 :: GhcMonad m => LoadHowMuch -> [ModSummary]
731 load2 how_much mod_graph = do
733 hsc_env <- getSession
735 let hpt1 = hsc_HPT hsc_env
736 let dflags = hsc_dflags hsc_env
738 -- The "bad" boot modules are the ones for which we have
739 -- B.hs-boot in the module graph, but no B.hs
740 -- The downsweep should have ensured this does not happen
742 let all_home_mods = [ms_mod_name s
743 | s <- mod_graph, not (isBootSummary s)]
744 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
745 not (ms_mod_name s `elem` all_home_mods)]
746 ASSERT( null bad_boot_mods ) return ()
748 -- check that the module given in HowMuch actually exists, otherwise
749 -- topSortModuleGraph will bomb later.
750 let checkHowMuch (LoadUpTo m) = checkMod m
751 checkHowMuch (LoadDependenciesOf m) = checkMod m
755 | m `elem` all_home_mods = and_then
757 liftIO $ errorMsg dflags (text "no such module:" <+>
761 checkHowMuch how_much $ do
763 -- mg2_with_srcimps drops the hi-boot nodes, returning a
764 -- graph with cycles. Among other things, it is used for
765 -- backing out partially complete cycles following a failed
766 -- upsweep, and for removing from hpt all the modules
767 -- not in strict downwards closure, during calls to compile.
768 let mg2_with_srcimps :: [SCC ModSummary]
769 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
771 -- If we can determine that any of the {-# SOURCE #-} imports
772 -- are definitely unnecessary, then emit a warning.
773 warnUnnecessarySourceImports mg2_with_srcimps
776 -- check the stability property for each module.
777 stable_mods@(stable_obj,stable_bco)
778 = checkStability hpt1 mg2_with_srcimps all_home_mods
780 -- prune bits of the HPT which are definitely redundant now,
782 pruned_hpt = pruneHomePackageTable hpt1
783 (flattenSCCs mg2_with_srcimps)
786 _ <- liftIO $ evaluate pruned_hpt
788 -- before we unload anything, make sure we don't leave an old
789 -- interactive context around pointing to dead bindings. Also,
790 -- write the pruned HPT to allow the old HPT to be GC'd.
791 modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext,
792 hsc_HPT = pruned_hpt }
794 liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
795 text "Stable BCO:" <+> ppr stable_bco)
797 -- Unload any modules which are going to be re-linked this time around.
798 let stable_linkables = [ linkable
799 | m <- stable_obj++stable_bco,
800 Just hmi <- [lookupUFM pruned_hpt m],
801 Just linkable <- [hm_linkable hmi] ]
802 liftIO $ unload hsc_env stable_linkables
804 -- We could at this point detect cycles which aren't broken by
805 -- a source-import, and complain immediately, but it seems better
806 -- to let upsweep_mods do this, so at least some useful work gets
807 -- done before the upsweep is abandoned.
808 --hPutStrLn stderr "after tsort:\n"
809 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
811 -- Now do the upsweep, calling compile for each module in
812 -- turn. Final result is version 3 of everything.
814 -- Topologically sort the module graph, this time including hi-boot
815 -- nodes, and possibly just including the portion of the graph
816 -- reachable from the module specified in the 2nd argument to load.
817 -- This graph should be cycle-free.
818 -- If we're restricting the upsweep to a portion of the graph, we
819 -- also want to retain everything that is still stable.
820 let full_mg :: [SCC ModSummary]
821 full_mg = topSortModuleGraph False mod_graph Nothing
823 maybe_top_mod = case how_much of
825 LoadDependenciesOf m -> Just m
828 partial_mg0 :: [SCC ModSummary]
829 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
831 -- LoadDependenciesOf m: we want the upsweep to stop just
832 -- short of the specified module (unless the specified module
835 | LoadDependenciesOf _mod <- how_much
836 = ASSERT( case last partial_mg0 of
837 AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
838 List.init partial_mg0
844 | AcyclicSCC ms <- full_mg,
845 ms_mod_name ms `elem` stable_obj++stable_bco,
846 ms_mod_name ms `notElem` [ ms_mod_name ms' |
847 AcyclicSCC ms' <- partial_mg ] ]
849 mg = stable_mg ++ partial_mg
851 -- clean up between compilations
852 let cleanup = cleanTempFilesExcept dflags
853 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
855 liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
857 (upsweep_ok, hsc_env1, modsUpswept)
858 <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
859 pruned_hpt stable_mods cleanup mg
861 -- Make modsDone be the summaries for each home module now
862 -- available; this should equal the domain of hpt3.
863 -- Get in in a roughly top .. bottom order (hence reverse).
865 let modsDone = reverse modsUpswept
867 -- Try and do linking in some form, depending on whether the
868 -- upsweep was completely or only partially successful.
870 if succeeded upsweep_ok
873 -- Easy; just relink it all.
874 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep completely successful.")
876 -- Clean up after ourselves
877 liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
879 -- Issue a warning for the confusing case where the user
880 -- said '-o foo' but we're not going to do any linking.
881 -- We attempt linking if either (a) one of the modules is
882 -- called Main, or (b) the user said -no-hs-main, indicating
883 -- that main() is going to come from somewhere else.
885 let ofile = outputFile dflags
886 let no_hs_main = dopt Opt_NoHsMain dflags
888 main_mod = mainModIs dflags
889 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
890 do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib
892 when (ghcLink dflags == LinkBinary
893 && isJust ofile && not do_linking) $
894 liftIO $ debugTraceMsg dflags 1 $
895 text ("Warning: output was redirected with -o, " ++
896 "but no output will be generated\n" ++
897 "because there is no " ++
898 moduleNameString (moduleName main_mod) ++ " module.")
900 -- link everything together
901 linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
903 loadFinish Succeeded linkresult hsc_env1
906 -- Tricky. We need to back out the effects of compiling any
907 -- half-done cycles, both so as to clean up the top level envs
908 -- and to avoid telling the interactive linker to link them.
909 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep partially successful.")
912 = map ms_mod modsDone
913 let mods_to_zap_names
914 = findPartiallyCompletedCycles modsDone_names
917 = filter ((`notElem` mods_to_zap_names).ms_mod)
920 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
923 -- Clean up after ourselves
924 liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
926 -- there should be no Nothings where linkables should be, now
927 ASSERT(all (isJust.hm_linkable)
928 (eltsUFM (hsc_HPT hsc_env))) do
930 -- Link everything together
931 linkresult <- liftIO $ link (ghcLink dflags) dflags False hpt4
933 let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
934 loadFinish Failed linkresult hsc_env4
936 -- Finish up after a load.
938 -- If the link failed, unload everything and return.
939 loadFinish :: GhcMonad m =>
940 SuccessFlag -> SuccessFlag -> HscEnv
942 loadFinish _all_ok Failed hsc_env
943 = do liftIO $ unload hsc_env []
944 modifySession $ \_ -> discardProg hsc_env
947 -- Empty the interactive context and set the module context to the topmost
948 -- newly loaded module, or the Prelude if none were loaded.
949 loadFinish all_ok Succeeded hsc_env
950 = do modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext }
954 -- Forget the current program, but retain the persistent info in HscEnv
955 discardProg :: HscEnv -> HscEnv
957 = hsc_env { hsc_mod_graph = emptyMG,
958 hsc_IC = emptyInteractiveContext,
959 hsc_HPT = emptyHomePackageTable }
961 -- used to fish out the preprocess output files for the purposes of
962 -- cleaning up. The preprocessed file *might* be the same as the
963 -- source file, but that doesn't do any harm.
964 ppFilesFromSummaries :: [ModSummary] -> [FilePath]
965 ppFilesFromSummaries summaries = map ms_hspp_file summaries
967 -- -----------------------------------------------------------------------------
969 class ParsedMod m where
970 modSummary :: m -> ModSummary
971 parsedSource :: m -> ParsedSource
973 class ParsedMod m => TypecheckedMod m where
974 renamedSource :: m -> Maybe RenamedSource
975 typecheckedSource :: m -> TypecheckedSource
976 moduleInfo :: m -> ModuleInfo
977 tm_internals :: m -> (TcGblEnv, ModDetails)
978 -- ToDo: improvements that could be made here:
979 -- if the module succeeded renaming but not typechecking,
980 -- we can still get back the GlobalRdrEnv and exports, so
981 -- perhaps the ModuleInfo should be split up into separate
984 class TypecheckedMod m => DesugaredMod m where
985 coreModule :: m -> ModGuts
987 -- | The result of successful parsing.
989 ParsedModule { pm_mod_summary :: ModSummary
990 , pm_parsed_source :: ParsedSource }
992 instance ParsedMod ParsedModule where
993 modSummary m = pm_mod_summary m
994 parsedSource m = pm_parsed_source m
996 -- | The result of successful typechecking. It also contains the parser
998 data TypecheckedModule =
999 TypecheckedModule { tm_parsed_module :: ParsedModule
1000 , tm_renamed_source :: Maybe RenamedSource
1001 , tm_typechecked_source :: TypecheckedSource
1002 , tm_checked_module_info :: ModuleInfo
1003 , tm_internals_ :: (TcGblEnv, ModDetails)
1006 instance ParsedMod TypecheckedModule where
1007 modSummary m = modSummary (tm_parsed_module m)
1008 parsedSource m = parsedSource (tm_parsed_module m)
1010 instance TypecheckedMod TypecheckedModule where
1011 renamedSource m = tm_renamed_source m
1012 typecheckedSource m = tm_typechecked_source m
1013 moduleInfo m = tm_checked_module_info m
1014 tm_internals m = tm_internals_ m
1016 -- | The result of successful desugaring (i.e., translation to core). Also
1017 -- contains all the information of a typechecked module.
1018 data DesugaredModule =
1019 DesugaredModule { dm_typechecked_module :: TypecheckedModule
1020 , dm_core_module :: ModGuts
1023 instance ParsedMod DesugaredModule where
1024 modSummary m = modSummary (dm_typechecked_module m)
1025 parsedSource m = parsedSource (dm_typechecked_module m)
1027 instance TypecheckedMod DesugaredModule where
1028 renamedSource m = renamedSource (dm_typechecked_module m)
1029 typecheckedSource m = typecheckedSource (dm_typechecked_module m)
1030 moduleInfo m = moduleInfo (dm_typechecked_module m)
1031 tm_internals m = tm_internals_ (dm_typechecked_module m)
1033 instance DesugaredMod DesugaredModule where
1034 coreModule m = dm_core_module m
1036 type ParsedSource = Located (HsModule RdrName)
1037 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
1038 Maybe (HsDoc Name), HaddockModInfo Name)
1039 type TypecheckedSource = LHsBinds Id
1042 -- - things that aren't in the output of the typechecker right now:
1043 -- - the export list
1045 -- - type signatures
1046 -- - type/data/newtype declarations
1047 -- - class declarations
1049 -- - extra things in the typechecker's output:
1050 -- - default methods are turned into top-level decls.
1051 -- - dictionary bindings
1053 -- | Return the 'ModSummary' of a module with the given name.
1055 -- The module must be part of the module graph (see 'hsc_mod_graph' and
1056 -- 'ModuleGraph'). If this is not the case, this function will throw a
1059 -- This function ignores boot modules and requires that there is only one
1060 -- non-boot module with the given name.
1061 getModSummary :: GhcMonad m => ModuleName -> m ModSummary
1062 getModSummary mod = do
1063 mg <- liftM hsc_mod_graph getSession
1064 case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
1065 [] -> throw $ mkApiErr (text "Module not part of module graph")
1067 multiple -> throw $ mkApiErr (text "getModSummary is ambiguous: " <+> ppr multiple)
1069 -- | Parse a module.
1071 -- Throws a 'SourceError' on parse error.
1072 parseModule :: GhcMonad m => ModSummary -> m ParsedModule
1074 rdr_module <- withTempSession
1075 (\e -> e { hsc_dflags = ms_hspp_opts ms }) $
1077 return (ParsedModule ms rdr_module)
1079 -- | Typecheck and rename a parsed module.
1081 -- Throws a 'SourceError' if either fails.
1082 typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
1083 typecheckModule pmod = do
1084 let ms = modSummary pmod
1085 withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
1086 (tc_gbl_env, rn_info)
1087 <- hscTypecheckRename ms (parsedSource pmod)
1088 details <- makeSimpleDetails tc_gbl_env
1091 tm_internals_ = (tc_gbl_env, details),
1092 tm_parsed_module = pmod,
1093 tm_renamed_source = rn_info,
1094 tm_typechecked_source = tcg_binds tc_gbl_env,
1095 tm_checked_module_info =
1097 minf_type_env = md_types details,
1098 minf_exports = availsToNameSet $ md_exports details,
1099 minf_rdr_env = Just (tcg_rdr_env tc_gbl_env),
1100 minf_instances = md_insts details
1102 ,minf_modBreaks = emptyModBreaks
1106 -- | Desugar a typechecked module.
1107 desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
1108 desugarModule tcm = do
1109 let ms = modSummary tcm
1110 withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
1111 let (tcg, _) = tm_internals tcm
1112 guts <- hscDesugar ms tcg
1115 dm_typechecked_module = tcm,
1116 dm_core_module = guts
1119 -- | Load a module. Input doesn't need to be desugared.
1121 -- A module must be loaded before dependent modules can be typechecked. This
1122 -- always includes generating a 'ModIface' and, depending on the
1123 -- 'DynFlags.hscTarget', may also include code generation.
1125 -- This function will always cause recompilation and will always overwrite
1126 -- previous compilation results (potentially files on disk).
1128 loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
1130 let ms = modSummary tcm
1131 let mod = ms_mod_name ms
1132 let (tcg, _details) = tm_internals tcm
1134 withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
1136 let compilerBackend comp env ms' _ _mb_old_iface _ =
1137 withTempSession (\_ -> env) $
1138 hscBackend comp tcg ms'
1140 hsc_env <- getSession
1142 <- compile' (compilerBackend hscNothingCompiler
1143 ,compilerBackend hscInteractiveCompiler
1144 ,compilerBackend hscBatchCompiler)
1145 hsc_env ms 1 1 Nothing Nothing
1146 -- compile' shouldn't change the environment
1147 return $ addToUFM (hsc_HPT hsc_env) mod mod_info
1148 modifySession $ \e -> e{ hsc_HPT = hpt_new }
1151 -- | This is the way to get access to the Core bindings corresponding
1152 -- to a module. 'compileToCore' parses, typechecks, and
1153 -- desugars the module, then returns the resulting Core module (consisting of
1154 -- the module name, type declarations, and function declarations) if
1156 compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
1157 compileToCoreModule = compileCore False
1159 -- | Like compileToCoreModule, but invokes the simplifier, so
1160 -- as to return simplified and tidied Core.
1161 compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
1162 compileToCoreSimplified = compileCore True
1164 -- | Provided for backwards-compatibility: compileToCore returns just the Core
1165 -- bindings, but for most purposes, you probably want to call
1166 -- compileToCoreModule.
1167 compileToCore :: GhcMonad m => FilePath -> m [CoreBind]
1168 compileToCore fn = do
1169 mod <- compileToCoreModule session fn
1170 return $ cm_binds mod
1172 -- | Takes a CoreModule and compiles the bindings therein
1173 -- to object code. The first argument is a bool flag indicating
1174 -- whether to run the simplifier.
1175 -- The resulting .o, .hi, and executable files, if any, are stored in the
1176 -- current directory, and named according to the module name.
1177 -- This has only so far been tested with a single self-contained module.
1178 compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m ()
1179 compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
1180 dflags <- getSessionDynFlags
1181 currentTime <- liftIO $ getClockTime
1182 cwd <- liftIO $ getCurrentDirectory
1183 modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd
1184 ((moduleNameSlashes . moduleName) mName)
1186 let modSummary = ModSummary { ms_mod = mName,
1187 ms_hsc_src = ExtCoreFile,
1188 ms_location = modLocation,
1189 -- By setting the object file timestamp to Nothing,
1190 -- we always force recompilation, which is what we
1191 -- want. (Thus it doesn't matter what the timestamp
1192 -- for the (nonexistent) source file is.)
1193 ms_hs_date = currentTime,
1194 ms_obj_date = Nothing,
1195 -- Only handling the single-module case for now, so no imports.
1200 ms_hspp_opts = dflags,
1201 ms_hspp_buf = Nothing
1204 let maybe_simplify mod_guts | simplify = hscSimplify mod_guts
1205 | otherwise = return mod_guts
1206 guts <- maybe_simplify (mkModGuts cm)
1207 (iface, changed, _details, cgguts)
1208 <- hscNormalIface guts Nothing
1209 hscWriteIface iface changed modSummary
1210 _ <- hscGenHardCode cgguts modSummary
1213 -- Makes a "vanilla" ModGuts.
1214 mkModGuts :: CoreModule -> ModGuts
1215 mkModGuts coreModule = ModGuts {
1216 mg_module = cm_module coreModule,
1219 mg_deps = noDependencies,
1220 mg_dir_imps = emptyModuleEnv,
1221 mg_used_names = emptyNameSet,
1222 mg_rdr_env = emptyGlobalRdrEnv,
1223 mg_fix_env = emptyFixityEnv,
1224 mg_types = emptyTypeEnv,
1228 mg_binds = cm_binds coreModule,
1229 mg_foreign = NoStubs,
1230 mg_warns = NoWarnings,
1232 mg_hpc_info = emptyHpcInfo False,
1233 mg_modBreaks = emptyModBreaks,
1234 mg_vect_info = noVectInfo,
1235 mg_inst_env = emptyInstEnv,
1236 mg_fam_inst_env = emptyFamInstEnv
1239 compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
1240 compileCore simplify fn = do
1241 -- First, set the target to the desired filename
1242 target <- guessTarget fn Nothing
1244 _ <- load LoadAllTargets
1245 -- Then find dependencies
1246 modGraph <- depanal [] True
1247 case find ((== fn) . msHsFilePath) modGraph of
1248 Just modSummary -> do
1249 -- Now we have the module name;
1250 -- parse, typecheck and desugar the module
1251 mod_guts <- coreModule `fmap`
1252 -- TODO: space leaky: call hsc* directly?
1253 (desugarModule =<< typecheckModule =<< parseModule modSummary)
1254 liftM gutsToCoreModule $
1257 -- If simplify is true: simplify (hscSimplify), then tidy
1259 hsc_env <- getSession
1260 simpl_guts <- hscSimplify mod_guts
1261 tidy_guts <- liftIO $ tidyProgram hsc_env simpl_guts
1262 return $ Left tidy_guts
1264 return $ Right mod_guts
1266 Nothing -> panic "compileToCoreModule: target FilePath not found in\
1267 module dependency graph"
1268 where -- two versions, based on whether we simplify (thus run tidyProgram,
1269 -- which returns a (CgGuts, ModDetails) pair, or not (in which case
1270 -- we just have a ModGuts.
1271 gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
1272 gutsToCoreModule (Left (cg, md)) = CoreModule {
1273 cm_module = cg_module cg, cm_types = md_types md,
1274 cm_imports = cg_dir_imps cg, cm_binds = cg_binds cg
1276 gutsToCoreModule (Right mg) = CoreModule {
1277 cm_module = mg_module mg, cm_types = mg_types mg,
1278 cm_imports = moduleEnvKeys (mg_dir_imps mg), cm_binds = mg_binds mg
1281 -- ---------------------------------------------------------------------------
1284 unload :: HscEnv -> [Linkable] -> IO ()
1285 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
1286 = case ghcLink (hsc_dflags hsc_env) of
1288 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
1290 LinkInMemory -> panic "unload: no interpreter"
1291 -- urgh. avoid warnings:
1292 hsc_env stable_linkables
1296 -- -----------------------------------------------------------------------------
1300 Stability tells us which modules definitely do not need to be recompiled.
1301 There are two main reasons for having stability:
1303 - avoid doing a complete upsweep of the module graph in GHCi when
1304 modules near the bottom of the tree have not changed.
1306 - to tell GHCi when it can load object code: we can only load object code
1307 for a module when we also load object code fo all of the imports of the
1308 module. So we need to know that we will definitely not be recompiling
1309 any of these modules, and we can use the object code.
1311 The stability check is as follows. Both stableObject and
1312 stableBCO are used during the upsweep phase later.
1315 stable m = stableObject m || stableBCO m
1318 all stableObject (imports m)
1319 && old linkable does not exist, or is == on-disk .o
1320 && date(on-disk .o) > date(.hs)
1323 all stable (imports m)
1324 && date(BCO) > date(.hs)
1327 These properties embody the following ideas:
1329 - if a module is stable, then:
1331 - if it has been compiled in a previous pass (present in HPT)
1332 then it does not need to be compiled or re-linked.
1334 - if it has not been compiled in a previous pass,
1335 then we only need to read its .hi file from disk and
1336 link it to produce a 'ModDetails'.
1338 - if a modules is not stable, we will definitely be at least
1339 re-linking, and possibly re-compiling it during the 'upsweep'.
1340 All non-stable modules can (and should) therefore be unlinked
1341 before the 'upsweep'.
1343 - Note that objects are only considered stable if they only depend
1344 on other objects. We can't link object code against byte code.
1348 :: HomePackageTable -- HPT from last compilation
1349 -> [SCC ModSummary] -- current module graph (cyclic)
1350 -> [ModuleName] -- all home modules
1351 -> ([ModuleName], -- stableObject
1352 [ModuleName]) -- stableBCO
1354 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
1356 checkSCC (stable_obj, stable_bco) scc0
1357 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
1358 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
1359 | otherwise = (stable_obj, stable_bco)
1361 scc = flattenSCC scc0
1362 scc_mods = map ms_mod_name scc
1363 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
1365 scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))
1366 -- all imports outside the current SCC, but in the home pkg
1368 stable_obj_imps = map (`elem` stable_obj) scc_allimps
1369 stable_bco_imps = map (`elem` stable_bco) scc_allimps
1373 && all object_ok scc
1376 and (zipWith (||) stable_obj_imps stable_bco_imps)
1380 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
1384 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
1385 Just hmi | Just l <- hm_linkable hmi
1386 -> isObjectLinkable l && t == linkableTime l
1388 -- why '>=' rather than '>' above? If the filesystem stores
1389 -- times to the nearset second, we may occasionally find that
1390 -- the object & source have the same modification time,
1391 -- especially if the source was automatically generated
1392 -- and compiled. Using >= is slightly unsafe, but it matches
1393 -- make's behaviour.
1396 = case lookupUFM hpt (ms_mod_name ms) of
1397 Just hmi | Just l <- hm_linkable hmi ->
1398 not (isObjectLinkable l) &&
1399 linkableTime l >= ms_hs_date ms
1402 -- -----------------------------------------------------------------------------
1404 -- | Prune the HomePackageTable
1406 -- Before doing an upsweep, we can throw away:
1408 -- - For non-stable modules:
1409 -- - all ModDetails, all linked code
1410 -- - all unlinked code that is out of date with respect to
1413 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
1414 -- space at the end of the upsweep, because the topmost ModDetails of the
1415 -- old HPT holds on to the entire type environment from the previous
1418 pruneHomePackageTable
1421 -> ([ModuleName],[ModuleName])
1424 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
1427 | is_stable modl = hmi'
1428 | otherwise = hmi'{ hm_details = emptyModDetails }
1430 modl = moduleName (mi_module (hm_iface hmi))
1431 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
1432 = hmi{ hm_linkable = Nothing }
1435 where ms = expectJust "prune" (lookupUFM ms_map modl)
1437 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
1439 is_stable m = m `elem` stable_obj || m `elem` stable_bco
1441 -- -----------------------------------------------------------------------------
1443 -- Return (names of) all those in modsDone who are part of a cycle
1444 -- as defined by theGraph.
1445 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
1446 findPartiallyCompletedCycles modsDone theGraph
1450 chew ((AcyclicSCC _):rest) = chew rest -- acyclic? not interesting.
1451 chew ((CyclicSCC vs):rest)
1452 = let names_in_this_cycle = nub (map ms_mod vs)
1454 = nub ([done | done <- modsDone,
1455 done `elem` names_in_this_cycle])
1456 chewed_rest = chew rest
1458 if notNull mods_in_this_cycle
1459 && length mods_in_this_cycle < length names_in_this_cycle
1460 then mods_in_this_cycle ++ chewed_rest
1463 -- -----------------------------------------------------------------------------
1467 -- This is where we compile each module in the module graph, in a pass
1468 -- from the bottom to the top of the graph.
1470 -- There better had not be any cyclic groups here -- we check for them.
1474 HscEnv -- ^ Includes initially-empty HPT
1475 -> HomePackageTable -- ^ HPT from last time round (pruned)
1476 -> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability)
1477 -> IO () -- ^ How to clean up unwanted tmp files
1478 -> [SCC ModSummary] -- ^ Mods to do (the worklist)
1484 -- 1. A flag whether the complete upsweep was successful.
1485 -- 2. The 'HscEnv' with an updated HPT
1486 -- 3. A list of modules which succeeded loading.
1488 upsweep hsc_env old_hpt stable_mods cleanup sccs = do
1489 (res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
1490 return (res, hsc_env, reverse done)
1493 upsweep' hsc_env _old_hpt done
1495 = return (Succeeded, hsc_env, done)
1497 upsweep' hsc_env _old_hpt done
1498 (CyclicSCC ms:_) _ _
1499 = do liftIO $ fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
1500 return (Failed, hsc_env, done)
1502 upsweep' hsc_env old_hpt done
1503 (AcyclicSCC mod:mods) mod_index nmods
1504 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1505 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
1506 -- (moduleEnvElts (hsc_HPT hsc_env)))
1507 let logger = reportModuleCompilationResult (hsc_callbacks hsc_env)
1510 <- handleSourceError
1511 (\err -> do logger mod (Just err); return Nothing) $ do
1512 mod_info <- upsweep_mod hsc_env old_hpt stable_mods
1514 logger mod Nothing -- log warnings
1515 return (Just mod_info)
1517 liftIO cleanup -- Remove unwanted tmp files between compilations
1520 Nothing -> return (Failed, hsc_env, done)
1522 let this_mod = ms_mod_name mod
1524 -- Add new info to hsc_env
1525 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
1526 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
1528 -- Space-saving: delete the old HPT entry
1529 -- for mod BUT if mod is a hs-boot
1530 -- node, don't delete it. For the
1531 -- interface, the HPT entry is probaby for the
1532 -- main Haskell source file. Deleting it
1533 -- would force the real module to be recompiled
1535 old_hpt1 | isBootSummary mod = old_hpt
1536 | otherwise = delFromUFM old_hpt this_mod
1540 -- fixup our HomePackageTable after we've finished compiling
1541 -- a mutually-recursive loop. See reTypecheckLoop, below.
1542 hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done'
1544 upsweep' hsc_env2 old_hpt1 done' mods (mod_index+1) nmods
1546 -- | Compile a single module. Always produce a Linkable for it if
1547 -- successful. If no compilation happened, return the old Linkable.
1548 upsweep_mod :: GhcMonad m =>
1551 -> ([ModuleName],[ModuleName])
1553 -> Int -- index of module
1554 -> Int -- total number of modules
1557 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
1559 this_mod_name = ms_mod_name summary
1560 this_mod = ms_mod summary
1561 mb_obj_date = ms_obj_date summary
1562 obj_fn = ml_obj_file (ms_location summary)
1563 hs_date = ms_hs_date summary
1565 is_stable_obj = this_mod_name `elem` stable_obj
1566 is_stable_bco = this_mod_name `elem` stable_bco
1568 old_hmi = lookupUFM old_hpt this_mod_name
1570 -- We're using the dflags for this module now, obtained by
1571 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
1572 dflags = ms_hspp_opts summary
1573 prevailing_target = hscTarget (hsc_dflags hsc_env)
1574 local_target = hscTarget dflags
1576 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
1577 -- we don't do anything dodgy: these should only work to change
1578 -- from -fvia-C to -fasm and vice-versa, otherwise we could
1579 -- end up trying to link object code to byte code.
1580 target = if prevailing_target /= local_target
1581 && (not (isObjectTarget prevailing_target)
1582 || not (isObjectTarget local_target))
1583 then prevailing_target
1586 -- store the corrected hscTarget into the summary
1587 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
1589 -- The old interface is ok if
1590 -- a) we're compiling a source file, and the old HPT
1591 -- entry is for a source file
1592 -- b) we're compiling a hs-boot file
1593 -- Case (b) allows an hs-boot file to get the interface of its
1594 -- real source file on the second iteration of the compilation
1595 -- manager, but that does no harm. Otherwise the hs-boot file
1596 -- will always be recompiled
1601 Just hm_info | isBootSummary summary -> Just iface
1602 | not (mi_boot iface) -> Just iface
1603 | otherwise -> Nothing
1605 iface = hm_iface hm_info
1607 compile_it :: GhcMonad m => Maybe Linkable -> m HomeModInfo
1608 compile_it = compile hsc_env summary' mod_index nmods mb_old_iface
1610 compile_it_discard_iface :: GhcMonad m =>
1611 Maybe Linkable -> m HomeModInfo
1612 compile_it_discard_iface
1613 = compile hsc_env summary' mod_index nmods Nothing
1615 -- With the HscNothing target we create empty linkables to avoid
1616 -- recompilation. We have to detect these to recompile anyway if
1617 -- the target changed since the last compile.
1619 | Just hmi <- old_hmi, Just l <- hm_linkable hmi =
1620 null (linkableUnlinked l)
1622 -- we have no linkable, so it cannot be fake
1625 implies False _ = True
1631 -- Regardless of whether we're generating object code or
1632 -- byte code, we can always use an existing object file
1633 -- if it is *stable* (see checkStability).
1634 | is_stable_obj, Just hmi <- old_hmi -> do
1635 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1636 (text "skipping stable obj mod:" <+> ppr this_mod_name)
1638 -- object is stable, and we have an entry in the
1639 -- old HPT: nothing to do
1641 | is_stable_obj, isNothing old_hmi -> do
1642 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1643 (text "compiling stable on-disk mod:" <+> ppr this_mod_name)
1644 linkable <- liftIO $ findObjectLinkable this_mod obj_fn
1645 (expectJust "upsweep1" mb_obj_date)
1646 compile_it (Just linkable)
1647 -- object is stable, but we need to load the interface
1648 -- off disk to make a HMI.
1650 | not (isObjectTarget target), is_stable_bco,
1651 (target /= HscNothing) `implies` not is_fake_linkable ->
1652 ASSERT(isJust old_hmi) -- must be in the old_hpt
1653 let Just hmi = old_hmi in do
1654 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1655 (text "skipping stable BCO mod:" <+> ppr this_mod_name)
1657 -- BCO is stable: nothing to do
1659 | not (isObjectTarget target),
1660 Just hmi <- old_hmi,
1661 Just l <- hm_linkable hmi,
1662 not (isObjectLinkable l),
1663 (target /= HscNothing) `implies` not is_fake_linkable,
1664 linkableTime l >= ms_hs_date summary -> do
1665 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1666 (text "compiling non-stable BCO mod:" <+> ppr this_mod_name)
1668 -- we have an old BCO that is up to date with respect
1669 -- to the source: do a recompilation check as normal.
1671 -- When generating object code, if there's an up-to-date
1672 -- object file on the disk, then we can use it.
1673 -- However, if the object file is new (compared to any
1674 -- linkable we had from a previous compilation), then we
1675 -- must discard any in-memory interface, because this
1676 -- means the user has compiled the source file
1677 -- separately and generated a new interface, that we must
1678 -- read from the disk.
1680 | isObjectTarget target,
1681 Just obj_date <- mb_obj_date,
1682 obj_date >= hs_date -> do
1685 | Just l <- hm_linkable hmi,
1686 isObjectLinkable l && linkableTime l == obj_date -> do
1687 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1688 (text "compiling mod with new on-disk obj:" <+> ppr this_mod_name)
1691 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1692 (text "compiling mod with new on-disk obj2:" <+> ppr this_mod_name)
1693 linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date
1694 compile_it_discard_iface (Just linkable)
1697 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1698 (text "compiling mod:" <+> ppr this_mod_name)
1703 -- Filter modules in the HPT
1704 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
1705 retainInTopLevelEnvs keep_these hpt
1706 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
1708 , let mb_mod_info = lookupUFM hpt mod
1709 , isJust mb_mod_info ]
1711 -- ---------------------------------------------------------------------------
1712 -- Typecheck module loops
1715 See bug #930. This code fixes a long-standing bug in --make. The
1716 problem is that when compiling the modules *inside* a loop, a data
1717 type that is only defined at the top of the loop looks opaque; but
1718 after the loop is done, the structure of the data type becomes
1721 The difficulty is then that two different bits of code have
1722 different notions of what the data type looks like.
1724 The idea is that after we compile a module which also has an .hs-boot
1725 file, we re-generate the ModDetails for each of the modules that
1726 depends on the .hs-boot file, so that everyone points to the proper
1727 TyCons, Ids etc. defined by the real module, not the boot module.
1728 Fortunately re-generating a ModDetails from a ModIface is easy: the
1729 function TcIface.typecheckIface does exactly that.
1731 Picking the modules to re-typecheck is slightly tricky. Starting from
1732 the module graph consisting of the modules that have already been
1733 compiled, we reverse the edges (so they point from the imported module
1734 to the importing module), and depth-first-search from the .hs-boot
1735 node. This gives us all the modules that depend transitively on the
1736 .hs-boot module, and those are exactly the modules that we need to
1739 Following this fix, GHC can compile itself with --make -O2.
1742 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
1743 reTypecheckLoop hsc_env ms graph
1744 | not (isBootSummary ms) &&
1745 any (\m -> ms_mod m == this_mod && isBootSummary m) graph
1747 let mss = reachableBackwards (ms_mod_name ms) graph
1748 non_boot = filter (not.isBootSummary) mss
1749 debugTraceMsg (hsc_dflags hsc_env) 2 $
1750 text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
1751 typecheckLoop hsc_env (map ms_mod_name non_boot)
1755 this_mod = ms_mod ms
1757 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
1758 typecheckLoop hsc_env mods = do
1760 fixIO $ \new_hpt -> do
1761 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
1762 mds <- initIfaceCheck new_hsc_env $
1763 mapM (typecheckIface . hm_iface) hmis
1764 let new_hpt = addListToUFM old_hpt
1765 (zip mods [ hmi{ hm_details = details }
1766 | (hmi,details) <- zip hmis mds ])
1768 return hsc_env{ hsc_HPT = new_hpt }
1770 old_hpt = hsc_HPT hsc_env
1771 hmis = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
1773 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
1774 reachableBackwards mod summaries
1775 = [ ms | (ms,_,_) <- reachableG (transposeG graph) root ]
1776 where -- the rest just sets up the graph:
1777 (graph, lookup_node) = moduleGraphNodes False summaries
1778 root = expectJust "reachableBackwards" (lookup_node HsBootFile mod)
1780 -- ---------------------------------------------------------------------------
1781 -- Topological sort of the module graph
1783 type SummaryNode = (ModSummary, Int, [Int])
1787 -- ^ Drop hi-boot nodes? (see below)
1790 -- ^ Root module name. If @Nothing@, use the full graph.
1792 -- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1793 -- The resulting list of strongly-connected-components is in topologically
1794 -- sorted order, starting with the module(s) at the bottom of the
1795 -- dependency graph (ie compile them first) and ending with the ones at
1798 -- Drop hi-boot nodes (first boolean arg)?
1800 -- - @False@: treat the hi-boot summaries as nodes of the graph,
1801 -- so the graph must be acyclic
1803 -- - @True@: eliminate the hi-boot nodes, and instead pretend
1804 -- the a source-import of Foo is an import of Foo
1805 -- The resulting graph has no hi-boot nodes, but can be cyclic
1807 topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
1808 = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph
1810 (graph, lookup_node) = moduleGraphNodes drop_hs_boot_nodes summaries
1812 initial_graph = case mb_root_mod of
1815 -- restrict the graph to just those modules reachable from
1816 -- the specified module. We do this by building a graph with
1817 -- the full set of nodes, and determining the reachable set from
1818 -- the specified node.
1819 let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
1820 | otherwise = ghcError (ProgramError "module does not exist")
1821 in graphFromEdgedVertices (seq root (reachableG graph root))
1823 summaryNodeKey :: SummaryNode -> Int
1824 summaryNodeKey (_, k, _) = k
1826 summaryNodeSummary :: SummaryNode -> ModSummary
1827 summaryNodeSummary (s, _, _) = s
1829 moduleGraphNodes :: Bool -> [ModSummary]
1830 -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
1831 moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)
1833 numbered_summaries = zip summaries [1..]
1835 lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode
1836 lookup_node hs_src mod = lookupFM node_map (mod, hs_src)
1838 lookup_key :: HscSource -> ModuleName -> Maybe Int
1839 lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)
1841 node_map :: NodeMap SummaryNode
1842 node_map = listToFM [ ((moduleName (ms_mod s), ms_hsc_src s), node)
1843 | node@(s, _, _) <- nodes ]
1845 -- We use integers as the keys for the SCC algorithm
1846 nodes :: [SummaryNode]
1847 nodes = [ (s, key, out_keys)
1848 | (s, key) <- numbered_summaries
1849 -- Drop the hi-boot ones if told to do so
1850 , not (isBootSummary s && drop_hs_boot_nodes)
1851 , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
1852 out_edge_keys HsSrcFile (map unLoc (ms_home_imps s)) ++
1853 (-- see [boot-edges] below
1854 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
1856 else case lookup_key HsBootFile (ms_mod_name s) of
1860 -- [boot-edges] if this is a .hs and there is an equivalent
1861 -- .hs-boot, add a link from the former to the latter. This
1862 -- has the effect of detecting bogus cases where the .hs-boot
1863 -- depends on the .hs, by introducing a cycle. Additionally,
1864 -- it ensures that we will always process the .hs-boot before
1865 -- the .hs, and so the HomePackageTable will always have the
1866 -- most up to date information.
1868 -- Drop hs-boot nodes by using HsSrcFile as the key
1869 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1870 | otherwise = HsBootFile
1872 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1873 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1874 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1875 -- the IsBootInterface parameter True; else False
1878 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
1879 type NodeMap a = FiniteMap NodeKey a -- keyed by (mod, src_file_type) pairs
1881 msKey :: ModSummary -> NodeKey
1882 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1884 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1885 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
1887 nodeMapElts :: NodeMap a -> [a]
1888 nodeMapElts = eltsFM
1890 -- | If there are {-# SOURCE #-} imports between strongly connected
1891 -- components in the topological sort, then those imports can
1892 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1893 -- were necessary, then the edge would be part of a cycle.
1894 warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()
1895 warnUnnecessarySourceImports sccs =
1896 logWarnings (listToBag (concatMap (check.flattenSCC) sccs))
1898 let mods_in_this_cycle = map ms_mod_name ms in
1899 [ warn i | m <- ms, i <- ms_home_srcimps m,
1900 unLoc i `notElem` mods_in_this_cycle ]
1902 warn :: Located ModuleName -> WarnMsg
1905 (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
1906 <+> quotes (ppr mod))
1908 -----------------------------------------------------------------------------
1909 -- Downsweep (dependency analysis)
1911 -- Chase downwards from the specified root set, returning summaries
1912 -- for all home modules encountered. Only follow source-import
1915 -- We pass in the previous collection of summaries, which is used as a
1916 -- cache to avoid recalculating a module summary if the source is
1919 -- The returned list of [ModSummary] nodes has one node for each home-package
1920 -- module, plus one for any hs-boot files. The imports of these nodes
1921 -- are all there, including the imports of non-home-package modules.
1923 downsweep :: GhcMonad m =>
1925 -> [ModSummary] -- Old summaries
1926 -> [ModuleName] -- Ignore dependencies on these; treat
1927 -- them as if they were package modules
1928 -> Bool -- True <=> allow multiple targets to have
1929 -- the same module name; this is
1930 -- very useful for ghc -M
1932 -- The elts of [ModSummary] all have distinct
1933 -- (Modules, IsBoot) identifiers, unless the Bool is true
1934 -- in which case there can be repeats
1935 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1936 = do -- catch error messages and return them
1937 --handleErrMsg -- should be covered by GhcMonad now
1938 -- (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
1939 rootSummaries <- mapM getRootSummary roots
1940 let root_map = mkRootMap rootSummaries
1941 checkDuplicates root_map
1942 summs <- loop (concatMap msDeps rootSummaries) root_map
1945 roots = hsc_targets hsc_env
1947 old_summary_map :: NodeMap ModSummary
1948 old_summary_map = mkNodeMap old_summaries
1950 getRootSummary :: GhcMonad m => Target -> m ModSummary
1951 getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)
1952 = do exists <- liftIO $ doesFileExist file
1954 then summariseFile hsc_env old_summaries file mb_phase
1955 obj_allowed maybe_buf
1956 else throwOneError $ mkPlainErrMsg noSrcSpan $
1957 text "can't find file:" <+> text file
1958 getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
1959 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1960 (L rootLoc modl) obj_allowed
1962 case maybe_summary of
1963 Nothing -> packageModErr modl
1966 rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1968 -- In a root module, the filename is allowed to diverge from the module
1969 -- name, so we have to check that there aren't multiple root files
1970 -- defining the same module (otherwise the duplicates will be silently
1971 -- ignored, leading to confusing behaviour).
1972 checkDuplicates :: GhcMonad m => NodeMap [ModSummary] -> m ()
1973 checkDuplicates root_map
1974 | allow_dup_roots = return ()
1975 | null dup_roots = return ()
1976 | otherwise = liftIO $ multiRootsErr (head dup_roots)
1978 dup_roots :: [[ModSummary]] -- Each at least of length 2
1979 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1981 loop :: GhcMonad m =>
1982 [(Located ModuleName,IsBootInterface)]
1983 -- Work list: process these modules
1984 -> NodeMap [ModSummary]
1985 -- Visited set; the range is a list because
1986 -- the roots can have the same module names
1987 -- if allow_dup_roots is True
1989 -- The result includes the worklist, except
1990 -- for those mentioned in the visited set
1991 loop [] done = return (concat (nodeMapElts done))
1992 loop ((wanted_mod, is_boot) : ss) done
1993 | Just summs <- lookupFM done key
1994 = if isSingleton summs then
1997 do { liftIO $ multiRootsErr summs; return [] }
1999 = do mb_s <- summariseModule hsc_env old_summary_map
2000 is_boot wanted_mod True
2003 Nothing -> loop ss done
2004 Just s -> loop (msDeps s ++ ss) (addToFM done key [s])
2006 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
2008 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
2009 mkRootMap summaries = addListToFM_C (++) emptyFM
2010 [ (msKey s, [s]) | s <- summaries ]
2012 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
2013 -- (msDeps s) returns the dependencies of the ModSummary s.
2014 -- A wrinkle is that for a {-# SOURCE #-} import we return
2015 -- *both* the hs-boot file
2016 -- *and* the source file
2017 -- as "dependencies". That ensures that the list of all relevant
2018 -- modules always contains B.hs if it contains B.hs-boot.
2019 -- Remember, this pass isn't doing the topological sort. It's
2020 -- just gathering the list of all relevant ModSummaries
2022 concat [ [(m,True), (m,False)] | m <- ms_home_srcimps s ]
2023 ++ [ (m,False) | m <- ms_home_imps s ]
2025 home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
2026 home_imps imps = [ ideclName i | L _ i <- imps, isNothing (ideclPkgQual i) ]
2028 ms_home_allimps :: ModSummary -> [ModuleName]
2029 ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
2031 ms_home_srcimps :: ModSummary -> [Located ModuleName]
2032 ms_home_srcimps = home_imps . ms_srcimps
2034 ms_home_imps :: ModSummary -> [Located ModuleName]
2035 ms_home_imps = home_imps . ms_imps
2037 -----------------------------------------------------------------------------
2038 -- Summarising modules
2040 -- We have two types of summarisation:
2042 -- * Summarise a file. This is used for the root module(s) passed to
2043 -- cmLoadModules. The file is read, and used to determine the root
2044 -- module name. The module name may differ from the filename.
2046 -- * Summarise a module. We are given a module name, and must provide
2047 -- a summary. The finder is used to locate the file in which the module
2053 -> [ModSummary] -- old summaries
2054 -> FilePath -- source file name
2055 -> Maybe Phase -- start phase
2056 -> Bool -- object code allowed?
2057 -> Maybe (StringBuffer,ClockTime)
2060 summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
2061 -- we can use a cached summary if one is available and the
2062 -- source file hasn't changed, But we have to look up the summary
2063 -- by source file, rather than module name as we do in summarise.
2064 | Just old_summary <- findSummaryBySourceFile old_summaries file
2066 let location = ms_location old_summary
2068 -- return the cached summary if the source didn't change
2069 src_timestamp <- case maybe_buf of
2070 Just (_,t) -> return t
2071 Nothing -> liftIO $ getModificationTime file
2072 -- The file exists; we checked in getRootSummary above.
2073 -- If it gets removed subsequently, then this
2074 -- getModificationTime may fail, but that's the right
2077 if ms_hs_date old_summary == src_timestamp
2078 then do -- update the object-file timestamp
2080 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2081 || obj_allowed -- bug #1205
2082 then liftIO $ getObjTimestamp location False
2084 return old_summary{ ms_obj_date = obj_timestamp }
2092 let dflags = hsc_dflags hsc_env
2094 (dflags', hspp_fn, buf)
2095 <- preprocessFile hsc_env file mb_phase maybe_buf
2097 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
2099 -- Make a ModLocation for this file
2100 location <- liftIO $ mkHomeModLocation dflags mod_name file
2102 -- Tell the Finder cache where it is, so that subsequent calls
2103 -- to findModule will find it, even if it's not on any search path
2104 mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location
2106 src_timestamp <- case maybe_buf of
2107 Just (_,t) -> return t
2108 Nothing -> liftIO $ getModificationTime file
2109 -- getMofificationTime may fail
2111 -- when the user asks to load a source file by name, we only
2112 -- use an object file if -fobject-code is on. See #1205.
2114 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2115 || obj_allowed -- bug #1205
2116 then liftIO $ modificationTimeIfExists (ml_obj_file location)
2119 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
2120 ms_location = location,
2121 ms_hspp_file = hspp_fn,
2122 ms_hspp_opts = dflags',
2123 ms_hspp_buf = Just buf,
2124 ms_srcimps = srcimps, ms_imps = the_imps,
2125 ms_hs_date = src_timestamp,
2126 ms_obj_date = obj_timestamp })
2128 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
2129 findSummaryBySourceFile summaries file
2130 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
2131 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
2135 -- Summarise a module, and pick up source and timestamp.
2139 -> NodeMap ModSummary -- Map of old summaries
2140 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
2141 -> Located ModuleName -- Imported module to be summarised
2142 -> Bool -- object code allowed?
2143 -> Maybe (StringBuffer, ClockTime)
2144 -> [ModuleName] -- Modules to exclude
2145 -> m (Maybe ModSummary) -- Its new summary
2147 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
2148 obj_allowed maybe_buf excl_mods
2149 | wanted_mod `elem` excl_mods
2152 | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
2153 = do -- Find its new timestamp; all the
2154 -- ModSummaries in the old map have valid ml_hs_files
2155 let location = ms_location old_summary
2156 src_fn = expectJust "summariseModule" (ml_hs_file location)
2158 -- check the modification time on the source file, and
2159 -- return the cached summary if it hasn't changed. If the
2160 -- file has disappeared, we need to call the Finder again.
2162 Just (_,t) -> check_timestamp old_summary location src_fn t
2164 m <- liftIO $ System.IO.Error.try (getModificationTime src_fn)
2166 Right t -> check_timestamp old_summary location src_fn t
2167 Left e | isDoesNotExistError e -> find_it
2168 | otherwise -> liftIO $ ioError e
2170 | otherwise = find_it
2172 dflags = hsc_dflags hsc_env
2174 hsc_src = if is_boot then HsBootFile else HsSrcFile
2176 check_timestamp old_summary location src_fn src_timestamp
2177 | ms_hs_date old_summary == src_timestamp = do
2178 -- update the object-file timestamp
2179 obj_timestamp <- liftIO $
2180 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2181 || obj_allowed -- bug #1205
2182 then getObjTimestamp location is_boot
2184 return (Just old_summary{ ms_obj_date = obj_timestamp })
2186 -- source changed: re-summarise.
2187 new_summary location (ms_mod old_summary) src_fn src_timestamp
2190 -- Don't use the Finder's cache this time. If the module was
2191 -- previously a package module, it may have now appeared on the
2192 -- search path, so we want to consider it to be a home module. If
2193 -- the module was previously a home module, it may have moved.
2194 liftIO $ uncacheModule hsc_env wanted_mod
2195 found <- liftIO $ findImportedModule hsc_env wanted_mod Nothing
2198 | isJust (ml_hs_file location) ->
2200 just_found location mod
2202 -- Drop external-pkg
2203 ASSERT(modulePackageId mod /= thisPackage dflags)
2206 err -> liftIO $ noModError dflags loc wanted_mod err
2209 just_found location mod = do
2210 -- Adjust location to point to the hs-boot source file,
2211 -- hi file, object file, when is_boot says so
2212 let location' | is_boot = addBootSuffixLocn location
2213 | otherwise = location
2214 src_fn = expectJust "summarise2" (ml_hs_file location')
2216 -- Check that it exists
2217 -- It might have been deleted since the Finder last found it
2218 maybe_t <- liftIO $ modificationTimeIfExists src_fn
2220 Nothing -> noHsFileErr loc src_fn
2221 Just t -> new_summary location' mod src_fn t
2224 new_summary location mod src_fn src_timestamp
2226 -- Preprocess the source file and get its imports
2227 -- The dflags' contains the OPTIONS pragmas
2228 (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
2229 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
2231 when (mod_name /= wanted_mod) $
2232 throwOneError $ mkPlainErrMsg mod_loc $
2233 text "File name does not match module name:"
2234 $$ text "Saw:" <+> quotes (ppr mod_name)
2235 $$ text "Expected:" <+> quotes (ppr wanted_mod)
2237 -- Find the object timestamp, and return the summary
2238 obj_timestamp <- liftIO $
2239 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2240 || obj_allowed -- bug #1205
2241 then getObjTimestamp location is_boot
2244 return (Just (ModSummary { ms_mod = mod,
2245 ms_hsc_src = hsc_src,
2246 ms_location = location,
2247 ms_hspp_file = hspp_fn,
2248 ms_hspp_opts = dflags',
2249 ms_hspp_buf = Just buf,
2250 ms_srcimps = srcimps,
2252 ms_hs_date = src_timestamp,
2253 ms_obj_date = obj_timestamp }))
2256 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
2257 getObjTimestamp location is_boot
2258 = if is_boot then return Nothing
2259 else modificationTimeIfExists (ml_obj_file location)
2262 preprocessFile :: GhcMonad m =>
2265 -> Maybe Phase -- ^ Starting phase
2266 -> Maybe (StringBuffer,ClockTime)
2267 -> m (DynFlags, FilePath, StringBuffer)
2268 preprocessFile hsc_env src_fn mb_phase Nothing
2270 (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
2271 buf <- liftIO $ hGetStringBuffer hspp_fn
2272 return (dflags', hspp_fn, buf)
2274 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
2276 let dflags = hsc_dflags hsc_env
2277 -- case we bypass the preprocessing stage?
2279 local_opts = getOptions dflags buf src_fn
2281 (dflags', leftovers, warns)
2282 <- parseDynamicNoPackageFlags dflags local_opts
2283 checkProcessArgsResult leftovers
2284 handleFlagWarnings dflags' warns
2288 | Just (Unlit _) <- mb_phase = True
2289 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
2290 -- note: local_opts is only required if there's no Unlit phase
2291 | dopt Opt_Cpp dflags' = True
2292 | dopt Opt_Pp dflags' = True
2295 when needs_preprocessing $
2296 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
2298 return (dflags', src_fn, buf)
2301 -----------------------------------------------------------------------------
2303 -----------------------------------------------------------------------------
2305 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
2306 -- ToDo: we don't have a proper line number for this error
2307 noModError dflags loc wanted_mod err
2308 = throwOneError $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
2310 noHsFileErr :: GhcMonad m => SrcSpan -> String -> m a
2311 noHsFileErr loc path
2312 = throwOneError $ mkPlainErrMsg loc $ text "Can't find" <+> text path
2314 packageModErr :: GhcMonad m => ModuleName -> m a
2316 = throwOneError $ mkPlainErrMsg noSrcSpan $
2317 text "module" <+> quotes (ppr mod) <+> text "is a package module"
2319 multiRootsErr :: [ModSummary] -> IO ()
2320 multiRootsErr [] = panic "multiRootsErr"
2321 multiRootsErr summs@(summ1:_)
2322 = throwOneError $ mkPlainErrMsg noSrcSpan $
2323 text "module" <+> quotes (ppr mod) <+>
2324 text "is defined in multiple files:" <+>
2325 sep (map text files)
2328 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
2330 cyclicModuleErr :: [ModSummary] -> SDoc
2332 = hang (ptext (sLit "Module imports form a cycle for modules:"))
2333 2 (vcat (map show_one ms))
2335 show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
2336 nest 2 $ ptext (sLit "imports:") <+>
2337 (pp_imps HsBootFile (ms_srcimps ms)
2338 $$ pp_imps HsSrcFile (ms_imps ms))]
2339 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
2340 pp_imps src mods = fsep (map (show_mod src) mods)
2343 -- | Inform GHC that the working directory has changed. GHC will flush
2344 -- its cache of module locations, since it may no longer be valid.
2346 -- Note: Before changing the working directory make sure all threads running
2347 -- in the same session have stopped. If you change the working directory,
2348 -- you should also unload the current program (set targets to empty,
2349 -- followed by load).
2350 workingDirectoryChanged :: GhcMonad m => m ()
2351 workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)
2353 -- -----------------------------------------------------------------------------
2354 -- inspecting the session
2356 -- | Get the module dependency graph.
2357 getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
2358 getModuleGraph = liftM hsc_mod_graph getSession
2360 -- | Determines whether a set of modules requires Template Haskell.
2362 -- Note that if the session's 'DynFlags' enabled Template Haskell when
2363 -- 'depanal' was called, then each module in the returned module graph will
2364 -- have Template Haskell enabled whether it is actually needed or not.
2365 needsTemplateHaskell :: ModuleGraph -> Bool
2366 needsTemplateHaskell ms =
2367 any (dopt Opt_TemplateHaskell . ms_hspp_opts) ms
2369 -- | Return @True@ <==> module is loaded.
2370 isLoaded :: GhcMonad m => ModuleName -> m Bool
2371 isLoaded m = withSession $ \hsc_env ->
2372 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
2374 -- | Return the bindings for the current interactive session.
2375 getBindings :: GhcMonad m => m [TyThing]
2376 getBindings = withSession $ \hsc_env ->
2377 -- we have to implement the shadowing behaviour of ic_tmp_ids here
2378 -- (see InteractiveContext) and the quickest way is to use an OccEnv.
2380 occ_env = mkOccEnv [ (nameOccName (idName id), AnId id)
2381 | id <- ic_tmp_ids (hsc_IC hsc_env) ]
2383 return (occEnvElts occ_env)
2385 getPrintUnqual :: GhcMonad m => m PrintUnqualified
2386 getPrintUnqual = withSession $ \hsc_env ->
2387 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
2389 -- | Container for information about a 'Module'.
2390 data ModuleInfo = ModuleInfo {
2391 minf_type_env :: TypeEnv,
2392 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
2393 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
2394 minf_instances :: [Instance]
2396 ,minf_modBreaks :: ModBreaks
2398 -- ToDo: this should really contain the ModIface too
2400 -- We don't want HomeModInfo here, because a ModuleInfo applies
2401 -- to package modules too.
2403 -- | Request information about a loaded 'Module'
2404 getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X
2405 getModuleInfo mdl = withSession $ \hsc_env -> do
2406 let mg = hsc_mod_graph hsc_env
2407 if mdl `elem` map ms_mod mg
2408 then liftIO $ getHomeModuleInfo hsc_env (moduleName mdl)
2410 {- if isHomeModule (hsc_dflags hsc_env) mdl
2412 else -} liftIO $ getPackageModuleInfo hsc_env mdl
2413 -- getPackageModuleInfo will attempt to find the interface, so
2414 -- we don't want to call it for a home module, just in case there
2415 -- was a problem loading the module and the interface doesn't
2416 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
2418 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
2420 getPackageModuleInfo hsc_env mdl = do
2421 (_msgs, mb_avails) <- getModuleExports hsc_env mdl
2423 Nothing -> return Nothing
2425 eps <- readIORef (hsc_EPS hsc_env)
2427 names = availsToNameSet avails
2429 tys = [ ty | name <- concatMap availNames avails,
2430 Just ty <- [lookupTypeEnv pte name] ]
2432 return (Just (ModuleInfo {
2433 minf_type_env = mkTypeEnv tys,
2434 minf_exports = names,
2435 minf_rdr_env = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
2436 minf_instances = error "getModuleInfo: instances for package module unimplemented",
2437 minf_modBreaks = emptyModBreaks
2440 getPackageModuleInfo _hsc_env _mdl = do
2441 -- bogusly different for non-GHCI (ToDo)
2445 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
2446 getHomeModuleInfo hsc_env mdl =
2447 case lookupUFM (hsc_HPT hsc_env) mdl of
2448 Nothing -> return Nothing
2450 let details = hm_details hmi
2451 return (Just (ModuleInfo {
2452 minf_type_env = md_types details,
2453 minf_exports = availsToNameSet (md_exports details),
2454 minf_rdr_env = mi_globals $! hm_iface hmi,
2455 minf_instances = md_insts details
2457 ,minf_modBreaks = getModBreaks hmi
2461 -- | The list of top-level entities defined in a module
2462 modInfoTyThings :: ModuleInfo -> [TyThing]
2463 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
2465 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
2466 modInfoTopLevelScope minf
2467 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
2469 modInfoExports :: ModuleInfo -> [Name]
2470 modInfoExports minf = nameSetToList $! minf_exports minf
2472 -- | Returns the instances defined by the specified module.
2473 -- Warning: currently unimplemented for package modules.
2474 modInfoInstances :: ModuleInfo -> [Instance]
2475 modInfoInstances = minf_instances
2477 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
2478 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
2480 mkPrintUnqualifiedForModule :: GhcMonad m =>
2482 -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X
2483 mkPrintUnqualifiedForModule minf = withSession $ \hsc_env -> do
2484 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
2486 modInfoLookupName :: GhcMonad m =>
2488 -> m (Maybe TyThing) -- XXX: returns a Maybe X
2489 modInfoLookupName minf name = withSession $ \hsc_env -> do
2490 case lookupTypeEnv (minf_type_env minf) name of
2491 Just tyThing -> return (Just tyThing)
2493 eps <- liftIO $ readIORef (hsc_EPS hsc_env)
2494 return $! lookupType (hsc_dflags hsc_env)
2495 (hsc_HPT hsc_env) (eps_PTE eps) name
2498 modInfoModBreaks :: ModuleInfo -> ModBreaks
2499 modInfoModBreaks = minf_modBreaks
2502 isDictonaryId :: Id -> Bool
2504 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
2506 -- | Looks up a global name: that is, any top-level name in any
2507 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
2508 -- the interactive context, and therefore does not require a preceding
2510 lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
2511 lookupGlobalName name = withSession $ \hsc_env -> do
2512 liftIO $ lookupTypeHscEnv hsc_env name
2514 findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
2515 findGlobalAnns deserialize target = withSession $ \hsc_env -> do
2516 ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
2517 return (findAnns deserialize ann_env target)
2520 -- | get the GlobalRdrEnv for a session
2521 getGRE :: GhcMonad m => m GlobalRdrEnv
2522 getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
2525 -- -----------------------------------------------------------------------------
2527 -- | Return all /external/ modules available in the package database.
2528 -- Modules from the current session (i.e., from the 'HomePackageTable') are
2530 packageDbModules :: GhcMonad m =>
2531 Bool -- ^ Only consider exposed packages.
2533 packageDbModules only_exposed = do
2534 dflags <- getSessionDynFlags
2535 let pkgs = UFM.eltsUFM (pkgIdMap (pkgState dflags))
2537 [ mkModule pid modname | p <- pkgs
2538 , not only_exposed || exposed p
2539 , let pid = packageConfigId p
2540 , modname <- exposedModules p ]
2542 -- -----------------------------------------------------------------------------
2543 -- Misc exported utils
2545 dataConType :: DataCon -> Type
2546 dataConType dc = idType (dataConWrapId dc)
2548 -- | print a 'NamedThing', adding parentheses if the name is an operator.
2549 pprParenSymName :: NamedThing a => a -> SDoc
2550 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
2552 -- ----------------------------------------------------------------------------
2557 -- - Data and Typeable instances for HsSyn.
2559 -- ToDo: check for small transformations that happen to the syntax in
2560 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
2562 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
2563 -- to get from TyCons, Ids etc. to TH syntax (reify).
2565 -- :browse will use either lm_toplev or inspect lm_interface, depending
2566 -- on whether the module is interpreted or not.
2570 -- Extract the filename, stringbuffer content and dynflags associed to a module
2572 -- XXX: Explain pre-conditions
2573 getModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynFlags)
2574 getModuleSourceAndFlags mod = do
2575 m <- getModSummary (moduleName mod)
2576 case ml_hs_file $ ms_location m of
2577 Nothing -> throw $ mkApiErr (text "No source available for module " <+> ppr mod)
2578 Just sourceFile -> do
2579 source <- liftIO $ hGetStringBuffer sourceFile
2580 return (sourceFile, source, ms_hspp_opts m)
2583 -- | Return module source as token stream, including comments.
2585 -- The module must be in the module graph and its source must be available.
2586 -- Throws a 'HscTypes.SourceError' on parse error.
2587 getTokenStream :: GhcMonad m => Module -> m [Located Token]
2588 getTokenStream mod = do
2589 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
2590 let startLoc = mkSrcLoc (mkFastString sourceFile) 0 0
2591 case lexTokenStream source startLoc flags of
2592 POk _ ts -> return ts
2593 PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
2595 -- | Give even more information on the source than 'getTokenStream'
2596 -- This function allows reconstructing the source completely with
2597 -- 'showRichTokenStream'.
2598 getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
2599 getRichTokenStream mod = do
2600 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
2601 let startLoc = mkSrcLoc (mkFastString sourceFile) 0 0
2602 case lexTokenStream source startLoc flags of
2603 POk _ ts -> return $ addSourceToTokens startLoc source ts
2604 PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
2606 -- | Given a source location and a StringBuffer corresponding to this
2607 -- location, return a rich token stream with the source associated to the
2609 addSourceToTokens :: SrcLoc -> StringBuffer -> [Located Token]
2610 -> [(Located Token, String)]
2611 addSourceToTokens _ _ [] = []
2612 addSourceToTokens loc buf (t@(L span _) : ts)
2613 | not (isGoodSrcSpan span) = (t,"") : addSourceToTokens loc buf ts
2614 | otherwise = (t,str) : addSourceToTokens newLoc newBuf ts
2616 (newLoc, newBuf, str) = go "" loc buf
2617 start = srcSpanStart span
2618 end = srcSpanEnd span
2619 go acc loc buf | loc < start = go acc nLoc nBuf
2620 | start <= loc && loc < end = go (ch:acc) nLoc nBuf
2621 | otherwise = (loc, buf, reverse acc)
2622 where (ch, nBuf) = nextChar buf
2623 nLoc = advanceSrcLoc loc ch
2626 -- | Take a rich token stream such as produced from 'getRichTokenStream' and
2627 -- return source code almost identical to the original code (except for
2628 -- insignificant whitespace.)
2629 showRichTokenStream :: [(Located Token, String)] -> String
2630 showRichTokenStream ts = go startLoc ts ""
2631 where sourceFile = srcSpanFile (getLoc . fst . head $ ts)
2632 startLoc = mkSrcLoc sourceFile 0 0
2634 go loc ((L span _, str):ts)
2635 | not (isGoodSrcSpan span) = go loc ts
2636 | locLine == tokLine = ((replicate (tokCol - locCol) ' ') ++)
2639 | otherwise = ((replicate (tokLine - locLine) '\n') ++)
2640 . ((replicate tokCol ' ') ++)
2643 where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
2644 (tokLine, tokCol) = (srcSpanStartLine span, srcSpanStartCol span)
2645 tokEnd = srcSpanEnd span
2647 -- -----------------------------------------------------------------------------
2648 -- Interactive evaluation
2650 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
2651 -- filesystem and package database to find the corresponding 'Module',
2652 -- using the algorithm that is used for an @import@ declaration.
2653 findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
2654 findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
2656 dflags = hsc_dflags hsc_env
2657 this_pkg = thisPackage dflags
2660 Just pkg | fsToPackageId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
2661 res <- findImportedModule hsc_env mod_name maybe_pkg
2663 Found _ m -> return m
2664 err -> noModError dflags noSrcSpan mod_name err
2666 home <- lookupLoadedHomeModule mod_name
2669 Nothing -> liftIO $ do
2670 res <- findImportedModule hsc_env mod_name maybe_pkg
2672 Found loc m | modulePackageId m /= this_pkg -> return m
2673 | otherwise -> modNotLoadedError m loc
2674 err -> noModError dflags noSrcSpan mod_name err
2676 modNotLoadedError :: Module -> ModLocation -> IO a
2677 modNotLoadedError m loc = ghcError $ CmdLineError $ showSDoc $
2678 text "module is not loaded:" <+>
2679 quotes (ppr (moduleName m)) <+>
2680 parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
2682 -- | Like 'findModule', but differs slightly when the module refers to
2683 -- a source file, and the file has not been loaded via 'load'. In
2684 -- this case, 'findModule' will throw an error (module not loaded),
2685 -- but 'lookupModule' will check to see whether the module can also be
2686 -- found in a package, and if so, that package 'Module' will be
2687 -- returned. If not, the usual module-not-found error will be thrown.
2689 lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
2690 lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
2691 lookupModule mod_name Nothing = withSession $ \hsc_env -> do
2692 home <- lookupLoadedHomeModule mod_name
2695 Nothing -> liftIO $ do
2696 res <- findExposedPackageModule hsc_env mod_name Nothing
2698 Found _ m -> return m
2699 err -> noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
2701 lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)
2702 lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
2703 case lookupUFM (hsc_HPT hsc_env) mod_name of
2704 Just mod_info -> return (Just (mi_module (hm_iface mod_info)))
2705 _not_a_home_module -> return Nothing
2708 getHistorySpan :: GhcMonad m => History -> m SrcSpan
2709 getHistorySpan h = withSession $ \hsc_env ->
2710 return$ InteractiveEval.getHistorySpan hsc_env h
2712 obtainTermFromVal :: GhcMonad m => Int -> Bool -> Type -> a -> m Term
2713 obtainTermFromVal bound force ty a =
2714 withSession $ \hsc_env ->
2715 liftIO $ InteractiveEval.obtainTermFromVal hsc_env bound force ty a
2717 obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
2718 obtainTermFromId bound force id =
2719 withSession $ \hsc_env ->
2720 liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id
projects / ghc-hetmet.git / blob