ghc/compiler/main/GHC.hs

   1 -- -----------------------------------------------------------------------------
   2 --
   3 -- (c) The University of Glasgow, 2005
   4 --
   5 -- The GHC API
   6 --
   7 -- -----------------------------------------------------------------------------
   8
   9 module GHC (
  10         -- * Initialisation
  11         Session,
  12         defaultErrorHandler,
  13         defaultCleanupHandler,
  14         init,
  15         newSession,
  16
  17         -- * Flags and settings
  18         DynFlags(..), DynFlag(..), GhcMode(..), HscTarget(..), dopt,
  19         parseDynamicFlags,
  20         initPackages,
  21         getSessionDynFlags,
  22         setSessionDynFlags,
  23         setMsgHandler,
  24
  25         -- * Targets
  26         Target(..), TargetId(..),
  27         setTargets,
  28         getTargets,
  29         addTarget,
  30         removeTarget,
  31         guessTarget,
  32
  33         -- * Loading\/compiling the program
  34         depanal,
  35         load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
  36         workingDirectoryChanged,
  37
  38         -- * Inspecting the module structure of the program
  39         ModuleGraph, ModSummary(..),
  40         getModuleGraph,
  41         isLoaded,
  42         topSortModuleGraph,
  43
  44         -- * Inspecting modules
  45         ModuleInfo,
  46         getModuleInfo,
  47         modInfoTyThings,
  48         lookupName,
  49         allNamesInScope,
  50
  51         -- * Interactive evaluation
  52         getBindings, getPrintUnqual,
  53 #ifdef GHCI
  54         setContext, getContext,
  55         moduleIsInterpreted,
  56         getInfo, GetInfoResult,
  57         exprType,
  58         typeKind,
  59         parseName,
  60         RunResult(..),
  61         runStmt,
  62         browseModule,
  63         showModule,
  64         compileExpr, HValue,
  65 #endif
  66
  67         -- * Abstract syntax elements
  68
  69         -- ** Modules
  70         Module, mkModule, pprModule,
  71
  72         -- ** Names
  73         Name,
  74
  75         -- ** Identifiers
  76         Id, idType,
  77         isImplicitId, isDeadBinder,
  78         isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
  79         isRecordSelector,
  80         isPrimOpId, isFCallId,
  81         isDataConWorkId, idDataCon,
  82         isBottomingId, isDictonaryId,
  83
  84         -- ** Type constructors
  85         TyCon,
  86         isClassTyCon, isSynTyCon, isNewTyCon,
  87
  88         -- ** Data constructors
  89         DataCon,
  90
  91         -- ** Classes
  92         Class,
  93         classSCTheta, classTvsFds,
  94
  95         -- ** Types and Kinds
  96         Type, dropForAlls,
  97         Kind,
  98
  99         -- ** Entities
 100         TyThing(..),
 101
 102         -- * Exceptions
 103         GhcException(..), showGhcException,
 104
 105         -- * Miscellaneous
 106         sessionHscEnv,
 107         cyclicModuleErr,
 108   ) where
 109
 110 {-
 111  ToDo:
 112
 113   * return error messages rather than printing them.
 114   * inline bits of HscMain here to simplify layering: hscGetInfo,
 115     hscTcExpr, hscStmt.
 116   * implement second argument to load.
 117   * we need to expose DynFlags, so should parseDynamicFlags really be
 118     part of this interface?
 119   * what StaticFlags should we expose, if any?
 120 -}
 121
 122 #include "HsVersions.h"
 123
 124 #ifdef GHCI
 125 import qualified Linker
 126 import Linker           ( HValue, extendLinkEnv )
 127 import NameEnv          ( lookupNameEnv )
 128 import TcRnDriver       ( mkExportEnv, getModuleContents, tcRnLookupRdrName )
 129 import RdrName          ( plusGlobalRdrEnv )
 130 import HscMain          ( hscGetInfo, GetInfoResult, hscParseIdentifier,
 131                           hscStmt, hscTcExpr, hscKcType )
 132 import Type             ( tidyType )
 133 import VarEnv           ( emptyTidyEnv )
 134 import GHC.Exts         ( unsafeCoerce# )
 135 import IfaceSyn         ( IfaceDecl )
 136 #endif
 137
 138 import Packages         ( initPackages )
 139 import RdrName          ( GlobalRdrEnv )
 140 import HsSyn            ( HsModule, LHsBinds )
 141 import Type             ( Kind, Type, dropForAlls )
 142 import Id               ( Id, idType, isImplicitId, isDeadBinder,
 143                           isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
 144                           isRecordSelector,
 145                           isPrimOpId, isFCallId,
 146                           isDataConWorkId, idDataCon,
 147                           isBottomingId )
 148 import TyCon            ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon )
 149 import Class            ( Class, classSCTheta, classTvsFds )
 150 import DataCon          ( DataCon )
 151 import Name             ( Name, getName, nameModule_maybe )
 152 import RdrName          ( RdrName, gre_name, globalRdrEnvElts )
 153 import NameEnv          ( nameEnvElts )
 154 import SrcLoc           ( Located(..) )
 155 import DriverPipeline
 156 import DriverPhases     ( Phase(..), isHaskellSrcFilename, startPhase )
 157 import GetImports       ( getImports )
 158 import Packages         ( isHomePackage )
 159 import Finder
 160 import HscMain          ( newHscEnv, hscFileCheck, HscResult(..) )
 161 import HscTypes
 162 import DynFlags
 163 import StaticFlags
 164 import SysTools         ( initSysTools, cleanTempFiles )
 165 import Module
 166 import FiniteMap
 167 import Panic
 168 import Digraph
 169 import ErrUtils         ( showPass, Messages, putMsg, debugTraceMsg )
 170 import qualified ErrUtils
 171 import Util
 172 import StringBuffer     ( StringBuffer, hGetStringBuffer )
 173 import Outputable
 174 import SysTools         ( cleanTempFilesExcept )
 175 import BasicTypes       ( SuccessFlag(..), succeeded, failed )
 176 import Maybes           ( orElse, expectJust, mapCatMaybes )
 177 import TcType           ( tcSplitSigmaTy, isDictTy )
 178
 179 import Directory        ( getModificationTime, doesFileExist )
 180 import Maybe            ( isJust, isNothing, fromJust, fromMaybe, catMaybes )
 181 import Maybes           ( expectJust )
 182 import List             ( partition, nub )
 183 import qualified List
 184 import Monad            ( unless, when, foldM )
 185 import System           ( exitWith, ExitCode(..) )
 186 import Time             ( ClockTime )
 187 import EXCEPTION as Exception hiding (handle)
 188 import DATA_IOREF
 189 import IO
 190 import Prelude hiding (init)
 191
 192 -- -----------------------------------------------------------------------------
 193 -- Exception handlers
 194
 195 -- | Install some default exception handlers and run the inner computation.
 196 -- Unless you want to handle exceptions yourself, you should wrap this around
 197 -- the top level of your program.  The default handlers output the error
 198 -- message(s) to stderr and exit cleanly.
 199 defaultErrorHandler :: IO a -> IO a
 200 defaultErrorHandler inner =
 201   -- top-level exception handler: any unrecognised exception is a compiler bug.
 202   handle (\exception -> do
 203            hFlush stdout
 204            case exception of
 205                 -- an IO exception probably isn't our fault, so don't panic
 206                 IOException _ ->  putMsg (show exception)
 207                 AsyncException StackOverflow ->
 208                         putMsg "stack overflow: use +RTS -K<size> to increase it"
 209                 _other ->  putMsg (show (Panic (show exception)))
 210            exitWith (ExitFailure 1)
 211          ) $
 212
 213   -- all error messages are propagated as exceptions
 214   handleDyn (\dyn -> do
 215                 hFlush stdout
 216                 case dyn of
 217                      PhaseFailed _ code -> exitWith code
 218                      Interrupted -> exitWith (ExitFailure 1)
 219                      _ -> do putMsg (show (dyn :: GhcException))
 220                              exitWith (ExitFailure 1)
 221             ) $
 222   inner
 223
 224 -- | Install a default cleanup handler to remove temporary files
 225 -- deposited by a GHC run.  This is seperate from
 226 -- 'defaultErrorHandler', because you might want to override the error
 227 -- handling, but still get the ordinary cleanup behaviour.
 228 defaultCleanupHandler :: DynFlags -> IO a -> IO a
 229 defaultCleanupHandler dflags inner =
 230    -- make sure we clean up after ourselves
 231    later (unless (dopt Opt_KeepTmpFiles dflags) $
 232             cleanTempFiles dflags)
 233         -- exceptions will be blocked while we clean the temporary files,
 234         -- so there shouldn't be any difficulty if we receive further
 235         -- signals.
 236    inner
 237
 238
 239 -- | Initialises GHC.  This must be done /once/ only.  Takes the
 240 -- command-line arguments.  All command-line arguments which aren't
 241 -- understood by GHC will be returned.
 242
 243 init :: [String] -> IO [String]
 244 init args = do
 245    -- catch ^C
 246    installSignalHandlers
 247
 248    -- Grab the -B option if there is one
 249    let (minusB_args, argv1) = partition (prefixMatch "-B") args
 250    dflags0 <- initSysTools minusB_args defaultDynFlags
 251    writeIORef v_initDynFlags dflags0
 252
 253    -- Parse the static flags
 254    argv2 <- parseStaticFlags argv1
 255    return argv2
 256
 257 GLOBAL_VAR(v_initDynFlags, error "initDynFlags", DynFlags)
 258         -- stores the DynFlags between the call to init and subsequent
 259         -- calls to newSession.
 260
 261 -- | Starts a new session.  A session consists of a set of loaded
 262 -- modules, a set of options (DynFlags), and an interactive context.
 263 -- ToDo: GhcMode should say "keep typechecked code" and\/or "keep renamed
 264 -- code".
 265 newSession :: GhcMode -> IO Session
 266 newSession mode = do
 267   dflags0 <- readIORef v_initDynFlags
 268   dflags <- initDynFlags dflags0
 269   env <- newHscEnv dflags{ ghcMode=mode }
 270   ref <- newIORef env
 271   return (Session ref)
 272
 273 -- tmp: this breaks the abstraction, but required because DriverMkDepend
 274 -- needs to call the Finder.  ToDo: untangle this.
 275 sessionHscEnv :: Session -> IO HscEnv
 276 sessionHscEnv (Session ref) = readIORef ref
 277
 278 withSession :: Session -> (HscEnv -> IO a) -> IO a
 279 withSession (Session ref) f = do h <- readIORef ref; f h
 280
 281 modifySession :: Session -> (HscEnv -> HscEnv) -> IO ()
 282 modifySession (Session ref) f = do h <- readIORef ref; writeIORef ref $! f h
 283
 284 -- -----------------------------------------------------------------------------
 285 -- Flags & settings
 286
 287 -- | Grabs the DynFlags from the Session
 288 getSessionDynFlags :: Session -> IO DynFlags
 289 getSessionDynFlags s = withSession s (return . hsc_dflags)
 290
 291 -- | Updates the DynFlags in a Session
 292 setSessionDynFlags :: Session -> DynFlags -> IO ()
 293 setSessionDynFlags s dflags = modifySession s (\h -> h{ hsc_dflags = dflags })
 294
 295 -- | Messages during compilation (eg. warnings and progress messages)
 296 -- are reported using this callback.  By default, these messages are
 297 -- printed to stderr.
 298 setMsgHandler :: (String -> IO ()) -> IO ()
 299 setMsgHandler = ErrUtils.setMsgHandler
 300
 301 -- -----------------------------------------------------------------------------
 302 -- Targets
 303
 304 -- ToDo: think about relative vs. absolute file paths. And what
 305 -- happens when the current directory changes.
 306
 307 -- | Sets the targets for this session.  Each target may be a module name
 308 -- or a filename.  The targets correspond to the set of root modules for
 309 -- the program\/library.  Unloading the current program is achieved by
 310 -- setting the current set of targets to be empty, followed by load.
 311 setTargets :: Session -> [Target] -> IO ()
 312 setTargets s targets = modifySession s (\h -> h{ hsc_targets = targets })
 313
 314 -- | returns the current set of targets
 315 getTargets :: Session -> IO [Target]
 316 getTargets s = withSession s (return . hsc_targets)
 317
 318 -- | Add another target
 319 addTarget :: Session -> Target -> IO ()
 320 addTarget s target
 321   = modifySession s (\h -> h{ hsc_targets = target : hsc_targets h })
 322
 323 -- | Remove a target
 324 removeTarget :: Session -> TargetId -> IO ()
 325 removeTarget s target_id
 326   = modifySession s (\h -> h{ hsc_targets = filter (hsc_targets h) })
 327   where
 328    filter targets = [ t | t@(Target id _) <- targets, id /= target_id ]
 329
 330 -- Attempts to guess what Target a string refers to.  This function implements
 331 -- the --make/GHCi command-line syntax for filenames:
 332 --
 333 --      - if the string looks like a Haskell source filename, then interpret
 334 --        it as such
 335 --      - if adding a .hs or .lhs suffix yields the name of an existing file,
 336 --        then use that
 337 --      - otherwise interpret the string as a module name
 338 --
 339 guessTarget :: String -> IO Target
 340 guessTarget file
 341    | isHaskellSrcFilename file
 342    = return (Target (TargetFile file) Nothing)
 343    | otherwise
 344    = do exists <- doesFileExist hs_file
 345         if exists then return (Target (TargetFile hs_file) Nothing) else do
 346         exists <- doesFileExist lhs_file
 347         if exists then return (Target (TargetFile lhs_file) Nothing) else do
 348         return (Target (TargetModule (mkModule file)) Nothing)
 349      where
 350          hs_file = file ++ ".hs"
 351          lhs_file = file ++ ".lhs"
 352
 353 -- -----------------------------------------------------------------------------
 354 -- Loading the program
 355
 356 -- Perform a dependency analysis starting from the current targets
 357 -- and update the session with the new module graph.
 358 depanal :: Session -> [Module] -> IO ()
 359 depanal (Session ref) excluded_mods = do
 360   hsc_env <- readIORef ref
 361   let
 362          dflags  = hsc_dflags hsc_env
 363          gmode   = ghcMode (hsc_dflags hsc_env)
 364          targets = hsc_targets hsc_env
 365          old_graph = hsc_mod_graph hsc_env
 366
 367   showPass dflags "Chasing dependencies"
 368   when (gmode == BatchCompile) $
 369         debugTraceMsg dflags 1 (showSDoc (hcat [
 370                      text "Chasing modules from: ",
 371                         hcat (punctuate comma (map pprTarget targets))]))
 372
 373   graph <- downsweep hsc_env old_graph excluded_mods
 374   writeIORef ref hsc_env{ hsc_mod_graph=graph }
 375
 376 {-
 377 -- | The result of load.
 378 data LoadResult
 379   = LoadOk      Errors  -- ^ all specified targets were loaded successfully.
 380   | LoadFailed  Errors  -- ^ not all modules were loaded.
 381
 382 type Errors = [String]
 383
 384 data ErrMsg = ErrMsg {
 385         errMsgSeverity  :: Severity,  -- warning, error, etc.
 386         errMsgSpans     :: [SrcSpan],
 387         errMsgShortDoc  :: Doc,
 388         errMsgExtraInfo :: Doc
 389         }
 390 -}
 391
 392 data LoadHowMuch
 393    = LoadAllTargets
 394    | LoadUpTo Module
 395
 396 -- | Try to load the program.  If a Module is supplied, then just
 397 -- attempt to load up to this target.  If no Module is supplied,
 398 -- then try to load all targets.
 399 load :: Session -> LoadHowMuch -> IO SuccessFlag
 400 load s@(Session ref) how_much
 401    = do
 402         -- Dependency analysis first.  Note that this fixes the module graph:
 403         -- even if we don't get a fully successful upsweep, the full module
 404         -- graph is still retained in the Session.  We can tell which modules
 405         -- were successfully loaded by inspecting the Session's HPT.
 406         depanal s []
 407
 408         hsc_env <- readIORef ref
 409
 410         let hpt1      = hsc_HPT hsc_env
 411         let dflags    = hsc_dflags hsc_env
 412         let mod_graph = hsc_mod_graph hsc_env
 413
 414         let ghci_mode = ghcMode (hsc_dflags hsc_env) -- this never changes
 415         let verb      = verbosity dflags
 416
 417         -- The "bad" boot modules are the ones for which we have
 418         -- B.hs-boot in the module graph, but no B.hs
 419         -- The downsweep should have ensured this does not happen
 420         -- (see msDeps)
 421         let all_home_mods = [ms_mod s | s <- mod_graph, not (isBootSummary s)]
 422             bad_boot_mods = [s        | s <- mod_graph, isBootSummary s,
 423                                         not (ms_mod s `elem` all_home_mods)]
 424         ASSERT( null bad_boot_mods ) return ()
 425
 426         -- mg2_with_srcimps drops the hi-boot nodes, returning a
 427         -- graph with cycles.  Among other things, it is used for
 428         -- backing out partially complete cycles following a failed
 429         -- upsweep, and for removing from hpt all the modules
 430         -- not in strict downwards closure, during calls to compile.
 431         let mg2_with_srcimps :: [SCC ModSummary]
 432             mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
 433
 434             -- check the stability property for each module.
 435             stable_mods@(stable_obj,stable_bco)
 436                 | BatchCompile <- ghci_mode = ([],[])
 437                 | otherwise = checkStability hpt1 mg2_with_srcimps all_home_mods
 438
 439             -- prune bits of the HPT which are definitely redundant now,
 440             -- to save space.
 441             pruned_hpt = pruneHomePackageTable hpt1
 442                                 (flattenSCCs mg2_with_srcimps)
 443                                 stable_mods
 444
 445         evaluate pruned_hpt
 446
 447         debugTraceMsg dflags 2 (showSDoc (text "Stable obj:" <+> ppr stable_obj $$
 448                                 text "Stable BCO:" <+> ppr stable_bco))
 449
 450         -- Unload any modules which are going to be re-linked this time around.
 451         let stable_linkables = [ linkable
 452                                | m <- stable_obj++stable_bco,
 453                                  Just hmi <- [lookupModuleEnv pruned_hpt m],
 454                                  Just linkable <- [hm_linkable hmi] ]
 455         unload hsc_env stable_linkables
 456
 457         -- We could at this point detect cycles which aren't broken by
 458         -- a source-import, and complain immediately, but it seems better
 459         -- to let upsweep_mods do this, so at least some useful work gets
 460         -- done before the upsweep is abandoned.
 461         --hPutStrLn stderr "after tsort:\n"
 462         --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
 463
 464         -- Now do the upsweep, calling compile for each module in
 465         -- turn.  Final result is version 3 of everything.
 466
 467         -- Topologically sort the module graph, this time including hi-boot
 468         -- nodes, and possibly just including the portion of the graph
 469         -- reachable from the module specified in the 2nd argument to load.
 470         -- This graph should be cycle-free.
 471         -- If we're restricting the upsweep to a portion of the graph, we
 472         -- also want to retain everything that is still stable.
 473         let full_mg :: [SCC ModSummary]
 474             full_mg    = topSortModuleGraph False mod_graph Nothing
 475
 476             maybe_top_mod = case how_much of
 477                                 LoadUpTo m           -> Just m
 478                                 _                    -> Nothing
 479
 480             partial_mg :: [SCC ModSummary]
 481             partial_mg = topSortModuleGraph False mod_graph maybe_top_mod
 482
 483             stable_mg =
 484                 [ AcyclicSCC ms
 485                 | AcyclicSCC ms <- full_mg,
 486                   ms_mod ms `elem` stable_obj++stable_bco,
 487                   ms_mod ms `notElem` [ ms_mod ms' |
 488                                         AcyclicSCC ms' <- partial_mg ] ]
 489
 490             mg = stable_mg ++ partial_mg
 491
 492         -- clean up between compilations
 493         let cleanup = cleanTempFilesExcept dflags
 494                           (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
 495
 496         (upsweep_ok, hsc_env1, modsUpswept)
 497            <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
 498                            pruned_hpt stable_mods cleanup mg
 499
 500         -- Make modsDone be the summaries for each home module now
 501         -- available; this should equal the domain of hpt3.
 502         -- Get in in a roughly top .. bottom order (hence reverse).
 503
 504         let modsDone = reverse modsUpswept
 505
 506         -- Try and do linking in some form, depending on whether the
 507         -- upsweep was completely or only partially successful.
 508
 509         if succeeded upsweep_ok
 510
 511          then
 512            -- Easy; just relink it all.
 513            do debugTraceMsg dflags 2 "Upsweep completely successful."
 514
 515               -- Clean up after ourselves
 516               cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
 517
 518               -- Issue a warning for the confusing case where the user
 519               -- said '-o foo' but we're not going to do any linking.
 520               -- We attempt linking if either (a) one of the modules is
 521               -- called Main, or (b) the user said -no-hs-main, indicating
 522               -- that main() is going to come from somewhere else.
 523               --
 524               let ofile = outputFile dflags
 525               let no_hs_main = dopt Opt_NoHsMain dflags
 526               let mb_main_mod = mainModIs dflags
 527               let
 528                 main_mod = mb_main_mod `orElse` "Main"
 529                 a_root_is_Main
 530                     = any ((==main_mod).moduleUserString.ms_mod)
 531                           mod_graph
 532                 do_linking = a_root_is_Main || no_hs_main
 533
 534               when (ghci_mode == BatchCompile && isJust ofile && not do_linking) $
 535                 debugTraceMsg dflags 1 ("Warning: output was redirected with -o, " ++
 536                                    "but no output will be generated\n" ++
 537                                    "because there is no " ++ main_mod ++ " module.")
 538
 539               -- link everything together
 540               linkresult <- link ghci_mode dflags do_linking (hsc_HPT hsc_env1)
 541
 542               loadFinish Succeeded linkresult ref hsc_env1
 543
 544          else
 545            -- Tricky.  We need to back out the effects of compiling any
 546            -- half-done cycles, both so as to clean up the top level envs
 547            -- and to avoid telling the interactive linker to link them.
 548            do debugTraceMsg dflags 2 "Upsweep partially successful."
 549
 550               let modsDone_names
 551                      = map ms_mod modsDone
 552               let mods_to_zap_names
 553                      = findPartiallyCompletedCycles modsDone_names
 554                           mg2_with_srcimps
 555               let mods_to_keep
 556                      = filter ((`notElem` mods_to_zap_names).ms_mod)
 557                           modsDone
 558
 559               let hpt4 = retainInTopLevelEnvs (map ms_mod mods_to_keep)
 560                                               (hsc_HPT hsc_env1)
 561
 562               -- Clean up after ourselves
 563               cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
 564
 565               -- there should be no Nothings where linkables should be, now
 566               ASSERT(all (isJust.hm_linkable)
 567                         (moduleEnvElts (hsc_HPT hsc_env))) do
 568
 569               -- Link everything together
 570               linkresult <- link ghci_mode dflags False hpt4
 571
 572               let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
 573               loadFinish Failed linkresult ref hsc_env4
 574
 575 -- Finish up after a load.
 576
 577 -- If the link failed, unload everything and return.
 578 loadFinish all_ok Failed ref hsc_env
 579   = do unload hsc_env []
 580        writeIORef ref $! discardProg hsc_env
 581        return Failed
 582
 583 -- Empty the interactive context and set the module context to the topmost
 584 -- newly loaded module, or the Prelude if none were loaded.
 585 loadFinish all_ok Succeeded ref hsc_env
 586   = do writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
 587        return all_ok
 588
 589
 590 -- Forget the current program, but retain the persistent info in HscEnv
 591 discardProg :: HscEnv -> HscEnv
 592 discardProg hsc_env
 593   = hsc_env { hsc_mod_graph = emptyMG,
 594               hsc_IC = emptyInteractiveContext,
 595               hsc_HPT = emptyHomePackageTable }
 596
 597 -- used to fish out the preprocess output files for the purposes of
 598 -- cleaning up.  The preprocessed file *might* be the same as the
 599 -- source file, but that doesn't do any harm.
 600 ppFilesFromSummaries summaries = [ fn | Just fn <- map ms_hspp_file summaries ]
 601
 602 -----------------------------------------------------------------------------
 603 -- Unloading
 604
 605 unload :: HscEnv -> [Linkable] -> IO ()
 606 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
 607   = case ghcMode (hsc_dflags hsc_env) of
 608         BatchCompile  -> return ()
 609         JustTypecheck -> return ()
 610 #ifdef GHCI
 611         Interactive -> Linker.unload (hsc_dflags hsc_env) stable_linkables
 612 #else
 613         Interactive -> panic "unload: no interpreter"
 614 #endif
 615         other -> panic "unload: strange mode"
 616
 617 -- -----------------------------------------------------------------------------
 618 -- checkStability
 619
 620 {-
 621   Stability tells us which modules definitely do not need to be recompiled.
 622   There are two main reasons for having stability:
 623
 624    - avoid doing a complete upsweep of the module graph in GHCi when
 625      modules near the bottom of the tree have not changed.
 626
 627    - to tell GHCi when it can load object code: we can only load object code
 628      for a module when we also load object code fo  all of the imports of the
 629      module.  So we need to know that we will definitely not be recompiling
 630      any of these modules, and we can use the object code.
 631
 632   NB. stability is of no importance to BatchCompile at all, only Interactive.
 633   (ToDo: what about JustTypecheck?)
 634
 635   The stability check is as follows.  Both stableObject and
 636   stableBCO are used during the upsweep phase later.
 637
 638   -------------------
 639   stable m = stableObject m || stableBCO m
 640
 641   stableObject m =
 642         all stableObject (imports m)
 643         && old linkable does not exist, or is == on-disk .o
 644         && date(on-disk .o) > date(.hs)
 645
 646   stableBCO m =
 647         all stable (imports m)
 648         && date(BCO) > date(.hs)
 649   -------------------
 650
 651   These properties embody the following ideas:
 652
 653     - if a module is stable:
 654         - if it has been compiled in a previous pass (present in HPT)
 655           then it does not need to be compiled or re-linked.
 656         - if it has not been compiled in a previous pass,
 657           then we only need to read its .hi file from disk and
 658           link it to produce a ModDetails.
 659
 660     - if a modules is not stable, we will definitely be at least
 661       re-linking, and possibly re-compiling it during the upsweep.
 662       All non-stable modules can (and should) therefore be unlinked
 663       before the upsweep.
 664
 665     - Note that objects are only considered stable if they only depend
 666       on other objects.  We can't link object code against byte code.
 667 -}
 668
 669 checkStability
 670         :: HomePackageTable             -- HPT from last compilation
 671         -> [SCC ModSummary]             -- current module graph (cyclic)
 672         -> [Module]                     -- all home modules
 673         -> ([Module],                   -- stableObject
 674             [Module])                   -- stableBCO
 675
 676 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
 677   where
 678    checkSCC (stable_obj, stable_bco) scc0
 679      | stableObjects = (scc_mods ++ stable_obj, stable_bco)
 680      | stableBCOs    = (stable_obj, scc_mods ++ stable_bco)
 681      | otherwise     = (stable_obj, stable_bco)
 682      where
 683         scc = flattenSCC scc0
 684         scc_mods = map ms_mod scc
 685         home_module m   = m `elem` all_home_mods && m `notElem` scc_mods
 686
 687         scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
 688             -- all imports outside the current SCC, but in the home pkg
 689
 690         stable_obj_imps = map (`elem` stable_obj) scc_allimps
 691         stable_bco_imps = map (`elem` stable_bco) scc_allimps
 692
 693         stableObjects =
 694            and stable_obj_imps
 695            && all object_ok scc
 696
 697         stableBCOs =
 698            and (zipWith (||) stable_obj_imps stable_bco_imps)
 699            && all bco_ok scc
 700
 701         object_ok ms
 702           | Just t <- ms_obj_date ms  =  t >= ms_hs_date ms
 703                                          && same_as_prev t
 704           | otherwise = False
 705           where
 706              same_as_prev t = case lookupModuleEnv hpt (ms_mod ms) of
 707                                 Nothing  -> True
 708                                 Just hmi  | Just l <- hm_linkable hmi
 709                                  -> isObjectLinkable l && t == linkableTime l
 710                 -- why '>=' rather than '>' above?  If the filesystem stores
 711                 -- times to the nearset second, we may occasionally find that
 712                 -- the object & source have the same modification time,
 713                 -- especially if the source was automatically generated
 714                 -- and compiled.  Using >= is slightly unsafe, but it matches
 715                 -- make's behaviour.
 716
 717         bco_ok ms
 718           = case lookupModuleEnv hpt (ms_mod ms) of
 719                 Nothing  -> False
 720                 Just hmi  | Just l <- hm_linkable hmi ->
 721                         not (isObjectLinkable l) &&
 722                         linkableTime l >= ms_hs_date ms
 723
 724 ms_allimps :: ModSummary -> [Module]
 725 ms_allimps ms = ms_srcimps ms ++ ms_imps ms
 726
 727 -- -----------------------------------------------------------------------------
 728 -- Prune the HomePackageTable
 729
 730 -- Before doing an upsweep, we can throw away:
 731 --
 732 --   - For non-stable modules:
 733 --      - all ModDetails, all linked code
 734 --   - all unlinked code that is out of date with respect to
 735 --     the source file
 736 --
 737 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
 738 -- space at the end of the upsweep, because the topmost ModDetails of the
 739 -- old HPT holds on to the entire type environment from the previous
 740 -- compilation.
 741
 742 pruneHomePackageTable
 743    :: HomePackageTable
 744    -> [ModSummary]
 745    -> ([Module],[Module])
 746    -> HomePackageTable
 747
 748 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
 749   = mapModuleEnv prune hpt
 750   where prune hmi
 751           | is_stable modl = hmi'
 752           | otherwise      = hmi'{ hm_details = emptyModDetails }
 753           where
 754            modl = mi_module (hm_iface hmi)
 755            hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
 756                 = hmi{ hm_linkable = Nothing }
 757                 | otherwise
 758                 = hmi
 759                 where ms = expectJust "prune" (lookupModuleEnv ms_map modl)
 760
 761         ms_map = mkModuleEnv [(ms_mod ms, ms) | ms <- summ]
 762
 763         is_stable m = m `elem` stable_obj || m `elem` stable_bco
 764
 765 -- -----------------------------------------------------------------------------
 766
 767 -- Return (names of) all those in modsDone who are part of a cycle
 768 -- as defined by theGraph.
 769 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
 770 findPartiallyCompletedCycles modsDone theGraph
 771    = chew theGraph
 772      where
 773         chew [] = []
 774         chew ((AcyclicSCC v):rest) = chew rest    -- acyclic?  not interesting.
 775         chew ((CyclicSCC vs):rest)
 776            = let names_in_this_cycle = nub (map ms_mod vs)
 777                  mods_in_this_cycle
 778                     = nub ([done | done <- modsDone,
 779                                    done `elem` names_in_this_cycle])
 780                  chewed_rest = chew rest
 781              in
 782              if   notNull mods_in_this_cycle
 783                   && length mods_in_this_cycle < length names_in_this_cycle
 784              then mods_in_this_cycle ++ chewed_rest
 785              else chewed_rest
 786
 787 -- -----------------------------------------------------------------------------
 788 -- The upsweep
 789
 790 -- This is where we compile each module in the module graph, in a pass
 791 -- from the bottom to the top of the graph.
 792
 793 -- There better had not be any cyclic groups here -- we check for them.
 794
 795 upsweep
 796     :: HscEnv                   -- Includes initially-empty HPT
 797     -> HomePackageTable         -- HPT from last time round (pruned)
 798     -> ([Module],[Module])      -- stable modules (see checkStability)
 799     -> IO ()                    -- How to clean up unwanted tmp files
 800     -> [SCC ModSummary]         -- Mods to do (the worklist)
 801     -> IO (SuccessFlag,
 802            HscEnv,              -- With an updated HPT
 803            [ModSummary])        -- Mods which succeeded
 804
 805 upsweep hsc_env old_hpt stable_mods cleanup
 806      []
 807    = return (Succeeded, hsc_env, [])
 808
 809 upsweep hsc_env old_hpt stable_mods cleanup
 810      (CyclicSCC ms:_)
 811    = do putMsg (showSDoc (cyclicModuleErr ms))
 812         return (Failed, hsc_env, [])
 813
 814 upsweep hsc_env old_hpt stable_mods cleanup
 815      (AcyclicSCC mod:mods)
 816    = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
 817         --           show (map (moduleUserString.moduleName.mi_module.hm_iface)
 818         --                     (moduleEnvElts (hsc_HPT hsc_env)))
 819
 820         mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod
 821
 822         cleanup         -- Remove unwanted tmp files between compilations
 823
 824         case mb_mod_info of
 825             Nothing -> return (Failed, hsc_env, [])
 826             Just mod_info -> do
 827                 { let this_mod = ms_mod mod
 828
 829                         -- Add new info to hsc_env
 830                       hpt1     = extendModuleEnv (hsc_HPT hsc_env)
 831                                         this_mod mod_info
 832                       hsc_env1 = hsc_env { hsc_HPT = hpt1 }
 833
 834                         -- Space-saving: delete the old HPT entry
 835                         -- for mod BUT if mod is a hs-boot
 836                         -- node, don't delete it.  For the
 837                         -- interface, the HPT entry is probaby for the
 838                         -- main Haskell source file.  Deleting it
 839                         -- would force .. (what?? --SDM)
 840                       old_hpt1 | isBootSummary mod = old_hpt
 841                                | otherwise = delModuleEnv old_hpt this_mod
 842
 843                 ; (restOK, hsc_env2, modOKs)
 844                         <- upsweep hsc_env1 old_hpt1 stable_mods cleanup mods
 845                 ; return (restOK, hsc_env2, mod:modOKs)
 846                 }
 847
 848
 849 -- Compile a single module.  Always produce a Linkable for it if
 850 -- successful.  If no compilation happened, return the old Linkable.
 851 upsweep_mod :: HscEnv
 852             -> HomePackageTable
 853             -> ([Module],[Module])
 854             -> ModSummary
 855             -> IO (Maybe HomeModInfo)   -- Nothing => Failed
 856
 857 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary
 858    = do
 859         let
 860             this_mod    = ms_mod summary
 861             mb_obj_date = ms_obj_date summary
 862             obj_fn      = ml_obj_file (ms_location summary)
 863             hs_date     = ms_hs_date summary
 864
 865             compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
 866             compile_it  = upsweep_compile hsc_env old_hpt this_mod summary
 867
 868         case ghcMode (hsc_dflags hsc_env) of
 869             BatchCompile ->
 870                 case () of
 871                    -- Batch-compilating is easy: just check whether we have
 872                    -- an up-to-date object file.  If we do, then the compiler
 873                    -- needs to do a recompilation check.
 874                    _ | Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
 875                            linkable <-
 876                                 findObjectLinkable this_mod obj_fn obj_date
 877                            compile_it (Just linkable)
 878
 879                      | otherwise ->
 880                            compile_it Nothing
 881
 882             interactive ->
 883                 case () of
 884                     _ | is_stable_obj, isJust old_hmi ->
 885                            return old_hmi
 886                         -- object is stable, and we have an entry in the
 887                         -- old HPT: nothing to do
 888
 889                       | is_stable_obj, isNothing old_hmi -> do
 890                            linkable <-
 891                                 findObjectLinkable this_mod obj_fn
 892                                         (expectJust "upseep1" mb_obj_date)
 893                            compile_it (Just linkable)
 894                         -- object is stable, but we need to load the interface
 895                         -- off disk to make a HMI.
 896
 897                       | is_stable_bco ->
 898                            ASSERT(isJust old_hmi) -- must be in the old_hpt
 899                            return old_hmi
 900                         -- BCO is stable: nothing to do
 901
 902                       | Just hmi <- old_hmi,
 903                         Just l <- hm_linkable hmi, not (isObjectLinkable l),
 904                         linkableTime l >= ms_hs_date summary ->
 905                            compile_it (Just l)
 906                         -- we have an old BCO that is up to date with respect
 907                         -- to the source: do a recompilation check as normal.
 908
 909                       | otherwise ->
 910                           compile_it Nothing
 911                         -- no existing code at all: we must recompile.
 912                    where
 913                     is_stable_obj = this_mod `elem` stable_obj
 914                     is_stable_bco = this_mod `elem` stable_bco
 915
 916                     old_hmi = lookupModuleEnv old_hpt this_mod
 917
 918 -- Run hsc to compile a module
 919 upsweep_compile hsc_env old_hpt this_mod summary mb_old_linkable = do
 920   let
 921         -- The old interface is ok if it's in the old HPT
 922         --      a) we're compiling a source file, and the old HPT
 923         --      entry is for a source file
 924         --      b) we're compiling a hs-boot file
 925         -- Case (b) allows an hs-boot file to get the interface of its
 926         -- real source file on the second iteration of the compilation
 927         -- manager, but that does no harm.  Otherwise the hs-boot file
 928         -- will always be recompiled
 929
 930         mb_old_iface
 931                 = case lookupModuleEnv old_hpt this_mod of
 932                      Nothing                              -> Nothing
 933                      Just hm_info | isBootSummary summary -> Just iface
 934                                   | not (mi_boot iface)   -> Just iface
 935                                   | otherwise             -> Nothing
 936                                    where
 937                                      iface = hm_iface hm_info
 938
 939   compresult <- compile hsc_env summary mb_old_linkable mb_old_iface
 940
 941   case compresult of
 942         -- Compilation failed.  Compile may still have updated the PCS, tho.
 943         CompErrs -> return Nothing
 944
 945         -- Compilation "succeeded", and may or may not have returned a new
 946         -- linkable (depending on whether compilation was actually performed
 947         -- or not).
 948         CompOK new_details new_iface new_linkable
 949               -> do let new_info = HomeModInfo { hm_iface = new_iface,
 950                                                  hm_details = new_details,
 951                                                  hm_linkable = new_linkable }
 952                     return (Just new_info)
 953
 954
 955 -- Filter modules in the HPT
 956 retainInTopLevelEnvs :: [Module] -> HomePackageTable -> HomePackageTable
 957 retainInTopLevelEnvs keep_these hpt
 958    = mkModuleEnv [ (mod, expectJust "retain" mb_mod_info)
 959                  | mod <- keep_these
 960                  , let mb_mod_info = lookupModuleEnv hpt mod
 961                  , isJust mb_mod_info ]
 962
 963 -- ---------------------------------------------------------------------------
 964 -- Topological sort of the module graph
 965
 966 topSortModuleGraph
 967           :: Bool               -- Drop hi-boot nodes? (see below)
 968           -> [ModSummary]
 969           -> Maybe Module
 970           -> [SCC ModSummary]
 971 -- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
 972 -- The resulting list of strongly-connected-components is in topologically
 973 -- sorted order, starting with the module(s) at the bottom of the
 974 -- dependency graph (ie compile them first) and ending with the ones at
 975 -- the top.
 976 --
 977 -- Drop hi-boot nodes (first boolean arg)?
 978 --
 979 --   False:     treat the hi-boot summaries as nodes of the graph,
 980 --              so the graph must be acyclic
 981 --
 982 --   True:      eliminate the hi-boot nodes, and instead pretend
 983 --              the a source-import of Foo is an import of Foo
 984 --              The resulting graph has no hi-boot nodes, but can by cyclic
 985
 986 topSortModuleGraph drop_hs_boot_nodes summaries Nothing
 987   = stronglyConnComp (fst (moduleGraphNodes drop_hs_boot_nodes summaries))
 988 topSortModuleGraph drop_hs_boot_nodes summaries (Just mod)
 989   = stronglyConnComp (map vertex_fn (reachable graph root))
 990   where
 991         -- restrict the graph to just those modules reachable from
 992         -- the specified module.  We do this by building a graph with
 993         -- the full set of nodes, and determining the reachable set from
 994         -- the specified node.
 995         (nodes, lookup_key) = moduleGraphNodes drop_hs_boot_nodes summaries
 996         (graph, vertex_fn, key_fn) = graphFromEdges' nodes
 997         root
 998           | Just key <- lookup_key HsSrcFile mod, Just v <- key_fn key = v
 999           | otherwise  = throwDyn (ProgramError "module does not exist")
1000
1001 moduleGraphNodes :: Bool -> [ModSummary]
1002   -> ([(ModSummary, Int, [Int])], HscSource -> Module -> Maybe Int)
1003 moduleGraphNodes drop_hs_boot_nodes summaries = (nodes, lookup_key)
1004    where
1005         -- Drop hs-boot nodes by using HsSrcFile as the key
1006         hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1007                     | otherwise          = HsBootFile
1008
1009         -- We use integers as the keys for the SCC algorithm
1010         nodes :: [(ModSummary, Int, [Int])]
1011         nodes = [(s, expectJust "topSort" (lookup_key (ms_hsc_src s) (ms_mod s)),
1012                      out_edge_keys hs_boot_key (ms_srcimps s) ++
1013                      out_edge_keys HsSrcFile   (ms_imps s)    )
1014                 | s <- summaries
1015                 , not (isBootSummary s && drop_hs_boot_nodes) ]
1016                 -- Drop the hi-boot ones if told to do so
1017
1018         key_map :: NodeMap Int
1019         key_map = listToFM ([(ms_mod s, ms_hsc_src s) | s <- summaries]
1020                            `zip` [1..])
1021
1022         lookup_key :: HscSource -> Module -> Maybe Int
1023         lookup_key hs_src mod = lookupFM key_map (mod, hs_src)
1024
1025         out_edge_keys :: HscSource -> [Module] -> [Int]
1026         out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1027                 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1028                 -- the IsBootInterface parameter True; else False
1029
1030
1031 type NodeKey   = (Module, HscSource)      -- The nodes of the graph are
1032 type NodeMap a = FiniteMap NodeKey a      -- keyed by (mod, src_file_type) pairs
1033
1034 msKey :: ModSummary -> NodeKey
1035 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (mod,boot)
1036
1037 emptyNodeMap :: NodeMap a
1038 emptyNodeMap = emptyFM
1039
1040 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1041 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
1042
1043 nodeMapElts :: NodeMap a -> [a]
1044 nodeMapElts = eltsFM
1045
1046 -- -----------------------------------------------------------------
1047 -- The unlinked image
1048 --
1049 -- The compilation manager keeps a list of compiled, but as-yet unlinked
1050 -- binaries (byte code or object code).  Even when it links bytecode
1051 -- it keeps the unlinked version so it can re-link it later without
1052 -- recompiling.
1053
1054 type UnlinkedImage = [Linkable] -- the unlinked images (should be a set, really)
1055
1056 findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable
1057 findModuleLinkable_maybe lis mod
1058    = case [LM time nm us | LM time nm us <- lis, nm == mod] of
1059         []   -> Nothing
1060         [li] -> Just li
1061         many -> pprPanic "findModuleLinkable" (ppr mod)
1062
1063 delModuleLinkable :: [Linkable] -> Module -> [Linkable]
1064 delModuleLinkable ls mod = [ l | l@(LM _ nm _) <- ls, nm /= mod ]
1065
1066 -----------------------------------------------------------------------------
1067 -- Downsweep (dependency analysis)
1068
1069 -- Chase downwards from the specified root set, returning summaries
1070 -- for all home modules encountered.  Only follow source-import
1071 -- links.
1072
1073 -- We pass in the previous collection of summaries, which is used as a
1074 -- cache to avoid recalculating a module summary if the source is
1075 -- unchanged.
1076 --
1077 -- The returned list of [ModSummary] nodes has one node for each home-package
1078 -- module, plus one for any hs-boot files.  The imports of these nodes
1079 -- are all there, including the imports of non-home-package modules.
1080
1081 downsweep :: HscEnv
1082           -> [ModSummary]       -- Old summaries
1083           -> [Module]           -- Ignore dependencies on these; treat them as
1084                                 -- if they were package modules
1085           -> IO [ModSummary]
1086 downsweep hsc_env old_summaries excl_mods
1087    = do rootSummaries <- mapM getRootSummary roots
1088         checkDuplicates rootSummaries
1089         loop (concatMap msDeps rootSummaries)
1090              (mkNodeMap rootSummaries)
1091      where
1092         roots = hsc_targets hsc_env
1093
1094         old_summary_map :: NodeMap ModSummary
1095         old_summary_map = mkNodeMap old_summaries
1096
1097         getRootSummary :: Target -> IO ModSummary
1098         getRootSummary (Target (TargetFile file) maybe_buf)
1099            = do exists <- doesFileExist file
1100                 if exists then summariseFile hsc_env file maybe_buf else do
1101                 throwDyn (CmdLineError ("can't find file: " ++ file))
1102         getRootSummary (Target (TargetModule modl) maybe_buf)
1103            = do maybe_summary <- summarise hsc_env emptyNodeMap Nothing False
1104                                            modl maybe_buf excl_mods
1105                 case maybe_summary of
1106                    Nothing -> packageModErr modl
1107                    Just s  -> return s
1108
1109         -- In a root module, the filename is allowed to diverge from the module
1110         -- name, so we have to check that there aren't multiple root files
1111         -- defining the same module (otherwise the duplicates will be silently
1112         -- ignored, leading to confusing behaviour).
1113         checkDuplicates :: [ModSummary] -> IO ()
1114         checkDuplicates summaries = mapM_ check summaries
1115           where check summ =
1116                   case dups of
1117                         []     -> return ()
1118                         [_one] -> return ()
1119                         many   -> multiRootsErr modl many
1120                    where modl = ms_mod summ
1121                          dups =
1122                            [ expectJust "checkDup" (ml_hs_file (ms_location summ'))
1123                            | summ' <- summaries, ms_mod summ' == modl ]
1124
1125         loop :: [(FilePath,Module,IsBootInterface)]
1126                         -- Work list: process these modules
1127              -> NodeMap ModSummary
1128                         -- Visited set
1129              -> IO [ModSummary]
1130                         -- The result includes the worklist, except
1131                         -- for those mentioned in the visited set
1132         loop [] done      = return (nodeMapElts done)
1133         loop ((cur_path, wanted_mod, is_boot) : ss) done
1134           | key `elemFM` done = loop ss done
1135           | otherwise         = do { mb_s <- summarise hsc_env old_summary_map
1136                                                  (Just cur_path) is_boot
1137                                                  wanted_mod Nothing excl_mods
1138                                    ; case mb_s of
1139                                         Nothing -> loop ss done
1140                                         Just s  -> loop (msDeps s ++ ss)
1141                                                         (addToFM done key s) }
1142           where
1143             key = (wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1144
1145 msDeps :: ModSummary -> [(FilePath,             -- Importing module
1146                           Module,               -- Imported module
1147                           IsBootInterface)]      -- {-# SOURCE #-} import or not
1148 -- (msDeps s) returns the dependencies of the ModSummary s.
1149 -- A wrinkle is that for a {-# SOURCE #-} import we return
1150 --      *both* the hs-boot file
1151 --      *and* the source file
1152 -- as "dependencies".  That ensures that the list of all relevant
1153 -- modules always contains B.hs if it contains B.hs-boot.
1154 -- Remember, this pass isn't doing the topological sort.  It's
1155 -- just gathering the list of all relevant ModSummaries
1156 msDeps s =  concat [ [(f, m, True), (f,m,False)] | m <- ms_srcimps s]
1157          ++ [(f,m,False) | m <- ms_imps    s]
1158         where
1159           f = msHsFilePath s    -- Keep the importing module for error reporting
1160
1161
1162 -----------------------------------------------------------------------------
1163 -- Summarising modules
1164
1165 -- We have two types of summarisation:
1166 --
1167 --    * Summarise a file.  This is used for the root module(s) passed to
1168 --      cmLoadModules.  The file is read, and used to determine the root
1169 --      module name.  The module name may differ from the filename.
1170 --
1171 --    * Summarise a module.  We are given a module name, and must provide
1172 --      a summary.  The finder is used to locate the file in which the module
1173 --      resides.
1174
1175 summariseFile :: HscEnv -> FilePath
1176    -> Maybe (StringBuffer,ClockTime)
1177    -> IO ModSummary
1178 -- Used for Haskell source only, I think
1179 -- We know the file name, and we know it exists,
1180 -- but we don't necessarily know the module name (might differ)
1181 summariseFile hsc_env file maybe_buf
1182    = do let dflags = hsc_dflags hsc_env
1183
1184         (dflags', hspp_fn, buf)
1185             <- preprocessFile dflags file maybe_buf
1186
1187         (srcimps,the_imps,mod) <- getImports dflags' buf hspp_fn
1188
1189         -- Make a ModLocation for this file
1190         location <- mkHomeModLocation dflags mod file
1191
1192         -- Tell the Finder cache where it is, so that subsequent calls
1193         -- to findModule will find it, even if it's not on any search path
1194         addHomeModuleToFinder hsc_env mod location
1195
1196         src_timestamp <- case maybe_buf of
1197                            Just (_,t) -> return t
1198                            Nothing    -> getModificationTime file
1199
1200         obj_timestamp <- modificationTimeIfExists (ml_obj_file location)
1201
1202         return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1203                              ms_location = location,
1204                              ms_hspp_file = Just hspp_fn,
1205                              ms_hspp_buf  = Just buf,
1206                              ms_srcimps = srcimps, ms_imps = the_imps,
1207                              ms_hs_date = src_timestamp,
1208                              ms_obj_date = obj_timestamp })
1209
1210 -- Summarise a module, and pick up source and timestamp.
1211 summarise :: HscEnv
1212           -> NodeMap ModSummary -- Map of old summaries
1213           -> Maybe FilePath     -- Importing module (for error messages)
1214           -> IsBootInterface    -- True <=> a {-# SOURCE #-} import
1215           -> Module             -- Imported module to be summarised
1216           -> Maybe (StringBuffer, ClockTime)
1217           -> [Module]           -- Modules to exclude
1218           -> IO (Maybe ModSummary)      -- Its new summary
1219
1220 summarise hsc_env old_summary_map cur_mod is_boot wanted_mod maybe_buf excl_mods
1221   | wanted_mod `elem` excl_mods
1222   = return Nothing
1223
1224   | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
1225   = do          -- Find its new timestamp; all the
1226                 -- ModSummaries in the old map have valid ml_hs_files
1227         let location = ms_location old_summary
1228             src_fn = expectJust "summarise" (ml_hs_file location)
1229
1230                 -- return the cached summary if the source didn't change
1231         src_timestamp <- case maybe_buf of
1232                            Just (_,t) -> return t
1233                            Nothing    -> getModificationTime src_fn
1234
1235         if ms_hs_date old_summary == src_timestamp
1236            then do -- update the object-file timestamp
1237                   obj_timestamp <- getObjTimestamp location is_boot
1238                   return (Just old_summary{ ms_obj_date = obj_timestamp })
1239            else
1240                 -- source changed: re-summarise
1241                 new_summary location src_fn maybe_buf src_timestamp
1242
1243   | otherwise
1244   = do  found <- findModule hsc_env wanted_mod True {-explicit-}
1245         case found of
1246              Found location pkg
1247                 | not (isHomePackage pkg) -> return Nothing
1248                         -- Drop external-pkg
1249                 | isJust (ml_hs_file location) -> just_found location
1250                         -- Home package
1251              err -> noModError dflags cur_mod wanted_mod err
1252                         -- Not found
1253   where
1254     dflags = hsc_dflags hsc_env
1255
1256     hsc_src = if is_boot then HsBootFile else HsSrcFile
1257
1258     just_found location = do
1259                 -- Adjust location to point to the hs-boot source file,
1260                 -- hi file, object file, when is_boot says so
1261         let location' | is_boot   = addBootSuffixLocn location
1262                       | otherwise = location
1263             src_fn = expectJust "summarise2" (ml_hs_file location')
1264
1265                 -- Check that it exists
1266                 -- It might have been deleted since the Finder last found it
1267         maybe_t <- modificationTimeIfExists src_fn
1268         case maybe_t of
1269           Nothing -> noHsFileErr cur_mod src_fn
1270           Just t  -> new_summary location' src_fn Nothing t
1271
1272
1273     new_summary location src_fn maybe_bug src_timestamp
1274       = do
1275         -- Preprocess the source file and get its imports
1276         -- The dflags' contains the OPTIONS pragmas
1277         (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn maybe_buf
1278         (srcimps, the_imps, mod_name) <- getImports dflags' buf hspp_fn
1279
1280         when (mod_name /= wanted_mod) $
1281                 throwDyn (ProgramError
1282                    (showSDoc (text src_fn
1283                               <>  text ": file name does not match module name"
1284                               <+> quotes (ppr mod_name))))
1285
1286                 -- Find the object timestamp, and return the summary
1287         obj_timestamp <- getObjTimestamp location is_boot
1288
1289         return (Just ( ModSummary { ms_mod       = wanted_mod,
1290                                     ms_hsc_src   = hsc_src,
1291                                     ms_location  = location,
1292                                     ms_hspp_file = Just hspp_fn,
1293                                     ms_hspp_buf  = Just buf,
1294                                     ms_srcimps   = srcimps,
1295                                     ms_imps      = the_imps,
1296                                     ms_hs_date   = src_timestamp,
1297                                     ms_obj_date  = obj_timestamp }))
1298
1299
1300 getObjTimestamp location is_boot
1301   = if is_boot then return Nothing
1302                else modificationTimeIfExists (ml_obj_file location)
1303
1304
1305 preprocessFile :: DynFlags -> FilePath -> Maybe (StringBuffer,ClockTime)
1306   -> IO (DynFlags, FilePath, StringBuffer)
1307 preprocessFile dflags src_fn Nothing
1308   = do
1309         (dflags', hspp_fn) <- preprocess dflags src_fn
1310         buf <- hGetStringBuffer hspp_fn
1311         return (dflags', hspp_fn, buf)
1312
1313 preprocessFile dflags src_fn (Just (buf, time))
1314   = do
1315         -- case we bypass the preprocessing stage?
1316         let
1317             local_opts = getOptionsFromStringBuffer buf
1318         --
1319         (dflags', errs) <- parseDynamicFlags dflags local_opts
1320
1321         let
1322             needs_preprocessing
1323                 | Unlit _ <- startPhase src_fn  = True
1324                   -- note: local_opts is only required if there's no Unlit phase
1325                 | dopt Opt_Cpp dflags'          = True
1326                 | dopt Opt_Pp  dflags'          = True
1327                 | otherwise                     = False
1328
1329         when needs_preprocessing $
1330            ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
1331
1332         return (dflags', "<buffer>", buf)
1333
1334
1335 -----------------------------------------------------------------------------
1336 --                      Error messages
1337 -----------------------------------------------------------------------------
1338
1339 noModError :: DynFlags -> Maybe FilePath -> Module -> FindResult -> IO ab
1340 -- ToDo: we don't have a proper line number for this error
1341 noModError dflags cur_mod wanted_mod err
1342   = throwDyn $ ProgramError $ showSDoc $
1343     vcat [cantFindError dflags wanted_mod err,
1344           nest 2 (parens (pp_where cur_mod))]
1345
1346 noHsFileErr cur_mod path
1347   = throwDyn $ CmdLineError $ showSDoc $
1348     vcat [text "Can't find" <+> text path,
1349           nest 2 (parens (pp_where cur_mod))]
1350
1351 pp_where Nothing  = text "one of the roots of the dependency analysis"
1352 pp_where (Just p) = text "imported from" <+> text p
1353
1354 packageModErr mod
1355   = throwDyn (CmdLineError (showSDoc (text "module" <+>
1356                                    quotes (ppr mod) <+>
1357                                    text "is a package module")))
1358
1359 multiRootsErr mod files
1360   = throwDyn (ProgramError (showSDoc (
1361         text "module" <+> quotes (ppr mod) <+>
1362         text "is defined in multiple files:" <+>
1363         sep (map text files))))
1364
1365 cyclicModuleErr :: [ModSummary] -> SDoc
1366 cyclicModuleErr ms
1367   = hang (ptext SLIT("Module imports form a cycle for modules:"))
1368        2 (vcat (map show_one ms))
1369   where
1370     show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
1371                         nest 2 $ ptext SLIT("imports:") <+>
1372                                    (pp_imps HsBootFile (ms_srcimps ms)
1373                                    $$ pp_imps HsSrcFile  (ms_imps ms))]
1374     show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
1375     pp_imps src mods = fsep (map (show_mod src) mods)
1376
1377
1378 -- | Inform GHC that the working directory has changed.  GHC will flush
1379 -- its cache of module locations, since it may no longer be valid.
1380 -- Note: if you change the working directory, you should also unload
1381 -- the current program (set targets to empty, followed by load).
1382 workingDirectoryChanged :: Session -> IO ()
1383 workingDirectoryChanged s = withSession s $ \hsc_env ->
1384   flushFinderCache (hsc_FC hsc_env)
1385
1386 -- -----------------------------------------------------------------------------
1387 -- inspecting the session
1388
1389 -- | Get the module dependency graph.
1390 getModuleGraph :: Session -> IO ModuleGraph -- ToDo: DiGraph ModSummary
1391 getModuleGraph s = withSession s (return . hsc_mod_graph)
1392
1393 isLoaded :: Session -> Module -> IO Bool
1394 isLoaded s m = withSession s $ \hsc_env ->
1395   return $! isJust (lookupModuleEnv (hsc_HPT hsc_env) m)
1396
1397 getBindings :: Session -> IO [TyThing]
1398 getBindings s = withSession s (return . nameEnvElts . ic_type_env . hsc_IC)
1399
1400 getPrintUnqual :: Session -> IO PrintUnqualified
1401 getPrintUnqual s = withSession s (return . icPrintUnqual . hsc_IC)
1402
1403 #ifdef GHCI
1404 -- | Parses a string as an identifier, and returns the list of 'Name's that
1405 -- the identifier can refer to in the current interactive context.
1406 parseName :: Session -> String -> IO [Name]
1407 parseName s str = withSession s $ \hsc_env -> do
1408    maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
1409    case maybe_rdr_name of
1410         Nothing -> return []
1411         Just (L _ rdr_name) -> do
1412             mb_names <- tcRnLookupRdrName hsc_env rdr_name
1413             case mb_names of
1414                 Nothing -> return []
1415                 Just ns -> return ns
1416                 -- ToDo: should return error messages
1417 #endif
1418
1419 allNamesInScope :: Session -> IO [Name]
1420 allNamesInScope s = withSession s $ \hsc_env -> do
1421   eps <- readIORef (hsc_EPS hsc_env)
1422   return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
1423
1424 -- | Returns the 'TyThing' for a 'Name'.  The 'Name' may refer to any
1425 -- entity known to GHC, including 'Name's defined using 'runStmt'.
1426 lookupName :: Session -> Name -> IO (Maybe TyThing)
1427 lookupName s name = withSession s $ \hsc_env -> do
1428   case lookupTypeEnv (ic_type_env (hsc_IC hsc_env)) name of
1429         Just tt -> return (Just tt)
1430         Nothing -> do
1431             eps <- readIORef (hsc_EPS hsc_env)
1432             return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
1433
1434 -- | Container for information about a 'Module'.
1435 newtype ModuleInfo = ModuleInfo ModDetails
1436         -- ToDo: this should really contain the ModIface too
1437         -- We don't want HomeModInfo here, because a ModuleInfo applies
1438         -- to package modules too.
1439
1440 -- | Request information about a loaded 'Module'
1441 getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
1442 getModuleInfo s mdl = withSession s $ \hsc_env -> do
1443   case lookupModuleEnv (hsc_HPT hsc_env) mdl of
1444     Nothing  -> return Nothing
1445     Just hmi -> return (Just (ModuleInfo (hm_details hmi)))
1446         -- ToDo: we should be able to call getModuleInfo on a package module,
1447         -- even one that isn't loaded yet.
1448
1449 -- | The list of top-level entities defined in a module
1450 modInfoTyThings :: ModuleInfo -> [TyThing]
1451 modInfoTyThings (ModuleInfo md) = typeEnvElts (md_types md)
1452
1453 isDictonaryId :: Id -> Bool
1454 isDictonaryId id
1455   = case tcSplitSigmaTy (idType id) of { (tvs, theta, tau) -> isDictTy tau }
1456
1457 #if 0
1458
1459 data ObjectCode
1460   = ByteCode
1461   | BinaryCode FilePath
1462
1463 type TypecheckedCode = HsTypecheckedGroup
1464 type RenamedCode     = [HsGroup Name]
1465
1466 -- ToDo: typechecks abstract syntax or renamed abstract syntax.  Issues:
1467 --   - typechecked syntax includes extra dictionary translation and
1468 --     AbsBinds which need to be translated back into something closer to
1469 --     the original source.
1470 --   - renamed syntax currently doesn't exist in a single blob, since
1471 --     renaming and typechecking are interleaved at splice points.  We'd
1472 --     need a restriction that there are no splices in the source module.
1473
1474 -- ToDo:
1475 --   - Data and Typeable instances for HsSyn.
1476
1477 -- ToDo:
1478 --   - things that aren't in the output of the renamer:
1479 --     - the export list
1480 --     - the imports
1481
1482 -- ToDo:
1483 --   - things that aren't in the output of the typechecker right now:
1484 --     - the export list
1485 --     - the imports
1486 --     - type signatures
1487 --     - type/data/newtype declarations
1488 --     - class declarations
1489 --     - instances
1490 --   - extra things in the typechecker's output:
1491 --     - default methods are turned into top-level decls.
1492 --     - dictionary bindings
1493
1494 -- ToDo: check for small transformations that happen to the syntax in
1495 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
1496
1497 -- ToDo: maybe use TH syntax instead of IfaceSyn?  There's already a way
1498 -- to get from TyCons, Ids etc. to TH syntax (reify).
1499
1500 -- :browse will use either lm_toplev or inspect lm_interface, depending
1501 -- on whether the module is interpreted or not.
1502
1503 -- various abstract syntax types (perhaps IfaceBlah)
1504 data Type = ...
1505 data Kind = ...
1506
1507 -- This is for reconstructing refactored source code
1508 -- Calls the lexer repeatedly.
1509 -- ToDo: add comment tokens to token stream
1510 getTokenStream :: Session -> Module -> IO [Located Token]
1511 #endif
1512
1513 -- -----------------------------------------------------------------------------
1514 -- Interactive evaluation
1515
1516 #ifdef GHCI
1517
1518 -- | Set the interactive evaluation context.
1519 --
1520 -- Setting the context doesn't throw away any bindings; the bindings
1521 -- we've built up in the InteractiveContext simply move to the new
1522 -- module.  They always shadow anything in scope in the current context.
1523 setContext :: Session
1524            -> [Module]  -- entire top level scope of these modules
1525            -> [Module]  -- exports only of these modules
1526            -> IO ()
1527 setContext (Session ref) toplevs exports = do
1528   hsc_env <- readIORef ref
1529   let old_ic  = hsc_IC     hsc_env
1530       hpt     = hsc_HPT    hsc_env
1531
1532   mapM_ (checkModuleExists hsc_env hpt) exports
1533   export_env  <- mkExportEnv hsc_env exports
1534   toplev_envs <- mapM (mkTopLevEnv hpt) toplevs
1535   let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
1536   writeIORef ref hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplevs,
1537                                             ic_exports      = exports,
1538                                             ic_rn_gbl_env   = all_env } }
1539
1540 checkModuleExists :: HscEnv -> HomePackageTable -> Module -> IO ()
1541 checkModuleExists hsc_env hpt mod =
1542   case lookupModuleEnv hpt mod of
1543     Just mod_info -> return ()
1544     _not_a_home_module -> do
1545           res <- findPackageModule hsc_env mod True
1546           case res of
1547             Found _ _ -> return  ()
1548             err -> let msg = cantFindError (hsc_dflags hsc_env) mod err in
1549                    throwDyn (CmdLineError (showSDoc msg))
1550
1551 mkTopLevEnv :: HomePackageTable -> Module -> IO GlobalRdrEnv
1552 mkTopLevEnv hpt modl
1553  = case lookupModuleEnv hpt modl of
1554       Nothing ->
1555          throwDyn (ProgramError ("mkTopLevEnv: not a home module "
1556                         ++ showSDoc (pprModule modl)))
1557       Just details ->
1558          case mi_globals (hm_iface details) of
1559                 Nothing  ->
1560                    throwDyn (ProgramError ("mkTopLevEnv: not interpreted "
1561                                                 ++ showSDoc (pprModule modl)))
1562                 Just env -> return env
1563
1564 -- | Get the interactive evaluation context, consisting of a pair of the
1565 -- set of modules from which we take the full top-level scope, and the set
1566 -- of modules from which we take just the exports respectively.
1567 getContext :: Session -> IO ([Module],[Module])
1568 getContext s = withSession s (\HscEnv{ hsc_IC=ic } ->
1569                                 return (ic_toplev_scope ic, ic_exports ic))
1570
1571 -- | Returns 'True' if the specified module is interpreted, and hence has
1572 -- its full top-level scope available.
1573 moduleIsInterpreted :: Session -> Module -> IO Bool
1574 moduleIsInterpreted s modl = withSession s $ \h ->
1575  case lookupModuleEnv (hsc_HPT h) modl of
1576       Just details       -> return (isJust (mi_globals (hm_iface details)))
1577       _not_a_home_module -> return False
1578
1579 -- | Looks up an identifier in the current interactive context (for :info)
1580 {-# DEPRECATED getInfo "we should be using parseName/lookupName instead" #-}
1581 getInfo :: Session -> String -> IO [GetInfoResult]
1582 getInfo s id = withSession s $ \hsc_env -> hscGetInfo hsc_env id
1583
1584 -- -----------------------------------------------------------------------------
1585 -- Getting the type of an expression
1586
1587 -- | Get the type of an expression
1588 exprType :: Session -> String -> IO (Maybe Type)
1589 exprType s expr = withSession s $ \hsc_env -> do
1590    maybe_stuff <- hscTcExpr hsc_env expr
1591    case maybe_stuff of
1592         Nothing -> return Nothing
1593         Just ty -> return (Just tidy_ty)
1594              where
1595                 tidy_ty = tidyType emptyTidyEnv ty
1596                 dflags  = hsc_dflags hsc_env
1597
1598 -- -----------------------------------------------------------------------------
1599 -- Getting the kind of a type
1600
1601 -- | Get the kind of a  type
1602 typeKind  :: Session -> String -> IO (Maybe Kind)
1603 typeKind s str = withSession s $ \hsc_env -> do
1604    maybe_stuff <- hscKcType hsc_env str
1605    case maybe_stuff of
1606         Nothing -> return Nothing
1607         Just kind -> return (Just kind)
1608
1609 -----------------------------------------------------------------------------
1610 -- cmCompileExpr: compile an expression and deliver an HValue
1611
1612 compileExpr :: Session -> String -> IO (Maybe HValue)
1613 compileExpr s expr = withSession s $ \hsc_env -> do
1614   maybe_stuff <- hscStmt hsc_env ("let __cmCompileExpr = "++expr)
1615   case maybe_stuff of
1616         Nothing -> return Nothing
1617         Just (new_ic, names, hval) -> do
1618                         -- Run it!
1619                 hvals <- (unsafeCoerce# hval) :: IO [HValue]
1620
1621                 case (names,hvals) of
1622                   ([n],[hv]) -> return (Just hv)
1623                   _          -> panic "compileExpr"
1624
1625 -- -----------------------------------------------------------------------------
1626 -- running a statement interactively
1627
1628 data RunResult
1629   = RunOk [Name]                -- ^ names bound by this evaluation
1630   | RunFailed                   -- ^ statement failed compilation
1631   | RunException Exception      -- ^ statement raised an exception
1632
1633 -- | Run a statement in the current interactive context.  Statemenet
1634 -- may bind multple values.
1635 runStmt :: Session -> String -> IO RunResult
1636 runStmt (Session ref) expr
1637    = do
1638         hsc_env <- readIORef ref
1639
1640         -- Turn off -fwarn-unused-bindings when running a statement, to hide
1641         -- warnings about the implicit bindings we introduce.
1642         let dflags'  = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
1643             hsc_env' = hsc_env{ hsc_dflags = dflags' }
1644
1645         maybe_stuff <- hscStmt hsc_env' expr
1646
1647         case maybe_stuff of
1648            Nothing -> return RunFailed
1649            Just (new_hsc_env, names, hval) -> do
1650
1651                 let thing_to_run = unsafeCoerce# hval :: IO [HValue]
1652                 either_hvals <- sandboxIO thing_to_run
1653
1654                 case either_hvals of
1655                     Left e -> do
1656                         -- on error, keep the *old* interactive context,
1657                         -- so that 'it' is not bound to something
1658                         -- that doesn't exist.
1659                         return (RunException e)
1660
1661                     Right hvals -> do
1662                         -- Get the newly bound things, and bind them.
1663                         -- Don't need to delete any shadowed bindings;
1664                         -- the new ones override the old ones.
1665                         extendLinkEnv (zip names hvals)
1666
1667                         writeIORef ref new_hsc_env
1668                         return (RunOk names)
1669
1670
1671 -- We run the statement in a "sandbox" to protect the rest of the
1672 -- system from anything the expression might do.  For now, this
1673 -- consists of just wrapping it in an exception handler, but see below
1674 -- for another version.
1675
1676 sandboxIO :: IO a -> IO (Either Exception a)
1677 sandboxIO thing = Exception.try thing
1678
1679 {-
1680 -- This version of sandboxIO runs the expression in a completely new
1681 -- RTS main thread.  It is disabled for now because ^C exceptions
1682 -- won't be delivered to the new thread, instead they'll be delivered
1683 -- to the (blocked) GHCi main thread.
1684
1685 -- SLPJ: when re-enabling this, reflect a wrong-stat error as an exception
1686
1687 sandboxIO :: IO a -> IO (Either Int (Either Exception a))
1688 sandboxIO thing = do
1689   st_thing <- newStablePtr (Exception.try thing)
1690   alloca $ \ p_st_result -> do
1691     stat <- rts_evalStableIO st_thing p_st_result
1692     freeStablePtr st_thing
1693     if stat == 1
1694         then do st_result <- peek p_st_result
1695                 result <- deRefStablePtr st_result
1696                 freeStablePtr st_result
1697                 return (Right result)
1698         else do
1699                 return (Left (fromIntegral stat))
1700
1701 foreign import "rts_evalStableIO"  {- safe -}
1702   rts_evalStableIO :: StablePtr (IO a) -> Ptr (StablePtr a) -> IO CInt
1703   -- more informative than the C type!
1704 -}
1705
1706 -- ---------------------------------------------------------------------------
1707 -- cmBrowseModule: get all the TyThings defined in a module
1708
1709 {-# DEPRECATED browseModule "we should be using getModuleInfo instead" #-}
1710 browseModule :: Session -> Module -> Bool -> IO [IfaceDecl]
1711 browseModule s modl exports_only = withSession s $ \hsc_env -> do
1712   mb_decls <- getModuleContents hsc_env modl exports_only
1713   case mb_decls of
1714         Nothing -> return []            -- An error of some kind
1715         Just ds -> return ds
1716
1717
1718 -----------------------------------------------------------------------------
1719 -- show a module and it's source/object filenames
1720
1721 showModule :: Session -> ModSummary -> IO String
1722 showModule s mod_summary = withSession s $ \hsc_env -> do
1723   case lookupModuleEnv (hsc_HPT hsc_env) (ms_mod mod_summary) of
1724         Nothing       -> panic "missing linkable"
1725         Just mod_info -> return (showModMsg obj_linkable mod_summary)
1726                       where
1727                          obj_linkable = isObjectLinkable (fromJust (hm_linkable mod_info))
1728
1729 #endif /* GHCI */