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