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
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 -> load2 s how_much mod_graph
554 Nothing -> return Failed
556 load2 :: Session -> LoadHowMuch -> [ModSummary] -> IO SuccessFlag
557 load2 s@(Session ref) how_much mod_graph = do
559 hsc_env <- readIORef ref
561 let hpt1 = hsc_HPT hsc_env
562 let dflags = hsc_dflags hsc_env
564 -- The "bad" boot modules are the ones for which we have
565 -- B.hs-boot in the module graph, but no B.hs
566 -- The downsweep should have ensured this does not happen
568 let all_home_mods = [ms_mod_name s
569 | s <- mod_graph, not (isBootSummary s)]
570 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
571 not (ms_mod_name s `elem` all_home_mods)]
572 ASSERT( null bad_boot_mods ) return ()
574 -- check that the module given in HowMuch actually exists, otherwise
575 -- topSortModuleGraph will bomb later.
576 let checkHowMuch (LoadUpTo m) = checkMod m
577 checkHowMuch (LoadDependenciesOf m) = checkMod m
581 | m `elem` all_home_mods = and_then
583 errorMsg dflags (text "no such module:" <+>
587 checkHowMuch how_much $ do
589 -- mg2_with_srcimps drops the hi-boot nodes, returning a
590 -- graph with cycles. Among other things, it is used for
591 -- backing out partially complete cycles following a failed
592 -- upsweep, and for removing from hpt all the modules
593 -- not in strict downwards closure, during calls to compile.
594 let mg2_with_srcimps :: [SCC ModSummary]
595 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
597 -- If we can determine that any of the {-# SOURCE #-} imports
598 -- are definitely unnecessary, then emit a warning.
599 warnUnnecessarySourceImports dflags mg2_with_srcimps
602 -- check the stability property for each module.
603 stable_mods@(stable_obj,stable_bco)
604 = checkStability hpt1 mg2_with_srcimps all_home_mods
606 -- prune bits of the HPT which are definitely redundant now,
608 pruned_hpt = pruneHomePackageTable hpt1
609 (flattenSCCs mg2_with_srcimps)
614 -- before we unload anything, make sure we don't leave an old
615 -- interactive context around pointing to dead bindings. Also,
616 -- write the pruned HPT to allow the old HPT to be GC'd.
617 writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext,
618 hsc_HPT = pruned_hpt }
620 debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
621 text "Stable BCO:" <+> ppr stable_bco)
623 -- Unload any modules which are going to be re-linked this time around.
624 let stable_linkables = [ linkable
625 | m <- stable_obj++stable_bco,
626 Just hmi <- [lookupUFM pruned_hpt m],
627 Just linkable <- [hm_linkable hmi] ]
628 unload hsc_env stable_linkables
630 -- We could at this point detect cycles which aren't broken by
631 -- a source-import, and complain immediately, but it seems better
632 -- to let upsweep_mods do this, so at least some useful work gets
633 -- done before the upsweep is abandoned.
634 --hPutStrLn stderr "after tsort:\n"
635 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
637 -- Now do the upsweep, calling compile for each module in
638 -- turn. Final result is version 3 of everything.
640 -- Topologically sort the module graph, this time including hi-boot
641 -- nodes, and possibly just including the portion of the graph
642 -- reachable from the module specified in the 2nd argument to load.
643 -- This graph should be cycle-free.
644 -- If we're restricting the upsweep to a portion of the graph, we
645 -- also want to retain everything that is still stable.
646 let full_mg :: [SCC ModSummary]
647 full_mg = topSortModuleGraph False mod_graph Nothing
649 maybe_top_mod = case how_much of
651 LoadDependenciesOf m -> Just m
654 partial_mg0 :: [SCC ModSummary]
655 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
657 -- LoadDependenciesOf m: we want the upsweep to stop just
658 -- short of the specified module (unless the specified module
661 | LoadDependenciesOf _mod <- how_much
662 = ASSERT( case last partial_mg0 of
663 AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
664 List.init partial_mg0
670 | AcyclicSCC ms <- full_mg,
671 ms_mod_name ms `elem` stable_obj++stable_bco,
672 ms_mod_name ms `notElem` [ ms_mod_name ms' |
673 AcyclicSCC ms' <- partial_mg ] ]
675 mg = stable_mg ++ partial_mg
677 -- clean up between compilations
678 let cleanup = cleanTempFilesExcept dflags
679 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
681 debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
683 (upsweep_ok, hsc_env1, modsUpswept)
684 <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
685 pruned_hpt stable_mods cleanup mg
687 -- Make modsDone be the summaries for each home module now
688 -- available; this should equal the domain of hpt3.
689 -- Get in in a roughly top .. bottom order (hence reverse).
691 let modsDone = reverse modsUpswept
693 -- Try and do linking in some form, depending on whether the
694 -- upsweep was completely or only partially successful.
696 if succeeded upsweep_ok
699 -- Easy; just relink it all.
700 do debugTraceMsg dflags 2 (text "Upsweep completely successful.")
702 -- Clean up after ourselves
703 cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
705 -- Issue a warning for the confusing case where the user
706 -- said '-o foo' but we're not going to do any linking.
707 -- We attempt linking if either (a) one of the modules is
708 -- called Main, or (b) the user said -no-hs-main, indicating
709 -- that main() is going to come from somewhere else.
711 let ofile = outputFile dflags
712 let no_hs_main = dopt Opt_NoHsMain dflags
714 main_mod = mainModIs dflags
715 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
716 do_linking = a_root_is_Main || no_hs_main
718 when (ghcLink dflags == LinkBinary
719 && isJust ofile && not do_linking) $
720 debugTraceMsg dflags 1 $
721 text ("Warning: output was redirected with -o, " ++
722 "but no output will be generated\n" ++
723 "because there is no " ++
724 moduleNameString (moduleName main_mod) ++ " module.")
726 -- link everything together
727 linkresult <- link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
729 loadFinish Succeeded linkresult ref hsc_env1
732 -- Tricky. We need to back out the effects of compiling any
733 -- half-done cycles, both so as to clean up the top level envs
734 -- and to avoid telling the interactive linker to link them.
735 do debugTraceMsg dflags 2 (text "Upsweep partially successful.")
738 = map ms_mod modsDone
739 let mods_to_zap_names
740 = findPartiallyCompletedCycles modsDone_names
743 = filter ((`notElem` mods_to_zap_names).ms_mod)
746 let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
749 -- Clean up after ourselves
750 cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
752 -- there should be no Nothings where linkables should be, now
753 ASSERT(all (isJust.hm_linkable)
754 (eltsUFM (hsc_HPT hsc_env))) do
756 -- Link everything together
757 linkresult <- link (ghcLink dflags) dflags False hpt4
759 let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
760 loadFinish Failed linkresult ref hsc_env4
762 -- Finish up after a load.
764 -- If the link failed, unload everything and return.
765 loadFinish :: SuccessFlag -> SuccessFlag -> IORef HscEnv -> HscEnv -> IO SuccessFlag
766 loadFinish _all_ok Failed ref hsc_env
767 = do unload hsc_env []
768 writeIORef ref $! discardProg hsc_env
771 -- Empty the interactive context and set the module context to the topmost
772 -- newly loaded module, or the Prelude if none were loaded.
773 loadFinish all_ok Succeeded ref hsc_env
774 = do writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
778 -- Forget the current program, but retain the persistent info in HscEnv
779 discardProg :: HscEnv -> HscEnv
781 = hsc_env { hsc_mod_graph = emptyMG,
782 hsc_IC = emptyInteractiveContext,
783 hsc_HPT = emptyHomePackageTable }
785 -- used to fish out the preprocess output files for the purposes of
786 -- cleaning up. The preprocessed file *might* be the same as the
787 -- source file, but that doesn't do any harm.
788 ppFilesFromSummaries :: [ModSummary] -> [FilePath]
789 ppFilesFromSummaries summaries = map ms_hspp_file summaries
791 -- -----------------------------------------------------------------------------
795 CheckedModule { parsedSource :: ParsedSource,
796 renamedSource :: Maybe RenamedSource,
797 typecheckedSource :: Maybe TypecheckedSource,
798 checkedModuleInfo :: Maybe ModuleInfo,
799 coreModule :: Maybe ModGuts
801 -- ToDo: improvements that could be made here:
802 -- if the module succeeded renaming but not typechecking,
803 -- we can still get back the GlobalRdrEnv and exports, so
804 -- perhaps the ModuleInfo should be split up into separate
805 -- fields within CheckedModule.
807 type ParsedSource = Located (HsModule RdrName)
808 type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
809 Maybe (HsDoc Name), HaddockModInfo Name)
810 type TypecheckedSource = LHsBinds Id
813 -- - things that aren't in the output of the typechecker right now:
817 -- - type/data/newtype declarations
818 -- - class declarations
820 -- - extra things in the typechecker's output:
821 -- - default methods are turned into top-level decls.
822 -- - dictionary bindings
825 -- | This is the way to get access to parsed and typechecked source code
826 -- for a module. 'checkModule' attempts to typecheck the module. If
827 -- successful, it returns the abstract syntax for the module.
828 -- If compileToCore is true, it also desugars the module and returns the
829 -- resulting Core bindings as a component of the CheckedModule.
830 checkModule :: Session -> ModuleName -> Bool -> IO (Maybe CheckedModule)
831 checkModule (Session ref) mod compile_to_core
833 hsc_env <- readIORef ref
834 let mg = hsc_mod_graph hsc_env
835 case [ ms | ms <- mg, ms_mod_name ms == mod ] of
837 (ms:_) -> checkModule_ ref ms compile_to_core False
839 -- | parses and typechecks a module, optionally generates Core, and also
840 -- loads the module into the 'Session' so that modules which depend on
841 -- this one may subsequently be typechecked using 'checkModule' or
842 -- 'checkAndLoadModule'. If you need to check more than one module,
843 -- you probably want to use 'checkAndLoadModule'. Constructing the
844 -- interface takes a little work, so it might be slightly slower than
846 checkAndLoadModule :: Session -> ModSummary -> Bool -> IO (Maybe CheckedModule)
847 checkAndLoadModule (Session ref) ms compile_to_core
848 = checkModule_ ref ms compile_to_core True
850 checkModule_ :: IORef HscEnv -> ModSummary -> Bool -> Bool
851 -> IO (Maybe CheckedModule)
852 checkModule_ ref ms compile_to_core load
854 let mod = ms_mod_name ms
855 hsc_env0 <- readIORef ref
856 let hsc_env = hsc_env0{hsc_dflags=ms_hspp_opts ms}
857 mb_parsed <- parseFile hsc_env ms
859 Nothing -> return Nothing
860 Just rdr_module -> do
861 mb_typechecked <- typecheckRenameModule hsc_env ms rdr_module
862 case mb_typechecked of
863 Nothing -> return (Just CheckedModule {
864 parsedSource = rdr_module,
865 renamedSource = Nothing,
866 typecheckedSource = Nothing,
867 checkedModuleInfo = Nothing,
868 coreModule = Nothing })
869 Just (tcg, rn_info) -> do
870 details <- makeSimpleDetails hsc_env tcg
872 let tc_binds = tcg_binds tcg
873 let rdr_env = tcg_rdr_env tcg
874 let minf = ModuleInfo {
875 minf_type_env = md_types details,
876 minf_exports = availsToNameSet $
878 minf_rdr_env = Just rdr_env,
879 minf_instances = md_insts details
881 ,minf_modBreaks = emptyModBreaks
885 mb_guts <- if compile_to_core
886 then deSugarModule hsc_env ms tcg
889 -- If we are loading this module so that we can typecheck
890 -- dependent modules, generate an interface and stuff it
891 -- all in the HomePackageTable.
893 (iface,_) <- makeSimpleIface hsc_env Nothing tcg details
894 let mod_info = HomeModInfo {
896 hm_details = details,
897 hm_linkable = Nothing }
898 let hpt_new = addToUFM (hsc_HPT hsc_env) mod mod_info
899 writeIORef ref hsc_env0{ hsc_HPT = hpt_new }
901 return (Just (CheckedModule {
902 parsedSource = rdr_module,
903 renamedSource = rn_info,
904 typecheckedSource = Just tc_binds,
905 checkedModuleInfo = Just minf,
906 coreModule = mb_guts }))
908 -- | This is the way to get access to the Core bindings corresponding
909 -- to a module. 'compileToCore' invokes 'checkModule' to parse, typecheck, and
910 -- desugar the module, then returns the resulting Core module (consisting of
911 -- the module name, type declarations, and function declarations) if
913 compileToCoreModule :: Session -> FilePath -> IO (Maybe CoreModule)
914 compileToCoreModule = compileCore False
916 -- | Like compileToCoreModule, but invokes the simplifier, so
917 -- as to return simplified and tidied Core.
918 compileToCoreSimplified :: Session -> FilePath -> IO (Maybe CoreModule)
919 compileToCoreSimplified = compileCore True
921 -- | Provided for backwards-compatibility: compileToCore returns just the Core
922 -- bindings, but for most purposes, you probably want to call
923 -- compileToCoreModule.
924 compileToCore :: Session -> FilePath -> IO (Maybe [CoreBind])
925 compileToCore session fn = do
926 maybeCoreModule <- compileToCoreModule session fn
927 return $ fmap cm_binds maybeCoreModule
929 -- | Takes a CoreModule and compiles the bindings therein
930 -- to object code. The first argument is a bool flag indicating
931 -- whether to run the simplifier.
932 -- The resulting .o, .hi, and executable files, if any, are stored in the
933 -- current directory, and named according to the module name.
934 -- Returns True iff compilation succeeded.
935 -- This has only so far been tested with a single self-contained module.
936 compileCoreToObj :: Bool -> Session -> CoreModule -> IO Bool
937 compileCoreToObj simplify session cm@(CoreModule{ cm_module = mName }) = do
938 hscEnv <- sessionHscEnv session
939 dflags <- getSessionDynFlags session
940 currentTime <- getClockTime
941 cwd <- getCurrentDirectory
942 modLocation <- mkHiOnlyModLocation dflags (hiSuf dflags) cwd
943 ((moduleNameSlashes . moduleName) mName)
945 let modSummary = ModSummary { ms_mod = mName,
946 ms_hsc_src = ExtCoreFile,
947 ms_location = modLocation,
948 -- By setting the object file timestamp to Nothing,
949 -- we always force recompilation, which is what we
950 -- want. (Thus it doesn't matter what the timestamp
951 -- for the (nonexistent) source file is.)
952 ms_hs_date = currentTime,
953 ms_obj_date = Nothing,
954 -- Only handling the single-module case for now, so no imports.
959 ms_hspp_opts = dflags,
960 ms_hspp_buf = Nothing
963 mbHscResult <- evalComp
964 ((if simplify then hscSimplify else return) (mkModGuts cm)
965 >>= hscNormalIface >>= hscWriteIface >>= hscOneShot)
966 (CompState{ compHscEnv=hscEnv,
967 compModSummary=modSummary,
968 compOldIface=Nothing})
969 return $ isJust mbHscResult
971 -- Makes a "vanilla" ModGuts.
972 mkModGuts :: CoreModule -> ModGuts
973 mkModGuts coreModule = ModGuts {
974 mg_module = cm_module coreModule,
977 mg_deps = noDependencies,
978 mg_dir_imps = emptyModuleEnv,
979 mg_used_names = emptyNameSet,
980 mg_rdr_env = emptyGlobalRdrEnv,
981 mg_fix_env = emptyFixityEnv,
982 mg_types = emptyTypeEnv,
986 mg_binds = cm_binds coreModule,
987 mg_foreign = NoStubs,
988 mg_deprecs = NoDeprecs,
989 mg_hpc_info = emptyHpcInfo False,
990 mg_modBreaks = emptyModBreaks,
991 mg_vect_info = noVectInfo,
992 mg_inst_env = emptyInstEnv,
993 mg_fam_inst_env = emptyFamInstEnv
996 compileCore :: Bool -> Session -> FilePath -> IO (Maybe CoreModule)
997 compileCore simplify session fn = do
998 -- First, set the target to the desired filename
999 target <- guessTarget fn Nothing
1000 addTarget session target
1001 load session LoadAllTargets
1002 -- Then find dependencies
1003 maybeModGraph <- depanal session [] True
1004 case maybeModGraph of
1005 Nothing -> return Nothing
1007 case find ((== fn) . msHsFilePath) modGraph of
1008 Just modSummary -> do
1009 -- Now we have the module name;
1010 -- parse, typecheck and desugar the module
1011 let mod = ms_mod_name modSummary
1012 maybeCheckedModule <- checkModule session mod True
1013 case maybeCheckedModule of
1014 Nothing -> return Nothing
1015 Just checkedMod -> (liftM $ fmap gutsToCoreModule) $
1016 case (coreModule checkedMod) of
1017 Just mg | simplify -> (sessionHscEnv session)
1018 -- If simplify is true: simplify (hscSimplify),
1019 -- then tidy (tidyProgram).
1020 >>= \ hscEnv -> evalComp (hscSimplify mg)
1021 (CompState{ compHscEnv=hscEnv,
1022 compModSummary=modSummary,
1023 compOldIface=Nothing})
1024 >>= (tidyProgram hscEnv)
1025 >>= (return . Just . Left)
1026 Just guts -> return $ Just $ Right guts
1027 Nothing -> return Nothing
1028 Nothing -> panic "compileToCoreModule: target FilePath not found in\
1029 module dependency graph"
1030 where -- two versions, based on whether we simplify (thus run tidyProgram,
1031 -- which returns a (CgGuts, ModDetails) pair, or not (in which case
1032 -- we just have a ModGuts.
1033 gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
1034 gutsToCoreModule (Left (cg, md)) = CoreModule {
1035 cm_module = cg_module cg, cm_types = md_types md,
1036 cm_imports = cg_dir_imps cg, cm_binds = cg_binds cg
1038 gutsToCoreModule (Right mg) = CoreModule {
1039 cm_module = mg_module mg, cm_types = mg_types mg,
1040 cm_imports = moduleEnvKeys (mg_dir_imps mg), cm_binds = mg_binds mg
1043 -- ---------------------------------------------------------------------------
1046 unload :: HscEnv -> [Linkable] -> IO ()
1047 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
1048 = case ghcLink (hsc_dflags hsc_env) of
1050 LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
1052 LinkInMemory -> panic "unload: no interpreter"
1053 -- urgh. avoid warnings:
1054 hsc_env stable_linkables
1058 -- -----------------------------------------------------------------------------
1062 Stability tells us which modules definitely do not need to be recompiled.
1063 There are two main reasons for having stability:
1065 - avoid doing a complete upsweep of the module graph in GHCi when
1066 modules near the bottom of the tree have not changed.
1068 - to tell GHCi when it can load object code: we can only load object code
1069 for a module when we also load object code fo all of the imports of the
1070 module. So we need to know that we will definitely not be recompiling
1071 any of these modules, and we can use the object code.
1073 The stability check is as follows. Both stableObject and
1074 stableBCO are used during the upsweep phase later.
1077 stable m = stableObject m || stableBCO m
1080 all stableObject (imports m)
1081 && old linkable does not exist, or is == on-disk .o
1082 && date(on-disk .o) > date(.hs)
1085 all stable (imports m)
1086 && date(BCO) > date(.hs)
1089 These properties embody the following ideas:
1091 - if a module is stable, then:
1092 - if it has been compiled in a previous pass (present in HPT)
1093 then it does not need to be compiled or re-linked.
1094 - if it has not been compiled in a previous pass,
1095 then we only need to read its .hi file from disk and
1096 link it to produce a ModDetails.
1098 - if a modules is not stable, we will definitely be at least
1099 re-linking, and possibly re-compiling it during the upsweep.
1100 All non-stable modules can (and should) therefore be unlinked
1103 - Note that objects are only considered stable if they only depend
1104 on other objects. We can't link object code against byte code.
1108 :: HomePackageTable -- HPT from last compilation
1109 -> [SCC ModSummary] -- current module graph (cyclic)
1110 -> [ModuleName] -- all home modules
1111 -> ([ModuleName], -- stableObject
1112 [ModuleName]) -- stableBCO
1114 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
1116 checkSCC (stable_obj, stable_bco) scc0
1117 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
1118 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
1119 | otherwise = (stable_obj, stable_bco)
1121 scc = flattenSCC scc0
1122 scc_mods = map ms_mod_name scc
1123 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
1125 scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
1126 -- all imports outside the current SCC, but in the home pkg
1128 stable_obj_imps = map (`elem` stable_obj) scc_allimps
1129 stable_bco_imps = map (`elem` stable_bco) scc_allimps
1133 && all object_ok scc
1136 and (zipWith (||) stable_obj_imps stable_bco_imps)
1140 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
1144 same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
1145 Just hmi | Just l <- hm_linkable hmi
1146 -> isObjectLinkable l && t == linkableTime l
1148 -- why '>=' rather than '>' above? If the filesystem stores
1149 -- times to the nearset second, we may occasionally find that
1150 -- the object & source have the same modification time,
1151 -- especially if the source was automatically generated
1152 -- and compiled. Using >= is slightly unsafe, but it matches
1153 -- make's behaviour.
1156 = case lookupUFM hpt (ms_mod_name ms) of
1157 Just hmi | Just l <- hm_linkable hmi ->
1158 not (isObjectLinkable l) &&
1159 linkableTime l >= ms_hs_date ms
1162 ms_allimps :: ModSummary -> [ModuleName]
1163 ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
1165 -- -----------------------------------------------------------------------------
1166 -- Prune the HomePackageTable
1168 -- Before doing an upsweep, we can throw away:
1170 -- - For non-stable modules:
1171 -- - all ModDetails, all linked code
1172 -- - all unlinked code that is out of date with respect to
1175 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
1176 -- space at the end of the upsweep, because the topmost ModDetails of the
1177 -- old HPT holds on to the entire type environment from the previous
1180 pruneHomePackageTable
1183 -> ([ModuleName],[ModuleName])
1186 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
1189 | is_stable modl = hmi'
1190 | otherwise = hmi'{ hm_details = emptyModDetails }
1192 modl = moduleName (mi_module (hm_iface hmi))
1193 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
1194 = hmi{ hm_linkable = Nothing }
1197 where ms = expectJust "prune" (lookupUFM ms_map modl)
1199 ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
1201 is_stable m = m `elem` stable_obj || m `elem` stable_bco
1203 -- -----------------------------------------------------------------------------
1205 -- Return (names of) all those in modsDone who are part of a cycle
1206 -- as defined by theGraph.
1207 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
1208 findPartiallyCompletedCycles modsDone theGraph
1212 chew ((AcyclicSCC _):rest) = chew rest -- acyclic? not interesting.
1213 chew ((CyclicSCC vs):rest)
1214 = let names_in_this_cycle = nub (map ms_mod vs)
1216 = nub ([done | done <- modsDone,
1217 done `elem` names_in_this_cycle])
1218 chewed_rest = chew rest
1220 if notNull mods_in_this_cycle
1221 && length mods_in_this_cycle < length names_in_this_cycle
1222 then mods_in_this_cycle ++ chewed_rest
1225 -- -----------------------------------------------------------------------------
1228 -- This is where we compile each module in the module graph, in a pass
1229 -- from the bottom to the top of the graph.
1231 -- There better had not be any cyclic groups here -- we check for them.
1234 :: HscEnv -- Includes initially-empty HPT
1235 -> HomePackageTable -- HPT from last time round (pruned)
1236 -> ([ModuleName],[ModuleName]) -- stable modules (see checkStability)
1237 -> IO () -- How to clean up unwanted tmp files
1238 -> [SCC ModSummary] -- Mods to do (the worklist)
1240 HscEnv, -- With an updated HPT
1241 [ModSummary]) -- Mods which succeeded
1243 upsweep hsc_env old_hpt stable_mods cleanup sccs = do
1244 (res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
1245 return (res, hsc_env, reverse done)
1248 upsweep' hsc_env _old_hpt done
1250 = return (Succeeded, hsc_env, done)
1252 upsweep' hsc_env _old_hpt done
1253 (CyclicSCC ms:_) _ _
1254 = do fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
1255 return (Failed, hsc_env, done)
1257 upsweep' hsc_env old_hpt done
1258 (AcyclicSCC mod:mods) mod_index nmods
1259 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1260 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
1261 -- (moduleEnvElts (hsc_HPT hsc_env)))
1263 mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod
1266 cleanup -- Remove unwanted tmp files between compilations
1269 Nothing -> return (Failed, hsc_env, done)
1271 let this_mod = ms_mod_name mod
1273 -- Add new info to hsc_env
1274 hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info
1275 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
1277 -- Space-saving: delete the old HPT entry
1278 -- for mod BUT if mod is a hs-boot
1279 -- node, don't delete it. For the
1280 -- interface, the HPT entry is probaby for the
1281 -- main Haskell source file. Deleting it
1282 -- would force the real module to be recompiled
1284 old_hpt1 | isBootSummary mod = old_hpt
1285 | otherwise = delFromUFM old_hpt this_mod
1289 -- fixup our HomePackageTable after we've finished compiling
1290 -- a mutually-recursive loop. See reTypecheckLoop, below.
1291 hsc_env2 <- reTypecheckLoop hsc_env1 mod done'
1293 upsweep' hsc_env2 old_hpt1 done' mods (mod_index+1) nmods
1296 -- Compile a single module. Always produce a Linkable for it if
1297 -- successful. If no compilation happened, return the old Linkable.
1298 upsweep_mod :: HscEnv
1300 -> ([ModuleName],[ModuleName])
1302 -> Int -- index of module
1303 -> Int -- total number of modules
1304 -> IO (Maybe HomeModInfo) -- Nothing => Failed
1306 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
1308 this_mod_name = ms_mod_name summary
1309 this_mod = ms_mod summary
1310 mb_obj_date = ms_obj_date summary
1311 obj_fn = ml_obj_file (ms_location summary)
1312 hs_date = ms_hs_date summary
1314 is_stable_obj = this_mod_name `elem` stable_obj
1315 is_stable_bco = this_mod_name `elem` stable_bco
1317 old_hmi = lookupUFM old_hpt this_mod_name
1319 -- We're using the dflags for this module now, obtained by
1320 -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
1321 dflags = ms_hspp_opts summary
1322 prevailing_target = hscTarget (hsc_dflags hsc_env)
1323 local_target = hscTarget dflags
1325 -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
1326 -- we don't do anything dodgy: these should only work to change
1327 -- from -fvia-C to -fasm and vice-versa, otherwise we could
1328 -- end up trying to link object code to byte code.
1329 target = if prevailing_target /= local_target
1330 && (not (isObjectTarget prevailing_target)
1331 || not (isObjectTarget local_target))
1332 then prevailing_target
1335 -- store the corrected hscTarget into the summary
1336 summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
1338 -- The old interface is ok if
1339 -- a) we're compiling a source file, and the old HPT
1340 -- entry is for a source file
1341 -- b) we're compiling a hs-boot file
1342 -- Case (b) allows an hs-boot file to get the interface of its
1343 -- real source file on the second iteration of the compilation
1344 -- manager, but that does no harm. Otherwise the hs-boot file
1345 -- will always be recompiled
1350 Just hm_info | isBootSummary summary -> Just iface
1351 | not (mi_boot iface) -> Just iface
1352 | otherwise -> Nothing
1354 iface = hm_iface hm_info
1356 compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
1357 compile_it = compile hsc_env summary' mod_index nmods mb_old_iface
1359 compile_it_discard_iface
1360 = compile hsc_env summary' mod_index nmods Nothing
1366 -- Regardless of whether we're generating object code or
1367 -- byte code, we can always use an existing object file
1368 -- if it is *stable* (see checkStability).
1369 | is_stable_obj, isJust old_hmi ->
1371 -- object is stable, and we have an entry in the
1372 -- old HPT: nothing to do
1374 | is_stable_obj, isNothing old_hmi -> do
1375 linkable <- findObjectLinkable this_mod obj_fn
1376 (expectJust "upseep1" mb_obj_date)
1377 compile_it (Just linkable)
1378 -- object is stable, but we need to load the interface
1379 -- off disk to make a HMI.
1383 ASSERT(isJust old_hmi) -- must be in the old_hpt
1385 -- BCO is stable: nothing to do
1387 | Just hmi <- old_hmi,
1388 Just l <- hm_linkable hmi, not (isObjectLinkable l),
1389 linkableTime l >= ms_hs_date summary ->
1391 -- we have an old BCO that is up to date with respect
1392 -- to the source: do a recompilation check as normal.
1396 -- no existing code at all: we must recompile.
1398 -- When generating object code, if there's an up-to-date
1399 -- object file on the disk, then we can use it.
1400 -- However, if the object file is new (compared to any
1401 -- linkable we had from a previous compilation), then we
1402 -- must discard any in-memory interface, because this
1403 -- means the user has compiled the source file
1404 -- separately and generated a new interface, that we must
1405 -- read from the disk.
1407 obj | isObjectTarget obj,
1408 Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
1411 | Just l <- hm_linkable hmi,
1412 isObjectLinkable l && linkableTime l == obj_date
1413 -> compile_it (Just l)
1415 linkable <- findObjectLinkable this_mod obj_fn obj_date
1416 compile_it_discard_iface (Just linkable)
1423 -- Filter modules in the HPT
1424 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
1425 retainInTopLevelEnvs keep_these hpt
1426 = listToUFM [ (mod, expectJust "retain" mb_mod_info)
1428 , let mb_mod_info = lookupUFM hpt mod
1429 , isJust mb_mod_info ]
1431 -- ---------------------------------------------------------------------------
1432 -- Typecheck module loops
1435 See bug #930. This code fixes a long-standing bug in --make. The
1436 problem is that when compiling the modules *inside* a loop, a data
1437 type that is only defined at the top of the loop looks opaque; but
1438 after the loop is done, the structure of the data type becomes
1441 The difficulty is then that two different bits of code have
1442 different notions of what the data type looks like.
1444 The idea is that after we compile a module which also has an .hs-boot
1445 file, we re-generate the ModDetails for each of the modules that
1446 depends on the .hs-boot file, so that everyone points to the proper
1447 TyCons, Ids etc. defined by the real module, not the boot module.
1448 Fortunately re-generating a ModDetails from a ModIface is easy: the
1449 function TcIface.typecheckIface does exactly that.
1451 Picking the modules to re-typecheck is slightly tricky. Starting from
1452 the module graph consisting of the modules that have already been
1453 compiled, we reverse the edges (so they point from the imported module
1454 to the importing module), and depth-first-search from the .hs-boot
1455 node. This gives us all the modules that depend transitively on the
1456 .hs-boot module, and those are exactly the modules that we need to
1459 Following this fix, GHC can compile itself with --make -O2.
1462 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
1463 reTypecheckLoop hsc_env ms graph
1464 | not (isBootSummary ms) &&
1465 any (\m -> ms_mod m == this_mod && isBootSummary m) graph
1467 let mss = reachableBackwards (ms_mod_name ms) graph
1468 non_boot = filter (not.isBootSummary) mss
1469 debugTraceMsg (hsc_dflags hsc_env) 2 $
1470 text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
1471 typecheckLoop hsc_env (map ms_mod_name non_boot)
1475 this_mod = ms_mod ms
1477 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
1478 typecheckLoop hsc_env mods = do
1480 fixIO $ \new_hpt -> do
1481 let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
1482 mds <- initIfaceCheck new_hsc_env $
1483 mapM (typecheckIface . hm_iface) hmis
1484 let new_hpt = addListToUFM old_hpt
1485 (zip mods [ hmi{ hm_details = details }
1486 | (hmi,details) <- zip hmis mds ])
1488 return hsc_env{ hsc_HPT = new_hpt }
1490 old_hpt = hsc_HPT hsc_env
1491 hmis = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
1493 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
1494 reachableBackwards mod summaries
1495 = [ ms | (ms,_,_) <- map vertex_fn nodes_we_want ]
1497 -- all the nodes reachable by traversing the edges backwards
1498 -- from the root node:
1499 nodes_we_want = reachable (transposeG graph) root
1501 -- the rest just sets up the graph:
1502 (nodes, lookup_key) = moduleGraphNodes False summaries
1503 (graph, vertex_fn, key_fn) = graphFromEdges' nodes
1505 | Just key <- lookup_key HsBootFile mod, Just v <- key_fn key = v
1506 | otherwise = panic "reachableBackwards"
1508 -- ---------------------------------------------------------------------------
1509 -- Topological sort of the module graph
1512 :: Bool -- Drop hi-boot nodes? (see below)
1516 -- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1517 -- The resulting list of strongly-connected-components is in topologically
1518 -- sorted order, starting with the module(s) at the bottom of the
1519 -- dependency graph (ie compile them first) and ending with the ones at
1522 -- Drop hi-boot nodes (first boolean arg)?
1524 -- False: treat the hi-boot summaries as nodes of the graph,
1525 -- so the graph must be acyclic
1527 -- True: eliminate the hi-boot nodes, and instead pretend
1528 -- the a source-import of Foo is an import of Foo
1529 -- The resulting graph has no hi-boot nodes, but can by cyclic
1531 topSortModuleGraph drop_hs_boot_nodes summaries Nothing
1532 = stronglyConnComp (fst (moduleGraphNodes drop_hs_boot_nodes summaries))
1533 topSortModuleGraph drop_hs_boot_nodes summaries (Just mod)
1534 = stronglyConnComp (map vertex_fn (reachable graph root))
1536 -- restrict the graph to just those modules reachable from
1537 -- the specified module. We do this by building a graph with
1538 -- the full set of nodes, and determining the reachable set from
1539 -- the specified node.
1540 (nodes, lookup_key) = moduleGraphNodes drop_hs_boot_nodes summaries
1541 (graph, vertex_fn, key_fn) = graphFromEdges' nodes
1543 | Just key <- lookup_key HsSrcFile mod, Just v <- key_fn key = v
1544 | otherwise = throwDyn (ProgramError "module does not exist")
1546 moduleGraphNodes :: Bool -> [ModSummary]
1547 -> ([(ModSummary, Int, [Int])], HscSource -> ModuleName -> Maybe Int)
1548 moduleGraphNodes drop_hs_boot_nodes summaries = (nodes, lookup_key)
1550 -- Drop hs-boot nodes by using HsSrcFile as the key
1551 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1552 | otherwise = HsBootFile
1554 -- We use integers as the keys for the SCC algorithm
1555 nodes :: [(ModSummary, Int, [Int])]
1556 nodes = [(s, expectJust "topSort" $
1557 lookup_key (ms_hsc_src s) (ms_mod_name s),
1558 out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
1559 out_edge_keys HsSrcFile (map unLoc (ms_imps s)) ++
1560 (-- see [boot-edges] below
1561 if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
1563 else case lookup_key HsBootFile (ms_mod_name s) of
1568 , not (isBootSummary s && drop_hs_boot_nodes) ]
1569 -- Drop the hi-boot ones if told to do so
1571 -- [boot-edges] if this is a .hs and there is an equivalent
1572 -- .hs-boot, add a link from the former to the latter. This
1573 -- has the effect of detecting bogus cases where the .hs-boot
1574 -- depends on the .hs, by introducing a cycle. Additionally,
1575 -- it ensures that we will always process the .hs-boot before
1576 -- the .hs, and so the HomePackageTable will always have the
1577 -- most up to date information.
1579 key_map :: NodeMap Int
1580 key_map = listToFM ([(moduleName (ms_mod s), ms_hsc_src s)
1584 lookup_key :: HscSource -> ModuleName -> Maybe Int
1585 lookup_key hs_src mod = lookupFM key_map (mod, hs_src)
1587 out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1588 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1589 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1590 -- the IsBootInterface parameter True; else False
1593 type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are
1594 type NodeMap a = FiniteMap NodeKey a -- keyed by (mod, src_file_type) pairs
1596 msKey :: ModSummary -> NodeKey
1597 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1599 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1600 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
1602 nodeMapElts :: NodeMap a -> [a]
1603 nodeMapElts = eltsFM
1605 -- If there are {-# SOURCE #-} imports between strongly connected
1606 -- components in the topological sort, then those imports can
1607 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1608 -- were necessary, then the edge would be part of a cycle.
1609 warnUnnecessarySourceImports :: DynFlags -> [SCC ModSummary] -> IO ()
1610 warnUnnecessarySourceImports dflags sccs =
1611 printBagOfWarnings dflags (listToBag (concat (map (check.flattenSCC) sccs)))
1613 let mods_in_this_cycle = map ms_mod_name ms in
1614 [ warn i | m <- ms, i <- ms_srcimps m,
1615 unLoc i `notElem` mods_in_this_cycle ]
1617 warn :: Located ModuleName -> WarnMsg
1620 (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
1621 <+> quotes (ppr mod))
1623 -----------------------------------------------------------------------------
1624 -- Downsweep (dependency analysis)
1626 -- Chase downwards from the specified root set, returning summaries
1627 -- for all home modules encountered. Only follow source-import
1630 -- We pass in the previous collection of summaries, which is used as a
1631 -- cache to avoid recalculating a module summary if the source is
1634 -- The returned list of [ModSummary] nodes has one node for each home-package
1635 -- module, plus one for any hs-boot files. The imports of these nodes
1636 -- are all there, including the imports of non-home-package modules.
1639 -> [ModSummary] -- Old summaries
1640 -> [ModuleName] -- Ignore dependencies on these; treat
1641 -- them as if they were package modules
1642 -> Bool -- True <=> allow multiple targets to have
1643 -- the same module name; this is
1644 -- very useful for ghc -M
1645 -> IO (Maybe [ModSummary])
1646 -- The elts of [ModSummary] all have distinct
1647 -- (Modules, IsBoot) identifiers, unless the Bool is true
1648 -- in which case there can be repeats
1649 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1650 = -- catch error messages and return them
1651 handleDyn (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
1652 rootSummaries <- mapM getRootSummary roots
1653 let root_map = mkRootMap rootSummaries
1654 checkDuplicates root_map
1655 summs <- loop (concatMap msDeps rootSummaries) root_map
1658 roots = hsc_targets hsc_env
1660 old_summary_map :: NodeMap ModSummary
1661 old_summary_map = mkNodeMap old_summaries
1663 getRootSummary :: Target -> IO ModSummary
1664 getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
1665 = do exists <- doesFileExist file
1667 then summariseFile hsc_env old_summaries file mb_phase maybe_buf
1668 else throwDyn $ mkPlainErrMsg noSrcSpan $
1669 text "can't find file:" <+> text file
1670 getRootSummary (Target (TargetModule modl) maybe_buf)
1671 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1672 (L rootLoc modl) maybe_buf excl_mods
1673 case maybe_summary of
1674 Nothing -> packageModErr modl
1677 rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1679 -- In a root module, the filename is allowed to diverge from the module
1680 -- name, so we have to check that there aren't multiple root files
1681 -- defining the same module (otherwise the duplicates will be silently
1682 -- ignored, leading to confusing behaviour).
1683 checkDuplicates :: NodeMap [ModSummary] -> IO ()
1684 checkDuplicates root_map
1685 | allow_dup_roots = return ()
1686 | null dup_roots = return ()
1687 | otherwise = multiRootsErr (head dup_roots)
1689 dup_roots :: [[ModSummary]] -- Each at least of length 2
1690 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1692 loop :: [(Located ModuleName,IsBootInterface)]
1693 -- Work list: process these modules
1694 -> NodeMap [ModSummary]
1695 -- Visited set; the range is a list because
1696 -- the roots can have the same module names
1697 -- if allow_dup_roots is True
1699 -- The result includes the worklist, except
1700 -- for those mentioned in the visited set
1701 loop [] done = return (concat (nodeMapElts done))
1702 loop ((wanted_mod, is_boot) : ss) done
1703 | Just summs <- lookupFM done key
1704 = if isSingleton summs then
1707 do { multiRootsErr summs; return [] }
1708 | otherwise = do { mb_s <- summariseModule hsc_env old_summary_map
1709 is_boot wanted_mod Nothing excl_mods
1711 Nothing -> loop ss done
1712 Just s -> loop (msDeps s ++ ss)
1713 (addToFM done key [s]) }
1715 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1717 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1718 mkRootMap summaries = addListToFM_C (++) emptyFM
1719 [ (msKey s, [s]) | s <- summaries ]
1721 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
1722 -- (msDeps s) returns the dependencies of the ModSummary s.
1723 -- A wrinkle is that for a {-# SOURCE #-} import we return
1724 -- *both* the hs-boot file
1725 -- *and* the source file
1726 -- as "dependencies". That ensures that the list of all relevant
1727 -- modules always contains B.hs if it contains B.hs-boot.
1728 -- Remember, this pass isn't doing the topological sort. It's
1729 -- just gathering the list of all relevant ModSummaries
1731 concat [ [(m,True), (m,False)] | m <- ms_srcimps s ]
1732 ++ [ (m,False) | m <- ms_imps s ]
1734 -----------------------------------------------------------------------------
1735 -- Summarising modules
1737 -- We have two types of summarisation:
1739 -- * Summarise a file. This is used for the root module(s) passed to
1740 -- cmLoadModules. The file is read, and used to determine the root
1741 -- module name. The module name may differ from the filename.
1743 -- * Summarise a module. We are given a module name, and must provide
1744 -- a summary. The finder is used to locate the file in which the module
1749 -> [ModSummary] -- old summaries
1750 -> FilePath -- source file name
1751 -> Maybe Phase -- start phase
1752 -> Maybe (StringBuffer,ClockTime)
1755 summariseFile hsc_env old_summaries file mb_phase maybe_buf
1756 -- we can use a cached summary if one is available and the
1757 -- source file hasn't changed, But we have to look up the summary
1758 -- by source file, rather than module name as we do in summarise.
1759 | Just old_summary <- findSummaryBySourceFile old_summaries file
1761 let location = ms_location old_summary
1763 -- return the cached summary if the source didn't change
1764 src_timestamp <- case maybe_buf of
1765 Just (_,t) -> return t
1766 Nothing -> getModificationTime file
1767 -- The file exists; we checked in getRootSummary above.
1768 -- If it gets removed subsequently, then this
1769 -- getModificationTime may fail, but that's the right
1772 if ms_hs_date old_summary == src_timestamp
1773 then do -- update the object-file timestamp
1775 if isObjectTarget (hscTarget (hsc_dflags hsc_env)) -- #1205
1776 then getObjTimestamp location False
1778 return old_summary{ ms_obj_date = obj_timestamp }
1786 let dflags = hsc_dflags hsc_env
1788 (dflags', hspp_fn, buf)
1789 <- preprocessFile hsc_env file mb_phase maybe_buf
1791 (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
1793 -- Make a ModLocation for this file
1794 location <- mkHomeModLocation dflags mod_name file
1796 -- Tell the Finder cache where it is, so that subsequent calls
1797 -- to findModule will find it, even if it's not on any search path
1798 mod <- addHomeModuleToFinder hsc_env mod_name location
1800 src_timestamp <- case maybe_buf of
1801 Just (_,t) -> return t
1802 Nothing -> getModificationTime file
1803 -- getMofificationTime may fail
1805 -- when the user asks to load a source file by name, we only
1806 -- use an object file if -fobject-code is on. See #1205.
1808 if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1809 then modificationTimeIfExists (ml_obj_file location)
1812 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1813 ms_location = location,
1814 ms_hspp_file = hspp_fn,
1815 ms_hspp_opts = dflags',
1816 ms_hspp_buf = Just buf,
1817 ms_srcimps = srcimps, ms_imps = the_imps,
1818 ms_hs_date = src_timestamp,
1819 ms_obj_date = obj_timestamp })
1821 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
1822 findSummaryBySourceFile summaries file
1823 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
1824 expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
1828 -- Summarise a module, and pick up source and timestamp.
1831 -> NodeMap ModSummary -- Map of old summaries
1832 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
1833 -> Located ModuleName -- Imported module to be summarised
1834 -> Maybe (StringBuffer, ClockTime)
1835 -> [ModuleName] -- Modules to exclude
1836 -> IO (Maybe ModSummary) -- Its new summary
1838 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf excl_mods
1839 | wanted_mod `elem` excl_mods
1842 | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
1843 = do -- Find its new timestamp; all the
1844 -- ModSummaries in the old map have valid ml_hs_files
1845 let location = ms_location old_summary
1846 src_fn = expectJust "summariseModule" (ml_hs_file location)
1848 -- check the modification time on the source file, and
1849 -- return the cached summary if it hasn't changed. If the
1850 -- file has disappeared, we need to call the Finder again.
1852 Just (_,t) -> check_timestamp old_summary location src_fn t
1854 m <- System.IO.Error.try (getModificationTime src_fn)
1856 Right t -> check_timestamp old_summary location src_fn t
1857 Left e | isDoesNotExistError e -> find_it
1858 | otherwise -> ioError e
1860 | otherwise = find_it
1862 dflags = hsc_dflags hsc_env
1864 hsc_src = if is_boot then HsBootFile else HsSrcFile
1866 check_timestamp old_summary location src_fn src_timestamp
1867 | ms_hs_date old_summary == src_timestamp = do
1868 -- update the object-file timestamp
1869 obj_timestamp <- getObjTimestamp location is_boot
1870 return (Just old_summary{ ms_obj_date = obj_timestamp })
1872 -- source changed: re-summarise.
1873 new_summary location (ms_mod old_summary) src_fn src_timestamp
1876 -- Don't use the Finder's cache this time. If the module was
1877 -- previously a package module, it may have now appeared on the
1878 -- search path, so we want to consider it to be a home module. If
1879 -- the module was previously a home module, it may have moved.
1880 uncacheModule hsc_env wanted_mod
1881 found <- findImportedModule hsc_env wanted_mod Nothing
1884 | isJust (ml_hs_file location) ->
1886 just_found location mod
1888 -- Drop external-pkg
1889 ASSERT(modulePackageId mod /= thisPackage dflags)
1893 err -> noModError dflags loc wanted_mod err
1896 just_found location mod = do
1897 -- Adjust location to point to the hs-boot source file,
1898 -- hi file, object file, when is_boot says so
1899 let location' | is_boot = addBootSuffixLocn location
1900 | otherwise = location
1901 src_fn = expectJust "summarise2" (ml_hs_file location')
1903 -- Check that it exists
1904 -- It might have been deleted since the Finder last found it
1905 maybe_t <- modificationTimeIfExists src_fn
1907 Nothing -> noHsFileErr loc src_fn
1908 Just t -> new_summary location' mod src_fn t
1911 new_summary location mod src_fn src_timestamp
1913 -- Preprocess the source file and get its imports
1914 -- The dflags' contains the OPTIONS pragmas
1915 (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
1916 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
1918 when (mod_name /= wanted_mod) $
1919 throwDyn $ mkPlainErrMsg mod_loc $
1920 text "File name does not match module name:"
1921 $$ text "Saw:" <+> quotes (ppr mod_name)
1922 $$ text "Expected:" <+> quotes (ppr wanted_mod)
1924 -- Find the object timestamp, and return the summary
1925 obj_timestamp <- getObjTimestamp location is_boot
1927 return (Just ( ModSummary { ms_mod = mod,
1928 ms_hsc_src = hsc_src,
1929 ms_location = location,
1930 ms_hspp_file = hspp_fn,
1931 ms_hspp_opts = dflags',
1932 ms_hspp_buf = Just buf,
1933 ms_srcimps = srcimps,
1935 ms_hs_date = src_timestamp,
1936 ms_obj_date = obj_timestamp }))
1939 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
1940 getObjTimestamp location is_boot
1941 = if is_boot then return Nothing
1942 else modificationTimeIfExists (ml_obj_file location)
1945 preprocessFile :: HscEnv -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
1946 -> IO (DynFlags, FilePath, StringBuffer)
1947 preprocessFile hsc_env src_fn mb_phase Nothing
1949 (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
1950 buf <- hGetStringBuffer hspp_fn
1951 return (dflags', hspp_fn, buf)
1953 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
1955 let dflags = hsc_dflags hsc_env
1956 -- case we bypass the preprocessing stage?
1958 local_opts = getOptions dflags buf src_fn
1960 (dflags', leftovers, warns) <- parseDynamicFlags dflags (map unLoc local_opts)
1961 checkProcessArgsResult leftovers src_fn
1962 handleFlagWarnings dflags' warns
1966 | Just (Unlit _) <- mb_phase = True
1967 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
1968 -- note: local_opts is only required if there's no Unlit phase
1969 | dopt Opt_Cpp dflags' = True
1970 | dopt Opt_Pp dflags' = True
1973 when needs_preprocessing $
1974 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
1976 return (dflags', src_fn, buf)
1979 -----------------------------------------------------------------------------
1981 -----------------------------------------------------------------------------
1983 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
1984 -- ToDo: we don't have a proper line number for this error
1985 noModError dflags loc wanted_mod err
1986 = throwDyn $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
1988 noHsFileErr :: SrcSpan -> String -> a
1989 noHsFileErr loc path
1990 = throwDyn $ mkPlainErrMsg loc $ text "Can't find" <+> text path
1992 packageModErr :: ModuleName -> a
1994 = throwDyn $ mkPlainErrMsg noSrcSpan $
1995 text "module" <+> quotes (ppr mod) <+> text "is a package module"
1997 multiRootsErr :: [ModSummary] -> IO ()
1998 multiRootsErr [] = panic "multiRootsErr"
1999 multiRootsErr summs@(summ1:_)
2000 = throwDyn $ mkPlainErrMsg noSrcSpan $
2001 text "module" <+> quotes (ppr mod) <+>
2002 text "is defined in multiple files:" <+>
2003 sep (map text files)
2006 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
2008 cyclicModuleErr :: [ModSummary] -> SDoc
2010 = hang (ptext (sLit "Module imports form a cycle for modules:"))
2011 2 (vcat (map show_one ms))
2013 show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
2014 nest 2 $ ptext (sLit "imports:") <+>
2015 (pp_imps HsBootFile (ms_srcimps ms)
2016 $$ pp_imps HsSrcFile (ms_imps ms))]
2017 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
2018 pp_imps src mods = fsep (map (show_mod src) mods)
2021 -- | Inform GHC that the working directory has changed. GHC will flush
2022 -- its cache of module locations, since it may no longer be valid.
2023 -- Note: if you change the working directory, you should also unload
2024 -- the current program (set targets to empty, followed by load).
2025 workingDirectoryChanged :: Session -> IO ()
2026 workingDirectoryChanged s = withSession s $ flushFinderCaches
2028 -- -----------------------------------------------------------------------------
2029 -- inspecting the session
2031 -- | Get the module dependency graph.
2032 getModuleGraph :: Session -> IO ModuleGraph -- ToDo: DiGraph ModSummary
2033 getModuleGraph s = withSession s (return . hsc_mod_graph)
2035 isLoaded :: Session -> ModuleName -> IO Bool
2036 isLoaded s m = withSession s $ \hsc_env ->
2037 return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
2039 getBindings :: Session -> IO [TyThing]
2040 getBindings s = withSession s $ \hsc_env ->
2041 -- we have to implement the shadowing behaviour of ic_tmp_ids here
2042 -- (see InteractiveContext) and the quickest way is to use an OccEnv.
2044 tmp_ids = ic_tmp_ids (hsc_IC hsc_env)
2045 filtered = foldr f (const []) tmp_ids emptyUniqSet
2047 | uniq `elementOfUniqSet` set = rest set
2048 | otherwise = AnId id : rest (addOneToUniqSet set uniq)
2049 where uniq = getUnique (nameOccName (idName id))
2053 getPrintUnqual :: Session -> IO PrintUnqualified
2054 getPrintUnqual s = withSession s $ \hsc_env ->
2055 return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
2057 -- | Container for information about a 'Module'.
2058 data ModuleInfo = ModuleInfo {
2059 minf_type_env :: TypeEnv,
2060 minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
2061 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
2062 minf_instances :: [Instance]
2064 ,minf_modBreaks :: ModBreaks
2066 -- ToDo: this should really contain the ModIface too
2068 -- We don't want HomeModInfo here, because a ModuleInfo applies
2069 -- to package modules too.
2071 -- | Request information about a loaded 'Module'
2072 getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
2073 getModuleInfo s mdl = withSession s $ \hsc_env -> do
2074 let mg = hsc_mod_graph hsc_env
2075 if mdl `elem` map ms_mod mg
2076 then getHomeModuleInfo hsc_env (moduleName mdl)
2078 {- if isHomeModule (hsc_dflags hsc_env) mdl
2080 else -} getPackageModuleInfo hsc_env mdl
2081 -- getPackageModuleInfo will attempt to find the interface, so
2082 -- we don't want to call it for a home module, just in case there
2083 -- was a problem loading the module and the interface doesn't
2084 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
2086 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
2088 getPackageModuleInfo hsc_env mdl = do
2089 (_msgs, mb_avails) <- getModuleExports hsc_env mdl
2091 Nothing -> return Nothing
2093 eps <- readIORef (hsc_EPS hsc_env)
2095 names = availsToNameSet avails
2097 tys = [ ty | name <- concatMap availNames avails,
2098 Just ty <- [lookupTypeEnv pte name] ]
2100 return (Just (ModuleInfo {
2101 minf_type_env = mkTypeEnv tys,
2102 minf_exports = names,
2103 minf_rdr_env = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
2104 minf_instances = error "getModuleInfo: instances for package module unimplemented",
2105 minf_modBreaks = emptyModBreaks
2108 getPackageModuleInfo _hsc_env _mdl = do
2109 -- bogusly different for non-GHCI (ToDo)
2113 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
2114 getHomeModuleInfo hsc_env mdl =
2115 case lookupUFM (hsc_HPT hsc_env) mdl of
2116 Nothing -> return Nothing
2118 let details = hm_details hmi
2119 return (Just (ModuleInfo {
2120 minf_type_env = md_types details,
2121 minf_exports = availsToNameSet (md_exports details),
2122 minf_rdr_env = mi_globals $! hm_iface hmi,
2123 minf_instances = md_insts details
2125 ,minf_modBreaks = getModBreaks hmi
2129 -- | The list of top-level entities defined in a module
2130 modInfoTyThings :: ModuleInfo -> [TyThing]
2131 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
2133 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
2134 modInfoTopLevelScope minf
2135 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
2137 modInfoExports :: ModuleInfo -> [Name]
2138 modInfoExports minf = nameSetToList $! minf_exports minf
2140 -- | Returns the instances defined by the specified module.
2141 -- Warning: currently unimplemented for package modules.
2142 modInfoInstances :: ModuleInfo -> [Instance]
2143 modInfoInstances = minf_instances
2145 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
2146 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
2148 mkPrintUnqualifiedForModule :: Session -> ModuleInfo -> IO (Maybe PrintUnqualified)
2149 mkPrintUnqualifiedForModule s minf = withSession s $ \hsc_env -> do
2150 return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
2152 modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
2153 modInfoLookupName s minf name = withSession s $ \hsc_env -> do
2154 case lookupTypeEnv (minf_type_env minf) name of
2155 Just tyThing -> return (Just tyThing)
2157 eps <- readIORef (hsc_EPS hsc_env)
2158 return $! lookupType (hsc_dflags hsc_env)
2159 (hsc_HPT hsc_env) (eps_PTE eps) name
2162 modInfoModBreaks :: ModuleInfo -> ModBreaks
2163 modInfoModBreaks = minf_modBreaks
2166 isDictonaryId :: Id -> Bool
2168 = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
2170 -- | Looks up a global name: that is, any top-level name in any
2171 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
2172 -- the interactive context, and therefore does not require a preceding
2174 lookupGlobalName :: Session -> Name -> IO (Maybe TyThing)
2175 lookupGlobalName s name = withSession s $ \hsc_env -> do
2176 eps <- readIORef (hsc_EPS hsc_env)
2177 return $! lookupType (hsc_dflags hsc_env)
2178 (hsc_HPT hsc_env) (eps_PTE eps) name
2181 -- | get the GlobalRdrEnv for a session
2182 getGRE :: Session -> IO GlobalRdrEnv
2183 getGRE s = withSession s $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
2186 -- -----------------------------------------------------------------------------
2187 -- Misc exported utils
2189 dataConType :: DataCon -> Type
2190 dataConType dc = idType (dataConWrapId dc)
2192 -- | print a 'NamedThing', adding parentheses if the name is an operator.
2193 pprParenSymName :: NamedThing a => a -> SDoc
2194 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
2196 -- ----------------------------------------------------------------------------
2201 -- - Data and Typeable instances for HsSyn.
2203 -- ToDo: check for small transformations that happen to the syntax in
2204 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
2206 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
2207 -- to get from TyCons, Ids etc. to TH syntax (reify).
2209 -- :browse will use either lm_toplev or inspect lm_interface, depending
2210 -- on whether the module is interpreted or not.
2212 -- This is for reconstructing refactored source code
2213 -- Calls the lexer repeatedly.
2214 -- ToDo: add comment tokens to token stream
2215 getTokenStream :: Session -> Module -> IO [Located Token]
2218 -- -----------------------------------------------------------------------------
2219 -- Interactive evaluation
2221 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
2222 -- filesystem and package database to find the corresponding 'Module',
2223 -- using the algorithm that is used for an @import@ declaration.
2224 findModule :: Session -> ModuleName -> Maybe PackageId -> IO Module
2225 findModule s mod_name maybe_pkg = withSession s $ \hsc_env ->
2227 dflags = hsc_dflags hsc_env
2228 hpt = hsc_HPT hsc_env
2229 this_pkg = thisPackage dflags
2231 case lookupUFM hpt mod_name of
2232 Just mod_info -> return (mi_module (hm_iface mod_info))
2233 _not_a_home_module -> do
2234 res <- findImportedModule hsc_env mod_name maybe_pkg
2236 Found _ m | modulePackageId m /= this_pkg -> return m
2237 | otherwise -> throwDyn (CmdLineError (showSDoc $
2238 text "module" <+> quotes (ppr (moduleName m)) <+>
2239 text "is not loaded"))
2240 err -> let msg = cannotFindModule dflags mod_name err in
2241 throwDyn (CmdLineError (showSDoc msg))
2244 getHistorySpan :: Session -> History -> IO SrcSpan
2245 getHistorySpan sess h = withSession sess $ \hsc_env ->
2246 return$ InteractiveEval.getHistorySpan hsc_env h
2248 obtainTerm :: Session -> Bool -> Id -> IO Term
2249 obtainTerm sess force id = withSession sess $ \hsc_env ->
2250 InteractiveEval.obtainTerm hsc_env force id
2252 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
2253 obtainTerm1 sess force mb_ty a = withSession sess $ \hsc_env ->
2254 InteractiveEval.obtainTerm1 hsc_env force mb_ty a
2256 obtainTermB :: Session -> Int -> Bool -> Id -> IO Term
2257 obtainTermB sess bound force id = withSession sess $ \hsc_env ->
2258 InteractiveEval.obtainTermB hsc_env bound force id