1 -- -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow, 2005
7 -- -----------------------------------------------------------------------------
13 defaultCleanupHandler,
17 -- * Flags and settings
18 DynFlags(..), DynFlag(..), Severity(..), GhcMode(..), HscTarget(..), dopt,
25 Target(..), TargetId(..), Phase,
32 -- * Loading\/compiling the program
34 load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
35 workingDirectoryChanged,
36 checkModule, CheckedModule(..),
37 TypecheckedSource, ParsedSource, RenamedSource,
39 -- * Inspecting the module structure of the program
40 ModuleGraph, ModSummary(..),
45 -- * Inspecting modules
50 modInfoPrintUnqualified,
53 modInfoIsExportedName,
58 PrintUnqualified, alwaysQualify,
60 -- * Interactive evaluation
61 getBindings, getPrintUnqual,
63 setContext, getContext,
77 -- * Abstract syntax elements
80 Module, mkModule, pprModule,
84 nameModule, nameParent_maybe, pprParenSymName, nameSrcLoc,
89 isImplicitId, isDeadBinder,
90 isExportedId, isLocalId, isGlobalId,
92 isPrimOpId, isFCallId, isClassOpId_maybe,
93 isDataConWorkId, idDataCon,
94 isBottomingId, isDictonaryId,
95 recordSelectorFieldLabel,
97 -- ** Type constructors
99 tyConTyVars, tyConDataCons, tyConArity,
100 isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
107 -- ** Data constructors
109 dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
110 dataConIsInfix, isVanillaDataCon,
112 StrictnessMark(..), isMarkedStrict,
116 classMethods, classSCTheta, classTvsFds,
121 instanceDFunId, pprInstance, pprInstanceHdr,
123 -- ** Types and Kinds
124 Type, dropForAlls, splitForAllTys, funResultTy, pprParendType,
127 ThetaType, pprThetaArrow,
133 module HsSyn, -- ToDo: remove extraneous bits
137 defaultFixity, maxPrecedence,
141 -- ** Source locations
145 GhcException(..), showGhcException,
155 * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
156 * we need to expose DynFlags, so should parseDynamicFlags really be
157 part of this interface?
158 * what StaticFlags should we expose, if any?
161 #include "HsVersions.h"
164 import qualified Linker
165 import Linker ( HValue, extendLinkEnv )
166 import TcRnDriver ( tcRnLookupRdrName, tcRnGetInfo,
167 tcRnLookupName, getModuleExports )
168 import RdrName ( plusGlobalRdrEnv, Provenance(..),
169 ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
170 emptyGlobalRdrEnv, mkGlobalRdrEnv )
171 import HscMain ( hscParseIdentifier, hscStmt, hscTcExpr, hscKcType )
172 import Type ( tidyType )
173 import VarEnv ( emptyTidyEnv )
174 import GHC.Exts ( unsafeCoerce# )
177 import Packages ( initPackages )
178 import NameSet ( NameSet, nameSetToList, elemNameSet )
179 import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName,
182 import Type ( Kind, Type, dropForAlls, PredType, ThetaType,
183 pprThetaArrow, pprParendType, splitForAllTys,
185 import Id ( Id, idType, isImplicitId, isDeadBinder,
186 isExportedId, isLocalId, isGlobalId,
187 isRecordSelector, recordSelectorFieldLabel,
188 isPrimOpId, isFCallId, isClassOpId_maybe,
189 isDataConWorkId, idDataCon,
192 import TysPrim ( alphaTyVars )
193 import TyCon ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon,
194 isPrimTyCon, tyConArity,
195 tyConTyVars, tyConDataCons, getSynTyConDefn )
196 import Class ( Class, classSCTheta, classTvsFds, classMethods )
197 import FunDeps ( pprFundeps )
198 import DataCon ( DataCon, dataConWrapId, dataConSig, dataConTyCon,
199 dataConFieldLabels, dataConStrictMarks,
200 dataConIsInfix, isVanillaDataCon )
201 import Name ( Name, nameModule, NamedThing(..), nameParent_maybe,
203 import OccName ( parenSymOcc )
204 import NameEnv ( nameEnvElts )
205 import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr )
207 import DriverPipeline
208 import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase )
209 import GetImports ( getImports )
210 import Packages ( isHomePackage )
212 import HscMain ( newHscEnv, hscFileCheck, HscResult(..) )
216 import SysTools ( initSysTools, cleanTempFiles )
221 import Bag ( unitBag )
222 import ErrUtils ( Severity(..), showPass, Messages, fatalErrorMsg, debugTraceMsg,
223 mkPlainErrMsg, printBagOfErrors, printErrorsAndWarnings )
224 import qualified ErrUtils
225 import PrelNames ( mAIN )
227 import StringBuffer ( StringBuffer, hGetStringBuffer )
229 import SysTools ( cleanTempFilesExcept )
231 import TcType ( tcSplitSigmaTy, isDictTy )
232 import FastString ( mkFastString )
234 import Directory ( getModificationTime, doesFileExist )
235 import Maybe ( isJust, isNothing, fromJust )
236 import Maybes ( orElse, expectJust, mapCatMaybes )
237 import List ( partition, nub )
238 import qualified List
239 import Monad ( unless, when )
240 import System ( exitWith, ExitCode(..) )
241 import Time ( ClockTime )
242 import EXCEPTION as Exception hiding (handle)
245 import Prelude hiding (init)
247 -- -----------------------------------------------------------------------------
248 -- Exception handlers
250 -- | Install some default exception handlers and run the inner computation.
251 -- Unless you want to handle exceptions yourself, you should wrap this around
252 -- the top level of your program. The default handlers output the error
253 -- message(s) to stderr and exit cleanly.
254 defaultErrorHandler :: DynFlags -> IO a -> IO a
255 defaultErrorHandler dflags inner =
256 -- top-level exception handler: any unrecognised exception is a compiler bug.
257 handle (\exception -> do
260 -- an IO exception probably isn't our fault, so don't panic
262 fatalErrorMsg dflags (text (show exception))
263 AsyncException StackOverflow ->
264 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
266 fatalErrorMsg dflags (text (show (Panic (show exception))))
267 exitWith (ExitFailure 1)
270 -- program errors: messages with locations attached. Sometimes it is
271 -- convenient to just throw these as exceptions.
272 handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
273 exitWith (ExitFailure 1)) $
275 -- error messages propagated as exceptions
276 handleDyn (\dyn -> do
279 PhaseFailed _ code -> exitWith code
280 Interrupted -> exitWith (ExitFailure 1)
281 _ -> do fatalErrorMsg dflags (text (show (dyn :: GhcException)))
282 exitWith (ExitFailure 1)
286 -- | Install a default cleanup handler to remove temporary files
287 -- deposited by a GHC run. This is seperate from
288 -- 'defaultErrorHandler', because you might want to override the error
289 -- handling, but still get the ordinary cleanup behaviour.
290 defaultCleanupHandler :: DynFlags -> IO a -> IO a
291 defaultCleanupHandler dflags inner =
292 -- make sure we clean up after ourselves
293 later (unless (dopt Opt_KeepTmpFiles dflags) $
294 cleanTempFiles dflags)
295 -- exceptions will be blocked while we clean the temporary files,
296 -- so there shouldn't be any difficulty if we receive further
301 -- | Initialises GHC. This must be done /once/ only. Takes the
302 -- command-line arguments. All command-line arguments which aren't
303 -- understood by GHC will be returned.
305 init :: [String] -> IO [String]
308 installSignalHandlers
310 -- Grab the -B option if there is one
311 let (minusB_args, argv1) = partition (prefixMatch "-B") args
312 dflags0 <- initSysTools minusB_args defaultDynFlags
313 writeIORef v_initDynFlags dflags0
315 -- Parse the static flags
316 argv2 <- parseStaticFlags argv1
319 GLOBAL_VAR(v_initDynFlags, error "initDynFlags", DynFlags)
320 -- stores the DynFlags between the call to init and subsequent
321 -- calls to newSession.
323 -- | Starts a new session. A session consists of a set of loaded
324 -- modules, a set of options (DynFlags), and an interactive context.
325 -- ToDo: GhcMode should say "keep typechecked code" and\/or "keep renamed
327 newSession :: GhcMode -> IO Session
329 dflags0 <- readIORef v_initDynFlags
330 dflags <- initDynFlags dflags0
331 env <- newHscEnv dflags{ ghcMode=mode }
335 -- tmp: this breaks the abstraction, but required because DriverMkDepend
336 -- needs to call the Finder. ToDo: untangle this.
337 sessionHscEnv :: Session -> IO HscEnv
338 sessionHscEnv (Session ref) = readIORef ref
340 withSession :: Session -> (HscEnv -> IO a) -> IO a
341 withSession (Session ref) f = do h <- readIORef ref; f h
343 modifySession :: Session -> (HscEnv -> HscEnv) -> IO ()
344 modifySession (Session ref) f = do h <- readIORef ref; writeIORef ref $! f h
346 -- -----------------------------------------------------------------------------
349 -- | Grabs the DynFlags from the Session
350 getSessionDynFlags :: Session -> IO DynFlags
351 getSessionDynFlags s = withSession s (return . hsc_dflags)
353 -- | Updates the DynFlags in a Session
354 setSessionDynFlags :: Session -> DynFlags -> IO ()
355 setSessionDynFlags s dflags = modifySession s (\h -> h{ hsc_dflags = dflags })
357 -- | If there is no -o option, guess the name of target executable
358 -- by using top-level source file name as a base.
359 guessOutputFile :: Session -> IO ()
360 guessOutputFile s = modifySession s $ \env ->
361 let dflags = hsc_dflags env
362 mod_graph = hsc_mod_graph env
363 mainModuleSrcPath, guessedName :: Maybe String
364 mainModuleSrcPath = do
365 let isMain = (== mainModIs dflags) . ms_mod
366 [ms] <- return (filter isMain mod_graph)
367 ml_hs_file (ms_location ms)
368 #if defined(mingw32_HOST_OS)
369 guessedName = fmap (\fname -> basenameOf fname `joinFileExt` "exe") mainModuleSrcPath
371 guessedName = fmap basenameOf mainModuleSrcPath
374 case outputFile dflags of
376 Nothing -> env { hsc_dflags = dflags { outputFile = guessedName } }
378 -- -----------------------------------------------------------------------------
381 -- ToDo: think about relative vs. absolute file paths. And what
382 -- happens when the current directory changes.
384 -- | Sets the targets for this session. Each target may be a module name
385 -- or a filename. The targets correspond to the set of root modules for
386 -- the program\/library. Unloading the current program is achieved by
387 -- setting the current set of targets to be empty, followed by load.
388 setTargets :: Session -> [Target] -> IO ()
389 setTargets s targets = modifySession s (\h -> h{ hsc_targets = targets })
391 -- | returns the current set of targets
392 getTargets :: Session -> IO [Target]
393 getTargets s = withSession s (return . hsc_targets)
395 -- | Add another target
396 addTarget :: Session -> Target -> IO ()
398 = modifySession s (\h -> h{ hsc_targets = target : hsc_targets h })
401 removeTarget :: Session -> TargetId -> IO ()
402 removeTarget s target_id
403 = modifySession s (\h -> h{ hsc_targets = filter (hsc_targets h) })
405 filter targets = [ t | t@(Target id _) <- targets, id /= target_id ]
407 -- Attempts to guess what Target a string refers to. This function implements
408 -- the --make/GHCi command-line syntax for filenames:
410 -- - if the string looks like a Haskell source filename, then interpret
412 -- - if adding a .hs or .lhs suffix yields the name of an existing file,
414 -- - otherwise interpret the string as a module name
416 guessTarget :: String -> Maybe Phase -> IO Target
417 guessTarget file (Just phase)
418 = return (Target (TargetFile file (Just phase)) Nothing)
419 guessTarget file Nothing
420 | isHaskellSrcFilename file
421 = return (Target (TargetFile file Nothing) Nothing)
423 = do exists <- doesFileExist hs_file
425 then return (Target (TargetFile hs_file Nothing) Nothing)
427 exists <- doesFileExist lhs_file
429 then return (Target (TargetFile lhs_file Nothing) Nothing)
431 return (Target (TargetModule (mkModule file)) Nothing)
433 hs_file = file `joinFileExt` "hs"
434 lhs_file = file `joinFileExt` "lhs"
436 -- -----------------------------------------------------------------------------
437 -- Loading the program
439 -- Perform a dependency analysis starting from the current targets
440 -- and update the session with the new module graph.
441 depanal :: Session -> [Module] -> Bool -> IO (Maybe ModuleGraph)
442 depanal (Session ref) excluded_mods allow_dup_roots = do
443 hsc_env <- readIORef ref
445 dflags = hsc_dflags hsc_env
446 gmode = ghcMode (hsc_dflags hsc_env)
447 targets = hsc_targets hsc_env
448 old_graph = hsc_mod_graph hsc_env
450 showPass dflags "Chasing dependencies"
451 when (gmode == BatchCompile) $
452 debugTraceMsg dflags 1 (hcat [
453 text "Chasing modules from: ",
454 hcat (punctuate comma (map pprTarget targets))])
456 r <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
458 Just mod_graph -> writeIORef ref hsc_env{ hsc_mod_graph = mod_graph }
463 -- | The result of load.
465 = LoadOk Errors -- ^ all specified targets were loaded successfully.
466 | LoadFailed Errors -- ^ not all modules were loaded.
468 type Errors = [String]
470 data ErrMsg = ErrMsg {
471 errMsgSeverity :: Severity, -- warning, error, etc.
472 errMsgSpans :: [SrcSpan],
473 errMsgShortDoc :: Doc,
474 errMsgExtraInfo :: Doc
481 | LoadDependenciesOf Module
483 -- | Try to load the program. If a Module is supplied, then just
484 -- attempt to load up to this target. If no Module is supplied,
485 -- then try to load all targets.
486 load :: Session -> LoadHowMuch -> IO SuccessFlag
487 load s@(Session ref) how_much
489 -- Dependency analysis first. Note that this fixes the module graph:
490 -- even if we don't get a fully successful upsweep, the full module
491 -- graph is still retained in the Session. We can tell which modules
492 -- were successfully loaded by inspecting the Session's HPT.
493 mb_graph <- depanal s [] False
495 Just mod_graph -> load2 s how_much mod_graph
496 Nothing -> return Failed
498 load2 s@(Session ref) how_much mod_graph = do
500 hsc_env <- readIORef ref
502 let hpt1 = hsc_HPT hsc_env
503 let dflags = hsc_dflags hsc_env
504 let ghci_mode = ghcMode dflags -- this never changes
506 -- The "bad" boot modules are the ones for which we have
507 -- B.hs-boot in the module graph, but no B.hs
508 -- The downsweep should have ensured this does not happen
510 let all_home_mods = [ms_mod s | s <- mod_graph, not (isBootSummary s)]
512 bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
513 not (ms_mod s `elem` all_home_mods)]
515 ASSERT( null bad_boot_mods ) return ()
517 -- mg2_with_srcimps drops the hi-boot nodes, returning a
518 -- graph with cycles. Among other things, it is used for
519 -- backing out partially complete cycles following a failed
520 -- upsweep, and for removing from hpt all the modules
521 -- not in strict downwards closure, during calls to compile.
522 let mg2_with_srcimps :: [SCC ModSummary]
523 mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
525 -- check the stability property for each module.
526 stable_mods@(stable_obj,stable_bco)
527 | BatchCompile <- ghci_mode = ([],[])
528 | otherwise = checkStability hpt1 mg2_with_srcimps all_home_mods
530 -- prune bits of the HPT which are definitely redundant now,
532 pruned_hpt = pruneHomePackageTable hpt1
533 (flattenSCCs mg2_with_srcimps)
538 debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
539 text "Stable BCO:" <+> ppr stable_bco)
541 -- Unload any modules which are going to be re-linked this time around.
542 let stable_linkables = [ linkable
543 | m <- stable_obj++stable_bco,
544 Just hmi <- [lookupModuleEnv pruned_hpt m],
545 Just linkable <- [hm_linkable hmi] ]
546 unload hsc_env stable_linkables
548 -- We could at this point detect cycles which aren't broken by
549 -- a source-import, and complain immediately, but it seems better
550 -- to let upsweep_mods do this, so at least some useful work gets
551 -- done before the upsweep is abandoned.
552 --hPutStrLn stderr "after tsort:\n"
553 --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
555 -- Now do the upsweep, calling compile for each module in
556 -- turn. Final result is version 3 of everything.
558 -- Topologically sort the module graph, this time including hi-boot
559 -- nodes, and possibly just including the portion of the graph
560 -- reachable from the module specified in the 2nd argument to load.
561 -- This graph should be cycle-free.
562 -- If we're restricting the upsweep to a portion of the graph, we
563 -- also want to retain everything that is still stable.
564 let full_mg :: [SCC ModSummary]
565 full_mg = topSortModuleGraph False mod_graph Nothing
567 maybe_top_mod = case how_much of
569 LoadDependenciesOf m -> Just m
572 partial_mg0 :: [SCC ModSummary]
573 partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
575 -- LoadDependenciesOf m: we want the upsweep to stop just
576 -- short of the specified module (unless the specified module
579 | LoadDependenciesOf mod <- how_much
580 = ASSERT( case last partial_mg0 of
581 AcyclicSCC ms -> ms_mod ms == mod; _ -> False )
582 List.init partial_mg0
588 | AcyclicSCC ms <- full_mg,
589 ms_mod ms `elem` stable_obj++stable_bco,
590 ms_mod ms `notElem` [ ms_mod ms' |
591 AcyclicSCC ms' <- partial_mg ] ]
593 mg = stable_mg ++ partial_mg
595 -- clean up between compilations
596 let cleanup = cleanTempFilesExcept dflags
597 (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
599 (upsweep_ok, hsc_env1, modsUpswept)
600 <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
601 pruned_hpt stable_mods cleanup mg
603 -- Make modsDone be the summaries for each home module now
604 -- available; this should equal the domain of hpt3.
605 -- Get in in a roughly top .. bottom order (hence reverse).
607 let modsDone = reverse modsUpswept
609 -- Try and do linking in some form, depending on whether the
610 -- upsweep was completely or only partially successful.
612 if succeeded upsweep_ok
615 -- Easy; just relink it all.
616 do debugTraceMsg dflags 2 (text "Upsweep completely successful.")
618 -- Clean up after ourselves
619 cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
621 -- Issue a warning for the confusing case where the user
622 -- said '-o foo' but we're not going to do any linking.
623 -- We attempt linking if either (a) one of the modules is
624 -- called Main, or (b) the user said -no-hs-main, indicating
625 -- that main() is going to come from somewhere else.
627 let ofile = outputFile dflags
628 let no_hs_main = dopt Opt_NoHsMain dflags
630 main_mod = mainModIs dflags
631 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
632 do_linking = a_root_is_Main || no_hs_main
634 when (ghci_mode == BatchCompile && isJust ofile && not do_linking) $
635 debugTraceMsg dflags 1 (text ("Warning: output was redirected with -o, " ++
636 "but no output will be generated\n" ++
637 "because there is no " ++ moduleUserString main_mod ++ " module."))
639 -- link everything together
640 linkresult <- link ghci_mode dflags do_linking (hsc_HPT hsc_env1)
642 loadFinish Succeeded linkresult ref hsc_env1
645 -- Tricky. We need to back out the effects of compiling any
646 -- half-done cycles, both so as to clean up the top level envs
647 -- and to avoid telling the interactive linker to link them.
648 do debugTraceMsg dflags 2 (text "Upsweep partially successful.")
651 = map ms_mod modsDone
652 let mods_to_zap_names
653 = findPartiallyCompletedCycles modsDone_names
656 = filter ((`notElem` mods_to_zap_names).ms_mod)
659 let hpt4 = retainInTopLevelEnvs (map ms_mod mods_to_keep)
662 -- Clean up after ourselves
663 cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
665 -- there should be no Nothings where linkables should be, now
666 ASSERT(all (isJust.hm_linkable)
667 (moduleEnvElts (hsc_HPT hsc_env))) do
669 -- Link everything together
670 linkresult <- link ghci_mode dflags False hpt4
672 let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
673 loadFinish Failed linkresult ref hsc_env4
675 -- Finish up after a load.
677 -- If the link failed, unload everything and return.
678 loadFinish all_ok Failed ref hsc_env
679 = do unload hsc_env []
680 writeIORef ref $! discardProg hsc_env
683 -- Empty the interactive context and set the module context to the topmost
684 -- newly loaded module, or the Prelude if none were loaded.
685 loadFinish all_ok Succeeded ref hsc_env
686 = do writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
690 -- Forget the current program, but retain the persistent info in HscEnv
691 discardProg :: HscEnv -> HscEnv
693 = hsc_env { hsc_mod_graph = emptyMG,
694 hsc_IC = emptyInteractiveContext,
695 hsc_HPT = emptyHomePackageTable }
697 -- used to fish out the preprocess output files for the purposes of
698 -- cleaning up. The preprocessed file *might* be the same as the
699 -- source file, but that doesn't do any harm.
700 ppFilesFromSummaries summaries = [ fn | Just fn <- map ms_hspp_file summaries ]
702 -- -----------------------------------------------------------------------------
706 CheckedModule { parsedSource :: ParsedSource,
707 renamedSource :: Maybe RenamedSource,
708 typecheckedSource :: Maybe TypecheckedSource,
709 checkedModuleInfo :: Maybe ModuleInfo
711 -- ToDo: improvements that could be made here:
712 -- if the module succeeded renaming but not typechecking,
713 -- we can still get back the GlobalRdrEnv and exports, so
714 -- perhaps the ModuleInfo should be split up into separate
715 -- fields within CheckedModule.
717 type ParsedSource = Located (HsModule RdrName)
718 type RenamedSource = HsGroup Name
719 type TypecheckedSource = LHsBinds Id
722 -- - things that aren't in the output of the renamer:
725 -- - things that aren't in the output of the typechecker right now:
729 -- - type/data/newtype declarations
730 -- - class declarations
732 -- - extra things in the typechecker's output:
733 -- - default methods are turned into top-level decls.
734 -- - dictionary bindings
737 -- | This is the way to get access to parsed and typechecked source code
738 -- for a module. 'checkModule' loads all the dependencies of the specified
739 -- module in the Session, and then attempts to typecheck the module. If
740 -- successful, it returns the abstract syntax for the module.
741 checkModule :: Session -> Module -> IO (Maybe CheckedModule)
742 checkModule session@(Session ref) mod = do
743 -- load up the dependencies first
744 r <- load session (LoadDependenciesOf mod)
745 if (failed r) then return Nothing else do
747 -- now parse & typecheck the module
748 hsc_env <- readIORef ref
749 let mg = hsc_mod_graph hsc_env
750 case [ ms | ms <- mg, ms_mod ms == mod ] of
753 -- Add in the OPTIONS from the source file This is nasty:
754 -- we've done this once already, in the compilation manager
755 -- It might be better to cache the flags in the
756 -- ml_hspp_file field, say
757 let dflags0 = hsc_dflags hsc_env
758 hspp_buf = expectJust "GHC.checkModule" (ms_hspp_buf ms)
759 filename = fromJust (ml_hs_file (ms_location ms))
760 opts = getOptionsFromStringBuffer hspp_buf filename
761 (dflags1,leftovers) <- parseDynamicFlags dflags0 (map snd opts)
762 if (not (null leftovers))
763 then do printErrorsAndWarnings dflags1 (optionsErrorMsgs leftovers opts filename)
767 r <- hscFileCheck hsc_env{hsc_dflags=dflags1} ms
771 HscChecked parsed renamed Nothing ->
772 return (Just (CheckedModule {
773 parsedSource = parsed,
774 renamedSource = renamed,
775 typecheckedSource = Nothing,
776 checkedModuleInfo = Nothing }))
777 HscChecked parsed renamed
778 (Just (tc_binds, rdr_env, details)) -> do
779 let minf = ModuleInfo {
780 minf_type_env = md_types details,
781 minf_exports = md_exports details,
782 minf_rdr_env = Just rdr_env,
783 minf_instances = md_insts details
785 return (Just (CheckedModule {
786 parsedSource = parsed,
787 renamedSource = renamed,
788 typecheckedSource = Just tc_binds,
789 checkedModuleInfo = Just minf }))
793 -- ---------------------------------------------------------------------------
796 unload :: HscEnv -> [Linkable] -> IO ()
797 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
798 = case ghcMode (hsc_dflags hsc_env) of
799 BatchCompile -> return ()
800 JustTypecheck -> return ()
802 Interactive -> Linker.unload (hsc_dflags hsc_env) stable_linkables
804 Interactive -> panic "unload: no interpreter"
806 other -> panic "unload: strange mode"
808 -- -----------------------------------------------------------------------------
812 Stability tells us which modules definitely do not need to be recompiled.
813 There are two main reasons for having stability:
815 - avoid doing a complete upsweep of the module graph in GHCi when
816 modules near the bottom of the tree have not changed.
818 - to tell GHCi when it can load object code: we can only load object code
819 for a module when we also load object code fo all of the imports of the
820 module. So we need to know that we will definitely not be recompiling
821 any of these modules, and we can use the object code.
823 NB. stability is of no importance to BatchCompile at all, only Interactive.
824 (ToDo: what about JustTypecheck?)
826 The stability check is as follows. Both stableObject and
827 stableBCO are used during the upsweep phase later.
830 stable m = stableObject m || stableBCO m
833 all stableObject (imports m)
834 && old linkable does not exist, or is == on-disk .o
835 && date(on-disk .o) > date(.hs)
838 all stable (imports m)
839 && date(BCO) > date(.hs)
842 These properties embody the following ideas:
844 - if a module is stable:
845 - if it has been compiled in a previous pass (present in HPT)
846 then it does not need to be compiled or re-linked.
847 - if it has not been compiled in a previous pass,
848 then we only need to read its .hi file from disk and
849 link it to produce a ModDetails.
851 - if a modules is not stable, we will definitely be at least
852 re-linking, and possibly re-compiling it during the upsweep.
853 All non-stable modules can (and should) therefore be unlinked
856 - Note that objects are only considered stable if they only depend
857 on other objects. We can't link object code against byte code.
861 :: HomePackageTable -- HPT from last compilation
862 -> [SCC ModSummary] -- current module graph (cyclic)
863 -> [Module] -- all home modules
864 -> ([Module], -- stableObject
865 [Module]) -- stableBCO
867 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
869 checkSCC (stable_obj, stable_bco) scc0
870 | stableObjects = (scc_mods ++ stable_obj, stable_bco)
871 | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
872 | otherwise = (stable_obj, stable_bco)
874 scc = flattenSCC scc0
875 scc_mods = map ms_mod scc
876 home_module m = m `elem` all_home_mods && m `notElem` scc_mods
878 scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
879 -- all imports outside the current SCC, but in the home pkg
881 stable_obj_imps = map (`elem` stable_obj) scc_allimps
882 stable_bco_imps = map (`elem` stable_bco) scc_allimps
889 and (zipWith (||) stable_obj_imps stable_bco_imps)
893 | Just t <- ms_obj_date ms = t >= ms_hs_date ms
897 same_as_prev t = case lookupModuleEnv hpt (ms_mod ms) of
898 Just hmi | Just l <- hm_linkable hmi
899 -> isObjectLinkable l && t == linkableTime l
901 -- why '>=' rather than '>' above? If the filesystem stores
902 -- times to the nearset second, we may occasionally find that
903 -- the object & source have the same modification time,
904 -- especially if the source was automatically generated
905 -- and compiled. Using >= is slightly unsafe, but it matches
909 = case lookupModuleEnv hpt (ms_mod ms) of
910 Just hmi | Just l <- hm_linkable hmi ->
911 not (isObjectLinkable l) &&
912 linkableTime l >= ms_hs_date ms
915 ms_allimps :: ModSummary -> [Module]
916 ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
918 -- -----------------------------------------------------------------------------
919 -- Prune the HomePackageTable
921 -- Before doing an upsweep, we can throw away:
923 -- - For non-stable modules:
924 -- - all ModDetails, all linked code
925 -- - all unlinked code that is out of date with respect to
928 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
929 -- space at the end of the upsweep, because the topmost ModDetails of the
930 -- old HPT holds on to the entire type environment from the previous
933 pruneHomePackageTable
936 -> ([Module],[Module])
939 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
940 = mapModuleEnv prune hpt
942 | is_stable modl = hmi'
943 | otherwise = hmi'{ hm_details = emptyModDetails }
945 modl = mi_module (hm_iface hmi)
946 hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
947 = hmi{ hm_linkable = Nothing }
950 where ms = expectJust "prune" (lookupModuleEnv ms_map modl)
952 ms_map = mkModuleEnv [(ms_mod ms, ms) | ms <- summ]
954 is_stable m = m `elem` stable_obj || m `elem` stable_bco
956 -- -----------------------------------------------------------------------------
958 -- Return (names of) all those in modsDone who are part of a cycle
959 -- as defined by theGraph.
960 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
961 findPartiallyCompletedCycles modsDone theGraph
965 chew ((AcyclicSCC v):rest) = chew rest -- acyclic? not interesting.
966 chew ((CyclicSCC vs):rest)
967 = let names_in_this_cycle = nub (map ms_mod vs)
969 = nub ([done | done <- modsDone,
970 done `elem` names_in_this_cycle])
971 chewed_rest = chew rest
973 if notNull mods_in_this_cycle
974 && length mods_in_this_cycle < length names_in_this_cycle
975 then mods_in_this_cycle ++ chewed_rest
978 -- -----------------------------------------------------------------------------
981 -- This is where we compile each module in the module graph, in a pass
982 -- from the bottom to the top of the graph.
984 -- There better had not be any cyclic groups here -- we check for them.
987 :: HscEnv -- Includes initially-empty HPT
988 -> HomePackageTable -- HPT from last time round (pruned)
989 -> ([Module],[Module]) -- stable modules (see checkStability)
990 -> IO () -- How to clean up unwanted tmp files
991 -> [SCC ModSummary] -- Mods to do (the worklist)
993 HscEnv, -- With an updated HPT
994 [ModSummary]) -- Mods which succeeded
996 upsweep hsc_env old_hpt stable_mods cleanup mods
997 = upsweep' hsc_env old_hpt stable_mods cleanup mods 1 (length mods)
999 upsweep' hsc_env old_hpt stable_mods cleanup
1001 = return (Succeeded, hsc_env, [])
1003 upsweep' hsc_env old_hpt stable_mods cleanup
1004 (CyclicSCC ms:_) _ _
1005 = do fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
1006 return (Failed, hsc_env, [])
1008 upsweep' hsc_env old_hpt stable_mods cleanup
1009 (AcyclicSCC mod:mods) mod_index nmods
1010 = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1011 -- show (map (moduleUserString.moduleName.mi_module.hm_iface)
1012 -- (moduleEnvElts (hsc_HPT hsc_env)))
1014 mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod
1017 cleanup -- Remove unwanted tmp files between compilations
1020 Nothing -> return (Failed, hsc_env, [])
1022 { let this_mod = ms_mod mod
1024 -- Add new info to hsc_env
1025 hpt1 = extendModuleEnv (hsc_HPT hsc_env)
1027 hsc_env1 = hsc_env { hsc_HPT = hpt1 }
1029 -- Space-saving: delete the old HPT entry
1030 -- for mod BUT if mod is a hs-boot
1031 -- node, don't delete it. For the
1032 -- interface, the HPT entry is probaby for the
1033 -- main Haskell source file. Deleting it
1034 -- would force .. (what?? --SDM)
1035 old_hpt1 | isBootSummary mod = old_hpt
1036 | otherwise = delModuleEnv old_hpt this_mod
1038 ; (restOK, hsc_env2, modOKs)
1039 <- upsweep' hsc_env1 old_hpt1 stable_mods cleanup
1040 mods (mod_index+1) nmods
1041 ; return (restOK, hsc_env2, mod:modOKs)
1045 -- Compile a single module. Always produce a Linkable for it if
1046 -- successful. If no compilation happened, return the old Linkable.
1047 upsweep_mod :: HscEnv
1049 -> ([Module],[Module])
1051 -> Int -- index of module
1052 -> Int -- total number of modules
1053 -> IO (Maybe HomeModInfo) -- Nothing => Failed
1055 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
1058 this_mod = ms_mod summary
1059 mb_obj_date = ms_obj_date summary
1060 obj_fn = ml_obj_file (ms_location summary)
1061 hs_date = ms_hs_date summary
1063 compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
1064 compile_it = upsweep_compile hsc_env old_hpt this_mod
1065 summary mod_index nmods
1067 case ghcMode (hsc_dflags hsc_env) of
1070 -- Batch-compilating is easy: just check whether we have
1071 -- an up-to-date object file. If we do, then the compiler
1072 -- needs to do a recompilation check.
1073 _ | Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
1075 findObjectLinkable this_mod obj_fn obj_date
1076 compile_it (Just linkable)
1083 _ | is_stable_obj, isJust old_hmi ->
1085 -- object is stable, and we have an entry in the
1086 -- old HPT: nothing to do
1088 | is_stable_obj, isNothing old_hmi -> do
1090 findObjectLinkable this_mod obj_fn
1091 (expectJust "upseep1" mb_obj_date)
1092 compile_it (Just linkable)
1093 -- object is stable, but we need to load the interface
1094 -- off disk to make a HMI.
1097 ASSERT(isJust old_hmi) -- must be in the old_hpt
1099 -- BCO is stable: nothing to do
1101 | Just hmi <- old_hmi,
1102 Just l <- hm_linkable hmi, not (isObjectLinkable l),
1103 linkableTime l >= ms_hs_date summary ->
1105 -- we have an old BCO that is up to date with respect
1106 -- to the source: do a recompilation check as normal.
1110 -- no existing code at all: we must recompile.
1112 is_stable_obj = this_mod `elem` stable_obj
1113 is_stable_bco = this_mod `elem` stable_bco
1115 old_hmi = lookupModuleEnv old_hpt this_mod
1117 -- Run hsc to compile a module
1118 upsweep_compile hsc_env old_hpt this_mod summary
1120 mb_old_linkable = do
1122 -- The old interface is ok if it's in the old HPT
1123 -- a) we're compiling a source file, and the old HPT
1124 -- entry is for a source file
1125 -- b) we're compiling a hs-boot file
1126 -- Case (b) allows an hs-boot file to get the interface of its
1127 -- real source file on the second iteration of the compilation
1128 -- manager, but that does no harm. Otherwise the hs-boot file
1129 -- will always be recompiled
1132 = case lookupModuleEnv old_hpt this_mod of
1134 Just hm_info | isBootSummary summary -> Just iface
1135 | not (mi_boot iface) -> Just iface
1136 | otherwise -> Nothing
1138 iface = hm_iface hm_info
1140 compresult <- compile hsc_env summary mb_old_linkable mb_old_iface
1144 -- Compilation failed. Compile may still have updated the PCS, tho.
1145 CompErrs -> return Nothing
1147 -- Compilation "succeeded", and may or may not have returned a new
1148 -- linkable (depending on whether compilation was actually performed
1150 CompOK new_details new_iface new_linkable
1151 -> do let new_info = HomeModInfo { hm_iface = new_iface,
1152 hm_details = new_details,
1153 hm_linkable = new_linkable }
1154 return (Just new_info)
1157 -- Filter modules in the HPT
1158 retainInTopLevelEnvs :: [Module] -> HomePackageTable -> HomePackageTable
1159 retainInTopLevelEnvs keep_these hpt
1160 = mkModuleEnv [ (mod, expectJust "retain" mb_mod_info)
1162 , let mb_mod_info = lookupModuleEnv hpt mod
1163 , isJust mb_mod_info ]
1165 -- ---------------------------------------------------------------------------
1166 -- Topological sort of the module graph
1169 :: Bool -- Drop hi-boot nodes? (see below)
1173 -- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1174 -- The resulting list of strongly-connected-components is in topologically
1175 -- sorted order, starting with the module(s) at the bottom of the
1176 -- dependency graph (ie compile them first) and ending with the ones at
1179 -- Drop hi-boot nodes (first boolean arg)?
1181 -- False: treat the hi-boot summaries as nodes of the graph,
1182 -- so the graph must be acyclic
1184 -- True: eliminate the hi-boot nodes, and instead pretend
1185 -- the a source-import of Foo is an import of Foo
1186 -- The resulting graph has no hi-boot nodes, but can by cyclic
1188 topSortModuleGraph drop_hs_boot_nodes summaries Nothing
1189 = stronglyConnComp (fst (moduleGraphNodes drop_hs_boot_nodes summaries))
1190 topSortModuleGraph drop_hs_boot_nodes summaries (Just mod)
1191 = stronglyConnComp (map vertex_fn (reachable graph root))
1193 -- restrict the graph to just those modules reachable from
1194 -- the specified module. We do this by building a graph with
1195 -- the full set of nodes, and determining the reachable set from
1196 -- the specified node.
1197 (nodes, lookup_key) = moduleGraphNodes drop_hs_boot_nodes summaries
1198 (graph, vertex_fn, key_fn) = graphFromEdges' nodes
1200 | Just key <- lookup_key HsSrcFile mod, Just v <- key_fn key = v
1201 | otherwise = throwDyn (ProgramError "module does not exist")
1203 moduleGraphNodes :: Bool -> [ModSummary]
1204 -> ([(ModSummary, Int, [Int])], HscSource -> Module -> Maybe Int)
1205 moduleGraphNodes drop_hs_boot_nodes summaries = (nodes, lookup_key)
1207 -- Drop hs-boot nodes by using HsSrcFile as the key
1208 hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1209 | otherwise = HsBootFile
1211 -- We use integers as the keys for the SCC algorithm
1212 nodes :: [(ModSummary, Int, [Int])]
1213 nodes = [(s, expectJust "topSort" (lookup_key (ms_hsc_src s) (ms_mod s)),
1214 out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
1215 out_edge_keys HsSrcFile (map unLoc (ms_imps s)) )
1217 , not (isBootSummary s && drop_hs_boot_nodes) ]
1218 -- Drop the hi-boot ones if told to do so
1220 key_map :: NodeMap Int
1221 key_map = listToFM ([(ms_mod s, ms_hsc_src s) | s <- summaries]
1224 lookup_key :: HscSource -> Module -> Maybe Int
1225 lookup_key hs_src mod = lookupFM key_map (mod, hs_src)
1227 out_edge_keys :: HscSource -> [Module] -> [Int]
1228 out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1229 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1230 -- the IsBootInterface parameter True; else False
1233 type NodeKey = (Module, HscSource) -- The nodes of the graph are
1234 type NodeMap a = FiniteMap NodeKey a -- keyed by (mod, src_file_type) pairs
1236 msKey :: ModSummary -> NodeKey
1237 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (mod,boot)
1239 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1240 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
1242 nodeMapElts :: NodeMap a -> [a]
1243 nodeMapElts = eltsFM
1245 -----------------------------------------------------------------------------
1246 -- Downsweep (dependency analysis)
1248 -- Chase downwards from the specified root set, returning summaries
1249 -- for all home modules encountered. Only follow source-import
1252 -- We pass in the previous collection of summaries, which is used as a
1253 -- cache to avoid recalculating a module summary if the source is
1256 -- The returned list of [ModSummary] nodes has one node for each home-package
1257 -- module, plus one for any hs-boot files. The imports of these nodes
1258 -- are all there, including the imports of non-home-package modules.
1261 -> [ModSummary] -- Old summaries
1262 -> [Module] -- Ignore dependencies on these; treat
1263 -- them as if they were package modules
1264 -> Bool -- True <=> allow multiple targets to have
1265 -- the same module name; this is
1266 -- very useful for ghc -M
1267 -> IO (Maybe [ModSummary])
1268 -- The elts of [ModSummary] all have distinct
1269 -- (Modules, IsBoot) identifiers, unless the Bool is true
1270 -- in which case there can be repeats
1271 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1272 = -- catch error messages and return them
1273 handleDyn (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
1274 rootSummaries <- mapM getRootSummary roots
1275 let root_map = mkRootMap rootSummaries
1276 checkDuplicates root_map
1277 summs <- loop (concatMap msDeps rootSummaries) root_map
1280 roots = hsc_targets hsc_env
1282 old_summary_map :: NodeMap ModSummary
1283 old_summary_map = mkNodeMap old_summaries
1285 getRootSummary :: Target -> IO ModSummary
1286 getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
1287 = do exists <- doesFileExist file
1289 then summariseFile hsc_env old_summaries file mb_phase maybe_buf
1290 else throwDyn $ mkPlainErrMsg noSrcSpan $
1291 text "can't find file:" <+> text file
1292 getRootSummary (Target (TargetModule modl) maybe_buf)
1293 = do maybe_summary <- summariseModule hsc_env old_summary_map False
1294 (L rootLoc modl) maybe_buf excl_mods
1295 case maybe_summary of
1296 Nothing -> packageModErr modl
1299 rootLoc = mkGeneralSrcSpan FSLIT("<command line>")
1301 -- In a root module, the filename is allowed to diverge from the module
1302 -- name, so we have to check that there aren't multiple root files
1303 -- defining the same module (otherwise the duplicates will be silently
1304 -- ignored, leading to confusing behaviour).
1305 checkDuplicates :: NodeMap [ModSummary] -> IO ()
1306 checkDuplicates root_map
1307 | allow_dup_roots = return ()
1308 | null dup_roots = return ()
1309 | otherwise = multiRootsErr (head dup_roots)
1311 dup_roots :: [[ModSummary]] -- Each at least of length 2
1312 dup_roots = filterOut isSingleton (nodeMapElts root_map)
1314 loop :: [(Located Module,IsBootInterface)]
1315 -- Work list: process these modules
1316 -> NodeMap [ModSummary]
1317 -- Visited set; the range is a list because
1318 -- the roots can have the same module names
1319 -- if allow_dup_roots is True
1321 -- The result includes the worklist, except
1322 -- for those mentioned in the visited set
1323 loop [] done = return (concat (nodeMapElts done))
1324 loop ((wanted_mod, is_boot) : ss) done
1325 | Just summs <- lookupFM done key
1326 = if isSingleton summs then
1329 do { multiRootsErr summs; return [] }
1330 | otherwise = do { mb_s <- summariseModule hsc_env old_summary_map
1331 is_boot wanted_mod Nothing excl_mods
1333 Nothing -> loop ss done
1334 Just s -> loop (msDeps s ++ ss)
1335 (addToFM done key [s]) }
1337 key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1339 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1340 mkRootMap summaries = addListToFM_C (++) emptyFM
1341 [ (msKey s, [s]) | s <- summaries ]
1343 msDeps :: ModSummary -> [(Located Module, IsBootInterface)]
1344 -- (msDeps s) returns the dependencies of the ModSummary s.
1345 -- A wrinkle is that for a {-# SOURCE #-} import we return
1346 -- *both* the hs-boot file
1347 -- *and* the source file
1348 -- as "dependencies". That ensures that the list of all relevant
1349 -- modules always contains B.hs if it contains B.hs-boot.
1350 -- Remember, this pass isn't doing the topological sort. It's
1351 -- just gathering the list of all relevant ModSummaries
1353 concat [ [(m,True), (m,False)] | m <- ms_srcimps s ]
1354 ++ [ (m,False) | m <- ms_imps s ]
1356 -----------------------------------------------------------------------------
1357 -- Summarising modules
1359 -- We have two types of summarisation:
1361 -- * Summarise a file. This is used for the root module(s) passed to
1362 -- cmLoadModules. The file is read, and used to determine the root
1363 -- module name. The module name may differ from the filename.
1365 -- * Summarise a module. We are given a module name, and must provide
1366 -- a summary. The finder is used to locate the file in which the module
1371 -> [ModSummary] -- old summaries
1372 -> FilePath -- source file name
1373 -> Maybe Phase -- start phase
1374 -> Maybe (StringBuffer,ClockTime)
1377 summariseFile hsc_env old_summaries file mb_phase maybe_buf
1378 -- we can use a cached summary if one is available and the
1379 -- source file hasn't changed, But we have to look up the summary
1380 -- by source file, rather than module name as we do in summarise.
1381 | Just old_summary <- findSummaryBySourceFile old_summaries file
1383 let location = ms_location old_summary
1385 -- return the cached summary if the source didn't change
1386 src_timestamp <- case maybe_buf of
1387 Just (_,t) -> return t
1388 Nothing -> getModificationTime file
1389 -- The file exists; we checked in getRootSummary above.
1390 -- If it gets removed subsequently, then this
1391 -- getModificationTime may fail, but that's the right
1394 if ms_hs_date old_summary == src_timestamp
1395 then do -- update the object-file timestamp
1396 obj_timestamp <- getObjTimestamp location False
1397 return old_summary{ ms_obj_date = obj_timestamp }
1405 let dflags = hsc_dflags hsc_env
1407 (dflags', hspp_fn, buf)
1408 <- preprocessFile dflags file mb_phase maybe_buf
1410 (srcimps,the_imps, L _ mod) <- getImports dflags' buf hspp_fn
1412 -- Make a ModLocation for this file
1413 location <- mkHomeModLocation dflags mod file
1415 -- Tell the Finder cache where it is, so that subsequent calls
1416 -- to findModule will find it, even if it's not on any search path
1417 addHomeModuleToFinder hsc_env mod location
1419 src_timestamp <- case maybe_buf of
1420 Just (_,t) -> return t
1421 Nothing -> getModificationTime file
1422 -- getMofificationTime may fail
1424 obj_timestamp <- modificationTimeIfExists (ml_obj_file location)
1426 return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1427 ms_location = location,
1428 ms_hspp_file = Just hspp_fn,
1429 ms_hspp_buf = Just buf,
1430 ms_srcimps = srcimps, ms_imps = the_imps,
1431 ms_hs_date = src_timestamp,
1432 ms_obj_date = obj_timestamp })
1434 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
1435 findSummaryBySourceFile summaries file
1436 = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
1437 fromJust (ml_hs_file (ms_location ms)) == file ] of
1441 -- Summarise a module, and pick up source and timestamp.
1444 -> NodeMap ModSummary -- Map of old summaries
1445 -> IsBootInterface -- True <=> a {-# SOURCE #-} import
1446 -> Located Module -- Imported module to be summarised
1447 -> Maybe (StringBuffer, ClockTime)
1448 -> [Module] -- Modules to exclude
1449 -> IO (Maybe ModSummary) -- Its new summary
1451 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf excl_mods
1452 | wanted_mod `elem` excl_mods
1455 | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
1456 = do -- Find its new timestamp; all the
1457 -- ModSummaries in the old map have valid ml_hs_files
1458 let location = ms_location old_summary
1459 src_fn = expectJust "summariseModule" (ml_hs_file location)
1461 -- check the modification time on the source file, and
1462 -- return the cached summary if it hasn't changed. If the
1463 -- file has disappeared, we need to call the Finder again.
1465 Just (_,t) -> check_timestamp old_summary location src_fn t
1467 m <- IO.try (getModificationTime src_fn)
1469 Right t -> check_timestamp old_summary location src_fn t
1470 Left e | isDoesNotExistError e -> find_it
1471 | otherwise -> ioError e
1473 | otherwise = find_it
1475 dflags = hsc_dflags hsc_env
1477 hsc_src = if is_boot then HsBootFile else HsSrcFile
1479 check_timestamp old_summary location src_fn src_timestamp
1480 | ms_hs_date old_summary == src_timestamp = do
1481 -- update the object-file timestamp
1482 obj_timestamp <- getObjTimestamp location is_boot
1483 return (Just old_summary{ ms_obj_date = obj_timestamp })
1485 -- source changed: find and re-summarise. We call the finder
1486 -- again, because the user may have moved the source file.
1487 new_summary location src_fn src_timestamp
1490 -- Don't use the Finder's cache this time. If the module was
1491 -- previously a package module, it may have now appeared on the
1492 -- search path, so we want to consider it to be a home module. If
1493 -- the module was previously a home module, it may have moved.
1494 uncacheModule hsc_env wanted_mod
1495 found <- findModule hsc_env wanted_mod True {-explicit-}
1498 | not (isHomePackage pkg) -> return Nothing
1499 -- Drop external-pkg
1500 | isJust (ml_hs_file location) -> just_found location
1502 err -> noModError dflags loc wanted_mod err
1505 just_found location = do
1506 -- Adjust location to point to the hs-boot source file,
1507 -- hi file, object file, when is_boot says so
1508 let location' | is_boot = addBootSuffixLocn location
1509 | otherwise = location
1510 src_fn = expectJust "summarise2" (ml_hs_file location')
1512 -- Check that it exists
1513 -- It might have been deleted since the Finder last found it
1514 maybe_t <- modificationTimeIfExists src_fn
1516 Nothing -> noHsFileErr loc src_fn
1517 Just t -> new_summary location' src_fn t
1520 new_summary location src_fn src_timestamp
1522 -- Preprocess the source file and get its imports
1523 -- The dflags' contains the OPTIONS pragmas
1524 (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn Nothing maybe_buf
1525 (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn
1527 when (mod_name /= wanted_mod) $
1528 throwDyn $ mkPlainErrMsg mod_loc $
1529 text "file name does not match module name"
1530 <+> quotes (ppr mod_name)
1532 -- Find the object timestamp, and return the summary
1533 obj_timestamp <- getObjTimestamp location is_boot
1535 return (Just ( ModSummary { ms_mod = wanted_mod,
1536 ms_hsc_src = hsc_src,
1537 ms_location = location,
1538 ms_hspp_file = Just hspp_fn,
1539 ms_hspp_buf = Just buf,
1540 ms_srcimps = srcimps,
1542 ms_hs_date = src_timestamp,
1543 ms_obj_date = obj_timestamp }))
1546 getObjTimestamp location is_boot
1547 = if is_boot then return Nothing
1548 else modificationTimeIfExists (ml_obj_file location)
1551 preprocessFile :: DynFlags -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
1552 -> IO (DynFlags, FilePath, StringBuffer)
1553 preprocessFile dflags src_fn mb_phase Nothing
1555 (dflags', hspp_fn) <- preprocess dflags (src_fn, mb_phase)
1556 buf <- hGetStringBuffer hspp_fn
1557 return (dflags', hspp_fn, buf)
1559 preprocessFile dflags src_fn mb_phase (Just (buf, time))
1561 -- case we bypass the preprocessing stage?
1563 local_opts = getOptionsFromStringBuffer buf src_fn
1565 (dflags', errs) <- parseDynamicFlags dflags (map snd local_opts)
1569 | Just (Unlit _) <- mb_phase = True
1570 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
1571 -- note: local_opts is only required if there's no Unlit phase
1572 | dopt Opt_Cpp dflags' = True
1573 | dopt Opt_Pp dflags' = True
1576 when needs_preprocessing $
1577 ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
1579 return (dflags', src_fn, buf)
1582 -----------------------------------------------------------------------------
1584 -----------------------------------------------------------------------------
1586 noModError :: DynFlags -> SrcSpan -> Module -> FindResult -> IO ab
1587 -- ToDo: we don't have a proper line number for this error
1588 noModError dflags loc wanted_mod err
1589 = throwDyn $ mkPlainErrMsg loc $ cantFindError dflags wanted_mod err
1591 noHsFileErr loc path
1592 = throwDyn $ mkPlainErrMsg loc $ text "Can't find" <+> text path
1595 = throwDyn $ mkPlainErrMsg noSrcSpan $
1596 text "module" <+> quotes (ppr mod) <+> text "is a package module"
1598 multiRootsErr :: [ModSummary] -> IO ()
1599 multiRootsErr summs@(summ1:_)
1600 = throwDyn $ mkPlainErrMsg noSrcSpan $
1601 text "module" <+> quotes (ppr mod) <+>
1602 text "is defined in multiple files:" <+>
1603 sep (map text files)
1606 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
1608 cyclicModuleErr :: [ModSummary] -> SDoc
1610 = hang (ptext SLIT("Module imports form a cycle for modules:"))
1611 2 (vcat (map show_one ms))
1613 show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
1614 nest 2 $ ptext SLIT("imports:") <+>
1615 (pp_imps HsBootFile (ms_srcimps ms)
1616 $$ pp_imps HsSrcFile (ms_imps ms))]
1617 show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
1618 pp_imps src mods = fsep (map (show_mod src) mods)
1621 -- | Inform GHC that the working directory has changed. GHC will flush
1622 -- its cache of module locations, since it may no longer be valid.
1623 -- Note: if you change the working directory, you should also unload
1624 -- the current program (set targets to empty, followed by load).
1625 workingDirectoryChanged :: Session -> IO ()
1626 workingDirectoryChanged s = withSession s $ \hsc_env ->
1627 flushFinderCache (hsc_FC hsc_env)
1629 -- -----------------------------------------------------------------------------
1630 -- inspecting the session
1632 -- | Get the module dependency graph.
1633 getModuleGraph :: Session -> IO ModuleGraph -- ToDo: DiGraph ModSummary
1634 getModuleGraph s = withSession s (return . hsc_mod_graph)
1636 isLoaded :: Session -> Module -> IO Bool
1637 isLoaded s m = withSession s $ \hsc_env ->
1638 return $! isJust (lookupModuleEnv (hsc_HPT hsc_env) m)
1640 getBindings :: Session -> IO [TyThing]
1641 getBindings s = withSession s (return . nameEnvElts . ic_type_env . hsc_IC)
1643 getPrintUnqual :: Session -> IO PrintUnqualified
1644 getPrintUnqual s = withSession s (return . icPrintUnqual . hsc_IC)
1646 -- | Container for information about a 'Module'.
1647 data ModuleInfo = ModuleInfo {
1648 minf_type_env :: TypeEnv,
1649 minf_exports :: NameSet,
1650 minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
1651 minf_instances :: [Instance]
1652 -- ToDo: this should really contain the ModIface too
1654 -- We don't want HomeModInfo here, because a ModuleInfo applies
1655 -- to package modules too.
1657 -- | Request information about a loaded 'Module'
1658 getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
1659 getModuleInfo s mdl = withSession s $ \hsc_env -> do
1660 let mg = hsc_mod_graph hsc_env
1661 if mdl `elem` map ms_mod mg
1662 then getHomeModuleInfo hsc_env mdl
1664 {- if isHomeModule (hsc_dflags hsc_env) mdl
1666 else -} getPackageModuleInfo hsc_env mdl
1667 -- getPackageModuleInfo will attempt to find the interface, so
1668 -- we don't want to call it for a home module, just in case there
1669 -- was a problem loading the module and the interface doesn't
1670 -- exist... hence the isHomeModule test here. (ToDo: reinstate)
1672 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
1673 getPackageModuleInfo hsc_env mdl = do
1675 (_msgs, mb_names) <- getModuleExports hsc_env mdl
1677 Nothing -> return Nothing
1679 eps <- readIORef (hsc_EPS hsc_env)
1682 n_list = nameSetToList names
1683 tys = [ ty | name <- n_list,
1684 Just ty <- [lookupTypeEnv pte name] ]
1686 return (Just (ModuleInfo {
1687 minf_type_env = mkTypeEnv tys,
1688 minf_exports = names,
1689 minf_rdr_env = Just $! nameSetToGlobalRdrEnv names mdl,
1690 minf_instances = error "getModuleInfo: instances for package module unimplemented"
1693 -- bogusly different for non-GHCI (ToDo)
1697 getHomeModuleInfo hsc_env mdl =
1698 case lookupModuleEnv (hsc_HPT hsc_env) mdl of
1699 Nothing -> return Nothing
1701 let details = hm_details hmi
1702 return (Just (ModuleInfo {
1703 minf_type_env = md_types details,
1704 minf_exports = md_exports details,
1705 minf_rdr_env = mi_globals $! hm_iface hmi,
1706 minf_instances = md_insts details
1709 -- | The list of top-level entities defined in a module
1710 modInfoTyThings :: ModuleInfo -> [TyThing]
1711 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
1713 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
1714 modInfoTopLevelScope minf
1715 = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
1717 modInfoExports :: ModuleInfo -> [Name]
1718 modInfoExports minf = nameSetToList $! minf_exports minf
1720 -- | Returns the instances defined by the specified module.
1721 -- Warning: currently unimplemented for package modules.
1722 modInfoInstances :: ModuleInfo -> [Instance]
1723 modInfoInstances = minf_instances
1725 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
1726 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
1728 modInfoPrintUnqualified :: ModuleInfo -> Maybe PrintUnqualified
1729 modInfoPrintUnqualified minf = fmap unQualInScope (minf_rdr_env minf)
1731 modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
1732 modInfoLookupName s minf name = withSession s $ \hsc_env -> do
1733 case lookupTypeEnv (minf_type_env minf) name of
1734 Just tyThing -> return (Just tyThing)
1736 eps <- readIORef (hsc_EPS hsc_env)
1737 return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
1739 isDictonaryId :: Id -> Bool
1741 = case tcSplitSigmaTy (idType id) of { (tvs, theta, tau) -> isDictTy tau }
1743 -- | Looks up a global name: that is, any top-level name in any
1744 -- visible module. Unlike 'lookupName', lookupGlobalName does not use
1745 -- the interactive context, and therefore does not require a preceding
1747 lookupGlobalName :: Session -> Name -> IO (Maybe TyThing)
1748 lookupGlobalName s name = withSession s $ \hsc_env -> do
1749 eps <- readIORef (hsc_EPS hsc_env)
1750 return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
1752 -- -----------------------------------------------------------------------------
1753 -- Misc exported utils
1755 dataConType :: DataCon -> Type
1756 dataConType dc = idType (dataConWrapId dc)
1758 -- | print a 'NamedThing', adding parentheses if the name is an operator.
1759 pprParenSymName :: NamedThing a => a -> SDoc
1760 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
1762 -- ----------------------------------------------------------------------------
1767 -- - Data and Typeable instances for HsSyn.
1769 -- ToDo: check for small transformations that happen to the syntax in
1770 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
1772 -- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way
1773 -- to get from TyCons, Ids etc. to TH syntax (reify).
1775 -- :browse will use either lm_toplev or inspect lm_interface, depending
1776 -- on whether the module is interpreted or not.
1778 -- This is for reconstructing refactored source code
1779 -- Calls the lexer repeatedly.
1780 -- ToDo: add comment tokens to token stream
1781 getTokenStream :: Session -> Module -> IO [Located Token]
1784 -- -----------------------------------------------------------------------------
1785 -- Interactive evaluation
1789 -- | Set the interactive evaluation context.
1791 -- Setting the context doesn't throw away any bindings; the bindings
1792 -- we've built up in the InteractiveContext simply move to the new
1793 -- module. They always shadow anything in scope in the current context.
1794 setContext :: Session
1795 -> [Module] -- entire top level scope of these modules
1796 -> [Module] -- exports only of these modules
1798 setContext (Session ref) toplevs exports = do
1799 hsc_env <- readIORef ref
1800 let old_ic = hsc_IC hsc_env
1801 hpt = hsc_HPT hsc_env
1803 mapM_ (checkModuleExists hsc_env hpt) exports
1804 export_env <- mkExportEnv hsc_env exports
1805 toplev_envs <- mapM (mkTopLevEnv hpt) toplevs
1806 let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
1807 writeIORef ref hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplevs,
1808 ic_exports = exports,
1809 ic_rn_gbl_env = all_env }}
1812 -- Make a GlobalRdrEnv based on the exports of the modules only.
1813 mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
1814 mkExportEnv hsc_env mods = do
1815 stuff <- mapM (getModuleExports hsc_env) mods
1817 (_msgs, mb_name_sets) = unzip stuff
1818 gres = [ nameSetToGlobalRdrEnv name_set mod
1819 | (Just name_set, mod) <- zip mb_name_sets mods ]
1821 return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv gres
1823 nameSetToGlobalRdrEnv :: NameSet -> Module -> GlobalRdrEnv
1824 nameSetToGlobalRdrEnv names mod =
1825 mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = vanillaProv mod }
1826 | name <- nameSetToList names ]
1828 vanillaProv :: Module -> Provenance
1829 -- We're building a GlobalRdrEnv as if the user imported
1830 -- all the specified modules into the global interactive module
1831 vanillaProv mod = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}]
1833 decl = ImpDeclSpec { is_mod = mod, is_as = mod,
1835 is_dloc = srcLocSpan interactiveSrcLoc }
1837 checkModuleExists :: HscEnv -> HomePackageTable -> Module -> IO ()
1838 checkModuleExists hsc_env hpt mod =
1839 case lookupModuleEnv hpt mod of
1840 Just mod_info -> return ()
1841 _not_a_home_module -> do
1842 res <- findPackageModule hsc_env mod True
1844 Found _ _ -> return ()
1845 err -> let msg = cantFindError (hsc_dflags hsc_env) mod err in
1846 throwDyn (CmdLineError (showSDoc msg))
1848 mkTopLevEnv :: HomePackageTable -> Module -> IO GlobalRdrEnv
1849 mkTopLevEnv hpt modl
1850 = case lookupModuleEnv hpt modl of
1852 throwDyn (ProgramError ("mkTopLevEnv: not a home module "
1853 ++ showSDoc (pprModule modl)))
1855 case mi_globals (hm_iface details) of
1857 throwDyn (ProgramError ("mkTopLevEnv: not interpreted "
1858 ++ showSDoc (pprModule modl)))
1859 Just env -> return env
1861 -- | Get the interactive evaluation context, consisting of a pair of the
1862 -- set of modules from which we take the full top-level scope, and the set
1863 -- of modules from which we take just the exports respectively.
1864 getContext :: Session -> IO ([Module],[Module])
1865 getContext s = withSession s (\HscEnv{ hsc_IC=ic } ->
1866 return (ic_toplev_scope ic, ic_exports ic))
1868 -- | Returns 'True' if the specified module is interpreted, and hence has
1869 -- its full top-level scope available.
1870 moduleIsInterpreted :: Session -> Module -> IO Bool
1871 moduleIsInterpreted s modl = withSession s $ \h ->
1872 case lookupModuleEnv (hsc_HPT h) modl of
1873 Just details -> return (isJust (mi_globals (hm_iface details)))
1874 _not_a_home_module -> return False
1876 -- | Looks up an identifier in the current interactive context (for :info)
1877 getInfo :: Session -> Name -> IO (Maybe (TyThing,Fixity,[Instance]))
1878 getInfo s name = withSession s $ \hsc_env -> tcRnGetInfo hsc_env name
1880 -- | Returns all names in scope in the current interactive context
1881 getNamesInScope :: Session -> IO [Name]
1882 getNamesInScope s = withSession s $ \hsc_env -> do
1883 return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
1885 -- | Parses a string as an identifier, and returns the list of 'Name's that
1886 -- the identifier can refer to in the current interactive context.
1887 parseName :: Session -> String -> IO [Name]
1888 parseName s str = withSession s $ \hsc_env -> do
1889 maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
1890 case maybe_rdr_name of
1891 Nothing -> return []
1892 Just (L _ rdr_name) -> do
1893 mb_names <- tcRnLookupRdrName hsc_env rdr_name
1895 Nothing -> return []
1896 Just ns -> return ns
1897 -- ToDo: should return error messages
1899 -- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
1900 -- entity known to GHC, including 'Name's defined using 'runStmt'.
1901 lookupName :: Session -> Name -> IO (Maybe TyThing)
1902 lookupName s name = withSession s $ \hsc_env -> tcRnLookupName hsc_env name
1904 -- -----------------------------------------------------------------------------
1905 -- Getting the type of an expression
1907 -- | Get the type of an expression
1908 exprType :: Session -> String -> IO (Maybe Type)
1909 exprType s expr = withSession s $ \hsc_env -> do
1910 maybe_stuff <- hscTcExpr hsc_env expr
1912 Nothing -> return Nothing
1913 Just ty -> return (Just tidy_ty)
1915 tidy_ty = tidyType emptyTidyEnv ty
1917 -- -----------------------------------------------------------------------------
1918 -- Getting the kind of a type
1920 -- | Get the kind of a type
1921 typeKind :: Session -> String -> IO (Maybe Kind)
1922 typeKind s str = withSession s $ \hsc_env -> do
1923 maybe_stuff <- hscKcType hsc_env str
1925 Nothing -> return Nothing
1926 Just kind -> return (Just kind)
1928 -----------------------------------------------------------------------------
1929 -- cmCompileExpr: compile an expression and deliver an HValue
1931 compileExpr :: Session -> String -> IO (Maybe HValue)
1932 compileExpr s expr = withSession s $ \hsc_env -> do
1933 maybe_stuff <- hscStmt hsc_env ("let __cmCompileExpr = "++expr)
1935 Nothing -> return Nothing
1936 Just (new_ic, names, hval) -> do
1938 hvals <- (unsafeCoerce# hval) :: IO [HValue]
1940 case (names,hvals) of
1941 ([n],[hv]) -> return (Just hv)
1942 _ -> panic "compileExpr"
1944 -- -----------------------------------------------------------------------------
1945 -- running a statement interactively
1948 = RunOk [Name] -- ^ names bound by this evaluation
1949 | RunFailed -- ^ statement failed compilation
1950 | RunException Exception -- ^ statement raised an exception
1952 -- | Run a statement in the current interactive context. Statemenet
1953 -- may bind multple values.
1954 runStmt :: Session -> String -> IO RunResult
1955 runStmt (Session ref) expr
1957 hsc_env <- readIORef ref
1959 -- Turn off -fwarn-unused-bindings when running a statement, to hide
1960 -- warnings about the implicit bindings we introduce.
1961 let dflags' = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
1962 hsc_env' = hsc_env{ hsc_dflags = dflags' }
1964 maybe_stuff <- hscStmt hsc_env' expr
1967 Nothing -> return RunFailed
1968 Just (new_hsc_env, names, hval) -> do
1970 let thing_to_run = unsafeCoerce# hval :: IO [HValue]
1971 either_hvals <- sandboxIO thing_to_run
1973 case either_hvals of
1975 -- on error, keep the *old* interactive context,
1976 -- so that 'it' is not bound to something
1977 -- that doesn't exist.
1978 return (RunException e)
1981 -- Get the newly bound things, and bind them.
1982 -- Don't need to delete any shadowed bindings;
1983 -- the new ones override the old ones.
1984 extendLinkEnv (zip names hvals)
1986 writeIORef ref new_hsc_env
1987 return (RunOk names)
1990 -- We run the statement in a "sandbox" to protect the rest of the
1991 -- system from anything the expression might do. For now, this
1992 -- consists of just wrapping it in an exception handler, but see below
1993 -- for another version.
1995 sandboxIO :: IO a -> IO (Either Exception a)
1996 sandboxIO thing = Exception.try thing
1999 -- This version of sandboxIO runs the expression in a completely new
2000 -- RTS main thread. It is disabled for now because ^C exceptions
2001 -- won't be delivered to the new thread, instead they'll be delivered
2002 -- to the (blocked) GHCi main thread.
2004 -- SLPJ: when re-enabling this, reflect a wrong-stat error as an exception
2006 sandboxIO :: IO a -> IO (Either Int (Either Exception a))
2007 sandboxIO thing = do
2008 st_thing <- newStablePtr (Exception.try thing)
2009 alloca $ \ p_st_result -> do
2010 stat <- rts_evalStableIO st_thing p_st_result
2011 freeStablePtr st_thing
2013 then do st_result <- peek p_st_result
2014 result <- deRefStablePtr st_result
2015 freeStablePtr st_result
2016 return (Right result)
2018 return (Left (fromIntegral stat))
2020 foreign import "rts_evalStableIO" {- safe -}
2021 rts_evalStableIO :: StablePtr (IO a) -> Ptr (StablePtr a) -> IO CInt
2022 -- more informative than the C type!
2025 -----------------------------------------------------------------------------
2026 -- show a module and it's source/object filenames
2028 showModule :: Session -> ModSummary -> IO String
2029 showModule s mod_summary = withSession s $ \hsc_env -> do
2030 case lookupModuleEnv (hsc_HPT hsc_env) (ms_mod mod_summary) of
2031 Nothing -> panic "missing linkable"
2032 Just mod_info -> return (showModMsg obj_linkable mod_summary)
2034 obj_linkable = isObjectLinkable (fromJust (hm_linkable mod_info))