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