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,
46 -- * Parsing Haddock comments
49 -- * Inspecting the module structure of the program
50 ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
55 -- * Inspecting modules
62 modInfoIsExportedName,
65 mkPrintUnqualifiedForModule,
68 PrintUnqualified, alwaysQualify,
70 -- * Interactive evaluation
71 getBindings, getPrintUnqual,
74 setContext, getContext,
84 runStmt, SingleStep(..),
86 Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
87 resumeHistory, resumeHistoryIx),
88 History(historyBreakInfo, historyEnclosingDecl),
89 GHC.getHistorySpan, getHistoryModule,
93 InteractiveEval.forward,
96 InteractiveEval.compileExpr, HValue, dynCompileExpr,
98 GHC.obtainTerm, GHC.obtainTerm1, GHC.obtainTermB, reconstructType,
100 ModBreaks(..), BreakIndex,
101 BreakInfo(breakInfo_number, breakInfo_module),
102 BreakArray, setBreakOn, setBreakOff, getBreak,
105 -- * Abstract syntax elements
111 Module, mkModule, pprModule, moduleName, modulePackageId,
112 ModuleName, mkModuleName, moduleNameString,
116 isExternalName, nameModule, pprParenSymName, nameSrcSpan,
118 RdrName(Qual,Unqual),
122 isImplicitId, isDeadBinder,
123 isExportedId, isLocalId, isGlobalId,
125 isPrimOpId, isFCallId, isClassOpId_maybe,
126 isDataConWorkId, idDataCon,
127 isBottomingId, isDictonaryId,
128 recordSelectorFieldLabel,
130 -- ** Type constructors
132 tyConTyVars, tyConDataCons, tyConArity,
133 isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
135 synTyConDefn, synTyConType, synTyConResKind,
141 -- ** Data constructors
143 dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
144 dataConIsInfix, isVanillaDataCon,
146 StrictnessMark(..), isMarkedStrict,
150 classMethods, classSCTheta, classTvsFds,
155 instanceDFunId, pprInstance, pprInstanceHdr,
157 -- ** Types and Kinds
158 Type, splitForAllTys, funResultTy,
159 pprParendType, pprTypeApp,
162 ThetaType, pprThetaArrow,
168 module HsSyn, -- ToDo: remove extraneous bits
172 defaultFixity, maxPrecedence,
176 -- ** Source locations
178 mkSrcLoc, isGoodSrcLoc, noSrcLoc,
179 srcLocFile, srcLocLine, srcLocCol,
181 mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
182 srcSpanStart, srcSpanEnd,
184 srcSpanStartLine, srcSpanEndLine,
185 srcSpanStartCol, srcSpanEndCol,
188 GhcException(..), showGhcException,
198 * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
199 * what StaticFlags should we expose, if any?
202 #include "HsVersions.h"
205 import qualified Linker
206 import Linker ( HValue )
210 import InteractiveEval
215 import TcRnTypes hiding (LIE)
216 import TcRnMonad ( initIfaceCheck )
221 import Type hiding (typeKind)
222 import TcType hiding (typeKind)
224 import Var hiding (setIdType)
225 import TysPrim ( alphaTyVars )
230 import Name hiding ( varName )
231 import OccName ( parenSymOcc )
232 import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr )
235 import DriverPipeline
236 import DriverPhases ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase )
237 import HeaderInfo ( getImports, getOptions )
243 import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
252 import Bag ( unitBag, listToBag )
253 import ErrUtils ( Severity(..), showPass, fatalErrorMsg, debugTraceMsg,
254 mkPlainErrMsg, printBagOfErrors, printBagOfWarnings,
256 import qualified ErrUtils
258 import StringBuffer ( StringBuffer, hGetStringBuffer )
261 import Maybes ( expectJust, mapCatMaybes )
263 import HaddockLex ( tokenise )
265 import Control.Concurrent
266 import System.Directory ( getModificationTime, doesFileExist )
269 import qualified Data.List as List
271 import System.Exit ( exitWith, ExitCode(..) )
272 import System.Time ( ClockTime )
273 import Control.Exception as Exception hiding (handle)
276 import System.IO.Error ( try, isDoesNotExistError )
277 import Prelude hiding (init)
280 -- -----------------------------------------------------------------------------
281 -- Exception handlers
283 -- | Install some default exception handlers and run the inner computation.
284 -- Unless you want to handle exceptions yourself, you should wrap this around
285 -- the top level of your program. The default handlers output the error
286 -- message(s) to stderr and exit cleanly.
287 defaultErrorHandler :: DynFlags -> IO a -> IO a
288 defaultErrorHandler dflags inner =
289 -- top-level exception handler: any unrecognised exception is a compiler bug.
290 handle (\exception -> do
293 -- an IO exception probably isn't our fault, so don't panic
295 fatalErrorMsg dflags (text (show exception))
296 AsyncException StackOverflow ->
297 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
299 fatalErrorMsg dflags (text (show (Panic (show exception))))
300 exitWith (ExitFailure 1)
303 -- program errors: messages with locations attached. Sometimes it is
304 -- convenient to just throw these as exceptions.
305 handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
306 exitWith (ExitFailure 1)) $
308 -- error messages propagated as exceptions
309 handleDyn (\dyn -> do
312 PhaseFailed _ code -> exitWith code
313 Interrupted -> exitWith (ExitFailure 1)
314 _ -> do fatalErrorMsg dflags (text (show (dyn :: GhcException)))
315 exitWith (ExitFailure 1)
319 -- | Install a default cleanup handler to remove temporary files
320 -- deposited by a GHC run. This is seperate from
321 -- 'defaultErrorHandler', because you might want to override the error
322 -- handling, but still get the ordinary cleanup behaviour.
323 defaultCleanupHandler :: DynFlags -> IO a -> IO a
324 defaultCleanupHandler dflags inner =
325 -- make sure we clean up after ourselves
326 later (do cleanTempFiles dflags
329 -- exceptions will be blocked while we clean the temporary files,
330 -- so there shouldn't be any difficulty if we receive further
335 -- | Starts a new session. A session consists of a set of loaded
336 -- modules, a set of options (DynFlags), and an interactive context.
337 -- ToDo: explain argument [[mb_top_dir]]
338 newSession :: Maybe FilePath -> IO Session
339 newSession mb_top_dir = do
341 main_thread <- myThreadId
342 modifyMVar_ interruptTargetThread (return . (main_thread :))
343 installSignalHandlers
346 dflags0 <- initSysTools mb_top_dir defaultDynFlags
347 dflags <- initDynFlags dflags0
348 env <- newHscEnv dflags
352 -- tmp: this breaks the abstraction, but required because DriverMkDepend
353 -- needs to call the Finder. ToDo: untangle this.
354 sessionHscEnv :: Session -> IO HscEnv
355 sessionHscEnv (Session ref) = readIORef ref
357 -- -----------------------------------------------------------------------------
360 -- | Grabs the DynFlags from the Session
361 getSessionDynFlags :: Session -> IO DynFlags
362 getSessionDynFlags s = withSession s (return . hsc_dflags)
364 -- | Updates the DynFlags in a Session. This also reads
365 -- the package database (unless it has already been read),
366 -- and prepares the compilers knowledge about packages. It
367 -- can be called again to load new packages: just add new
368 -- package flags to (packageFlags dflags).
370 -- Returns a list of new packages that may need to be linked in using
371 -- the dynamic linker (see 'linkPackages') as a result of new package
372 -- flags. If you are not doing linking or doing static linking, you
373 -- can ignore the list of packages returned.
375 setSessionDynFlags :: Session -> DynFlags -> IO [PackageId]
376 setSessionDynFlags (Session ref) dflags = do
377 hsc_env <- readIORef ref
378 (dflags', preload) <- initPackages dflags
379 writeIORef ref $! hsc_env{ hsc_dflags = dflags' }
382 -- | If there is no -o option, guess the name of target executable
383 -- by using top-level source file name as a base.
384 guessOutputFile :: Session -> IO ()
385 guessOutputFile s = modifySession s $ \env ->
386 let dflags = hsc_dflags env
387 mod_graph = hsc_mod_graph env
388 mainModuleSrcPath, guessedName :: Maybe String
389 mainModuleSrcPath = do
390 let isMain = (== mainModIs dflags) . ms_mod
391 [ms] <- return (filter isMain mod_graph)
392 ml_hs_file (ms_location ms)
393 guessedName = fmap basenameOf mainModuleSrcPath
395 case outputFile dflags of
397 Nothing -> env { hsc_dflags = dflags { outputFile = guessedName } }
399 -- -----------------------------------------------------------------------------
402 -- ToDo: think about relative vs. absolute file paths. And what
403 -- happens when the current directory changes.
405 -- | Sets the targets for this session. Each target may be a module name
406 -- or a filename. The targets correspond to the set of root modules for
407 -- the program\/library. Unloading the current program is achieved by
408 -- setting the current set of targets to be empty, followed by load.
409 setTargets :: Session -> [Target] -> IO ()
410 setTargets s targets = modifySession s (\h -> h{ hsc_targets = targets })
412 -- | returns the current set of targets
413 getTargets :: Session -> IO [Target]
414 getTargets s = withSession s (return . hsc_targets)
416 -- | Add another target
417 addTarget :: Session -> Target -> IO ()
419 = modifySession s (\h -> h{ hsc_targets = target : hsc_targets h })
422 removeTarget :: Session -> TargetId -> IO ()
423 removeTarget s target_id
424 = modifySession s (\h -> h{ hsc_targets = filter (hsc_targets h) })
426 filter targets = [ t | t@(Target id _) <- targets, id /= target_id ]
428 -- Attempts to guess what Target a string refers to. This function implements
429 -- the --make/GHCi command-line syntax for filenames:
431 -- - if the string looks like a Haskell source filename, then interpret
433 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
435 -- - otherwise interpret the string as a module name
437 guessTarget :: String -> Maybe Phase -> IO Target
438 guessTarget file (Just phase)
439 = return (Target (TargetFile file (Just phase)) Nothing)
440 guessTarget file Nothing
441 | isHaskellSrcFilename file
442 = return (Target (TargetFile file Nothing) Nothing)
444 = do exists <- doesFileExist hs_file
446 then return (Target (TargetFile hs_file Nothing) Nothing)
448 exists <- doesFileExist lhs_file
450 then return (Target (TargetFile lhs_file Nothing) Nothing)
452 return (Target (TargetModule (mkModuleName file)) Nothing)
454 hs_file = file `joinFileExt` "hs"
455 lhs_file = file `joinFileExt` "lhs"
457 -- -----------------------------------------------------------------------------
458 -- Extending the program scope
460 extendGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
461 extendGlobalRdrScope session rdrElts
462 = modifySession session $ \hscEnv ->
463 let global_rdr = hsc_global_rdr_env hscEnv
464 in hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv global_rdr rdrElts }
466 setGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
467 setGlobalRdrScope session rdrElts
468 = modifySession session $ \hscEnv ->
469 hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv rdrElts }
471 extendGlobalTypeScope :: Session -> [Id] -> IO ()
472 extendGlobalTypeScope session ids
473 = modifySession session $ \hscEnv ->
474 let global_type = hsc_global_type_env hscEnv
475 in hscEnv{ hsc_global_type_env = extendTypeEnvWithIds global_type ids }
477 setGlobalTypeScope :: Session -> [Id] -> IO ()
478 setGlobalTypeScope session ids
479 = modifySession session $ \hscEnv ->
480 hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
482 -- -----------------------------------------------------------------------------
483 -- Parsing Haddock comments
485 parseHaddockComment :: String -> Either String (HsDoc RdrName)
486 parseHaddockComment string =
487 case parseHaddockParagraphs (tokenise string) of
491 -- -----------------------------------------------------------------------------
492 -- Loading the program
494 -- Perform a dependency analysis starting from the current targets
495 -- and update the session with the new module graph.
496 depanal :: Session -> [ModuleName] -> Bool -> IO (Maybe ModuleGraph)
497 depanal (Session ref) excluded_mods allow_dup_roots = do
498 hsc_env <- readIORef ref
500 dflags = hsc_dflags hsc_env
501 targets = hsc_targets hsc_env
502 old_graph = hsc_mod_graph hsc_env
504 showPass dflags "Chasing dependencies"
505 debugTraceMsg dflags 2 (hcat [
506 text "Chasing modules from: ",
507 hcat (punctuate comma (map pprTarget targets))])
509 r <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
511 Just mod_graph -> writeIORef ref hsc_env{ hsc_mod_graph = mod_graph }
516 -- | The result of load.
518 = LoadOk Errors -- ^ all specified targets were loaded successfully.
519 | LoadFailed Errors -- ^ not all modules were loaded.
521 type Errors = [String]
523 data ErrMsg = ErrMsg {
524 errMsgSeverity :: Severity, -- warning, error, etc.
525 errMsgSpans :: [SrcSpan],
526 errMsgShortDoc :: Doc,
527 errMsgExtraInfo :: Doc
533 | LoadUpTo ModuleName
534 | LoadDependenciesOf ModuleName
536 -- | Try to load the program. If a Module is supplied, then just
537 -- attempt to load up to this target. If no Module is supplied,
538 -- then try to load all targets.
539 load :: Session -> LoadHowMuch -> IO SuccessFlag
540 load s@(Session ref) how_much
542 -- Dependency analysis first. Note that this fixes the module graph:
543 -- even if we don't get a fully successful upsweep, the full module
544 -- graph is still retained in the Session. We can tell which modules
545 -- were successfully loaded by inspecting the Session's HPT.
546 mb_graph <- depanal s [] False
548 Just mod_graph -> catchingFailure $ load2 s how_much mod_graph
549 Nothing -> return Failed
550 where catchingFailure f = f `Exception.catch` \e -> do
551 hsc_env <- readIORef ref
552 -- trac #1565 / test ghci021:
553 -- let bindings may explode if we try to use them after
555 writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
558 load2 :: Session -> LoadHowMuch -> [ModSummary] -> IO SuccessFlag
559 load2 s@(Session ref) how_much mod_graph = do
561 hsc_env <- readIORef ref
563 let hpt1 = hsc_HPT hsc_env
564 let dflags = hsc_dflags hsc_env
566 -- The "bad" boot modules are the ones for which we have
567 -- B.hs-boot in the module graph, but no B.hs
568 -- The downsweep should have ensured this does not happen
570 let all_home_mods = [ms_mod_name s
571 | s <- mod_graph, not (isBootSummary s)]
572 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
573 not (ms_mod_name s `elem` all_home_mods)]
574 ASSERT( null bad_boot_mods ) return ()
576 -- mg2_with_srcimps drops the hi-boot nodes, returning a
577 -- graph with cycles. Among other things, it is used for
578 -- backing out partially complete cycles following a failed
579 -- upsweep, and for removing from hpt all the modules
580 -- not in strict downwards closure, during calls to compile.
581 let mg2_with_srcimps :: [SCC ModSummary]
582 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
584 -- If we can determine that any of the {-# SOURCE #-} imports
585 -- are definitely unnecessary, then emit a warning.
586 warnUnnecessarySourceImports dflags mg2_with_srcimps
589 -- check the stability property for each module.
590 stable_mods@(stable_obj,stable_bco)
591 = checkStability hpt1 mg2_with_srcimps all_home_mods
593 -- prune bits of the HPT which are definitely redundant now,
595 pruned_hpt = pruneHomePackageTable hpt1
596 (flattenSCCs mg2_with_srcimps)
601 debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
602 text "Stable BCO:" <+> ppr stable_bco)
604 -- Unload any modules which are going to be re-linked this time around.
605 let stable_linkables = [ linkable
606 | m <- stable_obj++stable_bco,
607 Just hmi <- [lookupUFM pruned_hpt m],
608 Just linkable <- [hm_linkable hmi] ]
609 unload hsc_env stable_linkables
611 -- We could at this point detect cycles which aren't broken by
612 -- a source-import, and complain immediately, but it seems better
613 -- to let upsweep_mods do this, so at least some useful work gets
614 -- done before the upsweep is abandoned.
615 --hPutStrLn stderr "after tsort:\n"
616 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
618 -- Now do the upsweep, calling compile for each module in
619 -- turn. Final result is version 3 of everything.
621 -- Topologically sort the module graph, this time including hi-boot
622 -- nodes, and possibly just including the portion of the graph
623 -- reachable from the module specified in the 2nd argument to load.
624 -- This graph should be cycle-free.
625 -- If we're restricting the upsweep to a portion of the graph, we
626 -- also want to retain everything that is still stable.
627 let full_mg :: [SCC ModSummary]
628 full_mg = topSortModuleGraph False mod_graph Nothing
630 maybe_top_mod = case how_much of
632 LoadDependenciesOf m -> Just m
635 partial_mg0 :: [SCC ModSummary]
636 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
638 -- LoadDependenciesOf m: we want the upsweep to stop just
639 -- short of the specified module (unless the specified module
642 | LoadDependenciesOf _mod <- how_much
643 = ASSERT( case last partial_mg0 of
644 AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
645 List.init partial_mg0
651 | AcyclicSCC ms <- full_mg,
652 ms_mod_name ms `elem` stable_obj++stable_bco,
653 ms_mod_name ms `notElem` [ ms_mod_name ms' |
654 AcyclicSCC ms' <- partial_mg ] ]
656 mg = stable_mg ++ partial_mg
658 -- clean up between compilations
659 let cleanup = cleanTempFilesExcept dflags
660 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
662 debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
664 (upsweep_ok, hsc_env1, modsUpswept)
665 <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
666 pruned_hpt stable_mods cleanup mg
668 -- Make modsDone be the summaries for each home module now
669 -- available; this should equal the domain of hpt3.
670 -- Get in in a roughly top .. bottom order (hence reverse).
672 let modsDone = reverse modsUpswept
674 -- Try and do linking in some form, depending on whether the
675 -- upsweep was completely or only partially successful.
677 if succeeded upsweep_ok
680 -- Easy; just relink it all.
681 do debugTraceMsg dflags 2 (text "Upsweep completely successful.")
683 -- Clean up after ourselves
684 cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
686 -- Issue a warning for the confusing case where the user
687 -- said '-o foo' but we're not going to do any linking.
688 -- We attempt linking if either (a) one of the modules is
689 -- called Main, or (b) the user said -no-hs-main, indicating
690 -- that main() is going to come from somewhere else.
692 let ofile = outputFile dflags
693 let no_hs_main = dopt Opt_NoHsMain dflags
695 main_mod = mainModIs dflags
696 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
697 do_linking = a_root_is_Main || no_hs_main
699 when (ghcLink dflags == LinkBinary
700 && isJust ofile && not do_linking) $
701 debugTraceMsg dflags 1 $
702 text ("Warning: output was redirected with -o, " ++
703 "but no output will be generated\n" ++
704 "because there is no " ++
705 moduleNameString (moduleName main_mod) ++ " module.")
707 -- link everything together
708 linkresult <- link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
710 loadFinish Succeeded linkresult ref hsc_env1
713 -- Tricky. We need to back out the effects of compiling any
714 -- half-done cycles, both so as to clean up the top level envs
715 -- and to avoid telling the interactive linker to link them.
716 do debugTraceMsg dflags 2 (text "Upsweep partially successful.")
719 = map ms_mod modsDone
720 let mods_to_zap_names
721 = findPartiallyCompletedCycles modsDone_names
724 = filter ((`notElem` mods_to_zap_names).ms_mod)
727 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
730 -- Clean up after ourselves
731 cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
733 -- there should be no Nothings where linkables should be, now
734 ASSERT(all (isJust.hm_linkable)
735 (eltsUFM (hsc_HPT hsc_env))) do
737 -- Link everything together
738 linkresult <- link (ghcLink dflags) dflags False hpt4
740 let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
741 loadFinish Failed linkresult ref hsc_env4
743 -- Finish up after a load.
745 -- If the link failed, unload everything and return.
746 loadFinish :: SuccessFlag -> SuccessFlag -> IORef HscEnv -> HscEnv -> IO SuccessFlag
747 loadFinish _all_ok Failed ref hsc_env
748 = do unload hsc_env []
749 writeIORef ref $! discardProg hsc_env
752 -- Empty the interactive context and set the module context to the topmost
753 -- newly loaded module, or the Prelude if none were loaded.
754 loadFinish all_ok Succeeded ref hsc_env
755 = do writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
759 -- Forget the current program, but retain the persistent info in HscEnv
760 discardProg :: HscEnv -> HscEnv
762 = hsc_env { hsc_mod_graph = emptyMG,
763 hsc_IC = emptyInteractiveContext,
764 hsc_HPT = emptyHomePackageTable }
766 -- used to fish out the preprocess output files for the purposes of
767 -- cleaning up. The preprocessed file *might* be the same as the
768 -- source file, but that doesn't do any harm.
769 ppFilesFromSummaries :: [ModSummary] -> [FilePath]
770 ppFilesFromSummaries summaries = map ms_hspp_file summaries
772 -- -----------------------------------------------------------------------------
776 CheckedModule { parsedSource :: ParsedSource,
777 renamedSource :: Maybe RenamedSource,
778 typecheckedSource :: Maybe TypecheckedSource,
779 checkedModuleInfo :: Maybe ModuleInfo,
780 coreModule :: Maybe CoreModule
782 -- ToDo: improvements that could be made here:
783 -- if the module succeeded renaming but not typechecking,
784 -- we can still get back the GlobalRdrEnv and exports, so
785 -- perhaps the ModuleInfo should be split up into separate
786 -- fields within CheckedModule.
788 type ParsedSource = Located (HsModule RdrName)
789 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
790 Maybe (HsDoc Name), HaddockModInfo Name)
791 type TypecheckedSource = LHsBinds Id
794 -- - things that aren't in the output of the typechecker right now:
798 -- - type/data/newtype declarations
799 -- - class declarations
801 -- - extra things in the typechecker's output:
802 -- - default methods are turned into top-level decls.
803 -- - dictionary bindings
806 -- | This is the way to get access to parsed and typechecked source code
807 -- for a module. 'checkModule' attempts to typecheck the module. If
808 -- successful, it returns the abstract syntax for the module.
809 -- If compileToCore is true, it also desugars the module and returns the
810 -- resulting Core bindings as a component of the CheckedModule.
811 checkModule :: Session -> ModuleName -> Bool -> IO (Maybe CheckedModule)
812 checkModule (Session ref) mod compile_to_core
814 hsc_env <- readIORef ref
815 let mg = hsc_mod_graph hsc_env
816 case [ ms | ms <- mg, ms_mod_name ms == mod ] of
818 (ms:_) -> checkModule_ ref ms compile_to_core False
820 -- | parses and typechecks a module, optionally generates Core, and also
821 -- loads the module into the 'Session' so that modules which depend on
822 -- this one may subsequently be typechecked using 'checkModule' or
823 -- 'checkAndLoadModule'. If you need to check more than one module,
824 -- you probably want to use 'checkAndLoadModule'. Constructing the
825 -- interface takes a little work, so it might be slightly slower than
827 checkAndLoadModule :: Session -> ModSummary -> Bool -> IO (Maybe CheckedModule)
828 checkAndLoadModule (Session ref) ms compile_to_core
829 = checkModule_ ref ms compile_to_core True
831 checkModule_ :: IORef HscEnv -> ModSummary -> Bool -> Bool
832 -> IO (Maybe CheckedModule)
833 checkModule_ ref ms compile_to_core load
835 let mod = ms_mod_name ms
836 hsc_env0 <- readIORef ref
837 let hsc_env = hsc_env0{hsc_dflags=ms_hspp_opts ms}
838 mb_parsed <- parseFile hsc_env ms
840 Nothing -> return Nothing
841 Just rdr_module -> do
842 mb_typechecked <- typecheckRenameModule hsc_env ms rdr_module
843 case mb_typechecked of
844 Nothing -> return (Just CheckedModule {
845 parsedSource = rdr_module,
846 renamedSource = Nothing,
847 typecheckedSource = Nothing,
848 checkedModuleInfo = Nothing,
849 coreModule = Nothing })
850 Just (tcg, rn_info) -> do
851 details <- makeSimpleDetails hsc_env tcg
853 let tc_binds = tcg_binds tcg
854 let rdr_env = tcg_rdr_env tcg
855 let minf = ModuleInfo {
856 minf_type_env = md_types details,
857 minf_exports = availsToNameSet $
859 minf_rdr_env = Just rdr_env,
860 minf_instances = md_insts details
862 ,minf_modBreaks = emptyModBreaks
866 mb_guts <- if compile_to_core
867 then deSugarModule hsc_env ms tcg
870 let mb_core = fmap (\ mg ->
871 CoreModule { cm_module = mg_module mg,
872 cm_types = mg_types mg,
873 cm_binds = mg_binds mg })
876 -- If we are loading this module so that we can typecheck
877 -- dependent modules, generate an interface and stuff it
878 -- all in the HomePackageTable.
880 (iface,_) <- makeSimpleIface hsc_env Nothing tcg details
881 let mod_info = HomeModInfo {
883 hm_details = details,
884 hm_linkable = Nothing }
885 let hpt_new = addToUFM (hsc_HPT hsc_env) mod mod_info
886 writeIORef ref hsc_env0{ hsc_HPT = hpt_new }
888 return (Just (CheckedModule {
889 parsedSource = rdr_module,
890 renamedSource = rn_info,
891 typecheckedSource = Just tc_binds,
892 checkedModuleInfo = Just minf,
893 coreModule = mb_core }))
895 -- | This is the way to get access to the Core bindings corresponding
896 -- to a module. 'compileToCore' invokes 'checkModule' to parse, typecheck, and
897 -- desugar the module, then returns the resulting Core module (consisting of
898 -- the module name, type declarations, and function declarations) if
900 compileToCoreModule :: Session -> FilePath -> IO (Maybe CoreModule)
901 compileToCoreModule session fn = do
902 -- First, set the target to the desired filename
903 target <- guessTarget fn Nothing
904 addTarget session target
905 load session LoadAllTargets
906 -- Then find dependencies
907 maybeModGraph <- depanal session [] True
908 case maybeModGraph of
909 Nothing -> return Nothing
911 case find ((== fn) . msHsFilePath) modGraph of
912 Just modSummary -> do
913 -- Now we have the module name;
914 -- parse, typecheck and desugar the module
915 let mod = ms_mod_name modSummary
916 maybeCheckedModule <- checkModule session mod True
917 case maybeCheckedModule of
918 Nothing -> return Nothing
919 Just checkedMod -> return $ coreModule checkedMod
920 Nothing -> panic "compileToCoreModule: target FilePath not found in\
921 module dependency graph"
923 -- | Provided for backwards-compatibility: compileToCore returns just the Core
924 -- bindings, but for most purposes, you probably want to call
925 -- compileToCoreModule.
926 compileToCore :: Session -> FilePath -> IO (Maybe [CoreBind])
927 compileToCore session fn = do
928 maybeCoreModule <- compileToCoreModule session fn
929 return $ fmap cm_binds maybeCoreModule
930 -- ---------------------------------------------------------------------------
933 unload :: HscEnv -> [Linkable] -> IO ()
934 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
935 = case ghcLink (hsc_dflags hsc_env) of
937 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
939 LinkInMemory -> panic "unload: no interpreter"
940 -- urgh. avoid warnings:
941 hsc_env stable_linkables
945 -- -----------------------------------------------------------------------------
949 Stability tells us which modules definitely do not need to be recompiled.
950 There are two main reasons for having stability:
952 - avoid doing a complete upsweep of the module graph in GHCi when
953 modules near the bottom of the tree have not changed.
955 - to tell GHCi when it can load object code: we can only load object code
956 for a module when we also load object code fo all of the imports of the
957 module. So we need to know that we will definitely not be recompiling
958 any of these modules, and we can use the object code.
960 The stability check is as follows. Both stableObject and
961 stableBCO are used during the upsweep phase later.
964 stable m = stableObject m || stableBCO m
967 all stableObject (imports m)
968 && old linkable does not exist, or is == on-disk .o
969 && date(on-disk .o) > date(.hs)
972 all stable (imports m)
973 && date(BCO) > date(.hs)
976 These properties embody the following ideas:
978 - if a module is stable, then:
979 - if it has been compiled in a previous pass (present in HPT)
980 then it does not need to be compiled or re-linked.
981 - if it has not been compiled in a previous pass,
982 then we only need to read its .hi file from disk and
983 link it to produce a ModDetails.
985 - if a modules is not stable, we will definitely be at least
986 re-linking, and possibly re-compiling it during the upsweep.
987 All non-stable modules can (and should) therefore be unlinked
990 - Note that objects are only considered stable if they only depend
991 on other objects. We can't link object code against byte code.
995 :: HomePackageTable -- HPT from last compilation
996 -> [SCC ModSummary] -- current module graph (cyclic)
997 -> [ModuleName] -- all home modules
998 -> ([ModuleName], -- stableObject
999 [ModuleName]) -- stableBCO
1001 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
1003 checkSCC (stable_obj, stable_bco) scc0
1004 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
1005 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
1006 | otherwise = (stable_obj, stable_bco)
1008 scc = flattenSCC scc0
1009 scc_mods = map ms_mod_name scc
1010 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
1012 scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
1013 -- all imports outside the current SCC, but in the home pkg
1015 stable_obj_imps = map (`elem` stable_obj) scc_allimps
1016 stable_bco_imps = map (`elem` stable_bco) scc_allimps
1020 && all object_ok scc
1023 and (zipWith (||) stable_obj_imps stable_bco_imps)
1027 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
1031 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
1032 Just hmi | Just l <- hm_linkable hmi
1033 -> isObjectLinkable l && t == linkableTime l
1035 -- why '>=' rather than '>' above? If the filesystem stores
1036 -- times to the nearset second, we may occasionally find that
1037 -- the object & source have the same modification time,
1038 -- especially if the source was automatically generated
1039 -- and compiled. Using >= is slightly unsafe, but it matches
1040 -- make's behaviour.
1043 = case lookupUFM hpt (ms_mod_name ms) of
1044 Just hmi | Just l <- hm_linkable hmi ->
1045 not (isObjectLinkable l) &&
1046 linkableTime l >= ms_hs_date ms
1049 ms_allimps :: ModSummary -> [ModuleName]
1050 ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
1052 -- -----------------------------------------------------------------------------
1053 -- Prune the HomePackageTable
1055 -- Before doing an upsweep, we can throw away:
1057 -- - For non-stable modules:
1058 -- - all ModDetails, all linked code
1059 -- - all unlinked code that is out of date with respect to
1062 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
1063 -- space at the end of the upsweep, because the topmost ModDetails of the
1064 -- old HPT holds on to the entire type environment from the previous
1067 pruneHomePackageTable
1070 -> ([ModuleName],[ModuleName])
1073 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
1076 | is_stable modl = hmi'
1077 | otherwise = hmi'{ hm_details = emptyModDetails }
1079 modl = moduleName (mi_module (hm_iface hmi))
1080 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
1081 = hmi{ hm_linkable = Nothing }
1084 where ms = expectJust "prune" (lookupUFM ms_map modl)
1086 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
1088 is_stable m = m `elem` stable_obj || m `elem` stable_bco
1090 -- -----------------------------------------------------------------------------
1092 -- Return (names of) all those in modsDone who are part of a cycle
1093 -- as defined by theGraph.
1094 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
1095 findPartiallyCompletedCycles modsDone theGraph
1099 chew ((AcyclicSCC _):rest) = chew rest -- acyclic? not interesting.
1100 chew ((CyclicSCC vs):rest)
1101 = let names_in_this_cycle = nub (map ms_mod vs)
1103 = nub ([done | done <- modsDone,
1104 done `elem` names_in_this_cycle])
1105 chewed_rest = chew rest
1107 if notNull mods_in_this_cycle
1108 && length mods_in_this_cycle < length names_in_this_cycle
1109 then mods_in_this_cycle ++ chewed_rest
1112 -- -----------------------------------------------------------------------------
1115 -- This is where we compile each module in the module graph, in a pass
1116 -- from the bottom to the top of the graph.
1118 -- There better had not be any cyclic groups here -- we check for them.
1121 :: HscEnv -- Includes initially-empty HPT
1122 -> HomePackageTable -- HPT from last time round (pruned)
1123 -> ([ModuleName],[ModuleName]) -- stable modules (see checkStability)
1124 -> IO () -- How to clean up unwanted tmp files
1125 -> [SCC ModSummary] -- Mods to do (the worklist)
1127 HscEnv, -- With an updated HPT
1128 [ModSummary]) -- Mods which succeeded
1130 upsweep hsc_env old_hpt stable_mods cleanup sccs = do
1131 (res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
1132 return (res, hsc_env, reverse done)
1135 upsweep' hsc_env _old_hpt done
1137 = return (Succeeded, hsc_env, done)
1139 upsweep' hsc_env _old_hpt done
1140 (CyclicSCC ms:_) _ _
1141 = do fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
1142 return (Failed, hsc_env, done)
1144 upsweep' hsc_env old_hpt done
1145 (AcyclicSCC mod:mods) mod_index nmods
1146 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1147 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
1148 -- (moduleEnvElts (hsc_HPT hsc_env)))
1150 mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod
1153 cleanup -- Remove unwanted tmp files between compilations
1156 Nothing -> return (Failed, hsc_env, done)
1158 let this_mod = ms_mod_name mod
1160 -- Add new info to hsc_env
1161 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
1162 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
1164 -- Space-saving: delete the old HPT entry
1165 -- for mod BUT if mod is a hs-boot
1166 -- node, don't delete it. For the
1167 -- interface, the HPT entry is probaby for the
1168 -- main Haskell source file. Deleting it
1169 -- would force the real module to be recompiled
1171 old_hpt1 | isBootSummary mod = old_hpt
1172 | otherwise = delFromUFM old_hpt this_mod
1176 -- fixup our HomePackageTable after we've finished compiling
1177 -- a mutually-recursive loop. See reTypecheckLoop, below.
1178 hsc_env2 <- reTypecheckLoop hsc_env1 mod done'
1180 upsweep' hsc_env2 old_hpt1 done' mods (mod_index+1) nmods
1183 -- Compile a single module. Always produce a Linkable for it if
1184 -- successful. If no compilation happened, return the old Linkable.
1185 upsweep_mod :: HscEnv
1187 -> ([ModuleName],[ModuleName])
1189 -> Int -- index of module
1190 -> Int -- total number of modules
1191 -> IO (Maybe HomeModInfo) -- Nothing => Failed
1193 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
1195 this_mod_name = ms_mod_name summary
1196 this_mod = ms_mod summary
1197 mb_obj_date = ms_obj_date summary
1198 obj_fn = ml_obj_file (ms_location summary)
1199 hs_date = ms_hs_date summary
1201 is_stable_obj = this_mod_name `elem` stable_obj
1202 is_stable_bco = this_mod_name `elem` stable_bco
1204 old_hmi = lookupUFM old_hpt this_mod_name
1206 -- We're using the dflags for this module now, obtained by
1207 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
1208 dflags = ms_hspp_opts summary
1209 prevailing_target = hscTarget (hsc_dflags hsc_env)
1210 local_target = hscTarget dflags
1212 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
1213 -- we don't do anything dodgy: these should only work to change
1214 -- from -fvia-C to -fasm and vice-versa, otherwise we could
1215 -- end up trying to link object code to byte code.
1216 target = if prevailing_target /= local_target
1217 && (not (isObjectTarget prevailing_target)
1218 || not (isObjectTarget local_target))
1219 then prevailing_target
1222 -- store the corrected hscTarget into the summary
1223 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
1225 -- The old interface is ok if
1226 -- a) we're compiling a source file, and the old HPT
1227 -- entry is for a source file
1228 -- b) we're compiling a hs-boot file
1229 -- Case (b) allows an hs-boot file to get the interface of its
1230 -- real source file on the second iteration of the compilation
1231 -- manager, but that does no harm. Otherwise the hs-boot file
1232 -- will always be recompiled
1237 Just hm_info | isBootSummary summary -> Just iface
1238 | not (mi_boot iface) -> Just iface
1239 | otherwise -> Nothing
1241 iface = hm_iface hm_info
1243 compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
1244 compile_it = compile hsc_env summary' mod_index nmods mb_old_iface
1246 compile_it_discard_iface
1247 = compile hsc_env summary' mod_index nmods Nothing
1253 -- Regardless of whether we're generating object code or
1254 -- byte code, we can always use an existing object file
1255 -- if it is *stable* (see checkStability).
1256 | is_stable_obj, isJust old_hmi ->
1258 -- object is stable, and we have an entry in the
1259 -- old HPT: nothing to do
1261 | is_stable_obj, isNothing old_hmi -> do
1262 linkable <- findObjectLinkable this_mod obj_fn
1263 (expectJust "upseep1" mb_obj_date)
1264 compile_it (Just linkable)
1265 -- object is stable, but we need to load the interface
1266 -- off disk to make a HMI.
1270 ASSERT(isJust old_hmi) -- must be in the old_hpt
1272 -- BCO is stable: nothing to do
1274 | Just hmi <- old_hmi,
1275 Just l <- hm_linkable hmi, not (isObjectLinkable l),
1276 linkableTime l >= ms_hs_date summary ->
1278 -- we have an old BCO that is up to date with respect
1279 -- to the source: do a recompilation check as normal.
1283 -- no existing code at all: we must recompile.
1285 -- When generating object code, if there's an up-to-date
1286 -- object file on the disk, then we can use it.
1287 -- However, if the object file is new (compared to any
1288 -- linkable we had from a previous compilation), then we
1289 -- must discard any in-memory interface, because this
1290 -- means the user has compiled the source file
1291 -- separately and generated a new interface, that we must
1292 -- read from the disk.
1294 obj | isObjectTarget obj,
1295 Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
1298 | Just l <- hm_linkable hmi,
1299 isObjectLinkable l && linkableTime l == obj_date
1300 -> compile_it (Just l)
1302 linkable <- findObjectLinkable this_mod obj_fn obj_date
1303 compile_it_discard_iface (Just linkable)
1310 -- Filter modules in the HPT
1311 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
1312 retainInTopLevelEnvs keep_these hpt
1313 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
1315 , let mb_mod_info = lookupUFM hpt mod
1316 , isJust mb_mod_info ]
1318 -- ---------------------------------------------------------------------------
1319 -- Typecheck module loops
1322 See bug #930. This code fixes a long-standing bug in --make. The
1323 problem is that when compiling the modules *inside* a loop, a data
1324 type that is only defined at the top of the loop looks opaque; but
1325 after the loop is done, the structure of the data type becomes
1328 The difficulty is then that two different bits of code have
1329 different notions of what the data type looks like.
1331 The idea is that after we compile a module which also has an .hs-boot
1332 file, we re-generate the ModDetails for each of the modules that
1333 depends on the .hs-boot file, so that everyone points to the proper
1334 TyCons, Ids etc. defined by the real module, not the boot module.
1335 Fortunately re-generating a ModDetails from a ModIface is easy: the
1336 function TcIface.typecheckIface does exactly that.
1338 Picking the modules to re-typecheck is slightly tricky. Starting from
1339 the module graph consisting of the modules that have already been
1340 compiled, we reverse the edges (so they point from the imported module
1341 to the importing module), and depth-first-search from the .hs-boot
1342 node. This gives us all the modules that depend transitively on the
1343 .hs-boot module, and those are exactly the modules that we need to
1346 Following this fix, GHC can compile itself with --make -O2.
1349 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
1350 reTypecheckLoop hsc_env ms graph
1351 | not (isBootSummary ms) &&
1352 any (\m -> ms_mod m == this_mod && isBootSummary m) graph
1354 let mss = reachableBackwards (ms_mod_name ms) graph
1355 non_boot = filter (not.isBootSummary) mss
1356 debugTraceMsg (hsc_dflags hsc_env) 2 $
1357 text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
1358 typecheckLoop hsc_env (map ms_mod_name non_boot)
1362 this_mod = ms_mod ms
1364 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
1365 typecheckLoop hsc_env mods = do
1367 fixIO $ \new_hpt -> do
1368 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
1369 mds <- initIfaceCheck new_hsc_env $
1370 mapM (typecheckIface . hm_iface) hmis
1371 let new_hpt = addListToUFM old_hpt
1372 (zip mods [ hmi{ hm_details = details }
1373 | (hmi,details) <- zip hmis mds ])
1375 return hsc_env{ hsc_HPT = new_hpt }
1377 old_hpt = hsc_HPT hsc_env
1378 hmis = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
1380 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
1381 reachableBackwards mod summaries
1382 = [ ms | (ms,_,_) <- map vertex_fn nodes_we_want ]
1384 -- all the nodes reachable by traversing the edges backwards
1385 -- from the root node:
1386 nodes_we_want = reachable (transposeG graph) root
1388 -- the rest just sets up the graph:
1389 (nodes, lookup_key) = moduleGraphNodes False summaries
1390 (graph, vertex_fn, key_fn) = graphFromEdges' nodes
1392 | Just key <- lookup_key HsBootFile mod, Just v <- key_fn key = v
1393 | otherwise = panic "reachableBackwards"
1395 -- ---------------------------------------------------------------------------
1396 -- Topological sort of the module graph
1399 :: Bool -- Drop hi-boot nodes? (see below)
1403 -- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1404 -- The resulting list of strongly-connected-components is in topologically
1405 -- sorted order, starting with the module(s) at the bottom of the
1406 -- dependency graph (ie compile them first) and ending with the ones at
1409 -- Drop hi-boot nodes (first boolean arg)?
1411 -- False: treat the hi-boot summaries as nodes of the graph,
1412 -- so the graph must be acyclic
1414 -- True: eliminate the hi-boot nodes, and instead pretend
1415 -- the a source-import of Foo is an import of Foo
1416 -- The resulting graph has no hi-boot nodes, but can by cyclic
1418 topSortModuleGraph drop_hs_boot_nodes summaries Nothing
1419 = stronglyConnComp (fst (moduleGraphNodes drop_hs_boot_nodes summaries))
1420 topSortModuleGraph drop_hs_boot_nodes summaries (Just mod)
1421 = stronglyConnComp (map vertex_fn (reachable graph root))
1423 -- restrict the graph to just those modules reachable from
1424 -- the specified module. We do this by building a graph with
1425 -- the full set of nodes, and determining the reachable set from
1426 -- the specified node.
1427 (nodes, lookup_key) = moduleGraphNodes drop_hs_boot_nodes summaries
1428 (graph, vertex_fn, key_fn) = graphFromEdges' nodes
1430 | Just key <- lookup_key HsSrcFile mod, Just v <- key_fn key = v
1431 | otherwise = throwDyn (ProgramError "module does not exist")
1433 moduleGraphNodes :: Bool -> [ModSummary]
1434 -> ([(ModSummary, Int, [Int])], HscSource -> ModuleName -> Maybe Int)
1435 moduleGraphNodes drop_hs_boot_nodes summaries = (nodes, lookup_key)
1437 -- Drop hs-boot nodes by using HsSrcFile as the key
1438 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1439 | otherwise = HsBootFile
1441 -- We use integers as the keys for the SCC algorithm
1442 nodes :: [(ModSummary, Int, [Int])]
1443 nodes = [(s, expectJust "topSort" $
1444 lookup_key (ms_hsc_src s) (ms_mod_name s),
1445 out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
1446 out_edge_keys HsSrcFile (map unLoc (ms_imps s)) ++
1447 (-- see [boot-edges] below
1448 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
1450 else case lookup_key HsBootFile (ms_mod_name s) of
1455 , not (isBootSummary s && drop_hs_boot_nodes) ]
1456 -- Drop the hi-boot ones if told to do so
1458 -- [boot-edges] if this is a .hs and there is an equivalent
1459 -- .hs-boot, add a link from the former to the latter. This
1460 -- has the effect of detecting bogus cases where the .hs-boot
1461 -- depends on the .hs, by introducing a cycle. Additionally,
1462 -- it ensures that we will always process the .hs-boot before
1463 -- the .hs, and so the HomePackageTable will always have the
1464 -- most up to date information.
1466 key_map :: NodeMap Int
1467 key_map = listToFM ([(moduleName (ms_mod s), ms_hsc_src s)
1471 lookup_key :: HscSource -> ModuleName -> Maybe Int
1472 lookup_key hs_src mod = lookupFM key_map (mod, hs_src)
1474 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1475 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1476 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1477 -- the IsBootInterface parameter True; else False
1480 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
1481 type NodeMap a = FiniteMap NodeKey a -- keyed by (mod, src_file_type) pairs
1483 msKey :: ModSummary -> NodeKey
1484 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1486 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1487 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
1489 nodeMapElts :: NodeMap a -> [a]
1490 nodeMapElts = eltsFM
1492 -- If there are {-# SOURCE #-} imports between strongly connected
1493 -- components in the topological sort, then those imports can
1494 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1495 -- were necessary, then the edge would be part of a cycle.
1496 warnUnnecessarySourceImports :: DynFlags -> [SCC ModSummary] -> IO ()
1497 warnUnnecessarySourceImports dflags sccs =
1498 printBagOfWarnings dflags (listToBag (concat (map (check.flattenSCC) sccs)))
1500 let mods_in_this_cycle = map ms_mod_name ms in
1501 [ warn i | m <- ms, i <- ms_srcimps m,
1502 unLoc i `notElem` mods_in_this_cycle ]
1504 warn :: Located ModuleName -> WarnMsg
1507 (ptext SLIT("Warning: {-# SOURCE #-} unnecessary in import of ")
1508 <+> quotes (ppr mod))
1510 -----------------------------------------------------------------------------
1511 -- Downsweep (dependency analysis)
1513 -- Chase downwards from the specified root set, returning summaries
1514 -- for all home modules encountered. Only follow source-import
1517 -- We pass in the previous collection of summaries, which is used as a
1518 -- cache to avoid recalculating a module summary if the source is
1521 -- The returned list of [ModSummary] nodes has one node for each home-package
1522 -- module, plus one for any hs-boot files. The imports of these nodes
1523 -- are all there, including the imports of non-home-package modules.
1526 -> [ModSummary] -- Old summaries
1527 -> [ModuleName] -- Ignore dependencies on these; treat
1528 -- them as if they were package modules
1529 -> Bool -- True <=> allow multiple targets to have
1530 -- the same module name; this is
1531 -- very useful for ghc -M
1532 -> IO (Maybe [ModSummary])
1533 -- The elts of [ModSummary] all have distinct
1534 -- (Modules, IsBoot) identifiers, unless the Bool is true
1535 -- in which case there can be repeats
1536 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1537 = -- catch error messages and return them
1538 handleDyn (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
1539 rootSummaries <- mapM getRootSummary roots
1540 let root_map = mkRootMap rootSummaries
1541 checkDuplicates root_map
1542 summs <- loop (concatMap msDeps rootSummaries) root_map
1545 roots = hsc_targets hsc_env
1547 old_summary_map :: NodeMap ModSummary
1548 old_summary_map = mkNodeMap old_summaries
1550 getRootSummary :: Target -> IO ModSummary
1551 getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
1552 = do exists <- doesFileExist file
1554 then summariseFile hsc_env old_summaries file mb_phase maybe_buf
1555 else throwDyn $ mkPlainErrMsg noSrcSpan $
1556 text "can't find file:" <+> text file
1557 getRootSummary (Target (TargetModule modl) maybe_buf)
1558 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1559 (L rootLoc modl) maybe_buf excl_mods
1560 case maybe_summary of
1561 Nothing -> packageModErr modl
1564 rootLoc = mkGeneralSrcSpan FSLIT("<command line>")
1566 -- In a root module, the filename is allowed to diverge from the module
1567 -- name, so we have to check that there aren't multiple root files
1568 -- defining the same module (otherwise the duplicates will be silently
1569 -- ignored, leading to confusing behaviour).
1570 checkDuplicates :: NodeMap [ModSummary] -> IO ()
1571 checkDuplicates root_map
1572 | allow_dup_roots = return ()
1573 | null dup_roots = return ()
1574 | otherwise = multiRootsErr (head dup_roots)
1576 dup_roots :: [[ModSummary]] -- Each at least of length 2
1577 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1579 loop :: [(Located ModuleName,IsBootInterface)]
1580 -- Work list: process these modules
1581 -> NodeMap [ModSummary]
1582 -- Visited set; the range is a list because
1583 -- the roots can have the same module names
1584 -- if allow_dup_roots is True
1586 -- The result includes the worklist, except
1587 -- for those mentioned in the visited set
1588 loop [] done = return (concat (nodeMapElts done))
1589 loop ((wanted_mod, is_boot) : ss) done
1590 | Just summs <- lookupFM done key
1591 = if isSingleton summs then
1594 do { multiRootsErr summs; return [] }
1595 | otherwise = do { mb_s <- summariseModule hsc_env old_summary_map
1596 is_boot wanted_mod Nothing excl_mods
1598 Nothing -> loop ss done
1599 Just s -> loop (msDeps s ++ ss)
1600 (addToFM done key [s]) }
1602 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1604 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1605 mkRootMap summaries = addListToFM_C (++) emptyFM
1606 [ (msKey s, [s]) | s <- summaries ]
1608 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
1609 -- (msDeps s) returns the dependencies of the ModSummary s.
1610 -- A wrinkle is that for a {-# SOURCE #-} import we return
1611 -- *both* the hs-boot file
1612 -- *and* the source file
1613 -- as "dependencies". That ensures that the list of all relevant
1614 -- modules always contains B.hs if it contains B.hs-boot.
1615 -- Remember, this pass isn't doing the topological sort. It's
1616 -- just gathering the list of all relevant ModSummaries
1618 concat [ [(m,True), (m,False)] | m <- ms_srcimps s ]
1619 ++ [ (m,False) | m <- ms_imps s ]
1621 -----------------------------------------------------------------------------
1622 -- Summarising modules
1624 -- We have two types of summarisation:
1626 -- * Summarise a file. This is used for the root module(s) passed to
1627 -- cmLoadModules. The file is read, and used to determine the root
1628 -- module name. The module name may differ from the filename.
1630 -- * Summarise a module. We are given a module name, and must provide
1631 -- a summary. The finder is used to locate the file in which the module
1636 -> [ModSummary] -- old summaries
1637 -> FilePath -- source file name
1638 -> Maybe Phase -- start phase
1639 -> Maybe (StringBuffer,ClockTime)
1642 summariseFile hsc_env old_summaries file mb_phase maybe_buf
1643 -- we can use a cached summary if one is available and the
1644 -- source file hasn't changed, But we have to look up the summary
1645 -- by source file, rather than module name as we do in summarise.
1646 | Just old_summary <- findSummaryBySourceFile old_summaries file
1648 let location = ms_location old_summary
1650 -- return the cached summary if the source didn't change
1651 src_timestamp <- case maybe_buf of
1652 Just (_,t) -> return t
1653 Nothing -> getModificationTime file
1654 -- The file exists; we checked in getRootSummary above.
1655 -- If it gets removed subsequently, then this
1656 -- getModificationTime may fail, but that's the right
1659 if ms_hs_date old_summary == src_timestamp
1660 then do -- update the object-file timestamp
1661 obj_timestamp <- getObjTimestamp location False
1662 return old_summary{ ms_obj_date = obj_timestamp }
1670 let dflags = hsc_dflags hsc_env
1672 (dflags', hspp_fn, buf)
1673 <- preprocessFile dflags file mb_phase maybe_buf
1675 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
1677 -- Make a ModLocation for this file
1678 location <- mkHomeModLocation dflags mod_name file
1680 -- Tell the Finder cache where it is, so that subsequent calls
1681 -- to findModule will find it, even if it's not on any search path
1682 mod <- addHomeModuleToFinder hsc_env mod_name location
1684 src_timestamp <- case maybe_buf of
1685 Just (_,t) -> return t
1686 Nothing -> getModificationTime file
1687 -- getMofificationTime may fail
1689 obj_timestamp <- modificationTimeIfExists (ml_obj_file location)
1691 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1692 ms_location = location,
1693 ms_hspp_file = hspp_fn,
1694 ms_hspp_opts = dflags',
1695 ms_hspp_buf = Just buf,
1696 ms_srcimps = srcimps, ms_imps = the_imps,
1697 ms_hs_date = src_timestamp,
1698 ms_obj_date = obj_timestamp })
1700 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
1701 findSummaryBySourceFile summaries file
1702 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
1703 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
1707 -- Summarise a module, and pick up source and timestamp.
1710 -> NodeMap ModSummary -- Map of old summaries
1711 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
1712 -> Located ModuleName -- Imported module to be summarised
1713 -> Maybe (StringBuffer, ClockTime)
1714 -> [ModuleName] -- Modules to exclude
1715 -> IO (Maybe ModSummary) -- Its new summary
1717 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf excl_mods
1718 | wanted_mod `elem` excl_mods
1721 | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
1722 = do -- Find its new timestamp; all the
1723 -- ModSummaries in the old map have valid ml_hs_files
1724 let location = ms_location old_summary
1725 src_fn = expectJust "summariseModule" (ml_hs_file location)
1727 -- check the modification time on the source file, and
1728 -- return the cached summary if it hasn't changed. If the
1729 -- file has disappeared, we need to call the Finder again.
1731 Just (_,t) -> check_timestamp old_summary location src_fn t
1733 m <- System.IO.Error.try (getModificationTime src_fn)
1735 Right t -> check_timestamp old_summary location src_fn t
1736 Left e | isDoesNotExistError e -> find_it
1737 | otherwise -> ioError e
1739 | otherwise = find_it
1741 dflags = hsc_dflags hsc_env
1743 hsc_src = if is_boot then HsBootFile else HsSrcFile
1745 check_timestamp old_summary location src_fn src_timestamp
1746 | ms_hs_date old_summary == src_timestamp = do
1747 -- update the object-file timestamp
1748 obj_timestamp <- getObjTimestamp location is_boot
1749 return (Just old_summary{ ms_obj_date = obj_timestamp })
1751 -- source changed: re-summarise.
1752 new_summary location (ms_mod old_summary) src_fn src_timestamp
1755 -- Don't use the Finder's cache this time. If the module was
1756 -- previously a package module, it may have now appeared on the
1757 -- search path, so we want to consider it to be a home module. If
1758 -- the module was previously a home module, it may have moved.
1759 uncacheModule hsc_env wanted_mod
1760 found <- findImportedModule hsc_env wanted_mod Nothing
1763 | isJust (ml_hs_file location) ->
1765 just_found location mod
1767 -- Drop external-pkg
1768 ASSERT(modulePackageId mod /= thisPackage dflags)
1772 err -> noModError dflags loc wanted_mod err
1775 just_found location mod = do
1776 -- Adjust location to point to the hs-boot source file,
1777 -- hi file, object file, when is_boot says so
1778 let location' | is_boot = addBootSuffixLocn location
1779 | otherwise = location
1780 src_fn = expectJust "summarise2" (ml_hs_file location')
1782 -- Check that it exists
1783 -- It might have been deleted since the Finder last found it
1784 maybe_t <- modificationTimeIfExists src_fn
1786 Nothing -> noHsFileErr loc src_fn
1787 Just t -> new_summary location' mod src_fn t
1790 new_summary location mod src_fn src_timestamp
1792 -- Preprocess the source file and get its imports
1793 -- The dflags' contains the OPTIONS pragmas
1794 (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn Nothing maybe_buf
1795 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
1797 when (mod_name /= wanted_mod) $
1798 throwDyn $ mkPlainErrMsg mod_loc $
1799 text "file name does not match module name"
1800 <+> quotes (ppr mod_name)
1802 -- Find the object timestamp, and return the summary
1803 obj_timestamp <- getObjTimestamp location is_boot
1805 return (Just ( ModSummary { ms_mod = mod,
1806 ms_hsc_src = hsc_src,
1807 ms_location = location,
1808 ms_hspp_file = hspp_fn,
1809 ms_hspp_opts = dflags',
1810 ms_hspp_buf = Just buf,
1811 ms_srcimps = srcimps,
1813 ms_hs_date = src_timestamp,
1814 ms_obj_date = obj_timestamp }))
1817 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
1818 getObjTimestamp location is_boot
1819 = if is_boot then return Nothing
1820 else modificationTimeIfExists (ml_obj_file location)
1823 preprocessFile :: DynFlags -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
1824 -> IO (DynFlags, FilePath, StringBuffer)
1825 preprocessFile dflags src_fn mb_phase Nothing
1827 (dflags', hspp_fn) <- preprocess dflags (src_fn, mb_phase)
1828 buf <- hGetStringBuffer hspp_fn
1829 return (dflags', hspp_fn, buf)
1831 preprocessFile dflags src_fn mb_phase (Just (buf, _time))
1833 -- case we bypass the preprocessing stage?
1835 local_opts = getOptions buf src_fn
1837 (dflags', _errs) <- parseDynamicFlags dflags (map unLoc local_opts)
1838 -- XXX: shouldn't we be reporting the errors?
1842 | Just (Unlit _) <- mb_phase = True
1843 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
1844 -- note: local_opts is only required if there's no Unlit phase
1845 | dopt Opt_Cpp dflags' = True
1846 | dopt Opt_Pp dflags' = True
1849 when needs_preprocessing $
1850 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
1852 return (dflags', src_fn, buf)
1855 -----------------------------------------------------------------------------
1857 -----------------------------------------------------------------------------
1859 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
1860 -- ToDo: we don't have a proper line number for this error
1861 noModError dflags loc wanted_mod err
1862 = throwDyn $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
1864 noHsFileErr :: SrcSpan -> String -> a
1865 noHsFileErr loc path
1866 = throwDyn $ mkPlainErrMsg loc $ text "Can't find" <+> text path
1868 packageModErr :: ModuleName -> a
1870 = throwDyn $ mkPlainErrMsg noSrcSpan $
1871 text "module" <+> quotes (ppr mod) <+> text "is a package module"
1873 multiRootsErr :: [ModSummary] -> IO ()
1874 multiRootsErr [] = panic "multiRootsErr"
1875 multiRootsErr summs@(summ1:_)
1876 = throwDyn $ mkPlainErrMsg noSrcSpan $
1877 text "module" <+> quotes (ppr mod) <+>
1878 text "is defined in multiple files:" <+>
1879 sep (map text files)
1882 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
1884 cyclicModuleErr :: [ModSummary] -> SDoc
1886 = hang (ptext SLIT("Module imports form a cycle for modules:"))
1887 2 (vcat (map show_one ms))
1889 show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
1890 nest 2 $ ptext SLIT("imports:") <+>
1891 (pp_imps HsBootFile (ms_srcimps ms)
1892 $$ pp_imps HsSrcFile (ms_imps ms))]
1893 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
1894 pp_imps src mods = fsep (map (show_mod src) mods)
1897 -- | Inform GHC that the working directory has changed. GHC will flush
1898 -- its cache of module locations, since it may no longer be valid.
1899 -- Note: if you change the working directory, you should also unload
1900 -- the current program (set targets to empty, followed by load).
1901 workingDirectoryChanged :: Session -> IO ()
1902 workingDirectoryChanged s = withSession s $ flushFinderCaches
1904 -- -----------------------------------------------------------------------------
1905 -- inspecting the session
1907 -- | Get the module dependency graph.
1908 getModuleGraph :: Session -> IO ModuleGraph -- ToDo: DiGraph ModSummary
1909 getModuleGraph s = withSession s (return . hsc_mod_graph)
1911 isLoaded :: Session -> ModuleName -> IO Bool
1912 isLoaded s m = withSession s $ \hsc_env ->
1913 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
1915 getBindings :: Session -> IO [TyThing]
1916 getBindings s = withSession s $ \hsc_env ->
1917 -- we have to implement the shadowing behaviour of ic_tmp_ids here
1918 -- (see InteractiveContext) and the quickest way is to use an OccEnv.
1920 tmp_ids = ic_tmp_ids (hsc_IC hsc_env)
1921 filtered = foldr f (const []) tmp_ids emptyUniqSet
1923 | uniq `elementOfUniqSet` set = rest set
1924 | otherwise = AnId id : rest (addOneToUniqSet set uniq)
1925 where uniq = getUnique (nameOccName (idName id))
1929 getPrintUnqual :: Session -> IO PrintUnqualified
1930 getPrintUnqual s = withSession s $ \hsc_env ->
1931 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
1933 -- | Container for information about a 'Module'.
1934 data ModuleInfo = ModuleInfo {
1935 minf_type_env :: TypeEnv,
1936 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
1937 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
1938 minf_instances :: [Instance]
1940 ,minf_modBreaks :: ModBreaks
1942 -- ToDo: this should really contain the ModIface too
1944 -- We don't want HomeModInfo here, because a ModuleInfo applies
1945 -- to package modules too.
1947 -- | Request information about a loaded 'Module'
1948 getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
1949 getModuleInfo s mdl = withSession s $ \hsc_env -> do
1950 let mg = hsc_mod_graph hsc_env
1951 if mdl `elem` map ms_mod mg
1952 then getHomeModuleInfo hsc_env (moduleName mdl)
1954 {- if isHomeModule (hsc_dflags hsc_env) mdl
1956 else -} getPackageModuleInfo hsc_env mdl
1957 -- getPackageModuleInfo will attempt to find the interface, so
1958 -- we don't want to call it for a home module, just in case there
1959 -- was a problem loading the module and the interface doesn't
1960 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
1962 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
1964 getPackageModuleInfo hsc_env mdl = do
1965 (_msgs, mb_avails) <- getModuleExports hsc_env mdl
1967 Nothing -> return Nothing
1969 eps <- readIORef (hsc_EPS hsc_env)
1971 names = availsToNameSet avails
1973 tys = [ ty | name <- concatMap availNames avails,
1974 Just ty <- [lookupTypeEnv pte name] ]
1976 return (Just (ModuleInfo {
1977 minf_type_env = mkTypeEnv tys,
1978 minf_exports = names,
1979 minf_rdr_env = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
1980 minf_instances = error "getModuleInfo: instances for package module unimplemented",
1981 minf_modBreaks = emptyModBreaks
1984 getPackageModuleInfo _hsc_env _mdl = do
1985 -- bogusly different for non-GHCI (ToDo)
1989 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
1990 getHomeModuleInfo hsc_env mdl =
1991 case lookupUFM (hsc_HPT hsc_env) mdl of
1992 Nothing -> return Nothing
1994 let details = hm_details hmi
1995 return (Just (ModuleInfo {
1996 minf_type_env = md_types details,
1997 minf_exports = availsToNameSet (md_exports details),
1998 minf_rdr_env = mi_globals $! hm_iface hmi,
1999 minf_instances = md_insts details
2001 ,minf_modBreaks = getModBreaks hmi
2005 -- | The list of top-level entities defined in a module
2006 modInfoTyThings :: ModuleInfo -> [TyThing]
2007 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
2009 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
2010 modInfoTopLevelScope minf
2011 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
2013 modInfoExports :: ModuleInfo -> [Name]
2014 modInfoExports minf = nameSetToList $! minf_exports minf
2016 -- | Returns the instances defined by the specified module.
2017 -- Warning: currently unimplemented for package modules.
2018 modInfoInstances :: ModuleInfo -> [Instance]
2019 modInfoInstances = minf_instances
2021 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
2022 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
2024 mkPrintUnqualifiedForModule :: Session -> ModuleInfo -> IO (Maybe PrintUnqualified)
2025 mkPrintUnqualifiedForModule s minf = withSession s $ \hsc_env -> do
2026 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
2028 modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
2029 modInfoLookupName s minf name = withSession s $ \hsc_env -> do
2030 case lookupTypeEnv (minf_type_env minf) name of
2031 Just tyThing -> return (Just tyThing)
2033 eps <- readIORef (hsc_EPS hsc_env)
2034 return $! lookupType (hsc_dflags hsc_env)
2035 (hsc_HPT hsc_env) (eps_PTE eps) name
2038 modInfoModBreaks :: ModuleInfo -> ModBreaks
2039 modInfoModBreaks = minf_modBreaks
2042 isDictonaryId :: Id -> Bool
2044 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
2046 -- | Looks up a global name: that is, any top-level name in any
2047 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
2048 -- the interactive context, and therefore does not require a preceding
2050 lookupGlobalName :: Session -> Name -> IO (Maybe TyThing)
2051 lookupGlobalName s name = withSession s $ \hsc_env -> do
2052 eps <- readIORef (hsc_EPS hsc_env)
2053 return $! lookupType (hsc_dflags hsc_env)
2054 (hsc_HPT hsc_env) (eps_PTE eps) name
2057 -- | get the GlobalRdrEnv for a session
2058 getGRE :: Session -> IO GlobalRdrEnv
2059 getGRE s = withSession s $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
2062 -- -----------------------------------------------------------------------------
2063 -- Misc exported utils
2065 dataConType :: DataCon -> Type
2066 dataConType dc = idType (dataConWrapId dc)
2068 -- | print a 'NamedThing', adding parentheses if the name is an operator.
2069 pprParenSymName :: NamedThing a => a -> SDoc
2070 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
2072 -- ----------------------------------------------------------------------------
2077 -- - Data and Typeable instances for HsSyn.
2079 -- ToDo: check for small transformations that happen to the syntax in
2080 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
2082 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
2083 -- to get from TyCons, Ids etc. to TH syntax (reify).
2085 -- :browse will use either lm_toplev or inspect lm_interface, depending
2086 -- on whether the module is interpreted or not.
2088 -- This is for reconstructing refactored source code
2089 -- Calls the lexer repeatedly.
2090 -- ToDo: add comment tokens to token stream
2091 getTokenStream :: Session -> Module -> IO [Located Token]
2094 -- -----------------------------------------------------------------------------
2095 -- Interactive evaluation
2097 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
2098 -- filesystem and package database to find the corresponding 'Module',
2099 -- using the algorithm that is used for an @import@ declaration.
2100 findModule :: Session -> ModuleName -> Maybe PackageId -> IO Module
2101 findModule s mod_name maybe_pkg = withSession s $ \hsc_env ->
2103 dflags = hsc_dflags hsc_env
2104 hpt = hsc_HPT hsc_env
2105 this_pkg = thisPackage dflags
2107 case lookupUFM hpt mod_name of
2108 Just mod_info -> return (mi_module (hm_iface mod_info))
2109 _not_a_home_module -> do
2110 res <- findImportedModule hsc_env mod_name maybe_pkg
2112 Found _ m | modulePackageId m /= this_pkg -> return m
2113 | otherwise -> throwDyn (CmdLineError (showSDoc $
2114 text "module" <+> pprModule m <+>
2115 text "is not loaded"))
2116 err -> let msg = cannotFindModule dflags mod_name err in
2117 throwDyn (CmdLineError (showSDoc msg))
2120 getHistorySpan :: Session -> History -> IO SrcSpan
2121 getHistorySpan sess h = withSession sess $ \hsc_env ->
2122 return$ InteractiveEval.getHistorySpan hsc_env h
2124 obtainTerm :: Session -> Bool -> Id -> IO Term
2125 obtainTerm sess force id = withSession sess $ \hsc_env ->
2126 InteractiveEval.obtainTerm hsc_env force id
2128 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
2129 obtainTerm1 sess force mb_ty a = withSession sess $ \hsc_env ->
2130 InteractiveEval.obtainTerm1 hsc_env force mb_ty a
2132 obtainTermB :: Session -> Int -> Bool -> Id -> IO Term
2133 obtainTermB sess bound force id = withSession sess $ \hsc_env ->
2134 InteractiveEval.obtainTermB hsc_env bound force id