1 -- -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow, 2005
7 -- -----------------------------------------------------------------------------
13 defaultCleanupHandler,
17 -- * Flags and settings
18 DynFlags(..), DynFlag(..), GhcMode(..), HscTarget(..), dopt,
26 Target(..), TargetId(..),
33 -- * Loading\/compiling the program
35 load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
36 workingDirectoryChanged,
37 checkModule, CheckedModule(..),
39 -- * Inspecting the module structure of the program
40 ModuleGraph, ModSummary(..),
45 -- * Interactive evaluation
46 getBindings, getPrintUnqual,
48 setContext, getContext,
50 getInfo, GetInfoResult,
61 -- * Abstract syntax elements
64 Module, mkModule, pprModule,
70 -- ** Type constructors
73 -- ** Data constructors
87 GhcException(..), showGhcException,
97 * return error messages rather than printing them.
98 * inline bits of HscMain here to simplify layering: hscGetInfo,
100 * implement second argument to load.
101 * we need to expose DynFlags, so should parseDynamicFlags really be
102 part of this interface?
103 * what StaticFlags should we expose, if any?
106 #include "HsVersions.h"
109 import qualified Linker
110 import Linker ( HValue, extendLinkEnv )
111 import NameEnv ( lookupNameEnv )
112 import TcRnDriver ( mkExportEnv, getModuleContents )
113 import RdrName ( plusGlobalRdrEnv )
114 import HscMain ( hscGetInfo, GetInfoResult,
115 hscStmt, hscTcExpr, hscKcType )
116 import Type ( tidyType )
117 import VarEnv ( emptyTidyEnv )
118 import GHC.Exts ( unsafeCoerce# )
119 import IfaceSyn ( IfaceDecl )
122 import Packages ( initPackages )
123 import RdrName ( GlobalRdrEnv )
124 import HsSyn ( HsModule, LHsBinds )
125 import Type ( Kind, Type, dropForAlls )
126 import Id ( Id, idType )
127 import TyCon ( TyCon )
128 import Class ( Class )
129 import DataCon ( DataCon )
131 import RdrName ( RdrName )
132 import NameEnv ( nameEnvElts )
133 import SrcLoc ( Located )
134 import DriverPipeline
135 import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase )
136 import GetImports ( getImports )
137 import Packages ( isHomePackage )
139 import HscMain ( newHscEnv, hscFileCheck, HscResult(..) )
143 import SysTools ( initSysTools, cleanTempFiles )
148 import ErrUtils ( showPass, Messages, putMsg, debugTraceMsg )
149 import qualified ErrUtils
151 import StringBuffer ( StringBuffer, hGetStringBuffer )
153 import SysTools ( cleanTempFilesExcept )
154 import BasicTypes ( SuccessFlag(..), succeeded, failed )
155 import Maybes ( orElse, expectJust, mapCatMaybes )
157 import Directory ( getModificationTime, doesFileExist )
158 import Maybe ( isJust, isNothing, fromJust )
159 import Maybes ( expectJust )
160 import List ( partition, nub )
161 import qualified List
162 import Monad ( unless, when, foldM )
163 import System ( exitWith, ExitCode(..) )
164 import Time ( ClockTime )
165 import EXCEPTION as Exception hiding (handle)
168 import Prelude hiding (init)
170 -- -----------------------------------------------------------------------------
171 -- Exception handlers
173 -- | Install some default exception handlers and run the inner computation.
174 -- Unless you want to handle exceptions yourself, you should wrap this around
175 -- the top level of your program. The default handlers output the error
176 -- message(s) to stderr and exit cleanly.
177 defaultErrorHandler :: IO a -> IO a
178 defaultErrorHandler inner =
179 -- top-level exception handler: any unrecognised exception is a compiler bug.
180 handle (\exception -> do
183 -- an IO exception probably isn't our fault, so don't panic
184 IOException _ -> putMsg (show exception)
185 AsyncException StackOverflow ->
186 putMsg "stack overflow: use +RTS -K<size> to increase it"
187 _other -> putMsg (show (Panic (show exception)))
188 exitWith (ExitFailure 1)
191 -- all error messages are propagated as exceptions
192 handleDyn (\dyn -> do
195 PhaseFailed _ code -> exitWith code
196 Interrupted -> exitWith (ExitFailure 1)
197 _ -> do putMsg (show (dyn :: GhcException))
198 exitWith (ExitFailure 1)
202 -- | Install a default cleanup handler to remove temporary files
203 -- deposited by a GHC run. This is seperate from
204 -- 'defaultErrorHandler', because you might want to override the error
205 -- handling, but still get the ordinary cleanup behaviour.
206 defaultCleanupHandler :: DynFlags -> IO a -> IO a
207 defaultCleanupHandler dflags inner =
208 -- make sure we clean up after ourselves
209 later (unless (dopt Opt_KeepTmpFiles dflags) $
210 cleanTempFiles dflags)
211 -- exceptions will be blocked while we clean the temporary files,
212 -- so there shouldn't be any difficulty if we receive further
217 -- | Initialises GHC. This must be done /once/ only. Takes the
218 -- command-line arguments. All command-line arguments which aren't
219 -- understood by GHC will be returned.
221 init :: [String] -> IO [String]
224 installSignalHandlers
226 -- Grab the -B option if there is one
227 let (minusB_args, argv1) = partition (prefixMatch "-B") args
228 dflags0 <- initSysTools minusB_args defaultDynFlags
229 writeIORef v_initDynFlags dflags0
231 -- Parse the static flags
232 argv2 <- parseStaticFlags argv1
235 GLOBAL_VAR(v_initDynFlags, error "initDynFlags", DynFlags)
236 -- stores the DynFlags between the call to init and subsequent
237 -- calls to newSession.
239 -- | Starts a new session. A session consists of a set of loaded
240 -- modules, a set of options (DynFlags), and an interactive context.
241 -- ToDo: GhcMode should say "keep typechecked code" and\/or "keep renamed
243 newSession :: GhcMode -> IO Session
245 dflags0 <- readIORef v_initDynFlags
246 dflags <- initDynFlags dflags0
247 env <- newHscEnv dflags{ ghcMode=mode }
251 -- tmp: this breaks the abstraction, but required because DriverMkDepend
252 -- needs to call the Finder. ToDo: untangle this.
253 sessionHscEnv :: Session -> IO HscEnv
254 sessionHscEnv (Session ref) = readIORef ref
256 withSession :: Session -> (HscEnv -> IO a) -> IO a
257 withSession (Session ref) f = do h <- readIORef ref; f h
259 modifySession :: Session -> (HscEnv -> HscEnv) -> IO ()
260 modifySession (Session ref) f = do h <- readIORef ref; writeIORef ref $! f h
262 -- -----------------------------------------------------------------------------
265 -- | Grabs the DynFlags from the Session
266 getSessionDynFlags :: Session -> IO DynFlags
267 getSessionDynFlags s = withSession s (return . hsc_dflags)
269 -- | Updates the DynFlags in a Session
270 setSessionDynFlags :: Session -> DynFlags -> IO ()
271 setSessionDynFlags s dflags = modifySession s (\h -> h{ hsc_dflags = dflags })
273 -- | Messages during compilation (eg. warnings and progress messages)
274 -- are reported using this callback. By default, these messages are
275 -- printed to stderr.
276 setMsgHandler :: (String -> IO ()) -> IO ()
277 setMsgHandler = ErrUtils.setMsgHandler
279 -- -----------------------------------------------------------------------------
282 -- ToDo: think about relative vs. absolute file paths. And what
283 -- happens when the current directory changes.
285 -- | Sets the targets for this session. Each target may be a module name
286 -- or a filename. The targets correspond to the set of root modules for
287 -- the program\/library. Unloading the current program is achieved by
288 -- setting the current set of targets to be empty, followed by load.
289 setTargets :: Session -> [Target] -> IO ()
290 setTargets s targets = modifySession s (\h -> h{ hsc_targets = targets })
292 -- | returns the current set of targets
293 getTargets :: Session -> IO [Target]
294 getTargets s = withSession s (return . hsc_targets)
296 -- | Add another target
297 addTarget :: Session -> Target -> IO ()
299 = modifySession s (\h -> h{ hsc_targets = target : hsc_targets h })
302 removeTarget :: Session -> TargetId -> IO ()
303 removeTarget s target_id
304 = modifySession s (\h -> h{ hsc_targets = filter (hsc_targets h) })
306 filter targets = [ t | t@(Target id _) <- targets, id /= target_id ]
308 -- Attempts to guess what Target a string refers to. This function implements
309 -- the --make/GHCi command-line syntax for filenames:
311 -- - if the string looks like a Haskell source filename, then interpret
313 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
315 -- - otherwise interpret the string as a module name
317 guessTarget :: String -> IO Target
319 | isHaskellSrcFilename file
320 = return (Target (TargetFile file) Nothing)
322 = do exists <- doesFileExist hs_file
323 if exists then return (Target (TargetFile hs_file) Nothing) else do
324 exists <- doesFileExist lhs_file
325 if exists then return (Target (TargetFile lhs_file) Nothing) else do
326 return (Target (TargetModule (mkModule file)) Nothing)
328 hs_file = file ++ ".hs"
329 lhs_file = file ++ ".lhs"
331 -- -----------------------------------------------------------------------------
332 -- Loading the program
334 -- Perform a dependency analysis starting from the current targets
335 -- and update the session with the new module graph.
336 depanal :: Session -> [Module] -> IO ()
337 depanal (Session ref) excluded_mods = do
338 hsc_env <- readIORef ref
340 dflags = hsc_dflags hsc_env
341 gmode = ghcMode (hsc_dflags hsc_env)
342 targets = hsc_targets hsc_env
343 old_graph = hsc_mod_graph hsc_env
345 showPass dflags "Chasing dependencies"
346 when (gmode == BatchCompile) $
347 debugTraceMsg dflags 1 (showSDoc (hcat [
348 text "Chasing modules from: ",
349 hcat (punctuate comma (map pprTarget targets))]))
351 graph <- downsweep hsc_env old_graph excluded_mods
352 writeIORef ref hsc_env{ hsc_mod_graph=graph }
355 -- | The result of load.
357 = LoadOk Errors -- ^ all specified targets were loaded successfully.
358 | LoadFailed Errors -- ^ not all modules were loaded.
360 type Errors = [String]
362 data ErrMsg = ErrMsg {
363 errMsgSeverity :: Severity, -- warning, error, etc.
364 errMsgSpans :: [SrcSpan],
365 errMsgShortDoc :: Doc,
366 errMsgExtraInfo :: Doc
373 | LoadDependenciesOf Module
375 -- | Try to load the program. If a Module is supplied, then just
376 -- attempt to load up to this target. If no Module is supplied,
377 -- then try to load all targets.
378 load :: Session -> LoadHowMuch -> IO SuccessFlag
379 load s@(Session ref) how_much
381 -- Dependency analysis first. Note that this fixes the module graph:
382 -- even if we don't get a fully successful upsweep, the full module
383 -- graph is still retained in the Session. We can tell which modules
384 -- were successfully loaded by inspecting the Session's HPT.
387 hsc_env <- readIORef ref
389 let hpt1 = hsc_HPT hsc_env
390 let dflags = hsc_dflags hsc_env
391 let mod_graph = hsc_mod_graph hsc_env
393 let ghci_mode = ghcMode (hsc_dflags hsc_env) -- this never changes
394 let verb = verbosity dflags
396 -- The "bad" boot modules are the ones for which we have
397 -- B.hs-boot in the module graph, but no B.hs
398 -- The downsweep should have ensured this does not happen
400 let all_home_mods = [ms_mod s | s <- mod_graph, not (isBootSummary s)]
401 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
402 not (ms_mod s `elem` all_home_mods)]
403 ASSERT( null bad_boot_mods ) return ()
405 -- mg2_with_srcimps drops the hi-boot nodes, returning a
406 -- graph with cycles. Among other things, it is used for
407 -- backing out partially complete cycles following a failed
408 -- upsweep, and for removing from hpt all the modules
409 -- not in strict downwards closure, during calls to compile.
410 let mg2_with_srcimps :: [SCC ModSummary]
411 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
413 -- check the stability property for each module.
414 stable_mods@(stable_obj,stable_bco)
415 | BatchCompile <- ghci_mode = ([],[])
416 | otherwise = checkStability hpt1 mg2_with_srcimps all_home_mods
418 -- prune bits of the HPT which are definitely redundant now,
420 pruned_hpt = pruneHomePackageTable hpt1
421 (flattenSCCs mg2_with_srcimps)
426 debugTraceMsg dflags 2 (showSDoc (text "Stable obj:" <+> ppr stable_obj $$
427 text "Stable BCO:" <+> ppr stable_bco))
429 -- Unload any modules which are going to be re-linked this time around.
430 let stable_linkables = [ linkable
431 | m <- stable_obj++stable_bco,
432 Just hmi <- [lookupModuleEnv pruned_hpt m],
433 Just linkable <- [hm_linkable hmi] ]
434 unload hsc_env stable_linkables
436 -- We could at this point detect cycles which aren't broken by
437 -- a source-import, and complain immediately, but it seems better
438 -- to let upsweep_mods do this, so at least some useful work gets
439 -- done before the upsweep is abandoned.
440 --hPutStrLn stderr "after tsort:\n"
441 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
443 -- Now do the upsweep, calling compile for each module in
444 -- turn. Final result is version 3 of everything.
446 -- Topologically sort the module graph, this time including hi-boot
447 -- nodes, and possibly just including the portion of the graph
448 -- reachable from the module specified in the 2nd argument to load.
449 -- This graph should be cycle-free.
450 -- If we're restricting the upsweep to a portion of the graph, we
451 -- also want to retain everything that is still stable.
452 let full_mg :: [SCC ModSummary]
453 full_mg = topSortModuleGraph False mod_graph Nothing
455 maybe_top_mod = case how_much of
457 LoadDependenciesOf m -> Just m
460 partial_mg0 :: [SCC ModSummary]
461 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
463 -- LoadDependenciesOf m: we want the upsweep to stop just
464 -- short of the specified module (unless the specified module
467 | LoadDependenciesOf mod <- how_much
468 = ASSERT( case last partial_mg0 of
469 AcyclicSCC ms -> ms_mod ms == mod; _ -> False )
470 List.init partial_mg0
476 | AcyclicSCC ms <- full_mg,
477 ms_mod ms `elem` stable_obj++stable_bco,
478 ms_mod ms `notElem` [ ms_mod ms' |
479 AcyclicSCC ms' <- partial_mg ] ]
481 mg = stable_mg ++ partial_mg
483 -- clean up between compilations
484 let cleanup = cleanTempFilesExcept dflags
485 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
487 (upsweep_ok, hsc_env1, modsUpswept)
488 <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
489 pruned_hpt stable_mods cleanup mg
491 -- Make modsDone be the summaries for each home module now
492 -- available; this should equal the domain of hpt3.
493 -- Get in in a roughly top .. bottom order (hence reverse).
495 let modsDone = reverse modsUpswept
497 -- Try and do linking in some form, depending on whether the
498 -- upsweep was completely or only partially successful.
500 if succeeded upsweep_ok
503 -- Easy; just relink it all.
504 do debugTraceMsg dflags 2 "Upsweep completely successful."
506 -- Clean up after ourselves
507 cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
509 -- Issue a warning for the confusing case where the user
510 -- said '-o foo' but we're not going to do any linking.
511 -- We attempt linking if either (a) one of the modules is
512 -- called Main, or (b) the user said -no-hs-main, indicating
513 -- that main() is going to come from somewhere else.
515 let ofile = outputFile dflags
516 let no_hs_main = dopt Opt_NoHsMain dflags
517 let mb_main_mod = mainModIs dflags
519 main_mod = mb_main_mod `orElse` "Main"
521 = any ((==main_mod).moduleUserString.ms_mod)
523 do_linking = a_root_is_Main || no_hs_main
525 when (ghci_mode == BatchCompile && isJust ofile && not do_linking) $
526 debugTraceMsg dflags 1 ("Warning: output was redirected with -o, " ++
527 "but no output will be generated\n" ++
528 "because there is no " ++ main_mod ++ " module.")
530 -- link everything together
531 linkresult <- link ghci_mode dflags do_linking (hsc_HPT hsc_env1)
533 loadFinish Succeeded linkresult ref hsc_env1
536 -- Tricky. We need to back out the effects of compiling any
537 -- half-done cycles, both so as to clean up the top level envs
538 -- and to avoid telling the interactive linker to link them.
539 do debugTraceMsg dflags 2 "Upsweep partially successful."
542 = map ms_mod modsDone
543 let mods_to_zap_names
544 = findPartiallyCompletedCycles modsDone_names
547 = filter ((`notElem` mods_to_zap_names).ms_mod)
550 let hpt4 = retainInTopLevelEnvs (map ms_mod mods_to_keep)
553 -- Clean up after ourselves
554 cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
556 -- there should be no Nothings where linkables should be, now
557 ASSERT(all (isJust.hm_linkable)
558 (moduleEnvElts (hsc_HPT hsc_env))) do
560 -- Link everything together
561 linkresult <- link ghci_mode dflags False hpt4
563 let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
564 loadFinish Failed linkresult ref hsc_env4
566 -- Finish up after a load.
568 -- If the link failed, unload everything and return.
569 loadFinish all_ok Failed ref hsc_env
570 = do unload hsc_env []
571 writeIORef ref $! discardProg hsc_env
574 -- Empty the interactive context and set the module context to the topmost
575 -- newly loaded module, or the Prelude if none were loaded.
576 loadFinish all_ok Succeeded ref hsc_env
577 = do writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
581 -- Forget the current program, but retain the persistent info in HscEnv
582 discardProg :: HscEnv -> HscEnv
584 = hsc_env { hsc_mod_graph = emptyMG,
585 hsc_IC = emptyInteractiveContext,
586 hsc_HPT = emptyHomePackageTable }
588 -- used to fish out the preprocess output files for the purposes of
589 -- cleaning up. The preprocessed file *might* be the same as the
590 -- source file, but that doesn't do any harm.
591 ppFilesFromSummaries summaries = [ fn | Just fn <- map ms_hspp_file summaries ]
593 -- -----------------------------------------------------------------------------
597 CheckedModule { parsedSource :: ParsedSource,
598 -- ToDo: renamedSource
599 typecheckedSource :: Maybe TypecheckedSource
602 type ParsedSource = Located (HsModule RdrName)
603 type TypecheckedSource = (LHsBinds Id, GlobalRdrEnv)
605 -- | This is the way to get access to parsed and typechecked source code
606 -- for a module. 'checkModule' loads all the dependencies of the specified
607 -- module in the Session, and then attempts to typecheck the module. If
608 -- successful, it returns the abstract syntax for the module.
609 checkModule :: Session -> Module -> (Messages -> IO ())
610 -> IO (Maybe CheckedModule)
611 checkModule session@(Session ref) mod msg_act = do
612 -- load up the dependencies first
613 r <- load session (LoadDependenciesOf mod)
614 if (failed r) then return Nothing else do
616 -- now parse & typecheck the module
617 hsc_env <- readIORef ref
618 let mg = hsc_mod_graph hsc_env
619 case [ ms | ms <- mg, ms_mod ms == mod ] of
622 r <- hscFileCheck hsc_env msg_act ms
626 HscChecked parsed tcd ->
627 return (Just (CheckedModule parsed tcd) )
629 -----------------------------------------------------------------------------
632 unload :: HscEnv -> [Linkable] -> IO ()
633 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
634 = case ghcMode (hsc_dflags hsc_env) of
635 BatchCompile -> return ()
636 JustTypecheck -> return ()
638 Interactive -> Linker.unload (hsc_dflags hsc_env) stable_linkables
640 Interactive -> panic "unload: no interpreter"
642 other -> panic "unload: strange mode"
644 -- -----------------------------------------------------------------------------
648 Stability tells us which modules definitely do not need to be recompiled.
649 There are two main reasons for having stability:
651 - avoid doing a complete upsweep of the module graph in GHCi when
652 modules near the bottom of the tree have not changed.
654 - to tell GHCi when it can load object code: we can only load object code
655 for a module when we also load object code fo all of the imports of the
656 module. So we need to know that we will definitely not be recompiling
657 any of these modules, and we can use the object code.
659 NB. stability is of no importance to BatchCompile at all, only Interactive.
660 (ToDo: what about JustTypecheck?)
662 The stability check is as follows. Both stableObject and
663 stableBCO are used during the upsweep phase later.
666 stable m = stableObject m || stableBCO m
669 all stableObject (imports m)
670 && old linkable does not exist, or is == on-disk .o
671 && date(on-disk .o) > date(.hs)
674 all stable (imports m)
675 && date(BCO) > date(.hs)
678 These properties embody the following ideas:
680 - if a module is stable:
681 - if it has been compiled in a previous pass (present in HPT)
682 then it does not need to be compiled or re-linked.
683 - if it has not been compiled in a previous pass,
684 then we only need to read its .hi file from disk and
685 link it to produce a ModDetails.
687 - if a modules is not stable, we will definitely be at least
688 re-linking, and possibly re-compiling it during the upsweep.
689 All non-stable modules can (and should) therefore be unlinked
692 - Note that objects are only considered stable if they only depend
693 on other objects. We can't link object code against byte code.
697 :: HomePackageTable -- HPT from last compilation
698 -> [SCC ModSummary] -- current module graph (cyclic)
699 -> [Module] -- all home modules
700 -> ([Module], -- stableObject
701 [Module]) -- stableBCO
703 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
705 checkSCC (stable_obj, stable_bco) scc0
706 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
707 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
708 | otherwise = (stable_obj, stable_bco)
710 scc = flattenSCC scc0
711 scc_mods = map ms_mod scc
712 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
714 scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
715 -- all imports outside the current SCC, but in the home pkg
717 stable_obj_imps = map (`elem` stable_obj) scc_allimps
718 stable_bco_imps = map (`elem` stable_bco) scc_allimps
725 and (zipWith (||) stable_obj_imps stable_bco_imps)
729 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
733 same_as_prev t = case lookupModuleEnv hpt (ms_mod ms) of
735 Just hmi | Just l <- hm_linkable hmi
736 -> isObjectLinkable l && t == linkableTime l
737 -- why '>=' rather than '>' above? If the filesystem stores
738 -- times to the nearset second, we may occasionally find that
739 -- the object & source have the same modification time,
740 -- especially if the source was automatically generated
741 -- and compiled. Using >= is slightly unsafe, but it matches
745 = case lookupModuleEnv hpt (ms_mod ms) of
747 Just hmi | Just l <- hm_linkable hmi ->
748 not (isObjectLinkable l) &&
749 linkableTime l >= ms_hs_date ms
751 ms_allimps :: ModSummary -> [Module]
752 ms_allimps ms = ms_srcimps ms ++ ms_imps ms
754 -- -----------------------------------------------------------------------------
755 -- Prune the HomePackageTable
757 -- Before doing an upsweep, we can throw away:
759 -- - For non-stable modules:
760 -- - all ModDetails, all linked code
761 -- - all unlinked code that is out of date with respect to
764 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
765 -- space at the end of the upsweep, because the topmost ModDetails of the
766 -- old HPT holds on to the entire type environment from the previous
769 pruneHomePackageTable
772 -> ([Module],[Module])
775 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
776 = mapModuleEnv prune hpt
778 | is_stable modl = hmi'
779 | otherwise = hmi'{ hm_details = emptyModDetails }
781 modl = mi_module (hm_iface hmi)
782 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
783 = hmi{ hm_linkable = Nothing }
786 where ms = expectJust "prune" (lookupModuleEnv ms_map modl)
788 ms_map = mkModuleEnv [(ms_mod ms, ms) | ms <- summ]
790 is_stable m = m `elem` stable_obj || m `elem` stable_bco
792 -- -----------------------------------------------------------------------------
794 -- Return (names of) all those in modsDone who are part of a cycle
795 -- as defined by theGraph.
796 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
797 findPartiallyCompletedCycles modsDone theGraph
801 chew ((AcyclicSCC v):rest) = chew rest -- acyclic? not interesting.
802 chew ((CyclicSCC vs):rest)
803 = let names_in_this_cycle = nub (map ms_mod vs)
805 = nub ([done | done <- modsDone,
806 done `elem` names_in_this_cycle])
807 chewed_rest = chew rest
809 if notNull mods_in_this_cycle
810 && length mods_in_this_cycle < length names_in_this_cycle
811 then mods_in_this_cycle ++ chewed_rest
814 -- -----------------------------------------------------------------------------
817 -- This is where we compile each module in the module graph, in a pass
818 -- from the bottom to the top of the graph.
820 -- There better had not be any cyclic groups here -- we check for them.
823 :: HscEnv -- Includes initially-empty HPT
824 -> HomePackageTable -- HPT from last time round (pruned)
825 -> ([Module],[Module]) -- stable modules (see checkStability)
826 -> IO () -- How to clean up unwanted tmp files
827 -> [SCC ModSummary] -- Mods to do (the worklist)
829 HscEnv, -- With an updated HPT
830 [ModSummary]) -- Mods which succeeded
832 upsweep hsc_env old_hpt stable_mods cleanup
834 = return (Succeeded, hsc_env, [])
836 upsweep hsc_env old_hpt stable_mods cleanup
838 = do putMsg (showSDoc (cyclicModuleErr ms))
839 return (Failed, hsc_env, [])
841 upsweep hsc_env old_hpt stable_mods cleanup
842 (AcyclicSCC mod:mods)
843 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
844 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
845 -- (moduleEnvElts (hsc_HPT hsc_env)))
847 mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod
849 cleanup -- Remove unwanted tmp files between compilations
852 Nothing -> return (Failed, hsc_env, [])
854 { let this_mod = ms_mod mod
856 -- Add new info to hsc_env
857 hpt1 = extendModuleEnv (hsc_HPT hsc_env)
859 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
861 -- Space-saving: delete the old HPT entry
862 -- for mod BUT if mod is a hs-boot
863 -- node, don't delete it. For the
864 -- interface, the HPT entry is probaby for the
865 -- main Haskell source file. Deleting it
866 -- would force .. (what?? --SDM)
867 old_hpt1 | isBootSummary mod = old_hpt
868 | otherwise = delModuleEnv old_hpt this_mod
870 ; (restOK, hsc_env2, modOKs)
871 <- upsweep hsc_env1 old_hpt1 stable_mods cleanup mods
872 ; return (restOK, hsc_env2, mod:modOKs)
876 -- Compile a single module. Always produce a Linkable for it if
877 -- successful. If no compilation happened, return the old Linkable.
878 upsweep_mod :: HscEnv
880 -> ([Module],[Module])
882 -> IO (Maybe HomeModInfo) -- Nothing => Failed
884 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary
887 this_mod = ms_mod summary
888 mb_obj_date = ms_obj_date summary
889 obj_fn = ml_obj_file (ms_location summary)
890 hs_date = ms_hs_date summary
892 compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
893 compile_it = upsweep_compile hsc_env old_hpt this_mod summary
895 case ghcMode (hsc_dflags hsc_env) of
898 -- Batch-compilating is easy: just check whether we have
899 -- an up-to-date object file. If we do, then the compiler
900 -- needs to do a recompilation check.
901 _ | Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
903 findObjectLinkable this_mod obj_fn obj_date
904 compile_it (Just linkable)
911 _ | is_stable_obj, isJust old_hmi ->
913 -- object is stable, and we have an entry in the
914 -- old HPT: nothing to do
916 | is_stable_obj, isNothing old_hmi -> do
918 findObjectLinkable this_mod obj_fn
919 (expectJust "upseep1" mb_obj_date)
920 compile_it (Just linkable)
921 -- object is stable, but we need to load the interface
922 -- off disk to make a HMI.
925 ASSERT(isJust old_hmi) -- must be in the old_hpt
927 -- BCO is stable: nothing to do
929 | Just hmi <- old_hmi,
930 Just l <- hm_linkable hmi, not (isObjectLinkable l),
931 linkableTime l >= ms_hs_date summary ->
933 -- we have an old BCO that is up to date with respect
934 -- to the source: do a recompilation check as normal.
938 -- no existing code at all: we must recompile.
940 is_stable_obj = this_mod `elem` stable_obj
941 is_stable_bco = this_mod `elem` stable_bco
943 old_hmi = lookupModuleEnv old_hpt this_mod
945 -- Run hsc to compile a module
946 upsweep_compile hsc_env old_hpt this_mod summary mb_old_linkable = do
948 -- The old interface is ok if it's in the old HPT
949 -- a) we're compiling a source file, and the old HPT
950 -- entry is for a source file
951 -- b) we're compiling a hs-boot file
952 -- Case (b) allows an hs-boot file to get the interface of its
953 -- real source file on the second iteration of the compilation
954 -- manager, but that does no harm. Otherwise the hs-boot file
955 -- will always be recompiled
958 = case lookupModuleEnv old_hpt this_mod of
960 Just hm_info | isBootSummary summary -> Just iface
961 | not (mi_boot iface) -> Just iface
962 | otherwise -> Nothing
964 iface = hm_iface hm_info
966 compresult <- compile hsc_env summary mb_old_linkable mb_old_iface
969 -- Compilation failed. Compile may still have updated the PCS, tho.
970 CompErrs -> return Nothing
972 -- Compilation "succeeded", and may or may not have returned a new
973 -- linkable (depending on whether compilation was actually performed
975 CompOK new_details new_iface new_linkable
976 -> do let new_info = HomeModInfo { hm_iface = new_iface,
977 hm_details = new_details,
978 hm_linkable = new_linkable }
979 return (Just new_info)
982 -- Filter modules in the HPT
983 retainInTopLevelEnvs :: [Module] -> HomePackageTable -> HomePackageTable
984 retainInTopLevelEnvs keep_these hpt
985 = mkModuleEnv [ (mod, expectJust "retain" mb_mod_info)
987 , let mb_mod_info = lookupModuleEnv hpt mod
988 , isJust mb_mod_info ]
990 -- ---------------------------------------------------------------------------
991 -- Topological sort of the module graph
994 :: Bool -- Drop hi-boot nodes? (see below)
998 -- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
999 -- The resulting list of strongly-connected-components is in topologically
1000 -- sorted order, starting with the module(s) at the bottom of the
1001 -- dependency graph (ie compile them first) and ending with the ones at
1004 -- Drop hi-boot nodes (first boolean arg)?
1006 -- False: treat the hi-boot summaries as nodes of the graph,
1007 -- so the graph must be acyclic
1009 -- True: eliminate the hi-boot nodes, and instead pretend
1010 -- the a source-import of Foo is an import of Foo
1011 -- The resulting graph has no hi-boot nodes, but can by cyclic
1013 topSortModuleGraph drop_hs_boot_nodes summaries Nothing
1014 = stronglyConnComp (fst (moduleGraphNodes drop_hs_boot_nodes summaries))
1015 topSortModuleGraph drop_hs_boot_nodes summaries (Just mod)
1016 = stronglyConnComp (map vertex_fn (reachable graph root))
1018 -- restrict the graph to just those modules reachable from
1019 -- the specified module. We do this by building a graph with
1020 -- the full set of nodes, and determining the reachable set from
1021 -- the specified node.
1022 (nodes, lookup_key) = moduleGraphNodes drop_hs_boot_nodes summaries
1023 (graph, vertex_fn, key_fn) = graphFromEdges' nodes
1025 | Just key <- lookup_key HsSrcFile mod, Just v <- key_fn key = v
1026 | otherwise = throwDyn (ProgramError "module does not exist")
1028 moduleGraphNodes :: Bool -> [ModSummary]
1029 -> ([(ModSummary, Int, [Int])], HscSource -> Module -> Maybe Int)
1030 moduleGraphNodes drop_hs_boot_nodes summaries = (nodes, lookup_key)
1032 -- Drop hs-boot nodes by using HsSrcFile as the key
1033 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1034 | otherwise = HsBootFile
1036 -- We use integers as the keys for the SCC algorithm
1037 nodes :: [(ModSummary, Int, [Int])]
1038 nodes = [(s, expectJust "topSort" (lookup_key (ms_hsc_src s) (ms_mod s)),
1039 out_edge_keys hs_boot_key (ms_srcimps s) ++
1040 out_edge_keys HsSrcFile (ms_imps s) )
1042 , not (isBootSummary s && drop_hs_boot_nodes) ]
1043 -- Drop the hi-boot ones if told to do so
1045 key_map :: NodeMap Int
1046 key_map = listToFM ([(ms_mod s, ms_hsc_src s) | s <- summaries]
1049 lookup_key :: HscSource -> Module -> Maybe Int
1050 lookup_key hs_src mod = lookupFM key_map (mod, hs_src)
1052 out_edge_keys :: HscSource -> [Module] -> [Int]
1053 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1054 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1055 -- the IsBootInterface parameter True; else False
1058 type NodeKey = (Module, HscSource) -- The nodes of the graph are
1059 type NodeMap a = FiniteMap NodeKey a -- keyed by (mod, src_file_type) pairs
1061 msKey :: ModSummary -> NodeKey
1062 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (mod,boot)
1064 emptyNodeMap :: NodeMap a
1065 emptyNodeMap = emptyFM
1067 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1068 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
1070 nodeMapElts :: NodeMap a -> [a]
1071 nodeMapElts = eltsFM
1073 -- -----------------------------------------------------------------
1074 -- The unlinked image
1076 -- The compilation manager keeps a list of compiled, but as-yet unlinked
1077 -- binaries (byte code or object code). Even when it links bytecode
1078 -- it keeps the unlinked version so it can re-link it later without
1081 type UnlinkedImage = [Linkable] -- the unlinked images (should be a set, really)
1083 findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable
1084 findModuleLinkable_maybe lis mod
1085 = case [LM time nm us | LM time nm us <- lis, nm == mod] of
1088 many -> pprPanic "findModuleLinkable" (ppr mod)
1090 delModuleLinkable :: [Linkable] -> Module -> [Linkable]
1091 delModuleLinkable ls mod = [ l | l@(LM _ nm _) <- ls, nm /= mod ]
1093 -----------------------------------------------------------------------------
1094 -- Downsweep (dependency analysis)
1096 -- Chase downwards from the specified root set, returning summaries
1097 -- for all home modules encountered. Only follow source-import
1100 -- We pass in the previous collection of summaries, which is used as a
1101 -- cache to avoid recalculating a module summary if the source is
1104 -- The returned list of [ModSummary] nodes has one node for each home-package
1105 -- module, plus one for any hs-boot files. The imports of these nodes
1106 -- are all there, including the imports of non-home-package modules.
1109 -> [ModSummary] -- Old summaries
1110 -> [Module] -- Ignore dependencies on these; treat them as
1111 -- if they were package modules
1113 downsweep hsc_env old_summaries excl_mods
1114 = do rootSummaries <- mapM getRootSummary roots
1115 checkDuplicates rootSummaries
1116 loop (concatMap msDeps rootSummaries)
1117 (mkNodeMap rootSummaries)
1119 roots = hsc_targets hsc_env
1121 old_summary_map :: NodeMap ModSummary
1122 old_summary_map = mkNodeMap old_summaries
1124 getRootSummary :: Target -> IO ModSummary
1125 getRootSummary (Target (TargetFile file) maybe_buf)
1126 = do exists <- doesFileExist file
1127 if exists then summariseFile hsc_env file maybe_buf else do
1128 throwDyn (CmdLineError ("can't find file: " ++ file))
1129 getRootSummary (Target (TargetModule modl) maybe_buf)
1130 = do maybe_summary <- summarise hsc_env emptyNodeMap Nothing False
1131 modl maybe_buf excl_mods
1132 case maybe_summary of
1133 Nothing -> packageModErr modl
1136 -- In a root module, the filename is allowed to diverge from the module
1137 -- name, so we have to check that there aren't multiple root files
1138 -- defining the same module (otherwise the duplicates will be silently
1139 -- ignored, leading to confusing behaviour).
1140 checkDuplicates :: [ModSummary] -> IO ()
1141 checkDuplicates summaries = mapM_ check summaries
1146 many -> multiRootsErr modl many
1147 where modl = ms_mod summ
1149 [ expectJust "checkDup" (ml_hs_file (ms_location summ'))
1150 | summ' <- summaries, ms_mod summ' == modl ]
1152 loop :: [(FilePath,Module,IsBootInterface)]
1153 -- Work list: process these modules
1154 -> NodeMap ModSummary
1157 -- The result includes the worklist, except
1158 -- for those mentioned in the visited set
1159 loop [] done = return (nodeMapElts done)
1160 loop ((cur_path, wanted_mod, is_boot) : ss) done
1161 | key `elemFM` done = loop ss done
1162 | otherwise = do { mb_s <- summarise hsc_env old_summary_map
1163 (Just cur_path) is_boot
1164 wanted_mod Nothing excl_mods
1166 Nothing -> loop ss done
1167 Just s -> loop (msDeps s ++ ss)
1168 (addToFM done key s) }
1170 key = (wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1172 msDeps :: ModSummary -> [(FilePath, -- Importing module
1173 Module, -- Imported module
1174 IsBootInterface)] -- {-# SOURCE #-} import or not
1175 -- (msDeps s) returns the dependencies of the ModSummary s.
1176 -- A wrinkle is that for a {-# SOURCE #-} import we return
1177 -- *both* the hs-boot file
1178 -- *and* the source file
1179 -- as "dependencies". That ensures that the list of all relevant
1180 -- modules always contains B.hs if it contains B.hs-boot.
1181 -- Remember, this pass isn't doing the topological sort. It's
1182 -- just gathering the list of all relevant ModSummaries
1183 msDeps s = concat [ [(f, m, True), (f,m,False)] | m <- ms_srcimps s]
1184 ++ [(f,m,False) | m <- ms_imps s]
1186 f = msHsFilePath s -- Keep the importing module for error reporting
1189 -----------------------------------------------------------------------------
1190 -- Summarising modules
1192 -- We have two types of summarisation:
1194 -- * Summarise a file. This is used for the root module(s) passed to
1195 -- cmLoadModules. The file is read, and used to determine the root
1196 -- module name. The module name may differ from the filename.
1198 -- * Summarise a module. We are given a module name, and must provide
1199 -- a summary. The finder is used to locate the file in which the module
1202 summariseFile :: HscEnv -> FilePath
1203 -> Maybe (StringBuffer,ClockTime)
1205 -- Used for Haskell source only, I think
1206 -- We know the file name, and we know it exists,
1207 -- but we don't necessarily know the module name (might differ)
1208 summariseFile hsc_env file maybe_buf
1209 = do let dflags = hsc_dflags hsc_env
1211 (dflags', hspp_fn, buf)
1212 <- preprocessFile dflags file maybe_buf
1214 (srcimps,the_imps,mod) <- getImports dflags' buf hspp_fn
1216 -- Make a ModLocation for this file
1217 location <- mkHomeModLocation dflags mod file
1219 -- Tell the Finder cache where it is, so that subsequent calls
1220 -- to findModule will find it, even if it's not on any search path
1221 addHomeModuleToFinder hsc_env mod location
1223 src_timestamp <- case maybe_buf of
1224 Just (_,t) -> return t
1225 Nothing -> getModificationTime file
1227 obj_timestamp <- modificationTimeIfExists (ml_obj_file location)
1229 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1230 ms_location = location,
1231 ms_hspp_file = Just hspp_fn,
1232 ms_hspp_buf = Just buf,
1233 ms_srcimps = srcimps, ms_imps = the_imps,
1234 ms_hs_date = src_timestamp,
1235 ms_obj_date = obj_timestamp })
1237 -- Summarise a module, and pick up source and timestamp.
1239 -> NodeMap ModSummary -- Map of old summaries
1240 -> Maybe FilePath -- Importing module (for error messages)
1241 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
1242 -> Module -- Imported module to be summarised
1243 -> Maybe (StringBuffer, ClockTime)
1244 -> [Module] -- Modules to exclude
1245 -> IO (Maybe ModSummary) -- Its new summary
1247 summarise hsc_env old_summary_map cur_mod is_boot wanted_mod maybe_buf excl_mods
1248 | wanted_mod `elem` excl_mods
1251 | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
1252 = do -- Find its new timestamp; all the
1253 -- ModSummaries in the old map have valid ml_hs_files
1254 let location = ms_location old_summary
1255 src_fn = expectJust "summarise" (ml_hs_file location)
1257 -- return the cached summary if the source didn't change
1258 src_timestamp <- case maybe_buf of
1259 Just (_,t) -> return t
1260 Nothing -> getModificationTime src_fn
1262 if ms_hs_date old_summary == src_timestamp
1263 then do -- update the object-file timestamp
1264 obj_timestamp <- getObjTimestamp location is_boot
1265 return (Just old_summary{ ms_obj_date = obj_timestamp })
1267 -- source changed: re-summarise
1268 new_summary location src_fn maybe_buf src_timestamp
1271 = do found <- findModule hsc_env wanted_mod True {-explicit-}
1274 | not (isHomePackage pkg) -> return Nothing
1275 -- Drop external-pkg
1276 | isJust (ml_hs_file location) -> just_found location
1278 err -> noModError dflags cur_mod wanted_mod err
1281 dflags = hsc_dflags hsc_env
1283 hsc_src = if is_boot then HsBootFile else HsSrcFile
1285 just_found location = do
1286 -- Adjust location to point to the hs-boot source file,
1287 -- hi file, object file, when is_boot says so
1288 let location' | is_boot = addBootSuffixLocn location
1289 | otherwise = location
1290 src_fn = expectJust "summarise2" (ml_hs_file location')
1292 -- Check that it exists
1293 -- It might have been deleted since the Finder last found it
1294 maybe_t <- modificationTimeIfExists src_fn
1296 Nothing -> noHsFileErr cur_mod src_fn
1297 Just t -> new_summary location' src_fn Nothing t
1300 new_summary location src_fn maybe_bug src_timestamp
1302 -- Preprocess the source file and get its imports
1303 -- The dflags' contains the OPTIONS pragmas
1304 (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn maybe_buf
1305 (srcimps, the_imps, mod_name) <- getImports dflags' buf hspp_fn
1307 when (mod_name /= wanted_mod) $
1308 throwDyn (ProgramError
1309 (showSDoc (text src_fn
1310 <> text ": file name does not match module name"
1311 <+> quotes (ppr mod_name))))
1313 -- Find the object timestamp, and return the summary
1314 obj_timestamp <- getObjTimestamp location is_boot
1316 return (Just ( ModSummary { ms_mod = wanted_mod,
1317 ms_hsc_src = hsc_src,
1318 ms_location = location,
1319 ms_hspp_file = Just hspp_fn,
1320 ms_hspp_buf = Just buf,
1321 ms_srcimps = srcimps,
1323 ms_hs_date = src_timestamp,
1324 ms_obj_date = obj_timestamp }))
1327 getObjTimestamp location is_boot
1328 = if is_boot then return Nothing
1329 else modificationTimeIfExists (ml_obj_file location)
1332 preprocessFile :: DynFlags -> FilePath -> Maybe (StringBuffer,ClockTime)
1333 -> IO (DynFlags, FilePath, StringBuffer)
1334 preprocessFile dflags src_fn Nothing
1336 (dflags', hspp_fn) <- preprocess dflags src_fn
1337 buf <- hGetStringBuffer hspp_fn
1338 return (dflags', hspp_fn, buf)
1340 preprocessFile dflags src_fn (Just (buf, time))
1342 -- case we bypass the preprocessing stage?
1344 local_opts = getOptionsFromStringBuffer buf
1346 (dflags', errs) <- parseDynamicFlags dflags local_opts
1350 | Unlit _ <- startPhase src_fn = True
1351 -- note: local_opts is only required if there's no Unlit phase
1352 | dopt Opt_Cpp dflags' = True
1353 | dopt Opt_Pp dflags' = True
1356 when needs_preprocessing $
1357 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
1359 return (dflags', "<buffer>", buf)
1362 -----------------------------------------------------------------------------
1364 -----------------------------------------------------------------------------
1366 noModError :: DynFlags -> Maybe FilePath -> Module -> FindResult -> IO ab
1367 -- ToDo: we don't have a proper line number for this error
1368 noModError dflags cur_mod wanted_mod err
1369 = throwDyn $ ProgramError $ showSDoc $
1370 vcat [cantFindError dflags wanted_mod err,
1371 nest 2 (parens (pp_where cur_mod))]
1373 noHsFileErr cur_mod path
1374 = throwDyn $ CmdLineError $ showSDoc $
1375 vcat [text "Can't find" <+> text path,
1376 nest 2 (parens (pp_where cur_mod))]
1378 pp_where Nothing = text "one of the roots of the dependency analysis"
1379 pp_where (Just p) = text "imported from" <+> text p
1382 = throwDyn (CmdLineError (showSDoc (text "module" <+>
1383 quotes (ppr mod) <+>
1384 text "is a package module")))
1386 multiRootsErr mod files
1387 = throwDyn (ProgramError (showSDoc (
1388 text "module" <+> quotes (ppr mod) <+>
1389 text "is defined in multiple files:" <+>
1390 sep (map text files))))
1392 cyclicModuleErr :: [ModSummary] -> SDoc
1394 = hang (ptext SLIT("Module imports form a cycle for modules:"))
1395 2 (vcat (map show_one ms))
1397 show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
1398 nest 2 $ ptext SLIT("imports:") <+>
1399 (pp_imps HsBootFile (ms_srcimps ms)
1400 $$ pp_imps HsSrcFile (ms_imps ms))]
1401 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
1402 pp_imps src mods = fsep (map (show_mod src) mods)
1405 -- | Inform GHC that the working directory has changed. GHC will flush
1406 -- its cache of module locations, since it may no longer be valid.
1407 -- Note: if you change the working directory, you should also unload
1408 -- the current program (set targets to empty, followed by load).
1409 workingDirectoryChanged :: Session -> IO ()
1410 workingDirectoryChanged s = withSession s $ \hsc_env ->
1411 flushFinderCache (hsc_FC hsc_env)
1413 -- -----------------------------------------------------------------------------
1414 -- inspecting the session
1416 -- | Get the module dependency graph.
1417 getModuleGraph :: Session -> IO ModuleGraph -- ToDo: DiGraph ModSummary
1418 getModuleGraph s = withSession s (return . hsc_mod_graph)
1420 isLoaded :: Session -> Module -> IO Bool
1421 isLoaded s m = withSession s $ \hsc_env ->
1422 return $! isJust (lookupModuleEnv (hsc_HPT hsc_env) m)
1424 getBindings :: Session -> IO [TyThing]
1425 getBindings s = withSession s (return . nameEnvElts . ic_type_env . hsc_IC)
1427 getPrintUnqual :: Session -> IO PrintUnqualified
1428 getPrintUnqual s = withSession s (return . icPrintUnqual . hsc_IC)
1431 getModuleInfo :: Session -> Module -> IO ModuleInfo
1435 | BinaryCode FilePath
1437 data ModuleInfo = ModuleInfo {
1438 lm_modulename :: Module,
1439 lm_summary :: ModSummary,
1440 lm_interface :: ModIface,
1441 lm_tc_code :: Maybe TypecheckedCode,
1442 lm_rn_code :: Maybe RenamedCode,
1443 lm_obj :: Maybe ObjectCode
1446 type TypecheckedCode = HsTypecheckedGroup
1447 type RenamedCode = [HsGroup Name]
1449 -- ToDo: typechecks abstract syntax or renamed abstract syntax. Issues:
1450 -- - typechecked syntax includes extra dictionary translation and
1451 -- AbsBinds which need to be translated back into something closer to
1452 -- the original source.
1453 -- - renamed syntax currently doesn't exist in a single blob, since
1454 -- renaming and typechecking are interleaved at splice points. We'd
1455 -- need a restriction that there are no splices in the source module.
1458 -- - Data and Typeable instances for HsSyn.
1461 -- - things that aren't in the output of the renamer:
1462 -- - the export list
1466 -- - things that aren't in the output of the typechecker right now:
1467 -- - the export list
1469 -- - type signatures
1470 -- - type/data/newtype declarations
1471 -- - class declarations
1473 -- - extra things in the typechecker's output:
1474 -- - default methods are turned into top-level decls.
1475 -- - dictionary bindings
1477 -- ToDo: check for small transformations that happen to the syntax in
1478 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
1480 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
1481 -- to get from TyCons, Ids etc. to TH syntax (reify).
1483 -- :browse will use either lm_toplev or inspect lm_interface, depending
1484 -- on whether the module is interpreted or not.
1486 -- various abstract syntax types (perhaps IfaceBlah)
1490 -- This is for reconstructing refactored source code
1491 -- Calls the lexer repeatedly.
1492 -- ToDo: add comment tokens to token stream
1493 getTokenStream :: Session -> Module -> IO [Located Token]
1496 -- -----------------------------------------------------------------------------
1497 -- Interactive evaluation
1501 -- | Set the interactive evaluation context.
1503 -- Setting the context doesn't throw away any bindings; the bindings
1504 -- we've built up in the InteractiveContext simply move to the new
1505 -- module. They always shadow anything in scope in the current context.
1506 setContext :: Session
1507 -> [Module] -- entire top level scope of these modules
1508 -> [Module] -- exports only of these modules
1510 setContext (Session ref) toplevs exports = do
1511 hsc_env <- readIORef ref
1512 let old_ic = hsc_IC hsc_env
1513 hpt = hsc_HPT hsc_env
1515 mapM_ (checkModuleExists hsc_env hpt) exports
1516 export_env <- mkExportEnv hsc_env exports
1517 toplev_envs <- mapM (mkTopLevEnv hpt) toplevs
1518 let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
1519 writeIORef ref hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplevs,
1520 ic_exports = exports,
1521 ic_rn_gbl_env = all_env } }
1523 checkModuleExists :: HscEnv -> HomePackageTable -> Module -> IO ()
1524 checkModuleExists hsc_env hpt mod =
1525 case lookupModuleEnv hpt mod of
1526 Just mod_info -> return ()
1527 _not_a_home_module -> do
1528 res <- findPackageModule hsc_env mod True
1530 Found _ _ -> return ()
1531 err -> let msg = cantFindError (hsc_dflags hsc_env) mod err in
1532 throwDyn (CmdLineError (showSDoc msg))
1534 mkTopLevEnv :: HomePackageTable -> Module -> IO GlobalRdrEnv
1535 mkTopLevEnv hpt modl
1536 = case lookupModuleEnv hpt modl of
1538 throwDyn (ProgramError ("mkTopLevEnv: not a home module "
1539 ++ showSDoc (pprModule modl)))
1541 case mi_globals (hm_iface details) of
1543 throwDyn (ProgramError ("mkTopLevEnv: not interpreted "
1544 ++ showSDoc (pprModule modl)))
1545 Just env -> return env
1547 -- | Get the interactive evaluation context, consisting of a pair of the
1548 -- set of modules from which we take the full top-level scope, and the set
1549 -- of modules from which we take just the exports respectively.
1550 getContext :: Session -> IO ([Module],[Module])
1551 getContext s = withSession s (\HscEnv{ hsc_IC=ic } ->
1552 return (ic_toplev_scope ic, ic_exports ic))
1554 -- | Returns 'True' if the specified module is interpreted, and hence has
1555 -- its full top-level scope available.
1556 moduleIsInterpreted :: Session -> Module -> IO Bool
1557 moduleIsInterpreted s modl = withSession s $ \h ->
1558 case lookupModuleEnv (hsc_HPT h) modl of
1559 Just details -> return (isJust (mi_globals (hm_iface details)))
1560 _not_a_home_module -> return False
1562 -- | Looks up an identifier in the current interactive context (for :info)
1563 getInfo :: Session -> String -> IO [GetInfoResult]
1564 getInfo s id = withSession s $ \hsc_env -> hscGetInfo hsc_env id
1566 -- -----------------------------------------------------------------------------
1567 -- Getting the type of an expression
1569 -- | Get the type of an expression
1570 exprType :: Session -> String -> IO (Maybe Type)
1571 exprType s expr = withSession s $ \hsc_env -> do
1572 maybe_stuff <- hscTcExpr hsc_env expr
1574 Nothing -> return Nothing
1575 Just ty -> return (Just tidy_ty)
1577 tidy_ty = tidyType emptyTidyEnv ty
1578 dflags = hsc_dflags hsc_env
1580 -- -----------------------------------------------------------------------------
1581 -- Getting the kind of a type
1583 -- | Get the kind of a type
1584 typeKind :: Session -> String -> IO (Maybe Kind)
1585 typeKind s str = withSession s $ \hsc_env -> do
1586 maybe_stuff <- hscKcType hsc_env str
1588 Nothing -> return Nothing
1589 Just kind -> return (Just kind)
1591 -----------------------------------------------------------------------------
1592 -- lookupName: returns the TyThing for a Name in the interactive context.
1593 -- ToDo: should look it up in the full environment
1595 lookupName :: Session -> Name -> IO (Maybe TyThing)
1596 lookupName s name = withSession s $ \hsc_env -> do
1597 return $! lookupNameEnv (ic_type_env (hsc_IC hsc_env)) name
1599 -----------------------------------------------------------------------------
1600 -- cmCompileExpr: compile an expression and deliver an HValue
1602 compileExpr :: Session -> String -> IO (Maybe HValue)
1603 compileExpr s expr = withSession s $ \hsc_env -> do
1604 maybe_stuff <- hscStmt hsc_env ("let __cmCompileExpr = "++expr)
1606 Nothing -> return Nothing
1607 Just (new_ic, names, hval) -> do
1609 hvals <- (unsafeCoerce# hval) :: IO [HValue]
1611 case (names,hvals) of
1612 ([n],[hv]) -> return (Just hv)
1613 _ -> panic "compileExpr"
1615 -- -----------------------------------------------------------------------------
1616 -- running a statement interactively
1619 = RunOk [Name] -- ^ names bound by this evaluation
1620 | RunFailed -- ^ statement failed compilation
1621 | RunException Exception -- ^ statement raised an exception
1623 -- | Run a statement in the current interactive context. Statemenet
1624 -- may bind multple values.
1625 runStmt :: Session -> String -> IO RunResult
1626 runStmt (Session ref) expr
1628 hsc_env <- readIORef ref
1630 -- Turn off -fwarn-unused-bindings when running a statement, to hide
1631 -- warnings about the implicit bindings we introduce.
1632 let dflags' = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
1633 hsc_env' = hsc_env{ hsc_dflags = dflags' }
1635 maybe_stuff <- hscStmt hsc_env' expr
1638 Nothing -> return RunFailed
1639 Just (new_hsc_env, names, hval) -> do
1641 let thing_to_run = unsafeCoerce# hval :: IO [HValue]
1642 either_hvals <- sandboxIO thing_to_run
1644 case either_hvals of
1646 -- on error, keep the *old* interactive context,
1647 -- so that 'it' is not bound to something
1648 -- that doesn't exist.
1649 return (RunException e)
1652 -- Get the newly bound things, and bind them.
1653 -- Don't need to delete any shadowed bindings;
1654 -- the new ones override the old ones.
1655 extendLinkEnv (zip names hvals)
1657 writeIORef ref new_hsc_env
1658 return (RunOk names)
1661 -- We run the statement in a "sandbox" to protect the rest of the
1662 -- system from anything the expression might do. For now, this
1663 -- consists of just wrapping it in an exception handler, but see below
1664 -- for another version.
1666 sandboxIO :: IO a -> IO (Either Exception a)
1667 sandboxIO thing = Exception.try thing
1670 -- This version of sandboxIO runs the expression in a completely new
1671 -- RTS main thread. It is disabled for now because ^C exceptions
1672 -- won't be delivered to the new thread, instead they'll be delivered
1673 -- to the (blocked) GHCi main thread.
1675 -- SLPJ: when re-enabling this, reflect a wrong-stat error as an exception
1677 sandboxIO :: IO a -> IO (Either Int (Either Exception a))
1678 sandboxIO thing = do
1679 st_thing <- newStablePtr (Exception.try thing)
1680 alloca $ \ p_st_result -> do
1681 stat <- rts_evalStableIO st_thing p_st_result
1682 freeStablePtr st_thing
1684 then do st_result <- peek p_st_result
1685 result <- deRefStablePtr st_result
1686 freeStablePtr st_result
1687 return (Right result)
1689 return (Left (fromIntegral stat))
1691 foreign import "rts_evalStableIO" {- safe -}
1692 rts_evalStableIO :: StablePtr (IO a) -> Ptr (StablePtr a) -> IO CInt
1693 -- more informative than the C type!
1696 -- ---------------------------------------------------------------------------
1697 -- cmBrowseModule: get all the TyThings defined in a module
1699 browseModule :: Session -> Module -> Bool -> IO [IfaceDecl]
1700 browseModule s modl exports_only = withSession s $ \hsc_env -> do
1701 mb_decls <- getModuleContents hsc_env modl exports_only
1703 Nothing -> return [] -- An error of some kind
1704 Just ds -> return ds
1707 -----------------------------------------------------------------------------
1708 -- show a module and it's source/object filenames
1710 showModule :: Session -> ModSummary -> IO String
1711 showModule s mod_summary = withSession s $ \hsc_env -> do
1712 case lookupModuleEnv (hsc_HPT hsc_env) (ms_mod mod_summary) of
1713 Nothing -> panic "missing linkable"
1714 Just mod_info -> return (showModMsg obj_linkable mod_summary)
1716 obj_linkable = isObjectLinkable (fromJust (hm_linkable mod_info))