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 -- * Loading\/compiling the program
41 load, loadWithLogger, LoadHowMuch(..),
42 SuccessFlag(..), succeeded, failed,
43 defaultWarnErrLogger, WarnErrLogger,
44 workingDirectoryChanged,
45 parseModule, typecheckModule, desugarModule, loadModule,
46 ParsedModule(..), TypecheckedModule(..), DesugaredModule(..),
47 TypecheckedSource, ParsedSource, RenamedSource, -- ditto
48 TypecheckedMod, ParsedMod,
49 moduleInfo, renamedSource, typecheckedSource,
50 parsedSource, coreModule,
51 compileToCoreModule, compileToCoreSimplified,
55 -- * Inspecting the module structure of the program
56 ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
61 -- * Inspecting modules
68 modInfoIsExportedName,
72 mkPrintUnqualifiedForModule,
74 -- * Querying the environment
78 PrintUnqualified, alwaysQualify,
80 -- * Interactive evaluation
81 getBindings, getPrintUnqual,
85 setContext, getContext,
95 runStmt, parseImportDecl, SingleStep(..),
97 Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
98 resumeHistory, resumeHistoryIx),
99 History(historyBreakInfo, historyEnclosingDecl),
100 GHC.getHistorySpan, getHistoryModule,
103 InteractiveEval.back,
104 InteractiveEval.forward,
107 InteractiveEval.compileExpr, HValue, dynCompileExpr,
108 GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
110 ModBreaks(..), BreakIndex,
111 BreakInfo(breakInfo_number, breakInfo_module),
112 BreakArray, setBreakOn, setBreakOff, getBreak,
116 -- * Abstract syntax elements
122 Module, mkModule, pprModule, moduleName, modulePackageId,
123 ModuleName, mkModuleName, moduleNameString,
127 isExternalName, nameModule, pprParenSymName, nameSrcSpan,
129 RdrName(Qual,Unqual),
133 isImplicitId, isDeadBinder,
134 isExportedId, isLocalId, isGlobalId,
136 isPrimOpId, isFCallId, isClassOpId_maybe,
137 isDataConWorkId, idDataCon,
138 isBottomingId, isDictonaryId,
139 recordSelectorFieldLabel,
141 -- ** Type constructors
143 tyConTyVars, tyConDataCons, tyConArity,
144 isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
146 synTyConDefn, synTyConType, synTyConResKind,
152 -- ** Data constructors
154 dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
155 dataConIsInfix, isVanillaDataCon, dataConUserType,
157 StrictnessMark(..), isMarkedStrict,
161 classMethods, classSCTheta, classTvsFds,
166 instanceDFunId, pprInstance, pprInstanceHdr,
168 -- ** Types and Kinds
169 Type, splitForAllTys, funResultTy,
170 pprParendType, pprTypeApp,
173 ThetaType, pprForAll, pprThetaArrow,
179 module HsSyn, -- ToDo: remove extraneous bits
183 defaultFixity, maxPrecedence,
187 -- ** Source locations
189 mkSrcLoc, isGoodSrcLoc, noSrcLoc,
190 srcLocFile, srcLocLine, srcLocCol,
192 mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
193 srcSpanStart, srcSpanEnd,
195 srcSpanStartLine, srcSpanEndLine,
196 srcSpanStartCol, srcSpanEndCol,
201 -- *** Constructing Located
202 noLoc, mkGeneralLocated,
204 -- *** Deconstructing Located
207 -- *** Combining and comparing Located values
208 eqLocated, cmpLocated, combineLocs, addCLoc,
209 leftmost_smallest, leftmost_largest, rightmost,
213 GhcException(..), showGhcException,
215 -- * Token stream manipulations
217 getTokenStream, getRichTokenStream,
218 showRichTokenStream, addSourceToTokens,
228 * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
229 * what StaticFlags should we expose, if any?
232 #include "HsVersions.h"
235 import qualified Linker
236 import Linker ( HValue )
239 import InteractiveEval
245 import TcRnMonad ( initIfaceCheck )
249 import qualified HsSyn -- hack as we want to reexport the whole module
250 import HsSyn hiding ((<.>))
252 import Coercion ( synTyConResKind )
253 import TcType hiding( typeKind )
256 import TysPrim ( alphaTyVars )
261 import Name hiding ( varName )
262 -- import OccName ( parenSymOcc )
263 import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr,
265 import FamInstEnv ( emptyFamInstEnv )
269 import DriverPipeline
270 import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase )
276 import StaticFlagParser
277 import qualified StaticFlags
278 import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
285 import Bag ( unitBag, listToBag, emptyBag, isEmptyBag )
289 import StringBuffer ( StringBuffer, hGetStringBuffer, nextChar )
292 import Maybes ( expectJust, mapCatMaybes )
296 import System.Directory ( getModificationTime, doesFileExist,
297 getCurrentDirectory )
299 import Data.Map (Map)
300 import qualified Data.Map as Map
301 import qualified FiniteMap as Map
303 import qualified Data.List as List
304 import Data.Typeable ( Typeable )
305 import Data.Word ( Word8 )
307 import System.Exit ( exitWith, ExitCode(..) )
308 import System.Time ( ClockTime, getClockTime )
311 import System.FilePath
313 import System.IO.Error ( try, isDoesNotExistError )
314 import Prelude hiding (init)
317 -- -----------------------------------------------------------------------------
318 -- Exception handlers
320 -- | Install some default exception handlers and run the inner computation.
321 -- Unless you want to handle exceptions yourself, you should wrap this around
322 -- the top level of your program. The default handlers output the error
323 -- message(s) to stderr and exit cleanly.
324 defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => DynFlags -> m a -> m a
325 defaultErrorHandler dflags inner =
326 -- top-level exception handler: any unrecognised exception is a compiler bug.
327 ghandle (\exception -> liftIO $ do
329 case fromException exception of
330 -- an IO exception probably isn't our fault, so don't panic
331 Just (ioe :: IOException) ->
332 fatalErrorMsg dflags (text (show ioe))
333 _ -> case fromException exception of
334 Just UserInterrupt -> exitWith (ExitFailure 1)
335 Just StackOverflow ->
336 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
337 _ -> case fromException exception of
338 Just (ex :: ExitCode) -> throw ex
341 (text (show (Panic (show exception))))
342 exitWith (ExitFailure 1)
345 -- error messages propagated as exceptions
350 PhaseFailed _ code -> exitWith code
351 Signal _ -> exitWith (ExitFailure 1)
352 _ -> do fatalErrorMsg dflags (text (show ge))
353 exitWith (ExitFailure 1)
357 -- | Install a default cleanup handler to remove temporary files deposited by
358 -- a GHC run. This is seperate from 'defaultErrorHandler', because you might
359 -- want to override the error handling, but still get the ordinary cleanup
361 defaultCleanupHandler :: (ExceptionMonad m, MonadIO m) =>
362 DynFlags -> m a -> m a
363 defaultCleanupHandler dflags inner =
364 -- make sure we clean up after ourselves
367 cleanTempFiles dflags
370 -- exceptions will be blocked while we clean the temporary files,
371 -- so there shouldn't be any difficulty if we receive further
374 -- | Print the error message and all warnings. Useful inside exception
375 -- handlers. Clears warnings after printing.
376 printExceptionAndWarnings :: GhcMonad m => SourceError -> m ()
377 printExceptionAndWarnings err = do
378 let errs = srcErrorMessages err
380 dflags <- getSessionDynFlags
382 -- Empty errors means we failed due to -Werror. (Since this function
383 -- takes a source error as argument, we know for sure _some_ error
384 -- did indeed happen.)
386 printBagOfWarnings dflags warns
387 printBagOfErrors dflags (unitBag warnIsErrorMsg)
388 else liftIO $ printBagOfErrors dflags errs
391 -- | Print all accumulated warnings using 'log_action'.
392 printWarnings :: GhcMonad m => m ()
394 dflags <- getSessionDynFlags
396 liftIO $ printBagOfWarnings dflags warns
399 -- | Run function for the 'Ghc' monad.
401 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
402 -- to this function will create a new session which should not be shared among
405 -- Any errors not handled inside the 'Ghc' action are propagated as IO
408 runGhc :: Maybe FilePath -- ^ See argument to 'initGhcMonad'.
409 -> Ghc a -- ^ The action to perform.
411 runGhc mb_top_dir ghc = do
412 wref <- newIORef emptyBag
413 ref <- newIORef undefined
414 let session = Session ref wref
415 flip unGhc session $ do
416 initGhcMonad mb_top_dir
418 -- XXX: unregister interrupt handlers here?
420 -- | Run function for 'GhcT' monad transformer.
422 -- It initialises the GHC session and warnings via 'initGhcMonad'. Each call
423 -- to this function will create a new session which should not be shared among
426 runGhcT :: (ExceptionMonad m, Functor m, MonadIO m) =>
427 Maybe FilePath -- ^ See argument to 'initGhcMonad'.
428 -> GhcT m a -- ^ The action to perform.
430 runGhcT mb_top_dir ghct = do
431 wref <- liftIO $ newIORef emptyBag
432 ref <- liftIO $ newIORef undefined
433 let session = Session ref wref
434 flip unGhcT session $ do
435 initGhcMonad mb_top_dir
438 -- | Initialise a GHC session.
440 -- If you implement a custom 'GhcMonad' you must call this function in the
441 -- monad run function. It will initialise the session variable and clear all
444 -- The first argument should point to the directory where GHC's library files
445 -- reside. More precisely, this should be the output of @ghc --print-libdir@
446 -- of the version of GHC the module using this API is compiled with. For
447 -- portability, you should use the @ghc-paths@ package, available at
448 -- <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/ghc-paths>.
450 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
451 initGhcMonad mb_top_dir = do
453 liftIO $ installSignalHandlers
455 liftIO $ StaticFlags.initStaticOpts
457 dflags0 <- liftIO $ initDynFlags defaultDynFlags
458 dflags <- liftIO $ initSysTools mb_top_dir dflags0
459 env <- liftIO $ newHscEnv defaultCallbacks dflags
463 defaultCallbacks :: GhcApiCallbacks
466 reportModuleCompilationResult =
467 \_ mb_err -> defaultWarnErrLogger mb_err
470 -- -----------------------------------------------------------------------------
473 -- | Grabs the DynFlags from the Session
474 getSessionDynFlags :: GhcMonad m => m DynFlags
475 getSessionDynFlags = withSession (return . hsc_dflags)
477 -- | Updates the DynFlags in a Session. This also reads
478 -- the package database (unless it has already been read),
479 -- and prepares the compilers knowledge about packages. It
480 -- can be called again to load new packages: just add new
481 -- package flags to (packageFlags dflags).
483 -- Returns a list of new packages that may need to be linked in using
484 -- the dynamic linker (see 'linkPackages') as a result of new package
485 -- flags. If you are not doing linking or doing static linking, you
486 -- can ignore the list of packages returned.
488 setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
489 setSessionDynFlags dflags = do
490 (dflags', preload) <- liftIO $ initPackages dflags
491 modifySession (\h -> h{ hsc_dflags = dflags' })
494 -- | If there is no -o option, guess the name of target executable
495 -- by using top-level source file name as a base.
496 guessOutputFile :: GhcMonad m => m ()
497 guessOutputFile = modifySession $ \env ->
498 let dflags = hsc_dflags env
499 mod_graph = hsc_mod_graph env
500 mainModuleSrcPath :: Maybe String
501 mainModuleSrcPath = do
502 let isMain = (== mainModIs dflags) . ms_mod
503 [ms] <- return (filter isMain mod_graph)
504 ml_hs_file (ms_location ms)
505 name = fmap dropExtension mainModuleSrcPath
507 #if defined(mingw32_HOST_OS)
508 -- we must add the .exe extention unconditionally here, otherwise
509 -- when name has an extension of its own, the .exe extension will
510 -- not be added by DriverPipeline.exeFileName. See #2248
511 name_exe = fmap (<.> "exe") name
516 case outputFile dflags of
518 Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } }
520 -- -----------------------------------------------------------------------------
523 -- ToDo: think about relative vs. absolute file paths. And what
524 -- happens when the current directory changes.
526 -- | Sets the targets for this session. Each target may be a module name
527 -- or a filename. The targets correspond to the set of root modules for
528 -- the program\/library. Unloading the current program is achieved by
529 -- setting the current set of targets to be empty, followed by 'load'.
530 setTargets :: GhcMonad m => [Target] -> m ()
531 setTargets targets = modifySession (\h -> h{ hsc_targets = targets })
533 -- | Returns the current set of targets
534 getTargets :: GhcMonad m => m [Target]
535 getTargets = withSession (return . hsc_targets)
537 -- | Add another target.
538 addTarget :: GhcMonad m => Target -> m ()
540 = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
543 removeTarget :: GhcMonad m => TargetId -> m ()
544 removeTarget target_id
545 = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
547 filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
549 -- | Attempts to guess what Target a string refers to. This function
550 -- implements the @--make@/GHCi command-line syntax for filenames:
552 -- - if the string looks like a Haskell source filename, then interpret it
555 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
558 -- - otherwise interpret the string as a module name
560 guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
561 guessTarget str (Just phase)
562 = return (Target (TargetFile str (Just phase)) True Nothing)
563 guessTarget str Nothing
564 | isHaskellSrcFilename file
565 = return (target (TargetFile file Nothing))
567 = do exists <- liftIO $ doesFileExist hs_file
569 then return (target (TargetFile hs_file Nothing))
571 exists <- liftIO $ doesFileExist lhs_file
573 then return (target (TargetFile lhs_file Nothing))
575 if looksLikeModuleName file
576 then return (target (TargetModule (mkModuleName file)))
579 (ProgramError (showSDoc $
580 text "target" <+> quotes (text file) <+>
581 text "is not a module name or a source file"))
584 | '*':rest <- str = (rest, False)
585 | otherwise = (str, True)
587 hs_file = file <.> "hs"
588 lhs_file = file <.> "lhs"
590 target tid = Target tid obj_allowed Nothing
592 -- -----------------------------------------------------------------------------
593 -- Loading the program
595 -- | Perform a dependency analysis starting from the current targets
596 -- and update the session with the new module graph.
598 -- Dependency analysis entails parsing the @import@ directives and may
599 -- therefore require running certain preprocessors.
601 -- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.
602 -- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the
603 -- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module. Thus if you want to
604 -- changes to the 'DynFlags' to take effect you need to call this function
607 depanal :: GhcMonad m =>
608 [ModuleName] -- ^ excluded modules
609 -> Bool -- ^ allow duplicate roots
611 depanal excluded_mods allow_dup_roots = do
612 hsc_env <- getSession
614 dflags = hsc_dflags hsc_env
615 targets = hsc_targets hsc_env
616 old_graph = hsc_mod_graph hsc_env
618 liftIO $ showPass dflags "Chasing dependencies"
619 liftIO $ debugTraceMsg dflags 2 (hcat [
620 text "Chasing modules from: ",
621 hcat (punctuate comma (map pprTarget targets))])
623 mod_graph <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
624 modifySession $ \_ -> hsc_env { hsc_mod_graph = mod_graph }
627 -- | Describes which modules of the module graph need to be loaded.
630 -- ^ Load all targets and its dependencies.
631 | LoadUpTo ModuleName
632 -- ^ Load only the given module and its dependencies.
633 | LoadDependenciesOf ModuleName
634 -- ^ Load only the dependencies of the given module, but not the module
637 -- | Try to load the program. See 'LoadHowMuch' for the different modes.
639 -- This function implements the core of GHC's @--make@ mode. It preprocesses,
640 -- compiles and loads the specified modules, avoiding re-compilation wherever
641 -- possible. Depending on the target (see 'DynFlags.hscTarget') compilating
642 -- and loading may result in files being created on disk.
644 -- Calls the 'reportModuleCompilationResult' callback after each compiling
645 -- each module, whether successful or not.
647 -- Throw a 'SourceError' if errors are encountered before the actual
648 -- compilation starts (e.g., during dependency analysis). All other errors
649 -- are reported using the callback.
651 load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
653 mod_graph <- depanal [] False
654 load2 how_much mod_graph
656 -- | A function called to log warnings and errors.
657 type WarnErrLogger = GhcMonad m => Maybe SourceError -> m ()
659 defaultWarnErrLogger :: WarnErrLogger
660 defaultWarnErrLogger Nothing = printWarnings
661 defaultWarnErrLogger (Just e) = printExceptionAndWarnings e
663 -- | Try to load the program. If a Module is supplied, then just
664 -- attempt to load up to this target. If no Module is supplied,
665 -- then try to load all targets.
667 -- The first argument is a function that is called after compiling each
668 -- module to print wanrings and errors.
670 -- While compiling a module, all 'SourceError's are caught and passed to the
671 -- logger, however, this function may still throw a 'SourceError' if
672 -- dependency analysis failed (e.g., due to a parse error).
674 loadWithLogger :: GhcMonad m => WarnErrLogger -> LoadHowMuch -> m SuccessFlag
675 loadWithLogger logger how_much = do
676 -- Dependency analysis first. Note that this fixes the module graph:
677 -- even if we don't get a fully successful upsweep, the full module
678 -- graph is still retained in the Session. We can tell which modules
679 -- were successfully loaded by inspecting the Session's HPT.
680 withLocalCallbacks (\cbs -> cbs { reportModuleCompilationResult =
684 load2 :: GhcMonad m => LoadHowMuch -> [ModSummary]
686 load2 how_much mod_graph = do
688 hsc_env <- getSession
690 let hpt1 = hsc_HPT hsc_env
691 let dflags = hsc_dflags hsc_env
693 -- The "bad" boot modules are the ones for which we have
694 -- B.hs-boot in the module graph, but no B.hs
695 -- The downsweep should have ensured this does not happen
697 let all_home_mods = [ms_mod_name s
698 | s <- mod_graph, not (isBootSummary s)]
699 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
700 not (ms_mod_name s `elem` all_home_mods)]
701 ASSERT( null bad_boot_mods ) return ()
703 -- check that the module given in HowMuch actually exists, otherwise
704 -- topSortModuleGraph will bomb later.
705 let checkHowMuch (LoadUpTo m) = checkMod m
706 checkHowMuch (LoadDependenciesOf m) = checkMod m
710 | m `elem` all_home_mods = and_then
712 liftIO $ errorMsg dflags (text "no such module:" <+>
716 checkHowMuch how_much $ do
718 -- mg2_with_srcimps drops the hi-boot nodes, returning a
719 -- graph with cycles. Among other things, it is used for
720 -- backing out partially complete cycles following a failed
721 -- upsweep, and for removing from hpt all the modules
722 -- not in strict downwards closure, during calls to compile.
723 let mg2_with_srcimps :: [SCC ModSummary]
724 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
726 -- If we can determine that any of the {-# SOURCE #-} imports
727 -- are definitely unnecessary, then emit a warning.
728 warnUnnecessarySourceImports mg2_with_srcimps
731 -- check the stability property for each module.
732 stable_mods@(stable_obj,stable_bco)
733 = checkStability hpt1 mg2_with_srcimps all_home_mods
735 -- prune bits of the HPT which are definitely redundant now,
737 pruned_hpt = pruneHomePackageTable hpt1
738 (flattenSCCs mg2_with_srcimps)
741 _ <- liftIO $ evaluate pruned_hpt
743 -- before we unload anything, make sure we don't leave an old
744 -- interactive context around pointing to dead bindings. Also,
745 -- write the pruned HPT to allow the old HPT to be GC'd.
746 modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext,
747 hsc_HPT = pruned_hpt }
749 liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
750 text "Stable BCO:" <+> ppr stable_bco)
752 -- Unload any modules which are going to be re-linked this time around.
753 let stable_linkables = [ linkable
754 | m <- stable_obj++stable_bco,
755 Just hmi <- [lookupUFM pruned_hpt m],
756 Just linkable <- [hm_linkable hmi] ]
757 liftIO $ unload hsc_env stable_linkables
759 -- We could at this point detect cycles which aren't broken by
760 -- a source-import, and complain immediately, but it seems better
761 -- to let upsweep_mods do this, so at least some useful work gets
762 -- done before the upsweep is abandoned.
763 --hPutStrLn stderr "after tsort:\n"
764 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
766 -- Now do the upsweep, calling compile for each module in
767 -- turn. Final result is version 3 of everything.
769 -- Topologically sort the module graph, this time including hi-boot
770 -- nodes, and possibly just including the portion of the graph
771 -- reachable from the module specified in the 2nd argument to load.
772 -- This graph should be cycle-free.
773 -- If we're restricting the upsweep to a portion of the graph, we
774 -- also want to retain everything that is still stable.
775 let full_mg :: [SCC ModSummary]
776 full_mg = topSortModuleGraph False mod_graph Nothing
778 maybe_top_mod = case how_much of
780 LoadDependenciesOf m -> Just m
783 partial_mg0 :: [SCC ModSummary]
784 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
786 -- LoadDependenciesOf m: we want the upsweep to stop just
787 -- short of the specified module (unless the specified module
790 | LoadDependenciesOf _mod <- how_much
791 = ASSERT( case last partial_mg0 of
792 AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
793 List.init partial_mg0
799 | AcyclicSCC ms <- full_mg,
800 ms_mod_name ms `elem` stable_obj++stable_bco,
801 ms_mod_name ms `notElem` [ ms_mod_name ms' |
802 AcyclicSCC ms' <- partial_mg ] ]
804 mg = stable_mg ++ partial_mg
806 -- clean up between compilations
807 let cleanup = cleanTempFilesExcept dflags
808 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
810 liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
812 (upsweep_ok, hsc_env1, modsUpswept)
813 <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
814 pruned_hpt stable_mods cleanup mg
816 -- Make modsDone be the summaries for each home module now
817 -- available; this should equal the domain of hpt3.
818 -- Get in in a roughly top .. bottom order (hence reverse).
820 let modsDone = reverse modsUpswept
822 -- Try and do linking in some form, depending on whether the
823 -- upsweep was completely or only partially successful.
825 if succeeded upsweep_ok
828 -- Easy; just relink it all.
829 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep completely successful.")
831 -- Clean up after ourselves
832 liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
834 -- Issue a warning for the confusing case where the user
835 -- said '-o foo' but we're not going to do any linking.
836 -- We attempt linking if either (a) one of the modules is
837 -- called Main, or (b) the user said -no-hs-main, indicating
838 -- that main() is going to come from somewhere else.
840 let ofile = outputFile dflags
841 let no_hs_main = dopt Opt_NoHsMain dflags
843 main_mod = mainModIs dflags
844 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
845 do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib
847 when (ghcLink dflags == LinkBinary
848 && isJust ofile && not do_linking) $
849 liftIO $ debugTraceMsg dflags 1 $
850 text ("Warning: output was redirected with -o, " ++
851 "but no output will be generated\n" ++
852 "because there is no " ++
853 moduleNameString (moduleName main_mod) ++ " module.")
855 -- link everything together
856 linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
858 loadFinish Succeeded linkresult hsc_env1
861 -- Tricky. We need to back out the effects of compiling any
862 -- half-done cycles, both so as to clean up the top level envs
863 -- and to avoid telling the interactive linker to link them.
864 do liftIO $ debugTraceMsg dflags 2 (text "Upsweep partially successful.")
867 = map ms_mod modsDone
868 let mods_to_zap_names
869 = findPartiallyCompletedCycles modsDone_names
872 = filter ((`notElem` mods_to_zap_names).ms_mod)
875 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
878 -- Clean up after ourselves
879 liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
881 -- there should be no Nothings where linkables should be, now
882 ASSERT(all (isJust.hm_linkable)
883 (eltsUFM (hsc_HPT hsc_env))) do
885 -- Link everything together
886 linkresult <- liftIO $ link (ghcLink dflags) dflags False hpt4
888 let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
889 loadFinish Failed linkresult hsc_env4
891 -- Finish up after a load.
893 -- If the link failed, unload everything and return.
894 loadFinish :: GhcMonad m =>
895 SuccessFlag -> SuccessFlag -> HscEnv
897 loadFinish _all_ok Failed hsc_env
898 = do liftIO $ unload hsc_env []
899 modifySession $ \_ -> discardProg hsc_env
902 -- Empty the interactive context and set the module context to the topmost
903 -- newly loaded module, or the Prelude if none were loaded.
904 loadFinish all_ok Succeeded hsc_env
905 = do modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext }
909 -- Forget the current program, but retain the persistent info in HscEnv
910 discardProg :: HscEnv -> HscEnv
912 = hsc_env { hsc_mod_graph = emptyMG,
913 hsc_IC = emptyInteractiveContext,
914 hsc_HPT = emptyHomePackageTable }
916 -- used to fish out the preprocess output files for the purposes of
917 -- cleaning up. The preprocessed file *might* be the same as the
918 -- source file, but that doesn't do any harm.
919 ppFilesFromSummaries :: [ModSummary] -> [FilePath]
920 ppFilesFromSummaries summaries = map ms_hspp_file summaries
922 -- -----------------------------------------------------------------------------
924 class ParsedMod m where
925 modSummary :: m -> ModSummary
926 parsedSource :: m -> ParsedSource
928 class ParsedMod m => TypecheckedMod m where
929 renamedSource :: m -> Maybe RenamedSource
930 typecheckedSource :: m -> TypecheckedSource
931 moduleInfo :: m -> ModuleInfo
932 tm_internals :: m -> (TcGblEnv, ModDetails)
933 -- ToDo: improvements that could be made here:
934 -- if the module succeeded renaming but not typechecking,
935 -- we can still get back the GlobalRdrEnv and exports, so
936 -- perhaps the ModuleInfo should be split up into separate
939 class TypecheckedMod m => DesugaredMod m where
940 coreModule :: m -> ModGuts
942 -- | The result of successful parsing.
944 ParsedModule { pm_mod_summary :: ModSummary
945 , pm_parsed_source :: ParsedSource }
947 instance ParsedMod ParsedModule where
948 modSummary m = pm_mod_summary m
949 parsedSource m = pm_parsed_source m
951 -- | The result of successful typechecking. It also contains the parser
953 data TypecheckedModule =
954 TypecheckedModule { tm_parsed_module :: ParsedModule
955 , tm_renamed_source :: Maybe RenamedSource
956 , tm_typechecked_source :: TypecheckedSource
957 , tm_checked_module_info :: ModuleInfo
958 , tm_internals_ :: (TcGblEnv, ModDetails)
961 instance ParsedMod TypecheckedModule where
962 modSummary m = modSummary (tm_parsed_module m)
963 parsedSource m = parsedSource (tm_parsed_module m)
965 instance TypecheckedMod TypecheckedModule where
966 renamedSource m = tm_renamed_source m
967 typecheckedSource m = tm_typechecked_source m
968 moduleInfo m = tm_checked_module_info m
969 tm_internals m = tm_internals_ m
971 -- | The result of successful desugaring (i.e., translation to core). Also
972 -- contains all the information of a typechecked module.
973 data DesugaredModule =
974 DesugaredModule { dm_typechecked_module :: TypecheckedModule
975 , dm_core_module :: ModGuts
978 instance ParsedMod DesugaredModule where
979 modSummary m = modSummary (dm_typechecked_module m)
980 parsedSource m = parsedSource (dm_typechecked_module m)
982 instance TypecheckedMod DesugaredModule where
983 renamedSource m = renamedSource (dm_typechecked_module m)
984 typecheckedSource m = typecheckedSource (dm_typechecked_module m)
985 moduleInfo m = moduleInfo (dm_typechecked_module m)
986 tm_internals m = tm_internals_ (dm_typechecked_module m)
988 instance DesugaredMod DesugaredModule where
989 coreModule m = dm_core_module m
991 type ParsedSource = Located (HsModule RdrName)
992 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
994 type TypecheckedSource = LHsBinds Id
997 -- - things that aren't in the output of the typechecker right now:
1000 -- - type signatures
1001 -- - type/data/newtype declarations
1002 -- - class declarations
1004 -- - extra things in the typechecker's output:
1005 -- - default methods are turned into top-level decls.
1006 -- - dictionary bindings
1008 -- | Return the 'ModSummary' of a module with the given name.
1010 -- The module must be part of the module graph (see 'hsc_mod_graph' and
1011 -- 'ModuleGraph'). If this is not the case, this function will throw a
1014 -- This function ignores boot modules and requires that there is only one
1015 -- non-boot module with the given name.
1016 getModSummary :: GhcMonad m => ModuleName -> m ModSummary
1017 getModSummary mod = do
1018 mg <- liftM hsc_mod_graph getSession
1019 case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
1020 [] -> throw $ mkApiErr (text "Module not part of module graph")
1022 multiple -> throw $ mkApiErr (text "getModSummary is ambiguous: " <+> ppr multiple)
1024 -- | Parse a module.
1026 -- Throws a 'SourceError' on parse error.
1027 parseModule :: GhcMonad m => ModSummary -> m ParsedModule
1029 rdr_module <- withTempSession
1030 (\e -> e { hsc_dflags = ms_hspp_opts ms }) $
1032 return (ParsedModule ms rdr_module)
1034 -- | Typecheck and rename a parsed module.
1036 -- Throws a 'SourceError' if either fails.
1037 typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
1038 typecheckModule pmod = do
1039 let ms = modSummary pmod
1040 withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
1041 (tc_gbl_env, rn_info)
1042 <- hscTypecheckRename ms (parsedSource pmod)
1043 details <- makeSimpleDetails tc_gbl_env
1046 tm_internals_ = (tc_gbl_env, details),
1047 tm_parsed_module = pmod,
1048 tm_renamed_source = rn_info,
1049 tm_typechecked_source = tcg_binds tc_gbl_env,
1050 tm_checked_module_info =
1052 minf_type_env = md_types details,
1053 minf_exports = availsToNameSet $ md_exports details,
1054 minf_rdr_env = Just (tcg_rdr_env tc_gbl_env),
1055 minf_instances = md_insts details
1057 ,minf_modBreaks = emptyModBreaks
1061 -- | Desugar a typechecked module.
1062 desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
1063 desugarModule tcm = do
1064 let ms = modSummary tcm
1065 withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
1066 let (tcg, _) = tm_internals tcm
1067 guts <- hscDesugar ms tcg
1070 dm_typechecked_module = tcm,
1071 dm_core_module = guts
1074 -- | Load a module. Input doesn't need to be desugared.
1076 -- A module must be loaded before dependent modules can be typechecked. This
1077 -- always includes generating a 'ModIface' and, depending on the
1078 -- 'DynFlags.hscTarget', may also include code generation.
1080 -- This function will always cause recompilation and will always overwrite
1081 -- previous compilation results (potentially files on disk).
1083 loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
1085 let ms = modSummary tcm
1086 let mod = ms_mod_name ms
1087 let loc = ms_location ms
1088 let (tcg, _details) = tm_internals tcm
1090 withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
1092 let compilerBackend comp env ms' _ _mb_old_iface _ =
1093 withTempSession (\_ -> env) $
1094 hscBackend comp tcg ms' Nothing
1096 hsc_env <- getSession
1099 case ms_obj_date ms of
1100 Just t | t > ms_hs_date ms -> do
1101 l <- liftIO $ findObjectLinkable (ms_mod ms)
1104 _otherwise -> return Nothing
1106 compile' (compilerBackend hscNothingCompiler
1107 ,compilerBackend hscInteractiveCompiler
1108 ,hscCheckRecompBackend hscBatchCompiler tcg)
1109 hsc_env ms 1 1 Nothing mb_linkable
1110 -- compile' shouldn't change the environment
1111 return $ addToUFM (hsc_HPT hsc_env) mod mod_info
1112 modifySession $ \e -> e{ hsc_HPT = hpt_new }
1116 -- | This is the way to get access to the Core bindings corresponding
1117 -- to a module. 'compileToCore' parses, typechecks, and
1118 -- desugars the module, then returns the resulting Core module (consisting of
1119 -- the module name, type declarations, and function declarations) if
1121 compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
1122 compileToCoreModule = compileCore False
1124 -- | Like compileToCoreModule, but invokes the simplifier, so
1125 -- as to return simplified and tidied Core.
1126 compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
1127 compileToCoreSimplified = compileCore True
1129 -- | Provided for backwards-compatibility: compileToCore returns just the Core
1130 -- bindings, but for most purposes, you probably want to call
1131 -- compileToCoreModule.
1132 compileToCore :: GhcMonad m => FilePath -> m [CoreBind]
1133 compileToCore fn = do
1134 mod <- compileToCoreModule session fn
1135 return $ cm_binds mod
1137 -- | Takes a CoreModule and compiles the bindings therein
1138 -- to object code. The first argument is a bool flag indicating
1139 -- whether to run the simplifier.
1140 -- The resulting .o, .hi, and executable files, if any, are stored in the
1141 -- current directory, and named according to the module name.
1142 -- This has only so far been tested with a single self-contained module.
1143 compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m ()
1144 compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
1145 dflags <- getSessionDynFlags
1146 currentTime <- liftIO $ getClockTime
1147 cwd <- liftIO $ getCurrentDirectory
1148 modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd
1149 ((moduleNameSlashes . moduleName) mName)
1151 let modSummary = ModSummary { ms_mod = mName,
1152 ms_hsc_src = ExtCoreFile,
1153 ms_location = modLocation,
1154 -- By setting the object file timestamp to Nothing,
1155 -- we always force recompilation, which is what we
1156 -- want. (Thus it doesn't matter what the timestamp
1157 -- for the (nonexistent) source file is.)
1158 ms_hs_date = currentTime,
1159 ms_obj_date = Nothing,
1160 -- Only handling the single-module case for now, so no imports.
1165 ms_hspp_opts = dflags,
1166 ms_hspp_buf = Nothing
1169 let maybe_simplify mod_guts | simplify = hscSimplify mod_guts
1170 | otherwise = return mod_guts
1171 guts <- maybe_simplify (mkModGuts cm)
1172 (iface, changed, _details, cgguts)
1173 <- hscNormalIface guts Nothing
1174 hscWriteIface iface changed modSummary
1175 _ <- hscGenHardCode cgguts modSummary
1178 -- Makes a "vanilla" ModGuts.
1179 mkModGuts :: CoreModule -> ModGuts
1180 mkModGuts coreModule = ModGuts {
1181 mg_module = cm_module coreModule,
1184 mg_deps = noDependencies,
1185 mg_dir_imps = emptyModuleEnv,
1186 mg_used_names = emptyNameSet,
1187 mg_rdr_env = emptyGlobalRdrEnv,
1188 mg_fix_env = emptyFixityEnv,
1189 mg_types = emptyTypeEnv,
1193 mg_binds = cm_binds coreModule,
1194 mg_foreign = NoStubs,
1195 mg_warns = NoWarnings,
1197 mg_hpc_info = emptyHpcInfo False,
1198 mg_modBreaks = emptyModBreaks,
1199 mg_vect_info = noVectInfo,
1200 mg_inst_env = emptyInstEnv,
1201 mg_fam_inst_env = emptyFamInstEnv
1204 compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
1205 compileCore simplify fn = do
1206 -- First, set the target to the desired filename
1207 target <- guessTarget fn Nothing
1209 _ <- load LoadAllTargets
1210 -- Then find dependencies
1211 modGraph <- depanal [] True
1212 case find ((== fn) . msHsFilePath) modGraph of
1213 Just modSummary -> do
1214 -- Now we have the module name;
1215 -- parse, typecheck and desugar the module
1216 mod_guts <- coreModule `fmap`
1217 -- TODO: space leaky: call hsc* directly?
1218 (desugarModule =<< typecheckModule =<< parseModule modSummary)
1219 liftM gutsToCoreModule $
1222 -- If simplify is true: simplify (hscSimplify), then tidy
1224 hsc_env <- getSession
1225 simpl_guts <- hscSimplify mod_guts
1226 tidy_guts <- liftIO $ tidyProgram hsc_env simpl_guts
1227 return $ Left tidy_guts
1229 return $ Right mod_guts
1231 Nothing -> panic "compileToCoreModule: target FilePath not found in\
1232 module dependency graph"
1233 where -- two versions, based on whether we simplify (thus run tidyProgram,
1234 -- which returns a (CgGuts, ModDetails) pair, or not (in which case
1235 -- we just have a ModGuts.
1236 gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
1237 gutsToCoreModule (Left (cg, md)) = CoreModule {
1238 cm_module = cg_module cg, cm_types = md_types md,
1239 cm_imports = cg_dir_imps cg, cm_binds = cg_binds cg
1241 gutsToCoreModule (Right mg) = CoreModule {
1242 cm_module = mg_module mg, cm_types = mg_types mg,
1243 cm_imports = moduleEnvKeys (mg_dir_imps mg), cm_binds = mg_binds mg
1246 -- ---------------------------------------------------------------------------
1249 unload :: HscEnv -> [Linkable] -> IO ()
1250 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
1251 = case ghcLink (hsc_dflags hsc_env) of
1253 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
1255 LinkInMemory -> panic "unload: no interpreter"
1256 -- urgh. avoid warnings:
1257 hsc_env stable_linkables
1261 -- -----------------------------------------------------------------------------
1265 Stability tells us which modules definitely do not need to be recompiled.
1266 There are two main reasons for having stability:
1268 - avoid doing a complete upsweep of the module graph in GHCi when
1269 modules near the bottom of the tree have not changed.
1271 - to tell GHCi when it can load object code: we can only load object code
1272 for a module when we also load object code fo all of the imports of the
1273 module. So we need to know that we will definitely not be recompiling
1274 any of these modules, and we can use the object code.
1276 The stability check is as follows. Both stableObject and
1277 stableBCO are used during the upsweep phase later.
1280 stable m = stableObject m || stableBCO m
1283 all stableObject (imports m)
1284 && old linkable does not exist, or is == on-disk .o
1285 && date(on-disk .o) > date(.hs)
1288 all stable (imports m)
1289 && date(BCO) > date(.hs)
1292 These properties embody the following ideas:
1294 - if a module is stable, then:
1296 - if it has been compiled in a previous pass (present in HPT)
1297 then it does not need to be compiled or re-linked.
1299 - if it has not been compiled in a previous pass,
1300 then we only need to read its .hi file from disk and
1301 link it to produce a 'ModDetails'.
1303 - if a modules is not stable, we will definitely be at least
1304 re-linking, and possibly re-compiling it during the 'upsweep'.
1305 All non-stable modules can (and should) therefore be unlinked
1306 before the 'upsweep'.
1308 - Note that objects are only considered stable if they only depend
1309 on other objects. We can't link object code against byte code.
1313 :: HomePackageTable -- HPT from last compilation
1314 -> [SCC ModSummary] -- current module graph (cyclic)
1315 -> [ModuleName] -- all home modules
1316 -> ([ModuleName], -- stableObject
1317 [ModuleName]) -- stableBCO
1319 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
1321 checkSCC (stable_obj, stable_bco) scc0
1322 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
1323 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
1324 | otherwise = (stable_obj, stable_bco)
1326 scc = flattenSCC scc0
1327 scc_mods = map ms_mod_name scc
1328 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
1330 scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))
1331 -- all imports outside the current SCC, but in the home pkg
1333 stable_obj_imps = map (`elem` stable_obj) scc_allimps
1334 stable_bco_imps = map (`elem` stable_bco) scc_allimps
1338 && all object_ok scc
1341 and (zipWith (||) stable_obj_imps stable_bco_imps)
1345 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
1349 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
1350 Just hmi | Just l <- hm_linkable hmi
1351 -> isObjectLinkable l && t == linkableTime l
1353 -- why '>=' rather than '>' above? If the filesystem stores
1354 -- times to the nearset second, we may occasionally find that
1355 -- the object & source have the same modification time,
1356 -- especially if the source was automatically generated
1357 -- and compiled. Using >= is slightly unsafe, but it matches
1358 -- make's behaviour.
1361 = case lookupUFM hpt (ms_mod_name ms) of
1362 Just hmi | Just l <- hm_linkable hmi ->
1363 not (isObjectLinkable l) &&
1364 linkableTime l >= ms_hs_date ms
1367 -- -----------------------------------------------------------------------------
1369 -- | Prune the HomePackageTable
1371 -- Before doing an upsweep, we can throw away:
1373 -- - For non-stable modules:
1374 -- - all ModDetails, all linked code
1375 -- - all unlinked code that is out of date with respect to
1378 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
1379 -- space at the end of the upsweep, because the topmost ModDetails of the
1380 -- old HPT holds on to the entire type environment from the previous
1383 pruneHomePackageTable
1386 -> ([ModuleName],[ModuleName])
1389 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
1392 | is_stable modl = hmi'
1393 | otherwise = hmi'{ hm_details = emptyModDetails }
1395 modl = moduleName (mi_module (hm_iface hmi))
1396 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
1397 = hmi{ hm_linkable = Nothing }
1400 where ms = expectJust "prune" (lookupUFM ms_map modl)
1402 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
1404 is_stable m = m `elem` stable_obj || m `elem` stable_bco
1406 -- -----------------------------------------------------------------------------
1408 -- Return (names of) all those in modsDone who are part of a cycle
1409 -- as defined by theGraph.
1410 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
1411 findPartiallyCompletedCycles modsDone theGraph
1415 chew ((AcyclicSCC _):rest) = chew rest -- acyclic? not interesting.
1416 chew ((CyclicSCC vs):rest)
1417 = let names_in_this_cycle = nub (map ms_mod vs)
1419 = nub ([done | done <- modsDone,
1420 done `elem` names_in_this_cycle])
1421 chewed_rest = chew rest
1423 if notNull mods_in_this_cycle
1424 && length mods_in_this_cycle < length names_in_this_cycle
1425 then mods_in_this_cycle ++ chewed_rest
1428 -- -----------------------------------------------------------------------------
1432 -- This is where we compile each module in the module graph, in a pass
1433 -- from the bottom to the top of the graph.
1435 -- There better had not be any cyclic groups here -- we check for them.
1439 HscEnv -- ^ Includes initially-empty HPT
1440 -> HomePackageTable -- ^ HPT from last time round (pruned)
1441 -> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability)
1442 -> IO () -- ^ How to clean up unwanted tmp files
1443 -> [SCC ModSummary] -- ^ Mods to do (the worklist)
1449 -- 1. A flag whether the complete upsweep was successful.
1450 -- 2. The 'HscEnv' with an updated HPT
1451 -- 3. A list of modules which succeeded loading.
1453 upsweep hsc_env old_hpt stable_mods cleanup sccs = do
1454 (res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
1455 return (res, hsc_env, reverse done)
1458 upsweep' hsc_env _old_hpt done
1460 = return (Succeeded, hsc_env, done)
1462 upsweep' hsc_env _old_hpt done
1463 (CyclicSCC ms:_) _ _
1464 = do liftIO $ fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
1465 return (Failed, hsc_env, done)
1467 upsweep' hsc_env old_hpt done
1468 (AcyclicSCC mod:mods) mod_index nmods
1469 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1470 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
1471 -- (moduleEnvElts (hsc_HPT hsc_env)))
1472 let logger = reportModuleCompilationResult (hsc_callbacks hsc_env)
1475 <- handleSourceError
1476 (\err -> do logger mod (Just err); return Nothing) $ do
1477 mod_info <- upsweep_mod hsc_env old_hpt stable_mods
1479 logger mod Nothing -- log warnings
1480 return (Just mod_info)
1482 liftIO cleanup -- Remove unwanted tmp files between compilations
1485 Nothing -> return (Failed, hsc_env, done)
1487 let this_mod = ms_mod_name mod
1489 -- Add new info to hsc_env
1490 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
1491 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
1493 -- Space-saving: delete the old HPT entry
1494 -- for mod BUT if mod is a hs-boot
1495 -- node, don't delete it. For the
1496 -- interface, the HPT entry is probaby for the
1497 -- main Haskell source file. Deleting it
1498 -- would force the real module to be recompiled
1500 old_hpt1 | isBootSummary mod = old_hpt
1501 | otherwise = delFromUFM old_hpt this_mod
1505 -- fixup our HomePackageTable after we've finished compiling
1506 -- a mutually-recursive loop. See reTypecheckLoop, below.
1507 hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done'
1509 upsweep' hsc_env2 old_hpt1 done' mods (mod_index+1) nmods
1511 -- | Compile a single module. Always produce a Linkable for it if
1512 -- successful. If no compilation happened, return the old Linkable.
1513 upsweep_mod :: GhcMonad m =>
1516 -> ([ModuleName],[ModuleName])
1518 -> Int -- index of module
1519 -> Int -- total number of modules
1522 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
1524 this_mod_name = ms_mod_name summary
1525 this_mod = ms_mod summary
1526 mb_obj_date = ms_obj_date summary
1527 obj_fn = ml_obj_file (ms_location summary)
1528 hs_date = ms_hs_date summary
1530 is_stable_obj = this_mod_name `elem` stable_obj
1531 is_stable_bco = this_mod_name `elem` stable_bco
1533 old_hmi = lookupUFM old_hpt this_mod_name
1535 -- We're using the dflags for this module now, obtained by
1536 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
1537 dflags = ms_hspp_opts summary
1538 prevailing_target = hscTarget (hsc_dflags hsc_env)
1539 local_target = hscTarget dflags
1541 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
1542 -- we don't do anything dodgy: these should only work to change
1543 -- from -fvia-C to -fasm and vice-versa, otherwise we could
1544 -- end up trying to link object code to byte code.
1545 target = if prevailing_target /= local_target
1546 && (not (isObjectTarget prevailing_target)
1547 || not (isObjectTarget local_target))
1548 then prevailing_target
1551 -- store the corrected hscTarget into the summary
1552 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
1554 -- The old interface is ok if
1555 -- a) we're compiling a source file, and the old HPT
1556 -- entry is for a source file
1557 -- b) we're compiling a hs-boot file
1558 -- Case (b) allows an hs-boot file to get the interface of its
1559 -- real source file on the second iteration of the compilation
1560 -- manager, but that does no harm. Otherwise the hs-boot file
1561 -- will always be recompiled
1566 Just hm_info | isBootSummary summary -> Just iface
1567 | not (mi_boot iface) -> Just iface
1568 | otherwise -> Nothing
1570 iface = hm_iface hm_info
1572 compile_it :: GhcMonad m => Maybe Linkable -> m HomeModInfo
1573 compile_it = compile hsc_env summary' mod_index nmods mb_old_iface
1575 compile_it_discard_iface :: GhcMonad m =>
1576 Maybe Linkable -> m HomeModInfo
1577 compile_it_discard_iface
1578 = compile hsc_env summary' mod_index nmods Nothing
1580 -- With the HscNothing target we create empty linkables to avoid
1581 -- recompilation. We have to detect these to recompile anyway if
1582 -- the target changed since the last compile.
1584 | Just hmi <- old_hmi, Just l <- hm_linkable hmi =
1585 null (linkableUnlinked l)
1587 -- we have no linkable, so it cannot be fake
1590 implies False _ = True
1596 -- Regardless of whether we're generating object code or
1597 -- byte code, we can always use an existing object file
1598 -- if it is *stable* (see checkStability).
1599 | is_stable_obj, Just hmi <- old_hmi -> do
1600 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1601 (text "skipping stable obj mod:" <+> ppr this_mod_name)
1603 -- object is stable, and we have an entry in the
1604 -- old HPT: nothing to do
1606 | is_stable_obj, isNothing old_hmi -> do
1607 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1608 (text "compiling stable on-disk mod:" <+> ppr this_mod_name)
1609 linkable <- liftIO $ findObjectLinkable this_mod obj_fn
1610 (expectJust "upsweep1" mb_obj_date)
1611 compile_it (Just linkable)
1612 -- object is stable, but we need to load the interface
1613 -- off disk to make a HMI.
1615 | not (isObjectTarget target), is_stable_bco,
1616 (target /= HscNothing) `implies` not is_fake_linkable ->
1617 ASSERT(isJust old_hmi) -- must be in the old_hpt
1618 let Just hmi = old_hmi in do
1619 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1620 (text "skipping stable BCO mod:" <+> ppr this_mod_name)
1622 -- BCO is stable: nothing to do
1624 | not (isObjectTarget target),
1625 Just hmi <- old_hmi,
1626 Just l <- hm_linkable hmi,
1627 not (isObjectLinkable l),
1628 (target /= HscNothing) `implies` not is_fake_linkable,
1629 linkableTime l >= ms_hs_date summary -> do
1630 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1631 (text "compiling non-stable BCO mod:" <+> ppr this_mod_name)
1633 -- we have an old BCO that is up to date with respect
1634 -- to the source: do a recompilation check as normal.
1636 -- When generating object code, if there's an up-to-date
1637 -- object file on the disk, then we can use it.
1638 -- However, if the object file is new (compared to any
1639 -- linkable we had from a previous compilation), then we
1640 -- must discard any in-memory interface, because this
1641 -- means the user has compiled the source file
1642 -- separately and generated a new interface, that we must
1643 -- read from the disk.
1645 | isObjectTarget target,
1646 Just obj_date <- mb_obj_date,
1647 obj_date >= hs_date -> do
1650 | Just l <- hm_linkable hmi,
1651 isObjectLinkable l && linkableTime l == obj_date -> do
1652 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1653 (text "compiling mod with new on-disk obj:" <+> ppr this_mod_name)
1656 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1657 (text "compiling mod with new on-disk obj2:" <+> ppr this_mod_name)
1658 linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date
1659 compile_it_discard_iface (Just linkable)
1662 liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
1663 (text "compiling mod:" <+> ppr this_mod_name)
1668 -- Filter modules in the HPT
1669 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
1670 retainInTopLevelEnvs keep_these hpt
1671 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
1673 , let mb_mod_info = lookupUFM hpt mod
1674 , isJust mb_mod_info ]
1676 -- ---------------------------------------------------------------------------
1677 -- Typecheck module loops
1680 See bug #930. This code fixes a long-standing bug in --make. The
1681 problem is that when compiling the modules *inside* a loop, a data
1682 type that is only defined at the top of the loop looks opaque; but
1683 after the loop is done, the structure of the data type becomes
1686 The difficulty is then that two different bits of code have
1687 different notions of what the data type looks like.
1689 The idea is that after we compile a module which also has an .hs-boot
1690 file, we re-generate the ModDetails for each of the modules that
1691 depends on the .hs-boot file, so that everyone points to the proper
1692 TyCons, Ids etc. defined by the real module, not the boot module.
1693 Fortunately re-generating a ModDetails from a ModIface is easy: the
1694 function TcIface.typecheckIface does exactly that.
1696 Picking the modules to re-typecheck is slightly tricky. Starting from
1697 the module graph consisting of the modules that have already been
1698 compiled, we reverse the edges (so they point from the imported module
1699 to the importing module), and depth-first-search from the .hs-boot
1700 node. This gives us all the modules that depend transitively on the
1701 .hs-boot module, and those are exactly the modules that we need to
1704 Following this fix, GHC can compile itself with --make -O2.
1707 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
1708 reTypecheckLoop hsc_env ms graph
1709 | not (isBootSummary ms) &&
1710 any (\m -> ms_mod m == this_mod && isBootSummary m) graph
1712 let mss = reachableBackwards (ms_mod_name ms) graph
1713 non_boot = filter (not.isBootSummary) mss
1714 debugTraceMsg (hsc_dflags hsc_env) 2 $
1715 text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
1716 typecheckLoop hsc_env (map ms_mod_name non_boot)
1720 this_mod = ms_mod ms
1722 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
1723 typecheckLoop hsc_env mods = do
1725 fixIO $ \new_hpt -> do
1726 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
1727 mds <- initIfaceCheck new_hsc_env $
1728 mapM (typecheckIface . hm_iface) hmis
1729 let new_hpt = addListToUFM old_hpt
1730 (zip mods [ hmi{ hm_details = details }
1731 | (hmi,details) <- zip hmis mds ])
1733 return hsc_env{ hsc_HPT = new_hpt }
1735 old_hpt = hsc_HPT hsc_env
1736 hmis = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
1738 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
1739 reachableBackwards mod summaries
1740 = [ ms | (ms,_,_) <- reachableG (transposeG graph) root ]
1741 where -- the rest just sets up the graph:
1742 (graph, lookup_node) = moduleGraphNodes False summaries
1743 root = expectJust "reachableBackwards" (lookup_node HsBootFile mod)
1745 -- ---------------------------------------------------------------------------
1746 -- Topological sort of the module graph
1748 type SummaryNode = (ModSummary, Int, [Int])
1752 -- ^ Drop hi-boot nodes? (see below)
1755 -- ^ Root module name. If @Nothing@, use the full graph.
1757 -- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1758 -- The resulting list of strongly-connected-components is in topologically
1759 -- sorted order, starting with the module(s) at the bottom of the
1760 -- dependency graph (ie compile them first) and ending with the ones at
1763 -- Drop hi-boot nodes (first boolean arg)?
1765 -- - @False@: treat the hi-boot summaries as nodes of the graph,
1766 -- so the graph must be acyclic
1768 -- - @True@: eliminate the hi-boot nodes, and instead pretend
1769 -- the a source-import of Foo is an import of Foo
1770 -- The resulting graph has no hi-boot nodes, but can be cyclic
1772 topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
1773 = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph
1775 (graph, lookup_node) = moduleGraphNodes drop_hs_boot_nodes summaries
1777 initial_graph = case mb_root_mod of
1780 -- restrict the graph to just those modules reachable from
1781 -- the specified module. We do this by building a graph with
1782 -- the full set of nodes, and determining the reachable set from
1783 -- the specified node.
1784 let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
1785 | otherwise = ghcError (ProgramError "module does not exist")
1786 in graphFromEdgedVertices (seq root (reachableG graph root))
1788 summaryNodeKey :: SummaryNode -> Int
1789 summaryNodeKey (_, k, _) = k
1791 summaryNodeSummary :: SummaryNode -> ModSummary
1792 summaryNodeSummary (s, _, _) = s
1794 moduleGraphNodes :: Bool -> [ModSummary]
1795 -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
1796 moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)
1798 numbered_summaries = zip summaries [1..]
1800 lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode
1801 lookup_node hs_src mod = Map.lookup (mod, hs_src) node_map
1803 lookup_key :: HscSource -> ModuleName -> Maybe Int
1804 lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)
1806 node_map :: NodeMap SummaryNode
1807 node_map = Map.fromList [ ((moduleName (ms_mod s), ms_hsc_src s), node)
1808 | node@(s, _, _) <- nodes ]
1810 -- We use integers as the keys for the SCC algorithm
1811 nodes :: [SummaryNode]
1812 nodes = [ (s, key, out_keys)
1813 | (s, key) <- numbered_summaries
1814 -- Drop the hi-boot ones if told to do so
1815 , not (isBootSummary s && drop_hs_boot_nodes)
1816 , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
1817 out_edge_keys HsSrcFile (map unLoc (ms_home_imps s)) ++
1818 (-- see [boot-edges] below
1819 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
1821 else case lookup_key HsBootFile (ms_mod_name s) of
1825 -- [boot-edges] if this is a .hs and there is an equivalent
1826 -- .hs-boot, add a link from the former to the latter. This
1827 -- has the effect of detecting bogus cases where the .hs-boot
1828 -- depends on the .hs, by introducing a cycle. Additionally,
1829 -- it ensures that we will always process the .hs-boot before
1830 -- the .hs, and so the HomePackageTable will always have the
1831 -- most up to date information.
1833 -- Drop hs-boot nodes by using HsSrcFile as the key
1834 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1835 | otherwise = HsBootFile
1837 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1838 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1839 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1840 -- the IsBootInterface parameter True; else False
1843 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
1844 type NodeMap a = Map NodeKey a -- keyed by (mod, src_file_type) pairs
1846 msKey :: ModSummary -> NodeKey
1847 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1849 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1850 mkNodeMap summaries = Map.fromList [ (msKey s, s) | s <- summaries]
1852 nodeMapElts :: NodeMap a -> [a]
1853 nodeMapElts = Map.elems
1855 -- | If there are {-# SOURCE #-} imports between strongly connected
1856 -- components in the topological sort, then those imports can
1857 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1858 -- were necessary, then the edge would be part of a cycle.
1859 warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()
1860 warnUnnecessarySourceImports sccs =
1861 logWarnings (listToBag (concatMap (check.flattenSCC) sccs))
1863 let mods_in_this_cycle = map ms_mod_name ms in
1864 [ warn i | m <- ms, i <- ms_home_srcimps m,
1865 unLoc i `notElem` mods_in_this_cycle ]
1867 warn :: Located ModuleName -> WarnMsg
1870 (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
1871 <+> quotes (ppr mod))
1873 -----------------------------------------------------------------------------
1874 -- Downsweep (dependency analysis)
1876 -- Chase downwards from the specified root set, returning summaries
1877 -- for all home modules encountered. Only follow source-import
1880 -- We pass in the previous collection of summaries, which is used as a
1881 -- cache to avoid recalculating a module summary if the source is
1884 -- The returned list of [ModSummary] nodes has one node for each home-package
1885 -- module, plus one for any hs-boot files. The imports of these nodes
1886 -- are all there, including the imports of non-home-package modules.
1888 downsweep :: GhcMonad m =>
1890 -> [ModSummary] -- Old summaries
1891 -> [ModuleName] -- Ignore dependencies on these; treat
1892 -- them as if they were package modules
1893 -> Bool -- True <=> allow multiple targets to have
1894 -- the same module name; this is
1895 -- very useful for ghc -M
1897 -- The elts of [ModSummary] all have distinct
1898 -- (Modules, IsBoot) identifiers, unless the Bool is true
1899 -- in which case there can be repeats
1900 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1901 = do -- catch error messages and return them
1902 --handleErrMsg -- should be covered by GhcMonad now
1903 -- (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
1904 rootSummaries <- mapM getRootSummary roots
1905 let root_map = mkRootMap rootSummaries
1906 checkDuplicates root_map
1907 summs <- loop (concatMap msDeps rootSummaries) root_map
1910 roots = hsc_targets hsc_env
1912 old_summary_map :: NodeMap ModSummary
1913 old_summary_map = mkNodeMap old_summaries
1915 getRootSummary :: GhcMonad m => Target -> m ModSummary
1916 getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)
1917 = do exists <- liftIO $ doesFileExist file
1919 then summariseFile hsc_env old_summaries file mb_phase
1920 obj_allowed maybe_buf
1921 else throwOneError $ mkPlainErrMsg noSrcSpan $
1922 text "can't find file:" <+> text file
1923 getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
1924 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1925 (L rootLoc modl) obj_allowed
1927 case maybe_summary of
1928 Nothing -> packageModErr modl
1931 rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1933 -- In a root module, the filename is allowed to diverge from the module
1934 -- name, so we have to check that there aren't multiple root files
1935 -- defining the same module (otherwise the duplicates will be silently
1936 -- ignored, leading to confusing behaviour).
1937 checkDuplicates :: GhcMonad m => NodeMap [ModSummary] -> m ()
1938 checkDuplicates root_map
1939 | allow_dup_roots = return ()
1940 | null dup_roots = return ()
1941 | otherwise = liftIO $ multiRootsErr (head dup_roots)
1943 dup_roots :: [[ModSummary]] -- Each at least of length 2
1944 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1946 loop :: GhcMonad m =>
1947 [(Located ModuleName,IsBootInterface)]
1948 -- Work list: process these modules
1949 -> NodeMap [ModSummary]
1950 -- Visited set; the range is a list because
1951 -- the roots can have the same module names
1952 -- if allow_dup_roots is True
1954 -- The result includes the worklist, except
1955 -- for those mentioned in the visited set
1956 loop [] done = return (concat (nodeMapElts done))
1957 loop ((wanted_mod, is_boot) : ss) done
1958 | Just summs <- Map.lookup key done
1959 = if isSingleton summs then
1962 do { liftIO $ multiRootsErr summs; return [] }
1964 = do mb_s <- summariseModule hsc_env old_summary_map
1965 is_boot wanted_mod True
1968 Nothing -> loop ss done
1969 Just s -> loop (msDeps s ++ ss) (Map.insert key [s] done)
1971 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1973 -- XXX Does the (++) here need to be flipped?
1974 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1975 mkRootMap summaries = Map.insertListWith (flip (++))
1976 [ (msKey s, [s]) | s <- summaries ]
1979 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
1980 -- (msDeps s) returns the dependencies of the ModSummary s.
1981 -- A wrinkle is that for a {-# SOURCE #-} import we return
1982 -- *both* the hs-boot file
1983 -- *and* the source file
1984 -- as "dependencies". That ensures that the list of all relevant
1985 -- modules always contains B.hs if it contains B.hs-boot.
1986 -- Remember, this pass isn't doing the topological sort. It's
1987 -- just gathering the list of all relevant ModSummaries
1989 concat [ [(m,True), (m,False)] | m <- ms_home_srcimps s ]
1990 ++ [ (m,False) | m <- ms_home_imps s ]
1992 home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
1993 home_imps imps = [ ideclName i | L _ i <- imps, isLocal (ideclPkgQual i) ]
1994 where isLocal Nothing = True
1995 isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special
1998 ms_home_allimps :: ModSummary -> [ModuleName]
1999 ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
2001 ms_home_srcimps :: ModSummary -> [Located ModuleName]
2002 ms_home_srcimps = home_imps . ms_srcimps
2004 ms_home_imps :: ModSummary -> [Located ModuleName]
2005 ms_home_imps = home_imps . ms_imps
2007 -----------------------------------------------------------------------------
2008 -- Summarising modules
2010 -- We have two types of summarisation:
2012 -- * Summarise a file. This is used for the root module(s) passed to
2013 -- cmLoadModules. The file is read, and used to determine the root
2014 -- module name. The module name may differ from the filename.
2016 -- * Summarise a module. We are given a module name, and must provide
2017 -- a summary. The finder is used to locate the file in which the module
2023 -> [ModSummary] -- old summaries
2024 -> FilePath -- source file name
2025 -> Maybe Phase -- start phase
2026 -> Bool -- object code allowed?
2027 -> Maybe (StringBuffer,ClockTime)
2030 summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
2031 -- we can use a cached summary if one is available and the
2032 -- source file hasn't changed, But we have to look up the summary
2033 -- by source file, rather than module name as we do in summarise.
2034 | Just old_summary <- findSummaryBySourceFile old_summaries file
2036 let location = ms_location old_summary
2038 -- return the cached summary if the source didn't change
2039 src_timestamp <- case maybe_buf of
2040 Just (_,t) -> return t
2041 Nothing -> liftIO $ getModificationTime file
2042 -- The file exists; we checked in getRootSummary above.
2043 -- If it gets removed subsequently, then this
2044 -- getModificationTime may fail, but that's the right
2047 if ms_hs_date old_summary == src_timestamp
2048 then do -- update the object-file timestamp
2050 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2051 || obj_allowed -- bug #1205
2052 then liftIO $ getObjTimestamp location False
2054 return old_summary{ ms_obj_date = obj_timestamp }
2062 let dflags = hsc_dflags hsc_env
2064 (dflags', hspp_fn, buf)
2065 <- preprocessFile hsc_env file mb_phase maybe_buf
2067 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
2069 -- Make a ModLocation for this file
2070 location <- liftIO $ mkHomeModLocation dflags mod_name file
2072 -- Tell the Finder cache where it is, so that subsequent calls
2073 -- to findModule will find it, even if it's not on any search path
2074 mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location
2076 src_timestamp <- case maybe_buf of
2077 Just (_,t) -> return t
2078 Nothing -> liftIO $ getModificationTime file
2079 -- getMofificationTime may fail
2081 -- when the user asks to load a source file by name, we only
2082 -- use an object file if -fobject-code is on. See #1205.
2084 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2085 || obj_allowed -- bug #1205
2086 then liftIO $ modificationTimeIfExists (ml_obj_file location)
2089 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
2090 ms_location = location,
2091 ms_hspp_file = hspp_fn,
2092 ms_hspp_opts = dflags',
2093 ms_hspp_buf = Just buf,
2094 ms_srcimps = srcimps, ms_imps = the_imps,
2095 ms_hs_date = src_timestamp,
2096 ms_obj_date = obj_timestamp })
2098 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
2099 findSummaryBySourceFile summaries file
2100 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
2101 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
2105 -- Summarise a module, and pick up source and timestamp.
2109 -> NodeMap ModSummary -- Map of old summaries
2110 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
2111 -> Located ModuleName -- Imported module to be summarised
2112 -> Bool -- object code allowed?
2113 -> Maybe (StringBuffer, ClockTime)
2114 -> [ModuleName] -- Modules to exclude
2115 -> m (Maybe ModSummary) -- Its new summary
2117 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
2118 obj_allowed maybe_buf excl_mods
2119 | wanted_mod `elem` excl_mods
2122 | Just old_summary <- Map.lookup (wanted_mod, hsc_src) old_summary_map
2123 = do -- Find its new timestamp; all the
2124 -- ModSummaries in the old map have valid ml_hs_files
2125 let location = ms_location old_summary
2126 src_fn = expectJust "summariseModule" (ml_hs_file location)
2128 -- check the modification time on the source file, and
2129 -- return the cached summary if it hasn't changed. If the
2130 -- file has disappeared, we need to call the Finder again.
2132 Just (_,t) -> check_timestamp old_summary location src_fn t
2134 m <- liftIO $ System.IO.Error.try (getModificationTime src_fn)
2136 Right t -> check_timestamp old_summary location src_fn t
2137 Left e | isDoesNotExistError e -> find_it
2138 | otherwise -> liftIO $ ioError e
2140 | otherwise = find_it
2142 dflags = hsc_dflags hsc_env
2144 hsc_src = if is_boot then HsBootFile else HsSrcFile
2146 check_timestamp old_summary location src_fn src_timestamp
2147 | ms_hs_date old_summary == src_timestamp = do
2148 -- update the object-file timestamp
2149 obj_timestamp <- liftIO $
2150 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2151 || obj_allowed -- bug #1205
2152 then getObjTimestamp location is_boot
2154 return (Just old_summary{ ms_obj_date = obj_timestamp })
2156 -- source changed: re-summarise.
2157 new_summary location (ms_mod old_summary) src_fn src_timestamp
2160 -- Don't use the Finder's cache this time. If the module was
2161 -- previously a package module, it may have now appeared on the
2162 -- search path, so we want to consider it to be a home module. If
2163 -- the module was previously a home module, it may have moved.
2164 liftIO $ uncacheModule hsc_env wanted_mod
2165 found <- liftIO $ findImportedModule hsc_env wanted_mod Nothing
2168 | isJust (ml_hs_file location) ->
2170 just_found location mod
2172 -- Drop external-pkg
2173 ASSERT(modulePackageId mod /= thisPackage dflags)
2176 err -> liftIO $ noModError dflags loc wanted_mod err
2179 just_found location mod = do
2180 -- Adjust location to point to the hs-boot source file,
2181 -- hi file, object file, when is_boot says so
2182 let location' | is_boot = addBootSuffixLocn location
2183 | otherwise = location
2184 src_fn = expectJust "summarise2" (ml_hs_file location')
2186 -- Check that it exists
2187 -- It might have been deleted since the Finder last found it
2188 maybe_t <- liftIO $ modificationTimeIfExists src_fn
2190 Nothing -> noHsFileErr loc src_fn
2191 Just t -> new_summary location' mod src_fn t
2194 new_summary location mod src_fn src_timestamp
2196 -- Preprocess the source file and get its imports
2197 -- The dflags' contains the OPTIONS pragmas
2198 (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
2199 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
2201 when (mod_name /= wanted_mod) $
2202 throwOneError $ mkPlainErrMsg mod_loc $
2203 text "File name does not match module name:"
2204 $$ text "Saw:" <+> quotes (ppr mod_name)
2205 $$ text "Expected:" <+> quotes (ppr wanted_mod)
2207 -- Find the object timestamp, and return the summary
2208 obj_timestamp <- liftIO $
2209 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
2210 || obj_allowed -- bug #1205
2211 then getObjTimestamp location is_boot
2214 return (Just (ModSummary { ms_mod = mod,
2215 ms_hsc_src = hsc_src,
2216 ms_location = location,
2217 ms_hspp_file = hspp_fn,
2218 ms_hspp_opts = dflags',
2219 ms_hspp_buf = Just buf,
2220 ms_srcimps = srcimps,
2222 ms_hs_date = src_timestamp,
2223 ms_obj_date = obj_timestamp }))
2226 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
2227 getObjTimestamp location is_boot
2228 = if is_boot then return Nothing
2229 else modificationTimeIfExists (ml_obj_file location)
2232 preprocessFile :: GhcMonad m =>
2235 -> Maybe Phase -- ^ Starting phase
2236 -> Maybe (StringBuffer,ClockTime)
2237 -> m (DynFlags, FilePath, StringBuffer)
2238 preprocessFile hsc_env src_fn mb_phase Nothing
2240 (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
2241 buf <- liftIO $ hGetStringBuffer hspp_fn
2242 return (dflags', hspp_fn, buf)
2244 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
2246 let dflags = hsc_dflags hsc_env
2247 -- case we bypass the preprocessing stage?
2249 local_opts = getOptions dflags buf src_fn
2251 (dflags', leftovers, warns)
2252 <- parseDynamicNoPackageFlags dflags local_opts
2253 checkProcessArgsResult leftovers
2254 handleFlagWarnings dflags' warns
2258 | Just (Unlit _) <- mb_phase = True
2259 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
2260 -- note: local_opts is only required if there's no Unlit phase
2261 | xopt Opt_Cpp dflags' = True
2262 | dopt Opt_Pp dflags' = True
2265 when needs_preprocessing $
2266 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
2268 return (dflags', src_fn, buf)
2271 -----------------------------------------------------------------------------
2273 -----------------------------------------------------------------------------
2275 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
2276 -- ToDo: we don't have a proper line number for this error
2277 noModError dflags loc wanted_mod err
2278 = throwOneError $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
2280 noHsFileErr :: GhcMonad m => SrcSpan -> String -> m a
2281 noHsFileErr loc path
2282 = throwOneError $ mkPlainErrMsg loc $ text "Can't find" <+> text path
2284 packageModErr :: GhcMonad m => ModuleName -> m a
2286 = throwOneError $ mkPlainErrMsg noSrcSpan $
2287 text "module" <+> quotes (ppr mod) <+> text "is a package module"
2289 multiRootsErr :: [ModSummary] -> IO ()
2290 multiRootsErr [] = panic "multiRootsErr"
2291 multiRootsErr summs@(summ1:_)
2292 = throwOneError $ mkPlainErrMsg noSrcSpan $
2293 text "module" <+> quotes (ppr mod) <+>
2294 text "is defined in multiple files:" <+>
2295 sep (map text files)
2298 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
2300 cyclicModuleErr :: [ModSummary] -> SDoc
2302 = hang (ptext (sLit "Module imports form a cycle for modules:"))
2303 2 (vcat (map show_one ms))
2305 mods_in_cycle = map ms_mod_name ms
2306 imp_modname = unLoc . ideclName . unLoc
2307 just_in_cycle = filter ((`elem` mods_in_cycle) . imp_modname)
2310 vcat [ show_mod (ms_hsc_src ms) (ms_mod_name ms) <+>
2311 maybe empty (parens . text) (ml_hs_file (ms_location ms)),
2312 nest 2 $ ptext (sLit "imports:") <+> vcat [
2313 pp_imps HsBootFile (just_in_cycle $ ms_srcimps ms),
2314 pp_imps HsSrcFile (just_in_cycle $ ms_imps ms) ]
2316 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
2317 pp_imps src imps = fsep (map (show_mod src . unLoc . ideclName . unLoc) imps)
2320 -- | Inform GHC that the working directory has changed. GHC will flush
2321 -- its cache of module locations, since it may no longer be valid.
2323 -- Note: Before changing the working directory make sure all threads running
2324 -- in the same session have stopped. If you change the working directory,
2325 -- you should also unload the current program (set targets to empty,
2326 -- followed by load).
2327 workingDirectoryChanged :: GhcMonad m => m ()
2328 workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)
2330 -- -----------------------------------------------------------------------------
2331 -- inspecting the session
2333 -- | Get the module dependency graph.
2334 getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
2335 getModuleGraph = liftM hsc_mod_graph getSession
2337 -- | Determines whether a set of modules requires Template Haskell.
2339 -- Note that if the session's 'DynFlags' enabled Template Haskell when
2340 -- 'depanal' was called, then each module in the returned module graph will
2341 -- have Template Haskell enabled whether it is actually needed or not.
2342 needsTemplateHaskell :: ModuleGraph -> Bool
2343 needsTemplateHaskell ms =
2344 any (xopt Opt_TemplateHaskell . ms_hspp_opts) ms
2346 -- | Return @True@ <==> module is loaded.
2347 isLoaded :: GhcMonad m => ModuleName -> m Bool
2348 isLoaded m = withSession $ \hsc_env ->
2349 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
2351 -- | Return the bindings for the current interactive session.
2352 getBindings :: GhcMonad m => m [TyThing]
2353 getBindings = withSession $ \hsc_env ->
2354 -- we have to implement the shadowing behaviour of ic_tmp_ids here
2355 -- (see InteractiveContext) and the quickest way is to use an OccEnv.
2357 occ_env = mkOccEnv [ (nameOccName (idName id), AnId id)
2358 | id <- ic_tmp_ids (hsc_IC hsc_env) ]
2360 return (occEnvElts occ_env)
2362 getPrintUnqual :: GhcMonad m => m PrintUnqualified
2363 getPrintUnqual = withSession $ \hsc_env ->
2364 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
2366 -- | Container for information about a 'Module'.
2367 data ModuleInfo = ModuleInfo {
2368 minf_type_env :: TypeEnv,
2369 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
2370 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
2371 minf_instances :: [Instance]
2373 ,minf_modBreaks :: ModBreaks
2375 -- ToDo: this should really contain the ModIface too
2377 -- We don't want HomeModInfo here, because a ModuleInfo applies
2378 -- to package modules too.
2380 -- | Request information about a loaded 'Module'
2381 getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X
2382 getModuleInfo mdl = withSession $ \hsc_env -> do
2383 let mg = hsc_mod_graph hsc_env
2384 if mdl `elem` map ms_mod mg
2385 then liftIO $ getHomeModuleInfo hsc_env (moduleName mdl)
2387 {- if isHomeModule (hsc_dflags hsc_env) mdl
2389 else -} liftIO $ getPackageModuleInfo hsc_env mdl
2390 -- getPackageModuleInfo will attempt to find the interface, so
2391 -- we don't want to call it for a home module, just in case there
2392 -- was a problem loading the module and the interface doesn't
2393 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
2395 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
2397 getPackageModuleInfo hsc_env mdl = do
2398 (_msgs, mb_avails) <- getModuleExports hsc_env mdl
2400 Nothing -> return Nothing
2402 eps <- readIORef (hsc_EPS hsc_env)
2404 names = availsToNameSet avails
2406 tys = [ ty | name <- concatMap availNames avails,
2407 Just ty <- [lookupTypeEnv pte name] ]
2409 return (Just (ModuleInfo {
2410 minf_type_env = mkTypeEnv tys,
2411 minf_exports = names,
2412 minf_rdr_env = Just $! availsToGlobalRdrEnv (moduleName mdl) avails,
2413 minf_instances = error "getModuleInfo: instances for package module unimplemented",
2414 minf_modBreaks = emptyModBreaks
2417 getPackageModuleInfo _hsc_env _mdl = do
2418 -- bogusly different for non-GHCI (ToDo)
2422 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
2423 getHomeModuleInfo hsc_env mdl =
2424 case lookupUFM (hsc_HPT hsc_env) mdl of
2425 Nothing -> return Nothing
2427 let details = hm_details hmi
2428 return (Just (ModuleInfo {
2429 minf_type_env = md_types details,
2430 minf_exports = availsToNameSet (md_exports details),
2431 minf_rdr_env = mi_globals $! hm_iface hmi,
2432 minf_instances = md_insts details
2434 ,minf_modBreaks = getModBreaks hmi
2438 -- | The list of top-level entities defined in a module
2439 modInfoTyThings :: ModuleInfo -> [TyThing]
2440 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
2442 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
2443 modInfoTopLevelScope minf
2444 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
2446 modInfoExports :: ModuleInfo -> [Name]
2447 modInfoExports minf = nameSetToList $! minf_exports minf
2449 -- | Returns the instances defined by the specified module.
2450 -- Warning: currently unimplemented for package modules.
2451 modInfoInstances :: ModuleInfo -> [Instance]
2452 modInfoInstances = minf_instances
2454 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
2455 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
2457 mkPrintUnqualifiedForModule :: GhcMonad m =>
2459 -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X
2460 mkPrintUnqualifiedForModule minf = withSession $ \hsc_env -> do
2461 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
2463 modInfoLookupName :: GhcMonad m =>
2465 -> m (Maybe TyThing) -- XXX: returns a Maybe X
2466 modInfoLookupName minf name = withSession $ \hsc_env -> do
2467 case lookupTypeEnv (minf_type_env minf) name of
2468 Just tyThing -> return (Just tyThing)
2470 eps <- liftIO $ readIORef (hsc_EPS hsc_env)
2471 return $! lookupType (hsc_dflags hsc_env)
2472 (hsc_HPT hsc_env) (eps_PTE eps) name
2475 modInfoModBreaks :: ModuleInfo -> ModBreaks
2476 modInfoModBreaks = minf_modBreaks
2479 isDictonaryId :: Id -> Bool
2481 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
2483 -- | Looks up a global name: that is, any top-level name in any
2484 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
2485 -- the interactive context, and therefore does not require a preceding
2487 lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
2488 lookupGlobalName name = withSession $ \hsc_env -> do
2489 liftIO $ lookupTypeHscEnv hsc_env name
2491 findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
2492 findGlobalAnns deserialize target = withSession $ \hsc_env -> do
2493 ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
2494 return (findAnns deserialize ann_env target)
2497 -- | get the GlobalRdrEnv for a session
2498 getGRE :: GhcMonad m => m GlobalRdrEnv
2499 getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
2502 -- -----------------------------------------------------------------------------
2504 -- | Return all /external/ modules available in the package database.
2505 -- Modules from the current session (i.e., from the 'HomePackageTable') are
2507 packageDbModules :: GhcMonad m =>
2508 Bool -- ^ Only consider exposed packages.
2510 packageDbModules only_exposed = do
2511 dflags <- getSessionDynFlags
2512 let pkgs = eltsUFM (pkgIdMap (pkgState dflags))
2514 [ mkModule pid modname | p <- pkgs
2515 , not only_exposed || exposed p
2516 , let pid = packageConfigId p
2517 , modname <- exposedModules p ]
2519 -- -----------------------------------------------------------------------------
2520 -- Misc exported utils
2522 dataConType :: DataCon -> Type
2523 dataConType dc = idType (dataConWrapId dc)
2525 -- | print a 'NamedThing', adding parentheses if the name is an operator.
2526 pprParenSymName :: NamedThing a => a -> SDoc
2527 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
2529 -- ----------------------------------------------------------------------------
2534 -- - Data and Typeable instances for HsSyn.
2536 -- ToDo: check for small transformations that happen to the syntax in
2537 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
2539 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
2540 -- to get from TyCons, Ids etc. to TH syntax (reify).
2542 -- :browse will use either lm_toplev or inspect lm_interface, depending
2543 -- on whether the module is interpreted or not.
2547 -- Extract the filename, stringbuffer content and dynflags associed to a module
2549 -- XXX: Explain pre-conditions
2550 getModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynFlags)
2551 getModuleSourceAndFlags mod = do
2552 m <- getModSummary (moduleName mod)
2553 case ml_hs_file $ ms_location m of
2554 Nothing -> throw $ mkApiErr (text "No source available for module " <+> ppr mod)
2555 Just sourceFile -> do
2556 source <- liftIO $ hGetStringBuffer sourceFile
2557 return (sourceFile, source, ms_hspp_opts m)
2560 -- | Return module source as token stream, including comments.
2562 -- The module must be in the module graph and its source must be available.
2563 -- Throws a 'HscTypes.SourceError' on parse error.
2564 getTokenStream :: GhcMonad m => Module -> m [Located Token]
2565 getTokenStream mod = do
2566 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
2567 let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
2568 case lexTokenStream source startLoc flags of
2569 POk _ ts -> return ts
2570 PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
2572 -- | Give even more information on the source than 'getTokenStream'
2573 -- This function allows reconstructing the source completely with
2574 -- 'showRichTokenStream'.
2575 getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
2576 getRichTokenStream mod = do
2577 (sourceFile, source, flags) <- getModuleSourceAndFlags mod
2578 let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
2579 case lexTokenStream source startLoc flags of
2580 POk _ ts -> return $ addSourceToTokens startLoc source ts
2581 PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
2583 -- | Given a source location and a StringBuffer corresponding to this
2584 -- location, return a rich token stream with the source associated to the
2586 addSourceToTokens :: SrcLoc -> StringBuffer -> [Located Token]
2587 -> [(Located Token, String)]
2588 addSourceToTokens _ _ [] = []
2589 addSourceToTokens loc buf (t@(L span _) : ts)
2590 | not (isGoodSrcSpan span) = (t,"") : addSourceToTokens loc buf ts
2591 | otherwise = (t,str) : addSourceToTokens newLoc newBuf ts
2593 (newLoc, newBuf, str) = go "" loc buf
2594 start = srcSpanStart span
2595 end = srcSpanEnd span
2596 go acc loc buf | loc < start = go acc nLoc nBuf
2597 | start <= loc && loc < end = go (ch:acc) nLoc nBuf
2598 | otherwise = (loc, buf, reverse acc)
2599 where (ch, nBuf) = nextChar buf
2600 nLoc = advanceSrcLoc loc ch
2603 -- | Take a rich token stream such as produced from 'getRichTokenStream' and
2604 -- return source code almost identical to the original code (except for
2605 -- insignificant whitespace.)
2606 showRichTokenStream :: [(Located Token, String)] -> String
2607 showRichTokenStream ts = go startLoc ts ""
2608 where sourceFile = srcSpanFile (getLoc . fst . head $ ts)
2609 startLoc = mkSrcLoc sourceFile 1 1
2611 go loc ((L span _, str):ts)
2612 | not (isGoodSrcSpan span) = go loc ts
2613 | locLine == tokLine = ((replicate (tokCol - locCol) ' ') ++)
2616 | otherwise = ((replicate (tokLine - locLine) '\n') ++)
2617 . ((replicate tokCol ' ') ++)
2620 where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
2621 (tokLine, tokCol) = (srcSpanStartLine span, srcSpanStartCol span)
2622 tokEnd = srcSpanEnd span
2624 -- -----------------------------------------------------------------------------
2625 -- Interactive evaluation
2627 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
2628 -- filesystem and package database to find the corresponding 'Module',
2629 -- using the algorithm that is used for an @import@ declaration.
2630 findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
2631 findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
2633 dflags = hsc_dflags hsc_env
2634 this_pkg = thisPackage dflags
2637 Just pkg | fsToPackageId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
2638 res <- findImportedModule hsc_env mod_name maybe_pkg
2640 Found _ m -> return m
2641 err -> noModError dflags noSrcSpan mod_name err
2643 home <- lookupLoadedHomeModule mod_name
2646 Nothing -> liftIO $ do
2647 res <- findImportedModule hsc_env mod_name maybe_pkg
2649 Found loc m | modulePackageId m /= this_pkg -> return m
2650 | otherwise -> modNotLoadedError m loc
2651 err -> noModError dflags noSrcSpan mod_name err
2653 modNotLoadedError :: Module -> ModLocation -> IO a
2654 modNotLoadedError m loc = ghcError $ CmdLineError $ showSDoc $
2655 text "module is not loaded:" <+>
2656 quotes (ppr (moduleName m)) <+>
2657 parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
2659 -- | Like 'findModule', but differs slightly when the module refers to
2660 -- a source file, and the file has not been loaded via 'load'. In
2661 -- this case, 'findModule' will throw an error (module not loaded),
2662 -- but 'lookupModule' will check to see whether the module can also be
2663 -- found in a package, and if so, that package 'Module' will be
2664 -- returned. If not, the usual module-not-found error will be thrown.
2666 lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
2667 lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
2668 lookupModule mod_name Nothing = withSession $ \hsc_env -> do
2669 home <- lookupLoadedHomeModule mod_name
2672 Nothing -> liftIO $ do
2673 res <- findExposedPackageModule hsc_env mod_name Nothing
2675 Found _ m -> return m
2676 err -> noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
2678 lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)
2679 lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
2680 case lookupUFM (hsc_HPT hsc_env) mod_name of
2681 Just mod_info -> return (Just (mi_module (hm_iface mod_info)))
2682 _not_a_home_module -> return Nothing
2685 getHistorySpan :: GhcMonad m => History -> m SrcSpan
2686 getHistorySpan h = withSession $ \hsc_env ->
2687 return$ InteractiveEval.getHistorySpan hsc_env h
2689 obtainTermFromVal :: GhcMonad m => Int -> Bool -> Type -> a -> m Term
2690 obtainTermFromVal bound force ty a =
2691 withSession $ \hsc_env ->
2692 liftIO $ InteractiveEval.obtainTermFromVal hsc_env bound force ty a
2694 obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
2695 obtainTermFromId bound force id =
2696 withSession $ \hsc_env ->
2697 liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id
2701 -- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
2702 -- entity known to GHC, including 'Name's defined using 'runStmt'.
2703 lookupName :: GhcMonad m => Name -> m (Maybe TyThing)
2704 lookupName name = withSession $ \hsc_env -> do
2705 mb_tything <- ioMsg $ tcRnLookupName hsc_env name
2707 -- XXX: calls panic in some circumstances; is that ok?
projects / ghc-hetmet.git / blob