1 -- -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow, 2005
7 -- -----------------------------------------------------------------------------
13 defaultCleanupHandler,
16 -- * Flags and settings
17 DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
18 GhcMode(..), GhcLink(..), defaultObjectTarget,
25 Target(..), TargetId(..), Phase,
32 -- * Extending the program scope
33 extendGlobalRdrScope, -- :: Session -> [GlobalRdrElt] -> IO ()
34 setGlobalRdrScope, -- :: Session -> [GlobalRdrElt] -> IO ()
35 extendGlobalTypeScope, -- :: Session -> [Id] -> IO ()
36 setGlobalTypeScope, -- :: Session -> [Id] -> IO ()
38 -- * Loading\/compiling the program
40 load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
41 workingDirectoryChanged,
42 checkModule, checkAndLoadModule, CheckedModule(..),
43 TypecheckedSource, ParsedSource, RenamedSource,
44 compileToCore, compileToCoreModule, compileToCoreSimplified,
47 -- * Parsing Haddock comments
50 -- * Inspecting the module structure of the program
51 ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
56 -- * Inspecting modules
63 modInfoIsExportedName,
66 mkPrintUnqualifiedForModule,
69 PrintUnqualified, alwaysQualify,
71 -- * Interactive evaluation
72 getBindings, getPrintUnqual,
75 setContext, getContext,
85 runStmt, SingleStep(..),
87 Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
88 resumeHistory, resumeHistoryIx),
89 History(historyBreakInfo, historyEnclosingDecl),
90 GHC.getHistorySpan, getHistoryModule,
94 InteractiveEval.forward,
97 InteractiveEval.compileExpr, HValue, dynCompileExpr,
99 GHC.obtainTerm, GHC.obtainTerm1, GHC.obtainTermB, reconstructType,
101 ModBreaks(..), BreakIndex,
102 BreakInfo(breakInfo_number, breakInfo_module),
103 BreakArray, setBreakOn, setBreakOff, getBreak,
106 -- * Abstract syntax elements
112 Module, mkModule, pprModule, moduleName, modulePackageId,
113 ModuleName, mkModuleName, moduleNameString,
117 isExternalName, nameModule, pprParenSymName, nameSrcSpan,
119 RdrName(Qual,Unqual),
123 isImplicitId, isDeadBinder,
124 isExportedId, isLocalId, isGlobalId,
126 isPrimOpId, isFCallId, isClassOpId_maybe,
127 isDataConWorkId, idDataCon,
128 isBottomingId, isDictonaryId,
129 recordSelectorFieldLabel,
131 -- ** Type constructors
133 tyConTyVars, tyConDataCons, tyConArity,
134 isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
136 synTyConDefn, synTyConType, synTyConResKind,
142 -- ** Data constructors
144 dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
145 dataConIsInfix, isVanillaDataCon,
147 StrictnessMark(..), isMarkedStrict,
151 classMethods, classSCTheta, classTvsFds,
156 instanceDFunId, pprInstance, pprInstanceHdr,
158 -- ** Types and Kinds
159 Type, splitForAllTys, funResultTy,
160 pprParendType, pprTypeApp,
163 ThetaType, pprThetaArrow,
169 module HsSyn, -- ToDo: remove extraneous bits
173 defaultFixity, maxPrecedence,
177 -- ** Source locations
179 mkSrcLoc, isGoodSrcLoc, noSrcLoc,
180 srcLocFile, srcLocLine, srcLocCol,
182 mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
183 srcSpanStart, srcSpanEnd,
185 srcSpanStartLine, srcSpanEndLine,
186 srcSpanStartCol, srcSpanEndCol,
189 GhcException(..), showGhcException,
199 * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
200 * what StaticFlags should we expose, if any?
203 #include "HsVersions.h"
206 import qualified Linker
207 import Linker ( HValue )
211 import InteractiveEval
216 import TcRnTypes hiding (LIE)
217 import TcRnMonad ( initIfaceCheck )
221 import qualified HsSyn -- hack as we want to reexport the whole module
222 import HsSyn hiding ((<.>))
223 import Type hiding (typeKind)
224 import TcType hiding (typeKind)
226 import Var hiding (setIdType)
227 import TysPrim ( alphaTyVars )
232 import Name hiding ( varName )
233 import OccName ( parenSymOcc )
234 import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr,
236 import FamInstEnv ( emptyFamInstEnv )
240 import DriverPipeline
241 import DriverPhases ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase )
248 import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
257 import Bag ( unitBag, listToBag )
260 import StringBuffer ( StringBuffer, hGetStringBuffer )
263 import Maybes ( expectJust, mapCatMaybes )
265 import HaddockLex ( tokenise )
268 import Control.Concurrent
269 import System.Directory ( getModificationTime, doesFileExist,
270 getCurrentDirectory )
273 import qualified Data.List as List
275 import System.Exit ( exitWith, ExitCode(..) )
276 import System.Time ( ClockTime, getClockTime )
277 import Control.Exception as Exception hiding (handle)
279 import System.FilePath
281 import System.IO.Error ( try, isDoesNotExistError )
282 import Prelude hiding (init)
285 -- -----------------------------------------------------------------------------
286 -- Exception handlers
288 -- | Install some default exception handlers and run the inner computation.
289 -- Unless you want to handle exceptions yourself, you should wrap this around
290 -- the top level of your program. The default handlers output the error
291 -- message(s) to stderr and exit cleanly.
292 defaultErrorHandler :: DynFlags -> IO a -> IO a
293 defaultErrorHandler dflags inner =
294 -- top-level exception handler: any unrecognised exception is a compiler bug.
295 handle (\exception -> do
298 -- an IO exception probably isn't our fault, so don't panic
300 fatalErrorMsg dflags (text (show exception))
301 AsyncException StackOverflow ->
302 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
304 fatalErrorMsg dflags (text (show (Panic (show exception))))
305 exitWith (ExitFailure 1)
308 -- program errors: messages with locations attached. Sometimes it is
309 -- convenient to just throw these as exceptions.
310 handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
311 exitWith (ExitFailure 1)) $
313 -- error messages propagated as exceptions
314 handleDyn (\dyn -> do
317 PhaseFailed _ code -> exitWith code
318 Interrupted -> exitWith (ExitFailure 1)
319 _ -> do fatalErrorMsg dflags (text (show (dyn :: GhcException)))
320 exitWith (ExitFailure 1)
324 -- | Install a default cleanup handler to remove temporary files
325 -- deposited by a GHC run. This is seperate from
326 -- 'defaultErrorHandler', because you might want to override the error
327 -- handling, but still get the ordinary cleanup behaviour.
328 defaultCleanupHandler :: DynFlags -> IO a -> IO a
329 defaultCleanupHandler dflags inner =
330 -- make sure we clean up after ourselves
331 later (do cleanTempFiles dflags
334 -- exceptions will be blocked while we clean the temporary files,
335 -- so there shouldn't be any difficulty if we receive further
340 -- | Starts a new session. A session consists of a set of loaded
341 -- modules, a set of options (DynFlags), and an interactive context.
342 -- ToDo: explain argument [[mb_top_dir]]
343 newSession :: Maybe FilePath -> IO Session
344 newSession mb_top_dir = do
346 main_thread <- myThreadId
347 modifyMVar_ interruptTargetThread (return . (main_thread :))
348 installSignalHandlers
351 dflags0 <- initDynFlags defaultDynFlags
352 dflags <- initSysTools mb_top_dir dflags0
353 env <- newHscEnv dflags
357 -- tmp: this breaks the abstraction, but required because DriverMkDepend
358 -- needs to call the Finder. ToDo: untangle this.
359 sessionHscEnv :: Session -> IO HscEnv
360 sessionHscEnv (Session ref) = readIORef ref
362 -- -----------------------------------------------------------------------------
365 -- | Grabs the DynFlags from the Session
366 getSessionDynFlags :: Session -> IO DynFlags
367 getSessionDynFlags s = withSession s (return . hsc_dflags)
369 -- | Updates the DynFlags in a Session. This also reads
370 -- the package database (unless it has already been read),
371 -- and prepares the compilers knowledge about packages. It
372 -- can be called again to load new packages: just add new
373 -- package flags to (packageFlags dflags).
375 -- Returns a list of new packages that may need to be linked in using
376 -- the dynamic linker (see 'linkPackages') as a result of new package
377 -- flags. If you are not doing linking or doing static linking, you
378 -- can ignore the list of packages returned.
380 setSessionDynFlags :: Session -> DynFlags -> IO [PackageId]
381 setSessionDynFlags (Session ref) dflags = do
382 hsc_env <- readIORef ref
383 (dflags', preload) <- initPackages dflags
384 writeIORef ref $! hsc_env{ hsc_dflags = dflags' }
387 -- | If there is no -o option, guess the name of target executable
388 -- by using top-level source file name as a base.
389 guessOutputFile :: Session -> IO ()
390 guessOutputFile s = modifySession s $ \env ->
391 let dflags = hsc_dflags env
392 mod_graph = hsc_mod_graph env
393 mainModuleSrcPath, guessedName :: Maybe String
394 mainModuleSrcPath = do
395 let isMain = (== mainModIs dflags) . ms_mod
396 [ms] <- return (filter isMain mod_graph)
397 ml_hs_file (ms_location ms)
398 guessedName = fmap dropExtension mainModuleSrcPath
400 case outputFile dflags of
402 Nothing -> env { hsc_dflags = dflags { outputFile = guessedName } }
404 -- -----------------------------------------------------------------------------
407 -- ToDo: think about relative vs. absolute file paths. And what
408 -- happens when the current directory changes.
410 -- | Sets the targets for this session. Each target may be a module name
411 -- or a filename. The targets correspond to the set of root modules for
412 -- the program\/library. Unloading the current program is achieved by
413 -- setting the current set of targets to be empty, followed by load.
414 setTargets :: Session -> [Target] -> IO ()
415 setTargets s targets = modifySession s (\h -> h{ hsc_targets = targets })
417 -- | returns the current set of targets
418 getTargets :: Session -> IO [Target]
419 getTargets s = withSession s (return . hsc_targets)
421 -- | Add another target
422 addTarget :: Session -> Target -> IO ()
424 = modifySession s (\h -> h{ hsc_targets = target : hsc_targets h })
427 removeTarget :: Session -> TargetId -> IO ()
428 removeTarget s target_id
429 = modifySession s (\h -> h{ hsc_targets = filter (hsc_targets h) })
431 filter targets = [ t | t@(Target id _) <- targets, id /= target_id ]
433 -- Attempts to guess what Target a string refers to. This function implements
434 -- the --make/GHCi command-line syntax for filenames:
436 -- - if the string looks like a Haskell source filename, then interpret
438 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
440 -- - otherwise interpret the string as a module name
442 guessTarget :: String -> Maybe Phase -> IO Target
443 guessTarget file (Just phase)
444 = return (Target (TargetFile file (Just phase)) Nothing)
445 guessTarget file Nothing
446 | isHaskellSrcFilename file
447 = return (Target (TargetFile file Nothing) Nothing)
449 = do exists <- doesFileExist hs_file
451 then return (Target (TargetFile hs_file Nothing) Nothing)
453 exists <- doesFileExist lhs_file
455 then return (Target (TargetFile lhs_file Nothing) Nothing)
457 return (Target (TargetModule (mkModuleName file)) Nothing)
459 hs_file = file <.> "hs"
460 lhs_file = file <.> "lhs"
462 -- -----------------------------------------------------------------------------
463 -- Extending the program scope
465 extendGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
466 extendGlobalRdrScope session rdrElts
467 = modifySession session $ \hscEnv ->
468 let global_rdr = hsc_global_rdr_env hscEnv
469 in hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv global_rdr rdrElts }
471 setGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
472 setGlobalRdrScope session rdrElts
473 = modifySession session $ \hscEnv ->
474 hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv rdrElts }
476 extendGlobalTypeScope :: Session -> [Id] -> IO ()
477 extendGlobalTypeScope session ids
478 = modifySession session $ \hscEnv ->
479 let global_type = hsc_global_type_env hscEnv
480 in hscEnv{ hsc_global_type_env = extendTypeEnvWithIds global_type ids }
482 setGlobalTypeScope :: Session -> [Id] -> IO ()
483 setGlobalTypeScope session ids
484 = modifySession session $ \hscEnv ->
485 hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
487 -- -----------------------------------------------------------------------------
488 -- Parsing Haddock comments
490 parseHaddockComment :: String -> Either String (HsDoc RdrName)
491 parseHaddockComment string =
492 case parseHaddockParagraphs (tokenise string) of
496 -- -----------------------------------------------------------------------------
497 -- Loading the program
499 -- Perform a dependency analysis starting from the current targets
500 -- and update the session with the new module graph.
501 depanal :: Session -> [ModuleName] -> Bool -> IO (Maybe ModuleGraph)
502 depanal (Session ref) excluded_mods allow_dup_roots = do
503 hsc_env <- readIORef ref
505 dflags = hsc_dflags hsc_env
506 targets = hsc_targets hsc_env
507 old_graph = hsc_mod_graph hsc_env
509 showPass dflags "Chasing dependencies"
510 debugTraceMsg dflags 2 (hcat [
511 text "Chasing modules from: ",
512 hcat (punctuate comma (map pprTarget targets))])
514 r <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
516 Just mod_graph -> writeIORef ref hsc_env{ hsc_mod_graph = mod_graph }
521 -- | The result of load.
523 = LoadOk Errors -- ^ all specified targets were loaded successfully.
524 | LoadFailed Errors -- ^ not all modules were loaded.
526 type Errors = [String]
528 data ErrMsg = ErrMsg {
529 errMsgSeverity :: Severity, -- warning, error, etc.
530 errMsgSpans :: [SrcSpan],
531 errMsgShortDoc :: Doc,
532 errMsgExtraInfo :: Doc
538 | LoadUpTo ModuleName
539 | LoadDependenciesOf ModuleName
541 -- | Try to load the program. If a Module is supplied, then just
542 -- attempt to load up to this target. If no Module is supplied,
543 -- then try to load all targets.
544 load :: Session -> LoadHowMuch -> IO SuccessFlag
545 load s@(Session ref) how_much
547 -- Dependency analysis first. Note that this fixes the module graph:
548 -- even if we don't get a fully successful upsweep, the full module
549 -- graph is still retained in the Session. We can tell which modules
550 -- were successfully loaded by inspecting the Session's HPT.
551 mb_graph <- depanal s [] False
553 Just mod_graph -> catchingFailure $ load2 s how_much mod_graph
554 Nothing -> return Failed
555 where catchingFailure f = f `Exception.catch` \e -> do
556 hsc_env <- readIORef ref
557 -- trac #1565 / test ghci021:
558 -- let bindings may explode if we try to use them after
560 writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
563 load2 :: Session -> LoadHowMuch -> [ModSummary] -> IO SuccessFlag
564 load2 s@(Session ref) how_much mod_graph = do
566 hsc_env <- readIORef ref
568 let hpt1 = hsc_HPT hsc_env
569 let dflags = hsc_dflags hsc_env
571 -- The "bad" boot modules are the ones for which we have
572 -- B.hs-boot in the module graph, but no B.hs
573 -- The downsweep should have ensured this does not happen
575 let all_home_mods = [ms_mod_name s
576 | s <- mod_graph, not (isBootSummary s)]
577 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
578 not (ms_mod_name s `elem` all_home_mods)]
579 ASSERT( null bad_boot_mods ) return ()
581 -- mg2_with_srcimps drops the hi-boot nodes, returning a
582 -- graph with cycles. Among other things, it is used for
583 -- backing out partially complete cycles following a failed
584 -- upsweep, and for removing from hpt all the modules
585 -- not in strict downwards closure, during calls to compile.
586 let mg2_with_srcimps :: [SCC ModSummary]
587 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
589 -- If we can determine that any of the {-# SOURCE #-} imports
590 -- are definitely unnecessary, then emit a warning.
591 warnUnnecessarySourceImports dflags mg2_with_srcimps
594 -- check the stability property for each module.
595 stable_mods@(stable_obj,stable_bco)
596 = checkStability hpt1 mg2_with_srcimps all_home_mods
598 -- prune bits of the HPT which are definitely redundant now,
600 pruned_hpt = pruneHomePackageTable hpt1
601 (flattenSCCs mg2_with_srcimps)
606 debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
607 text "Stable BCO:" <+> ppr stable_bco)
609 -- Unload any modules which are going to be re-linked this time around.
610 let stable_linkables = [ linkable
611 | m <- stable_obj++stable_bco,
612 Just hmi <- [lookupUFM pruned_hpt m],
613 Just linkable <- [hm_linkable hmi] ]
614 unload hsc_env stable_linkables
616 -- We could at this point detect cycles which aren't broken by
617 -- a source-import, and complain immediately, but it seems better
618 -- to let upsweep_mods do this, so at least some useful work gets
619 -- done before the upsweep is abandoned.
620 --hPutStrLn stderr "after tsort:\n"
621 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
623 -- Now do the upsweep, calling compile for each module in
624 -- turn. Final result is version 3 of everything.
626 -- Topologically sort the module graph, this time including hi-boot
627 -- nodes, and possibly just including the portion of the graph
628 -- reachable from the module specified in the 2nd argument to load.
629 -- This graph should be cycle-free.
630 -- If we're restricting the upsweep to a portion of the graph, we
631 -- also want to retain everything that is still stable.
632 let full_mg :: [SCC ModSummary]
633 full_mg = topSortModuleGraph False mod_graph Nothing
635 maybe_top_mod = case how_much of
637 LoadDependenciesOf m -> Just m
640 partial_mg0 :: [SCC ModSummary]
641 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
643 -- LoadDependenciesOf m: we want the upsweep to stop just
644 -- short of the specified module (unless the specified module
647 | LoadDependenciesOf _mod <- how_much
648 = ASSERT( case last partial_mg0 of
649 AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
650 List.init partial_mg0
656 | AcyclicSCC ms <- full_mg,
657 ms_mod_name ms `elem` stable_obj++stable_bco,
658 ms_mod_name ms `notElem` [ ms_mod_name ms' |
659 AcyclicSCC ms' <- partial_mg ] ]
661 mg = stable_mg ++ partial_mg
663 -- clean up between compilations
664 let cleanup = cleanTempFilesExcept dflags
665 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
667 debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
669 (upsweep_ok, hsc_env1, modsUpswept)
670 <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
671 pruned_hpt stable_mods cleanup mg
673 -- Make modsDone be the summaries for each home module now
674 -- available; this should equal the domain of hpt3.
675 -- Get in in a roughly top .. bottom order (hence reverse).
677 let modsDone = reverse modsUpswept
679 -- Try and do linking in some form, depending on whether the
680 -- upsweep was completely or only partially successful.
682 if succeeded upsweep_ok
685 -- Easy; just relink it all.
686 do debugTraceMsg dflags 2 (text "Upsweep completely successful.")
688 -- Clean up after ourselves
689 cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
691 -- Issue a warning for the confusing case where the user
692 -- said '-o foo' but we're not going to do any linking.
693 -- We attempt linking if either (a) one of the modules is
694 -- called Main, or (b) the user said -no-hs-main, indicating
695 -- that main() is going to come from somewhere else.
697 let ofile = outputFile dflags
698 let no_hs_main = dopt Opt_NoHsMain dflags
700 main_mod = mainModIs dflags
701 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
702 do_linking = a_root_is_Main || no_hs_main
704 when (ghcLink dflags == LinkBinary
705 && isJust ofile && not do_linking) $
706 debugTraceMsg dflags 1 $
707 text ("Warning: output was redirected with -o, " ++
708 "but no output will be generated\n" ++
709 "because there is no " ++
710 moduleNameString (moduleName main_mod) ++ " module.")
712 -- link everything together
713 linkresult <- link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
715 loadFinish Succeeded linkresult ref hsc_env1
718 -- Tricky. We need to back out the effects of compiling any
719 -- half-done cycles, both so as to clean up the top level envs
720 -- and to avoid telling the interactive linker to link them.
721 do debugTraceMsg dflags 2 (text "Upsweep partially successful.")
724 = map ms_mod modsDone
725 let mods_to_zap_names
726 = findPartiallyCompletedCycles modsDone_names
729 = filter ((`notElem` mods_to_zap_names).ms_mod)
732 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
735 -- Clean up after ourselves
736 cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
738 -- there should be no Nothings where linkables should be, now
739 ASSERT(all (isJust.hm_linkable)
740 (eltsUFM (hsc_HPT hsc_env))) do
742 -- Link everything together
743 linkresult <- link (ghcLink dflags) dflags False hpt4
745 let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
746 loadFinish Failed linkresult ref hsc_env4
748 -- Finish up after a load.
750 -- If the link failed, unload everything and return.
751 loadFinish :: SuccessFlag -> SuccessFlag -> IORef HscEnv -> HscEnv -> IO SuccessFlag
752 loadFinish _all_ok Failed ref hsc_env
753 = do unload hsc_env []
754 writeIORef ref $! discardProg hsc_env
757 -- Empty the interactive context and set the module context to the topmost
758 -- newly loaded module, or the Prelude if none were loaded.
759 loadFinish all_ok Succeeded ref hsc_env
760 = do writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
764 -- Forget the current program, but retain the persistent info in HscEnv
765 discardProg :: HscEnv -> HscEnv
767 = hsc_env { hsc_mod_graph = emptyMG,
768 hsc_IC = emptyInteractiveContext,
769 hsc_HPT = emptyHomePackageTable }
771 -- used to fish out the preprocess output files for the purposes of
772 -- cleaning up. The preprocessed file *might* be the same as the
773 -- source file, but that doesn't do any harm.
774 ppFilesFromSummaries :: [ModSummary] -> [FilePath]
775 ppFilesFromSummaries summaries = map ms_hspp_file summaries
777 -- -----------------------------------------------------------------------------
781 CheckedModule { parsedSource :: ParsedSource,
782 renamedSource :: Maybe RenamedSource,
783 typecheckedSource :: Maybe TypecheckedSource,
784 checkedModuleInfo :: Maybe ModuleInfo,
785 coreModule :: Maybe ModGuts
787 -- ToDo: improvements that could be made here:
788 -- if the module succeeded renaming but not typechecking,
789 -- we can still get back the GlobalRdrEnv and exports, so
790 -- perhaps the ModuleInfo should be split up into separate
791 -- fields within CheckedModule.
793 type ParsedSource = Located (HsModule RdrName)
794 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
795 Maybe (HsDoc Name), HaddockModInfo Name)
796 type TypecheckedSource = LHsBinds Id
799 -- - things that aren't in the output of the typechecker right now:
803 -- - type/data/newtype declarations
804 -- - class declarations
806 -- - extra things in the typechecker's output:
807 -- - default methods are turned into top-level decls.
808 -- - dictionary bindings
811 -- | This is the way to get access to parsed and typechecked source code
812 -- for a module. 'checkModule' attempts to typecheck the module. If
813 -- successful, it returns the abstract syntax for the module.
814 -- If compileToCore is true, it also desugars the module and returns the
815 -- resulting Core bindings as a component of the CheckedModule.
816 checkModule :: Session -> ModuleName -> Bool -> IO (Maybe CheckedModule)
817 checkModule (Session ref) mod compile_to_core
819 hsc_env <- readIORef ref
820 let mg = hsc_mod_graph hsc_env
821 case [ ms | ms <- mg, ms_mod_name ms == mod ] of
823 (ms:_) -> checkModule_ ref ms compile_to_core False
825 -- | parses and typechecks a module, optionally generates Core, and also
826 -- loads the module into the 'Session' so that modules which depend on
827 -- this one may subsequently be typechecked using 'checkModule' or
828 -- 'checkAndLoadModule'. If you need to check more than one module,
829 -- you probably want to use 'checkAndLoadModule'. Constructing the
830 -- interface takes a little work, so it might be slightly slower than
832 checkAndLoadModule :: Session -> ModSummary -> Bool -> IO (Maybe CheckedModule)
833 checkAndLoadModule (Session ref) ms compile_to_core
834 = checkModule_ ref ms compile_to_core True
836 checkModule_ :: IORef HscEnv -> ModSummary -> Bool -> Bool
837 -> IO (Maybe CheckedModule)
838 checkModule_ ref ms compile_to_core load
840 let mod = ms_mod_name ms
841 hsc_env0 <- readIORef ref
842 let hsc_env = hsc_env0{hsc_dflags=ms_hspp_opts ms}
843 mb_parsed <- parseFile hsc_env ms
845 Nothing -> return Nothing
846 Just rdr_module -> do
847 mb_typechecked <- typecheckRenameModule hsc_env ms rdr_module
848 case mb_typechecked of
849 Nothing -> return (Just CheckedModule {
850 parsedSource = rdr_module,
851 renamedSource = Nothing,
852 typecheckedSource = Nothing,
853 checkedModuleInfo = Nothing,
854 coreModule = Nothing })
855 Just (tcg, rn_info) -> do
856 details <- makeSimpleDetails hsc_env tcg
858 let tc_binds = tcg_binds tcg
859 let rdr_env = tcg_rdr_env tcg
860 let minf = ModuleInfo {
861 minf_type_env = md_types details,
862 minf_exports = availsToNameSet $
864 minf_rdr_env = Just rdr_env,
865 minf_instances = md_insts details
867 ,minf_modBreaks = emptyModBreaks
871 mb_guts <- if compile_to_core
872 then deSugarModule hsc_env ms tcg
875 -- If we are loading this module so that we can typecheck
876 -- dependent modules, generate an interface and stuff it
877 -- all in the HomePackageTable.
879 (iface,_) <- makeSimpleIface hsc_env Nothing tcg details
880 let mod_info = HomeModInfo {
882 hm_details = details,
883 hm_linkable = Nothing }
884 let hpt_new = addToUFM (hsc_HPT hsc_env) mod mod_info
885 writeIORef ref hsc_env0{ hsc_HPT = hpt_new }
887 return (Just (CheckedModule {
888 parsedSource = rdr_module,
889 renamedSource = rn_info,
890 typecheckedSource = Just tc_binds,
891 checkedModuleInfo = Just minf,
892 coreModule = mb_guts }))
894 -- | This is the way to get access to the Core bindings corresponding
895 -- to a module. 'compileToCore' invokes 'checkModule' to parse, typecheck, and
896 -- desugar the module, then returns the resulting Core module (consisting of
897 -- the module name, type declarations, and function declarations) if
899 compileToCoreModule :: Session -> FilePath -> IO (Maybe CoreModule)
900 compileToCoreModule = compileCore False
902 -- | Like compileToCoreModule, but invokes the simplifier, so
903 -- as to return simplified and tidied Core.
904 compileToCoreSimplified :: Session -> FilePath -> IO (Maybe CoreModule)
905 compileToCoreSimplified = compileCore True
907 -- | Provided for backwards-compatibility: compileToCore returns just the Core
908 -- bindings, but for most purposes, you probably want to call
909 -- compileToCoreModule.
910 compileToCore :: Session -> FilePath -> IO (Maybe [CoreBind])
911 compileToCore session fn = do
912 maybeCoreModule <- compileToCoreModule session fn
913 return $ fmap cm_binds maybeCoreModule
915 -- | Takes a CoreModule and compiles the bindings therein
916 -- to object code. The first argument is a bool flag indicating
917 -- whether to run the simplifier.
918 -- The resulting .o, .hi, and executable files, if any, are stored in the
919 -- current directory, and named according to the module name.
920 -- Returns True iff compilation succeeded.
921 -- This has only so far been tested with a single self-contained module.
922 compileCoreToObj :: Bool -> Session -> CoreModule -> IO Bool
923 compileCoreToObj simplify session cm@(CoreModule{ cm_module = mName }) = do
924 hscEnv <- sessionHscEnv session
925 dflags <- getSessionDynFlags session
926 currentTime <- getClockTime
927 cwd <- getCurrentDirectory
928 modLocation <- mkHiOnlyModLocation dflags (hiSuf dflags) cwd
929 ((moduleNameSlashes . moduleName) mName)
931 let modSummary = ModSummary { ms_mod = mName,
932 ms_hsc_src = ExtCoreFile,
933 ms_location = modLocation,
934 -- By setting the object file timestamp to Nothing,
935 -- we always force recompilation, which is what we
936 -- want. (Thus it doesn't matter what the timestamp
937 -- for the (nonexistent) source file is.)
938 ms_hs_date = currentTime,
939 ms_obj_date = Nothing,
940 -- Only handling the single-module case for now, so no imports.
945 ms_hspp_opts = dflags,
946 ms_hspp_buf = Nothing
949 mbHscResult <- evalComp
950 ((if simplify then hscSimplify else return) (mkModGuts cm)
951 >>= hscNormalIface >>= hscWriteIface >>= hscOneShot)
952 (CompState{ compHscEnv=hscEnv,
953 compModSummary=modSummary,
954 compOldIface=Nothing})
955 return $ isJust mbHscResult
957 -- Makes a "vanilla" ModGuts.
958 mkModGuts :: CoreModule -> ModGuts
959 mkModGuts coreModule = ModGuts {
960 mg_module = cm_module coreModule,
963 mg_deps = noDependencies,
964 mg_dir_imps = emptyModuleEnv,
965 mg_used_names = emptyNameSet,
966 mg_rdr_env = emptyGlobalRdrEnv,
967 mg_fix_env = emptyFixityEnv,
968 mg_types = emptyTypeEnv,
972 mg_binds = cm_binds coreModule,
973 mg_foreign = NoStubs,
974 mg_deprecs = NoDeprecs,
975 mg_hpc_info = emptyHpcInfo False,
976 mg_modBreaks = emptyModBreaks,
977 mg_vect_info = noVectInfo,
978 mg_inst_env = emptyInstEnv,
979 mg_fam_inst_env = emptyFamInstEnv
982 compileCore :: Bool -> Session -> FilePath -> IO (Maybe CoreModule)
983 compileCore simplify session fn = do
984 -- First, set the target to the desired filename
985 target <- guessTarget fn Nothing
986 addTarget session target
987 load session LoadAllTargets
988 -- Then find dependencies
989 maybeModGraph <- depanal session [] True
990 case maybeModGraph of
991 Nothing -> return Nothing
993 case find ((== fn) . msHsFilePath) modGraph of
994 Just modSummary -> do
995 -- Now we have the module name;
996 -- parse, typecheck and desugar the module
997 let mod = ms_mod_name modSummary
998 maybeCheckedModule <- checkModule session mod True
999 case maybeCheckedModule of
1000 Nothing -> return Nothing
1001 Just checkedMod -> (liftM $ fmap gutsToCoreModule) $
1002 case (coreModule checkedMod) of
1003 Just mg | simplify -> (sessionHscEnv session)
1004 -- If simplify is true: simplify (hscSimplify),
1005 -- then tidy (tidyProgram).
1006 >>= \ hscEnv -> evalComp (hscSimplify mg)
1007 (CompState{ compHscEnv=hscEnv,
1008 compModSummary=modSummary,
1009 compOldIface=Nothing})
1010 >>= (tidyProgram hscEnv)
1011 >>= (return . Just . Left)
1012 Just guts -> return $ Just $ Right guts
1013 Nothing -> return Nothing
1014 Nothing -> panic "compileToCoreModule: target FilePath not found in\
1015 module dependency graph"
1016 where -- two versions, based on whether we simplify (thus run tidyProgram,
1017 -- which returns a (CgGuts, ModDetails) pair, or not (in which case
1018 -- we just have a ModGuts.
1019 gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
1020 gutsToCoreModule (Left (cg, md)) = CoreModule {
1021 cm_module = cg_module cg, cm_types = md_types md,
1022 cm_imports = cg_dir_imps cg, cm_binds = cg_binds cg
1024 gutsToCoreModule (Right mg) = CoreModule {
1025 cm_module = mg_module mg, cm_types = mg_types mg,
1026 cm_imports = moduleEnvKeys (mg_dir_imps mg), cm_binds = mg_binds mg
1029 -- ---------------------------------------------------------------------------
1032 unload :: HscEnv -> [Linkable] -> IO ()
1033 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
1034 = case ghcLink (hsc_dflags hsc_env) of
1036 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
1038 LinkInMemory -> panic "unload: no interpreter"
1039 -- urgh. avoid warnings:
1040 hsc_env stable_linkables
1044 -- -----------------------------------------------------------------------------
1048 Stability tells us which modules definitely do not need to be recompiled.
1049 There are two main reasons for having stability:
1051 - avoid doing a complete upsweep of the module graph in GHCi when
1052 modules near the bottom of the tree have not changed.
1054 - to tell GHCi when it can load object code: we can only load object code
1055 for a module when we also load object code fo all of the imports of the
1056 module. So we need to know that we will definitely not be recompiling
1057 any of these modules, and we can use the object code.
1059 The stability check is as follows. Both stableObject and
1060 stableBCO are used during the upsweep phase later.
1063 stable m = stableObject m || stableBCO m
1066 all stableObject (imports m)
1067 && old linkable does not exist, or is == on-disk .o
1068 && date(on-disk .o) > date(.hs)
1071 all stable (imports m)
1072 && date(BCO) > date(.hs)
1075 These properties embody the following ideas:
1077 - if a module is stable, then:
1078 - if it has been compiled in a previous pass (present in HPT)
1079 then it does not need to be compiled or re-linked.
1080 - if it has not been compiled in a previous pass,
1081 then we only need to read its .hi file from disk and
1082 link it to produce a ModDetails.
1084 - if a modules is not stable, we will definitely be at least
1085 re-linking, and possibly re-compiling it during the upsweep.
1086 All non-stable modules can (and should) therefore be unlinked
1089 - Note that objects are only considered stable if they only depend
1090 on other objects. We can't link object code against byte code.
1094 :: HomePackageTable -- HPT from last compilation
1095 -> [SCC ModSummary] -- current module graph (cyclic)
1096 -> [ModuleName] -- all home modules
1097 -> ([ModuleName], -- stableObject
1098 [ModuleName]) -- stableBCO
1100 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
1102 checkSCC (stable_obj, stable_bco) scc0
1103 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
1104 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
1105 | otherwise = (stable_obj, stable_bco)
1107 scc = flattenSCC scc0
1108 scc_mods = map ms_mod_name scc
1109 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
1111 scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
1112 -- all imports outside the current SCC, but in the home pkg
1114 stable_obj_imps = map (`elem` stable_obj) scc_allimps
1115 stable_bco_imps = map (`elem` stable_bco) scc_allimps
1119 && all object_ok scc
1122 and (zipWith (||) stable_obj_imps stable_bco_imps)
1126 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
1130 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
1131 Just hmi | Just l <- hm_linkable hmi
1132 -> isObjectLinkable l && t == linkableTime l
1134 -- why '>=' rather than '>' above? If the filesystem stores
1135 -- times to the nearset second, we may occasionally find that
1136 -- the object & source have the same modification time,
1137 -- especially if the source was automatically generated
1138 -- and compiled. Using >= is slightly unsafe, but it matches
1139 -- make's behaviour.
1142 = case lookupUFM hpt (ms_mod_name ms) of
1143 Just hmi | Just l <- hm_linkable hmi ->
1144 not (isObjectLinkable l) &&
1145 linkableTime l >= ms_hs_date ms
1148 ms_allimps :: ModSummary -> [ModuleName]
1149 ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
1151 -- -----------------------------------------------------------------------------
1152 -- Prune the HomePackageTable
1154 -- Before doing an upsweep, we can throw away:
1156 -- - For non-stable modules:
1157 -- - all ModDetails, all linked code
1158 -- - all unlinked code that is out of date with respect to
1161 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
1162 -- space at the end of the upsweep, because the topmost ModDetails of the
1163 -- old HPT holds on to the entire type environment from the previous
1166 pruneHomePackageTable
1169 -> ([ModuleName],[ModuleName])
1172 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
1175 | is_stable modl = hmi'
1176 | otherwise = hmi'{ hm_details = emptyModDetails }
1178 modl = moduleName (mi_module (hm_iface hmi))
1179 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
1180 = hmi{ hm_linkable = Nothing }
1183 where ms = expectJust "prune" (lookupUFM ms_map modl)
1185 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
1187 is_stable m = m `elem` stable_obj || m `elem` stable_bco
1189 -- -----------------------------------------------------------------------------
1191 -- Return (names of) all those in modsDone who are part of a cycle
1192 -- as defined by theGraph.
1193 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
1194 findPartiallyCompletedCycles modsDone theGraph
1198 chew ((AcyclicSCC _):rest) = chew rest -- acyclic? not interesting.
1199 chew ((CyclicSCC vs):rest)
1200 = let names_in_this_cycle = nub (map ms_mod vs)
1202 = nub ([done | done <- modsDone,
1203 done `elem` names_in_this_cycle])
1204 chewed_rest = chew rest
1206 if notNull mods_in_this_cycle
1207 && length mods_in_this_cycle < length names_in_this_cycle
1208 then mods_in_this_cycle ++ chewed_rest
1211 -- -----------------------------------------------------------------------------
1214 -- This is where we compile each module in the module graph, in a pass
1215 -- from the bottom to the top of the graph.
1217 -- There better had not be any cyclic groups here -- we check for them.
1220 :: HscEnv -- Includes initially-empty HPT
1221 -> HomePackageTable -- HPT from last time round (pruned)
1222 -> ([ModuleName],[ModuleName]) -- stable modules (see checkStability)
1223 -> IO () -- How to clean up unwanted tmp files
1224 -> [SCC ModSummary] -- Mods to do (the worklist)
1226 HscEnv, -- With an updated HPT
1227 [ModSummary]) -- Mods which succeeded
1229 upsweep hsc_env old_hpt stable_mods cleanup sccs = do
1230 (res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
1231 return (res, hsc_env, reverse done)
1234 upsweep' hsc_env _old_hpt done
1236 = return (Succeeded, hsc_env, done)
1238 upsweep' hsc_env _old_hpt done
1239 (CyclicSCC ms:_) _ _
1240 = do fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
1241 return (Failed, hsc_env, done)
1243 upsweep' hsc_env old_hpt done
1244 (AcyclicSCC mod:mods) mod_index nmods
1245 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1246 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
1247 -- (moduleEnvElts (hsc_HPT hsc_env)))
1249 mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod
1252 cleanup -- Remove unwanted tmp files between compilations
1255 Nothing -> return (Failed, hsc_env, done)
1257 let this_mod = ms_mod_name mod
1259 -- Add new info to hsc_env
1260 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
1261 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
1263 -- Space-saving: delete the old HPT entry
1264 -- for mod BUT if mod is a hs-boot
1265 -- node, don't delete it. For the
1266 -- interface, the HPT entry is probaby for the
1267 -- main Haskell source file. Deleting it
1268 -- would force the real module to be recompiled
1270 old_hpt1 | isBootSummary mod = old_hpt
1271 | otherwise = delFromUFM old_hpt this_mod
1275 -- fixup our HomePackageTable after we've finished compiling
1276 -- a mutually-recursive loop. See reTypecheckLoop, below.
1277 hsc_env2 <- reTypecheckLoop hsc_env1 mod done'
1279 upsweep' hsc_env2 old_hpt1 done' mods (mod_index+1) nmods
1282 -- Compile a single module. Always produce a Linkable for it if
1283 -- successful. If no compilation happened, return the old Linkable.
1284 upsweep_mod :: HscEnv
1286 -> ([ModuleName],[ModuleName])
1288 -> Int -- index of module
1289 -> Int -- total number of modules
1290 -> IO (Maybe HomeModInfo) -- Nothing => Failed
1292 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
1294 this_mod_name = ms_mod_name summary
1295 this_mod = ms_mod summary
1296 mb_obj_date = ms_obj_date summary
1297 obj_fn = ml_obj_file (ms_location summary)
1298 hs_date = ms_hs_date summary
1300 is_stable_obj = this_mod_name `elem` stable_obj
1301 is_stable_bco = this_mod_name `elem` stable_bco
1303 old_hmi = lookupUFM old_hpt this_mod_name
1305 -- We're using the dflags for this module now, obtained by
1306 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
1307 dflags = ms_hspp_opts summary
1308 prevailing_target = hscTarget (hsc_dflags hsc_env)
1309 local_target = hscTarget dflags
1311 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
1312 -- we don't do anything dodgy: these should only work to change
1313 -- from -fvia-C to -fasm and vice-versa, otherwise we could
1314 -- end up trying to link object code to byte code.
1315 target = if prevailing_target /= local_target
1316 && (not (isObjectTarget prevailing_target)
1317 || not (isObjectTarget local_target))
1318 then prevailing_target
1321 -- store the corrected hscTarget into the summary
1322 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
1324 -- The old interface is ok if
1325 -- a) we're compiling a source file, and the old HPT
1326 -- entry is for a source file
1327 -- b) we're compiling a hs-boot file
1328 -- Case (b) allows an hs-boot file to get the interface of its
1329 -- real source file on the second iteration of the compilation
1330 -- manager, but that does no harm. Otherwise the hs-boot file
1331 -- will always be recompiled
1336 Just hm_info | isBootSummary summary -> Just iface
1337 | not (mi_boot iface) -> Just iface
1338 | otherwise -> Nothing
1340 iface = hm_iface hm_info
1342 compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
1343 compile_it = compile hsc_env summary' mod_index nmods mb_old_iface
1345 compile_it_discard_iface
1346 = compile hsc_env summary' mod_index nmods Nothing
1352 -- Regardless of whether we're generating object code or
1353 -- byte code, we can always use an existing object file
1354 -- if it is *stable* (see checkStability).
1355 | is_stable_obj, isJust old_hmi ->
1357 -- object is stable, and we have an entry in the
1358 -- old HPT: nothing to do
1360 | is_stable_obj, isNothing old_hmi -> do
1361 linkable <- findObjectLinkable this_mod obj_fn
1362 (expectJust "upseep1" mb_obj_date)
1363 compile_it (Just linkable)
1364 -- object is stable, but we need to load the interface
1365 -- off disk to make a HMI.
1369 ASSERT(isJust old_hmi) -- must be in the old_hpt
1371 -- BCO is stable: nothing to do
1373 | Just hmi <- old_hmi,
1374 Just l <- hm_linkable hmi, not (isObjectLinkable l),
1375 linkableTime l >= ms_hs_date summary ->
1377 -- we have an old BCO that is up to date with respect
1378 -- to the source: do a recompilation check as normal.
1382 -- no existing code at all: we must recompile.
1384 -- When generating object code, if there's an up-to-date
1385 -- object file on the disk, then we can use it.
1386 -- However, if the object file is new (compared to any
1387 -- linkable we had from a previous compilation), then we
1388 -- must discard any in-memory interface, because this
1389 -- means the user has compiled the source file
1390 -- separately and generated a new interface, that we must
1391 -- read from the disk.
1393 obj | isObjectTarget obj,
1394 Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
1397 | Just l <- hm_linkable hmi,
1398 isObjectLinkable l && linkableTime l == obj_date
1399 -> compile_it (Just l)
1401 linkable <- findObjectLinkable this_mod obj_fn obj_date
1402 compile_it_discard_iface (Just linkable)
1409 -- Filter modules in the HPT
1410 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
1411 retainInTopLevelEnvs keep_these hpt
1412 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
1414 , let mb_mod_info = lookupUFM hpt mod
1415 , isJust mb_mod_info ]
1417 -- ---------------------------------------------------------------------------
1418 -- Typecheck module loops
1421 See bug #930. This code fixes a long-standing bug in --make. The
1422 problem is that when compiling the modules *inside* a loop, a data
1423 type that is only defined at the top of the loop looks opaque; but
1424 after the loop is done, the structure of the data type becomes
1427 The difficulty is then that two different bits of code have
1428 different notions of what the data type looks like.
1430 The idea is that after we compile a module which also has an .hs-boot
1431 file, we re-generate the ModDetails for each of the modules that
1432 depends on the .hs-boot file, so that everyone points to the proper
1433 TyCons, Ids etc. defined by the real module, not the boot module.
1434 Fortunately re-generating a ModDetails from a ModIface is easy: the
1435 function TcIface.typecheckIface does exactly that.
1437 Picking the modules to re-typecheck is slightly tricky. Starting from
1438 the module graph consisting of the modules that have already been
1439 compiled, we reverse the edges (so they point from the imported module
1440 to the importing module), and depth-first-search from the .hs-boot
1441 node. This gives us all the modules that depend transitively on the
1442 .hs-boot module, and those are exactly the modules that we need to
1445 Following this fix, GHC can compile itself with --make -O2.
1448 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
1449 reTypecheckLoop hsc_env ms graph
1450 | not (isBootSummary ms) &&
1451 any (\m -> ms_mod m == this_mod && isBootSummary m) graph
1453 let mss = reachableBackwards (ms_mod_name ms) graph
1454 non_boot = filter (not.isBootSummary) mss
1455 debugTraceMsg (hsc_dflags hsc_env) 2 $
1456 text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
1457 typecheckLoop hsc_env (map ms_mod_name non_boot)
1461 this_mod = ms_mod ms
1463 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
1464 typecheckLoop hsc_env mods = do
1466 fixIO $ \new_hpt -> do
1467 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
1468 mds <- initIfaceCheck new_hsc_env $
1469 mapM (typecheckIface . hm_iface) hmis
1470 let new_hpt = addListToUFM old_hpt
1471 (zip mods [ hmi{ hm_details = details }
1472 | (hmi,details) <- zip hmis mds ])
1474 return hsc_env{ hsc_HPT = new_hpt }
1476 old_hpt = hsc_HPT hsc_env
1477 hmis = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
1479 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
1480 reachableBackwards mod summaries
1481 = [ ms | (ms,_,_) <- map vertex_fn nodes_we_want ]
1483 -- all the nodes reachable by traversing the edges backwards
1484 -- from the root node:
1485 nodes_we_want = reachable (transposeG graph) root
1487 -- the rest just sets up the graph:
1488 (nodes, lookup_key) = moduleGraphNodes False summaries
1489 (graph, vertex_fn, key_fn) = graphFromEdges' nodes
1491 | Just key <- lookup_key HsBootFile mod, Just v <- key_fn key = v
1492 | otherwise = panic "reachableBackwards"
1494 -- ---------------------------------------------------------------------------
1495 -- Topological sort of the module graph
1498 :: Bool -- Drop hi-boot nodes? (see below)
1502 -- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1503 -- The resulting list of strongly-connected-components is in topologically
1504 -- sorted order, starting with the module(s) at the bottom of the
1505 -- dependency graph (ie compile them first) and ending with the ones at
1508 -- Drop hi-boot nodes (first boolean arg)?
1510 -- False: treat the hi-boot summaries as nodes of the graph,
1511 -- so the graph must be acyclic
1513 -- True: eliminate the hi-boot nodes, and instead pretend
1514 -- the a source-import of Foo is an import of Foo
1515 -- The resulting graph has no hi-boot nodes, but can by cyclic
1517 topSortModuleGraph drop_hs_boot_nodes summaries Nothing
1518 = stronglyConnComp (fst (moduleGraphNodes drop_hs_boot_nodes summaries))
1519 topSortModuleGraph drop_hs_boot_nodes summaries (Just mod)
1520 = stronglyConnComp (map vertex_fn (reachable graph root))
1522 -- restrict the graph to just those modules reachable from
1523 -- the specified module. We do this by building a graph with
1524 -- the full set of nodes, and determining the reachable set from
1525 -- the specified node.
1526 (nodes, lookup_key) = moduleGraphNodes drop_hs_boot_nodes summaries
1527 (graph, vertex_fn, key_fn) = graphFromEdges' nodes
1529 | Just key <- lookup_key HsSrcFile mod, Just v <- key_fn key = v
1530 | otherwise = throwDyn (ProgramError "module does not exist")
1532 moduleGraphNodes :: Bool -> [ModSummary]
1533 -> ([(ModSummary, Int, [Int])], HscSource -> ModuleName -> Maybe Int)
1534 moduleGraphNodes drop_hs_boot_nodes summaries = (nodes, lookup_key)
1536 -- Drop hs-boot nodes by using HsSrcFile as the key
1537 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1538 | otherwise = HsBootFile
1540 -- We use integers as the keys for the SCC algorithm
1541 nodes :: [(ModSummary, Int, [Int])]
1542 nodes = [(s, expectJust "topSort" $
1543 lookup_key (ms_hsc_src s) (ms_mod_name s),
1544 out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
1545 out_edge_keys HsSrcFile (map unLoc (ms_imps s)) ++
1546 (-- see [boot-edges] below
1547 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
1549 else case lookup_key HsBootFile (ms_mod_name s) of
1554 , not (isBootSummary s && drop_hs_boot_nodes) ]
1555 -- Drop the hi-boot ones if told to do so
1557 -- [boot-edges] if this is a .hs and there is an equivalent
1558 -- .hs-boot, add a link from the former to the latter. This
1559 -- has the effect of detecting bogus cases where the .hs-boot
1560 -- depends on the .hs, by introducing a cycle. Additionally,
1561 -- it ensures that we will always process the .hs-boot before
1562 -- the .hs, and so the HomePackageTable will always have the
1563 -- most up to date information.
1565 key_map :: NodeMap Int
1566 key_map = listToFM ([(moduleName (ms_mod s), ms_hsc_src s)
1570 lookup_key :: HscSource -> ModuleName -> Maybe Int
1571 lookup_key hs_src mod = lookupFM key_map (mod, hs_src)
1573 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1574 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1575 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1576 -- the IsBootInterface parameter True; else False
1579 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
1580 type NodeMap a = FiniteMap NodeKey a -- keyed by (mod, src_file_type) pairs
1582 msKey :: ModSummary -> NodeKey
1583 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1585 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1586 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
1588 nodeMapElts :: NodeMap a -> [a]
1589 nodeMapElts = eltsFM
1591 -- If there are {-# SOURCE #-} imports between strongly connected
1592 -- components in the topological sort, then those imports can
1593 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1594 -- were necessary, then the edge would be part of a cycle.
1595 warnUnnecessarySourceImports :: DynFlags -> [SCC ModSummary] -> IO ()
1596 warnUnnecessarySourceImports dflags sccs =
1597 printBagOfWarnings dflags (listToBag (concat (map (check.flattenSCC) sccs)))
1599 let mods_in_this_cycle = map ms_mod_name ms in
1600 [ warn i | m <- ms, i <- ms_srcimps m,
1601 unLoc i `notElem` mods_in_this_cycle ]
1603 warn :: Located ModuleName -> WarnMsg
1606 (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
1607 <+> quotes (ppr mod))
1609 -----------------------------------------------------------------------------
1610 -- Downsweep (dependency analysis)
1612 -- Chase downwards from the specified root set, returning summaries
1613 -- for all home modules encountered. Only follow source-import
1616 -- We pass in the previous collection of summaries, which is used as a
1617 -- cache to avoid recalculating a module summary if the source is
1620 -- The returned list of [ModSummary] nodes has one node for each home-package
1621 -- module, plus one for any hs-boot files. The imports of these nodes
1622 -- are all there, including the imports of non-home-package modules.
1625 -> [ModSummary] -- Old summaries
1626 -> [ModuleName] -- Ignore dependencies on these; treat
1627 -- them as if they were package modules
1628 -> Bool -- True <=> allow multiple targets to have
1629 -- the same module name; this is
1630 -- very useful for ghc -M
1631 -> IO (Maybe [ModSummary])
1632 -- The elts of [ModSummary] all have distinct
1633 -- (Modules, IsBoot) identifiers, unless the Bool is true
1634 -- in which case there can be repeats
1635 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1636 = -- catch error messages and return them
1637 handleDyn (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
1638 rootSummaries <- mapM getRootSummary roots
1639 let root_map = mkRootMap rootSummaries
1640 checkDuplicates root_map
1641 summs <- loop (concatMap msDeps rootSummaries) root_map
1644 roots = hsc_targets hsc_env
1646 old_summary_map :: NodeMap ModSummary
1647 old_summary_map = mkNodeMap old_summaries
1649 getRootSummary :: Target -> IO ModSummary
1650 getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
1651 = do exists <- doesFileExist file
1653 then summariseFile hsc_env old_summaries file mb_phase maybe_buf
1654 else throwDyn $ mkPlainErrMsg noSrcSpan $
1655 text "can't find file:" <+> text file
1656 getRootSummary (Target (TargetModule modl) maybe_buf)
1657 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1658 (L rootLoc modl) maybe_buf excl_mods
1659 case maybe_summary of
1660 Nothing -> packageModErr modl
1663 rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1665 -- In a root module, the filename is allowed to diverge from the module
1666 -- name, so we have to check that there aren't multiple root files
1667 -- defining the same module (otherwise the duplicates will be silently
1668 -- ignored, leading to confusing behaviour).
1669 checkDuplicates :: NodeMap [ModSummary] -> IO ()
1670 checkDuplicates root_map
1671 | allow_dup_roots = return ()
1672 | null dup_roots = return ()
1673 | otherwise = multiRootsErr (head dup_roots)
1675 dup_roots :: [[ModSummary]] -- Each at least of length 2
1676 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1678 loop :: [(Located ModuleName,IsBootInterface)]
1679 -- Work list: process these modules
1680 -> NodeMap [ModSummary]
1681 -- Visited set; the range is a list because
1682 -- the roots can have the same module names
1683 -- if allow_dup_roots is True
1685 -- The result includes the worklist, except
1686 -- for those mentioned in the visited set
1687 loop [] done = return (concat (nodeMapElts done))
1688 loop ((wanted_mod, is_boot) : ss) done
1689 | Just summs <- lookupFM done key
1690 = if isSingleton summs then
1693 do { multiRootsErr summs; return [] }
1694 | otherwise = do { mb_s <- summariseModule hsc_env old_summary_map
1695 is_boot wanted_mod Nothing excl_mods
1697 Nothing -> loop ss done
1698 Just s -> loop (msDeps s ++ ss)
1699 (addToFM done key [s]) }
1701 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1703 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1704 mkRootMap summaries = addListToFM_C (++) emptyFM
1705 [ (msKey s, [s]) | s <- summaries ]
1707 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
1708 -- (msDeps s) returns the dependencies of the ModSummary s.
1709 -- A wrinkle is that for a {-# SOURCE #-} import we return
1710 -- *both* the hs-boot file
1711 -- *and* the source file
1712 -- as "dependencies". That ensures that the list of all relevant
1713 -- modules always contains B.hs if it contains B.hs-boot.
1714 -- Remember, this pass isn't doing the topological sort. It's
1715 -- just gathering the list of all relevant ModSummaries
1717 concat [ [(m,True), (m,False)] | m <- ms_srcimps s ]
1718 ++ [ (m,False) | m <- ms_imps s ]
1720 -----------------------------------------------------------------------------
1721 -- Summarising modules
1723 -- We have two types of summarisation:
1725 -- * Summarise a file. This is used for the root module(s) passed to
1726 -- cmLoadModules. The file is read, and used to determine the root
1727 -- module name. The module name may differ from the filename.
1729 -- * Summarise a module. We are given a module name, and must provide
1730 -- a summary. The finder is used to locate the file in which the module
1735 -> [ModSummary] -- old summaries
1736 -> FilePath -- source file name
1737 -> Maybe Phase -- start phase
1738 -> Maybe (StringBuffer,ClockTime)
1741 summariseFile hsc_env old_summaries file mb_phase maybe_buf
1742 -- we can use a cached summary if one is available and the
1743 -- source file hasn't changed, But we have to look up the summary
1744 -- by source file, rather than module name as we do in summarise.
1745 | Just old_summary <- findSummaryBySourceFile old_summaries file
1747 let location = ms_location old_summary
1749 -- return the cached summary if the source didn't change
1750 src_timestamp <- case maybe_buf of
1751 Just (_,t) -> return t
1752 Nothing -> getModificationTime file
1753 -- The file exists; we checked in getRootSummary above.
1754 -- If it gets removed subsequently, then this
1755 -- getModificationTime may fail, but that's the right
1758 if ms_hs_date old_summary == src_timestamp
1759 then do -- update the object-file timestamp
1760 obj_timestamp <- getObjTimestamp location False
1761 return old_summary{ ms_obj_date = obj_timestamp }
1769 let dflags = hsc_dflags hsc_env
1771 (dflags', hspp_fn, buf)
1772 <- preprocessFile hsc_env file mb_phase maybe_buf
1774 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
1776 -- Make a ModLocation for this file
1777 location <- mkHomeModLocation dflags mod_name file
1779 -- Tell the Finder cache where it is, so that subsequent calls
1780 -- to findModule will find it, even if it's not on any search path
1781 mod <- addHomeModuleToFinder hsc_env mod_name location
1783 src_timestamp <- case maybe_buf of
1784 Just (_,t) -> return t
1785 Nothing -> getModificationTime file
1786 -- getMofificationTime may fail
1788 obj_timestamp <- modificationTimeIfExists (ml_obj_file location)
1790 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1791 ms_location = location,
1792 ms_hspp_file = hspp_fn,
1793 ms_hspp_opts = dflags',
1794 ms_hspp_buf = Just buf,
1795 ms_srcimps = srcimps, ms_imps = the_imps,
1796 ms_hs_date = src_timestamp,
1797 ms_obj_date = obj_timestamp })
1799 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
1800 findSummaryBySourceFile summaries file
1801 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
1802 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
1806 -- Summarise a module, and pick up source and timestamp.
1809 -> NodeMap ModSummary -- Map of old summaries
1810 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
1811 -> Located ModuleName -- Imported module to be summarised
1812 -> Maybe (StringBuffer, ClockTime)
1813 -> [ModuleName] -- Modules to exclude
1814 -> IO (Maybe ModSummary) -- Its new summary
1816 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf excl_mods
1817 | wanted_mod `elem` excl_mods
1820 | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
1821 = do -- Find its new timestamp; all the
1822 -- ModSummaries in the old map have valid ml_hs_files
1823 let location = ms_location old_summary
1824 src_fn = expectJust "summariseModule" (ml_hs_file location)
1826 -- check the modification time on the source file, and
1827 -- return the cached summary if it hasn't changed. If the
1828 -- file has disappeared, we need to call the Finder again.
1830 Just (_,t) -> check_timestamp old_summary location src_fn t
1832 m <- System.IO.Error.try (getModificationTime src_fn)
1834 Right t -> check_timestamp old_summary location src_fn t
1835 Left e | isDoesNotExistError e -> find_it
1836 | otherwise -> ioError e
1838 | otherwise = find_it
1840 dflags = hsc_dflags hsc_env
1842 hsc_src = if is_boot then HsBootFile else HsSrcFile
1844 check_timestamp old_summary location src_fn src_timestamp
1845 | ms_hs_date old_summary == src_timestamp = do
1846 -- update the object-file timestamp
1847 obj_timestamp <- getObjTimestamp location is_boot
1848 return (Just old_summary{ ms_obj_date = obj_timestamp })
1850 -- source changed: re-summarise.
1851 new_summary location (ms_mod old_summary) src_fn src_timestamp
1854 -- Don't use the Finder's cache this time. If the module was
1855 -- previously a package module, it may have now appeared on the
1856 -- search path, so we want to consider it to be a home module. If
1857 -- the module was previously a home module, it may have moved.
1858 uncacheModule hsc_env wanted_mod
1859 found <- findImportedModule hsc_env wanted_mod Nothing
1862 | isJust (ml_hs_file location) ->
1864 just_found location mod
1866 -- Drop external-pkg
1867 ASSERT(modulePackageId mod /= thisPackage dflags)
1871 err -> noModError dflags loc wanted_mod err
1874 just_found location mod = do
1875 -- Adjust location to point to the hs-boot source file,
1876 -- hi file, object file, when is_boot says so
1877 let location' | is_boot = addBootSuffixLocn location
1878 | otherwise = location
1879 src_fn = expectJust "summarise2" (ml_hs_file location')
1881 -- Check that it exists
1882 -- It might have been deleted since the Finder last found it
1883 maybe_t <- modificationTimeIfExists src_fn
1885 Nothing -> noHsFileErr loc src_fn
1886 Just t -> new_summary location' mod src_fn t
1889 new_summary location mod src_fn src_timestamp
1891 -- Preprocess the source file and get its imports
1892 -- The dflags' contains the OPTIONS pragmas
1893 (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
1894 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
1896 when (mod_name /= wanted_mod) $
1897 throwDyn $ mkPlainErrMsg mod_loc $
1898 text "File name does not match module name:"
1899 $$ text "Saw:" <+> quotes (ppr mod_name)
1900 $$ text "Expected:" <+> quotes (ppr wanted_mod)
1902 -- Find the object timestamp, and return the summary
1903 obj_timestamp <- getObjTimestamp location is_boot
1905 return (Just ( ModSummary { ms_mod = mod,
1906 ms_hsc_src = hsc_src,
1907 ms_location = location,
1908 ms_hspp_file = hspp_fn,
1909 ms_hspp_opts = dflags',
1910 ms_hspp_buf = Just buf,
1911 ms_srcimps = srcimps,
1913 ms_hs_date = src_timestamp,
1914 ms_obj_date = obj_timestamp }))
1917 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
1918 getObjTimestamp location is_boot
1919 = if is_boot then return Nothing
1920 else modificationTimeIfExists (ml_obj_file location)
1923 preprocessFile :: HscEnv -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
1924 -> IO (DynFlags, FilePath, StringBuffer)
1925 preprocessFile hsc_env src_fn mb_phase Nothing
1927 (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
1928 buf <- hGetStringBuffer hspp_fn
1929 return (dflags', hspp_fn, buf)
1931 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
1933 let dflags = hsc_dflags hsc_env
1934 -- case we bypass the preprocessing stage?
1936 local_opts = getOptions dflags buf src_fn
1938 (dflags', leftovers, warns) <- parseDynamicFlags dflags (map unLoc local_opts)
1939 checkProcessArgsResult leftovers src_fn
1940 handleFlagWarnings dflags' warns
1944 | Just (Unlit _) <- mb_phase = True
1945 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
1946 -- note: local_opts is only required if there's no Unlit phase
1947 | dopt Opt_Cpp dflags' = True
1948 | dopt Opt_Pp dflags' = True
1951 when needs_preprocessing $
1952 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
1954 return (dflags', src_fn, buf)
1957 -----------------------------------------------------------------------------
1959 -----------------------------------------------------------------------------
1961 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
1962 -- ToDo: we don't have a proper line number for this error
1963 noModError dflags loc wanted_mod err
1964 = throwDyn $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
1966 noHsFileErr :: SrcSpan -> String -> a
1967 noHsFileErr loc path
1968 = throwDyn $ mkPlainErrMsg loc $ text "Can't find" <+> text path
1970 packageModErr :: ModuleName -> a
1972 = throwDyn $ mkPlainErrMsg noSrcSpan $
1973 text "module" <+> quotes (ppr mod) <+> text "is a package module"
1975 multiRootsErr :: [ModSummary] -> IO ()
1976 multiRootsErr [] = panic "multiRootsErr"
1977 multiRootsErr summs@(summ1:_)
1978 = throwDyn $ mkPlainErrMsg noSrcSpan $
1979 text "module" <+> quotes (ppr mod) <+>
1980 text "is defined in multiple files:" <+>
1981 sep (map text files)
1984 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
1986 cyclicModuleErr :: [ModSummary] -> SDoc
1988 = hang (ptext (sLit "Module imports form a cycle for modules:"))
1989 2 (vcat (map show_one ms))
1991 show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
1992 nest 2 $ ptext (sLit "imports:") <+>
1993 (pp_imps HsBootFile (ms_srcimps ms)
1994 $$ pp_imps HsSrcFile (ms_imps ms))]
1995 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
1996 pp_imps src mods = fsep (map (show_mod src) mods)
1999 -- | Inform GHC that the working directory has changed. GHC will flush
2000 -- its cache of module locations, since it may no longer be valid.
2001 -- Note: if you change the working directory, you should also unload
2002 -- the current program (set targets to empty, followed by load).
2003 workingDirectoryChanged :: Session -> IO ()
2004 workingDirectoryChanged s = withSession s $ flushFinderCaches
2006 -- -----------------------------------------------------------------------------
2007 -- inspecting the session
2009 -- | Get the module dependency graph.
2010 getModuleGraph :: Session -> IO ModuleGraph -- ToDo: DiGraph ModSummary
2011 getModuleGraph s = withSession s (return . hsc_mod_graph)
2013 isLoaded :: Session -> ModuleName -> IO Bool
2014 isLoaded s m = withSession s $ \hsc_env ->
2015 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
2017 getBindings :: Session -> IO [TyThing]
2018 getBindings s = withSession s $ \hsc_env ->
2019 -- we have to implement the shadowing behaviour of ic_tmp_ids here
2020 -- (see InteractiveContext) and the quickest way is to use an OccEnv.
2022 tmp_ids = ic_tmp_ids (hsc_IC hsc_env)
2023 filtered = foldr f (const []) tmp_ids emptyUniqSet
2025 | uniq `elementOfUniqSet` set = rest set
2026 | otherwise = AnId id : rest (addOneToUniqSet set uniq)
2027 where uniq = getUnique (nameOccName (idName id))
2031 getPrintUnqual :: Session -> IO PrintUnqualified
2032 getPrintUnqual s = withSession s $ \hsc_env ->
2033 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
2035 -- | Container for information about a 'Module'.
2036 data ModuleInfo = ModuleInfo {
2037 minf_type_env :: TypeEnv,
2038 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
2039 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
2040 minf_instances :: [Instance]
2042 ,minf_modBreaks :: ModBreaks
2044 -- ToDo: this should really contain the ModIface too
2046 -- We don't want HomeModInfo here, because a ModuleInfo applies
2047 -- to package modules too.
2049 -- | Request information about a loaded 'Module'
2050 getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
2051 getModuleInfo s mdl = withSession s $ \hsc_env -> do
2052 let mg = hsc_mod_graph hsc_env
2053 if mdl `elem` map ms_mod mg
2054 then getHomeModuleInfo hsc_env (moduleName mdl)
2056 {- if isHomeModule (hsc_dflags hsc_env) mdl
2058 else -} getPackageModuleInfo hsc_env mdl
2059 -- getPackageModuleInfo will attempt to find the interface, so
2060 -- we don't want to call it for a home module, just in case there
2061 -- was a problem loading the module and the interface doesn't
2062 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
2064 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
2066 getPackageModuleInfo hsc_env mdl = do
2067 (_msgs, mb_avails) <- getModuleExports hsc_env mdl
2069 Nothing -> return Nothing
2071 eps <- readIORef (hsc_EPS hsc_env)
2073 names = availsToNameSet avails
2075 tys = [ ty | name <- concatMap availNames avails,
2076 Just ty <- [lookupTypeEnv pte name] ]
2078 return (Just (ModuleInfo {
2079 minf_type_env = mkTypeEnv tys,
2080 minf_exports = names,
2081 minf_rdr_env = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
2082 minf_instances = error "getModuleInfo: instances for package module unimplemented",
2083 minf_modBreaks = emptyModBreaks
2086 getPackageModuleInfo _hsc_env _mdl = do
2087 -- bogusly different for non-GHCI (ToDo)
2091 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
2092 getHomeModuleInfo hsc_env mdl =
2093 case lookupUFM (hsc_HPT hsc_env) mdl of
2094 Nothing -> return Nothing
2096 let details = hm_details hmi
2097 return (Just (ModuleInfo {
2098 minf_type_env = md_types details,
2099 minf_exports = availsToNameSet (md_exports details),
2100 minf_rdr_env = mi_globals $! hm_iface hmi,
2101 minf_instances = md_insts details
2103 ,minf_modBreaks = getModBreaks hmi
2107 -- | The list of top-level entities defined in a module
2108 modInfoTyThings :: ModuleInfo -> [TyThing]
2109 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
2111 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
2112 modInfoTopLevelScope minf
2113 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
2115 modInfoExports :: ModuleInfo -> [Name]
2116 modInfoExports minf = nameSetToList $! minf_exports minf
2118 -- | Returns the instances defined by the specified module.
2119 -- Warning: currently unimplemented for package modules.
2120 modInfoInstances :: ModuleInfo -> [Instance]
2121 modInfoInstances = minf_instances
2123 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
2124 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
2126 mkPrintUnqualifiedForModule :: Session -> ModuleInfo -> IO (Maybe PrintUnqualified)
2127 mkPrintUnqualifiedForModule s minf = withSession s $ \hsc_env -> do
2128 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
2130 modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
2131 modInfoLookupName s minf name = withSession s $ \hsc_env -> do
2132 case lookupTypeEnv (minf_type_env minf) name of
2133 Just tyThing -> return (Just tyThing)
2135 eps <- readIORef (hsc_EPS hsc_env)
2136 return $! lookupType (hsc_dflags hsc_env)
2137 (hsc_HPT hsc_env) (eps_PTE eps) name
2140 modInfoModBreaks :: ModuleInfo -> ModBreaks
2141 modInfoModBreaks = minf_modBreaks
2144 isDictonaryId :: Id -> Bool
2146 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
2148 -- | Looks up a global name: that is, any top-level name in any
2149 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
2150 -- the interactive context, and therefore does not require a preceding
2152 lookupGlobalName :: Session -> Name -> IO (Maybe TyThing)
2153 lookupGlobalName s name = withSession s $ \hsc_env -> do
2154 eps <- readIORef (hsc_EPS hsc_env)
2155 return $! lookupType (hsc_dflags hsc_env)
2156 (hsc_HPT hsc_env) (eps_PTE eps) name
2159 -- | get the GlobalRdrEnv for a session
2160 getGRE :: Session -> IO GlobalRdrEnv
2161 getGRE s = withSession s $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
2164 -- -----------------------------------------------------------------------------
2165 -- Misc exported utils
2167 dataConType :: DataCon -> Type
2168 dataConType dc = idType (dataConWrapId dc)
2170 -- | print a 'NamedThing', adding parentheses if the name is an operator.
2171 pprParenSymName :: NamedThing a => a -> SDoc
2172 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
2174 -- ----------------------------------------------------------------------------
2179 -- - Data and Typeable instances for HsSyn.
2181 -- ToDo: check for small transformations that happen to the syntax in
2182 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
2184 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
2185 -- to get from TyCons, Ids etc. to TH syntax (reify).
2187 -- :browse will use either lm_toplev or inspect lm_interface, depending
2188 -- on whether the module is interpreted or not.
2190 -- This is for reconstructing refactored source code
2191 -- Calls the lexer repeatedly.
2192 -- ToDo: add comment tokens to token stream
2193 getTokenStream :: Session -> Module -> IO [Located Token]
2196 -- -----------------------------------------------------------------------------
2197 -- Interactive evaluation
2199 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
2200 -- filesystem and package database to find the corresponding 'Module',
2201 -- using the algorithm that is used for an @import@ declaration.
2202 findModule :: Session -> ModuleName -> Maybe PackageId -> IO Module
2203 findModule s mod_name maybe_pkg = withSession s $ \hsc_env ->
2205 dflags = hsc_dflags hsc_env
2206 hpt = hsc_HPT hsc_env
2207 this_pkg = thisPackage dflags
2209 case lookupUFM hpt mod_name of
2210 Just mod_info -> return (mi_module (hm_iface mod_info))
2211 _not_a_home_module -> do
2212 res <- findImportedModule hsc_env mod_name maybe_pkg
2214 Found _ m | modulePackageId m /= this_pkg -> return m
2215 | otherwise -> throwDyn (CmdLineError (showSDoc $
2216 text "module" <+> pprModule m <+>
2217 text "is not loaded"))
2218 err -> let msg = cannotFindModule dflags mod_name err in
2219 throwDyn (CmdLineError (showSDoc msg))
2222 getHistorySpan :: Session -> History -> IO SrcSpan
2223 getHistorySpan sess h = withSession sess $ \hsc_env ->
2224 return$ InteractiveEval.getHistorySpan hsc_env h
2226 obtainTerm :: Session -> Bool -> Id -> IO Term
2227 obtainTerm sess force id = withSession sess $ \hsc_env ->
2228 InteractiveEval.obtainTerm hsc_env force id
2230 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
2231 obtainTerm1 sess force mb_ty a = withSession sess $ \hsc_env ->
2232 InteractiveEval.obtainTerm1 hsc_env force mb_ty a
2234 obtainTermB :: Session -> Int -> Bool -> Id -> IO Term
2235 obtainTermB sess bound force id = withSession sess $ \hsc_env ->
2236 InteractiveEval.obtainTermB hsc_env bound force id