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         newSession,
  15
  16         -- * Flags and settings
  17         DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
  18         GhcMode(..), GhcLink(..), defaultObjectTarget,
  19         parseDynamicFlags,
  20         getSessionDynFlags,
  21         setSessionDynFlags,
  22         parseStaticFlags,
  23
  24         -- * Targets
  25         Target(..), TargetId(..), Phase,
  26         setTargets,
  27         getTargets,
  28         addTarget,
  29         removeTarget,
  30         guessTarget,
  31
  32         -- * Extending the program scope
  33         extendGlobalRdrScope,  -- :: Session -> [GlobalRdrElt] -> IO ()
  34         setGlobalRdrScope,     -- :: Session -> [GlobalRdrElt] -> IO ()
  35         extendGlobalTypeScope, -- :: Session -> [Id] -> IO ()
  36         setGlobalTypeScope,    -- :: Session -> [Id] -> IO ()
  37
  38         -- * Loading\/compiling the program
  39         depanal,
  40         load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
  41         workingDirectoryChanged,
  42         checkModule, checkAndLoadModule, CheckedModule(..),
  43         TypecheckedSource, ParsedSource, RenamedSource,
  44         compileToCore, compileToCoreModule, compileToCoreSimplified,
  45         compileCoreToObj,
  46
  47         -- * Parsing Haddock comments
  48         parseHaddockComment,
  49
  50         -- * Inspecting the module structure of the program
  51         ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
  52         getModuleGraph,
  53         isLoaded,
  54         topSortModuleGraph,
  55
  56         -- * Inspecting modules
  57         ModuleInfo,
  58         getModuleInfo,
  59         modInfoTyThings,
  60         modInfoTopLevelScope,
  61         modInfoExports,
  62         modInfoInstances,
  63         modInfoIsExportedName,
  64         modInfoLookupName,
  65         lookupGlobalName,
  66         mkPrintUnqualifiedForModule,
  67
  68         -- * Printing
  69         PrintUnqualified, alwaysQualify,
  70
  71         -- * Interactive evaluation
  72         getBindings, getPrintUnqual,
  73         findModule,
  74 #ifdef GHCI
  75         setContext, getContext,
  76         getNamesInScope,
  77         getRdrNamesInScope,
  78         getGRE,
  79         moduleIsInterpreted,
  80         getInfo,
  81         exprType,
  82         typeKind,
  83         parseName,
  84         RunResult(..),
  85         runStmt, SingleStep(..),
  86         resume,
  87         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
  88                resumeHistory, resumeHistoryIx),
  89         History(historyBreakInfo, historyEnclosingDecl),
  90         GHC.getHistorySpan, getHistoryModule,
  91         getResumeContext,
  92         abandon, abandonAll,
  93         InteractiveEval.back,
  94         InteractiveEval.forward,
  95         showModule,
  96         isModuleInterpreted,
  97         InteractiveEval.compileExpr, HValue, dynCompileExpr,
  98         lookupName,
  99         GHC.obtainTerm, GHC.obtainTerm1, GHC.obtainTermB, reconstructType,
 100         modInfoModBreaks,
 101         ModBreaks(..), BreakIndex,
 102         BreakInfo(breakInfo_number, breakInfo_module),
 103         BreakArray, setBreakOn, setBreakOff, getBreak,
 104 #endif
 105
 106         -- * Abstract syntax elements
 107
 108         -- ** Packages
 109         PackageId,
 110
 111         -- ** Modules
 112         Module, mkModule, pprModule, moduleName, modulePackageId,
 113         ModuleName, mkModuleName, moduleNameString,
 114
 115         -- ** Names
 116         Name,
 117         isExternalName, nameModule, pprParenSymName, nameSrcSpan,
 118         NamedThing(..),
 119         RdrName(Qual,Unqual),
 120
 121         -- ** Identifiers
 122         Id, idType,
 123         isImplicitId, isDeadBinder,
 124         isExportedId, isLocalId, isGlobalId,
 125         isRecordSelector,
 126         isPrimOpId, isFCallId, isClassOpId_maybe,
 127         isDataConWorkId, idDataCon,
 128         isBottomingId, isDictonaryId,
 129         recordSelectorFieldLabel,
 130
 131         -- ** Type constructors
 132         TyCon,
 133         tyConTyVars, tyConDataCons, tyConArity,
 134         isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
 135         isOpenTyCon,
 136         synTyConDefn, synTyConType, synTyConResKind,
 137
 138         -- ** Type variables
 139         TyVar,
 140         alphaTyVars,
 141
 142         -- ** Data constructors
 143         DataCon,
 144         dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
 145         dataConIsInfix, isVanillaDataCon,
 146         dataConStrictMarks,
 147         StrictnessMark(..), isMarkedStrict,
 148
 149         -- ** Classes
 150         Class,
 151         classMethods, classSCTheta, classTvsFds,
 152         pprFundeps,
 153
 154         -- ** Instances
 155         Instance,
 156         instanceDFunId, pprInstance, pprInstanceHdr,
 157
 158         -- ** Types and Kinds
 159         Type, splitForAllTys, funResultTy,
 160         pprParendType, pprTypeApp,
 161         Kind,
 162         PredType,
 163         ThetaType, pprThetaArrow,
 164
 165         -- ** Entities
 166         TyThing(..),
 167
 168         -- ** Syntax
 169         module HsSyn, -- ToDo: remove extraneous bits
 170
 171         -- ** Fixities
 172         FixityDirection(..),
 173         defaultFixity, maxPrecedence,
 174         negateFixity,
 175         compareFixity,
 176
 177         -- ** Source locations
 178         SrcLoc, pprDefnLoc,
 179         mkSrcLoc, isGoodSrcLoc, noSrcLoc,
 180         srcLocFile, srcLocLine, srcLocCol,
 181         SrcSpan,
 182         mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,
 183         srcSpanStart, srcSpanEnd,
 184         srcSpanFile,
 185         srcSpanStartLine, srcSpanEndLine,
 186         srcSpanStartCol, srcSpanEndCol,
 187
 188         -- * Exceptions
 189         GhcException(..), showGhcException,
 190
 191         -- * Miscellaneous
 192         sessionHscEnv,
 193         cyclicModuleErr,
 194   ) where
 195
 196 {-
 197  ToDo:
 198
 199   * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
 200   * what StaticFlags should we expose, if any?
 201 -}
 202
 203 #include "HsVersions.h"
 204
 205 #ifdef GHCI
 206 import qualified Linker
 207 import Linker           ( HValue )
 208 import ByteCodeInstr
 209 import BreakArray
 210 import NameSet
 211 import InteractiveEval
 212 import TcRnDriver
 213 #endif
 214
 215 import TcIface
 216 import TcRnTypes        hiding (LIE)
 217 import TcRnMonad        ( initIfaceCheck )
 218 import Packages
 219 import NameSet
 220 import RdrName
 221 import qualified HsSyn -- hack as we want to reexport the whole module
 222 import HsSyn hiding ((<.>))
 223 import Type             hiding (typeKind)
 224 import TcType           hiding (typeKind)
 225 import Id
 226 import Var              hiding (setIdType)
 227 import TysPrim          ( alphaTyVars )
 228 import TyCon
 229 import Class
 230 import FunDeps
 231 import DataCon
 232 import Name             hiding ( varName )
 233 import OccName          ( parenSymOcc )
 234 import InstEnv          ( Instance, instanceDFunId, pprInstance, pprInstanceHdr,
 235                           emptyInstEnv )
 236 import FamInstEnv       ( emptyFamInstEnv )
 237 import SrcLoc
 238 import CoreSyn
 239 import TidyPgm
 240 import DriverPipeline
 241 import DriverPhases     ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase )
 242 import HeaderInfo
 243 import Finder
 244 import HscMain
 245 import HscTypes
 246 import DynFlags
 247 import StaticFlags
 248 import SysTools     ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
 249                       cleanTempDirs )
 250 import Module
 251 import LazyUniqFM
 252 import UniqSet
 253 import Unique
 254 import FiniteMap
 255 import Panic
 256 import Digraph
 257 import Bag              ( unitBag, listToBag )
 258 import ErrUtils
 259 import Util
 260 import StringBuffer     ( StringBuffer, hGetStringBuffer )
 261 import Outputable
 262 import BasicTypes
 263 import Maybes           ( expectJust, mapCatMaybes )
 264 import HaddockParse
 265 import HaddockLex       ( tokenise )
 266 import FastString
 267
 268 import Control.Concurrent
 269 import System.Directory ( getModificationTime, doesFileExist,
 270                           getCurrentDirectory )
 271 import Data.Maybe
 272 import Data.List
 273 import qualified Data.List as List
 274 import Control.Monad
 275 import System.Exit      ( exitWith, ExitCode(..) )
 276 import System.Time      ( ClockTime, getClockTime )
 277 import Control.Exception as Exception hiding (handle)
 278 import Data.IORef
 279 import System.FilePath
 280 import System.IO
 281 import System.IO.Error  ( try, isDoesNotExistError )
 282 import Prelude hiding (init)
 283
 284
 285 -- -----------------------------------------------------------------------------
 286 -- Exception handlers
 287
 288 -- | Install some default exception handlers and run the inner computation.
 289 -- Unless you want to handle exceptions yourself, you should wrap this around
 290 -- the top level of your program.  The default handlers output the error
 291 -- message(s) to stderr and exit cleanly.
 292 defaultErrorHandler :: DynFlags -> IO a -> IO a
 293 defaultErrorHandler dflags inner =
 294   -- top-level exception handler: any unrecognised exception is a compiler bug.
 295   handle (\exception -> do
 296            hFlush stdout
 297            case exception of
 298                 -- an IO exception probably isn't our fault, so don't panic
 299                 IOException _ ->
 300                   fatalErrorMsg dflags (text (show exception))
 301                 AsyncException StackOverflow ->
 302                   fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
 303                 _other ->
 304                   fatalErrorMsg dflags (text (show (Panic (show exception))))
 305            exitWith (ExitFailure 1)
 306          ) $
 307
 308   -- program errors: messages with locations attached.  Sometimes it is
 309   -- convenient to just throw these as exceptions.
 310   handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
 311                         exitWith (ExitFailure 1)) $
 312
 313   -- error messages propagated as exceptions
 314   handleDyn (\dyn -> do
 315                 hFlush stdout
 316                 case dyn of
 317                      PhaseFailed _ code -> exitWith code
 318                      Interrupted -> exitWith (ExitFailure 1)
 319                      _ -> do fatalErrorMsg dflags (text (show (dyn :: GhcException)))
 320                              exitWith (ExitFailure 1)
 321             ) $
 322   inner
 323
 324 -- | Install a default cleanup handler to remove temporary files
 325 -- deposited by a GHC run.  This is seperate from
 326 -- 'defaultErrorHandler', because you might want to override the error
 327 -- handling, but still get the ordinary cleanup behaviour.
 328 defaultCleanupHandler :: DynFlags -> IO a -> IO a
 329 defaultCleanupHandler dflags inner =
 330     -- make sure we clean up after ourselves
 331     later (do cleanTempFiles dflags
 332               cleanTempDirs dflags
 333           )
 334           -- exceptions will be blocked while we clean the temporary files,
 335           -- so there shouldn't be any difficulty if we receive further
 336           -- signals.
 337     inner
 338
 339
 340 -- | Starts a new session.  A session consists of a set of loaded
 341 -- modules, a set of options (DynFlags), and an interactive context.
 342 -- ToDo: explain argument [[mb_top_dir]]
 343 newSession :: Maybe FilePath -> IO Session
 344 newSession mb_top_dir = do
 345   -- catch ^C
 346   main_thread <- myThreadId
 347   modifyMVar_ interruptTargetThread (return . (main_thread :))
 348   installSignalHandlers
 349
 350   initStaticOpts
 351   dflags0 <- initDynFlags defaultDynFlags
 352   dflags <- initSysTools mb_top_dir dflags0
 353   env <- newHscEnv dflags
 354   ref <- newIORef env
 355   return (Session ref)
 356
 357 -- tmp: this breaks the abstraction, but required because DriverMkDepend
 358 -- needs to call the Finder.  ToDo: untangle this.
 359 sessionHscEnv :: Session -> IO HscEnv
 360 sessionHscEnv (Session ref) = readIORef ref
 361
 362 -- -----------------------------------------------------------------------------
 363 -- Flags & settings
 364
 365 -- | Grabs the DynFlags from the Session
 366 getSessionDynFlags :: Session -> IO DynFlags
 367 getSessionDynFlags s = withSession s (return . hsc_dflags)
 368
 369 -- | Updates the DynFlags in a Session.  This also reads
 370 -- the package database (unless it has already been read),
 371 -- and prepares the compilers knowledge about packages.  It
 372 -- can be called again to load new packages: just add new
 373 -- package flags to (packageFlags dflags).
 374 --
 375 -- Returns a list of new packages that may need to be linked in using
 376 -- the dynamic linker (see 'linkPackages') as a result of new package
 377 -- flags.  If you are not doing linking or doing static linking, you
 378 -- can ignore the list of packages returned.
 379 --
 380 setSessionDynFlags :: Session -> DynFlags -> IO [PackageId]
 381 setSessionDynFlags (Session ref) dflags = do
 382   hsc_env <- readIORef ref
 383   (dflags', preload) <- initPackages dflags
 384   writeIORef ref $! hsc_env{ hsc_dflags = dflags' }
 385   return preload
 386
 387 -- | If there is no -o option, guess the name of target executable
 388 -- by using top-level source file name as a base.
 389 guessOutputFile :: Session -> IO ()
 390 guessOutputFile s = modifySession s $ \env ->
 391     let dflags = hsc_dflags env
 392         mod_graph = hsc_mod_graph env
 393         mainModuleSrcPath, guessedName :: Maybe String
 394         mainModuleSrcPath = do
 395             let isMain = (== mainModIs dflags) . ms_mod
 396             [ms] <- return (filter isMain mod_graph)
 397             ml_hs_file (ms_location ms)
 398         guessedName = fmap dropExtension mainModuleSrcPath
 399     in
 400     case outputFile dflags of
 401         Just _ -> env
 402         Nothing -> env { hsc_dflags = dflags { outputFile = guessedName } }
 403
 404 -- -----------------------------------------------------------------------------
 405 -- Targets
 406
 407 -- ToDo: think about relative vs. absolute file paths. And what
 408 -- happens when the current directory changes.
 409
 410 -- | Sets the targets for this session.  Each target may be a module name
 411 -- or a filename.  The targets correspond to the set of root modules for
 412 -- the program\/library.  Unloading the current program is achieved by
 413 -- setting the current set of targets to be empty, followed by load.
 414 setTargets :: Session -> [Target] -> IO ()
 415 setTargets s targets = modifySession s (\h -> h{ hsc_targets = targets })
 416
 417 -- | returns the current set of targets
 418 getTargets :: Session -> IO [Target]
 419 getTargets s = withSession s (return . hsc_targets)
 420
 421 -- | Add another target
 422 addTarget :: Session -> Target -> IO ()
 423 addTarget s target
 424   = modifySession s (\h -> h{ hsc_targets = target : hsc_targets h })
 425
 426 -- | Remove a target
 427 removeTarget :: Session -> TargetId -> IO ()
 428 removeTarget s target_id
 429   = modifySession s (\h -> h{ hsc_targets = filter (hsc_targets h) })
 430   where
 431    filter targets = [ t | t@(Target id _) <- targets, id /= target_id ]
 432
 433 -- Attempts to guess what Target a string refers to.  This function implements
 434 -- the --make/GHCi command-line syntax for filenames:
 435 --
 436 --      - if the string looks like a Haskell source filename, then interpret
 437 --        it as such
 438 --      - if adding a .hs or .lhs suffix yields the name of an existing file,
 439 --        then use that
 440 --      - otherwise interpret the string as a module name
 441 --
 442 guessTarget :: String -> Maybe Phase -> IO Target
 443 guessTarget file (Just phase)
 444    = return (Target (TargetFile file (Just phase)) Nothing)
 445 guessTarget file Nothing
 446    | isHaskellSrcFilename file
 447    = return (Target (TargetFile file Nothing) Nothing)
 448    | otherwise
 449    = do exists <- doesFileExist hs_file
 450         if exists
 451            then return (Target (TargetFile hs_file Nothing) Nothing)
 452            else do
 453         exists <- doesFileExist lhs_file
 454         if exists
 455            then return (Target (TargetFile lhs_file Nothing) Nothing)
 456            else do
 457         return (Target (TargetModule (mkModuleName file)) Nothing)
 458      where
 459          hs_file  = file <.> "hs"
 460          lhs_file = file <.> "lhs"
 461
 462 -- -----------------------------------------------------------------------------
 463 -- Extending the program scope
 464
 465 extendGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
 466 extendGlobalRdrScope session rdrElts
 467     = modifySession session $ \hscEnv ->
 468       let global_rdr = hsc_global_rdr_env hscEnv
 469       in hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv global_rdr rdrElts }
 470
 471 setGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
 472 setGlobalRdrScope session rdrElts
 473     = modifySession session $ \hscEnv ->
 474       hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv rdrElts }
 475
 476 extendGlobalTypeScope :: Session -> [Id] -> IO ()
 477 extendGlobalTypeScope session ids
 478     = modifySession session $ \hscEnv ->
 479       let global_type = hsc_global_type_env hscEnv
 480       in hscEnv{ hsc_global_type_env = extendTypeEnvWithIds global_type ids }
 481
 482 setGlobalTypeScope :: Session -> [Id] -> IO ()
 483 setGlobalTypeScope session ids
 484     = modifySession session $ \hscEnv ->
 485       hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
 486
 487 -- -----------------------------------------------------------------------------
 488 -- Parsing Haddock comments
 489
 490 parseHaddockComment :: String -> Either String (HsDoc RdrName)
 491 parseHaddockComment string =
 492   case parseHaddockParagraphs (tokenise string) of
 493     MyLeft x  -> Left x
 494     MyRight x -> Right x
 495
 496 -- -----------------------------------------------------------------------------
 497 -- Loading the program
 498
 499 -- Perform a dependency analysis starting from the current targets
 500 -- and update the session with the new module graph.
 501 depanal :: Session -> [ModuleName] -> Bool -> IO (Maybe ModuleGraph)
 502 depanal (Session ref) excluded_mods allow_dup_roots = do
 503   hsc_env <- readIORef ref
 504   let
 505          dflags  = hsc_dflags hsc_env
 506          targets = hsc_targets hsc_env
 507          old_graph = hsc_mod_graph hsc_env
 508
 509   showPass dflags "Chasing dependencies"
 510   debugTraceMsg dflags 2 (hcat [
 511              text "Chasing modules from: ",
 512              hcat (punctuate comma (map pprTarget targets))])
 513
 514   r <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
 515   case r of
 516     Just mod_graph -> writeIORef ref hsc_env{ hsc_mod_graph = mod_graph }
 517     _ -> return ()
 518   return r
 519
 520 {-
 521 -- | The result of load.
 522 data LoadResult
 523   = LoadOk      Errors  -- ^ all specified targets were loaded successfully.
 524   | LoadFailed  Errors  -- ^ not all modules were loaded.
 525
 526 type Errors = [String]
 527
 528 data ErrMsg = ErrMsg {
 529         errMsgSeverity  :: Severity,  -- warning, error, etc.
 530         errMsgSpans     :: [SrcSpan],
 531         errMsgShortDoc  :: Doc,
 532         errMsgExtraInfo :: Doc
 533         }
 534 -}
 535
 536 data LoadHowMuch
 537    = LoadAllTargets
 538    | LoadUpTo ModuleName
 539    | LoadDependenciesOf ModuleName
 540
 541 -- | Try to load the program.  If a Module is supplied, then just
 542 -- attempt to load up to this target.  If no Module is supplied,
 543 -- then try to load all targets.
 544 load :: Session -> LoadHowMuch -> IO SuccessFlag
 545 load s how_much
 546    = do
 547         -- Dependency analysis first.  Note that this fixes the module graph:
 548         -- even if we don't get a fully successful upsweep, the full module
 549         -- graph is still retained in the Session.  We can tell which modules
 550         -- were successfully loaded by inspecting the Session's HPT.
 551         mb_graph <- depanal s [] False
 552         case mb_graph of
 553            Just mod_graph -> load2 s how_much mod_graph
 554            Nothing        -> return Failed
 555
 556 load2 :: Session -> LoadHowMuch -> [ModSummary] -> IO SuccessFlag
 557 load2 s@(Session ref) how_much mod_graph = do
 558         guessOutputFile s
 559         hsc_env <- readIORef ref
 560
 561         let hpt1      = hsc_HPT hsc_env
 562         let dflags    = hsc_dflags hsc_env
 563
 564         -- The "bad" boot modules are the ones for which we have
 565         -- B.hs-boot in the module graph, but no B.hs
 566         -- The downsweep should have ensured this does not happen
 567         -- (see msDeps)
 568         let all_home_mods = [ms_mod_name s
 569                             | s <- mod_graph, not (isBootSummary s)]
 570             bad_boot_mods = [s        | s <- mod_graph, isBootSummary s,
 571                                         not (ms_mod_name s `elem` all_home_mods)]
 572         ASSERT( null bad_boot_mods ) return ()
 573
 574         -- check that the module given in HowMuch actually exists, otherwise
 575         -- topSortModuleGraph will bomb later.
 576         let checkHowMuch (LoadUpTo m)           = checkMod m
 577             checkHowMuch (LoadDependenciesOf m) = checkMod m
 578             checkHowMuch _ = id
 579
 580             checkMod m and_then
 581                 | m `elem` all_home_mods = and_then
 582                 | otherwise = do
 583                         errorMsg dflags (text "no such module:" <+>
 584                                          quotes (ppr m))
 585                         return Failed
 586
 587         checkHowMuch how_much $ do
 588
 589         -- mg2_with_srcimps drops the hi-boot nodes, returning a
 590         -- graph with cycles.  Among other things, it is used for
 591         -- backing out partially complete cycles following a failed
 592         -- upsweep, and for removing from hpt all the modules
 593         -- not in strict downwards closure, during calls to compile.
 594         let mg2_with_srcimps :: [SCC ModSummary]
 595             mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
 596
 597         -- If we can determine that any of the {-# SOURCE #-} imports
 598         -- are definitely unnecessary, then emit a warning.
 599         warnUnnecessarySourceImports dflags mg2_with_srcimps
 600
 601         let
 602             -- check the stability property for each module.
 603             stable_mods@(stable_obj,stable_bco)
 604                 = checkStability hpt1 mg2_with_srcimps all_home_mods
 605
 606             -- prune bits of the HPT which are definitely redundant now,
 607             -- to save space.
 608             pruned_hpt = pruneHomePackageTable hpt1
 609                                 (flattenSCCs mg2_with_srcimps)
 610                                 stable_mods
 611
 612         evaluate pruned_hpt
 613
 614         -- before we unload anything, make sure we don't leave an old
 615         -- interactive context around pointing to dead bindings.  Also,
 616         -- write the pruned HPT to allow the old HPT to be GC'd.
 617         writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext,
 618                                    hsc_HPT = pruned_hpt }
 619
 620         debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
 621                                 text "Stable BCO:" <+> ppr stable_bco)
 622
 623         -- Unload any modules which are going to be re-linked this time around.
 624         let stable_linkables = [ linkable
 625                                | m <- stable_obj++stable_bco,
 626                                  Just hmi <- [lookupUFM pruned_hpt m],
 627                                  Just linkable <- [hm_linkable hmi] ]
 628         unload hsc_env stable_linkables
 629
 630         -- We could at this point detect cycles which aren't broken by
 631         -- a source-import, and complain immediately, but it seems better
 632         -- to let upsweep_mods do this, so at least some useful work gets
 633         -- done before the upsweep is abandoned.
 634         --hPutStrLn stderr "after tsort:\n"
 635         --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
 636
 637         -- Now do the upsweep, calling compile for each module in
 638         -- turn.  Final result is version 3 of everything.
 639
 640         -- Topologically sort the module graph, this time including hi-boot
 641         -- nodes, and possibly just including the portion of the graph
 642         -- reachable from the module specified in the 2nd argument to load.
 643         -- This graph should be cycle-free.
 644         -- If we're restricting the upsweep to a portion of the graph, we
 645         -- also want to retain everything that is still stable.
 646         let full_mg :: [SCC ModSummary]
 647             full_mg    = topSortModuleGraph False mod_graph Nothing
 648
 649             maybe_top_mod = case how_much of
 650                                 LoadUpTo m           -> Just m
 651                                 LoadDependenciesOf m -> Just m
 652                                 _                    -> Nothing
 653
 654             partial_mg0 :: [SCC ModSummary]
 655             partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
 656
 657             -- LoadDependenciesOf m: we want the upsweep to stop just
 658             -- short of the specified module (unless the specified module
 659             -- is stable).
 660             partial_mg
 661                 | LoadDependenciesOf _mod <- how_much
 662                 = ASSERT( case last partial_mg0 of
 663                             AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )
 664                   List.init partial_mg0
 665                 | otherwise
 666                 = partial_mg0
 667
 668             stable_mg =
 669                 [ AcyclicSCC ms
 670                 | AcyclicSCC ms <- full_mg,
 671                   ms_mod_name ms `elem` stable_obj++stable_bco,
 672                   ms_mod_name ms `notElem` [ ms_mod_name ms' |
 673                                                 AcyclicSCC ms' <- partial_mg ] ]
 674
 675             mg = stable_mg ++ partial_mg
 676
 677         -- clean up between compilations
 678         let cleanup = cleanTempFilesExcept dflags
 679                           (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
 680
 681         debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
 682                                    2 (ppr mg))
 683         (upsweep_ok, hsc_env1, modsUpswept)
 684            <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
 685                            pruned_hpt stable_mods cleanup mg
 686
 687         -- Make modsDone be the summaries for each home module now
 688         -- available; this should equal the domain of hpt3.
 689         -- Get in in a roughly top .. bottom order (hence reverse).
 690
 691         let modsDone = reverse modsUpswept
 692
 693         -- Try and do linking in some form, depending on whether the
 694         -- upsweep was completely or only partially successful.
 695
 696         if succeeded upsweep_ok
 697
 698          then
 699            -- Easy; just relink it all.
 700            do debugTraceMsg dflags 2 (text "Upsweep completely successful.")
 701
 702               -- Clean up after ourselves
 703               cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
 704
 705               -- Issue a warning for the confusing case where the user
 706               -- said '-o foo' but we're not going to do any linking.
 707               -- We attempt linking if either (a) one of the modules is
 708               -- called Main, or (b) the user said -no-hs-main, indicating
 709               -- that main() is going to come from somewhere else.
 710               --
 711               let ofile = outputFile dflags
 712               let no_hs_main = dopt Opt_NoHsMain dflags
 713               let
 714                 main_mod = mainModIs dflags
 715                 a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
 716                 do_linking = a_root_is_Main || no_hs_main
 717
 718               when (ghcLink dflags == LinkBinary
 719                     && isJust ofile && not do_linking) $
 720                 debugTraceMsg dflags 1 $
 721                     text ("Warning: output was redirected with -o, " ++
 722                           "but no output will be generated\n" ++
 723                           "because there is no " ++
 724                           moduleNameString (moduleName main_mod) ++ " module.")
 725
 726               -- link everything together
 727               linkresult <- link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
 728
 729               loadFinish Succeeded linkresult ref hsc_env1
 730
 731          else
 732            -- Tricky.  We need to back out the effects of compiling any
 733            -- half-done cycles, both so as to clean up the top level envs
 734            -- and to avoid telling the interactive linker to link them.
 735            do debugTraceMsg dflags 2 (text "Upsweep partially successful.")
 736
 737               let modsDone_names
 738                      = map ms_mod modsDone
 739               let mods_to_zap_names
 740                      = findPartiallyCompletedCycles modsDone_names
 741                           mg2_with_srcimps
 742               let mods_to_keep
 743                      = filter ((`notElem` mods_to_zap_names).ms_mod)
 744                           modsDone
 745
 746               let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
 747                                               (hsc_HPT hsc_env1)
 748
 749               -- Clean up after ourselves
 750               cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
 751
 752               -- there should be no Nothings where linkables should be, now
 753               ASSERT(all (isJust.hm_linkable)
 754                         (eltsUFM (hsc_HPT hsc_env))) do
 755
 756               -- Link everything together
 757               linkresult <- link (ghcLink dflags) dflags False hpt4
 758
 759               let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
 760               loadFinish Failed linkresult ref hsc_env4
 761
 762 -- Finish up after a load.
 763
 764 -- If the link failed, unload everything and return.
 765 loadFinish :: SuccessFlag -> SuccessFlag -> IORef HscEnv -> HscEnv -> IO SuccessFlag
 766 loadFinish _all_ok Failed ref hsc_env
 767   = do unload hsc_env []
 768        writeIORef ref $! discardProg hsc_env
 769        return Failed
 770
 771 -- Empty the interactive context and set the module context to the topmost
 772 -- newly loaded module, or the Prelude if none were loaded.
 773 loadFinish all_ok Succeeded ref hsc_env
 774   = do writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
 775        return all_ok
 776
 777
 778 -- Forget the current program, but retain the persistent info in HscEnv
 779 discardProg :: HscEnv -> HscEnv
 780 discardProg hsc_env
 781   = hsc_env { hsc_mod_graph = emptyMG,
 782               hsc_IC = emptyInteractiveContext,
 783               hsc_HPT = emptyHomePackageTable }
 784
 785 -- used to fish out the preprocess output files for the purposes of
 786 -- cleaning up.  The preprocessed file *might* be the same as the
 787 -- source file, but that doesn't do any harm.
 788 ppFilesFromSummaries :: [ModSummary] -> [FilePath]
 789 ppFilesFromSummaries summaries = map ms_hspp_file summaries
 790
 791 -- -----------------------------------------------------------------------------
 792 -- Check module
 793
 794 data CheckedModule =
 795   CheckedModule { parsedSource      :: ParsedSource,
 796                   renamedSource     :: Maybe RenamedSource,
 797                   typecheckedSource :: Maybe TypecheckedSource,
 798                   checkedModuleInfo :: Maybe ModuleInfo,
 799                   coreModule        :: Maybe ModGuts
 800                 }
 801         -- ToDo: improvements that could be made here:
 802         --  if the module succeeded renaming but not typechecking,
 803         --  we can still get back the GlobalRdrEnv and exports, so
 804         --  perhaps the ModuleInfo should be split up into separate
 805         --  fields within CheckedModule.
 806
 807 type ParsedSource      = Located (HsModule RdrName)
 808 type RenamedSource     = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
 809                           Maybe (HsDoc Name), HaddockModInfo Name)
 810 type TypecheckedSource = LHsBinds Id
 811
 812 -- NOTE:
 813 --   - things that aren't in the output of the typechecker right now:
 814 --     - the export list
 815 --     - the imports
 816 --     - type signatures
 817 --     - type/data/newtype declarations
 818 --     - class declarations
 819 --     - instances
 820 --   - extra things in the typechecker's output:
 821 --     - default methods are turned into top-level decls.
 822 --     - dictionary bindings
 823
 824
 825 -- | This is the way to get access to parsed and typechecked source code
 826 -- for a module.  'checkModule' attempts to typecheck the module.  If
 827 -- successful, it returns the abstract syntax for the module.
 828 -- If compileToCore is true, it also desugars the module and returns the
 829 -- resulting Core bindings as a component of the CheckedModule.
 830 checkModule :: Session -> ModuleName -> Bool -> IO (Maybe CheckedModule)
 831 checkModule (Session ref) mod compile_to_core
 832  = do
 833    hsc_env <- readIORef ref
 834    let mg  = hsc_mod_graph hsc_env
 835    case [ ms | ms <- mg, ms_mod_name ms == mod ] of
 836         [] -> return Nothing
 837         (ms:_) -> checkModule_ ref ms compile_to_core False
 838
 839 -- | parses and typechecks a module, optionally generates Core, and also
 840 -- loads the module into the 'Session' so that modules which depend on
 841 -- this one may subsequently be typechecked using 'checkModule' or
 842 -- 'checkAndLoadModule'.  If you need to check more than one module,
 843 -- you probably want to use 'checkAndLoadModule'.  Constructing the
 844 -- interface takes a little work, so it might be slightly slower than
 845 -- 'checkModule'.
 846 checkAndLoadModule :: Session -> ModSummary -> Bool -> IO (Maybe CheckedModule)
 847 checkAndLoadModule (Session ref) ms compile_to_core
 848  = checkModule_ ref ms compile_to_core True
 849
 850 checkModule_ :: IORef HscEnv -> ModSummary -> Bool -> Bool
 851              -> IO (Maybe CheckedModule)
 852 checkModule_ ref ms compile_to_core load
 853  = do
 854    let mod = ms_mod_name ms
 855    hsc_env0 <- readIORef ref
 856    let hsc_env = hsc_env0{hsc_dflags=ms_hspp_opts ms}
 857    mb_parsed <- parseFile hsc_env ms
 858    case mb_parsed of
 859              Nothing -> return Nothing
 860              Just rdr_module -> do
 861                mb_typechecked <- typecheckRenameModule hsc_env ms rdr_module
 862                case mb_typechecked of
 863                  Nothing -> return (Just CheckedModule {
 864                                               parsedSource = rdr_module,
 865                                               renamedSource = Nothing,
 866                                               typecheckedSource = Nothing,
 867                                               checkedModuleInfo = Nothing,
 868                                               coreModule = Nothing })
 869                  Just (tcg, rn_info) -> do
 870                    details <- makeSimpleDetails hsc_env tcg
 871
 872                    let tc_binds = tcg_binds tcg
 873                    let rdr_env  = tcg_rdr_env tcg
 874                    let minf = ModuleInfo {
 875                                 minf_type_env  = md_types details,
 876                                 minf_exports   = availsToNameSet $
 877                                                      md_exports details,
 878                                 minf_rdr_env   = Just rdr_env,
 879                                 minf_instances = md_insts details
 880 #ifdef GHCI
 881                                ,minf_modBreaks = emptyModBreaks
 882 #endif
 883                               }
 884
 885                    mb_guts <- if compile_to_core
 886                                  then deSugarModule hsc_env ms tcg
 887                                  else return Nothing
 888
 889                    -- If we are loading this module so that we can typecheck
 890                    -- dependent modules, generate an interface and stuff it
 891                    -- all in the HomePackageTable.
 892                    when load $ do
 893                      (iface,_) <- makeSimpleIface hsc_env Nothing tcg details
 894                      let mod_info = HomeModInfo {
 895                                         hm_iface = iface,
 896                                         hm_details = details,
 897                                         hm_linkable = Nothing }
 898                      let hpt_new = addToUFM (hsc_HPT hsc_env) mod mod_info
 899                      writeIORef ref hsc_env0{ hsc_HPT = hpt_new }
 900
 901                    return (Just (CheckedModule {
 902                                         parsedSource = rdr_module,
 903                                         renamedSource = rn_info,
 904                                         typecheckedSource = Just tc_binds,
 905                                         checkedModuleInfo = Just minf,
 906                                         coreModule = mb_guts }))
 907
 908 -- | This is the way to get access to the Core bindings corresponding
 909 -- to a module. 'compileToCore' invokes 'checkModule' to parse, typecheck, and
 910 -- desugar the module, then returns the resulting Core module (consisting of
 911 -- the module name, type declarations, and function declarations) if
 912 -- successful.
 913 compileToCoreModule :: Session -> FilePath -> IO (Maybe CoreModule)
 914 compileToCoreModule = compileCore False
 915
 916 -- | Like compileToCoreModule, but invokes the simplifier, so
 917 -- as to return simplified and tidied Core.
 918 compileToCoreSimplified :: Session -> FilePath -> IO (Maybe CoreModule)
 919 compileToCoreSimplified = compileCore True
 920
 921 -- | Provided for backwards-compatibility: compileToCore returns just the Core
 922 -- bindings, but for most purposes, you probably want to call
 923 -- compileToCoreModule.
 924 compileToCore :: Session -> FilePath -> IO (Maybe [CoreBind])
 925 compileToCore session fn = do
 926    maybeCoreModule <- compileToCoreModule session fn
 927    return $ fmap cm_binds maybeCoreModule
 928
 929 -- | Takes a CoreModule and compiles the bindings therein
 930 -- to object code. The first argument is a bool flag indicating
 931 -- whether to run the simplifier.
 932 -- The resulting .o, .hi, and executable files, if any, are stored in the
 933 -- current directory, and named according to the module name.
 934 -- Returns True iff compilation succeeded.
 935 -- This has only so far been tested with a single self-contained module.
 936 compileCoreToObj :: Bool -> Session -> CoreModule -> IO Bool
 937 compileCoreToObj simplify session cm@(CoreModule{ cm_module = mName }) = do
 938   hscEnv      <- sessionHscEnv session
 939   dflags      <- getSessionDynFlags session
 940   currentTime <- getClockTime
 941   cwd         <- getCurrentDirectory
 942   modLocation <- mkHiOnlyModLocation dflags (hiSuf dflags) cwd
 943                    ((moduleNameSlashes . moduleName) mName)
 944
 945   let modSummary = ModSummary { ms_mod = mName,
 946          ms_hsc_src = ExtCoreFile,
 947          ms_location = modLocation,
 948          -- By setting the object file timestamp to Nothing,
 949          -- we always force recompilation, which is what we
 950          -- want. (Thus it doesn't matter what the timestamp
 951          -- for the (nonexistent) source file is.)
 952          ms_hs_date = currentTime,
 953          ms_obj_date = Nothing,
 954          -- Only handling the single-module case for now, so no imports.
 955          ms_srcimps = [],
 956          ms_imps = [],
 957          -- No source file
 958          ms_hspp_file = "",
 959          ms_hspp_opts = dflags,
 960          ms_hspp_buf = Nothing
 961       }
 962
 963   mbHscResult <- evalComp
 964      ((if simplify then hscSimplify else return) (mkModGuts cm)
 965      >>= hscNormalIface >>= hscWriteIface >>= hscOneShot)
 966      (CompState{ compHscEnv=hscEnv,
 967                  compModSummary=modSummary,
 968                  compOldIface=Nothing})
 969   return $ isJust mbHscResult
 970
 971 -- Makes a "vanilla" ModGuts.
 972 mkModGuts :: CoreModule -> ModGuts
 973 mkModGuts coreModule = ModGuts {
 974   mg_module = cm_module coreModule,
 975   mg_boot = False,
 976   mg_exports = [],
 977   mg_deps = noDependencies,
 978   mg_dir_imps = emptyModuleEnv,
 979   mg_used_names = emptyNameSet,
 980   mg_rdr_env = emptyGlobalRdrEnv,
 981   mg_fix_env = emptyFixityEnv,
 982   mg_types = emptyTypeEnv,
 983   mg_insts = [],
 984   mg_fam_insts = [],
 985   mg_rules = [],
 986   mg_binds = cm_binds coreModule,
 987   mg_foreign = NoStubs,
 988   mg_deprecs = NoDeprecs,
 989   mg_hpc_info = emptyHpcInfo False,
 990   mg_modBreaks = emptyModBreaks,
 991   mg_vect_info = noVectInfo,
 992   mg_inst_env = emptyInstEnv,
 993   mg_fam_inst_env = emptyFamInstEnv
 994 }
 995
 996 compileCore :: Bool -> Session -> FilePath -> IO (Maybe CoreModule)
 997 compileCore simplify session fn = do
 998    -- First, set the target to the desired filename
 999    target <- guessTarget fn Nothing
1000    addTarget session target
1001    load session LoadAllTargets
1002    -- Then find dependencies
1003    maybeModGraph <- depanal session [] True
1004    case maybeModGraph of
1005      Nothing -> return Nothing
1006      Just modGraph -> do
1007        case find ((== fn) . msHsFilePath) modGraph of
1008          Just modSummary -> do
1009            -- Now we have the module name;
1010            -- parse, typecheck and desugar the module
1011            let mod = ms_mod_name modSummary
1012            maybeCheckedModule <- checkModule session mod True
1013            case maybeCheckedModule of
1014              Nothing -> return Nothing
1015              Just checkedMod -> (liftM $ fmap gutsToCoreModule) $
1016                                 case (coreModule checkedMod) of
1017                                   Just mg | simplify -> (sessionHscEnv session)
1018                                   -- If simplify is true: simplify (hscSimplify),
1019                                   -- then tidy (tidyProgram).
1020                                    >>= \ hscEnv -> evalComp (hscSimplify mg)
1021                                          (CompState{ compHscEnv=hscEnv,
1022                                                      compModSummary=modSummary,
1023                                                      compOldIface=Nothing})
1024                                           >>= (tidyProgram hscEnv)
1025                                           >>= (return . Just . Left)
1026                                   Just guts -> return $ Just $ Right guts
1027                                   Nothing   -> return Nothing
1028          Nothing -> panic "compileToCoreModule: target FilePath not found in\
1029                            module dependency graph"
1030   where -- two versions, based on whether we simplify (thus run tidyProgram,
1031         -- which returns a (CgGuts, ModDetails) pair, or not (in which case
1032         -- we just have a ModGuts.
1033         gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
1034         gutsToCoreModule (Left (cg, md))  = CoreModule {
1035           cm_module = cg_module cg,    cm_types = md_types md,
1036           cm_imports = cg_dir_imps cg, cm_binds = cg_binds cg
1037         }
1038         gutsToCoreModule (Right mg) = CoreModule {
1039           cm_module  = mg_module mg,                   cm_types   = mg_types mg,
1040           cm_imports = moduleEnvKeys (mg_dir_imps mg), cm_binds   = mg_binds mg
1041          }
1042
1043 -- ---------------------------------------------------------------------------
1044 -- Unloading
1045
1046 unload :: HscEnv -> [Linkable] -> IO ()
1047 unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
1048   = case ghcLink (hsc_dflags hsc_env) of
1049 #ifdef GHCI
1050         LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
1051 #else
1052         LinkInMemory -> panic "unload: no interpreter"
1053                                 -- urgh.  avoid warnings:
1054                                 hsc_env stable_linkables
1055 #endif
1056         _other -> return ()
1057
1058 -- -----------------------------------------------------------------------------
1059 -- checkStability
1060
1061 {-
1062   Stability tells us which modules definitely do not need to be recompiled.
1063   There are two main reasons for having stability:
1064
1065    - avoid doing a complete upsweep of the module graph in GHCi when
1066      modules near the bottom of the tree have not changed.
1067
1068    - to tell GHCi when it can load object code: we can only load object code
1069      for a module when we also load object code fo  all of the imports of the
1070      module.  So we need to know that we will definitely not be recompiling
1071      any of these modules, and we can use the object code.
1072
1073   The stability check is as follows.  Both stableObject and
1074   stableBCO are used during the upsweep phase later.
1075
1076   -------------------
1077   stable m = stableObject m || stableBCO m
1078
1079   stableObject m =
1080         all stableObject (imports m)
1081         && old linkable does not exist, or is == on-disk .o
1082         && date(on-disk .o) > date(.hs)
1083
1084   stableBCO m =
1085         all stable (imports m)
1086         && date(BCO) > date(.hs)
1087   -------------------
1088
1089   These properties embody the following ideas:
1090
1091     - if a module is stable, then:
1092         - if it has been compiled in a previous pass (present in HPT)
1093           then it does not need to be compiled or re-linked.
1094         - if it has not been compiled in a previous pass,
1095           then we only need to read its .hi file from disk and
1096           link it to produce a ModDetails.
1097
1098     - if a modules is not stable, we will definitely be at least
1099       re-linking, and possibly re-compiling it during the upsweep.
1100       All non-stable modules can (and should) therefore be unlinked
1101       before the upsweep.
1102
1103     - Note that objects are only considered stable if they only depend
1104       on other objects.  We can't link object code against byte code.
1105 -}
1106
1107 checkStability
1108         :: HomePackageTable             -- HPT from last compilation
1109         -> [SCC ModSummary]             -- current module graph (cyclic)
1110         -> [ModuleName]                 -- all home modules
1111         -> ([ModuleName],               -- stableObject
1112             [ModuleName])               -- stableBCO
1113
1114 checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
1115   where
1116    checkSCC (stable_obj, stable_bco) scc0
1117      | stableObjects = (scc_mods ++ stable_obj, stable_bco)
1118      | stableBCOs    = (stable_obj, scc_mods ++ stable_bco)
1119      | otherwise     = (stable_obj, stable_bco)
1120      where
1121         scc = flattenSCC scc0
1122         scc_mods = map ms_mod_name scc
1123         home_module m   = m `elem` all_home_mods && m `notElem` scc_mods
1124
1125         scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
1126             -- all imports outside the current SCC, but in the home pkg
1127
1128         stable_obj_imps = map (`elem` stable_obj) scc_allimps
1129         stable_bco_imps = map (`elem` stable_bco) scc_allimps
1130
1131         stableObjects =
1132            and stable_obj_imps
1133            && all object_ok scc
1134
1135         stableBCOs =
1136            and (zipWith (||) stable_obj_imps stable_bco_imps)
1137            && all bco_ok scc
1138
1139         object_ok ms
1140           | Just t <- ms_obj_date ms  =  t >= ms_hs_date ms
1141                                          && same_as_prev t
1142           | otherwise = False
1143           where
1144              same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
1145                                 Just hmi  | Just l <- hm_linkable hmi
1146                                  -> isObjectLinkable l && t == linkableTime l
1147                                 _other  -> True
1148                 -- why '>=' rather than '>' above?  If the filesystem stores
1149                 -- times to the nearset second, we may occasionally find that
1150                 -- the object & source have the same modification time,
1151                 -- especially if the source was automatically generated
1152                 -- and compiled.  Using >= is slightly unsafe, but it matches
1153                 -- make's behaviour.
1154
1155         bco_ok ms
1156           = case lookupUFM hpt (ms_mod_name ms) of
1157                 Just hmi  | Just l <- hm_linkable hmi ->
1158                         not (isObjectLinkable l) &&
1159                         linkableTime l >= ms_hs_date ms
1160                 _other  -> False
1161
1162 ms_allimps :: ModSummary -> [ModuleName]
1163 ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
1164
1165 -- -----------------------------------------------------------------------------
1166 -- Prune the HomePackageTable
1167
1168 -- Before doing an upsweep, we can throw away:
1169 --
1170 --   - For non-stable modules:
1171 --      - all ModDetails, all linked code
1172 --   - all unlinked code that is out of date with respect to
1173 --     the source file
1174 --
1175 -- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
1176 -- space at the end of the upsweep, because the topmost ModDetails of the
1177 -- old HPT holds on to the entire type environment from the previous
1178 -- compilation.
1179
1180 pruneHomePackageTable
1181    :: HomePackageTable
1182    -> [ModSummary]
1183    -> ([ModuleName],[ModuleName])
1184    -> HomePackageTable
1185
1186 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
1187   = mapUFM prune hpt
1188   where prune hmi
1189           | is_stable modl = hmi'
1190           | otherwise      = hmi'{ hm_details = emptyModDetails }
1191           where
1192            modl = moduleName (mi_module (hm_iface hmi))
1193            hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
1194                 = hmi{ hm_linkable = Nothing }
1195                 | otherwise
1196                 = hmi
1197                 where ms = expectJust "prune" (lookupUFM ms_map modl)
1198
1199         ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]
1200
1201         is_stable m = m `elem` stable_obj || m `elem` stable_bco
1202
1203 -- -----------------------------------------------------------------------------
1204
1205 -- Return (names of) all those in modsDone who are part of a cycle
1206 -- as defined by theGraph.
1207 findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
1208 findPartiallyCompletedCycles modsDone theGraph
1209    = chew theGraph
1210      where
1211         chew [] = []
1212         chew ((AcyclicSCC _):rest) = chew rest    -- acyclic?  not interesting.
1213         chew ((CyclicSCC vs):rest)
1214            = let names_in_this_cycle = nub (map ms_mod vs)
1215                  mods_in_this_cycle
1216                     = nub ([done | done <- modsDone,
1217                                    done `elem` names_in_this_cycle])
1218                  chewed_rest = chew rest
1219              in
1220              if   notNull mods_in_this_cycle
1221                   && length mods_in_this_cycle < length names_in_this_cycle
1222              then mods_in_this_cycle ++ chewed_rest
1223              else chewed_rest
1224
1225 -- -----------------------------------------------------------------------------
1226 -- The upsweep
1227
1228 -- This is where we compile each module in the module graph, in a pass
1229 -- from the bottom to the top of the graph.
1230
1231 -- There better had not be any cyclic groups here -- we check for them.
1232
1233 upsweep
1234     :: HscEnv                   -- Includes initially-empty HPT
1235     -> HomePackageTable         -- HPT from last time round (pruned)
1236     -> ([ModuleName],[ModuleName]) -- stable modules (see checkStability)
1237     -> IO ()                    -- How to clean up unwanted tmp files
1238     -> [SCC ModSummary]         -- Mods to do (the worklist)
1239     -> IO (SuccessFlag,
1240            HscEnv,              -- With an updated HPT
1241            [ModSummary])        -- Mods which succeeded
1242
1243 upsweep hsc_env old_hpt stable_mods cleanup sccs = do
1244    (res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
1245    return (res, hsc_env, reverse done)
1246  where
1247
1248   upsweep' hsc_env _old_hpt done
1249      [] _ _
1250    = return (Succeeded, hsc_env, done)
1251
1252   upsweep' hsc_env _old_hpt done
1253      (CyclicSCC ms:_) _ _
1254    = do fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
1255         return (Failed, hsc_env, done)
1256
1257   upsweep' hsc_env old_hpt done
1258      (AcyclicSCC mod:mods) mod_index nmods
1259    = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
1260         --           show (map (moduleUserString.moduleName.mi_module.hm_iface)
1261         --                     (moduleEnvElts (hsc_HPT hsc_env)))
1262
1263         mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod
1264                        mod_index nmods
1265
1266         cleanup         -- Remove unwanted tmp files between compilations
1267
1268         case mb_mod_info of
1269             Nothing -> return (Failed, hsc_env, done)
1270             Just mod_info -> do
1271                 let this_mod = ms_mod_name mod
1272
1273                         -- Add new info to hsc_env
1274                     hpt1     = addToUFM (hsc_HPT hsc_env) this_mod mod_info
1275                     hsc_env1 = hsc_env { hsc_HPT = hpt1 }
1276
1277                         -- Space-saving: delete the old HPT entry
1278                         -- for mod BUT if mod is a hs-boot
1279                         -- node, don't delete it.  For the
1280                         -- interface, the HPT entry is probaby for the
1281                         -- main Haskell source file.  Deleting it
1282                         -- would force the real module to be recompiled
1283                         -- every time.
1284                     old_hpt1 | isBootSummary mod = old_hpt
1285                              | otherwise = delFromUFM old_hpt this_mod
1286
1287                     done' = mod:done
1288
1289                         -- fixup our HomePackageTable after we've finished compiling
1290                         -- a mutually-recursive loop.  See reTypecheckLoop, below.
1291                 hsc_env2 <- reTypecheckLoop hsc_env1 mod done'
1292
1293                 upsweep' hsc_env2 old_hpt1 done' mods (mod_index+1) nmods
1294
1295
1296 -- Compile a single module.  Always produce a Linkable for it if
1297 -- successful.  If no compilation happened, return the old Linkable.
1298 upsweep_mod :: HscEnv
1299             -> HomePackageTable
1300             -> ([ModuleName],[ModuleName])
1301             -> ModSummary
1302             -> Int  -- index of module
1303             -> Int  -- total number of modules
1304             -> IO (Maybe HomeModInfo)   -- Nothing => Failed
1305
1306 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
1307    =    let
1308             this_mod_name = ms_mod_name summary
1309             this_mod    = ms_mod summary
1310             mb_obj_date = ms_obj_date summary
1311             obj_fn      = ml_obj_file (ms_location summary)
1312             hs_date     = ms_hs_date summary
1313
1314             is_stable_obj = this_mod_name `elem` stable_obj
1315             is_stable_bco = this_mod_name `elem` stable_bco
1316
1317             old_hmi = lookupUFM old_hpt this_mod_name
1318
1319             -- We're using the dflags for this module now, obtained by
1320             -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
1321             dflags = ms_hspp_opts summary
1322             prevailing_target = hscTarget (hsc_dflags hsc_env)
1323             local_target      = hscTarget dflags
1324
1325             -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
1326             -- we don't do anything dodgy: these should only work to change
1327             -- from -fvia-C to -fasm and vice-versa, otherwise we could
1328             -- end up trying to link object code to byte code.
1329             target = if prevailing_target /= local_target
1330                         && (not (isObjectTarget prevailing_target)
1331                             || not (isObjectTarget local_target))
1332                         then prevailing_target
1333                         else local_target
1334
1335             -- store the corrected hscTarget into the summary
1336             summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
1337
1338             -- The old interface is ok if
1339             --  a) we're compiling a source file, and the old HPT
1340             --     entry is for a source file
1341             --  b) we're compiling a hs-boot file
1342             -- Case (b) allows an hs-boot file to get the interface of its
1343             -- real source file on the second iteration of the compilation
1344             -- manager, but that does no harm.  Otherwise the hs-boot file
1345             -- will always be recompiled
1346
1347             mb_old_iface
1348                 = case old_hmi of
1349                      Nothing                              -> Nothing
1350                      Just hm_info | isBootSummary summary -> Just iface
1351                                   | not (mi_boot iface)   -> Just iface
1352                                   | otherwise             -> Nothing
1353                                    where
1354                                      iface = hm_iface hm_info
1355
1356             compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
1357             compile_it  = compile hsc_env summary' mod_index nmods mb_old_iface
1358
1359             compile_it_discard_iface
1360                         = compile hsc_env summary' mod_index nmods Nothing
1361
1362         in
1363         case target of
1364
1365             _any
1366                 -- Regardless of whether we're generating object code or
1367                 -- byte code, we can always use an existing object file
1368                 -- if it is *stable* (see checkStability).
1369                 | is_stable_obj, isJust old_hmi ->
1370                         return old_hmi
1371                         -- object is stable, and we have an entry in the
1372                         -- old HPT: nothing to do
1373
1374                 | is_stable_obj, isNothing old_hmi -> do
1375                         linkable <- findObjectLinkable this_mod obj_fn
1376                                         (expectJust "upseep1" mb_obj_date)
1377                         compile_it (Just linkable)
1378                         -- object is stable, but we need to load the interface
1379                         -- off disk to make a HMI.
1380
1381             HscInterpreted
1382                 | is_stable_bco ->
1383                         ASSERT(isJust old_hmi) -- must be in the old_hpt
1384                         return old_hmi
1385                         -- BCO is stable: nothing to do
1386
1387                 | Just hmi <- old_hmi,
1388                   Just l <- hm_linkable hmi, not (isObjectLinkable l),
1389                   linkableTime l >= ms_hs_date summary ->
1390                         compile_it (Just l)
1391                         -- we have an old BCO that is up to date with respect
1392                         -- to the source: do a recompilation check as normal.
1393
1394                 | otherwise ->
1395                         compile_it Nothing
1396                         -- no existing code at all: we must recompile.
1397
1398               -- When generating object code, if there's an up-to-date
1399               -- object file on the disk, then we can use it.
1400               -- However, if the object file is new (compared to any
1401               -- linkable we had from a previous compilation), then we
1402               -- must discard any in-memory interface, because this
1403               -- means the user has compiled the source file
1404               -- separately and generated a new interface, that we must
1405               -- read from the disk.
1406               --
1407             obj | isObjectTarget obj,
1408                   Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
1409                      case old_hmi of
1410                         Just hmi
1411                           | Just l <- hm_linkable hmi,
1412                             isObjectLinkable l && linkableTime l == obj_date
1413                             -> compile_it (Just l)
1414                         _otherwise -> do
1415                           linkable <- findObjectLinkable this_mod obj_fn obj_date
1416                           compile_it_discard_iface (Just linkable)
1417
1418             _otherwise ->
1419                   compile_it Nothing
1420
1421
1422
1423 -- Filter modules in the HPT
1424 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
1425 retainInTopLevelEnvs keep_these hpt
1426    = listToUFM   [ (mod, expectJust "retain" mb_mod_info)
1427                  | mod <- keep_these
1428                  , let mb_mod_info = lookupUFM hpt mod
1429                  , isJust mb_mod_info ]
1430
1431 -- ---------------------------------------------------------------------------
1432 -- Typecheck module loops
1433
1434 {-
1435 See bug #930.  This code fixes a long-standing bug in --make.  The
1436 problem is that when compiling the modules *inside* a loop, a data
1437 type that is only defined at the top of the loop looks opaque; but
1438 after the loop is done, the structure of the data type becomes
1439 apparent.
1440
1441 The difficulty is then that two different bits of code have
1442 different notions of what the data type looks like.
1443
1444 The idea is that after we compile a module which also has an .hs-boot
1445 file, we re-generate the ModDetails for each of the modules that
1446 depends on the .hs-boot file, so that everyone points to the proper
1447 TyCons, Ids etc. defined by the real module, not the boot module.
1448 Fortunately re-generating a ModDetails from a ModIface is easy: the
1449 function TcIface.typecheckIface does exactly that.
1450
1451 Picking the modules to re-typecheck is slightly tricky.  Starting from
1452 the module graph consisting of the modules that have already been
1453 compiled, we reverse the edges (so they point from the imported module
1454 to the importing module), and depth-first-search from the .hs-boot
1455 node.  This gives us all the modules that depend transitively on the
1456 .hs-boot module, and those are exactly the modules that we need to
1457 re-typecheck.
1458
1459 Following this fix, GHC can compile itself with --make -O2.
1460 -}
1461
1462 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
1463 reTypecheckLoop hsc_env ms graph
1464   | not (isBootSummary ms) &&
1465     any (\m -> ms_mod m == this_mod && isBootSummary m) graph
1466   = do
1467         let mss = reachableBackwards (ms_mod_name ms) graph
1468             non_boot = filter (not.isBootSummary) mss
1469         debugTraceMsg (hsc_dflags hsc_env) 2 $
1470            text "Re-typechecking loop: " <> ppr (map ms_mod_name non_boot)
1471         typecheckLoop hsc_env (map ms_mod_name non_boot)
1472   | otherwise
1473   = return hsc_env
1474  where
1475   this_mod = ms_mod ms
1476
1477 typecheckLoop :: HscEnv -> [ModuleName] -> IO HscEnv
1478 typecheckLoop hsc_env mods = do
1479   new_hpt <-
1480     fixIO $ \new_hpt -> do
1481       let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
1482       mds <- initIfaceCheck new_hsc_env $
1483                 mapM (typecheckIface . hm_iface) hmis
1484       let new_hpt = addListToUFM old_hpt
1485                         (zip mods [ hmi{ hm_details = details }
1486                                   | (hmi,details) <- zip hmis mds ])
1487       return new_hpt
1488   return hsc_env{ hsc_HPT = new_hpt }
1489   where
1490     old_hpt = hsc_HPT hsc_env
1491     hmis    = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
1492
1493 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
1494 reachableBackwards mod summaries
1495   = [ ms | (ms,_,_) <- map vertex_fn nodes_we_want ]
1496   where
1497         -- all the nodes reachable by traversing the edges backwards
1498         -- from the root node:
1499         nodes_we_want = reachable (transposeG graph) root
1500
1501         -- the rest just sets up the graph:
1502         (nodes, lookup_key) = moduleGraphNodes False summaries
1503         (graph, vertex_fn, key_fn) = graphFromEdges' nodes
1504         root
1505           | Just key <- lookup_key HsBootFile mod, Just v <- key_fn key = v
1506           | otherwise = panic "reachableBackwards"
1507
1508 -- ---------------------------------------------------------------------------
1509 -- Topological sort of the module graph
1510
1511 topSortModuleGraph
1512           :: Bool               -- Drop hi-boot nodes? (see below)
1513           -> [ModSummary]
1514           -> Maybe ModuleName
1515           -> [SCC ModSummary]
1516 -- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
1517 -- The resulting list of strongly-connected-components is in topologically
1518 -- sorted order, starting with the module(s) at the bottom of the
1519 -- dependency graph (ie compile them first) and ending with the ones at
1520 -- the top.
1521 --
1522 -- Drop hi-boot nodes (first boolean arg)?
1523 --
1524 --   False:     treat the hi-boot summaries as nodes of the graph,
1525 --              so the graph must be acyclic
1526 --
1527 --   True:      eliminate the hi-boot nodes, and instead pretend
1528 --              the a source-import of Foo is an import of Foo
1529 --              The resulting graph has no hi-boot nodes, but can by cyclic
1530
1531 topSortModuleGraph drop_hs_boot_nodes summaries Nothing
1532   = stronglyConnComp (fst (moduleGraphNodes drop_hs_boot_nodes summaries))
1533 topSortModuleGraph drop_hs_boot_nodes summaries (Just mod)
1534   = stronglyConnComp (map vertex_fn (reachable graph root))
1535   where
1536         -- restrict the graph to just those modules reachable from
1537         -- the specified module.  We do this by building a graph with
1538         -- the full set of nodes, and determining the reachable set from
1539         -- the specified node.
1540         (nodes, lookup_key) = moduleGraphNodes drop_hs_boot_nodes summaries
1541         (graph, vertex_fn, key_fn) = graphFromEdges' nodes
1542         root
1543           | Just key <- lookup_key HsSrcFile mod, Just v <- key_fn key = v
1544           | otherwise  = throwDyn (ProgramError "module does not exist")
1545
1546 moduleGraphNodes :: Bool -> [ModSummary]
1547   -> ([(ModSummary, Int, [Int])], HscSource -> ModuleName -> Maybe Int)
1548 moduleGraphNodes drop_hs_boot_nodes summaries = (nodes, lookup_key)
1549    where
1550         -- Drop hs-boot nodes by using HsSrcFile as the key
1551         hs_boot_key | drop_hs_boot_nodes = HsSrcFile
1552                     | otherwise          = HsBootFile
1553
1554         -- We use integers as the keys for the SCC algorithm
1555         nodes :: [(ModSummary, Int, [Int])]
1556         nodes = [(s, expectJust "topSort" $
1557                         lookup_key (ms_hsc_src s) (ms_mod_name s),
1558                      out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
1559                      out_edge_keys HsSrcFile   (map unLoc (ms_imps s)) ++
1560                      (-- see [boot-edges] below
1561                       if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
1562                         then []
1563                         else case lookup_key HsBootFile (ms_mod_name s) of
1564                                 Nothing -> []
1565                                 Just k  -> [k])
1566                  )
1567                 | s <- summaries
1568                 , not (isBootSummary s && drop_hs_boot_nodes) ]
1569                 -- Drop the hi-boot ones if told to do so
1570
1571         -- [boot-edges] if this is a .hs and there is an equivalent
1572         -- .hs-boot, add a link from the former to the latter.  This
1573         -- has the effect of detecting bogus cases where the .hs-boot
1574         -- depends on the .hs, by introducing a cycle.  Additionally,
1575         -- it ensures that we will always process the .hs-boot before
1576         -- the .hs, and so the HomePackageTable will always have the
1577         -- most up to date information.
1578
1579         key_map :: NodeMap Int
1580         key_map = listToFM ([(moduleName (ms_mod s), ms_hsc_src s)
1581                             | s <- summaries]
1582                            `zip` [1..])
1583
1584         lookup_key :: HscSource -> ModuleName -> Maybe Int
1585         lookup_key hs_src mod = lookupFM key_map (mod, hs_src)
1586
1587         out_edge_keys :: HscSource -> [ModuleName] -> [Int]
1588         out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
1589                 -- If we want keep_hi_boot_nodes, then we do lookup_key with
1590                 -- the IsBootInterface parameter True; else False
1591
1592
1593 type NodeKey   = (ModuleName, HscSource)  -- The nodes of the graph are
1594 type NodeMap a = FiniteMap NodeKey a      -- keyed by (mod, src_file_type) pairs
1595
1596 msKey :: ModSummary -> NodeKey
1597 msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot)
1598
1599 mkNodeMap :: [ModSummary] -> NodeMap ModSummary
1600 mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
1601
1602 nodeMapElts :: NodeMap a -> [a]
1603 nodeMapElts = eltsFM
1604
1605 -- If there are {-# SOURCE #-} imports between strongly connected
1606 -- components in the topological sort, then those imports can
1607 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
1608 -- were necessary, then the edge would be part of a cycle.
1609 warnUnnecessarySourceImports :: DynFlags -> [SCC ModSummary] -> IO ()
1610 warnUnnecessarySourceImports dflags sccs =
1611   printBagOfWarnings dflags (listToBag (concat (map (check.flattenSCC) sccs)))
1612   where check ms =
1613            let mods_in_this_cycle = map ms_mod_name ms in
1614            [ warn i | m <- ms, i <- ms_srcimps m,
1615                         unLoc i `notElem`  mods_in_this_cycle ]
1616
1617         warn :: Located ModuleName -> WarnMsg
1618         warn (L loc mod) =
1619            mkPlainErrMsg loc
1620                 (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
1621                  <+> quotes (ppr mod))
1622
1623 -----------------------------------------------------------------------------
1624 -- Downsweep (dependency analysis)
1625
1626 -- Chase downwards from the specified root set, returning summaries
1627 -- for all home modules encountered.  Only follow source-import
1628 -- links.
1629
1630 -- We pass in the previous collection of summaries, which is used as a
1631 -- cache to avoid recalculating a module summary if the source is
1632 -- unchanged.
1633 --
1634 -- The returned list of [ModSummary] nodes has one node for each home-package
1635 -- module, plus one for any hs-boot files.  The imports of these nodes
1636 -- are all there, including the imports of non-home-package modules.
1637
1638 downsweep :: HscEnv
1639           -> [ModSummary]       -- Old summaries
1640           -> [ModuleName]       -- Ignore dependencies on these; treat
1641                                 -- them as if they were package modules
1642           -> Bool               -- True <=> allow multiple targets to have
1643                                 --          the same module name; this is
1644                                 --          very useful for ghc -M
1645           -> IO (Maybe [ModSummary])
1646                 -- The elts of [ModSummary] all have distinct
1647                 -- (Modules, IsBoot) identifiers, unless the Bool is true
1648                 -- in which case there can be repeats
1649 downsweep hsc_env old_summaries excl_mods allow_dup_roots
1650    = -- catch error messages and return them
1651      handleDyn (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
1652        rootSummaries <- mapM getRootSummary roots
1653        let root_map = mkRootMap rootSummaries
1654        checkDuplicates root_map
1655        summs <- loop (concatMap msDeps rootSummaries) root_map
1656        return (Just summs)
1657      where
1658         roots = hsc_targets hsc_env
1659
1660         old_summary_map :: NodeMap ModSummary
1661         old_summary_map = mkNodeMap old_summaries
1662
1663         getRootSummary :: Target -> IO ModSummary
1664         getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
1665            = do exists <- doesFileExist file
1666                 if exists
1667                     then summariseFile hsc_env old_summaries file mb_phase maybe_buf
1668                     else throwDyn $ mkPlainErrMsg noSrcSpan $
1669                            text "can't find file:" <+> text file
1670         getRootSummary (Target (TargetModule modl) maybe_buf)
1671            = do maybe_summary <- summariseModule hsc_env old_summary_map False
1672                                            (L rootLoc modl) maybe_buf excl_mods
1673                 case maybe_summary of
1674                    Nothing -> packageModErr modl
1675                    Just s  -> return s
1676
1677         rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
1678
1679         -- In a root module, the filename is allowed to diverge from the module
1680         -- name, so we have to check that there aren't multiple root files
1681         -- defining the same module (otherwise the duplicates will be silently
1682         -- ignored, leading to confusing behaviour).
1683         checkDuplicates :: NodeMap [ModSummary] -> IO ()
1684         checkDuplicates root_map
1685            | allow_dup_roots = return ()
1686            | null dup_roots  = return ()
1687            | otherwise       = multiRootsErr (head dup_roots)
1688            where
1689              dup_roots :: [[ModSummary]]        -- Each at least of length 2
1690              dup_roots = filterOut isSingleton (nodeMapElts root_map)
1691
1692         loop :: [(Located ModuleName,IsBootInterface)]
1693                         -- Work list: process these modules
1694              -> NodeMap [ModSummary]
1695                         -- Visited set; the range is a list because
1696                         -- the roots can have the same module names
1697                         -- if allow_dup_roots is True
1698              -> IO [ModSummary]
1699                         -- The result includes the worklist, except
1700                         -- for those mentioned in the visited set
1701         loop [] done      = return (concat (nodeMapElts done))
1702         loop ((wanted_mod, is_boot) : ss) done
1703           | Just summs <- lookupFM done key
1704           = if isSingleton summs then
1705                 loop ss done
1706             else
1707                 do { multiRootsErr summs; return [] }
1708           | otherwise         = do { mb_s <- summariseModule hsc_env old_summary_map
1709                                                  is_boot wanted_mod Nothing excl_mods
1710                                    ; case mb_s of
1711                                         Nothing -> loop ss done
1712                                         Just s  -> loop (msDeps s ++ ss)
1713                                                         (addToFM done key [s]) }
1714           where
1715             key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
1716
1717 mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
1718 mkRootMap summaries = addListToFM_C (++) emptyFM
1719                         [ (msKey s, [s]) | s <- summaries ]
1720
1721 msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
1722 -- (msDeps s) returns the dependencies of the ModSummary s.
1723 -- A wrinkle is that for a {-# SOURCE #-} import we return
1724 --      *both* the hs-boot file
1725 --      *and* the source file
1726 -- as "dependencies".  That ensures that the list of all relevant
1727 -- modules always contains B.hs if it contains B.hs-boot.
1728 -- Remember, this pass isn't doing the topological sort.  It's
1729 -- just gathering the list of all relevant ModSummaries
1730 msDeps s =
1731     concat [ [(m,True), (m,False)] | m <- ms_srcimps s ]
1732          ++ [ (m,False) | m <- ms_imps s ]
1733
1734 -----------------------------------------------------------------------------
1735 -- Summarising modules
1736
1737 -- We have two types of summarisation:
1738 --
1739 --    * Summarise a file.  This is used for the root module(s) passed to
1740 --      cmLoadModules.  The file is read, and used to determine the root
1741 --      module name.  The module name may differ from the filename.
1742 --
1743 --    * Summarise a module.  We are given a module name, and must provide
1744 --      a summary.  The finder is used to locate the file in which the module
1745 --      resides.
1746
1747 summariseFile
1748         :: HscEnv
1749         -> [ModSummary]                 -- old summaries
1750         -> FilePath                     -- source file name
1751         -> Maybe Phase                  -- start phase
1752         -> Maybe (StringBuffer,ClockTime)
1753         -> IO ModSummary
1754
1755 summariseFile hsc_env old_summaries file mb_phase maybe_buf
1756         -- we can use a cached summary if one is available and the
1757         -- source file hasn't changed,  But we have to look up the summary
1758         -- by source file, rather than module name as we do in summarise.
1759    | Just old_summary <- findSummaryBySourceFile old_summaries file
1760    = do
1761         let location = ms_location old_summary
1762
1763                 -- return the cached summary if the source didn't change
1764         src_timestamp <- case maybe_buf of
1765                            Just (_,t) -> return t
1766                            Nothing    -> getModificationTime file
1767                 -- The file exists; we checked in getRootSummary above.
1768                 -- If it gets removed subsequently, then this
1769                 -- getModificationTime may fail, but that's the right
1770                 -- behaviour.
1771
1772         if ms_hs_date old_summary == src_timestamp
1773            then do -- update the object-file timestamp
1774                   obj_timestamp <-
1775                     if isObjectTarget (hscTarget (hsc_dflags hsc_env)) -- #1205
1776                         then getObjTimestamp location False
1777                         else return Nothing
1778                   return old_summary{ ms_obj_date = obj_timestamp }
1779            else
1780                 new_summary
1781
1782    | otherwise
1783    = new_summary
1784   where
1785     new_summary = do
1786         let dflags = hsc_dflags hsc_env
1787
1788         (dflags', hspp_fn, buf)
1789             <- preprocessFile hsc_env file mb_phase maybe_buf
1790
1791         (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
1792
1793         -- Make a ModLocation for this file
1794         location <- mkHomeModLocation dflags mod_name file
1795
1796         -- Tell the Finder cache where it is, so that subsequent calls
1797         -- to findModule will find it, even if it's not on any search path
1798         mod <- addHomeModuleToFinder hsc_env mod_name location
1799
1800         src_timestamp <- case maybe_buf of
1801                            Just (_,t) -> return t
1802                            Nothing    -> getModificationTime file
1803                         -- getMofificationTime may fail
1804
1805         -- when the user asks to load a source file by name, we only
1806         -- use an object file if -fobject-code is on.  See #1205.
1807         obj_timestamp <-
1808             if isObjectTarget (hscTarget (hsc_dflags hsc_env))
1809                 then modificationTimeIfExists (ml_obj_file location)
1810                 else return Nothing
1811
1812         return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
1813                              ms_location = location,
1814                              ms_hspp_file = hspp_fn,
1815                              ms_hspp_opts = dflags',
1816                              ms_hspp_buf  = Just buf,
1817                              ms_srcimps = srcimps, ms_imps = the_imps,
1818                              ms_hs_date = src_timestamp,
1819                              ms_obj_date = obj_timestamp })
1820
1821 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
1822 findSummaryBySourceFile summaries file
1823   = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
1824                                  expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
1825         [] -> Nothing
1826         (x:_) -> Just x
1827
1828 -- Summarise a module, and pick up source and timestamp.
1829 summariseModule
1830           :: HscEnv
1831           -> NodeMap ModSummary -- Map of old summaries
1832           -> IsBootInterface    -- True <=> a {-# SOURCE #-} import
1833           -> Located ModuleName -- Imported module to be summarised
1834           -> Maybe (StringBuffer, ClockTime)
1835           -> [ModuleName]               -- Modules to exclude
1836           -> IO (Maybe ModSummary)      -- Its new summary
1837
1838 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf excl_mods
1839   | wanted_mod `elem` excl_mods
1840   = return Nothing
1841
1842   | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
1843   = do          -- Find its new timestamp; all the
1844                 -- ModSummaries in the old map have valid ml_hs_files
1845         let location = ms_location old_summary
1846             src_fn = expectJust "summariseModule" (ml_hs_file location)
1847
1848                 -- check the modification time on the source file, and
1849                 -- return the cached summary if it hasn't changed.  If the
1850                 -- file has disappeared, we need to call the Finder again.
1851         case maybe_buf of
1852            Just (_,t) -> check_timestamp old_summary location src_fn t
1853            Nothing    -> do
1854                 m <- System.IO.Error.try (getModificationTime src_fn)
1855                 case m of
1856                    Right t -> check_timestamp old_summary location src_fn t
1857                    Left e | isDoesNotExistError e -> find_it
1858                           | otherwise             -> ioError e
1859
1860   | otherwise  = find_it
1861   where
1862     dflags = hsc_dflags hsc_env
1863
1864     hsc_src = if is_boot then HsBootFile else HsSrcFile
1865
1866     check_timestamp old_summary location src_fn src_timestamp
1867         | ms_hs_date old_summary == src_timestamp = do
1868                 -- update the object-file timestamp
1869                 obj_timestamp <- getObjTimestamp location is_boot
1870                 return (Just old_summary{ ms_obj_date = obj_timestamp })
1871         | otherwise =
1872                 -- source changed: re-summarise.
1873                 new_summary location (ms_mod old_summary) src_fn src_timestamp
1874
1875     find_it = do
1876         -- Don't use the Finder's cache this time.  If the module was
1877         -- previously a package module, it may have now appeared on the
1878         -- search path, so we want to consider it to be a home module.  If
1879         -- the module was previously a home module, it may have moved.
1880         uncacheModule hsc_env wanted_mod
1881         found <- findImportedModule hsc_env wanted_mod Nothing
1882         case found of
1883              Found location mod
1884                 | isJust (ml_hs_file location) ->
1885                         -- Home package
1886                          just_found location mod
1887                 | otherwise ->
1888                         -- Drop external-pkg
1889                         ASSERT(modulePackageId mod /= thisPackage dflags)
1890                         return Nothing
1891                 where
1892
1893              err -> noModError dflags loc wanted_mod err
1894                         -- Not found
1895
1896     just_found location mod = do
1897                 -- Adjust location to point to the hs-boot source file,
1898                 -- hi file, object file, when is_boot says so
1899         let location' | is_boot   = addBootSuffixLocn location
1900                       | otherwise = location
1901             src_fn = expectJust "summarise2" (ml_hs_file location')
1902
1903                 -- Check that it exists
1904                 -- It might have been deleted since the Finder last found it
1905         maybe_t <- modificationTimeIfExists src_fn
1906         case maybe_t of
1907           Nothing -> noHsFileErr loc src_fn
1908           Just t  -> new_summary location' mod src_fn t
1909
1910
1911     new_summary location mod src_fn src_timestamp
1912       = do
1913         -- Preprocess the source file and get its imports
1914         -- The dflags' contains the OPTIONS pragmas
1915         (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
1916         (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
1917
1918         when (mod_name /= wanted_mod) $
1919                 throwDyn $ mkPlainErrMsg mod_loc $
1920                               text "File name does not match module name:"
1921                               $$ text "Saw:" <+> quotes (ppr mod_name)
1922                               $$ text "Expected:" <+> quotes (ppr wanted_mod)
1923
1924                 -- Find the object timestamp, and return the summary
1925         obj_timestamp <- getObjTimestamp location is_boot
1926
1927         return (Just ( ModSummary { ms_mod       = mod,
1928                                     ms_hsc_src   = hsc_src,
1929                                     ms_location  = location,
1930                                     ms_hspp_file = hspp_fn,
1931                                     ms_hspp_opts = dflags',
1932                                     ms_hspp_buf  = Just buf,
1933                                     ms_srcimps   = srcimps,
1934                                     ms_imps      = the_imps,
1935                                     ms_hs_date   = src_timestamp,
1936                                     ms_obj_date  = obj_timestamp }))
1937
1938
1939 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
1940 getObjTimestamp location is_boot
1941   = if is_boot then return Nothing
1942                else modificationTimeIfExists (ml_obj_file location)
1943
1944
1945 preprocessFile :: HscEnv -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
1946   -> IO (DynFlags, FilePath, StringBuffer)
1947 preprocessFile hsc_env src_fn mb_phase Nothing
1948   = do
1949         (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
1950         buf <- hGetStringBuffer hspp_fn
1951         return (dflags', hspp_fn, buf)
1952
1953 preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
1954   = do
1955         let dflags = hsc_dflags hsc_env
1956         -- case we bypass the preprocessing stage?
1957         let
1958             local_opts = getOptions dflags buf src_fn
1959         --
1960         (dflags', leftovers, warns) <- parseDynamicFlags dflags (map unLoc local_opts)
1961         checkProcessArgsResult leftovers src_fn
1962         handleFlagWarnings dflags' warns
1963
1964         let
1965             needs_preprocessing
1966                 | Just (Unlit _) <- mb_phase    = True
1967                 | Nothing <- mb_phase, Unlit _ <- startPhase src_fn  = True
1968                   -- note: local_opts is only required if there's no Unlit phase
1969                 | dopt Opt_Cpp dflags'          = True
1970                 | dopt Opt_Pp  dflags'          = True
1971                 | otherwise                     = False
1972
1973         when needs_preprocessing $
1974            ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
1975
1976         return (dflags', src_fn, buf)
1977
1978
1979 -----------------------------------------------------------------------------
1980 --                      Error messages
1981 -----------------------------------------------------------------------------
1982
1983 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
1984 -- ToDo: we don't have a proper line number for this error
1985 noModError dflags loc wanted_mod err
1986   = throwDyn $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
1987
1988 noHsFileErr :: SrcSpan -> String -> a
1989 noHsFileErr loc path
1990   = throwDyn $ mkPlainErrMsg loc $ text "Can't find" <+> text path
1991
1992 packageModErr :: ModuleName -> a
1993 packageModErr mod
1994   = throwDyn $ mkPlainErrMsg noSrcSpan $
1995         text "module" <+> quotes (ppr mod) <+> text "is a package module"
1996
1997 multiRootsErr :: [ModSummary] -> IO ()
1998 multiRootsErr [] = panic "multiRootsErr"
1999 multiRootsErr summs@(summ1:_)
2000   = throwDyn $ mkPlainErrMsg noSrcSpan $
2001         text "module" <+> quotes (ppr mod) <+>
2002         text "is defined in multiple files:" <+>
2003         sep (map text files)
2004   where
2005     mod = ms_mod summ1
2006     files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
2007
2008 cyclicModuleErr :: [ModSummary] -> SDoc
2009 cyclicModuleErr ms
2010   = hang (ptext (sLit "Module imports form a cycle for modules:"))
2011        2 (vcat (map show_one ms))
2012   where
2013     show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
2014                         nest 2 $ ptext (sLit "imports:") <+>
2015                                    (pp_imps HsBootFile (ms_srcimps ms)
2016                                    $$ pp_imps HsSrcFile  (ms_imps ms))]
2017     show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
2018     pp_imps src mods = fsep (map (show_mod src) mods)
2019
2020
2021 -- | Inform GHC that the working directory has changed.  GHC will flush
2022 -- its cache of module locations, since it may no longer be valid.
2023 -- Note: if you change the working directory, you should also unload
2024 -- the current program (set targets to empty, followed by load).
2025 workingDirectoryChanged :: Session -> IO ()
2026 workingDirectoryChanged s = withSession s $ flushFinderCaches
2027
2028 -- -----------------------------------------------------------------------------
2029 -- inspecting the session
2030
2031 -- | Get the module dependency graph.
2032 getModuleGraph :: Session -> IO ModuleGraph -- ToDo: DiGraph ModSummary
2033 getModuleGraph s = withSession s (return . hsc_mod_graph)
2034
2035 isLoaded :: Session -> ModuleName -> IO Bool
2036 isLoaded s m = withSession s $ \hsc_env ->
2037   return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
2038
2039 getBindings :: Session -> IO [TyThing]
2040 getBindings s = withSession s $ \hsc_env ->
2041    -- we have to implement the shadowing behaviour of ic_tmp_ids here
2042    -- (see InteractiveContext) and the quickest way is to use an OccEnv.
2043    let
2044        tmp_ids = ic_tmp_ids (hsc_IC hsc_env)
2045        filtered = foldr f (const []) tmp_ids emptyUniqSet
2046        f id rest set
2047            | uniq `elementOfUniqSet` set = rest set
2048            | otherwise  = AnId id : rest (addOneToUniqSet set uniq)
2049            where uniq = getUnique (nameOccName (idName id))
2050    in
2051    return filtered
2052
2053 getPrintUnqual :: Session -> IO PrintUnqualified
2054 getPrintUnqual s = withSession s $ \hsc_env ->
2055   return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
2056
2057 -- | Container for information about a 'Module'.
2058 data ModuleInfo = ModuleInfo {
2059         minf_type_env  :: TypeEnv,
2060         minf_exports   :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
2061         minf_rdr_env   :: Maybe GlobalRdrEnv,   -- Nothing for a compiled/package mod
2062         minf_instances :: [Instance]
2063 #ifdef GHCI
2064         ,minf_modBreaks :: ModBreaks
2065 #endif
2066         -- ToDo: this should really contain the ModIface too
2067   }
2068         -- We don't want HomeModInfo here, because a ModuleInfo applies
2069         -- to package modules too.
2070
2071 -- | Request information about a loaded 'Module'
2072 getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
2073 getModuleInfo s mdl = withSession s $ \hsc_env -> do
2074   let mg = hsc_mod_graph hsc_env
2075   if mdl `elem` map ms_mod mg
2076         then getHomeModuleInfo hsc_env (moduleName mdl)
2077         else do
2078   {- if isHomeModule (hsc_dflags hsc_env) mdl
2079         then return Nothing
2080         else -} getPackageModuleInfo hsc_env mdl
2081    -- getPackageModuleInfo will attempt to find the interface, so
2082    -- we don't want to call it for a home module, just in case there
2083    -- was a problem loading the module and the interface doesn't
2084    -- exist... hence the isHomeModule test here.  (ToDo: reinstate)
2085
2086 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
2087 #ifdef GHCI
2088 getPackageModuleInfo hsc_env mdl = do
2089   (_msgs, mb_avails) <- getModuleExports hsc_env mdl
2090   case mb_avails of
2091     Nothing -> return Nothing
2092     Just avails -> do
2093         eps <- readIORef (hsc_EPS hsc_env)
2094         let
2095             names  = availsToNameSet avails
2096             pte    = eps_PTE eps
2097             tys    = [ ty | name <- concatMap availNames avails,
2098                             Just ty <- [lookupTypeEnv pte name] ]
2099         --
2100         return (Just (ModuleInfo {
2101                         minf_type_env  = mkTypeEnv tys,
2102                         minf_exports   = names,
2103                         minf_rdr_env   = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
2104                         minf_instances = error "getModuleInfo: instances for package module unimplemented",
2105                         minf_modBreaks = emptyModBreaks
2106                 }))
2107 #else
2108 getPackageModuleInfo _hsc_env _mdl = do
2109   -- bogusly different for non-GHCI (ToDo)
2110   return Nothing
2111 #endif
2112
2113 getHomeModuleInfo :: HscEnv -> ModuleName -> IO (Maybe ModuleInfo)
2114 getHomeModuleInfo hsc_env mdl =
2115   case lookupUFM (hsc_HPT hsc_env) mdl of
2116     Nothing  -> return Nothing
2117     Just hmi -> do
2118       let details = hm_details hmi
2119       return (Just (ModuleInfo {
2120                         minf_type_env  = md_types details,
2121                         minf_exports   = availsToNameSet (md_exports details),
2122                         minf_rdr_env   = mi_globals $! hm_iface hmi,
2123                         minf_instances = md_insts details
2124 #ifdef GHCI
2125                        ,minf_modBreaks = getModBreaks hmi
2126 #endif
2127                         }))
2128
2129 -- | The list of top-level entities defined in a module
2130 modInfoTyThings :: ModuleInfo -> [TyThing]
2131 modInfoTyThings minf = typeEnvElts (minf_type_env minf)
2132
2133 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
2134 modInfoTopLevelScope minf
2135   = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
2136
2137 modInfoExports :: ModuleInfo -> [Name]
2138 modInfoExports minf = nameSetToList $! minf_exports minf
2139
2140 -- | Returns the instances defined by the specified module.
2141 -- Warning: currently unimplemented for package modules.
2142 modInfoInstances :: ModuleInfo -> [Instance]
2143 modInfoInstances = minf_instances
2144
2145 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
2146 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
2147
2148 mkPrintUnqualifiedForModule :: Session -> ModuleInfo -> IO (Maybe PrintUnqualified)
2149 mkPrintUnqualifiedForModule s minf = withSession s $ \hsc_env -> do
2150   return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
2151
2152 modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
2153 modInfoLookupName s minf name = withSession s $ \hsc_env -> do
2154    case lookupTypeEnv (minf_type_env minf) name of
2155      Just tyThing -> return (Just tyThing)
2156      Nothing      -> do
2157        eps <- readIORef (hsc_EPS hsc_env)
2158        return $! lookupType (hsc_dflags hsc_env)
2159                             (hsc_HPT hsc_env) (eps_PTE eps) name
2160
2161 #ifdef GHCI
2162 modInfoModBreaks :: ModuleInfo -> ModBreaks
2163 modInfoModBreaks = minf_modBreaks
2164 #endif
2165
2166 isDictonaryId :: Id -> Bool
2167 isDictonaryId id
2168   = case tcSplitSigmaTy (idType id) of { (_tvs, _theta, tau) -> isDictTy tau }
2169
2170 -- | Looks up a global name: that is, any top-level name in any
2171 -- visible module.  Unlike 'lookupName', lookupGlobalName does not use
2172 -- the interactive context, and therefore does not require a preceding
2173 -- 'setContext'.
2174 lookupGlobalName :: Session -> Name -> IO (Maybe TyThing)
2175 lookupGlobalName s name = withSession s $ \hsc_env -> do
2176    eps <- readIORef (hsc_EPS hsc_env)
2177    return $! lookupType (hsc_dflags hsc_env)
2178                         (hsc_HPT hsc_env) (eps_PTE eps) name
2179
2180 #ifdef GHCI
2181 -- | get the GlobalRdrEnv for a session
2182 getGRE :: Session -> IO GlobalRdrEnv
2183 getGRE s = withSession s $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
2184 #endif
2185
2186 -- -----------------------------------------------------------------------------
2187 -- Misc exported utils
2188
2189 dataConType :: DataCon -> Type
2190 dataConType dc = idType (dataConWrapId dc)
2191
2192 -- | print a 'NamedThing', adding parentheses if the name is an operator.
2193 pprParenSymName :: NamedThing a => a -> SDoc
2194 pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
2195
2196 -- ----------------------------------------------------------------------------
2197
2198 #if 0
2199
2200 -- ToDo:
2201 --   - Data and Typeable instances for HsSyn.
2202
2203 -- ToDo: check for small transformations that happen to the syntax in
2204 -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
2205
2206 -- ToDo: maybe use TH syntax instead of IfaceSyn?  There's already a way
2207 -- to get from TyCons, Ids etc. to TH syntax (reify).
2208
2209 -- :browse will use either lm_toplev or inspect lm_interface, depending
2210 -- on whether the module is interpreted or not.
2211
2212 -- This is for reconstructing refactored source code
2213 -- Calls the lexer repeatedly.
2214 -- ToDo: add comment tokens to token stream
2215 getTokenStream :: Session -> Module -> IO [Located Token]
2216 #endif
2217
2218 -- -----------------------------------------------------------------------------
2219 -- Interactive evaluation
2220
2221 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
2222 -- filesystem and package database to find the corresponding 'Module',
2223 -- using the algorithm that is used for an @import@ declaration.
2224 findModule :: Session -> ModuleName -> Maybe PackageId -> IO Module
2225 findModule s mod_name maybe_pkg = withSession s $ \hsc_env ->
2226   let
2227         dflags = hsc_dflags hsc_env
2228         hpt    = hsc_HPT hsc_env
2229         this_pkg = thisPackage dflags
2230   in
2231   case lookupUFM hpt mod_name of
2232     Just mod_info -> return (mi_module (hm_iface mod_info))
2233     _not_a_home_module -> do
2234           res <- findImportedModule hsc_env mod_name maybe_pkg
2235           case res of
2236             Found _ m | modulePackageId m /= this_pkg -> return m
2237                       | otherwise -> throwDyn (CmdLineError (showSDoc $
2238                                         text "module" <+> quotes (ppr (moduleName m)) <+>
2239                                         text "is not loaded"))
2240             err -> let msg = cannotFindModule dflags mod_name err in
2241                    throwDyn (CmdLineError (showSDoc msg))
2242
2243 #ifdef GHCI
2244 getHistorySpan :: Session -> History -> IO SrcSpan
2245 getHistorySpan sess h = withSession sess $ \hsc_env ->
2246                           return$ InteractiveEval.getHistorySpan hsc_env h
2247
2248 obtainTerm :: Session -> Bool -> Id -> IO Term
2249 obtainTerm sess force id = withSession sess $ \hsc_env ->
2250                             InteractiveEval.obtainTerm hsc_env force id
2251
2252 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
2253 obtainTerm1 sess force mb_ty a = withSession sess $ \hsc_env ->
2254                                InteractiveEval.obtainTerm1 hsc_env force mb_ty a
2255
2256 obtainTermB :: Session -> Int -> Bool -> Id -> IO Term
2257 obtainTermB sess bound force id = withSession sess $ \hsc_env ->
2258                             InteractiveEval.obtainTermB hsc_env bound force id
2259
2260 #endif